{-# 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
        eol <- BufferM Bool
atEol
        sol <- atSol
        when (eol && not sol) 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 c <- BufferM Bool
atSol; unless c 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 c <- BufferM Bool
atEol; unless c 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
    start <- BufferM Point
pointB
    let 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)
        (move, moveBack) = if dir == Forward then (rightB, leftB) else (leftB, rightB)
    doUntilB_ (predicate <$> readB) move
    b <- readB
    if stopAtLineBreaks && b == '\n'
    then moveTo start
    else when (style == Exclusive && b == c) 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
  prev <- BufferM YiString
readPreviousOfLnB
  if R.all isSpace prev then moveToSol else 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
    isEmpty <- BufferM Bool
isCurrentLineEmptyB
    if isEmpty
    then return False
    else do
        let go = do
                  eol <- BufferM Bool
atEol
                  if eol
                  then return True
                  else do
                      c <- readB
                      if isSpace c
                      then rightB >> go
                      else return False
        moveToSol
        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
  sof <- BufferM Bool
atSof
  if sof then pointB
         else do p <- pointB
                 return $ Point (fromPoint p - 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
  c <- BufferM Int
curCol
  reg <- regionOfB Line
  text <- readRegionB reg
  let (r, jb) = deleteSpaces c text
  modifyRegionB (const r) 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.
  moveToColB $ c - 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 eol <- BufferM Bool
atEol
           when eol leftB
           transposeB Character 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 m <- BufferM Point
getSelectionMarkPointB
                           p <- pointB
                           setSelectionMarkPointB p
                           moveTo 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
    s <- BufferM Point
sizeB
    p <- pointB
    m <- gets isUnchangedBuffer
    l <- curLn
    c <- curCol
    nm <- gets identString
    let 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
                                 }
    return 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
    h <- (Window -> Int) -> BufferM Int
forall a. (Window -> a) -> BufferM a
askWindow Window -> Int
actualLines
    scrollB $ n * max 0 (h - 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 h <- (Window -> Int) -> BufferM Int
forall a. (Window -> a) -> BufferM a
askWindow Window -> Int
actualLines
                      vimScrollB $ n * f h

-- | Move to middle line in screen
scrollToCursorB :: BufferM ()
scrollToCursorB :: BufferM ()
scrollToCursorB = do
    MarkSet f i _ <- BufferM (MarkSet Int)
markLines
    h <- askWindow actualLines
    let 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)
    scrollB $ i - m

-- | Move cursor to the top of the screen
scrollCursorToTopB :: BufferM ()
scrollCursorToTopB :: BufferM ()
scrollCursorToTopB = do
    MarkSet f i _ <- BufferM (MarkSet Int)
markLines
    scrollB $ i - 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 f i _ <- BufferM (MarkSet Int)
markLines
    h <- askWindow actualLines
    scrollB $ i - f - h + 1

-- | Scroll by n lines.
scrollB :: Int -> BufferM ()
scrollB :: Int -> BufferM ()
scrollB Int
n = do
  MarkSet fr _ _ <- BufferM (MarkSet Mark)
askMarks
  savingPointB $ do
    moveTo =<< use (markPointA fr)
    void $ gotoLnFrom n
    (markPointA fr .=) =<< pointB
  w <- askWindow wkey
  pointFollowsWindowA %= Set.insert 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
    w <- (Window -> WindowRef) -> BufferM WindowRef
forall a. (Window -> a) -> BufferM a
askWindow Window -> WindowRef
wkey
    movePoint <- Set.member w <$> use pointFollowsWindowA
    when movePoint $ do
        r <- winRegionB
        p <- pointB
        moveTo $ max (regionStart r) $ min (regionEnd r) 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
    w <- (Window -> WindowRef) -> BufferM WindowRef
forall a. (Window -> a) -> BufferM a
askWindow Window -> WindowRef
wkey
    movePoint <- Set.member w <$> use pointFollowsWindowA
    if movePoint then return False else do
        inWin <- pointInWindowB =<< pointB
        if inWin then return False else do
            h <- askWindow actualLines
            r <- winRegionB
            p <- pointB
            let 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
            i <- indexOfSolAbove gap
            f <- fromMark <$> askMarks
            markPointA f .= i
            return 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
  r <- BufferM Region
winRegionB
  moveTo (regionEnd r - 1)
  moveToSol
  replicateM_ n lineUp

-- | Move to middle line in screen
middleB :: BufferM ()
middleB :: BufferM ()
middleB = do
  w <- BufferM Window
forall r (m :: * -> *). MonadReader r m => m r
ask
  f <- fromMark <$> askMarks
  moveTo =<< use (markPointA f)
  replicateM_ (actualLines w `div` 2) 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
  m <- BufferM Point
getSelectionMarkPointB
  p <- pointB
  return $ mkRegion p m

-- | Return the empty region if the selection is not visible.
getRawSelectRegionB :: BufferM Region
getRawSelectRegionB :: BufferM Region
getRawSelectRegionB = do
  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 s then getRawestSelectRegionB else do
     p <- pointB
     return $ mkRegion p p

-- | Get the current region boundaries. Extended to the current selection unit.
getSelectRegionB :: BufferM Region
getSelectRegionB :: BufferM Region
getSelectRegionB = do
  regionStyle <- BufferM RegionStyle
getRegionStyle
  r <- getRawSelectRegionB
  convertRegionToStyleB r 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
  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
  when isThisBlank $ do
    p <- pointB
    -- go up to the 1st blank line in the group
    void $ whileB (R.null <$> getNextLineB Backward) lineUp
    q <- pointB
    -- delete the whole blank region.
    deleteRegionB $ mkRegion p 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
  l <- TextUnit -> BufferM YiString
readUnitB TextUnit
Line
  if delPrefix == R.take (R.length delPrefix) l
    then unLineCommentSelectionB insPrefix delPrefix
    else linePrefixSelectionB insPrefix

-- | Replace the contents of the buffer with some string
replaceBufferContent :: YiString -> BufferM ()
replaceBufferContent :: YiString -> BufferM ()
replaceBufferContent YiString
newvalue = do
  r <- TextUnit -> BufferM Region
regionOfB TextUnit
Document
  replaceRegionB r 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
    reg <- TextUnit -> Region -> BufferM Region
unitWiseRegion TextUnit
Line Region
region
    modifyRegionB transform (fixR 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
  r <- TextUnit -> BufferM Region
regionOfB TextUnit
Document
  replaceRegionB r s
  markSavedB 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
    (l0, 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
    (l1, c1) <- getLineAndColOfPoint $ regionEnd reg
    let (left, top, bottom, right) = (min c0 c1, min l0 l1, max l0 l1, max c0 c1)
    lengths <- forM [top .. bottom] $ \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
        currentLeft <- BufferM Int
curCol
        if currentLeft /= left
        then return 0
        else do
            moveToColB right
            rightAtEol <- atEol
            leftOnEol
            currentRight <- curCol
            return $ if currentRight == 0 && rightAtEol
                     then 0
                     else currentRight - currentLeft + 1
    startingPoint <- pointOfLineColB top left
    return (startingPoint, 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
    (l0, _) <- 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
    (l1, _) <- getLineAndColOfPoint $ regionEnd reg
    moveTo $ regionStart reg
    fmap catMaybes $ forM [0 .. abs (l0 - l1)] $ \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
        p <- BufferM Point
pointB
        eol <- atEol
        return (if not eol then Just p else 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
    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]
acc Point
p = do Point -> BufferM ()
moveTo Point
p
                       BufferM ()
moveToSol
                       edge <- BufferM Point
pointB
                       if edge >= lastSol
                       then return $ reverse (edge:acc)
                       else do
                           void $ lineMoveRel 1
                           go (edge:acc) =<< pointB
    go [] (regionStart 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
    (l0, _) <- 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
    (l1, _) <- getLineAndColOfPoint $ regionEnd reg
    moveTo $ 1 + regionEnd reg
    fmap reverse $ forM [0 .. abs (l0 - l1)] $ \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
    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]
acc Point
p = do Point -> BufferM ()
moveTo Point
p
                       BufferM ()
moveToEol
                       edge <- BufferM Point
pointB
                       if edge >= lastEol
                       then return $ reverse (edge:acc)
                       else do
                           void $ lineMoveRel 1
                           go (edge:acc) =<< pointB
    go [] (regionStart 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
    (start, lengths) <- Region -> BufferM (Point, [Int])
shapeOfBlockRegionB Region
reg
    forM (zip [0..] lengths) $ \(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
        p0 <- BufferM Point
pointB
        moveXorEol l
        p1 <- pointB
        let subRegion = Point -> Point -> Region
mkRegion Point
p0 Point
p1
        return 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
    (start, lengths) <- Region -> BufferM (Point, [Int])
shapeOfBlockRegionB Region
reg
    moveTo start
    points <- forM (zip [1..] lengths) $ \(Int
i, Int
l) -> do
        Int -> BufferM ()
deleteN Int
l
        p <- BufferM Point
pointB
        moveTo start
        lineMoveRel i
        return (if l == 0 then Nothing else Just p)
    return $ start :| drop 1 (catMaybes 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
    effectiveRegion <- Region -> RegionStyle -> BufferM Region
convertRegionToStyleB Region
reg RegionStyle
style
    deleteRegionB effectiveRegion
    return $! pure (regionStart 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
    (start, lengths) <- Region -> BufferM (Point, [Int])
shapeOfBlockRegionB Region
reg
    moveTo start
    chunks <- forM lengths $ \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
            p <- BufferM Point
pointB
            r <- readRegionB $ mkRegion p (p +~ Size l)
            void $ lineMoveRel 1
            return r
    return $ R.intersperse '\n' 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
          col <- BufferM Int
curCol
          moveToEol
          newlineB
          insertN $ R.replicateChar col ' '

  [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
    (_, c0) <- Point -> BufferM (Int, Int)
getLineAndColOfPoint Point
p0
    (_, c1) <- getLineAndColOfPoint p1
    case compare c0 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
            flippedP0 <- BufferM Point
pointB
            return (flippedP0, p1 -~ Size (c1 - 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
    lineCount <- BufferM Int
lineCountB
    void $ gotoLn $ floor (fromIntegral lineCount * f)
    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
          c <- BufferM Char
readB
          case 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 eof <- BufferM Bool
atEof
                       eol <- atEol
                       if eof || eol
                           then return False
                           else rightB >> goToMatch
    p <- BufferM Point
pointB
    foundMatch <- goToMatch
    unless foundMatch $ moveTo p

-- Vim numbers

-- | Increase (or decrease if negative) next number on line by n.
incrementNextNumberByB :: Int -> BufferM ()
incrementNextNumberByB :: Int -> BufferM ()
incrementNextNumberByB Int
n = do
    start <- BufferM Point
pointB
    untilB_ (not <$> isNumberB) $ moveXorSol 1
    untilB_          isNumberB  $ moveXorEol 1
    begin <- pointB
    beginIsEol <- atEol
    untilB_ (not <$> isNumberB) $ moveXorEol 1
    end <- pointB
    if beginIsEol then moveTo start
    else do modifyRegionB (increment n) (mkRegion begin end)
            moveXorSol 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
    eol <- BufferM Bool
atEol
    sol <- atSol
    if sol then isDigit <$> readB
    else if eol then return False
         else 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
    previous <- BufferM Char
readB
    moveXorEol 2
    next <- readB
    moveXorSol 1
    current <- readB
    if | previous == '0' && current == 'o' && isOctDigit next -> return True  -- octal format
       | previous == '0' && current == 'x' && isHexDigit next -> return True  -- hex format
       |                    current == '-' && isDigit next    -> return True  -- negative numbers
       |                    isDigit current                   -> return True  -- all decimal digits
       |                    isHexDigit current                -> testHexB     -- ['a'..'f'] for hex
       | otherwise                                            -> return 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)
    leftChar <- BufferM Char
readB
    moveXorSol 1
    leftToLeftChar <- readB
    if leftChar == 'x' && leftToLeftChar == '0'
    then return True
    else return 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
    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
    col <- curCol
    len <- pointB >>= eolPointB >>= colOf
    let 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
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
jumps
    if next <= 0
        then moveXorEol (n * wid)
        else do moveXorEol (jumps * wid)
                void $ gotoLnFrom 1
                lineMoveVisRelUp $ next - 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
    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
    col <- curCol
    let jumps = Int
col Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
wid
        next = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
jumps
    if next <= 0
        then leftN (n * wid)
        else do leftN (jumps * wid)
                void $ gotoLnFrom $ -1
                moveToEol
                lineMoveVisRelDown $ next - 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
    curPos <- BufferM Point
pointB
    curMark <- getSelectionMarkPointB
    isVisible <- getVisibleSelection

    savingPointB $ do
        if not isVisible
        then nextWordB
        else do
            moveTo curMark
            if curMark < curPos
            then prevWordB
            else nextWordB

        setVisibleSelection True
        pointB >>= setSelectionMarkPointB