diff options
| -rw-r--r-- | hack.cabal | 1 | ||||
| -rw-r--r-- | src/Main.hs | 31 |
2 files changed, 32 insertions, 0 deletions
@@ -15,6 +15,7 @@ Executable hack main-is: Main.hs Build-depends: + containers, mtl, old-locale, process, 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 |