module Yi.Buffer.HighLevel
( atEof
, atEol
, atLastLine
, atSol
, 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
, moveToEol
, moveToSol
, moveXorEol
, moveXorSol
, nextCInLineExc
, nextCInLineInc
, nextNParagraphs
, nextWordB
, prevCInLineExc
, prevCInLineInc
, prevNParagraphs
, prevWordB
, readCurrentWordB
, readLnB
, readPrevWordB
, readRegionRopeWithStyleB
, replaceBufferContent
, revertB
, rightEdgesOfRegionB
, scrollB
, scrollCursorToBottomB
, scrollCursorToTopB
, scrollScreensB
, scrollToCursorB
, scrollToLineAboveWindowB
, scrollToLineBelowWindowB
, setSelectionMarkPointB
, setSelectRegionB
, shapeOfBlockRegionB
, sortLines
, snapInsB
, snapScreenB
, splitBlockRegionToContiguousSubRegionsB
, swapB
, switchCaseChar
, test3CharB
, testHexB
, toggleCommentB
, topB
, unLineCommentSelectionB
, upFromBosB
, uppercaseWordB
, upScreenB
, upScreensB
, vimScrollB
, vimScrollByB
) where
import Control.Applicative
import Control.Lens hiding ((-~), (+~), re, transform)
import Control.Monad
import Control.Monad.RWS.Strict (ask)
import Control.Monad.State hiding (forM, forM_, sequence_)
import Data.Char (isDigit, isHexDigit, isOctDigit,
toUpper, isUpper, toLower, isSpace)
import Data.List (sort, intersperse)
import Data.Maybe (fromMaybe, listToMaybe, catMaybes)
import Data.Monoid
import qualified Data.Text as T
import Data.Time (UTCTime)
import Data.Tuple (swap)
import Numeric (showOct, showHex, readOct, readHex)
import Yi.Buffer.Basic
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
import Yi.Utils
import Yi.Window
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' = stepB >> readB >>= go (0::Int)
where go opened c | c == cStop && opened == 0 = return ()
| c == cStop = stepB >> readB >>= go (opened1)
| c == cStart = stepB >> readB >>= go (opened+1)
| otherwise = stepB >> readB >>= go opened
(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
readCharB :: BufferM (Maybe Char)
readCharB = fmap R.head (readUnitB Character)
readRestOfLnB :: BufferM YiString
readRestOfLnB = readRegionB =<< regionOfPartB Line Forward
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)
nextPointB :: BufferM Point
nextPointB = do
eof <- atEof
if eof 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 = deleteSpaces c text
modifyRegionB (const r) reg
case u of
Just _ -> moveToColB (c (R.length text R.length r))
Nothing -> return ()
where
deleteSpaces :: Int -> R.YiString -> R.YiString
deleteSpaces c l =
let (f, b) = R.splitAt c l
in R.dropWhileEnd isSpace f <> case u of
Nothing -> R.dropWhile isSpace b
Just _ -> b
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
switchCaseCharB :: BufferM ()
switchCaseCharB =
transformB (R.withText $ T.map switchCaseChar) Character Forward
switchCaseChar :: Char -> Char
switchCaseChar c = if isUpper c then toLower c else toUpper c
deleteToEol :: BufferM ()
deleteToEol = deleteRegionB =<< regionOfPartB Line Forward
deleteLineForward :: BufferM ()
deleteLineForward =
do moveToSol
deleteToEol
deleteN 1
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 height
scrollB $ n * max 0 (h 3)
scrollByB :: (Int -> Int) -> Int -> BufferM ()
scrollByB f n = do h <- askWindow height
scrollB $ n * f h
vimScrollB :: Int -> BufferM ()
vimScrollB n = do scrollB n
void $ lineMoveRel n
vimScrollByB :: (Int -> Int) -> Int -> BufferM ()
vimScrollByB f n = do h <- askWindow height
vimScrollB $ n * f h
scrollToCursorB :: BufferM ()
scrollToCursorB = do
MarkSet f i _ <- markLines
h <- askWindow height
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_ (height 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
extendSelectRegionB :: Region -> BufferM ()
extendSelectRegionB region = (setSelectRegionB . unionRegion region) =<< getSelectRegionB
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)
modifySelectionB :: (R.YiString -> R.YiString) -> BufferM ()
modifySelectionB = modifyExtendedSelectionB Character
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
justifySelectionWithTopB :: BufferM ()
justifySelectionWithTopB =
modifySelectionB justifyLines
where
justifyLines :: R.YiString -> R.YiString
justifyLines input =
case R.lines input of
[] -> ""
[ one ] -> one
(top : _) -> mapLines justifyLine input
where
topIndent = R.takeWhile isSpace top
justifyLine :: R.YiString -> R.YiString
justifyLine "" = ""
justifyLine l = topIndent <> R.dropWhile isSpace l
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)
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 . 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)
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 -> fmap 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) . (flip showHex "") . (+ n) . (fst . head . readHex)) xs
go ('0':'o':xs) = ((\ys -> '0':'o':ys) . (flip 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