add registers

2 files changed, 32 insertions, 0 deletions

diff --git a/hack.cabal b/hack.cabal
index acfcae4..1e9708b 100644
--- a/hack.cabal
+++ b/hack.cabal
@@ -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