{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Yi.Keymap.Vim.ExMap
-- License     :  GPL-2
-- Maintainer  :  yi-devel@googlegroups.com
-- Stability   :  experimental
-- Portability :  portable
--
-- I'm a module waiting for some kind soul to give me a commentary!

module Yi.Keymap.Vim.ExMap (defExMap) where

import           Control.Monad            (when)
import           Data.Char                (isSpace)
import           Data.Maybe               (fromJust)
import           Data.Monoid              ((<>))
import qualified Data.Text                as T (Text, drop, head, length, split, unwords, map, unpack)
import           System.FilePath          (isPathSeparator)
import           Yi.Buffer                hiding (Insert)
import           Yi.Editor
import           Yi.History               (historyDown, historyFinish, historyPrefixSet, historyUp)
import           Yi.Keymap                (YiM)
import           Yi.Keymap.Vim.Common
import           Yi.Keymap.Vim.Utils      (matchFromBool, selectBinding)
import           Yi.Keymap.Vim.Ex
import           Yi.Keymap.Vim.StateUtils (modifyStateE, resetCountE, switchModeE, getRegisterE)
import qualified Yi.Rope                  as R (fromText, toText)
import           Yi.String                (commonTPrefix')

defExMap :: [EventString -> Maybe ExCommand] -> [VimBinding]
defExMap :: [EventString -> Maybe ExCommand] -> [VimBinding]
defExMap [EventString -> Maybe ExCommand]
cmdParsers = VimBinding
printable VimBinding -> [VimBinding] -> [VimBinding]
forall a. a -> [a] -> [a]
: [EventString -> Maybe ExCommand] -> [VimBinding]
specials [EventString -> Maybe ExCommand]
cmdParsers

specials :: [EventString -> Maybe ExCommand] -> [VimBinding]
specials :: [EventString -> Maybe ExCommand] -> [VimBinding]
specials [EventString -> Maybe ExCommand]
cmdParsers =
    [ VimBinding
exitBinding
    , [EventString -> Maybe ExCommand] -> VimBinding
completionBinding [EventString -> Maybe ExCommand]
cmdParsers
    , [EventString -> Maybe ExCommand] -> VimBinding
finishBindingY [EventString -> Maybe ExCommand]
cmdParsers
    , [EventString -> Maybe ExCommand] -> VimBinding
finishBindingE [EventString -> Maybe ExCommand]
cmdParsers
    , VimBinding
failBindingE
    , VimBinding
historyBinding
    , VimBinding
pasteRegisterBinding
    ]

completionBinding :: [EventString -> Maybe ExCommand] -> VimBinding
completionBinding :: [EventString -> Maybe ExCommand] -> VimBinding
completionBinding [EventString -> Maybe ExCommand]
commandParsers = (EventString -> VimState -> MatchResult (YiM RepeatToken))
-> VimBinding
VimBindingY EventString -> VimState -> MatchResult (YiM RepeatToken)
forall a.
(Eq a, IsString a) =>
a -> VimState -> MatchResult (YiM RepeatToken)
f
  where
    f :: a -> VimState -> MatchResult (YiM RepeatToken)
f a
"<Tab>" (VimState { vsMode :: VimState -> VimMode
vsMode = VimMode
Ex }) = YiM RepeatToken -> MatchResult (YiM RepeatToken)
forall a. a -> MatchResult a
WholeMatch (YiM RepeatToken -> MatchResult (YiM RepeatToken))
-> YiM RepeatToken -> MatchResult (YiM RepeatToken)
forall a b. (a -> b) -> a -> b
$ do
        EventString
commandString <- Text -> EventString
Ev (Text -> EventString)
-> (YiString -> Text) -> YiString -> EventString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> Text
R.toText (YiString -> EventString) -> YiM YiString -> YiM EventString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM YiString -> YiM YiString
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM YiString
elemsB
        case [EventString -> Maybe ExCommand] -> EventString -> Maybe ExCommand
evStringToExCommand [EventString -> Maybe ExCommand]
commandParsers EventString
commandString of
          Just ExCommand
cmd -> ExCommand -> YiM ()
complete ExCommand
cmd
          Maybe ExCommand
Nothing -> () -> YiM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        RepeatToken -> YiM RepeatToken
forall (m :: * -> *) a. Monad m => a -> m a
return RepeatToken
Drop
    f a
_ VimState
_ = MatchResult (YiM RepeatToken)
forall a. MatchResult a
NoMatch
    complete :: ExCommand -> YiM ()
    complete :: ExCommand -> YiM ()
complete ExCommand
cmd = do
        [Text]
possibilities <- ExCommand -> YiM [Text]
cmdComplete ExCommand
cmd
        case [Text]
possibilities of
          [] -> () -> YiM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          (Text
s:[]) -> Text -> YiM ()
updateCommand Text
s
          [Text]
ss -> do
              let s :: Text
s = [Text] -> Text
commonTPrefix' [Text]
ss
              Text -> YiM ()
updateCommand Text
s
              Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg (Text -> YiM ()) -> ([Text] -> Text) -> [Text] -> YiM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unwords ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Text -> Text
dropToLastWordOf Text
s) ([Text] -> YiM ()) -> [Text] -> YiM ()
forall a b. (a -> b) -> a -> b
$ [Text]
ss

    updateCommand :: T.Text -> YiM ()
    updateCommand :: Text -> YiM ()
updateCommand Text
s = do
        BufferM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> YiM ()) -> BufferM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ YiString -> BufferM ()
replaceBufferContent (Text -> YiString
R.fromText Text
s)
        EditorM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM () -> YiM ()) -> EditorM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ do
            Text -> EditorM ()
historyPrefixSet Text
s
            (VimState -> VimState) -> EditorM ()
modifyStateE ((VimState -> VimState) -> EditorM ())
-> (VimState -> VimState) -> EditorM ()
forall a b. (a -> b) -> a -> b
$ \VimState
state -> VimState
state {
                vsOngoingInsertEvents :: EventString
vsOngoingInsertEvents = Text -> EventString
Ev Text
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 :: Text -> Text -> Text
dropToLastWordOf Text
s = case [Text] -> [Text]
forall a. [a] -> [a]
reverse ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
T.split Char -> Bool
isWordSep (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text
s of
  []     -> Text -> Text
forall a. a -> a
id
  [Text
_]    -> Text -> Text
forall a. a -> a
id
  Text
_ : [Text]
ws -> Int -> Text -> Text
T.drop (Int -> Text -> Text) -> ([Text] -> Int) -> [Text] -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Enum a => a -> a
succ (Int -> Int) -> ([Text] -> Int) -> [Text] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
T.length (Text -> Int) -> ([Text] -> Text) -> [Text] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unwords ([Text] -> Text -> Text) -> [Text] -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text]
ws
  where
    isWordSep :: Char -> Bool
    isWordSep :: Char -> Bool
isWordSep Char
c = Char -> Bool
isPathSeparator Char
c Bool -> Bool -> Bool
|| Char -> Bool
isSpace Char
c

exitEx :: Bool -> EditorM ()
exitEx :: Bool -> EditorM ()
exitEx Bool
success = do
    Bool -> EditorM () -> EditorM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
success EditorM ()
historyFinish
    EditorM ()
resetCountE
    VimMode -> EditorM ()
switchModeE VimMode
Normal
    EditorM ()
closeBufferAndWindowE
    BufferM () -> EditorM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> EditorM ()) -> BufferM () -> EditorM ()
forall a b. (a -> b) -> a -> b
$ Bool -> BufferM ()
setVisibleSelection Bool
False

exitBinding :: VimBinding
exitBinding :: VimBinding
exitBinding = (EventString -> VimState -> MatchResult (EditorM RepeatToken))
-> VimBinding
VimBindingE EventString -> VimState -> MatchResult (EditorM RepeatToken)
forall a.
(Eq a, IsString a) =>
a -> VimState -> MatchResult (EditorM RepeatToken)
f
    where
      f :: a -> VimState -> MatchResult (EditorM RepeatToken)
f a
"<CR>" (VimState { vsMode :: VimState -> VimMode
vsMode = VimMode
Ex, vsOngoingInsertEvents :: VimState -> EventString
vsOngoingInsertEvents = Ev Text
"" })
          = EditorM RepeatToken -> MatchResult (EditorM RepeatToken)
forall a. a -> MatchResult a
WholeMatch EditorM RepeatToken
action
      f a
evs (VimState { vsMode :: VimState -> VimMode
vsMode = VimMode
Ex })
          = EditorM RepeatToken
action EditorM RepeatToken
-> MatchResult () -> MatchResult (EditorM RepeatToken)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> MatchResult ()
matchFromBool (a
evs a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a
"<Esc>", a
"<C-c>"])
      f a
_ VimState
_ = MatchResult (EditorM RepeatToken)
forall a. MatchResult a
NoMatch
      action :: EditorM RepeatToken
action = Bool -> EditorM ()
exitEx Bool
False EditorM () -> EditorM RepeatToken -> EditorM RepeatToken
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RepeatToken -> EditorM RepeatToken
forall (m :: * -> *) a. Monad m => a -> m a
return RepeatToken
Drop

finishBindingY :: [EventString -> Maybe ExCommand] -> VimBinding
finishBindingY :: [EventString -> Maybe ExCommand] -> VimBinding
finishBindingY [EventString -> Maybe ExCommand]
commandParsers = (EventString -> VimState -> MatchResult (YiM RepeatToken))
-> VimBinding
VimBindingY EventString -> VimState -> MatchResult (YiM RepeatToken)
f
    where f :: EventString -> VimState -> MatchResult (YiM RepeatToken)
f EventString
evs VimState
state = [EventString -> Maybe ExCommand]
-> ([EventString -> Maybe ExCommand] -> EventString -> YiM ())
-> YiM RepeatToken
forall (m :: * -> *).
MonadEditor m =>
[EventString -> Maybe ExCommand]
-> ([EventString -> Maybe ExCommand] -> EventString -> m ())
-> m RepeatToken
finishAction [EventString -> Maybe ExCommand]
commandParsers [EventString -> Maybe ExCommand] -> EventString -> YiM ()
exEvalY
                      YiM RepeatToken -> MatchResult () -> MatchResult (YiM RepeatToken)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [EventString -> Maybe ExCommand]
-> (ExCommand -> Bool) -> EventString -> VimState -> MatchResult ()
finishPrereq [EventString -> Maybe ExCommand]
commandParsers (Bool -> Bool
not (Bool -> Bool) -> (ExCommand -> Bool) -> ExCommand -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExCommand -> Bool
cmdIsPure) EventString
evs VimState
state


finishBindingE :: [EventString -> Maybe ExCommand] -> VimBinding
finishBindingE :: [EventString -> Maybe ExCommand] -> VimBinding
finishBindingE [EventString -> Maybe ExCommand]
commandParsers = (EventString -> VimState -> MatchResult (EditorM RepeatToken))
-> VimBinding
VimBindingE EventString -> VimState -> MatchResult (EditorM RepeatToken)
f
    where f :: EventString -> VimState -> MatchResult (EditorM RepeatToken)
f EventString
evs VimState
state = [EventString -> Maybe ExCommand]
-> ([EventString -> Maybe ExCommand] -> EventString -> EditorM ())
-> EditorM RepeatToken
forall (m :: * -> *).
MonadEditor m =>
[EventString -> Maybe ExCommand]
-> ([EventString -> Maybe ExCommand] -> EventString -> m ())
-> m RepeatToken
finishAction [EventString -> Maybe ExCommand]
commandParsers [EventString -> Maybe ExCommand] -> EventString -> EditorM ()
exEvalE
                      EditorM RepeatToken
-> MatchResult () -> MatchResult (EditorM RepeatToken)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [EventString -> Maybe ExCommand]
-> (ExCommand -> Bool) -> EventString -> VimState -> MatchResult ()
finishPrereq [EventString -> Maybe ExCommand]
commandParsers ExCommand -> Bool
cmdIsPure EventString
evs VimState
state

finishPrereq :: [EventString -> Maybe ExCommand] -> (ExCommand -> Bool)
    -> EventString -> VimState -> MatchResult ()
finishPrereq :: [EventString -> Maybe ExCommand]
-> (ExCommand -> Bool) -> EventString -> VimState -> MatchResult ()
finishPrereq [EventString -> Maybe ExCommand]
commandParsers ExCommand -> Bool
cmdPred EventString
evs VimState
s =
    Bool -> MatchResult ()
matchFromBool (Bool -> MatchResult ())
-> ([Bool] -> Bool) -> [Bool] -> MatchResult ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> MatchResult ()) -> [Bool] -> MatchResult ()
forall a b. (a -> b) -> a -> b
$
        [ VimState -> VimMode
vsMode VimState
s VimMode -> VimMode -> Bool
forall a. Eq a => a -> a -> Bool
== VimMode
Ex
        , EventString
evs EventString -> [EventString] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [EventString
"<CR>", EventString
"<C-m>"]
        , case [EventString -> Maybe ExCommand] -> EventString -> Maybe ExCommand
evStringToExCommand [EventString -> Maybe ExCommand]
commandParsers (VimState -> EventString
vsOngoingInsertEvents VimState
s) of
            Just ExCommand
cmd -> ExCommand -> Bool
cmdPred ExCommand
cmd
            Maybe ExCommand
_ -> Bool
False
        ]

finishAction :: MonadEditor m => [EventString -> Maybe ExCommand] ->
    ([EventString -> Maybe ExCommand] -> EventString -> m ()) -> m RepeatToken
finishAction :: [EventString -> Maybe ExCommand]
-> ([EventString -> Maybe ExCommand] -> EventString -> m ())
-> m RepeatToken
finishAction [EventString -> Maybe ExCommand]
commandParsers [EventString -> Maybe ExCommand] -> EventString -> m ()
execute = do
  YiString
s <- EditorM YiString -> m YiString
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM YiString -> m YiString) -> EditorM YiString -> m YiString
forall a b. (a -> b) -> a -> b
$ BufferM YiString -> EditorM YiString
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM YiString
elemsB
  EditorM () -> m ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM () -> m ()) -> EditorM () -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> EditorM ()
exitEx Bool
True
  [EventString -> Maybe ExCommand] -> EventString -> m ()
execute [EventString -> Maybe ExCommand]
commandParsers (Text -> EventString
Ev (Text -> EventString) -> Text -> EventString
forall a b. (a -> b) -> a -> b
$ YiString -> Text
R.toText YiString
s) -- TODO
  RepeatToken -> m RepeatToken
forall (m :: * -> *) a. Monad m => a -> m a
return RepeatToken
Drop

failBindingE :: VimBinding
failBindingE :: VimBinding
failBindingE = (EventString -> VimState -> MatchResult (EditorM RepeatToken))
-> VimBinding
VimBindingE EventString -> VimState -> MatchResult (EditorM RepeatToken)
forall a.
(Eq a, IsString a) =>
a -> VimState -> MatchResult (EditorM RepeatToken)
f
    where f :: a -> VimState -> MatchResult (EditorM RepeatToken)
f a
evs VimState
s | VimState -> VimMode
vsMode VimState
s VimMode -> VimMode -> Bool
forall a. Eq a => a -> a -> Bool
== VimMode
Ex Bool -> Bool -> Bool
&& a
evs a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
"<CR>"
            = EditorM RepeatToken -> MatchResult (EditorM RepeatToken)
forall a. a -> MatchResult a
WholeMatch (EditorM RepeatToken -> MatchResult (EditorM RepeatToken))
-> EditorM RepeatToken -> MatchResult (EditorM RepeatToken)
forall a b. (a -> b) -> a -> b
$ do
                Bool -> EditorM ()
exitEx Bool
False
                VimState
state <- EditorM VimState
forall (m :: * -> *) a.
(MonadEditor m, YiVariable a, Default a, Functor m) =>
m a
getEditorDyn
                Text -> EditorM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg (Text -> EditorM ())
-> (EventString -> Text) -> EventString -> EditorM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventString -> Text
_unEv (EventString -> EditorM ()) -> EventString -> EditorM ()
forall a b. (a -> b) -> a -> b
$ EventString
"Not an editor command: " EventString -> EventString -> EventString
forall a. Semigroup a => a -> a -> a
<> VimState -> EventString
vsOngoingInsertEvents VimState
state
                RepeatToken -> EditorM RepeatToken
forall (m :: * -> *) a. Monad m => a -> m a
return RepeatToken
Drop
          f a
_ VimState
_ = MatchResult (EditorM RepeatToken)
forall a. MatchResult a
NoMatch

historyBinding :: VimBinding
historyBinding :: VimBinding
historyBinding = (EventString -> VimState -> MatchResult (EditorM RepeatToken))
-> VimBinding
VimBindingE EventString -> VimState -> MatchResult (EditorM RepeatToken)
f
    where f :: EventString -> VimState -> MatchResult (EditorM RepeatToken)
f EventString
evs (VimState { vsMode :: VimState -> VimMode
vsMode = VimMode
Ex }) | EventString
evs EventString -> [EventString] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ((EventString, EditorM ()) -> EventString)
-> [(EventString, EditorM ())] -> [EventString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (EventString, EditorM ()) -> EventString
forall a b. (a, b) -> a
fst [(EventString, EditorM ())]
binds
             = EditorM RepeatToken -> MatchResult (EditorM RepeatToken)
forall a. a -> MatchResult a
WholeMatch (EditorM RepeatToken -> MatchResult (EditorM RepeatToken))
-> EditorM RepeatToken -> MatchResult (EditorM RepeatToken)
forall a b. (a -> b) -> a -> b
$ do
              Maybe (EditorM ()) -> EditorM ()
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (EditorM ()) -> EditorM ())
-> Maybe (EditorM ()) -> EditorM ()
forall a b. (a -> b) -> a -> b
$ EventString -> [(EventString, EditorM ())] -> Maybe (EditorM ())
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup EventString
evs [(EventString, EditorM ())]
binds
              YiString
command <- BufferM YiString -> EditorM YiString
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM YiString
elemsB
              (VimState -> VimState) -> EditorM ()
modifyStateE ((VimState -> VimState) -> EditorM ())
-> (VimState -> VimState) -> EditorM ()
forall a b. (a -> b) -> a -> b
$ \VimState
state -> VimState
state {
                  vsOngoingInsertEvents :: EventString
vsOngoingInsertEvents = Text -> EventString
Ev (Text -> EventString) -> Text -> EventString
forall a b. (a -> b) -> a -> b
$ YiString -> Text
R.toText YiString
command
              }
              RepeatToken -> EditorM RepeatToken
forall (m :: * -> *) a. Monad m => a -> m a
return RepeatToken
Drop
          f EventString
_ VimState
_ = MatchResult (EditorM RepeatToken)
forall a. MatchResult a
NoMatch
          binds :: [(EventString, EditorM ())]
binds =
              [ (EventString
"<Up>", EditorM ()
historyUp)
              , (EventString
"<C-p>", EditorM ()
historyUp)
              , (EventString
"<Down>", EditorM ()
historyDown)
              , (EventString
"<C-n>", EditorM ()
historyDown)
              ]

-- <C-r>a pastes a content of regContent of 'a' Register to Ex buffer ('a' is forall)
pasteRegisterBinding :: VimBinding
pasteRegisterBinding :: VimBinding
pasteRegisterBinding = (EventString -> VimState -> MatchResult (EditorM RepeatToken))
-> VimBinding
VimBindingE ((EventString -> VimState -> MatchResult (EditorM RepeatToken))
 -> VimBinding)
-> (EventString -> VimState -> MatchResult (EditorM RepeatToken))
-> VimBinding
forall a b. (a -> b) -> a -> b
$ [Char] -> VimState -> MatchResult (EditorM RepeatToken)
f ([Char] -> VimState -> MatchResult (EditorM RepeatToken))
-> (EventString -> [Char])
-> EventString
-> VimState
-> MatchResult (EditorM RepeatToken)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> [Char]) -> (EventString -> Text) -> EventString -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventString -> Text
_unEv
  where
    f :: [Char] -> VimState -> MatchResult (EditorM RepeatToken)
f [Char]
"<C-r>" (VimState { vsMode :: VimState -> VimMode
vsMode = VimMode
Ex }) = MatchResult (EditorM RepeatToken)
forall a. MatchResult a
PartialMatch
    f (Char
'<':Char
'C':Char
'-':Char
'r':Char
'>':Char
regName:[]) vs :: VimState
vs@(VimState { vsMode :: VimState -> VimMode
vsMode = VimMode
Ex }) =
        EditorM RepeatToken -> MatchResult (EditorM RepeatToken)
forall a. a -> MatchResult a
WholeMatch (EditorM RepeatToken -> MatchResult (EditorM RepeatToken))
-> EditorM RepeatToken -> MatchResult (EditorM RepeatToken)
forall a b. (a -> b) -> a -> b
$ Char -> VimState -> EditorM RepeatToken
pasteRegister Char
regName VimState
vs
    f [Char]
_ VimState
_ = MatchResult (EditorM RepeatToken)
forall a. MatchResult a
NoMatch

    -- Paste a content to Ex buffer, and update vsOngoingInsertEvents of VimState
    pasteRegister :: RegisterName -> VimState -> EditorM RepeatToken
    pasteRegister :: Char -> VimState -> EditorM RepeatToken
pasteRegister Char
registerName VimState
vs = do
        -- Replace " to \NUL, because yi's default register is \NUL and Vim's default is "
        let registerName' :: Char
registerName' = if Char
registerName Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"' then Char
'\NUL' else Char
registerName
        Maybe YiString
mayRegisterVal <- (Register -> YiString) -> Maybe Register -> Maybe YiString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Register -> YiString
regContent (Maybe Register -> Maybe YiString)
-> EditorM (Maybe Register) -> EditorM (Maybe YiString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> EditorM (Maybe Register)
getRegisterE Char
registerName'
        case Maybe YiString
mayRegisterVal of
            Maybe YiString
Nothing  -> RepeatToken -> EditorM RepeatToken
forall (m :: * -> *) a. Monad m => a -> m a
return RepeatToken
Drop
            Just YiString
val -> do
                BufferM () -> EditorM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> EditorM ()) -> BufferM () -> EditorM ()
forall a b. (a -> b) -> a -> b
$ YiString -> BufferM ()
insertN (YiString -> BufferM ())
-> (YiString -> YiString) -> YiString -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> YiString
replaceCr (YiString -> BufferM ()) -> YiString -> BufferM ()
forall a b. (a -> b) -> a -> b
$ YiString
val
                -- putEditorDyn fixes that Ex mode never evaluate pasted command
                -- If you remove this, tests/vimtests/ex/paste_register will failed
                VimState -> EditorM ()
forall (m :: * -> *) a.
(MonadEditor m, YiVariable a, Functor m) =>
a -> m ()
putEditorDyn VimState
vs { vsOngoingInsertEvents :: EventString
vsOngoingInsertEvents = Text -> EventString
Ev (Text -> EventString)
-> (YiString -> Text) -> YiString -> EventString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> Text
R.toText (YiString -> EventString) -> YiString -> EventString
forall a b. (a -> b) -> a -> b
$ YiString
val }
                RepeatToken -> EditorM RepeatToken
forall (m :: * -> *) a. Monad m => a -> m a
return RepeatToken
Finish
    -- Avoid putting EOL
    replaceCr :: YiString -> YiString
replaceCr = let replacer :: Char -> Char
replacer Char
'\n' = Char
'\r'
                    replacer Char
x    = Char
x
                in Text -> YiString
R.fromText (Text -> YiString) -> (YiString -> Text) -> YiString -> YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> Text -> Text
T.map Char -> Char
replacer (Text -> Text) -> (YiString -> Text) -> YiString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> Text
R.toText

printable :: VimBinding
printable :: VimBinding
printable = (EventString -> VimState -> MatchResult (EditorM RepeatToken))
-> VimBinding
VimBindingE EventString -> VimState -> MatchResult (EditorM RepeatToken)
f
    where f :: EventString -> VimState -> MatchResult (EditorM RepeatToken)
f EventString
evs vs :: VimState
vs@(VimState { vsMode :: VimState -> VimMode
vsMode = VimMode
Ex }) =
            case EventString
-> VimState -> [VimBinding] -> MatchResult (YiM RepeatToken)
selectBinding EventString
evs VimState
vs ([VimBinding] -> MatchResult (YiM RepeatToken))
-> [VimBinding] -> MatchResult (YiM RepeatToken)
forall a b. (a -> b) -> a -> b
$ [EventString -> Maybe ExCommand] -> [VimBinding]
specials [] of
                MatchResult (YiM RepeatToken)
NoMatch -> EditorM RepeatToken -> MatchResult (EditorM RepeatToken)
forall a. a -> MatchResult a
WholeMatch (EditorM RepeatToken -> MatchResult (EditorM RepeatToken))
-> EditorM RepeatToken -> MatchResult (EditorM RepeatToken)
forall a b. (a -> b) -> a -> b
$ EventString -> EditorM RepeatToken
editAction EventString
evs
                MatchResult (YiM RepeatToken)
_       -> MatchResult (EditorM RepeatToken)
forall a. MatchResult a
NoMatch
          f EventString
_ VimState
_ = MatchResult (EditorM RepeatToken)
forall a. MatchResult a
NoMatch

editAction :: EventString -> EditorM RepeatToken
editAction :: EventString -> EditorM RepeatToken
editAction (Ev Text
evs) = do
  BufferM () -> EditorM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> EditorM ()) -> BufferM () -> EditorM ()
forall a b. (a -> b) -> a -> b
$ case Text
evs of
      Text
"<BS>"    -> BufferM ()
bdeleteB
      Text
"<C-h>"   -> BufferM ()
bdeleteB
      Text
"<C-w>"   -> TextUnit -> Direction -> BufferM Region
regionOfPartNonEmptyB TextUnit
unitViWordOnLine Direction
Backward BufferM Region -> (Region -> BufferM ()) -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Region -> BufferM ()
deleteRegionB
      Text
"<lt>"    -> Char -> BufferM ()
insertB Char
'<'
      Text
"<Del>"   -> TextUnit -> Direction -> BufferM ()
deleteB TextUnit
Character Direction
Forward
      Text
"<C-d>"   -> TextUnit -> Direction -> BufferM ()
deleteB TextUnit
Character Direction
Forward
      Text
"<M-d>"   -> TextUnit -> Direction -> BufferM ()
deleteB TextUnit
unitWord Direction
Forward
      Text
"<Left>"  -> Int -> BufferM ()
moveXorSol Int
1
      Text
"<C-b>"   -> Int -> BufferM ()
moveXorSol Int
1
      Text
"<Right>" -> Int -> BufferM ()
moveXorEol Int
1
      Text
"<C-f>"   -> Int -> BufferM ()
moveXorEol Int
1
      Text
"<Home>"  -> BufferM ()
moveToSol
      Text
"<C-a>"   -> BufferM ()
moveToSol
      Text
"<End>"   -> BufferM ()
moveToEol
      Text
"<C-e>"   -> BufferM ()
moveToEol
      Text
"<C-u>"   -> BufferM ()
moveToSol BufferM () -> BufferM () -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferM ()
deleteToEol
      Text
"<C-k>"   -> BufferM ()
deleteToEol
      Text
_ -> case Text -> Int
T.length Text
evs of
          Int
1 -> Char -> BufferM ()
insertB (Char -> BufferM ()) -> Char -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Text -> Char
T.head Text
evs
          Int
_ -> [Char] -> BufferM ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> BufferM ()) -> [Char] -> BufferM ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Unhandled event " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
forall a. Show a => a -> [Char]
show Text
evs [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" in ex mode"
  Text
command <- YiString -> Text
R.toText (YiString -> Text) -> EditorM YiString -> EditorM Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM YiString -> EditorM YiString
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM YiString
elemsB
  Text -> EditorM ()
historyPrefixSet Text
command
  (VimState -> VimState) -> EditorM ()
modifyStateE ((VimState -> VimState) -> EditorM ())
-> (VimState -> VimState) -> EditorM ()
forall a b. (a -> b) -> a -> b
$ \VimState
state -> VimState
state {
    vsOngoingInsertEvents :: EventString
vsOngoingInsertEvents = Text -> EventString
Ev Text
command
  }
  RepeatToken -> EditorM RepeatToken
forall (m :: * -> *) a. Monad m => a -> m a
return RepeatToken
Drop