-- Copyright (c) 2004, 2008 Don Stewart - http://www.cse.unsw.edu.au/~dons -- | An emulation of the Nano editor module Yi.Keymap.Nano ( keymap ) where import Yi.Yi import Yi.Keymap.Emacs.KillRing import Data.Char ( chr, isAlphaNum, toLower ) import Control.Arrow import Control.Exception ( ioErrors, try, evaluate ) import Control.Monad ( when ) import Control.Monad.Trans ( lift ) -- | Top level function. A function of this type is used by the editor -- main loop to interpret actions. The second argument to @execLexer@ is -- our default state. keymap :: Keymap keymap = comap eventToChar nano_km -- | @NanoMode@ is the type of our interactive process. type NanoMode = Interact Char () -- | Helper function: match any char in the input string. anyChar :: String -> Interact Char Char anyChar cs = satisfy (`elem` cs) -- | The default mode is /cmd/ mode. Our other mode is the echo buffer -- mode. In cmd mode you can insert chars, run commands and switch to -- the echo buffer mode. -- nano_km :: NanoMode nano_km = choice [cmdChar, cmdSwitch, searchChar, insChar] -- -- Here's where we write a bunch of lexer fragments, corresponding to -- the different behaviours of the editor: char insertion, cmd actions, -- cmd line buffer editing, etc. -- -- -- | Normal chars just insert themselves -- insChar :: NanoMode insChar = do c <- anyChar ('\n' : map chr [32 .. 126]) write $ insertN c -- -- | Command chars run actions. -- cmdChar :: NanoMode cmdChar = choice [event c >> act | (c,act) <- cmdCharFM] -- -- A key\/action table. This is where we actually map command (^) chars -- to actions. -- cmdCharFM :: [(Char, NanoMode)] cmdCharFM = [ -- ('\127', write $ bdeleteB1), -- ? ('\188', write prevBufW) -- 'M-<' ? ,('\190', write nextBufW) -- 'M->' ? ,('\^A', write moveToSol) ,('\^B', write leftB) ,('\^D', write deleteN 1) ,('\^E', write moveToEol) ,('\^F', write rightB) ,('\^H', write $ leftB >> deleteN 1) ,('\^K', write $ killLineE) ,('\^L', write refreshEditor) ,('\^M', write $ insertN '\n') ,('\^N', write (execB Move VLine Forward)) ,('\^P', write (execB Move VLine Backward)) ,('\^U', write undoB) ,('\^V', write downScreenB) ,('\^X', do write $ do b <- isUnchangedB ; if b then quitEditor else return () switch2WriteMode) -- TODO: separate this ,('\^Y', write upScreenB) ,('\^Z', write suspendEditor) ,('\0', write $ do moveWhileE (isAlphaNum) GoRight moveWhileE (not . isAlphaNum) GoRight ) ,(keyBackspace, write $ leftB >> deleteN 1) ,(keyDown, write (execB Move VLine Backward)) ,(keyLeft, write leftB) ,(keyRight, write rightB) ,(keyUp, write (execB Move VLine Backward)) ,('\^G', write $ msgEditor "nano-yi : yi emulating nano") ,('\^I', write (do bufInfo <- bufInfoB let s = bufInfoFileName bufInfo ln = bufInfoLineNo bufInfo col = bufInfoColNo bufInfo pt = bufInfoCharNo bufInfo pct = bufInfoPercent bufInfo msgEditor $ "[ line "++show ln++", col "++show col++ ", char "++show pt++"/"++show s++" ("++pct++") ]")) ] where -- -- | print a message and switch to sub-mode lexer for Y\/N questions -- switch2WriteMode = do write $ msgEditor "Save modified buffer (ANSWERING \"No\" WILL DESTROY CHANGES) ? " c <- anyChar "ynYN" when (toLower c == 'y') $ write fwriteE write quitEditor -- -- | Switching to the command buffer -- -- help-mode in nano to be a separate mode too. There are probably -- others. -- -- We see a \^R, we need to print a prompt, and switch to -- the new mode, which will accumulate filename characters until nl. -- Once the user presses Enter, in the @echo_km@ mode, we are -- able to evaluate the action char represents (e.g. writing a file). -- -- Since we're going to edit the command buffer, which is still a -- slighly buffer magic (unfortunately) we need to explicitly switch -- focus. -- cmdSwitch :: NanoMode cmdSwitch = choice [event c >> echoMode prompt (\s -> anyChar "\n\r" >> write (act s)) | (c,act,prompt) <- echoCharFM] -- -- | Nano search behaviour. -- searchChar :: NanoMode searchChar = do event '\^W' write $ do mre <- getRegexE let prompt = case mre of -- create a prompt Nothing -> "Search: " Just (pat,_) -> "Search ["++pat++"]: " msgEditor prompt -- FIXME: the prompt currently cannot be passed to the echoMode, this prompt will get overwritten. -- The fix is NOT to use MetaM!!! -- The fix is to stop using getRegexE to remember the last thing searched. echoMode "Search: " search_km return () -- -- When searching, a few extra key bindings become available, which -- immediately interrupt the echo mode, perform an action, and then drop -- back to normal mode. -- -- ^G Get Help ^Y First Line ^R Replace M-C Case Sens M-R Regexp -- ^C Cancel ^V Last Line ^T Go To Line M-B Direction Up History -- -- We augment the echo keymap with the following bindings, by passing -- them in the @OnlyMode@ field of the lexer state. The echo keymap the -- knows how to add in these extra bindings. -- search_km :: String -> NanoMode search_km p = choice [srch_g, srch_y, srch_v, srch_t, srch_c, srch_r, performSearch] where -- TODO: use the same style as other modes (list of Char, String -> Action) srch_g = event '\^G' >> write (msgEditor "nano-yi : yi emulating nano") srch_y = event '\^Y' >> write (gotoLn 0 >> moveToSol) srch_v = event '\^V' >> write (do bufInfo <- bufInfoB let x = bufInfoLineNo bufInfo gotoLn x >> moveToSol) srch_t = event '\^T' >> write (msgEditor "unimplemented") -- goto line srch_c = event '\^C' >> write (msgEditor "[ Search Cancelled ]") srch_r = event '\^R' >> write (msgEditor "unimplemented") performSearch = event '\n' >> write (case p of [] -> doSearch Nothing [] GoRight _ -> doSearch (Just p) [] GoRight) -- M-C -- M-R -- M-B -- Up ------------------------------------------------------------------------ -- -- echo buffer mode -- -- | A simple line editor. -- @echoMode prompt exitProcess@ runs the line editor; @prompt@ will -- be displayed as prompt, @exitProcess@ is a process that will be -- used to exit the line-editor sub-process if it succeeds on input -- typed during edition. echoMode :: String -> (String -> Interact Char a) -> Interact Char a echoMode prompt exitProcess = do write (logPutStrLn "echoMode") result <- lineEdit [] return result where lineEdit s = do write $ msgEditor (prompt ++ s) (exitProcess s +++ (anyChar deleteChars >> lineEdit (take (length s - 1) s)) +++ (do c <- anyChar ('\n' : map chr [32 .. 126]); lineEdit (s++[c]))) -- | Actions that mess with the echo (or command) buffer. Notice how -- these actions take a @String@ as an argument, and the second -- component of the elem of the fm is a string that is used as a -- prompt. echoCharFM :: [(Char, String -> Action, String)] echoCharFM = [('\^O', \f -> if f == [] then return () else catchJustE ioErrors (do fwriteToE f ; msgEditor "Wrote current file.") (msgEditor . show) ,"File Name to Write: ") ,('\^_', \s -> do e <- lift $ try $ evaluate $ read s case e of Left _ -> errorEditor "[ Come on, be reasonable ]" Right ln -> gotoLn ln >> moveToSol >> msgClr ,"Enter line number: ") ] -- --------------------------------------------------------------------- -- utilities -- undef :: Char -> Action -- undef c = errorEditor $ "Not implemented: " ++ show c deleteChars :: [Char] deleteChars = ['\BS', '\127', keyBackspace]