prompt completion: case-sensitivity

Provide a way to perform case-insensitive file / directory completion.
We're using compgen to generate completion candidates, and this is
case-sensitive by default. We can control this by setting the
completion-ignore-case Readline variable prior to invoking compgen. If
we're running a Bash with Readline support, this works as expected.
Otherwise, it has no effect -- completion candidates are still returned,
but compgen generates them in a case-sensitive manner.

To avoid breaking changes, the signatures and behavior of existing
exported functions are unchanged:
  - XMonad.Layout.WorkspaceDir.changeDir
  - XMonad.Prompt.Directory.directoryPrompt
  - XMonad.Prompt.Shell.getShellCompl

New variations of these functions are provided, allowing the caller
to specify the desired case-sensitivity via a ComplCaseSensitivity
argument:
  - XMonad.Layout.WorkspaceDir.changeDir'
  - XMonad.Prompt.Directory.directoryPrompt'
  - XMonad.Prompt.Shell.getShellCompl'

The XMonad.Prompt.Shell exports a couple new functions:
  - compgenDirectories
  - compgenFiles

We make use of this in XMonad.Prompt.Directory to avoid duplicating the
compgen code.

XMonad/Layout/WorkspaceDir.hs

@@ -26,6 +26,7 @@ module XMonad.Layout.WorkspaceDir (
                                    -- $usage
                                    workspaceDir,
                                    changeDir,
+                                   changeDir',
                                    WorkspaceDir,
                                   ) where
 
@@ -33,8 +34,8 @@ import System.Directory ( setCurrentDirectory, getCurrentDirectory )
 import Control.Monad ( when )
 
 import XMonad hiding ( focus )
-import XMonad.Prompt ( XPConfig )
-import XMonad.Prompt.Directory ( directoryPrompt )
+import XMonad.Prompt ( ComplCaseSensitivity (ComplCaseSensitive), XPConfig )
+import XMonad.Prompt.Directory ( directoryPrompt' )
 import XMonad.Layout.LayoutModifier
 import XMonad.StackSet ( tag, currentTag )
 
@@ -87,4 +88,7 @@ scd :: String -> X ()
 scd x = catchIO $ setCurrentDirectory x
 
 changeDir :: XPConfig -> X ()
-changeDir c = directoryPrompt c "Set working directory: " (sendMessage . Chdir)
+changeDir = changeDir' (ComplCaseSensitive True)
+
+changeDir' :: ComplCaseSensitivity -> XPConfig -> X ()
+changeDir' csn c = directoryPrompt' csn c "Set working directory: " (sendMessage . Chdir)

XMonad/Prompt.hs

@@ -60,6 +60,7 @@ module XMonad.Prompt
     , moveHistory, setSuccess, setDone, setModeDone
     , Direction1D(..)
     , ComplFunction
+    , ComplCaseSensitivity(..)
     -- * X Utilities
     -- $xutils
     , mkUnmanagedWindow
@@ -200,6 +201,8 @@ type ComplFunction = String -> IO [String]
 type XPMode = XPType
 data XPOperationMode = XPSingleMode ComplFunction XPType | XPMultipleModes (W.Stack XPType)
 
+newtype ComplCaseSensitivity = ComplCaseSensitive Bool
+
 instance Show XPType where
     show (XPT p) = showXPrompt p
 

XMonad/Prompt/Directory.hs

@@ -16,13 +16,14 @@ module XMonad.Prompt.Directory (
                              -- * Usage
                              -- $usage
                              directoryPrompt,
+                             directoryPrompt',
                              directoryMultipleModes,
                              Dir
                               ) where
 
 import XMonad
 import XMonad.Prompt
-import XMonad.Util.Run ( runProcessWithInput )
+import XMonad.Prompt.Shell ( compgenDirectories )
 
 -- $usage
 -- For an example usage see "XMonad.Layout.WorkspaceDir"
@@ -31,13 +32,16 @@ data Dir = Dir String (String -> X ())
 
 instance XPrompt Dir where
     showXPrompt (Dir x _) = x
-    completionFunction _ = getDirCompl
+    completionFunction _ = getDirCompl (ComplCaseSensitive True)
     modeAction (Dir _ f) buf auto =
       let dir = if null auto then buf else auto
       in f dir
 
 directoryPrompt :: XPConfig -> String -> (String -> X ()) -> X ()
-directoryPrompt c prom f = mkXPrompt (Dir prom f) c getDirCompl f
+directoryPrompt = directoryPrompt' (ComplCaseSensitive True)
+
+directoryPrompt' :: ComplCaseSensitivity -> XPConfig -> String -> (String -> X ()) -> X ()
+directoryPrompt' csn c prom f = mkXPrompt (Dir prom f) c (getDirCompl csn) f
 
 -- | A @XPType@ entry suitable for using with @mkXPromptWithModes@.
 directoryMultipleModes :: String            -- ^ Prompt.
@@ -45,9 +49,8 @@ directoryMultipleModes :: String            -- ^ Prompt.
                        -> XPType
 directoryMultipleModes p f = XPT (Dir p f)
 
-getDirCompl :: String -> IO [String]
-getDirCompl s = (filter notboring . lines) <$>
-                runProcessWithInput "bash" [] ("compgen -A directory " ++ s ++ "\n")
+getDirCompl :: ComplCaseSensitivity -> String -> IO [String]
+getDirCompl csn s = filter notboring . lines <$> compgenDirectories csn s
 
 notboring :: String -> Bool
 notboring ('.':'.':_) = True

XMonad/Prompt/Shell.hs

@@ -22,10 +22,13 @@ module XMonad.Prompt.Shell
     , unsafePrompt
 
     -- * Utility functions
+    , compgenDirectories
+    , compgenFiles
     , getCommands
     , getBrowser
     , getEditor
     , getShellCompl
+    , getShellCompl'
     , split
     ) where
 
@@ -95,10 +98,12 @@ unsafePrompt c config = mkXPrompt Shell config (getShellCompl [c] $ searchPredic
     where run a = unsafeSpawn $ c ++ " " ++ a
 
 getShellCompl :: [String] -> Predicate -> String -> IO [String]
-getShellCompl cmds p s | s == "" || last s == ' ' = return []
-                       | otherwise                = do
-    f     <- fmap lines $ runProcessWithInput "bash" [] ("compgen -A file -- "
-                                                        ++ s ++ "\n")
+getShellCompl = getShellCompl' (ComplCaseSensitive True)
+
+getShellCompl' :: ComplCaseSensitivity -> [String] -> Predicate -> String -> IO [String]
+getShellCompl' csn cmds p s | s == "" || last s == ' ' = return []
+                            | otherwise                = do
+    f     <- fmap lines (compgenFiles csn s)
     files <- case f of
                [x] -> do fs <- getFileStatus (encodeString x)
                          if isDirectory fs then return [x ++ "/"]
@@ -112,6 +117,23 @@ getShellCompl cmds p s | s == "" || last s == ' ' = return []
         | otherwise = x `compare` y
     startsWith str ps = isPrefixOf (map toLower ps) (map toLower str)
 
+compgenFiles :: ComplCaseSensitivity -> String -> IO String
+compgenFiles csn = compgen csn "file"
+
+compgenDirectories :: ComplCaseSensitivity -> String -> IO String
+compgenDirectories csn = compgen csn "directory"
+
+compgen :: ComplCaseSensitivity -> String -> String -> IO String
+compgen csn actionOpt s = runProcessWithInput "bash" [] $
+    complCaseSensitivityCmd csn ++ " ; " ++ compgenCmd actionOpt s
+
+complCaseSensitivityCmd :: ComplCaseSensitivity -> String
+complCaseSensitivityCmd (ComplCaseSensitive b) =
+    "bind 'set completion-ignore-case " ++ (if b then "off" else "on") ++ "'"
+
+compgenCmd :: String -> String -> String
+compgenCmd actionOpt s = "compgen -A " ++ actionOpt ++ " -- " ++ s ++ "\n"
+
 commandCompletionFunction :: [String] -> Predicate -> String -> [String]
 commandCompletionFunction cmds p str | '/' `elem` str = []
                                      | otherwise      = filter (p str) cmds