DynamicProjects: allow case-insensitive prompts

Provide a way to use case-insensitive directory completion.
This commit is contained in:
ivanbrennan
2020-09-14 21:01:12 -04:00
parent 0c9c330295
commit 4de529a923

View File

@@ -29,9 +29,13 @@ module XMonad.Actions.DynamicProjects
-- * Bindings
, switchProjectPrompt
, switchProjectPrompt'
, shiftToProjectPrompt
, shiftToProjectPrompt'
, renameProjectPrompt
, renameProjectPrompt'
, changeProjectDirPrompt
, changeProjectDirPrompt'
-- * Helper Functions
, switchProject
@@ -145,24 +149,24 @@ instance ExtensionClass ProjectState where
--------------------------------------------------------------------------------
-- Internal types for working with XPrompt.
data ProjectPrompt = ProjectPrompt XPConfig ProjectMode [ProjectName]
data ProjectPrompt = ProjectPrompt XPConfig ComplCaseSensitivity ProjectMode [ProjectName]
data ProjectMode = SwitchMode | ShiftMode | RenameMode | DirMode
instance XPrompt ProjectPrompt where
showXPrompt (ProjectPrompt _ submode _) =
showXPrompt (ProjectPrompt _ _ submode _) =
case submode of
SwitchMode -> "Switch or Create Project: "
ShiftMode -> "Send Window to Project: "
RenameMode -> "New Project Name: "
DirMode -> "Change Project Directory: "
completionFunction (ProjectPrompt _ RenameMode _) = return . (:[])
completionFunction (ProjectPrompt _ DirMode _) =
let xpt = directoryMultipleModes "" (const $ return ())
completionFunction (ProjectPrompt _ _ RenameMode _) = return . (:[])
completionFunction (ProjectPrompt _ csn DirMode _) =
let xpt = directoryMultipleModes' csn "" (const $ return ())
in completionFunction xpt
completionFunction (ProjectPrompt c _ ns) = mkComplFunFromList' c ns
completionFunction (ProjectPrompt c _ _ ns) = mkComplFunFromList' c ns
modeAction (ProjectPrompt _ SwitchMode _) buf auto = do
modeAction (ProjectPrompt _ _ SwitchMode _) buf auto = do
let name = if null auto then buf else auto
ps <- XS.gets projects
@@ -171,17 +175,17 @@ instance XPrompt ProjectPrompt where
Nothing | null name -> return ()
| otherwise -> switchProject (defProject name)
modeAction (ProjectPrompt _ ShiftMode _) buf auto = do
modeAction (ProjectPrompt _ _ ShiftMode _) buf auto = do
let name = if null auto then buf else auto
ps <- XS.gets projects
shiftToProject . fromMaybe (defProject name) $ Map.lookup name ps
modeAction (ProjectPrompt _ RenameMode _) name _ =
modeAction (ProjectPrompt _ _ RenameMode _) name _ =
when (not (null name) && not (all isSpace name)) $ do
renameWorkspaceByName name
modifyProject (\p -> p { projectName = name })
modeAction (ProjectPrompt _ DirMode _) buf auto = do
modeAction (ProjectPrompt _ _ DirMode _) buf auto = do
let dir' = if null auto then buf else auto
dir <- io $ makeAbsolute dir'
modifyProject (\p -> p { projectDirectory = dir })
@@ -279,7 +283,12 @@ switchProject p = do
-- | Prompt for a project name and then switch to it. Automatically
-- creates a project if a new name is returned from the prompt.
switchProjectPrompt :: XPConfig -> X ()
switchProjectPrompt = projectPrompt [ SwitchMode
switchProjectPrompt = switchProjectPrompt' (ComplCaseSensitive True)
-- | Like @switchProjectPrompt@ with a parameter controlling
-- completion case-sensitivity.
switchProjectPrompt' :: ComplCaseSensitivity -> XPConfig -> X ()
switchProjectPrompt' csn = projectPrompt csn [ SwitchMode
, ShiftMode
, RenameMode
, DirMode
@@ -296,7 +305,12 @@ shiftToProject p = do
-- | Prompts for a project name and then shifts the currently focused
-- window to that project.
shiftToProjectPrompt :: XPConfig -> X ()
shiftToProjectPrompt = projectPrompt [ ShiftMode
shiftToProjectPrompt = shiftToProjectPrompt' (ComplCaseSensitive True)
-- | Like @shiftToProjectPrompt@ with a parameter controlling
-- completion case-sensitivity.
shiftToProjectPrompt' :: ComplCaseSensitivity -> XPConfig -> X ()
shiftToProjectPrompt' csn = projectPrompt csn [ ShiftMode
, RenameMode
, SwitchMode
, DirMode
@@ -305,7 +319,12 @@ shiftToProjectPrompt = projectPrompt [ ShiftMode
--------------------------------------------------------------------------------
-- | Rename the current project.
renameProjectPrompt :: XPConfig -> X ()
renameProjectPrompt = projectPrompt [ RenameMode
renameProjectPrompt = renameProjectPrompt' (ComplCaseSensitive True)
-- | Like @renameProjectPrompt@ with a parameter controlling
-- completion case-sensitivity.
renameProjectPrompt' :: ComplCaseSensitivity -> XPConfig -> X ()
renameProjectPrompt' csn = projectPrompt csn [ RenameMode
, DirMode
, SwitchMode
, ShiftMode
@@ -317,7 +336,12 @@ renameProjectPrompt = projectPrompt [ RenameMode
-- NOTE: This will only affect new processed started in this project.
-- Existing processes will maintain the previous working directory.
changeProjectDirPrompt :: XPConfig -> X ()
changeProjectDirPrompt = projectPrompt [ DirMode
changeProjectDirPrompt = changeProjectDirPrompt' (ComplCaseSensitive True)
-- | Like @changeProjectDirPrompt@ with a parameter controlling
-- completion case-sensitivity.
changeProjectDirPrompt' :: ComplCaseSensitivity -> XPConfig -> X ()
changeProjectDirPrompt' csn = projectPrompt csn [ DirMode
, SwitchMode
, ShiftMode
, RenameMode
@@ -325,13 +349,13 @@ changeProjectDirPrompt = projectPrompt [ DirMode
--------------------------------------------------------------------------------
-- | Prompt for a project name.
projectPrompt :: [ProjectMode] -> XPConfig -> X ()
projectPrompt submodes c = do
projectPrompt :: ComplCaseSensitivity -> [ProjectMode] -> XPConfig -> X ()
projectPrompt csn submodes c = do
ws <- map W.tag <$> gets (W.workspaces . windowset)
ps <- XS.gets projects
let names = sort (Map.keys ps `union` ws)
modes = map (\m -> XPT $ ProjectPrompt c m names) submodes
modes = map (\m -> XPT $ ProjectPrompt c csn m names) submodes
mkXPromptWithModes modes c