mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-05-19 11:30:22 -07:00
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:
parent
2f2a217b85
commit
e705eba1e0
101
XMonad/Prompt.hs
101
XMonad/Prompt.hs
@ -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 ()
|
||||||
|
Loading…
x
Reference in New Issue
Block a user