Install XDG desktop icon files.

The icon files will be installed when running make install or cabal
install. Did not try to run update-icon-caches, since I think it's debian
specific, and dh_icons will take care of that for the Debian package.

Using the favicon as a 16x16 icon. At 24x24 the svg displays pretty well,
although the dotted lines are rather faint. The svg is ok at all higher
resolutions.

The standalone linux build auto-installs the desktop and autostart files
when run. I have not made it auto-install the icon file too, because
a) that would take more work to include them in the tarball and find them
b) it would need to be an install to ~/.icons/, and I don't know if that
   really works!

Assistant/Install/AutoStart.hs

@@ -35,4 +35,5 @@ fdoAutostart command = genDesktopEntry
 	"Autostart"
 	False
 	(command ++ " assistant --autostart")
+	Nothing
 	[]

Assistant/Install/Menu.hs

@@ -27,4 +27,5 @@ fdoDesktopMenu command = genDesktopEntry
 	"Track and sync the files in your Git Annex"
 	False
 	(command ++ " webapp")
+	(Just "git-annex") -- icon base name
 	["Network", "FileTransfer"]

Build/DesktopFile.hs

@@ -1,4 +1,4 @@
-{- Generating and installing a desktop menu entry file
+{- Generating and installing a desktop menu entry file and icon,
  - and a desktop autostart file. (And OSX equivilants.)
  -
  - Copyright 2012 Joey Hess <joey@kitenet.net>
@@ -28,6 +28,7 @@ import System.Posix.Files
 #endif
 import System.FilePath
 import Data.Maybe
+import System.IO
 
 systemwideInstall :: IO Bool
 #ifndef mingw32_HOST_OS 
@@ -48,14 +49,28 @@ inDestDir f = do
 
 writeFDODesktop :: FilePath -> IO ()
 writeFDODesktop command = do
-	datadir <- ifM systemwideInstall ( return systemDataDir, userDataDir )
+	systemwide <- systemwideInstall
+
+	datadir <- if systemwide then return systemDataDir else userDataDir
 	installMenu command
 		=<< inDestDir (desktopMenuFilePath "git-annex" datadir)
 
-	configdir <- ifM systemwideInstall ( return systemConfigDir, userConfigDir )
+	installIcon "doc/logo.svg" =<< inDestDir
+		=<< iconFilePath "git-annex.svg" "scalable" systemwide
+	installIcon "doc/favicon.png" =<< inDestDir
+		=<< iconFilePath "git-annex.png" "16x16" systemwide
+
+	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

Build/InstallDesktopFile.hs

@@ -1,4 +1,4 @@
-{- Generating and installing a desktop menu entry file
+{- Generating and installing a desktop menu entry file and icon,
  - and a desktop autostart file. (And OSX equivilants.)
  -
  - Copyright 2012 Joey Hess <joey@kitenet.net>

Utility/FreeDesktop.hs

@@ -3,6 +3,7 @@
  - http://standards.freedesktop.org/basedir-spec/latest/
  - http://standards.freedesktop.org/desktop-entry-spec/latest/
  - http://standards.freedesktop.org/menu-spec/latest/
+ - http://standards.freedesktop.org/icon-theme-spec/latest/
  -
  - Copyright 2012 Joey Hess <joey@kitenet.net>
  -
@@ -16,6 +17,7 @@ module Utility.FreeDesktop (
 	writeDesktopMenuFile,
 	desktopMenuFilePath,
 	autoStartPath,
+	iconFilePath,
 	systemDataDir,
 	systemConfigDir,
 	userDataDir,
@@ -34,6 +36,7 @@ import System.Directory
 import System.FilePath
 import Data.List
 import Data.String.Utils
+import Data.Maybe
 import Control.Applicative
 
 type DesktopEntry = [(Key, Value)]
@@ -54,18 +57,19 @@ toString (ListV l)
   where
 	escapesemi = join "\\;" . split ";"
 
-genDesktopEntry :: String -> String -> Bool -> FilePath -> [String] -> DesktopEntry
+genDesktopEntry :: String -> String -> Bool -> FilePath -> Maybe String -> [String] -> DesktopEntry
-genDesktopEntry name comment terminal program categories =
+genDesktopEntry name comment terminal program icon categories = catMaybes
 	[ item "Type" StringV "Application"
 	, item "Version" NumericV 1.0
 	, item "Name" StringV name
 	, item "Comment" StringV comment
 	, item "Terminal" BoolV terminal
 	, item "Exec" StringV program
+	, maybe Nothing (item "Icon" StringV) icon
 	, item "Categories" ListV (map StringV categories)
 	]
   where
-	item x c y = (x, c y)
+	item x c y = Just (x, c y)
 
 buildDesktopMenuFile :: DesktopEntry -> String
 buildDesktopMenuFile d = unlines ("[Desktop Entry]" : map keyvalue d) ++ "\n"
@@ -89,6 +93,17 @@ autoStartPath :: String -> FilePath -> FilePath
 autoStartPath basename configdir =
 	configdir </> "autostart" </> desktopfile basename
 
+{- Path to use for an icon file.
+ - The resolution is something like "48x48" or "scalable". -}
+iconFilePath :: FilePath -> String -> Bool -> IO FilePath
+iconFilePath file resolution systemwide
+	| systemwide = return $ systemDataDir </> "icons" </> subpath
+	| otherwise = do
+		home <- myHomeDir
+		return $ home </> ".icons" </> subpath
+  where
+	subpath = "hicolor" </> resolution </> "apps" </> file
+
 desktopfile :: FilePath -> FilePath
 desktopfile f = f ++ ".desktop"
 

debian/changelog

@@ -1,3 +1,9 @@
+git-annex (4.20130710) UNRELEASED; urgency=low
+
+  * Install XDG desktop icon files.
+
+ -- Joey Hess <joeyh@debian.org>  Tue, 09 Jul 2013 19:17:13 -0400
+
 git-annex (4.20130709) unstable; urgency=low
 
   * --all: New switch that makes git-annex operate on all data stored