install autostart file too

This commit is contained in:
Joey Hess 2012-08-01 23:31:53 -04:00
parent ffeb060002
commit 23fe661d37
3 changed files with 41 additions and 19 deletions

View file

@ -1,4 +1,5 @@
{- Generating and installing a desktop menu entry file.
{- Generating and installing a desktop menu entry file
- and a desktop autostart file.
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
@ -24,16 +25,28 @@ desktop command = genDesktopEntry
(command ++ " webapp")
["Network", "FileTransfer"]
writeDesktop :: DesktopEntry -> IO ()
writeDesktop d = do
autostart :: FilePath -> DesktopEntry
autostart command = genDesktopEntry
"Git Annex Assistant"
"Autostart"
False
(command ++ " assistant --autostart")
[]
writeDesktop :: String -> IO ()
writeDesktop command = do
destdir <- catchDefaultIO (getEnv "DESTDIR") ""
uid <- fromIntegral <$> getRealUserID
dest <- if uid /= 0
then userDesktopMenuFilePath "git-annex"
else return $ systemDesktopMenuFilePath "git-annex"
writeDesktopMenuFile d dest
datadir <- if uid /= 0 then userDataDir else return systemDataDir
writeDesktopMenuFile (desktop command) $
desktopMenuFilePath "git-annex" datadir
configdir <- if uid /= 0 then userConfigDir else return systemConfigDir
writeDesktopMenuFile (autostart command) $
autoStartPath "git-annex" configdir
main = getArgs >>= go
where
go [] = error "specify git-annex command"
go (command:_) = writeDesktop $ desktop command
go (command:_) = writeDesktop command

View file

@ -52,6 +52,6 @@ installManpages copyDest verbosity pkg lbi =
installDesktopFile :: CopyDest -> Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()
installDesktopFile copyDest verbosity pkg lbi =
InstallDesktopFile.writeDesktop $ InstallDesktopFile.desktop $ dstBinDir </> "git-annex"
InstallDesktopFile.writeDesktop $ dstBinDir </> "git-annex"
where
dstBinDir = bindir $ absoluteInstallDirs pkg lbi copyDest

View file

@ -14,8 +14,12 @@ module Utility.FreeDesktop (
genDesktopEntry,
buildDesktopMenuFile,
writeDesktopMenuFile,
userDesktopMenuFilePath,
systemDesktopMenuFilePath
desktopMenuFilePath,
autoStartPath,
systemDataDir,
systemConfigDir,
userDataDir,
userConfigDir
) where
import Utility.Exception
@ -70,18 +74,23 @@ writeDesktopMenuFile d file = do
createDirectoryIfMissing True (parentDir file)
writeFile file $ buildDesktopMenuFile d
userDesktopMenuFilePath :: String -> IO FilePath
userDesktopMenuFilePath basename = do
datadir <- userDataDir
return $ datadir </> "applications" </> desktopfile basename
desktopMenuFilePath :: String -> FilePath -> FilePath
desktopMenuFilePath basename datadir =
datadir </> "applications" </> desktopfile basename
systemDesktopMenuFilePath :: String -> FilePath
systemDesktopMenuFilePath basename =
"/usr/share/applications" </> desktopfile basename
autoStartPath :: String -> FilePath -> FilePath
autoStartPath basename configdir =
configdir </> "autostart" </> desktopfile basename
desktopfile :: FilePath -> FilePath
desktopfile f = f ++ ".desktop"
systemDataDir :: FilePath
systemDataDir = "/usr/share"
systemConfigDir :: FilePath
systemConfigDir = "/etc/xdg"
userDataDir :: IO FilePath
userDataDir = do
dir <- xdgEnv "DATA_HOME" =<< myHomeDir
@ -89,7 +98,7 @@ userDataDir = do
userConfigDir :: IO FilePath
userConfigDir = do
dir <- xdgEnv "DATA_HOME" =<< myHomeDir
dir <- xdgEnv "CONFIG_HOME" =<< myHomeDir
return $ dir </> ".config"
xdgEnv :: String -> String -> IO String