From 71cbab90d14385ea4bf723ca8df06d29065caabe Mon Sep 17 00:00:00 2001
From: Daniel Schoepe <daniel.schoepe@gmail.com>
Date: Thu, 10 Sep 2009 18:08:28 +0200
Subject: Make the keymap of XMonad.Prompt customizable
Ignore-this: 37c04043518d7e4e06b821b3438cbe03
This patch allows the user to change the keymap XMonad.Prompt and
related modules use to be customized using the XPConfig structure.
darcs-hash:20090910160828-7f603-8da00edfbc34cfee22fd3ecd66e107913dd6af81.gz
---
XMonad/Prompt.hs | 141 +++++++++++++++++++++++++++++++++----------------------
1 file changed, 84 insertions(+), 57 deletions(-)
diff --git a/XMonad/Prompt.hs b/XMonad/Prompt.hs
index 123c8a6..3467693 100644
--- a/XMonad/Prompt.hs
+++ b/XMonad/Prompt.hs
@@ -25,6 +25,15 @@ module XMonad.Prompt
, XPPosition (..)
, XPConfig (..)
, XPrompt (..)
+ , XP
+ , defaultXPKeymap
+ , completion
+ , quit
+ , killBefore, killAfter, startOfLine, endOfLine
+ , pasteString, copyString
+ , moveWord, killWord, deleteString
+ , moveHistory, setSuccess, setDone
+ , Direction (..)
, ComplFunction
-- * X Utilities
-- $xutils
@@ -58,7 +67,7 @@ import qualified XMonad.StackSet as W
import XMonad.Util.Font
import XMonad.Util.XSelection (getSelection, putSelection)
-import Control.Arrow ((&&&))
+import Control.Arrow ((&&&),first)
import Control.Concurrent (threadDelay)
import Control.Monad.Reader
import Control.Monad.State
@@ -73,8 +82,7 @@ import System.IO
import System.Posix.Files
import Control.Exception hiding (handle)
-import qualified Data.Map as Map
-import Data.Map (Map)
+import qualified Data.Map as M
-- $usage
-- For usage examples see "XMonad.Prompt.Shell",
@@ -102,6 +110,7 @@ data XPState =
, offset :: !Int
, config :: XPConfig
, successful :: Bool
+ , done :: Bool
}
data XPConfig =
@@ -118,6 +127,8 @@ data XPConfig =
, historyFilter :: [String] -> [String]
-- ^ a filter to determine which
-- history entries to remember
+ , promptKeymap :: M.Map (KeyMask,KeySym) (XP ())
+ -- ^ Mapping from key combinations to actions
, defaultText :: String -- ^ The text by default in the prompt line
, autoComplete :: Maybe Int -- ^ Just x: if only one completion remains, auto-select it,
, showCompletionOnTab :: Bool -- ^ Only show list of completions when Tab was pressed
@@ -178,6 +189,7 @@ data XPPosition = Top
deriving (Show,Read)
amberXPConfig, defaultXPConfig, greenXPConfig :: XPConfig
+
defaultXPConfig =
XPC { font = "-misc-fixed-*-*-*-*-12-*-*-*-*-*-*-*"
, bgColor = "grey22"
@@ -186,6 +198,7 @@ defaultXPConfig =
, bgHLight = "grey"
, borderColor = "white"
, promptBorderWidth = 1
+ , promptKeymap = defaultXPKeymap
, position = Bottom
, height = 18
, historySize = 256
@@ -218,6 +231,7 @@ initState d rw w s compl gc fonts pt h c =
, offset = length (defaultText c)
, config = c
, successful = False
+ , done = False
}
-- this would be much easier with functional references
@@ -245,7 +259,7 @@ mkXPromptWithReturn t conf compl action = do
gc <- liftIO $ createGC d w
liftIO $ setGraphicsExposures d gc False
fs <- initXMF (font conf)
- let hs = fromMaybe [] $ Map.lookup (showXPrompt t) hist
+ let hs = fromMaybe [] $ M.lookup (showXPrompt t) hist
st = initState d rw w s compl gc fs (XPT t) hs conf
st' <- liftIO $ execStateT runXP st
@@ -253,7 +267,7 @@ mkXPromptWithReturn t conf compl action = do
liftIO $ freeGC d gc
if successful st'
then do
- liftIO $ writeHistory $ Map.insertWith
+ liftIO $ writeHistory $ M.insertWith
(\xs ys -> take (historySize conf)
. historyFilter conf $ xs ++ ys)
(showXPrompt t) [command st'] hist
@@ -301,26 +315,21 @@ eventLoop action = do
else return (Nothing, "")
return (ks,s,ev)
action (fromMaybe xK_VoidSymbol keysym,string) event
+ gets done >>= flip unless (eventLoop action)
-- Main event handler
handle :: KeyStroke -> Event -> XP ()
-handle k@(ks,_) e@(KeyEvent {ev_event_type = t})
- | t == keyPress && ks == xK_Tab = do
- c <- getCompletions
- if length c > 1 then modify $ \s -> s { showComplWin = True } else return ()
- completionHandle c k e
handle ks (KeyEvent {ev_event_type = t, ev_state = m})
| t == keyPress = keyPressHandle m ks
handle _ (ExposeEvent {ev_window = w}) = do
st <- get
when (win st == w) updateWindows
- eventLoop handle
-handle _ _ = eventLoop handle
+handle _ _ = return ()
--- completion event handler
-completionHandle :: [String] -> KeyStroke -> Event -> XP ()
-completionHandle c (ks,_) (KeyEvent {ev_event_type = t})
- | t == keyPress && ks == xK_Tab = do
+completion :: XP ()
+completion = do
+ c <- getCompletions
+ when (length c > 1) $ modify (\s -> s { showComplWin = True })
st <- get
let updateState l = do let new_command = nextCompletion (xptype st) (command st) l
modify $ \s -> setCommand new_command $ s { offset = length new_command }
@@ -330,6 +339,12 @@ completionHandle c (ks,_) (KeyEvent {ev_event_type = t})
[] -> updateWindows >> eventLoop handle
[x] -> updateState [x] >> getCompletions >>= updateWins
l -> updateState l >> updateWins l
+
+
+-- completion event handler
+completionHandle :: [String] -> KeyStroke -> Event -> XP ()
+completionHandle c (ks,_) (KeyEvent {ev_event_type = t})
+ | t == keyPress && ks == xK_Tab = completion
-- key release
| t == keyRelease && ks == xK_Tab = eventLoop (completionHandle c)
-- other keys
@@ -338,6 +353,7 @@ completionHandle _ ks (KeyEvent {ev_event_type = t, ev_state = m})
-- some other event: go back to main loop
completionHandle _ k e = handle k e
+
tryAutoComplete :: XP Bool
tryAutoComplete = do
ac <- gets (autoComplete . config)
@@ -360,51 +376,62 @@ tryAutoComplete = do
data Direction = Prev | Next deriving (Eq,Show,Read)
+defaultXPKeymap :: M.Map (KeyMask,KeySym) (XP ())
+defaultXPKeymap = M.fromList $
+ map (first $ (,) controlMask) -- control + <key>
+ [ (xK_u, killBefore)
+ , (xK_k, killAfter)
+ , (xK_a, startOfLine)
+ , (xK_e, endOfLine)
+ , (xK_y, pasteString)
+ , (xK_c, copyString)
+ , (xK_Right, moveWord Next)
+ , (xK_Left, moveWord Prev)
+ , (xK_Delete, killWord Next)
+ , (xK_BackSpace, killWord Prev)
+ , (xK_w, killWord Prev)
+ , (xK_q, quit)
+ ] ++
+ map (first $ (,) 0)
+ [ (xK_Return, setSuccess True >> setDone True)
+ , (xK_KP_Enter, setSuccess True >> setDone True)
+ , (xK_BackSpace, deleteString Prev)
+ , (xK_Delete, deleteString Next)
+ , (xK_Left, moveCursor Prev)
+ , (xK_Right, moveCursor Next)
+ , (xK_Home, startOfLine)
+ , (xK_End, endOfLine)
+ , (xK_Down, moveHistory W.focusUp')
+ , (xK_Up, moveHistory W.focusDown')
+ , (xK_Tab, completion)
+ , (xK_Escape, quit)
+ ]
+
keyPressHandle :: KeyMask -> KeyStroke -> XP ()
--- commands: ctrl + ... todo
-keyPressHandle mask (ks,_)
- | (mask .&. controlMask) > 0 =
- -- control sequences
- case () of
- _ | ks == xK_u -> killBefore >> go
- | ks == xK_k -> killAfter >> go
- | ks == xK_a -> startOfLine >> go
- | ks == xK_e -> endOfLine >> go
- | ks == xK_y -> pasteString >> go
- | ks == xK_c -> copyString >> go
- | ks == xK_Right -> moveWord Next >> go
- | ks == xK_Left -> moveWord Prev >> go
- | ks == xK_Delete -> killWord Next >> go
- | ks == xK_BackSpace -> killWord Prev >> go
- | ks == xK_w -> killWord Prev >> go
- | ks == xK_g || ks == xK_c -> quit
- | otherwise -> eventLoop handle -- unhandled control sequence
- | ks == xK_Return || ks == xK_KP_Enter = setSuccess True
- | ks == xK_BackSpace = deleteString Prev >> go
- | ks == xK_Delete = deleteString Next >> go
- | ks == xK_Left = moveCursor Prev >> go
- | ks == xK_Right = moveCursor Next >> go
- | ks == xK_Home = startOfLine >> go
- | ks == xK_End = endOfLine >> go
- | ks == xK_Down = moveHistory W.focusUp' >> go
- | ks == xK_Up = moveHistory W.focusDown' >> go
- | ks == xK_Escape = quit
- where
- go = updateWindows >> eventLoop handle
- quit = flushString >> setSuccess False -- quit and discard everything
--- insert a character
-keyPressHandle _ (_,s)
- | s == "" = eventLoop handle
- | otherwise = do insertString (decodeInput s)
- updateWindows
- completed <- tryAutoComplete
- if completed then setSuccess True else eventLoop handle
+keyPressHandle mask (ks,str) = do
+ km <- gets (promptKeymap . config)
+ case M.lookup (mask,ks) km of
+ Just action -> action >> updateWindows
+ Nothing -> case str of
+ "" -> eventLoop handle
+ _ -> when (mask .&. controlMask == 0) $ do
+ insertString (decodeInput str)
+ updateWindows
+ completed <- tryAutoComplete
+ when completed $ setSuccess True >> setDone True
setSuccess :: Bool -> XP ()
setSuccess b = modify $ \s -> s { successful = b }
+setDone :: Bool -> XP ()
+setDone b = modify $ \s -> s { done = b }
+
-- KeyPress and State
+-- | Quit.
+quit :: XP ()
+quit = flushString >> setSuccess False >> setDone True
+
-- | Kill the portion of the command before the cursor
killBefore :: XP ()
killBefore =
@@ -704,10 +731,10 @@ printComplString d drw gc fc bc x y s = do
-- History
-type History = Map String [String]
+type History = M.Map String [String]
emptyHistory :: History
-emptyHistory = Map.empty
+emptyHistory = M.empty
getHistoryFile :: IO FilePath
getHistoryFile = fmap (++ "/history") $ getAppUserDataDirectory "xmonad"
@@ -824,7 +851,7 @@ breakAtSpace s
-- 'getShellCompl'; you pass it to mkXPrompt, and it will make completions work
-- from the query history stored in ~\/.xmonad\/history.
historyCompletion :: ComplFunction
-historyCompletion x = fmap (deleteConsecutive . filter (isInfixOf x) . Map.fold (++) []) readHistory
+historyCompletion x = fmap (deleteConsecutive . filter (isInfixOf x) . M.fold (++) []) readHistory
-- | Sort a list and remove duplicates. Like 'deleteAllDuplicates', but trades off
-- laziness and stability for efficiency.
--
cgit v1.2.3