yi-keymap-vim-0.19.0/0000755000000000000000000000000013755614221012473 5ustar0000000000000000yi-keymap-vim-0.19.0/Setup.hs0000644000000000000000000000012613755614221014126 0ustar0000000000000000#!/usr/bin/env runhaskell import Distribution.Simple main :: IO () main = defaultMain yi-keymap-vim-0.19.0/yi-keymap-vim.cabal0000644000000000000000000001106313755614221016156 0ustar0000000000000000name: yi-keymap-vim version: 0.19.0 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 license: GPL-2 build-type: Simple cabal-version: >= 1.10 extra-source-files: tests/vimtests/blockvisual/*.test tests/vimtests/change/*.test tests/vimtests/delete/*.test tests/vimtests/digraphs/*.test tests/vimtests/digraphs/*.test tests/vimtests/empty/*.test tests/vimtests/ex/*.test tests/vimtests/find/*.test tests/vimtests/format/*.test tests/vimtests/indent/*.test tests/vimtests/insertion/*.test tests/vimtests/joinlines/*.test tests/vimtests/jumplist/*.test tests/vimtests/macros/*.test tests/vimtests/marks/*.test tests/vimtests/movement/*.test tests/vimtests/numbers/*.test tests/vimtests/paste/*.test tests/vimtests/repeat/*.test tests/vimtests/replace/*.test tests/vimtests/search/*.test tests/vimtests/searchword/*.test tests/vimtests/sort/*.test tests/vimtests/switchcase/*.test tests/vimtests/undo/*.test tests/vimtests/unicode/*.test tests/vimtests/unsorted/*.test tests/vimtests/visual/*.test tests/vimtests/yank/*.test 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 , text , transformers-base , unordered-containers , yi-core >= 0.19 , yi-language >= 0.19 , yi-rope >= 0.10 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.Number Yi.Keymap.Vim.Ex.Commands.Paste Yi.Keymap.Vim.Ex.Commands.Quit Yi.Keymap.Vim.Ex.Commands.Read 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.Commands.Registers 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.BufferNew Yi.Keymap.Vim.Ex.Commands.Stack Yi.Keymap.Vim.Substitution 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 , text , transformers-base , unordered-containers , yi-core >= 0.19 , yi-language >= 0.19 , yi-rope >= 0.10 , tasty , tasty-hunit , QuickCheck , tasty-quickcheck , yi-keymap-vim other-modules: Generic.TestPureBufferManipulations Generic.TestUtils Vim.EditorManipulations.BufferExCommand Vim.TestExCommandParsers Vim.TestPureBufferManipulations Vim.TestPureEditorManipulations default-language: Haskell2010 yi-keymap-vim-0.19.0/src/0000755000000000000000000000000013755614221013262 5ustar0000000000000000yi-keymap-vim-0.19.0/src/Yi/0000755000000000000000000000000013755614221013643 5ustar0000000000000000yi-keymap-vim-0.19.0/src/Yi/Keymap/0000755000000000000000000000000013755614221015071 5ustar0000000000000000yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim.hs0000644000000000000000000001630113755614221016161 0ustar0000000000000000{-# 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 (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, DigraphTbl) 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 :: DigraphTbl , 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 yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/0000755000000000000000000000000013755614221015624 5ustar0000000000000000yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/Substitution.hs0000644000000000000000000000770413755614221020704 0ustar0000000000000000{-# language OverloadedStrings #-} module Yi.Keymap.Vim.Substitution ( substituteE , substituteConfirmE , repeatSubstitutionE , repeatSubstitutionFlaglessE ) where import Control.Monad (void) import Data.Monoid import Yi.MiniBuffer import Yi.Keymap (Keymap) import qualified Yi.Rope as R import Yi.Regex import Yi.Buffer import Yi.Editor import Yi.Search import Yi.Keymap.Keys (char, choice, (?>>!)) import Yi.Keymap.Vim.Common import Yi.Keymap.Vim.StateUtils substituteE :: Substitution -> BufferM Region -> EditorM () substituteE s@(Substitution from to global caseInsensitive confirm) regionB = do let opts = if caseInsensitive then [IgnoreCase] else [] lines' <- withCurrentBuffer $ regionB >>= linesOfRegionB 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' -> do saveSubstitutionE s if confirm then substituteConfirmE regex' to global lines' else do 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 substituteConfirmE :: SearchExp -> R.YiString -> Bool -> [Region] -> EditorM () substituteConfirmE 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' -- | 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 -- | 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 -- | 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 repeatSubstitutionFlaglessE :: Substitution -> EditorM () repeatSubstitutionFlaglessE (Substitution from to _ _ _) = substituteE (Substitution from to False False False) (regionOfB Line) repeatSubstitutionE :: Substitution -> EditorM () repeatSubstitutionE s = substituteE s (regionOfB Line) yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/ReplaceSingleCharMap.hs0000644000000000000000000000412713755614221022135 0ustar0000000000000000{-# 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 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 "" -> replaceCharB '<' "" -> replaceCharWithBelowB "" -> 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 yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/StyledRegion.hs0000644000000000000000000000535113755614221020574 0ustar0000000000000000{-# 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 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 yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/MatchResult.hs0000644000000000000000000000227613755614221020422 0ustar0000000000000000{-# 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 ayi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/Tag.hs0000644000000000000000000001646013755614221016702 0ustar0000000000000000{-# 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 yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/Digraph.hs0000644000000000000000000021426513755614221017550 0ustar0000000000000000{-# OPTIONS_GHC -O2 #-} {-# LANGUAGE BangPatterns #-} module Yi.Keymap.Vim.Digraph ( charFromDigraph , defDigraphs , DigraphTbl ) where import Control.Applicative (Alternative ((<|>))) newtype DigraphTbl = DigraphTbl (Char -> Char -> Maybe Char) charFromDigraph :: DigraphTbl -> Char -> Char -> Maybe Char charFromDigraph (DigraphTbl tbl) x y = tbl x y <|> tbl y x defDigraphs :: DigraphTbl defDigraphs = DigraphTbl lookupDigraph lookupDigraph :: Char -> Char -> Maybe Char lookupDigraph !x !y = case switch x y of '\xFFFF' -> Nothing c -> Just c switch :: Char -> Char -> Char switch 'N' 'U' = '\x0000' -- NULL (NUL) switch 'S' 'H' = '\x0001' -- START OF HEADING (SOH) switch 'S' 'X' = '\x0002' -- START OF TEXT (STX) switch 'E' 'X' = '\x0003' -- END OF TEXT (ETX) switch 'E' 'T' = '\x0004' -- END OF TRANSMISSION (EOT) switch 'E' 'Q' = '\x0005' -- ENQUIRY (ENQ) switch 'A' 'K' = '\x0006' -- ACKNOWLEDGE (ACK) switch 'B' 'L' = '\x0007' -- BELL (BEL) switch 'B' 'S' = '\x0008' -- BACKSPACE (BS) switch 'H' 'T' = '\x0009' -- CHARACTER TABULATION (HT) switch 'L' 'F' = '\x000A' -- LINE FEED (LF) switch 'V' 'T' = '\x000B' -- LINE TABULATION (VT) switch 'F' 'F' = '\x000C' -- FORM FEED (FF) switch 'C' 'R' = '\x000D' -- CARRIAGE RETURN (CR) switch 'S' 'O' = '\x000E' -- SHIFT OUT (SO) switch 'S' 'I' = '\x000F' -- SHIFT IN (SI) switch 'D' 'L' = '\x0010' -- DATALINK ESCAPE (DLE) switch 'D' '1' = '\x0011' -- DEVICE CONTROL ONE (DC1) switch 'D' '2' = '\x0012' -- DEVICE CONTROL TWO (DC2) switch 'D' '3' = '\x0013' -- DEVICE CONTROL THREE (DC3) switch 'D' '4' = '\x0014' -- DEVICE CONTROL FOUR (DC4) switch 'N' 'K' = '\x0015' -- NEGATIVE ACKNOWLEDGE (NAK) switch 'S' 'Y' = '\x0016' -- SYNCHRONOUS IDLE (SYN) switch 'E' 'B' = '\x0017' -- END OF TRANSMISSION BLOCK (ETB) switch 'C' 'N' = '\x0018' -- CANCEL (CAN) switch 'E' 'M' = '\x0019' -- END OF MEDIUM (EM) switch 'S' 'B' = '\x001A' -- SUBSTITUTE (SUB) switch 'E' 'C' = '\x001B' -- ESCAPE (ESC) switch 'F' 'S' = '\x001C' -- FILE SEPARATOR (IS4) switch 'G' 'S' = '\x001D' -- GROUP SEPARATOR (IS3) switch 'R' 'S' = '\x001E' -- RECORD SEPARATOR (IS2) switch 'U' 'S' = '\x001F' -- UNIT SEPARATOR (IS1) switch 'S' 'P' = '\x0020' -- SPACE switch 'N' 'b' = '\x0023' -- NUMBER SIGN switch 'D' 'O' = '\x0024' -- DOLLAR SIGN switch 'A' 't' = '\x0040' -- COMMERCIAL AT switch '<' '(' = '\x005B' -- LEFT SQUARE BRACKET switch '/' '/' = '\x005C' -- REVERSE SOLIDUS switch ')' '>' = '\x005D' -- RIGHT SQUARE BRACKET switch '\'' '>' = '\x005E' -- CIRCUMFLEX ACCENT switch '\'' '!' = '\x0060' -- GRAVE ACCENT switch '(' '!' = '\x007B' -- LEFT CURLY BRACKET switch '!' '!' = '\x007C' -- VERTICAL LINE switch '!' ')' = '\x007D' -- RIGHT CURLY BRACKET switch '\'' '?' = '\x007E' -- TILDE switch 'D' 'T' = '\x007F' -- DELETE (DEL) switch 'P' 'A' = '\x0080' -- PADDING CHARACTER (PAD) switch 'H' 'O' = '\x0081' -- HIGH OCTET PRESET (HOP) switch 'B' 'H' = '\x0082' -- BREAK PERMITTED HERE (BPH) switch 'N' 'H' = '\x0083' -- NO BREAK HERE (NBH) switch 'I' 'N' = '\x0084' -- INDEX (IND) switch 'N' 'L' = '\x0085' -- NEXT LINE (NEL) switch 'S' 'A' = '\x0086' -- START OF SELECTED AREA (SSA) switch 'E' 'S' = '\x0087' -- END OF SELECTED AREA (ESA) switch 'H' 'S' = '\x0088' -- CHARACTER TABULATION SET (HTS) switch 'H' 'J' = '\x0089' -- CHARACTER TABULATION WITH JUSTIFICATION (HTJ) switch 'V' 'S' = '\x008A' -- LINE TABULATION SET (VTS) switch 'P' 'D' = '\x008B' -- PARTIAL LINE FORWARD (PLD) switch 'P' 'U' = '\x008C' -- PARTIAL LINE BACKWARD (PLU) switch 'R' 'I' = '\x008D' -- REVERSE LINE FEED (RI) switch 'S' '2' = '\x008E' -- SINGLE-SHIFT TWO (SS2) switch 'S' '3' = '\x008F' -- SINGLE-SHIFT THREE (SS3) switch 'D' 'C' = '\x0090' -- DEVICE CONTROL STRING (DCS) switch 'P' '1' = '\x0091' -- PRIVATE USE ONE (PU1) switch 'P' '2' = '\x0092' -- PRIVATE USE TWO (PU2) switch 'T' 'S' = '\x0093' -- SET TRANSMIT STATE (STS) switch 'C' 'C' = '\x0094' -- CANCEL CHARACTER (CCH) switch 'M' 'W' = '\x0095' -- MESSAGE WAITING (MW) switch 'S' 'G' = '\x0096' -- START OF GUARDED AREA (SPA) switch 'E' 'G' = '\x0097' -- END OF GUARDED AREA (EPA) switch 'S' 'S' = '\x0098' -- START OF STRING (SOS) switch 'G' 'C' = '\x0099' -- SINGLE GRAPHIC CHARACTER INTRODUCER (SGCI) switch 'S' 'C' = '\x009A' -- SINGLE CHARACTER INTRODUCER (SCI) switch 'C' 'I' = '\x009B' -- CONTROL SEQUENCE INTRODUCER (CSI) switch 'S' 'T' = '\x009C' -- STRING TERMINATOR (ST) switch 'O' 'C' = '\x009D' -- OPERATING SYSTEM COMMAND (OSC) switch 'P' 'M' = '\x009E' -- PRIVACY MESSAGE (PM) switch 'A' 'C' = '\x009F' -- APPLICATION PROGRAM COMMAND (APC) switch 'N' 'S' = '\x00A0' -- NO-BREAK SPACE switch '!' 'I' = '\x00A1' -- INVERTED EXCLAMATION MARK switch 'C' 't' = '\x00A2' -- CENT SIGN switch 'P' 'd' = '\x00A3' -- POUND SIGN switch 'C' 'u' = '\x00A4' -- CURRENCY SIGN switch 'Y' 'e' = '\x00A5' -- YEN SIGN switch 'B' 'B' = '\x00A6' -- BROKEN BAR switch 'S' 'E' = '\x00A7' -- SECTION SIGN switch '\'' ':' = '\x00A8' -- DIAERESIS switch 'C' 'o' = '\x00A9' -- COPYRIGHT SIGN switch '-' 'a' = '\x00AA' -- FEMININE ORDINAL INDICATOR switch '<' '<' = '\x00AB' -- LEFT-POINTING DOUBLE ANGLE QUOTATION MARK switch 'N' 'O' = '\x00AC' -- NOT SIGN switch '-' '-' = '\x00AD' -- SOFT HYPHEN switch 'R' 'g' = '\x00AE' -- REGISTERED SIGN switch '\'' 'm' = '\x00AF' -- MACRON switch 'D' 'G' = '\x00B0' -- DEGREE SIGN switch '+' '-' = '\x00B1' -- PLUS-MINUS SIGN switch '2' 'S' = '\x00B2' -- SUPERSCRIPT TWO switch '3' 'S' = '\x00B3' -- SUPERSCRIPT THREE switch '\'' '\'' = '\x00B4' -- ACUTE ACCENT switch 'M' 'y' = '\x00B5' -- MICRO SIGN switch 'P' 'I' = '\x00B6' -- PILCROW SIGN switch '.' 'M' = '\x00B7' -- MIDDLE DOT switch '\'' ',' = '\x00B8' -- CEDILLA switch '1' 'S' = '\x00B9' -- SUPERSCRIPT ONE switch '-' 'o' = '\x00BA' -- MASCULINE ORDINAL INDICATOR switch '>' '>' = '\x00BB' -- RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK switch '1' '4' = '\x00BC' -- VULGAR FRACTION ONE QUARTER switch '1' '2' = '\x00BD' -- VULGAR FRACTION ONE HALF switch '3' '4' = '\x00BE' -- VULGAR FRACTION THREE QUARTERS switch '?' 'I' = '\x00BF' -- INVERTED QUESTION MARK switch 'A' '!' = '\x00C0' -- LATIN CAPITAL LETTER A WITH GRAVE switch 'A' '\'' = '\x00C1' -- LATIN CAPITAL LETTER A WITH ACUTE switch 'A' '>' = '\x00C2' -- LATIN CAPITAL LETTER A WITH CIRCUMFLEX switch 'A' '?' = '\x00C3' -- LATIN CAPITAL LETTER A WITH TILDE switch 'A' ':' = '\x00C4' -- LATIN CAPITAL LETTER A WITH DIAERESIS switch 'A' 'A' = '\x00C5' -- LATIN CAPITAL LETTER A WITH RING ABOVE switch 'A' 'E' = '\x00C6' -- LATIN CAPITAL LETTER AE switch 'C' ',' = '\x00C7' -- LATIN CAPITAL LETTER C WITH CEDILLA switch 'E' '!' = '\x00C8' -- LATIN CAPITAL LETTER E WITH GRAVE switch 'E' '\'' = '\x00C9' -- LATIN CAPITAL LETTER E WITH ACUTE switch 'E' '>' = '\x00CA' -- LATIN CAPITAL LETTER E WITH CIRCUMFLEX switch 'E' ':' = '\x00CB' -- LATIN CAPITAL LETTER E WITH DIAERESIS switch 'I' '!' = '\x00CC' -- LATIN CAPITAL LETTER I WITH GRAVE switch 'I' '\'' = '\x00CD' -- LATIN CAPITAL LETTER I WITH ACUTE switch 'I' '>' = '\x00CE' -- LATIN CAPITAL LETTER I WITH CIRCUMFLEX switch 'I' ':' = '\x00CF' -- LATIN CAPITAL LETTER I WITH DIAERESIS switch 'D' '-' = '\x00D0' -- LATIN CAPITAL LETTER ETH (Icelandic) switch 'N' '?' = '\x00D1' -- LATIN CAPITAL LETTER N WITH TILDE switch 'O' '!' = '\x00D2' -- LATIN CAPITAL LETTER O WITH GRAVE switch 'O' '\'' = '\x00D3' -- LATIN CAPITAL LETTER O WITH ACUTE switch 'O' '>' = '\x00D4' -- LATIN CAPITAL LETTER O WITH CIRCUMFLEX switch 'O' '?' = '\x00D5' -- LATIN CAPITAL LETTER O WITH TILDE switch 'O' ':' = '\x00D6' -- LATIN CAPITAL LETTER O WITH DIAERESIS switch '*' 'X' = '\x00D7' -- MULTIPLICATION SIGN switch 'O' '/' = '\x00D8' -- LATIN CAPITAL LETTER O WITH STROKE switch 'U' '!' = '\x00D9' -- LATIN CAPITAL LETTER U WITH GRAVE switch 'U' '\'' = '\x00DA' -- LATIN CAPITAL LETTER U WITH ACUTE switch 'U' '>' = '\x00DB' -- LATIN CAPITAL LETTER U WITH CIRCUMFLEX switch 'U' ':' = '\x00DC' -- LATIN CAPITAL LETTER U WITH DIAERESIS switch 'Y' '\'' = '\x00DD' -- LATIN CAPITAL LETTER Y WITH ACUTE switch 'T' 'H' = '\x00DE' -- LATIN CAPITAL LETTER THORN (Icelandic) switch 's' 's' = '\x00DF' -- LATIN SMALL LETTER SHARP S (German) switch 'a' '!' = '\x00E0' -- LATIN SMALL LETTER A WITH GRAVE switch 'a' '\'' = '\x00E1' -- LATIN SMALL LETTER A WITH ACUTE switch 'a' '>' = '\x00E2' -- LATIN SMALL LETTER A WITH CIRCUMFLEX switch 'a' '?' = '\x00E3' -- LATIN SMALL LETTER A WITH TILDE switch 'a' ':' = '\x00E4' -- LATIN SMALL LETTER A WITH DIAERESIS switch 'a' 'a' = '\x00E5' -- LATIN SMALL LETTER A WITH RING ABOVE switch 'a' 'e' = '\x00E6' -- LATIN SMALL LETTER AE switch 'c' ',' = '\x00E7' -- LATIN SMALL LETTER C WITH CEDILLA switch 'e' '!' = '\x00E8' -- LATIN SMALL LETTER E WITH GRAVE switch 'e' '\'' = '\x00E9' -- LATIN SMALL LETTER E WITH ACUTE switch 'e' '>' = '\x00EA' -- LATIN SMALL LETTER E WITH CIRCUMFLEX switch 'e' ':' = '\x00EB' -- LATIN SMALL LETTER E WITH DIAERESIS switch 'i' '!' = '\x00EC' -- LATIN SMALL LETTER I WITH GRAVE switch 'i' '\'' = '\x00ED' -- LATIN SMALL LETTER I WITH ACUTE switch 'i' '>' = '\x00EE' -- LATIN SMALL LETTER I WITH CIRCUMFLEX switch 'i' ':' = '\x00EF' -- LATIN SMALL LETTER I WITH DIAERESIS switch 'd' '-' = '\x00F0' -- LATIN SMALL LETTER ETH (Icelandic) switch 'n' '?' = '\x00F1' -- LATIN SMALL LETTER N WITH TILDE switch 'o' '!' = '\x00F2' -- LATIN SMALL LETTER O WITH GRAVE switch 'o' '\'' = '\x00F3' -- LATIN SMALL LETTER O WITH ACUTE switch 'o' '>' = '\x00F4' -- LATIN SMALL LETTER O WITH CIRCUMFLEX switch 'o' '?' = '\x00F5' -- LATIN SMALL LETTER O WITH TILDE switch 'o' ':' = '\x00F6' -- LATIN SMALL LETTER O WITH DIAERESIS switch '-' ':' = '\x00F7' -- DIVISION SIGN switch 'o' '/' = '\x00F8' -- LATIN SMALL LETTER O WITH STROKE switch 'u' '!' = '\x00F9' -- LATIN SMALL LETTER U WITH GRAVE switch 'u' '\'' = '\x00FA' -- LATIN SMALL LETTER U WITH ACUTE switch 'u' '>' = '\x00FB' -- LATIN SMALL LETTER U WITH CIRCUMFLEX switch 'u' ':' = '\x00FC' -- LATIN SMALL LETTER U WITH DIAERESIS switch 'y' '\'' = '\x00FD' -- LATIN SMALL LETTER Y WITH ACUTE switch 't' 'h' = '\x00FE' -- LATIN SMALL LETTER THORN (Icelandic) switch 'y' ':' = '\x00FF' -- LATIN SMALL LETTER Y WITH DIAERESIS switch 'A' '-' = '\x0100' -- LATIN CAPITAL LETTER A WITH MACRON switch 'a' '-' = '\x0101' -- LATIN SMALL LETTER A WITH MACRON switch 'A' '(' = '\x0102' -- LATIN CAPITAL LETTER A WITH BREVE switch 'a' '(' = '\x0103' -- LATIN SMALL LETTER A WITH BREVE switch 'A' ';' = '\x0104' -- LATIN CAPITAL LETTER A WITH OGONEK switch 'a' ';' = '\x0105' -- LATIN SMALL LETTER A WITH OGONEK switch 'C' '\'' = '\x0106' -- LATIN CAPITAL LETTER C WITH ACUTE switch 'c' '\'' = '\x0107' -- LATIN SMALL LETTER C WITH ACUTE switch 'C' '>' = '\x0108' -- LATIN CAPITAL LETTER C WITH CIRCUMFLEX switch 'c' '>' = '\x0109' -- LATIN SMALL LETTER C WITH CIRCUMFLEX switch 'C' '.' = '\x010A' -- LATIN CAPITAL LETTER C WITH DOT ABOVE switch 'c' '.' = '\x010B' -- LATIN SMALL LETTER C WITH DOT ABOVE switch 'C' '<' = '\x010C' -- LATIN CAPITAL LETTER C WITH CARON switch 'c' '<' = '\x010D' -- LATIN SMALL LETTER C WITH CARON switch 'D' '<' = '\x010E' -- LATIN CAPITAL LETTER D WITH CARON switch 'd' '<' = '\x010F' -- LATIN SMALL LETTER D WITH CARON switch 'D' '/' = '\x0110' -- LATIN CAPITAL LETTER D WITH STROKE switch 'd' '/' = '\x0111' -- LATIN SMALL LETTER D WITH STROKE switch 'E' '-' = '\x0112' -- LATIN CAPITAL LETTER E WITH MACRON switch 'e' '-' = '\x0113' -- LATIN SMALL LETTER E WITH MACRON switch 'E' '(' = '\x0114' -- LATIN CAPITAL LETTER E WITH BREVE switch 'e' '(' = '\x0115' -- LATIN SMALL LETTER E WITH BREVE switch 'E' '.' = '\x0116' -- LATIN CAPITAL LETTER E WITH DOT ABOVE switch 'e' '.' = '\x0117' -- LATIN SMALL LETTER E WITH DOT ABOVE switch 'E' ';' = '\x0118' -- LATIN CAPITAL LETTER E WITH OGONEK switch 'e' ';' = '\x0119' -- LATIN SMALL LETTER E WITH OGONEK switch 'E' '<' = '\x011A' -- LATIN CAPITAL LETTER E WITH CARON switch 'e' '<' = '\x011B' -- LATIN SMALL LETTER E WITH CARON switch 'G' '>' = '\x011C' -- LATIN CAPITAL LETTER G WITH CIRCUMFLEX switch 'g' '>' = '\x011D' -- LATIN SMALL LETTER G WITH CIRCUMFLEX switch 'G' '(' = '\x011E' -- LATIN CAPITAL LETTER G WITH BREVE switch 'g' '(' = '\x011F' -- LATIN SMALL LETTER G WITH BREVE switch 'G' '.' = '\x0120' -- LATIN CAPITAL LETTER G WITH DOT ABOVE switch 'g' '.' = '\x0121' -- LATIN SMALL LETTER G WITH DOT ABOVE switch 'G' ',' = '\x0122' -- LATIN CAPITAL LETTER G WITH CEDILLA switch 'g' ',' = '\x0123' -- LATIN SMALL LETTER G WITH CEDILLA switch 'H' '>' = '\x0124' -- LATIN CAPITAL LETTER H WITH CIRCUMFLEX switch 'h' '>' = '\x0125' -- LATIN SMALL LETTER H WITH CIRCUMFLEX switch 'H' '/' = '\x0126' -- LATIN CAPITAL LETTER H WITH STROKE switch 'h' '/' = '\x0127' -- LATIN SMALL LETTER H WITH STROKE switch 'I' '?' = '\x0128' -- LATIN CAPITAL LETTER I WITH TILDE switch 'i' '?' = '\x0129' -- LATIN SMALL LETTER I WITH TILDE switch 'I' '-' = '\x012A' -- LATIN CAPITAL LETTER I WITH MACRON switch 'i' '-' = '\x012B' -- LATIN SMALL LETTER I WITH MACRON switch 'I' '(' = '\x012C' -- LATIN CAPITAL LETTER I WITH BREVE switch 'i' '(' = '\x012D' -- LATIN SMALL LETTER I WITH BREVE switch 'I' ';' = '\x012E' -- LATIN CAPITAL LETTER I WITH OGONEK switch 'i' ';' = '\x012F' -- LATIN SMALL LETTER I WITH OGONEK switch 'I' '.' = '\x0130' -- LATIN CAPITAL LETTER I WITH DOT ABOVE switch 'i' '.' = '\x0131' -- LATIN SMALL LETTER DOTLESS I switch 'I' 'J' = '\x0132' -- LATIN CAPITAL LIGATURE IJ switch 'i' 'j' = '\x0133' -- LATIN SMALL LIGATURE IJ switch 'J' '>' = '\x0134' -- LATIN CAPITAL LETTER J WITH CIRCUMFLEX switch 'j' '>' = '\x0135' -- LATIN SMALL LETTER J WITH CIRCUMFLEX switch 'K' ',' = '\x0136' -- LATIN CAPITAL LETTER K WITH CEDILLA switch 'k' ',' = '\x0137' -- LATIN SMALL LETTER K WITH CEDILLA switch 'k' 'k' = '\x0138' -- LATIN SMALL LETTER KRA switch 'L' '\'' = '\x0139' -- LATIN CAPITAL LETTER L WITH ACUTE switch 'l' '\'' = '\x013A' -- LATIN SMALL LETTER L WITH ACUTE switch 'L' ',' = '\x013B' -- LATIN CAPITAL LETTER L WITH CEDILLA switch 'l' ',' = '\x013C' -- LATIN SMALL LETTER L WITH CEDILLA switch 'L' '<' = '\x013D' -- LATIN CAPITAL LETTER L WITH CARON switch 'l' '<' = '\x013E' -- LATIN SMALL LETTER L WITH CARON switch 'L' '.' = '\x013F' -- LATIN CAPITAL LETTER L WITH MIDDLE DOT switch 'l' '.' = '\x0140' -- LATIN SMALL LETTER L WITH MIDDLE DOT switch 'L' '/' = '\x0141' -- LATIN CAPITAL LETTER L WITH STROKE switch 'l' '/' = '\x0142' -- LATIN SMALL LETTER L WITH STROKE switch 'N' '\'' = '\x0143' -- LATIN CAPITAL LETTER N WITH ACUTE ` switch 'n' '\'' = '\x0144' -- LATIN SMALL LETTER N WITH ACUTE ` switch 'N' ',' = '\x0145' -- LATIN CAPITAL LETTER N WITH CEDILLA ` switch 'n' ',' = '\x0146' -- LATIN SMALL LETTER N WITH CEDILLA ` switch 'N' '<' = '\x0147' -- LATIN CAPITAL LETTER N WITH CARON ` switch 'n' '<' = '\x0148' -- LATIN SMALL LETTER N WITH CARON ` switch '\'' 'n' = '\x0149' -- LATIN SMALL LETTER N PRECEDED BY APOSTROPHE ` switch 'N' 'G' = '\x014A' -- LATIN CAPITAL LETTER ENG switch 'n' 'g' = '\x014B' -- LATIN SMALL LETTER ENG switch 'O' '-' = '\x014C' -- LATIN CAPITAL LETTER O WITH MACRON switch 'o' '-' = '\x014D' -- LATIN SMALL LETTER O WITH MACRON switch 'O' '(' = '\x014E' -- LATIN CAPITAL LETTER O WITH BREVE switch 'o' '(' = '\x014F' -- LATIN SMALL LETTER O WITH BREVE switch 'O' '"' = '\x0150' -- LATIN CAPITAL LETTER O WITH DOUBLE ACUTE switch 'o' '"' = '\x0151' -- LATIN SMALL LETTER O WITH DOUBLE ACUTE switch 'O' 'E' = '\x0152' -- LATIN CAPITAL LIGATURE OE switch 'o' 'e' = '\x0153' -- LATIN SMALL LIGATURE OE switch 'R' '\'' = '\x0154' -- LATIN CAPITAL LETTER R WITH ACUTE switch 'r' '\'' = '\x0155' -- LATIN SMALL LETTER R WITH ACUTE switch 'R' ',' = '\x0156' -- LATIN CAPITAL LETTER R WITH CEDILLA switch 'r' ',' = '\x0157' -- LATIN SMALL LETTER R WITH CEDILLA switch 'R' '<' = '\x0158' -- LATIN CAPITAL LETTER R WITH CARON switch 'r' '<' = '\x0159' -- LATIN SMALL LETTER R WITH CARON switch 'S' '\'' = '\x015A' -- LATIN CAPITAL LETTER S WITH ACUTE switch 's' '\'' = '\x015B' -- LATIN SMALL LETTER S WITH ACUTE switch 'S' '>' = '\x015C' -- LATIN CAPITAL LETTER S WITH CIRCUMFLEX switch 's' '>' = '\x015D' -- LATIN SMALL LETTER S WITH CIRCUMFLEX switch 'S' ',' = '\x015E' -- LATIN CAPITAL LETTER S WITH CEDILLA switch 's' ',' = '\x015F' -- LATIN SMALL LETTER S WITH CEDILLA switch 'S' '<' = '\x0160' -- LATIN CAPITAL LETTER S WITH CARON switch 's' '<' = '\x0161' -- LATIN SMALL LETTER S WITH CARON switch 'T' ',' = '\x0162' -- LATIN CAPITAL LETTER T WITH CEDILLA switch 't' ',' = '\x0163' -- LATIN SMALL LETTER T WITH CEDILLA switch 'T' '<' = '\x0164' -- LATIN CAPITAL LETTER T WITH CARON switch 't' '<' = '\x0165' -- LATIN SMALL LETTER T WITH CARON switch 'T' '/' = '\x0166' -- LATIN CAPITAL LETTER T WITH STROKE switch 't' '/' = '\x0167' -- LATIN SMALL LETTER T WITH STROKE switch 'U' '?' = '\x0168' -- LATIN CAPITAL LETTER U WITH TILDE switch 'u' '?' = '\x0169' -- LATIN SMALL LETTER U WITH TILDE switch 'U' '-' = '\x016A' -- LATIN CAPITAL LETTER U WITH MACRON switch 'u' '-' = '\x016B' -- LATIN SMALL LETTER U WITH MACRON switch 'U' '(' = '\x016C' -- LATIN CAPITAL LETTER U WITH BREVE switch 'u' '(' = '\x016D' -- LATIN SMALL LETTER U WITH BREVE switch 'U' '0' = '\x016E' -- LATIN CAPITAL LETTER U WITH RING ABOVE switch 'u' '0' = '\x016F' -- LATIN SMALL LETTER U WITH RING ABOVE switch 'U' '"' = '\x0170' -- LATIN CAPITAL LETTER U WITH DOUBLE ACUTE switch 'u' '"' = '\x0171' -- LATIN SMALL LETTER U WITH DOUBLE ACUTE switch 'U' ';' = '\x0172' -- LATIN CAPITAL LETTER U WITH OGONEK switch 'u' ';' = '\x0173' -- LATIN SMALL LETTER U WITH OGONEK switch 'W' '>' = '\x0174' -- LATIN CAPITAL LETTER W WITH CIRCUMFLEX switch 'w' '>' = '\x0175' -- LATIN SMALL LETTER W WITH CIRCUMFLEX switch 'Y' '>' = '\x0176' -- LATIN CAPITAL LETTER Y WITH CIRCUMFLEX switch 'y' '>' = '\x0177' -- LATIN SMALL LETTER Y WITH CIRCUMFLEX switch 'Y' ':' = '\x0178' -- LATIN CAPITAL LETTER Y WITH DIAERESIS switch 'Z' '\'' = '\x0179' -- LATIN CAPITAL LETTER Z WITH ACUTE switch 'z' '\'' = '\x017A' -- LATIN SMALL LETTER Z WITH ACUTE switch 'Z' '.' = '\x017B' -- LATIN CAPITAL LETTER Z WITH DOT ABOVE switch 'z' '.' = '\x017C' -- LATIN SMALL LETTER Z WITH DOT ABOVE switch 'Z' '<' = '\x017D' -- LATIN CAPITAL LETTER Z WITH CARON switch 'z' '<' = '\x017E' -- LATIN SMALL LETTER Z WITH CARON switch 'O' '9' = '\x01A0' -- LATIN CAPITAL LETTER O WITH HORN switch 'o' '9' = '\x01A1' -- LATIN SMALL LETTER O WITH HORN switch 'O' 'I' = '\x01A2' -- LATIN CAPITAL LETTER OI switch 'o' 'i' = '\x01A3' -- LATIN SMALL LETTER OI switch 'y' 'r' = '\x01A6' -- LATIN LETTER YR switch 'U' '9' = '\x01AF' -- LATIN CAPITAL LETTER U WITH HORN switch 'u' '9' = '\x01B0' -- LATIN SMALL LETTER U WITH HORN switch 'Z' '/' = '\x01B5' -- LATIN CAPITAL LETTER Z WITH STROKE switch 'z' '/' = '\x01B6' -- LATIN SMALL LETTER Z WITH STROKE switch 'E' 'D' = '\x01B7' -- LATIN CAPITAL LETTER EZH switch 'A' '<' = '\x01CD' -- LATIN CAPITAL LETTER A WITH CARON switch 'a' '<' = '\x01CE' -- LATIN SMALL LETTER A WITH CARON switch 'I' '<' = '\x01CF' -- LATIN CAPITAL LETTER I WITH CARON switch 'i' '<' = '\x01D0' -- LATIN SMALL LETTER I WITH CARON switch 'O' '<' = '\x01D1' -- LATIN CAPITAL LETTER O WITH CARON switch 'o' '<' = '\x01D2' -- LATIN SMALL LETTER O WITH CARON switch 'U' '<' = '\x01D3' -- LATIN CAPITAL LETTER U WITH CARON switch 'u' '<' = '\x01D4' -- LATIN SMALL LETTER U WITH CARON switch 'A' '1' = '\x01DE' -- LATIN CAPITAL LETTER A WITH DIAERESIS AND MACRON switch 'a' '1' = '\x01DF' -- LATIN SMALL LETTER A WITH DIAERESIS AND MACRON switch 'A' '7' = '\x01E0' -- LATIN CAPITAL LETTER A WITH DOT ABOVE AND MACRON switch 'a' '7' = '\x01E1' -- LATIN SMALL LETTER A WITH DOT ABOVE AND MACRON switch 'A' '3' = '\x01E2' -- LATIN CAPITAL LETTER AE WITH MACRON switch 'a' '3' = '\x01E3' -- LATIN SMALL LETTER AE WITH MACRON switch 'G' '/' = '\x01E4' -- LATIN CAPITAL LETTER G WITH STROKE switch 'g' '/' = '\x01E5' -- LATIN SMALL LETTER G WITH STROKE switch 'G' '<' = '\x01E6' -- LATIN CAPITAL LETTER G WITH CARON switch 'g' '<' = '\x01E7' -- LATIN SMALL LETTER G WITH CARON switch 'K' '<' = '\x01E8' -- LATIN CAPITAL LETTER K WITH CARON switch 'k' '<' = '\x01E9' -- LATIN SMALL LETTER K WITH CARON switch 'O' ';' = '\x01EA' -- LATIN CAPITAL LETTER O WITH OGONEK switch 'o' ';' = '\x01EB' -- LATIN SMALL LETTER O WITH OGONEK switch 'O' '1' = '\x01EC' -- LATIN CAPITAL LETTER O WITH OGONEK AND MACRON switch 'o' '1' = '\x01ED' -- LATIN SMALL LETTER O WITH OGONEK AND MACRON switch 'E' 'Z' = '\x01EE' -- LATIN CAPITAL LETTER EZH WITH CARON switch 'e' 'z' = '\x01EF' -- LATIN SMALL LETTER EZH WITH CARON switch 'j' '<' = '\x01F0' -- LATIN SMALL LETTER J WITH CARON switch 'G' '\'' = '\x01F4' -- LATIN CAPITAL LETTER G WITH ACUTE switch 'g' '\'' = '\x01F5' -- LATIN SMALL LETTER G WITH ACUTE switch ';' 'S' = '\x02BF' -- MODIFIER LETTER LEFT HALF RING switch '\'' '<' = '\x02C7' -- CARON switch '\'' '(' = '\x02D8' -- BREVE switch '\'' '.' = '\x02D9' -- DOT ABOVE switch '\'' '0' = '\x02DA' -- RING ABOVE switch '\'' ';' = '\x02DB' -- OGONEK switch '\'' '"' = '\x02DD' -- DOUBLE ACUTE ACCENT switch 'A' '%' = '\x0386' -- GREEK CAPITAL LETTER ALPHA WITH TONOS switch 'E' '%' = '\x0388' -- GREEK CAPITAL LETTER EPSILON WITH TONOS switch 'Y' '%' = '\x0389' -- GREEK CAPITAL LETTER ETA WITH TONOS switch 'I' '%' = '\x038A' -- GREEK CAPITAL LETTER IOTA WITH TONOS switch 'O' '%' = '\x038C' -- GREEK CAPITAL LETTER OMICRON WITH TONOS switch 'U' '%' = '\x038E' -- GREEK CAPITAL LETTER UPSILON WITH TONOS switch 'W' '%' = '\x038F' -- GREEK CAPITAL LETTER OMEGA WITH TONOS switch 'i' '3' = '\x0390' -- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS switch 'A' '*' = '\x0391' -- GREEK CAPITAL LETTER ALPHA switch 'B' '*' = '\x0392' -- GREEK CAPITAL LETTER BETA switch 'G' '*' = '\x0393' -- GREEK CAPITAL LETTER GAMMA switch 'D' '*' = '\x0394' -- GREEK CAPITAL LETTER DELTA switch 'E' '*' = '\x0395' -- GREEK CAPITAL LETTER EPSILON switch 'Z' '*' = '\x0396' -- GREEK CAPITAL LETTER ZETA switch 'Y' '*' = '\x0397' -- GREEK CAPITAL LETTER ETA switch 'H' '*' = '\x0398' -- GREEK CAPITAL LETTER THETA switch 'I' '*' = '\x0399' -- GREEK CAPITAL LETTER IOTA switch 'K' '*' = '\x039A' -- GREEK CAPITAL LETTER KAPPA switch 'L' '*' = '\x039B' -- GREEK CAPITAL LETTER LAMDA switch 'M' '*' = '\x039C' -- GREEK CAPITAL LETTER MU switch 'N' '*' = '\x039D' -- GREEK CAPITAL LETTER NU switch 'C' '*' = '\x039E' -- GREEK CAPITAL LETTER XI switch 'O' '*' = '\x039F' -- GREEK CAPITAL LETTER OMICRON switch 'P' '*' = '\x03A0' -- GREEK CAPITAL LETTER PI switch 'R' '*' = '\x03A1' -- GREEK CAPITAL LETTER RHO switch 'S' '*' = '\x03A3' -- GREEK CAPITAL LETTER SIGMA switch 'T' '*' = '\x03A4' -- GREEK CAPITAL LETTER TAU switch 'U' '*' = '\x03A5' -- GREEK CAPITAL LETTER UPSILON switch 'F' '*' = '\x03A6' -- GREEK CAPITAL LETTER PHI switch 'X' '*' = '\x03A7' -- GREEK CAPITAL LETTER CHI switch 'Q' '*' = '\x03A8' -- GREEK CAPITAL LETTER PSI switch 'W' '*' = '\x03A9' -- GREEK CAPITAL LETTER OMEGA switch 'J' '*' = '\x03AA' -- GREEK CAPITAL LETTER IOTA WITH DIALYTIKA switch 'V' '*' = '\x03AB' -- GREEK CAPITAL LETTER UPSILON WITH DIALYTIKA switch 'a' '%' = '\x03AC' -- GREEK SMALL LETTER ALPHA WITH TONOS switch 'e' '%' = '\x03AD' -- GREEK SMALL LETTER EPSILON WITH TONOS switch 'y' '%' = '\x03AE' -- GREEK SMALL LETTER ETA WITH TONOS switch 'i' '%' = '\x03AF' -- GREEK SMALL LETTER IOTA WITH TONOS switch 'u' '3' = '\x03B0' -- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS switch 'a' '*' = '\x03B1' -- GREEK SMALL LETTER ALPHA switch 'b' '*' = '\x03B2' -- GREEK SMALL LETTER BETA switch 'g' '*' = '\x03B3' -- GREEK SMALL LETTER GAMMA switch 'd' '*' = '\x03B4' -- GREEK SMALL LETTER DELTA switch 'e' '*' = '\x03B5' -- GREEK SMALL LETTER EPSILON switch 'z' '*' = '\x03B6' -- GREEK SMALL LETTER ZETA switch 'y' '*' = '\x03B7' -- GREEK SMALL LETTER ETA switch 'h' '*' = '\x03B8' -- GREEK SMALL LETTER THETA switch 'i' '*' = '\x03B9' -- GREEK SMALL LETTER IOTA switch 'k' '*' = '\x03BA' -- GREEK SMALL LETTER KAPPA switch 'l' '*' = '\x03BB' -- GREEK SMALL LETTER LAMDA switch 'm' '*' = '\x03BC' -- GREEK SMALL LETTER MU switch 'n' '*' = '\x03BD' -- GREEK SMALL LETTER NU switch 'c' '*' = '\x03BE' -- GREEK SMALL LETTER XI switch 'o' '*' = '\x03BF' -- GREEK SMALL LETTER OMICRON switch 'p' '*' = '\x03C0' -- GREEK SMALL LETTER PI switch 'r' '*' = '\x03C1' -- GREEK SMALL LETTER RHO switch '*' 's' = '\x03C2' -- GREEK SMALL LETTER FINAL SIGMA switch 's' '*' = '\x03C3' -- GREEK SMALL LETTER SIGMA switch 't' '*' = '\x03C4' -- GREEK SMALL LETTER TAU switch 'u' '*' = '\x03C5' -- GREEK SMALL LETTER UPSILON switch 'f' '*' = '\x03C6' -- GREEK SMALL LETTER PHI switch 'x' '*' = '\x03C7' -- GREEK SMALL LETTER CHI switch 'q' '*' = '\x03C8' -- GREEK SMALL LETTER PSI switch 'w' '*' = '\x03C9' -- GREEK SMALL LETTER OMEGA switch 'j' '*' = '\x03CA' -- GREEK SMALL LETTER IOTA WITH DIALYTIKA switch 'v' '*' = '\x03CB' -- GREEK SMALL LETTER UPSILON WITH DIALYTIKA switch 'o' '%' = '\x03CC' -- GREEK SMALL LETTER OMICRON WITH TONOS switch 'u' '%' = '\x03CD' -- GREEK SMALL LETTER UPSILON WITH TONOS switch 'w' '%' = '\x03CE' -- GREEK SMALL LETTER OMEGA WITH TONOS switch '\'' 'G' = '\x03D8' -- GREEK LETTER ARCHAIC KOPPA switch ',' 'G' = '\x03D9' -- GREEK SMALL LETTER ARCHAIC KOPPA switch 'T' '3' = '\x03DA' -- GREEK LETTER STIGMA switch 't' '3' = '\x03DB' -- GREEK SMALL LETTER STIGMA switch 'M' '3' = '\x03DC' -- GREEK LETTER DIGAMMA switch 'm' '3' = '\x03DD' -- GREEK SMALL LETTER DIGAMMA switch 'K' '3' = '\x03DE' -- GREEK LETTER KOPPA switch 'k' '3' = '\x03DF' -- GREEK SMALL LETTER KOPPA switch 'P' '3' = '\x03E0' -- GREEK LETTER SAMPI switch 'p' '3' = '\x03E1' -- GREEK SMALL LETTER SAMPI switch '\'' '%' = '\x03F4' -- GREEK CAPITAL THETA SYMBOL switch 'j' '3' = '\x03F5' -- GREEK LUNATE EPSILON SYMBOL switch 'I' 'O' = '\x0401' -- CYRILLIC CAPITAL LETTER IO switch 'D' '%' = '\x0402' -- CYRILLIC CAPITAL LETTER DJE switch 'G' '%' = '\x0403' -- CYRILLIC CAPITAL LETTER GJE switch 'I' 'E' = '\x0404' -- CYRILLIC CAPITAL LETTER UKRAINIAN IE switch 'D' 'S' = '\x0405' -- CYRILLIC CAPITAL LETTER DZE switch 'I' 'I' = '\x0406' -- CYRILLIC CAPITAL LETTER BYELORUSSIAN-UKRAINIAN I switch 'Y' 'I' = '\x0407' -- CYRILLIC CAPITAL LETTER YI switch 'J' '%' = '\x0408' -- CYRILLIC CAPITAL LETTER JE switch 'L' 'J' = '\x0409' -- CYRILLIC CAPITAL LETTER LJE switch 'N' 'J' = '\x040A' -- CYRILLIC CAPITAL LETTER NJE switch 'T' 's' = '\x040B' -- CYRILLIC CAPITAL LETTER TSHE switch 'K' 'J' = '\x040C' -- CYRILLIC CAPITAL LETTER KJE switch 'V' '%' = '\x040E' -- CYRILLIC CAPITAL LETTER SHORT U switch 'D' 'Z' = '\x040F' -- CYRILLIC CAPITAL LETTER DZHE switch 'A' '=' = '\x0410' -- CYRILLIC CAPITAL LETTER A switch 'B' '=' = '\x0411' -- CYRILLIC CAPITAL LETTER BE switch 'V' '=' = '\x0412' -- CYRILLIC CAPITAL LETTER VE switch 'G' '=' = '\x0413' -- CYRILLIC CAPITAL LETTER GHE switch 'D' '=' = '\x0414' -- CYRILLIC CAPITAL LETTER DE switch 'E' '=' = '\x0415' -- CYRILLIC CAPITAL LETTER IE switch 'Z' '%' = '\x0416' -- CYRILLIC CAPITAL LETTER ZHE switch 'Z' '=' = '\x0417' -- CYRILLIC CAPITAL LETTER ZE switch 'I' '=' = '\x0418' -- CYRILLIC CAPITAL LETTER I switch 'J' '=' = '\x0419' -- CYRILLIC CAPITAL LETTER SHORT I switch 'K' '=' = '\x041A' -- CYRILLIC CAPITAL LETTER KA switch 'L' '=' = '\x041B' -- CYRILLIC CAPITAL LETTER EL switch 'M' '=' = '\x041C' -- CYRILLIC CAPITAL LETTER EM switch 'N' '=' = '\x041D' -- CYRILLIC CAPITAL LETTER EN switch 'O' '=' = '\x041E' -- CYRILLIC CAPITAL LETTER O switch 'P' '=' = '\x041F' -- CYRILLIC CAPITAL LETTER PE switch 'R' '=' = '\x0420' -- CYRILLIC CAPITAL LETTER ER switch 'S' '=' = '\x0421' -- CYRILLIC CAPITAL LETTER ES switch 'T' '=' = '\x0422' -- CYRILLIC CAPITAL LETTER TE switch 'U' '=' = '\x0423' -- CYRILLIC CAPITAL LETTER U switch 'F' '=' = '\x0424' -- CYRILLIC CAPITAL LETTER EF switch 'H' '=' = '\x0425' -- CYRILLIC CAPITAL LETTER HA switch 'C' '=' = '\x0426' -- CYRILLIC CAPITAL LETTER TSE switch 'C' '%' = '\x0427' -- CYRILLIC CAPITAL LETTER CHE switch 'S' '%' = '\x0428' -- CYRILLIC CAPITAL LETTER SHA switch 'S' 'c' = '\x0429' -- CYRILLIC CAPITAL LETTER SHCHA switch '=' '"' = '\x042A' -- CYRILLIC CAPITAL LETTER HARD SIGN switch 'Y' '=' = '\x042B' -- CYRILLIC CAPITAL LETTER YERU switch '%' '"' = '\x042C' -- CYRILLIC CAPITAL LETTER SOFT SIGN switch 'J' 'E' = '\x042D' -- CYRILLIC CAPITAL LETTER E switch 'J' 'U' = '\x042E' -- CYRILLIC CAPITAL LETTER YU switch 'J' 'A' = '\x042F' -- CYRILLIC CAPITAL LETTER YA switch 'a' '=' = '\x0430' -- CYRILLIC SMALL LETTER A switch 'b' '=' = '\x0431' -- CYRILLIC SMALL LETTER BE switch 'v' '=' = '\x0432' -- CYRILLIC SMALL LETTER VE switch 'g' '=' = '\x0433' -- CYRILLIC SMALL LETTER GHE switch 'd' '=' = '\x0434' -- CYRILLIC SMALL LETTER DE switch 'e' '=' = '\x0435' -- CYRILLIC SMALL LETTER IE switch 'z' '%' = '\x0436' -- CYRILLIC SMALL LETTER ZHE switch 'z' '=' = '\x0437' -- CYRILLIC SMALL LETTER ZE switch 'i' '=' = '\x0438' -- CYRILLIC SMALL LETTER I switch 'j' '=' = '\x0439' -- CYRILLIC SMALL LETTER SHORT I switch 'k' '=' = '\x043A' -- CYRILLIC SMALL LETTER KA switch 'l' '=' = '\x043B' -- CYRILLIC SMALL LETTER EL switch 'm' '=' = '\x043C' -- CYRILLIC SMALL LETTER EM switch 'n' '=' = '\x043D' -- CYRILLIC SMALL LETTER EN switch 'o' '=' = '\x043E' -- CYRILLIC SMALL LETTER O switch 'p' '=' = '\x043F' -- CYRILLIC SMALL LETTER PE switch 'r' '=' = '\x0440' -- CYRILLIC SMALL LETTER ER switch 's' '=' = '\x0441' -- CYRILLIC SMALL LETTER ES switch 't' '=' = '\x0442' -- CYRILLIC SMALL LETTER TE switch 'u' '=' = '\x0443' -- CYRILLIC SMALL LETTER U switch 'f' '=' = '\x0444' -- CYRILLIC SMALL LETTER EF switch 'h' '=' = '\x0445' -- CYRILLIC SMALL LETTER HA switch 'c' '=' = '\x0446' -- CYRILLIC SMALL LETTER TSE switch 'c' '%' = '\x0447' -- CYRILLIC SMALL LETTER CHE switch 's' '%' = '\x0448' -- CYRILLIC SMALL LETTER SHA switch 's' 'c' = '\x0449' -- CYRILLIC SMALL LETTER SHCHA switch '=' '\'' = '\x044A' -- CYRILLIC SMALL LETTER HARD SIGN switch 'y' '=' = '\x044B' -- CYRILLIC SMALL LETTER YERU switch '%' '\'' = '\x044C' -- CYRILLIC SMALL LETTER SOFT SIGN switch 'j' 'e' = '\x044D' -- CYRILLIC SMALL LETTER E switch 'j' 'u' = '\x044E' -- CYRILLIC SMALL LETTER YU switch 'j' 'a' = '\x044F' -- CYRILLIC SMALL LETTER YA switch 'i' 'o' = '\x0451' -- CYRILLIC SMALL LETTER IO switch 'd' '%' = '\x0452' -- CYRILLIC SMALL LETTER DJE switch 'g' '%' = '\x0453' -- CYRILLIC SMALL LETTER GJE switch 'i' 'e' = '\x0454' -- CYRILLIC SMALL LETTER UKRAINIAN IE switch 'd' 's' = '\x0455' -- CYRILLIC SMALL LETTER DZE switch 'i' 'i' = '\x0456' -- CYRILLIC SMALL LETTER BYELORUSSIAN-UKRAINIAN I switch 'y' 'i' = '\x0457' -- CYRILLIC SMALL LETTER YI switch 'j' '%' = '\x0458' -- CYRILLIC SMALL LETTER JE switch 'l' 'j' = '\x0459' -- CYRILLIC SMALL LETTER LJE switch 'n' 'j' = '\x045A' -- CYRILLIC SMALL LETTER NJE switch 't' 's' = '\x045B' -- CYRILLIC SMALL LETTER TSHE switch 'k' 'j' = '\x045C' -- CYRILLIC SMALL LETTER KJE switch 'v' '%' = '\x045E' -- CYRILLIC SMALL LETTER SHORT U switch 'd' 'z' = '\x045F' -- CYRILLIC SMALL LETTER DZHE switch 'Y' '3' = '\x0462' -- CYRILLIC CAPITAL LETTER YAT switch 'y' '3' = '\x0463' -- CYRILLIC SMALL LETTER YAT switch 'O' '3' = '\x046A' -- CYRILLIC CAPITAL LETTER BIG YUS switch 'o' '3' = '\x046B' -- CYRILLIC SMALL LETTER BIG YUS switch 'F' '3' = '\x0472' -- CYRILLIC CAPITAL LETTER FITA switch 'f' '3' = '\x0473' -- CYRILLIC SMALL LETTER FITA switch 'V' '3' = '\x0474' -- CYRILLIC CAPITAL LETTER IZHITSA switch 'v' '3' = '\x0475' -- CYRILLIC SMALL LETTER IZHITSA switch 'C' '3' = '\x0480' -- CYRILLIC CAPITAL LETTER KOPPA switch 'c' '3' = '\x0481' -- CYRILLIC SMALL LETTER KOPPA switch 'G' '3' = '\x0490' -- CYRILLIC CAPITAL LETTER GHE WITH UPTURN switch 'g' '3' = '\x0491' -- CYRILLIC SMALL LETTER GHE WITH UPTURN switch 'A' '+' = '\x05D0' -- HEBREW LETTER ALEF switch 'B' '+' = '\x05D1' -- HEBREW LETTER BET switch 'G' '+' = '\x05D2' -- HEBREW LETTER GIMEL switch 'D' '+' = '\x05D3' -- HEBREW LETTER DALET switch 'H' '+' = '\x05D4' -- HEBREW LETTER HE switch 'W' '+' = '\x05D5' -- HEBREW LETTER VAV switch 'Z' '+' = '\x05D6' -- HEBREW LETTER ZAYIN switch 'X' '+' = '\x05D7' -- HEBREW LETTER HET switch 'T' 'j' = '\x05D8' -- HEBREW LETTER TET switch 'J' '+' = '\x05D9' -- HEBREW LETTER YOD switch 'K' '%' = '\x05DA' -- HEBREW LETTER FINAL KAF switch 'K' '+' = '\x05DB' -- HEBREW LETTER KAF switch 'L' '+' = '\x05DC' -- HEBREW LETTER LAMED switch 'M' '%' = '\x05DD' -- HEBREW LETTER FINAL MEM switch 'M' '+' = '\x05DE' -- HEBREW LETTER MEM switch 'N' '%' = '\x05DF' -- HEBREW LETTER FINAL NUN ` switch 'N' '+' = '\x05E0' -- HEBREW LETTER NUN ` switch 'S' '+' = '\x05E1' -- HEBREW LETTER SAMEKH switch 'E' '+' = '\x05E2' -- HEBREW LETTER AYIN switch 'P' '%' = '\x05E3' -- HEBREW LETTER FINAL PE switch 'P' '+' = '\x05E4' -- HEBREW LETTER PE switch 'Z' 'j' = '\x05E5' -- HEBREW LETTER FINAL TSADI switch 'Z' 'J' = '\x05E6' -- HEBREW LETTER TSADI switch 'Q' '+' = '\x05E7' -- HEBREW LETTER QOF switch 'R' '+' = '\x05E8' -- HEBREW LETTER RESH switch 'S' 'h' = '\x05E9' -- HEBREW LETTER SHIN switch 'T' '+' = '\x05EA' -- HEBREW LETTER TAV switch ',' '+' = '\x060C' -- ARABIC COMMA switch ';' '+' = '\x061B' -- ARABIC SEMICOLON switch '?' '+' = '\x061F' -- ARABIC QUESTION MARK switch 'H' '\'' = '\x0621' -- ARABIC LETTER HAMZA switch 'a' 'M' = '\x0622' -- ARABIC LETTER ALEF WITH MADDA ABOVE switch 'a' 'H' = '\x0623' -- ARABIC LETTER ALEF WITH HAMZA ABOVE switch 'w' 'H' = '\x0624' -- ARABIC LETTER WAW WITH HAMZA ABOVE switch 'a' 'h' = '\x0625' -- ARABIC LETTER ALEF WITH HAMZA BELOW switch 'y' 'H' = '\x0626' -- ARABIC LETTER YEH WITH HAMZA ABOVE switch 'a' '+' = '\x0627' -- ARABIC LETTER ALEF switch 'b' '+' = '\x0628' -- ARABIC LETTER BEH switch 't' 'm' = '\x0629' -- ARABIC LETTER TEH MARBUTA switch 't' '+' = '\x062A' -- ARABIC LETTER TEH switch 't' 'k' = '\x062B' -- ARABIC LETTER THEH switch 'g' '+' = '\x062C' -- ARABIC LETTER JEEM switch 'h' 'k' = '\x062D' -- ARABIC LETTER HAH switch 'x' '+' = '\x062E' -- ARABIC LETTER KHAH switch 'd' '+' = '\x062F' -- ARABIC LETTER DAL switch 'd' 'k' = '\x0630' -- ARABIC LETTER THAL switch 'r' '+' = '\x0631' -- ARABIC LETTER REH switch 'z' '+' = '\x0632' -- ARABIC LETTER ZAIN switch 's' '+' = '\x0633' -- ARABIC LETTER SEEN switch 's' 'n' = '\x0634' -- ARABIC LETTER SHEEN switch 'c' '+' = '\x0635' -- ARABIC LETTER SAD switch 'd' 'd' = '\x0636' -- ARABIC LETTER DAD switch 't' 'j' = '\x0637' -- ARABIC LETTER TAH switch 'z' 'H' = '\x0638' -- ARABIC LETTER ZAH switch 'e' '+' = '\x0639' -- ARABIC LETTER AIN switch 'i' '+' = '\x063A' -- ARABIC LETTER GHAIN switch '+' '+' = '\x0640' -- ARABIC TATWEEL switch 'f' '+' = '\x0641' -- ARABIC LETTER FEH switch 'q' '+' = '\x0642' -- ARABIC LETTER QAF switch 'k' '+' = '\x0643' -- ARABIC LETTER KAF switch 'l' '+' = '\x0644' -- ARABIC LETTER LAM switch 'm' '+' = '\x0645' -- ARABIC LETTER MEEM switch 'n' '+' = '\x0646' -- ARABIC LETTER NOON switch 'h' '+' = '\x0647' -- ARABIC LETTER HEH switch 'w' '+' = '\x0648' -- ARABIC LETTER WAW switch 'j' '+' = '\x0649' -- ARABIC LETTER ALEF MAKSURA switch 'y' '+' = '\x064A' -- ARABIC LETTER YEH switch ':' '+' = '\x064B' -- ARABIC FATHATAN switch '"' '+' = '\x064C' -- ARABIC DAMMATAN switch '=' '+' = '\x064D' -- ARABIC KASRATAN switch '/' '+' = '\x064E' -- ARABIC FATHA switch '\'' '+' = '\x064F' -- ARABIC DAMMA switch '1' '+' = '\x0650' -- ARABIC KASRA switch '3' '+' = '\x0651' -- ARABIC SHADDA switch '0' '+' = '\x0652' -- ARABIC SUKUN switch 'a' 'S' = '\x0670' -- ARABIC LETTER SUPERSCRIPT ALEF switch 'p' '+' = '\x067E' -- ARABIC LETTER PEH switch 'v' '+' = '\x06A4' -- ARABIC LETTER VEH switch 'g' 'f' = '\x06AF' -- ARABIC LETTER GAF switch '0' 'a' = '\x06F0' -- EXTENDED ARABIC-INDIC DIGIT ZERO switch '1' 'a' = '\x06F1' -- EXTENDED ARABIC-INDIC DIGIT ONE switch '2' 'a' = '\x06F2' -- EXTENDED ARABIC-INDIC DIGIT TWO switch '3' 'a' = '\x06F3' -- EXTENDED ARABIC-INDIC DIGIT THREE switch '4' 'a' = '\x06F4' -- EXTENDED ARABIC-INDIC DIGIT FOUR switch '5' 'a' = '\x06F5' -- EXTENDED ARABIC-INDIC DIGIT FIVE switch '6' 'a' = '\x06F6' -- EXTENDED ARABIC-INDIC DIGIT SIX switch '7' 'a' = '\x06F7' -- EXTENDED ARABIC-INDIC DIGIT SEVEN switch '8' 'a' = '\x06F8' -- EXTENDED ARABIC-INDIC DIGIT EIGHT switch '9' 'a' = '\x06F9' -- EXTENDED ARABIC-INDIC DIGIT NINE switch 'B' '.' = '\x1E02' -- LATIN CAPITAL LETTER B WITH DOT ABOVE switch 'b' '.' = '\x1E03' -- LATIN SMALL LETTER B WITH DOT ABOVE switch 'B' '_' = '\x1E06' -- LATIN CAPITAL LETTER B WITH LINE BELOW switch 'b' '_' = '\x1E07' -- LATIN SMALL LETTER B WITH LINE BELOW switch 'D' '.' = '\x1E0A' -- LATIN CAPITAL LETTER D WITH DOT ABOVE switch 'd' '.' = '\x1E0B' -- LATIN SMALL LETTER D WITH DOT ABOVE switch 'D' '_' = '\x1E0E' -- LATIN CAPITAL LETTER D WITH LINE BELOW switch 'd' '_' = '\x1E0F' -- LATIN SMALL LETTER D WITH LINE BELOW switch 'D' ',' = '\x1E10' -- LATIN CAPITAL LETTER D WITH CEDILLA switch 'd' ',' = '\x1E11' -- LATIN SMALL LETTER D WITH CEDILLA switch 'F' '.' = '\x1E1E' -- LATIN CAPITAL LETTER F WITH DOT ABOVE switch 'f' '.' = '\x1E1F' -- LATIN SMALL LETTER F WITH DOT ABOVE switch 'G' '-' = '\x1E20' -- LATIN CAPITAL LETTER G WITH MACRON switch 'g' '-' = '\x1E21' -- LATIN SMALL LETTER G WITH MACRON switch 'H' '.' = '\x1E22' -- LATIN CAPITAL LETTER H WITH DOT ABOVE switch 'h' '.' = '\x1E23' -- LATIN SMALL LETTER H WITH DOT ABOVE switch 'H' ':' = '\x1E26' -- LATIN CAPITAL LETTER H WITH DIAERESIS switch 'h' ':' = '\x1E27' -- LATIN SMALL LETTER H WITH DIAERESIS switch 'H' ',' = '\x1E28' -- LATIN CAPITAL LETTER H WITH CEDILLA switch 'h' ',' = '\x1E29' -- LATIN SMALL LETTER H WITH CEDILLA switch 'K' '\'' = '\x1E30' -- LATIN CAPITAL LETTER K WITH ACUTE switch 'k' '\'' = '\x1E31' -- LATIN SMALL LETTER K WITH ACUTE switch 'K' '_' = '\x1E34' -- LATIN CAPITAL LETTER K WITH LINE BELOW switch 'k' '_' = '\x1E35' -- LATIN SMALL LETTER K WITH LINE BELOW switch 'L' '_' = '\x1E3A' -- LATIN CAPITAL LETTER L WITH LINE BELOW switch 'l' '_' = '\x1E3B' -- LATIN SMALL LETTER L WITH LINE BELOW switch 'M' '\'' = '\x1E3E' -- LATIN CAPITAL LETTER M WITH ACUTE switch 'm' '\'' = '\x1E3F' -- LATIN SMALL LETTER M WITH ACUTE switch 'M' '.' = '\x1E40' -- LATIN CAPITAL LETTER M WITH DOT ABOVE switch 'm' '.' = '\x1E41' -- LATIN SMALL LETTER M WITH DOT ABOVE switch 'N' '.' = '\x1E44' -- LATIN CAPITAL LETTER N WITH DOT ABOVE ` switch 'n' '.' = '\x1E45' -- LATIN SMALL LETTER N WITH DOT ABOVE ` switch 'N' '_' = '\x1E48' -- LATIN CAPITAL LETTER N WITH LINE BELOW ` switch 'n' '_' = '\x1E49' -- LATIN SMALL LETTER N WITH LINE BELOW ` switch 'P' '\'' = '\x1E54' -- LATIN CAPITAL LETTER P WITH ACUTE switch 'p' '\'' = '\x1E55' -- LATIN SMALL LETTER P WITH ACUTE switch 'P' '.' = '\x1E56' -- LATIN CAPITAL LETTER P WITH DOT ABOVE switch 'p' '.' = '\x1E57' -- LATIN SMALL LETTER P WITH DOT ABOVE switch 'R' '.' = '\x1E58' -- LATIN CAPITAL LETTER R WITH DOT ABOVE switch 'r' '.' = '\x1E59' -- LATIN SMALL LETTER R WITH DOT ABOVE switch 'R' '_' = '\x1E5E' -- LATIN CAPITAL LETTER R WITH LINE BELOW switch 'r' '_' = '\x1E5F' -- LATIN SMALL LETTER R WITH LINE BELOW switch 'S' '.' = '\x1E60' -- LATIN CAPITAL LETTER S WITH DOT ABOVE switch 's' '.' = '\x1E61' -- LATIN SMALL LETTER S WITH DOT ABOVE switch 'T' '.' = '\x1E6A' -- LATIN CAPITAL LETTER T WITH DOT ABOVE switch 't' '.' = '\x1E6B' -- LATIN SMALL LETTER T WITH DOT ABOVE switch 'T' '_' = '\x1E6E' -- LATIN CAPITAL LETTER T WITH LINE BELOW switch 't' '_' = '\x1E6F' -- LATIN SMALL LETTER T WITH LINE BELOW switch 'V' '?' = '\x1E7C' -- LATIN CAPITAL LETTER V WITH TILDE switch 'v' '?' = '\x1E7D' -- LATIN SMALL LETTER V WITH TILDE switch 'W' '!' = '\x1E80' -- LATIN CAPITAL LETTER W WITH GRAVE switch 'w' '!' = '\x1E81' -- LATIN SMALL LETTER W WITH GRAVE switch 'W' '\'' = '\x1E82' -- LATIN CAPITAL LETTER W WITH ACUTE switch 'w' '\'' = '\x1E83' -- LATIN SMALL LETTER W WITH ACUTE switch 'W' ':' = '\x1E84' -- LATIN CAPITAL LETTER W WITH DIAERESIS switch 'w' ':' = '\x1E85' -- LATIN SMALL LETTER W WITH DIAERESIS switch 'W' '.' = '\x1E86' -- LATIN CAPITAL LETTER W WITH DOT ABOVE switch 'w' '.' = '\x1E87' -- LATIN SMALL LETTER W WITH DOT ABOVE switch 'X' '.' = '\x1E8A' -- LATIN CAPITAL LETTER X WITH DOT ABOVE switch 'x' '.' = '\x1E8B' -- LATIN SMALL LETTER X WITH DOT ABOVE switch 'X' ':' = '\x1E8C' -- LATIN CAPITAL LETTER X WITH DIAERESIS switch 'x' ':' = '\x1E8D' -- LATIN SMALL LETTER X WITH DIAERESIS switch 'Y' '.' = '\x1E8E' -- LATIN CAPITAL LETTER Y WITH DOT ABOVE switch 'y' '.' = '\x1E8F' -- LATIN SMALL LETTER Y WITH DOT ABOVE switch 'Z' '>' = '\x1E90' -- LATIN CAPITAL LETTER Z WITH CIRCUMFLEX switch 'z' '>' = '\x1E91' -- LATIN SMALL LETTER Z WITH CIRCUMFLEX switch 'Z' '_' = '\x1E94' -- LATIN CAPITAL LETTER Z WITH LINE BELOW switch 'z' '_' = '\x1E95' -- LATIN SMALL LETTER Z WITH LINE BELOW switch 'h' '_' = '\x1E96' -- LATIN SMALL LETTER H WITH LINE BELOW switch 't' ':' = '\x1E97' -- LATIN SMALL LETTER T WITH DIAERESIS switch 'w' '0' = '\x1E98' -- LATIN SMALL LETTER W WITH RING ABOVE switch 'y' '0' = '\x1E99' -- LATIN SMALL LETTER Y WITH RING ABOVE switch 'A' '2' = '\x1EA2' -- LATIN CAPITAL LETTER A WITH HOOK ABOVE switch 'a' '2' = '\x1EA3' -- LATIN SMALL LETTER A WITH HOOK ABOVE switch 'E' '2' = '\x1EBA' -- LATIN CAPITAL LETTER E WITH HOOK ABOVE switch 'e' '2' = '\x1EBB' -- LATIN SMALL LETTER E WITH HOOK ABOVE switch 'E' '?' = '\x1EBC' -- LATIN CAPITAL LETTER E WITH TILDE switch 'e' '?' = '\x1EBD' -- LATIN SMALL LETTER E WITH TILDE switch 'I' '2' = '\x1EC8' -- LATIN CAPITAL LETTER I WITH HOOK ABOVE switch 'i' '2' = '\x1EC9' -- LATIN SMALL LETTER I WITH HOOK ABOVE switch 'O' '2' = '\x1ECE' -- LATIN CAPITAL LETTER O WITH HOOK ABOVE switch 'o' '2' = '\x1ECF' -- LATIN SMALL LETTER O WITH HOOK ABOVE switch 'U' '2' = '\x1EE6' -- LATIN CAPITAL LETTER U WITH HOOK ABOVE switch 'u' '2' = '\x1EE7' -- LATIN SMALL LETTER U WITH HOOK ABOVE switch 'Y' '!' = '\x1EF2' -- LATIN CAPITAL LETTER Y WITH GRAVE switch 'y' '!' = '\x1EF3' -- LATIN SMALL LETTER Y WITH GRAVE switch 'Y' '2' = '\x1EF6' -- LATIN CAPITAL LETTER Y WITH HOOK ABOVE switch 'y' '2' = '\x1EF7' -- LATIN SMALL LETTER Y WITH HOOK ABOVE switch 'Y' '?' = '\x1EF8' -- LATIN CAPITAL LETTER Y WITH TILDE switch 'y' '?' = '\x1EF9' -- LATIN SMALL LETTER Y WITH TILDE switch ';' '\'' = '\x1F00' -- GREEK SMALL LETTER ALPHA WITH PSILI switch ',' '\'' = '\x1F01' -- GREEK SMALL LETTER ALPHA WITH DASIA switch ';' '!' = '\x1F02' -- GREEK SMALL LETTER ALPHA WITH PSILI AND VARIA switch ',' '!' = '\x1F03' -- GREEK SMALL LETTER ALPHA WITH DASIA AND VARIA switch '?' ';' = '\x1F04' -- GREEK SMALL LETTER ALPHA WITH PSILI AND OXIA switch '?' ',' = '\x1F05' -- GREEK SMALL LETTER ALPHA WITH DASIA AND OXIA switch '!' ':' = '\x1F06' -- GREEK SMALL LETTER ALPHA WITH PSILI AND PERISPOMENI switch '?' ':' = '\x1F07' -- GREEK SMALL LETTER ALPHA WITH DASIA AND PERISPOMENI switch '1' 'N' = '\x2002' -- EN SPACE switch '1' 'M' = '\x2003' -- EM SPACE switch '3' 'M' = '\x2004' -- THREE-PER-EM SPACE switch '4' 'M' = '\x2005' -- FOUR-PER-EM SPACE switch '6' 'M' = '\x2006' -- SIX-PER-EM SPACE switch '1' 'T' = '\x2009' -- THIN SPACE switch '1' 'H' = '\x200A' -- HAIR SPACE switch '-' '1' = '\x2010' -- HYPHEN switch '-' 'N' = '\x2013' -- EN DASH ` switch '-' 'M' = '\x2014' -- EM DASH switch '-' '3' = '\x2015' -- HORIZONTAL BAR switch '!' '2' = '\x2016' -- DOUBLE VERTICAL LINE switch '=' '2' = '\x2017' -- DOUBLE LOW LINE switch '\'' '6' = '\x2018' -- LEFT SINGLE QUOTATION MARK switch '\'' '9' = '\x2019' -- RIGHT SINGLE QUOTATION MARK switch '.' '9' = '\x201A' -- SINGLE LOW-9 QUOTATION MARK switch '9' '\'' = '\x201B' -- SINGLE HIGH-REVERSED-9 QUOTATION MARK switch '"' '6' = '\x201C' -- LEFT DOUBLE QUOTATION MARK switch '"' '9' = '\x201D' -- RIGHT DOUBLE QUOTATION MARK switch ':' '9' = '\x201E' -- DOUBLE LOW-9 QUOTATION MARK switch '9' '"' = '\x201F' -- DOUBLE HIGH-REVERSED-9 QUOTATION MARK switch '/' '-' = '\x2020' -- DAGGER switch '/' '=' = '\x2021' -- DOUBLE DAGGER switch '.' '.' = '\x2025' -- TWO DOT LEADER switch '%' '0' = '\x2030' -- PER MILLE SIGN switch '1' '\'' = '\x2032' -- PRIME switch '2' '\'' = '\x2033' -- DOUBLE PRIME switch '3' '\'' = '\x2034' -- TRIPLE PRIME switch '1' '"' = '\x2035' -- REVERSED PRIME switch '2' '"' = '\x2036' -- REVERSED DOUBLE PRIME switch '3' '"' = '\x2037' -- REVERSED TRIPLE PRIME switch 'C' 'a' = '\x2038' -- CARET switch '<' '1' = '\x2039' -- SINGLE LEFT-POINTING ANGLE QUOTATION MARK switch '>' '1' = '\x203A' -- SINGLE RIGHT-POINTING ANGLE QUOTATION MARK switch ':' 'X' = '\x203B' -- REFERENCE MARK switch '\'' '-' = '\x203E' -- OVERLINE switch '/' 'f' = '\x2044' -- FRACTION SLASH switch '0' 'S' = '\x2070' -- SUPERSCRIPT ZERO switch '4' 'S' = '\x2074' -- SUPERSCRIPT FOUR switch '5' 'S' = '\x2075' -- SUPERSCRIPT FIVE switch '6' 'S' = '\x2076' -- SUPERSCRIPT SIX switch '7' 'S' = '\x2077' -- SUPERSCRIPT SEVEN switch '8' 'S' = '\x2078' -- SUPERSCRIPT EIGHT switch '9' 'S' = '\x2079' -- SUPERSCRIPT NINE switch '+' 'S' = '\x207A' -- SUPERSCRIPT PLUS SIGN switch '-' 'S' = '\x207B' -- SUPERSCRIPT MINUS switch '=' 'S' = '\x207C' -- SUPERSCRIPT EQUALS SIGN switch '(' 'S' = '\x207D' -- SUPERSCRIPT LEFT PARENTHESIS switch ')' 'S' = '\x207E' -- SUPERSCRIPT RIGHT PARENTHESIS switch 'n' 'S' = '\x207F' -- SUPERSCRIPT LATIN SMALL LETTER N ` switch '0' 's' = '\x2080' -- SUBSCRIPT ZERO switch '1' 's' = '\x2081' -- SUBSCRIPT ONE switch '2' 's' = '\x2082' -- SUBSCRIPT TWO switch '3' 's' = '\x2083' -- SUBSCRIPT THREE switch '4' 's' = '\x2084' -- SUBSCRIPT FOUR switch '5' 's' = '\x2085' -- SUBSCRIPT FIVE switch '6' 's' = '\x2086' -- SUBSCRIPT SIX switch '7' 's' = '\x2087' -- SUBSCRIPT SEVEN switch '8' 's' = '\x2088' -- SUBSCRIPT EIGHT switch '9' 's' = '\x2089' -- SUBSCRIPT NINE switch '+' 's' = '\x208A' -- SUBSCRIPT PLUS SIGN switch '-' 's' = '\x208B' -- SUBSCRIPT MINUS switch '=' 's' = '\x208C' -- SUBSCRIPT EQUALS SIGN switch '(' 's' = '\x208D' -- SUBSCRIPT LEFT PARENTHESIS switch ')' 's' = '\x208E' -- SUBSCRIPT RIGHT PARENTHESIS switch 'L' 'i' = '\x20A4' -- LIRA SIGN switch 'P' 't' = '\x20A7' -- PESETA SIGN switch 'W' '=' = '\x20A9' -- WON SIGN switch 'E' 'u' = '\x20AC' -- EURO SIGN switch 'o' 'C' = '\x2103' -- DEGREE CELSIUS switch 'c' 'o' = '\x2105' -- CARE OF switch 'o' 'F' = '\x2109' -- DEGREE FAHRENHEIT switch 'N' '0' = '\x2116' -- NUMERO SIGN switch 'P' 'O' = '\x2117' -- SOUND RECORDING COPYRIGHT switch 'R' 'x' = '\x211E' -- PRESCRIPTION TAKE switch 'S' 'M' = '\x2120' -- SERVICE MARK switch 'T' 'M' = '\x2122' -- TRADE MARK SIGN switch 'O' 'm' = '\x2126' -- OHM SIGN switch 'A' 'O' = '\x212B' -- ANGSTROM SIGN switch '1' '3' = '\x2153' -- VULGAR FRACTION ONE THIRD switch '2' '3' = '\x2154' -- VULGAR FRACTION TWO THIRDS switch '1' '5' = '\x2155' -- VULGAR FRACTION ONE FIFTH switch '2' '5' = '\x2156' -- VULGAR FRACTION TWO FIFTHS switch '3' '5' = '\x2157' -- VULGAR FRACTION THREE FIFTHS switch '4' '5' = '\x2158' -- VULGAR FRACTION FOUR FIFTHS switch '1' '6' = '\x2159' -- VULGAR FRACTION ONE SIXTH switch '5' '6' = '\x215A' -- VULGAR FRACTION FIVE SIXTHS switch '1' '8' = '\x215B' -- VULGAR FRACTION ONE EIGHTH switch '3' '8' = '\x215C' -- VULGAR FRACTION THREE EIGHTHS switch '5' '8' = '\x215D' -- VULGAR FRACTION FIVE EIGHTHS switch '7' '8' = '\x215E' -- VULGAR FRACTION SEVEN EIGHTHS switch '1' 'R' = '\x2160' -- ROMAN NUMERAL ONE switch '2' 'R' = '\x2161' -- ROMAN NUMERAL TWO switch '3' 'R' = '\x2162' -- ROMAN NUMERAL THREE switch '4' 'R' = '\x2163' -- ROMAN NUMERAL FOUR switch '5' 'R' = '\x2164' -- ROMAN NUMERAL FIVE switch '6' 'R' = '\x2165' -- ROMAN NUMERAL SIX switch '7' 'R' = '\x2166' -- ROMAN NUMERAL SEVEN switch '8' 'R' = '\x2167' -- ROMAN NUMERAL EIGHT switch '9' 'R' = '\x2168' -- ROMAN NUMERAL NINE switch 'a' 'R' = '\x2169' -- ROMAN NUMERAL TEN switch 'b' 'R' = '\x216A' -- ROMAN NUMERAL ELEVEN switch 'c' 'R' = '\x216B' -- ROMAN NUMERAL TWELVE switch '1' 'r' = '\x2170' -- SMALL ROMAN NUMERAL ONE switch '2' 'r' = '\x2171' -- SMALL ROMAN NUMERAL TWO switch '3' 'r' = '\x2172' -- SMALL ROMAN NUMERAL THREE switch '4' 'r' = '\x2173' -- SMALL ROMAN NUMERAL FOUR switch '5' 'r' = '\x2174' -- SMALL ROMAN NUMERAL FIVE switch '6' 'r' = '\x2175' -- SMALL ROMAN NUMERAL SIX switch '7' 'r' = '\x2176' -- SMALL ROMAN NUMERAL SEVEN switch '8' 'r' = '\x2177' -- SMALL ROMAN NUMERAL EIGHT switch '9' 'r' = '\x2178' -- SMALL ROMAN NUMERAL NINE switch 'a' 'r' = '\x2179' -- SMALL ROMAN NUMERAL TEN switch 'b' 'r' = '\x217A' -- SMALL ROMAN NUMERAL ELEVEN switch 'c' 'r' = '\x217B' -- SMALL ROMAN NUMERAL TWELVE switch '<' '-' = '\x2190' -- LEFTWARDS ARROW switch '-' '!' = '\x2191' -- UPWARDS ARROW switch '-' '>' = '\x2192' -- RIGHTWARDS ARROW switch '-' 'v' = '\x2193' -- DOWNWARDS ARROW switch '<' '>' = '\x2194' -- LEFT RIGHT ARROW switch 'U' 'D' = '\x2195' -- UP DOWN ARROW switch '<' '=' = '\x21D0' -- LEFTWARDS DOUBLE ARROW switch '=' '>' = '\x21D2' -- RIGHTWARDS DOUBLE ARROW switch '=' '=' = '\x21D4' -- LEFT RIGHT DOUBLE ARROW switch 'F' 'A' = '\x2200' -- FOR ALL switch 'd' 'P' = '\x2202' -- PARTIAL DIFFERENTIAL switch 'T' 'E' = '\x2203' -- THERE EXISTS switch '/' '0' = '\x2205' -- EMPTY SET switch 'D' 'E' = '\x2206' -- INCREMENT switch 'N' 'B' = '\x2207' -- NABLA switch '(' '-' = '\x2208' -- ELEMENT OF switch '-' ')' = '\x220B' -- CONTAINS AS MEMBER switch '*' 'P' = '\x220F' -- N-ARY PRODUCT ` switch '+' 'Z' = '\x2211' -- N-ARY SUMMATION ` switch '-' '2' = '\x2212' -- MINUS SIGN switch '-' '+' = '\x2213' -- MINUS-OR-PLUS SIGN switch '*' '-' = '\x2217' -- ASTERISK OPERATOR switch 'O' 'b' = '\x2218' -- RING OPERATOR switch 'S' 'b' = '\x2219' -- BULLET OPERATOR switch 'R' 'T' = '\x221A' -- SQUARE ROOT switch '0' '(' = '\x221D' -- PROPORTIONAL TO switch '0' '0' = '\x221E' -- INFINITY switch '-' 'L' = '\x221F' -- RIGHT ANGLE switch '-' 'V' = '\x2220' -- ANGLE switch 'P' 'P' = '\x2225' -- PARALLEL TO switch 'A' 'N' = '\x2227' -- LOGICAL AND switch 'O' 'R' = '\x2228' -- LOGICAL OR switch '(' 'U' = '\x2229' -- INTERSECTION switch ')' 'U' = '\x222A' -- UNION switch 'I' 'n' = '\x222B' -- INTEGRAL switch 'D' 'I' = '\x222C' -- DOUBLE INTEGRAL switch 'I' 'o' = '\x222E' -- CONTOUR INTEGRAL switch '.' ':' = '\x2234' -- THEREFORE switch ':' '.' = '\x2235' -- BECAUSE switch ':' 'R' = '\x2236' -- RATIO switch ':' ':' = '\x2237' -- PROPORTION switch '?' '1' = '\x223C' -- TILDE OPERATOR switch 'C' 'G' = '\x223E' -- INVERTED LAZY S switch '?' '-' = '\x2243' -- ASYMPTOTICALLY EQUAL TO switch '?' '=' = '\x2245' -- APPROXIMATELY EQUAL TO switch '?' '2' = '\x2248' -- ALMOST EQUAL TO switch '=' '?' = '\x224C' -- ALL EQUAL TO switch 'H' 'I' = '\x2253' -- IMAGE OF OR APPROXIMATELY EQUAL TO switch '!' '=' = '\x2260' -- NOT EQUAL TO switch '=' '3' = '\x2261' -- IDENTICAL TO switch '=' '<' = '\x2264' -- LESS-THAN OR EQUAL TO switch '>' '=' = '\x2265' -- GREATER-THAN OR EQUAL TO switch '<' '*' = '\x226A' -- MUCH LESS-THAN switch '*' '>' = '\x226B' -- MUCH GREATER-THAN switch '!' '<' = '\x226E' -- NOT LESS-THAN switch '!' '>' = '\x226F' -- NOT GREATER-THAN switch '(' 'C' = '\x2282' -- SUBSET OF switch ')' 'C' = '\x2283' -- SUPERSET OF switch '(' '_' = '\x2286' -- SUBSET OF OR EQUAL TO switch ')' '_' = '\x2287' -- SUPERSET OF OR EQUAL TO switch '0' '.' = '\x2299' -- CIRCLED DOT OPERATOR switch '0' '2' = '\x229A' -- CIRCLED RING OPERATOR switch '-' 'T' = '\x22A5' -- UP TACK switch '.' 'P' = '\x22C5' -- DOT OPERATOR switch ':' '3' = '\x22EE' -- VERTICAL ELLIPSIS switch '.' '3' = '\x22EF' -- MIDLINE HORIZONTAL ELLIPSIS switch 'E' 'h' = '\x2302' -- HOUSE switch '<' '7' = '\x2308' -- LEFT CEILING switch '>' '7' = '\x2309' -- RIGHT CEILING switch '7' '<' = '\x230A' -- LEFT FLOOR switch '7' '>' = '\x230B' -- RIGHT FLOOR switch 'N' 'I' = '\x2310' -- REVERSED NOT SIGN switch '(' 'A' = '\x2312' -- ARC switch 'T' 'R' = '\x2315' -- TELEPHONE RECORDER switch 'I' 'u' = '\x2320' -- TOP HALF INTEGRAL switch 'I' 'l' = '\x2321' -- BOTTOM HALF INTEGRAL switch '<' '/' = '\x2329' -- LEFT-POINTING ANGLE BRACKET switch '/' '>' = '\x232A' -- RIGHT-POINTING ANGLE BRACKET switch 'V' 's' = '\x2423' -- OPEN BOX switch '1' 'h' = '\x2440' -- OCR HOOK switch '3' 'h' = '\x2441' -- OCR CHAIR switch '2' 'h' = '\x2442' -- OCR FORK switch '4' 'h' = '\x2443' -- OCR INVERTED FORK switch '1' 'j' = '\x2446' -- OCR BRANCH BANK IDENTIFICATION switch '2' 'j' = '\x2447' -- OCR AMOUNT OF CHECK switch '3' 'j' = '\x2448' -- OCR DASH switch '4' 'j' = '\x2449' -- OCR CUSTOMER ACCOUNT NUMBER switch '1' '.' = '\x2488' -- DIGIT ONE FULL STOP switch '2' '.' = '\x2489' -- DIGIT TWO FULL STOP switch '3' '.' = '\x248A' -- DIGIT THREE FULL STOP switch '4' '.' = '\x248B' -- DIGIT FOUR FULL STOP switch '5' '.' = '\x248C' -- DIGIT FIVE FULL STOP switch '6' '.' = '\x248D' -- DIGIT SIX FULL STOP switch '7' '.' = '\x248E' -- DIGIT SEVEN FULL STOP switch '8' '.' = '\x248F' -- DIGIT EIGHT FULL STOP switch '9' '.' = '\x2490' -- DIGIT NINE FULL STOP switch 'h' 'h' = '\x2500' -- BOX DRAWINGS LIGHT HORIZONTAL switch 'H' 'H' = '\x2501' -- BOX DRAWINGS HEAVY HORIZONTAL switch 'v' 'v' = '\x2502' -- BOX DRAWINGS LIGHT VERTICAL switch 'V' 'V' = '\x2503' -- BOX DRAWINGS HEAVY VERTICAL switch '3' '-' = '\x2504' -- BOX DRAWINGS LIGHT TRIPLE DASH HORIZONTAL switch '3' '_' = '\x2505' -- BOX DRAWINGS HEAVY TRIPLE DASH HORIZONTAL switch '3' '!' = '\x2506' -- BOX DRAWINGS LIGHT TRIPLE DASH VERTICAL switch '3' '/' = '\x2507' -- BOX DRAWINGS HEAVY TRIPLE DASH VERTICAL switch '4' '-' = '\x2508' -- BOX DRAWINGS LIGHT QUADRUPLE DASH HORIZONTAL switch '4' '_' = '\x2509' -- BOX DRAWINGS HEAVY QUADRUPLE DASH HORIZONTAL switch '4' '!' = '\x250A' -- BOX DRAWINGS LIGHT QUADRUPLE DASH VERTICAL switch '4' '/' = '\x250B' -- BOX DRAWINGS HEAVY QUADRUPLE DASH VERTICAL switch 'd' 'r' = '\x250C' -- BOX DRAWINGS LIGHT DOWN AND RIGHT switch 'd' 'R' = '\x250D' -- BOX DRAWINGS DOWN LIGHT AND RIGHT HEAVY switch 'D' 'r' = '\x250E' -- BOX DRAWINGS DOWN HEAVY AND RIGHT LIGHT switch 'D' 'R' = '\x250F' -- BOX DRAWINGS HEAVY DOWN AND RIGHT switch 'd' 'l' = '\x2510' -- BOX DRAWINGS LIGHT DOWN AND LEFT switch 'd' 'L' = '\x2511' -- BOX DRAWINGS DOWN LIGHT AND LEFT HEAVY switch 'D' 'l' = '\x2512' -- BOX DRAWINGS DOWN HEAVY AND LEFT LIGHT switch 'L' 'D' = '\x2513' -- BOX DRAWINGS HEAVY DOWN AND LEFT switch 'u' 'r' = '\x2514' -- BOX DRAWINGS LIGHT UP AND RIGHT switch 'u' 'R' = '\x2515' -- BOX DRAWINGS UP LIGHT AND RIGHT HEAVY switch 'U' 'r' = '\x2516' -- BOX DRAWINGS UP HEAVY AND RIGHT LIGHT switch 'U' 'R' = '\x2517' -- BOX DRAWINGS HEAVY UP AND RIGHT switch 'u' 'l' = '\x2518' -- BOX VOICED SOUND MARKDRAWINGS LIGHT UP AND LEFT switch 'u' 'L' = '\x2519' -- BOX DRAWINGS UP LIGHT AND LEFT HEAVY switch 'U' 'l' = '\x251A' -- BOX DRAWINGS UP HEAVY AND LEFT LIGHT switch 'U' 'L' = '\x251B' -- BOX DRAWINGS HEAVY UP AND LEFT switch 'v' 'r' = '\x251C' -- BOX DRAWINGS LIGHT VERTICAL AND RIGHT switch 'v' 'R' = '\x251D' -- BOX DRAWINGS VERTICAL LIGHT AND RIGHT HEAVY switch 'V' 'r' = '\x2520' -- BOX DRAWINGS VERTICAL HEAVY AND RIGHT LIGHT switch 'V' 'R' = '\x2523' -- BOX DRAWINGS HEAVY VERTICAL AND RIGHT switch 'v' 'l' = '\x2524' -- BOX DRAWINGS LIGHT VERTICAL AND LEFT switch 'v' 'L' = '\x2525' -- BOX DRAWINGS VERTICAL LIGHT AND LEFT HEAVY switch 'V' 'l' = '\x2528' -- BOX DRAWINGS VERTICAL HEAVY AND LEFT LIGHT switch 'V' 'L' = '\x252B' -- BOX DRAWINGS HEAVY VERTICAL AND LEFT switch 'd' 'h' = '\x252C' -- BOX DRAWINGS LIGHT DOWN AND HORIZONTAL switch 'd' 'H' = '\x252F' -- BOX DRAWINGS DOWN LIGHT AND HORIZONTAL HEAVY switch 'D' 'h' = '\x2530' -- BOX DRAWINGS DOWN HEAVY AND HORIZONTAL LIGHT switch 'D' 'H' = '\x2533' -- BOX DRAWINGS HEAVY DOWN AND HORIZONTAL switch 'u' 'h' = '\x2534' -- BOX DRAWINGS LIGHT UP AND HORIZONTAL switch 'u' 'H' = '\x2537' -- BOX DRAWINGS UP LIGHT AND HORIZONTAL HEAVY switch 'U' 'h' = '\x2538' -- BOX DRAWINGS UP HEAVY AND HORIZONTAL LIGHT switch 'U' 'H' = '\x253B' -- BOX DRAWINGS HEAVY UP AND HORIZONTAL switch 'v' 'h' = '\x253C' -- BOX DRAWINGS LIGHT VERTICAL AND HORIZONTAL switch 'v' 'H' = '\x253F' -- BOX DRAWINGS VERTICAL LIGHT AND HORIZONTAL HEAVY switch 'V' 'h' = '\x2542' -- BOX DRAWINGS VERTICAL HEAVY AND HORIZONTAL LIGHT switch 'V' 'H' = '\x254B' -- BOX DRAWINGS HEAVY VERTICAL AND HORIZONTAL switch 'F' 'D' = '\x2571' -- BOX DRAWINGS LIGHT DIAGONAL UPPER RIGHT TO LOWER LEFT switch 'B' 'D' = '\x2572' -- BOX DRAWINGS LIGHT DIAGONAL UPPER LEFT TO LOWER RIGHT switch 'T' 'B' = '\x2580' -- UPPER HALF BLOCK switch 'L' 'B' = '\x2584' -- LOWER HALF BLOCK switch 'F' 'B' = '\x2588' -- FULL BLOCK switch 'l' 'B' = '\x258C' -- LEFT HALF BLOCK switch 'R' 'B' = '\x2590' -- RIGHT HALF BLOCK switch '.' 'S' = '\x2591' -- LIGHT SHADE switch ':' 'S' = '\x2592' -- MEDIUM SHADE switch '?' 'S' = '\x2593' -- DARK SHADE switch 'f' 'S' = '\x25A0' -- BLACK SQUARE switch 'O' 'S' = '\x25A1' -- WHITE SQUARE switch 'R' 'O' = '\x25A2' -- WHITE SQUARE WITH ROUNDED CORNERS switch 'R' 'r' = '\x25A3' -- WHITE SQUARE CONTAINING BLACK SMALL SQUARE switch 'R' 'F' = '\x25A4' -- SQUARE WITH HORIZONTAL FILL switch 'R' 'Y' = '\x25A5' -- SQUARE WITH VERTICAL FILL switch 'R' 'H' = '\x25A6' -- SQUARE WITH ORTHOGONAL CROSSHATCH FILL switch 'R' 'Z' = '\x25A7' -- SQUARE WITH UPPER LEFT TO LOWER RIGHT FILL switch 'R' 'K' = '\x25A8' -- SQUARE WITH UPPER RIGHT TO LOWER LEFT FILL switch 'R' 'X' = '\x25A9' -- SQUARE WITH DIAGONAL CROSSHATCH FILL switch 's' 'B' = '\x25AA' -- BLACK SMALL SQUARE switch 'S' 'R' = '\x25AC' -- BLACK RECTANGLE switch 'O' 'r' = '\x25AD' -- WHITE RECTANGLE switch 'U' 'T' = '\x25B2' -- BLACK UP-POINTING TRIANGLE switch 'u' 'T' = '\x25B3' -- WHITE UP-POINTING TRIANGLE switch 'P' 'R' = '\x25B6' -- BLACK RIGHT-POINTING TRIANGLE switch 'T' 'r' = '\x25B7' -- WHITE RIGHT-POINTING TRIANGLE switch 'D' 't' = '\x25BC' -- BLACK DOWN-POINTING TRIANGLE switch 'd' 'T' = '\x25BD' -- WHITE DOWN-POINTING TRIANGLE switch 'P' 'L' = '\x25C0' -- BLACK LEFT-POINTING TRIANGLE switch 'T' 'l' = '\x25C1' -- WHITE LEFT-POINTING TRIANGLE switch 'D' 'b' = '\x25C6' -- BLACK DIAMOND switch 'D' 'w' = '\x25C7' -- WHITE DIAMOND switch 'L' 'Z' = '\x25CA' -- LOZENGE switch '0' 'm' = '\x25CB' -- WHITE CIRCLE switch '0' 'o' = '\x25CE' -- BULLSEYE switch '0' 'M' = '\x25CF' -- BLACK CIRCLE switch '0' 'L' = '\x25D0' -- CIRCLE WITH LEFT HALF BLACK switch '0' 'R' = '\x25D1' -- CIRCLE WITH RIGHT HALF BLACK switch 'S' 'n' = '\x25D8' -- INVERSE BULLET switch 'I' 'c' = '\x25D9' -- INVERSE WHITE CIRCLE switch 'F' 'd' = '\x25E2' -- BLACK LOWER RIGHT TRIANGLE switch 'B' 'd' = '\x25E3' -- BLACK LOWER LEFT TRIANGLE switch '*' '2' = '\x2605' -- BLACK STAR switch '*' '1' = '\x2606' -- WHITE STAR switch '<' 'H' = '\x261C' -- WHITE LEFT POINTING INDEX switch '>' 'H' = '\x261E' -- WHITE RIGHT POINTING INDEX switch '0' 'u' = '\x263A' -- WHITE SMILING FACE switch '0' 'U' = '\x263B' -- BLACK SMILING FACE switch 'S' 'U' = '\x263C' -- WHITE SUN WITH RAYS switch 'F' 'm' = '\x2640' -- FEMALE SIGN switch 'M' 'l' = '\x2642' -- MALE SIGN switch 'c' 'S' = '\x2660' -- BLACK SPADE SUIT switch 'c' 'H' = '\x2661' -- WHITE HEART SUIT switch 'c' 'D' = '\x2662' -- WHITE DIAMOND SUIT switch 'c' 'C' = '\x2663' -- BLACK CLUB SUIT switch 'M' 'd' = '\x2669' -- QUARTER NOTE ` switch 'M' '8' = '\x266A' -- EIGHTH NOTE ` switch 'M' '2' = '\x266B' -- BEAMED EIGHTH NOTES switch 'M' 'b' = '\x266D' -- MUSIC FLAT SIGN switch 'M' 'x' = '\x266E' -- MUSIC NATURAL SIGN switch 'M' 'X' = '\x266F' -- MUSIC SHARP SIGN switch 'O' 'K' = '\x2713' -- CHECK MARK switch 'X' 'X' = '\x2717' -- BALLOT X switch '-' 'X' = '\x2720' -- MALTESE CROSS switch 'I' 'S' = '\x3000' -- IDEOGRAPHIC SPACE switch ',' '_' = '\x3001' -- IDEOGRAPHIC COMMA switch '.' '_' = '\x3002' -- IDEOGRAPHIC FULL STOP switch '+' '"' = '\x3003' -- DITTO MARK switch '+' '_' = '\x3004' -- JAPANESE INDUSTRIAL STANDARD SYMBOL switch '*' '_' = '\x3005' -- IDEOGRAPHIC ITERATION MARK switch ';' '_' = '\x3006' -- IDEOGRAPHIC CLOSING MARK switch '0' '_' = '\x3007' -- IDEOGRAPHIC NUMBER ZERO switch '<' '+' = '\x300A' -- LEFT DOUBLE ANGLE BRACKET switch '>' '+' = '\x300B' -- RIGHT DOUBLE ANGLE BRACKET switch '<' '\'' = '\x300C' -- LEFT CORNER BRACKET switch '>' '\'' = '\x300D' -- RIGHT CORNER BRACKET switch '<' '"' = '\x300E' -- LEFT WHITE CORNER BRACKET switch '>' '"' = '\x300F' -- RIGHT WHITE CORNER BRACKET switch '(' '"' = '\x3010' -- LEFT BLACK LENTICULAR BRACKET switch ')' '"' = '\x3011' -- RIGHT BLACK LENTICULAR BRACKET switch '=' 'T' = '\x3012' -- POSTAL MARK switch '=' '_' = '\x3013' -- GETA MARK switch '(' '\'' = '\x3014' -- LEFT TORTOISE SHELL BRACKET switch ')' '\'' = '\x3015' -- RIGHT TORTOISE SHELL BRACKET switch '(' 'I' = '\x3016' -- LEFT WHITE LENTICULAR BRACKET switch ')' 'I' = '\x3017' -- RIGHT WHITE LENTICULAR BRACKET switch '-' '?' = '\x301C' -- WAVE DASH switch 'A' '5' = '\x3041' -- HIRAGANA LETTER SMALL A switch 'a' '5' = '\x3042' -- HIRAGANA LETTER A switch 'I' '5' = '\x3043' -- HIRAGANA LETTER SMALL I switch 'i' '5' = '\x3044' -- HIRAGANA LETTER I switch 'U' '5' = '\x3045' -- HIRAGANA LETTER SMALL U switch 'u' '5' = '\x3046' -- HIRAGANA LETTER U switch 'E' '5' = '\x3047' -- HIRAGANA LETTER SMALL E switch 'e' '5' = '\x3048' -- HIRAGANA LETTER E switch 'O' '5' = '\x3049' -- HIRAGANA LETTER SMALL O switch 'o' '5' = '\x304A' -- HIRAGANA LETTER O switch 'k' 'a' = '\x304B' -- HIRAGANA LETTER KA switch 'g' 'a' = '\x304C' -- HIRAGANA LETTER GA switch 'k' 'i' = '\x304D' -- HIRAGANA LETTER KI switch 'g' 'i' = '\x304E' -- HIRAGANA LETTER GI switch 'k' 'u' = '\x304F' -- HIRAGANA LETTER KU switch 'g' 'u' = '\x3050' -- HIRAGANA LETTER GU switch 'k' 'e' = '\x3051' -- HIRAGANA LETTER KE switch 'g' 'e' = '\x3052' -- HIRAGANA LETTER GE switch 'k' 'o' = '\x3053' -- HIRAGANA LETTER KO switch 'g' 'o' = '\x3054' -- HIRAGANA LETTER GO switch 's' 'a' = '\x3055' -- HIRAGANA LETTER SA switch 'z' 'a' = '\x3056' -- HIRAGANA LETTER ZA switch 's' 'i' = '\x3057' -- HIRAGANA LETTER SI switch 'z' 'i' = '\x3058' -- HIRAGANA LETTER ZI switch 's' 'u' = '\x3059' -- HIRAGANA LETTER SU switch 'z' 'u' = '\x305A' -- HIRAGANA LETTER ZU switch 's' 'e' = '\x305B' -- HIRAGANA LETTER SE switch 'z' 'e' = '\x305C' -- HIRAGANA LETTER ZE switch 's' 'o' = '\x305D' -- HIRAGANA LETTER SO switch 'z' 'o' = '\x305E' -- HIRAGANA LETTER ZO switch 't' 'a' = '\x305F' -- HIRAGANA LETTER TA switch 'd' 'a' = '\x3060' -- HIRAGANA LETTER DA switch 't' 'i' = '\x3061' -- HIRAGANA LETTER TI switch 'd' 'i' = '\x3062' -- HIRAGANA LETTER DI switch 't' 'U' = '\x3063' -- HIRAGANA LETTER SMALL TU switch 't' 'u' = '\x3064' -- HIRAGANA LETTER TU switch 'd' 'u' = '\x3065' -- HIRAGANA LETTER DU switch 't' 'e' = '\x3066' -- HIRAGANA LETTER TE switch 'd' 'e' = '\x3067' -- HIRAGANA LETTER DE switch 't' 'o' = '\x3068' -- HIRAGANA LETTER TO switch 'd' 'o' = '\x3069' -- HIRAGANA LETTER DO switch 'n' 'a' = '\x306A' -- HIRAGANA LETTER NA switch 'n' 'i' = '\x306B' -- HIRAGANA LETTER NI switch 'n' 'u' = '\x306C' -- HIRAGANA LETTER NU switch 'n' 'e' = '\x306D' -- HIRAGANA LETTER NE switch 'n' 'o' = '\x306E' -- HIRAGANA LETTER NO switch 'h' 'a' = '\x306F' -- HIRAGANA LETTER HA switch 'b' 'a' = '\x3070' -- HIRAGANA LETTER BA switch 'p' 'a' = '\x3071' -- HIRAGANA LETTER PA switch 'h' 'i' = '\x3072' -- HIRAGANA LETTER HI switch 'b' 'i' = '\x3073' -- HIRAGANA LETTER BI switch 'p' 'i' = '\x3074' -- HIRAGANA LETTER PI switch 'h' 'u' = '\x3075' -- HIRAGANA LETTER HU switch 'b' 'u' = '\x3076' -- HIRAGANA LETTER BU switch 'p' 'u' = '\x3077' -- HIRAGANA LETTER PU switch 'h' 'e' = '\x3078' -- HIRAGANA LETTER HE switch 'b' 'e' = '\x3079' -- HIRAGANA LETTER BE switch 'p' 'e' = '\x307A' -- HIRAGANA LETTER PE switch 'h' 'o' = '\x307B' -- HIRAGANA LETTER HO switch 'b' 'o' = '\x307C' -- HIRAGANA LETTER BO switch 'p' 'o' = '\x307D' -- HIRAGANA LETTER PO switch 'm' 'a' = '\x307E' -- HIRAGANA LETTER MA switch 'm' 'i' = '\x307F' -- HIRAGANA LETTER MI switch 'm' 'u' = '\x3080' -- HIRAGANA LETTER MU switch 'm' 'e' = '\x3081' -- HIRAGANA LETTER ME switch 'm' 'o' = '\x3082' -- HIRAGANA LETTER MO switch 'y' 'A' = '\x3083' -- HIRAGANA LETTER SMALL YA switch 'y' 'a' = '\x3084' -- HIRAGANA LETTER YA switch 'y' 'U' = '\x3085' -- HIRAGANA LETTER SMALL YU switch 'y' 'u' = '\x3086' -- HIRAGANA LETTER YU switch 'y' 'O' = '\x3087' -- HIRAGANA LETTER SMALL YO switch 'y' 'o' = '\x3088' -- HIRAGANA LETTER YO switch 'r' 'a' = '\x3089' -- HIRAGANA LETTER RA switch 'r' 'i' = '\x308A' -- HIRAGANA LETTER RI switch 'r' 'u' = '\x308B' -- HIRAGANA LETTER RU switch 'r' 'e' = '\x308C' -- HIRAGANA LETTER RE switch 'r' 'o' = '\x308D' -- HIRAGANA LETTER RO switch 'w' 'A' = '\x308E' -- HIRAGANA LETTER SMALL WA switch 'w' 'a' = '\x308F' -- HIRAGANA LETTER WA switch 'w' 'i' = '\x3090' -- HIRAGANA LETTER WI switch 'w' 'e' = '\x3091' -- HIRAGANA LETTER WE switch 'w' 'o' = '\x3092' -- HIRAGANA LETTER WO switch 'n' '5' = '\x3093' -- HIRAGANA LETTER N ` switch 'v' 'u' = '\x3094' -- HIRAGANA LETTER VU switch '"' '5' = '\x309B' -- KATAKANA-HIRAGANA VOICED SOUND MARK switch '0' '5' = '\x309C' -- KATAKANA-HIRAGANA SEMI-VOICED SOUND MARK switch '*' '5' = '\x309D' -- HIRAGANA ITERATION MARK switch '+' '5' = '\x309E' -- HIRAGANA VOICED ITERATION MARK switch 'a' '6' = '\x30A1' -- KATAKANA LETTER SMALL A switch 'A' '6' = '\x30A2' -- KATAKANA LETTER A switch 'i' '6' = '\x30A3' -- KATAKANA LETTER SMALL I switch 'I' '6' = '\x30A4' -- KATAKANA LETTER I switch 'u' '6' = '\x30A5' -- KATAKANA LETTER SMALL U switch 'U' '6' = '\x30A6' -- KATAKANA LETTER U switch 'e' '6' = '\x30A7' -- KATAKANA LETTER SMALL E switch 'E' '6' = '\x30A8' -- KATAKANA LETTER E switch 'o' '6' = '\x30A9' -- KATAKANA LETTER SMALL O switch 'O' '6' = '\x30AA' -- KATAKANA LETTER O switch 'K' 'a' = '\x30AB' -- KATAKANA LETTER KA switch 'G' 'a' = '\x30AC' -- KATAKANA LETTER GA switch 'K' 'i' = '\x30AD' -- KATAKANA LETTER KI switch 'G' 'i' = '\x30AE' -- KATAKANA LETTER GI switch 'K' 'u' = '\x30AF' -- KATAKANA LETTER KU switch 'G' 'u' = '\x30B0' -- KATAKANA LETTER GU switch 'K' 'e' = '\x30B1' -- KATAKANA LETTER KE switch 'G' 'e' = '\x30B2' -- KATAKANA LETTER GE switch 'K' 'o' = '\x30B3' -- KATAKANA LETTER KO switch 'G' 'o' = '\x30B4' -- KATAKANA LETTER GO switch 'S' 'a' = '\x30B5' -- KATAKANA LETTER SA switch 'Z' 'a' = '\x30B6' -- KATAKANA LETTER ZA switch 'S' 'i' = '\x30B7' -- KATAKANA LETTER SI switch 'Z' 'i' = '\x30B8' -- KATAKANA LETTER ZI switch 'S' 'u' = '\x30B9' -- KATAKANA LETTER SU switch 'Z' 'u' = '\x30BA' -- KATAKANA LETTER ZU switch 'S' 'e' = '\x30BB' -- KATAKANA LETTER SE switch 'Z' 'e' = '\x30BC' -- KATAKANA LETTER ZE switch 'S' 'o' = '\x30BD' -- KATAKANA LETTER SO switch 'Z' 'o' = '\x30BE' -- KATAKANA LETTER ZO switch 'T' 'a' = '\x30BF' -- KATAKANA LETTER TA switch 'D' 'a' = '\x30C0' -- KATAKANA LETTER DA switch 'T' 'i' = '\x30C1' -- KATAKANA LETTER TI switch 'D' 'i' = '\x30C2' -- KATAKANA LETTER DI switch 'T' 'U' = '\x30C3' -- KATAKANA LETTER SMALL TU switch 'T' 'u' = '\x30C4' -- KATAKANA LETTER TU switch 'D' 'u' = '\x30C5' -- KATAKANA LETTER DU switch 'T' 'e' = '\x30C6' -- KATAKANA LETTER TE switch 'D' 'e' = '\x30C7' -- KATAKANA LETTER DE switch 'T' 'o' = '\x30C8' -- KATAKANA LETTER TO switch 'D' 'o' = '\x30C9' -- KATAKANA LETTER DO switch 'N' 'a' = '\x30CA' -- KATAKANA LETTER NA switch 'N' 'i' = '\x30CB' -- KATAKANA LETTER NI switch 'N' 'u' = '\x30CC' -- KATAKANA LETTER NU switch 'N' 'e' = '\x30CD' -- KATAKANA LETTER NE switch 'N' 'o' = '\x30CE' -- KATAKANA LETTER NO switch 'H' 'a' = '\x30CF' -- KATAKANA LETTER HA switch 'B' 'a' = '\x30D0' -- KATAKANA LETTER BA switch 'P' 'a' = '\x30D1' -- KATAKANA LETTER PA switch 'H' 'i' = '\x30D2' -- KATAKANA LETTER HI switch 'B' 'i' = '\x30D3' -- KATAKANA LETTER BI switch 'P' 'i' = '\x30D4' -- KATAKANA LETTER PI switch 'H' 'u' = '\x30D5' -- KATAKANA LETTER HU switch 'B' 'u' = '\x30D6' -- KATAKANA LETTER BU switch 'P' 'u' = '\x30D7' -- KATAKANA LETTER PU switch 'H' 'e' = '\x30D8' -- KATAKANA LETTER HE switch 'B' 'e' = '\x30D9' -- KATAKANA LETTER BE switch 'P' 'e' = '\x30DA' -- KATAKANA LETTER PE switch 'H' 'o' = '\x30DB' -- KATAKANA LETTER HO switch 'B' 'o' = '\x30DC' -- KATAKANA LETTER BO switch 'P' 'o' = '\x30DD' -- KATAKANA LETTER PO switch 'M' 'a' = '\x30DE' -- KATAKANA LETTER MA switch 'M' 'i' = '\x30DF' -- KATAKANA LETTER MI switch 'M' 'u' = '\x30E0' -- KATAKANA LETTER MU switch 'M' 'e' = '\x30E1' -- KATAKANA LETTER ME switch 'M' 'o' = '\x30E2' -- KATAKANA LETTER MO switch 'Y' 'A' = '\x30E3' -- KATAKANA LETTER SMALL YA switch 'Y' 'a' = '\x30E4' -- KATAKANA LETTER YA switch 'Y' 'U' = '\x30E5' -- KATAKANA LETTER SMALL YU switch 'Y' 'u' = '\x30E6' -- KATAKANA LETTER YU switch 'Y' 'O' = '\x30E7' -- KATAKANA LETTER SMALL YO switch 'Y' 'o' = '\x30E8' -- KATAKANA LETTER YO switch 'R' 'a' = '\x30E9' -- KATAKANA LETTER RA switch 'R' 'i' = '\x30EA' -- KATAKANA LETTER RI switch 'R' 'u' = '\x30EB' -- KATAKANA LETTER RU switch 'R' 'e' = '\x30EC' -- KATAKANA LETTER RE switch 'R' 'o' = '\x30ED' -- KATAKANA LETTER RO switch 'W' 'A' = '\x30EE' -- KATAKANA LETTER SMALL WA switch 'W' 'a' = '\x30EF' -- KATAKANA LETTER WA switch 'W' 'i' = '\x30F0' -- KATAKANA LETTER WI switch 'W' 'e' = '\x30F1' -- KATAKANA LETTER WE switch 'W' 'o' = '\x30F2' -- KATAKANA LETTER WO switch 'N' '6' = '\x30F3' -- KATAKANA LETTER N ` switch 'V' 'u' = '\x30F4' -- KATAKANA LETTER VU switch 'K' 'A' = '\x30F5' -- KATAKANA LETTER SMALL KA switch 'K' 'E' = '\x30F6' -- KATAKANA LETTER SMALL KE switch 'V' 'a' = '\x30F7' -- KATAKANA LETTER VA switch 'V' 'i' = '\x30F8' -- KATAKANA LETTER VI switch 'V' 'e' = '\x30F9' -- KATAKANA LETTER VE switch 'V' 'o' = '\x30FA' -- KATAKANA LETTER VO switch '.' '6' = '\x30FB' -- KATAKANA MIDDLE DOT switch '-' '6' = '\x30FC' -- KATAKANA-HIRAGANA PROLONGED SOUND MARK switch '*' '6' = '\x30FD' -- KATAKANA ITERATION MARK switch '+' '6' = '\x30FE' -- KATAKANA VOICED ITERATION MARK switch 'b' '4' = '\x3105' -- BOPOMOFO LETTER B switch 'p' '4' = '\x3106' -- BOPOMOFO LETTER P switch 'm' '4' = '\x3107' -- BOPOMOFO LETTER M switch 'f' '4' = '\x3108' -- BOPOMOFO LETTER F switch 'd' '4' = '\x3109' -- BOPOMOFO LETTER D switch 't' '4' = '\x310A' -- BOPOMOFO LETTER T switch 'n' '4' = '\x310B' -- BOPOMOFO LETTER N ` switch 'l' '4' = '\x310C' -- BOPOMOFO LETTER L switch 'g' '4' = '\x310D' -- BOPOMOFO LETTER G switch 'k' '4' = '\x310E' -- BOPOMOFO LETTER K switch 'h' '4' = '\x310F' -- BOPOMOFO LETTER H switch 'j' '4' = '\x3110' -- BOPOMOFO LETTER J switch 'q' '4' = '\x3111' -- BOPOMOFO LETTER Q switch 'x' '4' = '\x3112' -- BOPOMOFO LETTER X switch 'z' 'h' = '\x3113' -- BOPOMOFO LETTER ZH switch 'c' 'h' = '\x3114' -- BOPOMOFO LETTER CH switch 's' 'h' = '\x3115' -- BOPOMOFO LETTER SH switch 'r' '4' = '\x3116' -- BOPOMOFO LETTER R switch 'z' '4' = '\x3117' -- BOPOMOFO LETTER Z switch 'c' '4' = '\x3118' -- BOPOMOFO LETTER C switch 's' '4' = '\x3119' -- BOPOMOFO LETTER S switch 'a' '4' = '\x311A' -- BOPOMOFO LETTER A switch 'o' '4' = '\x311B' -- BOPOMOFO LETTER O switch 'e' '4' = '\x311C' -- BOPOMOFO LETTER E switch 'a' 'i' = '\x311E' -- BOPOMOFO LETTER AI switch 'e' 'i' = '\x311F' -- BOPOMOFO LETTER EI switch 'a' 'u' = '\x3120' -- BOPOMOFO LETTER AU switch 'o' 'u' = '\x3121' -- BOPOMOFO LETTER OU switch 'a' 'n' = '\x3122' -- BOPOMOFO LETTER AN switch 'e' 'n' = '\x3123' -- BOPOMOFO LETTER EN switch 'a' 'N' = '\x3124' -- BOPOMOFO LETTER ANG switch 'e' 'N' = '\x3125' -- BOPOMOFO LETTER ENG switch 'e' 'r' = '\x3126' -- BOPOMOFO LETTER ER switch 'i' '4' = '\x3127' -- BOPOMOFO LETTER I switch 'u' '4' = '\x3128' -- BOPOMOFO LETTER U switch 'i' 'u' = '\x3129' -- BOPOMOFO LETTER IU switch 'v' '4' = '\x312A' -- BOPOMOFO LETTER V switch 'n' 'G' = '\x312B' -- BOPOMOFO LETTER NG switch 'g' 'n' = '\x312C' -- BOPOMOFO LETTER GN switch '1' 'c' = '\x3220' -- PARENTHESIZED IDEOGRAPH ONE switch '2' 'c' = '\x3221' -- PARENTHESIZED IDEOGRAPH TWO switch '3' 'c' = '\x3222' -- PARENTHESIZED IDEOGRAPH THREE switch '4' 'c' = '\x3223' -- PARENTHESIZED IDEOGRAPH FOUR switch '5' 'c' = '\x3224' -- PARENTHESIZED IDEOGRAPH FIVE switch '6' 'c' = '\x3225' -- PARENTHESIZED IDEOGRAPH SIX switch '7' 'c' = '\x3226' -- PARENTHESIZED IDEOGRAPH SEVEN switch '8' 'c' = '\x3227' -- PARENTHESIZED IDEOGRAPH EIGHT switch '9' 'c' = '\x3228' -- PARENTHESIZED IDEOGRAPH NINE switch 'f' 'f' = '\xFB00' -- LATIN SMALL LIGATURE FF switch 'f' 'i' = '\xFB01' -- LATIN SMALL LIGATURE FI switch 'f' 'l' = '\xFB02' -- LATIN SMALL LIGATURE FL switch 'f' 't' = '\xFB05' -- LATIN SMALL LIGATURE LONG S T switch 's' 't' = '\xFB06' -- LATIN SMALL LIGATURE ST switch _ _ = '\xFFFF' -- Fallback yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/Motion.hs0000644000000000000000000002125213755614221017427 0ustar0000000000000000{-# 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 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) , ("", False, void . lineMoveRel) , ("", 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 , ("", False, scrollScreensB . negate) , ("", False, scrollScreensB . negate) , ("", False, scrollScreensB) , ("", 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) , ("", False, moveXorSol) , ("", 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 , ("", 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) , ("", 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:"") | m `elem` ('f' : "FtT") = matchGotoCharMove (m:"<") matchGotoCharMove (m:c:[]) | m `elem` ('f' : "FtT") = WholeMatch $ Move style False action where (style, move, offset) = case m of 'f' -> (Inclusive, nextCInLineInc c, pure ()) 't' -> (Inclusive, nextCInLineInc c, moveB Character Backward) 'F' -> (Exclusive, prevCInLineInc c, pure ()) 'T' -> (Exclusive, prevCInLineInc c, moveB Character Forward) _ -> error "can't happen" action mcount = do let count = fromMaybe 1 mcount p0 <- pointB replicateM_ (count - 1) $ move p1 <- pointB move p2 <- pointB offset when (p1 == p2) $ moveTo p0 matchGotoCharMove _ = NoMatch yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/ExMap.hs0000644000000000000000000002075613755614221017204 0ustar0000000000000000{-# 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, map, unpack) import System.FilePath (isPathSeparator) import Yi.Buffer 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.Utils (matchFromBool, selectBinding) import Yi.Keymap.Vim.Ex import Yi.Keymap.Vim.StateUtils (modifyStateE, resetCountE, switchModeE, getRegisterE) import qualified Yi.Rope as R (fromText, toText) import Yi.String (commonTPrefix') defExMap :: [EventString -> Maybe ExCommand] -> [VimBinding] defExMap cmdParsers = printable : specials cmdParsers specials :: [EventString -> Maybe ExCommand] -> [VimBinding] specials cmdParsers = [ exitBinding , completionBinding cmdParsers , finishBindingY cmdParsers , finishBindingE cmdParsers , failBindingE , historyBinding , pasteRegisterBinding ] completionBinding :: [EventString -> Maybe ExCommand] -> VimBinding completionBinding commandParsers = VimBindingY f where f "" (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 "" (VimState { vsMode = Ex, vsOngoingInsertEvents = Ev "" }) = WholeMatch action f evs (VimState { vsMode = Ex }) = action <$ matchFromBool (evs `elem` ["", ""]) 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` ["", ""] , 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 == "" = WholeMatch $ do exitEx False state <- getEditorDyn printMsg . _unEv $ "Not an editor command: " <> vsOngoingInsertEvents state return Drop 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 = [ ("", historyUp) , ("", historyUp) , ("", historyDown) , ("", historyDown) ] -- a pastes a content of regContent of 'a' Register to Ex buffer ('a' is forall) pasteRegisterBinding :: VimBinding pasteRegisterBinding = VimBindingE $ f . T.unpack . _unEv where f "" (VimState { vsMode = Ex }) = PartialMatch f ('<':'C':'-':'r':'>':regName:[]) vs@(VimState { vsMode = Ex }) = WholeMatch $ pasteRegister regName vs f _ _ = NoMatch -- Paste a content to Ex buffer, and update vsOngoingInsertEvents of VimState pasteRegister :: RegisterName -> VimState -> EditorM RepeatToken pasteRegister registerName vs = do -- Replace " to \NUL, because yi's default register is \NUL and Vim's default is " let registerName' = if registerName == '"' then '\NUL' else registerName mayRegisterVal <- fmap regContent <$> getRegisterE registerName' case mayRegisterVal of Nothing -> return Drop Just val -> do withCurrentBuffer $ insertN . replaceCr $ val -- putEditorDyn fixes that Ex mode never evaluate pasted command -- If you remove this, tests/vimtests/ex/paste_register will failed putEditorDyn vs { vsOngoingInsertEvents = Ev . R.toText $ val } return Finish -- Avoid putting EOL replaceCr = let replacer '\n' = '\r' replacer x = x in R.fromText . T.map replacer . R.toText printable :: VimBinding printable = VimBindingE f where f evs vs@(VimState { vsMode = Ex }) = case selectBinding evs vs $ specials [] of NoMatch -> WholeMatch $ editAction evs _ -> NoMatch f _ _ = NoMatch editAction :: EventString -> EditorM RepeatToken editAction (Ev evs) = do withCurrentBuffer $ case evs of "" -> bdeleteB "" -> bdeleteB "" -> regionOfPartNonEmptyB unitViWordOnLine Backward >>= deleteRegionB "" -> insertB '<' "" -> deleteB Character Forward "" -> deleteB Character Forward "" -> deleteB unitWord Forward "" -> moveXorSol 1 "" -> moveXorSol 1 "" -> moveXorEol 1 "" -> moveXorEol 1 "" -> moveToSol "" -> moveToSol "" -> moveToEol "" -> moveToEol "" -> moveToSol >> deleteToEol "" -> deleteToEol _ -> 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 yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/Eval.hs0000644000000000000000000000122613755614221017050 0ustar0000000000000000{-# 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.pureEval' 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 } yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/ReplaceMap.hs0000644000000000000000000000611013755614221020167 0ustar0000000000000000{-# 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 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 "" -> insertOrReplaceB '<' "" -> insertOrReplaceB '\n' -- For testing purposes assume noexpandtab, tw=4 "" -> replicateM_ 4 $ insertOrReplaceB ' ' "" -> return () -- TODO "" -> return () -- TODO "" -> insertOrReplaceCharWithBelowB "" -> insertOrReplaceCharWithAboveB "" -> return () -- TODO "" -> return () -- TODO "" -> return () -- TODO "" -> return () -- TODO "" -> return () -- TODO "" -> 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 yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/NormalMap.hs0000644000000000000000000005170113755614221020052 0ustar0000000000000000{-# 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, insert) 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 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.Substitution (repeatSubstitutionE, repeatSubstitutionFlaglessE) 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 '^', controlCaret, resetCount) , (ctrlCh '6', controlCaret, resetCount) ] where controlCaret = alternateBufferE . (+ (-1)) =<< getCountE finishingBingings :: [VimBinding] finishingBingings = fmap (mkStringBindingE Normal Finish) [ ("x", cutCharE Forward NonSticky =<< getCountE, resetCount) , ("", 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') , ("", 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)) , ("", enableVisualE Block, resetCount . switchMode (Visual Block)) ] ++ fmap (mkBindingE Normal Continue) [ -- 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) ] nonrepeatableBindings :: [VimBinding] nonrepeatableBindings = fmap (mkBindingE Normal Drop) [ (spec KEsc, return (), resetCount) , (ctrlCh 'c', return (), resetCount) -- 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 '&', loadSubstitutionE >>= maybe (pure ()) repeatSubstitutionFlaglessE, id) -- 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) , ("g&", loadSubstitutionE >>= maybe (pure ()) repeatSubstitutionE, id) , ("", printFileInfoE, resetCount) , ("c", tryCloseE, resetCount) , ("o", closeOtherE, resetCount) , ("s", splitE, resetCount) , ("w", nextWinE, resetCount) , ("", nextWinE, resetCount) -- TODO: please implement downWinE , ("", nextWinE, resetCount) -- TODO: please implement rightWinE , ("", nextWinE, resetCount) , ("W", prevWinE, resetCount) , ("p", prevWinE, resetCount) , ("", prevWinE, resetCount) -- TODO: please implement upWinE , ("", prevWinE, resetCount) -- TODO: please implement leftWinE , ("l", layoutManagersNextE, resetCount) , ("L", layoutManagersPreviousE, resetCount) --, (" ", layoutManagersNextE, resetCount) , ("v", layoutManagerNextVariantE, resetCount) , ("V", layoutManagerPreviousVariantE, resetCount) , ("", getCountE >>= withCurrentBuffer . incrementNextNumberByB, resetCount) , ("", 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) , ("gf", openFileUnderCursor $ Just newTabE, resetCount) , ("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 = insert 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 reg@(Register _ evs) -> do let count = fromMaybe 1 mbCount mkAct = Ev . T.replicate count . R.toText scheduleActionStringForEval . mkAct $ evs modifyStateE $ \s -> s { vsRegisterMap = insert '@' reg (vsRegisterMap s) } 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 yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/Common.hs0000644000000000000000000001475513755614221017424 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# 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 , Substitution(..) , 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.Semigroup (Semigroup) 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 (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, Semigroup, Monoid) instance IsString EventString where fromString = Ev . T.pack newtype OperatorName = Op { _unOp :: T.Text } deriving (Show, Eq, Semigroup, Monoid) instance IsString OperatorName where fromString = Op . T.pack 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 (Show, 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.pureEval comment , vsOngoingInsertEvents :: !EventString , vsLastGotoCharCommand :: !(Maybe GotoCharCommand) , vsBindingAccumulator :: !EventString , vsSecondaryCursors :: ![Point] -- TODO: these should live in a buffer, just as the main cursor does , vsPaste :: !Bool -- ^ like vim's :help paste , vsCurrentMacroRecording :: !(Maybe (MacroName, EventString)) , vsLastSubstitution :: !(Maybe Substitution) } 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 Nothing -- last substitution 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)) data Substitution = Substitution { subsFrom :: YiString , subsTo :: YiString , subsFlagGlobal :: !Bool , subsFlagCaseInsensitive :: !Bool , subsFlagConfirm :: !Bool } deriving (Generic) instance Binary Substitution yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/Operator.hs0000644000000000000000000002257313755614221017764 0ustar0000000000000000{-# 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 qualified Data.List.NonEmpty as NE import Data.Maybe (fromJust) import Data.Monoid ((<>)) import qualified Data.Text as T (unpack) import Yi.Buffer hiding (Insert) import Yi.Buffer.Misc (startUpdateTransactionB) 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, modifyStateE) 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 "" 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 <- NE.head <$> 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 do withCurrentBuffer $ startUpdateTransactionB case style of LineWise -> withCurrentBuffer $ do point <- NE.head <$> deleteRegionWithStyleB reg style moveTo point insertB '\n' leftB Block -> do points <- withCurrentBuffer $ do points <- deleteRegionWithStyleB reg style moveTo $ NE.head points return points modifyStateE $ \s -> s { vsSecondaryCursors = NE.tail points } _ -> withCurrentBuffer $ do point <- NE.head <$> deleteRegionWithStyleB reg style moveTo point 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 evsyi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/TextObject.hs0000644000000000000000000000531613755614221020240 0ustar0000000000000000module Yi.Keymap.Vim.TextObject ( TextObject(..) , CountedTextObject(..) , regionOfTextObjectB , changeTextObjectCount , changeTextObjectStyle , stringToTextObject ) where import Control.Monad (replicateM_, (<=<)) import Yi.Buffer 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 yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/StateUtils.hs0000644000000000000000000001440613755614221020266 0ustar0000000000000000{-# 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 , saveSubstitutionE , loadSubstitutionE ) 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 accum `seq` 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' } saveSubstitutionE :: Substitution -> EditorM () saveSubstitutionE sub = modifyStateE $ \s -> s { vsLastSubstitution = Just sub } loadSubstitutionE :: EditorM (Maybe Substitution) loadSubstitutionE = vsLastSubstitution <$> getEditorDynyi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/Search.hs0000644000000000000000000000322113755614221017363 0ustar0000000000000000{-# 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 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 yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/InsertMap.hs0000644000000000000000000002420013755614221020060 0ustar0000000000000000{-# 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 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, DigraphTbl) 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 :: DigraphTbl -> [VimBinding] defInsertMap digraphs = [rawPrintable] <> specials digraphs <> [printable] specials :: DigraphTbl -> [VimBinding] specials digraphs = [exitBinding digraphs, pasteRegisterBinding, digraphBinding digraphs , oneshotNormalBinding, completionBinding, cursorBinding] exitBinding :: DigraphTbl -> VimBinding exitBinding digraphs = VimBindingE f where f :: EventString -> VimState -> MatchResult (EditorM RepeatToken) f evs (VimState { vsMode = (Insert _) }) | evs `elem` ["", ""] = 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` ["", ""] = WholeMatch . withCurrentBuffer $ do case evs of "" -> insertB '<' "" -> newlineB "" -> insertB '\t' "" -> bdeleteB "" -> bdeleteB "" -> deleteB Character Forward "" -> moveToSol "" -> moveToEol "" -> scrollScreensB (-1) "" -> scrollScreensB 1 c -> insertN (R.fromText $ _unEv c) return Continue f _ _ = NoMatch replay :: DigraphTbl -> [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 "" (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 "" (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 :: DigraphTbl -> 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 "" (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 "" -> do isOldLineEmpty <- isCurrentLineEmptyB shouldTrimOldLine <- isCurrentLineAllWhiteSpaceB if isOldLineEmpty then newlineB else if shouldTrimOldLine then savingPointB $ do moveToSol newlineB else do newlineB indentAsTheMostIndentedNeighborLineB firstNonSpaceB "" -> do if et then insertN' . R.fromString $ replicate sw ' ' else insertB' '\t' "" -> modifyIndentB (+ sw) "" -> modifyIndentB (max 0 . subtract sw) "" -> insertCharWithBelowB "" -> insertCharWithAboveB "" -> bdeleteB' "" -> bdeleteB' "" -> moveToSol "" -> moveToEol >> leftOnEol "" -> scrollScreensB (-1) "" -> scrollScreensB 1 "" -> deleteB' Character Forward "" -> deleteRegionB' =<< regionOfPartNonEmptyB unitViWordOnLine Backward "" -> bdeleteLineB "" -> 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` ["", ""] = WholeMatch $ do let _direction = if evs == "" then Forward else Backward completeWordB FromAllBuffers return Continue f _ _ = NoMatch cursorBinding :: VimBinding cursorBinding = VimBindingE f where f "" (VimState { vsMode = (Insert _) }) = WholeMatch $ do withCurrentBuffer $ moveXorSol 1 return Continue f "" (VimState { vsMode = (Insert _) }) = WholeMatch $ do withCurrentBuffer $ moveXorEol 1 return Continue f evs (VimState { vsMode = (Insert _) }) | evs `elem` ["", "", "", ""] = WholeMatch $ do let WholeMatch (Move _style _isJump move) = stringToMove evs withCurrentBuffer $ move Nothing return Continue f _ _ = NoMatch yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/Ex.hs0000644000000000000000000000577113755614221016546 0ustar0000000000000000{-# 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.BufferNew as BufferNew (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.Number as Number (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.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 qualified Yi.Keymap.Vim.Ex.Commands.Registers as Registers (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 , BufferNew.parse , Cabal.parse , Delete.parse , Edit.parse , Global.parse , GotoLine.parse , Help.parse , Make.parse , Nohl.parse , Number.parse , Paste.parse , Quit.parse , Read.parse , Sort.parse , Substitute.parse , Shell.parse , Tag.parse , Undo.parse , Write.parse , Yi.parse , Copy.parse , Stack.parse , Registers.parse ] yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/EventUtils.hs0000644000000000000000000001151113755614221020261 0ustar0000000000000000{-# 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 "" = (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 "" = 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 "" Event (KASCII ' ') [MCtrl] -> Ev "" 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 $ " 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 $ " s `T.snoc` '>' [MMeta] -> Ev $ " 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) yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/VisualMap.hs0000644000000000000000000003404613755614221020070 0ustar0000000000000000{-# 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, when) import Data.Char (ord) import Data.List (group) import Data.Maybe (fromJust, fromMaybe) import qualified Data.Text as T (unpack) import Yi.Buffer 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, addNewLineIfNecessary, pasteInclusiveB) import Yi.MiniBuffer (spawnMinibufferE) import Yi.Monad (whenM) import qualified Yi.Rope as R (toText, countNewLines) import Yi.Tag (Tag (Tag)) import Yi.Utils (SemiNum ((-~))) defVisualMap :: [VimOperator] -> [VimBinding] defVisualMap operators = [escBinding, motionBinding, textObjectBinding, changeVisualStyleBinding, setMarkBinding] ++ [chooseRegisterBinding, pasteBinding] ++ 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` ["", ""]) 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", ""] = WholeMatch $ do currentMode <- fmap vsMode getEditorDyn let newStyle = case evs of "v" -> Inclusive "V" -> LineWise "" -> 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) void escAction return Finish _ -> NoMatch f _ _ = NoMatch data VisualPaste = PasteBefore | ReplaceSelection deriving (Eq, Ord, Show) pasteBinding :: VimBinding pasteBinding = VimBindingE (f . T.unpack . _unEv) where f "P" VimState { vsMode = (Visual style) } = pasteMatch style PasteBefore f "p" VimState { vsMode = (Visual style) } = pasteMatch style ReplaceSelection f _ _ = NoMatch pasteMatch :: RegionStyle -> VisualPaste -> MatchResult (EditorM RepeatToken) pasteMatch style p = WholeMatch $ do register <- getRegisterE . vsActiveRegister =<< getEditorDyn maybe (pure ()) (paste style p) register void escAction return Finish paste :: RegionStyle -> VisualPaste -> Register -> EditorM () paste LineWise = linePaste paste Block = blockPaste paste Inclusive = otherPaste paste Exclusive = otherPaste linePaste :: VisualPaste -> Register -> EditorM () linePaste p (Register _style rope) = withCurrentBuffer $ do region <- regionOfSelectionB when (p == ReplaceSelection) . void $ deleteRegionWithStyleB region LineWise insertRopeWithStyleB (addNewLineIfNecessary rope) LineWise blockPaste :: VisualPaste -> Register -> EditorM () blockPaste p (Register _style rope) = withCurrentBuffer $ do here <- pointB there <- getSelectionMarkPointB (here', there') <- flipRectangleB here there reg <- regionOfSelectionB moveTo (minimum [here, there, here', there']) when (p == ReplaceSelection) . void $ deleteRegionWithStyleB reg Block if R.countNewLines rope == 0 then actionOnLeft reg $ maybe (pure ()) (\_ -> insertRopeWithStyleB rope _style) else pasteInclusiveB rope _style where -- Taken from deleteRegionWithStyleB actionOnLeft :: Region -> (Maybe Point -> BufferM ()) -> BufferM () actionOnLeft reg action = savingPointB $ do (start, lengths) <- shapeOfBlockRegionB reg moveTo start forM_ (zip [0..] lengths) $ \(i, l) -> do p' <- pointB moveTo start void $ lineMoveRel i action (if l == 0 then Nothing else Just p') otherPaste :: VisualPaste -> Register -> EditorM () otherPaste _ (Register _style rope) = withCurrentBuffer $ do region <- regionOfSelectionB region' <- convertRegionToStyleB region Inclusive replaceRegionB region' rope 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 } withCurrentBuffer $ setVisibleSelection False switchModeE $ Insert (head evs) return Continue f _ _ = NoMatch tagJumpBinding :: VimBinding tagJumpBinding = VimBindingY (f . T.unpack . _unEv) where f "" (VimState { vsMode = (Visual _) }) = WholeMatch $ do tag <- Tag . R.toText <$> withCurrentBuffer (regionOfSelectionB >>= readRegionB) void $ withEditor escAction gotoTag tag 0 Nothing return Finish f _ _ = NoMatch yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/Utils.hs0000644000000000000000000002003313755614221017256 0ustar0000000000000000{-# 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 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 yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/NormalOperatorPendingMap.hs0000644000000000000000000001617613755614221023102 0ustar0000000000000000{-# 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 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 "" -> 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") -- v2V3w -> (Just 6, "", "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 | "" `isPrefixOf` s = go [] count ("":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" yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/SearchMotionMap.hs0000644000000000000000000000621513755614221021215 0ustar0000000000000000{-# 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 (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 "" (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 = [ ("", isearchDelE) , ("", isearchDelE) , ("", isearchHistory 1) , ("", isearchHistory 1) , ("", isearchHistory (-1)) , ("", isearchHistory (-1)) , ("", 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 yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/Ex/0000755000000000000000000000000013755614221016200 5ustar0000000000000000yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/Ex/Eval.hs0000644000000000000000000000311613755614221017424 0ustar0000000000000000{-# 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 () yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/Ex/Types.hs0000644000000000000000000000163413755614221017644 0ustar0000000000000000{-# 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 yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/Ex/Commands/0000755000000000000000000000000013755614221017741 5ustar0000000000000000yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/Ex/Commands/Yi.hs0000644000000000000000000000217613755614221020664 0ustar0000000000000000{-# 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 } yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/Ex/Commands/Copy.hs0000644000000000000000000000346413755614221021216 0ustar0000000000000000{-# 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) yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/Ex/Commands/Number.hs0000644000000000000000000000400713755614221021526 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Keymap.Vim.Ex.Commands.Number -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- Toggles line numbers. module Yi.Keymap.Vim.Ex.Commands.Number (parse) where import qualified Data.Attoparsec.Text as P (string) import Data.Monoid ((<>)) import Yi.Editor (printMsg, withCurrentBuffer) import Yi.Keymap (Action (BufferA, EditorA)) import Yi.Keymap.Vim.Common (EventString) import Yi.Keymap.Vim.Ex.Commands.Common (BoolOptionAction (..), parseBoolOption, pureExCommand) import qualified Yi.Keymap.Vim.Ex.Commands.Common as Ex (parse) import Yi.Keymap.Vim.Ex.Types (ExCommand (..), evStringToExCommand) import Yi.String (showT) import Yi.UI.LineNumbers (getDisplayLineNumbersLocal, setDisplayLineNumbersLocal) -- | Defines the following commands: -- - :set [no]number (toggle buffer-local line numbers) -- - :unset number (make the current buffer use the global setting) parse :: EventString -> Maybe ExCommand parse = evStringToExCommand [ parseBoolOption "number" actionSet , parseUnset ] actionSet :: BoolOptionAction -> Action actionSet BoolOptionAsk = EditorA $ do mb <- withCurrentBuffer getDisplayLineNumbersLocal printMsg $ "number = " <> case mb of Nothing -> "" Just b -> showT b actionSet (BoolOptionSet b) = BufferA $ setDisplayLineNumbersLocal (Just b) actionSet BoolOptionInvert = BufferA $ do b <- getDisplayLineNumbersLocal setDisplayLineNumbersLocal (fmap not b) parseUnset :: EventString -> Maybe ExCommand parseUnset = Ex.parse $ do _ <- P.string "unset number" return $ pureExCommand { cmdShow = "unset number" , cmdAction = BufferA $ setDisplayLineNumbersLocal Nothing } yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/Ex/Commands/Buffer.hs0000644000000000000000000000551313755614221021512 0ustar0000000000000000{-# 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,bufferIdentifier) 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) 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 <- bufferIdentifier 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 } bufferSymbol :: P.Parser T.Text bufferSymbol = P.string "%" <|> P.string "#" bufferIdentifier :: P.Parser T.Text bufferIdentifier = (T.pack <$> P.many1 P.digit) <|> bufferSymbol <|> (T.pack <$> P.many1 P.space) *> (T.pack <$> P.many' P.anyChar) <|> P.endOfInput *> return "" 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 yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/Ex/Commands/Tag.hs0000644000000000000000000000432113755614221021010 0ustar0000000000000000{-# 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"] } yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/Ex/Commands/Paste.hs0000644000000000000000000000246713755614221021362 0ustar0000000000000000{-# 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) } yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/Ex/Commands/Make.hs0000644000000000000000000000207413755614221021155 0ustar0000000000000000{-# 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 } yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/Ex/Commands/Write.hs0000644000000000000000000000430513755614221021371 0ustar0000000000000000{-# 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 yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/Ex/Commands/Substitute.hs0000644000000000000000000000602613755614221022454 0ustar0000000000000000{-# 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, satisfy, string, option, (), Parser) 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 import Yi.Keymap (Action (EditorA)) import Yi.Keymap.Vim.Common (EventString, Substitution(..)) import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common (parse, pureExCommand, parseRange) import Yi.Keymap.Vim.Ex.Types (ExCommand (cmdAction, cmdShow)) import qualified Yi.Rope as R (fromString, toText) import Yi.Keymap.Vim.Substitution -- | Skip one or no occurrences of a given parser. skipOptional :: Alternative f => f a -> f () skipOptional p = P.option () (() <$ p) {-# SPECIALIZE skipOptional :: P.Parser a -> P.Parser () #-} parse :: EventString -> Maybe ExCommand parse = Common.parse $ do (rangeText, rangeB) <- over _2 (fromMaybe $ regionOfB Line) <$> P.match Common.parseRange P.char 's' *> skipOptional (P.string "ub" *> skipOptional (P.string "stitute")) P. "substitute" 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)) flagChars <- P.option "" $ P.char delimiter *> P.many' (P.satisfy $ P.inClass "gic") return $! substitute (Substitution from to ('g' `elem` flagChars) ('i' `elem` flagChars) ('c' `elem` flagChars)) delimiter rangeText rangeB substitute :: Substitution -> Char -> T.Text -> BufferM Region -> ExCommand substitute s@(Substitution from to global caseInsensitive confirm) delimiter 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 $ substituteE s regionB } yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/Ex/Commands/Help.hs0000644000000000000000000000250113755614221021163 0ustar0000000000000000{-# 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 } yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/Ex/Commands/Shell.hs0000644000000000000000000000225113755614221021344 0ustar0000000000000000{-# 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,satisfy) import Yi.Command (interactiveRun) 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.satisfy (/=' ')) args <- Common.commandArgs return $ Common.impureExCommand { cmdShow = "!" , cmdAction = YiA $ interactiveRun cmd args (const $ return ()) } yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/Ex/Commands/Delete.hs0000644000000000000000000000302113755614221021473 0ustar0000000000000000{-# 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 qualified Data.Attoparsec.Text as P (string, try, match) import Data.Maybe (fromMaybe) import Data.Text () import Data.Semigroup ((<>)) import Lens.Micro.Platform import Yi.Buffer 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, parseRange) import Yi.Keymap.Vim.Ex.Types (ExCommand (cmdAction, cmdShow)) parse :: EventString -> Maybe ExCommand parse = Common.parse $ do (rangeText, rangeB) <- over _2 (fromMaybe currentLineRegionB) <$> P.match Common.parseRange void $ P.try ( P.string "delete") <|> P.string "d" return $ Common.pureExCommand { cmdShow = rangeText <> "delete" , cmdAction = BufferA $ deleteRegionB =<< rangeB } where currentLineRegionB = flip convertRegionToStyleB LineWise =<< regionOfB Line yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/Ex/Commands/Buffers.hs0000644000000000000000000000475213755614221021701 0ustar0000000000000000{-# 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 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 ] yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/Ex/Commands/Registers.hs0000644000000000000000000000554613755614221022256 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Keymap.Vim.Ex.Commands.BufferDelete -- License : GPL-2 -- -- :reg[isters] ex command to list yanked texts. module Yi.Keymap.Vim.Ex.Commands.Registers (printRegisters, parse) where import Control.Applicative (Alternative ((<|>))) import Control.Monad (void) import Data.Monoid ((<>)) import Yi.Keymap (Action (EditorA)) import Yi.Keymap.Vim.Ex.Types (ExCommand (cmdAction, cmdShow)) import Yi.Keymap.Vim.Common (EventString, RegisterName, Register (regContent), VimState (vsRegisterMap)) import Yi.Editor (EditorM, getEditorDyn, newBufferE) import Yi.Rope (YiString) import Yi.Types (withEditor, BufferId (MemBuffer)) import qualified Data.Attoparsec.Text as P (string, try, endOfInput) import qualified Data.HashMap.Strict as HM (toList) import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common (parse, pureExCommand) import qualified Yi.Rope as R (concat, toString, fromString) -- | Show registered register and content in new buffer printRegisters :: EditorM () printRegisters = do xs <- HM.toList . vsRegisterMap <$> getEditorDyn let xs' = visualizeConvert xs registers = flip map xs' $ \(nameWithSep, content) -> nameWithSep <> content <> "\n" bufDetail = "--- Register ---\n" <> R.concat registers void $ newBufferE (MemBuffer "Register list") bufDetail where replaceName n | n == '\NUL' = "\\NUL | " | otherwise = ['"', n] ++ " | " -- Straighten diff of \NUL replaceContent = let replaceContentChar c | c == '\n' = "^J" | otherwise = [c] in concatMap replaceContentChar visualizeConvert :: [(RegisterName, Register)] -> [(YiString, YiString)] visualizeConvert = map $ \(name, reg) -> let content = R.toString . regContent $ reg in ( R.fromString . replaceName $ name , R.fromString . replaceContent $ content ) -- | See :help :registers on Vim parse :: EventString -> Maybe ExCommand parse = Common.parse $ do _ <- P.string "reg" <* ( P.try (P.string "isters") <|> P.try (P.string "ister") <|> P.try (P.string "iste") <|> P.try (P.string "ist") <|> P.try (P.string "is") <|> P.try (P.string "i") <|> P.string "" ) <* P.endOfInput return Common.pureExCommand { cmdShow = "registers" , cmdAction = EditorA $ withEditor printRegisters } yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/Ex/Commands/Undo.hs0000644000000000000000000000223013755614221021177 0ustar0000000000000000{-# 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 (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 yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/Ex/Commands/Edit.hs0000644000000000000000000000400613755614221021162 0ustar0000000000000000{-# 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, null) import qualified Data.Attoparsec.Text as P (anyChar, many', 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)) import Yi.Editor (printMsg) 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.many' P.anyChar return $! edit (isJust tab) filename edit :: Bool -> T.Text -> ExCommand edit tab f = Common.impureExCommand { cmdShow = showEdit tab f , cmdAction = YiA $ if T.null f then printMsg "No file name" else 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 yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/Ex/Commands/Sort.hs0000644000000000000000000000273013755614221021226 0ustar0000000000000000{-# 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{regionEnd = regionEnd region - 1} yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/Ex/Commands/Global.hs0000644000000000000000000000540213755614221021476 0ustar0000000000000000{-# 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 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] yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/Ex/Commands/Quit.hs0000644000000000000000000001106013755614221021215 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# language RankNTypes #-} {-# 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, Getting) import Control.Monad (void, when) import Control.Monad.State.Class (MonadState) 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 System.Exit (ExitCode (ExitFailure)) import Yi.Buffer (bkey, file) import Yi.Core (closeWindow, errorEditor, quitEditor, quitEditorWithExitCode) 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) uses :: forall a b f s. MonadState s f => Getting a s a -> (a -> b) -> f b 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 void $ P.try (P.string "cquit") <|> P.string "cq" return hardExitWithError , 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 } hardExitWithError :: ExCommand hardExitWithError = Common.impureExCommand { cmdShow = "cquit" , cmdAction = YiA (quitEditorWithExitCode (ExitFailure 1)) } 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 yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/Ex/Commands/BufferDelete.hs0000644000000000000000000000470513755614221022637 0ustar0000000000000000{-# LANGUAGE OverloadedStrings, UnboxedTuples #-} {-# 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 (some)) import Control.Monad (void, when) import qualified Data.Text as T (null) import qualified Data.Attoparsec.Text as P (Parser, choice, digit, parseOnly, string) import Lens.Micro.Platform (use) import Yi.Buffer.Basic (BufferRef (..)) import Yi.Core (closeWindow, errorEditor) import Yi.Editor (currentWindowA, deleteBuffer, getBufferWithName, withEditor) import Yi.Keymap (Action (YiA)) import Yi.Keymap.Vim.Common (EventString) import Yi.Keymap.Vim.Ex.Commands.Buffer (bufferIdentifier) import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common (needsSaving, parseWithBangAndCount, impureExCommand) import Yi.Keymap.Vim.Ex.Types (ExCommand (cmdAction, cmdShow)) import Yi.Window (bufkey) parse :: EventString -> Maybe ExCommand parse = Common.parseWithBangAndCount nameParser $ \ _ bang mcount -> do bufIdent <- bufferIdentifier return $ Common.impureExCommand { cmdShow = "bdelete" , cmdAction = YiA $ do buffer <- case (# mcount, P.parseOnly bufferRef bufIdent #) of (# Just i, _ #) -> return $ BufferRef i _ | T.null bufIdent -> withEditor $ bufkey <$> use currentWindowA (# _, Right ref #) -> return ref (# _, Left _ #) -> getBufferWithName bufIdent q <- if bang then pure True else not <$> Common.needsSaving buffer if q then do deleteBuffer buffer when (T.null bufIdent) $ closeWindow -- Because this function closed the window before I started altering it else errorEditor "No write since last change (add ! to override)" } where bufferRef = BufferRef . read <$> some P.digit nameParser :: P.Parser () nameParser = void . P.choice . fmap P.string $ ["bdelete","bdel","bd"] yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/Ex/Commands/Common.hs0000644000000000000000000002631613755614221021535 0ustar0000000000000000{-# 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 region <- regionB convertRegionToStyleB region LineWise 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 relative <- (Nothing <$ P.char '.' <|>) $ do () <$ P.char '.' <|> pure () c <- P.satisfy $ P.inClass "+-" (i :: Int) <- read <$> P.many1 P.digit return . Just $ 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 yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/Ex/Commands/Nohl.hs0000644000000000000000000000177613755614221021210 0ustar0000000000000000{-# 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 qualified Data.Text as T 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 (Ev s) | T.isPrefixOf s "nohlsearch" && T.compareLength s 2 == GT = Just nohl | otherwise = Nothing nohl :: ExCommand nohl = pureExCommand { cmdAction = EditorA resetRegexE , cmdShow = "nohlsearch" } yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/Ex/Commands/GotoLine.hs0000644000000000000000000000204213755614221022013 0ustar0000000000000000{-# 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 (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 yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/Ex/Commands/Cabal.hs0000644000000000000000000000275513755614221021310 0ustar0000000000000000{-# 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 } yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/Ex/Commands/Read.hs0000644000000000000000000000503113755614221021147 0ustar0000000000000000{-# 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 } yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/Ex/Commands/Stack.hs0000644000000000000000000000341613755614221021346 0ustar0000000000000000{-# 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" ]yi-keymap-vim-0.19.0/src/Yi/Keymap/Vim/Ex/Commands/BufferNew.hs0000644000000000000000000000273413755614221022166 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- | -- Module : Yi.Keymap.Vim.Ex.Commands.BufferNew -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable module Yi.Keymap.Vim.Ex.Commands.BufferNew (parse) where import Control.Applicative (Alternative(..)) import Control.Monad (void) import qualified Data.Attoparsec.Text as P (anyChar, char, string) import Data.List (null) import qualified Data.Text as T (pack) import Yi.Buffer (BufferId (MemBuffer)) import Yi.Editor (newEmptyBufferE, newTempBufferE, switchToBufferE) 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.string "new" n <- (some (P.char ' ') *> many (P.anyChar)) <|> ("" <$ many (P.char ' ')) return $ Common.pureExCommand { cmdShow = "new" , cmdAction = EditorA $ do b <- if null n then newTempBufferE else newEmptyBufferE (MemBuffer $ T.pack n) switchToBufferE b } yi-keymap-vim-0.19.0/src/Yi/Config/0000755000000000000000000000000013755614221015050 5ustar0000000000000000yi-keymap-vim-0.19.0/src/Yi/Config/Default/0000755000000000000000000000000013755614221016434 5ustar0000000000000000yi-keymap-vim-0.19.0/src/Yi/Config/Default/Vim.hs0000644000000000000000000000072113755614221017523 0ustar0000000000000000module 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 yi-keymap-vim-0.19.0/tests/0000755000000000000000000000000013755614221013635 5ustar0000000000000000yi-keymap-vim-0.19.0/tests/TestSuite.hs0000644000000000000000000000063613755614221016127 0ustar0000000000000000module 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 ] yi-keymap-vim-0.19.0/tests/Vim/0000755000000000000000000000000013755614221014370 5ustar0000000000000000yi-keymap-vim-0.19.0/tests/Vim/TestPureEditorManipulations.hs0000644000000000000000000000237113755614221022415 0ustar0000000000000000{-# 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-0.19.0/tests/Vim/TestExCommandParsers.hs0000644000000000000000000001346513755614221021010 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Vim.TestExCommandParsers (tests) where import Data.List (inits) 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 import qualified Yi.Keymap.Vim.Ex.Commands.Registers as Registers import qualified Yi.Keymap.Vim.Ex.Commands.Nohl as Nohl 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 ]) , CommandParser "Registers.parse" (Registers.parse . Ev . T.pack) [ "reg" , "regi" , "regis" , "regist" , "registe" , "register" , "registers" ] False False (pure "") , CommandParser "Nohl.parse" (Nohl.parse . Ev . T.pack) (drop 3 $ inits "nohlsearch") False False (pure "") ] 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 ] yi-keymap-vim-0.19.0/tests/Vim/TestPureBufferManipulations.hs0000644000000000000000000000241313755614221022375 0ustar0000000000000000{-# 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} yi-keymap-vim-0.19.0/tests/Vim/EditorManipulations/0000755000000000000000000000000013755614221020362 5ustar0000000000000000yi-keymap-vim-0.19.0/tests/Vim/EditorManipulations/BufferExCommand.hs0000644000000000000000000001431513755614221023727 0ustar0000000000000000{-# 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 bufs 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 bufs = fst $ bufs !! n nthBufferName :: Int -> [(BufferRef, BufferName)] -> BufferName nthBufferName n bufs = snd $ bufs !! n tests :: Config -> KeyEval -> TestTree tests c ev = testGroup ":buffer" [ testCase ":buffer {bufname} switches to the named buffer" $ do let setupActions = createInitialBuffers preConditions editor bufs = assertNotCurrentBuffer (nthBufferRef 1 bufs) editor testActions bufs = ev $ ":buffer " ++ nthBufferName 1 bufs ++ "" assertions editor bufs = do assertContentOfCurrentBuffer c "Buffer two" editor assertCurrentBuffer (nthBufferRef 1 bufs) editor runTest setupActions preConditions testActions assertions c , testCase ":buffer N switches to the numbered buffer" $ do let setupActions = createInitialBuffers preConditions editor bufs = assertNotCurrentBuffer (nthBufferRef 1 bufs) editor testActions bufs = let (BufferRef bref) = nthBufferRef 1 bufs in ev $ ":buffer " ++ show bref ++ "" assertions editor bufs = do assertContentOfCurrentBuffer c "Buffer two" editor assertCurrentBuffer (nthBufferRef 1 bufs) editor runTest setupActions preConditions testActions assertions c , testCase ":buffer # switches to the previous buffer" $ do let setupActions = createInitialBuffers preConditions editor bufs = assertEqual "Unexpected buffer stack" [nthBufferRef 2 bufs, nthBufferRef 1 bufs] (take 2 . NE.toList $ bufferStack editor) testActions _ = ev $ ":buffer #" assertions editor bufs = do assertEqual "Unexpected buffer stack" [nthBufferRef 1 bufs, nthBufferRef 2 bufs] (take 2 . NE.toList $ bufferStack editor) runTest setupActions preConditions testActions assertions c , testCase ":buffer % is a no-op" $ do let setupActions = createInitialBuffers preConditions editor bufs = assertCurrentBuffer (nthBufferRef 2 bufs) editor testActions _ = ev $ ":buffer %" assertions editor bufs = do assertContentOfCurrentBuffer c "Buffer three" editor assertCurrentBuffer (nthBufferRef 2 bufs) editor runTest setupActions preConditions testActions assertions c , testCase ":buffer is a no-op" $ do let setupActions = createInitialBuffers preConditions editor bufs = assertCurrentBuffer (nthBufferRef 2 bufs) editor testActions _ = ev $ ":buffer" assertions editor bufs = do assertContentOfCurrentBuffer c "Buffer three" editor assertCurrentBuffer (nthBufferRef 2 bufs) editor runTest setupActions preConditions testActions assertions c , testCase "A modified buffer is not abandoned" $ do let setupActions = createInitialBuffers preConditions editor bufs = assertNotCurrentBuffer (nthBufferRef 1 bufs) editor testActions bufs = do withCurrentBuffer $ insertN "The buffer is altered" ev $ ":buffer " ++ nthBufferName 1 bufs ++ "" assertions editor bufs = do assertNotCurrentBuffer (nthBufferRef 1 bufs) editor runTest setupActions preConditions testActions assertions c , testCase "A modified buffer can be abandoned with a bang" $ do let setupActions = createInitialBuffers preConditions editor bufs = assertNotCurrentBuffer (nthBufferRef 1 bufs) editor testActions bufs = do withCurrentBuffer $ insertN "The buffer is altered" ev $ ":buffer! " ++ nthBufferName 1 bufs ++ "" assertions editor bufs = do assertCurrentBuffer (nthBufferRef 1 bufs) editor runTest setupActions preConditions testActions assertions c , testCase ":Nbuffer switches to the numbered buffer" $ do let setupActions = createInitialBuffers preConditions editor bufs = assertNotCurrentBuffer (nthBufferRef 1 bufs) editor testActions bufs = -- return () let (BufferRef bref) = nthBufferRef 1 bufs in ev $ ":" ++ show bref ++ "buffer" -- in ev $ ":buffer " ++ show bref ++ "" assertions editor bufs = do -- assertContentOfCurrentBuffer c "Buffer two" editor assertCurrentBuffer (nthBufferRef 1 bufs) 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 ] yi-keymap-vim-0.19.0/tests/Generic/0000755000000000000000000000000013755614221015211 5ustar0000000000000000yi-keymap-vim-0.19.0/tests/Generic/TestUtils.hs0000644000000000000000000000772413755614221017517 0ustar0000000000000000module 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) yi-keymap-vim-0.19.0/tests/Generic/TestPureBufferManipulations.hs0000644000000000000000000001674313755614221023231 0ustar0000000000000000-- | 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 (getTests) 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 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 width' height') = let region = mkSizeRegion (Point 0) (Size (width' * height')) in currentWindowA %= (\w -> w { height = height', actualLines = height', 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) (ktOutput t) actualOut 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 yi-keymap-vim-0.19.0/tests/vimtests/0000755000000000000000000000000013755614221015513 5ustar0000000000000000yi-keymap-vim-0.19.0/tests/vimtests/search/0000755000000000000000000000000013755614221016760 5ustar0000000000000000yi-keymap-vim-0.19.0/tests/vimtests/search/counted_2.test0000644000000000000000000000032313755614221021541 0ustar0000000000000000-- Input (3,1) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,13) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events 2?doloryi-keymap-vim-0.19.0/tests/vimtests/search/9.test0000644000000000000000000000006613755614221020033 0ustar0000000000000000-- Input (1,1) Foo -- Output (1,1) oo -- Events /xyi-keymap-vim-0.19.0/tests/vimtests/search/1.test0000644000000000000000000000023413755614221020020 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,13) Lorem ipsum olor sit amet abc def ghi qwe rty uiop -- Events /dolorxyi-keymap-vim-0.19.0/tests/vimtests/search/8.test0000644000000000000000000000036713755614221020036 0ustar0000000000000000-- Input (2,16) Lorem ipsum dolor sit amet ipsum dolor sit amet ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,8) Lorem ipsum dolor sit amet ipsum dolor sit amet ipsum dolor sit amet abc def ghi qwe rty uiop -- Events ?dolornnnyi-keymap-vim-0.19.0/tests/vimtests/search/history2.test0000644000000000000000000000026513755614221021447 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,13) Lorem ipsum olor sit amet abc def ghi qwe rty uiop -- Events /dolor/ametgg/xyi-keymap-vim-0.19.0/tests/vimtests/search/counted_n_1.test0000644000000000000000000000041213755614221022054 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (3,13) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events /dolor2nyi-keymap-vim-0.19.0/tests/vimtests/search/counted_n_3.test0000644000000000000000000000050113755614221022055 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (4,13) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events /dolorn2nyi-keymap-vim-0.19.0/tests/vimtests/search/counted_1.test0000644000000000000000000000032313755614221021540 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,13) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events 2/doloryi-keymap-vim-0.19.0/tests/vimtests/search/counted_n_2.test0000644000000000000000000000050113755614221022054 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (4,13) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events /dolor2nnyi-keymap-vim-0.19.0/tests/vimtests/search/history4.test0000644000000000000000000000027213755614221021447 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,23) Lorem ipsum dolor sit met abc def ghi qwe rty uiop -- Events /dolor/ametgg/xyi-keymap-vim-0.19.0/tests/vimtests/search/history1.test0000644000000000000000000000026613755614221021447 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,13) Lorem ipsum olor sit amet abc def ghi qwe rty uiop -- Events /dolor/ametgg/xyi-keymap-vim-0.19.0/tests/vimtests/search/counted_capN_1.test0000644000000000000000000000050013755614221022476 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (3,13) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events /dolor2Nyi-keymap-vim-0.19.0/tests/vimtests/search/2.test0000644000000000000000000000032313755614221020020 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,13) Lorem ipsum dolor sit amet Lorem ipsum olor sit amet abc def ghi qwe rty uiop -- Events /dolornxyi-keymap-vim-0.19.0/tests/vimtests/search/counted_3.test0000644000000000000000000000023513755614221021544 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,13) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events 1/doloryi-keymap-vim-0.19.0/tests/vimtests/search/7.test0000644000000000000000000000032413755614221020026 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,13) Lorem ipsum olor sit amet Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events /dolornnxyi-keymap-vim-0.19.0/tests/vimtests/search/3.test0000644000000000000000000000036413755614221020026 0ustar0000000000000000-- Input (2,16) Lorem ipsum dolor sit amet ipsum dolor sit amet ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,8) Lorem ipsum dolor sit amet ipsum dolor sit amet ipsum dolor sit amet abc def ghi qwe rty uiop -- Events ?doloryi-keymap-vim-0.19.0/tests/vimtests/search/4.test0000644000000000000000000000036613755614221020031 0ustar0000000000000000-- Input (2,16) Lorem ipsum dolor sit amet ipsum dolor sit amet ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,13) Lorem ipsum dolor sit amet ipsum dolor sit amet ipsum dolor sit amet abc def ghi qwe rty uiop -- Events ?dolornyi-keymap-vim-0.19.0/tests/vimtests/search/history3.test0000644000000000000000000000027313755614221021447 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,23) Lorem ipsum dolor sit met abc def ghi qwe rty uiop -- Events /dolor/ametgg/xyi-keymap-vim-0.19.0/tests/vimtests/search/6.test0000644000000000000000000000032413755614221020025 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,13) Lorem ipsum olor sit amet Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events /dolornNxyi-keymap-vim-0.19.0/tests/vimtests/search/5.test0000644000000000000000000000036613755614221020032 0ustar0000000000000000-- Input (2,16) Lorem ipsum dolor sit amet ipsum dolor sit amet ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,8) Lorem ipsum dolor sit amet ipsum dolor sit amet ipsum dolor sit amet abc def ghi qwe rty uiop -- Events ?dolornNyi-keymap-vim-0.19.0/tests/vimtests/search/counted_capN_2.test0000644000000000000000000000041213755614221022501 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,13) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events ?dolor2Nyi-keymap-vim-0.19.0/tests/vimtests/repeat/0000755000000000000000000000000013755614221016773 5ustar0000000000000000yi-keymap-vim-0.19.0/tests/vimtests/repeat/capI2.test0000644000000000000000000000010513755614221020626 0ustar0000000000000000-- Input (1,1) foo -- Output (1,6) ABCABCABCfoo -- Events IABC2.yi-keymap-vim-0.19.0/tests/vimtests/repeat/dwp.test0000644000000000000000000000024313755614221020465 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,19) iLorem Lorem Lorem psum dolor sit amet abc def ghi qwe rty uiop -- Events dwp..yi-keymap-vim-0.19.0/tests/vimtests/repeat/a4.test0000644000000000000000000000011513755614221020175 0ustar0000000000000000-- Input (1,1) foo -- Output (1,16) fABCABCABCABCABCoo -- Events 3aABC2.yi-keymap-vim-0.19.0/tests/vimtests/repeat/r.test0000644000000000000000000000007713755614221020141 0ustar0000000000000000-- Input (1,1) abcdef -- Output (1,5) xbxdxf -- Events rx2l.2l.yi-keymap-vim-0.19.0/tests/vimtests/repeat/o3.test0000644000000000000000000000013013755614221020207 0ustar0000000000000000-- Input (2,1) 123 456 789 -- Output (5,3) 123 456 abc abc abc 789 -- Events oabc..yi-keymap-vim-0.19.0/tests/vimtests/repeat/x_1.test0000644000000000000000000000021713755614221020363 0ustar0000000000000000-- Input (2,2) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,2) Lorem ipsum dolor sit amet a ghi qwe rty uiop -- Events 2x..yi-keymap-vim-0.19.0/tests/vimtests/repeat/capX_1.test0000644000000000000000000000021713755614221021007 0ustar0000000000000000-- Input (2,8) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,2) Lorem ipsum dolor sit amet a ghi qwe rty uiop -- Events 2X..yi-keymap-vim-0.19.0/tests/vimtests/repeat/a5.test0000644000000000000000000000014513755614221020201 0ustar0000000000000000-- Input (1,1) foo -- Output (1,28) fABCABCABCABCABCABCABCABCABCoo -- Events 3aABCy.d.yi-keymap-vim-0.19.0/tests/vimtests/repeat/tilde_repeat.test0000644000000000000000000000022613755614221022335 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,13) lOREM IPSUM dolor sit amet abc def ghi qwe rty uiop -- Events 6~. yi-keymap-vim-0.19.0/tests/vimtests/repeat/capI3.test0000644000000000000000000000011413755614221020627 0ustar0000000000000000-- Input (1,1) foo -- Output (1,6) ABCABCABCABCABCfoo -- Events 3IABC2.yi-keymap-vim-0.19.0/tests/vimtests/repeat/a3.test0000644000000000000000000000013113755614221020172 0ustar0000000000000000-- Input (1,1) foo -- Output (1,28) fABCABCABCABCABCABCABCABCABCoo -- Events 3aABC..yi-keymap-vim-0.19.0/tests/vimtests/repeat/r_3.test0000644000000000000000000000011013755614221020347 0ustar0000000000000000-- Input (1,1) abcdefghijk -- Output (1,6) xbxdefghijk -- Events rx2l.3lyi-keymap-vim-0.19.0/tests/vimtests/repeat/capI4.test0000644000000000000000000000013013755614221020626 0ustar0000000000000000-- Input (1,1) foo -- Output (1,9) ABCABCABCABCABCABCABCABCABCfoo -- Events 3IABC..yi-keymap-vim-0.19.0/tests/vimtests/repeat/o1.test0000644000000000000000000000014113755614221020207 0ustar0000000000000000-- Input (2,1) 123 456 789 -- Output (7,3) 123 456 abc abc abc abc abc 789 -- Events 2oabc3.yi-keymap-vim-0.19.0/tests/vimtests/repeat/capI.test0000644000000000000000000000010513755614221020544 0ustar0000000000000000-- Input (1,1) foo -- Output (1,3) ABCABCABCfoo -- Events IABC..yi-keymap-vim-0.19.0/tests/vimtests/repeat/o2.test0000644000000000000000000000013013755614221020206 0ustar0000000000000000-- Input (2,1) 123 456 789 -- Output (5,3) 123 456 abc abc abc 789 -- Events oabc2.yi-keymap-vim-0.19.0/tests/vimtests/repeat/x.test0000644000000000000000000000022113755614221020136 0ustar0000000000000000-- Input (2,2) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,2) Lorem ipsum dolor sit amet adef ghi qwe rty uiop -- Events x..yi-keymap-vim-0.19.0/tests/vimtests/repeat/r_1.test0000644000000000000000000000007413755614221020356 0ustar0000000000000000-- Input (1,1) abcdef -- Output (1,3) xbxdef -- Events rx2l.yi-keymap-vim-0.19.0/tests/vimtests/repeat/dw_capP.test0000644000000000000000000000024313755614221021250 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,16) LoremLoremLorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events dwP..yi-keymap-vim-0.19.0/tests/vimtests/repeat/capX.test0000644000000000000000000000022113755614221020562 0ustar0000000000000000-- Input (2,5) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,2) Lorem ipsum dolor sit amet adef ghi qwe rty uiop -- Events X..yi-keymap-vim-0.19.0/tests/vimtests/repeat/x_2.test0000644000000000000000000000022313755614221020361 0ustar0000000000000000-- Input (1,2) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,6) Lemps dolor sit amet abc def ghi qwe rty uiop -- Events 2x2l.2l.yi-keymap-vim-0.19.0/tests/vimtests/repeat/capC.test0000644000000000000000000000013413755614221020540 0ustar0000000000000000-- Input (1,1) foo bar foo baz -- Output (2,9) foo quux foo quux -- Events wCquuxj0w.yi-keymap-vim-0.19.0/tests/vimtests/repeat/O1.test0000644000000000000000000000014113755614221020147 0ustar0000000000000000-- Input (2,1) 123 456 789 -- Output (7,3) 123 456 abc abc abc abc abc 789 -- Events 2oabc3.yi-keymap-vim-0.19.0/tests/vimtests/repeat/capO3.test0000644000000000000000000000013013755614221020633 0ustar0000000000000000-- Input (2,1) 123 456 789 -- Output (2,3) 123 abc abc abc 456 789 -- Events Oabc..yi-keymap-vim-0.19.0/tests/vimtests/repeat/tilde_repeat_does_not_affect_other_lines.test0000644000000000000000000000023013755614221030125 0ustar0000000000000000-- Input (1,1) abcdefghijklmnopqrstuvwxyz abc def ghi qwe rty uiop -- Output (1,26) ABCDEFGHIJKLMNOPQRSTUVWXYz abc def ghi qwe rty uiop -- Events 13~.. yi-keymap-vim-0.19.0/tests/vimtests/repeat/i.test0000644000000000000000000000010513755614221020120 0ustar0000000000000000-- Input (1,1) foo -- Output (1,7) ABABABCCCfoo -- Events iABC..yi-keymap-vim-0.19.0/tests/vimtests/repeat/a.test0000644000000000000000000000010613755614221020111 0ustar0000000000000000-- Input (1,1) foo -- Output (1,10) fABCABCABCoo -- Events aABC..yi-keymap-vim-0.19.0/tests/vimtests/repeat/capO2.test0000644000000000000000000000013013755614221020632 0ustar0000000000000000-- Input (2,1) 123 456 789 -- Output (3,3) 123 abc abc abc 456 789 -- Events Oabc2.yi-keymap-vim-0.19.0/tests/vimtests/repeat/r_2.test0000644000000000000000000000011413755614221020352 0ustar0000000000000000-- Input (1,1) abcdefghijk -- Output (1,8) xbxdexgxijk -- Events rx2l.3l.2l.yi-keymap-vim-0.19.0/tests/vimtests/repeat/capA4.test0000644000000000000000000000011513755614221020621 0ustar0000000000000000-- Input (1,1) foo -- Output (1,18) fooABCABCABCABCABC -- Events 3AABC2.yi-keymap-vim-0.19.0/tests/vimtests/repeat/i3.test0000644000000000000000000000011513755614221020204 0ustar0000000000000000-- Input (1,1) foo -- Output (1,14) ABCABCABABCABCCfoo -- Events 3iABC2.yi-keymap-vim-0.19.0/tests/vimtests/repeat/capA3.test0000644000000000000000000000013113755614221020616 0ustar0000000000000000-- Input (1,1) foo -- Output (1,30) fooABCABCABCABCABCABCABCABCABC -- Events 3AABC..yi-keymap-vim-0.19.0/tests/vimtests/repeat/a2.test0000644000000000000000000000010613755614221020173 0ustar0000000000000000-- Input (1,1) foo -- Output (1,10) fABCABCABCoo -- Events aABC2.yi-keymap-vim-0.19.0/tests/vimtests/repeat/i4.test0000644000000000000000000000013113755614221020203 0ustar0000000000000000-- Input (1,1) foo -- Output (1,25) ABCABCABABCABCABABCABCABCCCfoo -- Events 3iABC..yi-keymap-vim-0.19.0/tests/vimtests/repeat/capA2.test0000644000000000000000000000010613755614221020617 0ustar0000000000000000-- Input (1,1) foo -- Output (1,12) fooABCABCABC -- Events AABC2.yi-keymap-vim-0.19.0/tests/vimtests/repeat/capA.test0000644000000000000000000000010613755614221020535 0ustar0000000000000000-- Input (1,1) foo -- Output (1,12) fooABCABCABC -- Events AABC..yi-keymap-vim-0.19.0/tests/vimtests/repeat/2r.test0000644000000000000000000000007513755614221020221 0ustar0000000000000000-- Input (1,1) abcdef -- Output (1,6) xxcdxx -- Events 2rx3l.yi-keymap-vim-0.19.0/tests/vimtests/repeat/i2.test0000644000000000000000000000010513755614221020202 0ustar0000000000000000-- Input (1,1) foo -- Output (1,8) ABABCABCCfoo -- Events iABC2.yi-keymap-vim-0.19.0/tests/vimtests/repeat/counted_2r.test0000644000000000000000000000010013755614221021727 0ustar0000000000000000-- Input (1,1) abcdefg -- Output (1,7) xxxdexx -- Events 3rx3l2.yi-keymap-vim-0.19.0/tests/vimtests/repeat/capO.test0000644000000000000000000000014513755614221020556 0ustar0000000000000000-- Input (2,1) 123 456 789 -- Output (5,3) 123 abc abc abc abc abc abc 456 789 -- Events 2Oabc..yi-keymap-vim-0.19.0/tests/vimtests/repeat/o.test0000644000000000000000000000014513755614221020132 0ustar0000000000000000-- Input (2,1) 123 456 789 -- Output (8,3) 123 456 abc abc abc abc abc abc 789 -- Events 2oabc..yi-keymap-vim-0.19.0/tests/vimtests/jumplist/0000755000000000000000000000000013755614221017362 5ustar0000000000000000yi-keymap-vim-0.19.0/tests/vimtests/jumplist/1.test0000644000000000000000000000041713755614221020425 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet -- Output (2,7) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet -- Events w***yi-keymap-vim-0.19.0/tests/vimtests/jumplist/2.test0000644000000000000000000000043113755614221020422 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet -- Output (4,7) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet -- Events w***yi-keymap-vim-0.19.0/tests/vimtests/delete/0000755000000000000000000000000013755614221016755 5ustar0000000000000000yi-keymap-vim-0.19.0/tests/vimtests/delete/d00.test0000644000000000000000000000015713755614221020244 0ustar0000000000000000-- Input (1,6) abc def ghi 123 456 789 lorem ipsum -- Output (1,1) ef ghi 123 456 789 lorem ipsum -- Events d0 yi-keymap-vim-0.19.0/tests/vimtests/delete/ld3w.test0000644000000000000000000000010113755614221020517 0ustar0000000000000000-- Input (1,1) 1 2 3 4 5 6 -- Output (1,1) 1 4 5 6 -- Events ld3wyi-keymap-vim-0.19.0/tests/vimtests/delete/dd_2.test0000644000000000000000000000015613755614221020470 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,1) qwe rty uiop -- Events $2ddyi-keymap-vim-0.19.0/tests/vimtests/delete/d2vd.test0000644000000000000000000000022513755614221020514 0ustar0000000000000000-- Input (2,8) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,7) Lorem ipsum dolor sit amet abc qwe rty uiop -- Events d2vd yi-keymap-vim-0.19.0/tests/vimtests/delete/x_1.test0000644000000000000000000000010113755614221020335 0ustar0000000000000000-- Input (2,2) foo bar baz -- Output (2,1) foo b baz -- Events 5xyi-keymap-vim-0.19.0/tests/vimtests/delete/capX_1.test0000644000000000000000000000010213755614221020762 0ustar0000000000000000-- Input (2,2) foo bar baz -- Output (2,1) foo ar baz -- Events 5Xyi-keymap-vim-0.19.0/tests/vimtests/delete/ldw.test0000644000000000000000000000010313755614221020436 0ustar0000000000000000-- Input (1,1) 1 2 3 4 5 6 -- Output (1,2) 12 3 4 5 6 -- Events ldwyi-keymap-vim-0.19.0/tests/vimtests/delete/2d3w.test0000644000000000000000000000010113755614221020425 0ustar0000000000000000-- Input (1,1) a b c d e f g h -- Output (1,1) g h -- Events 2d3wyi-keymap-vim-0.19.0/tests/vimtests/delete/d0.test0000644000000000000000000000016213755614221020160 0ustar0000000000000000-- Input (1,1) abc def ghi 123 456 789 lorem ipsum -- Output (1,1) bc def ghi 123 456 789 lorem ipsum -- Events dlyi-keymap-vim-0.19.0/tests/vimtests/delete/dvd.test0000644000000000000000000000022613755614221020433 0ustar0000000000000000-- Input (2,8) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,4) Lorem ipsum dolor sit amet def ghi qwe rty uiop -- Events dvdyi-keymap-vim-0.19.0/tests/vimtests/delete/C-u_2.test0000644000000000000000000000010713755614221020521 0ustar0000000000000000-- Input (2,1) foo bar baz -- Output (1,8) foo barbaz -- Events i yi-keymap-vim-0.19.0/tests/vimtests/delete/d2vd_1.test0000644000000000000000000000023013755614221020730 0ustar0000000000000000-- Input (2,8) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,8) Lorem ipsum dolor sit amet abc qwe rty uiop -- Events d2vd yi-keymap-vim-0.19.0/tests/vimtests/delete/10dd.test0000644000000000000000000000017413755614221020410 0ustar0000000000000000-- Input (2,2) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,1) Lorem ipsum dolor sit amet -- Events 10ddyi-keymap-vim-0.19.0/tests/vimtests/delete/d_right_curly.test0000644000000000000000000000012713755614221022514 0ustar0000000000000000-- Input (1,5) Foo bar baz 123 234 345 -- Output (1,4) Foo 123 234 345 -- Events d} yi-keymap-vim-0.19.0/tests/vimtests/delete/dd.test0000644000000000000000000000021013755614221020236 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,1) Lorem ipsum dolor sit amet qwe rty uiop -- Events jddyi-keymap-vim-0.19.0/tests/vimtests/delete/x.test0000644000000000000000000000023513755614221020125 0ustar0000000000000000-- Input (1,1) A very intelligent turtle Found programming UNIX a hurdle -- Output (2,4) A very intelligent turtle Foumming UNIX a hurdle -- Events 3lj5xxxxxyi-keymap-vim-0.19.0/tests/vimtests/delete/d2G.test0000644000000000000000000000022613755614221020272 0ustar0000000000000000-- Input (3,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop aze rty uiop -- Output (2,1) Lorem ipsum dolor sit amet aze rty uiop -- Events d2G yi-keymap-vim-0.19.0/tests/vimtests/delete/dj.test0000644000000000000000000000015413755614221020253 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,1) qwe rty uiop -- Events djyi-keymap-vim-0.19.0/tests/vimtests/delete/d3vd.test0000644000000000000000000000025113755614221020514 0ustar0000000000000000-- Input (2,8) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop qwe rty uiop -- Output (2,8) Lorem ipsum dolor sit amet abc qwe rty uiop -- Events d3vd yi-keymap-vim-0.19.0/tests/vimtests/delete/capX.test0000644000000000000000000000024113755614221020546 0ustar0000000000000000-- Input (1,1) A very intelligent turtle Found programming UNIX a hurdle -- Output (2,11) A very intelligent turtle Found progng UNIX a hurdle -- Events 15lj3XXXyi-keymap-vim-0.19.0/tests/vimtests/delete/capD.test0000644000000000000000000000011113755614221020516 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (2,2) foo b baz -- Events jllDyi-keymap-vim-0.19.0/tests/vimtests/delete/ldwdw.test0000644000000000000000000000010313755614221020771 0ustar0000000000000000-- Input (1,1) 1 2 3 4 5 6 -- Output (1,2) 13 4 5 6 -- Events ldwdwyi-keymap-vim-0.19.0/tests/vimtests/delete/dd_1.test0000644000000000000000000000021113755614221020457 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,1) Lorem ipsum dolor sit amet qwe rty uiop -- Events j$ddyi-keymap-vim-0.19.0/tests/vimtests/delete/ld3w_1.test0000644000000000000000000000010013755614221020736 0ustar0000000000000000-- Input (1,1) 1 2 3 4 5 6 -- Output (1,2) 14 5 6 -- Events ld3wyi-keymap-vim-0.19.0/tests/vimtests/delete/2dd.test0000644000000000000000000000015513755614221020330 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,1) qwe rty uiop -- Events 2ddyi-keymap-vim-0.19.0/tests/vimtests/delete/daw.test0000644000000000000000000000021613755614221020430 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,1) ipsum dolor sit amet abc def ghi qwe rty uiop -- Events dawyi-keymap-vim-0.19.0/tests/vimtests/delete/d_capV_right_curly.test0000644000000000000000000000012113755614221023457 0ustar0000000000000000-- Input (1,5) Foo bar baz 123 234 345 -- Output (1,1) 123 234 345 -- Events dV}yi-keymap-vim-0.19.0/tests/vimtests/delete/dd_3.test0000644000000000000000000000020613755614221020465 0ustar0000000000000000-- Input (3,3) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,1) Lorem ipsum dolor sit amet abc def ghi -- Events ddyi-keymap-vim-0.19.0/tests/vimtests/delete/2d3w_1.test0000644000000000000000000000013413755614221020653 0ustar0000000000000000-- Input (1,1) a b c d e f g h a b c d e f g h -- Output (2,1) g h e f g h -- Events 2d3wj4.yi-keymap-vim-0.19.0/tests/vimtests/delete/de.test0000644000000000000000000000021613755614221020245 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,1) ipsum dolor sit amet abc def ghi qwe rty uiop -- Events deyi-keymap-vim-0.19.0/tests/vimtests/delete/d_v_right_curly.test0000644000000000000000000000012513755614221023037 0ustar0000000000000000-- Input (1,5) Foo bar baz 123 234 345 -- Output (1,5) Foo 123 234 345 -- Events dv}yi-keymap-vim-0.19.0/tests/vimtests/delete/dt.test0000644000000000000000000000024313755614221020264 0ustar0000000000000000-- Input (2,10) Lorem ipsum dolor sit amet [peanut butter and jelly] qwe rty uiop -- Output (2,10) Lorem ipsum dolor sit amet [peanut b] qwe rty uiop -- Events dt]yi-keymap-vim-0.19.0/tests/vimtests/delete/dve.test0000644000000000000000000000010213755614221020425 0ustar0000000000000000-- Input (1,1) Foo bar baz -- Output (1,1) o bar baz -- Events dveyi-keymap-vim-0.19.0/tests/vimtests/delete/d3G.test0000644000000000000000000000022613755614221020273 0ustar0000000000000000-- Input (2,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop aze rty uiop -- Output (2,1) Lorem ipsum dolor sit amet aze rty uiop -- Events d3G yi-keymap-vim-0.19.0/tests/vimtests/delete/dd_4.test0000644000000000000000000000017713755614221020475 0ustar0000000000000000-- Input (2,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,1) Lorem ipsum dolor sit amet -- Events 2ddyi-keymap-vim-0.19.0/tests/vimtests/delete/d_capG.test0000644000000000000000000000015613755614221021035 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop aze rty uiop -- Output (1,1) -- Events dG yi-keymap-vim-0.19.0/tests/vimtests/delete/dw_1.test0000644000000000000000000000020313755614221020503 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,1) sit amet abc def ghi qwe rty uiop -- Events dw..yi-keymap-vim-0.19.0/tests/vimtests/delete/diw.test0000644000000000000000000000021713755614221020441 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,1) ipsum dolor sit amet abc def ghi qwe rty uiop -- Events diwyi-keymap-vim-0.19.0/tests/vimtests/delete/dd_5.test0000644000000000000000000000017713755614221020476 0ustar0000000000000000-- Input (2,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,1) Lorem ipsum dolor sit amet -- Events 2ddyi-keymap-vim-0.19.0/tests/vimtests/delete/dVl.test0000644000000000000000000000021013755614221020374 0ustar0000000000000000-- Input (2,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,1) Lorem ipsum dolor sit amet qwe rty uiop -- Events dVlyi-keymap-vim-0.19.0/tests/vimtests/delete/spec_delete.test0000644000000000000000000000010513755614221022126 0ustar0000000000000000-- Input (2,2) foo bar baz -- Output (2,2) foo br baz -- Events yi-keymap-vim-0.19.0/tests/vimtests/delete/C-u_1.test0000644000000000000000000000017413755614221020524 0ustar0000000000000000-- Input (2,5) Lorem ipsum dolor sit amet qwe rty uiop -- Output (2,1) Lorem ipsum dolor sit amet rty uiop -- Events i yi-keymap-vim-0.19.0/tests/vimtests/format/0000755000000000000000000000000013755614221017003 5ustar0000000000000000yi-keymap-vim-0.19.0/tests/vimtests/format/long_blank_line.test0000644000000000000000000000031513755614221023020 0ustar0000000000000000-- Input (1,1) the above line is 100 spaces -- Output (1,1) the above line is 100 spaces -- Events gqip yi-keymap-vim-0.19.0/tests/vimtests/format/break_line_in_word.test0000644000000000000000000000044613755614221023524 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. -- Output (2,1) Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. -- Events gqip yi-keymap-vim-0.19.0/tests/vimtests/format/join_lines.test0000644000000000000000000000061613755614221022040 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet, consectetur adipiscing elit. Donec a diam lectus. Sed sit amet ipsum mauris. Maecenas congue ligula ac quam viverra nec consectetur ante hendrerit. -- Output (3,1) Lorem ipsum dolor sit amet, consectetur adipiscing elit. Donec a diam lectus. Sed sit amet ipsum mauris. Maecenas congue ligula ac quam viverra nec consectetur ante hendrerit. -- Events gqip yi-keymap-vim-0.19.0/tests/vimtests/format/long_line.test0000644000000000000000000000034013755614221021647 0ustar0000000000000000-- Input (1,1) Loremipsumdolorsitamet,consecteturadipiscingelit.Donecadiamlectus.Sedsitametipsummauris. -- Output (1,1) Loremipsumdolorsitamet,consecteturadipiscingelit.Donecadiamlectus.Sedsitametipsummauris. -- Events gqip yi-keymap-vim-0.19.0/tests/vimtests/format/indent.test0000644000000000000000000000033013755614221021161 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet, consectetur adipiscing elit. Donec a diam lectus. -- Output (2,5) Lorem ipsum dolor sit amet, consectetur adipiscing elit. Donec a diam lectus. -- Events gqip yi-keymap-vim-0.19.0/tests/vimtests/format/trailing_ws.test0000644000000000000000000000031213755614221022222 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod -- Output (1,1) Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod -- Events gqip yi-keymap-vim-0.19.0/tests/vimtests/yank/0000755000000000000000000000000013755614221016455 5ustar0000000000000000yi-keymap-vim-0.19.0/tests/vimtests/yank/yy.test0000644000000000000000000000010313755614221020011 0ustar0000000000000000-- Input (2,2) foo bar baz -- Output (2,2) foo bar baz -- Events yyyi-keymap-vim-0.19.0/tests/vimtests/movement/0000755000000000000000000000000013755614221017345 5ustar0000000000000000yi-keymap-vim-0.19.0/tests/vimtests/movement/eol_j.test0000644000000000000000000000022713755614221021337 0ustar0000000000000000-- Input (2,2) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (4,12) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events $jjyi-keymap-vim-0.19.0/tests/vimtests/movement/v_eol_j2.test0000644000000000000000000000022713755614221021746 0ustar0000000000000000-- Input (1,2) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events v$0jyi-keymap-vim-0.19.0/tests/vimtests/movement/empty.test0000644000000000000000000000005713755614221021406 0ustar0000000000000000-- Input (1,1) -- Output (1,1) -- Events hjklyi-keymap-vim-0.19.0/tests/vimtests/movement/empty_1.test0000644000000000000000000000006013755614221021620 0ustar0000000000000000-- Input (1,1) -- Output (1,1) -- Events ggG$0yi-keymap-vim-0.19.0/tests/vimtests/movement/eol_j2.test0000644000000000000000000000022613755614221021420 0ustar0000000000000000-- Input (1,2) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events $0jyi-keymap-vim-0.19.0/tests/vimtests/sort/0000755000000000000000000000000013755614221016502 5ustar0000000000000000yi-keymap-vim-0.19.0/tests/vimtests/sort/1.test0000644000000000000000000000013113755614221017536 0ustar0000000000000000-- Input (1,1) 1 2 3 5 4 6 7 8 9 -- Output (10,1) 1 2 3 4 5 6 7 8 9 -- Events :sortyi-keymap-vim-0.19.0/tests/vimtests/sort/2.test0000644000000000000000000000013313755614221017541 0ustar0000000000000000-- Input (1,1) 1 2 3 5 4 6 7 8 9 -- Output (3,1) 1 2 3 5 4 6 7 8 9 -- Events :1,2sortyi-keymap-vim-0.19.0/tests/vimtests/sort/3.test0000644000000000000000000000013313755614221017542 0ustar0000000000000000-- Input (1,1) 1 2 3 5 4 6 7 8 9 -- Output (1,1) 1 2 3 4 5 6 7 8 9 -- Events :4,5sortyi-keymap-vim-0.19.0/tests/vimtests/sort/4.test0000644000000000000000000000013413755614221017544 0ustar0000000000000000-- Input (1,1) 1 2 3 5 4 6 7 8 9 -- Output (10,1) 1 2 3 4 5 6 7 8 9 -- Events :1,9sortyi-keymap-vim-0.19.0/tests/vimtests/sort/6.test0000644000000000000000000000034613755614221017553 0ustar0000000000000000-- Input (1,1) #pragma once #include #include #include namespace stuff { -- Output (6,1) #pragma once #include #include #include namespace stuff { -- Events jjVjj:sort yi-keymap-vim-0.19.0/tests/vimtests/sort/5.test0000644000000000000000000000012613755614221017546 0ustar0000000000000000-- Input (1,1) 1 2 3 5 4 6 7 8 9 -- Output (9,2) 1 2 3 4 5 6 7 8 9 -- Events :sortyi-keymap-vim-0.19.0/tests/vimtests/change/0000755000000000000000000000000013755614221016740 5ustar0000000000000000yi-keymap-vim-0.19.0/tests/vimtests/change/ciw.test0000644000000000000000000000023213755614221020420 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,3) foo ipsum dolor sit amet abc def ghi qwe rty uiop -- Events ciwfooyi-keymap-vim-0.19.0/tests/vimtests/change/s_eol.test0000644000000000000000000000023313755614221020740 0ustar0000000000000000-- Input (1,11) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,26) Lorem ipsum dolor sit amex abc def ghi qwe rty uiop -- Events $sxyi-keymap-vim-0.19.0/tests/vimtests/change/c3l.test0000644000000000000000000000023213755614221020317 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,11) xem ipsum xor sit amet abc def ghi qwe rty uiop -- Events c3lxww.yi-keymap-vim-0.19.0/tests/vimtests/change/S.test0000644000000000000000000000020413755614221020037 0ustar0000000000000000-- Input (1,11) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,3) man abc def ghi qwe rty uiop -- Events Smanyi-keymap-vim-0.19.0/tests/vimtests/change/cc.test0000644000000000000000000000020513755614221020223 0ustar0000000000000000-- Input (1,11) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,3) man abc def ghi qwe rty uiop -- Events ccmanyi-keymap-vim-0.19.0/tests/vimtests/change/V3jc.test0000644000000000000000000000015313755614221020445 0ustar0000000000000000-- Input (2,3) aaaaaa bbbbbb cccccc dddddd eeeeee ffffff -- Output (2,1) aaaaaa ffffff -- Events V3jcyi-keymap-vim-0.19.0/tests/vimtests/change/C_whole_line.test0000644000000000000000000000020313755614221022223 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,3) man abc def ghi qwe rty uiop -- Events Cmanyi-keymap-vim-0.19.0/tests/vimtests/change/C_part_of_line.test0000644000000000000000000000021413755614221022541 0ustar0000000000000000-- Input (1,9) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,11) Lorem ipman abc def ghi qwe rty uiop -- Events Cmanyi-keymap-vim-0.19.0/tests/vimtests/joinlines/0000755000000000000000000000000013755614221017505 5ustar0000000000000000yi-keymap-vim-0.19.0/tests/vimtests/joinlines/counted_2.test0000644000000000000000000000010313755614221022262 0ustar0000000000000000-- Input (1,2) aaa bbb ccc -- Output (1,8) aaa bbb ccc -- Events 3Jyi-keymap-vim-0.19.0/tests/vimtests/joinlines/1.test0000644000000000000000000000007213755614221020545 0ustar0000000000000000-- Input (1,3) aaa bbb -- Output (1,4) aaa bbb -- Events Jyi-keymap-vim-0.19.0/tests/vimtests/joinlines/counted_1.test0000644000000000000000000000007313755614221022267 0ustar0000000000000000-- Input (1,3) aaa bbb -- Output (1,4) aaa bbb -- Events 1Jyi-keymap-vim-0.19.0/tests/vimtests/joinlines/2.test0000644000000000000000000000007213755614221020546 0ustar0000000000000000-- Input (1,1) aaa bbb -- Output (1,4) aaa bbb -- Events Jyi-keymap-vim-0.19.0/tests/vimtests/blockvisual/0000755000000000000000000000000013755614221020031 5ustar0000000000000000yi-keymap-vim-0.19.0/tests/vimtests/blockvisual/d_3.test0000644000000000000000000000011113755614221021370 0ustar0000000000000000-- Input (2,1) foo bar -- Output (2,1) foo bar -- Events 3jdyi-keymap-vim-0.19.0/tests/vimtests/blockvisual/o_6.test0000644000000000000000000000022413755614221021413 0ustar0000000000000000-- Input (1,17) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,7) Lorem dolor sit amet abc de qwe rty uiop -- Events 10hjOhdyi-keymap-vim-0.19.0/tests/vimtests/blockvisual/block_P_3.test0000644000000000000000000000021213755614221022520 0ustar0000000000000000-- Input (4,1) 123456 123456 123456 foo bar baz -- Output (1,1) foo123456 bar123456 123456 foo bar baz -- Events jeykkkP yi-keymap-vim-0.19.0/tests/vimtests/blockvisual/9.test0000644000000000000000000000014113755614221021076 0ustar0000000000000000-- Input (1,1) abcd abcd abcd abcd -- Output (2,3) abcd abD abCD abCD -- Events jjjlllkkhgUxyi-keymap-vim-0.19.0/tests/vimtests/blockvisual/o_3.test0000644000000000000000000000013213755614221021406 0ustar0000000000000000-- Input (2,2) abcd abcd abcd abcd -- Output (3,3) abcd abcd abcd abcd -- Events jlooyi-keymap-vim-0.19.0/tests/vimtests/blockvisual/8.test0000644000000000000000000000013413755614221021077 0ustar0000000000000000-- Input (1,1) ABCD ABCD ABCD ABCD -- Output (2,2) ABCD AcD AbcD ABCD -- Events ljjlguxyi-keymap-vim-0.19.0/tests/vimtests/blockvisual/block_p_4.test0000644000000000000000000000014213755614221022563 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (1,1) foooo barar bazaz -- Events jjjeyjjjp yi-keymap-vim-0.19.0/tests/vimtests/blockvisual/capD_2.test0000644000000000000000000000015113755614221022017 0ustar0000000000000000-- Input (2,2) foo 44444444 bar baz xyzzy 123123 -- Output (2,1) foo 4 b b x 123123 -- Events 4jD yi-keymap-vim-0.19.0/tests/vimtests/blockvisual/block.test0000644000000000000000000000013213755614221022020 0ustar0000000000000000-- Input (1,1) ABCD ABCD ABCD ABCD -- Output (3,3) ABCD ABCD ABCD ABCD -- Events jljlyi-keymap-vim-0.19.0/tests/vimtests/blockvisual/d.test0000644000000000000000000000021413755614221021152 0ustar0000000000000000-- Input (1,17) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,7) Lorem sit amet abc de qwe rty uiop -- Events 10hjdyi-keymap-vim-0.19.0/tests/vimtests/blockvisual/block_P_4.test0000644000000000000000000000014513755614221022526 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (1,1) foofoo barbar bazbaz -- Events jjjeyjjjP yi-keymap-vim-0.19.0/tests/vimtests/blockvisual/r_3.test0000644000000000000000000000011313755614221021410 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (1,2) fxx bxx baz -- Events lljrxyi-keymap-vim-0.19.0/tests/vimtests/blockvisual/y_9.test0000644000000000000000000000014313755614221021430 0ustar0000000000000000-- Input (2,2) 1234 abcd ABCD XYZW -- Output (2,2) 1234 abcdbcd ABCD XYZW -- Events llllllllyPyi-keymap-vim-0.19.0/tests/vimtests/blockvisual/d_1.test0000644000000000000000000000012513755614221021373 0ustar0000000000000000-- Input (2,3) ABCD ABCD ABCD ABCD -- Output (2,2) ABCD AD AD ABCD -- Events jhdyi-keymap-vim-0.19.0/tests/vimtests/blockvisual/o_5.test0000644000000000000000000000020713755614221021413 0ustar0000000000000000-- Input (1,17) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,2) Ldolor sit amet a qwe rty uiop -- Events j2|Odyi-keymap-vim-0.19.0/tests/vimtests/blockvisual/y_4.test0000644000000000000000000000014013755614221021420 0ustar0000000000000000-- Input (1,1) 1234 abcd ABCD XYZW -- Output (2,3) 1234 abbccd ABBCCD XYZW -- Events ljljypyi-keymap-vim-0.19.0/tests/vimtests/blockvisual/capI.test0000644000000000000000000000012413755614221021603 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (1,3) fo-o ba-r ba-z -- Events lljjI-yi-keymap-vim-0.19.0/tests/vimtests/blockvisual/y_10.test0000644000000000000000000000013513755614221021501 0ustar0000000000000000-- Input (2,2) 1234 abcd ABCD XYZW -- Output (2,2) 1234 abcdbcd ABCD XYZW -- Events llyPyi-keymap-vim-0.19.0/tests/vimtests/blockvisual/commentblock_1.test0000644000000000000000000000017313755614221023630 0ustar0000000000000000-- Input (1,3) foo bar baz xyzzy abc 123 -- Output (1,3) @foo bar @baz xyzzy @abc 12@3 -- Events 3jI@yi-keymap-vim-0.19.0/tests/vimtests/blockvisual/capU_2.test0000644000000000000000000000011213755614221022035 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (1,1) FOo BAr BAz -- Events ljjUyi-keymap-vim-0.19.0/tests/vimtests/blockvisual/r_1.test0000644000000000000000000000016213755614221021412 0ustar0000000000000000-- Input (1,3) foo bar baz xyzzy abc 123 -- Output (1,3) xoo bar xaz xyzzy xbc 12x -- Events 3jrxyi-keymap-vim-0.19.0/tests/vimtests/blockvisual/y_11.test0000644000000000000000000000016613755614221021506 0ustar0000000000000000-- Input (2,2) abcdef abcdef abcdef abcdef -- Output (2,2) abcdef a bcdef a bcdef a bcdef -- Events jj> yi-keymap-vim-0.19.0/tests/vimtests/blockvisual/d_2.test0000644000000000000000000000020613755614221021374 0ustar0000000000000000-- Input (2,1) 444 foo bar baz xyzzy abc 123 555 -- Output (2,1) 444 foo bar baz xyzzy abc 123 555 -- Events 3jldyi-keymap-vim-0.19.0/tests/vimtests/blockvisual/u_2.test0000644000000000000000000000011213755614221021411 0ustar0000000000000000-- Input (1,1) FOO BAR BAZ -- Output (1,1) foO baR baZ -- Events ljjuyi-keymap-vim-0.19.0/tests/vimtests/blockvisual/y_15.test0000644000000000000000000000020413755614221021503 0ustar0000000000000000-- Input (2,2) abcdef a bcdef a bcdef a bcdef -- Output (2,2) abcdef a bcdef a bcdef a bcdef -- Events jjyi-keymap-vim-0.19.0/tests/vimtests/blockvisual/y_8.test0000644000000000000000000000013613755614221021431 0ustar0000000000000000-- Input (1,1) 1234 abcd ABCD XYZW -- Output (1,5) 12344 abcdd ABCDD XYZW -- Events $jjypyi-keymap-vim-0.19.0/tests/vimtests/blockvisual/d_4.test0000644000000000000000000000013213755614221021374 0ustar0000000000000000-- Input (1,6) xyzzy123 foo barbaz90 -- Output (1,6) xyzzy3 foo barba0 -- Events jjldyi-keymap-vim-0.19.0/tests/vimtests/blockvisual/commentblock_2.test0000644000000000000000000000023413755614221023627 0ustar0000000000000000-- Input (2,3) 444 foo bar baz xyzzy abc 123 555 -- Output (2,5) 444 // foo bar // baz xyzzy // abc 123 555 -- Events 3jI// yi-keymap-vim-0.19.0/tests/vimtests/blockvisual/switchcase_2.test0000644000000000000000000000010113755614221023300 0ustar0000000000000000-- Input (1,1) foo bar -- Output (1,1) FOo BAr -- Events jl~yi-keymap-vim-0.19.0/tests/vimtests/blockvisual/block_d_2.test0000644000000000000000000000012213755614221022543 0ustar0000000000000000-- Input (1,4) ABCD ABCD ABCD ABCD -- Output (1,1) A A A ABCD -- Events 2jhhdyi-keymap-vim-0.19.0/tests/vimtests/blockvisual/y_7.test0000644000000000000000000000014013755614221021423 0ustar0000000000000000-- Input (1,1) 1234 abcd ABCD XYZW -- Output (2,2) 1234 abcbcd ABCBCD XYZW -- Events ljljyPyi-keymap-vim-0.19.0/tests/vimtests/blockvisual/r_2.test0000644000000000000000000000010713755614221021412 0ustar0000000000000000-- Input (1,1) 1234 1234 -- Output (1,2) 1xx4 1xx4 -- Events lljrxyi-keymap-vim-0.19.0/tests/vimtests/blockvisual/o_1.test0000644000000000000000000000013113755614221021403 0ustar0000000000000000-- Input (2,2) abcd abcd abcd abcd -- Output (2,2) abcd abcd abcd abcd -- Events jloyi-keymap-vim-0.19.0/tests/vimtests/blockvisual/block_p_1.test0000644000000000000000000000013213755614221022557 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (1,1) foooo fooar fooaz -- Events ywjjjp yi-keymap-vim-0.19.0/tests/vimtests/blockvisual/commentblock.test0000644000000000000000000000023413755614221023406 0ustar0000000000000000-- Input (2,3) 444 foo bar baz xyzzy abc 123 555 -- Output (2,5) 444 // foo bar // baz xyzzy // abc 123 555 -- Events 3jI// yi-keymap-vim-0.19.0/tests/vimtests/blockvisual/block_d.test0000644000000000000000000000012713755614221022327 0ustar0000000000000000-- Input (1,1) ABCD ABCD ABCD ABCD -- Output (2,2) ABCD AD AD ABCD -- Events jljldyi-keymap-vim-0.19.0/tests/vimtests/blockvisual/r_4.test0000644000000000000000000000011213755614221021410 0ustar0000000000000000-- Input (1,1) 1234 1234 -- Output (1,2) 1xx4 1xx4 -- Events lljjrxyi-keymap-vim-0.19.0/tests/vimtests/blockvisual/y_14.test0000644000000000000000000000017013755614221021504 0ustar0000000000000000-- Input (2,2) abcdef a bcdef a bcdef a bcdef -- Output (2,2) abcdef abcdef abcdef abcdef -- Events jjyi-keymap-vim-0.19.0/tests/vimtests/blockvisual/block_p_2.test0000644000000000000000000000021313755614221022560 0ustar0000000000000000-- Input (4,1) 123456 123456 123456 foo bar baz -- Output (1,1) foo23456 bar23456 23456 bazoo bar baz -- Events jjjeykkkp yi-keymap-vim-0.19.0/tests/vimtests/blockvisual/y_13.test0000644000000000000000000000017113755614221021504 0ustar0000000000000000-- Input (2,2) abcdef a bcdef a bcdef abcdef -- Output (2,2) abcdef a bcdef a bcdef a bcdef -- Events jj>yi-keymap-vim-0.19.0/tests/vimtests/blockvisual/block_P_2.test0000644000000000000000000000021713755614221022524 0ustar0000000000000000-- Input (4,1) 123456 123456 123456 foo bar baz -- Output (1,1) foo123456 bar123456 123456 bazfoo bar baz -- Events jjjeykkkP yi-keymap-vim-0.19.0/tests/vimtests/blockvisual/c.test0000644000000000000000000000013213755614221021150 0ustar0000000000000000-- Input (1,2) foo bar baz -- Output (1,4) f123o b123r b123z -- Events jjjc123yi-keymap-vim-0.19.0/tests/vimtests/blockvisual/capD_1.test0000644000000000000000000000007513755614221022023 0ustar0000000000000000-- Input (1,1) foo bar -- Output (1,1) f b -- Events ljDyi-keymap-vim-0.19.0/tests/vimtests/blockvisual/paste_block.test0000644000000000000000000000016413755614221023221 0ustar0000000000000000-- Input (1,1) 123 foo 456 bar 789 baz -- Output (1,1) 123 123 456 456 789 789 -- Events jjllygg0wjjllpgg0yi-keymap-vim-0.19.0/tests/vimtests/blockvisual/block_d_1.test0000644000000000000000000000012713755614221022547 0ustar0000000000000000-- Input (1,4) ABCD ABCD ABCD ABCD -- Output (2,2) ABCD AD AD ABCD -- Events hjjhdyi-keymap-vim-0.19.0/tests/vimtests/blockvisual/y_3.test0000644000000000000000000000007713755614221021430 0ustar0000000000000000-- Input (1,1) 12 12 -- Output (1,2) 112 112 -- Events jypyi-keymap-vim-0.19.0/tests/vimtests/blockvisual/o_4.test0000644000000000000000000000013113755614221021406 0ustar0000000000000000-- Input (2,2) abcd abcd abcd abcd -- Output (3,2) abcd abcd abcd abcd -- Events jlOyi-keymap-vim-0.19.0/tests/vimtests/blockvisual/0.test0000644000000000000000000000011313755614221021064 0ustar0000000000000000-- Input (1,1) 1234 1234 1234 -- Output (1,2) 14 14 14 -- Events lljjdyi-keymap-vim-0.19.0/tests/vimtests/blockvisual/hl.test0000644000000000000000000000023313755614221021333 0ustar0000000000000000-- Input (1,17) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,7) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events 10hjyi-keymap-vim-0.19.0/tests/vimtests/blockvisual/y_12.test0000644000000000000000000000017213755614221021504 0ustar0000000000000000-- Input (2,2) abcdef abcdef abcdef abcdef -- Output (3,3) abcdef abcdef abbcdcdef abbcdcdef bcd -- Events lljjyjp yi-keymap-vim-0.19.0/tests/vimtests/blockvisual/o_2.test0000644000000000000000000000013213755614221021405 0ustar0000000000000000-- Input (2,2) abcd abcd abcd abcd -- Output (2,3) abcd abcd abcd abcd -- Events jloOyi-keymap-vim-0.19.0/tests/vimtests/blockvisual/block_p_3.test0000644000000000000000000000020613755614221022563 0ustar0000000000000000-- Input (4,1) 123456 123456 123456 foo bar baz -- Output (1,1) foo23456 bar23456 23456 oo bar baz -- Events jeykkkp yi-keymap-vim-0.19.0/tests/vimtests/blockvisual/block_P_1.test0000644000000000000000000000013513755614221022522 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (1,1) foofoo foobar foobaz -- Events ywjjjP yi-keymap-vim-0.19.0/tests/vimtests/unicode/0000755000000000000000000000000013755614221017141 5ustar0000000000000000yi-keymap-vim-0.19.0/tests/vimtests/unicode/russian.test0000644000000000000000000000016313755614221021526 0ustar0000000000000000-- Input (1,1) -- Output (1,16) Спасибопожалусто -- Events iСпасибопожалусто yi-keymap-vim-0.19.0/tests/vimtests/unicode/chinese-simp.test0000644000000000000000000000011213755614221022420 0ustar0000000000000000-- Input (1,1) -- Output (1,4) 中文测试 -- Events i中文测试 yi-keymap-vim-0.19.0/tests/vimtests/unicode/chinese-trad.test0000644000000000000000000000011213755614221022402 0ustar0000000000000000-- Input (1,1) -- Output (1,4) 中文測試 -- Events i中文測試 yi-keymap-vim-0.19.0/tests/vimtests/replace/0000755000000000000000000000000013755614221017126 5ustar0000000000000000yi-keymap-vim-0.19.0/tests/vimtests/replace/9.test0000644000000000000000000000022713755614221020200 0ustar0000000000000000-- Input (1,2) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,2) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events ryi-keymap-vim-0.19.0/tests/vimtests/replace/1.test0000644000000000000000000000011113755614221020160 0ustar0000000000000000-- Input (1,1) foobarbaz -- Output (1,7) foo123baz -- Events 3lR123lyi-keymap-vim-0.19.0/tests/vimtests/replace/8.test0000644000000000000000000000012213755614221020171 0ustar0000000000000000-- Input (1,1) foobarbaz -- Output (1,12) foo123456789 -- Events 3lR123456789yi-keymap-vim-0.19.0/tests/vimtests/replace/2.test0000644000000000000000000000010213755614221020161 0ustar0000000000000000-- Input (1,1) foobarbaz -- Output (1,6) fooxxxbaz -- Events 3l3rxyi-keymap-vim-0.19.0/tests/vimtests/replace/12.test0000644000000000000000000000012713755614221020251 0ustar0000000000000000-- Input (1,1) foobarbaz -- Output (1,13) foo123456789< -- Events 3lR123456789yi-keymap-vim-0.19.0/tests/vimtests/replace/7.test0000644000000000000000000000023013755614221020170 0ustar0000000000000000-- Input (2,2) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,6) Lorem ipsum dolor sit amet aorem f ghi qwe rty uiop -- Events 5ryi-keymap-vim-0.19.0/tests/vimtests/replace/3.test0000644000000000000000000000010513755614221020165 0ustar0000000000000000-- Input (2,2) foo bar baz -- Output (2,3) foo bxx baz -- Events 5rx yi-keymap-vim-0.19.0/tests/vimtests/replace/4.test0000644000000000000000000000022713755614221020173 0ustar0000000000000000-- Input (2,2) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,2) Lorem ipsum dolor sit amet awc def ghi qwe rty uiop -- Events ryi-keymap-vim-0.19.0/tests/vimtests/replace/11.test0000644000000000000000000000017513755614221020253 0ustar0000000000000000-- Input (2,1) Lorem ipsum dolor sit amet qwe rty uiop -- Output (2,1) Lorem ipsum dolor sit amet qwe rty uiop -- Events rxyi-keymap-vim-0.19.0/tests/vimtests/replace/6.test0000644000000000000000000000023013755614221020167 0ustar0000000000000000-- Input (2,2) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,5) Lorem ipsum dolor sit amet awe ref ghi qwe rty uiop -- Events 4ryi-keymap-vim-0.19.0/tests/vimtests/replace/5.test0000644000000000000000000000022713755614221020174 0ustar0000000000000000-- Input (2,2) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,2) Lorem ipsum dolor sit amet aoc def ghi qwe rty uiop -- Events ryi-keymap-vim-0.19.0/tests/vimtests/replace/0.test0000644000000000000000000000010313755614221020160 0ustar0000000000000000-- Input (1,1) foobarbaz -- Output (1,6) fooiarbaz -- Events 3lrillyi-keymap-vim-0.19.0/tests/vimtests/replace/10.test0000644000000000000000000000022713755614221020250 0ustar0000000000000000-- Input (3,2) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (3,2) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events ryi-keymap-vim-0.19.0/tests/vimtests/searchword/0000755000000000000000000000000013755614221017654 5ustar0000000000000000yi-keymap-vim-0.19.0/tests/vimtests/searchword/repeat_star.test0000644000000000000000000000032413755614221023065 0ustar0000000000000000-- Input (1,1) lorem ipsum lorem2 dolor sit amet dolor sit amet lorem ipsum lorem-lorem ipsumipsum -- Output (3,7) lorem ipsum lorem2 dolor sit amet dolor sit amet lorem ipsum lorem-lorem ipsumipsum -- Events *nnyi-keymap-vim-0.19.0/tests/vimtests/searchword/star.test0000644000000000000000000000032313755614221021524 0ustar0000000000000000-- Input (1,1) lorem ipsum lorem2 dolor sit amet dolor sit amet lorem ipsum lorem-lorem ipsumipsum -- Output (2,16) lorem ipsum lorem2 dolor sit amet dolor sit amet lorem ipsum lorem-lorem ipsumipsum -- Events *yi-keymap-vim-0.19.0/tests/vimtests/searchword/g_repeat_pound_1.test0000644000000000000000000000032413755614221023767 0ustar0000000000000000-- Input (1,1) lorem ipsum lorem2 dolor sit amet dolor sit amet lorem ipsum lorem-lorem ipsumipsum -- Output (3,1) lorem ipsum lorem2 dolor sit amet dolor sit amet lorem ipsum lorem-lorem ipsumipsum -- Events g#nyi-keymap-vim-0.19.0/tests/vimtests/searchword/repeat_pound.test0000644000000000000000000000032513755614221023242 0ustar0000000000000000-- Input (1,1) lorem ipsum lorem2 dolor sit amet dolor sit amet lorem ipsum lorem-lorem ipsumipsum -- Output (2,16) lorem ipsum lorem2 dolor sit amet dolor sit amet lorem ipsum lorem-lorem ipsumipsum -- Events #nnyi-keymap-vim-0.19.0/tests/vimtests/searchword/star_2.test0000644000000000000000000000032513755614221021747 0ustar0000000000000000-- Input (1,2) (lorem ipsum lorem2 dolor sit amet dolor sit amet lorem ipsum lorem-lorem ipsumipsum -- Output (2,16) (lorem ipsum lorem2 dolor sit amet dolor sit amet lorem ipsum lorem-lorem ipsumipsum -- Events *yi-keymap-vim-0.19.0/tests/vimtests/searchword/g_repeat_star.test0000644000000000000000000000032513755614221023374 0ustar0000000000000000-- Input (1,1) lorem ipsum lorem2 dolor sit amet dolor sit amet lorem ipsum lorem-lorem ipsumipsum -- Output (3,1) lorem ipsum lorem2 dolor sit amet dolor sit amet lorem ipsum lorem-lorem ipsumipsum -- Events g*nnyi-keymap-vim-0.19.0/tests/vimtests/searchword/g_pound.test0000644000000000000000000000032313755614221022206 0ustar0000000000000000-- Input (1,1) lorem ipsum lorem2 dolor sit amet dolor sit amet lorem ipsum lorem-lorem ipsumipsum -- Output (3,7) lorem ipsum lorem2 dolor sit amet dolor sit amet lorem ipsum lorem-lorem ipsumipsum -- Events g#yi-keymap-vim-0.19.0/tests/vimtests/searchword/g_repeat_pound.test0000644000000000000000000000032713755614221023552 0ustar0000000000000000-- Input (1,1) lorem ipsum lorem2 dolor sit amet dolor sit amet lorem ipsum lorem-lorem ipsumipsum -- Output (1,13) lorem ipsum lorem2 dolor sit amet dolor sit amet lorem ipsum lorem-lorem ipsumipsum -- Events g#nnnyi-keymap-vim-0.19.0/tests/vimtests/searchword/pound.test0000644000000000000000000000032213755614221021677 0ustar0000000000000000-- Input (1,1) lorem ipsum lorem2 dolor sit amet dolor sit amet lorem ipsum lorem-lorem ipsumipsum -- Output (3,7) lorem ipsum lorem2 dolor sit amet dolor sit amet lorem ipsum lorem-lorem ipsumipsum -- Events #yi-keymap-vim-0.19.0/tests/vimtests/searchword/g_star.test0000644000000000000000000000032413755614221022033 0ustar0000000000000000-- Input (1,1) lorem ipsum lorem2 dolor sit amet dolor sit amet lorem ipsum lorem-lorem ipsumipsum -- Output (1,13) lorem ipsum lorem2 dolor sit amet dolor sit amet lorem ipsum lorem-lorem ipsumipsum -- Events g*yi-keymap-vim-0.19.0/tests/vimtests/ex/0000755000000000000000000000000013755614221016127 5ustar0000000000000000yi-keymap-vim-0.19.0/tests/vimtests/ex/fail.test0000644000000000000000000000011713755614221017742 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (2,2) foo bar baz -- Events ll:blahhj yi-keymap-vim-0.19.0/tests/vimtests/ex/empty.test0000644000000000000000000000007213755614221020165 0ustar0000000000000000-- Input (1,1) -- Output (1,1) -- Events :::yi-keymap-vim-0.19.0/tests/vimtests/ex/esc.test0000644000000000000000000000011413755614221017576 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (2,2) foo bar baz -- Events ll:hj yi-keymap-vim-0.19.0/tests/vimtests/ex/esc_1.test0000644000000000000000000000012013755614221020013 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (2,2) foo bar baz -- Events ll:blahhj yi-keymap-vim-0.19.0/tests/vimtests/marks/0000755000000000000000000000000013755614221016630 5ustar0000000000000000yi-keymap-vim-0.19.0/tests/vimtests/marks/unjump_quote.test0000644000000000000000000000045013755614221022263 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet -- Output (2,5) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet -- Events ww**'' yi-keymap-vim-0.19.0/tests/vimtests/marks/unjump_quote_blank.test0000644000000000000000000000041513755614221023433 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet -- Output (2,16) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet -- Events wwjG'' yi-keymap-vim-0.19.0/tests/vimtests/marks/unjump_backquote.test0000644000000000000000000000040713755614221023106 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet -- Output (2,7) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet -- Events w**`` yi-keymap-vim-0.19.0/tests/vimtests/indent/0000755000000000000000000000000013755614221016774 5ustar0000000000000000yi-keymap-vim-0.19.0/tests/vimtests/indent/1.test0000644000000000000000000000012513755614221020033 0ustar0000000000000000-- Input (1,1) foo bar baz 123 -- Output (2,5) foo bar baz 123 -- Events j>j yi-keymap-vim-0.19.0/tests/vimtests/indent/8.test0000644000000000000000000000020313755614221020037 0ustar0000000000000000-- Input (1,1) foo bar baz 123 -- Output (1,5) foo bar baz 123 -- Events 4jyi-keymap-vim-0.19.0/tests/vimtests/indent/setpaste.test0000644000000000000000000000022013755614221021517 0ustar0000000000000000-- Input (1,7) foo bar baz -- Output (3,3) foo quux 123 bar baz -- Events aquux:set pastea123 yi-keymap-vim-0.19.0/tests/vimtests/indent/2.test0000644000000000000000000000012113755614221020030 0ustar0000000000000000-- Input (1,1) foo bar baz 123 -- Output (2,5) foo bar baz 123 -- Events j>> yi-keymap-vim-0.19.0/tests/vimtests/indent/7.test0000644000000000000000000000020013755614221020033 0ustar0000000000000000-- Input (1,1) foo bar baz 123 -- Output (1,9) foo bar baz 123 -- Events 5>>yi-keymap-vim-0.19.0/tests/vimtests/indent/3.test0000644000000000000000000000012613755614221020036 0ustar0000000000000000-- Input (1,1) foo bar baz 123 -- Output (2,5) foo bar baz 123 -- Events j2>> yi-keymap-vim-0.19.0/tests/vimtests/indent/4.test0000644000000000000000000000012513755614221020036 0ustar0000000000000000-- Input (2,5) foo bar baz 123 -- Output (2,1) foo bar baz 123 -- Events yi-keymap-vim-0.19.0/tests/vimtests/indent/6.test0000644000000000000000000000013713755614221020043 0ustar0000000000000000-- Input (2,6) foo bar baz 123 -- Output (2,1) foo bar baz 123 -- Events Vjyi-keymap-vim-0.19.0/tests/vimtests/indent/5.test0000644000000000000000000000014213755614221020036 0ustar0000000000000000-- Input (2,5) foo bar baz 123 -- Output (2,1) foo bar baz 123 -- Events 2yi-keymap-vim-0.19.0/tests/vimtests/empty/0000755000000000000000000000000013755614221016651 5ustar0000000000000000yi-keymap-vim-0.19.0/tests/vimtests/empty/empty.test0000644000000000000000000000006113755614221020705 0ustar0000000000000000-- Input (1,1) -- Output (1,1) -- Events yi-keymap-vim-0.19.0/tests/vimtests/find/0000755000000000000000000000000013755614221016433 5ustar0000000000000000yi-keymap-vim-0.19.0/tests/vimtests/find/t6.test0000644000000000000000000000022613755614221017665 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,13) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events to2;yi-keymap-vim-0.19.0/tests/vimtests/find/f6.test0000644000000000000000000000016413755614221017650 0ustar0000000000000000-- Input (1,1) Foo ii Bar abc def ghi qwe rty uiop -- Output (1,6) Foo ii Bar abc def ghi qwe rty uiop -- Events 2fiyi-keymap-vim-0.19.0/tests/vimtests/find/f.test0000644000000000000000000000022313755614221017556 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,7) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events fiyi-keymap-vim-0.19.0/tests/vimtests/find/t3.test0000644000000000000000000000022513755614221017661 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,7) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events fi;,yi-keymap-vim-0.19.0/tests/vimtests/find/f5.test0000644000000000000000000000022713755614221017647 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor syi-keymap-vim-0.19.0/tests/vimtests/find/t2.test0000644000000000000000000000022613755614221017661 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,19) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events til;yi-keymap-vim-0.19.0/tests/vimtests/find/f4.test0000644000000000000000000000022313755614221017642 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events fhyi-keymap-vim-0.19.0/tests/vimtests/find/f3.test0000644000000000000000000000022513755614221017643 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,7) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events fi;,yi-keymap-vim-0.19.0/tests/vimtests/find/f2.test0000644000000000000000000000022513755614221017642 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,20) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events fi;yi-keymap-vim-0.19.0/tests/vimtests/find/t5.test0000644000000000000000000000022413755614221017662 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,6) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events ti;yi-keymap-vim-0.19.0/tests/vimtests/find/t4.test0000644000000000000000000000022313755614221017660 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events thyi-keymap-vim-0.19.0/tests/vimtests/find/f1.test0000644000000000000000000000022513755614221017641 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,20) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events 2fiyi-keymap-vim-0.19.0/tests/vimtests/find/t.test0000644000000000000000000000022313755614221017574 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,6) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events tiyi-keymap-vim-0.19.0/tests/vimtests/find/t1.test0000644000000000000000000000022513755614221017657 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,19) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events 2tiyi-keymap-vim-0.19.0/tests/vimtests/find/t7.test0000644000000000000000000000016413755614221017667 0ustar0000000000000000-- Input (1,1) Foo ii bar abc def ghi qwe rty uiop -- Output (1,5) Foo ii bar abc def ghi qwe rty uiop -- Events 2tiyi-keymap-vim-0.19.0/tests/vimtests/digraphs/0000755000000000000000000000000013755614221017314 5ustar0000000000000000yi-keymap-vim-0.19.0/tests/vimtests/digraphs/ae.test0000644000000000000000000000010413755614221020575 0ustar0000000000000000-- Input (1,5) abcdf -- Output (1,5) abcdæf -- Events iaeyi-keymap-vim-0.19.0/tests/vimtests/digraphs/eacute.test0000644000000000000000000000010413755614221021456 0ustar0000000000000000-- Input (1,5) abcdf -- Output (1,5) abcdéf -- Events i'eyi-keymap-vim-0.19.0/tests/vimtests/visual/0000755000000000000000000000000013755614221017016 5ustar0000000000000000yi-keymap-vim-0.19.0/tests/vimtests/visual/paste_word.test0000644000000000000000000000010513755614221022062 0ustar0000000000000000-- Input (1,2) foo bar -- Output (1,1) foo foo -- Events viwywviwp0yi-keymap-vim-0.19.0/tests/vimtests/visual/y_1.test0000644000000000000000000000010513755614221020403 0ustar0000000000000000-- Input (1,1) foo bar -- Output (1,3) fooo baro bar -- Events lvjlypyi-keymap-vim-0.19.0/tests/vimtests/visual/I_0.test0000644000000000000000000000011313755614221020321 0ustar0000000000000000-- Input (1,1) abc def -- Output (1,3) 123abc 123def -- Events VjI123 yi-keymap-vim-0.19.0/tests/vimtests/visual/indent_11.test0000644000000000000000000000021713755614221021501 0ustar0000000000000000-- Input (1,1) def main(): foo() bar() baz() quux() -- Output (3,5) def main(): foo() bar() baz() quux() -- Events jjV}}>yi-keymap-vim-0.19.0/tests/vimtests/visual/indent_9.test0000644000000000000000000000011013755614221021420 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (1,1) foo bar baz -- Events V>Vyi-keymap-vim-0.19.0/tests/vimtests/visual/viw.test0000644000000000000000000000010213755614221020515 0ustar0000000000000000-- Input (1,6) 123 456 789 -- Output (1,5) 123 789 -- Events viwxyi-keymap-vim-0.19.0/tests/vimtests/visual/m_0.test0000644000000000000000000000010313755614221020364 0ustar0000000000000000-- Input (1,1) foo bar -- Output (2,2) foo br -- Events vljmavgg`axyi-keymap-vim-0.19.0/tests/vimtests/visual/gq_0.test0000644000000000000000000000010413755614221020540 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (1,1) foo bar baz -- Events Vgqyi-keymap-vim-0.19.0/tests/vimtests/visual/u_0.test0000644000000000000000000000006613755614221020404 0ustar0000000000000000-- Input (1,1) TEST -- Output (1,1) test -- Events Vguyi-keymap-vim-0.19.0/tests/vimtests/visual/14.test0000644000000000000000000000010013755614221020132 0ustar0000000000000000-- Input (1,1) ab1 cd2 -- Output (1,1) b1 cd2 -- Events jVlkgux yi-keymap-vim-0.19.0/tests/vimtests/visual/1.test0000644000000000000000000000010013755614221020046 0ustar0000000000000000-- Input (1,1) 12345678 -- Output (1,2) 1345678 -- Events lv3lyxyi-keymap-vim-0.19.0/tests/vimtests/visual/CSs.test0000644000000000000000000000203413755614221020406 0ustar0000000000000000-- Input (1,1) 0; nil 20; binil 40; quadnil 1; un 21; biun 41; quadun 2; bi 22; bibi 42; quadbi 3; tri 23; bitri 43; quadtri 4; quad 24; biquad 44; quadquad 5; pent 25; bipent 45; quadpent 6; hex 26; bihex 46; quadhex 7; sept 27; bisept 47; quadsept 8; oct 28; bioct 48; quadoct 9; enn 29; bienn 49; quadenn X; dec 2X; bidec 4X; quaddec E; lev 2E; bilev 4E; quadlev -- Output (11,7) 0; nil 20; binil 40; quadnil 1; un 21; biun 41; quadun 2; two 22; bibi 42; quadbi 3; tri 23; bitri 43; quadtri 4; quad 24; biquad 44; quadquad 5; pent 25; bipent 45; quadpent 6; six 26; bihex 46; quadhex 7; sept 27; bisept 47; quadsept 8; oct 28; bioct 48; quadoct 9; nine 29; bienn 49; quadenn X; ten 2X; bidec 4X; quaddec E; lev 2E; bilev 4E; quadlev -- Events 2j3lv3lstwo 4j03lvelcsix 3j03lv4lCnine j03lvelSten yi-keymap-vim-0.19.0/tests/vimtests/visual/indent_6.test0000644000000000000000000000012113755614221021417 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (1,5) foo bar baz -- Events V2j>yi-keymap-vim-0.19.0/tests/vimtests/visual/capU_0.test0000644000000000000000000000007513755614221021030 0ustar0000000000000000-- Input (1,1) foo bar -- Output (1,1) FOO Bar -- Events vwgUyi-keymap-vim-0.19.0/tests/vimtests/visual/13.test0000644000000000000000000000010513755614221020136 0ustar0000000000000000-- Input (1,1) 12345678 -- Output (1,1) 2345678 -- Events yv3lyxyi-keymap-vim-0.19.0/tests/vimtests/visual/capD_2.test0000644000000000000000000000007113755614221021005 0ustar0000000000000000-- Input (1,1) foo bar -- Output (1,1) bar -- Events VjkDyi-keymap-vim-0.19.0/tests/vimtests/visual/indent_8.test0000644000000000000000000000011013755614221021417 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (1,1) foo bar baz -- Events Vyi-keymap-vim-0.19.0/tests/vimtests/visual/v3iwx.test0000644000000000000000000000010113755614221020767 0ustar0000000000000000-- Input (1,1) 123 456 789 -- Output (1,1) 789 -- Events v3iwx yi-keymap-vim-0.19.0/tests/vimtests/visual/I_1.test0000644000000000000000000000011713755614221020326 0ustar0000000000000000-- Input (1,1) abc def -- Output (1,3) 123abc 123def -- Events jI123 yi-keymap-vim-0.19.0/tests/vimtests/visual/vlllx.test0000644000000000000000000000007013755614221021055 0ustar0000000000000000-- Input (1,1) foobar -- Output (1,1) ar -- Events vlllxyi-keymap-vim-0.19.0/tests/vimtests/visual/indent_13.test0000644000000000000000000000026713755614221021510 0ustar0000000000000000-- Input (1,1) def main(): foo() bar() baz() quux() -- Output (3,1) def main(): foo() bar() baz() quux() -- Events jj}} yi-keymap-vim-0.19.0/tests/vimtests/visual/paste_multiline.test0000644000000000000000000000013213755614221023111 0ustar0000000000000000-- Input (1,1) foo bar 123 baz -- Output (1,1) foo bar foo bar baz -- Events Vjy3ggVpgg0yi-keymap-vim-0.19.0/tests/vimtests/visual/d_1.test0000644000000000000000000000006413755614221020362 0ustar0000000000000000-- Input (1,1) foobar -- Output (1,1) -- Events v$dyi-keymap-vim-0.19.0/tests/vimtests/visual/capU_1.test0000644000000000000000000000010513755614221021023 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (1,1) FOO BAR BAZ -- Events VjjUyi-keymap-vim-0.19.0/tests/vimtests/visual/switchcase_1.test0000644000000000000000000000007113755614221022272 0ustar0000000000000000-- Input (1,1) FooBar -- Output (1,1) fOObAR -- Events V~yi-keymap-vim-0.19.0/tests/vimtests/visual/capY_0.test0000644000000000000000000000011013755614221021022 0ustar0000000000000000-- Input (1,1) foo foo bar -- Output (2,1) foo foo foo bar -- Events VYpyi-keymap-vim-0.19.0/tests/vimtests/visual/switchcase_0.test0000644000000000000000000000007413755614221022274 0ustar0000000000000000-- Input (1,1) foobar -- Output (1,2) fOOBar -- Events lv2l~yi-keymap-vim-0.19.0/tests/vimtests/visual/y_6.test0000644000000000000000000000010413755614221020407 0ustar0000000000000000-- Input (1,1) foo bar -- Output (1,4) fooo bar bar -- Events llvjypyi-keymap-vim-0.19.0/tests/vimtests/visual/A_1.test0000644000000000000000000000015713755614221020322 0ustar0000000000000000-- Input (1,1) averyverylongline shortline -- Output (1,18) averyverylonglineb shortlineb -- Events VjAbyi-keymap-vim-0.19.0/tests/vimtests/visual/indent_12.test0000644000000000000000000000022413755614221021500 0ustar0000000000000000-- Input (1,1) def main(): foo() bar() baz() quux() -- Output (3,1) def main(): foo() bar() baz() quux() -- Events jj}}> yi-keymap-vim-0.19.0/tests/vimtests/visual/r_1.test0000644000000000000000000000010013755614221020367 0ustar0000000000000000-- Input (1,1) foo bar -- Output (1,3) fox xxr -- Events jlvklrxyi-keymap-vim-0.19.0/tests/vimtests/visual/indent_1.test0000644000000000000000000000011513755614221021415 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (2,5) foo bar baz -- Events jVj>yi-keymap-vim-0.19.0/tests/vimtests/visual/d_2.test0000644000000000000000000000010213755614221020354 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (2,1) foo baz -- Events jVlldyi-keymap-vim-0.19.0/tests/vimtests/visual/A_0.test0000644000000000000000000000020313755614221020311 0ustar0000000000000000-- Input (1,1) averyverylongline shortline shorter -- Output (1,18) averyverylonglineb shortlineb shorterb -- Events jjVkkAbyi-keymap-vim-0.19.0/tests/vimtests/visual/gq_1.test0000644000000000000000000000010513755614221020542 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (1,1) foo bar baz -- Events Vjgqyi-keymap-vim-0.19.0/tests/vimtests/visual/2.test0000644000000000000000000000010113755614221020050 0ustar0000000000000000-- Input (1,1) 12345678 -- Output (1,4) 1235678 -- Events $hv3hyxyi-keymap-vim-0.19.0/tests/vimtests/visual/indent_7.test0000644000000000000000000000013113755614221021421 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (1,21) foo bar baz -- Events V5>yi-keymap-vim-0.19.0/tests/vimtests/visual/paste_word_2.test0000644000000000000000000000012013755614221022300 0ustar0000000000000000-- Input (1,2) foo bar baz -- Output (1,1) foo foo foo -- Events viwywviwpwviwp0yi-keymap-vim-0.19.0/tests/vimtests/visual/A_2.test0000644000000000000000000000016513755614221020322 0ustar0000000000000000-- Input (1,1) averyverylongline shortline -- Output (1,6) averybverylongline shortbline -- Events j4lAb yi-keymap-vim-0.19.0/tests/vimtests/visual/paste_line.test0000644000000000000000000000011013755614221022032 0ustar0000000000000000-- Input (1,1) foo bar -- Output (1,1) foo foo foo -- Events yyjVppgg0yi-keymap-vim-0.19.0/tests/vimtests/visual/d_0.test0000644000000000000000000000010213755614221020352 0ustar0000000000000000-- Input (1,1) foobarbaz -- Output (1,2) fbaz -- Events lvlkkjl2ldyi-keymap-vim-0.19.0/tests/vimtests/visual/y_5.test0000644000000000000000000000010413755614221020406 0ustar0000000000000000-- Input (1,1) foo bar -- Output (1,3) foo bar bar -- Events llvjypxyi-keymap-vim-0.19.0/tests/vimtests/visual/indent_3.test0000644000000000000000000000007013755614221021417 0ustar0000000000000000-- Input (1,1) foo -- Output (1,1) foo -- Events vlyi-keymap-vim-0.19.0/tests/vimtests/visual/r_0.test0000644000000000000000000000007213755614221020376 0ustar0000000000000000-- Input (1,1) foobar -- Output (1,1) aaaaaa -- Events Vrayi-keymap-vim-0.19.0/tests/vimtests/visual/12.test0000644000000000000000000000011113755614221020132 0ustar0000000000000000-- Input (1,1) 12345678 -- Output (1,5) 1234678 -- Events lv3lxv3ly yi-keymap-vim-0.19.0/tests/vimtests/visual/indent_0.test0000644000000000000000000000010413755614221021412 0ustar0000000000000000-- Input (1,1) foo bar -- Output (1,5) foo bar -- Events vj>yi-keymap-vim-0.19.0/tests/vimtests/visual/indent_2.test0000644000000000000000000000010213755614221021412 0ustar0000000000000000-- Input (1,1) foo -- Output (1,13) foo -- Events vl3>yi-keymap-vim-0.19.0/tests/vimtests/visual/r_2.test0000644000000000000000000000023013755614221020374 0ustar0000000000000000-- Input (1,7) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,7) Lorem XXXXXXXXXXXXXXXXXXXX XXXXXXX ghi qwe rty uiop -- Events vj^eerXyi-keymap-vim-0.19.0/tests/vimtests/visual/7.test0000644000000000000000000000007313755614221020065 0ustar0000000000000000-- Input (1,1) ab cd -- Output (1,1) b cd -- Events jVlkguxyi-keymap-vim-0.19.0/tests/vimtests/visual/m_1.test0000644000000000000000000000011013755614221020363 0ustar0000000000000000-- Input (1,1) 1 2 3 4 -- Output (2,1) 1 2 3 4 -- Events Vjmajjmb'ayi-keymap-vim-0.19.0/tests/vimtests/visual/u_1.test0000644000000000000000000000006713755614221020406 0ustar0000000000000000-- Input (1,1) TeSt -- Output (1,1) teSt -- Events vlguyi-keymap-vim-0.19.0/tests/vimtests/visual/15.test0000644000000000000000000000010213755614221020135 0ustar0000000000000000-- Input (1,1) foobarbaz -- Output (1,2) fbaz -- Events lvlkkjl2ldyi-keymap-vim-0.19.0/tests/vimtests/visual/A_3.test0000644000000000000000000000010513755614221020315 0ustar0000000000000000-- Input (1,1) 123 -- Output (1,7) 123text -- Events $Atextyi-keymap-vim-0.19.0/tests/vimtests/visual/3.test0000644000000000000000000000007513755614221020063 0ustar0000000000000000-- Input (1,1) aaa bbb -- Output (1,2) aA BBb -- Events lvj~xyi-keymap-vim-0.19.0/tests/vimtests/visual/indent_5.test0000644000000000000000000000011413755614221021420 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (1,5) foo bar baz -- Events Vj>yi-keymap-vim-0.19.0/tests/vimtests/visual/4.test0000644000000000000000000000007613755614221020065 0ustar0000000000000000-- Input (1,1) 123 456 -- Output (1,2) 13 456 -- Events jlvkyxyi-keymap-vim-0.19.0/tests/vimtests/visual/o_0.test0000644000000000000000000000007613755614221020377 0ustar0000000000000000-- Input (1,1) foobar -- Output (1,4) fooar -- Events lv2lo2ldyi-keymap-vim-0.19.0/tests/vimtests/visual/11.test0000644000000000000000000000010413755614221020133 0ustar0000000000000000-- Input (1,1) 12345678 -- Output (1,5) 1234678 -- Events lv3lxyi-keymap-vim-0.19.0/tests/vimtests/visual/6.test0000644000000000000000000000007113755614221020062 0ustar0000000000000000-- Input (1,1) 12 34 -- Output (1,1) 2 34 -- Events lVjyxyi-keymap-vim-0.19.0/tests/vimtests/visual/capD_1.test0000644000000000000000000000007713755614221021012 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (1,1) baz -- Events lVjlD yi-keymap-vim-0.19.0/tests/vimtests/visual/vx.test0000644000000000000000000000022213755614221020350 0ustar0000000000000000-- Input (2,2) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,2) Lorem ipsum dolor sit amet ac def ghi qwe rty uiop -- Events vxyi-keymap-vim-0.19.0/tests/vimtests/visual/capD_0.test0000644000000000000000000000007613755614221021010 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (1,1) baz -- Events lvjlDyi-keymap-vim-0.19.0/tests/vimtests/visual/y_0.test0000644000000000000000000000011113755614221020377 0ustar0000000000000000-- Input (1,1) foobar -- Output (3,1) foobar foobar foobar -- Events Vyppyi-keymap-vim-0.19.0/tests/vimtests/visual/y_2.test0000644000000000000000000000010713755614221020406 0ustar0000000000000000-- Input (1,1) foo bar -- Output (2,1) foo bar -- Events Vjlllypddxxxddyi-keymap-vim-0.19.0/tests/vimtests/visual/y_3.test0000644000000000000000000000011013755614221020401 0ustar0000000000000000-- Input (1,1) foo bar -- Output (2,1) foo foo bar bar -- Events Vjlllypyi-keymap-vim-0.19.0/tests/vimtests/visual/indent_4.test0000644000000000000000000000010713755614221021421 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (1,5) foo bar baz -- Events V>yi-keymap-vim-0.19.0/tests/vimtests/visual/Vd.test0000644000000000000000000000006713755614221020273 0ustar0000000000000000-- Input (1,1) foo bar -- Output (1,1) bar -- Events Vdyi-keymap-vim-0.19.0/tests/vimtests/visual/10.test0000644000000000000000000000010413755614221020132 0ustar0000000000000000-- Input (1,1) 12345678 -- Output (1,5) 1234678 -- Events lv3lxyi-keymap-vim-0.19.0/tests/vimtests/visual/indent_10.test0000644000000000000000000000015013755614221021474 0ustar0000000000000000-- Input (1,1) foo bar baz xyzzy -- Output (1,1) foo bar baz xyzzy -- Events V2jyi-keymap-vim-0.19.0/tests/vimtests/undo/0000755000000000000000000000000013755614221016460 5ustar0000000000000000yi-keymap-vim-0.19.0/tests/vimtests/undo/9.test0000644000000000000000000000013713755614221017532 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (2,3) foo bar baz -- Events jlA 123A 456uuuyi-keymap-vim-0.19.0/tests/vimtests/undo/1.test0000644000000000000000000000011413755614221017515 0ustar0000000000000000-- Input (2,2) foo bar baz -- Output (2,3) foo bar baz -- Events A 123uyi-keymap-vim-0.19.0/tests/vimtests/undo/8.test0000644000000000000000000000015413755614221017530 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (2,11) foo bar 123 456 baz -- Events jlA 123A 456uuyi-keymap-vim-0.19.0/tests/vimtests/undo/2.test0000644000000000000000000000012613755614221017521 0ustar0000000000000000-- Input (2,2) foo bar baz -- Output (2,7) foo bar 123 baz -- Events A 123u yi-keymap-vim-0.19.0/tests/vimtests/undo/7.test0000644000000000000000000000014213755614221017524 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (2,7) foo bar 123 baz -- Events jlA 123A 456uuyi-keymap-vim-0.19.0/tests/vimtests/undo/3.test0000644000000000000000000000010413755614221017516 0ustar0000000000000000-- Input (2,2) foo bar baz -- Output (2,2) foo bar baz -- Events xu yi-keymap-vim-0.19.0/tests/vimtests/undo/4.test0000644000000000000000000000011213755614221017516 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (2,2) foo br baz -- Events jlxu yi-keymap-vim-0.19.0/tests/vimtests/undo/6.test0000644000000000000000000000013113755614221017521 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (2,3) foo bar baz -- Events jlA 123A 456uuyi-keymap-vim-0.19.0/tests/vimtests/undo/5.test0000644000000000000000000000013413755614221017523 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (2,7) foo bar 123 baz -- Events jlA 123A 456uyi-keymap-vim-0.19.0/tests/vimtests/undo/cw.test0000644000000000000000000000011513755614221017767 0ustar0000000000000000-- Input (2,1) foo bar baz -- Output (2,1) foo bar baz -- Events cwohaiuyi-keymap-vim-0.19.0/tests/vimtests/unsorted/0000755000000000000000000000000013755614221017356 5ustar0000000000000000yi-keymap-vim-0.19.0/tests/vimtests/unsorted/2yy.test0000644000000000000000000000022413755614221021000 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events 2yyyi-keymap-vim-0.19.0/tests/vimtests/unsorted/v3lcABC.test0000644000000000000000000000011513755614221021431 0ustar0000000000000000-- Input (1,1) Lorem ipsum -- Output (1,8) ABCm ABCm -- Events v3lcABCw.yi-keymap-vim-0.19.0/tests/vimtests/paste/0000755000000000000000000000000013755614221016627 5ustar0000000000000000yi-keymap-vim-0.19.0/tests/vimtests/paste/visual.test0000644000000000000000000000024413755614221021033 0ustar0000000000000000-- Input (2,2) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,3) Lorem ipsum dolor sit amet abbc def ghi qwec def ghi qwe rty uiop -- Events vjlypyi-keymap-vim-0.19.0/tests/vimtests/paste/y_1.test0000644000000000000000000000011513755614221020215 0ustar0000000000000000-- Input (2,2) 1234 abcd xyzw -- Output (2,4) 1234 abcdbcd xyzw -- Events y$Pyi-keymap-vim-0.19.0/tests/vimtests/paste/dwp.test0000644000000000000000000000022413755614221020320 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,7) iLorem psum dolor sit amet abc def ghi qwe rty uiop -- Events dwpyi-keymap-vim-0.19.0/tests/vimtests/paste/ddp.test0000644000000000000000000000022413755614221020275 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,1) abc def ghi Lorem ipsum dolor sit amet qwe rty uiop -- Events ddpyi-keymap-vim-0.19.0/tests/vimtests/paste/ywp.test0000644000000000000000000000023213755614221020344 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,7) LLorem orem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events ywpyi-keymap-vim-0.19.0/tests/vimtests/paste/p_at_newline2.test0000644000000000000000000000014513755614221022256 0ustar0000000000000000-- Input (1,1) abc def 123 456 789 xxx -- Output (3,3) abc def 789 123 456 xxx -- Events 4j4ld$2kP yi-keymap-vim-0.19.0/tests/vimtests/paste/ddp_1.test0000644000000000000000000000022413755614221020515 0ustar0000000000000000-- Input (3,2) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (3,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events ddpyi-keymap-vim-0.19.0/tests/vimtests/paste/dep.test0000644000000000000000000000022413755614221020276 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,6) Loremipsum dolor sit amet abc def ghi qwe rty uiop -- Events depyi-keymap-vim-0.19.0/tests/vimtests/paste/dd_capP_1.test0000644000000000000000000000022413755614221021300 0ustar0000000000000000-- Input (3,6) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,1) Lorem ipsum dolor sit amet qwe rty uiop abc def ghi -- Events ddPyi-keymap-vim-0.19.0/tests/vimtests/paste/2yyp.test0000644000000000000000000000027413755614221020436 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,1) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet abc def ghi abc def ghi qwe rty uiop -- Events 2yypyi-keymap-vim-0.19.0/tests/vimtests/paste/dbp.test0000644000000000000000000000022413755614221020273 0ustar0000000000000000-- Input (1,9) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,9) Lorem sipum dolor sit amet abc def ghi qwe rty uiop -- Events dbpyi-keymap-vim-0.19.0/tests/vimtests/paste/dw_capP.test0000644000000000000000000000022413755614221021103 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,6) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events dwPyi-keymap-vim-0.19.0/tests/vimtests/paste/p_at_newline.test0000644000000000000000000000014513755614221022174 0ustar0000000000000000-- Input (1,1) abc def 123 456 789 xxx -- Output (3,3) abc def 789 123 456 xxx -- Events 4j4ld$2kp yi-keymap-vim-0.19.0/tests/vimtests/paste/2dd_capP_1.test0000644000000000000000000000022513755614221021363 0ustar0000000000000000-- Input (2,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,1) abc def ghi qwe rty uiop Lorem ipsum dolor sit amet -- Events 2ddPyi-keymap-vim-0.19.0/tests/vimtests/paste/2dd_capP.test0000644000000000000000000000023513755614221021144 0ustar0000000000000000-- Input (2,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop foo -- Output (2,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop foo -- Events 2ddPyi-keymap-vim-0.19.0/tests/vimtests/paste/ddkP.test0000644000000000000000000000022513755614221020411 0ustar0000000000000000-- Input (2,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,1) abc def ghi Lorem ipsum dolor sit amet qwe rty uiop -- Events ddkPyi-keymap-vim-0.19.0/tests/vimtests/paste/yep.test0000644000000000000000000000023113755614221020321 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,6) LLoremorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events yepyi-keymap-vim-0.19.0/tests/vimtests/paste/yyp.test0000644000000000000000000000025713755614221020355 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,1) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events yypyi-keymap-vim-0.19.0/tests/vimtests/paste/2ddp.test0000644000000000000000000000022513755614221020360 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,1) qwe rty uiop Lorem ipsum dolor sit amet abc def ghi -- Events 2ddpyi-keymap-vim-0.19.0/tests/vimtests/paste/Yp.test0000644000000000000000000000024713755614221020123 0ustar0000000000000000-- Input (1,10) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,27) Lorem ipsuum dolor sit ametm dolor sit amet abc def ghi qwe rty uiop -- Events Yp yi-keymap-vim-0.19.0/tests/vimtests/paste/2ddp_1.test0000644000000000000000000000022513755614221020600 0ustar0000000000000000-- Input (3,3) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (3,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events 2ddpyi-keymap-vim-0.19.0/tests/vimtests/paste/y_2.test0000644000000000000000000000011613755614221020217 0ustar0000000000000000-- Input (2,2) 1234 abcd xyzw -- Output (2,4) 1234 abcdbcd xyzw -- Events y3lPyi-keymap-vim-0.19.0/tests/vimtests/paste/dd_capP.test0000644000000000000000000000022413755614221021060 0ustar0000000000000000-- Input (2,6) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events ddPyi-keymap-vim-0.19.0/tests/vimtests/paste/yy_capP.test0000644000000000000000000000025713755614221021140 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,1) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events yyPyi-keymap-vim-0.19.0/tests/vimtests/paste/d2wp.test0000644000000000000000000000022613755614221020404 0ustar0000000000000000-- Input (1,9) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,19) Lorem ipssum dolor it amet abc def ghi qwe rty uiop -- Events d2wpyi-keymap-vim-0.19.0/tests/vimtests/paste/y_3.test0000644000000000000000000000011713755614221020221 0ustar0000000000000000-- Input (2,2) 1234 abcd xyzw -- Output (2,4) 1234 abcdbcd xyzw -- Events y20lPyi-keymap-vim-0.19.0/tests/vimtests/paste/ddjp.test0000644000000000000000000000022513755614221020450 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (3,1) abc def ghi qwe rty uiop Lorem ipsum dolor sit amet -- Events ddjpyi-keymap-vim-0.19.0/tests/vimtests/paste/yjp.test0000644000000000000000000000027313755614221020334 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,1) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet abc def ghi abc def ghi qwe rty uiop -- Events yjpyi-keymap-vim-0.19.0/tests/vimtests/numbers/0000755000000000000000000000000013755614221017166 5ustar0000000000000000yi-keymap-vim-0.19.0/tests/vimtests/numbers/hex_increase.test0000644000000000000000000000054313755614221022526 0ustar0000000000000000-- Input (1,1) Test increasing 0x1 to 0x2 Test increasing 0x9 to 0xa Test increasing 0xf to 0x10 Test increasing 0x1f to 0x20 Test increasing 0xff to 0x100 -- Output (5,21) Test increasing 0x2 to 0x2 Test increasing 0xa to 0xa Test increasing 0x10 to 0x10 Test increasing 0x20 to 0x20 Test increasing 0x100 to 0x100 -- Events jjjjyi-keymap-vim-0.19.0/tests/vimtests/numbers/oct_hex_letters.test0000644000000000000000000000035713755614221023267 0ustar0000000000000000-- Input (1,1) Make sure aa bb cc dd ee ff 0x1 increments correctly. Make sure oo 0o1 increments correctly. -- Output (2,16) Make sure aa bb cc dd ee ff 0x2 increments correctly. Make sure oo 0o2 increments correctly. -- Events +yi-keymap-vim-0.19.0/tests/vimtests/numbers/no_numbers.test0000644000000000000000000000052213755614221022235 0ustar0000000000000000-- Input (1,1) Test case if numbers are not present on the line. This should not cause yi to freeze. This should not cause the cursor to move. -- Output (3,1) Test case if numbers are not present on the line. This should not cause yi to freeze. This should not cause the cursor to move. -- Events j$^11jyi-keymap-vim-0.19.0/tests/vimtests/numbers/oct_increase.test0000644000000000000000000000044713755614221022532 0ustar0000000000000000-- Input (1,1) Test increasing 0o1 to 0o2 Test increasing 0o7 to 0o10 Test increasing 0o17 to 0o20 Test increasing 0o77 to 0o100 -- Output (4,21) Test increasing 0o2 to 0o2 Test increasing 0o10 to 0o10 Test increasing 0o20 to 0o20 Test increasing 0o100 to 0o100 -- Events jjjyi-keymap-vim-0.19.0/tests/vimtests/numbers/hex_decrease.test0000644000000000000000000000053713755614221022513 0ustar0000000000000000-- Input (1,1) Test decreasing 0x1 to 0x0 Test decreasing 0xa to 0x9 Test decreasing 0x10 to 0xf Test decreasing 0x20 to 0x1f Test decreasing 0x100 to 0xff -- Output (5,20) Test decreasing 0x0 to 0x0 Test decreasing 0x9 to 0x9 Test decreasing 0xf to 0xf Test decreasing 0x1f to 0x1f Test decreasing 0xff to 0xff -- Events jjjjyi-keymap-vim-0.19.0/tests/vimtests/numbers/increment.test0000644000000000000000000000043113755614221022051 0ustar0000000000000000-- Input (1,1) Test increasing 0 to 11 Test increasing -11 to 11 Test increasing -101 to -99 Test increasing 99 to 101 -- Output (4,19) Test increasing 11 to 11 Test increasing 11 to 11 Test increasing -99 to -99 Test increasing 101 to 101 -- Events 11j22j2jh2 yi-keymap-vim-0.19.0/tests/vimtests/numbers/sol_eol.test0000644000000000000000000000012113755614221021515 0ustar0000000000000000-- Input (1,1) 0x1 0o1 1 -- Output (3,1) 0x5 0o4 3 -- Events 4j3j2yi-keymap-vim-0.19.0/tests/vimtests/numbers/cursor_on_digits.test0000644000000000000000000000074213755614221023446 0ustar0000000000000000-- Input (1,1) Test increasing 109 to 110 when cursor is on 9. Test increasing 109 to 110 when cursor is on 0. Test increasing 109 to 110 when cursor is on 1. Test increasing 109 to 110 when cursor is on space before 1. -- Output (4,19) Test increasing 110 to 110 when cursor is on 9. Test increasing 110 to 110 when cursor is on 0. Test increasing 110 to 110 when cursor is on 1. Test increasing 110 to 110 when cursor is on space before 1. -- Events 3ejhj2hj3hyi-keymap-vim-0.19.0/tests/vimtests/numbers/decrement.test0000644000000000000000000000066713755614221022046 0ustar0000000000000000-- Input (1,1) Test decreasing 101 to 99 Test decreasing 11 to 9 Test decreasing 9 to 1 Test decreasing 1 to 0 Test decreasing 0 to -1 Test decreasing -1 to -11 Test decreasing -99 to -101 -- Output (7,20) Test decreasing 99 to 99 Test decreasing 9 to 9 Test decreasing 1 to 1 Test decreasing 0 to 0 Test decreasing -1 to -1 Test decreasing -11 to -11 Test decreasing -101 to -101 -- Events 2j2j8jjj10j2 yi-keymap-vim-0.19.0/tests/vimtests/numbers/oct_decrease.test0000644000000000000000000000044313755614221022510 0ustar0000000000000000-- Input (1,1) Test decreasing 0o1 to 0o0 Test decreasing 0o10 to 0o7 Test decreasing 0o20 to 0o17 Test decreasing 0o100 to 0o77 -- Output (4,20) Test decreasing 0o0 to 0o0 Test decreasing 0o7 to 0o7 Test decreasing 0o17 to 0o17 Test decreasing 0o77 to 0o77 -- Events jjjyi-keymap-vim-0.19.0/tests/vimtests/macros/0000755000000000000000000000000013755614221016777 5ustar0000000000000000yi-keymap-vim-0.19.0/tests/vimtests/macros/9.test0000644000000000000000000000022013755614221020042 0ustar0000000000000000-- Input (1,1) 123 123 123 qwf 123 123 123 ars 123 123 123 zxc -- Output (1,7) 123 123 123 qwf 123 123 123 ars 123 123 123 zxc -- Events q1eq@1 yi-keymap-vim-0.19.0/tests/vimtests/macros/14.test0000644000000000000000000000012213755614221020117 0ustar0000000000000000-- Input (2,1) abc A123b -- Output (1,1) abc123 A123b -- Events "0yyk@0 yi-keymap-vim-0.19.0/tests/vimtests/macros/1.test0000644000000000000000000000013413755614221020036 0ustar0000000000000000-- Input (2,2) qwf ars zxc -- Output (2,11) qwf arfoofoofoos zxc -- Events qaafooq@a@a yi-keymap-vim-0.19.0/tests/vimtests/macros/8.test0000644000000000000000000000022113755614221020042 0ustar0000000000000000-- Input (1,1) 123 123 123 qwf 123 123 123 ars 123 123 123 zxc -- Output (1,7) 123 123 123 qwf 123 123 123 ars 123 123 123 zxc -- Events q1f3q@1 yi-keymap-vim-0.19.0/tests/vimtests/macros/16.test0000644000000000000000000000016313755614221020126 0ustar0000000000000000-- Input (1,1) ^x$x "123 123 123" "123 123 123" -- Output (3,11) ^x$x 123 123 123 123 123 123 -- Events "ry$j@rj@r yi-keymap-vim-0.19.0/tests/vimtests/macros/13.test0000644000000000000000000000012313755614221020117 0ustar0000000000000000-- Input (1,1) abc -- Output (2,10) abc123 A123b -- Events qqA123bqj"qp yi-keymap-vim-0.19.0/tests/vimtests/macros/2.test0000644000000000000000000000010513755614221020035 0ustar0000000000000000-- Input (2,2) qwf ars zxc -- Output (2,2) qwf ars zxc -- Events qaq yi-keymap-vim-0.19.0/tests/vimtests/macros/12.test0000644000000000000000000000022213755614221020116 0ustar0000000000000000-- Input (1,1) 123 123 123 qwf 123 123 123 ars 123 123 123 zxc -- Output (1,15) 123 123 123 qwf 123 123 123 ars 123 123 123 zxc -- Events q1eeq@1 yi-keymap-vim-0.19.0/tests/vimtests/macros/7.test0000644000000000000000000000022313755614221020043 0ustar0000000000000000-- Input (1,1) 123 123 123 qwf 123 123 123 ars 123 123 123 zxc -- Output (1,11) 123 123 123 qwf 123 123 123 ars 123 123 123 zxc -- Events qqf3q2@q yi-keymap-vim-0.19.0/tests/vimtests/macros/15.test0000644000000000000000000000007213755614221020124 0ustar0000000000000000-- Input (1,1) -- Output (1,4) ^x$x -- Events qr^x$xq"rp yi-keymap-vim-0.19.0/tests/vimtests/macros/3.test0000644000000000000000000000012613755614221020041 0ustar0000000000000000-- Input (2,2) qwf ars zxc -- Output (2,8) qwf arfoofoos zxc -- Events qaafooq@a yi-keymap-vim-0.19.0/tests/vimtests/macros/4.test0000644000000000000000000000013313755614221020040 0ustar0000000000000000-- Input (2,2) qwf ars zxc -- Output (2,11) qwf arfoofoofoos zxc -- Events qaafooq2@a yi-keymap-vim-0.19.0/tests/vimtests/macros/11.test0000644000000000000000000000022213755614221020115 0ustar0000000000000000-- Input (1,1) 123 123 123 qwf 123 123 123 ars 123 123 123 zxc -- Output (1,8) 123 123 123 qwf 123 123 123 ars 123 123 123 zxc -- Events q1f3lq@1 yi-keymap-vim-0.19.0/tests/vimtests/macros/6.test0000644000000000000000000000022113755614221020040 0ustar0000000000000000-- Input (1,1) 123 123 123 qwf 123 123 123 ars 123 123 123 zxc -- Output (1,7) 123 123 123 qwf 123 123 123 ars 123 123 123 zxc -- Events qqf3q@q yi-keymap-vim-0.19.0/tests/vimtests/macros/5.test0000644000000000000000000000013413755614221020042 0ustar0000000000000000-- Input (2,2) qwf ars zxc -- Output (2,4) qwf afoorfoofoos zxc -- Events qaafooq@a0@a yi-keymap-vim-0.19.0/tests/vimtests/macros/0.test0000644000000000000000000000012113755614221020031 0ustar0000000000000000-- Input (2,2) qwf ars zxc -- Output (2,5) qwf arfoos zxc -- Events qaafooq yi-keymap-vim-0.19.0/tests/vimtests/macros/10.test0000644000000000000000000000022213755614221020114 0ustar0000000000000000-- Input (1,1) 123 123 123 qwf 123 123 123 ars 123 123 123 zxc -- Output (1,11) 123 123 123 qwf 123 123 123 ars 123 123 123 zxc -- Events q1eq2@1 yi-keymap-vim-0.19.0/tests/vimtests/macros/repeat_last_macro.test0000644000000000000000000000013313755614221023361 0ustar0000000000000000-- Input (2,2) qwf ars zxc -- Output (2,11) qwf arfoofoofoos zxc -- Events qaafooq@a@@yi-keymap-vim-0.19.0/tests/vimtests/insertion/0000755000000000000000000000000013755614221017525 5ustar0000000000000000yi-keymap-vim-0.19.0/tests/vimtests/insertion/C-o_3.test0000644000000000000000000000013013755614221021260 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (2,3) foo arbaz -- Events lijj yi-keymap-vim-0.19.0/tests/vimtests/insertion/capI2.test0000644000000000000000000000010513755614221021360 0ustar0000000000000000-- Input (1,7) foo -- Output (1,7) barfoo -- Events Ibaryi-keymap-vim-0.19.0/tests/vimtests/insertion/C-c_10.test0000644000000000000000000000010013755614221021317 0ustar0000000000000000-- Input (1,1) foo bar -- Output (2,1) foo bar -- Events oyi-keymap-vim-0.19.0/tests/vimtests/insertion/a4.test0000644000000000000000000000010113755614221020722 0ustar0000000000000000-- Input (1,1) -- Output (1,5) fooOO -- Events ifooaOOyi-keymap-vim-0.19.0/tests/vimtests/insertion/counted_capI.test0000644000000000000000000000014313755614221023021 0ustar0000000000000000-- Input (1,2) aa -- Output (1,42) xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxaa -- Events 42Ixyi-keymap-vim-0.19.0/tests/vimtests/insertion/C-f.test0000644000000000000000000000010313755614221021025 0ustar0000000000000000-- Input (1,1) Hi -- Output (1,4) "Hi" -- Events i""yi-keymap-vim-0.19.0/tests/vimtests/insertion/counted_o.test0000644000000000000000000000012313755614221022401 0ustar0000000000000000-- Input (2,1) abc def ghi -- Output (4,3) abc def 123 123 ghi -- Events 2o123yi-keymap-vim-0.19.0/tests/vimtests/insertion/C-h_1.test0000644000000000000000000000007613755614221021260 0ustar0000000000000000-- Input (1,1) foo -- Output (1,1) foo -- Events liyi-keymap-vim-0.19.0/tests/vimtests/insertion/counted_capA.test0000644000000000000000000000014313755614221023011 0ustar0000000000000000-- Input (1,1) aa -- Output (1,44) aaxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx -- Events 42Axyi-keymap-vim-0.19.0/tests/vimtests/insertion/nl_insert.test0000644000000000000000000000007613755614221022426 0ustar0000000000000000-- Input (1,2) x -- Output (2,1) xbc d -- Events abcdyi-keymap-vim-0.19.0/tests/vimtests/insertion/C-c_6.test0000644000000000000000000000010213755614221021246 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (1,1) baz -- Events c2wyi-keymap-vim-0.19.0/tests/vimtests/insertion/o3.test0000644000000000000000000000006513755614221020750 0ustar0000000000000000-- Input (2,1) -- Output (3,1) -- Events o yi-keymap-vim-0.19.0/tests/vimtests/insertion/a_on_empty_line.test0000644000000000000000000000006713755614221023572 0ustar0000000000000000-- Input (2,1) -- Output (2,1) q -- Events aqyi-keymap-vim-0.19.0/tests/vimtests/insertion/indent_6.test0000644000000000000000000000016513755614221022136 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (4,5) foo bar xyzzy baz -- Events joxyzzyyi-keymap-vim-0.19.0/tests/vimtests/insertion/C-y_1.test0000644000000000000000000000010613755614221021273 0ustar0000000000000000-- Input (1,1) foo bar -- Output (2,1) foo fbar -- Events jiyi-keymap-vim-0.19.0/tests/vimtests/insertion/C-c_13.test0000644000000000000000000000011413755614221021327 0ustar0000000000000000-- Input (1,1) foo bar -- Output (1,10) foo bhelloar -- Events wlihelloyi-keymap-vim-0.19.0/tests/vimtests/insertion/indent_8.test0000644000000000000000000000023313755614221022134 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (6,9) foo bar xyzzy baz -- Events joxyzzyyi-keymap-vim-0.19.0/tests/vimtests/insertion/C-d_5.test0000644000000000000000000000010513755614221021251 0ustar0000000000000000-- Input (2,1) foo bar -- Output (2,5) foo bar -- Events iyi-keymap-vim-0.19.0/tests/vimtests/insertion/C-d_1.test0000644000000000000000000000007313755614221021251 0ustar0000000000000000-- Input (1,1) foo -- Output (1,1) foo -- Events iyi-keymap-vim-0.19.0/tests/vimtests/insertion/C-y_0.test0000644000000000000000000000012213755614221021270 0ustar0000000000000000-- Input (1,1) foo bar -- Output (2,3) foo foobar -- Events jiyi-keymap-vim-0.19.0/tests/vimtests/insertion/C-r_0.test0000644000000000000000000000011313755614221021261 0ustar0000000000000000-- Input (1,1) barbaz -- Output (1,3) barbarbaz -- Events "ay3liayi-keymap-vim-0.19.0/tests/vimtests/insertion/C-h_4.test0000644000000000000000000000011413755614221021254 0ustar0000000000000000-- Input (1,1) 1 2 3 -- Output (1,1) 1 -- Events GAyi-keymap-vim-0.19.0/tests/vimtests/insertion/O4.test0000644000000000000000000000006513755614221020711 0ustar0000000000000000-- Input (2,1) -- Output (2,1) -- Events O yi-keymap-vim-0.19.0/tests/vimtests/insertion/capI3.test0000644000000000000000000000006713755614221021370 0ustar0000000000000000-- Input (1,7) -- Output (1,3) bar -- Events Ibaryi-keymap-vim-0.19.0/tests/vimtests/insertion/C-w_1.test0000644000000000000000000000007113755614221021272 0ustar0000000000000000-- Input (1,1) foobar -- Output (1,1) r -- Events $iyi-keymap-vim-0.19.0/tests/vimtests/insertion/a3.test0000644000000000000000000000010213755614221020722 0ustar0000000000000000-- Input (1,1) -- Output (1,5) fooOO -- Events ifoo$aOOyi-keymap-vim-0.19.0/tests/vimtests/insertion/C-c_3.test0000644000000000000000000000010013755614221021241 0ustar0000000000000000-- Input (1,1) baz bar -- Output (1,6) baz ba -- Events lAxyi-keymap-vim-0.19.0/tests/vimtests/insertion/C-w_0.test0000644000000000000000000000007113755614221021271 0ustar0000000000000000-- Input (1,1) foobar -- Output (1,1) r -- Events $iyi-keymap-vim-0.19.0/tests/vimtests/insertion/onechar.test0000644000000000000000000000010713755614221022043 0ustar0000000000000000-- Input (1,4) foo bar -- Output (2,1) foo x bar -- Events ix yi-keymap-vim-0.19.0/tests/vimtests/insertion/spec_insert.test0000644000000000000000000000011513755614221022741 0ustar0000000000000000-- Input (2,2) foo bar baz -- Output (2,2) foo b1ar baz -- Events 1yi-keymap-vim-0.19.0/tests/vimtests/insertion/C-o_4.test0000644000000000000000000000012713755614221021267 0ustar0000000000000000-- Input (1,1) -- Output (1,3) ugougsausageosausage -- Events isausagebugo. yi-keymap-vim-0.19.0/tests/vimtests/insertion/o1.test0000644000000000000000000000011013755614221020735 0ustar0000000000000000-- Input (2,1) abc def ghi -- Output (3,1) abc def ghi -- Events oyi-keymap-vim-0.19.0/tests/vimtests/insertion/capI.test0000644000000000000000000000010113755614221021272 0ustar0000000000000000-- Input (1,1) -- Output (1,2) OOfoo -- Events ifooIOOyi-keymap-vim-0.19.0/tests/vimtests/insertion/C-y_2.test0000644000000000000000000000011413755614221021273 0ustar0000000000000000-- Input (1,1) f bar -- Output (2,1) f fbar -- Events jiyi-keymap-vim-0.19.0/tests/vimtests/insertion/C-b.test0000644000000000000000000000012113755614221021021 0ustar0000000000000000-- Input (1,1) foo = -- Output (1,12) foo = (2 + 3) -- Events A()2 + 3yi-keymap-vim-0.19.0/tests/vimtests/insertion/C-d_2.test0000644000000000000000000000010413755614221021245 0ustar0000000000000000-- Input (1,1) foo bar -- Output (1,1) foo bar -- Events iyi-keymap-vim-0.19.0/tests/vimtests/insertion/indent_1.test0000644000000000000000000000013713755614221022130 0ustar0000000000000000-- Input (1,8) foo bar baz -- Output (2,4) foo bar baz -- Events iyi-keymap-vim-0.19.0/tests/vimtests/insertion/C-c_12.test0000644000000000000000000000010113755614221021322 0ustar0000000000000000-- Input (1,1) foo bar -- Output (1,5) foo ar -- Events wlixyi-keymap-vim-0.19.0/tests/vimtests/insertion/C-c_9.test0000644000000000000000000000010013755614221021247 0ustar0000000000000000-- Input (1,1) foo bar -- Output (1,1) foo bar -- Events Oyi-keymap-vim-0.19.0/tests/vimtests/insertion/indent_7.test0000644000000000000000000000016513755614221022137 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (4,5) foo bar xyzzy baz -- Events joxyzzyyi-keymap-vim-0.19.0/tests/vimtests/insertion/C-e_0.test0000644000000000000000000000010513755614221021245 0ustar0000000000000000-- Input (1,1) foo bar -- Output (1,1) bfoo bar -- Events iyi-keymap-vim-0.19.0/tests/vimtests/insertion/C-c_0.test0000644000000000000000000000006613755614221021251 0ustar0000000000000000-- Input (1,1) bar -- Output (1,1) ar -- Events syi-keymap-vim-0.19.0/tests/vimtests/insertion/C-r_1.test0000644000000000000000000000012013755614221021260 0ustar0000000000000000-- Input (1,1) bar baz -- Output (2,1) babar r baz -- Events "byyllib yi-keymap-vim-0.19.0/tests/vimtests/insertion/indent_3.test0000644000000000000000000000017613755614221022135 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (6,9) foo bar xyzzy baz -- Events joxyzzyyi-keymap-vim-0.19.0/tests/vimtests/insertion/counted_i.test0000644000000000000000000000012213755614221022372 0ustar0000000000000000-- Input (1,2) aa -- Output (1,25) axyzxyzxyzxyzxyzxyzxyzxyza -- Events 8ixyzyi-keymap-vim-0.19.0/tests/vimtests/insertion/i.test0000644000000000000000000000010213755614221020647 0ustar0000000000000000-- Input (1,1) -- Output (1,3) fOOoo -- Events ifoohiOOyi-keymap-vim-0.19.0/tests/vimtests/insertion/C-o_2.test0000644000000000000000000000012013755614221021256 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (1,4) foo baz -- Events i7lyi-keymap-vim-0.19.0/tests/vimtests/insertion/counted_capO.test0000644000000000000000000000012313755614221023025 0ustar0000000000000000-- Input (2,1) abc def ghi -- Output (3,3) abc 123 123 def ghi -- Events 2O123yi-keymap-vim-0.19.0/tests/vimtests/insertion/C-d_0.test0000644000000000000000000000007313755614221021250 0ustar0000000000000000-- Input (1,1) foo -- Output (1,5) foo -- Events iyi-keymap-vim-0.19.0/tests/vimtests/insertion/C-c_1.test0000644000000000000000000000006713755614221021253 0ustar0000000000000000-- Input (1,1) bar -- Output (1,1) br -- Events lsyi-keymap-vim-0.19.0/tests/vimtests/insertion/indent_0.test0000644000000000000000000000016413755614221022127 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (4,9) foo bar xyzzy baz -- Events joxyzzyyi-keymap-vim-0.19.0/tests/vimtests/insertion/C-c_4.test0000644000000000000000000000010013755614221021242 0ustar0000000000000000-- Input (1,1) baz bar -- Output (1,2) bz bar -- Events laxyi-keymap-vim-0.19.0/tests/vimtests/insertion/C-e_1.test0000644000000000000000000000012113755614221021244 0ustar0000000000000000-- Input (1,1) foo bar -- Output (1,3) barfoo bar -- Events iyi-keymap-vim-0.19.0/tests/vimtests/insertion/indent_2.test0000644000000000000000000000014013755614221022123 0ustar0000000000000000-- Input (1,9) foo bar baz -- Output (2,4) foo bar baz -- Events iyi-keymap-vim-0.19.0/tests/vimtests/insertion/a.test0000644000000000000000000000010213755614221020637 0ustar0000000000000000-- Input (1,1) -- Output (1,4) foOOo -- Events ifoohaOOyi-keymap-vim-0.19.0/tests/vimtests/insertion/C-h_2.test0000644000000000000000000000010413755614221021251 0ustar0000000000000000-- Input (1,1) foo bar -- Output (1,3) foobar -- Events jiyi-keymap-vim-0.19.0/tests/vimtests/insertion/capA4.test0000644000000000000000000000010213755614221021347 0ustar0000000000000000-- Input (1,1) -- Output (1,5) fooOO -- Events ifoo$AOOyi-keymap-vim-0.19.0/tests/vimtests/insertion/2o.test0000644000000000000000000000012313755614221020742 0ustar0000000000000000-- Input (2,1) 123 456 789 -- Output (4,3) 123 456 abc abc 789 -- Events 2oabcyi-keymap-vim-0.19.0/tests/vimtests/insertion/i3.test0000644000000000000000000000010213755614221020732 0ustar0000000000000000-- Input (1,1) -- Output (1,4) foOOo -- Events ifoo$iOOyi-keymap-vim-0.19.0/tests/vimtests/insertion/O2.test0000644000000000000000000000011013755614221020676 0ustar0000000000000000-- Input (2,1) abc def ghi -- Output (2,1) abc def ghi -- Events Oyi-keymap-vim-0.19.0/tests/vimtests/insertion/counted_a.test0000644000000000000000000000014313755614221022365 0ustar0000000000000000-- Input (1,2) aa -- Output (1,44) aaxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx -- Events 42axyi-keymap-vim-0.19.0/tests/vimtests/insertion/C-c_11.test0000644000000000000000000000010113755614221021321 0ustar0000000000000000-- Input (1,1) foo bar -- Output (1,1) oo bar -- Events wlIxyi-keymap-vim-0.19.0/tests/vimtests/insertion/capA3.test0000644000000000000000000000010213755614221021346 0ustar0000000000000000-- Input (1,1) -- Output (1,5) fooOO -- Events ifoohAOOyi-keymap-vim-0.19.0/tests/vimtests/insertion/C-e_2.test0000644000000000000000000000011313755614221021246 0ustar0000000000000000-- Input (1,1) foo b -- Output (1,1) bfoo b -- Events iyi-keymap-vim-0.19.0/tests/vimtests/insertion/C-c_8.test0000644000000000000000000000011113755614221021250 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (2,1) foo bar baz -- Events jOyi-keymap-vim-0.19.0/tests/vimtests/insertion/indent_5.test0000644000000000000000000000017713755614221022140 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (6,5) foo bar xyzzy baz -- Events joxyzzyyi-keymap-vim-0.19.0/tests/vimtests/insertion/C-h_3.test0000644000000000000000000000013113755614221021252 0ustar0000000000000000-- Input (1,1) 1234567890 -- Output (1,5) 12345 -- Events Ayi-keymap-vim-0.19.0/tests/vimtests/insertion/C-c_5.test0000644000000000000000000000010413755614221021247 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (1,1) bar baz -- Events Cyi-keymap-vim-0.19.0/tests/vimtests/insertion/a2.test0000644000000000000000000000010213755614221020721 0ustar0000000000000000-- Input (1,1) -- Output (1,3) fOOoo -- Events ifoo0aOOyi-keymap-vim-0.19.0/tests/vimtests/insertion/C-d_6.test0000644000000000000000000000010113755614221021246 0ustar0000000000000000-- Input (2,1) foo bar -- Output (2,1) foo bar -- Events iyi-keymap-vim-0.19.0/tests/vimtests/insertion/capA2.test0000644000000000000000000000007513755614221021356 0ustar0000000000000000-- Input (2,1) -- Output (2,3) foo -- Events Afooyi-keymap-vim-0.19.0/tests/vimtests/insertion/C-d_3.test0000644000000000000000000000007313755614221021253 0ustar0000000000000000-- Input (1,6) foo -- Output (1,2) foo -- Events iyi-keymap-vim-0.19.0/tests/vimtests/insertion/C-c_2.test0000644000000000000000000000007413755614221021252 0ustar0000000000000000-- Input (1,1) foo bar -- Output (1,1) bar -- Events Syi-keymap-vim-0.19.0/tests/vimtests/insertion/C-c_7.test0000644000000000000000000000011113755614221021247 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (3,1) foo bar baz -- Events joyi-keymap-vim-0.19.0/tests/vimtests/insertion/capA.test0000644000000000000000000000010113755614221021262 0ustar0000000000000000-- Input (1,1) -- Output (1,5) fooOO -- Events ifooAOOyi-keymap-vim-0.19.0/tests/vimtests/insertion/indent_4.test0000644000000000000000000000016013755614221022127 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (6,1) foo bar baz -- Events joyi-keymap-vim-0.19.0/tests/vimtests/insertion/spec_delete.test0000644000000000000000000000011313755614221022675 0ustar0000000000000000-- Input (2,2) foo bar baz -- Output (2,1) foo br baz -- Events iyi-keymap-vim-0.19.0/tests/vimtests/insertion/C-d_4.test0000644000000000000000000000007313755614221021254 0ustar0000000000000000-- Input (1,2) foo -- Output (1,6) foo -- Events iyi-keymap-vim-0.19.0/tests/vimtests/insertion/i2.test0000644000000000000000000000010213755614221020731 0ustar0000000000000000-- Input (1,1) -- Output (1,2) OOfoo -- Events ifoo0iOOyi-keymap-vim-0.19.0/tests/vimtests/insertion/C-h_0.test0000644000000000000000000000006713755614221021257 0ustar0000000000000000-- Input (1,1) foo -- Output (1,1) foo -- Events iyi-keymap-vim-0.19.0/tests/vimtests/insertion/capO.test0000644000000000000000000000013113755614221021303 0ustar0000000000000000-- Input (2,1) abc def ghi -- Output (3,3) abc 123 456 def ghi -- Events O123456yi-keymap-vim-0.19.0/tests/vimtests/insertion/o.test0000644000000000000000000000013113755614221020657 0ustar0000000000000000-- Input (2,1) abc def ghi -- Output (4,3) abc def 123 456 ghi -- Events o123456yi-keymap-vim-0.19.0/tests/vimtests/switchcase/0000755000000000000000000000000013755614221017650 5ustar0000000000000000yi-keymap-vim-0.19.0/tests/vimtests/switchcase/gtilde_1.test0000644000000000000000000000022513755614221022240 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,1) lOREM IPSUM dolor sit amet abc def ghi qwe rty uiop -- Events g~2wyi-keymap-vim-0.19.0/tests/vimtests/switchcase/tilde_near_eol.test0000644000000000000000000000022413755614221023514 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,26) Lorem ipsum dolor sit ameT abc def ghi qwe rty uiop -- Events $~yi-keymap-vim-0.19.0/tests/vimtests/switchcase/g_capU.test0000644000000000000000000000022513755614221021746 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,1) LOREM IPSUM dolor sit amet abc def ghi qwe rty uiop -- Events gU2wyi-keymap-vim-0.19.0/tests/vimtests/switchcase/tilde_does_not_cross_lines.test0000644000000000000000000000022613755614221026147 0ustar0000000000000000-- Input (1,1) abcdefghijklmnopqrstuvwxyz abc def ghi qwe rty uiop -- Output (1,26) ABCDEFGHIJKLMNOPQRSTUVWXYZ abc def ghi qwe rty uiop -- Events 30~ yi-keymap-vim-0.19.0/tests/vimtests/switchcase/tilde_with_count.test0000644000000000000000000000022613755614221024115 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,11) lOREM IPSUm dolor sit amet abc def ghi qwe rty uiop -- Events 10~ yi-keymap-vim-0.19.0/tests/vimtests/switchcase/gu.test0000644000000000000000000000022513755614221021163 0ustar0000000000000000-- Input (1,1) LOREM IPSUM dolor sit amet abc def ghi qwe rty uiop -- Output (1,1) lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events gu2wyi-keymap-vim-0.19.0/tests/vimtests/switchcase/gtilde.test0000644000000000000000000000022513755614221022020 0ustar0000000000000000-- Input (1,1) LOREM IPSUM dolor sit amet abc def ghi qwe rty uiop -- Output (1,1) lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events g~2wyi-keymap-vim-0.19.0/tests/vimtests/switchcase/tilde_no_count.test0000644000000000000000000000022313755614221023553 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,2) lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events ~ yi-keymap-vim-0.19.0/tests/vimtests/switchcase/tilde_left_over_count_at_eol_is_ignored.test0000644000000000000000000000110413755614221030650 0ustar0000000000000000-- Input (2,1) 12345678901234567890 If tilde is given a count which is greater than the line length the case of the final character is switched exactly once. We have 18 characters in the first line, a count of 19 should switch the final 'a' to 'A', not to 'A' and then back to 'a'. -- Output (2,19) 12345678901234567890 iF TILDE IS GIVEN A count which is greater than the line length the case of the final character is switched exactly once. We have 18 characters in the first line, a count of 19 should switch the final 'a' to 'A', not to 'A' and then back to 'a'. -- Events 20~