{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE UndecidableInstances  #-}
{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Yi.Keymap.Emacs.Utils
-- License     :  GPL-2
-- Maintainer  :  yi-devel@googlegroups.com
-- Stability   :  experimental
-- Portability :  portable
--
-- This module is aimed at being a helper for the Emacs keybindings.
-- In particular this should be useful for anyone that has a custom
-- keymap derived from or based on the Emacs one.

module Yi.Keymap.Emacs.Utils
  ( UnivArgument
  , argToInt
  , askQuitEditor
  , askSaveEditor
  , modifiedQuitEditor
  , withMinibuffer
  , queryReplaceE
  , isearchKeymap
  , cabalConfigureE
  , cabalBuildE
  , reloadProjectE
  , executeExtendedCommandE
  , evalRegionE
  , readUniversalArg
  , scrollDownE
  , scrollUpE
  , switchBufferE
  , killBufferE
  , insertNextC
  , findFile
  , findFileReadOnly
  , findFileNewTab
  , promptFile
  , promptTag
  , justOneSep
  , joinLinesE
  , countWordsRegion
  )
where

import           Control.Applicative (Alternative ((<|>), many, some), optional)
import           Lens.Micro.Platform          (use, (.=))
import           Control.Monad       (filterM, replicateM_, void)
import           Control.Monad.Base  ()
import           Data.List           ((\\))
import           Data.Maybe          (fromMaybe)
import           Data.Monoid         ((<>))
import qualified Data.Text           as T (Text, concat, null, pack, singleton, snoc, unpack, unwords)
import           System.FilePath     (takeDirectory, takeFileName, (</>))
import           System.FriendlyPath ()
import           Yi.Buffer
import           Yi.Command          (cabalBuildE, cabalConfigureE, reloadProjectE)
import           Yi.Core             (quitEditor)
import           Yi.Editor
import           Yi.Eval             (execEditorAction, getAllNamesInScope)
import           Yi.File             (deservesSave, editFile, fwriteBufferE, openingNewFile)
import           Yi.Keymap           (Keymap, KeymapM, YiM, write)
import           Yi.Keymap.Keys
import           Yi.MiniBuffer
import           Yi.Misc             (promptFile)
import           Yi.Monad            (gets)
import           Yi.Rectangle        (getRectangle)
import           Yi.Regex            (makeSearchOptsM)
import qualified Yi.Rope             as R (countNewLines, fromText, length, replicateChar, toText, words)
import           Yi.Search
import           Yi.String           (showT)
import           Yi.Tag
import           Yi.Utils            (io)

type UnivArgument = Maybe Int

----------------------------
-- | Quits the editor if there are no unmodified buffers
-- if there are unmodified buffers then we ask individually for
-- each modified buffer whether or not the user wishes to save
-- it or not. If we get to the end of this list and there are still
-- some modified buffers then we ask again if the user wishes to
-- quit, but this is then a simple yes or no.
askQuitEditor :: YiM ()
askQuitEditor :: YiM ()
askQuitEditor = Bool -> [FBuffer] -> YiM ()
askIndividualSave Bool
True ([FBuffer] -> YiM ()) -> YiM [FBuffer] -> YiM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< YiM [FBuffer]
getModifiedBuffers

askSaveEditor :: YiM ()
askSaveEditor :: YiM ()
askSaveEditor = Bool -> [FBuffer] -> YiM ()
askIndividualSave Bool
False ([FBuffer] -> YiM ()) -> YiM [FBuffer] -> YiM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< YiM [FBuffer]
getModifiedBuffers

getModifiedBuffers :: YiM [FBuffer]
getModifiedBuffers :: YiM [FBuffer]
getModifiedBuffers = (FBuffer -> YiM Bool) -> [FBuffer] -> YiM [FBuffer]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FBuffer -> YiM Bool
deservesSave ([FBuffer] -> YiM [FBuffer]) -> YiM [FBuffer] -> YiM [FBuffer]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Editor -> [FBuffer]) -> YiM [FBuffer]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Editor -> [FBuffer]
bufferSet

--------------------------------------------------
-- Takes in a list of buffers which have been identified
-- as modified since their last save.

askIndividualSave :: Bool -> [FBuffer] -> YiM ()
askIndividualSave :: Bool -> [FBuffer] -> YiM ()
askIndividualSave Bool
True []  = YiM ()
modifiedQuitEditor
askIndividualSave Bool
False [] = () -> YiM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
askIndividualSave Bool
hasQuit allBuffers :: [FBuffer]
allBuffers@(FBuffer
firstBuffer : [FBuffer]
others) =
  YiM BufferRef -> YiM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (EditorM BufferRef -> YiM BufferRef
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (Text -> KeymapEndo -> EditorM BufferRef
spawnMinibufferE Text
saveMessage (I Event Action () -> KeymapEndo
forall a b. a -> b -> a
const I Event Action ()
askKeymap)))
  where
  saveMessage :: Text
saveMessage = [Text] -> Text
T.concat [ Text
"do you want to save the buffer: "
                         , Text
bufferName
                         , Text
"? (y/n/", if Bool
hasQuit then Text
"q/" else Text
"", Text
"c/!)"
                         ]
  bufferName :: Text
bufferName  = FBuffer -> Text
identString FBuffer
firstBuffer

  askKeymap :: I Event Action ()
askKeymap = [I Event Action ()] -> I Event Action ()
forall (m :: * -> *) w e a.
(MonadInteract m w e, MonadFail m) =>
[m a] -> m a
choice ([ Char -> Event
char Char
'n' Event -> YiM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM ()
noAction
                      , Char -> Event
char Char
'y' Event -> YiM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM ()
yesAction
                      , Char -> Event
char Char
'!' Event -> YiM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM ()
allAction
                      , [Event] -> I Event Action Event
forall event (m :: * -> *) w.
(Ord event, MonadInteract m w event, MonadFail m) =>
[event] -> m event
oneOf [Char -> Event
char Char
'c', Event -> Event
ctrl (Event -> Event) -> Event -> Event
forall a b. (a -> b) -> a -> b
$ Char -> Event
char Char
'g']
                        I Event Action Event -> EditorM () -> I Event Action ()
forall (m :: * -> *) a x b.
(MonadInteract m Action Event, YiAction a x, Show x) =>
m b -> a -> m ()
>>! EditorM ()
closeBufferAndWindowE
                        -- cancel
                      ] [I Event Action ()] -> [I Event Action ()] -> [I Event Action ()]
forall a. [a] -> [a] -> [a]
++ [Char -> Event
char Char
'q' Event -> YiM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM ()
quitEditor | Bool
hasQuit])
  yesAction :: YiM ()
yesAction = do YiM Bool -> YiM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (YiM Bool -> YiM ()) -> YiM Bool -> YiM ()
forall a b. (a -> b) -> a -> b
$ BufferRef -> YiM Bool
fwriteBufferE (FBuffer -> BufferRef
bkey FBuffer
firstBuffer)
                 EditorM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor EditorM ()
closeBufferAndWindowE
                 YiM ()
continue

  noAction :: YiM ()
noAction = do EditorM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor EditorM ()
closeBufferAndWindowE
                YiM ()
continue

  allAction :: YiM ()
allAction = do (BufferRef -> YiM Bool) -> [BufferRef] -> YiM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ BufferRef -> YiM Bool
fwriteBufferE ([BufferRef] -> YiM ()) -> [BufferRef] -> YiM ()
forall a b. (a -> b) -> a -> b
$ (FBuffer -> BufferRef) -> [FBuffer] -> [BufferRef]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FBuffer -> BufferRef
bkey [FBuffer]
allBuffers
                 EditorM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor EditorM ()
closeBufferAndWindowE
                 Bool -> [FBuffer] -> YiM ()
askIndividualSave Bool
hasQuit []

  continue :: YiM ()
continue = Bool -> [FBuffer] -> YiM ()
askIndividualSave Bool
hasQuit [FBuffer]
others

---------------------------

---------------------------
-- | Quits the editor if there are no unmodified buffers
-- if there are then simply confirms with the user that they
-- with to quit.
modifiedQuitEditor :: YiM ()
modifiedQuitEditor :: YiM ()
modifiedQuitEditor =
  do [FBuffer]
modifiedBuffers <- YiM [FBuffer]
getModifiedBuffers
     if [FBuffer] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FBuffer]
modifiedBuffers
        then YiM ()
quitEditor
        else EditorM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM () -> YiM ()) -> EditorM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ EditorM BufferRef -> EditorM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Text -> KeymapEndo -> EditorM BufferRef
spawnMinibufferE Text
modifiedMessage (I Event Action () -> KeymapEndo
forall a b. a -> b -> a
const I Event Action ()
askKeymap))
  where
  modifiedMessage :: Text
modifiedMessage = Text
"Modified buffers exist really quit? (y/n)"

  askKeymap :: I Event Action ()
askKeymap = [I Event Action ()] -> I Event Action ()
forall (m :: * -> *) w e a.
(MonadInteract m w e, MonadFail m) =>
[m a] -> m a
choice [ Char -> Event
char Char
'n' Event -> EditorM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! EditorM ()
noAction
                     , Char -> Event
char Char
'y' Event -> YiM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM ()
quitEditor
                     ]

  noAction :: EditorM ()
noAction        = EditorM ()
closeBufferAndWindowE

-----------------------------
-- isearch
selfSearchKeymap :: Keymap
selfSearchKeymap :: I Event Action ()
selfSearchKeymap = do
  Event (KASCII Char
c) [] <- I Event Action Event
forall event (m :: * -> *) w.
(Ord event, MonadInteract m w event) =>
m event
anyEvent
  EditorM () -> I Event Action ()
forall (m :: * -> *) ev a x.
(MonadInteract m Action ev, YiAction a x, Show x) =>
a -> m ()
write (EditorM () -> I Event Action ())
-> (Text -> EditorM ()) -> Text -> I Event Action ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> EditorM ()
isearchAddE (Text -> I Event Action ()) -> Text -> I Event Action ()
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
c

searchKeymap :: Keymap
searchKeymap :: I Event Action ()
searchKeymap = I Event Action ()
selfSearchKeymap I Event Action () -> KeymapEndo
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [I Event Action ()] -> I Event Action ()
forall (m :: * -> *) w e a.
(MonadInteract m w e, MonadFail m) =>
[m a] -> m a
choice
               [ -- ("C-g", isearchDelE) -- Only if string is not empty.
                 Event -> Event
ctrl (Char -> Event
char Char
'r') Event -> EditorM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! EditorM ()
isearchPrevE
               , Event -> Event
ctrl (Char -> Event
char Char
's') Event -> EditorM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! EditorM ()
isearchNextE
               , Event -> Event
ctrl (Char -> Event
char Char
'w') Event -> EditorM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! EditorM ()
isearchWordE
               , Event -> Event
meta (Char -> Event
char Char
'p') Event -> EditorM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! Int -> EditorM ()
isearchHistory Int
1
               , Event -> Event
meta (Char -> Event
char Char
'n') Event -> EditorM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! Int -> EditorM ()
isearchHistory (-Int
1)
               , Key -> Event
spec Key
KBS        Event -> EditorM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! EditorM ()
isearchDelE
               ]

isearchKeymap :: Direction -> Keymap
isearchKeymap :: Direction -> I Event Action ()
isearchKeymap Direction
dir =
  do EditorM () -> I Event Action ()
forall (m :: * -> *) ev a x.
(MonadInteract m Action ev, YiAction a x, Show x) =>
a -> m ()
write (EditorM () -> I Event Action ())
-> EditorM () -> I Event Action ()
forall a b. (a -> b) -> a -> b
$ Direction -> EditorM ()
isearchInitE Direction
dir
     I Event Action [()] -> I Event Action ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (I Event Action [()] -> I Event Action ())
-> I Event Action [()] -> I Event Action ()
forall a b. (a -> b) -> a -> b
$ I Event Action () -> I Event Action [()]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many I Event Action ()
searchKeymap
     [I Event Action ()] -> I Event Action ()
forall (m :: * -> *) w e a.
(MonadInteract m w e, MonadFail m) =>
[m a] -> m a
choice [ Event -> Event
ctrl (Char -> Event
char Char
'g') Event -> EditorM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! EditorM ()
isearchCancelE
            , [Event] -> I Event Action Event
forall event (m :: * -> *) w.
(Ord event, MonadInteract m w event, MonadFail m) =>
[event] -> m event
oneOf [Event -> Event
ctrl (Char -> Event
char Char
'm'), Key -> Event
spec Key
KEnter]
              I Event Action Event -> EditorM () -> I Event Action ()
forall (m :: * -> *) a x b.
(MonadInteract m Action Event, YiAction a x, Show x) =>
m b -> a -> m ()
>>! EditorM () -> EditorM ()
forall a. EditorM a -> EditorM ()
isearchFinishWithE EditorM ()
resetRegexE
            ]
       I Event Action () -> KeymapEndo
forall (f :: * -> *) w e a.
MonadInteract f w e =>
f a -> f a -> f a
<|| EditorM () -> I Event Action ()
forall (m :: * -> *) ev a x.
(MonadInteract m Action ev, YiAction a x, Show x) =>
a -> m ()
write EditorM ()
isearchFinishE

----------------------------
-- query-replace
queryReplaceE :: YiM ()
queryReplaceE :: YiM ()
queryReplaceE = Text -> (Text -> YiM ()) -> YiM ()
withMinibufferFree Text
"Replace:" ((Text -> YiM ()) -> YiM ()) -> (Text -> YiM ()) -> YiM ()
forall a b. (a -> b) -> a -> b
$ \Text
replaceWhat ->
  Text -> (Text -> YiM ()) -> YiM ()
withMinibufferFree Text
"With:" ((Text -> YiM ()) -> YiM ()) -> (Text -> YiM ()) -> YiM ()
forall a b. (a -> b) -> a -> b
$ \Text
replaceWith -> do
    BufferRef
b <- (Editor -> BufferRef) -> YiM BufferRef
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Editor -> BufferRef
currentBuffer
    Window
win <- Getting Window Editor Window -> YiM Window
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Window Editor Window
Lens' Editor Window
currentWindowA
    let repStr :: YiString
repStr = Text -> YiString
R.fromText Text
replaceWith
        replaceKm :: I Event Action ()
replaceKm =
          [I Event Action ()] -> I Event Action ()
forall (m :: * -> *) w e a.
(MonadInteract m w e, MonadFail m) =>
[m a] -> m a
choice [ Char -> Event
char Char
'n'                  Event -> EditorM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! Window -> BufferRef -> SearchExp -> EditorM ()
qrNext Window
win BufferRef
b SearchExp
re
                 , Char -> Event
char Char
'!'                  Event -> EditorM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! Window -> BufferRef -> SearchExp -> YiString -> EditorM ()
qrReplaceAll Window
win BufferRef
b SearchExp
re YiString
repStr
                 , [Event] -> I Event Action Event
forall event (m :: * -> *) w.
(Ord event, MonadInteract m w event, MonadFail m) =>
[event] -> m event
oneOf [Char -> Event
char Char
'y', Char -> Event
char Char
' '] I Event Action Event -> EditorM () -> I Event Action ()
forall (m :: * -> *) a x b.
(MonadInteract m Action Event, YiAction a x, Show x) =>
m b -> a -> m ()
>>! Window -> BufferRef -> SearchExp -> YiString -> EditorM ()
qrReplaceOne Window
win BufferRef
b SearchExp
re YiString
repStr
                 , [Event] -> I Event Action Event
forall event (m :: * -> *) w.
(Ord event, MonadInteract m w event, MonadFail m) =>
[event] -> m event
oneOf [Char -> Event
char Char
'q', Event -> Event
ctrl (Char -> Event
char Char
'g')] I Event Action Event -> EditorM () -> I Event Action ()
forall (m :: * -> *) a x b.
(MonadInteract m Action Event, YiAction a x, Show x) =>
m b -> a -> m ()
>>! EditorM ()
qrFinish
                 ]
        -- TODO: Yi.Regex to Text
        Right SearchExp
re = [SearchOption] -> String -> Either String SearchExp
makeSearchOptsM [] (Text -> String
T.unpack Text
replaceWhat)
        question :: Text
question = [Text] -> Text
T.unwords [ Text
"Replacing", Text
replaceWhat
                             , Text
"with", Text
replaceWith, Text
" (y,n,q,!):"
                             ]
    EditorM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM () -> YiM ()) -> EditorM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ do
      SearchExp -> EditorM ()
setRegexE SearchExp
re
      EditorM BufferRef -> EditorM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (EditorM BufferRef -> EditorM ())
-> EditorM BufferRef -> EditorM ()
forall a b. (a -> b) -> a -> b
$ Text -> KeymapEndo -> EditorM BufferRef
spawnMinibufferE Text
question (I Event Action () -> KeymapEndo
forall a b. a -> b -> a
const I Event Action ()
replaceKm)
      Window -> BufferRef -> SearchExp -> EditorM ()
qrNext Window
win BufferRef
b SearchExp
re


executeExtendedCommandE :: YiM ()
executeExtendedCommandE :: YiM ()
executeExtendedCommandE = Text -> (Text -> YiM [Text]) -> (Text -> YiM ()) -> YiM ()
withMinibuffer Text
"M-x" Text -> YiM [Text]
forall b. b -> YiM [Text]
scope Text -> YiM ()
act
  where
    act :: Text -> YiM ()
act = String -> YiM ()
execEditorAction (String -> YiM ()) -> (Text -> String) -> Text -> YiM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
    scope :: b -> YiM [Text]
scope = YiM [Text] -> b -> YiM [Text]
forall a b. a -> b -> a
const (YiM [Text] -> b -> YiM [Text]) -> YiM [Text] -> b -> YiM [Text]
forall a b. (a -> b) -> a -> b
$ (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack ([String] -> [Text]) -> YiM [String] -> YiM [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> YiM [String]
getAllNamesInScope

evalRegionE :: YiM ()
evalRegionE :: YiM ()
evalRegionE = do
  -- FIXME: do something sensible.
  YiM YiString -> YiM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (YiM YiString -> YiM ()) -> YiM YiString -> YiM ()
forall a b. (a -> b) -> a -> b
$ BufferM YiString -> YiM YiString
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM Region
getSelectRegionB BufferM Region -> (Region -> BufferM YiString) -> BufferM YiString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Region -> BufferM YiString
readRegionB)
  () -> YiM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- * Code for various commands
-- This ideally should be put in their own module,
-- without a prefix, so M-x ... would be easily implemented
-- by looking up that module's contents

-- | Insert next character, "raw"
insertNextC :: UnivArgument -> KeymapM ()
insertNextC :: UnivArgument -> I Event Action ()
insertNextC UnivArgument
a = do Event
c <- I Event Action Event
forall event (m :: * -> *) w.
(Ord event, MonadInteract m w event) =>
m event
anyEvent
                   BufferM () -> I Event Action ()
forall (m :: * -> *) ev a x.
(MonadInteract m Action ev, YiAction a x, Show x) =>
a -> m ()
write (BufferM () -> I Event Action ())
-> BufferM () -> I Event Action ()
forall a b. (a -> b) -> a -> b
$ Int -> BufferM () -> BufferM ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ (UnivArgument -> Int
argToInt UnivArgument
a) (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Char -> BufferM ()
insertB (Event -> Char
eventToChar Event
c)

-- | Convert the universal argument to a number of repetitions
argToInt :: UnivArgument -> Int
argToInt :: UnivArgument -> Int
argToInt = Int -> UnivArgument -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
1


digit :: (Event -> Event) -> KeymapM Char
digit :: (Event -> Event) -> KeymapM Char
digit Event -> Event
f = (Event -> Event) -> Char -> Char -> KeymapM Char
forall (m :: * -> *) w.
(MonadFail m, MonadInteract m w Event) =>
(Event -> Event) -> Char -> Char -> m Char
charOf Event -> Event
f Char
'0' Char
'9'

-- TODO: replace tt by digit meta
tt :: KeymapM Char
tt :: KeymapM Char
tt = do
  Event (KASCII Char
c) [Modifier]
_ <- (I Event Action Event
 -> I Event Action Event -> I Event Action Event)
-> [I Event Action Event] -> I Event Action Event
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 I Event Action Event
-> I Event Action Event -> I Event Action Event
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) ([I Event Action Event] -> I Event Action Event)
-> [I Event Action Event] -> I Event Action Event
forall a b. (a -> b) -> a -> b
$ (Char -> I Event Action Event) -> String -> [I Event Action Event]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Event -> I Event Action Event
forall event (m :: * -> *) w.
(Ord event, MonadInteract m w event) =>
event -> m event
event (Event -> I Event Action Event)
-> (Char -> Event) -> Char -> I Event Action Event
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Event
metaCh ) [Char
'0'..Char
'9']
  Char -> KeymapM Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
c


-- doing the argument precisely is kind of tedious.
-- read: http://www.gnu.org/software/emacs/manual/html_node/Arguments.html
-- and: http://www.gnu.org/software/emacs/elisp-manual/html_node/elisp_318.html
readUniversalArg :: KeymapM (Maybe Int)
readUniversalArg :: KeymapM UnivArgument
readUniversalArg = I Event Action Int -> KeymapM UnivArgument
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ((Char -> Event
ctrlCh Char
'u' Event -> I Event Action Int -> I Event Action Int
forall (m :: * -> *) action a.
MonadInteract m action Event =>
Event -> m a -> m a
?>> (String -> Int
forall a. Read a => String -> a
read (String -> Int) -> I Event Action String -> I Event Action Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeymapM Char -> I Event Action String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ((Event -> Event) -> KeymapM Char
digit Event -> Event
forall a. a -> a
id) I Event Action Int -> I Event Action Int -> I Event Action Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> I Event Action Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
4)) I Event Action Int -> I Event Action Int -> I Event Action Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (String -> Int
forall a. Read a => String -> a
read (String -> Int) -> I Event Action String -> I Event Action Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeymapM Char -> I Event Action String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some KeymapM Char
tt))


-- | Finds file and runs specified action on the resulting buffer
findFileAndDo :: T.Text -- ^ Prompt
              -> BufferM a -- ^ Action to run on the resulting buffer
              -> YiM ()
findFileAndDo :: Text -> BufferM a -> YiM ()
findFileAndDo Text
prompt BufferM a
act = Text -> (Text -> YiM ()) -> YiM ()
promptFile Text
prompt ((Text -> YiM ()) -> YiM ()) -> (Text -> YiM ()) -> YiM ()
forall a b. (a -> b) -> a -> b
$ \Text
filename -> do
  Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg (Text -> YiM ()) -> Text -> YiM ()
forall a b. (a -> b) -> a -> b
$ Text
"loading " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
filename
  String -> BufferM a -> YiM ()
forall a. String -> BufferM a -> YiM ()
openingNewFile (Text -> String
T.unpack Text
filename) BufferM a
act

-- | Open a file using the minibuffer. We have to set up some stuff to
-- allow hints and auto-completion.
findFile :: YiM ()
findFile :: YiM ()
findFile = Text -> BufferM () -> YiM ()
forall a. Text -> BufferM a -> YiM ()
findFileAndDo Text
"find file:" (BufferM () -> YiM ()) -> BufferM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ () -> BufferM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Like 'findFile' but sets the resulting buffer to read-only.
findFileReadOnly :: YiM ()
findFileReadOnly :: YiM ()
findFileReadOnly = Text -> BufferM () -> YiM ()
forall a. Text -> BufferM a -> YiM ()
findFileAndDo Text
"find file (read only):" (BufferM () -> YiM ()) -> BufferM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ (Bool -> Identity Bool) -> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c Bool
readOnlyA ((Bool -> Identity Bool) -> FBuffer -> Identity FBuffer)
-> Bool -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True

-- | Open a file in a new tab using the minibuffer.
findFileNewTab :: YiM ()
findFileNewTab :: YiM ()
findFileNewTab = Text -> (Text -> YiM ()) -> YiM ()
promptFile Text
"find file (new tab): " ((Text -> YiM ()) -> YiM ()) -> (Text -> YiM ()) -> YiM ()
forall a b. (a -> b) -> a -> b
$ \Text
filename -> do
  EditorM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor EditorM ()
newTabE
  Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg (Text -> YiM ()) -> Text -> YiM ()
forall a b. (a -> b) -> a -> b
$ Text
"loading " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
filename
  YiM (Either Text BufferRef) -> YiM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (YiM (Either Text BufferRef) -> YiM ())
-> (String -> YiM (Either Text BufferRef)) -> String -> YiM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> YiM (Either Text BufferRef)
editFile (String -> YiM ()) -> String -> YiM ()
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
filename

scrollDownE :: UnivArgument -> BufferM ()
scrollDownE :: UnivArgument -> BufferM ()
scrollDownE UnivArgument
a = case UnivArgument
a of
                 UnivArgument
Nothing -> BufferM ()
downScreenB
                 Just Int
n -> Int -> BufferM ()
scrollB Int
n

scrollUpE :: UnivArgument -> BufferM ()
scrollUpE :: UnivArgument -> BufferM ()
scrollUpE UnivArgument
a = case UnivArgument
a of
                 UnivArgument
Nothing -> BufferM ()
upScreenB
                 Just Int
n -> Int -> BufferM ()
scrollB (Int -> Int
forall a. Num a => a -> a
negate Int
n)

-- | Prompts the user for a buffer name and switches to the chosen buffer.
switchBufferE :: YiM ()
switchBufferE :: YiM ()
switchBufferE = Text
-> (BufferRef -> YiM ())
-> ([BufferRef] -> [BufferRef] -> [BufferRef])
-> YiM ()
promptingForBuffer Text
"switch to buffer:"
                  (EditorM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM () -> YiM ())
-> (BufferRef -> EditorM ()) -> BufferRef -> YiM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BufferRef -> EditorM ()
switchToBufferE) (\[BufferRef]
o [BufferRef]
b -> ([BufferRef]
b [BufferRef] -> [BufferRef] -> [BufferRef]
forall a. Eq a => [a] -> [a] -> [a]
\\ [BufferRef]
o) [BufferRef] -> [BufferRef] -> [BufferRef]
forall a. [a] -> [a] -> [a]
++ [BufferRef]
o)


-- | Prompts the user for a buffer name and kills the chosen buffer.
-- Prompts about really closing if the buffer is marked as changed
-- since last save.
killBufferE :: YiM ()
killBufferE :: YiM ()
killBufferE = Text
-> (BufferRef -> YiM ())
-> ([BufferRef] -> [BufferRef] -> [BufferRef])
-> YiM ()
promptingForBuffer Text
"kill buffer:" BufferRef -> YiM ()
k (\[BufferRef]
o [BufferRef]
b -> [BufferRef]
o [BufferRef] -> [BufferRef] -> [BufferRef]
forall a. [a] -> [a] -> [a]
++ ([BufferRef]
b [BufferRef] -> [BufferRef] -> [BufferRef]
forall a. Eq a => [a] -> [a] -> [a]
\\ [BufferRef]
o))
  where
    k :: BufferRef -> YiM ()
    k :: BufferRef -> YiM ()
k BufferRef
b = do
      FBuffer
buf <- EditorM FBuffer -> YiM FBuffer
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM FBuffer -> YiM FBuffer)
-> ((Editor -> FBuffer) -> EditorM FBuffer)
-> (Editor -> FBuffer)
-> YiM FBuffer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Editor -> FBuffer) -> EditorM FBuffer
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((Editor -> FBuffer) -> YiM FBuffer)
-> (Editor -> FBuffer) -> YiM FBuffer
forall a b. (a -> b) -> a -> b
$ BufferRef -> Editor -> FBuffer
findBufferWith BufferRef
b
      Bool
ch <- FBuffer -> YiM Bool
deservesSave FBuffer
buf
      let askKeymap :: I Event Action ()
askKeymap = [I Event Action ()] -> I Event Action ()
forall (m :: * -> *) w e a.
(MonadInteract m w e, MonadFail m) =>
[m a] -> m a
choice [ Char -> Event
char Char
'n' Event -> EditorM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! EditorM ()
closeBufferAndWindowE
                             , Char -> Event
char Char
'y' Event -> EditorM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! EditorM ()
delBuf EditorM () -> EditorM () -> EditorM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EditorM ()
closeBufferAndWindowE
                             , Char -> Event
ctrlCh Char
'g' Event -> EditorM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! EditorM ()
closeBufferAndWindowE
                             ]
          delBuf :: EditorM ()
delBuf = BufferRef -> EditorM ()
forall (m :: * -> *). MonadEditor m => BufferRef -> m ()
deleteBuffer BufferRef
b
          question :: Text
question = FBuffer -> Text
identString FBuffer
buf Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" changed, close anyway? (y/n)"
      EditorM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM () -> YiM ()) -> EditorM () -> YiM ()
forall a b. (a -> b) -> a -> b
$
         if Bool
ch
         then EditorM BufferRef -> EditorM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (EditorM BufferRef -> EditorM ())
-> EditorM BufferRef -> EditorM ()
forall a b. (a -> b) -> a -> b
$ Text -> KeymapEndo -> EditorM BufferRef
spawnMinibufferE Text
question (I Event Action () -> KeymapEndo
forall a b. a -> b -> a
const I Event Action ()
askKeymap)
         else EditorM ()
delBuf


-- | If on separators (space, tab, unicode seps), reduce multiple
-- separators to just a single separator (or however many given
-- through 'UnivArgument').
--
-- If we aren't looking at a separator, insert a single space. This is
-- like emacs ‘just-one-space’ but doesn't deal with negative argument
-- case but works with other separators than just space. What counts
-- as a separator is decided by 'isAnySep' modulo @\n@ character.
--
-- Further, it will only reduce a single type of separator at once: if
-- we have hard tabs followed by spaces, we are able to reduce one and
-- not the other.
justOneSep :: UnivArgument -> BufferM ()
justOneSep :: UnivArgument -> BufferM ()
justOneSep UnivArgument
u = BufferM Char
readB BufferM Char -> (Char -> BufferM ()) -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Char
c ->
  BufferM Point
pointB BufferM Point -> (Point -> BufferM ()) -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Point
point -> case Point
point of
    Point Int
0 -> if Char -> Bool
isSep Char
c then BufferM ()
deleteSeparators else Char -> BufferM ()
insertMult Char
c
    Point Int
x ->
      if Char -> Bool
isSep Char
c
      then BufferM ()
deleteSeparators
      else Point -> BufferM Char
readAtB (Int -> Point
Point (Int -> Point) -> Int -> Point
forall a b. (a -> b) -> a -> b
$ Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) BufferM Char -> (Char -> BufferM ()) -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Char
d ->
        -- We weren't looking at separator but there might be one behind us
        if Char -> Bool
isSep Char
d
          then TextUnit -> Direction -> BufferM ()
moveB TextUnit
Character Direction
Backward BufferM () -> BufferM () -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferM ()
deleteSeparators
          else Char -> BufferM ()
insertMult Char
' ' -- no separators, insert a space just
                              -- like emacs does
  where
    isSep :: Char -> Bool
isSep Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n' Bool -> Bool -> Bool
&& Char -> Bool
isAnySep Char
c
    insertMult :: Char -> BufferM ()
insertMult Char
c = YiString -> BufferM ()
insertN (YiString -> BufferM ()) -> YiString -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Int -> Char -> YiString
R.replicateChar (Int -> (Int -> Int) -> UnivArgument -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
1 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1) UnivArgument
u) Char
c

    deleteSeparators :: BufferM ()
deleteSeparators = do
      TextUnit -> (Direction, BoundarySide) -> Direction -> BufferM ()
genMaybeMoveB TextUnit
unitSepThisLine (Direction
Backward, BoundarySide
InsideBound) Direction
Backward
      TextUnit -> Direction -> BufferM ()
moveB TextUnit
Character Direction
Forward
      (Char -> Bool) -> BufferM () -> BufferM ()
forall a. (Char -> Bool) -> BufferM a -> BufferM ()
doIfCharB Char -> Bool
isSep (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$ TextUnit -> Direction -> BufferM ()
deleteB TextUnit
unitSepThisLine Direction
Forward



-- | Join this line to previous (or next N if universal)
joinLinesE :: UnivArgument -> BufferM ()
joinLinesE :: UnivArgument -> BufferM ()
joinLinesE UnivArgument
Nothing = () -> BufferM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
joinLinesE (Just Int
_) = do
  TextUnit -> Direction -> BufferM ()
moveB TextUnit
VLine Direction
Forward
  BufferM ()
moveToSol BufferM () -> BufferM () -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (YiString -> YiString) -> TextUnit -> Direction -> BufferM ()
transformB (YiString -> YiString -> YiString
forall a b. a -> b -> a
const YiString
" ") TextUnit
Character Direction
Backward BufferM () -> BufferM () -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> UnivArgument -> BufferM ()
justOneSep UnivArgument
forall a. Maybe a
Nothing

-- | Shortcut to use a default list when a blank list is given.
-- Used for default values to emacs queries
maybeList :: [a] -> [a] -> [a]
maybeList :: [a] -> [a] -> [a]
maybeList [a]
def [] = [a]
def
maybeList [a]
_   [a]
ls = [a]
ls

maybeTag :: Tag -> T.Text -> Tag
maybeTag :: Tag -> Text -> Tag
maybeTag Tag
def Text
t = if Text -> Bool
T.null Text
t then Tag
def else Text -> Tag
Tag Text
t

--------------------------------------------------
-- TAGS - See Yi.Tag for more info

-- | Prompt the user to give a tag and then jump to that tag
promptTag :: YiM ()
promptTag :: YiM ()
promptTag = do
  -- default tag is where the buffer is on
  Tag
defaultTag <- BufferM Tag -> YiM Tag
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM Tag -> YiM Tag) -> BufferM Tag -> YiM Tag
forall a b. (a -> b) -> a -> b
$ Text -> Tag
Tag (Text -> Tag) -> (YiString -> Text) -> YiString -> Tag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> Text
R.toText (YiString -> Tag) -> BufferM YiString -> BufferM Tag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TextUnit -> BufferM YiString
readUnitB TextUnit
unitWord
  -- if we have tags use them to generate hints
  Maybe TagTable
tagTable <- EditorM (Maybe TagTable) -> YiM (Maybe TagTable)
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor EditorM (Maybe TagTable)
getTags
  -- Hints are expensive - only lazily generate 10
  let hinter :: Text -> YiM [Text]
hinter =  [Text] -> YiM [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> YiM [Text]) -> (Text -> [Text]) -> Text -> YiM [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take Int
10 ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> [Text])
-> (TagTable -> Text -> [Text]) -> Maybe TagTable -> Text -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> [Text]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> [Text]) -> (Text -> String) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) TagTable -> Text -> [Text]
hintTags Maybe TagTable
tagTable
  -- Completions are super-cheap. Go wild
  let completer :: Text -> YiM Text
completer =  Text -> YiM Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> YiM Text) -> (Text -> Text) -> Text -> YiM Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text)
-> (TagTable -> Text -> Text) -> Maybe TagTable -> Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text -> Text
forall a. a -> a
id TagTable -> Text -> Text
completeTag Maybe TagTable
tagTable
      p :: Text
p = Text
"Find tag: (default " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Tag -> Text
_unTag Tag
defaultTag Text -> Char -> Text
`T.snoc` Char
')'
  Text
-> (Text -> YiM [Text])
-> Text
-> (Text -> YiM Text)
-> (Text -> YiM ())
-> (Text -> YiM ())
-> YiM ()
withMinibufferGen Text
"" Text -> YiM [Text]
hinter Text
p Text -> YiM Text
completer (YiM () -> Text -> YiM ()
forall a b. a -> b -> a
const (YiM () -> Text -> YiM ()) -> YiM () -> Text -> YiM ()
forall a b. (a -> b) -> a -> b
$ () -> YiM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) ((Text -> YiM ()) -> YiM ()) -> (Text -> YiM ()) -> YiM ()
forall a b. (a -> b) -> a -> b
$
    -- if the string is "" use the defaultTag
    Tag -> YiM ()
gotoTag (Tag -> YiM ()) -> (Text -> Tag) -> Text -> YiM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tag -> Text -> Tag
maybeTag Tag
defaultTag

-- | Opens the file that contains @tag@. Uses the global tag table and prompts
-- the user to open one if it does not exist
gotoTag :: Tag -> YiM ()
gotoTag :: Tag -> YiM ()
gotoTag Tag
tag =
    (TagTable -> YiM ()) -> YiM ()
visitTagTable ((TagTable -> YiM ()) -> YiM ()) -> (TagTable -> YiM ()) -> YiM ()
forall a b. (a -> b) -> a -> b
$ \TagTable
tagTable ->
        case Tag -> TagTable -> [(String, Int)]
lookupTag Tag
tag TagTable
tagTable of
          [] -> Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg (Text -> YiM ()) -> Text -> YiM ()
forall a b. (a -> b) -> a -> b
$ Text
"No tags containing " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Tag -> Text
_unTag Tag
tag
          (String
filename, Int
line):[(String, Int)]
_ -> String -> BufferM Int -> YiM ()
forall a. String -> BufferM a -> YiM ()
openingNewFile String
filename (BufferM Int -> YiM ()) -> BufferM Int -> YiM ()
forall a b. (a -> b) -> a -> b
$ Int -> BufferM Int
gotoLn Int
line

-- | Call continuation @act@ with the TagTable. Uses the global table
-- and prompts the user if it doesn't exist
visitTagTable :: (TagTable -> YiM ()) -> YiM ()
visitTagTable :: (TagTable -> YiM ()) -> YiM ()
visitTagTable TagTable -> YiM ()
act = do
  Maybe TagTable
posTagTable <- EditorM (Maybe TagTable) -> YiM (Maybe TagTable)
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor EditorM (Maybe TagTable)
getTags
  -- does the tagtable exist?
  case Maybe TagTable
posTagTable of
    Just TagTable
tagTable -> TagTable -> YiM ()
act TagTable
tagTable
    Maybe TagTable
Nothing -> Text -> (Text -> YiM ()) -> YiM ()
promptFile Text
"Visit tags table: (default tags)" ((Text -> YiM ()) -> YiM ()) -> (Text -> YiM ()) -> YiM ()
forall a b. (a -> b) -> a -> b
$ \Text
path -> do
      -- default emacs behavior, append tags
        let p :: String
p = Text -> String
T.unpack Text
path
            filename :: String
filename = String -> String -> String
forall a. [a] -> [a] -> [a]
maybeList String
"tags" (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
takeFileName String
p
        TagTable
tagTable <- IO TagTable -> YiM TagTable
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO TagTable -> YiM TagTable) -> IO TagTable -> YiM TagTable
forall a b. (a -> b) -> a -> b
$ String -> IO TagTable
importTagTable (String -> IO TagTable) -> String -> IO TagTable
forall a b. (a -> b) -> a -> b
$ String -> String
takeDirectory String
p String -> String -> String
</> String
filename
        EditorM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM () -> YiM ()) -> EditorM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ TagTable -> EditorM ()
setTags TagTable
tagTable
        TagTable -> YiM ()
act TagTable
tagTable

-- TODO: use TextUnit to count things inside region for better experience
-- | Counts the number of lines, words and characters inside selected
-- region. Coresponds to emacs' @count-words-region@.
countWordsRegion :: YiM ()
countWordsRegion :: YiM ()
countWordsRegion = do
  (Int
l, Int
w, Int
c) <- EditorM (Int, Int, Int) -> YiM (Int, Int, Int)
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM (Int, Int, Int) -> YiM (Int, Int, Int))
-> EditorM (Int, Int, Int) -> YiM (Int, Int, Int)
forall a b. (a -> b) -> a -> b
$ do
    YiString
t <- BufferM YiString -> EditorM YiString
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM YiString -> EditorM YiString)
-> BufferM YiString -> EditorM YiString
forall a b. (a -> b) -> a -> b
$ BufferM (Region, Int, Int)
getRectangle BufferM (Region, Int, Int)
-> ((Region, Int, Int) -> BufferM YiString) -> BufferM YiString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Region
reg, Int
_, Int
_) -> Region -> BufferM YiString
readRegionB Region
reg
    let nls :: Int
nls = YiString -> Int
R.countNewLines YiString
t
    (Int, Int, Int) -> EditorM (Int, Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (if Int
nls Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int
1 else Int
nls, [YiString] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([YiString] -> Int) -> [YiString] -> Int
forall a b. (a -> b) -> a -> b
$ YiString -> [YiString]
R.words YiString
t, YiString -> Int
R.length YiString
t)
  Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg (Text -> YiM ()) -> Text -> YiM ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords [ Text
"Region has", Int -> Text
forall a. Show a => a -> Text
showT Int
l, Int -> Text -> Text
forall a a. (Eq a, Num a, Semigroup a, IsString a) => a -> a -> a
p Int
l Text
"line" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
","
                        , Int -> Text
forall a. Show a => a -> Text
showT Int
w, Int -> Text -> Text
forall a a. (Eq a, Num a, Semigroup a, IsString a) => a -> a -> a
p Int
w Text
"word" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", and"
                        , Int -> Text
forall a. Show a => a -> Text
showT Int
c, Int -> Text -> Text
forall a a. (Eq a, Num a, Semigroup a, IsString a) => a -> a -> a
p Int
w Text
"character" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
                        ]
  where
    p :: a -> a -> a
p a
x a
w = if a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1 then a
w else a
w a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"s"