twin/xmonad-contrib
1
0
Fork 0
mirror of https://github.com/xmonad/xmonad-contrib.git synced 2025-08-06 06:51:55 -07:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source
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
Download Patch File Download Diff File Expand all files Collapse all files

184
XMonad/Prompt.hs
View File

@@ -22,7 +22,7 @@ module XMonad.Prompt
, amberXPConfig , amberXPConfig
, defaultXPConfig , defaultXPConfig
, greenXPConfig , greenXPConfig
, XPMode , XPMode
, XPType (..) , XPType (..)
, XPPosition (..) , XPPosition (..)
, XPConfig (..) , XPConfig (..)
@@ -68,31 +68,31 @@ module XMonad.Prompt
, XPState , XPState
) where ) where
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
import XMonad.Util.Types import XMonad.Util.Types
import XMonad.Util.XSelection (getSelection) 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
import Data.Bits import Data.Bits
import Data.Char (isSpace) import Data.Char (isSpace)
import Data.IORef import Data.IORef
import Data.List import Data.List
import Data.Maybe (fromMaybe) import qualified Data.Map as M
import Data.Set (fromList, toList) import Data.Maybe (fromMaybe)
import System.Directory (getAppUserDataDirectory) import Data.Set (fromList, toList)
import System.IO import System.Directory (getAppUserDataDirectory)
import System.Posix.Files import System.IO
import qualified Data.Map as M import System.Posix.Files
-- $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
@@ -134,7 +135,7 @@ data XPConfig =
, promptBorderWidth :: !Dimension -- ^ Border width , promptBorderWidth :: !Dimension -- ^ Border width
, position :: XPPosition -- ^ Position: 'Top' or 'Bottom' , 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. , 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 , historySize :: !Int -- ^ The number of history entries to be saved
, historyFilter :: [String] -> [String] , historyFilter :: [String] -> [String]
-- ^ a filter to determine which -- ^ a filter to determine which
@@ -210,18 +211,18 @@ class XPrompt t where
-- | When the prompt has multiple modes, this is the function -- | When the prompt has multiple modes, this is the function
-- used to generate the autocompletion list. -- 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. -- The default implementation shows an error message.
completionFunction :: t -> ComplFunction completionFunction :: t -> ComplFunction
completionFunction t = \_ -> return ["Completions for " ++ (showXPrompt t) ++ " could not be loaded"] 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. -- 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). -- The second argument is the query made by the user (written in the prompt's buffer).
modeAction :: t -> String -> String -> X () modeAction :: t -> String -> String -> X ()
modeAction _ _ _ = return () modeAction _ _ _ = return ()
data XPPosition = Top data XPPosition = Top
| Bottom | Bottom
deriving (Show,Read) deriving (Show,Read)
@@ -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
@@ -292,20 +294,20 @@ setNextMode st = case operationMode st of
currentMode = W.focus modes 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 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 _ -> 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
command = W.focus . commandHistory command = W.focus . commandHistory
@@ -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,10 +352,9 @@ 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)
io $ writeHistory $ M.insertWith io $ writeHistory $ M.insertWith
(\xs ys -> prune . historyFilter conf $ xs ++ ys) (\xs ys -> prune . historyFilter conf $ xs ++ ys)
(showXPrompt t) (showXPrompt t)
@@ -359,13 +363,12 @@ mkXPromptWithReturn t conf compl action = do
-- we need to apply historyFilter before as well, since -- we need to apply historyFilter before as well, since
-- otherwise the filter would not be applied if -- otherwise the filter would not be applied if
-- there is no history -- 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 --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
-- | Creates a prompt given: -- | 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 non-empty list of modes
-- * A prompt configuration -- * 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 -- 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. -- that means that this prompt overrides the value `alwaysHighlight` for its configuration to True.
mkXPromptWithModes :: [XPType] -> XPConfig -> X () mkXPromptWithModes :: [XPType] -> XPConfig -> X ()
mkXPromptWithModes modes conf = do mkXPromptWithModes modes conf = do
@@ -417,9 +420,7 @@ 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)
-- insert into history the buffers value -- insert into history the buffers value
@@ -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
@@ -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 -- some other event: go back to main loop
completionHandle _ k e = handle k e completionHandle _ k e = handle k e
--Receives an state of the prompt, the size of the autocompletion list and returns the column,row --Receives an state of the prompt, the size of the autocompletion list and returns the column,row
--which should be highlighted next --which should be highlighted next
nextComplIndex :: XPState -> Int -> (Int,Int) 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
if (currentrow + 1 < (nitems `mod` nrows) ) then --hlight is still not at the last row 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 else if(currentrow + 1 < nrows) then --hlight not at the last row
(currentcol, currentrow + 1) (currentcol, currentrow + 1)
else else
(currentcol + 1, 0) (currentcol + 1, 0)
tryAutoComplete :: XP Bool tryAutoComplete :: XP Bool
tryAutoComplete = do tryAutoComplete = do
@@ -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
@@ -728,15 +732,15 @@ startOfLine =
flushString :: XP () flushString :: XP ()
flushString = modify $ \s -> setCommand "" $ s { offset = 0} flushString = modify $ \s -> setCommand "" $ s { offset = 0}
--reset index if config has `alwaysHighlight`. The inserted char could imply fewer autocompletions. --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 --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 :: XPState -> XPState
resetComplIndex st = if (alwaysHighlight $ config st) then st { complIndex = (0,0) } else st resetComplIndex st = if (alwaysHighlight $ config st) then st { complIndex = (0,0) } else st
-- | Insert a character at the cursor position -- | Insert a character at the cursor position
insertString :: String -> XP () insertString :: String -> XP ()
insertString str = insertString str =
modify $ \s -> let modify $ \s -> let
cmd = (c (command s) (offset s)) cmd = (c (command s) (offset s))
st = resetComplIndex $ s { offset = o (offset s)} st = resetComplIndex $ s { offset = o (offset s)}
in setCommand cmd st in setCommand cmd st
@@ -767,7 +771,7 @@ moveCursor d =
modify $ \s -> s { offset = o (offset s) (command s)} 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) 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''. -- predicate for non-word characters. See 'moveWord''.
moveWord :: Direction1D -> XP () moveWord :: Direction1D -> XP ()
moveWord = moveWord' isSpace moveWord = moveWord' isSpace
@@ -781,7 +785,7 @@ moveWord' p d = do
o <- gets offset o <- gets offset
let (f,ss) = splitAt o c let (f,ss) = splitAt o c
len = uncurry (+) len = uncurry (+)
. (length *** (length . fst . break p)) . (length *** (length . fst . break p))
. break (not . p) . break (not . p)
newoff = case d of newoff = case d of
Prev -> o - len (reverse f) Prev -> o - len (reverse f)
@@ -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 ()
@@ -872,7 +883,7 @@ getCompletionFunction :: XPState -> ComplFunction
getCompletionFunction st = case operationMode st of getCompletionFunction st = case operationMode st of
XPSingleMode compl _ -> compl XPSingleMode compl _ -> compl
XPMultipleModes modes -> completionFunction $ W.focus modes XPMultipleModes modes -> completionFunction $ W.focus modes
-- Completions -- Completions
getCompletions :: XP [String] getCompletions :: XP [String]
getCompletions = do getCompletions = do
@@ -932,7 +943,7 @@ getComplWinDim compl = do
xp = (asc + desc) `div` 2 xp = (asc + desc) `div` 2
yy = map fi . take (fi actual_rows) $ [yp,(yp + ht)..] yy = map fi . take (fi actual_rows) $ [yp,(yp + ht)..]
xx = take (fi columns) [xp,(xp + max_compl_len)..] xx = take (fi columns) [xp,(xp + max_compl_len)..]
return (rect_x scr + x, rect_y scr + fi y, wh, actual_height, xx, yy) return (rect_x scr + x, rect_y scr + fi y, wh, actual_height, xx, yy)
drawComplWin :: Window -> [String] -> XP () drawComplWin :: Window -> [String] -> XP ()
@@ -975,10 +986,10 @@ 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
rowIndex = fromMaybe 0 $ elemIndex x $ (!!) xss colIndex rowIndex = fromMaybe 0 $ elemIndex x $ (!!) xss colIndex
in (colIndex,rowIndex) in (colIndex,rowIndex)
@@ -988,22 +999,23 @@ printComplList :: Display -> Drawable -> GC -> String -> String
printComplList d drw gc fc bc xs ys sss = printComplList d drw gc fc bc xs ys sss =
zipWithM_ (\x ss -> zipWithM_ (\x ss ->
zipWithM_ (\y item -> do zipWithM_ (\y item -> do
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 ->
then (fgHLight $ config st,bgHLight $ config st) -- compare item with buffer's value
else (fc,bc) 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) printStringXMF d drw (fontS st) gc f b x y item)
ys ss) xs sss ys ss) xs sss
-- History -- History
type History = M.Map String [String] type History = M.Map String [String]

22
XMonad/Prompt/Shell.hs
View File

@@ -29,18 +29,18 @@ module XMonad.Prompt.Shell
, split , split
) where ) where
import Codec.Binary.UTF8.String (encodeString) import Codec.Binary.UTF8.String (encodeString)
import Control.Exception import Control.Exception
import Control.Monad (forM) import Control.Monad (forM)
import Data.List (isPrefixOf) import Data.List (isPrefixOf)
import Prelude hiding (catch) import Prelude hiding (catch)
import System.Directory (doesDirectoryExist, getDirectoryContents) 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