yi-keymap-emacs (empty) → 0.13
raw patch · 6 files changed
+941/−0 lines, 6 filesdep +Hclipdep +basedep +containerssetup-changed
Dependencies added: Hclip, base, containers, filepath, microlens-platform, mtl, oo-prototypes, semigroups, text, transformers-base, yi-core, yi-language, yi-misc-modes, yi-rope
Files
- Setup.hs +4/−0
- src/Yi/Config/Default/Emacs.hs +53/−0
- src/Yi/Keymap/Emacs.hs +298/−0
- src/Yi/Keymap/Emacs/KillRing.hs +114/−0
- src/Yi/Keymap/Emacs/Utils.hs +426/−0
- yi-keymap-emacs.cabal +46/−0
+ Setup.hs view
@@ -0,0 +1,4 @@+#!/usr/bin/env runhaskell+import Distribution.Simple+main :: IO ()+main = defaultMain
+ src/Yi/Config/Default/Emacs.hs view
@@ -0,0 +1,53 @@+{-# 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
+ src/Yi/Keymap/Emacs.hs view
@@ -0,0 +1,298 @@+{-# 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+ , mkKeymap+ , defKeymap+ , ModeMap(..)+ , eKeymap+ , completionCaseSensitive+ ) where++import Control.Applicative (Alternative ((<|>), empty, some))+import Lens.Micro.Platform ((.=), makeLenses, (%=))+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 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 (adjBlock, 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 = mkKeymap defKeymap++mkKeymap :: Proto ModeMap -> KeymapSet+mkKeymap = 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 (adjBlock n >> 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' = adjBlock (-1) >> 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' ?>>! (setSelectRegionB =<< regionOfB unitParagraph)+ , 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 >> adjBlock (-1) >> 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 'a' ?>>! alignRegionOn+ , 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+ ]
+ src/Yi/Keymap/Emacs/KillRing.hs view
@@ -0,0 +1,114 @@+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- 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, (%=), (.=))+import Control.Monad (replicateM_, when)+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 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
+ src/Yi/Keymap/Emacs/Utils.hs view
@@ -0,0 +1,426 @@+{-# 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.cabal view
@@ -0,0 +1,46 @@+-- This file has been generated from package.yaml by hpack version 0.14.0.+--+-- see: https://github.com/sol/hpack++name: yi-keymap-emacs+version: 0.13+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 <yi-devel@googlegroups.com>+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+ , semigroups+ , text+ , transformers-base+ , yi-core+ , yi-misc-modes+ , yi-language+ , yi-rope+ 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