XMonad.Prompt: Fix alwaysHighlight tab-completion

526336ecec98aa2fe1cc98521473372b0664e19d introduced a bug where
tab-completion has an issue when a completion contains spaces; it only
deletes the last word of that completion, causing the next TAB to again
select the current selection and add it to the command.  In this way,
the prompt can get "stuck" on an item, endlessly adding all but the
first word to the command every time TAB is pressed.

C.f. xmonad/xmonad-contrib/issues/455
This commit is contained in:
slotThe 2021-01-31 20:18:48 +01:00
parent 0a2e1f7254
commit ee4a3a932d

View File

@ -1,3 +1,4 @@
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-} {-# LANGUAGE TupleSections #-}
{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
@ -100,7 +101,7 @@ import XMonad.Util.Types
import XMonad.Util.XSelection (getSelection) import XMonad.Util.XSelection (getSelection)
import Codec.Binary.UTF8.String (decodeString,isUTF8Encoded) import Codec.Binary.UTF8.String (decodeString,isUTF8Encoded)
import Control.Arrow (first, second, (&&&), (***)) import Control.Arrow (first, (&&&), (***))
import Control.Concurrent (threadDelay) import Control.Concurrent (threadDelay)
import Control.Exception as E hiding (handle) import Control.Exception as E hiding (handle)
import Control.Monad.State import Control.Monad.State
@ -425,9 +426,6 @@ command = W.focus . commandHistory
setCommand :: String -> XPState -> XPState setCommand :: String -> XPState -> XPState
setCommand xs s = s { commandHistory = (commandHistory s) { W.focus = xs }} setCommand xs s = s { commandHistory = (commandHistory s) { W.focus = xs }}
setHighlightedCompl :: Maybe String -> XPState -> XPState
setHighlightedCompl hc st = st { highlightedCompl = hc}
-- | Sets the input string to the given value. -- | Sets the input string to the given value.
setInput :: String -> XP () setInput :: String -> XP ()
setInput = modify . setCommand setInput = modify . setCommand
@ -729,9 +727,9 @@ handleCompletion cs = do
st <- get st <- get
let updateWins l = redrawWindows l let updateWins l = redrawWindows l
updateState l = case alwaysHlight of updateState l = if alwaysHlight
False -> simpleComplete l st then hlComplete (getLastWord $ command st) l st
True -> hlComplete l st else simpleComplete l st
case cs of case cs of
[] -> updateWindows [] -> updateWindows
@ -756,26 +754,37 @@ handleCompletion cs = do
-- buffer to reflect that. -- buffer to reflect that.
-- --
--TODO: Scroll or paginate results --TODO: Scroll or paginate results
hlComplete :: [String] -> XPState -> XP () hlComplete :: String -> [String] -> XPState -> XP ()
hlComplete l st = hlComplete prevCompl l st =
let newCommand = fromMaybe (command st) $ highlightedItem st l in if | -- The current suggestion matches the command and is a
if newCommand == (getLastWord . command $ st) -- proper suffix of the last suggestion, so replace it.
then do isSuffixOfCmd && isProperSuffixOfLast -> replaceCompletion
-- The word currently under the cursor is the same
-- as the current suggestion, so we should advance -- The current suggestion matches the command, so advance
-- to the next completion and try again. -- to the next completion and try again.
let complIndex' = nextComplIndex st (length l) | isSuffixOfCmd ->
highlightedCompl' = highlightedItem st { complIndex = complIndex'} cs hlComplete hlCompl l $ st{ complIndex = complIndex'
hlComplete l $ st { complIndex = complIndex', , highlightedCompl = nextHlCompl
highlightedCompl = highlightedCompl' }
}
else do -- If nothing matches at all, delete the suggestion and
-- The word under the cursor differs from the -- highlight the next one.
-- current suggestion, so replace it | otherwise -> replaceCompletion
where
hlCompl :: String = fromMaybe (command st) $ highlightedItem st l
complIndex' :: (Int, Int) = nextComplIndex st (length l)
nextHlCompl :: Maybe String = highlightedItem st{ complIndex = complIndex' } cs
isSuffixOfCmd :: Bool = hlCompl `isSuffixOf` command st
isProperSuffixOfLast :: Bool = hlCompl `isSuffixOf` prevCompl
&& not (prevCompl `isSuffixOf` hlCompl)
replaceCompletion :: XP () = do
put st put st
killWord Prev replicateM_ (length $ words prevCompl) $ killWord Prev
insertString' newCommand insertString' hlCompl
endOfLine endOfLine
-- | Initiate a prompt sub-map event loop. Submaps are intended to provide -- | Initiate a prompt sub-map event loop. Submaps are intended to provide
-- alternate keybindings. Accepts a default action and a mapping from key -- alternate keybindings. Accepts a default action and a mapping from key
-- combinations to actions. If no entry matches, the default action is run. -- combinations to actions. If no entry matches, the default action is run.