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
, setSelectionMarkPointB
, setSelectRegionB
, shapeOfBlockRegionB
, sortLines
, sortLinesWithRegion
, snapInsB
, snapScreenB
, splitBlockRegionToContiguousSubRegionsB
, swapB
, switchCaseChar
, test3CharB
, testHexB
, toggleCommentB
, topB
, unLineCommentSelectionB
, upFromBosB
, uppercaseWordB
, upScreenB
, upScreensB
, vimScrollB
, vimScrollByB
, markWord
) where
import Control.Applicative (Applicative ((<*>)), (<$>))
import Control.Lens (assign, over, use, (%=), (.=))
import Control.Lens.Cons (_last)
import Control.Monad (forM, forM_, liftM, 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.Maybe (catMaybes, fromMaybe, listToMaybe)
import Data.Monoid (Monoid (mempty), (<>))
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))
moveToMTB :: BufferM ()
moveToMTB = (==) <$> curLn <*> screenMidLn >>= \case
True -> downFromTosB 0
_ -> (==) <$> curLn <*> screenTopLn >>= \case
True -> upFromBosB 0
_ -> downFromTosB =<< () <$> screenMidLn <*> screenTopLn
moveToSol :: BufferM ()
moveToSol = maybeMoveB Line Backward
moveToEol :: BufferM ()
moveToEol = maybeMoveB Line Forward
topB :: BufferM ()
topB = moveTo 0
botB :: BufferM ()
botB = moveTo =<< sizeB
leftOnEol :: BufferM ()
leftOnEol = savingPrefCol $ do
eol <- atEol
sol <- atSol
when (eol && not sol) leftB
moveXorSol :: Int -> BufferM ()
moveXorSol x = replicateM_ x $ do c <- atSol; unless c leftB
moveXorEol :: Int -> BufferM ()
moveXorEol x = replicateM_ x $ do c <- atEol; unless c rightB
nextWordB :: BufferM ()
nextWordB = moveB unitWord Forward
prevWordB :: BufferM ()
prevWordB = moveB unitWord Backward
gotoCharacterB :: Char -> Direction -> RegionStyle -> Bool -> BufferM ()
gotoCharacterB c dir style stopAtLineBreaks = do
start <- pointB
let predicate = if stopAtLineBreaks then (`elem` [c, '\n']) else (== 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
nextCInc :: Char -> BufferM ()
nextCInc c = gotoCharacterB c Forward Inclusive False
nextCInLineInc :: Char -> BufferM ()
nextCInLineInc c = gotoCharacterB c Forward Inclusive True
nextCExc :: Char -> BufferM ()
nextCExc c = gotoCharacterB c Forward Exclusive False
nextCInLineExc :: Char -> BufferM ()
nextCInLineExc c = gotoCharacterB c Forward Exclusive True
prevCInc :: Char -> BufferM ()
prevCInc c = gotoCharacterB c Backward Inclusive False
prevCInLineInc :: Char -> BufferM ()
prevCInLineInc c = gotoCharacterB c Backward Inclusive True
prevCExc :: Char -> BufferM ()
prevCExc c = gotoCharacterB c Backward Exclusive False
prevCInLineExc :: Char -> BufferM ()
prevCInLineExc c = gotoCharacterB c Backward Exclusive True
firstNonSpaceB :: BufferM ()
firstNonSpaceB = do
moveToSol
untilB_ ((||) <$> atEol <*> ((not . isSpace) <$> readB)) rightB
lastNonSpaceB :: BufferM ()
lastNonSpaceB = do
moveToEol
untilB_ ((||) <$> atSol <*> ((not . isSpace) <$> readB)) leftB
moveNonspaceOrSol :: BufferM ()
moveNonspaceOrSol = do
prev <- readPreviousOfLnB
if R.all isSpace prev then moveToSol else firstNonSpaceB
isCurrentLineEmptyB :: BufferM Bool
isCurrentLineEmptyB = savingPointB $ moveToSol >> atEol
isCurrentLineAllWhiteSpaceB :: BufferM Bool
isCurrentLineAllWhiteSpaceB = savingPointB $ do
isEmpty <- isCurrentLineEmptyB
if isEmpty
then return False
else do
let go = do
eol <- atEol
if eol
then return True
else do
c <- readB
if isSpace c
then rightB >> go
else return False
moveToSol
go
nextNParagraphs :: Int -> BufferM ()
nextNParagraphs n = replicateM_ n $ moveB unitEmacsParagraph Forward
prevNParagraphs :: Int -> BufferM ()
prevNParagraphs n = replicateM_ n $ moveB unitEmacsParagraph Backward
goUnmatchedB :: Direction -> Char -> Char -> BufferM ()
goUnmatchedB dir cStart' cStop' = getLineAndCol >>= \position ->
stepB >> readB >>= go position (0::Int)
where
go pos opened c
| c == cStop && opened == 0 = return ()
| c == cStop = goIfNotEofSof pos (opened1)
| c == cStart = goIfNotEofSof pos (opened+1)
| otherwise = goIfNotEofSof pos opened
goIfNotEofSof pos opened = atEof >>= \eof -> atSof >>= \sof ->
if not eof && not sof
then stepB >> readB >>= go pos opened
else gotoLn (fst pos) >> moveToColB (snd pos)
(stepB, cStart, cStop) | dir == Forward = (rightB, cStart', cStop')
| otherwise = (leftB, cStop', cStart')
atSol :: BufferM Bool
atSol = atBoundaryB Line Backward
atEol :: BufferM Bool
atEol = atBoundaryB Line Forward
atSof :: BufferM Bool
atSof = atBoundaryB Document Backward
atEof :: BufferM Bool
atEof = atBoundaryB Document Forward
atLastLine :: BufferM Bool
atLastLine = savingPointB $ do
moveToEol
(==) <$> sizeB <*> pointB
getLineAndCol :: BufferM (Int, Int)
getLineAndCol = (,) <$> curLn <*> curCol
getLineAndColOfPoint :: Point -> BufferM (Int, Int)
getLineAndColOfPoint p = savingPointB $ moveTo p >> getLineAndCol
readLnB :: BufferM YiString
readLnB = readUnitB Line
readPreviousOfLnB :: BufferM YiString
readPreviousOfLnB = readRegionB =<< regionOfPartB Line Backward
hasWhiteSpaceBefore :: BufferM Bool
hasWhiteSpaceBefore = liftM isSpace (prevPointB >>= readAtB)
prevPointB :: BufferM Point
prevPointB = do
sof <- atSof
if sof then pointB
else do p <- pointB
return $ Point (fromPoint p 1)
readCurrentWordB :: BufferM YiString
readCurrentWordB = readUnitB unitWord
readPrevWordB :: BufferM YiString
readPrevWordB = readPrevUnitB unitViWordOnLine
bdeleteB :: BufferM ()
bdeleteB = deleteB Character Backward
killWordB :: BufferM ()
killWordB = deleteB unitWord Forward
bkillWordB :: BufferM ()
bkillWordB = deleteB unitWord Backward
bdeleteLineB :: BufferM ()
bdeleteLineB = atSol >>= \sol -> if sol then bdeleteB else deleteB Line Backward
deleteHorizontalSpaceB :: Maybe Int -> BufferM ()
deleteHorizontalSpaceB u = do
c <- curCol
reg <- regionOfB Line
text <- readRegionB reg
let (r, jb) = deleteSpaces c text
modifyRegionB (const r) reg
moveToColB $ c jb
where
deleteSpaces :: Int -> R.YiString -> (R.YiString, Int)
deleteSpaces c l =
let (f, b) = R.splitAt c l
f' = R.dropWhileEnd isSpace f
cleaned = f' <> case u of
Nothing -> R.dropWhile isSpace b
Just _ -> b
in (cleaned, R.length f R.length f')
uppercaseWordB :: BufferM ()
uppercaseWordB = transformB (R.withText T.toUpper) unitWord Forward
lowercaseWordB :: BufferM ()
lowercaseWordB = transformB (R.withText T.toLower) unitWord Forward
capitaliseWordB :: BufferM ()
capitaliseWordB = transformB capitalizeFirst unitWord Forward
switchCaseChar :: Char -> Char
switchCaseChar c = if isUpper c then toLower c else toUpper c
deleteToEol :: BufferM ()
deleteToEol = deleteRegionB =<< regionOfPartB Line Forward
swapB :: BufferM ()
swapB = do eol <- atEol
when eol leftB
transposeB Character Forward
deleteTrailingSpaceB :: BufferM ()
deleteTrailingSpaceB =
regionOfB Document >>=
savingPositionB . modifyRegionB (tru . mapLines stripEnd)
where
stripEnd :: R.YiString -> R.YiString
stripEnd x = case R.last x of
Nothing -> x
Just '\n' -> (`R.snoc` '\n') $ R.dropWhileEnd isSpace x
_ -> R.dropWhileEnd isSpace x
tru :: R.YiString -> R.YiString
tru x = if R.length x == 0
then x
else (`R.snoc` '\n') $ R.dropWhileEnd (== '\n') x
setSelectionMarkPointB :: Point -> BufferM ()
setSelectionMarkPointB p = (.= p) . markPointA =<< selMark <$> askMarks
getSelectionMarkPointB :: BufferM Point
getSelectionMarkPointB = use . markPointA =<< selMark <$> askMarks
exchangePointAndMarkB :: BufferM ()
exchangePointAndMarkB = do m <- getSelectionMarkPointB
p <- pointB
setSelectionMarkPointB p
moveTo m
getBookmarkB :: String -> BufferM Mark
getBookmarkB = getMarkB . Just
data BufferFileInfo =
BufferFileInfo { bufInfoFileName :: FilePath
, bufInfoSize :: Int
, bufInfoLineNo :: Int
, bufInfoColNo :: Int
, bufInfoCharNo :: Point
, bufInfoPercent :: T.Text
, bufInfoModified :: Bool
}
bufInfoB :: BufferM BufferFileInfo
bufInfoB = do
s <- sizeB
p <- pointB
m <- gets isUnchangedBuffer
l <- curLn
c <- curCol
nm <- gets identString
let bufInfo = BufferFileInfo { bufInfoFileName = T.unpack nm
, bufInfoSize = fromIntegral s
, bufInfoLineNo = l
, bufInfoColNo = c
, bufInfoCharNo = p
, bufInfoPercent = getPercent p s
, bufInfoModified = not m
}
return bufInfo
upScreensB :: Int -> BufferM ()
upScreensB = scrollScreensB . negate
downScreensB :: Int -> BufferM ()
downScreensB = scrollScreensB
upScreenB :: BufferM ()
upScreenB = scrollScreensB (1)
downScreenB :: BufferM ()
downScreenB = scrollScreensB 1
scrollScreensB :: Int -> BufferM ()
scrollScreensB n = do
h <- askWindow actualLines
scrollB $ n * max 0 (h 1)
vimScrollB :: Int -> BufferM ()
vimScrollB n = do scrollB n
void $ lineMoveRel n
vimScrollByB :: (Int -> Int) -> Int -> BufferM ()
vimScrollByB f n = do h <- askWindow actualLines
vimScrollB $ n * f h
scrollToCursorB :: BufferM ()
scrollToCursorB = do
MarkSet f i _ <- markLines
h <- askWindow actualLines
let m = f + (h `div` 2)
scrollB $ i m
scrollCursorToTopB :: BufferM ()
scrollCursorToTopB = do
MarkSet f i _ <- markLines
scrollB $ i f
scrollCursorToBottomB :: BufferM ()
scrollCursorToBottomB = do
MarkSet _ i _ <- markLines
r <- winRegionB
t <- lineOf (regionEnd r 1)
scrollB $ i t
scrollB :: Int -> BufferM ()
scrollB n = do
MarkSet fr _ _ <- askMarks
savingPointB $ do
moveTo =<< use (markPointA fr)
void $ gotoLnFrom n
(markPointA fr .=) =<< pointB
w <- askWindow wkey
(%=) pointFollowsWindowA (\old w' -> ((w == w') || old w'))
scrollToLineAboveWindowB :: BufferM ()
scrollToLineAboveWindowB = do downFromTosB 0
replicateM_ 1 lineUp
scrollCursorToBottomB
scrollToLineBelowWindowB :: BufferM ()
scrollToLineBelowWindowB = do upFromBosB 0
replicateM_ 1 lineDown
scrollCursorToTopB
snapInsB :: BufferM ()
snapInsB = do
movePoint <- use pointFollowsWindowA
w <- askWindow wkey
when (movePoint w) $ do
r <- winRegionB
p <- pointB
moveTo $ max (regionStart r) $ min (regionEnd r) p
indexOfSolAbove :: Int -> BufferM Point
indexOfSolAbove n = pointAt $ gotoLnFrom (negate n)
data RelPosition = Above | Below | Within
deriving (Show)
pointScreenRelPosition :: Point -> Point -> Point -> RelPosition
pointScreenRelPosition p rs re
| rs > p && p > re = Within
| p < rs = Above
| p > re = Below
pointScreenRelPosition _ _ _ = Within
snapScreenB :: Maybe ScrollStyle ->BufferM Bool
snapScreenB style = do
movePoint <- use pointFollowsWindowA
w <- askWindow wkey
if movePoint w 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 style of
Just SingleLine -> case pointScreenRelPosition p (regionStart r) (regionEnd r) of
Above -> 0
Below -> h 1
Within -> 0
_ -> h `div` 2
i <- indexOfSolAbove gap
f <- fromMark <$> askMarks
markPointA f .= i
return True
downFromTosB :: Int -> BufferM ()
downFromTosB n = do
moveTo =<< use . markPointA =<< fromMark <$> askMarks
replicateM_ n lineDown
upFromBosB :: Int -> BufferM ()
upFromBosB n = do
r <- winRegionB
moveTo (regionEnd r 1)
moveToSol
replicateM_ n lineUp
middleB :: BufferM ()
middleB = do
w <- ask
f <- fromMark <$> askMarks
moveTo =<< use (markPointA f)
replicateM_ (actualLines w `div` 2) lineDown
pointInWindowB :: Point -> BufferM Bool
pointInWindowB p = nearRegion p <$> winRegionB
getRawestSelectRegionB :: BufferM Region
getRawestSelectRegionB = do
m <- getSelectionMarkPointB
p <- pointB
return $ mkRegion p m
getRawSelectRegionB :: BufferM Region
getRawSelectRegionB = do
s <- use highlightSelectionA
if s then getRawestSelectRegionB else do
p <- pointB
return $ mkRegion p p
getSelectRegionB :: BufferM Region
getSelectRegionB = do
regionStyle <- getRegionStyle
r <- getRawSelectRegionB
convertRegionToStyleB r regionStyle
setSelectRegionB :: Region -> BufferM ()
setSelectRegionB region = do
assign highlightSelectionA True
setSelectionMarkPointB $ regionStart region
moveTo $ regionEnd region
deleteBlankLinesB :: BufferM ()
deleteBlankLinesB = do
isThisBlank <- isBlank <$> readLnB
when isThisBlank $ do
p <- pointB
void $ whileB (R.null <$> getNextLineB Backward) lineUp
q <- pointB
deleteRegionB $ mkRegion p q
lineStreamB :: Direction -> BufferM [YiString]
lineStreamB dir = fmap rev . R.lines <$> (streamB dir =<< pointB)
where
rev = case dir of
Forward -> id
Backward -> R.reverse
getMaybeNextLineB :: Direction -> BufferM (Maybe YiString)
getMaybeNextLineB dir = listToMaybe <$> lineStreamB dir
getNextLineB :: Direction -> BufferM YiString
getNextLineB dir = fromMaybe R.empty <$> getMaybeNextLineB dir
getNextLineWhichB :: Direction -> (YiString -> Bool) -> BufferM (Maybe YiString)
getNextLineWhichB dir cond = listToMaybe . filter cond <$> lineStreamB dir
getNextNonBlankLineB :: Direction -> BufferM YiString
getNextNonBlankLineB dir =
fromMaybe R.empty <$> getNextLineWhichB dir (not . R.null)
modifyExtendedSelectionB :: TextUnit -> (R.YiString -> R.YiString) -> BufferM ()
modifyExtendedSelectionB unit transform
= modifyRegionB transform =<< unitWiseRegion unit =<< getSelectRegionB
linePrefixSelectionB :: R.YiString
-> BufferM ()
linePrefixSelectionB s =
modifyExtendedSelectionB Line . overInit $ mapLines (s <>)
unLineCommentSelectionB :: R.YiString
-> R.YiString
-> BufferM ()
unLineCommentSelectionB s1 s2 =
modifyExtendedSelectionB Line $ mapLines unCommentLine
where
(l1, l2) = (R.length s1, R.length s2)
unCommentLine :: R.YiString -> R.YiString
unCommentLine line = case (R.splitAt l1 line, R.splitAt l2 line) of
((f, s) , (f', s')) | s1 == f -> s
| s2 == f' -> s'
| otherwise -> line
toggleCommentB :: R.YiString -> BufferM ()
toggleCommentB c = toggleCommentSelectionB (c `R.snoc` ' ') c
toggleCommentSelectionB :: R.YiString -> R.YiString -> BufferM ()
toggleCommentSelectionB insPrefix delPrefix = do
l <- readUnitB Line
if delPrefix == R.take (R.length delPrefix) l
then unLineCommentSelectionB insPrefix delPrefix
else linePrefixSelectionB insPrefix
replaceBufferContent :: YiString -> BufferM ()
replaceBufferContent newvalue = do
r <- regionOfB Document
replaceRegionB r newvalue
fillRegion :: Region -> BufferM ()
fillRegion = modifyRegionB (R.unlines . fillText 80)
fillParagraph :: BufferM ()
fillParagraph = fillRegion =<< regionOfB unitParagraph
sortLines :: BufferM ()
sortLines = modifyExtendedSelectionB Line (onLines sort)
modifyExtendedLRegion :: Region -> (R.YiString -> R.YiString) -> BufferM ()
modifyExtendedLRegion region transform = do
reg <- unitWiseRegion Line region
modifyRegionB transform (fixR reg)
where fixR reg = mkRegion (regionStart reg) $ regionEnd reg + 1
sortLinesWithRegion :: Region -> BufferM ()
sortLinesWithRegion region = modifyExtendedLRegion region (onLines sort')
where sort' [] = []
sort' lns =
if hasnl (last lns)
then sort lns
else over _last
(fromMaybe (error "sortLinesWithRegion fromMaybe") . R.init) . sort $
over _last (`R.snoc` '\n') lns
hasnl t | R.last t == Just '\n' = True
| otherwise = False
revertB :: YiString -> Maybe R.ConverterName -> UTCTime -> BufferM ()
revertB s cn now = do
r <- regionOfB Document
replaceRegionB r s
encodingConverterNameA .= cn
markSavedB now
shapeOfBlockRegionB :: Region -> BufferM (Point, [Int])
shapeOfBlockRegionB reg = savingPointB $ do
(l0, c0) <- getLineAndColOfPoint $ regionStart 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] $ \l -> do
void $ gotoLn l
moveToColB left
currentLeft <- 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 Block reg = savingPointB $ do
(l0, _) <- getLineAndColOfPoint $ regionStart reg
(l1, _) <- getLineAndColOfPoint $ regionEnd reg
moveTo $ regionStart reg
fmap catMaybes $ forM [0 .. abs (l0 l1)] $ \i -> savingPointB $ do
void $ lineMoveRel i
p <- pointB
eol <- atEol
return (if not eol then Just p else Nothing)
leftEdgesOfRegionB LineWise reg = savingPointB $ do
lastSol <- do
moveTo $ regionEnd reg
moveToSol
pointB
let go acc p = do moveTo p
moveToSol
edge <- pointB
if edge >= lastSol
then return $ reverse (edge:acc)
else do
void $ lineMoveRel 1
go (edge:acc) =<< pointB
go [] (regionStart reg)
leftEdgesOfRegionB _ r = return [regionStart r]
rightEdgesOfRegionB :: RegionStyle -> Region -> BufferM [Point]
rightEdgesOfRegionB Block reg = savingPointB $ do
(l0, _) <- getLineAndColOfPoint $ regionStart reg
(l1, _) <- getLineAndColOfPoint $ regionEnd reg
moveTo $ 1 + regionEnd reg
fmap reverse $ forM [0 .. abs (l0 l1)] $ \i -> savingPointB $ do
void $ lineMoveRel $ i
pointB
rightEdgesOfRegionB LineWise reg = savingPointB $ do
lastEol <- do
moveTo $ regionEnd reg
moveToEol
pointB
let go acc p = do moveTo p
moveToEol
edge <- pointB
if edge >= lastEol
then return $ reverse (edge:acc)
else do
void $ lineMoveRel 1
go (edge:acc) =<< pointB
go [] (regionStart reg)
rightEdgesOfRegionB _ reg = savingPointB $ do
moveTo $ regionEnd reg
leftOnEol
fmap return pointB
splitBlockRegionToContiguousSubRegionsB :: Region -> BufferM [Region]
splitBlockRegionToContiguousSubRegionsB reg = savingPointB $ do
(start, lengths) <- shapeOfBlockRegionB reg
moveTo start
forM lengths $ \l -> do
p0 <- pointB
moveXorEol l
p1 <- pointB
let subRegion = mkRegion p0 p1
moveTo p0
void $ lineMoveRel 1
return subRegion
deleteRegionWithStyleB :: Region -> RegionStyle -> BufferM Point
deleteRegionWithStyleB reg Block = savingPointB $ do
(start, lengths) <- shapeOfBlockRegionB reg
moveTo start
forM_ (zip [1..] lengths) $ \(i, l) -> do
deleteN l
moveTo start
lineMoveRel i
return start
deleteRegionWithStyleB reg style = savingPointB $ do
effectiveRegion <- convertRegionToStyleB reg style
deleteRegionB effectiveRegion
return $! regionStart effectiveRegion
readRegionRopeWithStyleB :: Region -> RegionStyle -> BufferM YiString
readRegionRopeWithStyleB reg Block = savingPointB $ do
(start, lengths) <- shapeOfBlockRegionB reg
moveTo start
chunks <- forM lengths $ \l ->
if l == 0
then lineMoveRel 1 >> return mempty
else do
p <- pointB
r <- readRegionB $ mkRegion p (p +~ Size l)
void $ lineMoveRel 1
return r
return $ R.intersperse '\n' chunks
readRegionRopeWithStyleB reg style = readRegionB =<< convertRegionToStyleB reg style
insertRopeWithStyleB :: YiString -> RegionStyle -> BufferM ()
insertRopeWithStyleB rope Block = savingPointB $ do
let ls = R.lines rope
advanceLine = atLastLine >>= \case
False -> void $ lineMoveRel 1
True -> do
col <- curCol
moveToEol
newlineB
insertN $ R.replicateChar col ' '
sequence_ $ intersperse advanceLine $ fmap (savingPointB . insertN) ls
insertRopeWithStyleB rope LineWise = do
moveToSol
savingPointB $ insertN rope
insertRopeWithStyleB rope _ = insertN rope
flipRectangleB :: Point -> Point -> BufferM (Point, Point)
flipRectangleB p0 p1 = savingPointB $ do
(_, c0) <- getLineAndColOfPoint p0
(_, c1) <- getLineAndColOfPoint p1
case compare c0 c1 of
EQ -> return (p0, p1)
GT -> swap <$> flipRectangleB p1 p0
LT -> do
moveTo p0
moveXorEol $ c1 c0
flippedP0 <- pointB
return (flippedP0, p1 -~ Size (c1 c0))
movePercentageFileB :: Int -> BufferM ()
movePercentageFileB i = do
let f :: Double
f = case fromIntegral i / 100.0 of
x | x > 1.0 -> 1.0
| x < 0.0 -> 0.0
| otherwise -> x
lineCount <- lineCountB
void $ gotoLn $ floor (fromIntegral lineCount * f)
firstNonSpaceB
findMatchingPairB :: BufferM ()
findMatchingPairB = do
let go dir a b = goUnmatchedB dir a b >> return True
goToMatch = do
c <- readB
case c of '(' -> go Forward '(' ')'
')' -> go Backward '(' ')'
'{' -> go Forward '{' '}'
'}' -> go Backward '{' '}'
'[' -> go Forward '[' ']'
']' -> go Backward '[' ']'
_ -> otherChar
otherChar = do eof <- atEof
eol <- atEol
if eof || eol
then return False
else rightB >> goToMatch
p <- pointB
foundMatch <- goToMatch
unless foundMatch $ moveTo p
incrementNextNumberByB :: Int -> BufferM ()
incrementNextNumberByB n = do
start <- 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 :: Int -> R.YiString -> R.YiString
increment n l = R.fromString $ go (R.toString l)
where
go ('0':'x':xs) = (\ys -> '0':'x':ys) . (`showHex` "") . (+ n) . fst . head . readHex $ xs
go ('0':'o':xs) = (\ys -> '0':'o':ys) . (`showOct` "") . (+ n) . fst . head . readOct $ xs
go s = show . (+ n) . (\x -> read x :: Int) $ s
isNumberB :: BufferM Bool
isNumberB = do
eol <- atEol
sol <- atSol
if sol then isDigit <$> readB
else if eol then return False
else test3CharB
test3CharB :: BufferM Bool
test3CharB = do
moveXorSol 1
previous <- readB
moveXorEol 2
next <- readB
moveXorSol 1
current <- readB
if | previous == '0' && current == 'o' && isOctDigit next -> return True
| previous == '0' && current == 'x' && isHexDigit next -> return True
| current == '-' && isDigit next -> return True
| isDigit current -> return True
| isHexDigit current -> testHexB
| otherwise -> return False
testHexB :: BufferM Bool
testHexB = savingPointB $ do
untilB_ (not . isHexDigit <$> readB) (moveXorSol 1)
leftChar <- readB
moveXorSol 1
leftToLeftChar <- readB
if leftChar == 'x' && leftToLeftChar == '0'
then return True
else return False
lineMoveVisRel :: Int -> BufferM ()
lineMoveVisRel = movingToPrefVisCol . lineMoveVisRelUp
lineMoveVisRelUp :: Int -> BufferM ()
lineMoveVisRelUp 0 = return ()
lineMoveVisRelUp n | n < 0 = lineMoveVisRelDown $ negate n
| otherwise = do
wid <- width <$> use lastActiveWindowA
col <- curCol
len <- pointB >>= eolPointB >>= colOf
let jumps = (len `div` wid) (col `div` wid)
next = n jumps
if next <= 0
then moveXorEol (n * wid)
else do moveXorEol (jumps * wid)
void $ gotoLnFrom 1
lineMoveVisRelUp $ next 1
lineMoveVisRelDown :: Int -> BufferM ()
lineMoveVisRelDown 0 = return ()
lineMoveVisRelDown n | n < 0 = lineMoveVisRelUp $ negate n
| otherwise = do
wid <- width <$> use lastActiveWindowA
col <- curCol
let jumps = col `div` wid
next = n jumps
if next <= 0
then leftN (n * wid)
else do leftN (jumps * wid)
void $ gotoLnFrom $ 1
moveToEol
lineMoveVisRelDown $ next 1
markWord :: BufferM ()
markWord = do
curPos <- 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