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

-- |
-- Module      :  Yi.Buffer.HighLevel
-- License     :  GPL-2
-- Maintainer  :  yi-devel@googlegroups.com
-- Stability   :  experimental
-- Portability :  portable
--
-- High level operations on buffers.

module Yi.Buffer.HighLevel
    ( atEof
    , atEol
    , atLastLine
    , atSol
    , atSof
    , bdeleteB
    , bdeleteLineB
    , bkillWordB
    , botB
    , bufInfoB
    , BufferFileInfo (..)
    , capitaliseWordB
    , deleteBlankLinesB
    , deleteHorizontalSpaceB
    , deleteRegionWithStyleB
    , deleteToEol
    , deleteTrailingSpaceB
    , downFromTosB
    , downScreenB
    , downScreensB
    , exchangePointAndMarkB
    , fillParagraph
    , findMatchingPairB
    , firstNonSpaceB
    , flipRectangleB
    , getBookmarkB
    , getLineAndCol
    , getLineAndColOfPoint
    , getNextLineB
    , getNextNonBlankLineB
    , getRawestSelectRegionB
    , getSelectionMarkPointB
    , getSelectRegionB
    , gotoCharacterB
    , hasWhiteSpaceBefore
    , incrementNextNumberByB
    , insertRopeWithStyleB
    , isCurrentLineAllWhiteSpaceB
    , isCurrentLineEmptyB
    , isNumberB
    , killWordB
    , lastNonSpaceB
    , leftEdgesOfRegionB
    , leftOnEol
    , lineMoveVisRel
    , linePrefixSelectionB
    , lineStreamB
    , lowercaseWordB
    , middleB
    , modifyExtendedSelectionB
    , moveNonspaceOrSol
    , movePercentageFileB
    , moveToMTB
    , moveToEol
    , moveToSol
    , moveXorEol
    , moveXorSol
    , nextCExc
    , nextCInc
    , nextCInLineExc
    , nextCInLineInc
    , nextNParagraphs
    , nextWordB
    , prevCExc
    , prevCInc
    , prevCInLineExc
    , prevCInLineInc
    , prevNParagraphs
    , prevWordB
    , readCurrentWordB
    , readLnB
    , readPrevWordB
    , readRegionRopeWithStyleB
    , replaceBufferContent
    , revertB
    , rightEdgesOfRegionB
    , scrollB
    , scrollCursorToBottomB
    , scrollCursorToTopB
    , scrollScreensB
    , scrollToCursorB
    , scrollToLineAboveWindowB
    , scrollToLineBelowWindowB
    , selectNParagraphs
    , setSelectionMarkPointB
    , setSelectRegionB
    , shapeOfBlockRegionB
    , sortLines
    , sortLinesWithRegion
    , snapInsB
    , snapScreenB
    , splitBlockRegionToContiguousSubRegionsB
    , swapB
    , switchCaseChar
    , test3CharB
    , testHexB
    , toggleCommentB
    , topB
    , unLineCommentSelectionB
    , upFromBosB
    , uppercaseWordB
    , upScreenB
    , upScreensB
    , vimScrollB
    , vimScrollByB
    , markWord
    ) where

import           Lens.Micro.Platform      (over, use, (%=), (.=), _last)
import           Control.Monad            (forM, forM_, replicateM_, unless, void, when)
import           Control.Monad.RWS.Strict (ask)
import           Control.Monad.State      (gets)
import           Data.Char                (isDigit, isHexDigit, isOctDigit, isSpace, isUpper, toLower, toUpper)
import           Data.List                (intersperse, sort)
import           Data.List.NonEmpty       (NonEmpty(..))
import           Data.Maybe               (catMaybes, fromMaybe, listToMaybe)
import           Data.Monoid              ((<>))
import qualified Data.Set                 as Set
import qualified Data.Text                as T (Text, toLower, toUpper, unpack)
import           Data.Time                (UTCTime)
import           Data.Tuple               (swap)
import           Numeric                  (readHex, readOct, showHex, showOct)
import           Yi.Buffer.Basic          (Direction (..), Mark, Point (..), Size (Size))
import           Yi.Buffer.Misc
import           Yi.Buffer.Normal
import           Yi.Buffer.Region
import           Yi.Config.Misc           (ScrollStyle (SingleLine))
import           Yi.Rope                  (YiString)
import qualified Yi.Rope                  as R
import           Yi.String                (capitalizeFirst, fillText, isBlank, mapLines, onLines, overInit)
import           Yi.Utils                 (SemiNum ((+~), (-~)))
import           Yi.Window                (Window (actualLines, width, wkey))

-- ---------------------------------------------------------------------
-- Movement operations


-- | Move point between the middle, top and bottom of the screen
-- If the point stays at the middle, it'll be gone to the top
-- else if the point stays at the top, it'll be gone to the bottom
-- else it'll be gone to the middle
moveToMTB :: BufferM ()
moveToMTB :: BufferM ()
moveToMTB = Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Int -> Int -> Bool) -> BufferM Int -> BufferM (Int -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM Int
curLn BufferM (Int -> Bool) -> BufferM Int -> BufferM Bool
forall a b. BufferM (a -> b) -> BufferM a -> BufferM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BufferM Int
screenMidLn BufferM Bool -> (Bool -> BufferM ()) -> BufferM ()
forall a b. BufferM a -> (a -> BufferM b) -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Bool
True -> Int -> BufferM ()
downFromTosB Int
0
    Bool
_    -> Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Int -> Int -> Bool) -> BufferM Int -> BufferM (Int -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM Int
curLn BufferM (Int -> Bool) -> BufferM Int -> BufferM Bool
forall a b. BufferM (a -> b) -> BufferM a -> BufferM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BufferM Int
screenTopLn BufferM Bool -> (Bool -> BufferM ()) -> BufferM ()
forall a b. BufferM a -> (a -> BufferM b) -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Bool
True -> Int -> BufferM ()
upFromBosB Int
0
                Bool
_    -> Int -> BufferM ()
downFromTosB (Int -> BufferM ()) -> BufferM Int -> BufferM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (-) (Int -> Int -> Int) -> BufferM Int -> BufferM (Int -> Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM Int
screenMidLn BufferM (Int -> Int) -> BufferM Int -> BufferM Int
forall a b. BufferM (a -> b) -> BufferM a -> BufferM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BufferM Int
screenTopLn


-- | Move point to start of line
moveToSol :: BufferM ()
moveToSol :: BufferM ()
moveToSol = TextUnit -> Direction -> BufferM ()
maybeMoveB TextUnit
Line Direction
Backward

-- | Move point to end of line
moveToEol :: BufferM ()
moveToEol :: BufferM ()
moveToEol = TextUnit -> Direction -> BufferM ()
maybeMoveB TextUnit
Line Direction
Forward

-- | Move cursor to origin
topB :: BufferM ()
topB :: BufferM ()
topB = Point -> BufferM ()
moveTo Point
0

-- | Move cursor to end of buffer
botB :: BufferM ()
botB :: BufferM ()
botB = Point -> BufferM ()
moveTo (Point -> BufferM ()) -> BufferM Point -> BufferM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BufferM Point
sizeB

-- | Move left if on eol, but not on blank line
leftOnEol :: BufferM ()
-- @savingPrefCol@ is needed, because deep down @leftB@ contains @forgetPrefCol@
-- which messes up vertical cursor motion in Vim normal mode
leftOnEol :: BufferM ()
leftOnEol = BufferM () -> BufferM ()
forall a. BufferM a -> BufferM a
savingPrefCol (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$ do
        Bool
eol <- BufferM Bool
atEol
        Bool
sol <- BufferM Bool
atSol
        Bool -> BufferM () -> BufferM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
eol Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
sol) BufferM ()
leftB

-- | Move @x@ chars back, or to the sol, whichever is less
moveXorSol :: Int -> BufferM ()
moveXorSol :: Int -> BufferM ()
moveXorSol Int
x = Int -> BufferM () -> BufferM ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
x (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$ do Bool
c <- BufferM Bool
atSol; Bool -> BufferM () -> BufferM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
c BufferM ()
leftB

-- | Move @x@ chars forward, or to the eol, whichever is less
moveXorEol :: Int -> BufferM ()
moveXorEol :: Int -> BufferM ()
moveXorEol Int
x = Int -> BufferM () -> BufferM ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
x (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$ do Bool
c <- BufferM Bool
atEol; Bool -> BufferM () -> BufferM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
c BufferM ()
rightB

-- | Move to first char of next word forwards
nextWordB :: BufferM ()
nextWordB :: BufferM ()
nextWordB = TextUnit -> Direction -> BufferM ()
moveB TextUnit
unitWord Direction
Forward

-- | Move to first char of next word backwards
prevWordB :: BufferM ()
prevWordB :: BufferM ()
prevWordB = TextUnit -> Direction -> BufferM ()
moveB TextUnit
unitWord Direction
Backward

-- * Char-based movement actions.

gotoCharacterB :: Char -> Direction -> RegionStyle -> Bool -> BufferM ()
gotoCharacterB :: Char -> Direction -> RegionStyle -> Bool -> BufferM ()
gotoCharacterB Char
c Direction
dir RegionStyle
style Bool
stopAtLineBreaks = do
    Point
start <- BufferM Point
pointB
    let predicate :: Char -> Bool
predicate = if Bool
stopAtLineBreaks then (Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
c, Char
'\n']) else (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c)
        (BufferM ()
move, BufferM ()
moveBack) = if Direction
dir Direction -> Direction -> Bool
forall a. Eq a => a -> a -> Bool
== Direction
Forward then (BufferM ()
rightB, BufferM ()
leftB) else (BufferM ()
leftB, BufferM ()
rightB)
    BufferM Bool -> BufferM () -> BufferM ()
forall a. BufferM Bool -> BufferM a -> BufferM ()
doUntilB_ (Char -> Bool
predicate (Char -> Bool) -> BufferM Char -> BufferM Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM Char
readB) BufferM ()
move
    Char
b <- BufferM Char
readB
    if Bool
stopAtLineBreaks Bool -> Bool -> Bool
&& Char
b Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n'
    then Point -> BufferM ()
moveTo Point
start
    else Bool -> BufferM () -> BufferM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RegionStyle
style RegionStyle -> RegionStyle -> Bool
forall a. Eq a => a -> a -> Bool
== RegionStyle
Exclusive Bool -> Bool -> Bool
&& Char
b Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c) BufferM ()
moveBack

-- | Move to the next occurrence of @c@
nextCInc :: Char -> BufferM ()
nextCInc :: Char -> BufferM ()
nextCInc Char
c = Char -> Direction -> RegionStyle -> Bool -> BufferM ()
gotoCharacterB Char
c Direction
Forward RegionStyle
Inclusive Bool
False

nextCInLineInc :: Char -> BufferM ()
nextCInLineInc :: Char -> BufferM ()
nextCInLineInc Char
c = Char -> Direction -> RegionStyle -> Bool -> BufferM ()
gotoCharacterB Char
c Direction
Forward RegionStyle
Inclusive Bool
True

-- | Move to the character before the next occurrence of @c@
nextCExc :: Char -> BufferM ()
nextCExc :: Char -> BufferM ()
nextCExc Char
c = Char -> Direction -> RegionStyle -> Bool -> BufferM ()
gotoCharacterB Char
c Direction
Forward RegionStyle
Exclusive Bool
False

nextCInLineExc :: Char -> BufferM ()
nextCInLineExc :: Char -> BufferM ()
nextCInLineExc Char
c = Char -> Direction -> RegionStyle -> Bool -> BufferM ()
gotoCharacterB Char
c Direction
Forward RegionStyle
Exclusive Bool
True

-- | Move to the previous occurrence of @c@
prevCInc :: Char -> BufferM ()
prevCInc :: Char -> BufferM ()
prevCInc Char
c = Char -> Direction -> RegionStyle -> Bool -> BufferM ()
gotoCharacterB Char
c Direction
Backward RegionStyle
Inclusive Bool
False

prevCInLineInc :: Char -> BufferM ()
prevCInLineInc :: Char -> BufferM ()
prevCInLineInc Char
c = Char -> Direction -> RegionStyle -> Bool -> BufferM ()
gotoCharacterB Char
c Direction
Backward RegionStyle
Inclusive Bool
True

-- | Move to the character after the previous occurrence of @c@
prevCExc :: Char -> BufferM ()
prevCExc :: Char -> BufferM ()
prevCExc Char
c = Char -> Direction -> RegionStyle -> Bool -> BufferM ()
gotoCharacterB Char
c Direction
Backward RegionStyle
Exclusive Bool
False

prevCInLineExc :: Char -> BufferM ()
prevCInLineExc :: Char -> BufferM ()
prevCInLineExc Char
c = Char -> Direction -> RegionStyle -> Bool -> BufferM ()
gotoCharacterB Char
c Direction
Backward RegionStyle
Exclusive Bool
True

-- | Move to first non-space character in this line
firstNonSpaceB :: BufferM ()
firstNonSpaceB :: BufferM ()
firstNonSpaceB = do
  BufferM ()
moveToSol
  BufferM Bool -> BufferM () -> BufferM ()
forall a. BufferM Bool -> BufferM a -> BufferM ()
untilB_ (Bool -> Bool -> Bool
(||) (Bool -> Bool -> Bool) -> BufferM Bool -> BufferM (Bool -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM Bool
atEol BufferM (Bool -> Bool) -> BufferM Bool -> BufferM Bool
forall a b. BufferM (a -> b) -> BufferM a -> BufferM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) (Char -> Bool) -> BufferM Char -> BufferM Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM Char
readB)) BufferM ()
rightB

-- | Move to the last non-space character in this line
lastNonSpaceB :: BufferM ()
lastNonSpaceB :: BufferM ()
lastNonSpaceB = do
  BufferM ()
moveToEol
  BufferM Bool -> BufferM () -> BufferM ()
forall a. BufferM Bool -> BufferM a -> BufferM ()
untilB_ (Bool -> Bool -> Bool
(||) (Bool -> Bool -> Bool) -> BufferM Bool -> BufferM (Bool -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM Bool
atSol BufferM (Bool -> Bool) -> BufferM Bool -> BufferM Bool
forall a b. BufferM (a -> b) -> BufferM a -> BufferM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) (Char -> Bool) -> BufferM Char -> BufferM Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM Char
readB)) BufferM ()
leftB

-- | Go to the first non space character in the line;
-- if already there, then go to the beginning of the line.
moveNonspaceOrSol :: BufferM ()
moveNonspaceOrSol :: BufferM ()
moveNonspaceOrSol = do
  YiString
prev <- BufferM YiString
readPreviousOfLnB
  if (Char -> Bool) -> YiString -> Bool
R.all Char -> Bool
isSpace YiString
prev then BufferM ()
moveToSol else BufferM ()
firstNonSpaceB

-- | True if current line consists of just a newline (no whitespace)
isCurrentLineEmptyB :: BufferM Bool
isCurrentLineEmptyB :: BufferM Bool
isCurrentLineEmptyB = BufferM Bool -> BufferM Bool
forall a. BufferM a -> BufferM a
savingPointB (BufferM Bool -> BufferM Bool) -> BufferM Bool -> BufferM Bool
forall a b. (a -> b) -> a -> b
$ BufferM ()
moveToSol BufferM () -> BufferM Bool -> BufferM Bool
forall a b. BufferM a -> BufferM b -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferM Bool
atEol

-- | Note: Returns False if line doesn't have any characters besides a newline
isCurrentLineAllWhiteSpaceB :: BufferM Bool
isCurrentLineAllWhiteSpaceB :: BufferM Bool
isCurrentLineAllWhiteSpaceB = BufferM Bool -> BufferM Bool
forall a. BufferM a -> BufferM a
savingPointB (BufferM Bool -> BufferM Bool) -> BufferM Bool -> BufferM Bool
forall a b. (a -> b) -> a -> b
$ do
    Bool
isEmpty <- BufferM Bool
isCurrentLineEmptyB
    if Bool
isEmpty
    then Bool -> BufferM Bool
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    else do
        let go :: BufferM Bool
go = do
                  Bool
eol <- BufferM Bool
atEol
                  if Bool
eol
                  then Bool -> BufferM Bool
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                  else do
                      Char
c <- BufferM Char
readB
                      if Char -> Bool
isSpace Char
c
                      then BufferM ()
rightB BufferM () -> BufferM Bool -> BufferM Bool
forall a b. BufferM a -> BufferM b -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferM Bool
go
                      else Bool -> BufferM Bool
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
        BufferM ()
moveToSol
        BufferM Bool
go

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

-- | Move down next @n@ paragraphs
nextNParagraphs :: Int -> BufferM ()
nextNParagraphs :: Int -> BufferM ()
nextNParagraphs Int
n = Int -> BufferM () -> BufferM ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
n (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$ TextUnit -> Direction -> BufferM ()
moveB TextUnit
unitEmacsParagraph Direction
Forward

-- | Move up prev @n@ paragraphs
prevNParagraphs :: Int -> BufferM ()
prevNParagraphs :: Int -> BufferM ()
prevNParagraphs Int
n = Int -> BufferM () -> BufferM ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
n (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$ TextUnit -> Direction -> BufferM ()
moveB TextUnit
unitEmacsParagraph Direction
Backward

-- | Select next @n@ paragraphs
selectNParagraphs :: Int -> BufferM ()
selectNParagraphs :: Int -> BufferM ()
selectNParagraphs Int
n = do
  BufferM Bool
getVisibleSelection BufferM Bool -> (Bool -> BufferM ()) -> BufferM ()
forall a b. BufferM a -> (a -> BufferM b) -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Bool
True -> BufferM ()
exchangePointAndMarkB
            BufferM () -> BufferM () -> BufferM ()
forall a b. BufferM a -> BufferM b -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> BufferM ()
nextNParagraphs Int
n BufferM () -> BufferM () -> BufferM ()
forall a b. BufferM a -> BufferM b -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Bool -> BufferM ()
setVisibleSelection Bool
True)
            BufferM () -> BufferM () -> BufferM ()
forall a b. BufferM a -> BufferM b -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferM ()
exchangePointAndMarkB
    Bool
False -> Int -> BufferM ()
nextNParagraphs Int
n BufferM () -> BufferM () -> BufferM ()
forall a b. BufferM a -> BufferM b -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Bool -> BufferM ()
setVisibleSelection Bool
True)
             BufferM () -> BufferM Point -> BufferM Point
forall a b. BufferM a -> BufferM b -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferM Point
pointB BufferM Point -> (Point -> BufferM ()) -> BufferM ()
forall a b. BufferM a -> (a -> BufferM b) -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Point -> BufferM ()
setSelectionMarkPointB BufferM () -> BufferM () -> BufferM ()
forall a b. BufferM a -> BufferM b -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> BufferM ()
prevNParagraphs Int
n

-- ! Examples:
-- @goUnmatchedB Backward '(' ')'@
-- Move to the previous unmatched '('
-- @goUnmatchedB Forward '{' '}'@
-- Move to the next unmatched '}'
goUnmatchedB :: Direction -> Char -> Char -> BufferM ()
goUnmatchedB :: Direction -> Char -> Char -> BufferM ()
goUnmatchedB Direction
dir Char
cStart' Char
cStop' = BufferM (Int, Int)
getLineAndCol BufferM (Int, Int) -> ((Int, Int) -> BufferM ()) -> BufferM ()
forall a b. BufferM a -> (a -> BufferM b) -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Int, Int)
position ->
    BufferM ()
stepB BufferM () -> BufferM Char -> BufferM Char
forall a b. BufferM a -> BufferM b -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferM Char
readB BufferM Char -> (Char -> BufferM ()) -> BufferM ()
forall a b. BufferM a -> (a -> BufferM b) -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int, Int) -> Int -> Char -> BufferM ()
forall {t}. (Eq t, Num t) => (Int, Int) -> t -> Char -> BufferM ()
go (Int, Int)
position (Int
0::Int)
    where
        go :: (Int, Int) -> t -> Char -> BufferM ()
go (Int, Int)
pos t
opened Char
c
           | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
cStop Bool -> Bool -> Bool
&& t
opened t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0 = () -> BufferM ()
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
           | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
cStop       = (Int, Int) -> t -> BufferM ()
goIfNotEofSof (Int, Int)
pos (t
openedt -> t -> t
forall a. Num a => a -> a -> a
-t
1)
           | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
cStart      = (Int, Int) -> t -> BufferM ()
goIfNotEofSof (Int, Int)
pos (t
openedt -> t -> t
forall a. Num a => a -> a -> a
+t
1)
           | Bool
otherwise        = (Int, Int) -> t -> BufferM ()
goIfNotEofSof (Int, Int)
pos  t
opened
        goIfNotEofSof :: (Int, Int) -> t -> BufferM ()
goIfNotEofSof (Int, Int)
pos t
opened = BufferM Bool
atEof BufferM Bool -> (Bool -> BufferM ()) -> BufferM ()
forall a b. BufferM a -> (a -> BufferM b) -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
eof -> BufferM Bool
atSof BufferM Bool -> (Bool -> BufferM ()) -> BufferM ()
forall a b. BufferM a -> (a -> BufferM b) -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
sof ->
            if Bool -> Bool
not Bool
eof Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
sof
                then BufferM ()
stepB BufferM () -> BufferM Char -> BufferM Char
forall a b. BufferM a -> BufferM b -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferM Char
readB BufferM Char -> (Char -> BufferM ()) -> BufferM ()
forall a b. BufferM a -> (a -> BufferM b) -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int, Int) -> t -> Char -> BufferM ()
go (Int, Int)
pos t
opened
                else Int -> BufferM Int
gotoLn ((Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
pos) BufferM Int -> BufferM () -> BufferM ()
forall a b. BufferM a -> BufferM b -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> BufferM ()
moveToColB ((Int, Int) -> Int
forall a b. (a, b) -> b
snd (Int, Int)
pos)
        (BufferM ()
stepB, Char
cStart, Char
cStop) | Direction
dir Direction -> Direction -> Bool
forall a. Eq a => a -> a -> Bool
== Direction
Forward = (BufferM ()
rightB, Char
cStart', Char
cStop')
                               | Bool
otherwise      = (BufferM ()
leftB, Char
cStop', Char
cStart')

-----------------------------------------------------------------------
-- Queries

-- | Return true if the current point is the start of a line
atSol :: BufferM Bool
atSol :: BufferM Bool
atSol = TextUnit -> Direction -> BufferM Bool
atBoundaryB TextUnit
Line Direction
Backward

-- | Return true if the current point is the end of a line
atEol :: BufferM Bool
atEol :: BufferM Bool
atEol = TextUnit -> Direction -> BufferM Bool
atBoundaryB TextUnit
Line Direction
Forward

-- | True if point at start of file
atSof :: BufferM Bool
atSof :: BufferM Bool
atSof = TextUnit -> Direction -> BufferM Bool
atBoundaryB TextUnit
Document Direction
Backward

-- | True if point at end of file
atEof :: BufferM Bool
atEof :: BufferM Bool
atEof = TextUnit -> Direction -> BufferM Bool
atBoundaryB TextUnit
Document Direction
Forward

-- | True if point at the last line
atLastLine :: BufferM Bool
atLastLine :: BufferM Bool
atLastLine = BufferM Bool -> BufferM Bool
forall a. BufferM a -> BufferM a
savingPointB (BufferM Bool -> BufferM Bool) -> BufferM Bool -> BufferM Bool
forall a b. (a -> b) -> a -> b
$ do
    BufferM ()
moveToEol
    Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Point -> Point -> Bool)
-> BufferM Point -> BufferM (Point -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM Point
sizeB BufferM (Point -> Bool) -> BufferM Point -> BufferM Bool
forall a b. BufferM (a -> b) -> BufferM a -> BufferM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BufferM Point
pointB

-- | Get the current line and column number
getLineAndCol :: BufferM (Int, Int)
getLineAndCol :: BufferM (Int, Int)
getLineAndCol = (,) (Int -> Int -> (Int, Int))
-> BufferM Int -> BufferM (Int -> (Int, Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM Int
curLn BufferM (Int -> (Int, Int)) -> BufferM Int -> BufferM (Int, Int)
forall a b. BufferM (a -> b) -> BufferM a -> BufferM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BufferM Int
curCol

getLineAndColOfPoint :: Point -> BufferM (Int, Int)
getLineAndColOfPoint :: Point -> BufferM (Int, Int)
getLineAndColOfPoint Point
p = BufferM (Int, Int) -> BufferM (Int, Int)
forall a. BufferM a -> BufferM a
savingPointB (BufferM (Int, Int) -> BufferM (Int, Int))
-> BufferM (Int, Int) -> BufferM (Int, Int)
forall a b. (a -> b) -> a -> b
$ Point -> BufferM ()
moveTo Point
p BufferM () -> BufferM (Int, Int) -> BufferM (Int, Int)
forall a b. BufferM a -> BufferM b -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferM (Int, Int)
getLineAndCol

-- | Read the line the point is on
readLnB :: BufferM YiString
readLnB :: BufferM YiString
readLnB = TextUnit -> BufferM YiString
readUnitB TextUnit
Line

-- | Read from point to beginning of line
readPreviousOfLnB :: BufferM YiString
readPreviousOfLnB :: BufferM YiString
readPreviousOfLnB = Region -> BufferM YiString
readRegionB (Region -> BufferM YiString) -> BufferM Region -> BufferM YiString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TextUnit -> Direction -> BufferM Region
regionOfPartB TextUnit
Line Direction
Backward

hasWhiteSpaceBefore :: BufferM Bool
hasWhiteSpaceBefore :: BufferM Bool
hasWhiteSpaceBefore = (Char -> Bool) -> BufferM Char -> BufferM Bool
forall a b. (a -> b) -> BufferM a -> BufferM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Bool
isSpace (BufferM Point
prevPointB BufferM Point -> (Point -> BufferM Char) -> BufferM Char
forall a b. BufferM a -> (a -> BufferM b) -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Point -> BufferM Char
readAtB)

-- | Get the previous point, unless at the beginning of the file
prevPointB :: BufferM Point
prevPointB :: BufferM Point
prevPointB = do
  Bool
sof <- BufferM Bool
atSof
  if Bool
sof then BufferM Point
pointB
         else do Point
p <- BufferM Point
pointB
                 Point -> BufferM Point
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Point -> BufferM Point) -> Point -> BufferM Point
forall a b. (a -> b) -> a -> b
$ Int -> Point
Point (Point -> Int
fromPoint Point
p Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

-- | Reads in word at point.
readCurrentWordB :: BufferM YiString
readCurrentWordB :: BufferM YiString
readCurrentWordB = TextUnit -> BufferM YiString
readUnitB TextUnit
unitWord

-- | Reads in word before point.
readPrevWordB :: BufferM YiString
readPrevWordB :: BufferM YiString
readPrevWordB = TextUnit -> BufferM YiString
readPrevUnitB TextUnit
unitViWordOnLine

-------------------------
-- Deletes

-- | Delete one character backward
bdeleteB :: BufferM ()
bdeleteB :: BufferM ()
bdeleteB = TextUnit -> Direction -> BufferM ()
deleteB TextUnit
Character Direction
Backward

-- | Delete forward whitespace or non-whitespace depending on
-- the character under point.
killWordB :: BufferM ()
killWordB :: BufferM ()
killWordB = TextUnit -> Direction -> BufferM ()
deleteB TextUnit
unitWord Direction
Forward

-- | Delete backward whitespace or non-whitespace depending on
-- the character before point.
bkillWordB :: BufferM ()
bkillWordB :: BufferM ()
bkillWordB = TextUnit -> Direction -> BufferM ()
deleteB TextUnit
unitWord Direction
Backward

-- | Delete backward to the sof or the new line character
bdeleteLineB :: BufferM ()
bdeleteLineB :: BufferM ()
bdeleteLineB = BufferM Bool
atSol BufferM Bool -> (Bool -> BufferM ()) -> BufferM ()
forall a b. BufferM a -> (a -> BufferM b) -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
sol -> if Bool
sol then BufferM ()
bdeleteB else TextUnit -> Direction -> BufferM ()
deleteB TextUnit
Line Direction
Backward


-- UnivArgument is in Yi.Keymap.Emacs.Utils but we can't import it due
-- to cyclic imports.
-- | emacs' @delete-horizontal-space@ with the optional argument.
deleteHorizontalSpaceB :: Maybe Int -> BufferM ()
deleteHorizontalSpaceB :: Maybe Int -> BufferM ()
deleteHorizontalSpaceB Maybe Int
u = do
  Int
c <- BufferM Int
curCol
  Region
reg <- TextUnit -> BufferM Region
regionOfB TextUnit
Line
  YiString
text <- Region -> BufferM YiString
readRegionB Region
reg
  let (YiString
r, Int
jb) = Int -> YiString -> (YiString, Int)
deleteSpaces Int
c YiString
text
  (YiString -> YiString) -> Region -> BufferM ()
modifyRegionB (YiString -> YiString -> YiString
forall a b. a -> b -> a
const YiString
r) Region
reg
  -- Jump backwards to where the now-deleted spaces have started so
  -- it's consistent and feels natural instead of leaving us somewhere
  -- in the text.
  Int -> BufferM ()
moveToColB (Int -> BufferM ()) -> Int -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
jb
  where
    deleteSpaces :: Int -> R.YiString -> (R.YiString, Int)
    deleteSpaces :: Int -> YiString -> (YiString, Int)
deleteSpaces Int
c YiString
l =
      let (YiString
f, YiString
b) = Int -> YiString -> (YiString, YiString)
R.splitAt Int
c YiString
l
          f' :: YiString
f' = (Char -> Bool) -> YiString -> YiString
R.dropWhileEnd Char -> Bool
isSpace YiString
f
          cleaned :: YiString
cleaned = YiString
f' YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> case Maybe Int
u of
            Maybe Int
Nothing -> (Char -> Bool) -> YiString -> YiString
R.dropWhile Char -> Bool
isSpace YiString
b
            Just Int
_ -> YiString
b
      -- We only want to jump back the number of spaces before the
      -- point, not the total number of characters we're removing.
      in (YiString
cleaned, YiString -> Int
R.length YiString
f Int -> Int -> Int
forall a. Num a => a -> a -> a
- YiString -> Int
R.length YiString
f')

----------------------------------------
-- Transform operations

-- | capitalise the word under the cursor
uppercaseWordB :: BufferM ()
uppercaseWordB :: BufferM ()
uppercaseWordB = (YiString -> YiString) -> TextUnit -> Direction -> BufferM ()
transformB ((Text -> Text) -> YiString -> YiString
R.withText Text -> Text
T.toUpper) TextUnit
unitWord Direction
Forward

-- | lowerise word under the cursor
lowercaseWordB :: BufferM ()
lowercaseWordB :: BufferM ()
lowercaseWordB = (YiString -> YiString) -> TextUnit -> Direction -> BufferM ()
transformB ((Text -> Text) -> YiString -> YiString
R.withText Text -> Text
T.toLower) TextUnit
unitWord Direction
Forward

-- | capitalise the first letter of this word
capitaliseWordB :: BufferM ()
capitaliseWordB :: BufferM ()
capitaliseWordB = (YiString -> YiString) -> TextUnit -> Direction -> BufferM ()
transformB YiString -> YiString
capitalizeFirst TextUnit
unitWord Direction
Forward

switchCaseChar :: Char -> Char
switchCaseChar :: Char -> Char
switchCaseChar Char
c = if Char -> Bool
isUpper Char
c then Char -> Char
toLower Char
c else Char -> Char
toUpper Char
c

-- | Delete to the end of line, excluding it.
deleteToEol :: BufferM ()
deleteToEol :: BufferM ()
deleteToEol = Region -> BufferM ()
deleteRegionB (Region -> BufferM ()) -> BufferM Region -> BufferM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TextUnit -> Direction -> BufferM Region
regionOfPartB TextUnit
Line Direction
Forward

-- | Transpose two characters, (the Emacs C-t action)
swapB :: BufferM ()
swapB :: BufferM ()
swapB = do Bool
eol <- BufferM Bool
atEol
           Bool -> BufferM () -> BufferM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
eol BufferM ()
leftB
           TextUnit -> Direction -> BufferM ()
transposeB TextUnit
Character Direction
Forward

-- | Delete trailing whitespace from all lines. Uses 'savingPositionB'
-- to get back to where it was.
deleteTrailingSpaceB :: BufferM ()
deleteTrailingSpaceB :: BufferM ()
deleteTrailingSpaceB =
  TextUnit -> BufferM Region
regionOfB TextUnit
Document BufferM Region -> (Region -> BufferM ()) -> BufferM ()
forall a b. BufferM a -> (a -> BufferM b) -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
  BufferM () -> BufferM ()
forall a. BufferM a -> BufferM a
savingPositionB (BufferM () -> BufferM ())
-> (Region -> BufferM ()) -> Region -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (YiString -> YiString) -> Region -> BufferM ()
modifyRegionB (YiString -> YiString
tru (YiString -> YiString)
-> (YiString -> YiString) -> YiString -> YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (YiString -> YiString) -> YiString -> YiString
mapLines YiString -> YiString
stripEnd)
  where
    -- Strips the space from the end of each line, preserving
    -- newlines.
    stripEnd :: R.YiString -> R.YiString
    stripEnd :: YiString -> YiString
stripEnd YiString
x = case YiString -> Maybe Char
R.last YiString
x of
      Maybe Char
Nothing -> YiString
x
      Just Char
'\n' -> (YiString -> Char -> YiString
`R.snoc` Char
'\n') (YiString -> YiString) -> YiString -> YiString
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> YiString -> YiString
R.dropWhileEnd Char -> Bool
isSpace YiString
x
      Maybe Char
_ -> (Char -> Bool) -> YiString -> YiString
R.dropWhileEnd Char -> Bool
isSpace YiString
x

    -- | Cut off trailing newlines, making sure to preserve one.
    tru :: R.YiString -> R.YiString
    tru :: YiString -> YiString
tru YiString
x = if YiString -> Int
R.length YiString
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
            then YiString
x
            else (YiString -> Char -> YiString
`R.snoc` Char
'\n') (YiString -> YiString) -> YiString -> YiString
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> YiString -> YiString
R.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') YiString
x

-- ----------------------------------------------------
-- | Marks

-- | Set the current buffer selection mark
setSelectionMarkPointB :: Point -> BufferM ()
setSelectionMarkPointB :: Point -> BufferM ()
setSelectionMarkPointB Point
p = (ASetter FBuffer FBuffer Point Point -> Point -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Point
p) (ASetter FBuffer FBuffer Point Point -> BufferM ())
-> (Mark -> ASetter FBuffer FBuffer Point Point)
-> Mark
-> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mark -> ASetter FBuffer FBuffer Point Point
forall (f :: * -> *).
Functor f =>
Mark -> (Point -> f Point) -> FBuffer -> f FBuffer
markPointA (Mark -> BufferM ()) -> BufferM Mark -> BufferM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MarkSet Mark -> Mark
forall a. MarkSet a -> a
selMark (MarkSet Mark -> Mark) -> BufferM (MarkSet Mark) -> BufferM Mark
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM (MarkSet Mark)
askMarks

-- | Get the current buffer selection mark
getSelectionMarkPointB :: BufferM Point
getSelectionMarkPointB :: BufferM Point
getSelectionMarkPointB = Getting Point FBuffer Point -> BufferM Point
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting Point FBuffer Point -> BufferM Point)
-> (Mark -> Getting Point FBuffer Point) -> Mark -> BufferM Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mark -> Getting Point FBuffer Point
forall (f :: * -> *).
Functor f =>
Mark -> (Point -> f Point) -> FBuffer -> f FBuffer
markPointA (Mark -> BufferM Point) -> BufferM Mark -> BufferM Point
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MarkSet Mark -> Mark
forall a. MarkSet a -> a
selMark (MarkSet Mark -> Mark) -> BufferM (MarkSet Mark) -> BufferM Mark
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM (MarkSet Mark)
askMarks

-- | Exchange point & mark.
exchangePointAndMarkB :: BufferM ()
exchangePointAndMarkB :: BufferM ()
exchangePointAndMarkB = do Point
m <- BufferM Point
getSelectionMarkPointB
                           Point
p <- BufferM Point
pointB
                           Point -> BufferM ()
setSelectionMarkPointB Point
p
                           Point -> BufferM ()
moveTo Point
m

getBookmarkB :: String -> BufferM Mark
getBookmarkB :: [Char] -> BufferM Mark
getBookmarkB = Maybe [Char] -> BufferM Mark
getMarkB (Maybe [Char] -> BufferM Mark)
-> ([Char] -> Maybe [Char]) -> [Char] -> BufferM Mark
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just


-- ---------------------------------------------------------------------
-- Buffer operations

data BufferFileInfo =
    BufferFileInfo { BufferFileInfo -> [Char]
bufInfoFileName :: FilePath
                   , BufferFileInfo -> Int
bufInfoSize     :: Int
                   , BufferFileInfo -> Int
bufInfoLineNo   :: Int
                   , BufferFileInfo -> Int
bufInfoColNo    :: Int
                   , BufferFileInfo -> Point
bufInfoCharNo   :: Point
                   , BufferFileInfo -> Text
bufInfoPercent  :: T.Text
                   , BufferFileInfo -> Bool
bufInfoModified :: Bool
                   }

-- | File info, size in chars, line no, col num, char num, percent
bufInfoB :: BufferM BufferFileInfo
bufInfoB :: BufferM BufferFileInfo
bufInfoB = do
    Point
s <- BufferM Point
sizeB
    Point
p <- BufferM Point
pointB
    Bool
m <- (FBuffer -> Bool) -> BufferM Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FBuffer -> Bool
isUnchangedBuffer
    Int
l <- BufferM Int
curLn
    Int
c <- BufferM Int
curCol
    Text
nm <- (FBuffer -> Text) -> BufferM Text
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FBuffer -> Text
identString
    let bufInfo :: BufferFileInfo
bufInfo = BufferFileInfo { bufInfoFileName :: [Char]
bufInfoFileName = Text -> [Char]
T.unpack Text
nm
                                 , bufInfoSize :: Int
bufInfoSize     = Point -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Point
s
                                 , bufInfoLineNo :: Int
bufInfoLineNo   = Int
l
                                 , bufInfoColNo :: Int
bufInfoColNo    = Int
c
                                 , bufInfoCharNo :: Point
bufInfoCharNo   = Point
p
                                 , bufInfoPercent :: Text
bufInfoPercent  = Point -> Point -> Text
getPercent Point
p Point
s
                                 , bufInfoModified :: Bool
bufInfoModified = Bool -> Bool
not Bool
m
                                 }
    BufferFileInfo -> BufferM BufferFileInfo
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return BufferFileInfo
bufInfo

-----------------------------
-- Window-related operations

upScreensB :: Int -> BufferM ()
upScreensB :: Int -> BufferM ()
upScreensB = Int -> BufferM ()
scrollScreensB (Int -> BufferM ()) -> (Int -> Int) -> Int -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Num a => a -> a
negate

downScreensB :: Int -> BufferM ()
downScreensB :: Int -> BufferM ()
downScreensB = Int -> BufferM ()
scrollScreensB

-- | Scroll up 1 screen
upScreenB :: BufferM ()
upScreenB :: BufferM ()
upScreenB = Int -> BufferM ()
scrollScreensB (-Int
1)

-- | Scroll down 1 screen
downScreenB :: BufferM ()
downScreenB :: BufferM ()
downScreenB = Int -> BufferM ()
scrollScreensB Int
1

-- | Scroll by n screens (negative for up)
scrollScreensB :: Int -> BufferM ()
scrollScreensB :: Int -> BufferM ()
scrollScreensB Int
n = do
    Int
h <- (Window -> Int) -> BufferM Int
forall a. (Window -> a) -> BufferM a
askWindow Window -> Int
actualLines
    Int -> BufferM ()
scrollB (Int -> BufferM ()) -> Int -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) -- subtract some amount to get some overlap (emacs-like).

-- | Same as scrollB, but also moves the cursor
vimScrollB :: Int -> BufferM ()
vimScrollB :: Int -> BufferM ()
vimScrollB Int
n = do Int -> BufferM ()
scrollB Int
n
                  BufferM Int -> BufferM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (BufferM Int -> BufferM ()) -> BufferM Int -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Int -> BufferM Int
lineMoveRel Int
n

-- | Same as scrollByB, but also moves the cursor
vimScrollByB :: (Int -> Int) -> Int -> BufferM ()
vimScrollByB :: (Int -> Int) -> Int -> BufferM ()
vimScrollByB Int -> Int
f Int
n = do Int
h <- (Window -> Int) -> BufferM Int
forall a. (Window -> a) -> BufferM a
askWindow Window -> Int
actualLines
                      Int -> BufferM ()
vimScrollB (Int -> BufferM ()) -> Int -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int
f Int
h

-- | Move to middle line in screen
scrollToCursorB :: BufferM ()
scrollToCursorB :: BufferM ()
scrollToCursorB = do
    MarkSet Int
f Int
i Int
_ <- BufferM (MarkSet Int)
markLines
    Int
h <- (Window -> Int) -> BufferM Int
forall a. (Window -> a) -> BufferM a
askWindow Window -> Int
actualLines
    let m :: Int
m = Int
f Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
h Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)
    Int -> BufferM ()
scrollB (Int -> BufferM ()) -> Int -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
m

-- | Move cursor to the top of the screen
scrollCursorToTopB :: BufferM ()
scrollCursorToTopB :: BufferM ()
scrollCursorToTopB = do
    MarkSet Int
f Int
i Int
_ <- BufferM (MarkSet Int)
markLines
    Int -> BufferM ()
scrollB (Int -> BufferM ()) -> Int -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
f

-- | Move cursor to the bottom of the screen
scrollCursorToBottomB :: BufferM ()
scrollCursorToBottomB :: BufferM ()
scrollCursorToBottomB = do
    -- NOTE: This is only an approximation.
    --       The correct scroll amount depends on how many lines just above
    --       the current viewport are going to be wrapped. We don't have this
    --       information here as wrapping is done in the frontend.
    MarkSet Int
f Int
i Int
_ <- BufferM (MarkSet Int)
markLines
    Int
h <- (Window -> Int) -> BufferM Int
forall a. (Window -> a) -> BufferM a
askWindow Window -> Int
actualLines
    Int -> BufferM ()
scrollB (Int -> BufferM ()) -> Int -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
f Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

-- | Scroll by n lines.
scrollB :: Int -> BufferM ()
scrollB :: Int -> BufferM ()
scrollB Int
n = do
  MarkSet Mark
fr Mark
_ Mark
_ <- BufferM (MarkSet Mark)
askMarks
  BufferM () -> BufferM ()
forall a. BufferM a -> BufferM a
savingPointB (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$ do
    Point -> BufferM ()
moveTo (Point -> BufferM ()) -> BufferM Point -> BufferM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Getting Point FBuffer Point -> BufferM Point
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Mark -> Getting Point FBuffer Point
forall (f :: * -> *).
Functor f =>
Mark -> (Point -> f Point) -> FBuffer -> f FBuffer
markPointA Mark
fr)
    BufferM Int -> BufferM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (BufferM Int -> BufferM ()) -> BufferM Int -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Int -> BufferM Int
gotoLnFrom Int
n
    (Mark -> ASetter FBuffer FBuffer Point Point
forall (f :: * -> *).
Functor f =>
Mark -> (Point -> f Point) -> FBuffer -> f FBuffer
markPointA Mark
fr ASetter FBuffer FBuffer Point Point -> Point -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.=) (Point -> BufferM ()) -> BufferM Point -> BufferM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BufferM Point
pointB
  WindowRef
w <- (Window -> WindowRef) -> BufferM WindowRef
forall a. (Window -> a) -> BufferM a
askWindow Window -> WindowRef
wkey
  (Set WindowRef -> Identity (Set WindowRef))
-> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c (Set WindowRef)
Lens' FBuffer (Set WindowRef)
pointFollowsWindowA ((Set WindowRef -> Identity (Set WindowRef))
 -> FBuffer -> Identity FBuffer)
-> (Set WindowRef -> Set WindowRef) -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= WindowRef -> Set WindowRef -> Set WindowRef
forall a. Ord a => a -> Set a -> Set a
Set.insert WindowRef
w

-- Scroll line above window to the bottom.
scrollToLineAboveWindowB :: BufferM ()
scrollToLineAboveWindowB :: BufferM ()
scrollToLineAboveWindowB = do
    Int -> BufferM ()
downFromTosB Int
0
    Int -> BufferM () -> BufferM ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
1 BufferM ()
lineUp
    BufferM ()
scrollCursorToBottomB

-- Scroll line below window to the top.
scrollToLineBelowWindowB :: BufferM ()
scrollToLineBelowWindowB :: BufferM ()
scrollToLineBelowWindowB = do
    Int -> BufferM ()
upFromBosB Int
0
    Int -> BufferM () -> BufferM ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
1 BufferM ()
lineDown
    BufferM ()
scrollCursorToTopB

-- | Move the point to inside the viewable region
snapInsB :: BufferM ()
snapInsB :: BufferM ()
snapInsB = do
    WindowRef
w <- (Window -> WindowRef) -> BufferM WindowRef
forall a. (Window -> a) -> BufferM a
askWindow Window -> WindowRef
wkey
    Bool
movePoint <- WindowRef -> Set WindowRef -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member WindowRef
w (Set WindowRef -> Bool) -> BufferM (Set WindowRef) -> BufferM Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting (Set WindowRef) FBuffer (Set WindowRef)
-> BufferM (Set WindowRef)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Set WindowRef) FBuffer (Set WindowRef)
forall c. HasAttributes c => Lens' c (Set WindowRef)
Lens' FBuffer (Set WindowRef)
pointFollowsWindowA
    Bool -> BufferM () -> BufferM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
movePoint (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$ do
        Region
r <- BufferM Region
winRegionB
        Point
p <- BufferM Point
pointB
        Point -> BufferM ()
moveTo (Point -> BufferM ()) -> Point -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Point -> Point -> Point
forall a. Ord a => a -> a -> a
max (Region -> Point
regionStart Region
r) (Point -> Point) -> Point -> Point
forall a b. (a -> b) -> a -> b
$ Point -> Point -> Point
forall a. Ord a => a -> a -> a
min (Region -> Point
regionEnd Region
r) Point
p

-- | return index of Sol on line @n@ above current line
indexOfSolAbove :: Int -> BufferM Point
indexOfSolAbove :: Int -> BufferM Point
indexOfSolAbove Int
n = BufferM Int -> BufferM Point
forall a. BufferM a -> BufferM Point
pointAt (BufferM Int -> BufferM Point) -> BufferM Int -> BufferM Point
forall a b. (a -> b) -> a -> b
$ Int -> BufferM Int
gotoLnFrom (Int -> Int
forall a. Num a => a -> a
negate Int
n)

data RelPosition = Above | Below | Within
  deriving (Int -> RelPosition -> ShowS
[RelPosition] -> ShowS
RelPosition -> [Char]
(Int -> RelPosition -> ShowS)
-> (RelPosition -> [Char])
-> ([RelPosition] -> ShowS)
-> Show RelPosition
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RelPosition -> ShowS
showsPrec :: Int -> RelPosition -> ShowS
$cshow :: RelPosition -> [Char]
show :: RelPosition -> [Char]
$cshowList :: [RelPosition] -> ShowS
showList :: [RelPosition] -> ShowS
Show)

-- | return relative position of the point @p@
-- relative to the region defined by the points @rs@ and @re@
pointScreenRelPosition :: Point -> Point -> Point -> RelPosition
pointScreenRelPosition :: Point -> Point -> Point -> RelPosition
pointScreenRelPosition Point
p Point
rs Point
re
  | Point
rs Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
> Point
p Bool -> Bool -> Bool
&& Point
p Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
> Point
re = RelPosition
Within
  | Point
p Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
< Point
rs = RelPosition
Above
  | Point
p Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
> Point
re = RelPosition
Below
pointScreenRelPosition Point
_ Point
_ Point
_ = RelPosition
Within -- just to disable the non-exhaustive pattern match warning

-- | Move the visible region to include the point
snapScreenB :: Maybe ScrollStyle -> BufferM Bool
snapScreenB :: Maybe ScrollStyle -> BufferM Bool
snapScreenB Maybe ScrollStyle
style = do
    WindowRef
w <- (Window -> WindowRef) -> BufferM WindowRef
forall a. (Window -> a) -> BufferM a
askWindow Window -> WindowRef
wkey
    Bool
movePoint <- WindowRef -> Set WindowRef -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member WindowRef
w (Set WindowRef -> Bool) -> BufferM (Set WindowRef) -> BufferM Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting (Set WindowRef) FBuffer (Set WindowRef)
-> BufferM (Set WindowRef)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Set WindowRef) FBuffer (Set WindowRef)
forall c. HasAttributes c => Lens' c (Set WindowRef)
Lens' FBuffer (Set WindowRef)
pointFollowsWindowA
    if Bool
movePoint then Bool -> BufferM Bool
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False else do
        Bool
inWin <- Point -> BufferM Bool
pointInWindowB (Point -> BufferM Bool) -> BufferM Point -> BufferM Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BufferM Point
pointB
        if Bool
inWin then Bool -> BufferM Bool
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False else do
            Int
h <- (Window -> Int) -> BufferM Int
forall a. (Window -> a) -> BufferM a
askWindow Window -> Int
actualLines
            Region
r <- BufferM Region
winRegionB
            Point
p <- BufferM Point
pointB
            let gap :: Int
gap = case Maybe ScrollStyle
style of
                        Just ScrollStyle
SingleLine -> case Point -> Point -> Point -> RelPosition
pointScreenRelPosition Point
p (Region -> Point
regionStart Region
r) (Region -> Point
regionEnd Region
r) of
                                             RelPosition
Above  -> Int
0
                                             RelPosition
Below  -> Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
                                             RelPosition
Within -> Int
0 -- Impossible but handle it anyway
                        Maybe ScrollStyle
_               -> Int
h Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
            Point
i <- Int -> BufferM Point
indexOfSolAbove Int
gap
            Mark
f <- MarkSet Mark -> Mark
forall a. MarkSet a -> a
fromMark (MarkSet Mark -> Mark) -> BufferM (MarkSet Mark) -> BufferM Mark
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM (MarkSet Mark)
askMarks
            Mark -> ASetter FBuffer FBuffer Point Point
forall (f :: * -> *).
Functor f =>
Mark -> (Point -> f Point) -> FBuffer -> f FBuffer
markPointA Mark
f ASetter FBuffer FBuffer Point Point -> Point -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Point
i
            Bool -> BufferM Bool
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True


-- | Move to @n@ lines down from top of screen
downFromTosB :: Int -> BufferM ()
downFromTosB :: Int -> BufferM ()
downFromTosB Int
n = do
  Point -> BufferM ()
moveTo (Point -> BufferM ()) -> BufferM Point -> BufferM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Getting Point FBuffer Point -> BufferM Point
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting Point FBuffer Point -> BufferM Point)
-> (Mark -> Getting Point FBuffer Point) -> Mark -> BufferM Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mark -> Getting Point FBuffer Point
forall (f :: * -> *).
Functor f =>
Mark -> (Point -> f Point) -> FBuffer -> f FBuffer
markPointA (Mark -> BufferM Point) -> BufferM Mark -> BufferM Point
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MarkSet Mark -> Mark
forall a. MarkSet a -> a
fromMark (MarkSet Mark -> Mark) -> BufferM (MarkSet Mark) -> BufferM Mark
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM (MarkSet Mark)
askMarks
  Int -> BufferM () -> BufferM ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
n BufferM ()
lineDown

-- | Move to @n@ lines up from the bottom of the screen
upFromBosB :: Int -> BufferM ()
upFromBosB :: Int -> BufferM ()
upFromBosB Int
n = do
  Region
r <- BufferM Region
winRegionB
  Point -> BufferM ()
moveTo (Region -> Point
regionEnd Region
r Point -> Point -> Point
forall a. Num a => a -> a -> a
- Point
1)
  BufferM ()
moveToSol
  Int -> BufferM () -> BufferM ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
n BufferM ()
lineUp

-- | Move to middle line in screen
middleB :: BufferM ()
middleB :: BufferM ()
middleB = do
  Window
w <- BufferM Window
forall r (m :: * -> *). MonadReader r m => m r
ask
  Mark
f <- MarkSet Mark -> Mark
forall a. MarkSet a -> a
fromMark (MarkSet Mark -> Mark) -> BufferM (MarkSet Mark) -> BufferM Mark
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM (MarkSet Mark)
askMarks
  Point -> BufferM ()
moveTo (Point -> BufferM ()) -> BufferM Point -> BufferM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Getting Point FBuffer Point -> BufferM Point
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Mark -> Getting Point FBuffer Point
forall (f :: * -> *).
Functor f =>
Mark -> (Point -> f Point) -> FBuffer -> f FBuffer
markPointA Mark
f)
  Int -> BufferM () -> BufferM ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ (Window -> Int
actualLines Window
w Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) BufferM ()
lineDown

pointInWindowB :: Point -> BufferM Bool
pointInWindowB :: Point -> BufferM Bool
pointInWindowB Point
p = Point -> Region -> Bool
nearRegion Point
p (Region -> Bool) -> BufferM Region -> BufferM Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM Region
winRegionB

-----------------------------
-- Region-related operations

-- | Return the region between point and mark
getRawestSelectRegionB :: BufferM Region
getRawestSelectRegionB :: BufferM Region
getRawestSelectRegionB = do
  Point
m <- BufferM Point
getSelectionMarkPointB
  Point
p <- BufferM Point
pointB
  Region -> BufferM Region
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Region -> BufferM Region) -> Region -> BufferM Region
forall a b. (a -> b) -> a -> b
$ Point -> Point -> Region
mkRegion Point
p Point
m

-- | Return the empty region if the selection is not visible.
getRawSelectRegionB :: BufferM Region
getRawSelectRegionB :: BufferM Region
getRawSelectRegionB = do
  Bool
s <- Getting Bool FBuffer Bool -> BufferM Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Bool FBuffer Bool
Lens' FBuffer Bool
highlightSelectionA
  if Bool
s then BufferM Region
getRawestSelectRegionB else do
     Point
p <- BufferM Point
pointB
     Region -> BufferM Region
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Region -> BufferM Region) -> Region -> BufferM Region
forall a b. (a -> b) -> a -> b
$ Point -> Point -> Region
mkRegion Point
p Point
p

-- | Get the current region boundaries. Extended to the current selection unit.
getSelectRegionB :: BufferM Region
getSelectRegionB :: BufferM Region
getSelectRegionB = do
  RegionStyle
regionStyle <- BufferM RegionStyle
getRegionStyle
  Region
r <- BufferM Region
getRawSelectRegionB
  Region -> RegionStyle -> BufferM Region
convertRegionToStyleB Region
r RegionStyle
regionStyle

-- | Select the given region: set the selection mark at the 'regionStart'
-- and the current point at the 'regionEnd'.
setSelectRegionB :: Region -> BufferM ()
setSelectRegionB :: Region -> BufferM ()
setSelectRegionB Region
region = do
  (Bool -> Identity Bool) -> FBuffer -> Identity FBuffer
Lens' FBuffer Bool
highlightSelectionA ((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
  Point -> BufferM ()
setSelectionMarkPointB (Point -> BufferM ()) -> Point -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Region -> Point
regionStart Region
region
  Point -> BufferM ()
moveTo (Point -> BufferM ()) -> Point -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Region -> Point
regionEnd Region
region

------------------------------------------
-- Some line related movements/operations

deleteBlankLinesB :: BufferM ()
deleteBlankLinesB :: BufferM ()
deleteBlankLinesB = do
  Bool
isThisBlank <- YiString -> Bool
isBlank (YiString -> Bool) -> BufferM YiString -> BufferM Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM YiString
readLnB
  Bool -> BufferM () -> BufferM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isThisBlank (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$ do
    Point
p <- BufferM Point
pointB
    -- go up to the 1st blank line in the group
    BufferM [()] -> BufferM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (BufferM [()] -> BufferM ()) -> BufferM [()] -> BufferM ()
forall a b. (a -> b) -> a -> b
$ BufferM Bool -> BufferM () -> BufferM [()]
forall a. BufferM Bool -> BufferM a -> BufferM [a]
whileB (YiString -> Bool
R.null (YiString -> Bool) -> BufferM YiString -> BufferM Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Direction -> BufferM YiString
getNextLineB Direction
Backward) BufferM ()
lineUp
    Point
q <- BufferM Point
pointB
    -- delete the whole blank region.
    Region -> BufferM ()
deleteRegionB (Region -> BufferM ()) -> Region -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Point -> Point -> Region
mkRegion Point
p Point
q

-- | Get a (lazy) stream of lines in the buffer, starting at the /next/ line
-- in the given direction.
lineStreamB :: Direction -> BufferM [YiString]
lineStreamB :: Direction -> BufferM [YiString]
lineStreamB Direction
dir = (YiString -> YiString) -> [YiString] -> [YiString]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap YiString -> YiString
rev ([YiString] -> [YiString])
-> (YiString -> [YiString]) -> YiString -> [YiString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> [YiString]
R.lines (YiString -> [YiString]) -> BufferM YiString -> BufferM [YiString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Direction -> Point -> BufferM YiString
streamB Direction
dir (Point -> BufferM YiString) -> BufferM Point -> BufferM YiString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BufferM Point
pointB)
  where
    rev :: YiString -> YiString
rev = case Direction
dir of
      Direction
Forward -> YiString -> YiString
forall a. a -> a
id
      Direction
Backward -> YiString -> YiString
R.reverse

-- | Get the next line of text in the given direction. This returns
-- simply 'Nothing' if there no such line.
getMaybeNextLineB :: Direction -> BufferM (Maybe YiString)
getMaybeNextLineB :: Direction -> BufferM (Maybe YiString)
getMaybeNextLineB Direction
dir = [YiString] -> Maybe YiString
forall a. [a] -> Maybe a
listToMaybe ([YiString] -> Maybe YiString)
-> BufferM [YiString] -> BufferM (Maybe YiString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Direction -> BufferM [YiString]
lineStreamB Direction
dir

-- | The same as 'getMaybeNextLineB' but avoids the use of the 'Maybe'
-- type in the return by returning the empty string if there is no
-- next line.
getNextLineB :: Direction -> BufferM YiString
getNextLineB :: Direction -> BufferM YiString
getNextLineB Direction
dir = YiString -> Maybe YiString -> YiString
forall a. a -> Maybe a -> a
fromMaybe YiString
R.empty (Maybe YiString -> YiString)
-> BufferM (Maybe YiString) -> BufferM YiString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Direction -> BufferM (Maybe YiString)
getMaybeNextLineB Direction
dir

-- | Get closest line to the current line (not including the current
-- line) in the given direction which satisfies the given condition.
-- Returns 'Nothing' if there is no line which satisfies the
-- condition.
getNextLineWhichB :: Direction -> (YiString -> Bool) -> BufferM (Maybe YiString)
getNextLineWhichB :: Direction -> (YiString -> Bool) -> BufferM (Maybe YiString)
getNextLineWhichB Direction
dir YiString -> Bool
cond = [YiString] -> Maybe YiString
forall a. [a] -> Maybe a
listToMaybe ([YiString] -> Maybe YiString)
-> ([YiString] -> [YiString]) -> [YiString] -> Maybe YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (YiString -> Bool) -> [YiString] -> [YiString]
forall a. (a -> Bool) -> [a] -> [a]
filter YiString -> Bool
cond ([YiString] -> Maybe YiString)
-> BufferM [YiString] -> BufferM (Maybe YiString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Direction -> BufferM [YiString]
lineStreamB Direction
dir

-- | Returns the closest line to the current line which is non-blank,
-- in the given direction. Returns the empty string if there is no
-- such line (for example if we are on the top line already).
getNextNonBlankLineB :: Direction -> BufferM YiString
getNextNonBlankLineB :: Direction -> BufferM YiString
getNextNonBlankLineB Direction
dir =
  YiString -> Maybe YiString -> YiString
forall a. a -> Maybe a -> a
fromMaybe YiString
R.empty (Maybe YiString -> YiString)
-> BufferM (Maybe YiString) -> BufferM YiString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Direction -> (YiString -> Bool) -> BufferM (Maybe YiString)
getNextLineWhichB Direction
dir (Bool -> Bool
not (Bool -> Bool) -> (YiString -> Bool) -> YiString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> Bool
R.null)

------------------------------------------------
-- Some more utility functions involving
-- regions (generally that which is selected)

modifyExtendedSelectionB :: TextUnit -> (R.YiString -> R.YiString) -> BufferM ()
modifyExtendedSelectionB :: TextUnit -> (YiString -> YiString) -> BufferM ()
modifyExtendedSelectionB TextUnit
unit YiString -> YiString
transform
    = (YiString -> YiString) -> Region -> BufferM ()
modifyRegionB YiString -> YiString
transform (Region -> BufferM ()) -> BufferM Region -> BufferM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TextUnit -> Region -> BufferM Region
unitWiseRegion TextUnit
unit (Region -> BufferM Region) -> BufferM Region -> BufferM Region
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BufferM Region
getSelectRegionB

-- | Prefix each line in the selection using the given string.
linePrefixSelectionB :: R.YiString -- ^ The string that starts a line comment
                     ->  BufferM ()
linePrefixSelectionB :: YiString -> BufferM ()
linePrefixSelectionB YiString
s =
  TextUnit -> (YiString -> YiString) -> BufferM ()
modifyExtendedSelectionB TextUnit
Line ((YiString -> YiString) -> BufferM ())
-> ((YiString -> YiString) -> YiString -> YiString)
-> (YiString -> YiString)
-> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (YiString -> YiString) -> YiString -> YiString
overInit ((YiString -> YiString) -> BufferM ())
-> (YiString -> YiString) -> BufferM ()
forall a b. (a -> b) -> a -> b
$ (YiString -> YiString) -> YiString -> YiString
mapLines (YiString
s YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<>)

-- | Uncomments the selection using the given line comment
-- starting string. This only works for the comments which
-- begin at the start of the line.
unLineCommentSelectionB :: R.YiString -- ^ The string which begins a
                                      -- line comment
                        -> R.YiString -- ^ A potentially shorter
                                      -- string that begins a comment
                        -> BufferM ()
unLineCommentSelectionB :: YiString -> YiString -> BufferM ()
unLineCommentSelectionB YiString
s1 YiString
s2 =
  TextUnit -> (YiString -> YiString) -> BufferM ()
modifyExtendedSelectionB TextUnit
Line ((YiString -> YiString) -> BufferM ())
-> (YiString -> YiString) -> BufferM ()
forall a b. (a -> b) -> a -> b
$ (YiString -> YiString) -> YiString -> YiString
mapLines YiString -> YiString
unCommentLine
  where
  (Int
l1, Int
l2) = (YiString -> Int
R.length YiString
s1, YiString -> Int
R.length YiString
s2)

  unCommentLine :: R.YiString -> R.YiString
  unCommentLine :: YiString -> YiString
unCommentLine YiString
line = case (Int -> YiString -> (YiString, YiString)
R.splitAt Int
l1 YiString
line, Int -> YiString -> (YiString, YiString)
R.splitAt Int
l2 YiString
line) of
    ((YiString
f, YiString
s) , (YiString
f', YiString
s')) | YiString
s1 YiString -> YiString -> Bool
forall a. Eq a => a -> a -> Bool
== YiString
f   -> YiString
s
                        | YiString
s2 YiString -> YiString -> Bool
forall a. Eq a => a -> a -> Bool
== YiString
f'  -> YiString
s'
                        | Bool
otherwise -> YiString
line

-- | Just like 'toggleCommentSelectionB' but automatically inserts a
-- whitespace suffix to the inserted comment string. In fact:
toggleCommentB :: R.YiString -> BufferM ()
toggleCommentB :: YiString -> BufferM ()
toggleCommentB YiString
c = YiString -> YiString -> BufferM ()
toggleCommentSelectionB (YiString
c YiString -> Char -> YiString
`R.snoc` Char
' ') YiString
c

-- | Toggle line comments in the selection by adding or removing a
-- prefix to each line.
toggleCommentSelectionB :: R.YiString -> R.YiString -> BufferM ()
toggleCommentSelectionB :: YiString -> YiString -> BufferM ()
toggleCommentSelectionB YiString
insPrefix YiString
delPrefix = do
  YiString
l <- TextUnit -> BufferM YiString
readUnitB TextUnit
Line
  if YiString
delPrefix YiString -> YiString -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> YiString -> YiString
R.take (YiString -> Int
R.length YiString
delPrefix) YiString
l
    then YiString -> YiString -> BufferM ()
unLineCommentSelectionB YiString
insPrefix YiString
delPrefix
    else YiString -> BufferM ()
linePrefixSelectionB YiString
insPrefix

-- | Replace the contents of the buffer with some string
replaceBufferContent :: YiString -> BufferM ()
replaceBufferContent :: YiString -> BufferM ()
replaceBufferContent YiString
newvalue = do
  Region
r <- TextUnit -> BufferM Region
regionOfB TextUnit
Document
  Region -> YiString -> BufferM ()
replaceRegionB Region
r YiString
newvalue

-- | Fill the text in the region so it fits nicely 80 columns.
fillRegion :: Region -> BufferM ()
fillRegion :: Region -> BufferM ()
fillRegion = (YiString -> YiString) -> Region -> BufferM ()
modifyRegionB ([YiString] -> YiString
R.unlines ([YiString] -> YiString)
-> (YiString -> [YiString]) -> YiString -> YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> YiString -> [YiString]
fillText Int
80)

fillParagraph :: BufferM ()
fillParagraph :: BufferM ()
fillParagraph = Region -> BufferM ()
fillRegion (Region -> BufferM ()) -> BufferM Region -> BufferM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TextUnit -> BufferM Region
regionOfB TextUnit
unitParagraph

-- | Sort the lines of the region.
sortLines :: BufferM ()
sortLines :: BufferM ()
sortLines = TextUnit -> (YiString -> YiString) -> BufferM ()
modifyExtendedSelectionB TextUnit
Line (([YiString] -> [YiString]) -> YiString -> YiString
onLines [YiString] -> [YiString]
forall a. Ord a => [a] -> [a]
sort)

-- | Forces an extra newline into the region (if one exists)
modifyExtendedLRegion :: Region -> (R.YiString -> R.YiString) -> BufferM ()
modifyExtendedLRegion :: Region -> (YiString -> YiString) -> BufferM ()
modifyExtendedLRegion Region
region YiString -> YiString
transform = do
    Region
reg <- TextUnit -> Region -> BufferM Region
unitWiseRegion TextUnit
Line Region
region
    (YiString -> YiString) -> Region -> BufferM ()
modifyRegionB YiString -> YiString
transform (Region -> Region
fixR Region
reg)
  where fixR :: Region -> Region
fixR Region
reg = Point -> Point -> Region
mkRegion (Region -> Point
regionStart Region
reg) (Point -> Region) -> Point -> Region
forall a b. (a -> b) -> a -> b
$ Region -> Point
regionEnd Region
reg Point -> Point -> Point
forall a. Num a => a -> a -> a
+ Point
1

sortLinesWithRegion :: Region -> BufferM ()
sortLinesWithRegion :: Region -> BufferM ()
sortLinesWithRegion Region
region = Region -> (YiString -> YiString) -> BufferM ()
modifyExtendedLRegion Region
region (([YiString] -> [YiString]) -> YiString -> YiString
onLines [YiString] -> [YiString]
sort')
    where sort' :: [YiString] -> [YiString]
sort' [] = []
          sort' [YiString]
lns =
              if YiString -> Bool
hasnl ([YiString] -> YiString
forall a. HasCallStack => [a] -> a
last [YiString]
lns)
                  then [YiString] -> [YiString]
forall a. Ord a => [a] -> [a]
sort [YiString]
lns
                  else ASetter [YiString] [YiString] YiString YiString
-> (YiString -> YiString) -> [YiString] -> [YiString]
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter [YiString] [YiString] YiString YiString
forall s a. Snoc s s a a => Traversal' s a
Traversal' [YiString] YiString
_last
                      -- should be completely safe since every element contains newline
                      (YiString -> Maybe YiString -> YiString
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> YiString
forall a. HasCallStack => [Char] -> a
error [Char]
"sortLinesWithRegion fromMaybe") (Maybe YiString -> YiString)
-> (YiString -> Maybe YiString) -> YiString -> YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> Maybe YiString
R.init) ([YiString] -> [YiString])
-> ([YiString] -> [YiString]) -> [YiString] -> [YiString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [YiString] -> [YiString]
forall a. Ord a => [a] -> [a]
sort ([YiString] -> [YiString]) -> [YiString] -> [YiString]
forall a b. (a -> b) -> a -> b
$
                          ASetter [YiString] [YiString] YiString YiString
-> (YiString -> YiString) -> [YiString] -> [YiString]
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter [YiString] [YiString] YiString YiString
forall s a. Snoc s s a a => Traversal' s a
Traversal' [YiString] YiString
_last (YiString -> Char -> YiString
`R.snoc` Char
'\n') [YiString]
lns
          hasnl :: YiString -> Bool
hasnl YiString
t | YiString -> Maybe Char
R.last YiString
t Maybe Char -> Maybe Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\n' = Bool
True
                  | Bool
otherwise = Bool
False

-- | Helper function: revert the buffer contents to its on-disk version
revertB :: YiString -> UTCTime -> BufferM ()
revertB :: YiString -> UTCTime -> BufferM ()
revertB YiString
s UTCTime
now = do
  Region
r <- TextUnit -> BufferM Region
regionOfB TextUnit
Document
  Region -> YiString -> BufferM ()
replaceRegionB Region
r YiString
s
  UTCTime -> BufferM ()
markSavedB UTCTime
now

-- get lengths of parts covered by block region
--
-- Consider block region starting at 'o' and ending at 'z':
--
--    start
--      |
--     \|/
-- def foo(bar):
--     baz
--
--     ab
--     xyz0
--      /|\
--       |
--     finish
--
-- shapeOfBlockRegionB returns (regionStart, [2, 2, 0, 1, 2])
-- TODO: accept stickToEol flag
shapeOfBlockRegionB :: Region -> BufferM (Point, [Int])
shapeOfBlockRegionB :: Region -> BufferM (Point, [Int])
shapeOfBlockRegionB Region
reg = BufferM (Point, [Int]) -> BufferM (Point, [Int])
forall a. BufferM a -> BufferM a
savingPointB (BufferM (Point, [Int]) -> BufferM (Point, [Int]))
-> BufferM (Point, [Int]) -> BufferM (Point, [Int])
forall a b. (a -> b) -> a -> b
$ do
    (Int
l0, Int
c0) <- Point -> BufferM (Int, Int)
getLineAndColOfPoint (Point -> BufferM (Int, Int)) -> Point -> BufferM (Int, Int)
forall a b. (a -> b) -> a -> b
$ Region -> Point
regionStart Region
reg
    (Int
l1, Int
c1) <- Point -> BufferM (Int, Int)
getLineAndColOfPoint (Point -> BufferM (Int, Int)) -> Point -> BufferM (Int, Int)
forall a b. (a -> b) -> a -> b
$ Region -> Point
regionEnd Region
reg
    let (Int
left, Int
top, Int
bottom, Int
right) = (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
c0 Int
c1, Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
l0 Int
l1, Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
l0 Int
l1, Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
c0 Int
c1)
    [Int]
lengths <- [Int] -> (Int -> BufferM Int) -> BufferM [Int]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int
top .. Int
bottom] ((Int -> BufferM Int) -> BufferM [Int])
-> (Int -> BufferM Int) -> BufferM [Int]
forall a b. (a -> b) -> a -> b
$ \Int
l -> do
        BufferM Int -> BufferM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (BufferM Int -> BufferM ()) -> BufferM Int -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Int -> BufferM Int
gotoLn Int
l
        Int -> BufferM ()
moveToColB Int
left
        Int
currentLeft <- BufferM Int
curCol
        if Int
currentLeft Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
left
        then Int -> BufferM Int
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
        else do
            Int -> BufferM ()
moveToColB Int
right
            Bool
rightAtEol <- BufferM Bool
atEol
            BufferM ()
leftOnEol
            Int
currentRight <- BufferM Int
curCol
            Int -> BufferM Int
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> BufferM Int) -> Int -> BufferM Int
forall a b. (a -> b) -> a -> b
$ if Int
currentRight Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Bool
rightAtEol
                     then Int
0
                     else Int
currentRight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
currentLeft Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
    Point
startingPoint <- Int -> Int -> BufferM Point
pointOfLineColB Int
top Int
left
    (Point, [Int]) -> BufferM (Point, [Int])
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Point
startingPoint, [Int]
lengths)

leftEdgesOfRegionB :: RegionStyle -> Region -> BufferM [Point]
leftEdgesOfRegionB :: RegionStyle -> Region -> BufferM [Point]
leftEdgesOfRegionB RegionStyle
Block Region
reg = BufferM [Point] -> BufferM [Point]
forall a. BufferM a -> BufferM a
savingPointB (BufferM [Point] -> BufferM [Point])
-> BufferM [Point] -> BufferM [Point]
forall a b. (a -> b) -> a -> b
$ do
    (Int
l0, Int
_) <- Point -> BufferM (Int, Int)
getLineAndColOfPoint (Point -> BufferM (Int, Int)) -> Point -> BufferM (Int, Int)
forall a b. (a -> b) -> a -> b
$ Region -> Point
regionStart Region
reg
    (Int
l1, Int
_) <- Point -> BufferM (Int, Int)
getLineAndColOfPoint (Point -> BufferM (Int, Int)) -> Point -> BufferM (Int, Int)
forall a b. (a -> b) -> a -> b
$ Region -> Point
regionEnd Region
reg
    Point -> BufferM ()
moveTo (Point -> BufferM ()) -> Point -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Region -> Point
regionStart Region
reg
    ([Maybe Point] -> [Point])
-> BufferM [Maybe Point] -> BufferM [Point]
forall a b. (a -> b) -> BufferM a -> BufferM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe Point] -> [Point]
forall a. [Maybe a] -> [a]
catMaybes (BufferM [Maybe Point] -> BufferM [Point])
-> BufferM [Maybe Point] -> BufferM [Point]
forall a b. (a -> b) -> a -> b
$ [Int] -> (Int -> BufferM (Maybe Point)) -> BufferM [Maybe Point]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int
0 .. Int -> Int
forall a. Num a => a -> a
abs (Int
l0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l1)] ((Int -> BufferM (Maybe Point)) -> BufferM [Maybe Point])
-> (Int -> BufferM (Maybe Point)) -> BufferM [Maybe Point]
forall a b. (a -> b) -> a -> b
$ \Int
i -> BufferM (Maybe Point) -> BufferM (Maybe Point)
forall a. BufferM a -> BufferM a
savingPointB (BufferM (Maybe Point) -> BufferM (Maybe Point))
-> BufferM (Maybe Point) -> BufferM (Maybe Point)
forall a b. (a -> b) -> a -> b
$ do
        BufferM Int -> BufferM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (BufferM Int -> BufferM ()) -> BufferM Int -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Int -> BufferM Int
lineMoveRel Int
i
        Point
p <- BufferM Point
pointB
        Bool
eol <- BufferM Bool
atEol
        Maybe Point -> BufferM (Maybe Point)
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return (if Bool -> Bool
not Bool
eol then Point -> Maybe Point
forall a. a -> Maybe a
Just Point
p else Maybe Point
forall a. Maybe a
Nothing)
leftEdgesOfRegionB RegionStyle
LineWise Region
reg = BufferM [Point] -> BufferM [Point]
forall a. BufferM a -> BufferM a
savingPointB (BufferM [Point] -> BufferM [Point])
-> BufferM [Point] -> BufferM [Point]
forall a b. (a -> b) -> a -> b
$ do
    Point
lastSol <- do
        Point -> BufferM ()
moveTo (Point -> BufferM ()) -> Point -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Region -> Point
regionEnd Region
reg
        BufferM ()
moveToSol
        BufferM Point
pointB
    let  go :: [Point] -> Point -> BufferM [Point]
go [Point]
acc Point
p = do Point -> BufferM ()
moveTo Point
p
                       BufferM ()
moveToSol
                       Point
edge <- BufferM Point
pointB
                       if Point
edge Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
>= Point
lastSol
                       then [Point] -> BufferM [Point]
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Point] -> BufferM [Point]) -> [Point] -> BufferM [Point]
forall a b. (a -> b) -> a -> b
$ [Point] -> [Point]
forall a. [a] -> [a]
reverse (Point
edgePoint -> [Point] -> [Point]
forall a. a -> [a] -> [a]
:[Point]
acc)
                       else do
                           BufferM Int -> BufferM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (BufferM Int -> BufferM ()) -> BufferM Int -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Int -> BufferM Int
lineMoveRel Int
1
                           [Point] -> Point -> BufferM [Point]
go (Point
edgePoint -> [Point] -> [Point]
forall a. a -> [a] -> [a]
:[Point]
acc) (Point -> BufferM [Point]) -> BufferM Point -> BufferM [Point]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BufferM Point
pointB
    [Point] -> Point -> BufferM [Point]
go [] (Region -> Point
regionStart Region
reg)
leftEdgesOfRegionB RegionStyle
_ Region
r = [Point] -> BufferM [Point]
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return [Region -> Point
regionStart Region
r]

rightEdgesOfRegionB :: RegionStyle -> Region -> BufferM [Point]
rightEdgesOfRegionB :: RegionStyle -> Region -> BufferM [Point]
rightEdgesOfRegionB RegionStyle
Block Region
reg = BufferM [Point] -> BufferM [Point]
forall a. BufferM a -> BufferM a
savingPointB (BufferM [Point] -> BufferM [Point])
-> BufferM [Point] -> BufferM [Point]
forall a b. (a -> b) -> a -> b
$ do
    (Int
l0, Int
_) <- Point -> BufferM (Int, Int)
getLineAndColOfPoint (Point -> BufferM (Int, Int)) -> Point -> BufferM (Int, Int)
forall a b. (a -> b) -> a -> b
$ Region -> Point
regionStart Region
reg
    (Int
l1, Int
_) <- Point -> BufferM (Int, Int)
getLineAndColOfPoint (Point -> BufferM (Int, Int)) -> Point -> BufferM (Int, Int)
forall a b. (a -> b) -> a -> b
$ Region -> Point
regionEnd Region
reg
    Point -> BufferM ()
moveTo (Point -> BufferM ()) -> Point -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Point
1 Point -> Point -> Point
forall a. Num a => a -> a -> a
+ Region -> Point
regionEnd Region
reg
    ([Point] -> [Point]) -> BufferM [Point] -> BufferM [Point]
forall a b. (a -> b) -> BufferM a -> BufferM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Point] -> [Point]
forall a. [a] -> [a]
reverse (BufferM [Point] -> BufferM [Point])
-> BufferM [Point] -> BufferM [Point]
forall a b. (a -> b) -> a -> b
$ [Int] -> (Int -> BufferM Point) -> BufferM [Point]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int
0 .. Int -> Int
forall a. Num a => a -> a
abs (Int
l0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l1)] ((Int -> BufferM Point) -> BufferM [Point])
-> (Int -> BufferM Point) -> BufferM [Point]
forall a b. (a -> b) -> a -> b
$ \Int
i -> BufferM Point -> BufferM Point
forall a. BufferM a -> BufferM a
savingPointB (BufferM Point -> BufferM Point) -> BufferM Point -> BufferM Point
forall a b. (a -> b) -> a -> b
$ do
        BufferM Int -> BufferM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (BufferM Int -> BufferM ()) -> BufferM Int -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Int -> BufferM Int
lineMoveRel (Int -> BufferM Int) -> Int -> BufferM Int
forall a b. (a -> b) -> a -> b
$ -Int
i
        BufferM Point
pointB
rightEdgesOfRegionB RegionStyle
LineWise Region
reg = BufferM [Point] -> BufferM [Point]
forall a. BufferM a -> BufferM a
savingPointB (BufferM [Point] -> BufferM [Point])
-> BufferM [Point] -> BufferM [Point]
forall a b. (a -> b) -> a -> b
$ do
    Point
lastEol <- do
        Point -> BufferM ()
moveTo (Point -> BufferM ()) -> Point -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Region -> Point
regionEnd Region
reg
        BufferM ()
moveToEol
        BufferM Point
pointB
    let  go :: [Point] -> Point -> BufferM [Point]
go [Point]
acc Point
p = do Point -> BufferM ()
moveTo Point
p
                       BufferM ()
moveToEol
                       Point
edge <- BufferM Point
pointB
                       if Point
edge Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
>= Point
lastEol
                       then [Point] -> BufferM [Point]
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Point] -> BufferM [Point]) -> [Point] -> BufferM [Point]
forall a b. (a -> b) -> a -> b
$ [Point] -> [Point]
forall a. [a] -> [a]
reverse (Point
edgePoint -> [Point] -> [Point]
forall a. a -> [a] -> [a]
:[Point]
acc)
                       else do
                           BufferM Int -> BufferM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (BufferM Int -> BufferM ()) -> BufferM Int -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Int -> BufferM Int
lineMoveRel Int
1
                           [Point] -> Point -> BufferM [Point]
go (Point
edgePoint -> [Point] -> [Point]
forall a. a -> [a] -> [a]
:[Point]
acc) (Point -> BufferM [Point]) -> BufferM Point -> BufferM [Point]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BufferM Point
pointB
    [Point] -> Point -> BufferM [Point]
go [] (Region -> Point
regionStart Region
reg)
rightEdgesOfRegionB RegionStyle
_ Region
reg = BufferM [Point] -> BufferM [Point]
forall a. BufferM a -> BufferM a
savingPointB (BufferM [Point] -> BufferM [Point])
-> BufferM [Point] -> BufferM [Point]
forall a b. (a -> b) -> a -> b
$ do
    Point -> BufferM ()
moveTo (Point -> BufferM ()) -> Point -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Region -> Point
regionEnd Region
reg
    BufferM ()
leftOnEol
    (Point -> [Point]) -> BufferM Point -> BufferM [Point]
forall a b. (a -> b) -> BufferM a -> BufferM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Point -> [Point]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return BufferM Point
pointB

splitBlockRegionToContiguousSubRegionsB :: Region -> BufferM [Region]
splitBlockRegionToContiguousSubRegionsB :: Region -> BufferM [Region]
splitBlockRegionToContiguousSubRegionsB Region
reg = BufferM [Region] -> BufferM [Region]
forall a. BufferM a -> BufferM a
savingPointB (BufferM [Region] -> BufferM [Region])
-> BufferM [Region] -> BufferM [Region]
forall a b. (a -> b) -> a -> b
$ do
    (Point
start, [Int]
lengths) <- Region -> BufferM (Point, [Int])
shapeOfBlockRegionB Region
reg
    [(Int, Int)] -> ((Int, Int) -> BufferM Region) -> BufferM [Region]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ([Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [Int]
lengths) (((Int, Int) -> BufferM Region) -> BufferM [Region])
-> ((Int, Int) -> BufferM Region) -> BufferM [Region]
forall a b. (a -> b) -> a -> b
$ \(Int
i, Int
l) -> do
        Point -> BufferM ()
moveTo Point
start
        BufferM Int -> BufferM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (BufferM Int -> BufferM ()) -> BufferM Int -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Int -> BufferM Int
lineMoveRel Int
i
        Point
p0 <- BufferM Point
pointB
        Int -> BufferM ()
moveXorEol Int
l
        Point
p1 <- BufferM Point
pointB
        let subRegion :: Region
subRegion = Point -> Point -> Region
mkRegion Point
p0 Point
p1
        Region -> BufferM Region
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return Region
subRegion

-- Return list containing a single point for all non-block styles.
-- For Block return all the points along the left edge of the region
deleteRegionWithStyleB :: Region -> RegionStyle -> BufferM (NonEmpty Point)
deleteRegionWithStyleB :: Region -> RegionStyle -> BufferM (NonEmpty Point)
deleteRegionWithStyleB Region
reg RegionStyle
Block = BufferM (NonEmpty Point) -> BufferM (NonEmpty Point)
forall a. BufferM a -> BufferM a
savingPointB (BufferM (NonEmpty Point) -> BufferM (NonEmpty Point))
-> BufferM (NonEmpty Point) -> BufferM (NonEmpty Point)
forall a b. (a -> b) -> a -> b
$ do
    (Point
start, [Int]
lengths) <- Region -> BufferM (Point, [Int])
shapeOfBlockRegionB Region
reg
    Point -> BufferM ()
moveTo Point
start
    [Maybe Point]
points <- [(Int, Int)]
-> ((Int, Int) -> BufferM (Maybe Point)) -> BufferM [Maybe Point]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ([Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [Int]
lengths) (((Int, Int) -> BufferM (Maybe Point)) -> BufferM [Maybe Point])
-> ((Int, Int) -> BufferM (Maybe Point)) -> BufferM [Maybe Point]
forall a b. (a -> b) -> a -> b
$ \(Int
i, Int
l) -> do
        Int -> BufferM ()
deleteN Int
l
        Point
p <- BufferM Point
pointB
        Point -> BufferM ()
moveTo Point
start
        Int -> BufferM Int
lineMoveRel Int
i
        Maybe Point -> BufferM (Maybe Point)
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return (if Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Maybe Point
forall a. Maybe a
Nothing else Point -> Maybe Point
forall a. a -> Maybe a
Just Point
p)
    NonEmpty Point -> BufferM (NonEmpty Point)
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return (NonEmpty Point -> BufferM (NonEmpty Point))
-> NonEmpty Point -> BufferM (NonEmpty Point)
forall a b. (a -> b) -> a -> b
$ Point
start Point -> [Point] -> NonEmpty Point
forall a. a -> [a] -> NonEmpty a
:| Int -> [Point] -> [Point]
forall a. Int -> [a] -> [a]
drop Int
1 ([Maybe Point] -> [Point]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Point]
points)

deleteRegionWithStyleB Region
reg RegionStyle
style = BufferM (NonEmpty Point) -> BufferM (NonEmpty Point)
forall a. BufferM a -> BufferM a
savingPointB (BufferM (NonEmpty Point) -> BufferM (NonEmpty Point))
-> BufferM (NonEmpty Point) -> BufferM (NonEmpty Point)
forall a b. (a -> b) -> a -> b
$ do
    Region
effectiveRegion <- Region -> RegionStyle -> BufferM Region
convertRegionToStyleB Region
reg RegionStyle
style
    Region -> BufferM ()
deleteRegionB Region
effectiveRegion
    NonEmpty Point -> BufferM (NonEmpty Point)
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return (NonEmpty Point -> BufferM (NonEmpty Point))
-> NonEmpty Point -> BufferM (NonEmpty Point)
forall a b. (a -> b) -> a -> b
$! Point -> NonEmpty Point
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Region -> Point
regionStart Region
effectiveRegion)

readRegionRopeWithStyleB :: Region -> RegionStyle -> BufferM YiString
readRegionRopeWithStyleB :: Region -> RegionStyle -> BufferM YiString
readRegionRopeWithStyleB Region
reg RegionStyle
Block = BufferM YiString -> BufferM YiString
forall a. BufferM a -> BufferM a
savingPointB (BufferM YiString -> BufferM YiString)
-> BufferM YiString -> BufferM YiString
forall a b. (a -> b) -> a -> b
$ do
    (Point
start, [Int]
lengths) <- Region -> BufferM (Point, [Int])
shapeOfBlockRegionB Region
reg
    Point -> BufferM ()
moveTo Point
start
    [YiString]
chunks <- [Int] -> (Int -> BufferM YiString) -> BufferM [YiString]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int]
lengths ((Int -> BufferM YiString) -> BufferM [YiString])
-> (Int -> BufferM YiString) -> BufferM [YiString]
forall a b. (a -> b) -> a -> b
$ \Int
l ->
        if Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
        then Int -> BufferM Int
lineMoveRel Int
1 BufferM Int -> BufferM YiString -> BufferM YiString
forall a b. BufferM a -> BufferM b -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> YiString -> BufferM YiString
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return YiString
forall a. Monoid a => a
mempty
        else do
            Point
p <- BufferM Point
pointB
            YiString
r <- Region -> BufferM YiString
readRegionB (Region -> BufferM YiString) -> Region -> BufferM YiString
forall a b. (a -> b) -> a -> b
$ Point -> Point -> Region
mkRegion Point
p (Point
p Point -> Size -> Point
forall absolute relative.
SemiNum absolute relative =>
absolute -> relative -> absolute
+~ Int -> Size
Size Int
l)
            BufferM Int -> BufferM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (BufferM Int -> BufferM ()) -> BufferM Int -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Int -> BufferM Int
lineMoveRel Int
1
            YiString -> BufferM YiString
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return YiString
r
    YiString -> BufferM YiString
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return (YiString -> BufferM YiString) -> YiString -> BufferM YiString
forall a b. (a -> b) -> a -> b
$ Char -> [YiString] -> YiString
R.intersperse Char
'\n' [YiString]
chunks
readRegionRopeWithStyleB Region
reg RegionStyle
style = Region -> BufferM YiString
readRegionB (Region -> BufferM YiString) -> BufferM Region -> BufferM YiString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Region -> RegionStyle -> BufferM Region
convertRegionToStyleB Region
reg RegionStyle
style

insertRopeWithStyleB :: YiString -> RegionStyle -> BufferM ()
insertRopeWithStyleB :: YiString -> RegionStyle -> BufferM ()
insertRopeWithStyleB YiString
rope RegionStyle
Block = BufferM () -> BufferM ()
forall a. BufferM a -> BufferM a
savingPointB (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$ do
  let ls :: [YiString]
ls = YiString -> [YiString]
R.lines YiString
rope
      advanceLine :: BufferM ()
advanceLine = BufferM Bool
atLastLine BufferM Bool -> (Bool -> BufferM ()) -> BufferM ()
forall a b. BufferM a -> (a -> BufferM b) -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Bool
False -> BufferM Int -> BufferM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (BufferM Int -> BufferM ()) -> BufferM Int -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Int -> BufferM Int
lineMoveRel Int
1
        Bool
True -> do
          Int
col <- BufferM Int
curCol
          BufferM ()
moveToEol
          BufferM ()
newlineB
          YiString -> BufferM ()
insertN (YiString -> BufferM ()) -> YiString -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Int -> Char -> YiString
R.replicateChar Int
col Char
' '

  [BufferM ()] -> BufferM ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([BufferM ()] -> BufferM ()) -> [BufferM ()] -> BufferM ()
forall a b. (a -> b) -> a -> b
$ BufferM () -> [BufferM ()] -> [BufferM ()]
forall a. a -> [a] -> [a]
intersperse BufferM ()
advanceLine ([BufferM ()] -> [BufferM ()]) -> [BufferM ()] -> [BufferM ()]
forall a b. (a -> b) -> a -> b
$ (YiString -> BufferM ()) -> [YiString] -> [BufferM ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (BufferM () -> BufferM ()
forall a. BufferM a -> BufferM a
savingPointB (BufferM () -> BufferM ())
-> (YiString -> BufferM ()) -> YiString -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> BufferM ()
insertN) [YiString]
ls
insertRopeWithStyleB YiString
rope RegionStyle
LineWise = do
    BufferM ()
moveToSol
    BufferM () -> BufferM ()
forall a. BufferM a -> BufferM a
savingPointB (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$ YiString -> BufferM ()
insertN YiString
rope
insertRopeWithStyleB YiString
rope RegionStyle
_ = YiString -> BufferM ()
insertN YiString
rope

-- consider the following buffer content
--
-- 123456789
-- qwertyuio
-- asdfgh
--
-- The following examples use characters from that buffer as points.
-- h' denotes the newline after h
--
-- 1 r -> 4 q
-- 9 q -> 1 o
-- q h -> y a
-- a o -> h' q
-- o a -> q h'
-- 1 a -> 1 a
--
-- property: fmap swap (flipRectangleB a b) = flipRectangleB b a
flipRectangleB :: Point -> Point -> BufferM (Point, Point)
flipRectangleB :: Point -> Point -> BufferM (Point, Point)
flipRectangleB Point
p0 Point
p1 = BufferM (Point, Point) -> BufferM (Point, Point)
forall a. BufferM a -> BufferM a
savingPointB (BufferM (Point, Point) -> BufferM (Point, Point))
-> BufferM (Point, Point) -> BufferM (Point, Point)
forall a b. (a -> b) -> a -> b
$ do
    (Int
_, Int
c0) <- Point -> BufferM (Int, Int)
getLineAndColOfPoint Point
p0
    (Int
_, Int
c1) <- Point -> BufferM (Int, Int)
getLineAndColOfPoint Point
p1
    case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
c0 Int
c1 of
        Ordering
EQ -> (Point, Point) -> BufferM (Point, Point)
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Point
p0, Point
p1)
        Ordering
GT -> (Point, Point) -> (Point, Point)
forall a b. (a, b) -> (b, a)
swap ((Point, Point) -> (Point, Point))
-> BufferM (Point, Point) -> BufferM (Point, Point)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Point -> Point -> BufferM (Point, Point)
flipRectangleB Point
p1 Point
p0
        Ordering
LT -> do
            -- now we know that c0 < c1
            Point -> BufferM ()
moveTo Point
p0
            Int -> BufferM ()
moveXorEol (Int -> BufferM ()) -> Int -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Int
c1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
c0
            Point
flippedP0 <- BufferM Point
pointB
            (Point, Point) -> BufferM (Point, Point)
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Point
flippedP0, Point
p1 Point -> Size -> Point
forall absolute relative.
SemiNum absolute relative =>
absolute -> relative -> absolute
-~ Int -> Size
Size (Int
c1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
c0))

movePercentageFileB :: Int -> BufferM ()
movePercentageFileB :: Int -> BufferM ()
movePercentageFileB Int
i = do
    let f :: Double
        f :: Double
f = case Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
100.0 of
               Double
x | Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
1.0 -> Double
1.0
                 | Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0.0 -> Double
0.0 -- Impossible?
                 | Bool
otherwise -> Double
x
    Int
lineCount <- BufferM Int
lineCountB
    BufferM Int -> BufferM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (BufferM Int -> BufferM ()) -> BufferM Int -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Int -> BufferM Int
gotoLn (Int -> BufferM Int) -> Int -> BufferM Int
forall a b. (a -> b) -> a -> b
$ Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lineCount Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
f)
    BufferM ()
firstNonSpaceB

findMatchingPairB :: BufferM ()
findMatchingPairB :: BufferM ()
findMatchingPairB = do
    let go :: Direction -> Char -> Char -> BufferM Bool
go Direction
dir Char
a Char
b = Direction -> Char -> Char -> BufferM ()
goUnmatchedB Direction
dir Char
a Char
b BufferM () -> BufferM Bool -> BufferM Bool
forall a b. BufferM a -> BufferM b -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> BufferM Bool
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        goToMatch :: BufferM Bool
goToMatch = do
          Char
c <- BufferM Char
readB
          case Char
c of Char
'(' -> Direction -> Char -> Char -> BufferM Bool
go Direction
Forward  Char
'(' Char
')'
                    Char
')' -> Direction -> Char -> Char -> BufferM Bool
go Direction
Backward Char
'(' Char
')'
                    Char
'{' -> Direction -> Char -> Char -> BufferM Bool
go Direction
Forward  Char
'{' Char
'}'
                    Char
'}' -> Direction -> Char -> Char -> BufferM Bool
go Direction
Backward Char
'{' Char
'}'
                    Char
'[' -> Direction -> Char -> Char -> BufferM Bool
go Direction
Forward  Char
'[' Char
']'
                    Char
']' -> Direction -> Char -> Char -> BufferM Bool
go Direction
Backward Char
'[' Char
']'
                    Char
_   -> BufferM Bool
otherChar
        otherChar :: BufferM Bool
otherChar = do Bool
eof <- BufferM Bool
atEof
                       Bool
eol <- BufferM Bool
atEol
                       if Bool
eof Bool -> Bool -> Bool
|| Bool
eol
                           then Bool -> BufferM Bool
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                           else BufferM ()
rightB BufferM () -> BufferM Bool -> BufferM Bool
forall a b. BufferM a -> BufferM b -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferM Bool
goToMatch
    Point
p <- BufferM Point
pointB
    Bool
foundMatch <- BufferM Bool
goToMatch
    Bool -> BufferM () -> BufferM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
foundMatch (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Point -> BufferM ()
moveTo Point
p

-- Vim numbers

-- | Increase (or decrease if negative) next number on line by n.
incrementNextNumberByB :: Int -> BufferM ()
incrementNextNumberByB :: Int -> BufferM ()
incrementNextNumberByB Int
n = do
    Point
start <- BufferM Point
pointB
    BufferM Bool -> BufferM () -> BufferM ()
forall a. BufferM Bool -> BufferM a -> BufferM ()
untilB_ (Bool -> Bool
not (Bool -> Bool) -> BufferM Bool -> BufferM Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM Bool
isNumberB) (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Int -> BufferM ()
moveXorSol Int
1
    BufferM Bool -> BufferM () -> BufferM ()
forall a. BufferM Bool -> BufferM a -> BufferM ()
untilB_          BufferM Bool
isNumberB  (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Int -> BufferM ()
moveXorEol Int
1
    Point
begin <- BufferM Point
pointB
    Bool
beginIsEol <- BufferM Bool
atEol
    BufferM Bool -> BufferM () -> BufferM ()
forall a. BufferM Bool -> BufferM a -> BufferM ()
untilB_ (Bool -> Bool
not (Bool -> Bool) -> BufferM Bool -> BufferM Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM Bool
isNumberB) (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Int -> BufferM ()
moveXorEol Int
1
    Point
end <- BufferM Point
pointB
    if Bool
beginIsEol then Point -> BufferM ()
moveTo Point
start
    else do (YiString -> YiString) -> Region -> BufferM ()
modifyRegionB (Int -> YiString -> YiString
increment Int
n) (Point -> Point -> Region
mkRegion Point
begin Point
end)
            Int -> BufferM ()
moveXorSol Int
1

-- | Increment number in string by n.
increment :: Int -> R.YiString -> R.YiString
increment :: Int -> YiString -> YiString
increment Int
n YiString
l = [Char] -> YiString
R.fromString ([Char] -> YiString) -> [Char] -> YiString
forall a b. (a -> b) -> a -> b
$ ShowS
go (YiString -> [Char]
R.toString YiString
l)
  where
    go :: ShowS
go (Char
'0':Char
'x':[Char]
xs) = (\[Char]
ys -> Char
'0'Char -> ShowS
forall a. a -> [a] -> [a]
:Char
'x'Char -> ShowS
forall a. a -> [a] -> [a]
:[Char]
ys) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> ShowS
forall a. Integral a => a -> ShowS
`showHex` [Char]
"") (Int -> [Char]) -> ([Char] -> Int) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) (Int -> Int) -> ([Char] -> Int) -> [Char] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, [Char]) -> Int
forall a b. (a, b) -> a
fst ((Int, [Char]) -> Int)
-> ([Char] -> (Int, [Char])) -> [Char] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, [Char])] -> (Int, [Char])
forall a. HasCallStack => [a] -> a
head ([(Int, [Char])] -> (Int, [Char]))
-> ([Char] -> [(Int, [Char])]) -> [Char] -> (Int, [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [(Int, [Char])]
forall a. (Eq a, Num a) => ReadS a
readHex ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [Char]
xs
    go (Char
'0':Char
'o':[Char]
xs) = (\[Char]
ys -> Char
'0'Char -> ShowS
forall a. a -> [a] -> [a]
:Char
'o'Char -> ShowS
forall a. a -> [a] -> [a]
:[Char]
ys) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> ShowS
forall a. Integral a => a -> ShowS
`showOct` [Char]
"") (Int -> [Char]) -> ([Char] -> Int) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) (Int -> Int) -> ([Char] -> Int) -> [Char] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, [Char]) -> Int
forall a b. (a, b) -> a
fst ((Int, [Char]) -> Int)
-> ([Char] -> (Int, [Char])) -> [Char] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, [Char])] -> (Int, [Char])
forall a. HasCallStack => [a] -> a
head ([(Int, [Char])] -> (Int, [Char]))
-> ([Char] -> [(Int, [Char])]) -> [Char] -> (Int, [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [(Int, [Char])]
forall a. (Eq a, Num a) => ReadS a
readOct ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [Char]
xs
    go [Char]
s            = Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> [Char]) -> ([Char] -> Int) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) (Int -> Int) -> ([Char] -> Int) -> [Char] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\[Char]
x -> [Char] -> Int
forall a. Read a => [Char] -> a
read [Char]
x :: Int) ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [Char]
s

-- | Is character under cursor a number.
isNumberB :: BufferM Bool
isNumberB :: BufferM Bool
isNumberB = do
    Bool
eol <- BufferM Bool
atEol
    Bool
sol <- BufferM Bool
atSol
    if Bool
sol then Char -> Bool
isDigit (Char -> Bool) -> BufferM Char -> BufferM Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM Char
readB
    else if Bool
eol then Bool -> BufferM Bool
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
         else BufferM Bool
test3CharB

-- | Used by isNumber to test if current character under cursor is a number.
test3CharB :: BufferM Bool
test3CharB :: BufferM Bool
test3CharB = do
    Int -> BufferM ()
moveXorSol Int
1
    Char
previous <- BufferM Char
readB
    Int -> BufferM ()
moveXorEol Int
2
    Char
next <- BufferM Char
readB
    Int -> BufferM ()
moveXorSol Int
1
    Char
current <- BufferM Char
readB
    if | Char
previous Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'0' Bool -> Bool -> Bool
&& Char
current Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'o' Bool -> Bool -> Bool
&& Char -> Bool
isOctDigit Char
next -> Bool -> BufferM Bool
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True  -- octal format
       | Char
previous Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'0' Bool -> Bool -> Bool
&& Char
current Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'x' Bool -> Bool -> Bool
&& Char -> Bool
isHexDigit Char
next -> Bool -> BufferM Bool
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True  -- hex format
       |                    Char
current Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
&& Char -> Bool
isDigit Char
next    -> Bool -> BufferM Bool
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True  -- negative numbers
       |                    Char -> Bool
isDigit Char
current                   -> Bool -> BufferM Bool
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True  -- all decimal digits
       |                    Char -> Bool
isHexDigit Char
current                -> BufferM Bool
testHexB     -- ['a'..'f'] for hex
       | Bool
otherwise                                            -> Bool -> BufferM Bool
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

-- | Characters ['a'..'f'] are part of a hex number only if preceded by 0x.
-- Test if the current occurrence of ['a'..'f'] is part of a hex number.
testHexB :: BufferM Bool
testHexB :: BufferM Bool
testHexB = BufferM Bool -> BufferM Bool
forall a. BufferM a -> BufferM a
savingPointB (BufferM Bool -> BufferM Bool) -> BufferM Bool -> BufferM Bool
forall a b. (a -> b) -> a -> b
$ do
    BufferM Bool -> BufferM () -> BufferM ()
forall a. BufferM Bool -> BufferM a -> BufferM ()
untilB_ (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isHexDigit (Char -> Bool) -> BufferM Char -> BufferM Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM Char
readB) (Int -> BufferM ()
moveXorSol Int
1)
    Char
leftChar <- BufferM Char
readB
    Int -> BufferM ()
moveXorSol Int
1
    Char
leftToLeftChar <- BufferM Char
readB
    if Char
leftChar Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'x' Bool -> Bool -> Bool
&& Char
leftToLeftChar Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'0'
    then Bool -> BufferM Bool
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    else Bool -> BufferM Bool
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

-- | Move point down by @n@ lines
-- If line extends past width of window, count moving
-- a single line as moving width points to the right.
lineMoveVisRel :: Int -> BufferM ()
lineMoveVisRel :: Int -> BufferM ()
lineMoveVisRel = BufferM () -> BufferM ()
forall a. BufferM a -> BufferM a
movingToPrefVisCol (BufferM () -> BufferM ())
-> (Int -> BufferM ()) -> Int -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> BufferM ()
lineMoveVisRelUp

lineMoveVisRelUp :: Int -> BufferM ()
lineMoveVisRelUp :: Int -> BufferM ()
lineMoveVisRelUp Int
0 = () -> BufferM ()
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
lineMoveVisRelUp Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Int -> BufferM ()
lineMoveVisRelDown (Int -> BufferM ()) -> Int -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a. Num a => a -> a
negate Int
n
                   | Bool
otherwise = do
    Int
wid <- Window -> Int
width (Window -> Int) -> BufferM Window -> BufferM Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting Window FBuffer Window -> BufferM Window
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Window FBuffer Window
forall c. HasAttributes c => Lens' c Window
Lens' FBuffer Window
lastActiveWindowA
    Int
col <- BufferM Int
curCol
    Int
len <- BufferM Point
pointB BufferM Point -> (Point -> BufferM Point) -> BufferM Point
forall a b. BufferM a -> (a -> BufferM b) -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Point -> BufferM Point
eolPointB BufferM Point -> (Point -> BufferM Int) -> BufferM Int
forall a b. BufferM a -> (a -> BufferM b) -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Point -> BufferM Int
colOf
    let jumps :: Int
jumps = (Int
len Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
wid) Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
col Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
wid)
        next :: Int
next = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
jumps
    if Int
next Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
        then Int -> BufferM ()
moveXorEol (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
wid)
        else do Int -> BufferM ()
moveXorEol (Int
jumps Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
wid)
                BufferM Int -> BufferM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (BufferM Int -> BufferM ()) -> BufferM Int -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Int -> BufferM Int
gotoLnFrom Int
1
                Int -> BufferM ()
lineMoveVisRelUp (Int -> BufferM ()) -> Int -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Int
next Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

lineMoveVisRelDown :: Int -> BufferM ()
lineMoveVisRelDown :: Int -> BufferM ()
lineMoveVisRelDown Int
0 = () -> BufferM ()
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
lineMoveVisRelDown Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Int -> BufferM ()
lineMoveVisRelUp (Int -> BufferM ()) -> Int -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a. Num a => a -> a
negate Int
n
                     | Bool
otherwise = do
    Int
wid <- Window -> Int
width (Window -> Int) -> BufferM Window -> BufferM Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting Window FBuffer Window -> BufferM Window
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Window FBuffer Window
forall c. HasAttributes c => Lens' c Window
Lens' FBuffer Window
lastActiveWindowA
    Int
col <- BufferM Int
curCol
    let jumps :: Int
jumps = Int
col Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
wid
        next :: Int
next = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
jumps
    if Int
next Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
        then Int -> BufferM ()
leftN (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
wid)
        else do Int -> BufferM ()
leftN (Int
jumps Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
wid)
                BufferM Int -> BufferM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (BufferM Int -> BufferM ()) -> BufferM Int -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Int -> BufferM Int
gotoLnFrom (Int -> BufferM Int) -> Int -> BufferM Int
forall a b. (a -> b) -> a -> b
$ -Int
1
                BufferM ()
moveToEol
                Int -> BufferM ()
lineMoveVisRelDown (Int -> BufferM ()) -> Int -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Int
next Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

-- | Implements the same logic that emacs' `mark-word` does.
-- Checks the mark point and moves it forth (or backward) for one word.
markWord :: BufferM ()
markWord :: BufferM ()
markWord = do
    Point
curPos <- BufferM Point
pointB
    Point
curMark <- BufferM Point
getSelectionMarkPointB
    Bool
isVisible <- BufferM Bool
getVisibleSelection

    BufferM () -> BufferM ()
forall a. BufferM a -> BufferM a
savingPointB (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$ do
        if Bool -> Bool
not Bool
isVisible
        then BufferM ()
nextWordB
        else do
            Point -> BufferM ()
moveTo Point
curMark
            if Point
curMark Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
< Point
curPos
            then BufferM ()
prevWordB
            else BufferM ()
nextWordB

        Bool -> BufferM ()
setVisibleSelection Bool
True
        BufferM Point
pointB BufferM Point -> (Point -> BufferM ()) -> BufferM ()
forall a b. BufferM a -> (a -> BufferM b) -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Point -> BufferM ()
setSelectionMarkPointB