Correctly get the autocompletion item when alwaysHighlight in XMonad.Prompt is True

This commit is contained in:
c.lopez
2012-08-11 10:48:05 +00:00
parent 96ab91fcfa
commit b5f9a61dbe
2 changed files with 109 additions and 97 deletions

View File

@@ -70,7 +70,7 @@ module XMonad.Prompt
import Prelude hiding (catch) import Prelude hiding (catch)
import XMonad hiding (config, cleanMask) import XMonad hiding (cleanMask, config)
import qualified XMonad as X (numberlockMask) import qualified XMonad as X (numberlockMask)
import qualified XMonad.StackSet as W import qualified XMonad.StackSet as W
import XMonad.Util.Font import XMonad.Util.Font
@@ -79,7 +79,7 @@ import XMonad.Util.XSelection (getSelection)
import Codec.Binary.UTF8.String (decodeString) import Codec.Binary.UTF8.String (decodeString)
import Control.Applicative ((<$>)) import Control.Applicative ((<$>))
import Control.Arrow ((&&&),(***),first) import Control.Arrow (first, (&&&), (***))
import Control.Concurrent (threadDelay) import Control.Concurrent (threadDelay)
import Control.Exception.Extensible hiding (handle) import Control.Exception.Extensible hiding (handle)
import Control.Monad.State import Control.Monad.State
@@ -87,12 +87,12 @@ import Data.Bits
import Data.Char (isSpace) import Data.Char (isSpace)
import Data.IORef import Data.IORef
import Data.List import Data.List
import qualified Data.Map as M
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Data.Set (fromList, toList) import Data.Set (fromList, toList)
import System.Directory (getAppUserDataDirectory) import System.Directory (getAppUserDataDirectory)
import System.IO import System.IO
import System.Posix.Files import System.Posix.Files
import qualified Data.Map as M
-- $usage -- $usage
-- For usage examples see "XMonad.Prompt.Shell", -- For usage examples see "XMonad.Prompt.Shell",
@@ -114,6 +114,7 @@ data XPState =
, complIndex :: !(Int,Int) , complIndex :: !(Int,Int)
, showComplWin :: Bool , showComplWin :: Bool
, operationMode :: XPOperationMode , operationMode :: XPOperationMode
, highlightedCompl :: Maybe String
, gcon :: !GC , gcon :: !GC
, fontS :: !XMonadFont , fontS :: !XMonadFont
, commandHistory :: W.Stack String , commandHistory :: W.Stack String
@@ -263,6 +264,7 @@ initState d rw w s opMode gc fonts h c nm =
, complWinDim = Nothing , complWinDim = Nothing
, showComplWin = not (showCompletionOnTab c) , showComplWin = not (showCompletionOnTab c)
, operationMode = opMode , operationMode = opMode
, highlightedCompl = Nothing
, gcon = gc , gcon = gc
, fontS = fonts , fontS = fonts
, commandHistory = W.Stack { W.focus = defaultText c , commandHistory = W.Stack { W.focus = defaultText c
@@ -294,17 +296,17 @@ setNextMode st = case operationMode st of
_ -> st --nothing to do, the prompt's operation has only one mode _ -> st --nothing to do, the prompt's operation has only one mode
-- Returns the highlighted item -- Returns the highlighted item
highlightedItem :: XPState -> [String] -> String highlightedItem :: XPState -> [String] -> Maybe String
highlightedItem st' completions = case complWinDim st' of 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 Nothing -> Nothing -- when there isn't any compl win, we can't say how many cols,rows there are
Just winDim -> Just winDim ->
let let
(_,_,_,_,xx,yy) = winDim (_,_,_,_,xx,yy) = winDim
complMatrix = splitInSubListsAt (length yy) (take (length xx * length yy) completions) complMatrix = splitInSubListsAt (length yy) (take (length xx * length yy) completions)
(col_index,row_index) = (complIndex st') (col_index,row_index) = (complIndex st')
in case completions of in case completions of
[] -> "" -- no completions [] -> Nothing
_ -> complMatrix !! col_index !! row_index _ -> Just $ complMatrix !! col_index !! row_index
-- this would be much easier with functional references -- this would be much easier with functional references
command :: XPState -> String command :: XPState -> String
@@ -313,6 +315,9 @@ 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
@@ -347,7 +352,6 @@ mkXPromptWithReturn t conf compl action = do
releaseXMF fs releaseXMF fs
io $ freeGC d gc io $ freeGC d gc
if successful st' then do if successful st' then do
completions <- liftIO $ do getCompletionFunction st' (commandToComplete (currentXPMode st') (command st')) `catch` \(SomeException _) -> return []
let let
prune = take (historySize conf) prune = take (historySize conf)
@@ -363,8 +367,7 @@ mkXPromptWithReturn t conf compl action = do
--When it is false, it is handled depending on the prompt buffer's value --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' False -> command st'
True -> highlightedItem st' completions True -> fromMaybe "" $ highlightedCompl st'
--Just <$> action selectedCompletion
Just <$> action selectedCompletion Just <$> action selectedCompletion
else return Nothing else return Nothing
@@ -417,8 +420,6 @@ mkXPromptWithModes modes conf = do
io $ freeGC d gc io $ freeGC d gc
if successful st' then do if successful st' then do
completions <- liftIO $ do getCompletionFunction st' (commandToComplete (currentXPMode st') (command st')) `catch` \(SomeException _) -> return []
let let
prune = take (historySize conf) prune = take (historySize conf)
@@ -432,7 +433,7 @@ mkXPromptWithModes modes conf = do
case operationMode st' of case operationMode st' of
XPMultipleModes ms -> let XPMultipleModes ms -> let
action = modeAction $ W.focus ms 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 _ -> return () --This should never happen, we are creating a prompt with multiple modes, so its operationMode should have been constructed with XPMultipleMode
else else
return () return ()
@@ -504,11 +505,13 @@ completionHandle c ks@(sym,_) (KeyEvent { ev_event_type = t, ev_state = m }) = d
do do
st <- get st <- get
let updateState l = case alwaysHlight of 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) -- modify the buffer's value
False -> let new_command = nextCompletion (currentXPMode st) (command st) l False -> let newCommand = nextCompletion (currentXPMode st) (command st) l
in modify $ \s -> setCommand new_command $ s { offset = length new_command } in modify $ \s -> setCommand newCommand $ s { offset = length newCommand, highlightedCompl = Just newCommand}
--TODO: Scroll or paginate results --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) updateWins l = redrawWindows l >> eventLoop (completionHandle l)
case c of case c of
[] -> updateWindows >> eventLoop handle [] -> updateWindows >> eventLoop handle
@@ -525,7 +528,7 @@ nextComplIndex :: XPState -> Int -> (Int,Int)
nextComplIndex st nitems = case complWinDim st of nextComplIndex st nitems = case complWinDim st of
Nothing -> (0,0) --no window dims (just destroyed or not created) Nothing -> (0,0) --no window dims (just destroyed or not created)
Just winDim -> let Just winDim -> let
(_,_,_,_,xx,yy) = winDim (_,_,_,_,_,yy) = winDim
(ncols,nrows) = (nitems `div` length yy + if (nitems `mod` length yy > 0) then 1 else 0, length yy) (ncols,nrows) = (nitems `div` length yy + if (nitems `mod` length yy > 0) then 1 else 0, length yy)
(currentcol,currentrow) = complIndex st (currentcol,currentrow) = complIndex st
in if (currentcol + 1 >= ncols) then --hlight is in the last column in if (currentcol + 1 >= ncols) then --hlight is in the last column
@@ -662,6 +665,7 @@ keyPressHandle m (ks,str) = do
_ -> when (kmask .&. controlMask == 0) $ do _ -> when (kmask .&. controlMask == 0) $ do
insertString (decodeString str) insertString (decodeString str)
updateWindows updateWindows
updateHighlightedCompl
completed <- tryAutoComplete completed <- tryAutoComplete
when completed $ setSuccess True >> setDone True when completed $ setSuccess True >> setDone True
@@ -793,6 +797,13 @@ moveHistory f = modify $ \s -> let ch = f $ commandHistory s
in s { commandHistory = ch in s { commandHistory = ch
, offset = length $ W.focus 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 -- X Stuff
updateWindows :: XP () updateWindows :: XP ()
@@ -975,8 +986,8 @@ redrawComplWin compl = do
Nothing -> recreate Nothing -> recreate
else destroyComplWin else destroyComplWin
-- given a string and a matrix of strings, find the column and row indexes in which the string appears. -- Finds the column and row indexes in which a string appears.
-- if the string is not in the matrix, the function returns (0,0) -- if the string is not in the matrix, the indexes default to (0,0)
findComplIndex :: String -> [[String]] -> (Int,Int) findComplIndex :: String -> [[String]] -> (Int,Int)
findComplIndex x xss = let findComplIndex x xss = let
colIndex = fromMaybe 0 $ findIndex (\cols -> x `elem` cols) xss colIndex = fromMaybe 0 $ findIndex (\cols -> x `elem` cols) xss
@@ -991,14 +1002,15 @@ printComplList d drw gc fc bc xs ys sss =
st <- get st <- get
alwaysHlight <- gets $ alwaysHighlight . config alwaysHlight <- gets $ alwaysHighlight . config
let (f,b) = case alwaysHlight of let (f,b) = case alwaysHlight of
True -> --find the column, row in which this item is and decide if we should highlight True -> -- default to the first item, the one in (0,0)
let let
colIndex = fromMaybe 0 $ findIndex (\cols -> item `elem` cols) sss (colIndex,rowIndex) = findComplIndex item sss
rowIndex = fromMaybe 0 $ elemIndex item $ (!!) sss colIndex in -- assign some colors
in
if ((complIndex st) == (colIndex,rowIndex)) then (fgHLight $ config st,bgHLight $ config st) if ((complIndex st) == (colIndex,rowIndex)) then (fgHLight $ config st,bgHLight $ config st)
else (fc,bc) else (fc,bc)
False -> if completionToCommand (currentXPMode st) item == commandToComplete (currentXPMode st) (command st) False ->
-- compare item with buffer's value
if completionToCommand (currentXPMode st) item == commandToComplete (currentXPMode st) (command st)
then (fgHLight $ config st,bgHLight $ config st) then (fgHLight $ config st,bgHLight $ config st)
else (fc,bc) else (fc,bc)
printStringXMF d drw (fontS st) gc f b x y item) printStringXMF d drw (fontS st) gc f b x y item)

View File

@@ -38,9 +38,9 @@ import System.Directory (doesDirectoryExist, getDirectoryContents)
import System.Environment (getEnv) import System.Environment (getEnv)
import System.Posix.Files (getFileStatus, isDirectory) import System.Posix.Files (getFileStatus, isDirectory)
import XMonad.Util.Run
import XMonad hiding (config) import XMonad hiding (config)
import XMonad.Prompt import XMonad.Prompt
import XMonad.Util.Run
econst :: Monad m => a -> IOException -> m a econst :: Monad m => a -> IOException -> m a
econst = const . return econst = const . return