linux standalone auto-install icons

This commit is contained in:
Joey Hess 2013-07-09 20:50:41 -04:00
parent 9dac79a018
commit 00e6663128
5 changed files with 36 additions and 25 deletions

View file

@ -49,8 +49,9 @@ ensureInstalled = go =<< standaloneAppBase
#ifdef darwin_HOST_OS
autostartfile <- userAutoStart osxAutoStartLabel
#else
installMenu program
=<< desktopMenuFilePath "git-annex" <$> userDataDir
menufile <- desktopMenuFilePath "git-annex" <$> userDataDir
icondir <- iconDir <$> userDataDir
installMenu program menufile base icondir
autostartfile <- autoStartPath "git-annex" <$> userConfigDir
#endif
installAutoStart program autostartfile

View file

@ -9,14 +9,20 @@
module Assistant.Install.Menu where
import Common
import Utility.FreeDesktop
installMenu :: FilePath -> FilePath -> IO ()
installMenu command file =
installMenu :: FilePath -> FilePath -> FilePath -> FilePath -> IO ()
installMenu command menufile iconsrcdir icondir = do
#ifdef darwin_HOST_OS
return ()
#else
writeDesktopMenuFile (fdoDesktopMenu command) file
writeDesktopMenuFile (fdoDesktopMenu command) menufile
installIcon (iconsrcdir </> "logo.svg") $
iconFilePath (iconBaseName ++ ".svg") "scalable" icondir
installIcon (iconsrcdir </> "favicon.png") $
iconFilePath (iconBaseName ++ ".png") "16x16" icondir
#endif
{- The command can be either just "git-annex", or the full path to use
@ -27,5 +33,15 @@ fdoDesktopMenu command = genDesktopEntry
"Track and sync the files in your Git Annex"
False
(command ++ " webapp")
(Just "git-annex") -- icon base name
(Just iconBaseName)
["Network", "FileTransfer"]
installIcon :: FilePath -> FilePath -> IO ()
installIcon src dest = do
createDirectoryIfMissing True (parentDir dest)
withBinaryFile src ReadMode $ \hin ->
withBinaryFile dest WriteMode $ \hout ->
hGetContents hin >>= hPutStr hout
iconBaseName :: String
iconBaseName = "git-annex"

View file

@ -28,7 +28,6 @@ import System.Posix.Files
#endif
import System.FilePath
import Data.Maybe
import System.IO
systemwideInstall :: IO Bool
#ifndef mingw32_HOST_OS
@ -52,25 +51,14 @@ writeFDODesktop command = do
systemwide <- systemwideInstall
datadir <- if systemwide then return systemDataDir else userDataDir
installMenu command
=<< inDestDir (desktopMenuFilePath "git-annex" datadir)
installIcon "doc/logo.svg"
=<< inDestDir (iconFilePath "git-annex.svg" "scalable" datadir)
installIcon "doc/favicon.png"
=<< inDestDir (iconFilePath "git-annex.png" "16x16" datadir)
menufile <- inDestDir (desktopMenuFilePath "git-annex" datadir)
icondir <- inDestDir (iconDir datadir)
installMenu command menufile "doc" icondir
configdir <- if systemwide then return systemConfigDir else userConfigDir
installAutoStart command
=<< inDestDir (autoStartPath "git-annex" configdir)
installIcon :: FilePath -> FilePath -> IO ()
installIcon src dest = do
createDirectoryIfMissing True (parentDir dest)
withBinaryFile src ReadMode $ \hin ->
withBinaryFile dest WriteMode $ \hout ->
hGetContents hin >>= hPutStr hout
writeOSXDesktop :: FilePath -> IO ()
writeOSXDesktop command = do
installAutoStart command =<< inDestDir =<< ifM systemwideInstall

View file

@ -107,6 +107,7 @@ linuxstandalone: Build/Standalone
strip "$(LINUXSTANDALONE_DEST)/bin/git-annex"
ln -sf git-annex "$(LINUXSTANDALONE_DEST)/bin/git-annex-shell"
zcat standalone/licences.gz > $(LINUXSTANDALONE_DEST)/LICENSE
cp doc/favicon.png doc/logo.svg $(LINUXSTANDALONE_DEST)
./Build/Standalone "$(LINUXSTANDALONE_DEST)"

View file

@ -17,6 +17,7 @@ module Utility.FreeDesktop (
writeDesktopMenuFile,
desktopMenuFilePath,
autoStartPath,
iconDir,
iconFilePath,
systemDataDir,
systemConfigDir,
@ -93,13 +94,17 @@ autoStartPath :: String -> FilePath -> FilePath
autoStartPath basename configdir =
configdir </> "autostart" </> desktopfile basename
{- Path to use for an icon file, in either the systemDataDir
- or the userDatadir.
{- Base directory to install an icon file, in either the systemDataDir
- or the userDatadir. -}
iconDir :: FilePath -> FilePath
iconDir datadir = datadir </> "icons" </> "hicolor"
{- Filename of an icon, given the iconDir to use.
-
- The resolution is something like "48x48" or "scalable". -}
iconFilePath :: FilePath -> String -> FilePath -> FilePath
iconFilePath file resolution datadir = datadir </> "icons" </>
"hicolor" </> resolution </> "apps" </> file
iconFilePath file resolution icondir =
icondir </> resolution </> "apps" </> file
desktopfile :: FilePath -> FilePath
desktopfile f = f ++ ".desktop"