Better completion when using `alwaysHighlight'

This change improves the UX of X.Prompt when `alwaysHighlight` is
enabled.  This is especially useful for use with `mkXPromptWithModes`
which forces `alwaysHighlight` to be `True`.

When the user presses the `complKey` and `alwaysHighlight` is `True`,
one of two things will happen:

  1. If this is the first time `complKey` is pressed in this round of
     completion then the prompt buffer will be updated so it contains
     the currently highlighted item.

  2. Every other time that the `complKey` is pressed the next
     completion item will be selected and the prompt buffer updated.

This gives immediate feedback to the user and allows using some
prompts with `alwaysHighlight` that weren't possible before (e.g.,
shellPrompt, directoryPrompt, etc.)

XMonad/Prompt.hs

@@ -520,24 +520,59 @@ completionHandle c ks@(sym,_) (KeyEvent { ev_event_type = t, ev_state = m }) = d
   alwaysHlight <- gets $ alwaysHighlight . config
   mCleaned <- cleanMask m
   case () of
-    () | t == keyPress && (mCleaned,sym) == complKey ->
+    () | t == keyPress && (mCleaned,sym) == complKey -> do
-          do
+           st <- get
-            st <- get
+
-            let updateState l = case alwaysHlight of
+           let updateWins  l = redrawWindows l >> eventLoop (completionHandle l)
-                  -- modify the buffer's value
+               updateState l = case alwaysHlight of
-                  False -> let newCommand = nextCompletion (currentXPMode st) (command st) l
+                 False                                           -> simpleComplete l st
-                           in modify $ \s -> setCommand newCommand $ s { offset = length newCommand, highlightedCompl = Just newCommand}
+                 True | Just (command st) /= highlightedCompl st -> alwaysHighlightCurrent st
-                  --TODO: Scroll or paginate results
+                      | otherwise                                -> alwaysHighlightNext l st
-                  True -> let complIndex' = nextComplIndex st (length l)
+
-                              highlightedCompl' = highlightedItem st { complIndex = complIndex'} c
+           case c of
-                          in modify $ \s -> setHighlightedCompl highlightedCompl' $ s { complIndex = complIndex' }
+             []  -> updateWindows   >> eventLoop handle
-                updateWins l = redrawWindows l >> eventLoop (completionHandle l)
+             [x] -> updateState [x] >> getCompletions >>= updateWins
-            case c of
+             l   -> updateState l   >> updateWins l
-              []  -> updateWindows   >> eventLoop handle
-              [x] -> updateState [x] >> getCompletions >>= updateWins
-              l   -> updateState l   >> updateWins l
       | t == keyRelease && (mCleaned,sym) == complKey -> eventLoop (completionHandle c)
       | otherwise -> keyPressHandle mCleaned ks -- some other key, handle it normally
+  where
+    -- When alwaysHighlight is off, just complete based on what the
+    -- user has typed so far.
+    simpleComplete :: [String] -> XPState -> XP ()
+    simpleComplete l st = do
+      let newCommand = nextCompletion (currentXPMode st) (command st) l
+      modify $ \s -> setCommand newCommand $
+                     s { offset = length newCommand
+                       , highlightedCompl = Just newCommand
+                       }
+
+    -- If alwaysHighlight is on, and this is the first use of the
+    -- completion key, update the buffer so that it contains the
+    -- current completion item.
+    alwaysHighlightCurrent :: XPState -> XP ()
+    alwaysHighlightCurrent st = do
+      let newCommand = fromMaybe (command st) $ highlightedItem st c
+      modify $ \s -> setCommand newCommand $
+                     setHighlightedCompl (Just newCommand) $
+                     s { offset = length newCommand
+                       }
+
+    -- If alwaysHighlight is on, and the user wants the next
+    -- completion, move to the next completion item and update the
+    -- buffer to reflect that.
+    --
+    --TODO: Scroll or paginate results
+    alwaysHighlightNext :: [String] -> XPState -> XP ()
+    alwaysHighlightNext l st = do
+      let complIndex' = nextComplIndex st (length l)
+          highlightedCompl' = highlightedItem st { complIndex = complIndex'} c
+          newCommand = fromMaybe (command st) $ highlightedCompl'
+      modify $ \s -> setHighlightedCompl highlightedCompl' $
+                     setCommand newCommand $
+                     s { complIndex = complIndex'
+                       , offset = length newCommand
+                       }
+
 -- some other event: go back to main loop
 completionHandle _ k e = handle k e