yi-keymap-vim (empty) → 0.13
raw patch · 60 files changed
+6033/−0 lines, 60 filesdep +Hclipdep +QuickCheckdep +attoparsecsetup-changed
Dependencies added: Hclip, QuickCheck, attoparsec, base, binary, containers, data-default, directory, filepath, microlens-platform, mtl, oo-prototypes, pointedlist, safe, semigroups, tasty, tasty-hunit, tasty-quickcheck, text, transformers-base, unordered-containers, yi-core, yi-keymap-vim, yi-language, yi-rope
Files
- Setup.hs +4/−0
- src/Yi/Config/Default/Vim.hs +14/−0
- src/Yi/Keymap/Vim.hs +188/−0
- src/Yi/Keymap/Vim/Common.hs +186/−0
- src/Yi/Keymap/Vim/Digraph.hs +69/−0
- src/Yi/Keymap/Vim/Eval.hs +20/−0
- src/Yi/Keymap/Vim/EventUtils.hs +135/−0
- src/Yi/Keymap/Vim/Ex.hs +72/−0
- src/Yi/Keymap/Vim/Ex/Commands/Buffer.hs +73/−0
- src/Yi/Keymap/Vim/Ex/Commands/BufferDelete.hs +29/−0
- src/Yi/Keymap/Vim/Ex/Commands/Buffers.hs +57/−0
- src/Yi/Keymap/Vim/Ex/Commands/Cabal.hs +35/−0
- src/Yi/Keymap/Vim/Ex/Commands/Common.hs +319/−0
- src/Yi/Keymap/Vim/Ex/Commands/Copy.hs +42/−0
- src/Yi/Keymap/Vim/Ex/Commands/Delete.hs +31/−0
- src/Yi/Keymap/Vim/Ex/Commands/Edit.hs +46/−0
- src/Yi/Keymap/Vim/Ex/Commands/Global.hs +60/−0
- src/Yi/Keymap/Vim/Ex/Commands/GotoLine.hs +27/−0
- src/Yi/Keymap/Vim/Ex/Commands/Help.hs +35/−0
- src/Yi/Keymap/Vim/Ex/Commands/Make.hs +27/−0
- src/Yi/Keymap/Vim/Ex/Commands/Nohl.hs +29/−0
- src/Yi/Keymap/Vim/Ex/Commands/Paste.hs +35/−0
- src/Yi/Keymap/Vim/Ex/Commands/Quit.hs +104/−0
- src/Yi/Keymap/Vim/Ex/Commands/Read.hs +54/−0
- src/Yi/Keymap/Vim/Ex/Commands/Reload.hs +25/−0
- src/Yi/Keymap/Vim/Ex/Commands/Shell.hs +30/−0
- src/Yi/Keymap/Vim/Ex/Commands/Sort.hs +41/−0
- src/Yi/Keymap/Vim/Ex/Commands/Stack.hs +68/−0
- src/Yi/Keymap/Vim/Ex/Commands/Substitute.hs +134/−0
- src/Yi/Keymap/Vim/Ex/Commands/Tag.hs +65/−0
- src/Yi/Keymap/Vim/Ex/Commands/Undo.hs +32/−0
- src/Yi/Keymap/Vim/Ex/Commands/Write.hs +56/−0
- src/Yi/Keymap/Vim/Ex/Commands/Yi.hs +31/−0
- src/Yi/Keymap/Vim/Ex/Eval.hs +40/−0
- src/Yi/Keymap/Vim/Ex/Types.hs +34/−0
- src/Yi/Keymap/Vim/ExMap.hs +195/−0
- src/Yi/Keymap/Vim/InsertMap.hs +238/−0
- src/Yi/Keymap/Vim/MatchResult.hs +43/−0
- src/Yi/Keymap/Vim/Motion.hs +225/−0
- src/Yi/Keymap/Vim/NormalMap.hs +521/−0
- src/Yi/Keymap/Vim/NormalOperatorPendingMap.hs +171/−0
- src/Yi/Keymap/Vim/Operator.hs +218/−0
- src/Yi/Keymap/Vim/ReplaceMap.hs +90/−0
- src/Yi/Keymap/Vim/ReplaceSingleCharMap.hs +59/−0
- src/Yi/Keymap/Vim/Search.hs +45/−0
- src/Yi/Keymap/Vim/SearchMotionMap.hs +84/−0
- src/Yi/Keymap/Vim/StateUtils.hs +176/−0
- src/Yi/Keymap/Vim/StyledRegion.hs +77/−0
- src/Yi/Keymap/Vim/Tag.hs +215/−0
- src/Yi/Keymap/Vim/TextObject.hs +67/−0
- src/Yi/Keymap/Vim/Utils.hs +218/−0
- src/Yi/Keymap/Vim/VisualMap.hs +281/−0
- tests/Generic/TestPureBufferManipulations.hs +212/−0
- tests/Generic/TestUtils.hs +99/−0
- tests/TestSuite.hs +16/−0
- tests/Vim/EditorManipulations/BufferExCommand.hs +174/−0
- tests/Vim/TestExCommandParsers.hs +157/−0
- tests/Vim/TestPureBufferManipulations.hs +33/−0
- tests/Vim/TestPureEditorManipulations.hs +31/−0
- yi-keymap-vim.cabal +141/−0
+ Setup.hs view
@@ -0,0 +1,4 @@+#!/usr/bin/env runhaskell+import Distribution.Simple+main :: IO ()+main = defaultMain
+ src/Yi/Config/Default/Vim.hs view
@@ -0,0 +1,14 @@+module Yi.Config.Default.Vim (configureVim) where++import Lens.Micro.Platform ((.=), (%=), (.~))+import Yi.Buffer.Normal (RegionStyle (..))+import Yi.Keymap.Vim (keymapSet)+import Yi.Config.Misc (ScrollStyle (..))+import Yi.Config.Lens+import Yi.Config.Simple (ConfigM)++configureVim :: ConfigM ()+configureVim = do+ defaultKmA .= keymapSet+ configUIA %= (configScrollStyleA .~ Just SingleLine)+ configRegionStyleA .= Inclusive
+ src/Yi/Keymap/Vim.hs view
@@ -0,0 +1,188 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Keymap.Vim+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable+--+-- The vim keymap.++module Yi.Keymap.Vim+ ( keymapSet+ , mkKeymapSet+ , defVimConfig+ , VimBinding (..)+ , VimOperator (..)+ , VimConfig (..)+ , pureEval+ , impureEval+ , relayoutFromTo+ ) where++import Data.Char (toUpper)+import Data.List (find)+import Data.Monoid ((<>))+import Data.Prototype (Proto (Proto), extractValue)+import Yi.Buffer.Adjusted (commitUpdateTransactionB, startUpdateTransactionB)+import Yi.Editor+import Yi.Event (Event (..), Key (KASCII), Modifier (MCtrl, MMeta))+import Yi.Keymap (Keymap, KeymapM, KeymapSet, YiM, modelessKeymapSet, write)+import Yi.Keymap.Keys (anyEvent)+import Yi.Keymap.Vim.Common+import Yi.Keymap.Vim.Digraph (defDigraphs)+import Yi.Keymap.Vim.EventUtils (eventToEventString, parseEvents)+import Yi.Keymap.Vim.Ex (ExCommand, defExCommandParsers)+import Yi.Keymap.Vim.ExMap (defExMap)+import Yi.Keymap.Vim.InsertMap (defInsertMap)+import Yi.Keymap.Vim.NormalMap (defNormalMap)+import Yi.Keymap.Vim.NormalOperatorPendingMap (defNormalOperatorPendingMap)+import Yi.Keymap.Vim.Operator (VimOperator (..), defOperators)+import Yi.Keymap.Vim.ReplaceMap (defReplaceMap)+import Yi.Keymap.Vim.ReplaceSingleCharMap (defReplaceSingleMap)+import Yi.Keymap.Vim.SearchMotionMap (defSearchMotionMap)+import Yi.Keymap.Vim.StateUtils+import Yi.Keymap.Vim.Utils (selectBinding, selectPureBinding)+import Yi.Keymap.Vim.VisualMap (defVisualMap)++data VimConfig = VimConfig {+ vimKeymap :: Keymap+ , vimBindings :: [VimBinding]+ , vimOperators :: [VimOperator]+ , vimExCommandParsers :: [EventString -> Maybe ExCommand]+ , vimDigraphs :: [(String, Char)]+ , vimRelayout :: Char -> Char+ }++mkKeymapSet :: Proto VimConfig -> KeymapSet+mkKeymapSet = modelessKeymapSet . vimKeymap . extractValue++keymapSet :: KeymapSet+keymapSet = mkKeymapSet defVimConfig++defVimConfig :: Proto VimConfig+defVimConfig = Proto $ \this -> VimConfig {+ vimKeymap = defVimKeymap this+ , vimBindings = concat+ [ defNormalMap (vimOperators this)+ , defNormalOperatorPendingMap (vimOperators this)+ , defExMap (vimExCommandParsers this)+ , defInsertMap (vimDigraphs this)+ , defReplaceSingleMap+ , defReplaceMap+ , defVisualMap (vimOperators this)+ , defSearchMotionMap+ ]+ , vimOperators = defOperators+ , vimExCommandParsers = defExCommandParsers+ , vimDigraphs = defDigraphs+ , vimRelayout = id+ }++defVimKeymap :: VimConfig -> KeymapM ()+defVimKeymap config = do+ e <- anyEvent+ write $ impureHandleEvent config e True++-- This is not in Yi.Keymap.Vim.Eval to avoid circular dependency:+-- eval needs to know about bindings, which contains normal bindings,+-- which contains '.', which needs to eval things+-- So as a workaround '.' just saves a string that needs eval in VimState+-- and the actual evaluation happens in impureHandleEvent+pureEval :: VimConfig -> EventString -> EditorM ()+pureEval config = sequence_ . map (pureHandleEvent config) . parseEvents++impureEval :: VimConfig -> EventString -> Bool -> YiM ()+impureEval config s needsToConvertEvents = sequence_ actions+ where actions = map (\e -> impureHandleEvent config e needsToConvertEvents) $ parseEvents s++pureHandleEvent :: VimConfig -> Event -> EditorM ()+pureHandleEvent config ev+ = genericHandleEvent allPureBindings selectPureBinding config ev False++impureHandleEvent :: VimConfig -> Event -> Bool -> YiM ()+impureHandleEvent = genericHandleEvent vimBindings selectBinding++genericHandleEvent :: MonadEditor m => (VimConfig -> [VimBinding])+ -> (EventString -> VimState -> [VimBinding]+ -> MatchResult (m RepeatToken))+ -> VimConfig+ -> Event+ -> Bool+ -> m ()+genericHandleEvent getBindings pick config unconvertedEvent needsToConvertEvents = do+ currentState <- withEditor getEditorDyn+ let event = if needsToConvertEvents+ then convertEvent (vsMode currentState) (vimRelayout config) unconvertedEvent+ else unconvertedEvent+ evs = vsBindingAccumulator currentState <> eventToEventString event+ bindingMatch = pick evs currentState (getBindings config)+ prevMode = vsMode currentState++ case bindingMatch of+ NoMatch -> withEditor dropBindingAccumulatorE+ PartialMatch -> withEditor $ do+ accumulateBindingEventE event+ accumulateEventE event+ WholeMatch action -> do+ repeatToken <- action+ withEditor $ do+ dropBindingAccumulatorE+ accumulateEventE event+ case repeatToken of+ Drop -> do+ resetActiveRegisterE+ dropAccumulatorE+ Continue -> return ()+ Finish -> do+ resetActiveRegisterE+ flushAccumulatorE++ withEditor $ do+ newMode <- vsMode <$> getEditorDyn++ -- TODO: we should introduce some hook mechanism like autocommands in vim+ case (prevMode, newMode) of+ (Insert _, Insert _) -> return ()+ (Insert _, _) -> withCurrentBuffer commitUpdateTransactionB+ (_, Insert _) -> withCurrentBuffer startUpdateTransactionB+ _ -> return ()++ performEvalIfNecessary config+ updateModeIndicatorE currentState++performEvalIfNecessary :: VimConfig -> EditorM ()+performEvalIfNecessary config = do+ stateAfterAction <- getEditorDyn++ -- see comment for 'pureEval'+ modifyStateE $ \s -> s { vsStringToEval = mempty }+ pureEval config (vsStringToEval stateAfterAction)++allPureBindings :: VimConfig -> [VimBinding]+allPureBindings config = filter isPure $ vimBindings config+ where isPure (VimBindingE _) = True+ isPure _ = False++convertEvent :: VimMode -> (Char -> Char) -> Event -> Event+convertEvent (Insert _) f (Event (KASCII c) mods)+ | MCtrl `elem` mods || MMeta `elem` mods = Event (KASCII (f c)) mods+convertEvent Ex _ e = e+convertEvent (Insert _) _ e = e+convertEvent InsertNormal _ e = e+convertEvent InsertVisual _ e = e+convertEvent Replace _ e = e+convertEvent ReplaceSingleChar _ e = e+convertEvent (Search _ _) _ e = e+convertEvent _ f (Event (KASCII c) mods) = Event (KASCII (f c)) mods+convertEvent _ _ e = e++relayoutFromTo :: String -> String -> (Char -> Char)+relayoutFromTo keysFrom keysTo = \c ->+ maybe c fst (find ((== c) . snd)+ (zip (keysTo ++ fmap toUpper' keysTo)+ (keysFrom ++ fmap toUpper' keysFrom)))+ where toUpper' ';' = ':'+ toUpper' a = toUpper a
+ src/Yi/Keymap/Vim/Common.hs view
@@ -0,0 +1,186 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Keymap.Vim.Common+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable+--+-- Common types used by the vim keymap.++module Yi.Keymap.Vim.Common+ ( VimMode(..)+ , VimBinding(..)+ , GotoCharCommand(..)+ , VimState(..)+ , Register(..)+ , RepeatToken(..)+ , RepeatableAction(..)+ , MatchResult(..)+ , EventString(..), unEv+ , OperatorName(..), unOp+ , RegisterName+ , module Yi.Keymap.Vim.MatchResult+ , lookupBestMatch, matchesString+ ) where++import GHC.Generics (Generic)++import Control.Applicative (Alternative ((<|>)))+import Lens.Micro.Platform (makeLenses)+import Data.Binary (Binary (..))+import Data.Default (Default (..))+import qualified Data.HashMap.Strict as HM (HashMap)+import Data.Monoid ((<>))+import Data.String (IsString (..))+import qualified Data.Text as T (Text, isPrefixOf, pack)+import qualified Data.Text.Encoding as E (decodeUtf8, encodeUtf8)+import Data.Typeable (Typeable)+import Yi.Buffer.Adjusted (Direction, Point, RegionStyle)+import Yi.Editor (EditorM)+import Yi.Keymap (YiM)+import Yi.Keymap.Vim.MatchResult (MatchResult (..))+import Yi.Rope (YiString)+import Yi.Types (YiVariable)+++newtype EventString = Ev { _unEv :: T.Text } deriving (Show, Eq, Ord)++instance IsString EventString where+ fromString = Ev . T.pack++newtype OperatorName = Op { _unOp :: T.Text } deriving (Show, Eq)++instance IsString OperatorName where+ fromString = Op . T.pack++instance Monoid EventString where+ mempty = Ev mempty+ Ev t `mappend` Ev t' = Ev $ t <> t'++instance Monoid OperatorName where+ mempty = Op mempty+ Op t `mappend` Op t' = Op $ t <> t'++instance Binary EventString where+ get = Ev . E.decodeUtf8 <$> get+ put (Ev t) = put $ E.encodeUtf8 t++instance Binary OperatorName where+ get = Op . E.decodeUtf8 <$> get+ put (Op t) = put $ E.encodeUtf8 t++makeLenses ''EventString+makeLenses ''OperatorName++-- 'lookupBestMatch' and 'matchesString' pulled out of MatchResult+-- module to prevent cyclic dependencies. Screw more bootfiles.+lookupBestMatch :: EventString -> [(EventString, a)] -> MatchResult a+lookupBestMatch key = foldl go NoMatch+ where go m (k, x) = m <|> fmap (const x) (key `matchesString` k)++matchesString :: EventString -> EventString -> MatchResult ()+matchesString (Ev got) (Ev expected)+ | expected == got = WholeMatch ()+ | got `T.isPrefixOf` expected = PartialMatch+ | otherwise = NoMatch++type RegisterName = Char+type MacroName = Char++data RepeatableAction = RepeatableAction+ { raPreviousCount :: !Int+ , raActionString :: !EventString+ } deriving (Typeable, Eq, Show, Generic)++data Register = Register+ { regRegionStyle :: RegionStyle+ , regContent :: YiString+ } deriving (Generic)++data VimMode+ = Normal+ | NormalOperatorPending OperatorName+ | Insert Char -- ^ char denotes how state got into insert mode ('i', 'a', etc.)+ | Replace+ | ReplaceSingleChar+ | InsertNormal -- ^ after C-o+ | InsertVisual -- ^ after C-o and one of v, V, C-v+ | Visual RegionStyle+ | Ex+ | Search { previousMode :: VimMode, direction :: Direction }+ deriving (Typeable, Eq, Show, Generic)++data GotoCharCommand = GotoCharCommand !Char !Direction !RegionStyle+ deriving (Generic)++data VimState = VimState+ { vsMode :: !VimMode+ , vsCount :: !(Maybe Int)+ , vsAccumulator :: !EventString -- ^ for repeat and potentially macros+ , vsTextObjectAccumulator :: !EventString+ , vsRegisterMap :: !(HM.HashMap RegisterName Register)+ , vsActiveRegister :: !RegisterName+ , vsRepeatableAction :: !(Maybe RepeatableAction)+ , vsStringToEval :: !EventString -- ^ see Yi.Keymap.Vim.vimEval comment+ , vsOngoingInsertEvents :: !EventString+ , vsLastGotoCharCommand :: !(Maybe GotoCharCommand)+ , vsBindingAccumulator :: !EventString+ , vsSecondaryCursors :: ![Point]+ , vsPaste :: !Bool -- ^ like vim's :help paste+ , vsCurrentMacroRecording :: !(Maybe (MacroName, EventString))+ } deriving (Typeable, Generic)++instance Binary RepeatableAction+instance Binary Register+instance Binary GotoCharCommand++instance Default VimMode where+ def = Normal++instance Binary VimMode++instance Default VimState where+ def = VimState+ Normal -- mode+ Nothing -- count+ mempty -- accumulator+ mempty -- textobject accumulator+ mempty -- register map+ '\0' -- active register+ Nothing -- repeatable action+ mempty -- string to eval+ mempty -- ongoing insert events+ Nothing -- last goto char command+ mempty -- binding accumulator+ mempty -- secondary cursors+ False -- :set paste+ Nothing -- current macro recording++instance Binary VimState++instance YiVariable VimState++-- Whether an action can be repeated through the use of the '.' key.+--+-- Actions with a RepeatToken of:+--+-- - Finish are repeatable.+-- - Drop are not repeatable.+-- - Continue are currently in progress. They will become repeatable when+-- completed. It is possible to cancel a in progress action, in which case+-- it will not be repeatable.+data RepeatToken = Finish+ | Drop+ | Continue+ deriving Show++-- Distinction between YiM and EditorM variants is for testing.+data VimBinding+ = VimBindingY (EventString -> VimState -> MatchResult (YiM RepeatToken))+ | VimBindingE (EventString -> VimState -> MatchResult (EditorM RepeatToken))
+ src/Yi/Keymap/Vim/Digraph.hs view
@@ -0,0 +1,69 @@+module Yi.Keymap.Vim.Digraph+ ( charFromDigraph+ , defDigraphs+ ) where++import Control.Applicative (Alternative ((<|>)))++charFromDigraph :: [(String, Char)] -> Char -> Char -> Maybe Char+charFromDigraph digraphTable c1 c2 =+ lookup [c1, c2] digraphTable <|> lookup [c2, c1] digraphTable++defDigraphs :: [(String, Char)]+defDigraphs =+ [ ("ae", 'æ')+ , ("a'", 'á')+ , ("e'", 'é')+ , ("e`", 'è')+ , ("o\"", 'ő')+ , ("o:", 'ö')+ , ("a:", 'ä')+ , ("e:", 'ë')+ , ("u:", 'ü')+ , ("AE", 'Æ')+ , ("Ae", 'Æ')+ , ("A'", 'Á')+ , ("E'", 'É')+ , ("E`", 'È')+ , ("O\"", 'Ő')+ , ("O:", 'Ö')+ , ("A:", 'Ä')+ , ("E:", 'Ë')+ , ("U:", 'Ü')+ , ("=e", '€')+ , ("Cu", '¤')+ , ("+-", '±')+ , ("-+", '∓')+ , ("^1", '¹')+ , ("^2", '²')+ , ("^3", '³')+ , ("^4", '⁴')+ , ("^5", '⁵')+ , ("^6", '⁶')+ , ("^7", '⁷')+ , ("^8", '⁸')+ , ("^9", '⁹')+ , ("0S", '⁰')+ , ("1S", '¹')+ , ("2S", '²')+ , ("3S", '³')+ , ("4S", '⁴')+ , ("5S", '⁵')+ , ("6S", '⁶')+ , ("7S", '⁷')+ , ("8S", '⁸')+ , ("9S", '⁹')+ , ("0S", '⁰')+ , ("0s", '₀')+ , ("1s", '₁')+ , ("2s", '₂')+ , ("3s", '₃')+ , ("4s", '₄')+ , ("5s", '₅')+ , ("6s", '₆')+ , ("7s", '₇')+ , ("8s", '₈')+ , ("9s", '₉')+ , ("0s", '₀')+ , ("'0", '˚')+ ]
+ src/Yi/Keymap/Vim/Eval.hs view
@@ -0,0 +1,20 @@+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Keymap.Vim.Eval+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable+--+-- This module doesn't contains actual eval, see+-- 'Yi.Keymap.Vim.vimEval' comment.++module Yi.Keymap.Vim.Eval (scheduleActionStringForEval) where++import Yi.Editor (EditorM)+import Yi.Keymap.Vim.Common (EventString, VimState (vsStringToEval))+import Yi.Keymap.Vim.StateUtils (modifyStateE)++scheduleActionStringForEval :: EventString -> EditorM ()+scheduleActionStringForEval s = modifyStateE $ \st -> st { vsStringToEval = s }
+ src/Yi/Keymap/Vim/EventUtils.hs view
@@ -0,0 +1,135 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Keymap.Vim.EventUtils+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable++module Yi.Keymap.Vim.EventUtils+ ( stringToEvent+ , eventToEventString+ , parseEvents+ , stringToRepeatableAction+ , normalizeCount+ , splitCountedCommand+ ) where++import Data.Char (isDigit, toUpper)+import Data.List (foldl')+import qualified Data.Map as M (Map, fromList, lookup)+import Data.Monoid ((<>))+import qualified Data.Text as T (break, cons, null, pack, singleton, snoc, span, unpack)+import Data.Tuple (swap)+import Yi.Event+import Yi.Keymap.Keys (char, ctrl, meta, spec)+import Yi.Keymap.Vim.Common (EventString (Ev), RepeatableAction (RepeatableAction))+import Yi.String (showT)++specMap :: M.Map EventString Key+specMap = M.fromList specList++invSpecMap :: M.Map Key EventString+invSpecMap = M.fromList $ fmap swap specList++specList :: [(EventString, Key)]+specList =+ [ (Ev "Esc", KEsc)+ , (Ev "CR", KEnter)+ , (Ev "BS", KBS)+ , (Ev "Tab", KTab)+ , (Ev "Down", KDown)+ , (Ev "Up", KUp)+ , (Ev "Left", KLeft)+ , (Ev "Right", KRight)+ , (Ev "PageUp", KPageUp)+ , (Ev "PageDown", KPageDown)+ , (Ev "Home", KHome)+ , (Ev "End", KEnd)+ , (Ev "Ins", KIns)+ , (Ev "Del", KDel)+ ]++stringToEvent :: String -> Event+stringToEvent "<" = error "Invalid event string \"<\""+stringToEvent "<C-@>" = (Event (KASCII ' ') [MCtrl])+stringToEvent s@('<':'C':'-':_) = stringToEvent' 3 s ctrl+stringToEvent s@('<':'M':'-':_) = stringToEvent' 3 s meta+stringToEvent s@('<':'a':'-':_) = stringToEvent' 3 s meta+stringToEvent "<lt>" = char '<'+stringToEvent [c] = char c+stringToEvent ('<':'F':d:'>':[]) | isDigit d = spec (KFun $ read [d])+stringToEvent ('<':'F':'1':d:'>':[]) | isDigit d = spec (KFun $ 10 + read [d])+stringToEvent s@('<':_) = stringToEvent' 1 s id+stringToEvent s = error ("Invalid event string " ++ show s)++stringToEvent' :: Int -> String -> (Event -> Event) -> Event+stringToEvent' toDrop inputString modifier =+ let analyzedString = drop toDrop inputString+ in case analyzedString of+ [c,'>'] -> modifier (char c)+ _ -> if last analyzedString /= '>'+ then error ("Invalid event string " ++ show inputString)+ else case M.lookup (Ev . T.pack $ init analyzedString) specMap of+ Just k -> modifier (Event k [])+ Nothing -> error $ "Couldn't convert string " ++ show inputString ++ " to event"++eventToEventString :: Event -> EventString+eventToEventString e = case e of+ Event (KASCII '<') [] -> Ev "<lt>"+ Event (KASCII ' ') [MCtrl] -> Ev "<C-@>"+ Event (KASCII c) [] -> Ev $ T.singleton c+ Event (KASCII c) [MCtrl] -> Ev $ mkMod MCtrl c+ Event (KASCII c) [MMeta] -> Ev $ mkMod MMeta c+ Event (KASCII c) [MShift] -> Ev . T.singleton $ toUpper c+ Event (KFun x) [] -> Ev $ "<F" <> showT x `T.snoc` '>'+ v@(Event k mods) -> case M.lookup k invSpecMap of+ Just (Ev s) -> case mods of+ [] -> Ev $ '<' `T.cons` s `T.snoc` '>'+ [MCtrl] -> Ev $ "<C-" <> s `T.snoc` '>'+ [MMeta] -> Ev $ "<M-" <> s `T.snoc` '>'+ _ -> error $ "Couldn't convert event <" ++ show v+ ++ "> to string, because of unknown modifiers"+ Nothing -> error $ "Couldn't convert event <" ++ show v ++ "> to string"++ where+ f MCtrl = 'C'+ f MMeta = 'M'+ f _ = '×'+ mkMod m c = '<' `T.cons` f m `T.cons` '-'+ `T.cons` c `T.cons` T.singleton '>'++++parseEvents :: EventString -> [Event]+parseEvents (Ev x) = fst . foldl' go ([], []) $ T.unpack x+ where go (evs, s) '\n' = (evs, s)+ go (evs, []) '<' = (evs, "<")+ go (evs, []) c = (evs ++ [char c], [])+ go (evs, s) '>' = (evs ++ [stringToEvent (s ++ ">")], [])+ go (evs, s) c = (evs, s ++ [c])++stringToRepeatableAction :: EventString -> RepeatableAction+stringToRepeatableAction s = RepeatableAction count command+ where (count, command) = splitCountedCommand s++splitCountedCommand :: EventString -> (Int, EventString)+splitCountedCommand (Ev s) = (count, Ev commandString)+ where (countString, commandString) = T.span isDigit s+ count = case countString of+ "" -> 1+ x -> read $ T.unpack x++-- 2d3w -> 6dw+-- 6dw -> 6dw+-- dw -> dw+normalizeCount :: EventString -> EventString+normalizeCount s =+ if T.null countedObject+ then s+ else Ev $ showT (operatorCount * objectCount) <> operator <> object+ where (operatorCount, Ev rest1) = splitCountedCommand s+ (operator, countedObject) = T.break isDigit rest1+ (objectCount, Ev object) = splitCountedCommand (Ev countedObject)
+ src/Yi/Keymap/Vim/Ex.hs view
@@ -0,0 +1,72 @@+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Keymap.Vim.Ex+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable++module Yi.Keymap.Vim.Ex+ ( exEvalE+ , exEvalY+ , evStringToExCommand+ , ExCommand(..)+ , defExCommandParsers+ ) where++import Yi.Keymap.Vim.Common (EventString)+import qualified Yi.Keymap.Vim.Ex.Commands.Buffer as Buffer (parse)+import qualified Yi.Keymap.Vim.Ex.Commands.BufferDelete as BufferDelete (parse)+import qualified Yi.Keymap.Vim.Ex.Commands.Buffers as Buffers (parse)+import qualified Yi.Keymap.Vim.Ex.Commands.Cabal as Cabal (parse)+import qualified Yi.Keymap.Vim.Ex.Commands.Delete as Delete (parse)+import qualified Yi.Keymap.Vim.Ex.Commands.Edit as Edit (parse)+import qualified Yi.Keymap.Vim.Ex.Commands.Global as Global (parse)+import qualified Yi.Keymap.Vim.Ex.Commands.GotoLine as GotoLine (parse)+import qualified Yi.Keymap.Vim.Ex.Commands.Help as Help (parse)+import qualified Yi.Keymap.Vim.Ex.Commands.Make as Make (parse)+import qualified Yi.Keymap.Vim.Ex.Commands.Nohl as Nohl (parse)+import qualified Yi.Keymap.Vim.Ex.Commands.Paste as Paste (parse)+import qualified Yi.Keymap.Vim.Ex.Commands.Quit as Quit (parse)+import qualified Yi.Keymap.Vim.Ex.Commands.Read as Read (parse)+import qualified Yi.Keymap.Vim.Ex.Commands.Reload as Reload (parse)+import qualified Yi.Keymap.Vim.Ex.Commands.Shell as Shell (parse)+import qualified Yi.Keymap.Vim.Ex.Commands.Sort as Sort (parse)+import qualified Yi.Keymap.Vim.Ex.Commands.Substitute as Substitute (parse)+import qualified Yi.Keymap.Vim.Ex.Commands.Tag as Tag (parse)+import qualified Yi.Keymap.Vim.Ex.Commands.Undo as Undo (parse)+import qualified Yi.Keymap.Vim.Ex.Commands.Write as Write (parse)+import qualified Yi.Keymap.Vim.Ex.Commands.Yi as Yi (parse)+import qualified Yi.Keymap.Vim.Ex.Commands.Copy as Copy (parse)+import qualified Yi.Keymap.Vim.Ex.Commands.Stack as Stack (parse)+import Yi.Keymap.Vim.Ex.Eval (exEvalE, exEvalY)+import Yi.Keymap.Vim.Ex.Types (ExCommand (..), evStringToExCommand)++defExCommandParsers :: [EventString -> Maybe ExCommand]+defExCommandParsers =+ [ Buffer.parse+ , Buffers.parse+ , BufferDelete.parse+ , Cabal.parse+ , Delete.parse+ , Edit.parse+ , Global.parse+ , GotoLine.parse+ , Help.parse+ , Make.parse+ , Nohl.parse+ , Paste.parse+ , Quit.parse+ , Read.parse+ , Reload.parse+ , Sort.parse+ , Substitute.parse+ , Shell.parse+ , Tag.parse+ , Undo.parse+ , Write.parse+ , Yi.parse+ , Copy.parse+ , Stack.parse+ ]
+ src/Yi/Keymap/Vim/Ex/Commands/Buffer.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Keymap.Vim.Ex.Commands.Buffer+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable+--+-- :buffer ex command to switch to named or numbered buffer.++module Yi.Keymap.Vim.Ex.Commands.Buffer (parse) where++import Control.Applicative (Alternative ((<|>)))+import Control.Monad (void)+import Control.Monad.State (gets)+import qualified Data.Attoparsec.Text as P (Parser, anyChar, choice,+ digit, endOfInput, many', many1,+ parseOnly, space, string,+ try)+import Yi.Buffer.Basic (BufferRef (..))+import qualified Data.Text as T (Text, pack, unpack)+import Yi.Buffer.Misc (bkey, isUnchangedBuffer)+import Yi.Editor+import Yi.Keymap (Action (EditorA))+import Yi.Keymap.Vim.Common (EventString)+import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common (errorNoWrite, parseWithBangAndCount, pureExCommand)+import Yi.Keymap.Vim.Ex.Types (ExCommand (cmdAction, cmdShow))++parse :: EventString -> Maybe ExCommand+parse = Common.parseWithBangAndCount nameParser $ \ _ bang mcount -> do+ bufIdent <- (T.pack <$> P.many1 P.digit) <|> bufferSymbol <|>+ (T.pack <$> P.many1 P.space) *> (T.pack <$> P.many' P.anyChar) <|>+ P.endOfInput *> return ""+ return $ Common.pureExCommand {+ cmdShow = "buffer"+ , cmdAction = EditorA $ do+ unchanged <- withCurrentBuffer $ gets isUnchangedBuffer+ if bang || unchanged+ then case mcount of+ Nothing -> switchToBuffer bufIdent+ Just i -> switchByRef $ BufferRef i+ else Common.errorNoWrite+ }+ where+ bufferSymbol = P.string "%" <|> P.string "#"+++nameParser :: P.Parser ()+nameParser = void . P.choice . fmap P.string $ ["buffer", "buf", "bu", "b"]+++switchToBuffer :: T.Text -> EditorM ()+switchToBuffer s =+ case P.parseOnly bufferRef s of+ Right ref -> switchByRef ref+ Left _e -> switchByName $ T.unpack s+ where+ bufferRef = BufferRef . read <$> P.many1 P.digit+++switchByName :: String -> EditorM ()+switchByName "" = return ()+switchByName "%" = return ()+switchByName "#" = switchToBufferWithNameE ""+switchByName bufName = switchToBufferWithNameE (T.pack bufName)+++switchByRef :: BufferRef -> EditorM ()+switchByRef ref = do+ mBuf <- findBuffer ref+ maybe (return ()) (switchToBufferE . bkey) mBuf
+ src/Yi/Keymap/Vim/Ex/Commands/BufferDelete.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Keymap.Vim.Ex.Commands.BufferDelete+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable++module Yi.Keymap.Vim.Ex.Commands.BufferDelete (parse) where++import Control.Applicative (Alternative ((<|>)))+import Control.Monad (void)+import Data.Text ()+import qualified Data.Attoparsec.Text as P (string, try)+import Yi.Editor (closeBufferAndWindowE)+import Yi.Keymap (Action (EditorA))+import Yi.Keymap.Vim.Common (EventString)+import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common (parse, pureExCommand)+import Yi.Keymap.Vim.Ex.Types (ExCommand (cmdAction, cmdShow))++parse :: EventString -> Maybe ExCommand+parse = Common.parse $ do+ void $ P.try ( P.string "bdelete") <|> P.try ( P.string "bdel") <|> P.try (P.string "bd")+ return $ Common.pureExCommand {+ cmdShow = "bdelete"+ , cmdAction = EditorA closeBufferAndWindowE+ }
+ src/Yi/Keymap/Vim/Ex/Commands/Buffers.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Keymap.Vim.Ex.Commands.BufferDelete+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable+--+-- :buffers or :ls ex command to list buffers.+module Yi.Keymap.Vim.Ex.Commands.Buffers (parse) where++import Control.Applicative (Alternative ((<|>)))+import Lens.Micro.Platform (view)+import Control.Monad (void)+import qualified Data.Attoparsec.Text as P (string, try)+import qualified Data.Map as M (elems, mapWithKey)+import qualified Data.Text as T (intercalate, pack, unlines)+import Yi.Buffer.Basic (BufferRef (BufferRef))+import Yi.Buffer.Misc (BufferId (MemBuffer), identA)+import Yi.Editor+import Yi.Keymap (Action (EditorA))+import Yi.Keymap.Vim.Common (EventString)+import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common (parse, pureExCommand)+import Yi.Keymap.Vim.Ex.Types (ExCommand (cmdAction, cmdShow))+import Yi.Monad (gets)+import Yi.Rope (fromText)++parse :: EventString -> Maybe ExCommand+parse = Common.parse $ do+ void $ P.try ( P.string "buffers") <|> P.try ( P.string "ls") <|> P.try ( P.string "files" )+ return $ Common.pureExCommand {+ cmdShow = "buffers"+ , cmdAction = EditorA $ withEditor printBuffers+ }++printBuffers :: EditorM ()+printBuffers = do+ -- TODO Don't keep recreating new buffers. Use a pre-existing one.+ -- See the cabal buffer used in Command.hs for an example.+ -- TODO Add some simple keymaps to the buffer, like <CR> to open the buffer?+ bufs <- gets buffers+ let bufLines = M.elems $ M.mapWithKey bufLine bufs+ if length bufLines > 1+ then withEditor . void $+ newBufferE (MemBuffer "Buffer list")+ (fromText $ T.unlines bufLines)+ else printMsgs bufLines+ where+ tab = T.pack "\t"+ -- TODO shorten this name string perhaps.+ -- TODO Add more information: modified status, line number.+ bufLine (BufferRef bufNum) buf =+ T.intercalate tab [ T.pack . show $ bufNum+ , T.pack . show . view identA $ buf+ ]
+ src/Yi/Keymap/Vim/Ex/Commands/Cabal.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Keymap.Vim.Ex.Commands.Cabal+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable++module Yi.Keymap.Vim.Ex.Commands.Cabal (parse) where++import Control.Applicative (Alternative ((<|>)))+import Control.Monad (void)+import qualified Data.Attoparsec.Text as P (string, try)+import qualified Data.Text as T (pack)+import Yi.Command (cabalBuildE)+import Yi.Keymap (Action (YiA))+import Yi.Keymap.Vim.Common (EventString)+import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common (commandArgs, impureExCommand, parse)+import Yi.Keymap.Vim.Ex.Types (ExCommand (cmdAction, cmdShow))+import Yi.MiniBuffer (CommandArguments (CommandArguments))++-- TODO: Either hack Text into these parsec parsers or use Attoparsec.+-- Attoparsec is faster anyway and backtracks by default so we may+-- want to use that anyway.++parse :: EventString -> Maybe ExCommand+parse = Common.parse $ do+ void $ P.try (P.string "cabal build") <|> P.try (P.string "cabal")+ args <- Common.commandArgs+ return $ Common.impureExCommand {+ cmdShow = T.pack "cabal build"+ , cmdAction = YiA $ cabalBuildE $ CommandArguments args+ }
+ src/Yi/Keymap/Vim/Ex/Commands/Common.hs view
@@ -0,0 +1,319 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Keymap.Vim.Ex.Commands.Common+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable+--+-- Implements common 'ExCommand's for the Vim keymap.++module Yi.Keymap.Vim.Ex.Commands.Common+ ( parse+ , parseWithBang+ , parseWithBangAndCount+ , parseRange+ , BoolOptionAction(..)+ , TextOptionAction(..)+ , parseBoolOption+ , parseTextOption+ , filenameComplete+ , forAllBuffers+ , pureExCommand+ , impureExCommand+ , errorNoWrite+ , commandArgs+ , needsSaving+ ) where++import Control.Applicative (Alternative ((<|>)))+import Lens.Micro.Platform (use)+import Control.Monad (void, (>=>))+import qualified Data.Attoparsec.Text as P (Parser, anyChar, char,+ digit, inClass, many',+ many1, notInClass, parseOnly,+ option, satisfy, space, string)+import Data.List.NonEmpty (NonEmpty (..))+import Data.Monoid ((<>))+import qualified Data.Text as T (Text, concat, cons, drop,+ isPrefixOf, length, pack,+ singleton, snoc)+import System.Directory (getCurrentDirectory)+import Text.Read (readMaybe)+import Yi.Buffer+import Yi.Editor+import Yi.File (deservesSave)+import Yi.Keymap (Action, YiM, readEditor)+import Yi.Keymap.Vim.Common (EventString (Ev))+import Yi.Keymap.Vim.Ex.Types (ExCommand (..))+import Yi.Misc (matchingFileNames)+import Yi.Monad (gets)+import Yi.Style (errorStyle)+import Yi.Utils (io)++-- TODO this kind of thing is exactly where it makes sense to+-- *not* use parseOnly but its easier to have compatibility with+-- the old parsec-based interface for now.++parse :: P.Parser ExCommand -> EventString -> Maybe ExCommand+parse parser (Ev s) =+ either (const Nothing) Just $ P.parseOnly parser s++parseWithBangAndCount :: P.Parser a+ -- ^ The command name parser.+ -> (a -> Bool+ -> Maybe Int+ -> P.Parser ExCommand)+ -- ^ A parser for the remaining command arguments.+ -> EventString+ -- ^ The string to parse.+ -> Maybe ExCommand+parseWithBangAndCount nameParser argumentParser (Ev s) =+ either (const Nothing) Just (P.parseOnly parser s)+ where+ parser = do+ mcount <- parseCount+ a <- nameParser+ bang <- parseBang+ argumentParser a bang mcount++parseWithBang :: P.Parser a+ -- ^ The command name parser.+ -> (a -> Bool -> P.Parser ExCommand)+ -- ^ A parser for the remaining command arguments.+ -> EventString+ -- ^ The string to parse.+ -> Maybe ExCommand+parseWithBang nameParser argumentParser (Ev s) =+ either (const Nothing) Just (P.parseOnly parser s)+ where+ parser = do+ a <- nameParser+ bang <- parseBang+ argumentParser a bang++parseBang :: P.Parser Bool+parseBang = P.string "!" *> return True <|> return False++parseCount :: P.Parser (Maybe Int)+parseCount = readMaybe <$> P.many' P.digit++parseRange :: P.Parser (Maybe (BufferM Region))+parseRange = fmap Just parseFullRange+ <|> fmap Just (styleRange parsePointRange)+ <|> return Nothing++styleRange :: P.Parser (BufferM Region) -> P.Parser (BufferM Region)+styleRange = fmap $ \regionB -> do+ style <- getRegionStyle+ region <- regionB+ convertRegionToStyleB region style++parseFullRange :: P.Parser (BufferM Region)+parseFullRange = P.char '%' *> return (regionOfB Document)++parsePointRange :: P.Parser (BufferM Region)+parsePointRange = do+ p1 <- parseSinglePoint+ void $ P.char ','+ p2 <- parseSinglePoint2 p1+ return $ do+ p1' <- p1+ p2' <- p2+ return $ mkRegion (min p1' p2') (max p1' p2')++parseSinglePoint :: P.Parser (BufferM Point)+parseSinglePoint = parseSingleMark <|> parseLinePoint++-- | Some of the parse rules for the second point actually depend+-- on the first point. If parse rule succeeds this can result+-- in the first BufferM Point having to be run twice but this+-- probably isn't a big deal.+parseSinglePoint2 :: BufferM Point -> P.Parser (BufferM Point)+parseSinglePoint2 ptB = parseEndOfLine ptB <|> parseSinglePoint++-- | Parse a single mark, or a selection mark (< or >)+parseSingleMark :: P.Parser (BufferM Point)+parseSingleMark = P.char '\'' *> (parseSelMark <|> parseNormMark)++-- | Parse a normal mark (non-system)+parseNormMark :: P.Parser (BufferM Point)+parseNormMark = do+ c <- P.anyChar+ return $ mayGetMarkB [c] >>= \case+ Nothing -> fail $ "Mark " <> show c <> " not set"+ Just mark -> use (markPointA mark)++-- | Parse selection marks.+parseSelMark :: P.Parser (BufferM Point)+parseSelMark = do+ c <- P.satisfy $ P.inClass "<>"+ return $ if c == '<' then getSelectionMarkPointB else pointB++-- | Parses end of line, $, only valid for 2nd point.+parseEndOfLine :: BufferM Point -> P.Parser (BufferM Point)+parseEndOfLine ptB = P.char '$' *> return (ptB >>= eolPointB)++-- | Parses a numeric line or ".+k", k relative to current+parseLinePoint :: P.Parser (BufferM Point)+parseLinePoint = parseCurrentLinePoint <|> parseNormalLinePoint++-- | Parses .+-k+parseCurrentLinePoint :: P.Parser (BufferM Point)+parseCurrentLinePoint = do+ void $ P.char '.'+ relative <- P.option Nothing $ Just <$> do+ c <- P.satisfy $ P.inClass "+-"+ (i :: Int) <- read <$> P.many1 P.digit+ return $ if c == '+' then i else -i+ case relative of+ Nothing -> return $ pointB >>= solPointB+ Just offset -> return $ do+ ln <- curLn+ savingPointB $ gotoLn (ln + offset) >> pointB++-- | Parses a line number+parseNormalLinePoint :: P.Parser (BufferM Point)+parseNormalLinePoint = do+ ln <- read <$> P.many1 P.digit+ return . savingPointB $ gotoLn ln >> pointB++data BoolOptionAction = BoolOptionSet !Bool | BoolOptionInvert | BoolOptionAsk++parseBoolOption :: T.Text -> (BoolOptionAction -> Action) -> EventString+ -> Maybe ExCommand+parseBoolOption name action = parse $ do+ void $ P.string "set "+ nos <- P.many' (P.string "no")+ invs <- P.many' (P.string "inv")+ void $ P.string name+ bangs <- P.many' (P.string "!")+ qs <- P.many' (P.string "?")+ return $ pureExCommand {+ cmdShow = T.concat [ "set "+ , T.concat nos+ , name+ , T.concat bangs+ , T.concat qs ]+ , cmdAction = action $+ case fmap (not . null) [qs, bangs, invs, nos] of+ [True, _, _, _] -> BoolOptionAsk+ [_, True, _, _] -> BoolOptionInvert+ [_, _, True, _] -> BoolOptionInvert+ [_, _, _, True] -> BoolOptionSet False+ _ -> BoolOptionSet True+ }++data TextOptionAction = TextOptionSet !T.Text | TextOptionAsk++parseTextOption :: T.Text -> (TextOptionAction -> Action) -> EventString+ -> Maybe ExCommand+parseTextOption name action = parse $ do+ void $ P.string "set "+ void $ P.string name+ maybeNewValue <- P.option Nothing $ Just <$> do+ void $ P.many' P.space+ void $ P.char '='+ void $ P.many' P.space+ T.pack <$> P.many' P.anyChar+ return $ pureExCommand+ { cmdShow = T.concat [ "set "+ , name+ , maybe "" (" = " <>) maybeNewValue+ ]+ , cmdAction = action $ maybe TextOptionAsk TextOptionSet maybeNewValue+ }++removePwd :: T.Text -> YiM T.Text+removePwd path = do+ pwd' <- T.pack <$> io getCurrentDirectory+ return $! if pwd' `T.snoc` '/' `T.isPrefixOf` path+ then T.drop (1 + T.length pwd') path+ else path++filenameComplete :: T.Text -> YiM [T.Text]+filenameComplete f = if f == "%"+ then+ -- current buffer is minibuffer+ -- actual file is in the second buffer in bufferStack+ gets bufferStack >>= \case+ _ :| [] -> do+ printMsg "filenameComplete: Expected to see minibuffer!"+ return []+ _ :| bufferRef : _ -> do+ currentFileName <- fmap T.pack . withGivenBuffer bufferRef $+ fmap bufInfoFileName bufInfoB++ let sanitizedFileName = if "//" `T.isPrefixOf` currentFileName+ then '/' `T.cons` currentFileName+ else currentFileName++ return <$> removePwd sanitizedFileName++ else do+ files <- matchingFileNames Nothing f+ case files of+ [] -> return []+ [x] -> return <$> removePwd x+ xs -> sequence $ fmap removePwd xs++forAllBuffers :: MonadEditor m => (BufferRef -> m ()) -> m ()+forAllBuffers f = readEditor bufferStack >>= \(b :| bs) -> f b >> mapM_ f bs++pureExCommand :: ExCommand+pureExCommand = ExCommand {+ cmdIsPure = True+ , cmdComplete = return []+ , cmdAcceptsRange = False+ , cmdAction = undefined+ , cmdShow = undefined+ }++impureExCommand :: ExCommand+impureExCommand = pureExCommand { cmdIsPure = False }+++-- | Show an error on the status line.+errorEditor :: T.Text -> EditorM ()+errorEditor s = printStatus (["error: " <> s], errorStyle)+++-- | Show the common error message about an unsaved file on the status line.+errorNoWrite :: EditorM ()+errorNoWrite = errorEditor "No write since last change (add ! to override)"++-- | Useful parser for any Ex command that acts kind of like a shell+commandArgs :: P.Parser [T.Text]+commandArgs = P.many' commandArg++-- | Parse a single command, with a space in front+commandArg :: P.Parser T.Text+commandArg = fmap mconcat $ P.many1 P.space *> normArg++-- | Unquoted arg, allows for escaping of \, ", ', and space. Includes quoted arg+-- as a subset, because of things like aa"bbb"+normArg :: P.Parser [T.Text]+normArg = P.many1 $+ quoteArg '\"'+ <|> quoteArg '\"'+ <|> T.singleton <$> escapeChar+ <|> T.singleton <$> P.satisfy (P.notInClass " \"\'\\")++-- | Quoted arg with char delim. Allows same escapes, but doesn't require escaping+-- of the opposite kind or space. However, it does allow escaping opposite kind like+-- normal, as well as allowing escaping of space (is this normal behavior?).+quoteArg :: Char -> P.Parser T.Text+quoteArg delim = fmap T.pack $ P.char delim + *> P.many1 (P.satisfy (P.notInClass (delim:"\\")) <|> escapeChar)+ <* P.char delim++-- | Parser for a single escape character+escapeChar :: P.Parser Char+escapeChar = P.char '\\' *> P.satisfy (P.inClass " \"\'\\")++needsSaving :: BufferRef -> YiM Bool+needsSaving = findBuffer >=> maybe (return False) deservesSave
+ src/Yi/Keymap/Vim/Ex/Commands/Copy.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Keymap.Vim.Ex.Commands.Copy+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable+--+-- :copy ex command to copy selection to the clipboard.+module Yi.Keymap.Vim.Ex.Commands.Copy (parse) where++import Control.Monad (void)+import qualified Data.Attoparsec.Text as P (match, string)+import Data.Monoid ((<>))+import Yi.Editor (withCurrentBuffer)+import Yi.Keymap (Action (YiA))+import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common (parse, impureExCommand, parseRange)+import Yi.Keymap.Vim.Ex.Types (ExCommand (cmdAction, cmdShow))+import Yi.Keymap.Vim.Common (EventString)+import Yi.Types (YiM, BufferM)+import Yi.Rope (toString)+import Yi.Buffer.Region (readRegionB, Region)+import Control.Monad.Base (liftBase)+import System.Hclip (setClipboard)+import Yi.Core (errorEditor)++parse :: EventString -> Maybe ExCommand+parse = Common.parse $ do+ (regionText, region) <- P.match Common.parseRange+ void (P.string "copy")+ return $ Common.impureExCommand {+ cmdShow = regionText <> "copy"+ , cmdAction = YiA (copy region)+ }++copy :: Maybe (BufferM Region) -> YiM ()+copy maybeGetRegion = case maybeGetRegion of+ Nothing -> errorEditor "Cannot copy: No region"+ Just getRegion -> liftBase . setClipboard . toString + =<< withCurrentBuffer (readRegionB =<< getRegion)
+ src/Yi/Keymap/Vim/Ex/Commands/Delete.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Keymap.Vim.Ex.Commands.Delete+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable++module Yi.Keymap.Vim.Ex.Commands.Delete (parse) where++import Control.Applicative (Alternative ((<|>)))+import Control.Monad (void)+import Data.Text ()+import qualified Data.Attoparsec.Text as P (string, try)+import Yi.Buffer.Adjusted hiding (Delete)+import Yi.Keymap (Action (BufferA))+import Yi.Keymap.Vim.Common (EventString)+import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common (parse, pureExCommand)+import Yi.Keymap.Vim.Ex.Types (ExCommand (cmdAction, cmdShow))++parse :: EventString -> Maybe ExCommand+parse = Common.parse $ do+ void $ P.try ( P.string "delete") <|> P.string "d"+ return $ Common.pureExCommand {+ cmdShow = "delete"+ , cmdAction = BufferA $ do+ deleteUnitB Line Forward+ deleteN 1+ }
+ src/Yi/Keymap/Vim/Ex/Commands/Edit.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Keymap.Vim.Ex.Commands.Edit+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable+--+-- Implements quit commands.++module Yi.Keymap.Vim.Ex.Commands.Edit (parse) where++import Control.Applicative (Alternative ((<|>)))+import Control.Monad (void, when)+import Data.Maybe (isJust)+import qualified Data.Text as T (Text, append, pack, unpack)+import qualified Data.Attoparsec.Text as P (anyChar, many1, space, string, try, option)+import Yi.Editor (MonadEditor (withEditor), newTabE)+import Yi.File (openNewFile)+import Yi.Keymap (Action (YiA))+import Yi.Keymap.Vim.Common (EventString)+import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common (filenameComplete, impureExCommand, parse)+import Yi.Keymap.Vim.Ex.Types (ExCommand (cmdAction, cmdComplete, cmdShow))++parse :: EventString -> Maybe ExCommand+parse = Common.parse $ do+ tab <- P.option Nothing $ Just <$> P.string "tab"+ void $ P.try (P.string "edit") <|> P.string "e"+ void $ P.many1 P.space+ filename <- T.pack <$> P.many1 P.anyChar+ return $! edit (isJust tab) filename++edit :: Bool -> T.Text -> ExCommand+edit tab f = Common.impureExCommand {+ cmdShow = showEdit tab f+ , cmdAction = YiA $ do+ when tab $ withEditor newTabE+ openNewFile $ T.unpack f+ , cmdComplete = (fmap . fmap)+ (showEdit tab) (Common.filenameComplete f)+ }++showEdit :: Bool -> T.Text -> T.Text+showEdit tab f = (if tab then "tab" else "") `T.append` "edit " `T.append` f
+ src/Yi/Keymap/Vim/Ex/Commands/Global.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Keymap.Vim.Ex.Commands.Global+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable++module Yi.Keymap.Vim.Ex.Commands.Global (parse) where++import Control.Applicative (Alternative ((<|>)))+import Lens.Micro.Platform (use)+import Control.Monad (forM_, void, when)+import Data.Monoid ((<>))+import qualified Data.Text as T (Text, isInfixOf, pack, snoc)+import qualified Data.Attoparsec.Text as P (anyChar, char, many', satisfy, string, try)+import Yi.Buffer.Adjusted+import Yi.Editor (withCurrentBuffer)+import Yi.Keymap (Action (BufferA, EditorA))+import Yi.Keymap.Vim.Common (EventString (Ev))+import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common (parse, pureExCommand)+import qualified Yi.Keymap.Vim.Ex.Commands.Delete as Delete (parse)+import qualified Yi.Keymap.Vim.Ex.Commands.Substitute as Substitute (parse)+import Yi.Keymap.Vim.Ex.Types (ExCommand (cmdAction, cmdShow), evStringToExCommand)+import qualified Yi.Rope as R (toText)+import Yi.String (showT)++parse :: EventString -> Maybe ExCommand+parse = Common.parse $ do+ void $ P.try (P.string "global/") <|> P.string "g/"+ predicate <- T.pack <$> P.many' (P.satisfy (/= '/'))+ void $ P.char '/'+ cmdString <- Ev . T.pack <$> P.many' P.anyChar+ cmd <- case evStringToExCommand allowedCmds cmdString of+ Just c -> return c+ _ -> fail "Unexpected command argument for global command."+ return $! global predicate cmd++global :: T.Text -> ExCommand -> ExCommand+global p c = Common.pureExCommand {+ cmdShow = "g/" <> p `T.snoc` '/' <> showT c+ , cmdAction = EditorA $ do+ mark <- withCurrentBuffer setMarkHereB+ lineCount <- withCurrentBuffer lineCountB+ forM_ (reverse [1..lineCount]) $ \l -> do+ ln <- withCurrentBuffer $ gotoLn l >> R.toText <$> readLnB+ when (p `T.isInfixOf` ln) $+ case cmdAction c of+ BufferA action -> withCurrentBuffer $ void action+ EditorA action -> void action+ _ -> error "Impure command as an argument to global."+ withCurrentBuffer $ do+ use (markPointA mark) >>= moveTo+ deleteMarkB mark+ }++allowedCmds :: [EventString -> Maybe ExCommand]+allowedCmds = [Delete.parse, Substitute.parse]
+ src/Yi/Keymap/Vim/Ex/Commands/GotoLine.hs view
@@ -0,0 +1,27 @@+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Keymap.Vim.Ex.Commands.GotoLine+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable++module Yi.Keymap.Vim.Ex.Commands.GotoLine (parse) where++import Data.Char (isDigit)+import qualified Data.Text as T (all, null, unpack)+import Yi.Buffer.Adjusted (firstNonSpaceB, gotoLn)+import Yi.Keymap (Action (BufferA))+import Yi.Keymap.Vim.Common (EventString (Ev))+import Yi.Keymap.Vim.Ex.Commands.Common (pureExCommand)+import Yi.Keymap.Vim.Ex.Types (ExCommand (cmdAction, cmdShow))++parse :: EventString -> Maybe ExCommand+parse (Ev s) = if not (T.null s) && T.all isDigit s+ then let l = read $ T.unpack s in+ Just $ pureExCommand {+ cmdAction = BufferA $ gotoLn l >> firstNonSpaceB+ , cmdShow = s+ }+ else Nothing
+ src/Yi/Keymap/Vim/Ex/Commands/Help.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Keymap.Vim.Ex.Commands.Yi+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable+++module Yi.Keymap.Vim.Ex.Commands.Help (parse) where++import Control.Monad (void)+import qualified Data.Text as T (append, pack)+import qualified Data.Attoparsec.Text as P (anyChar, many1, option, space, string, try)+import Yi.Command.Help (displayHelpFor)+import Yi.Keymap (Action (YiA))+import Yi.Keymap.Vim.Common (EventString)+import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common (impureExCommand, parse)+import Yi.Keymap.Vim.Ex.Types (ExCommand (cmdAction, cmdShow))++parse :: EventString -> Maybe ExCommand+parse = Common.parse $ do+ void $ P.string "help"+ cmd <- P.option "" $ P.try $ do+ void $ P.many1 P.space+ T.pack <$> P.many1 P.anyChar+ return $! Common.impureExCommand {+ cmdAction = YiA $ displayHelpFor cmd+ , cmdShow = "help" `T.append`+ if cmd == ""+ then ""+ else " " `T.append` cmd+ }
+ src/Yi/Keymap/Vim/Ex/Commands/Make.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Keymap.Vim.Ex.Commands.Make+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable++module Yi.Keymap.Vim.Ex.Commands.Make (parse) where++import qualified Data.Attoparsec.Text as P (string)+import Yi.Command (makeBuildE)+import Yi.Keymap (Action (YiA))+import Yi.Keymap.Vim.Common (EventString)+import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common (commandArgs, impureExCommand, parse)+import Yi.Keymap.Vim.Ex.Types (ExCommand (cmdAction, cmdShow))+import Yi.MiniBuffer (CommandArguments (CommandArguments))++parse :: EventString -> Maybe ExCommand+parse = Common.parse $ do+ args <- P.string "make" *> Common.commandArgs+ return $ Common.impureExCommand {+ cmdShow = "make"+ , cmdAction = YiA $ makeBuildE $ CommandArguments args+ }
+ src/Yi/Keymap/Vim/Ex/Commands/Nohl.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Keymap.Vim.Ex.Commands.Nohl+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable++module Yi.Keymap.Vim.Ex.Commands.Nohl (parse) where++import Data.Text ()+import Yi.Keymap (Action (EditorA))+import Yi.Keymap.Vim.Common (EventString)+import Yi.Keymap.Vim.Ex.Commands.Common (pureExCommand)+import Yi.Keymap.Vim.Ex.Types (ExCommand (cmdAction, cmdShow))+import Yi.Search (resetRegexE)++parse :: EventString -> Maybe ExCommand+parse s = if s == "nohl" || s == "nohlsearch"+ then Just nohl+ else Nothing++nohl :: ExCommand+nohl = pureExCommand {+ cmdAction = EditorA resetRegexE+ , cmdShow = "nohlsearch"+ }
+ src/Yi/Keymap/Vim/Ex/Commands/Paste.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Keymap.Vim.Ex.Commands.Paste+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable+--+-- Implements quit commands.++module Yi.Keymap.Vim.Ex.Commands.Paste (parse) where++import Data.Monoid ((<>))+import Yi.Editor (getEditorDyn, printMsg)+import Yi.Keymap (Action (EditorA))+import Yi.Keymap.Vim.Common (EventString, VimState (vsPaste))+import Yi.Keymap.Vim.Ex.Commands.Common (BoolOptionAction (..), parseBoolOption)+import Yi.Keymap.Vim.Ex.Types (ExCommand)+import Yi.Keymap.Vim.StateUtils (modifyStateE)+import Yi.String (showT)++parse :: EventString -> Maybe ExCommand+parse = parseBoolOption "paste" action++action :: BoolOptionAction -> Action+action BoolOptionAsk = EditorA $ do+ value <- vsPaste <$> getEditorDyn+ printMsg $ "paste = " <> showT value+action (BoolOptionSet b) = modPaste $ const b+action BoolOptionInvert = modPaste not++modPaste :: (Bool -> Bool) -> Action+modPaste f = EditorA . modifyStateE $ \s -> s { vsPaste = f (vsPaste s) }
+ src/Yi/Keymap/Vim/Ex/Commands/Quit.hs view
@@ -0,0 +1,104 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Keymap.Vim.Ex.Commands.Quit+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable+--+-- Implements quit commands.++module Yi.Keymap.Vim.Ex.Commands.Quit (parse) where++import Control.Applicative (Alternative ((<|>)))+import Lens.Micro.Platform (use)+import Control.Monad (void, when)+import qualified Data.Attoparsec.Text as P (char, choice, many', string, try)+import Data.Foldable (find)+import qualified Data.List.PointedList.Circular as PL (length)+import Data.Monoid ((<>))+import qualified Data.Text as T (append)+import Yi.Buffer (bkey, file)+import Yi.Core (closeWindow, errorEditor, quitEditor)+import Yi.Editor+import Yi.File (deservesSave, fwriteAllY, viWrite)+import Yi.Keymap (Action (YiA), YiM, readEditor)+import Yi.Keymap.Vim.Common (EventString)+import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common (impureExCommand, needsSaving, parse)+import Yi.Keymap.Vim.Ex.Types (ExCommand (cmdAction, cmdShow))+import Yi.Monad (gets)+import Yi.String (showT)+import Yi.Window (bufkey)++-- TODO wtf is the type of this function? It looks like it was introduced+-- in the migration to microlens+uses l f = f <$> use l++parse :: EventString -> Maybe ExCommand+parse = Common.parse $ P.choice+ [ do+ void $ P.try ( P.string "xit") <|> P.string "x"+ bangs <- P.many' (P.char '!')+ return (quit True (not $ null bangs) False)+ , do+ ws <- P.many' (P.char 'w')+ void $ P.try ( P.string "quit") <|> P.string "q"+ as <- P.many' (P.try ( P.string "all") <|> P.string "a")+ bangs <- P.many' (P.char '!')+ return $! quit (not $ null ws) (not $ null bangs) (not $ null as)+ ]++quit :: Bool -> Bool -> Bool -> ExCommand+quit w f a = Common.impureExCommand {+ cmdShow = (if w then "w" else "")+ `T.append` "quit"+ `T.append` (if a then "all" else "")+ `T.append` (if f then "!" else "")+ , cmdAction = YiA $ action w f a+ }++action :: Bool -> Bool -> Bool -> YiM ()+action False False False = quitWindowE+action False False True = quitAllE+action True False False = viWrite >> closeWindow+action True False True = saveAndQuitAllE+action False True False = closeWindow+action False True True = quitEditor+action True True False = viWrite >> closeWindow+action True True True = saveAndQuitAllE++quitWindowE :: YiM ()+quitWindowE = do+ nw <- gets currentBuffer >>= Common.needsSaving+ ws <- withEditor $ use currentWindowA >>= windowsOnBufferE . bufkey+ if length ws == 1 && nw+ then errorEditor "No write since last change (add ! to override)"+ else do+ winCount <- withEditor $ uses windowsA PL.length+ tabCount <- withEditor $ uses tabsA PL.length+ if winCount == 1 && tabCount == 1+ -- if its the last window, quitting will quit the editor+ then quitAllE+ else closeWindow++quitAllE :: YiM ()+quitAllE = do+ let needsWindow b = (b,) <$> deservesSave b+ bs <- readEditor bufferSet >>= mapM needsWindow+ -- Vim only shows the first modified buffer in the error.+ case find snd bs of+ Nothing -> quitEditor+ Just (b, _) -> do+ bufferName <- withEditor $ withGivenBuffer (bkey b) $ gets file+ errorEditor $ "No write since last change for buffer "+ <> showT bufferName+ <> " (add ! to override)"++saveAndQuitAllE :: YiM ()+saveAndQuitAllE = do+ succeed <- fwriteAllY+ when succeed quitEditor
+ src/Yi/Keymap/Vim/Ex/Commands/Read.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Keymap.Vim.Ex.Commands.Read+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable++module Yi.Keymap.Vim.Ex.Commands.Read (parse) where++import Control.Applicative (Alternative ((<|>)))+import Control.Monad.Base (liftBase)+import qualified Data.Attoparsec.Text as P (anyChar, many1, space, string, try)+import Data.Monoid ((<>))+import qualified Data.Text as T (Text, pack)+import qualified Data.Text.IO as T (readFile)+import System.Exit (ExitCode (..))+import Yi.Buffer.HighLevel (insertRopeWithStyleB)+import Yi.Buffer.Normal (RegionStyle (LineWise))+import Yi.Editor (printMsg, withCurrentBuffer)+import Yi.Keymap (Action (YiA), YiM)+import Yi.Keymap.Vim.Common (EventString)+import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common (impureExCommand, parse)+import Yi.Keymap.Vim.Ex.Types (ExCommand (cmdAction, cmdShow))+import Yi.Process (runShellCommand)+import Yi.Rope (fromText, YiString)++parse :: EventString -> Maybe ExCommand+parse = Common.parse $+ (P.try (P.string "read") <|> P.string "r") *> P.many1 P.space+ *> ((P.string "!" *> parseCommand) <|> parseReadFile)+ where parseReadFile = do+ filename <- P.many1 P.anyChar+ return $! readCmd ("read file " <> T.pack filename)+ (liftBase $ fromText <$> T.readFile filename)+ parseCommand = do+ command <- P.many1 P.anyChar+ return $! readCmd ("read command " <> T.pack command) (runShellCommand' command)+ runShellCommand' :: String -> YiM YiString+ runShellCommand' cmd = do+ (exitCode,cmdOut,cmdErr) <- liftBase $ runShellCommand cmd+ case exitCode of+ ExitSuccess -> return $ fromText cmdOut+ ExitFailure _ -> printMsg cmdErr >> return ""++readCmd :: T.Text -> YiM YiString -> ExCommand+readCmd cmdShowText getYiString = Common.impureExCommand+ { cmdShow = cmdShowText+ , cmdAction = YiA $ do+ s <- getYiString+ withCurrentBuffer $ insertRopeWithStyleB s LineWise+ }
+ src/Yi/Keymap/Vim/Ex/Commands/Reload.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Keymap.Vim.Ex.Commands.Reload+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable++module Yi.Keymap.Vim.Ex.Commands.Reload (parse) where++import Data.Text ()+import Yi.Boot.Internal (reload)+import Yi.Keymap (Action (YiA))+import Yi.Keymap.Vim.Common (EventString)+import Yi.Keymap.Vim.Ex.Commands.Common (impureExCommand)+import Yi.Keymap.Vim.Ex.Types (ExCommand (cmdAction, cmdShow))++parse :: EventString -> Maybe ExCommand+parse "reload" = Just $ impureExCommand {+ cmdShow = "reload"+ , cmdAction = YiA reload+ }+parse _ = Nothing
+ src/Yi/Keymap/Vim/Ex/Commands/Shell.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Keymap.Vim.Ex.Commands.Shell+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable++module Yi.Keymap.Vim.Ex.Commands.Shell (parse) where++import Control.Monad (void)+import qualified Data.Text as T (pack)+import qualified Data.Attoparsec.Text as P (char, many1)+import Yi.Command (buildRun)+import Yi.Keymap (Action (YiA))+import Yi.Keymap.Vim.Common (EventString)+import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common (commandArgs, impureExCommand, parse)+import Yi.Keymap.Vim.Ex.Types (ExCommand (cmdAction, cmdShow))++parse :: EventString -> Maybe ExCommand+parse = Common.parse $ do+ void $ P.char '!'+ cmd <- T.pack <$> P.many1 (P.char ' ')+ args <- Common.commandArgs+ return $ Common.impureExCommand {+ cmdShow = "!"+ , cmdAction = YiA $ buildRun cmd args (const $ return ())+ }
+ src/Yi/Keymap/Vim/Ex/Commands/Sort.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Keymap.Vim.Ex.Commands.Sort+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable++module Yi.Keymap.Vim.Ex.Commands.Sort (parse) where++import Control.Monad (void)+import qualified Data.Attoparsec.Text as P (match, string)+import Data.Monoid ((<>))+import qualified Data.Text as T (Text)+import Yi.Buffer+import Yi.Keymap (Action (BufferA))+import Yi.Keymap.Vim.Common (EventString)+import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common (parse, parseRange, pureExCommand)+import Yi.Keymap.Vim.Ex.Types (ExCommand (cmdAction, cmdComplete, cmdShow))++parse :: EventString -> Maybe ExCommand+parse = Common.parse $ do+ (regionText, region) <- P.match Common.parseRange+ void $ P.string "sort"+ return $ sort region regionText++sort :: Maybe (BufferM Region) -> T.Text -> ExCommand+sort r rt = Common.pureExCommand {+ cmdShow = rt <> "sort"+ , cmdAction = BufferA $ sortA r+ , cmdComplete = return [rt <> "sort"]+ }++sortA :: Maybe (BufferM Region) -> BufferM ()+sortA r = do+ region <- case r of+ Nothing -> regionOfB Document+ Just r' -> r'+ sortLinesWithRegion region
+ src/Yi/Keymap/Vim/Ex/Commands/Stack.hs view
@@ -0,0 +1,68 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Keymap.Vim.Ex.Commands.Stack+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable++module Yi.Keymap.Vim.Ex.Commands.Stack (parse) where++import Control.Applicative (Alternative ((<|>)))+import Data.Attoparsec.Text as P (choice, Parser)+import Data.Text (Text)+import Data.Monoid ((<>))+import Yi.Command (stackCommandE)+import Yi.Keymap (Action (YiA))+import Yi.Keymap.Vim.Common (EventString)+import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common (commandArgs, impureExCommand, parse)+import Yi.Keymap.Vim.Ex.Types (ExCommand (cmdAction, cmdShow))+import Yi.MiniBuffer (CommandArguments (CommandArguments))++parse :: EventString -> Maybe ExCommand+parse = Common.parse $ do+ cmd <- "stack" *> (" " *> P.choice commands <|> pure "build")+ args <- Common.commandArgs+ return $ Common.impureExCommand {+ cmdShow = "stack " <> cmd+ , cmdAction = YiA $ stackCommandE cmd $ CommandArguments args+ }++commands :: [P.Parser Text]+commands =+ [ "build"+ , "install"+ , "uninstall"+ , "test"+ , "bench"+ , "haddock"+ , "new"+ , "templates"+ , "init"+ , "solver"+ , "setup"+ , "path"+ , "unpack"+ , "update"+ , "upgrade"+ , "upload"+ , "sdist"+ , "dot"+ , "exec"+ , "ghc"+ , "ghci"+ , "repl"+ , "runghc"+ , "runhaskell"+ , "eval"+ , "clean"+ , "list-dependencies"+ , "query"+ , "ide"+ , "docker"+ , "config"+ , "image"+ , "hpc"+ ]
+ src/Yi/Keymap/Vim/Ex/Commands/Substitute.hs view
@@ -0,0 +1,134 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Keymap.Vim.Ex.Commands.Substitute+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable++module Yi.Keymap.Vim.Ex.Commands.Substitute (parse) where++import Control.Applicative (Alternative ((<|>)))+import Control.Monad (void)+import qualified Data.Attoparsec.Text as P (char, inClass, many', match, option, + satisfy, string, try)+import Data.Maybe (fromMaybe)+import Data.Monoid ((<>))+import qualified Data.Text as T (Text, cons, snoc)+import Lens.Micro.Platform (over, _2)+import Yi.Buffer.Adjusted+import Yi.Buffer.Region (linesOfRegionB)+import Yi.Editor (EditorM, closeBufferAndWindowE, printMsg, withCurrentBuffer)+import Yi.Keymap (Action (EditorA), Keymap)+import Yi.Keymap.Keys (char, choice, (?>>!))+import Yi.Keymap.Vim.Common (EventString)+import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common (parse, pureExCommand, parseRange)+import Yi.Keymap.Vim.Ex.Types (ExCommand (cmdAction, cmdShow))+import Yi.MiniBuffer (spawnMinibufferE)+import Yi.Regex (makeSearchOptsM)+import Yi.Region (Region)+import qualified Yi.Rope as R (YiString, fromString, length, null, toText, toString)+import Yi.Search++parse :: EventString -> Maybe ExCommand+parse = Common.parse $ do+ (rangeText, rangeB) <- over _2 (fromMaybe $ regionOfB Line) <$> P.match Common.parseRange+ void $ P.try (P.string "substitute") <|> P.string "s"+ delimiter <- P.satisfy (`elem` ("!@#$%^&*()[]{}<>/.,~';:?-=" :: String))+ from <- R.fromString <$> P.many' (P.satisfy (/= delimiter))+ void $ P.char delimiter+ to <- R.fromString <$> P.many' (P.satisfy (/= delimiter))+ void $ P.char delimiter+ flagChars <- P.many' (P.satisfy $ P.inClass "gic")+ return $! substitute from to delimiter+ ('g' `elem` flagChars)+ ('i' `elem` flagChars)+ ('c' `elem` flagChars)+ rangeText+ rangeB++substitute :: R.YiString -> R.YiString -> Char -> Bool -> Bool -> Bool -> T.Text -> BufferM Region -> ExCommand+substitute from to delimiter global caseInsensitive confirm regionText regionB = Common.pureExCommand {+ cmdShow = regionText+ <> "s"+ <> (delimiter `T.cons` R.toText from)+ <> (delimiter `T.cons` R.toText to)+ `T.snoc` delimiter+ <> (if confirm then "c" else "")+ <> (if caseInsensitive then "i" else "")+ <> (if global then "g" else "")+ , cmdAction = EditorA $ do+ let opts = QuoteRegex : if caseInsensitive then [IgnoreCase] else []+ lines <- withCurrentBuffer $ regionB >>= linesOfRegionB+ region <- withCurrentBuffer regionB+ regex <- if R.null from+ then getRegexE+ else return . (either (const Nothing) Just) + . makeSearchOptsM opts . R.toString $ from+ case regex of+ Nothing -> printMsg "No previous search pattern"+ Just regex' -> if confirm+ then substituteConfirm regex' to global lines+ else withCurrentBuffer $ do+ -- We need to reverse the lines here so that replacing+ -- does not effect the regions in question.+ mapM_ (void . searchAndRepRegion0 regex' to global) (reverse lines)+ moveToSol+ }++-- | Run substitution in confirm mode+substituteConfirm :: SearchExp -> R.YiString -> Bool -> [Region] -> EditorM ()+substituteConfirm regex to global lines = do+ -- TODO This highlights all matches, even in non-global mode+ -- and could potentially be classified as a bug. Fixing requires+ -- changing the regex highlighting api.+ setRegexE regex+ regions <- withCurrentBuffer $ findMatches regex global lines+ substituteMatch to 0 False regions++-- | All matches to replace under given flags+findMatches :: SearchExp -> Bool -> [Region] -> BufferM [Region]+findMatches regex global lines = do+ let f = if global then id else take 1+ concat <$> mapM (fmap f . regexRegionB regex) lines++-- | Get regions corresponding to all lines+lineRegions :: [Int] -> BufferM [Region]+lineRegions = mapM $ \ln -> gotoLn ln >> regionOfB Line++-- | Offsets a region (to account for a region prior being modified)+offsetRegion :: Int -> Region -> Region+offsetRegion k reg = mkRegion (regionStart reg + k') (regionEnd reg + k')+ where k' = fromIntegral k++-- | Runs a list of matches using itself as a continuation+substituteMatch :: R.YiString -> Int -> Bool -> [Region] -> EditorM ()+substituteMatch _ _ _ [] = resetRegexE+substituteMatch to co autoAll (m:ms) = do+ let m' = offsetRegion co m+ withCurrentBuffer . moveTo $ regionStart m'+ len <- withCurrentBuffer $ R.length <$> readRegionB m'+ let diff = R.length to - len+ tex = "replace with " <> R.toText to <> " (y/n/a/q)?"+ if autoAll+ then do withCurrentBuffer $ replaceRegionB m' to+ substituteMatch to (co + diff) True ms+ else void . spawnMinibufferE tex . const $ askKeymap to co (co + diff) m ms++-- | Actual choices during confirm mode.+askKeymap :: R.YiString -> Int -> Int -> Region -> [Region] -> Keymap+askKeymap to co co' m ms = choice [+ char 'n' ?>>! cleanUp >> substituteMatch to co False ms+ , char 'a' ?>>! do cleanUp+ replace+ substituteMatch to co' True ms+ , char 'y' ?>>! do cleanUp+ replace+ substituteMatch to co' False ms+ , char 'q' ?>>! cleanUp >> resetRegexE+ ]+ where cleanUp = closeBufferAndWindowE+ replace = withCurrentBuffer $ replaceRegionB (offsetRegion co m) to
+ src/Yi/Keymap/Vim/Ex/Commands/Tag.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Keymap.Vim.Ex.Commands.Tag+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable++module Yi.Keymap.Vim.Ex.Commands.Tag (parse) where++import Control.Applicative (Alternative ((<|>)))+import Control.Monad (void)+import qualified Data.Attoparsec.Text as P (Parser, anyChar, endOfInput,+ many1, option,+ space, string)+import Data.Monoid ((<>))+import qualified Data.Text as T (pack)+import Yi.Keymap (Action (YiA))+import Yi.Keymap.Vim.Common (EventString)+import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common (impureExCommand, parse)+import Yi.Keymap.Vim.Ex.Types (ExCommand (cmdAction, cmdComplete, cmdShow))+import Yi.Keymap.Vim.Tag (completeVimTag, gotoTag, nextTag, unpopTag)+import Yi.Tag (Tag (Tag))++parse :: EventString -> Maybe ExCommand+parse = Common.parse $ do+ void $ P.string "t"+ parseTag <|> parseNext++parseTag :: P.Parser ExCommand+parseTag = do+ void $ P.string "a"+ void . P.option Nothing $ Just <$> P.string "g"+ t <- P.option Nothing $ Just <$> do+ void $ P.many1 P.space+ P.many1 P.anyChar+ case t of+ Nothing -> P.endOfInput >> return (tag Nothing)+ Just t' -> return $! tag (Just (Tag (T.pack t')))++parseNext :: P.Parser ExCommand+parseNext = do+ void $ P.string "next"+ return next++tag :: Maybe Tag -> ExCommand+tag Nothing = Common.impureExCommand {+ cmdShow = "tag"+ , cmdAction = YiA unpopTag+ , cmdComplete = return ["tag"]+ }+tag (Just (Tag t)) = Common.impureExCommand {+ cmdShow = "tag " <> t+ , cmdAction = YiA $ gotoTag (Tag t) 0 Nothing+ , cmdComplete = map ("tag " <>) <$> completeVimTag t+ }++next :: ExCommand+next = Common.impureExCommand {+ cmdShow = "tnext"+ , cmdAction = YiA nextTag+ , cmdComplete = return ["tnext"]+ }
+ src/Yi/Keymap/Vim/Ex/Commands/Undo.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Keymap.Vim.Ex.Commands.Undo+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable++module Yi.Keymap.Vim.Ex.Commands.Undo (parse) where++import Yi.Buffer.Adjusted (redoB, undoB)+import Yi.Keymap (Action (BufferA))+import Yi.Keymap.Vim.Common (EventString (Ev))+import Yi.Keymap.Vim.Ex.Commands.Common (pureExCommand)+import Yi.Keymap.Vim.Ex.Types (ExCommand (cmdAction, cmdComplete, cmdShow))++parse :: EventString -> Maybe ExCommand+parse (Ev s) | s `elem` ["u", "undo"] = + Just pureExCommand {+ cmdAction = BufferA undoB+ , cmdShow = "undo"+ , cmdComplete = return ["undo"]+ }+parse (Ev s) | s `elem` ["redo"] =+ Just pureExCommand {+ cmdAction = BufferA redoB+ , cmdShow = "redo"+ , cmdComplete = return ["redo"]+ }+parse _ = Nothing
+ src/Yi/Keymap/Vim/Ex/Commands/Write.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Keymap.Vim.Ex.Commands.Write+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable++module Yi.Keymap.Vim.Ex.Commands.Write (parse) where++import Control.Applicative (Alternative ((<|>)))+import Control.Monad (void, when)+import qualified Data.Attoparsec.Text as P (anyChar, many', many1, space, string, try)+import Data.Monoid ((<>))+import qualified Data.Text as T (Text, pack)+import Yi.Buffer (BufferRef)+import Yi.Editor (printMsg)+import Yi.File (fwriteBufferE, viWrite, viWriteTo)+import Yi.Keymap (Action (YiA), YiM)+import Yi.Keymap.Vim.Common (EventString)+import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common (forAllBuffers, impureExCommand, needsSaving, parse)+import Yi.Keymap.Vim.Ex.Types (ExCommand (cmdAction, cmdShow))++parse :: EventString -> Maybe ExCommand+parse = Common.parse $+ (P.try (P.string "write") <|> P.string "w")+ *> (parseWriteAs <|> parseWrite)+ where parseWrite = do+ alls <- P.many' (P.try ( P.string "all") <|> P.string "a")+ return $! writeCmd $ not (null alls)++ parseWriteAs = do+ void $ P.many1 P.space+ filename <- T.pack <$> P.many1 P.anyChar+ return $! writeAsCmd filename++writeCmd :: Bool -> ExCommand+writeCmd allFlag = Common.impureExCommand {+ cmdShow = "write" <> if allFlag then "all" else ""+ , cmdAction = YiA $ if allFlag+ then Common.forAllBuffers tryWriteBuffer >> printMsg "All files written"+ else viWrite+ }++writeAsCmd :: T.Text -> ExCommand+writeAsCmd filename = Common.impureExCommand {+ cmdShow = "write " <> filename+ , cmdAction = YiA $ viWriteTo filename+ }++tryWriteBuffer :: BufferRef -> YiM ()+tryWriteBuffer buf = do+ ns <- Common.needsSaving buf+ when ns . void $ fwriteBufferE buf
+ src/Yi/Keymap/Vim/Ex/Commands/Yi.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Keymap.Vim.Ex.Commands.Yi+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable+++module Yi.Keymap.Vim.Ex.Commands.Yi (parse) where++import Control.Monad (void)+import qualified Data.Attoparsec.Text as P (many1, space, string, takeText)+import qualified Data.Text as T (unpack)+import Yi.Eval (execEditorAction)+import Yi.Keymap (Action (YiA))+import Yi.Keymap.Vim.Common (EventString)+import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common (impureExCommand, parse)+import Yi.Keymap.Vim.Ex.Types (ExCommand (cmdAction, cmdShow))++parse :: EventString -> Maybe ExCommand+parse = Common.parse $ do+ void $ P.string "yi"+ void $ P.many1 P.space+ cmd <- P.takeText+ return $! Common.impureExCommand {+ cmdAction = YiA $ execEditorAction (T.unpack cmd)+ , cmdShow = cmd+ }
+ src/Yi/Keymap/Vim/Ex/Eval.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Keymap.Vim.Ex.Eval+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable++module Yi.Keymap.Vim.Ex.Eval+ ( exEvalE+ , exEvalY+ ) where++import Control.Monad (void)+import Data.Monoid ((<>))+import qualified Data.Text as T (unpack)+import Yi.Editor (EditorM, MonadEditor (withEditor), withCurrentBuffer)+import Yi.Keymap (Action (BufferA, EditorA, YiA), YiM)+import Yi.Keymap.Vim.Common (EventString (_unEv))+import Yi.Keymap.Vim.Ex.Types (ExCommand (cmdAction), evStringToExCommand)++exEvalE :: [EventString -> Maybe ExCommand] -> EventString -> EditorM ()+exEvalE cmds cmdString = evalHelper id (const $ error msg) cmds cmdString+ where msg = T.unpack . _unEv $ "exEvalE got impure command" <> cmdString++exEvalY :: [EventString -> Maybe ExCommand] -> EventString -> YiM ()+exEvalY = evalHelper withEditor id++evalHelper :: MonadEditor m =>+ (EditorM () -> m ()) -> (YiM () -> m ()) ->+ [EventString -> Maybe ExCommand] -> EventString -> m ()+evalHelper pureHandler impureHandler cmds cmdString =+ case evStringToExCommand cmds cmdString of+ Just cmd -> case cmdAction cmd of+ BufferA actionB -> pureHandler $ withCurrentBuffer (void actionB)+ EditorA actionE -> pureHandler (void actionE)+ YiA actionY -> impureHandler (void actionY)+ _ -> return ()
+ src/Yi/Keymap/Vim/Ex/Types.hs view
@@ -0,0 +1,34 @@+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Keymap.Vim.Ex.Types+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable++module Yi.Keymap.Vim.Ex.Types where++import Data.Maybe (listToMaybe, mapMaybe)+import Data.Text (Text, unpack)+import Yi.Keymap (Action, YiM)+import Yi.Keymap.Vim.Common (EventString)++data ExCommand = ExCommand {+ cmdComplete :: YiM [Text]+ , cmdIsPure :: Bool+ , cmdAction :: Action+ , cmdAcceptsRange :: Bool+ , cmdShow :: Text+}++instance Show ExCommand where+ show = unpack . cmdShow++data LineRange+ = MarkRange String String -- ^ 'a,'b+ | FullRange -- ^ %+ | CurrentLineRange++evStringToExCommand :: [EventString -> Maybe ExCommand] -> EventString -> Maybe ExCommand+evStringToExCommand parsers s = listToMaybe . mapMaybe ($ s) $ parsers
+ src/Yi/Keymap/Vim/ExMap.hs view
@@ -0,0 +1,195 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Keymap.Vim.ExMap+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable+--+-- I'm a module waiting for some kind soul to give me a commentary!++module Yi.Keymap.Vim.ExMap (defExMap) where++import Control.Monad (when)+import Data.Char (isSpace)+import Data.Maybe (fromJust)+import Data.Monoid ((<>))+import qualified Data.Text as T (Text, drop, head, length, split, unwords)+import System.FilePath (isPathSeparator)+import Yi.Buffer.Adjusted hiding (Insert)+import Yi.Editor+import Yi.History (historyDown, historyFinish, historyPrefixSet, historyUp)+import Yi.Keymap (YiM)+import Yi.Keymap.Vim.Common+import Yi.Keymap.Vim.Ex+import Yi.Keymap.Vim.StateUtils (modifyStateE, resetCountE, switchModeE)+import Yi.Keymap.Vim.Utils (matchFromBool)+import qualified Yi.Rope as R (fromText, toText)+import Yi.String (commonTPrefix')++defExMap :: [EventString -> Maybe ExCommand] -> [VimBinding]+defExMap cmdParsers =+ [ exitBinding+ , completionBinding cmdParsers+ , finishBindingY cmdParsers+ , finishBindingE cmdParsers+ , failBindingE+ , historyBinding+ , printable+ ]++completionBinding :: [EventString -> Maybe ExCommand] -> VimBinding+completionBinding commandParsers = VimBindingY f+ where+ f "<Tab>" (VimState { vsMode = Ex }) = WholeMatch $ do+ commandString <- Ev . R.toText <$> withCurrentBuffer elemsB+ case evStringToExCommand commandParsers commandString of+ Just cmd -> complete cmd+ Nothing -> return ()+ return Drop+ f _ _ = NoMatch+ complete :: ExCommand -> YiM ()+ complete cmd = do+ possibilities <- cmdComplete cmd+ case possibilities of+ [] -> return ()+ (s:[]) -> updateCommand s+ ss -> do+ let s = commonTPrefix' ss+ updateCommand s+ printMsg . T.unwords . fmap (dropToLastWordOf s) $ ss++ updateCommand :: T.Text -> YiM ()+ updateCommand s = do+ withCurrentBuffer $ replaceBufferContent (R.fromText s)+ withEditor $ do+ historyPrefixSet s+ modifyStateE $ \state -> state {+ vsOngoingInsertEvents = Ev s+ }++-- | TODO: verify whether 'T.split' works fine here in place of+-- @split@'s 'splitWhen'. If something breaks then you should use+-- 'splitWhen' + 'T.pack'/'T.unpack'.+dropToLastWordOf :: T.Text -> T.Text -> T.Text+dropToLastWordOf s = case reverse . T.split isWordSep $ s of+ [] -> id+ [_] -> id+ _ : ws -> T.drop . succ . T.length . T.unwords $ ws+ where+ isWordSep :: Char -> Bool+ isWordSep c = isPathSeparator c || isSpace c++exitEx :: Bool -> EditorM ()+exitEx success = do+ when success historyFinish+ resetCountE+ switchModeE Normal+ closeBufferAndWindowE+ withCurrentBuffer $ setVisibleSelection False++exitBinding :: VimBinding+exitBinding = VimBindingE f+ where+ f "<CR>" (VimState { vsMode = Ex, vsOngoingInsertEvents = Ev "" })+ = WholeMatch action+ f evs (VimState { vsMode = Ex })+ = action <$ matchFromBool (evs `elem` ["<Esc>", "<C-c>"])+ f _ _ = NoMatch+ action = exitEx False >> return Drop++finishBindingY :: [EventString -> Maybe ExCommand] -> VimBinding+finishBindingY commandParsers = VimBindingY f+ where f evs state = finishAction commandParsers exEvalY+ <$ finishPrereq commandParsers (not . cmdIsPure) evs state+++finishBindingE :: [EventString -> Maybe ExCommand] -> VimBinding+finishBindingE commandParsers = VimBindingE f+ where f evs state = finishAction commandParsers exEvalE+ <$ finishPrereq commandParsers cmdIsPure evs state++finishPrereq :: [EventString -> Maybe ExCommand] -> (ExCommand -> Bool)+ -> EventString -> VimState -> MatchResult ()+finishPrereq commandParsers cmdPred evs s =+ matchFromBool . and $+ [ vsMode s == Ex+ , evs `elem` ["<CR>", "<C-m>"]+ , case evStringToExCommand commandParsers (vsOngoingInsertEvents s) of+ Just cmd -> cmdPred cmd+ _ -> False+ ]++finishAction :: MonadEditor m => [EventString -> Maybe ExCommand] ->+ ([EventString -> Maybe ExCommand] -> EventString -> m ()) -> m RepeatToken+finishAction commandParsers execute = do+ s <- withEditor $ withCurrentBuffer elemsB+ withEditor $ exitEx True+ execute commandParsers (Ev $ R.toText s) -- TODO+ return Drop++failBindingE :: VimBinding+failBindingE = VimBindingE f+ where f evs s | vsMode s == Ex && evs == "<CR>"+ = WholeMatch $ do+ exitEx False+ state <- getEditorDyn+ printMsg . _unEv $ "Not an editor command: " <> vsOngoingInsertEvents state+ return Drop+ f _ _ = NoMatch++printable :: VimBinding+printable = VimBindingE f+ where f evs (VimState { vsMode = Ex }) = WholeMatch $ editAction evs+ f _ _ = NoMatch++historyBinding :: VimBinding+historyBinding = VimBindingE f+ where f evs (VimState { vsMode = Ex }) | evs `elem` fmap fst binds+ = WholeMatch $ do+ fromJust $ lookup evs binds+ command <- withCurrentBuffer elemsB+ modifyStateE $ \state -> state {+ vsOngoingInsertEvents = Ev $ R.toText command+ }+ return Drop+ f _ _ = NoMatch+ binds =+ [ ("<Up>", historyUp)+ , ("<C-p>", historyUp)+ , ("<Down>", historyDown)+ , ("<C-n>", historyDown)+ ]++editAction :: EventString -> EditorM RepeatToken+editAction (Ev evs) = do+ withCurrentBuffer $ case evs of+ "<BS>" -> bdeleteB+ "<C-h>" -> bdeleteB+ "<C-w>" -> do+ r <- regionOfPartNonEmptyB unitViWordOnLine Backward+ deleteRegionB r+ "<C-r>" -> return () -- TODO+ "<lt>" -> insertB '<'+ "<Del>" -> deleteB Character Forward+ "<Left>" -> moveXorSol 1+ "<C-b>" -> moveXorSol 1+ "<Right>" -> moveXorEol 1+ "<C-f>" -> moveXorEol 1+ "<Home>" -> moveToSol+ "<C-a>" -> moveToSol+ "<End>" -> moveToEol+ "<C-e>" -> moveToEol+ "<C-u>" -> moveToSol >> deleteToEol+ "<C-k>" -> deleteToEol+ evs' -> case T.length evs' of+ 1 -> insertB $ T.head evs'+ _ -> error $ "Unhandled event " ++ show evs' ++ " in ex mode"+ command <- R.toText <$> withCurrentBuffer elemsB+ historyPrefixSet command+ modifyStateE $ \state -> state {+ vsOngoingInsertEvents = Ev command+ }+ return Drop
+ src/Yi/Keymap/Vim/InsertMap.hs view
@@ -0,0 +1,238 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Keymap.Vim.InsertMap+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable++module Yi.Keymap.Vim.InsertMap (defInsertMap) where++import Prelude hiding (head)++import Lens.Micro.Platform (use)+import Control.Monad (forM, liftM2, replicateM_, void, when)+import Data.Char (isDigit)+import Data.List.NonEmpty (NonEmpty (..), head, toList)+import Data.Monoid ((<>))+import qualified Data.Text as T (pack, unpack)+import qualified Yi.Buffer as B (bdeleteB, deleteB, deleteRegionB, insertB, insertN)+import Yi.Buffer.Adjusted as BA hiding (Insert)+import Yi.Editor (EditorM, getEditorDyn, withCurrentBuffer)+import Yi.Event (Event)+import Yi.Keymap.Vim.Common+import Yi.Keymap.Vim.Digraph (charFromDigraph)+import Yi.Keymap.Vim.EventUtils (eventToEventString, parseEvents)+import Yi.Keymap.Vim.Motion (Move (Move), stringToMove)+import Yi.Keymap.Vim.StateUtils+import Yi.Keymap.Vim.Utils (selectBinding, selectPureBinding)+import Yi.Monad (whenM)+import qualified Yi.Rope as R (fromString, fromText)+import Yi.TextCompletion (CompletionScope (..), completeWordB)++defInsertMap :: [(String, Char)] -> [VimBinding]+defInsertMap digraphs =+ [rawPrintable] <> specials digraphs <> [printable]++specials :: [(String, Char)] -> [VimBinding]+specials digraphs =+ [exitBinding digraphs, pasteRegisterBinding, digraphBinding digraphs+ , oneshotNormalBinding, completionBinding, cursorBinding]++exitBinding :: [(String, Char)] -> VimBinding+exitBinding digraphs = VimBindingE f+ where+ f :: EventString -> VimState -> MatchResult (EditorM RepeatToken)+ f evs (VimState { vsMode = (Insert _) })+ | evs `elem` ["<Esc>", "<C-c>"]+ = WholeMatch $ do+ count <- getCountE+ (Insert starter) <- fmap vsMode getEditorDyn+ when (count > 1) $ do+ inputEvents <- fmap (parseEvents . vsOngoingInsertEvents) getEditorDyn+ replicateM_ (count - 1) $ do+ when (starter `elem` ['O', 'o']) $ withCurrentBuffer $ insertB '\n'+ replay digraphs inputEvents+ modifyStateE $ \s -> s { vsOngoingInsertEvents = mempty }+ withCurrentBuffer $ moveXorSol 1+ modifyStateE $ \s -> s { vsSecondaryCursors = mempty }+ resetCountE+ switchModeE Normal+ withCurrentBuffer $ whenM isCurrentLineAllWhiteSpaceB $ moveToSol >> deleteToEol+ return Finish+ f _ _ = NoMatch++rawPrintable :: VimBinding+rawPrintable = VimBindingE f+ where+ f :: EventString -> VimState -> MatchResult (EditorM RepeatToken)+ f evs s@(VimState { vsMode = (Insert _)})+ | vsPaste s && evs `notElem` ["<Esc>", "<C-c>"]+ = WholeMatch . withCurrentBuffer $ do+ case evs of+ "<lt>" -> insertB '<'+ "<CR>" -> newlineB+ "<Tab>" -> insertB '\t'+ "<BS>" -> bdeleteB+ "<C-h>" -> bdeleteB+ "<Del>" -> deleteB Character Forward+ "<Home>" -> moveToSol+ "<End>" -> moveToEol+ "<PageUp>" -> scrollScreensB (-1)+ "<PageDown>" -> scrollScreensB 1+ c -> insertN (R.fromText $ _unEv c)+ return Continue+ f _ _ = NoMatch++replay :: [(String, Char)] -> [Event] -> EditorM ()+replay _ [] = return ()+replay digraphs (e1:es1) = do+ state <- getEditorDyn+ let recurse = replay digraphs+ evs1 = eventToEventString e1+ bindingMatch1 = selectPureBinding evs1 state (defInsertMap digraphs)+ case bindingMatch1 of+ WholeMatch action -> void action >> recurse es1+ PartialMatch -> case es1 of+ [] -> return ()+ (e2:es2) -> do+ let evs2 = evs1 <> eventToEventString e2+ bindingMatch2 = selectPureBinding evs2 state (defInsertMap digraphs)+ case bindingMatch2 of+ WholeMatch action -> void action >> recurse es2+ _ -> recurse es2+ _ -> recurse es1++oneshotNormalBinding :: VimBinding+oneshotNormalBinding = VimBindingE (f . T.unpack . _unEv)+ where+ f "<C-o>" (VimState { vsMode = Insert _ }) = PartialMatch+ f ('<':'C':'-':'o':'>':evs) (VimState { vsMode = Insert _ }) =+ action evs <$ stringToMove (Ev . T.pack $ dropWhile isDigit evs)+ f _ _ = NoMatch+ action evs = do+ let (countString, motionCmd) = span isDigit evs+ WholeMatch (Move _style _isJump move) = stringToMove . Ev . T.pack $ motionCmd+ withCurrentBuffer $ move (if null countString then Nothing else Just (read countString))+ return Continue++pasteRegisterBinding :: VimBinding+pasteRegisterBinding = VimBindingE (f . T.unpack . _unEv)+ where f "<C-r>" (VimState { vsMode = Insert _ }) = PartialMatch+ f ('<':'C':'-':'r':'>':regName:[]) (VimState { vsMode = Insert _ })+ = WholeMatch $ do+ mr <- getRegisterE regName+ case mr of+ Nothing -> return ()+ Just (Register _style rope) -> withCurrentBuffer $ insertRopeWithStyleB rope Inclusive+ return Continue+ f _ _ = NoMatch++digraphBinding :: [(String, Char)] -> VimBinding+digraphBinding digraphs = VimBindingE (f . T.unpack . _unEv)+ where f ('<':'C':'-':'k':'>':c1:c2:[]) (VimState { vsMode = Insert _ })+ = WholeMatch $ do+ maybe (return ()) (withCurrentBuffer . insertB) $ charFromDigraph digraphs c1 c2+ return Continue+ f ('<':'C':'-':'k':'>':_c1:[]) (VimState { vsMode = Insert _ }) = PartialMatch+ f "<C-k>" (VimState { vsMode = Insert _ }) = PartialMatch+ f _ _ = NoMatch++printable :: VimBinding+printable = VimBindingE f+ where f evs state@(VimState { vsMode = Insert _ } ) =+ case selectBinding evs state (specials undefined) of+ NoMatch -> WholeMatch (printableAction evs)+ _ -> NoMatch+ f _ _ = NoMatch++printableAction :: EventString -> EditorM RepeatToken+printableAction evs = do+ saveInsertEventStringE evs+ currentCursor <- withCurrentBuffer pointB+ IndentSettings et _ sw <- withCurrentBuffer indentSettingsB+ secondaryCursors <- fmap vsSecondaryCursors getEditorDyn+ let allCursors = currentCursor :| secondaryCursors+ marks <- withCurrentBuffer $ forM' allCursors $ \cursor -> do+ moveTo cursor+ getMarkB Nothing++ -- Using autoindenting with multiple cursors+ -- is just too broken.+ let (insertB', insertN', deleteB', bdeleteB', deleteRegionB') =+ if null secondaryCursors+ then (BA.insertB, BA.insertN, BA.deleteB,+ BA.bdeleteB, BA.deleteRegionB)+ else (B.insertB, B.insertN, B.deleteB,+ B.bdeleteB, B.deleteRegionB)++ let bufAction = case T.unpack . _unEv $ evs of+ (c:[]) -> insertB' c+ "<CR>" -> do+ isOldLineEmpty <- isCurrentLineEmptyB+ shouldTrimOldLine <- isCurrentLineAllWhiteSpaceB+ if isOldLineEmpty+ then newlineB+ else if shouldTrimOldLine+ then savingPointB $ do+ moveToSol+ newlineB+ else do+ newlineB+ indentAsTheMostIndentedNeighborLineB+ firstNonSpaceB+ "<Tab>" -> do+ if et+ then insertN' . R.fromString $ replicate sw ' '+ else insertB' '\t'+ "<C-t>" -> modifyIndentB (+ sw)+ "<C-d>" -> modifyIndentB (max 0 . subtract sw)+ "<C-e>" -> insertCharWithBelowB+ "<C-y>" -> insertCharWithAboveB+ "<BS>" -> bdeleteB'+ "<C-h>" -> bdeleteB'+ "<Home>" -> moveToSol+ "<End>" -> moveToEol >> leftOnEol+ "<PageUp>" -> scrollScreensB (-1)+ "<PageDown>" -> scrollScreensB 1+ "<Del>" -> deleteB' Character Forward+ "<C-w>" -> deleteRegionB' =<< regionOfPartNonEmptyB unitViWordOnLine Backward+ "<C-u>" -> bdeleteLineB+ "<lt>" -> insertB' '<'+ evs' -> error $ "Unhandled event " <> show evs' <> " in insert mode"++ updatedCursors <- withCurrentBuffer $ do+ updatedCursors <- forM' marks $ \mark -> do+ moveTo =<< use (markPointA mark)+ bufAction+ pointB+ mapM_ deleteMarkB $ toList marks+ moveTo $ head updatedCursors+ return $ toList updatedCursors+ modifyStateE $ \s -> s { vsSecondaryCursors = drop 1 updatedCursors }+ return Continue+ where+ forM' :: Monad m => NonEmpty a -> (a -> m b) -> m (NonEmpty b)+ forM' (x :| xs) f = liftM2 (:|) (f x) (forM xs f)++completionBinding :: VimBinding+completionBinding = VimBindingE (f . T.unpack . _unEv)+ where f evs (VimState { vsMode = (Insert _) })+ | evs `elem` ["<C-n>", "<C-p>"]+ = WholeMatch $ do+ let _direction = if evs == "<C-n>" then Forward else Backward+ completeWordB FromAllBuffers+ return Continue+ f _ _ = NoMatch++cursorBinding :: VimBinding+cursorBinding = VimBindingE f+ where f evs (VimState { vsMode = (Insert _) })+ | evs `elem` ["<Up>", "<Left>", "<Down>", "<Right>"]+ = WholeMatch $ do+ let WholeMatch (Move _style _isJump move) = stringToMove evs+ withCurrentBuffer $ move Nothing+ return Continue+ f _ _ = NoMatch
+ src/Yi/Keymap/Vim/MatchResult.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE DeriveFunctor #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Keymap.Vim.MatchResult+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable++module Yi.Keymap.Vim.MatchResult where++import Control.Applicative (Alternative ((<|>), empty))++data MatchResult a = NoMatch+ | PartialMatch+ | WholeMatch a+ deriving Functor++instance Applicative MatchResult where+ pure = WholeMatch+ WholeMatch f <*> WholeMatch x = WholeMatch (f x)+ _ <*> _ = NoMatch++instance Alternative MatchResult where+ empty = NoMatch+ WholeMatch x <|> _ = WholeMatch x+ _ <|> WholeMatch x = WholeMatch x+ PartialMatch <|> _ = PartialMatch+ _ <|> PartialMatch = PartialMatch+ _ <|> _ = NoMatch++instance Show (MatchResult a) where+ show (WholeMatch _) = "WholeMatch"+ show PartialMatch = "PartialMatch"+ show NoMatch = "NoMatch"++matchFromBool :: Bool -> MatchResult ()+matchFromBool b = if b then WholeMatch () else NoMatch++matchFromMaybe :: Maybe a -> MatchResult a+matchFromMaybe Nothing = NoMatch+matchFromMaybe (Just a) = WholeMatch a
+ src/Yi/Keymap/Vim/Motion.hs view
@@ -0,0 +1,225 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Keymap.Vim.Operator+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable+--+-- TODO:+--+-- respecting wrap in gj, g0, etc+--+-- gm, go+-- ]], [[, [], ][+-- [(, [{, ]), ]}+-- ]m, ]M, [m, [M+-- [#, ]#+-- [*, [/, ]*, ]/+--+-- Traversing changelist++-- TODO:+-- from vim help:+--+-- Special case: "cw" and "cW" are treated like "ce" and "cE" if the cursor is+-- on a non-blank. This is because "cw" is interpreted as change-word, and a+-- word does not include the following white space. {Vi: "cw" when on a blank+-- followed by other blanks changes only the first blank; this is probably a+-- bug, because "dw" deletes all the blanks}+--+-- Another special case: When using the "w" motion in combination with an+-- operator and the last word moved over is at the end of a line, the end of+-- that word becomes the end of the operated text, not the first word in the+-- next line.+--+-- The original Vi implementation of "e" is buggy. For example, the "e" command+-- will stop on the first character of a line if the previous line was empty.+-- But when you use "2e" this does not happen. In Vim "ee" and "2e" are the+-- same, which is more logical. However, this causes a small incompatibility+-- between Vi and Vim.++module Yi.Keymap.Vim.Motion+ ( Move(..)+ , CountedMove(..)+ , stringToMove+ , regionOfMoveB+ , changeMoveStyle+ ) where++import Prelude hiding (repeat)++import Control.Applicative (Alternative ((<|>)))+import Lens.Micro.Platform (_3, over, use)+import Control.Monad (replicateM_, void, when, (<=<))+import Data.Maybe (fromMaybe)+import Data.Monoid ((<>))+import qualified Data.Text as T (unpack)+import Yi.Buffer.Adjusted+import Yi.Keymap.Vim.Common (EventString (_unEv), MatchResult (..), lookupBestMatch)+import Yi.Keymap.Vim.StyledRegion (StyledRegion (..), normalizeRegion)++data Move = Move {+ moveStyle :: !RegionStyle+ , moveIsJump :: !Bool+ , moveAction :: Maybe Int -> BufferM ()+ }++data CountedMove = CountedMove !(Maybe Int) !Move++stringToMove :: EventString -> MatchResult Move+stringToMove s = lookupMove s+ -- TODO: get rid of unpack+ <|> matchGotoCharMove (T.unpack . _unEv $ s)+ <|> matchGotoMarkMove (T.unpack . _unEv $ s)++lookupMove :: EventString -> MatchResult Move+lookupMove s = findMoveWithStyle Exclusive exclusiveMotions+ <|> findMoveWithStyle Inclusive inclusiveMotions+ <|> findMoveWithStyle LineWise linewiseMotions+ where findMoveWithStyle style choices =+ fmap (uncurry (Move style)) (lookupBestMatch s (fmap regroup choices))+ regroup (a, b, c) = (a, (b, c))++changeMoveStyle :: (RegionStyle -> RegionStyle) -> Move -> Move+changeMoveStyle smod (Move s j m) = Move (smod s) j m++-- Linewise motions which treat no count as being the same as a count of 1.+linewiseMotions :: [(EventString, Bool, Maybe Int -> BufferM ())]+linewiseMotions = fmap withDefaultCount+ [ ("j", False, void . lineMoveRel)+ , ("gj", False, void . lineMoveVisRel)+ , ("gk", False, void . lineMoveVisRel . negate)+ , ("k", False, void . lineMoveRel . negate)+ , ("<Down>", False, void . lineMoveRel)+ , ("<Up>", False, void . lineMoveRel . negate)+ , ("-", False, const firstNonSpaceB <=< void . lineMoveRel . negate)+ , ("+", False, const firstNonSpaceB <=< void . lineMoveRel)+ , ("_", False, \n -> do+ when (n > 1) $ void $ lineMoveRel (n - 1)+ firstNonSpaceB)+ , ("gg", True, void . gotoLn) -- TODO: save column+ , ("<C-b>", False, scrollScreensB . negate)+ , ("<PageUp>", False, scrollScreensB . negate)+ , ("<C-f>", False, scrollScreensB)+ , ("<PageDown>", False, scrollScreensB)+ , ("H", True, downFromTosB . pred)+ , ("M", True, const middleB)+ , ("L", True, upFromBosB . pred)+ ]+ <> [ ("G", True, gotoXOrEOF) ]+++-- Exclusive motions which treat no count as being the same as a count of 1.+exclusiveMotions :: [(EventString, Bool, Maybe Int -> BufferM ())]+exclusiveMotions = fmap withDefaultCount+ [ ("h", False, moveXorSol)+ , ("l", False, moveXorEol)+ , ("<Left>", False, moveXorSol)+ , ("<Right>", False, moveXorEol)+ , ("w", False, moveForwardB unitViWord)+ , ("W", False, moveForwardB unitViWORD)+ , ("b", False, moveBackwardB unitViWord)+ , ("B", False, moveBackwardB unitViWORD)+ , ("^", False, const firstNonSpaceB)+ , ("g^", False, const firstNonSpaceB) -- TODO: respect wrapping+ , ("g0", False, const moveToSol) -- TODO: respect wrapping+ , ("<Home>", False, const moveToSol)+ -- "0" sort of belongs here, but is currently handled as a special case in some modes+ , ("|", False, \n -> moveToSol >> moveXorEol (n - 1))+ , ("(", True, moveBackwardB unitSentence)+ , (")", True, moveForwardB unitSentence)+ , ("{", True, moveBackwardB unitEmacsParagraph)+ , ("}", True, moveForwardB unitEmacsParagraph)+ ]++-- Inclusive motions which treat no count as being the same as a count of 1.+inclusiveMotions :: [(EventString, Bool, Maybe Int -> BufferM ())]+inclusiveMotions = fmap (\(key, action) -> (key, False, action . fromMaybe 1))+ [+ -- Word motions+ ("e", repeat $ genMoveB unitViWord (Forward, InsideBound) Forward)+ , ("E", repeat $ genMoveB unitViWORD (Forward, InsideBound) Forward)+ , ("ge", repeat $ genMoveB unitViWord (Forward, InsideBound) Backward)+ , ("gE", repeat $ genMoveB unitViWORD (Forward, InsideBound) Backward)++ -- Intraline stuff+ , ("g$", \n -> do+ when (n > 1) $ void $ lineMoveRel (n - 1)+ moveToEol)+ , ("<End>", const $ moveToEol >> leftOnEol)+ , ("$", \n -> do+ when (n > 1) $ void $ lineMoveRel (n - 1)+ moveToEol+ leftOnEol)+ , ("g_", \n -> do+ when (n > 1) $ void $ lineMoveRel (n - 1)+ lastNonSpaceB)+ ]+ <>+ [("%", True,+ \maybeCount -> case maybeCount of+ Nothing -> findMatchingPairB+ Just percent -> movePercentageFileB percent)+ ]++repeat :: BufferM () -> Int -> BufferM ()+repeat = flip replicateM_++regionOfMoveB :: CountedMove -> BufferM StyledRegion+regionOfMoveB = normalizeRegion <=< regionOfMoveB'++regionOfMoveB' :: CountedMove -> BufferM StyledRegion+regionOfMoveB' (CountedMove n (Move style _isJump move)) = do+ region <- mkRegion <$> pointB <*> destinationOfMoveB+ (move n >> when (style == Inclusive) leftOnEol)+ return $! StyledRegion style region++moveForwardB, moveBackwardB :: TextUnit -> Int -> BufferM ()+moveForwardB unit = repeat $ genMoveB unit (Backward,InsideBound) Forward+moveBackwardB unit = repeat $ moveB unit Backward++gotoXOrEOF :: Maybe Int -> BufferM ()+gotoXOrEOF n = case n of+ Nothing -> botB >> moveToSol+ Just n' -> gotoLn n' >> moveToSol++withDefaultCount :: (EventString, Bool, Int -> BufferM ()) -> (EventString, Bool, Maybe Int -> BufferM ())+withDefaultCount = over _3 (. fromMaybe 1)++matchGotoMarkMove :: String -> MatchResult Move+matchGotoMarkMove (m:_) | m `notElem` ['\'', '`'] = NoMatch+matchGotoMarkMove (_:[]) = PartialMatch+matchGotoMarkMove (m:c:[]) = WholeMatch $ Move style True action+ where style = if m == '`' then Inclusive else LineWise+ action _mcount = do+ mmark <- mayGetMarkB [c]+ case mmark of+ Nothing -> fail $ "Mark " <> show c <> " not set"+ Just mark -> moveTo =<< use (markPointA mark)+matchGotoMarkMove _ = NoMatch++matchGotoCharMove :: String -> MatchResult Move+matchGotoCharMove (m:[]) | m `elem` ('f' : "FtT") = PartialMatch+matchGotoCharMove (m:"<lt>") | m `elem` ('f' : "FtT") = matchGotoCharMove (m:"<")+matchGotoCharMove (m:c:[]) | m `elem` ('f' : "FtT") = WholeMatch $ Move style False action+ where (dir, style, move) =+ case m of+ 'f' -> (Forward, Inclusive, nextCInLineInc c)+ 't' -> (Forward, Inclusive, nextCInLineExc c)+ 'F' -> (Backward, Exclusive, prevCInLineInc c)+ 'T' -> (Backward, Exclusive, prevCInLineExc c)+ _ -> error "can't happen"+ action mcount = do+ let count = fromMaybe 1 mcount+ p0 <- pointB+ replicateM_ (count - 1) $ do+ move+ moveB Character dir+ p1 <- pointB+ move+ p2 <- pointB+ when (p1 == p2) $ moveTo p0+matchGotoCharMove _ = NoMatch
+ src/Yi/Keymap/Vim/NormalMap.hs view
@@ -0,0 +1,521 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Keymap.Vim.NormalMap+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable++module Yi.Keymap.Vim.NormalMap (defNormalMap) where++import Prelude hiding (lookup)++import Lens.Micro.Platform (use, (.=))+import Control.Monad (replicateM_, unless, void, when)+import Data.Char (ord)+import Data.HashMap.Strict (lookup, singleton)+import Data.List (group)+import Data.Maybe (fromMaybe)+import Data.Monoid ((<>))+import qualified Data.Text as T (drop, empty, pack, replicate, unpack)+import System.Directory (doesFileExist)+import System.FriendlyPath (expandTilda)+import Yi.Buffer.Adjusted hiding (Insert)+import Yi.Core (closeWindow, quitEditor)+import Yi.Editor+import Yi.Event (Event (Event), Key (KASCII, KEnter, KEsc, KTab), Modifier (MCtrl))+import Yi.File (fwriteE, openNewFile)+import Yi.History (historyPrefixSet, historyStart)+import Yi.Keymap (YiM)+import Yi.Keymap.Keys (char, ctrlCh, spec)+import Yi.Keymap.Vim.Common+import Yi.Keymap.Vim.Eval (scheduleActionStringForEval)+import Yi.Keymap.Vim.Motion (CountedMove (CountedMove), regionOfMoveB, stringToMove)+import Yi.Keymap.Vim.Operator (VimOperator (..), opChange, opDelete, opYank)+import Yi.Keymap.Vim.Search (doVimSearch)+import Yi.Keymap.Vim.StateUtils+import Yi.Keymap.Vim.StyledRegion (StyledRegion (StyledRegion), transformCharactersInLineN)+import Yi.Keymap.Vim.Tag (gotoTag, popTag)+import Yi.Keymap.Vim.Utils+import Yi.MiniBuffer (spawnMinibufferE)+import Yi.Misc (printFileInfoE)+import Yi.Monad (maybeM, whenM)+import Yi.Regex (makeSearchOptsM, seInput)+import qualified Yi.Rope as R (fromText, null, toString, toText)+import Yi.Search (getRegexE, isearchInitE, makeSimpleSearch, setRegexE)+import Yi.String (showT)+import Yi.Tag (Tag (..))+import Yi.Utils (io)++data EOLStickiness = Sticky | NonSticky deriving Eq++mkDigitBinding :: Char -> VimBinding+mkDigitBinding c = mkBindingE Normal Continue (char c, return (), mutate)+ where+ mutate vs@(VimState {vsCount = Nothing}) = vs { vsCount = Just d }+ mutate vs@(VimState {vsCount = Just count}) =+ vs { vsCount = Just $ count * 10 + d }+ d = ord c - ord '0'++defNormalMap :: [VimOperator] -> [VimBinding]+defNormalMap operators =+ [recordMacroBinding, finishRecordingMacroBinding, playMacroBinding] <>+ [zeroBinding, repeatBinding, motionBinding, searchBinding] <>+ [chooseRegisterBinding, setMarkBinding] <>+ fmap mkDigitBinding ['1' .. '9'] <>+ operatorBindings operators <>+ finishingBingings <>+ continuingBindings <>+ nonrepeatableBindings <>+ jumpBindings <>+ fileEditBindings <>+ [tabTraversalBinding] <>+ [tagJumpBinding, tagPopBinding]++tagJumpBinding :: VimBinding+tagJumpBinding = mkBindingY Normal (Event (KASCII ']') [MCtrl], f, id)+ where f = withCurrentBuffer readCurrentWordB >>= g . Tag . R.toText+ g tag = gotoTag tag 0 Nothing++tagPopBinding :: VimBinding+tagPopBinding = mkBindingY Normal (Event (KASCII 't') [MCtrl], f, id)+ where f = popTag++motionBinding :: VimBinding+motionBinding = mkMotionBinding Drop $+ \m -> case m of+ Normal -> True+ _ -> False++chooseRegisterBinding :: VimBinding+chooseRegisterBinding = mkChooseRegisterBinding ((== Normal) . vsMode)++zeroBinding :: VimBinding+zeroBinding = VimBindingE f+ where f "0" (VimState {vsMode = Normal}) = WholeMatch $ do+ currentState <- getEditorDyn+ case vsCount currentState of+ Just c -> do+ setCountE (10 * c)+ return Continue+ Nothing -> do+ withCurrentBuffer moveToSol+ resetCountE+ withCurrentBuffer $ stickyEolA .= False+ return Drop+ f _ _ = NoMatch++repeatBinding :: VimBinding+repeatBinding = VimBindingE (f . T.unpack . _unEv)+ where+ f "." (VimState {vsMode = Normal}) = WholeMatch $ do+ currentState <- getEditorDyn+ case vsRepeatableAction currentState of+ Nothing -> return ()+ Just (RepeatableAction prevCount (Ev actionString)) -> do+ let count = showT $ fromMaybe prevCount (vsCount currentState)+ scheduleActionStringForEval . Ev $ count <> actionString+ resetCountE+ return Drop+ f _ _ = NoMatch++jumpBindings :: [VimBinding]+jumpBindings = fmap (mkBindingE Normal Drop)+ [ (ctrlCh 'o', jumpBackE, id)+ , (spec KTab, jumpForwardE, id)+ , (ctrlCh '^', controlCarrot, resetCount)+ , (ctrlCh '6', controlCarrot, resetCount)+ ]+ where+ controlCarrot = alternateBufferE . (+ (-1)) =<< getCountE++finishingBingings :: [VimBinding]+finishingBingings = fmap (mkStringBindingE Normal Finish)+ [ ("x", cutCharE Forward NonSticky =<< getCountE, resetCount)+ , ("<Del>", cutCharE Forward NonSticky =<< getCountE, resetCount)+ , ("X", cutCharE Backward NonSticky =<< getCountE, resetCount)++ , ("D",+ do region <- withCurrentBuffer $ regionWithTwoMovesB (return ()) moveToEol+ void $ operatorApplyToRegionE opDelete 1 $ StyledRegion Exclusive region+ , id)++ -- Pasting+ , ("p", pasteAfter, id)+ , ("P", pasteBefore, id)++ -- Miscellaneous.+ , ("~", do+ count <- getCountE+ withCurrentBuffer $ do+ transformCharactersInLineN count switchCaseChar+ leftOnEol+ , resetCount)+ , ("J", do+ count <- fmap (flip (-) 1 . max 2) getCountE+ withCurrentBuffer $ do+ (StyledRegion s r) <- case stringToMove "j" of+ WholeMatch m -> regionOfMoveB $ CountedMove (Just count) m+ _ -> error "can't happen"+ void $ lineMoveRel $ count - 1+ moveToEol+ joinLinesB =<< convertRegionToStyleB r s+ , resetCount)+ ]++pasteBefore :: EditorM ()+pasteBefore = do+ -- TODO: use count+ register <- getRegisterE . vsActiveRegister =<< getEditorDyn+ case register of+ Nothing -> return ()+ Just (Register LineWise rope) -> withCurrentBuffer $ unless (R.null rope) $+ -- Beware of edge cases ahead+ insertRopeWithStyleB (addNewLineIfNecessary rope) LineWise+ Just (Register style rope) -> withCurrentBuffer $ pasteInclusiveB rope style++pasteAfter :: EditorM ()+pasteAfter = do+ -- TODO: use count+ register <- getRegisterE . vsActiveRegister =<< getEditorDyn+ case register of+ Nothing -> return ()+ Just (Register LineWise rope) -> withCurrentBuffer $ do+ -- Beware of edge cases ahead+ moveToEol+ eof <- atEof+ when eof $ insertB '\n'+ rightB+ insertRopeWithStyleB (addNewLineIfNecessary rope) LineWise+ when eof $ savingPointB $ do+ newSize <- sizeB+ moveTo (newSize - 1)+ curChar <- readB+ when (curChar == '\n') $ deleteN 1+ Just (Register style rope) -> withCurrentBuffer $ do+ whenM (fmap not atEol) rightB+ pasteInclusiveB rope style++operatorBindings :: [VimOperator] -> [VimBinding]+operatorBindings = fmap mkOperatorBinding+ where+ mkT (Op o) = (Ev o, return (), switchMode . NormalOperatorPending $ Op o)+ mkOperatorBinding (VimOperator {operatorName = opName}) =+ mkStringBindingE Normal Continue $ mkT opName++continuingBindings :: [VimBinding]+continuingBindings = fmap (mkStringBindingE Normal Continue)+ [ ("r", return (), switchMode ReplaceSingleChar) -- TODO make it just a binding++ -- Transition to insert mode+ , ("i", return (), switchMode $ Insert 'i')+ , ("<Ins>", return (), switchMode $ Insert 'i')+ , ("I", withCurrentBuffer firstNonSpaceB, switchMode $ Insert 'I')+ , ("a", withCurrentBuffer $ moveXorEol 1, switchMode $ Insert 'a')+ , ("A", withCurrentBuffer moveToEol, switchMode $ Insert 'A')+ , ("o", withCurrentBuffer $ do+ moveToEol+ newlineB+ indentAsTheMostIndentedNeighborLineB+ , switchMode $ Insert 'o')+ , ("O", withCurrentBuffer $ do+ moveToSol+ newlineB+ leftB+ indentAsNextB+ , switchMode $ Insert 'O')++ -- Transition to visual+ , ("v", enableVisualE Inclusive, resetCount . switchMode (Visual Inclusive))+ , ("V", enableVisualE LineWise, resetCount . switchMode (Visual LineWise))+ , ("<C-v>", enableVisualE Block, resetCount . switchMode (Visual Block))+ ]++nonrepeatableBindings :: [VimBinding]+nonrepeatableBindings = fmap (mkBindingE Normal Drop)+ [ (spec KEsc, return (), resetCount)+ , (ctrlCh 'c', return (), resetCount)++ -- Changing+ , (char 'C',+ do region <- withCurrentBuffer $ regionWithTwoMovesB (return ()) moveToEol+ void $ operatorApplyToRegionE opChange 1 $ StyledRegion Exclusive region+ , switchMode $ Insert 'C')+ , (char 's', cutCharE Forward Sticky =<< getCountE, switchMode $ Insert 's')+ , (char 'S',+ do region <- withCurrentBuffer $ regionWithTwoMovesB firstNonSpaceB moveToEol+ void $ operatorApplyToRegionE opDelete 1 $ StyledRegion Exclusive region+ , switchMode $ Insert 'S')++ -- Replacing+ , (char 'R', return (), switchMode Replace)++ -- Yanking+ , ( char 'Y'+ , do region <- withCurrentBuffer $ regionWithTwoMovesB (return ()) moveToEol+ void $ operatorApplyToRegionE opYank 1 $ StyledRegion Exclusive region+ , id+ )++ -- Search+ , (char '*', addVimJumpHereE >> searchWordE True Forward, resetCount)+ , (char '#', addVimJumpHereE >> searchWordE True Backward, resetCount)+ , (char 'n', addVimJumpHereE >> withCount (continueSearching id), resetCount)+ , (char 'N', addVimJumpHereE >> withCount (continueSearching reverseDir), resetCount)+ , (char ';', repeatGotoCharE id, id)+ , (char ',', repeatGotoCharE reverseDir, id)++ -- Repeat+ , (char '&', return (), id) -- TODO++ -- Transition to ex+ , (char ':', do+ void (spawnMinibufferE ":" id)+ historyStart+ historyPrefixSet ""+ , switchMode Ex)++ -- Undo+ , (char 'u', withCountOnBuffer undoB >> withCurrentBuffer leftOnEol, id)+ , (char 'U', withCountOnBuffer undoB >> withCurrentBuffer leftOnEol, id) -- TODO+ , (ctrlCh 'r', withCountOnBuffer redoB >> withCurrentBuffer leftOnEol, id)++ -- scrolling+ ,(ctrlCh 'b', getCountE >>= withCurrentBuffer . upScreensB, id)+ ,(ctrlCh 'f', getCountE >>= withCurrentBuffer . downScreensB, id)+ ,(ctrlCh 'u', getCountE >>= withCurrentBuffer . vimScrollByB (negate . (`div` 2)), id)+ ,(ctrlCh 'd', getCountE >>= withCurrentBuffer . vimScrollByB (`div` 2), id)+ ,(ctrlCh 'y', getCountE >>= withCurrentBuffer . vimScrollB . negate, id)+ ,(ctrlCh 'e', getCountE >>= withCurrentBuffer . vimScrollB, id)++ -- unsorted TODO+ , (char '-', return (), id)+ , (char '+', return (), id)+ , (spec KEnter, return (), id)+ ] <> fmap (mkStringBindingE Normal Drop)+ [ ("g*", searchWordE False Forward, resetCount)+ , ("g#", searchWordE False Backward, resetCount)+ , ("gd", withCurrentBuffer $ withModeB modeGotoDeclaration, resetCount)+ , ("gD", withCurrentBuffer $ withModeB modeGotoDeclaration, resetCount)+ , ("<C-g>", printFileInfoE, resetCount)+ , ("<C-w>c", tryCloseE, resetCount)+ , ("<C-w>o", closeOtherE, resetCount)+ , ("<C-w>s", splitE, resetCount)+ , ("<C-w>w", nextWinE, resetCount)+ , ("<C-w><Down>", nextWinE, resetCount) -- TODO: please implement downWinE+ , ("<C-w><Right>", nextWinE, resetCount) -- TODO: please implement rightWinE+ , ("<C-w><C-w>", nextWinE, resetCount)+ , ("<C-w>W", prevWinE, resetCount)+ , ("<C-w>p", prevWinE, resetCount)+ , ("<C-w><Up>", prevWinE, resetCount) -- TODO: please implement upWinE+ , ("<C-w><Left>", prevWinE, resetCount) -- TODO: please implement leftWinE+ , ("<C-w>l", layoutManagersNextE, resetCount)+ , ("<C-w>L", layoutManagersPreviousE, resetCount)+ --, ("<C-w> ", layoutManagersNextE, resetCount)+ , ("<C-w>v", layoutManagerNextVariantE, resetCount)+ , ("<C-w>V", layoutManagerPreviousVariantE, resetCount)+ , ("<C-a>", getCountE >>= withCurrentBuffer . incrementNextNumberByB, resetCount)+ , ("<C-x>", getCountE >>= withCurrentBuffer . incrementNextNumberByB . negate, resetCount)++ -- z commands+ -- TODO Add prefix count+ , ("zt", withCurrentBuffer scrollCursorToTopB, resetCount)+ , ("zb", withCurrentBuffer scrollCursorToBottomB, resetCount)+ , ("zz", withCurrentBuffer scrollToCursorB, resetCount)+ {- -- TODO Horizantal scrolling+ , ("ze", withCurrentBuffer .., resetCount)+ , ("zs", withCurrentBuffer .., resetCount)+ , ("zH", withCurrentBuffer .., resetCount)+ , ("zL", withCurrentBuffer .., resetCount)+ , ("zh", withCurrentBuffer .., resetCount)+ , ("zl", withCurrentBuffer .., resetCount)+ -}+ , ("z.", withCurrentBuffer $ scrollToCursorB >> moveToSol, resetCount)+ , ("z+", withCurrentBuffer scrollToLineBelowWindowB, resetCount)+ , ("z-", withCurrentBuffer $ scrollCursorToBottomB >> moveToSol, resetCount)+ , ("z^", withCurrentBuffer scrollToLineAboveWindowB, resetCount)+ {- -- TODO Code folding+ , ("zf", .., resetCount)+ , ("zc", .., resetCount)+ , ("zo", .., resetCount)+ , ("za", .., resetCount)+ , ("zC", .., resetCount)+ , ("zO", .., resetCount)+ , ("zA", .., resetCount)+ , ("zr", .., resetCount)+ , ("zR", .., resetCount)+ , ("zm", .., resetCount)+ , ("zM", .., resetCount)+ -}++ -- Z commands+ ] <> fmap (mkStringBindingY Normal)+ [ ("ZQ", quitEditor, id)+ -- TODO ZZ should replicate :x not :wq+ , ("ZZ", fwriteE >> closeWindow, id)+ ]++fileEditBindings :: [VimBinding]+fileEditBindings = fmap (mkStringBindingY Normal)+ [ ("gf", openFileUnderCursor Nothing, resetCount)+ , ("<C-w>gf", openFileUnderCursor $ Just newTabE, resetCount)+ , ("<C-w>f", openFileUnderCursor $ Just (splitE >> prevWinE), resetCount)+ ]++setMarkBinding :: VimBinding+setMarkBinding = VimBindingE (f . T.unpack . _unEv)+ where f _ s | vsMode s /= Normal = NoMatch+ f "m" _ = PartialMatch+ f ('m':c:[]) _ = WholeMatch $ do+ withCurrentBuffer $ setNamedMarkHereB [c]+ return Drop+ f _ _ = NoMatch++searchWordE :: Bool -> Direction -> EditorM ()+searchWordE wholeWord dir = do+ word <- withCurrentBuffer readCurrentWordB++ let search re = do+ setRegexE re+ searchDirectionA .= dir+ withCount $ continueSearching (const dir)++ if wholeWord+ then case makeSearchOptsM [] $ "\\<" <> R.toString word <> "\\>" of+ Right re -> search re+ Left _ -> return ()+ else search $ makeSimpleSearch word++searchBinding :: VimBinding+searchBinding = VimBindingE (f . T.unpack . _unEv)+ where f evs (VimState { vsMode = Normal }) | evs `elem` group ['/', '?']+ = WholeMatch $ do+ state <- fmap vsMode getEditorDyn+ let dir = if evs == "/" then Forward else Backward+ switchModeE $ Search state dir+ isearchInitE dir+ historyStart+ historyPrefixSet T.empty+ return Continue+ f _ _ = NoMatch++continueSearching :: (Direction -> Direction) -> EditorM ()+continueSearching fdir =+ getRegexE >>= \case+ Just regex -> do+ dir <- fdir <$> use searchDirectionA+ printMsg . T.pack $ (if dir == Forward then '/' else '?') : seInput regex+ void $ doVimSearch Nothing [] dir+ Nothing -> printMsg "No previous search pattern"++repeatGotoCharE :: (Direction -> Direction) -> EditorM ()+repeatGotoCharE mutateDir = do+ prevCommand <- fmap vsLastGotoCharCommand getEditorDyn+ count <- getCountE+ withCurrentBuffer $ case prevCommand of+ Just (GotoCharCommand c dir style) -> do+ let newDir = mutateDir dir+ let move = gotoCharacterB c newDir style True+ p0 <- pointB+ replicateM_ (count - 1) $ do+ move+ when (style == Exclusive) $ moveB Character newDir+ p1 <- pointB+ move+ p2 <- pointB+ when (p1 == p2) $ moveTo p0+ Nothing -> return ()++enableVisualE :: RegionStyle -> EditorM ()+enableVisualE style = withCurrentBuffer $ do+ putRegionStyle style+ rectangleSelectionA .= (Block == style)+ setVisibleSelection True+ pointB >>= setSelectionMarkPointB++cutCharE :: Direction -> EOLStickiness -> Int -> EditorM ()+cutCharE dir stickiness count = do+ r <- withCurrentBuffer $ do+ p0 <- pointB+ (if dir == Forward then moveXorEol else moveXorSol) count+ p1 <- pointB+ let region = mkRegion p0 p1+ rope <- readRegionB region+ deleteRegionB $ mkRegion p0 p1+ when (stickiness == NonSticky) leftOnEol+ return rope+ regName <- fmap vsActiveRegister getEditorDyn+ setRegisterE regName Inclusive r++tabTraversalBinding :: VimBinding+tabTraversalBinding = VimBindingE (f . T.unpack . _unEv)+ where f "g" (VimState { vsMode = Normal }) = PartialMatch+ f ('g':c:[]) (VimState { vsMode = Normal }) | c `elem` ['t', 'T'] = WholeMatch $ do+ count <- getCountE+ replicateM_ count $ if c == 'T' then previousTabE else nextTabE+ resetCountE+ return Drop+ f _ _ = NoMatch++openFileUnderCursor :: Maybe (EditorM ()) -> YiM ()+openFileUnderCursor editorAction = do+ fileName <- fmap R.toString . withCurrentBuffer $ readUnitB unitViWORD+ fileExists <- io $ doesFileExist =<< expandTilda fileName+ if fileExists then do+ maybeM withEditor editorAction+ openNewFile $ fileName+ else+ withEditor . fail $ "Can't find file \"" <> fileName <> "\""++recordMacroBinding :: VimBinding+recordMacroBinding = VimBindingE (f . T.unpack . _unEv)+ where f "q" (VimState { vsMode = Normal+ , vsCurrentMacroRecording = Nothing })+ = PartialMatch+ f ['q', c] (VimState { vsMode = Normal })+ = WholeMatch $ do+ modifyStateE $ \s ->+ s { vsCurrentMacroRecording = Just (c, mempty) }+ return Finish+ f _ _ = NoMatch++finishRecordingMacroBinding :: VimBinding+finishRecordingMacroBinding = VimBindingE (f . T.unpack . _unEv)+ where f "q" (VimState { vsMode = Normal+ , vsCurrentMacroRecording = Just (macroName, Ev macroBody) })+ = WholeMatch $ do+ let reg = Register Exclusive (R.fromText (T.drop 2 macroBody))+ modifyStateE $ \s ->+ s { vsCurrentMacroRecording = Nothing+ , vsRegisterMap = singleton macroName reg+ <> vsRegisterMap s+ }+ return Finish+ f _ _ = NoMatch++playMacroBinding :: VimBinding+playMacroBinding = VimBindingE (f . T.unpack . _unEv)+ where f "@" (VimState { vsMode = Normal }) = PartialMatch+ f ['@', c] (VimState { vsMode = Normal+ , vsRegisterMap = registers+ , vsCount = mbCount }) = WholeMatch $ do+ resetCountE+ case lookup c registers of+ Just (Register _ evs) -> do+ let count = fromMaybe 1 mbCount+ mkAct = Ev . T.replicate count . R.toText+ scheduleActionStringForEval . mkAct $ evs+ return Finish+ Nothing -> return Drop+ f _ _ = NoMatch++-- TODO: withCount name implies that parameter has type (Int -> EditorM ())+-- Is there a better name for this function?+withCount :: EditorM () -> EditorM ()+withCount action = flip replicateM_ action =<< getCountE++withCountOnBuffer :: BufferM () -> EditorM ()+withCountOnBuffer action = withCount $ withCurrentBuffer action
+ src/Yi/Keymap/Vim/NormalOperatorPendingMap.hs view
@@ -0,0 +1,171 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Keymap.Vim.NormalOperatorPendingMap+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable++module Yi.Keymap.Vim.NormalOperatorPendingMap+ (defNormalOperatorPendingMap) where++import Control.Monad (void, when)+import Data.Char (isDigit)+import Data.List (isPrefixOf)+import Data.Maybe (fromJust, fromMaybe)+import Data.Monoid ((<>))+import qualified Data.Text as T (init, last, pack, snoc, unpack)+import Yi.Buffer.Adjusted hiding (Insert)+import Yi.Editor (getEditorDyn, withCurrentBuffer)+import Yi.Keymap.Keys (Key (KEsc), spec)+import Yi.Keymap.Vim.Common+import Yi.Keymap.Vim.Motion+import Yi.Keymap.Vim.Operator+import Yi.Keymap.Vim.StateUtils+import Yi.Keymap.Vim.StyledRegion (StyledRegion (..), normalizeRegion)+import Yi.Keymap.Vim.TextObject+import Yi.Keymap.Vim.Utils (mkBindingE)++defNormalOperatorPendingMap :: [VimOperator] -> [VimBinding]+defNormalOperatorPendingMap operators = [textObject operators, escBinding]++textObject :: [VimOperator] -> VimBinding+textObject operators = VimBindingE f+ where+ f evs vs = case vsMode vs of+ NormalOperatorPending _ -> WholeMatch $ action evs+ _ -> NoMatch+ action (Ev evs) = do+ currentState <- getEditorDyn++ let partial = vsTextObjectAccumulator currentState+ opChar = Ev . T.pack $ lastCharForOperator op+ op = fromJust $ stringToOperator operators opname+ (NormalOperatorPending opname) = vsMode currentState++ -- vim treats cw as ce+ let evs' = if opname == Op "c" && T.last evs == 'w' &&+ (case parseOperand opChar (evr evs) of+ JustMove _ -> True+ _ -> False)+ then T.init evs `T.snoc` 'e'+ else evs+ -- TODO: fix parseOperand to take EventString as second arg+ evr x = T.unpack . _unEv $ partial <> Ev x+ operand = parseOperand opChar (evr evs')++ case operand of+ NoOperand -> do+ dropTextObjectAccumulatorE+ resetCountE+ switchModeE Normal+ return Drop+ PartialOperand -> do+ accumulateTextObjectEventE (Ev evs)+ return Continue+ _ -> do+ count <- getCountE+ dropTextObjectAccumulatorE+ token <- case operand of+ JustTextObject cto@(CountedTextObject n _) -> do+ normalizeCountE (Just n)+ operatorApplyToTextObjectE op 1 $+ changeTextObjectCount (count * n) cto+ JustMove (CountedMove n m) -> do+ mcount <- getMaybeCountE+ normalizeCountE n+ region <- withCurrentBuffer $ regionOfMoveB $ CountedMove (maybeMult mcount n) m+ operatorApplyToRegionE op 1 region+ JustOperator n style -> do+ normalizeCountE (Just n)+ normalizedCount <- getCountE+ region <- withCurrentBuffer $ regionForOperatorLineB normalizedCount style+ curPoint <- withCurrentBuffer pointB+ token <- operatorApplyToRegionE op 1 region+ when (opname == Op "y") $+ withCurrentBuffer $ moveTo curPoint+ return token++ _ -> error "can't happen"+ resetCountE+ return token++regionForOperatorLineB :: Int -> RegionStyle -> BufferM StyledRegion+regionForOperatorLineB n style = normalizeRegion =<< StyledRegion style <$> savingPointB (do+ current <- pointB+ if n == 1+ then do+ firstNonSpaceB+ p0 <- pointB+ return $! mkRegion p0 current+ else do+ void $ lineMoveRel (n-2)+ moveToEol+ rightB+ firstNonSpaceB+ p1 <- pointB+ return $! mkRegion current p1)++escBinding :: VimBinding+escBinding = mkBindingE ReplaceSingleChar Drop (spec KEsc, return (), resetCount . switchMode Normal)++data OperandParseResult+ = JustTextObject !CountedTextObject+ | JustMove !CountedMove+ | JustOperator !Int !RegionStyle -- ^ like dd and d2vd+ | PartialOperand+ | NoOperand++parseOperand :: EventString -> String -> OperandParseResult+parseOperand opChar s = parseCommand mcount styleMod opChar commandString+ where (mcount, styleModString, commandString) = splitCountModifierCommand s+ styleMod = case styleModString of+ "" -> id+ "V" -> const LineWise+ "<C-v>" -> const Block+ "v" -> \style -> case style of+ Exclusive -> Inclusive+ _ -> Exclusive+ _ -> error "Can't happen"++-- | TODO: should this String be EventString?+parseCommand :: Maybe Int -> (RegionStyle -> RegionStyle)+ -> EventString -> String -> OperandParseResult+parseCommand _ _ _ "" = PartialOperand+parseCommand _ _ _ "i" = PartialOperand+parseCommand _ _ _ "a" = PartialOperand+parseCommand _ _ _ "g" = PartialOperand+parseCommand n sm o s | o' == s = JustOperator (fromMaybe 1 n) (sm LineWise)+ where o' = T.unpack . _unEv $ o+parseCommand n sm _ "0" =+ let m = Move Exclusive False (const moveToSol)+ in JustMove (CountedMove n (changeMoveStyle sm m))+parseCommand n sm _ s = case stringToMove . Ev $ T.pack s of+ WholeMatch m -> JustMove $ CountedMove n $ changeMoveStyle sm m+ PartialMatch -> PartialOperand+ NoMatch -> case stringToTextObject s of+ WholeMatch to -> JustTextObject $ CountedTextObject (fromMaybe 1 n)+ $ changeTextObjectStyle sm to+ _ -> NoOperand++-- TODO: setup doctests+-- Parse event string that can go after operator+-- w -> (Nothing, "", "w")+-- 2w -> (Just 2, "", "w")+-- V2w -> (Just 2, "V", "w")+-- v2V3<C-v>w -> (Just 6, "<C-v>", "w")+-- vvvvvvvvvvvvvw -> (Nothing, "v", "w")+-- 0 -> (Nothing, "", "0")+-- V0 -> (Nothing, "V", "0")+splitCountModifierCommand :: String -> (Maybe Int, String, String)+splitCountModifierCommand = go "" Nothing [""]+ where go "" Nothing mods "0" = (Nothing, head mods, "0")+ go ds count mods (h:t) | isDigit h = go (ds <> [h]) count mods t+ go ds@(_:_) count mods s@(h:_) | not (isDigit h) = go [] (maybeMult count (Just (read ds))) mods s+ go [] count mods (h:t) | h `elem` ['v', 'V'] = go [] count ([h]:mods) t+ go [] count mods s | "<C-v>" `isPrefixOf` s = go [] count ("<C-v>":mods) (drop 5 s)+ go [] count mods s = (count, head mods, s)+ go ds count mods [] = (maybeMult count (Just (read ds)), head mods, [])+ go (_:_) _ _ (_:_) = error "Can't happen because isDigit and not isDigit cover every case"
+ src/Yi/Keymap/Vim/Operator.hs view
@@ -0,0 +1,218 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Keymap.Vim.Operator+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable+--+-- Implements some operators for the Vim keymap.++module Yi.Keymap.Vim.Operator+ ( VimOperator(..)+ , defOperators+ , opDelete+ , opChange+ , opYank+ , opFormat+ , stringToOperator+ , mkCharTransformOperator+ , operatorApplyToTextObjectE+ , lastCharForOperator+ ) where++import Control.Monad (when)+import Data.Char (isSpace, toLower, toUpper)+import Data.Foldable (find)+import Data.Maybe (fromJust)+import Data.Monoid ((<>))+import qualified Data.Text as T (unpack)+import Yi.Buffer.Adjusted hiding (Insert)+import Yi.Editor (EditorM, getEditorDyn, withCurrentBuffer)+import Yi.Keymap.Vim.Common+import Yi.Keymap.Vim.EventUtils (eventToEventString, parseEvents)+import Yi.Keymap.Vim.StateUtils (setRegisterE, switchModeE)+import Yi.Keymap.Vim.StyledRegion (StyledRegion (..), transformCharactersInRegionB)+import Yi.Keymap.Vim.TextObject (CountedTextObject, regionOfTextObjectB)+import Yi.Keymap.Vim.Utils (indentBlockRegionB)+import Yi.Misc (rot13Char)+import Yi.Rope (YiString)+import qualified Yi.Rope as R++data VimOperator = VimOperator {+ operatorName :: !OperatorName+ , operatorApplyToRegionE :: Int -> StyledRegion -> EditorM RepeatToken+}++defOperators :: [VimOperator]+defOperators =+ [ opYank+ , opDelete+ , opChange+ , opFormat+ , mkCharTransformOperator "gu" toLower+ , mkCharTransformOperator "gU" toUpper+ , mkCharTransformOperator "g~" switchCaseChar+ , mkCharTransformOperator "g?" rot13Char+ , mkShiftOperator ">" id+ , mkShiftOperator "<lt>" negate+ ]++stringToOperator :: [VimOperator] -> OperatorName -> Maybe VimOperator+stringToOperator ops name = find ((== name) . operatorName) ops++operatorApplyToTextObjectE :: VimOperator -> Int -> CountedTextObject -> EditorM RepeatToken+operatorApplyToTextObjectE op count cto = do+ styledRegion <- withCurrentBuffer $ regionOfTextObjectB cto+ operatorApplyToRegionE op count styledRegion++opYank :: VimOperator+opYank = VimOperator {+ operatorName = "y"+ , operatorApplyToRegionE = \_count (StyledRegion style reg) -> do+ s <- withCurrentBuffer $ readRegionRopeWithStyleB reg style+ regName <- fmap vsActiveRegister getEditorDyn+ setRegisterE regName style s+ withCurrentBuffer $ moveTo . regionStart =<< convertRegionToStyleB reg style+ switchModeE Normal+ return Finish+}++opDelete :: VimOperator+opDelete = VimOperator {+ operatorName = "d"+ , operatorApplyToRegionE = \_count (StyledRegion style reg) -> do+ s <- withCurrentBuffer $ readRegionRopeWithStyleB reg style+ regName <- fmap vsActiveRegister getEditorDyn+ setRegisterE regName style s+ withCurrentBuffer $ do+ point <- deleteRegionWithStyleB reg style+ moveTo point+ eof <- atEof+ if eof+ then do+ leftB+ c <- readB+ when (c == '\n') $ deleteN 1 >> moveToSol+ else leftOnEol+ switchModeE Normal+ return Finish+}++opChange :: VimOperator+opChange = VimOperator {+ operatorName = "c"+ , operatorApplyToRegionE = \_count (StyledRegion style reg) -> do+ s <- withCurrentBuffer $ readRegionRopeWithStyleB reg style+ regName <- fmap vsActiveRegister getEditorDyn+ setRegisterE regName style s+ withCurrentBuffer $ do+ point <- deleteRegionWithStyleB reg style+ moveTo point+ when (style == LineWise) $ do+ insertB '\n'+ leftB+ switchModeE $ Insert 'c'+ return Continue+}++opFormat :: VimOperator+opFormat = VimOperator {+ operatorName = "gq"+ , operatorApplyToRegionE = \_count (StyledRegion style reg) -> do+ withCurrentBuffer $ formatRegionB style reg+ switchModeE Normal+ return Finish+}++formatRegionB :: RegionStyle -> Region -> BufferM ()+formatRegionB Block _reg = return ()+formatRegionB _style reg = do+ start <- solPointB $ regionStart reg+ end <- eolPointB $ regionEnd reg+ moveTo start+ -- Don't use firstNonSpaceB since paragraphs can start with lines made+ -- completely of whitespace (which should be fixed)+ untilB_ ((not . isSpace) <$> readB) rightB+ indent <- curCol+ modifyRegionB (formatStringWithIndent indent) $ reg { regionStart = start+ , regionEnd = end+ }+ -- Emulate vim behaviour+ moveTo =<< solPointB end+ firstNonSpaceB++formatStringWithIndent :: Int -> YiString -> YiString+formatStringWithIndent indent str+ | R.null str = R.empty+ | otherwise = let spaces = R.replicateChar indent ' '+ (formattedLine, textToFormat) = getNextLine (80 - indent) str+ lineEnd = if R.null textToFormat+ then R.empty+ else '\n' `R.cons` formatStringWithIndent indent textToFormat+ in R.concat [ spaces+ , formattedLine+ , lineEnd+ ]++getNextLine :: Int -> YiString -> (YiString, YiString)+getNextLine maxLength str = let firstSplit = takeBlock (R.empty, R.dropWhile isSpace str)+ isMaxLength (l, r) = R.length l > maxLength || R.null r+ in if isMaxLength firstSplit+ then firstSplit+ else let (line, remainingText) = until isMaxLength+ takeBlock+ firstSplit+ in if R.length line <= maxLength+ then (R.dropWhileEnd isSpace line, remainingText)+ else let (beginL, endL) = breakAtLastItem line+ in if isSpace $ fromJust $ R.head endL+ then (beginL, remainingText)+ else (R.dropWhileEnd isSpace beginL, endL `R.append` remainingText)+ where+ isMatch (Just x) y = isSpace x == isSpace y+ isMatch Nothing _ = False++ -- Gets the next block of either whitespace, or non-whitespace,+ -- characters+ takeBlock (cur, rest) =+ let (word, line) = R.span (isMatch $ R.head rest) rest+ in (cur `R.append` R.map (\c -> if c == '\n' then ' ' else c) word, line)+ breakAtLastItem s =+ let y = R.takeWhileEnd (isMatch $ R.last s) s+ (x, _) = R.splitAt (R.length s - R.length y) s+ in (x, y)++mkCharTransformOperator :: OperatorName -> (Char -> Char) -> VimOperator+mkCharTransformOperator name f = VimOperator {+ operatorName = name+ , operatorApplyToRegionE = \count sreg -> do+ withCurrentBuffer $ transformCharactersInRegionB sreg+ $ foldr (.) id (replicate count f)+ switchModeE Normal+ return Finish+}++mkShiftOperator :: OperatorName -> (Int -> Int) -> VimOperator+mkShiftOperator name countMod = VimOperator {+ operatorName = name+ , operatorApplyToRegionE = \count (StyledRegion style reg) -> do+ withCurrentBuffer $+ if style == Block+ then indentBlockRegionB (countMod count) reg+ else do+ reg' <- convertRegionToStyleB reg style+ shiftIndentOfRegionB (countMod count) reg'+ switchModeE Normal+ return Finish+}++lastCharForOperator :: VimOperator -> String+lastCharForOperator (VimOperator { operatorName = name })+ -- This cast here seems stupid, maybe we should only have one+ -- type?+ = case parseEvents (Ev . _unOp $ name) of+ [] -> error $ "invalid operator name " <> T.unpack (_unOp name)+ evs -> T.unpack . _unEv . eventToEventString $ last evs
+ src/Yi/Keymap/Vim/ReplaceMap.hs view
@@ -0,0 +1,90 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Keymap.Vim.ReplaceMap+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable++module Yi.Keymap.Vim.ReplaceMap (defReplaceMap) where++import Control.Monad (replicateM_, when)+import Data.Monoid ((<>))+import qualified Data.Text as T (unpack)+import Yi.Buffer.Adjusted+import Yi.Editor (EditorM, getEditorDyn, withCurrentBuffer)+import Yi.Keymap.Keys (Key (KEsc), ctrlCh, spec)+import Yi.Keymap.Vim.Common+import Yi.Keymap.Vim.EventUtils (eventToEventString, parseEvents)+import Yi.Keymap.Vim.StateUtils+import Yi.Keymap.Vim.Utils (mkBindingE)++defReplaceMap :: [VimBinding]+defReplaceMap = specials <> [printable]++specials :: [VimBinding]+specials = fmap (mkBindingE Replace Finish)+ [ (spec KEsc, exitReplaceMode, resetCount . switchMode Normal)+ , (ctrlCh 'c', exitReplaceMode, resetCount . switchMode Normal)+ ]++exitReplaceMode :: EditorM ()+exitReplaceMode = do+ count <- getCountE+ when (count > 1) $ do+ inputEvents <- fmap (parseEvents . vsOngoingInsertEvents) getEditorDyn+ replicateM_ (count - 1) $ mapM_ (printableAction . eventToEventString) inputEvents+ modifyStateE $ \s -> s { vsOngoingInsertEvents = mempty }+ withCurrentBuffer $ moveXorSol 1++printable :: VimBinding+printable = VimBindingE f+ where f evs s | Replace == vsMode s = WholeMatch $ printableAction evs+ f _ _ = NoMatch++printableAction :: EventString -> EditorM RepeatToken+printableAction evs = do+ saveInsertEventStringE evs+ withCurrentBuffer $ case T.unpack . _unEv $ evs of+ [c] -> insertOrReplaceB c+ "<CR>" -> insertOrReplaceB '\n'+ -- For testing purposes assume noexpandtab, tw=4+ "<Esc>" -> replicateM_ 4 $ insertOrReplaceB ' '+ "<C-t>" -> return () -- TODO+ "<C-d>" -> return () -- TODO+ "<C-e>" -> insertOrReplaceCharWithBelowB+ "<C-y>" -> insertOrReplaceCharWithAboveB+ "<C-h>" -> return () -- TODO+ "<C-j>" -> return () -- TODO+ "<C-o>" -> return () -- TODO+ "<C-w>" -> return () -- TODO+ "<C-r>" -> return () -- TODO+ "<C-k>" -> return () -- TODO+ evs' -> error $ "Unhandled event " <> evs' <> " in replace mode"+ return Continue++insertOrReplaceB :: Char -> BufferM ()+insertOrReplaceB c = do+ currentChar <- readB+ if currentChar == '\n'+ then insertB c+ else replaceCharB c+ rightB++insertOrReplaceCharWithBelowB :: BufferM ()+insertOrReplaceCharWithBelowB = do+ currentChar <- readB+ if currentChar == '\n'+ then insertCharWithBelowB+ else replaceCharWithBelowB+ rightB++insertOrReplaceCharWithAboveB :: BufferM ()+insertOrReplaceCharWithAboveB = do+ currentChar <- readB+ if currentChar == '\n'+ then insertCharWithAboveB+ else replaceCharWithAboveB+ rightB
+ src/Yi/Keymap/Vim/ReplaceSingleCharMap.hs view
@@ -0,0 +1,59 @@+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Keymap.Vim.ReplaceSingleCharMap+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable++module Yi.Keymap.Vim.ReplaceSingleCharMap+ ( defReplaceSingleMap+ ) where++import Control.Monad (replicateM_, when)+import Data.Maybe (fromMaybe)+import qualified Data.Text as T (unpack)+import Yi.Buffer.Adjusted+import Yi.Editor (getEditorDyn, withCurrentBuffer)+import Yi.Keymap.Keys (Key (KEsc), spec)+import Yi.Keymap.Vim.Common+import Yi.Keymap.Vim.StateUtils (resetCount, resetCountE, switchMode, switchModeE)+import Yi.Keymap.Vim.Utils (mkBindingE)+import Yi.Utils (SemiNum ((~-)))++defReplaceSingleMap :: [VimBinding]+defReplaceSingleMap = [escBinding, actualReplaceBinding]++escBinding :: VimBinding+escBinding = mkBindingE ReplaceSingleChar Drop (spec KEsc, return (), resetCount . switchMode Normal)++actualReplaceBinding :: VimBinding+actualReplaceBinding = VimBindingE (f . T.unpack . _unEv)+ where+ f evs s | ReplaceSingleChar == vsMode s = WholeMatch $ do+ currentState <- getEditorDyn+ let count = fromMaybe 1 $ vsCount currentState+ let replacer = case evs of+ (c:[]) -> replaceCharB c+ "<lt>" -> replaceCharB '<'+ "<C-e>" -> replaceCharWithBelowB+ "<C-y>" -> replaceCharWithAboveB+ _ -> return ()+ withCurrentBuffer $ do+ -- Is there more easy way to get distance to eol?+ here <- pointB+ moveToEol+ eol <- pointB+ moveTo here++ let effectiveCount = min count (fromSize $ eol ~- here)++ when (effectiveCount > 0) $ do+ replicateM_ effectiveCount $ replacer >> rightB+ leftB++ resetCountE+ switchModeE Normal+ return Finish+ f _ _ = NoMatch
+ src/Yi/Keymap/Vim/Search.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Keymap.Vim.Search+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable++module Yi.Keymap.Vim.Search (doVimSearch, continueVimSearch) where++import Data.Maybe (listToMaybe)+import Data.Text ()+import Yi.Buffer.Adjusted+import Yi.Editor (EditorM, printMsg, withCurrentBuffer)+import Yi.Search (SearchOption, getRegexE, searchInit)++doVimSearch :: Maybe String -> [SearchOption] -> Direction -> EditorM ()+doVimSearch Nothing _ dir = do+ mbRegex <- getRegexE+ case mbRegex of+ Just regex -> withCurrentBuffer $ continueVimSearch (regex, dir)+ Nothing -> printMsg "No previous search pattern"+doVimSearch (Just needle) opts dir =+ searchInit needle dir opts >>= withCurrentBuffer . continueVimSearch++continueVimSearch :: (SearchExp, Direction) -> BufferM ()+continueVimSearch (searchExp, dir) = do+ mp <- savingPointB $ do+ moveB Character dir -- start immed. after cursor+ rs <- regexB dir searchExp+ moveB Document (reverseDir dir) -- wrap around+ ls <- regexB dir searchExp+ return $ listToMaybe $ rs ++ ls+ -- regionFirst doesn't work right here, because something inside+ -- Buffer.Implementation.regexRegionBI breaks Region invariant and+ -- may return Region (Forward, A, B) where A > B+ -- TODO: investigate+ maybe (return ()) (moveTo . regionFirst') mp++regionFirst' :: Region -> Point+regionFirst' r = Point $ min a b+ where a = fromPoint $ regionStart r+ b = fromPoint $ regionEnd r
+ src/Yi/Keymap/Vim/SearchMotionMap.hs view
@@ -0,0 +1,84 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Keymap.Vim.SearchMotionMap+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable++module Yi.Keymap.Vim.SearchMotionMap (defSearchMotionMap) where++import Control.Monad (replicateM_)+import Data.Maybe (fromMaybe)+import qualified Data.Text as T (pack, unpack)+import Yi.Buffer.Adjusted (Direction (Backward, Forward), elemsB)+import Yi.Editor (getEditorDyn, withCurrentBuffer)+import Yi.History (historyFinish, historyPrefixSet)+import Yi.Keymap.Vim.Common+import Yi.Keymap.Vim.Search (continueVimSearch)+import Yi.Keymap.Vim.StateUtils (getCountE, switchModeE)+import Yi.Keymap.Vim.Utils (matchFromBool)+import qualified Yi.Rope as R (toText)+import Yi.Search++defSearchMotionMap :: [VimBinding]+defSearchMotionMap = [enterBinding, editBinding, exitBinding]++enterBinding :: VimBinding+enterBinding = VimBindingE f+ where f "<CR>" (VimState { vsMode = Search {}} ) = WholeMatch $ do+ Search prevMode dir <- fmap vsMode getEditorDyn+ -- TODO: parse cmd into regex and flags+ isearchFinishE+ historyFinish+ switchModeE prevMode++ count <- getCountE+ getRegexE >>= \case+ Nothing -> return ()+ Just regex -> withCurrentBuffer $+ if count == 1 && dir == Forward+ then do+ -- Workaround for isearchFinishE leaving cursor after match+ continueVimSearch (regex, Backward)+ continueVimSearch (regex, Forward)+ else replicateM_ (count - 1) $ continueVimSearch (regex, dir)+ case prevMode of+ Visual _ -> return Continue+ _ -> return Finish+ f _ _ = NoMatch++editBinding :: VimBinding+editBinding = VimBindingE (f . T.unpack . _unEv)+ where+ f evs (VimState { vsMode = Search {}} )+ = action evs <$+ matchFromBool (evs `elem` fmap (T.unpack . fst) binds+ || null (drop 1 evs))+ f _ _ = NoMatch+ action evs = do+ let evs' = T.pack evs+ fromMaybe (isearchAddE evs') (lookup evs' binds)+ withCurrentBuffer elemsB >>= historyPrefixSet . R.toText+ return Continue++ binds = [ ("<BS>", isearchDelE)+ , ("<C-h>", isearchDelE)+ , ("<C-p>", isearchHistory 1)+ , ("<Up>", isearchHistory 1)+ , ("<C-n>", isearchHistory (-1))+ , ("<Down>", isearchHistory (-1))+ , ("<lt>", isearchAddE "<")+ ]++exitBinding :: VimBinding+exitBinding = VimBindingE f+ where f _ (VimState { vsMode = Search {}} ) = WholeMatch $ do+ Search prevMode _dir <- fmap vsMode getEditorDyn+ isearchCancelE+ switchModeE prevMode+ return Drop+ f _ _ = NoMatch
+ src/Yi/Keymap/Vim/StateUtils.hs view
@@ -0,0 +1,176 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Keymap.Vim.StateUtils+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable++module Yi.Keymap.Vim.StateUtils+ ( switchMode+ , switchModeE+ , resetCount+ , resetCountE+ , setCountE+ , modifyStateE+ , getMaybeCountE+ , getCountE+ , accumulateEventE+ , accumulateBindingEventE+ , accumulateTextObjectEventE+ , flushAccumulatorE+ , dropAccumulatorE+ , dropBindingAccumulatorE+ , dropTextObjectAccumulatorE+ , setRegisterE+ , getRegisterE+ , normalizeCountE+ , maybeMult+ , updateModeIndicatorE+ , saveInsertEventStringE+ , resetActiveRegisterE+ ) where++import Control.Monad (when)+import qualified Data.HashMap.Strict as HM (insert, lookup)+import Data.Maybe (fromMaybe, isJust)+import Data.Monoid ((<>))+import qualified Data.Text as T (null)+import Yi.Buffer.Normal (RegionStyle (Block, LineWise))+import Yi.Editor (EditorM, getEditorDyn, putEditorDyn, setStatus)+import Yi.Event (Event)+import Yi.Keymap.Vim.Common+import Yi.Keymap.Vim.EventUtils+import Yi.Rope (YiString)+import Yi.String (showT)+import Yi.Style (defaultStyle)++switchMode :: VimMode -> VimState -> VimState+switchMode mode state = state { vsMode = mode }++switchModeE :: VimMode -> EditorM ()+switchModeE mode = modifyStateE $ switchMode mode++modifyStateE :: (VimState -> VimState) -> EditorM ()+modifyStateE f = do+ currentState <- getEditorDyn+ putEditorDyn $ f currentState++resetCount :: VimState -> VimState+resetCount s = s { vsCount = Nothing }++resetCountE :: EditorM ()+resetCountE = modifyStateE resetCount++getMaybeCountE :: EditorM (Maybe Int)+getMaybeCountE = fmap vsCount getEditorDyn++getCountE :: EditorM Int+getCountE = do+ currentState <- getEditorDyn+ return $! fromMaybe 1 (vsCount currentState)++setCountE :: Int -> EditorM ()+setCountE n = modifyStateE $ \s -> s { vsCount = Just n }++accumulateBindingEventE :: Event -> EditorM ()+accumulateBindingEventE e = modifyStateE $+ \s -> s { vsBindingAccumulator = vsBindingAccumulator s <> eventToEventString e }++accumulateEventE :: Event -> EditorM ()+accumulateEventE e = modifyStateE $+ \s -> s { vsAccumulator = vsAccumulator s <> eventToEventString e }++accumulateTextObjectEventE :: EventString -> EditorM ()+accumulateTextObjectEventE evs = modifyStateE $+ \s -> s { vsTextObjectAccumulator = vsTextObjectAccumulator s <> evs }++flushAccumulatorE :: EditorM ()+flushAccumulatorE = do+ accum <- vsAccumulator <$> getEditorDyn+ let repeatableAction = stringToRepeatableAction accum+ modifyStateE $ \s ->+ s { vsRepeatableAction = Just repeatableAction+ , vsAccumulator = mempty+ , vsCurrentMacroRecording = fmap (fmap (<> accum))+ (vsCurrentMacroRecording s)+ }++dropAccumulatorE :: EditorM ()+dropAccumulatorE =+ modifyStateE $ \s ->+ let accum = vsAccumulator s+ in s { vsAccumulator = mempty+ , vsCurrentMacroRecording = fmap (fmap (<> accum))+ (vsCurrentMacroRecording s)+ }++dropBindingAccumulatorE :: EditorM ()+dropBindingAccumulatorE =+ modifyStateE $ \s -> s { vsBindingAccumulator = mempty }++dropTextObjectAccumulatorE :: EditorM ()+dropTextObjectAccumulatorE =+ modifyStateE $ \s -> s { vsTextObjectAccumulator = mempty }++getRegisterE :: RegisterName -> EditorM (Maybe Register)+getRegisterE name = fmap (HM.lookup name . vsRegisterMap) getEditorDyn++setRegisterE :: RegisterName -> RegionStyle -> YiString -> EditorM ()+setRegisterE name style rope = do+ rmap <- fmap vsRegisterMap getEditorDyn+ let rmap' = HM.insert name (Register style rope) rmap+ modifyStateE $ \state -> state { vsRegisterMap = rmap' }++normalizeCountE :: Maybe Int -> EditorM ()+normalizeCountE n = do+ mcount <- getMaybeCountE+ modifyStateE $ \s -> s {+ vsCount = maybeMult mcount n+ , vsAccumulator = Ev (showT . fromMaybe 1 $ maybeMult mcount n)+ <> snd (splitCountedCommand . normalizeCount $ vsAccumulator s)+ }++maybeMult :: Num a => Maybe a -> Maybe a -> Maybe a+maybeMult (Just a) (Just b) = Just (a * b)+maybeMult Nothing Nothing = Nothing+maybeMult a Nothing = a+maybeMult Nothing b = b++updateModeIndicatorE :: VimState -> EditorM ()+updateModeIndicatorE prevState = do+ currentState <- getEditorDyn+ let mode = vsMode currentState+ prevMode = vsMode prevState+ paste = vsPaste currentState+ isRecording = isJust . vsCurrentMacroRecording $ currentState+ prevRecording = isJust . vsCurrentMacroRecording $ prevState++ when (mode /= prevMode || isRecording /= prevRecording) $ do+ let modeName = case mode of+ Insert _ -> "INSERT" <> if paste then " (paste) " else ""+ InsertNormal -> "(insert)"+ InsertVisual -> "(insert) VISUAL"+ Replace -> "REPLACE"+ Visual Block -> "VISUAL BLOCK"+ Visual LineWise -> "VISUAL LINE"+ Visual _ -> "VISUAL"+ _ -> ""++ decoratedModeName' = if T.null modeName+ then mempty+ else "-- " <> modeName <> " --"+ decoratedModeName = if isRecording+ then decoratedModeName' <> "recording"+ else decoratedModeName'++ setStatus ([decoratedModeName], defaultStyle)++saveInsertEventStringE :: EventString -> EditorM ()+saveInsertEventStringE evs = modifyStateE $ \s ->+ s { vsOngoingInsertEvents = vsOngoingInsertEvents s <> evs }++resetActiveRegisterE :: EditorM ()+resetActiveRegisterE = modifyStateE $ \s -> s { vsActiveRegister = '\0' }
+ src/Yi/Keymap/Vim/StyledRegion.hs view
@@ -0,0 +1,77 @@+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Keymap.Vim.StyledRegion+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable+--+-- I'm a module waiting for some kind soul to give me a commentary!++module Yi.Keymap.Vim.StyledRegion+ ( StyledRegion(..)+ , normalizeRegion+ , transformCharactersInRegionB+ , transformCharactersInLineN+ ) where++import Control.Monad (forM_)+import qualified Data.Text as T (map)+import Yi.Buffer.Adjusted+import qualified Yi.Rope as R (withText)+import Yi.Utils (SemiNum ((-~)))++data StyledRegion = StyledRegion !RegionStyle !Region++-- | from vim help:+--+-- 1. If the motion is exclusive and the end of the motion is in+-- column 1, the end of the motion is moved to the end of the+-- previous line and the motion becomes inclusive. Example: "}"+-- moves to the first line after a paragraph, but "d}" will not+-- include that line.+--+-- 2. If the motion is exclusive, the end of the motion is in column 1+-- and the start of the motion was at or before the first non-blank+-- in the line, the motion becomes linewise. Example: If a+-- paragraph begins with some blanks and you do "d}" while standing+-- on the first non-blank, all the lines of the paragraph are+-- deleted, including the blanks. If you do a put now, the deleted+-- lines will be inserted below the cursor position.+--+-- TODO: case 2+normalizeRegion :: StyledRegion -> BufferM StyledRegion+normalizeRegion sr@(StyledRegion style reg) =++ if style == Exclusive+ then do+ let end = regionEnd reg+ (_, endColumn) <- getLineAndColOfPoint end+ return (if endColumn == 0+ then StyledRegion Inclusive $ reg { regionEnd = end -~ 2 }+ else sr)+ else return sr++transformCharactersInRegionB :: StyledRegion -> (Char -> Char) -> BufferM ()+transformCharactersInRegionB (StyledRegion Block reg) f = do+ subregions <- splitBlockRegionToContiguousSubRegionsB reg+ forM_ subregions $ \sr ->+ transformCharactersInRegionB (StyledRegion Exclusive sr) f+ case subregions of+ (sr:_) -> moveTo (regionStart sr)+ [] -> error "Should never happen"+transformCharactersInRegionB (StyledRegion style reg) f = do+ reg' <- convertRegionToStyleB reg style+ s <- readRegionB reg'+ replaceRegionB reg' (R.withText (T.map f) s)+ moveTo (regionStart reg')++transformCharactersInLineN :: Int -> (Char -> Char) -> BufferM ()+transformCharactersInLineN count action = do+ p0 <- pointB+ moveXorEol count+ p1 <- pointB+ let sreg = StyledRegion Exclusive $ mkRegion p0 p1+ transformCharactersInRegionB sreg action+ moveTo p1
+ src/Yi/Keymap/Vim/Tag.hs view
@@ -0,0 +1,215 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Keymap.Vim.Tag+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable++module Yi.Keymap.Vim.Tag+ ( completeVimTag+ , gotoTag+ , nextTag+ , popTag+ , unpopTag+ ) where++import GHC.Generics (Generic)++import Lens.Micro.Platform (view)+import Control.Monad (foldM, void)+import Data.Binary (Binary (..))+import Data.Default (Default (..))+import Data.Maybe (maybeToList)+import Data.Monoid ((<>))+import qualified Data.Text as T (Text)+import Data.Typeable (Typeable)+import System.Directory (doesFileExist)+import System.FilePath (takeDirectory, (</>))+import System.FriendlyPath (userToCanonPath)+import Yi.Buffer+import Yi.Core (errorEditor)+import Yi.Editor+import Yi.File (openingNewFile)+import Yi.Keymap (YiM)+import Yi.Tag+import Yi.Types (YiVariable)+import Yi.Utils (io)++-- | List of tags and the file/line/char that they originate from.+-- (the location that :tag or Ctrl-[ was called from).+data VimTagStack = VimTagStack+ { tagStackList :: [(Tag, Int, FilePath, Int, Int)]+ , tagStackIndex :: Int+ } deriving (Typeable, Generic)++instance Default VimTagStack where+ def = VimTagStack [] 0++instance YiVariable VimTagStack++instance Binary VimTagStack++-- | Returns tag, tag index, filepath, line number, char number+getTagList :: EditorM [(Tag, Int, FilePath, Int, Int)]+getTagList = do+ VimTagStack ts _ <- getEditorDyn+ return ts++getTagIndex :: EditorM Int+getTagIndex = do+ VimTagStack _ ti <- getEditorDyn+ return ti++setTagList :: [(Tag, Int, FilePath, Int, Int)] -> EditorM ()+setTagList tl = do+ t@(VimTagStack _ _) <- getEditorDyn+ putEditorDyn $ t { tagStackList = tl }++setTagIndex :: Int -> EditorM ()+setTagIndex ti = do+ t@(VimTagStack _ _) <- getEditorDyn+ putEditorDyn $ t { tagStackIndex = ti }++-- | Push tag at index.+pushTagStack :: Tag -> Int -> FilePath -> Int -> Int -> EditorM ()+pushTagStack tag ind fp ln cn = do+ tl <- getTagList+ ti <- getTagIndex+ setTagList $ (take ti tl) ++ [(tag, ind, fp, ln, cn)]+ setTagIndex $ ti + 1++-- | Get tag and decrement index (so that when a new push is done, the current+-- tag is popped)+popTagStack :: EditorM (Maybe (Tag, Int, FilePath, Int, Int))+popTagStack = do+ tl <- getTagList+ ti <- getTagIndex+ case tl of+ [] -> return Nothing+ _ -> case ti of+ 0 -> return Nothing+ _ -> setTagIndex (ti - 1) >> return (Just $ tl !! (ti - 1))++-- | Opens the file that contains @tag@. Uses the global tag table or uses+-- the first valid tag file in @TagsFileList@.+gotoTag :: Tag -> Int -> Maybe (FilePath, Int, Int) -> YiM ()+gotoTag tag ind ret =+ void . visitTagTable $ \tagTable -> do+ let lis = lookupTag tag tagTable+ if (length lis) <= ind+ then errorEditor $ "tag not found: " <> _unTag tag+ else do+ bufinf <- withCurrentBuffer bufInfoB++ let (filename, line) = lis !! ind+ (fn, ln, cn) = case ret of+ Just ret' -> ret'+ Nothing -> (bufInfoFileName bufinf, + bufInfoLineNo bufinf, + bufInfoColNo bufinf)+ withEditor $ pushTagStack tag ind fn ln cn+ openingNewFile filename $ gotoLn line++-- | Goes to the next tag. (:tnext)+nextTag :: YiM ()+nextTag = do+ prev <- withEditor popTagStack + case prev of+ Nothing -> errorEditor $ "tag stack empty"+ Just (tag, ind, fn, ln, cn) -> gotoTag tag (ind + 1) (Just (fn, ln, cn))++-- | Return to location from before last tag jump.+popTag :: YiM ()+popTag = do+ tl <- withEditor getTagList+ case tl of+ [] -> errorEditor "tag stack empty"+ _ -> do+ posloc <- withEditor popTagStack+ case posloc of+ Nothing -> errorEditor "at bottom of tag stack"+ Just (_, _, fn, ln, cn) -> openingNewFile fn $ moveToLineColB ln cn++-- | Go to next tag in the tag stack. Represents :tag without any+-- specified tag.+unpopTag :: YiM ()+unpopTag = do+ tl <- withEditor getTagList+ ti <- withEditor getTagIndex+ if ti >= length tl+ then case tl of+ [] -> errorEditor "tag stack empty"+ _ -> errorEditor "at top of tag stack"+ else let (tag, ind, _, _, _) = tl !! ti+ in void . visitTagTable $ \tagTable -> do+ let lis = lookupTag tag tagTable+ if (length lis) <= ind+ then errorEditor $ "tag not found: " <> _unTag tag+ else do+ bufinf <- withCurrentBuffer bufInfoB+ let (filename, line) = lis !! ind+ ln = bufInfoLineNo bufinf+ cn = bufInfoColNo bufinf+ fn = bufInfoFileName bufinf+ tl' = take ti tl+ ++ (tag, ind, fn, ln, cn):(drop (ti + 1) tl)+ withEditor $ setTagList tl'+ openingNewFile filename $ gotoLn line++completeVimTag :: T.Text -> YiM [T.Text]+completeVimTag s =+ fmap maybeToList . visitTagTable $ return . flip completeTag s++-- | Gets the first valid tags file in @TagsFileList@, if such a valid+-- file exists.+tagsFile :: YiM (Maybe FilePath)+tagsFile = do+ fs <- view tagsFileList <$> askCfg+ let g f' f = case f' of+ Just _ -> return f'+ Nothing -> tagsFileLocation f+ foldM g Nothing fs++-- | Handles paths of the form ./[path], which represents a tags file relative+-- to the path of the current directory of a file rather than the directory+-- of the process.+tagsFileLocation :: String -> YiM (Maybe FilePath)+tagsFileLocation s+ | length s < 2 || take 2 s /= "./" = check s+ | otherwise = do+ let s' = drop 2 s+ dir <- takeDirectory <$>+ (withCurrentBuffer $ bufInfoB >>= return . bufInfoFileName)+ check $ dir </> s'+ where check f = do+ f' <- io $ userToCanonPath f+ fileExists <- io $ doesFileExist f'+ if fileExists+ then return $ Just f'+ else return Nothing++-- | Call continuation @act@ with the TagTable. Uses the global table+-- or, if it doesn't exist, uses the first valid tag file in+-- @TagsFileList@.+visitTagTable :: (TagTable -> YiM a) -> YiM (Maybe a)+visitTagTable act = do+ posTagTable <- withEditor getTags+ case posTagTable of+ Just tagTable -> Just <$> act tagTable+ Nothing -> do+ f <- tagsFile+ case f of+ Nothing -> errorEditor "No tags file" >> return Nothing+ Just f' -> do+ tagTable <- io $ importTagTable f'+ withEditor $ setTags tagTable+ Just <$> act tagTable
+ src/Yi/Keymap/Vim/TextObject.hs view
@@ -0,0 +1,67 @@+module Yi.Keymap.Vim.TextObject+ ( TextObject(..)+ , CountedTextObject(..)+ , regionOfTextObjectB+ , changeTextObjectCount+ , changeTextObjectStyle+ , stringToTextObject+ ) where++import Control.Monad (replicateM_, (<=<))+import Yi.Buffer.Adjusted+import Yi.Keymap.Vim.MatchResult+import Yi.Keymap.Vim.StyledRegion (StyledRegion (..), normalizeRegion)++data TextObject = TextObject !RegionStyle !TextUnit+data CountedTextObject = CountedTextObject !Int !TextObject++changeTextObjectCount :: Int -> CountedTextObject -> CountedTextObject+changeTextObjectCount n (CountedTextObject _ to) = CountedTextObject n to++regionOfTextObjectB :: CountedTextObject -> BufferM StyledRegion+regionOfTextObjectB = normalizeRegion <=< textObjectRegionB'++textObjectRegionB' :: CountedTextObject -> BufferM StyledRegion+textObjectRegionB' (CountedTextObject count (TextObject style unit)) =+ fmap (StyledRegion style) $ regionWithTwoMovesB+ (maybeMoveB unit Backward)+ (replicateM_ count $ moveB unit Forward)++changeTextObjectStyle :: (RegionStyle -> RegionStyle) -> TextObject -> TextObject+changeTextObjectStyle smod (TextObject s u) = TextObject (smod s) u++stringToTextObject :: String -> MatchResult TextObject+stringToTextObject "a" = PartialMatch+stringToTextObject "i" = PartialMatch+stringToTextObject ('i':s) = matchFromMaybe (parseTextObject InsideBound s)+stringToTextObject ('a':s) = matchFromMaybe (parseTextObject OutsideBound s)+stringToTextObject _ = NoMatch++parseTextObject :: BoundarySide -> String -> Maybe TextObject+parseTextObject bs (c:[]) = fmap (TextObject Exclusive . ($ bs == OutsideBound)) mkUnit+ where mkUnit = lookup c+ [('w', toOuter unitViWord unitViWordAnyBnd)+ ,('W', toOuter unitViWORD unitViWORDAnyBnd)+ ,('p', toOuter unitEmacsParagraph unitEmacsParagraph) -- TODO inner could be inproved+ ,('s', toOuter unitSentence unitSentence) -- TODO inner could be inproved+ ,('"', unitDelimited '"' '"')+ ,('`', unitDelimited '`' '`')+ ,('\'', unitDelimited '\'' '\'')+ ,('(', unitDelimited '(' ')')+ ,(')', unitDelimited '(' ')')+ ,('b', unitDelimited '(' ')')+ ,('[', unitDelimited '[' ']')+ ,(']', unitDelimited '[' ']')+ ,('{', unitDelimited '{' '}')+ ,('}', unitDelimited '{' '}')+ ,('B', unitDelimited '{' '}')+ ,('<', unitDelimited '<' '>')+ ,('>', unitDelimited '<' '>')+ -- TODO: 't'+ ]+parseTextObject _ _ = Nothing++-- TODO: this probably belongs to Buffer.TextUnit+toOuter :: TextUnit -> TextUnit -> Bool -> TextUnit+toOuter outer _ True = leftBoundaryUnit outer+toOuter _ inner False = inner
+ src/Yi/Keymap/Vim/Utils.hs view
@@ -0,0 +1,218 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Keymap.Vim.Utils+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable+--+-- Utils for the Vim keymap.++module Yi.Keymap.Vim.Utils+ ( mkBindingE+ , mkBindingY+ , mkStringBindingE+ , mkStringBindingY+ , splitCountedCommand+ , selectBinding+ , selectPureBinding+ , matchFromBool+ , mkMotionBinding+ , mkChooseRegisterBinding+ , pasteInclusiveB+ , addNewLineIfNecessary+ , indentBlockRegionB+ , addVimJumpHereE+ , exportRegisterToClipboard+ , pasteFromClipboard+ ) where++import Lens.Micro.Platform ((.=), use)+import Control.Monad (forM_, void, when)+import Data.Char (isSpace)+import Data.Foldable (asum)+import Data.List (group)+import qualified Data.Text as T (unpack)+import Safe (headDef)+import Yi.Buffer.Adjusted hiding (Insert)+import Yi.Editor+import Yi.Event (Event)+import Yi.Keymap (YiM)+import Yi.Keymap.Vim.Common+import Yi.Keymap.Vim.EventUtils (eventToEventString, splitCountedCommand)+import Yi.Keymap.Vim.MatchResult+import Yi.Keymap.Vim.Motion (Move (Move), stringToMove)+import Yi.Keymap.Vim.StateUtils (getMaybeCountE, modifyStateE,+ resetCountE, getRegisterE)+import Yi.Monad (whenM)+import Yi.Rope (YiString, countNewLines, last)+import qualified Yi.Rope as R (replicateChar, snoc, toString, fromString)+import Yi.Utils (io)+import System.Hclip (getClipboard, setClipboard)++-- 'mkBindingE' and 'mkBindingY' are helper functions for bindings+-- where VimState mutation is not dependent on action performed+-- and prerequisite has form (mode == ... && event == ...)++mkStringBindingE :: VimMode -> RepeatToken+ -> (EventString, EditorM (), VimState -> VimState) -> VimBinding+mkStringBindingE mode rtoken (eventString, action, mutate) = VimBindingE f+ where f _ vs | vsMode vs /= mode = NoMatch+ f evs _ = combineAction action mutate rtoken <$+ evs `matchesString` eventString++mkStringBindingY :: VimMode+ -> (EventString, YiM (), VimState -> VimState) -> VimBinding+mkStringBindingY mode (eventString, action, mutate) = VimBindingY f+ where f _ vs | vsMode vs /= mode = NoMatch+ f evs _ = combineAction action mutate Drop <$+ evs `matchesString` eventString++mkBindingE :: VimMode -> RepeatToken -> (Event, EditorM (), VimState -> VimState) -> VimBinding+mkBindingE mode rtoken (event, action, mutate) = VimBindingE f+ where f evs vs = combineAction action mutate rtoken <$+ matchFromBool (vsMode vs == mode && evs == eventToEventString event)++mkBindingY :: VimMode -> (Event, YiM (), VimState -> VimState) -> VimBinding+mkBindingY mode (event, action, mutate) = VimBindingY f+ where f evs vs = combineAction action mutate Drop <$+ matchFromBool (vsMode vs == mode && evs == eventToEventString event)++combineAction :: MonadEditor m => m () -> (VimState -> VimState) -> RepeatToken -> m RepeatToken+combineAction action mutateState rtoken = do+ action+ withEditor $ modifyStateE mutateState+ return rtoken++-- | All impure bindings will be ignored.+selectPureBinding :: EventString -> VimState -> [VimBinding] -> MatchResult (EditorM RepeatToken)+selectPureBinding evs state = asum . fmap try+ where try (VimBindingE matcher) = matcher evs state+ try (VimBindingY _) = NoMatch++selectBinding :: EventString -> VimState -> [VimBinding] -> MatchResult (YiM RepeatToken)+selectBinding input state = asum . fmap try+ where try (VimBindingY matcher) = matcher input state+ try (VimBindingE matcher) = fmap withEditor $ matcher input state++setUnjumpMarks :: Point -> BufferM ()+setUnjumpMarks p = do+ solP <- solPointB p+ lineStream <- indexedStreamB Forward solP+ let fstNonBlank =+ headDef solP [ p' | (p', ch) <- lineStream, not (isSpace ch) || ch == '\n' ]+ (.= p) . markPointA =<< getMarkB (Just "`")+ (.= fstNonBlank) . markPointA =<< getMarkB (Just "'")++addVimJumpAtE :: Point -> EditorM ()+addVimJumpAtE p = do+ withCurrentBuffer $ setUnjumpMarks p+ addJumpAtE p++addVimJumpHereE :: EditorM ()+addVimJumpHereE = do+ withCurrentBuffer $ setUnjumpMarks =<< pointB+ addJumpHereE++mkMotionBinding :: RepeatToken -> (VimMode -> Bool) -> VimBinding+mkMotionBinding token condition = VimBindingE f+ where+ -- TODO: stringToMove and go both to EventString+ f :: EventString -> VimState -> MatchResult (EditorM RepeatToken)+ f evs state | condition (vsMode state) =+ fmap (go . T.unpack . _unEv $ evs) (stringToMove evs)+ f _ _ = NoMatch++ go :: String -> Move -> EditorM RepeatToken+ go evs (Move _style isJump move) = do+ count <- getMaybeCountE+ prevPoint <- withCurrentBuffer $ do+ p <- pointB+ move count+ leftOnEol+ return p+ when isJump $ addVimJumpAtE prevPoint+ resetCountE++ sticky <- withCurrentBuffer $ use stickyEolA++ -- moving with j/k after $ sticks cursor to the right edge+ when (evs == "$") . withCurrentBuffer $ stickyEolA .= True+ when (evs `elem` group "jk" && sticky) $+ withCurrentBuffer $ moveToEol >> moveXorSol 1+ when (evs `notElem` group "jk$") . withCurrentBuffer $ stickyEolA .= False++ let m = head evs+ when (m `elem` ('f' : "FtT")) $ do+ let c = Prelude.last evs+ (dir, style) =+ case m of+ 'f' -> (Forward, Inclusive)+ 't' -> (Forward, Exclusive)+ 'F' -> (Backward, Inclusive)+ 'T' -> (Backward, Exclusive)+ _ -> error "can't happen"+ command = GotoCharCommand c dir style+ modifyStateE $ \s -> s { vsLastGotoCharCommand = Just command}++ return token++mkChooseRegisterBinding :: (VimState -> Bool) -> VimBinding+mkChooseRegisterBinding statePredicate = VimBindingE (f . T.unpack . _unEv)+ where f "\"" s | statePredicate s = PartialMatch+ f ['"', c] s | statePredicate s = WholeMatch $ do+ modifyStateE $ \s' -> s' { vsActiveRegister = c }+ return Continue+ f _ _ = NoMatch++indentBlockRegionB :: Int -> Region -> BufferM ()+indentBlockRegionB count reg = do+ indentSettings <- indentSettingsB+ (start, lengths) <- shapeOfBlockRegionB reg+ moveTo start+ forM_ (zip [1..] lengths) $ \(i, _) -> do+ whenM (not <$> atEol) $ do+ let w = shiftWidth indentSettings+ if count > 0+ then insertN $ R.replicateChar (count * w) ' '+ else go (abs count * w)+ moveTo start+ void $ lineMoveRel i+ moveTo start+ where+ go 0 = return ()+ go n = do+ c <- readB+ when (c == ' ') $+ deleteN 1 >> go (n - 1)+++pasteInclusiveB :: YiString -> RegionStyle -> BufferM ()+pasteInclusiveB rope style = do+ p0 <- pointB+ insertRopeWithStyleB rope style+ if countNewLines rope == 0 && style `elem` [ Exclusive, Inclusive ]+ then leftB+ else moveTo p0++trailingNewline :: YiString -> Bool+trailingNewline t = case Yi.Rope.last t of+ Just '\n' -> True+ _ -> False++addNewLineIfNecessary :: YiString -> YiString+addNewLineIfNecessary rope =+ if trailingNewline rope then rope else rope `R.snoc` '\n'++pasteFromClipboard :: YiM ()+pasteFromClipboard = do+ text <- fmap R.fromString $ io getClipboard+ withCurrentBuffer $ insertRopeWithStyleB text Inclusive++exportRegisterToClipboard :: RegisterName -> YiM ()+exportRegisterToClipboard name = do+ mbr <- withEditor $ getRegisterE name+ io . setClipboard $ maybe "" (R.toString . regContent) mbr+
+ src/Yi/Keymap/Vim/VisualMap.hs view
@@ -0,0 +1,281 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Keymap.Vim.VisualMap+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable+--+-- I'm a module waiting for some kind soul to give me a commentary!++module Yi.Keymap.Vim.VisualMap ( defVisualMap ) where++import Lens.Micro.Platform ((.=))+import Control.Monad (forM_, void)+import Data.Char (ord)+import Data.List (group)+import Data.Maybe (fromJust, fromMaybe)+import qualified Data.Text as T (unpack)+import Yi.Buffer.Adjusted hiding (Insert)+import Yi.Editor+import Yi.Keymap.Vim.Common+import Yi.Keymap.Vim.Operator (VimOperator (..), opDelete, stringToOperator)+import Yi.Keymap.Vim.StateUtils+import Yi.Keymap.Vim.StyledRegion (StyledRegion (StyledRegion), transformCharactersInRegionB)+import Yi.Keymap.Vim.Tag (gotoTag)+import Yi.Keymap.Vim.TextObject+import Yi.Keymap.Vim.Utils (matchFromBool, mkChooseRegisterBinding, mkMotionBinding)+import Yi.MiniBuffer (spawnMinibufferE)+import Yi.Monad (whenM)+import qualified Yi.Rope as R (toText)+import Yi.Tag (Tag (Tag))+import Yi.Utils (SemiNum ((-~)))++defVisualMap :: [VimOperator] -> [VimBinding]+defVisualMap operators =+ [escBinding, motionBinding, textObjectBinding, changeVisualStyleBinding, setMarkBinding]+ ++ [chooseRegisterBinding]+ ++ operatorBindings operators ++ digitBindings ++ [replaceBinding, switchEdgeBinding]+ ++ [insertBinding, exBinding, shiftDBinding]+ ++ [tagJumpBinding]++escAction :: EditorM RepeatToken+escAction = do+ resetCountE+ clrStatus+ withCurrentBuffer $ do+ setVisibleSelection False+ putRegionStyle Inclusive+ switchModeE Normal+ return Drop++escBinding :: VimBinding+escBinding = VimBindingE f+ where f evs (VimState { vsMode = (Visual _) }) = escAction <$+ matchFromBool (evs `elem` ["<Esc>", "<C-c>"])+ f _ _ = NoMatch++exBinding :: VimBinding+exBinding = VimBindingE f+ where f ":" (VimState { vsMode = (Visual _) }) = WholeMatch $ do+ void $ spawnMinibufferE ":" id+ withCurrentBuffer $ writeN "'<,'>"+ switchModeE Ex+ return Finish+ f _ _ = NoMatch++digitBindings :: [VimBinding]+digitBindings = zeroBinding : fmap mkDigitBinding ['1' .. '9']++zeroBinding :: VimBinding+zeroBinding = VimBindingE f+ where f "0" (VimState { vsMode = (Visual _) }) = WholeMatch $ do+ currentState <- getEditorDyn+ case vsCount currentState of+ Just c -> do+ setCountE (10 * c)+ return Continue+ Nothing -> do+ withCurrentBuffer moveToSol+ resetCountE+ withCurrentBuffer $ stickyEolA .= False+ return Continue+ f _ _ = NoMatch++setMarkBinding :: VimBinding+setMarkBinding = VimBindingE (f . T.unpack . _unEv)+ where f "m" (VimState { vsMode = (Visual _) }) = PartialMatch+ f ('m':c:[]) (VimState { vsMode = (Visual _) }) = WholeMatch $ do+ withCurrentBuffer $ setNamedMarkHereB [c]+ return Continue+ f _ _ = NoMatch++changeVisualStyleBinding :: VimBinding+changeVisualStyleBinding = VimBindingE f+ where f evs (VimState { vsMode = (Visual _) })+ | evs `elem` ["v", "V", "<C-v>"]+ = WholeMatch $ do+ currentMode <- fmap vsMode getEditorDyn+ let newStyle = case evs of+ "v" -> Inclusive+ "V" -> LineWise+ "<C-v>" -> Block+ _ -> error "Just silencing false positive warning."+ newMode = Visual newStyle+ if newMode == currentMode+ then escAction+ else do+ modifyStateE $ \s -> s { vsMode = newMode }+ withCurrentBuffer $ do+ putRegionStyle newStyle+ rectangleSelectionA .= (Block == newStyle)+ setVisibleSelection True+ return Finish+ f _ _ = NoMatch++mkDigitBinding :: Char -> VimBinding+mkDigitBinding c = VimBindingE (f . T.unpack . _unEv)+ where f [c'] (VimState { vsMode = (Visual _) }) | c == c'+ = WholeMatch $ do+ modifyStateE mutate+ return Continue+ f _ _ = NoMatch+ mutate vs@(VimState {vsCount = Nothing}) = vs { vsCount = Just d }+ mutate vs@(VimState {vsCount = Just count}) = vs { vsCount = Just $ count * 10 + d }+ d = ord c - ord '0'++motionBinding :: VimBinding+motionBinding = mkMotionBinding Continue $+ \m -> case m of+ Visual _ -> True+ _ -> False++textObjectBinding :: VimBinding+textObjectBinding = VimBindingE (f . T.unpack . _unEv)+ where+ f (stringToTextObject -> PartialMatch) (VimState {vsMode = Visual _}) = PartialMatch+ f (stringToTextObject -> WholeMatch to) (VimState {vsMode = Visual _, vsCount = mbCount}) =+ let count = fromMaybe 1 mbCount+ in+ WholeMatch $ do+ withCurrentBuffer $ do+ StyledRegion _ reg <- regionOfTextObjectB (CountedTextObject count to)+ setSelectionMarkPointB (regionStart reg)+ moveTo (regionEnd reg -~ 1)+ return Continue+ f _ _ = NoMatch++regionOfSelectionB :: BufferM Region+regionOfSelectionB = savingPointB $ do+ start <- getSelectionMarkPointB+ stop <- pointB+ return $! mkRegion start stop++operatorBindings :: [VimOperator] -> [VimBinding]+operatorBindings operators = fmap mkOperatorBinding $ operators ++ visualOperators+ where visualOperators = fmap synonymOp+ [ ("x", "d")+ , ("s", "c")+ , ("S", "c")+ , ("C", "c")+ , ("~", "g~")+ , ("Y", "y")+ , ("u", "gu")+ , ("U", "gU")+ ]+ synonymOp (newName, existingName) =+ VimOperator newName . operatorApplyToRegionE . fromJust+ . stringToOperator operators $ existingName++chooseRegisterBinding :: VimBinding+chooseRegisterBinding = mkChooseRegisterBinding $+ \s -> case s of+ (VimState { vsMode = (Visual _) }) -> True+ _ -> False++shiftDBinding :: VimBinding+shiftDBinding = VimBindingE (f . T.unpack . _unEv)+ where f "D" (VimState { vsMode = (Visual _) }) = WholeMatch $ do+ (Visual style) <- vsMode <$> getEditorDyn+ reg <- withCurrentBuffer regionOfSelectionB+ case style of+ Block -> withCurrentBuffer $ do+ (start, lengths) <- shapeOfBlockRegionB reg+ moveTo start+ startCol <- curCol+ forM_ (reverse [0 .. length lengths - 1]) $ \l -> do+ moveTo start+ void $ lineMoveRel l+ whenM (fmap (== startCol) curCol) deleteToEol+ leftOnEol+ _ -> do+ reg' <- withCurrentBuffer $ convertRegionToStyleB reg LineWise+ reg'' <- withCurrentBuffer $ mkRegionOfStyleB (regionStart reg')+ (regionEnd reg' -~ Size 1)+ Exclusive+ void $ operatorApplyToRegionE opDelete 1 $ StyledRegion LineWise reg''+ resetCountE+ switchModeE Normal+ return Finish+ f _ _ = NoMatch++mkOperatorBinding :: VimOperator -> VimBinding+mkOperatorBinding op = VimBindingE f+ where+ f evs (VimState { vsMode = (Visual _) }) =+ action <$ evs `matchesString` Ev (_unOp $ operatorName op)+ f _ _ = NoMatch+ action = do+ (Visual style) <- vsMode <$> getEditorDyn+ region <- withCurrentBuffer regionOfSelectionB+ count <- getCountE+ token <- operatorApplyToRegionE op count $ StyledRegion style region+ resetCountE+ clrStatus+ withCurrentBuffer $ do+ setVisibleSelection False+ putRegionStyle Inclusive+ return token++replaceBinding :: VimBinding+replaceBinding = VimBindingE (f . T.unpack . _unEv)+ where f evs (VimState { vsMode = (Visual _) }) =+ case evs of+ "r" -> PartialMatch+ ('r':c:[]) -> WholeMatch $ do+ (Visual style) <- vsMode <$> getEditorDyn+ region <- withCurrentBuffer regionOfSelectionB+ withCurrentBuffer $ transformCharactersInRegionB (StyledRegion style region)+ (\x -> if x == '\n' then x else c)+ switchModeE Normal+ return Finish+ _ -> NoMatch+ f _ _ = NoMatch++switchEdgeBinding :: VimBinding+switchEdgeBinding = VimBindingE (f . T.unpack . _unEv)+ where f [c] (VimState { vsMode = (Visual _) }) | c `elem` ['o', 'O']+ = WholeMatch $ do+ (Visual style) <- vsMode <$> getEditorDyn+ withCurrentBuffer $ do+ here <- pointB+ there <- getSelectionMarkPointB+ (here', there') <- case (c, style) of+ ('O', Block) -> flipRectangleB here there+ (_, _) -> return (there, here)+ moveTo here'+ setSelectionMarkPointB there'+ return Continue+ f _ _ = NoMatch++insertBinding :: VimBinding+insertBinding = VimBindingE (f . T.unpack . _unEv)+ where f evs (VimState { vsMode = (Visual _) }) | evs `elem` group "IA"+ = WholeMatch $ do+ (Visual style) <- vsMode <$> getEditorDyn+ region <- withCurrentBuffer regionOfSelectionB+ cursors <- withCurrentBuffer $ case evs of+ "I" -> leftEdgesOfRegionB style region+ "A" -> rightEdgesOfRegionB style region+ _ -> error "Just silencing ghc's false positive warning."+ case cursors of+ [] -> error "No cursor to move to (in Yi.Keymap.Vim.VisualMap.insertBinding)"+ (mainCursor : _) -> withCurrentBuffer (moveTo mainCursor)+ modifyStateE $ \s -> s { vsSecondaryCursors = drop 1 cursors }+ switchModeE $ Insert (head evs)+ return Continue+ f _ _ = NoMatch++tagJumpBinding :: VimBinding+tagJumpBinding = VimBindingY (f . T.unpack . _unEv)+ where f "<C-]>" (VimState { vsMode = (Visual _) })+ = WholeMatch $ do+ tag <- Tag . R.toText <$> withCurrentBuffer+ (regionOfSelectionB >>= readRegionB)+ withEditor $ switchModeE Normal+ gotoTag tag 0 Nothing+ return Finish+ f _ _ = NoMatch
+ tests/Generic/TestPureBufferManipulations.hs view
@@ -0,0 +1,212 @@+-- | This module aims to provide a generic back-end for other keymaps to+-- use for pure buffer manipulations. Pure buffer manipulations are considered+-- to be operations which simply change the contents of the buffer and move the+-- cursor. For example, opening a second buffer is not considered a pure buffer+-- operation.++module Generic.TestPureBufferManipulations where++import Test.Tasty.HUnit+import Test.Tasty (TestTree, testGroup)++import Control.Monad (filterM, forM, void, unless)+import Lens.Micro.Platform ((%=))++import Data.List (sort, isSuffixOf, intercalate, isPrefixOf)+import Data.Ord (comparing)++import System.Directory+import System.FilePath++import Text.Printf++import Yi.Buffer+import Yi.Config (Config)+import Yi.Editor+import Yi.Window+import Yi.Region++import Generic.TestUtils++data KeymapTest = KeymapTest {+ ktName :: String+ , ktOptionalSettings :: [OptionalSetting]+ , ktInput :: String+ , ktOutput :: String+ , ktEventString :: String+ , ktKeysEval :: KeyEval+ }++data OptionalSetting = WindowSize Int Int -- ^ WindowSize Width Height + deriving Eq++instance Show OptionalSetting where+ show (WindowSize w h) = unwords ["+WindowSize", (show w), (show h)]++instance Eq KeymapTest where+ KeymapTest n s i o e _ == KeymapTest n' s' i' o' e' _ =+ n == n' && s == s' && i == i' && o == o' && e == e'++instance Ord KeymapTest where+ compare = comparing ktName+++data TestResult = TestPassed String+ | TestFailed String String++instance Show TestResult where+ show (TestPassed name) = "PASSED " ++ name+ show (TestFailed name msg) = "FAILED " ++ name ++ ":\n" ++ msg++unlines' :: [String] -> String+unlines' = intercalate "\n"++optionalSettingPrefix :: String+optionalSettingPrefix = "--+ " ++isOptionalSetting :: String -> Bool+isOptionalSetting = (optionalSettingPrefix `isPrefixOf`)++decodeOptionalSetting :: [String] -> OptionalSetting+decodeOptionalSetting ["WindowSize", w, h] = WindowSize (read w) (read h)+decodeOptionalSetting unknownSetting = + error $ "Invalid Setting: " ++ (intercalate " " unknownSetting) ++loadTestFromDirectory :: FilePath -- ^ Directory of the test+ -> KeyEval -- ^ Function that can run+ -- ‘events’ commands+ -> IO KeymapTest+loadTestFromDirectory path ev = do+ [input, output, events] <- mapM (readFile' . (path </>)) ["input", "output", "events"]+ return $ KeymapTest (joinPath . drop 1 . splitPath $ path) [] input output events ev++isValidTestFile :: String -> Bool+isValidTestFile text =+ case (skipOptionals . lines $ text) of+ [] -> False+ ("-- Input": ls) ->+ case break (== "-- Output") ls of+ (_, []) -> False+ (_, "-- Output":ls') -> "-- Events" `elem` ls'+ _ -> False+ _ -> False+ where+ skipOptionals = dropWhile isOptionalSetting++-- | See Arguments to 'loadTestFromDirectory'+loadTestFromFile :: FilePath -> KeyEval -> IO KeymapTest+loadTestFromFile path ev = do+ text <- readFile' path+ unless (isValidTestFile text) $+ void $ printf "Test %s is invalid\n" path+ let (optionals, testContents) = span isOptionalSetting (lines text) + ls = tail testContents+ (input, rest) = break (== "-- Output") ls+ (output, rest2) = break (== "-- Events") $ tail rest+ eventText = tail rest2+ return $+ KeymapTest+ (joinPath . drop 1 . splitPath . dropExtension $ path)+ (map (decodeOptionalSetting . drop 1 . words) optionals)+ (unlines' input)+ (unlines' output)+ (unlines' eventText)+ ev++containsTest :: FilePath -> IO Bool+containsTest d = do+ files <- fmap (filter (`notElem` [".", ".."])) $ getDirectoryContents d+ return $ sort files == ["events", "input", "output"]++getRecursiveFiles :: FilePath -> IO [FilePath]+getRecursiveFiles topdir = do+ names <- getDirectoryContents topdir+ let properNames = filter (`notElem` [".", "..", ".git", ".svn"]) names+ paths <- forM properNames $ \name -> do+ let path = topdir </> name+ isDirectory <- doesDirectoryExist path+ if isDirectory+ then getRecursiveFiles path+ else return [path]+ return (concat paths)++getRecursiveDirectories :: FilePath -> IO [FilePath]+getRecursiveDirectories topdir = do+ names <- getDirectoryContents topdir+ let properNames = filter (`notElem` [".", "..", ".git", ".svn"]) names+ paths <- forM properNames $ \name -> do+ let path = topdir </> name+ isDirectory <- doesDirectoryExist path+ if isDirectory+ then fmap (path:) $ getRecursiveDirectories path+ else return []+ return (concat paths)++discoverTests :: FilePath -> KeyEval -> IO [KeymapTest]+discoverTests topdir ev = do+ dirs <- getRecursiveDirectories topdir+ testDirs <- filterM containsTest dirs+ testFiles <- fmap (filter (isSuffixOf ".test")) $ getRecursiveFiles topdir+ testsFromDirs <- mapM (`loadTestFromDirectory` ev) testDirs+ testsFromFiles <- mapM (`loadTestFromFile` ev) testFiles+ return $ testsFromDirs ++ testsFromFiles++optionalSettingAction :: OptionalSetting -> EditorM ()+optionalSettingAction (WindowSize w h) = + let region = mkSizeRegion (Point 0) (Size (w*h))+ in currentWindowA %= (\w -> w { height = h, actualLines = h, winRegion = region })++mkTestCase :: Config -> KeymapTest -> TestTree+mkTestCase cf t = testCase (ktName t) $ do+ let setupActions = do+ let (cursorLine, '\n':text) = break (== '\n') (ktInput t)+ mapM_ optionalSettingAction $ ktOptionalSettings t+ insertText text+ setCursorPosition cursorLine++ preConditions _ _ = return ()++ testActions _ = ktKeysEval t $ ktEventString t++ assertions editor _ =+ let actualOut = cursorPos editor ++ "\n" +++ extractBufferString cf editor+ in assertEqual (errorMsg actualOut) actualOut (ktOutput t)++ runTest setupActions preConditions testActions assertions cf++ where+ setCursorPosition cursorLine =+ let (x, y) = read cursorLine+ in withCurrentBuffer $ moveToLineColB x (y - 1)+ cursorPos = show . snd . runEditor cf (withCurrentBuffer $ do+ l <- curLn+ c <- curCol+ return (l, c + 1))+ errorMsg actualOut = unlines $ optionalSettings +++ [ "Input:", ktInput t+ , "Expected:", ktOutput t+ , "Got:", actualOut+ , "Events:", ktEventString t+ , "---"]+ optionalSettings = map show $ ktOptionalSettings t++-- | Takes a directory with the tests, a name of the keymap+-- and an evaluation function for the keys contained in the tests.+-- For Vim, we might do something like:+--+-- @+-- getTests defaultVimConfig "src/tests/vimtests"+-- "Vim" (pureEval $ extractValue defVimConfig)+-- @+getTests :: Config -> FilePath -> String+ -> KeyEval -> IO TestTree+getTests c fp n ev = do+ tests <- discoverTests fp ev+ return $ testGroup (n ++ " keymap tests") $+ fmap (mkTestCase c) . sort $ tests++readFile' :: FilePath -> IO String+readFile' f = do+ s <- readFile f+ return $! length s `seq` s
+ tests/Generic/TestUtils.hs view
@@ -0,0 +1,99 @@+module Generic.TestUtils where++import Control.Monad (unless)+import Test.Tasty.HUnit+import Yi.Buffer+import Yi.Config (Config)+import Yi.Editor+import qualified Yi.Rope as R+++type KeyEval = String -> EditorM ()+-- | Run a pure editor manipulation test.+--+-- Runs the @setupActions@ against an empty editor. Checks that @preConditions@+-- hold for that editor. Then runs @testActions@ against the setup editor.+-- Finally checks that @assertions@ hold for the final editor state.+--+-- @preConditions@, @testActions@ and @assertions@ are each passed the return+-- value of @setupActions@.+--+runTest :: EditorM a+ -- ^ Setup actions to initialize the editor.+ -> (Editor -> a -> Assertion)+ -- ^ Precondition assertions. Used to check that the editor+ -- is in the expected state prior to running the test actions.+ -> (a -> EditorM ())+ -- ^ The actions to run as part of the test. The return value+ -- from the setup action is passed to this.+ -> (Editor -> a -> Assertion)+ -- ^ Assertions to check that the editor is in the expected+ -- state. The return value from the setup action is passed to+ -- this.+ -> Config+ -- ^ The 'Config' to use for this test. 'defaultVimConfig' is+ -- an example of a value we could provide.+ -> Assertion+runTest setupActions preConditions testActions assertions c = do+ let (setupEditor, a) = runEditor c setupActions emptyEditor+ preConditions setupEditor a+ let finalEditor = fst $ runEditor c (testActions a) setupEditor+ assertions finalEditor a+++-- Return the contents of the current buffer as a string.+extractBufferString :: Config -> Editor -> String+extractBufferString c editor =+ R.toString $ snd (runEditor c (withCurrentBuffer elemsB) editor)+++--------------------------------------------------+-- Functions for altering the state of the editor.++-- | Insert the given text into the editor inside an update transaction.+insertText :: String -> EditorM ()+insertText text =+ withCurrentBuffer $ do+ startUpdateTransactionB+ insertN (R.fromString text)+ commitUpdateTransactionB+++--------------------------------------------------+-- Useful assertions.++-- | Asserts that the specified actual value is not equal to the unexpected+-- value. The output message will contain the prefix and the actual value.+--+-- If the prefix is the empty string (i.e., @\"\"@), then the prefix is omitted+-- and only the actual value is output.+assertNotEqual :: (Eq a, Show a) => String -- ^ The message prefix+ -> a -- ^ The expected value+ -> a -- ^ The actual value+ -> Assertion+assertNotEqual preface expected actual =+ unless (actual /= expected) (assertFailure msg)+ where+ msg = (if null preface then "" else preface ++ "\n") +++ "expected not to get: " ++ show expected+++-- | Asserts that the contents of the current buffer are equal to the expected+-- value. The output message will contain the expected value and the actual value.+assertContentOfCurrentBuffer :: Config -> String -> Editor -> Assertion+assertContentOfCurrentBuffer c expectedContent editor =+ assertEqual "Unexpected buffer content" expectedContent (extractBufferString c editor)+++-- | Asserts that the current buffer is not the specified buffer. The output will+-- contain the BufferKey of the current buffer.+assertNotCurrentBuffer :: BufferRef -> Editor -> Assertion+assertNotCurrentBuffer bufref editor =+ assertNotEqual "Unexpected current buffer" bufref (currentBuffer editor)+++-- | Asserts that the current buffer is the expected buffer. The output will+-- contain the expected BufferKey and the acutal BufferKey of the current buffer.+assertCurrentBuffer :: BufferRef -> Editor -> Assertion+assertCurrentBuffer bufref editor =+ assertEqual "Unexpected current buffer" bufref (currentBuffer editor)
+ tests/TestSuite.hs view
@@ -0,0 +1,16 @@+module Main where++import Test.Tasty (defaultMain, testGroup)++import qualified Vim.TestPureBufferManipulations as VimBuffer+import qualified Vim.TestPureEditorManipulations as VimEditor+import qualified Vim.TestExCommandParsers as VimExCommand++main :: IO ()+main = do+ tests <- VimBuffer.getTests+ defaultMain $ testGroup "Tests" [+ tests+ , VimEditor.tests+ , VimExCommand.tests+ ]
+ tests/Vim/EditorManipulations/BufferExCommand.hs view
@@ -0,0 +1,174 @@+{-# LANGUAGE OverloadedStrings #-}+-- | Tests for the :buffer ex command in the Vim keymap+--+module Vim.EditorManipulations.BufferExCommand (tests) where++import qualified Data.List.NonEmpty as NE+import Generic.TestUtils+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit+import Yi.Buffer+import Yi.Config (Config)+import Yi.Editor+import Yi.Rope ()++type BufferName = String++-- | Create three buffers and return the 'BufferRef' and buffer name of+-- each.+createInitialBuffers :: EditorM [(BufferRef, BufferName)]+createInitialBuffers = do+ one <- newBufferE (FileBuffer "one") "Buffer one"+ two <- newBufferE (FileBuffer "two") "Buffer two"+ three <- newBufferE (FileBuffer "three") "Buffer three"+ return [(one, "one"), (two, "two"), (three, "three")]+++nthBufferRef :: Int -> [(BufferRef, BufferName)] -> BufferRef+nthBufferRef n buffers = fst $ buffers !! n++nthBufferName :: Int -> [(BufferRef, BufferName)] -> BufferName+nthBufferName n buffers = snd $ buffers !! n+++tests :: Config -> KeyEval -> TestTree+tests c ev =+ testGroup ":buffer" [+ testCase ":buffer {bufname} switches to the named buffer" $ do+ let setupActions = createInitialBuffers++ preConditions editor buffers =+ assertNotCurrentBuffer (nthBufferRef 1 buffers) editor++ testActions buffers =+ ev $ ":buffer " ++ nthBufferName 1 buffers ++ "<CR>"++ assertions editor buffers = do+ assertContentOfCurrentBuffer c "Buffer two" editor+ assertCurrentBuffer (nthBufferRef 1 buffers) editor++ runTest setupActions preConditions testActions assertions c+++ , testCase ":buffer N switches to the numbered buffer" $ do+ let setupActions = createInitialBuffers++ preConditions editor buffers =+ assertNotCurrentBuffer (nthBufferRef 1 buffers) editor++ testActions buffers =+ let (BufferRef bref) = nthBufferRef 1 buffers+ in ev $ ":buffer " ++ show bref ++ "<CR>"++ assertions editor buffers = do+ assertContentOfCurrentBuffer c "Buffer two" editor+ assertCurrentBuffer (nthBufferRef 1 buffers) editor++ runTest setupActions preConditions testActions assertions c+++ , testCase ":buffer # switches to the previous buffer" $ do+ let setupActions = createInitialBuffers++ preConditions editor buffers =+ assertEqual "Unexpected buffer stack"+ [nthBufferRef 2 buffers, nthBufferRef 1 buffers]+ (take 2 . NE.toList $ bufferStack editor)++ testActions _ =+ ev $ ":buffer #<CR>"++ assertions editor buffers = do+ assertEqual "Unexpected buffer stack"+ [nthBufferRef 1 buffers, nthBufferRef 2 buffers]+ (take 2 . NE.toList $ bufferStack editor)++ runTest setupActions preConditions testActions assertions c+++ , testCase ":buffer % is a no-op" $ do+ let setupActions = createInitialBuffers++ preConditions editor buffers =+ assertCurrentBuffer (nthBufferRef 2 buffers) editor++ testActions _ =+ ev $ ":buffer %<CR>"++ assertions editor buffers = do+ assertContentOfCurrentBuffer c "Buffer three" editor+ assertCurrentBuffer (nthBufferRef 2 buffers) editor++ runTest setupActions preConditions testActions assertions c+++ , testCase ":buffer is a no-op" $ do+ let setupActions = createInitialBuffers++ preConditions editor buffers =+ assertCurrentBuffer (nthBufferRef 2 buffers) editor++ testActions _ =+ ev $ ":buffer<CR>"++ assertions editor buffers = do+ assertContentOfCurrentBuffer c "Buffer three" editor+ assertCurrentBuffer (nthBufferRef 2 buffers) editor++ runTest setupActions preConditions testActions assertions c+++ , testCase "A modified buffer is not abandoned" $ do+ let setupActions = createInitialBuffers++ preConditions editor buffers =+ assertNotCurrentBuffer (nthBufferRef 1 buffers) editor++ testActions buffers = do+ withCurrentBuffer $ insertN "The buffer is altered"+ ev $ ":buffer " ++ nthBufferName 1 buffers ++ "<CR>"++ assertions editor buffers = do+ assertNotCurrentBuffer (nthBufferRef 1 buffers) editor++ runTest setupActions preConditions testActions assertions c+++ , testCase "A modified buffer can be abandoned with a bang" $ do+ let setupActions = createInitialBuffers++ preConditions editor buffers =+ assertNotCurrentBuffer (nthBufferRef 1 buffers) editor++ testActions buffers = do+ withCurrentBuffer $ insertN "The buffer is altered"+ ev $ ":buffer! " ++ nthBufferName 1 buffers ++ "<CR>"++ assertions editor buffers = do+ assertCurrentBuffer (nthBufferRef 1 buffers) editor++ runTest setupActions preConditions testActions assertions c+++ , testCase ":Nbuffer switches to the numbered buffer" $ do+ let setupActions = createInitialBuffers++ preConditions editor buffers =+ assertNotCurrentBuffer (nthBufferRef 1 buffers) editor++ testActions buffers =+ -- return ()+ let (BufferRef bref) = nthBufferRef 1 buffers+ in ev $ ":" ++ show bref ++ "buffer<CR>"+ -- in ev $ ":buffer " ++ show bref ++ "<CR>"++ assertions editor buffers = do+ -- assertContentOfCurrentBuffer c "Buffer two" editor+ assertCurrentBuffer (nthBufferRef 1 buffers) editor++ runTest setupActions preConditions testActions assertions c+++ -- , testCase "A named buffer can be shown in a split window" $ do+ -- , testCase "A numbered buffer can be shown in a split window" $ do+ ]
+ tests/Vim/TestExCommandParsers.hs view
@@ -0,0 +1,157 @@+{-# LANGUAGE OverloadedStrings #-}+module Vim.TestExCommandParsers (tests) where++import Control.Applicative+import Data.Maybe+import Data.Monoid+import qualified Data.Text as T+import Test.QuickCheck+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.QuickCheck+import Yi.Keymap.Vim.Common+import Yi.Keymap.Vim.Ex+import qualified Yi.Keymap.Vim.Ex.Commands.Buffer as Buffer+import qualified Yi.Keymap.Vim.Ex.Commands.BufferDelete as BufferDelete+import qualified Yi.Keymap.Vim.Ex.Commands.Delete as Delete++data CommandParser = CommandParser+ { cpDescription :: String+ , cpParser :: String -> Maybe ExCommand+ , cpNames :: [String]+ , cpAcceptsBang :: Bool+ , cpAcceptsCount :: Bool+ , cpArgs :: Gen String+ }++addingSpace :: Gen String -> Gen String+addingSpace = fmap (" " <>)++numberString :: Gen String+numberString = (\(NonNegative n) -> show n) <$> (arbitrary :: Gen (NonNegative Int))++-- | QuickCheck Generator of buffer identifiers.+--+-- A buffer identifier is either an empty string, a "%" character, a "#"+-- character, a string containing only numbers (optionally preceeded by+-- a space), or a string containing any chars preceeded by a space. E.g.,+--+-- ["", "%", "#", " myBufferName", " 45", "45"]+--+-- TODO Don't select "", "%", "#" half of the time.+bufferIdentifier :: Gen String+bufferIdentifier =+ oneof [ addingSpace arbitrary+ , addingSpace numberString+ , numberString+ , oneof [pure "%", pure " %"]+ , oneof [pure "#", pure " #"]+ , pure ""+ ]++-- | QuickCheck generator of strings suitable for use as register names in Vim+-- ex command lines. Does not include a preceding @"@.+registerName :: Gen String+registerName =+ (:[]) <$> oneof [ elements ['0'..'9']+ , elements ['a'..'z']+ , elements ['A'..'Z']+ , elements ['"', '-', '=', '*', '+', '~', '_', '/']+ -- TODO Should the read-only registers be included here?+ -- , element [':', '.', '%', '#']+ ]++-- | QuickCheck generator of strings suitable for use as counts in Vim ex+-- command lines+count :: Gen String+count = numberString++commandParsers :: [CommandParser]+commandParsers =+ [ CommandParser+ "Buffer.parse"+ (Buffer.parse . Ev . T.pack)+ ["buffer", "buf", "bu", "b"]+ True+ True+ bufferIdentifier++ , CommandParser+ "BufferDelete.parse"+ (BufferDelete.parse . Ev . T.pack)+ ["bdelete", "bdel", "bd"]+ True+ False+ (unwords <$> listOf bufferIdentifier)++ , CommandParser+ "Delete.parse"+ (Delete.parse . Ev . T.pack)+ ["delete", "del", "de", "d"]+ -- XXX TODO support these weird abbreviations too?+ -- :dl, :dell, :delel, :deletl, :deletel+ -- :dp, :dep, :delp, :delep, :deletp, :deletep+ True+ False+ (oneof [ pure ""+ , addingSpace registerName+ , addingSpace count+ , (<>) <$> addingSpace registerName <*> addingSpace count+ ])+ ]+++commandString :: CommandParser -> Gen String+commandString cp = do+ name <- elements $ cpNames cp+ bang <- if cpAcceptsBang cp+ then elements ["!", ""]+ else pure ""+ count' <- if cpAcceptsCount cp+ then count+ else pure ""+ args <- cpArgs cp+ return $ concat [count', name, bang, args]+++expectedParserParses :: CommandParser -> TestTree+expectedParserParses commandParser =+ testProperty (cpDescription commandParser <> " parses expected input") $+ forAll (commandString commandParser)+ (isJust . cpParser commandParser)+++expectedParserSelected :: CommandParser -> TestTree+expectedParserSelected expectedCommandParser =+ testProperty testName $+ forAll (commandString expectedCommandParser) $ \s ->+ let expectedName = expectedCommandName (Ev $ T.pack s)+ actualName = actualCommandName (Ev $ T.pack s)+ in counterexample (errorMessage s actualName)+ (expectedName == actualName)+ where+ unE = T.unpack . _unEv+ expectedCommandName = commandNameFor [cpParser expectedCommandParser . unE]+ actualCommandName = commandNameFor defExCommandParsers+ commandNameFor parsers s =+ cmdShow <$> evStringToExCommand parsers s+ errorMessage s actualName =+ "Parsed " <> show s <> " to " <> show actualName <> " command"+ testName =+ cpDescription expectedCommandParser <> " selected for expected input"++++-- | Tests for the Ex command parsers in the Vim Keymap.+--+-- Tests that the parsers parse the strings they are expected to and that+-- the expected parser is selected for string.+--+-- The actions of the ex commands are not tested here.+tests :: TestTree+tests =+ testGroup "Vim keymap ex command parsers"+ [ testGroup "Expected parser parses" $+ map expectedParserParses commandParsers+ , testGroup "Expected parser selected" $+ map expectedParserSelected commandParsers+ ]
+ tests/Vim/TestPureBufferManipulations.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Tests for pure manipulations of a single buffer in the Vim Keymap.+--+-- A manipulation of a single buffer is an operation or sequence of operations+-- which do nothing other than change the contents or cursor position of a+-- single buffer.+--+-- This module loads the tests from files in @src/tests/vimtests@. Adding new+-- tests, or altering existing tests is done by editing files there. The format+-- should be self explanatory.+--+-- If a test is pure and manipulates something other than the contents or cursor+-- position of a single buffer, it should be added to the+-- 'Vim.TestPureEditorManipulations' module.+--+module Vim.TestPureBufferManipulations (getTests) where++import qualified Data.Text as T+import qualified Generic.TestPureBufferManipulations as GT+import Test.Tasty (TestTree)+import Yi (extractValue)+import Yi.Config.Default (defaultConfig)+import Yi.Keymap.Vim+import Yi.Keymap.Vim.Common+import Yi.Types (Config (..))++getTests :: IO TestTree+getTests = GT.getTests yiConfig "tests/vimtests"+ "Vim" (pureEval (extractValue defVimConfig) . Ev . T.pack)+ where+ yiConfig = defaultConfig {defaultKm = keymapSet}
+ tests/Vim/TestPureEditorManipulations.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE OverloadedStrings #-}+-- | Tests for pure manipulations of the editor in the Vim Keymap.+--+-- Pure manipulations of the editor refers to such things as changing layout,+-- navigating buffers, creating or deleting buffers, creating or deleting tabs.+-- In short, anything which 1) doesn't perform IO and 2) interacts with+-- something other than a single buffer.+--+-- If a test is pure and manipulates only a single buffer, it would be better+-- being part of the 'Vim.TestPureBufferManipulations' module. That module+-- provides a nicer way of writing pure single buffer manipulation tests.+--+module Vim.TestPureEditorManipulations (tests) where++import qualified Data.Text as T+import Test.Tasty (TestTree, testGroup)+import qualified Vim.EditorManipulations.BufferExCommand as BufferExCommand+import Yi (extractValue)+import Yi.Config.Default (defaultConfig)+import Yi.Keymap.Vim+import Yi.Keymap.Vim.Common+import Yi.Types (Config (..))++tests :: TestTree+tests =+ testGroup "Vim pure editor manipulation tests"+ [ BufferExCommand.tests yiConfig+ (pureEval (extractValue defVimConfig) . Ev . T.pack)+ ]+ where+ yiConfig = defaultConfig {defaultKm = keymapSet}
+ yi-keymap-vim.cabal view
@@ -0,0 +1,141 @@+-- This file has been generated from package.yaml by hpack version 0.14.0.+--+-- see: https://github.com/sol/hpack++name: yi-keymap-vim+version: 0.13+synopsis: Vim 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:+ attoparsec+ , base >= 4.8 && < 5+ , binary+ , containers+ , data-default+ , directory+ , filepath+ , Hclip+ , microlens-platform+ , mtl+ , oo-prototypes+ , pointedlist+ , safe+ , semigroups+ , text+ , transformers-base+ , unordered-containers+ , yi-core+ , yi-language+ , yi-rope+ exposed-modules:+ Yi.Config.Default.Vim+ Yi.Keymap.Vim+ Yi.Keymap.Vim.Common+ Yi.Keymap.Vim.Digraph+ Yi.Keymap.Vim.Eval+ Yi.Keymap.Vim.EventUtils+ Yi.Keymap.Vim.Ex+ Yi.Keymap.Vim.Ex.Commands.Buffer+ Yi.Keymap.Vim.Ex.Commands.BufferDelete+ Yi.Keymap.Vim.Ex.Commands.Buffers+ Yi.Keymap.Vim.Ex.Commands.Cabal+ Yi.Keymap.Vim.Ex.Commands.Common+ Yi.Keymap.Vim.Ex.Commands.Copy+ Yi.Keymap.Vim.Ex.Commands.Delete+ Yi.Keymap.Vim.Ex.Commands.Edit+ Yi.Keymap.Vim.Ex.Commands.Global+ Yi.Keymap.Vim.Ex.Commands.GotoLine+ Yi.Keymap.Vim.Ex.Commands.Help+ Yi.Keymap.Vim.Ex.Commands.Make+ Yi.Keymap.Vim.Ex.Commands.Nohl+ Yi.Keymap.Vim.Ex.Commands.Paste+ Yi.Keymap.Vim.Ex.Commands.Quit+ Yi.Keymap.Vim.Ex.Commands.Read+ Yi.Keymap.Vim.Ex.Commands.Reload+ Yi.Keymap.Vim.Ex.Commands.Shell+ Yi.Keymap.Vim.Ex.Commands.Sort+ Yi.Keymap.Vim.Ex.Commands.Substitute+ Yi.Keymap.Vim.Ex.Commands.Tag+ Yi.Keymap.Vim.Ex.Commands.Undo+ Yi.Keymap.Vim.Ex.Commands.Write+ Yi.Keymap.Vim.Ex.Commands.Yi+ Yi.Keymap.Vim.Ex.Eval+ Yi.Keymap.Vim.Ex.Types+ Yi.Keymap.Vim.ExMap+ Yi.Keymap.Vim.InsertMap+ Yi.Keymap.Vim.MatchResult+ Yi.Keymap.Vim.Motion+ Yi.Keymap.Vim.NormalMap+ Yi.Keymap.Vim.NormalOperatorPendingMap+ Yi.Keymap.Vim.Operator+ Yi.Keymap.Vim.ReplaceMap+ Yi.Keymap.Vim.ReplaceSingleCharMap+ Yi.Keymap.Vim.Search+ Yi.Keymap.Vim.SearchMotionMap+ Yi.Keymap.Vim.StateUtils+ Yi.Keymap.Vim.StyledRegion+ Yi.Keymap.Vim.Tag+ Yi.Keymap.Vim.TextObject+ Yi.Keymap.Vim.Utils+ Yi.Keymap.Vim.VisualMap+ other-modules:+ Yi.Keymap.Vim.Ex.Commands.Stack+ Paths_yi_keymap_vim+ default-language: Haskell2010++test-suite spec+ type: exitcode-stdio-1.0+ main-is: TestSuite.hs+ hs-source-dirs:+ tests+ ghc-options: -Wall -ferror-spans+ build-depends:+ attoparsec+ , base >= 4.8 && < 5+ , binary+ , containers+ , data-default+ , directory+ , filepath+ , Hclip+ , microlens-platform+ , mtl+ , oo-prototypes+ , pointedlist+ , safe+ , semigroups+ , text+ , transformers-base+ , unordered-containers+ , yi-core+ , yi-language+ , yi-rope+ , tasty+ , tasty-hunit+ , QuickCheck+ , tasty-quickcheck+ , yi-core+ , yi-keymap-vim+ other-modules:+ Generic.TestPureBufferManipulations+ Generic.TestUtils+ Vim.EditorManipulations.BufferExCommand+ Vim.TestExCommandParsers+ Vim.TestPureBufferManipulations+ Vim.TestPureEditorManipulations+ default-language: Haskell2010