mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

make the webapp honor the web.browser git config

Browse source
This commit is contained in:
Joey Hess 2012-08-08 13:15:35 -04:00
parent 7e2d07484f
commit fb4b19deed
2 changed files with 26 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

22
Command/WebApp.hs
View file

@ -17,6 +17,8 @@ import Assistant.Threads.WebApp
import Utility.WebApp import Utility.WebApp
import Utility.Daemon (checkDaemon, lockPidFile) import Utility.Daemon (checkDaemon, lockPidFile)
import Init import Init
import qualified Git
import qualified Git.Config
import qualified Git.CurrentRepo import qualified Git.CurrentRepo
import qualified Annex import qualified Annex
import Locations.UserConfig import Locations.UserConfig
@ -38,11 +40,12 @@ start = notBareRepo $ do
stop stop
where where
go = do go = do
browser <- fromRepo webBrowser
f <- liftIO . absPath =<< fromRepo gitAnnexHtmlShim f <- liftIO . absPath =<< fromRepo gitAnnexHtmlShim
ifM (checkpid <&&> checkshim f) $ ifM (checkpid <&&> checkshim f) $
( liftIO $ openBrowser f ( liftIO $ openBrowser browser f
, startDaemon True True $ Just $ , startDaemon True True $ Just $
const openBrowser const $ openBrowser browser
) )
checkpid = do checkpid = do
pidfile <- fromRepo gitAnnexPidFile pidfile <- fromRepo gitAnnexPidFile
@ -95,7 +98,8 @@ firstRun = do
putMVar v "" putMVar v ""
takeMVar v takeMVar v
mainthread v _url htmlshim = do mainthread v _url htmlshim = do
openBrowser htmlshim browser <- webBrowser <$> Git.Config.global
openBrowser browser htmlshim
_wait <- takeMVar v _wait <- takeMVar v
@ -108,11 +112,17 @@ firstRun = do
dummydaemonize = do dummydaemonize = do
liftIO . lockPidFile =<< fromRepo gitAnnexPidFile liftIO . lockPidFile =<< fromRepo gitAnnexPidFile
openBrowser :: FilePath -> IO () openBrowser :: Maybe FilePath -> FilePath -> IO ()
openBrowser htmlshim = unlessM (runBrowser url) $ openBrowser cmd htmlshim = go $ maybe runBrowser runCustomBrowser cmd
error $ "failed to start web browser on url " ++ url
where where
url = fileUrl htmlshim url = fileUrl htmlshim
go a = unlessM (a url) $
error $ "failed to start web browser on url " ++ url
runCustomBrowser c u = boolSystem c [Param u]
{- web.browser is a generic git config setting for a web browser program -}
webBrowser :: Git.Repo -> Maybe FilePath
webBrowser = Git.Config.getMaybe "web.browser"
fileUrl :: FilePath -> String fileUrl :: FilePath -> String
fileUrl file = "file://" ++ file fileUrl file = "file://" ++ file

10
Git/Config.hs
View file

@ -54,6 +54,16 @@ read' repo = go repo
params = ["config", "--null", "--list"] params = ["config", "--null", "--list"]
p = (proc "git" params) { cwd = Just d } p = (proc "git" params) { cwd = Just d }
{- Gets the global git config, returning a dummy Repo containing it. -}
global :: IO Repo
global = do
repo <- Git.Construct.fromUnknown
withHandle StdoutHandle createProcessSuccess p $
hRead repo
where
params = ["config", "--null", "--list", "--global"]
p = (proc "git" params)
{- Reads git config from a handle and populates a repo with it. -} {- Reads git config from a handle and populates a repo with it. -}
hRead :: Repo -> Handle -> IO Repo hRead :: Repo -> Handle -> IO Repo
hRead repo h = do hRead repo h = do