install autostart file too
This commit is contained in:
parent
ffeb060002
commit
23fe661d37
3 changed files with 41 additions and 19 deletions
|
@ -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
|
||||
|
|
2
Setup.hs
2
Setup.hs
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue