From fcec780f4bf68073bfad76998b05bf8663e9b83f Mon Sep 17 00:00:00 2001
From: Devin Mullins <me@twifkak.com>
Date: Sat, 6 Oct 2007 09:09:59 +0200
Subject: change Dmenu functions to return IO/X (Maybe String)

dmenu exits with code 1 when you hit Escape, and I wanna create a contrib that
takes advantage of that.

This required changes in four contribs (Commands, DirectoryPrompt, ShellPrompt,
and WorkspaceDir), and might require changes in users' Configs. Also, I'm not
sure some of the changes I made to the client code are very Haskelly. Would
appreciate input there.

darcs-hash:20071006070959-78224-eeefb4300d6d3de7b199f2b1ad37ba43384e03f1.gz
---
 Commands.hs        |  4 +++-
 DirectoryPrompt.hs |  4 +++-
 Dmenu.hs           | 18 +++++++++++-------
 ShellPrompt.hs     |  2 +-
 WorkspaceDir.hs    |  6 ++++--
 5 files changed, 22 insertions(+), 12 deletions(-)

diff --git a/Commands.hs b/Commands.hs
index ccb8c55..dcab544 100644
--- a/Commands.hs
+++ b/Commands.hs
@@ -102,7 +102,9 @@ runCommand :: [(String, X ())] -> X ()
 runCommand cl = do
   let m = commandMap cl
   choice <- dmenu (M.keys m)
-  fromMaybe (return ()) (M.lookup choice m)
+  case choice of
+    Just selection -> fromMaybe (return ()) (M.lookup selection m)
+    Nothing        -> return ()
 
 runCommand' :: String -> X ()
 runCommand' c = do
diff --git a/DirectoryPrompt.hs b/DirectoryPrompt.hs
index b010d4f..5ea4c36 100644
--- a/DirectoryPrompt.hs
+++ b/DirectoryPrompt.hs
@@ -18,6 +18,8 @@ module XMonadContrib.DirectoryPrompt (
                              directoryPrompt
                               ) where
 
+import Data.Maybe(fromMaybe)
+
 import XMonad
 import XMonadContrib.XPrompt
 import XMonadContrib.Dmenu ( runProcessWithInput )
@@ -34,7 +36,7 @@ directoryPrompt :: XPConfig -> String -> (String -> X ()) -> X ()
 directoryPrompt c prom job = mkXPrompt (Dir prom) c getDirCompl job
 
 getDirCompl :: String -> IO [String]
-getDirCompl s = (filter notboring . lines) `fmap`
+getDirCompl s = (filter notboring . lines . fromMaybe "") `fmap`
                 runProcessWithInput "/bin/bash" [] ("compgen -A directory " ++ s ++ "\n")
 
 notboring :: String -> Bool
diff --git a/Dmenu.hs b/Dmenu.hs
index 222d668..e5542c9 100644
--- a/Dmenu.hs
+++ b/Dmenu.hs
@@ -21,6 +21,7 @@ module XMonadContrib.Dmenu (
 
 import XMonad
 import qualified StackSet as W
+import System.Exit
 import System.Process
 import System.IO
 import Control.Monad.State
@@ -32,7 +33,9 @@ import Control.Monad.State
 
 -- %import XMonadContrib.Dmenu
 
-runProcessWithInput :: FilePath -> [String] -> String -> IO String
+-- | Returns Just output if the command succeeded, and Nothing if it didn't.
+-- This corresponds to dmenu's notion of exit code 1 for a cancelled invocation.
+runProcessWithInput :: FilePath -> [String] -> String -> IO (Maybe String)
 runProcessWithInput cmd args input = do
     (pin, pout, perr, ph) <- runInteractiveProcess cmd args Nothing Nothing
     hPutStr pin input
@@ -41,16 +44,17 @@ runProcessWithInput cmd args input = do
     when (output==output) $ return ()
     hClose pout
     hClose perr
-    waitForProcess ph
-    return output
-    
+    exitCode <- waitForProcess ph
+    case exitCode of
+      ExitSuccess   -> return (Just output)
+      ExitFailure _ -> return Nothing
+
 -- | Starts dmenu on the current screen. Requires this patch to dmenu:
 -- <http://www.jcreigh.com/dmenu/dmenu-3.2-xinerama.patch>
-dmenuXinerama :: [String] -> X String
+dmenuXinerama :: [String] -> X (Maybe String)
 dmenuXinerama opts = do
     curscreen <- (fromIntegral . W.screen . W.current) `liftM` gets windowset :: X Int
     io $ runProcessWithInput "dmenu" ["-xs", show (curscreen+1)] (unlines opts)
 
-dmenu :: [String] -> X String
+dmenu :: [String] -> X (Maybe String)
 dmenu opts = io $ runProcessWithInput "dmenu" [] (unlines opts)
-
diff --git a/ShellPrompt.hs b/ShellPrompt.hs
index d68d7cf..5a6aaf6 100644
--- a/ShellPrompt.hs
+++ b/ShellPrompt.hs
@@ -58,7 +58,7 @@ shellPrompt c = mkXPrompt Shell c getShellCompl spawn
 getShellCompl :: String -> IO [String]
 getShellCompl s 
     | s /= "" && last s /= ' ' = do
-  f <- fmap lines $ runProcessWithInput "/bin/bash" [] ("compgen -A file " ++ s ++ "\n")
+  f <- fmap (lines . fromMaybe "") $ runProcessWithInput "/bin/bash" [] ("compgen -A file " ++ s ++ "\n")
   c <- commandCompletionFunction s
   hPutStrLn stdout s
   return $ map escape . sort . nub $ f ++ c
diff --git a/WorkspaceDir.hs b/WorkspaceDir.hs
index 97e5f94..32f548d 100644
--- a/WorkspaceDir.hs
+++ b/WorkspaceDir.hs
@@ -68,8 +68,10 @@ workspaceDir :: LayoutClass l a => String -> l a
 workspaceDir s = ModifiedLayout (WorkspaceDir s)
 
 scd :: String -> X ()
-scd x = do x' <- io (runProcessWithInput "bash" [] ("echo -n " ++ x) `catch` \_ -> return x)
-           catchIO $ setCurrentDirectory x'
+scd x = do x' <- io (runProcessWithInput "bash" [] ("echo -n " ++ x) `catch` \_ -> return Nothing)
+           case x' of
+             Just newDir -> catchIO $ setCurrentDirectory newDir
+             Nothing     -> return ()
 
 changeDir :: XPConfig -> X ()
 changeDir c = directoryPrompt c "Set working directory: " (sendMessage . Chdir)
-- 
cgit v1.2.3