Prompt: Use searchPredicate in more cases

Prompts based on `mkComplFunList` and `mkComplFunList'` were not
taking into account the `searchPredicate` funtion from `XPConfig`.
This was rather confusing.

We fix it by passing `XPConfig` to these functions; although
this is strictly more than they need, it makes the breaking change very
easy to fix and is also more future-proof.
This commit is contained in:
Daniel Gorin 2019-11-18 20:00:37 +00:00
parent 52f8c82504
commit 28b3e34fd7
13 changed files with 41 additions and 36 deletions

View File

@ -4,6 +4,12 @@
### Breaking Changes ### Breaking Changes
* `XMonad.Prompt`
Now `mkComplFunFromList` and `mkComplFunFromList'` take an
additional `XPConfig` argument, so that they can take into
account the given `searchPredicate`.
* `XMonad.Hooks.EwmhDesktops` * `XMonad.Hooks.EwmhDesktops`
It is no longer recommended to use `fullscreenEventHook` directly. It is no longer recommended to use `fullscreenEventHook` directly.

View File

@ -145,24 +145,24 @@ instance ExtensionClass ProjectState where
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- Internal types for working with XPrompt. -- Internal types for working with XPrompt.
data ProjectPrompt = ProjectPrompt ProjectMode [ProjectName] data ProjectPrompt = ProjectPrompt XPConfig ProjectMode [ProjectName]
data ProjectMode = SwitchMode | ShiftMode | RenameMode | DirMode data ProjectMode = SwitchMode | ShiftMode | RenameMode | DirMode
instance XPrompt ProjectPrompt where instance XPrompt ProjectPrompt where
showXPrompt (ProjectPrompt submode _) = showXPrompt (ProjectPrompt _ submode _) =
case submode of case submode of
SwitchMode -> "Switch or Create Project: " SwitchMode -> "Switch or Create Project: "
ShiftMode -> "Send Window to Project: " ShiftMode -> "Send Window to Project: "
RenameMode -> "New Project Name: " RenameMode -> "New Project Name: "
DirMode -> "Change Project Directory: " DirMode -> "Change Project Directory: "
completionFunction (ProjectPrompt RenameMode _) = return . (:[]) completionFunction (ProjectPrompt _ RenameMode _) = return . (:[])
completionFunction (ProjectPrompt DirMode _) = completionFunction (ProjectPrompt _ DirMode _) =
let xpt = directoryMultipleModes "" (const $ return ()) let xpt = directoryMultipleModes "" (const $ return ())
in completionFunction xpt in completionFunction xpt
completionFunction (ProjectPrompt _ ns) = mkComplFunFromList' 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 let name = if null auto then buf else auto
ps <- XS.gets projects ps <- XS.gets projects
@ -171,17 +171,17 @@ instance XPrompt ProjectPrompt where
Nothing | null name -> return () Nothing | null name -> return ()
| otherwise -> switchProject (defProject name) | 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 let name = if null auto then buf else auto
ps <- XS.gets projects ps <- XS.gets projects
shiftToProject . fromMaybe (defProject name) $ Map.lookup name ps 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 when (not (null name) && not (all isSpace name)) $ do
renameWorkspaceByName name renameWorkspaceByName name
modifyProject (\p -> p { projectName = 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 let dir' = if null auto then buf else auto
dir <- io $ makeAbsolute dir' dir <- io $ makeAbsolute dir'
modifyProject (\p -> p { projectDirectory = dir }) modifyProject (\p -> p { projectDirectory = dir })
@ -331,7 +331,7 @@ projectPrompt submodes c = do
ps <- XS.gets projects ps <- XS.gets projects
let names = sort (Map.keys ps `union` ws) let names = sort (Map.keys ps `union` ws)
modes = map (\m -> XPT $ ProjectPrompt m names) submodes modes = map (\m -> XPT $ ProjectPrompt c m names) submodes
mkXPromptWithModes modes c mkXPromptWithModes modes c

View File

@ -133,7 +133,7 @@ instance XPrompt WSGPrompt where
promptWSGroupView :: XPConfig -> String -> X () promptWSGroupView :: XPConfig -> String -> X ()
promptWSGroupView xp s = do promptWSGroupView xp s = do
gs <- fmap (M.keys . unWSG) XS.get gs <- fmap (M.keys . unWSG) XS.get
mkXPrompt (WSGPrompt s) xp (mkComplFunFromList' gs) viewWSGroup mkXPrompt (WSGPrompt s) xp (mkComplFunFromList' xp gs) viewWSGroup
-- | Prompt for a name for the current workspace group. -- | Prompt for a name for the current workspace group.
promptWSGroupAdd :: XPConfig -> String -> X () promptWSGroupAdd :: XPConfig -> String -> X ()
@ -144,4 +144,4 @@ promptWSGroupAdd xp s =
promptWSGroupForget :: XPConfig -> String -> X () promptWSGroupForget :: XPConfig -> String -> X ()
promptWSGroupForget xp s = do promptWSGroupForget xp s = do
gs <- fmap (M.keys . unWSG) XS.get gs <- fmap (M.keys . unWSG) XS.get
mkXPrompt (WSGPrompt s) xp (mkComplFunFromList' gs) forgetWSGroup mkXPrompt (WSGPrompt s) xp (mkComplFunFromList' xp gs) forgetWSGroup

View File

@ -180,7 +180,7 @@ instance XPrompt TagPrompt where
tagPrompt :: XPConfig -> (String -> X ()) -> X () tagPrompt :: XPConfig -> (String -> X ()) -> X ()
tagPrompt c f = do tagPrompt c f = do
sc <- tagComplList sc <- tagComplList
mkXPrompt TagPrompt c (mkComplFunFromList' sc) f mkXPrompt TagPrompt c (mkComplFunFromList' c sc) f
tagComplList :: X [String] tagComplList :: X [String]
tagComplList = gets (concat . map (integrate' . stack) . workspaces . windowset) >>= tagComplList = gets (concat . map (integrate' . stack) . workspaces . windowset) >>=
@ -192,7 +192,7 @@ tagDelPrompt :: XPConfig -> X ()
tagDelPrompt c = do tagDelPrompt c = do
sc <- tagDelComplList sc <- tagDelComplList
if (sc /= []) if (sc /= [])
then mkXPrompt TagPrompt c (mkComplFunFromList' sc) (\s -> withFocused (delTag s)) then mkXPrompt TagPrompt c (mkComplFunFromList' c sc) (\s -> withFocused (delTag s))
else return () else return ()
tagDelComplList :: X [String] tagDelComplList :: X [String]

View File

@ -1605,19 +1605,18 @@ mkUnmanagedWindow d s rw x y w h = do
-- | This function takes a list of possible completions and returns a -- | This function takes a list of possible completions and returns a
-- completions function to be used with 'mkXPrompt' -- completions function to be used with 'mkXPrompt'
mkComplFunFromList :: [String] -> String -> IO [String] mkComplFunFromList :: XPConfig -> [String] -> String -> IO [String]
mkComplFunFromList _ [] = return [] mkComplFunFromList _ _ [] = return []
mkComplFunFromList l s = mkComplFunFromList c l s =
return $ filter (\x -> take (length s) x == s) l pure $ filter (searchPredicate c s) l
-- | This function takes a list of possible completions and returns a -- | This function takes a list of possible completions and returns a
-- completions function to be used with 'mkXPrompt'. If the string is -- completions function to be used with 'mkXPrompt'. If the string is
-- null it will return all completions. -- null it will return all completions.
mkComplFunFromList' :: [String] -> String -> IO [String] mkComplFunFromList' :: XPConfig -> [String] -> String -> IO [String]
mkComplFunFromList' l [] = return l mkComplFunFromList' _ l [] = return l
mkComplFunFromList' l s = mkComplFunFromList' c l s =
return $ filter (\x -> take (length s) x == s) l pure $ filter (searchPredicate c s) l
-- | Given the prompt type, the command line and the completion list, -- | Given the prompt type, the command line and the completion list,
-- return the next completion in the list for the last word of the -- return the next completion in the list for the last word of the

View File

@ -48,4 +48,4 @@ instance XPrompt EnterPrompt where
and simply ask to confirm (ENTER) or cancel (ESCAPE). The actual key and simply ask to confirm (ENTER) or cancel (ESCAPE). The actual key
handling is done by mkXPrompt.-} handling is done by mkXPrompt.-}
confirmPrompt :: XPConfig -> String -> X() -> X() confirmPrompt :: XPConfig -> String -> X() -> X()
confirmPrompt config app func = mkXPrompt (EnterPrompt app) config (mkComplFunFromList []) $ const func confirmPrompt config app func = mkXPrompt (EnterPrompt app) config (mkComplFunFromList config []) $ const func

View File

@ -56,7 +56,7 @@ import XMonad.Prompt.Input
-- of addresses for autocompletion. -- of addresses for autocompletion.
emailPrompt :: XPConfig -> [String] -> X () emailPrompt :: XPConfig -> [String] -> X ()
emailPrompt c addrs = emailPrompt c addrs =
inputPromptWithCompl c "To" (mkComplFunFromList addrs) ?+ \to -> inputPromptWithCompl c "To" (mkComplFunFromList c addrs) ?+ \to ->
inputPrompt c "Subject" ?+ \subj -> inputPrompt c "Subject" ?+ \subj ->
inputPrompt c "Body" ?+ \body -> inputPrompt c "Body" ?+ \body ->
runProcessWithInput "mail" ["-s", subj, to] (body ++ "\n") runProcessWithInput "mail" ["-s", subj, to] (body ++ "\n")

View File

@ -46,4 +46,4 @@ import XMonad.Layout.LayoutCombinators ( JumpToLayout(..) )
layoutPrompt :: XPConfig -> X () layoutPrompt :: XPConfig -> X ()
layoutPrompt c = do ls <- gets (map (description . layout) . workspaces . windowset) layoutPrompt c = do ls <- gets (map (description . layout) . workspaces . windowset)
mkXPrompt (Wor "") c (mkComplFunFromList' $ sort $ nub ls) (sendMessage . JumpToLayout) mkXPrompt (Wor "") c (mkComplFunFromList' c $ sort $ nub ls) (sendMessage . JumpToLayout)

View File

@ -60,7 +60,7 @@ instance XPrompt Man where
manPrompt :: XPConfig -> X () manPrompt :: XPConfig -> X ()
manPrompt c = do manPrompt c = do
mans <- io getMans mans <- io getMans
mkXPrompt Man c (manCompl mans) $ runInTerm "" . (++) "man " mkXPrompt Man c (manCompl c mans) $ runInTerm "" . (++) "man "
getMans :: IO [String] getMans :: IO [String]
getMans = do getMans = do
@ -80,12 +80,12 @@ getMans = do
else return [] else return []
return $ uniqSort $ concat mans return $ uniqSort $ concat mans
manCompl :: [String] -> String -> IO [String] manCompl :: XPConfig -> [String] -> String -> IO [String]
manCompl mans s | s == "" || last s == ' ' = return [] manCompl c mans s | s == "" || last s == ' ' = return []
| otherwise = do | otherwise = do
-- XXX readline instead of bash's compgen? -- XXX readline instead of bash's compgen?
f <- lines <$> getCommandOutput ("bash -c 'compgen -A file " ++ s ++ "'") f <- lines <$> getCommandOutput ("bash -c 'compgen -A file " ++ s ++ "'")
mkComplFunFromList (f ++ mans) s mkComplFunFromList c (f ++ mans) s
-- | Run a command using shell and return its output. -- | Run a command using shell and return its output.
-- --

View File

@ -64,7 +64,7 @@ instance XPrompt Ssh where
sshPrompt :: XPConfig -> X () sshPrompt :: XPConfig -> X ()
sshPrompt c = do sshPrompt c = do
sc <- io sshComplList sc <- io sshComplList
mkXPrompt Ssh c (mkComplFunFromList sc) ssh mkXPrompt Ssh c (mkComplFunFromList c sc) ssh
ssh :: String -> X () ssh :: String -> X ()
ssh = runInTerm "" . ("ssh " ++ ) ssh = runInTerm "" . ("ssh " ++ )

View File

@ -48,7 +48,7 @@ instance XPrompt ThemePrompt where
nextCompletion _ = getNextCompletion nextCompletion _ = getNextCompletion
themePrompt :: XPConfig -> X () themePrompt :: XPConfig -> X ()
themePrompt c = mkXPrompt ThemePrompt c (mkComplFunFromList' . map ppThemeInfo $ listOfThemes) changeTheme themePrompt c = mkXPrompt ThemePrompt c (mkComplFunFromList' c . map ppThemeInfo $ listOfThemes) changeTheme
where changeTheme t = sendMessage . SetTheme . fromMaybe def $ M.lookup t mapOfThemes where changeTheme t = sendMessage . SetTheme . fromMaybe def $ M.lookup t mapOfThemes
mapOfThemes :: M.Map String Theme mapOfThemes :: M.Map String Theme

View File

@ -46,4 +46,4 @@ workspacePrompt :: XPConfig -> (String -> X ()) -> X ()
workspacePrompt c job = do ws <- gets (workspaces . windowset) workspacePrompt c job = do ws <- gets (workspaces . windowset)
sort <- getSortByIndex sort <- getSortByIndex
let ts = map tag $ sort ws let ts = map tag $ sort ws
mkXPrompt (Wor "") c (mkComplFunFromList' ts) job mkXPrompt (Wor "") c (mkComplFunFromList' c ts) job

View File

@ -51,5 +51,5 @@ xmonadPrompt c = do
-- | An xmonad prompt with a custom command list -- | An xmonad prompt with a custom command list
xmonadPromptC :: [(String, X ())] -> XPConfig -> X () xmonadPromptC :: [(String, X ())] -> XPConfig -> X ()
xmonadPromptC commands c = xmonadPromptC commands c =
mkXPrompt XMonad c (mkComplFunFromList' (map fst commands)) $ mkXPrompt XMonad c (mkComplFunFromList' c (map fst commands)) $
fromMaybe (return ()) . (`lookup` commands) fromMaybe (return ()) . (`lookup` commands)