webapp: Automatically install Konqueror integration scripts to get and drop files.

Based on the example from the tip, but modified to cd into the repo before
running git-annex, since konqueror does not. Also, at least on my system,
the directory is ~/.kde, not ~/.kde4. (konqueror 4.12.4)

This commit was sponsored by Jürgen Peters.

Assistant/Install.hs

@@ -22,6 +22,7 @@ import Utility.SshConfig
 import Utility.OSX
 #else
 import Utility.FreeDesktop
+import Utility.UserInfo
 import Assistant.Install.Menu
 #endif
 
@@ -36,13 +37,13 @@ standaloneAppBase = getEnv "GIT_ANNEX_APP_BASE"
  - Note that this is done every time it's started, so if the user moves
  - it around, the paths this sets up won't break.
  -
- - Nautilus hook script installation is done even for packaged apps,
- - since it has to go into the user's home directory.
+ - File manager hook script installation is done even for
+ - packaged apps, since it has to go into the user's home directory.
  -}
 ensureInstalled :: IO ()
 ensureInstalled = go =<< standaloneAppBase
   where
-	go Nothing = installNautilus "git-annex"
+	go Nothing = installFileManagerHooks "git-annex"
 	go (Just base) = do
 		let program = base </> "git-annex"
 		programfile <- programFile
@@ -78,7 +79,7 @@ ensureInstalled = go =<< standaloneAppBase
 			, runshell "\"$@\""
 			]
 
-		installNautilus program
+		installFileManagerHooks program
 
 installWrapper :: FilePath -> String -> IO ()
 installWrapper file content = do
@@ -88,15 +89,23 @@ installWrapper file content = do
 		viaTmp writeFile file content
 		modifyFileMode file $ addModes [ownerExecuteMode]
 
-installNautilus :: FilePath -> IO ()
+installFileManagerHooks :: FilePath -> IO ()
 #ifdef linux_HOST_OS
-installNautilus program = do
-	scriptdir <- (\d -> d </> "nautilus" </> "scripts") <$> userDataDir
-	createDirectoryIfMissing True scriptdir
-	genscript scriptdir "get"
-	genscript scriptdir "drop"
+installFileManagerHooks program = do
+	-- Gnome
+	nautilusScriptdir <- (\d -> d </> "nautilus" </> "scripts") <$> userDataDir
+	createDirectoryIfMissing True nautilusScriptdir
+	genNautilusScript nautilusScriptdir "get"
+	genNautilusScript nautilusScriptdir "drop"
+
+	-- KDE
+	home <- myHomeDir
+	let kdeServiceMenusdir = home </> ".kde" </> "share" </> "kde4" </> "services" </> "ServiceMenus"
+	createDirectoryIfMissing True kdeServiceMenusdir
+	writeFile (kdeServiceMenusdir </> "git-annex.desktop")
+		(kdeDesktopFile ["get", "drop"])
   where
-	genscript scriptdir action =
+	genNautilusScript scriptdir action =
 		installscript (scriptdir </> scriptname action) $ unlines
 			[ shebang_local
 			, autoaddedcomment
@@ -108,9 +117,33 @@ installNautilus program = do
 		modifyFileMode f $ addModes [ownerExecuteMode]
 	safetoinstallscript f = catchDefaultIO True $
 		elem autoaddedcomment . lines <$> readFileStrict f
-	autoaddedcomment = "# Automatically added by git-annex, do not edit. (To disable, chmod 600 this file.)"
+	autoaddedcomment = "# " ++ autoaddedmsg ++ " (To disable, chmod 600 this file.)"
+	autoaddedmsg = "Automatically added by git-annex, do not edit."
+
+	kdeDesktopFile actions = unlines $ concat $
+		kdeDesktopHeader actions : map kdeDesktopAction actions
+	kdeDesktopHeader actions =
+		[ "# " ++ autoaddedmsg
+		, "[Desktop Entry]"
+		, "Type=Service"
+		, "ServiceTypes=all/allfiles"
+		, "MimeType=all/all;"
+		, "Actions=" ++ intercalate ";" (map kdeDesktopSection actions)
+		, "X-KDE-Priority=TopLevel"
+		, "X-KDE-Submenu=Git-Annex"
+		, "X-KDE-Icon=git-annex"
+		, "X-KDE-ServiceTypes=KonqPopupMenu/Plugin"
+		]
+	kdeDesktopSection command = "GitAnnex" ++ command
+	kdeDesktopAction command = 
+		[ ""
+		, "[Desktop Action " ++ kdeDesktopSection command ++ "]"
+		, "Name=" ++ command
+		, "Icon=git-annex"
+		, "Exec=sh -c 'cd \"$(dirname '%U')\" && git-annex " ++ command ++ " --notify-start --notify-finish -- %U'"
+		]
 #else
-installNautilus _ = noop
+installFileManagerHooks _ = noop
 #endif
 
 {- Returns a cleaned up environment that lacks settings used to make the

debian/changelog

@@ -1,3 +1,10 @@
+git-annex (5.20140718) UNRELEASED; urgency=medium
+
+  * webapp: Automatically install Konqueror integration scripts
+    to get and drop files.
+
+ -- Joey Hess <joeyh@debian.org>  Mon, 21 Jul 2014 14:41:26 -0400
+
 git-annex (5.20140717) unstable; urgency=high
 
   * Fix minor FD leak in journal code. Closes: #754608

doc/tips/file_manager_integration.mdwn

@@ -3,10 +3,11 @@ annexed files to get or drop.
 
 [[!toc]]
 
-## GNOME (nautilus)
+## GNOME (nautilus) and KDE (Dolphin/Konqueror)
 
-Recent git-annex comes with built-in nautilus integration. Just pick the
-action from the menu.
+Recent git-annex comes with built-in integration for the file managers of
+these desktop environments. These let you pick git-annex get and git-annex
+drop actions from the context menus when right-clicking on a file.
 
 [[!img assistant/nautilusmenu.png]]
 
@@ -14,30 +15,8 @@ action from the menu.
 
 This is set up by making simple scripts in
 `~/.local/share/nautilus/scripts`, with names like "git-annex get"
-
-## KDE (Dolphin/Konqueror)
-
-Create a file `~/.kde4/share/kde4/services/ServiceMenus/git-annex.desktop` with the following contents:
-
-        [Desktop Entry]
-        Type=Service
-        ServiceTypes=all/allfiles
-        MimeType=all/all;
-        Actions=GitAnnexGet;GitAnnexDrop;
-        X-KDE-Priority=TopLevel
-        X-KDE-Submenu=Git-Annex
-        X-KDE-Icon=git-annex
-        X-KDE-ServiceTypes=KonqPopupMenu/Plugin
-
-        [Desktop Action GitAnnexGet]
-        Name=Get
-        Icon=git-annex
-        Exec=git-annex get --notify-start --notify-finish -- %U
-
-        [Desktop Action GitAnnexDrop]
-        Name=Drop
-        Icon=git-annex
-        Exec=git-annex drop --notify-start --notify-finish -- %U
+and by making a 
+`~/.kde/share/kde4/services/ServiceMenus/git-annex.desktop file.
 
 ## XFCE (Thunar)