-- Copyright (c) 2005,2007,2008 Jean-Philippe Bernardy -- | This module aims at a mode that should be (mostly) intuitive to -- emacs users, but mapping things into the Yi world when -- convenient. Hence, do not go into the trouble of trying 100% -- emulation. For example, M-x gives access to Yi (Haskell) functions, -- with their native names. module Yi.Keymap.Emacs (keymap) where import Yi.Core import Yi.Dired import Yi.File import Yi.Misc import Yi.Rectangle import Yi.TextCompletion import Yi.Keymap.Emacs.KillRing import Yi.Keymap.Emacs.Utils ( askQuitEditor , evalRegionE , executeExtendedCommandE , findFile , insertNextC , isearchKeymap , killBufferE , queryReplaceE , readUniversalArg , scrollDownE , scrollUpE , cabalConfigureE , switchBufferE , withMinibuffer , askSaveEditor , argToInt ) import Data.Maybe import Data.Char import Control.Monad import Control.Applicative keymap :: Keymap keymap = selfInsertKeymap Nothing isDigit <|> completionKm <|> do univArg <- readUniversalArg selfInsertKeymap univArg (not . isDigit) <|> emacsKeys univArg selfInsertKeymap :: Maybe Int -> (Char -> Bool) -> Keymap selfInsertKeymap univArg except = do c <- printableChar when (not . except $ c) empty let n = argToInt univArg write (adjBlock n >> replicateM_ n (insertB c)) completionKm :: Keymap completionKm = do some ((meta (char '/') ?>>! wordComplete)) deprioritize write resetComplete -- 'adjustPriority' is there to lift the ambiguity between "continuing" completion -- and resetting it (restarting at the 1st completion). placeMark :: BufferM () placeMark = do setA highlightSelectionA True pointB >>= setSelectionMarkPointB deleteB' :: BufferM () deleteB' = adjBlock (-1) >> deleteN 1 emacsKeys :: Maybe Int -> Keymap emacsKeys univArg = choice [ -- First all the special key bindings spec KTab ?>>! (adjIndent IncreaseCycle) , (shift $ spec KTab) ?>>! (adjIndent DecreaseCycle) , spec KEnter ?>>! (repeatingArg $ insertB '\n') , spec KDel ?>>! (repeatingArg deleteB') , spec KBS ?>>! (repeatingArg (adjBlock (-1) >> bdeleteB)) , spec KHome ?>>! (repeatingArg moveToSol) , spec KEnd ?>>! (repeatingArg moveToEol) , spec KLeft ?>>! (repeatingArg leftB) , spec KRight ?>>! (repeatingArg rightB) , spec KUp ?>>! (repeatingArg $ moveB VLine Backward) , spec KDown ?>>! (repeatingArg $ moveB VLine Forward) , spec KPageDown ?>>! (repeatingArg downScreenB) , spec KPageUp ?>>! (repeatingArg upScreenB) , shift (spec KUp) ?>>! (repeatingArg (scrollB (-1))) , shift (spec KDown) ?>>! (repeatingArg (scrollB 1)) -- All the keybindings of the form 'Ctrl + special key' , (ctrl $ spec KLeft) ?>>! (repeatingArg prevWordB) , (ctrl $ spec KRight) ?>>! (repeatingArg nextWordB) , (ctrl $ spec KHome) ?>>! (repeatingArg topB) , (ctrl $ spec KEnd) ?>>! (repeatingArg botB) , (ctrl $ spec KUp) ?>>! (repeatingArg $ prevNParagraphs 1) , (ctrl $ spec KDown) ?>>! (repeatingArg $ nextNParagraphs 1) -- All the keybindings of the form "C-c" where 'c' is some character , ctrlCh '@' ?>>! placeMark , ctrlCh ' ' ?>>! placeMark , ctrlCh '/' ?>>! repeatingArg undoB , ctrlCh '_' ?>>! repeatingArg undoB , ctrlCh 'a' ?>>! (repeatingArg (maybeMoveB Line Backward)) , ctrlCh 'b' ?>>! (repeatingArg leftB) , ctrlCh 'd' ?>>! (repeatingArg deleteB') , ctrlCh 'e' ?>>! (repeatingArg (maybeMoveB Line Forward)) , ctrlCh 'f' ?>>! (repeatingArg rightB) , ctrlCh 'g' ?>>! (setVisibleSelection False) , ctrlCh 'i' ?>>! (adjIndent IncreaseOnly) , ctrlCh 'j' ?>>! (repeatingArg $ insertB '\n') , ctrlCh 'k' ?>>! killLineE univArg , ctrlCh 'l' ?>>! userForceRefresh , ctrlCh 'm' ?>>! (repeatingArg $ insertB '\n') , ctrlCh 'n' ?>>! (repeatingArg $ moveB VLine Forward) , ctrlCh 'o' ?>>! (repeatingArg (insertB '\n' >> leftB)) , ctrlCh 'p' ?>>! (repeatingArg $ moveB VLine Backward) , ctrlCh 'q' ?>> insertNextC univArg , ctrlCh 'r' ?>> (isearchKeymap Backward) , ctrlCh 's' ?>> (isearchKeymap Forward) , ctrlCh 't' ?>>! (repeatingArg $ swapB) , ctrlCh 'v' ?>>! scrollDownE univArg , ctrlCh 'w' ?>>! killRegion , ctrlCh 'y' ?>>! yankE , ctrlCh 'z' ?>>! suspendEditor -- All the keybindings of the form "C-M-c" where 'c' is some character , ( ctrl $ metaCh 'w') ?>>! appendNextKillE -- All the key-bindings which are preceded by a 'C-x' , ctrlCh 'x' ?>> ctrlX -- All The key-bindings of the form M-c where 'c' is some character. , metaCh 'v' ?>>! scrollUpE univArg , metaCh '!' ?>>! shellCommandE , metaCh 'p' ?>>! cabalConfigureE , metaCh '<' ?>>! (repeatingArg topB) , metaCh '>' ?>>! (repeatingArg botB) , metaCh '%' ?>>! queryReplaceE , metaCh 'a' ?>>! (repeatingArg $ moveB unitSentence Backward) , metaCh 'b' ?>>! (repeatingArg prevWordB) , metaCh 'c' ?>>! (repeatingArg capitaliseWordB) , metaCh 'd' ?>>! (repeatingArg killWordB) , metaCh 'e' ?>>! (repeatingArg $ moveB unitSentence Forward) , metaCh 'f' ?>>! (repeatingArg nextWordB) , metaCh 'h' ?>>! (setSelectRegionB =<< regionOfB unitParagraph) , metaCh 'k' ?>>! (repeatingArg $ deleteB unitSentence Forward) , metaCh 'l' ?>>! (repeatingArg lowercaseWordB) , metaCh 'q' ?>>! (withSyntax modePrettify) , metaCh 'u' ?>>! (repeatingArg uppercaseWordB) , metaCh 't' ?>>! (repeatingArg $ transposeB Word Forward) , metaCh 'w' ?>>! killRingSaveE , metaCh 'x' ?>>! executeExtendedCommandE , metaCh 'y' ?>>! yankPopE -- Other meta key-bindings , meta (spec KBS) ?>>! (repeatingArg bkillWordB) , metaCh 'g' ?>> char 'g' ?>>! gotoLn ] where withUnivArg :: YiAction (m ()) () => (Maybe Int -> m ()) -> YiM () withUnivArg cmd = do runAction $ makeAction (cmd univArg) repeatingArg :: (Monad m, YiAction (m ()) ()) => m () -> YiM () repeatingArg f = withIntArg $ \n -> replicateM_ n f withIntArg :: YiAction (m ()) () => (Int -> m ()) -> YiM () withIntArg cmd = withUnivArg $ \arg -> cmd (fromMaybe 1 arg) rectangleFuntions = choice [char 'o' ?>>! openRectangle, char 't' ?>>! stringRectangle, char 'k' ?>>! killRectangle, char 'y' ?>>! yankRectangle ] -- These keybindings are all preceded by a 'C-x' so for example to -- quit the editor we do a 'C-x C-c' ctrlX = choice [ ctrlCh 'o' ?>>! deleteBlankLinesB , char '^' ?>>! (repeatingArg enlargeWinE) , char '0' ?>>! closeWindow , char '1' ?>>! closeOtherE , char '2' ?>>! splitE , char 's' ?>>! askSaveEditor , ctrlCh 'c' ?>>! askQuitEditor , ctrlCh 'f' ?>>! findFile , ctrlCh 's' ?>>! fwriteE , ctrlCh 'w' ?>>! (withMinibuffer "Write file:" (matchingFileNames Nothing) fwriteToE ) , ctrlCh 'x' ?>>! (exchangePointAndMarkB >> setA highlightSelectionA True) , char 'b' ?>>! switchBufferE , char 'd' ?>>! dired , char 'e' ?>> char 'e' ?>>! evalRegionE , char 'o' ?>>! nextWinE , char 'k' ?>>! killBufferE , char 'r' ?>> rectangleFuntions , char 'u' ?>>! (repeatingArg undoB) , char 'v' ?>>! (repeatingArg shrinkWinE) ]