diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Main.hs | 31 | 
1 files changed, 31 insertions, 0 deletions
| diff --git a/src/Main.hs b/src/Main.hs index 6cac6fc..4a96cf0 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -18,6 +18,9 @@ import Control.Monad.Reader  import Control.Monad.State  import Control.Monad.Writer +import Data.Map (Map) +import qualified Data.Map as Map +  import Buffer  import Process  import Scanner (scan, runScanner, toChar) @@ -31,8 +34,13 @@ data VTState = VTState      { buffer :: Buffer      , mode :: Mode      , processCount :: Int +    , register :: Char +    , registers :: Map Char String      } +defaultRegister :: Char +defaultRegister = '"' +  main :: IO ()  main = do    hSetEcho stdin False @@ -45,6 +53,8 @@ main = do            { mode = InsertMode            , buffer = ("!while date; do sleep 1; done", "")            , processCount = 0 +          , register = defaultRegister +          , registers = Map.empty            }    lockRef <- newMVar () @@ -138,6 +148,7 @@ data Command    | Combine Command Command    | Nop    | RingBell +  | SetRegister Char  instance Monoid Command where      mempty = Nop @@ -236,6 +247,10 @@ execCommand ExecuteInputBuffer = do      st <- get      case showBuffer (buffer st) of +      ":r" -> do +          tell [ "--- Registers ---" ] +          tell $ map (\(r, s) -> ['"', r] ++ "  " ++ s) -- TODO pp +               $ Map.toList (registers st)        ":s" -> do            s <- liftIO getGCStats            tell [ show s ] @@ -298,6 +313,8 @@ execCommand Nop = return ()  execCommand RingBell = liftIO ringBell +execCommand (SetRegister c) = modify $ \q -> q { register = c } +  reform :: Int -> Char -> String  reform colorCode c = @@ -331,6 +348,7 @@ renderInputLine m (lhs, rhs) = do                          NormalMode -> "\x1b[33;1m@\x1b[m "                          InsertMode -> "> "                          VerbatimMode -> "\x1b[34;1m^\x1b[m " +                        SelectRegisterMode -> "\" "      putStr $ promptString ++ (lhs >>= reform') ++ (rhs >>= reform')      moveCursorLeft (length $ rhs >>= reformVis) @@ -391,6 +409,13 @@ charToCode :: Char -> String  charToCode c = "\\x" ++ showIntAtBase 16 intToDigit (ord c) "" +selectRegisterMap :: Keymap +selectRegisterMap = +  [ ("\x1b", ChangeMode NormalMode) +  ] +  ++ (map (\c -> ([c], SetRegister c <> ChangeMode NormalMode)) +          (['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ ".%#:-\"")) +  nmap :: Keymap  nmap = @@ -404,6 +429,7 @@ nmap =    , ("l", MotionCommand $ GotoRight 1)    , ("b", MotionCommand $ WordsBackward 1)    , ("w", MotionCommand $ WordsForward 1) +  , ("\"", ChangeMode SelectRegisterMode)    , ("\x1b[C", MotionCommand $ GotoRight 1)    , ("\x1b[D", MotionCommand $ GotoLeft 1)    , ("\x0a", ExecuteInputBuffer <> ChangeMode InsertMode) @@ -435,18 +461,23 @@ data Mode    = InsertMode    | NormalMode    | VerbatimMode +  | SelectRegisterMode    deriving (Eq)  instance  Show Mode  where    show NormalMode = "normal"    show InsertMode = "insert"    show VerbatimMode = "verbatim" +  show SelectRegisterMode = "select register"  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 +getCommand SelectRegisterMode s = +    maybe (AlertBadInput s) id $ lookup s selectRegisterMap +          -- ^ TODO clear bad input  -- TODO Control.Monad.whenLeft | 
