summaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Main.hs140
1 files changed, 30 insertions, 110 deletions
diff --git a/src/Main.hs b/src/Main.hs
index 43ff393..1a26868 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -23,6 +23,8 @@ import Control.Monad.Writer
import Buffer
import Process
+import Scanner (scan, runScanner, toChar)
+
data VTConfig = VTConfig
{ withOutput :: IO () -> IO ()
@@ -84,14 +86,34 @@ uiThread :: VTConfig -> (VTState -> IO ()) -> IO VTState -> IO ()
uiThread cf putState getState = forever $ do
q0 <- getState
- ((eitCmd, lns), q1) <- runVT cf q0 $ do
- c <- getCommand (mode q0)
- execCommand c
- return c
+
+ _ <- hLookAhead stdin -- wait for input
+ --t0 <- getCurrentTime
+ -- ((res, s), _) <- runScanner scan
+ ((_, s), _) <- runScanner scan
+ --t1 <- getCurrentTime
+ --putStrLn $ "====> \ESC[32;1m" ++ show s ++ "\ESC[m in " ++
+ -- (show $ diffUTCTime t1 t0)
+ -- ++ ": \"\ESC[35m" ++ (concat $ map (colorize . toChar) s)
+ -- ++ "\ESC[m\""
+ --case res of
+ -- Left msg -> putStrLn $ " error: " ++ msg
+ -- Right _ -> return ()
+
+ -- TODO don't leak C
+ let cmd = getCommand (mode q0) (map toChar s)
+
+ --withOutput cf $ do
+ -- putStrLn $ show cmd
+
+ ((_, lns), q1) <- runVT cf q0 (execCommand cmd)
-- TODO only putState if it has changed (?)
putState q1
+ -- XXX dummy for following legacy code
+ let eitCmd = Right cmd
+
let mbErr = case eitCmd of
Left err -> Just err
Right c ->
@@ -438,112 +460,10 @@ instance Show Mode where
show VerbatimMode = "verbatim"
-getCommand :: Mode -> VT Command
-getCommand InsertMode = getCommandXXX imap InsertString
-getCommand NormalMode = getCommandXXX nmap AlertBadInput
-getCommand VerbatimMode = verbatimKeymap
-
-
--- TODO refactor me please^_^
-getCommandXXX :: Keymap -> (String -> Command) -> VT Command
-getCommandXXX keymap defCmd = do
-
- -- wait for the first character
- _ <- liftIO $ hLookAhead stdin
-
- bufRef <- liftIO $ newIORef ""
- candRef <- liftIO $ newIORef Nothing
- cmdRef <- liftIO $ newEmptyMVar -- :: MVar (Maybe (String -> Command))
-
- -- TODO ensure that this thread dies eventually
- --forkIO $ rec "" keymap cmdRef candRef
- getCharThreadId <-
- --forkFinally (rec keymap cmdRef candRef bufRef)
- -- (\_ -> putStrLn "input terminated")
- liftIO $ forkIO $ do
- rec keymap cmdRef candRef bufRef
-
- watchDogThreadId <-
- liftIO $ forkIO $ do
- --putStrLn "watchdog activated"
- threadDelay $ 1000 * 50 -- 50ms
- --putStrLn "watchdog timeout"
- killThread getCharThreadId
- --putStrLn "watchdog killed getCharThread"
- putMVar cmdRef Nothing -- continue main thread
-
- mbCmd <- liftIO $ takeMVar cmdRef
-
- liftIO $ killThread watchDogThreadId
-
- cmd <- case mbCmd of
- Just cmd -> return cmd
- Nothing -> do
- mbCmd2 <- liftIO $ readIORef candRef
- case mbCmd2 of
- Just cmd2 -> return cmd2
- Nothing -> return defCmd
-
- s <- liftIO $ readIORef bufRef
-
- --clearLine
- --putStrLn $ "\x1b[35;1m" ++ (show s) ++ " -> " ++ (show $ cmd s) ++ "\x1b[m"
- return $ cmd s
-
- where
- rec :: Keymap
- -> MVar (Maybe (String -> Command))
- -> IORef (Maybe (String -> Command))
- -> IORef String
- -> IO ()
- rec km cmdRef candRef bufRef = do
- c <- getChar
- -- TODO s <- atomicModifyIORef bufRef $ \s -> let s' = s++[c] in (s,s)
- olds <- readIORef bufRef
- let s = olds ++ [c]
- writeIORef bufRef s
-
- let km' = map (\(str,cmd) -> (tail str, cmd))
- $ filter ((==c) . head . fst) km
-
- -- direct and indirect candidates
- (dc, ic) = partition (null . fst) km'
-
- --clearLine
- --putStrLn $ " s: " ++ show s
- --putStrLn $ "ic: " ++ (show $ map snd ic)
- --putStrLn $ "dc: " ++ (show $ map snd dc)
-
- -- update candidate
- if length dc == 1
- then atomicWriteIORef candRef (Just $ const $ snd $ dc !! 0)
- else atomicWriteIORef candRef Nothing
-
- case length km' of
- 0 -> do
- --return $ defCmd' (s ++ [c])
- cand <- readIORef candRef
- putMVar cmdRef cand
- 1 ->
- let (rest, cmd) = km' !! 0
- in if null rest
- then do
- --return $ cmd
- -- TODO somehow give s?
- putMVar cmdRef (Just $ const cmd)
- else do
- --rec (s ++ [c]) ic defCmd'
- rec ic cmdRef candRef bufRef
- _ -> do
- --rec (s ++ [c]) ic defCmd'
- rec ic cmdRef candRef bufRef
-
-
-
-verbatimKeymap :: VT Command
-verbatimKeymap = do
- c <- liftIO getChar
- return $ InsertString [c] <> ChangeMode InsertMode
+getCommand :: Mode -> String -> Command
+getCommand InsertMode s = maybe (InsertString s) id $ lookup s imap
+getCommand NormalMode s = maybe (AlertBadInput s) id $ lookup s nmap
+getCommand VerbatimMode s = InsertString s <> ChangeMode InsertMode
-- TODO Control.Monad.whenLeft