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