From 8c764f7361104d8a5505d86be8421d060e645532 Mon Sep 17 00:00:00 2001 From: "c.lopez" Date: Sat, 11 Aug 2012 12:48:05 +0200 Subject: Correctly get the autocompletion item when alwaysHighlight in XMonad.Prompt is True Ignore-this: fa2600df210c7d3472a797f19fb31a7 darcs-hash:20120811104805-c3db2-130ba7583c5498a5d8b30f075d394db203f65329.gz --- XMonad/Prompt.hs | 188 ++++++++++++++++++++++++++----------------------- XMonad/Prompt/Shell.hs | 24 +++---- 2 files changed, 112 insertions(+), 100 deletions(-) (limited to 'XMonad') diff --git a/XMonad/Prompt.hs b/XMonad/Prompt.hs index 23ea420..0627b39 100644 --- a/XMonad/Prompt.hs +++ b/XMonad/Prompt.hs @@ -22,7 +22,7 @@ module XMonad.Prompt , amberXPConfig , defaultXPConfig , greenXPConfig - , XPMode + , XPMode , XPType (..) , XPPosition (..) , XPConfig (..) @@ -68,31 +68,31 @@ module XMonad.Prompt , XPState ) where -import Prelude hiding (catch) - -import XMonad hiding (config, cleanMask) -import qualified XMonad as X (numberlockMask) -import qualified XMonad.StackSet as W -import XMonad.Util.Font -import XMonad.Util.Types -import XMonad.Util.XSelection (getSelection) - -import Codec.Binary.UTF8.String (decodeString) -import Control.Applicative ((<$>)) -import Control.Arrow ((&&&),(***),first) -import Control.Concurrent (threadDelay) -import Control.Exception.Extensible hiding (handle) -import Control.Monad.State -import Data.Bits -import Data.Char (isSpace) -import Data.IORef -import Data.List -import Data.Maybe (fromMaybe) -import Data.Set (fromList, toList) -import System.Directory (getAppUserDataDirectory) -import System.IO -import System.Posix.Files -import qualified Data.Map as M +import Prelude hiding (catch) + +import XMonad hiding (cleanMask, config) +import qualified XMonad as X (numberlockMask) +import qualified XMonad.StackSet as W +import XMonad.Util.Font +import XMonad.Util.Types +import XMonad.Util.XSelection (getSelection) + +import Codec.Binary.UTF8.String (decodeString) +import Control.Applicative ((<$>)) +import Control.Arrow (first, (&&&), (***)) +import Control.Concurrent (threadDelay) +import Control.Exception.Extensible hiding (handle) +import Control.Monad.State +import Data.Bits +import Data.Char (isSpace) +import Data.IORef +import Data.List +import qualified Data.Map as M +import Data.Maybe (fromMaybe) +import Data.Set (fromList, toList) +import System.Directory (getAppUserDataDirectory) +import System.IO +import System.Posix.Files -- $usage -- For usage examples see "XMonad.Prompt.Shell", @@ -114,6 +114,7 @@ data XPState = , complIndex :: !(Int,Int) , showComplWin :: Bool , operationMode :: XPOperationMode + , highlightedCompl :: Maybe String , gcon :: !GC , fontS :: !XMonadFont , commandHistory :: W.Stack String @@ -134,7 +135,7 @@ data XPConfig = , promptBorderWidth :: !Dimension -- ^ Border width , position :: XPPosition -- ^ Position: 'Top' or 'Bottom' , alwaysHighlight :: !Bool -- ^ Always highlight an item, overriden to True with multiple modes. This implies having *one* column of autocompletions only. - , height :: !Dimension -- ^ Window height + , height :: !Dimension -- ^ Window height , historySize :: !Int -- ^ The number of history entries to be saved , historyFilter :: [String] -> [String] -- ^ a filter to determine which @@ -210,18 +211,18 @@ class XPrompt t where -- | When the prompt has multiple modes, this is the function -- used to generate the autocompletion list. - -- The argument passed to this function is given by `commandToComplete` + -- The argument passed to this function is given by `commandToComplete` -- The default implementation shows an error message. completionFunction :: t -> ComplFunction completionFunction t = \_ -> return ["Completions for " ++ (showXPrompt t) ++ " could not be loaded"] - - -- | When the prompt has multiple modes, this function is called + + -- | When the prompt has multiple modes, this function is called -- when the user picked an item from the autocompletion list. - -- The first argument is the autocompleted item's text. + -- The first argument is the autocompleted item's text. -- The second argument is the query made by the user (written in the prompt's buffer). modeAction :: t -> String -> String -> X () modeAction _ _ _ = return () - + data XPPosition = Top | Bottom deriving (Show,Read) @@ -263,6 +264,7 @@ initState d rw w s opMode gc fonts h c nm = , complWinDim = Nothing , showComplWin = not (showCompletionOnTab c) , operationMode = opMode + , highlightedCompl = Nothing , gcon = gc , fontS = fonts , commandHistory = W.Stack { W.focus = defaultText c @@ -292,20 +294,20 @@ setNextMode st = case operationMode st of currentMode = W.focus modes in st { operationMode = XPMultipleModes W.Stack { W.up = [], W.focus = m, W.down = ms ++ [currentMode]}} --set next and move previous current mode to the of the stack _ -> st --nothing to do, the prompt's operation has only one mode - + -- Returns the highlighted item -highlightedItem :: XPState -> [String] -> String -highlightedItem st' completions = case complWinDim st' of - Nothing -> "" -- when there isn't any compl win, we can't say how many cols,rows there are - Just winDim -> +highlightedItem :: XPState -> [String] -> Maybe String +highlightedItem st' completions = case complWinDim st' of + Nothing -> Nothing -- when there isn't any compl win, we can't say how many cols,rows there are + Just winDim -> let (_,_,_,_,xx,yy) = winDim complMatrix = splitInSubListsAt (length yy) (take (length xx * length yy) completions) (col_index,row_index) = (complIndex st') in case completions of - [] -> "" -- no completions - _ -> complMatrix !! col_index !! row_index - + [] -> Nothing + _ -> Just $ complMatrix !! col_index !! row_index + -- this would be much easier with functional references command :: XPState -> String command = W.focus . commandHistory @@ -313,6 +315,9 @@ command = W.focus . commandHistory setCommand :: String -> XPState -> XPState 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. setInput :: String -> XP () setInput = modify . setCommand @@ -347,10 +352,9 @@ mkXPromptWithReturn t conf compl action = do releaseXMF fs io $ freeGC d gc if successful st' then do - completions <- liftIO $ do getCompletionFunction st' (commandToComplete (currentXPMode st') (command st')) `catch` \(SomeException _) -> return [] - let - prune = take (historySize conf) - + let + prune = take (historySize conf) + io $ writeHistory $ M.insertWith (\xs ys -> prune . historyFilter conf $ xs ++ ys) (showXPrompt t) @@ -359,13 +363,12 @@ mkXPromptWithReturn t conf compl action = do -- we need to apply historyFilter before as well, since -- otherwise the filter would not be applied if -- there is no history - --When alwaysHighlight is True, autocompletion is handled with indexes. + --When alwaysHighlight is True, autocompletion is handled with indexes. --When it is false, it is handled depending on the prompt buffer's value - let selectedCompletion = case alwaysHighlight (config st') of + let selectedCompletion = case alwaysHighlight (config st') of False -> command st' - True -> highlightedItem st' completions - --Just <$> action selectedCompletion - Just <$> action selectedCompletion + True -> fromMaybe "" $ highlightedCompl st' + Just <$> action selectedCompletion else return Nothing -- | Creates a prompt given: @@ -387,10 +390,10 @@ mkXPrompt t conf compl action = mkXPromptWithReturn t conf compl action >> retur -- * A non-empty list of modes -- * A prompt configuration -- --- The created prompt allows to switch between modes with `changeModeKey` in `conf`. The modes are +-- The created prompt allows to switch between modes with `changeModeKey` in `conf`. The modes are -- instances of XPrompt. See XMonad.Actions.Launcher for more details -- --- The argument supplied to the action to execute is always the current highlighted item, +-- The argument supplied to the action to execute is always the current highlighted item, -- that means that this prompt overrides the value `alwaysHighlight` for its configuration to True. mkXPromptWithModes :: [XPType] -> XPConfig -> X () mkXPromptWithModes modes conf = do @@ -417,9 +420,7 @@ mkXPromptWithModes modes conf = do io $ freeGC d gc if successful st' then do - completions <- liftIO $ do getCompletionFunction st' (commandToComplete (currentXPMode st') (command st')) `catch` \(SomeException _) -> return [] - - let + let prune = take (historySize conf) -- insert into history the buffers value @@ -432,7 +433,7 @@ mkXPromptWithModes modes conf = do case operationMode st' of XPMultipleModes ms -> let action = modeAction $ W.focus ms - in action (command st') (highlightedItem st' completions) + in action (command st') $ (fromMaybe "" $ highlightedCompl st') _ -> return () --This should never happen, we are creating a prompt with multiple modes, so its operationMode should have been constructed with XPMultipleMode else return () @@ -504,11 +505,13 @@ completionHandle c ks@(sym,_) (KeyEvent { ev_event_type = t, ev_state = m }) = d do st <- get let updateState l = case alwaysHlight of - --We will modify the next command (buffer's value), to be able to highlight the autocompletion (nextCompletion and commandToComplete implementation dependent) - False -> let new_command = nextCompletion (currentXPMode st) (command st) l - in modify $ \s -> setCommand new_command $ s { offset = length new_command } + -- modify the buffer's value + False -> let newCommand = nextCompletion (currentXPMode st) (command st) l + in modify $ \s -> setCommand newCommand $ s { offset = length newCommand, highlightedCompl = Just newCommand} --TODO: Scroll or paginate results - True -> modify $ \s -> s { complIndex = nextComplIndex st (length l)} + True -> let complIndex' = nextComplIndex st (length l) + highlightedCompl' = highlightedItem st { complIndex = complIndex'} c + in modify $ \s -> setHighlightedCompl highlightedCompl' $ s { complIndex = complIndex' } updateWins l = redrawWindows l >> eventLoop (completionHandle l) case c of [] -> updateWindows >> eventLoop handle @@ -519,14 +522,14 @@ completionHandle c ks@(sym,_) (KeyEvent { ev_event_type = t, ev_state = m }) = d -- some other event: go back to main loop completionHandle _ k e = handle k e ---Receives an state of the prompt, the size of the autocompletion list and returns the column,row ---which should be highlighted next -nextComplIndex :: XPState -> Int -> (Int,Int) -nextComplIndex st nitems = case complWinDim st of +--Receives an state of the prompt, the size of the autocompletion list and returns the column,row +--which should be highlighted next +nextComplIndex :: XPState -> Int -> (Int,Int) +nextComplIndex st nitems = case complWinDim st of Nothing -> (0,0) --no window dims (just destroyed or not created) Just winDim -> let - (_,_,_,_,xx,yy) = winDim - (ncols,nrows) = (nitems `div` length yy + if (nitems `mod` length yy > 0) then 1 else 0, length yy) + (_,_,_,_,_,yy) = winDim + (ncols,nrows) = (nitems `div` length yy + if (nitems `mod` length yy > 0) then 1 else 0, length yy) (currentcol,currentrow) = complIndex st in if (currentcol + 1 >= ncols) then --hlight is in the last column if (currentrow + 1 < (nitems `mod` nrows) ) then --hlight is still not at the last row @@ -536,7 +539,7 @@ nextComplIndex st nitems = case complWinDim st of else if(currentrow + 1 < nrows) then --hlight not at the last row (currentcol, currentrow + 1) else - (currentcol + 1, 0) + (currentcol + 1, 0) tryAutoComplete :: XP Bool tryAutoComplete = do @@ -662,6 +665,7 @@ keyPressHandle m (ks,str) = do _ -> when (kmask .&. controlMask == 0) $ do insertString (decodeString str) updateWindows + updateHighlightedCompl completed <- tryAutoComplete when completed $ setSuccess True >> setDone True @@ -728,15 +732,15 @@ startOfLine = flushString :: XP () flushString = modify $ \s -> setCommand "" $ s { offset = 0} ---reset index if config has `alwaysHighlight`. The inserted char could imply fewer autocompletions. ---If the current index was column 2, row 1 and now there are only 4 autocompletion rows with 1 column, what should we highlight? Set it to the first and start navigation again +--reset index if config has `alwaysHighlight`. The inserted char could imply fewer autocompletions. +--If the current index was column 2, row 1 and now there are only 4 autocompletion rows with 1 column, what should we highlight? Set it to the first and start navigation again resetComplIndex :: XPState -> XPState resetComplIndex st = if (alwaysHighlight $ config st) then st { complIndex = (0,0) } else st -- | Insert a character at the cursor position insertString :: String -> XP () insertString str = - modify $ \s -> let + modify $ \s -> let cmd = (c (command s) (offset s)) st = resetComplIndex $ s { offset = o (offset s)} in setCommand cmd st @@ -767,7 +771,7 @@ moveCursor d = modify $ \s -> s { offset = o (offset s) (command s)} where o oo c = if d == Prev then max 0 (oo - 1) else min (length c) (oo + 1) --- | Move the cursor one word, using 'isSpace' as the default +-- | Move the cursor one word, using 'isSpace' as the default -- predicate for non-word characters. See 'moveWord''. moveWord :: Direction1D -> XP () moveWord = moveWord' isSpace @@ -781,7 +785,7 @@ moveWord' p d = do o <- gets offset let (f,ss) = splitAt o c len = uncurry (+) - . (length *** (length . fst . break p)) + . (length *** (length . fst . break p)) . break (not . p) newoff = case d of Prev -> o - len (reverse f) @@ -793,6 +797,13 @@ moveHistory f = modify $ \s -> let ch = f $ commandHistory s in s { commandHistory = ch , offset = length $ W.focus ch } +updateHighlightedCompl :: XP () +updateHighlightedCompl = do + st <- get + cs <- getCompletions + alwaysHighlight' <- gets $ alwaysHighlight . config + when (alwaysHighlight') $ modify $ \s -> s {highlightedCompl = highlightedItem st cs} + -- X Stuff updateWindows :: XP () @@ -872,7 +883,7 @@ getCompletionFunction :: XPState -> ComplFunction getCompletionFunction st = case operationMode st of XPSingleMode compl _ -> compl XPMultipleModes modes -> completionFunction $ W.focus modes - + -- Completions getCompletions :: XP [String] getCompletions = do @@ -932,7 +943,7 @@ getComplWinDim compl = do xp = (asc + desc) `div` 2 yy = map fi . take (fi actual_rows) $ [yp,(yp + ht)..] xx = take (fi columns) [xp,(xp + max_compl_len)..] - + return (rect_x scr + x, rect_y scr + fi y, wh, actual_height, xx, yy) drawComplWin :: Window -> [String] -> XP () @@ -975,10 +986,10 @@ redrawComplWin compl = do Nothing -> recreate else destroyComplWin --- given a string and a matrix of strings, find the column and row indexes in which the string appears. --- if the string is not in the matrix, the function returns (0,0) +-- Finds the column and row indexes in which a string appears. +-- if the string is not in the matrix, the indexes default to (0,0) findComplIndex :: String -> [[String]] -> (Int,Int) -findComplIndex x xss = let +findComplIndex x xss = let colIndex = fromMaybe 0 $ findIndex (\cols -> x `elem` cols) xss rowIndex = fromMaybe 0 $ elemIndex x $ (!!) xss colIndex in (colIndex,rowIndex) @@ -988,22 +999,23 @@ printComplList :: Display -> Drawable -> GC -> String -> String printComplList d drw gc fc bc xs ys sss = zipWithM_ (\x ss -> zipWithM_ (\y item -> do - st <- get - alwaysHlight <- gets $ alwaysHighlight . config - let (f,b) = case alwaysHlight of - True -> --find the column, row in which this item is and decide if we should highlight - let - colIndex = fromMaybe 0 $ findIndex (\cols -> item `elem` cols) sss - rowIndex = fromMaybe 0 $ elemIndex item $ (!!) sss colIndex - in + st <- get + alwaysHlight <- gets $ alwaysHighlight . config + let (f,b) = case alwaysHlight of + True -> -- default to the first item, the one in (0,0) + let + (colIndex,rowIndex) = findComplIndex item sss + in -- assign some colors if ((complIndex st) == (colIndex,rowIndex)) then (fgHLight $ config st,bgHLight $ config st) else (fc,bc) - False -> if completionToCommand (currentXPMode st) item == commandToComplete (currentXPMode st) (command st) - then (fgHLight $ config st,bgHLight $ config st) - else (fc,bc) + False -> + -- compare item with buffer's value + if completionToCommand (currentXPMode st) item == commandToComplete (currentXPMode st) (command st) + then (fgHLight $ config st,bgHLight $ config st) + else (fc,bc) printStringXMF d drw (fontS st) gc f b x y item) ys ss) xs sss - + -- History type History = M.Map String [String] diff --git a/XMonad/Prompt/Shell.hs b/XMonad/Prompt/Shell.hs index d8aa272..c391ca3 100644 --- a/XMonad/Prompt/Shell.hs +++ b/XMonad/Prompt/Shell.hs @@ -29,18 +29,18 @@ module XMonad.Prompt.Shell , split ) where -import Codec.Binary.UTF8.String (encodeString) -import Control.Exception -import Control.Monad (forM) -import Data.List (isPrefixOf) -import Prelude hiding (catch) -import System.Directory (doesDirectoryExist, getDirectoryContents) -import System.Environment (getEnv) -import System.Posix.Files (getFileStatus, isDirectory) - -import XMonad.Util.Run -import XMonad hiding (config) -import XMonad.Prompt +import Codec.Binary.UTF8.String (encodeString) +import Control.Exception +import Control.Monad (forM) +import Data.List (isPrefixOf) +import Prelude hiding (catch) +import System.Directory (doesDirectoryExist, getDirectoryContents) +import System.Environment (getEnv) +import System.Posix.Files (getFileStatus, isDirectory) + +import XMonad hiding (config) +import XMonad.Prompt +import XMonad.Util.Run econst :: Monad m => a -> IOException -> m a econst = const . return -- cgit v1.2.3