XPrompt: code cleanup

The completion list is not cached anymore: this greatly simplify the code
making its runtime behaviour more predictable...;-) Suggested by Spencer.

darcs-hash:20070803181905-32816-a9a41a08657fff91a279a1bcf362cf72cc0cd458.gz

1 files changed, 44 insertions, 53 deletions

diff --git a/XPrompt.hs b/XPrompt.hs
index e0ffcac..ac2336d 100644
--- a/XPrompt.hs
+++ b/XPrompt.hs
@@ -61,7 +61,6 @@ data XPState =
         , complWin :: Maybe Window
         , complWinDim :: Maybe ComplWindowDim
         , completionFunction :: String -> IO [String]
-        , compList :: [String] -- Maybe ([String],[String],[String]) for scrolling 
         , gcon :: GC
         , fs :: FontStruct 
         , xptype :: XPType
@@ -121,7 +120,7 @@ type ComplFunction = String -> IO [String]
 initState :: XPrompt p => Display -> Window -> Window -> Rectangle -> ComplFunction
           -> GC -> FontStruct -> p -> [History] -> XPConfig -> XPState
 initState d rw w s compl gc f pt h c =
-    XPS d rw w s Nothing Nothing compl [] gc f (XPT pt) "" 0 h c
+    XPS d rw w s Nothing Nothing compl gc f (XPT pt) "" 0 h c
 
 mkXPrompt :: XPrompt p => p -> XPConfig -> ComplFunction -> (String -> X ())  -> X ()
 mkXPrompt t conf compl action = do
@@ -149,9 +148,10 @@ runXP = do
       w = win st
   status <- io $ grabKeyboard d w True grabModeAsync grabModeAsync currentTime
   when (status == grabSuccess) $ do
-            updateWindows
-            eventLoop handle
-            io $ ungrabKeyboard d currentTime
+            --updateWindows
+          updateWindows
+          eventLoop handle
+          io $ ungrabKeyboard d currentTime
   io $ destroyWindow d w
   destroyComplWin
   io $ sync d False
@@ -172,7 +172,9 @@ type KeyStroke = (KeySym, String)
 -- Main event handler
 handle :: KeyStroke -> Event -> XP ()
 handle k@(ks,_) e@(KeyEvent {ev_event_type = t})
-    | t == keyPress && ks == xK_Tab = completionHandle k e
+    | t == keyPress && ks == xK_Tab = do
+  c <- getCompletions
+  completionHandle c k e
 handle ks (KeyEvent {ev_event_type = t, ev_state = m}) 
     | t == keyPress = keyPressHandle m ks
 handle _ (AnyEvent {ev_event_type = t, ev_window = w}) 
@@ -182,25 +184,27 @@ handle _ (AnyEvent {ev_event_type = t, ev_window = w})
 handle _  _ = eventLoop handle
 
 -- completion event handler
-completionHandle :: KeyStroke -> Event -> XP ()
-completionHandle k@(ks,_) e@(KeyEvent {ev_event_type = t})
+completionHandle ::  [String] -> KeyStroke -> Event -> XP ()
+completionHandle c k@(ks,_) e@(KeyEvent {ev_event_type = t})
     | t == keyPress && ks == xK_Tab = do
   st <- get
-  case compList st of
+  case c of
     [] -> do updateWindows
+             eventLoop handle
     l  -> let new_index = case elemIndex (getLastWord (command st)) l of
                                 Just i -> if i >= (length l - 1) then 0 else i + 1
                                 Nothing -> 0
               new_command = skipLastWord (command st) ++ fill ++ l !! new_index
               fill = if  ' ' `elem` (command st) then " " else ""
           in do modify $ \s ->  s { command = new_command, offset = length new_command }
-                redrawWindows
-  eventLoop completionHandle
-
-completionHandle ks (KeyEvent {ev_event_type = t, ev_state = m}) 
+                redrawWindows c
+                eventLoop (completionHandle c)
+-- key release
+    | t == keyRelease && ks == xK_Tab = eventLoop (completionHandle c)
+completionHandle _ ks (KeyEvent {ev_event_type = t, ev_state = m})
     | t == keyPress = keyPressHandle m ks
 -- go back to main loop
-completionHandle k e = handle k e
+completionHandle _ k e = handle k e
 
 
 -- KeyPresses
@@ -223,35 +227,31 @@ keyPressHandle _ (ks,_)
 -- backspace
     | ks == xK_BackSpace = do
   deleteString Prev
-  refreshCompletionList
   updateWindows
   eventLoop handle
 -- delete
     | ks == xK_Delete = do
   deleteString Next
-  refreshCompletionList
   updateWindows
   eventLoop handle
 -- left
     | ks == xK_Left = do
   moveCursor Prev
-  redrawWindows
+  updateWindows
   eventLoop handle
 -- right
     | ks == xK_Right = do
   moveCursor Next
-  redrawWindows
+  updateWindows
   eventLoop handle
 -- up
     | ks == xK_Up = do
   moveHistory Prev
-  refreshCompletionList
   updateWindows
   eventLoop handle
 -- down
     | ks == xK_Down = do
   moveHistory Next
-  refreshCompletionList
   updateWindows
   eventLoop handle
 -- exscape: exit and discard everything
@@ -264,7 +264,6 @@ keyPressHandle _ (_,s)
     | s == "" = eventLoop handle
     | otherwise = do
   insertString s
-  refreshCompletionList
   updateWindows
   eventLoop handle
 
@@ -317,30 +316,34 @@ moveHistory d = do
 
 -- X Stuff
 
-createWin :: Display -> Window -> XPConfig -> Rectangle -> IO Window
-createWin d rw c s = do
-  let (x,y) = case position c of
-                Top -> (0,0)
-                Bottom -> (0, rect_height s - height c)
-  w <- mkUnmanagedWindow d (defaultScreenOfDisplay d) rw 
-                      (rect_x s + x) (rect_y s + fi y) (rect_width s) (height c)
-  mapWindow d w
-  return w
-
 updateWindows :: XP ()
 updateWindows = do
   d <- gets dpy
   drawWin
-  refreshCompletionList
+  c <- getCompletions
+  case c  of
+    [] -> return ()
+    l  -> redrawComplWin l
   io $ sync d False
 
-redrawWindows :: XP ()
-redrawWindows = do
-  st <- get
+redrawWindows :: [String] -> XP ()
+redrawWindows c = do
+  d <- gets dpy
   drawWin
-  case compList st of
+  case c  of
     [] -> return ()
     l  -> redrawComplWin l
+  io $ sync d False
+
+createWin :: Display -> Window -> XPConfig -> Rectangle -> IO Window
+createWin d rw c s = do
+  let (x,y) = case position c of
+                Top -> (0,0)
+                Bottom -> (0, rect_height s - height c)
+  w <- mkUnmanagedWindow d (defaultScreenOfDisplay d) rw 
+                      (rect_x s + x) (rect_y s + fi y) (rect_width s) (height c)
+  mapWindow d w
+  return w
 
 drawWin :: XP ()
 drawWin = do
@@ -392,34 +395,22 @@ printPrompt drw gc fontst = do
 
 -- Completions
 
-getCompletions :: String -> XP [String]
-getCompletions s = do
-  cf <- gets completionFunction 
-  c <- io $ cf s
-  setComplList c
-  return c
-
-setComplList :: [String] -> XP ()
-setComplList l =
-  modify (\s -> s { compList = l })
+getCompletions :: XP [String]
+getCompletions = do
+  s <- get
+  io $ (completionFunction s) (command s)
 
 setComplWin :: Window -> ComplWindowDim -> XP ()
 setComplWin w wi =
   modify (\s -> s { complWin = Just w, complWinDim = Just wi })
 
-refreshCompletionList :: XP ()
-refreshCompletionList = do
-  c <- gets command
-  compl <- getCompletions $ getLastWord c
-  redrawComplWin compl
-
 destroyComplWin :: XP ()
 destroyComplWin = do
   d <- gets dpy
   cw <- gets complWin
   case cw of
     Just w -> do io $ destroyWindow d w
-                 modify (\s -> s { complWin = Nothing, complWinDim = Nothing, compList = [] })
+                 modify (\s -> s { complWin = Nothing, complWinDim = Nothing })
     Nothing -> return ()
 
 type ComplWindowDim = (Position,Position,Dimension,Dimension,Columns,Rows)