yi-keymap-emacs-0.19.0/0000755000000000000000000000000013755614221012770 5ustar0000000000000000yi-keymap-emacs-0.19.0/Setup.hs0000644000000000000000000000012613755614221014423 0ustar0000000000000000#!/usr/bin/env runhaskell import Distribution.Simple main :: IO () main = defaultMain yi-keymap-emacs-0.19.0/yi-keymap-emacs.cabal0000644000000000000000000000173313755614221016753 0ustar0000000000000000name: yi-keymap-emacs version: 0.19.0 synopsis: Emacs keymap for Yi editor category: Yi homepage: https://github.com/yi-editor/yi#readme bug-reports: https://github.com/yi-editor/yi/issues maintainer: Yi developers license: GPL-2 build-type: Simple cabal-version: >= 1.10 source-repository head type: git location: https://github.com/yi-editor/yi library hs-source-dirs: src ghc-options: -Wall -ferror-spans build-depends: base >= 4.8 && < 5 , containers , filepath , Hclip , microlens-platform , mtl , oo-prototypes , text , transformers-base , yi-core >= 0.19 , yi-misc-modes >= 0.19 , yi-language >= 0.19 , yi-rope >= 0.10 exposed-modules: Yi.Config.Default.Emacs Yi.Keymap.Emacs Yi.Keymap.Emacs.KillRing Yi.Keymap.Emacs.Utils other-modules: Paths_yi_keymap_emacs default-language: Haskell2010 yi-keymap-emacs-0.19.0/src/0000755000000000000000000000000013755614221013557 5ustar0000000000000000yi-keymap-emacs-0.19.0/src/Yi/0000755000000000000000000000000013755614221014140 5ustar0000000000000000yi-keymap-emacs-0.19.0/src/Yi/Keymap/0000755000000000000000000000000013755614221015366 5ustar0000000000000000yi-keymap-emacs-0.19.0/src/Yi/Keymap/Emacs.hs0000644000000000000000000003261213755614221016756 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE LambdaCase #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Keymap.Emacs -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- 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 , mkKeymapSet , defKeymap , ModeMap(..) , eKeymap , completionCaseSensitive ) where import Control.Applicative (Alternative ((<|>), empty, some)) import Control.Monad (replicateM_, unless, void) import Control.Monad.State (gets) import Data.Char (digitToInt, isDigit) import Data.Maybe (fromMaybe) import Data.Prototype (Proto (Proto), extractValue) import Data.Text () import Lens.Micro.Platform ((.=), makeLenses, (%=)) import Yi.Buffer import Yi.Command (shellCommandE) import Yi.Core import Yi.Dired (dired) import Yi.Editor import Yi.File (fwriteE, fwriteToE) import Yi.Keymap (Keymap, KeymapSet, YiAction (..), YiM, modelessKeymapSet, write) import Yi.Keymap.Emacs.KillRing import Yi.Keymap.Emacs.Utils import Yi.Keymap.Keys import Yi.MiniBuffer import Yi.Misc (adjIndent, placeMark, selectAll) import Yi.Mode.Buffers (listBuffers) import Yi.Rectangle import Yi.Search (isearchFinishWithE, resetRegexE, getRegexE) import Yi.TextCompletion (resetComplete, wordComplete') data ModeMap = ModeMap { _eKeymap :: Keymap , _completionCaseSensitive :: Bool } $(makeLenses ''ModeMap) keymap :: KeymapSet keymap = mkKeymapSet defKeymap mkKeymapSet :: Proto ModeMap -> KeymapSet mkKeymapSet = modelessKeymapSet . _eKeymap . extractValue defKeymap :: Proto ModeMap defKeymap = Proto template where template self = ModeMap { _eKeymap = emacsKeymap , _completionCaseSensitive = False } where emacsKeymap :: Keymap emacsKeymap = selfInsertKeymap Nothing isDigit <|> completionKm (_completionCaseSensitive self) <|> do univArg <- readUniversalArg selfInsertKeymap univArg (not . isDigit) <|> emacsKeys univArg selfInsertKeymap :: Maybe Int -> (Char -> Bool) -> Keymap selfInsertKeymap univArg condition = do c <- printableChar unless (condition c) empty let n = argToInt univArg write (replicateM_ n (insertB c)) completionKm :: Bool -> Keymap completionKm caseSensitive = do void $ some (meta (char '/') ?>>! wordComplete' caseSensitive) deprioritize write resetComplete -- 'adjustPriority' is there to lift the ambiguity between "continuing" completion -- and resetting it (restarting at the 1st completion). deleteB' :: BufferM () deleteB' = deleteN 1 -- | Wrapper around 'moveE' which also cancels incremental search. See -- issue #499 for details. moveE :: TextUnit -> Direction -> EditorM () moveE u d = do getRegexE >>= \case -- let's check whether searching is in progress (issues #738, #610) Nothing -> return () _ -> isearchFinishWithE resetRegexE withCurrentBuffer (moveB u d) 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 newlineB , spec KDel ?>>! deleteRegionOr deleteForward , spec KBS ?>>! deleteRegionOr deleteBack , spec KHome ?>>! repeatingArg moveToSol , spec KEnd ?>>! repeatingArg moveToEol , spec KLeft ?>>! repeatingArg $ moveE Character Backward , spec KRight ?>>! repeatingArg $ moveE Character Forward , spec KUp ?>>! repeatingArg $ moveE VLine Backward , spec KDown ?>>! repeatingArg $ moveE 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 $ moveE Character Backward , ctrlCh 'd' ?>>! deleteForward , ctrlCh 'e' ?>>! repeatingArg (maybeMoveB Line Forward) , ctrlCh 'f' ?>>! repeatingArg $ moveE Character Forward , ctrlCh 'g' ?>>! setVisibleSelection False , ctrlCh 'h' ?>> char 'b' ?>>! acceptedInputsOtherWindow , ctrlCh 'i' ?>>! adjIndent IncreaseOnly , ctrlCh 'j' ?>>! newlineAndIndentB , ctrlCh 'k' ?>>! killLine univArg , ctrlCh 'l' ?>>! (withCurrentBuffer scrollToCursorB >> userForceRefresh) , ctrlCh 'm' ?>>! repeatingArg (insertB '\n') , ctrlCh 'n' ?>>! repeatingArg (moveE VLine Forward) , ctrlCh 'o' ?>>! repeatingArg (insertB '\n' >> leftB) , ctrlCh 'p' ?>>! repeatingArg (moveE 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' ?>>! yank , ctrlCh 'z' ?>>! suspendEditor , ctrlCh '+' ?>>! repeatingArg (increaseFontSize 1) , ctrlCh '-' ?>>! repeatingArg (decreaseFontSize 1) -- All the keybindings of the form "C-M-c" where 'c' is some character , ctrl (metaCh 'w') ?>>! appendNextKillE , ctrl (metaCh ' ') ?>>! layoutManagersNextE , ctrl (metaCh ',') ?>>! layoutManagerNextVariantE , ctrl (metaCh '.') ?>>! layoutManagerPreviousVariantE , ctrl (metaCh 'j') ?>>! nextWinE , ctrl (metaCh 'k') ?>>! prevWinE , ctrl (meta $ spec KEnter) ?>>! swapWinWithFirstE -- All the keybindings of the form "S-C-M-c" where 'c' is some key , shift (ctrl $ metaCh 'j') ?>>! moveWinNextE , shift (ctrl $ metaCh 'k') ?>>! moveWinPrevE , shift (ctrl $ meta $ spec KEnter) ?>>! pushWinToFirstE , Event (KASCII ' ') [MShift,MCtrl,MMeta] ?>>! layoutManagersPreviousE -- All the key-bindings which are preceded by a 'C-x' , ctrlCh 'x' ?>> ctrlX , ctrlCh 'c' ?>> ctrlC -- All The key-bindings of the form M-c where 'c' is some character. , metaCh ' ' ?>>! justOneSep univArg , metaCh 'v' ?>>! scrollUpE univArg , metaCh '!' ?>>! shellCommandE , metaCh '<' ?>>! repeatingArg topB , metaCh '>' ?>>! repeatingArg botB , metaCh '%' ?>>! queryReplaceE , metaCh '^' ?>>! joinLinesE univArg , metaCh ';' ?>>! commentRegion , metaCh 'a' ?>>! repeatingArg (moveE unitSentence Backward) , metaCh 'b' ?>>! repeatingArg prevWordB , metaCh 'c' ?>>! repeatingArg capitaliseWordB , metaCh 'd' ?>>! repeatingArg killWordB , metaCh 'e' ?>>! repeatingArg (moveE unitSentence Forward) , metaCh 'f' ?>>! repeatingArg nextWordB , metaCh 'h' ?>>! repeatingArg (selectNParagraphs 1) , metaCh 'k' ?>>! repeatingArg (deleteB unitSentence Forward) , metaCh 'l' ?>>! repeatingArg lowercaseWordB , metaCh 'm' ?>>! firstNonSpaceB , metaCh 'q' ?>>! withSyntax modePrettify , metaCh 'r' ?>>! repeatingArg moveToMTB , metaCh 'u' ?>>! repeatingArg uppercaseWordB , metaCh 't' ?>>! repeatingArg (transposeB unitWord Forward) , metaCh 'w' ?>>! killRingSave , metaCh 'x' ?>>! executeExtendedCommandE , metaCh 'y' ?>>! yankPopE , metaCh '.' ?>>! promptTag , metaCh '{' ?>>! repeatingArg (prevNParagraphs 1) , metaCh '}' ?>>! repeatingArg (nextNParagraphs 1) , metaCh '=' ?>>! countWordsRegion , metaCh '\\' ?>>! deleteHorizontalSpaceB univArg , metaCh '@' ?>>! repeatingArg markWord -- Other meta key-bindings , meta (spec KBS) ?>>! repeatingArg bkillWordB , metaCh 'g' ?>> optMod meta (char 'g') >>! (gotoLn . fromDoc :: Int ::: LineNumber -> BufferM Int) ] where -- inserting the empty string prevents the deletion from appearing in the killring -- which is a good thing when we are deleting individuals characters. See -- http://code.google.com/p/yi-editor/issues/detail?id=212 blockKillring = insertN "" withUnivArg :: YiAction (m ()) () => (Maybe Int -> m ()) -> YiM () withUnivArg cmd = 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) deleteBack :: YiM () deleteBack = repeatingArg $ blockKillring >> bdeleteB deleteForward :: YiM () deleteForward = repeatingArg $ blockKillring >> deleteB' -- Deletes current region if any, otherwise executes the given -- action. deleteRegionOr :: (Show a, YiAction (m a) a) => m a -> YiM () deleteRegionOr f = do b <- gets currentBuffer r <- withGivenBuffer b getSelectRegionB if regionSize r == 0 then runAction $ makeAction f else withGivenBuffer b $ deleteRegionB r ctrlC = choice [ ctrlCh 'c' ?>>! commentRegion ] rectangleFunctions = choice [ char 'o' ?>>! openRectangle , char 't' ?>>! stringRectangle , char 'k' ?>>! killRectangle , char 'y' ?>>! yankRectangle ] tabFunctions :: Keymap tabFunctions = choice [ optMod ctrl (char 'n') >>! nextTabE , optMod ctrl (char 'p') >>! previousTabE , optMod ctrl (char 't') >>! newTabE , optMod ctrl (char 'e') >>! findFileNewTab , optMod ctrl (char 'd') >>! deleteTabE , charOf id '0' '9' >>=! moveTabE . Just . digitToInt ] -- 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 '0' ?>>! closeWindowEmacs , char '1' ?>>! closeOtherE , char '2' ?>>! splitE , char 'h' ?>>! selectAll , char 's' ?>>! askSaveEditor , ctrlCh 'b' ?>>! listBuffers , ctrlCh 'c' ?>>! askQuitEditor , ctrlCh 'f' ?>>! findFile , ctrlCh 'r' ?>>! findFileReadOnly , ctrlCh 'q' ?>>! ((withCurrentBuffer (readOnlyA %= not)) :: EditorM ()) , ctrlCh 's' ?>>! fwriteE , ctrlCh 'w' ?>>! promptFile "Write file:" (void . fwriteToE) , ctrlCh 'x' ?>>! (exchangePointAndMarkB >> highlightSelectionA .= True) , char 'b' ?>>! switchBufferE , char 'd' ?>>! dired , char 'e' ?>> char 'e' ?>>! evalRegionE , char 'o' ?>>! nextWinE , char 'k' ?>>! killBufferE , char 'r' ?>> rectangleFunctions , char 'u' ?>>! repeatingArg undoB , optMod ctrl (char 't') >> tabFunctions ] yi-keymap-emacs-0.19.0/src/Yi/Keymap/Emacs/0000755000000000000000000000000013755614221016416 5ustar0000000000000000yi-keymap-emacs-0.19.0/src/Yi/Keymap/Emacs/KillRing.hs0000644000000000000000000000735213755614221020474 0ustar0000000000000000{-# OPTIONS_HADDOCK show-extensions #-} {-# language RankNTypes #-} -- | -- Module : Yi.Keymap.Emacs.KillRing -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable module Yi.Keymap.Emacs.KillRing where import Lens.Micro.Platform (use, (%=), (.=), Getting) import Control.Monad (replicateM_, when) import Control.Monad.State.Class (MonadState) import Data.List.NonEmpty (NonEmpty ((:|))) import Data.Maybe (fromMaybe) import Yi.Buffer import Yi.Editor (EditorM, killringA, withCurrentBuffer) import Yi.Keymap (YiM) import Yi.KillRing (Killring (_krContents), krKilled, krPut) import qualified Yi.Rope as R (YiString, fromString, toString) import Yi.Types (withEditor) import Yi.Utils (io) import System.Hclip (getClipboard, setClipboard) uses :: forall a b f s. MonadState s f => Getting a s a -> (a -> b) -> f b uses l f = f <$> use l -- * Killring actions -- | Adds system clipboard's contents on top of the killring if not already there clipboardToKillring :: YiM () clipboardToKillring = do text <- fmap R.fromString $ io getClipboard withEditor $ do text' <- killringGet when (text' /= text) $ killringPut Forward text -- | Adds the top of the killring to the system clipboard killringToClipboard :: YiM () killringToClipboard = do text <- withEditor killringGet io . setClipboard $ R.toString text -- This is like @kill-region-or-backward-word@. killRegionB :: BufferM () killRegionB = getSelectRegionB >>= \r -> if regionStart r == regionEnd r then bkillWordB else deleteRegionB r -- | C-w -- Like `killRegionB`, but with system clipboard synchronization killRegion :: YiM () killRegion = withCurrentBuffer killRegionB >> killringToClipboard -- | Kills current line killLineB :: Maybe Int -> BufferM () killLineB mbr = replicateM_ (fromMaybe 1 mbr) $ do eol <- atEol let tu = if eol then Character else Line deleteRegionB =<< regionOfPartNonEmptyB tu Forward -- | C-k -- | Like `killLineB`, but with system clipboard synchronization killLine :: Maybe Int -> YiM () killLine mbr = withCurrentBuffer (killLineB mbr) >> killringToClipboard killringGet :: EditorM R.YiString killringGet = do text :| _ <- uses killringA _krContents return text killringPut :: Direction -> R.YiString -> EditorM () killringPut dir s = killringA %= krPut dir s -- | Yanks top of killbuffer yankE :: EditorM () yankE = do text :| _ <- uses killringA _krContents withCurrentBuffer $ pointB >>= setSelectionMarkPointB >> insertN text -- | C-y -- Like `yankE`, but with system clipboard synchronization yank :: YiM () yank = clipboardToKillring >> withEditor yankE -- | Saves current selection to killring and then clears it killRingSaveE :: EditorM () killRingSaveE = do (r, text) <- withCurrentBuffer $ do r <- getSelectRegionB text <- readRegionB r highlightSelectionA .= False return (r, text) killringPut (regionDirection r) text -- | M-w -- Like `killRingSaveE`, but with system clipboard synchronization killRingSave :: YiM () killRingSave = withEditor killRingSaveE >> killringToClipboard -- | M-y -- TODO: Handle argument, verify last command was a yank yankPopE :: EditorM () yankPopE = do kr <- use killringA withCurrentBuffer (deleteRegionB =<< getRawestSelectRegionB) killringA .= let x :| xs = _krContents kr in kr { _krContents = case xs of [] -> x :| [] y:ys -> y :| ys ++ [x] } yankE -- | C-M-w appendNextKillE :: EditorM () appendNextKillE = killringA . krKilled .= True yi-keymap-emacs-0.19.0/src/Yi/Keymap/Emacs/Utils.hs0000644000000000000000000003654413755614221020066 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Keymap.Emacs.Utils -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- This module is aimed at being a helper for the Emacs keybindings. -- In particular this should be useful for anyone that has a custom -- keymap derived from or based on the Emacs one. module Yi.Keymap.Emacs.Utils ( UnivArgument , argToInt , askQuitEditor , askSaveEditor , modifiedQuitEditor , withMinibuffer , queryReplaceE , isearchKeymap , cabalConfigureE , cabalBuildE , reloadProjectE , executeExtendedCommandE , evalRegionE , readUniversalArg , scrollDownE , scrollUpE , switchBufferE , killBufferE , insertNextC , findFile , findFileReadOnly , findFileNewTab , promptFile , promptTag , justOneSep , joinLinesE , countWordsRegion ) where import Control.Applicative (Alternative ((<|>), many, some), optional) import Lens.Micro.Platform (use, (.=)) import Control.Monad (filterM, replicateM_, void) import Control.Monad.Base () import Data.List ((\\)) import Data.Maybe (fromMaybe) import Data.Monoid ((<>)) import qualified Data.Text as T (Text, concat, null, pack, singleton, snoc, unpack, unwords) import System.FilePath (takeDirectory, takeFileName, ()) import System.FriendlyPath () import Yi.Buffer import Yi.Command (cabalBuildE, cabalConfigureE, reloadProjectE) import Yi.Core (quitEditor) import Yi.Editor import Yi.Eval (execEditorAction, getAllNamesInScope) import Yi.File (deservesSave, editFile, fwriteBufferE, openingNewFile) import Yi.Keymap (Keymap, KeymapM, YiM, write) import Yi.Keymap.Keys import Yi.MiniBuffer import Yi.Misc (promptFile) import Yi.Monad (gets) import Yi.Rectangle (getRectangle) import Yi.Regex (makeSearchOptsM) import qualified Yi.Rope as R (countNewLines, fromText, length, replicateChar, toText, words) import Yi.Search import Yi.String (showT) import Yi.Tag import Yi.Utils (io) type UnivArgument = Maybe Int ---------------------------- -- | Quits the editor if there are no unmodified buffers -- if there are unmodified buffers then we ask individually for -- each modified buffer whether or not the user wishes to save -- it or not. If we get to the end of this list and there are still -- some modified buffers then we ask again if the user wishes to -- quit, but this is then a simple yes or no. askQuitEditor :: YiM () askQuitEditor = askIndividualSave True =<< getModifiedBuffers askSaveEditor :: YiM () askSaveEditor = askIndividualSave False =<< getModifiedBuffers getModifiedBuffers :: YiM [FBuffer] getModifiedBuffers = filterM deservesSave =<< gets bufferSet -------------------------------------------------- -- Takes in a list of buffers which have been identified -- as modified since their last save. askIndividualSave :: Bool -> [FBuffer] -> YiM () askIndividualSave True [] = modifiedQuitEditor askIndividualSave False [] = return () askIndividualSave hasQuit allBuffers@(firstBuffer : others) = void (withEditor (spawnMinibufferE saveMessage (const askKeymap))) where saveMessage = T.concat [ "do you want to save the buffer: " , bufferName , "? (y/n/", if hasQuit then "q/" else "", "c/!)" ] bufferName = identString firstBuffer askKeymap = choice ([ char 'n' ?>>! noAction , char 'y' ?>>! yesAction , char '!' ?>>! allAction , oneOf [char 'c', ctrl $ char 'g'] >>! closeBufferAndWindowE -- cancel ] ++ [char 'q' ?>>! quitEditor | hasQuit]) yesAction = do void $ fwriteBufferE (bkey firstBuffer) withEditor closeBufferAndWindowE continue noAction = do withEditor closeBufferAndWindowE continue allAction = do mapM_ fwriteBufferE $ fmap bkey allBuffers withEditor closeBufferAndWindowE askIndividualSave hasQuit [] continue = askIndividualSave hasQuit others --------------------------- --------------------------- -- | Quits the editor if there are no unmodified buffers -- if there are then simply confirms with the user that they -- with to quit. modifiedQuitEditor :: YiM () modifiedQuitEditor = do modifiedBuffers <- getModifiedBuffers if null modifiedBuffers then quitEditor else withEditor $ void (spawnMinibufferE modifiedMessage (const askKeymap)) where modifiedMessage = "Modified buffers exist really quit? (y/n)" askKeymap = choice [ char 'n' ?>>! noAction , char 'y' ?>>! quitEditor ] noAction = closeBufferAndWindowE ----------------------------- -- isearch selfSearchKeymap :: Keymap selfSearchKeymap = do Event (KASCII c) [] <- anyEvent write . isearchAddE $ T.singleton c searchKeymap :: Keymap searchKeymap = selfSearchKeymap <|> choice [ -- ("C-g", isearchDelE) -- Only if string is not empty. ctrl (char 'r') ?>>! isearchPrevE , ctrl (char 's') ?>>! isearchNextE , ctrl (char 'w') ?>>! isearchWordE , meta (char 'p') ?>>! isearchHistory 1 , meta (char 'n') ?>>! isearchHistory (-1) , spec KBS ?>>! isearchDelE ] isearchKeymap :: Direction -> Keymap isearchKeymap dir = do write $ isearchInitE dir void $ many searchKeymap choice [ ctrl (char 'g') ?>>! isearchCancelE , oneOf [ctrl (char 'm'), spec KEnter] >>! isearchFinishWithE resetRegexE ] <|| write isearchFinishE ---------------------------- -- query-replace queryReplaceE :: YiM () queryReplaceE = withMinibufferFree "Replace:" $ \replaceWhat -> withMinibufferFree "With:" $ \replaceWith -> do b <- gets currentBuffer win <- use currentWindowA let repStr = R.fromText replaceWith replaceKm = choice [ char 'n' ?>>! qrNext win b re , char '!' ?>>! qrReplaceAll win b re repStr , oneOf [char 'y', char ' '] >>! qrReplaceOne win b re repStr , oneOf [char 'q', ctrl (char 'g')] >>! qrFinish ] -- TODO: Yi.Regex to Text Right re = makeSearchOptsM [] (T.unpack replaceWhat) question = T.unwords [ "Replacing", replaceWhat , "with", replaceWith, " (y,n,q,!):" ] withEditor $ do setRegexE re void $ spawnMinibufferE question (const replaceKm) qrNext win b re executeExtendedCommandE :: YiM () executeExtendedCommandE = withMinibuffer "M-x" scope act where act = execEditorAction . T.unpack scope = const $ map T.pack <$> getAllNamesInScope evalRegionE :: YiM () evalRegionE = do -- FIXME: do something sensible. void $ withCurrentBuffer (getSelectRegionB >>= readRegionB) return () -- * Code for various commands -- This ideally should be put in their own module, -- without a prefix, so M-x ... would be easily implemented -- by looking up that module's contents -- | Insert next character, "raw" insertNextC :: UnivArgument -> KeymapM () insertNextC a = do c <- anyEvent write $ replicateM_ (argToInt a) $ insertB (eventToChar c) -- | Convert the universal argument to a number of repetitions argToInt :: UnivArgument -> Int argToInt = fromMaybe 1 digit :: (Event -> Event) -> KeymapM Char digit f = charOf f '0' '9' -- TODO: replace tt by digit meta tt :: KeymapM Char tt = do Event (KASCII c) _ <- foldr1 (<|>) $ fmap (event . metaCh ) ['0'..'9'] return c -- doing the argument precisely is kind of tedious. -- read: http://www.gnu.org/software/emacs/manual/html_node/Arguments.html -- and: http://www.gnu.org/software/emacs/elisp-manual/html_node/elisp_318.html readUniversalArg :: KeymapM (Maybe Int) readUniversalArg = optional ((ctrlCh 'u' ?>> (read <$> some (digit id) <|> pure 4)) <|> (read <$> some tt)) -- | Finds file and runs specified action on the resulting buffer findFileAndDo :: T.Text -- ^ Prompt -> BufferM a -- ^ Action to run on the resulting buffer -> YiM () findFileAndDo prompt act = promptFile prompt $ \filename -> do printMsg $ "loading " <> filename openingNewFile (T.unpack filename) act -- | Open a file using the minibuffer. We have to set up some stuff to -- allow hints and auto-completion. findFile :: YiM () findFile = findFileAndDo "find file:" $ return () -- | Like 'findFile' but sets the resulting buffer to read-only. findFileReadOnly :: YiM () findFileReadOnly = findFileAndDo "find file (read only):" $ readOnlyA .= True -- | Open a file in a new tab using the minibuffer. findFileNewTab :: YiM () findFileNewTab = promptFile "find file (new tab): " $ \filename -> do withEditor newTabE printMsg $ "loading " <> filename void . editFile $ T.unpack filename scrollDownE :: UnivArgument -> BufferM () scrollDownE a = case a of Nothing -> downScreenB Just n -> scrollB n scrollUpE :: UnivArgument -> BufferM () scrollUpE a = case a of Nothing -> upScreenB Just n -> scrollB (negate n) -- | Prompts the user for a buffer name and switches to the chosen buffer. switchBufferE :: YiM () switchBufferE = promptingForBuffer "switch to buffer:" (withEditor . switchToBufferE) (\o b -> (b \\ o) ++ o) -- | Prompts the user for a buffer name and kills the chosen buffer. -- Prompts about really closing if the buffer is marked as changed -- since last save. killBufferE :: YiM () killBufferE = promptingForBuffer "kill buffer:" k (\o b -> o ++ (b \\ o)) where k :: BufferRef -> YiM () k b = do buf <- withEditor . gets $ findBufferWith b ch <- deservesSave buf let askKeymap = choice [ char 'n' ?>>! closeBufferAndWindowE , char 'y' ?>>! delBuf >> closeBufferAndWindowE , ctrlCh 'g' ?>>! closeBufferAndWindowE ] delBuf = deleteBuffer b question = identString buf <> " changed, close anyway? (y/n)" withEditor $ if ch then void $ spawnMinibufferE question (const askKeymap) else delBuf -- | If on separators (space, tab, unicode seps), reduce multiple -- separators to just a single separator (or however many given -- through 'UnivArgument'). -- -- If we aren't looking at a separator, insert a single space. This is -- like emacs ‘just-one-space’ but doesn't deal with negative argument -- case but works with other separators than just space. What counts -- as a separator is decided by 'isAnySep' modulo @\n@ character. -- -- Further, it will only reduce a single type of separator at once: if -- we have hard tabs followed by spaces, we are able to reduce one and -- not the other. justOneSep :: UnivArgument -> BufferM () justOneSep u = readB >>= \c -> pointB >>= \point -> case point of Point 0 -> if isSep c then deleteSeparators else insertMult c Point x -> if isSep c then deleteSeparators else readAtB (Point $ x - 1) >>= \d -> -- We weren't looking at separator but there might be one behind us if isSep d then moveB Character Backward >> deleteSeparators else insertMult ' ' -- no separators, insert a space just -- like emacs does where isSep c = c /= '\n' && isAnySep c insertMult c = insertN $ R.replicateChar (maybe 1 (max 1) u) c deleteSeparators = do genMaybeMoveB unitSepThisLine (Backward, InsideBound) Backward moveB Character Forward doIfCharB isSep $ deleteB unitSepThisLine Forward -- | Join this line to previous (or next N if universal) joinLinesE :: UnivArgument -> BufferM () joinLinesE Nothing = return () joinLinesE (Just _) = do moveB VLine Forward moveToSol >> transformB (const " ") Character Backward >> justOneSep Nothing -- | Shortcut to use a default list when a blank list is given. -- Used for default values to emacs queries maybeList :: [a] -> [a] -> [a] maybeList def [] = def maybeList _ ls = ls maybeTag :: Tag -> T.Text -> Tag maybeTag def t = if T.null t then def else Tag t -------------------------------------------------- -- TAGS - See Yi.Tag for more info -- | Prompt the user to give a tag and then jump to that tag promptTag :: YiM () promptTag = do -- default tag is where the buffer is on defaultTag <- withCurrentBuffer $ Tag . R.toText <$> readUnitB unitWord -- if we have tags use them to generate hints tagTable <- withEditor getTags -- Hints are expensive - only lazily generate 10 let hinter = return . take 10 . maybe (fail . T.unpack) hintTags tagTable -- Completions are super-cheap. Go wild let completer = return . maybe id completeTag tagTable p = "Find tag: (default " <> _unTag defaultTag `T.snoc` ')' withMinibufferGen "" hinter p completer (const $ return ()) $ -- if the string is "" use the defaultTag gotoTag . maybeTag defaultTag -- | Opens the file that contains @tag@. Uses the global tag table and prompts -- the user to open one if it does not exist gotoTag :: Tag -> YiM () gotoTag tag = visitTagTable $ \tagTable -> case lookupTag tag tagTable of [] -> printMsg $ "No tags containing " <> _unTag tag (filename, line):_ -> openingNewFile filename $ gotoLn line -- | Call continuation @act@ with the TagTable. Uses the global table -- and prompts the user if it doesn't exist visitTagTable :: (TagTable -> YiM ()) -> YiM () visitTagTable act = do posTagTable <- withEditor getTags -- does the tagtable exist? case posTagTable of Just tagTable -> act tagTable Nothing -> promptFile "Visit tags table: (default tags)" $ \path -> do -- default emacs behavior, append tags let p = T.unpack path filename = maybeList "tags" $ takeFileName p tagTable <- io $ importTagTable $ takeDirectory p filename withEditor $ setTags tagTable act tagTable -- TODO: use TextUnit to count things inside region for better experience -- | Counts the number of lines, words and characters inside selected -- region. Coresponds to emacs' @count-words-region@. countWordsRegion :: YiM () countWordsRegion = do (l, w, c) <- withEditor $ do t <- withCurrentBuffer $ getRectangle >>= \(reg, _, _) -> readRegionB reg let nls = R.countNewLines t return (if nls == 0 then 1 else nls, length $ R.words t, R.length t) printMsg $ T.unwords [ "Region has", showT l, p l "line" <> "," , showT w, p w "word" <> ", and" , showT c, p w "character" <> "." ] where p x w = if x == 1 then w else w <> "s" yi-keymap-emacs-0.19.0/src/Yi/Config/0000755000000000000000000000000013755614221015345 5ustar0000000000000000yi-keymap-emacs-0.19.0/src/Yi/Config/Default/0000755000000000000000000000000013755614221016731 5ustar0000000000000000yi-keymap-emacs-0.19.0/src/Yi/Config/Default/Emacs.hs0000644000000000000000000000406013755614221020315 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Yi.Config.Default.Emacs (configureEmacs) where import Lens.Micro.Platform ((%=), (.=), (.~)) import Yi.Buffer.Misc (identA, directoryContentA) import Yi.Config.Misc (ScrollStyle (..)) import Yi.Editor (buffersA, newBufferE) import Yi.Event (Modifier (..), Key (..), Event (..)) import Yi.Interact (mkAutomaton, anyEvent, write, (||>), event, P) import Yi.Keymap (makeAction) import Yi.Keymap.Emacs (keymap) import Yi.Keymap.Keys (printableChar, spec) import Yi.Config.Lens import Yi.Config.Simple (ConfigM) import qualified Yi.Rope as R import Yi.Types import Control.Monad (forever, unless, void) import qualified Data.Map as M import Lens.Micro.Platform (use, (^.)) configureEmacs :: ConfigM () configureEmacs = do configUIA %= (configScrollStyleA .~ Just SnapToCenter) defaultKmA .= keymap startActionsA %= (makeAction openScratchBuffer :) configInputPreprocessA .= escToMeta configKillringAccumulateA .= True -- | Input preprocessor: Transform Esc;Char into Meta-Char -- Useful for emacs lovers ;) escToMeta :: P Event Event escToMeta = mkAutomaton $ forever $ (anyEvent >>= write) ||> do _ <- event (spec KEsc) c <- printableChar write (Event (KASCII c) [MMeta]) -- | Open an emacs-like scratch buffer if no file is open. openScratchBuffer :: YiM () openScratchBuffer = withEditor $ do fileBufOpen <- any isFileOrDir . M.elems <$> use buffersA unless fileBufOpen $ void . newBufferE (MemBuffer "scratch") $ R.unlines [ "This buffer is for notes you don't want to save." , "If you want to create a file, open that file," , "then enter the text in that file's own buffer." , "" ] where isFileOrDir :: FBuffer -> Bool isFileOrDir attrs = case attrs ^. identA of MemBuffer _ -> attrs ^. directoryContentA FileBuffer _ -> True