summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authortv <tv@shackspace.de>2014-08-01 12:14:02 +0200
committertv <tv@shackspace.de>2014-08-01 12:14:02 +0200
commitf029d6039fdf95200c548c5f3cc2c94447d5d8f2 (patch)
treefe011b91e198db03ff0acbdcb3c485bd9220b2a1
parent627894eacfba83bc820d5605b2a33d59c7c7e969 (diff)
add registers
-rw-r--r--hack.cabal1
-rw-r--r--src/Main.hs31
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