XPrompt: fixes a couple of bugs

- we run the action passed to mkXPrompt only if we have a command;
- updateWindows must call destroyComplWin if there are no completions;
- some comments (more to come)
- a shorthand in keyPressHandle
- removed all warnings
This commit is contained in:
Andrea Rossato
2007-08-04 09:08:17 +00:00
parent 6dcf6e4ce2
commit 2be1438c27

View File

@@ -66,7 +66,7 @@ data XPState =
, xptype :: XPType , xptype :: XPType
, command :: String , command :: String
, offset :: Int , offset :: Int
, history :: ![History] , history :: [History]
, config :: XPConfig , config :: XPConfig
} }
@@ -139,7 +139,7 @@ mkXPrompt t conf compl action = do
liftIO $ freeGC d gc liftIO $ freeGC d gc
liftIO $ freeFont d fontS liftIO $ freeFont d fontS
action (command st') when (command st' /= "") $ action (command st')
runXP :: XP () runXP :: XP ()
runXP = do runXP = do
@@ -148,7 +148,6 @@ runXP = do
w = win st w = win st
status <- io $ grabKeyboard d w True grabModeAsync grabModeAsync currentTime status <- io $ grabKeyboard d w True grabModeAsync grabModeAsync currentTime
when (status == grabSuccess) $ do when (status == grabSuccess) $ do
--updateWindows
updateWindows updateWindows
eventLoop handle eventLoop handle
io $ ungrabKeyboard d currentTime io $ ungrabKeyboard d currentTime
@@ -156,6 +155,8 @@ runXP = do
destroyComplWin destroyComplWin
io $ sync d False io $ sync d False
type KeyStroke = (KeySym, String)
eventLoop :: (KeyStroke -> Event -> XP ()) -> XP () eventLoop :: (KeyStroke -> Event -> XP ()) -> XP ()
eventLoop action = do eventLoop action = do
d <- gets dpy d <- gets dpy
@@ -167,8 +168,6 @@ eventLoop action = do
return (ks,s,ev) return (ks,s,ev)
action (fromMaybe xK_VoidSymbol keysym,string) event action (fromMaybe xK_VoidSymbol keysym,string) event
type KeyStroke = (KeySym, String)
-- Main event handler -- Main event handler
handle :: KeyStroke -> Event -> XP () handle :: KeyStroke -> Event -> XP ()
handle k@(ks,_) e@(KeyEvent {ev_event_type = t}) handle k@(ks,_) e@(KeyEvent {ev_event_type = t})
@@ -185,7 +184,7 @@ handle _ _ = eventLoop handle
-- completion event handler -- completion event handler
completionHandle :: [String] -> KeyStroke -> Event -> XP () completionHandle :: [String] -> KeyStroke -> Event -> XP ()
completionHandle c k@(ks,_) e@(KeyEvent {ev_event_type = t}) completionHandle c (ks,_) (KeyEvent {ev_event_type = t})
| t == keyPress && ks == xK_Tab = do | t == keyPress && ks == xK_Tab = do
st <- get st <- get
case c of case c of
@@ -201,25 +200,25 @@ completionHandle c k@(ks,_) e@(KeyEvent {ev_event_type = t})
eventLoop (completionHandle c) eventLoop (completionHandle c)
-- key release -- key release
| t == keyRelease && ks == xK_Tab = eventLoop (completionHandle c) | t == keyRelease && ks == xK_Tab = eventLoop (completionHandle c)
-- other keys
completionHandle _ ks (KeyEvent {ev_event_type = t, ev_state = m}) completionHandle _ ks (KeyEvent {ev_event_type = t, ev_state = m})
| t == keyPress = keyPressHandle m ks | t == keyPress = keyPressHandle m ks
-- 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
-- KeyPresses -- KeyPresses
data Direction = Prev | Next deriving (Eq,Show,Read) data Direction = Prev | Next deriving (Eq,Show,Read)
keyPressHandle :: KeyMask -> KeyStroke -> XP () keyPressHandle :: KeyMask -> KeyStroke -> XP ()
-- commands: ctrl + ... todo -- commands: ctrl + ... todo
keyPressHandle mask (ks,s) keyPressHandle mask _
| mask == controlMask = do | mask == controlMask = do
-- TODO -- TODO
eventLoop handle eventLoop handle
keyPressHandle _ (ks,_) keyPressHandle _ (ks,_)
-- exit -- Return: exit
| ks == xK_Return = do | ks == xK_Return = do
historyPush historyPush
writeHistory writeHistory
@@ -227,37 +226,35 @@ keyPressHandle _ (ks,_)
-- backspace -- backspace
| ks == xK_BackSpace = do | ks == xK_BackSpace = do
deleteString Prev deleteString Prev
updateWindows go
eventLoop handle
-- delete -- delete
| ks == xK_Delete = do | ks == xK_Delete = do
deleteString Next deleteString Next
updateWindows go
eventLoop handle
-- left -- left
| ks == xK_Left = do | ks == xK_Left = do
moveCursor Prev moveCursor Prev
updateWindows go
eventLoop handle
-- right -- right
| ks == xK_Right = do | ks == xK_Right = do
moveCursor Next moveCursor Next
updateWindows go
eventLoop handle
-- up -- up
| ks == xK_Up = do | ks == xK_Up = do
moveHistory Prev moveHistory Prev
updateWindows go
eventLoop handle
-- down -- down
| ks == xK_Down = do | ks == xK_Down = do
moveHistory Next moveHistory Next
updateWindows go
eventLoop handle -- escape: exit and discard everything
-- exscape: exit and discard everything
| ks == xK_Escape = do | ks == xK_Escape = do
flushString flushString
return () return ()
where
go = do
updateWindows
eventLoop handle
-- insert a character -- insert a character
keyPressHandle _ (_,s) keyPressHandle _ (_,s)
@@ -322,7 +319,7 @@ updateWindows = do
drawWin drawWin
c <- getCompletions c <- getCompletions
case c of case c of
[] -> return () [] -> destroyComplWin >> return ()
l -> redrawComplWin l l -> redrawComplWin l
io $ sync d False io $ sync d False