X.Prompt: Allow for backwards cycling of completions

+ Add a new prevCompletionKey to XPConfig, in order to cycle backwards.
  Bound to S-<Tab> by default.

+ Already handle null keystrings (times when only a modifier was
  pressed) in handleMain, such that completions aren't cleared
  prematurely.

+ Augment nextComplIndex (now computeComplIndex) with the ability to go
  in an arbitrary 1-dimensional direction. As a result, that function,
  as well as handleCompletion and handleCompletionMain now take an
  additional Direction1D argument.

Based on: https://github.com/solomon-b/xmonad-contrib/tree/feature/scrolling-prompt-completions
Fixes: https://github.com/xmonad/xmonad-contrib/issues/831

Co-authored-by: Solomon Bothwell <ssbothwell@gmail.com>
This commit is contained in:
Tony Zorman 2023-10-03 17:42:02 +02:00
parent a379850f50
commit 4c0d3cac8d
2 changed files with 61 additions and 45 deletions

View File

@ -243,6 +243,10 @@
- The `emacsLikeXPKeymap` and `vimLikeXPKeymap` keymaps now treat - The `emacsLikeXPKeymap` and `vimLikeXPKeymap` keymaps now treat
`C-m` the same as `Return`. `C-m` the same as `Return`.
- Added `prevCompletionKey` to `XPConfig`, facilitating the ability
to cycle through the completions backwards. This is bound to
`S-<TAB>` by default.
* `XMonad.Actions.Prefix` * `XMonad.Actions.Prefix`
- Added `orIfPrefixed`, a combinator to decide upon an action based - Added `orIfPrefixed`, a combinator to decide upon an action based

View File

@ -7,6 +7,7 @@
{-# LANGUAGE PatternGuards #-} {-# LANGUAGE PatternGuards #-}
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE MultiWayIf #-}
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- | -- |
-- Module : XMonad.Prompt -- Module : XMonad.Prompt
@ -183,7 +184,8 @@ data XPConfig =
-- history entries to remember -- history entries to remember
, promptKeymap :: M.Map (KeyMask,KeySym) (XP ()) , promptKeymap :: M.Map (KeyMask,KeySym) (XP ())
-- ^ Mapping from key combinations to actions -- ^ Mapping from key combinations to actions
, completionKey :: (KeyMask, KeySym) -- ^ Key that should trigger completion , completionKey :: (KeyMask, KeySym) -- ^ Key to trigger forward completion
, prevCompletionKey :: (KeyMask, KeySym) -- ^ Key to trigger backward completion
, changeModeKey :: KeySym -- ^ Key to change mode (when the prompt has multiple modes) , changeModeKey :: KeySym -- ^ Key to change mode (when the prompt has multiple modes)
, defaultText :: String -- ^ The text by default in the prompt line , defaultText :: String -- ^ The text by default in the prompt line
, autoComplete :: Maybe Int -- ^ Just x: if only one completion remains, auto-select it, , autoComplete :: Maybe Int -- ^ Just x: if only one completion remains, auto-select it,
@ -329,7 +331,8 @@ instance Default XPConfig where
, borderColor = border def , borderColor = border def
, promptBorderWidth = 1 , promptBorderWidth = 1
, promptKeymap = defaultXPKeymap , promptKeymap = defaultXPKeymap
, completionKey = (0,xK_Tab) , completionKey = (0, xK_Tab)
, prevCompletionKey = (shiftMask, xK_Tab)
, changeModeKey = xK_grave , changeModeKey = xK_grave
, position = Bottom , position = Bottom
, height = 18 , height = 18
@ -688,29 +691,31 @@ merely discarded, but passed to the respective application window.
-- | Prompt event handler for the main loop. Dispatches to input, completion -- | Prompt event handler for the main loop. Dispatches to input, completion
-- and mode switching handlers. -- and mode switching handlers.
handleMain :: KeyStroke -> Event -> XP () handleMain :: KeyStroke -> Event -> XP ()
handleMain stroke@(keysym,_) KeyEvent{ev_event_type = t, ev_state = m} = do handleMain stroke@(keysym, keystr) = \case
(compKey,modeKey) <- gets $ (completionKey &&& changeModeKey) . config KeyEvent{ev_event_type = t, ev_state = m} -> do
keymask <- gets cleanMask <*> pure m (prevCompKey, (compKey, modeKey)) <- gets $
-- haven't subscribed to keyRelease, so just in case (prevCompletionKey &&& completionKey &&& changeModeKey) . config
when (t == keyPress) $ keymask <- gets cleanMask <*> pure m
if (keymask,keysym) == compKey -- haven't subscribed to keyRelease, so just in case
then getCurrentCompletions >>= handleCompletionMain when (t == keyPress) $ if
else do | (keymask, keysym) == compKey ->
setCurrentCompletions Nothing getCurrentCompletions >>= handleCompletionMain Next
if keysym == modeKey | (keymask, keysym) == prevCompKey ->
then modify setNextMode >> updateWindows getCurrentCompletions >>= handleCompletionMain Prev
else handleInputMain keymask stroke | otherwise -> unless (null keystr) $ do -- null keystr = only a modifier was pressed
handleMain stroke event = handleOther stroke event setCurrentCompletions Nothing
if keysym == modeKey
-- | Prompt input handler for the main loop. then modify setNextMode >> updateWindows
handleInputMain :: KeyMask -> KeyStroke -> XP () else handleInput keymask
handleInputMain keymask (keysym,keystr) = do event -> handleOther stroke event
keymap <- gets (promptKeymap . config) where
case M.lookup (keymask,keysym) keymap of -- Prompt input handler for the main loop.
-- 'null keystr' i.e. when only a modifier was pressed handleInput :: KeyMask -> XP ()
Just action -> action >> updateWindows handleInput keymask = do
Nothing -> unless (null keystr) $ keymap <- gets (promptKeymap . config)
when (keymask .&. controlMask == 0) $ do case M.lookup (keymask,keysym) keymap of
Just action -> action >> updateWindows
Nothing -> when (keymask .&. controlMask == 0) $ do
insertString $ utf8Decode keystr insertString $ utf8Decode keystr
updateWindows updateWindows
updateHighlightedCompl updateHighlightedCompl
@ -725,17 +730,18 @@ handleInputMain keymask (keysym,keystr) = do
-- --
-- | Prompt completion handler for the main loop. Given 'Nothing', generate the -- | Prompt completion handler for the main loop. Given 'Nothing', generate the
-- current completion list. With the current list, trigger a completion. -- current completion list. With the current list, trigger a completion.
handleCompletionMain :: Maybe [String] -> XP () handleCompletionMain :: Direction1D -> Maybe [String] -> XP ()
handleCompletionMain Nothing = do handleCompletionMain dir compls = case compls of
cs <- getCompletions Just cs -> handleCompletion dir cs
when (length cs > 1) $ Nothing -> do
modify $ \s -> s { showComplWin = True } cs <- getCompletions
setCurrentCompletions $ Just cs when (length cs > 1) $
handleCompletion cs modify $ \s -> s { showComplWin = True }
handleCompletionMain (Just cs) = handleCompletion cs setCurrentCompletions $ Just cs
handleCompletion dir cs
handleCompletion :: [String] -> XP () handleCompletion :: Direction1D -> [String] -> XP ()
handleCompletion cs = do handleCompletion dir cs = do
alwaysHlight <- gets $ alwaysHighlight . config alwaysHlight <- gets $ alwaysHighlight . config
st <- get st <- get
@ -790,7 +796,7 @@ handleCompletion cs = do
| otherwise = replaceCompletion prevCompl | otherwise = replaceCompletion prevCompl
where where
hlCompl :: String = fromMaybe (command st) $ highlightedItem st l hlCompl :: String = fromMaybe (command st) $ highlightedItem st l
complIndex' :: (Int, Int) = nextComplIndex st complIndex' :: (Int, Int) = computeComplIndex dir st
nextHlCompl :: Maybe String = highlightedItem st{ complIndex = complIndex' } cs nextHlCompl :: Maybe String = highlightedItem st{ complIndex = complIndex' } cs
isSuffixOfCmd :: Bool = hlCompl `isSuffixOf` command st isSuffixOfCmd :: Bool = hlCompl `isSuffixOf` command st
@ -905,18 +911,24 @@ handleInputBuffer f keymask (keysym,keystr) event =
bufferOne :: String -> String -> (Bool,Bool) bufferOne :: String -> String -> (Bool,Bool)
bufferOne xs x = (null xs && null x,True) bufferOne xs x = (null xs && null x,True)
-- | Return the @(column, row)@ of the next highlight, or @(0, 0)@ if -- | Return the @(column, row)@ of the desired highlight, or @(0, 0)@ if
-- there is no prompt window or a wrap-around occurs. -- there is no prompt window or a wrap-around occurs.
nextComplIndex :: XPState -> (Int, Int) computeComplIndex :: Direction1D -> XPState -> (Int, Int)
nextComplIndex st = case complWinDim st of computeComplIndex dir st = case complWinDim st of
Nothing -> (0, 0) -- no window dimensions (just destroyed or not created) Nothing -> (0, 0) -- no window dimensions (just destroyed or not created)
Just ComplWindowDim{ cwCols, cwRows } -> Just ComplWindowDim{ cwCols, cwRows } ->
let (currentcol, currentrow) = complIndex st if rowm == currentrow + direction
(colm, rowm) = then (currentcol, rowm) -- We are not in the last row, so advance the row
((currentcol + 1) `mod` length cwCols, (currentrow + 1) `mod` length cwRows) else (colm, rowm) -- otherwise advance to the respective column
in if rowm == currentrow + 1 where
then (currentcol, currentrow + 1) -- We are not in the last row, so go down (currentcol, currentrow) = complIndex st
else (colm, rowm) -- otherwise advance to the next column (colm, rowm) =
( (currentcol + direction) `mod` length cwCols
, (currentrow + direction) `mod` length cwRows
)
direction = case dir of
Next -> 1
Prev -> -1
tryAutoComplete :: XP Bool tryAutoComplete :: XP Bool
tryAutoComplete = do tryAutoComplete = do