updates to XMonad.Prompt re: word-oriented commands

+ change killWord and moveWord to have emacs-like behavior: first move
    past/kill consecutive whitespace, then move past/kill consecutive
    non-whitespace.

  + create variants killWord' and moveWord' which take a predicate
    specifying non-word characters.

  + create variants defaultXPKeymap' and emacsLikeXPKeymap' which take
    the same sort of predicate, which is applied to all keybindings with
    word-oriented commands.
This commit is contained in:
Brent Yorgey 2012-05-10 17:43:17 +00:00
parent 2f2a217b85
commit e705eba1e0

View File

@ -20,19 +20,19 @@ module XMonad.Prompt
, mkXPromptWithReturn , mkXPromptWithReturn
, amberXPConfig , amberXPConfig
, defaultXPConfig , defaultXPConfig
, emacsLikeXPKeymap
, greenXPConfig , greenXPConfig
, XPType (..) , XPType (..)
, XPPosition (..) , XPPosition (..)
, XPConfig (..) , XPConfig (..)
, XPrompt (..) , XPrompt (..)
, XP , XP
, defaultXPKeymap , defaultXPKeymap, defaultXPKeymap'
, emacsLikeXPKeymap, emacsLikeXPKeymap'
, quit , quit
, killBefore, killAfter, startOfLine, endOfLine , killBefore, killAfter, startOfLine, endOfLine
, pasteString, moveCursor , pasteString, moveCursor
, setInput, getInput , setInput, getInput
, moveWord, killWord, deleteString , moveWord, moveWord', killWord, killWord', deleteString
, moveHistory, setSuccess, setDone , moveHistory, setSuccess, setDone
, Direction1D(..) , Direction1D(..)
, ComplFunction , ComplFunction
@ -77,7 +77,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
@ -412,19 +412,31 @@ tryAutoComplete = do
-- KeyPresses -- KeyPresses
-- | Default key bindings for prompts. Click on the \"Source\" link
-- to the right to see the complete list. See also 'defaultXPKeymap''.
defaultXPKeymap :: M.Map (KeyMask,KeySym) (XP ()) defaultXPKeymap :: M.Map (KeyMask,KeySym) (XP ())
defaultXPKeymap = M.fromList $ defaultXPKeymap = defaultXPKeymap' isSpace
-- | A variant of 'defaultXPKeymap' which lets you specify a custom
-- predicate for identifying non-word characters, which affects all
-- the word-oriented commands (move\/kill word). The default is
-- 'isSpace'. For example, by default a path like @foo\/bar\/baz@
-- would be considered as a single word. You could use a predicate
-- like @(\\c -> isSpace c || c == \'\/\')@ to move through or
-- delete components of the path one at a time.
defaultXPKeymap' :: (Char -> Bool) -> M.Map (KeyMask,KeySym) (XP ())
defaultXPKeymap' p = M.fromList $
map (first $ (,) controlMask) -- control + <key> map (first $ (,) controlMask) -- control + <key>
[ (xK_u, killBefore) [ (xK_u, killBefore)
, (xK_k, killAfter) , (xK_k, killAfter)
, (xK_a, startOfLine) , (xK_a, startOfLine)
, (xK_e, endOfLine) , (xK_e, endOfLine)
, (xK_y, pasteString) , (xK_y, pasteString)
, (xK_Right, moveWord Next) , (xK_Right, moveWord' p Next)
, (xK_Left, moveWord Prev) , (xK_Left, moveWord' p Prev)
, (xK_Delete, killWord Next) , (xK_Delete, killWord' p Next)
, (xK_BackSpace, killWord Prev) , (xK_BackSpace, killWord' p Prev)
, (xK_w, killWord Prev) , (xK_w, killWord' p Prev)
, (xK_g, quit) , (xK_g, quit)
, (xK_bracketleft, quit) , (xK_bracketleft, quit)
] ++ ] ++
@ -442,8 +454,21 @@ defaultXPKeymap = M.fromList $
, (xK_Escape, quit) , (xK_Escape, quit)
] ]
-- | A keymap with many emacs-like key bindings. Click on the
-- \"Source\" link to the right to see the complete list.
-- See also 'emacsLikeXPKeymap''.
emacsLikeXPKeymap :: M.Map (KeyMask,KeySym) (XP ()) emacsLikeXPKeymap :: M.Map (KeyMask,KeySym) (XP ())
emacsLikeXPKeymap = M.fromList $ emacsLikeXPKeymap = emacsLikeXPKeymap' isSpace
-- | A variant of 'emacsLikeXPKeymap' which lets you specify a custom
-- predicate for identifying non-word characters, which affects all
-- the word-oriented commands (move\/kill word). The default is
-- 'isSpace'. For example, by default a path like @foo\/bar\/baz@
-- would be considered as a single word. You could use a predicate
-- like @(\\c -> isSpace c || c == \'\/\')@ to move through or
-- delete components of the path one at a time.
emacsLikeXPKeymap' :: (Char -> Bool) -> M.Map (KeyMask,KeySym) (XP ())
emacsLikeXPKeymap' p = M.fromList $
map (first $ (,) controlMask) -- control + <key> map (first $ (,) controlMask) -- control + <key>
[ (xK_z, killBefore) --kill line backwards [ (xK_z, killBefore) --kill line backwards
, (xK_k, killAfter) -- kill line fowards , (xK_k, killAfter) -- kill line fowards
@ -452,16 +477,16 @@ emacsLikeXPKeymap = M.fromList $
, (xK_d, deleteString Next) -- delete a character foward , (xK_d, deleteString Next) -- delete a character foward
, (xK_b, moveCursor Prev) -- move cursor forward , (xK_b, moveCursor Prev) -- move cursor forward
, (xK_f, moveCursor Next) -- move cursor backward , (xK_f, moveCursor Next) -- move cursor backward
, (xK_BackSpace, killWord Prev) -- kill the previous word , (xK_BackSpace, killWord' p Prev) -- kill the previous word
, (xK_y, pasteString) , (xK_y, pasteString)
, (xK_g, quit) , (xK_g, quit)
, (xK_bracketleft, quit) , (xK_bracketleft, quit)
] ++ ] ++
map (first $ (,) mod1Mask) -- meta key + <key> map (first $ (,) mod1Mask) -- meta key + <key>
[ (xK_BackSpace, killWord Prev) [ (xK_BackSpace, killWord' p Prev)
, (xK_f, moveWord Next) -- move a word forward , (xK_f, moveWord' p Next) -- move a word forward
, (xK_b, moveWord Prev) -- move a word backward , (xK_b, moveWord' p Prev) -- move a word backward
, (xK_d, killWord Next) -- kill the next word , (xK_d, killWord' p Next) -- kill the next word
, (xK_n, moveHistory W.focusUp') , (xK_n, moveHistory W.focusUp')
, (xK_p, moveHistory W.focusDown') , (xK_p, moveHistory W.focusDown')
] ]
@ -516,16 +541,26 @@ killAfter :: XP ()
killAfter = killAfter =
modify $ \s -> setCommand (take (offset s) (command s)) s modify $ \s -> setCommand (take (offset s) (command s)) s
-- | Kill the next\/previous word -- | Kill the next\/previous word, using 'isSpace' as the default
-- predicate for non-word characters. See 'killWord''.
killWord :: Direction1D -> XP () killWord :: Direction1D -> XP ()
killWord d = do killWord = killWord' isSpace
-- | Kill the next\/previous word, given a predicate to identify
-- non-word characters. First delete any consecutive non-word
-- characters; then delete consecutive word characters, stopping
-- just before the next non-word character.
--
-- For example, by default (using 'killWord') a path like
-- @foo\/bar\/baz@ would be deleted in its entirety. Instead you can
-- use something like @killWord' (\\c -> isSpace c || c == \'\/\')@ to
-- delete the path one component at a time.
killWord' :: (Char -> Bool) -> Direction1D -> XP ()
killWord' p d = do
o <- gets offset o <- gets offset
c <- gets command c <- gets command
let (f,ss) = splitAt o c let (f,ss) = splitAt o c
delNextWord w = delNextWord = snd . break p . dropWhile p
case w of
' ':x -> x
word -> snd . break isSpace $ word
delPrevWord = reverse . delNextWord . reverse delPrevWord = reverse . delNextWord . reverse
(ncom,noff) = (ncom,noff) =
case d of case d of
@ -578,19 +613,25 @@ 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 -- | Move the cursor one word, using 'isSpace' as the default
-- predicate for non-word characters. See 'moveWord''.
moveWord :: Direction1D -> XP () moveWord :: Direction1D -> XP ()
moveWord d = do moveWord = moveWord' isSpace
-- | Move the cursor one word, given a predicate to identify non-word
-- characters. First move past any consecutive non-word characters;
-- then move to just before the next non-word character.
moveWord' :: (Char -> Bool) -> Direction1D -> XP ()
moveWord' p d = do
c <- gets command c <- gets command
o <- gets offset o <- gets offset
let (f,ss) = splitAt o c let (f,ss) = splitAt o c
lenToS = length . fst . break isSpace len = uncurry (+)
ln p s = case p s of . (length *** (length . fst . break p))
' ':x -> 1 + lenToS x . break (not . p)
x -> lenToS x
newoff = case d of newoff = case d of
Prev -> o - ln reverse f Prev -> o - len (reverse f)
Next -> o + ln id ss Next -> o + len ss
modify $ \s -> s { offset = newoff } modify $ \s -> s { offset = newoff }
moveHistory :: (W.Stack String -> W.Stack String) -> XP () moveHistory :: (W.Stack String -> W.Stack String) -> XP ()