module Yi.Buffer.Misc
( FBuffer (FBuffer, bmode)
, BufferM (..)
, WinMarks, MarkSet (..)
, bkey
, getMarks
, runBuffer
, runBufferFull
, runBufferDummyWindow
, curLn
, curCol
, colOf
, lineOf
, lineCountB
, sizeB
, pointB
, pointOfLineColB
, solPointB
, eolPointB
, markLines
, moveTo
, moveToColB
, moveToLineColB
, lineMoveRel
, lineUp
, lineDown
, newB
, MarkValue(..)
, Overlay (overlayAnnotation)
, mkOverlay
, gotoLn
, gotoLnFrom
, leftB
, rightB
, moveN
, leftN
, rightN
, insertN
, insertNAt
, insertB
, deleteN
, nelemsB
, writeB
, writeN
, newlineB
, deleteNAt
, readB
, elemsB
, undosA
, undoB
, redoB
, getMarkB
, setMarkHereB
, setNamedMarkHereB
, mayGetMarkB
, getMarkValueB
, markPointA
, modifyMarkB
, newMarkB
, deleteMarkB
, setVisibleSelection
, isUnchangedBuffer
, setAnyMode
, setMode
, setMode0
, modifyMode
, regexRegionB
, regexB
, readAtB
, getModeLine
, getPercent
, setInserting
, savingPrefCol
, forgetPreferCol
, movingToPrefCol
, movingToPrefVisCol
, preferColA
, markSavedB
, retroactivelyAtSavePointB
, addOverlayB
, delOverlayB
, delOverlaysOfOwnerB
, getOverlaysOfOwnerB
, isPointInsideOverlay
, savingExcursionB
, savingPointB
, savingPositionB
, pendingUpdatesA
, highlightSelectionA
, rectangleSelectionA
, readOnlyA
, insertingA
, pointFollowsWindowA
, revertPendingUpdatesB
, askWindow
, clearSyntax
, focusSyntax
, Mode (..)
, modeNameA
, modeAppliesA
, modeHLA
, modePrettifyA
, modeKeymapA
, modeIndentA
, modeAdjustBlockA
, modeFollowA
, modeIndentSettingsA
, modeToggleCommentSelectionA
, modeGetStrokesA
, modeOnLoadA
, modeModeLineA
, AnyMode (..)
, IndentBehaviour (..)
, IndentSettings (..)
, expandTabsA
, tabSizeA
, shiftWidthA
, modeAlwaysApplies
, modeNeverApplies
, emptyMode
, withModeB
, withMode0
, onMode
, withSyntaxB
, withSyntaxB'
, keymapProcessA
, strokesRangesB
, streamB
, indexedStreamB
, askMarks
, pointAt
, SearchExp
, lastActiveWindowA
, putBufferDyn
, getBufferDyn
, shortIdentString
, identString
, miniIdentString
, identA
, directoryContentA
, BufferId(..)
, file
, lastSyncTimeA
, replaceCharB
, replaceCharWithBelowB
, replaceCharWithAboveB
, insertCharWithBelowB
, insertCharWithAboveB
, pointAfterCursorB
, destinationOfMoveB
, withEveryLineB
, startUpdateTransactionB
, commitUpdateTransactionB
, applyUpdate
, betweenB
, decreaseFontSize
, increaseFontSize
, indentSettingsB
, fontsizeVariationA
, encodingConverterNameA
) where
import Control.Applicative
import Control.Lens hiding ((+~), Action, reversed, at, act)
import Control.Monad.RWS.Strict hiding (mapM_, mapM, get, put,
forM_, forM)
import Data.Binary
import Data.Char(ord)
import Data.Default
import Data.Foldable
import Data.Function hiding ((.), id)
import qualified Data.Map as M
import Data.Maybe
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import Data.Time
import Data.Traversable
import Data.DynamicState.Serializable
import Numeric(showHex)
import Prelude hiding (foldr, mapM, notElem)
import System.FilePath
import Yi.Buffer.Basic
import Yi.Buffer.Implementation
import Yi.Buffer.Undo
import Yi.Interact as I
import Yi.Monad
import Yi.Region
import Yi.Rope (YiString)
import qualified Yi.Rope as R
import Yi.Syntax
import Yi.Types
import Yi.Utils
import Yi.Window
makeClassyWithSuffix "A" ''Attributes
instance HasAttributes FBuffer where
attributesA = lens attributes (\(FBuffer f1 f2 _) a -> FBuffer f1 f2 a)
shortIdentString :: Int
-> FBuffer
-> T.Text
shortIdentString dl b = case b ^. identA of
MemBuffer bName -> "*" <> bName <> "*"
FileBuffer fName -> T.pack . joinPath . drop dl $ splitPath fName
identString :: FBuffer -> T.Text
identString b = case b ^. identA of
MemBuffer bName -> "*" <> bName <> "*"
FileBuffer fName -> T.pack fName
instance Show FBuffer where
show b = Prelude.concat [ "Buffer #", show (bkey b)
, " (", T.unpack (identString b), ")" ]
miniIdentString :: FBuffer -> T.Text
miniIdentString b = case b ^. identA of
MemBuffer bufName -> bufName
FileBuffer _ -> "MINIFILE:"
instance Binary FBuffer where
put (FBuffer binmode r attributes_) =
let strippedRaw :: BufferImpl ()
strippedRaw = setSyntaxBI (modeHL emptyMode) r
in do
put binmode
put strippedRaw
put attributes_
get =
FBuffer <$> get <*> getStripped <*> get
where getStripped :: Get (BufferImpl ())
getStripped = get
clearSyntax :: FBuffer -> FBuffer
clearSyntax = modifyRawbuf updateSyntax
queryRawbuf :: (forall syntax. BufferImpl syntax -> x) -> FBuffer -> x
queryRawbuf f (FBuffer _ fb _) = f fb
modifyRawbuf :: (forall syntax. BufferImpl syntax -> BufferImpl syntax) -> FBuffer -> FBuffer
modifyRawbuf f (FBuffer f1 f2 f3) = FBuffer f1 (f f2) f3
queryAndModifyRawbuf :: (forall syntax. BufferImpl syntax -> (BufferImpl syntax,x)) ->
FBuffer -> (FBuffer, x)
queryAndModifyRawbuf f (FBuffer f1 f5 f3) =
let (f5', x) = f f5
in (FBuffer f1 f5' f3, x)
file :: FBuffer -> Maybe FilePath
file b = case b ^. identA of
FileBuffer f -> Just f
MemBuffer _ -> Nothing
highlightSelectionA :: Lens' FBuffer Bool
highlightSelectionA = selectionStyleA .
lens highlightSelection (\e x -> e { highlightSelection = x })
rectangleSelectionA :: Lens' FBuffer Bool
rectangleSelectionA = selectionStyleA .
lens rectangleSelection (\e x -> e { rectangleSelection = x })
instance Binary (Mode syntax) where
put = put . E.encodeUtf8 . modeName
get = do
n <- E.decodeUtf8 <$> get
return (emptyMode {modeName = n})
increaseFontSize :: Int -> BufferM ()
increaseFontSize x = fontsizeVariationA %= \fs -> max 1 (fs + x)
decreaseFontSize :: Int -> BufferM ()
decreaseFontSize x = fontsizeVariationA %= \fs -> max 1 (fs x)
getModeLine :: [T.Text] -> BufferM T.Text
getModeLine prefix = withModeB (`modeModeLine` prefix)
defaultModeLine :: [T.Text] -> BufferM T.Text
defaultModeLine prefix = do
col <- curCol
pos <- pointB
ln <- curLn
p <- pointB
s <- sizeB
curChar <- readB
ro <-use readOnlyA
modeNm <- gets (withMode0 modeName)
unchanged <- gets isUnchangedBuffer
enc <- use encodingConverterNameA >>= return . \case
Nothing -> mempty
Just cn -> T.pack $ R.unCn cn
let pct
| pos == 0 || s == 0 = " Top"
| pos == s = " Bot"
| otherwise = getPercent p s
changed = if unchanged then "-" else "*"
readOnly' = if ro then "%" else changed
hexxed = T.pack $ showHex (ord curChar) ""
hexChar = "0x" <> T.justifyRight 2 '0' hexxed
toT = T.pack . show
nm <- gets $ shortIdentString (length prefix)
return $ T.concat [ enc, " ", readOnly', changed, " ", nm
, " ", hexChar, " "
, "L", T.justifyRight 5 ' ' (toT ln)
, " "
, "C", T.justifyRight 3 ' ' (toT col)
, " ", pct , " ", modeNm , " ", toT $ fromPoint p
]
getPercent :: Point -> Point -> T.Text
getPercent a b = T.justifyRight 3 ' ' (T.pack $ show p) `T.snoc` '%'
where p = ceiling (aa / bb * 100.0 :: Double) :: Int
aa = fromIntegral a :: Double
bb = fromIntegral b :: Double
queryBuffer :: (forall syntax. BufferImpl syntax -> x) -> BufferM x
queryBuffer = gets . queryRawbuf
modifyBuffer :: (forall syntax. BufferImpl syntax -> BufferImpl syntax) -> BufferM ()
modifyBuffer = modify . modifyRawbuf
queryAndModify :: (forall syntax. BufferImpl syntax -> (BufferImpl syntax,x)) -> BufferM x
queryAndModify = getsAndModify . queryAndModifyRawbuf
addOverlayB :: Overlay -> BufferM ()
addOverlayB ov = do
pendingUpdatesA %= (++ [overlayUpdate ov])
modifyBuffer $ addOverlayBI ov
getOverlaysOfOwnerB :: R.YiString -> BufferM (Set.Set Overlay)
getOverlaysOfOwnerB owner = queryBuffer (getOverlaysOfOwnerBI owner)
delOverlayB :: Overlay -> BufferM ()
delOverlayB ov = do
pendingUpdatesA %= (++ [overlayUpdate ov])
modifyBuffer $ delOverlayBI ov
delOverlaysOfOwnerB :: R.YiString -> BufferM ()
delOverlaysOfOwnerB owner =
modifyBuffer $ delOverlaysOfOwnerBI owner
isPointInsideOverlay :: Point -> Overlay -> Bool
isPointInsideOverlay point overlay =
let Overlay _ (MarkValue start _) (MarkValue finish _) _ _ = overlay
in start <= point && point <= finish
runBuffer :: Window -> FBuffer -> BufferM a -> (a, FBuffer)
runBuffer w b f =
let (a, _, b') = runBufferFull w b f
in (a, b')
getMarks :: Window -> BufferM (Maybe WinMarks)
getMarks = gets . getMarksRaw
getMarksRaw :: Window -> FBuffer -> Maybe WinMarks
getMarksRaw w b = M.lookup (wkey w) (b ^. winMarksA)
runBufferFull :: Window -> FBuffer -> BufferM a -> (a, [Update], FBuffer)
runBufferFull w b f =
let (a, b', updates) = runRWS (fromBufferM f') w b
f' = do
ms <- getMarks w
when (isNothing ms) $ do
newMarkValues <- if wkey (b ^. lastActiveWindowA) == def
then return
MarkSet { insMark = MarkValue 0 Forward,
selMark = MarkValue 0 Backward,
fromMark = MarkValue 0 Backward }
else do
Just mrks <- uses winMarksA (M.lookup $ wkey (b ^. lastActiveWindowA))
forM mrks getMarkValueB
newMrks <- forM newMarkValues newMarkB
winMarksA %= M.insert (wkey w) newMrks
assign lastActiveWindowA w
f
in (a, updates, pendingUpdatesA %~ (++ fmap TextUpdate updates) $ b')
getMarkValueRaw :: Mark -> FBuffer -> MarkValue
getMarkValueRaw m = fromMaybe (MarkValue 0 Forward) . queryRawbuf (getMarkValueBI m)
getMarkValueB :: Mark -> BufferM MarkValue
getMarkValueB = gets . getMarkValueRaw
newMarkB :: MarkValue -> BufferM Mark
newMarkB v = queryAndModify $ newMarkBI v
deleteMarkB :: Mark -> BufferM ()
deleteMarkB m = modifyBuffer $ deleteMarkValueBI m
runBufferDummyWindow :: FBuffer -> BufferM a -> a
runBufferDummyWindow b = fst . runBuffer (dummyWindow $ bkey b) b
markSavedB :: UTCTime -> BufferM ()
markSavedB t = do undosA %= setSavedFilePointU
assign lastSyncTimeA t
bkey :: FBuffer -> BufferRef
bkey = view bkey__A
isUnchangedBuffer :: FBuffer -> Bool
isUnchangedBuffer = isAtSavedFilePointU . view undosA
startUpdateTransactionB :: BufferM ()
startUpdateTransactionB = do
transactionPresent <- use updateTransactionInFlightA
if transactionPresent
then error "Already started update transaction"
else do
undosA %= addChangeU InteractivePoint
assign updateTransactionInFlightA True
commitUpdateTransactionB :: BufferM ()
commitUpdateTransactionB = do
transactionPresent <- use updateTransactionInFlightA
if not transactionPresent
then error "Not in update transaction"
else do
assign updateTransactionInFlightA False
transacAccum <- use updateTransactionAccumA
assign updateTransactionAccumA []
undosA %= (appEndo . mconcat) (Endo . addChangeU . AtomicChange <$> transacAccum)
undosA %= addChangeU InteractivePoint
undoRedo :: (forall syntax. Mark -> URList -> BufferImpl syntax
-> (BufferImpl syntax, (URList, [Update])))
-> BufferM ()
undoRedo f = do
isTransacPresent <- use updateTransactionInFlightA
if isTransacPresent
then error "Can't undo while undo transaction is in progress"
else do
m <- getInsMark
ur <- use undosA
(ur', updates) <- queryAndModify (f m ur)
assign undosA ur'
tell updates
undoB :: BufferM ()
undoB = undoRedo undoU
redoB :: BufferM ()
redoB = undoRedo redoU
retroactivelyAtSavePointB :: BufferM a -> BufferM a
retroactivelyAtSavePointB action = do
(undoDepth, result) <- go 0
replicateM_ undoDepth redoB
return result
where
go step = do
atSavedPoint <- gets isUnchangedBuffer
if atSavedPoint
then (step,) <$> action
else undoB >> go (step + 1)
const2 :: t -> t1 -> t2 -> t
const2 x _ _ = x
modeAlwaysApplies :: a -> b -> Bool
modeAlwaysApplies = const2 True
modeNeverApplies :: a -> b -> Bool
modeNeverApplies = const2 False
emptyMode :: Mode syntax
emptyMode = Mode
{
modeName = "empty",
modeApplies = modeNeverApplies,
modeHL = ExtHL noHighlighter,
modePrettify = const $ return (),
modeKeymap = id,
modeIndent = \_ _ -> return (),
modeAdjustBlock = \_ _ -> return (),
modeFollow = const emptyAction,
modeIndentSettings = IndentSettings
{ expandTabs = True
, tabSize = 8
, shiftWidth = 4
},
modeToggleCommentSelection = Nothing,
modeGetStrokes = \_ _ _ _ -> [],
modeOnLoad = return (),
modeGotoDeclaration = return (),
modeModeLine = defaultModeLine
}
newB :: BufferRef -> BufferId -> YiString -> FBuffer
newB unique nm s =
FBuffer { bmode = emptyMode
, rawbuf = newBI s
, attributes =
Attributes { ident = nm
, bkey__ = unique
, undos = emptyU
, preferCol = Nothing
, preferVisCol = Nothing
, bufferDynamic = mempty
, pendingUpdates = []
, selectionStyle = SelectionStyle False False
, keymapProcess = I.End
, winMarks = M.empty
, lastActiveWindow = dummyWindow unique
, lastSyncTime = epoch
, readOnly = False
, directoryContent = False
, inserting = True
, pointFollowsWindow = const False
, updateTransactionInFlight = False
, updateTransactionAccum = []
, fontsizeVariation = 0
, encodingConverterName = Nothing
} }
epoch :: UTCTime
epoch = UTCTime (toEnum 0) (toEnum 0)
sizeB :: BufferM Point
sizeB = queryBuffer sizeBI
pointB :: BufferM Point
pointB = use . markPointA =<< getInsMark
nelemsB :: Int -> Point -> BufferM YiString
nelemsB n i = R.take n <$> streamB Forward i
streamB :: Direction -> Point -> BufferM YiString
streamB dir i = queryBuffer $ getStream dir i
indexedStreamB :: Direction -> Point -> BufferM [(Point,Char)]
indexedStreamB dir i = queryBuffer $ getIndexedStream dir i
strokesRangesB :: Maybe SearchExp -> Region -> BufferM [[Stroke]]
strokesRangesB regex r = do
p <- pointB
getStrokes <- withSyntaxB modeGetStrokes
queryBuffer $ strokesRangesBI getStrokes regex r p
moveTo :: Point -> BufferM ()
moveTo x = do
forgetPreferCol
maxP <- sizeB
let p = case () of
_ | x < 0 -> Point 0
| x > maxP -> maxP
| otherwise -> x
(.= p) . markPointA =<< getInsMark
setInserting :: Bool -> BufferM ()
setInserting = assign insertingA
checkRO :: BufferM Bool
checkRO = do
ro <- use readOnlyA
when ro (fail "Read Only Buffer")
return ro
applyUpdate :: Update -> BufferM ()
applyUpdate update = do
ro <- checkRO
valid <- queryBuffer (isValidUpdate update)
when (not ro && valid) $ do
forgetPreferCol
let reversed = reverseUpdateI update
modifyBuffer (applyUpdateI update)
isTransacPresent <- use updateTransactionInFlightA
if isTransacPresent
then updateTransactionAccumA %= (reversed:)
else undosA %= addChangeU (AtomicChange reversed)
tell [update]
revertPendingUpdatesB :: BufferM ()
revertPendingUpdatesB = do
updates <- use pendingUpdatesA
modifyBuffer (flip (foldr (\u bi -> applyUpdateI (reverseUpdateI u) bi)) [u | TextUpdate u <- updates])
writeB :: Char -> BufferM ()
writeB c = do
deleteN 1
insertB c
writeN :: YiString -> BufferM ()
writeN cs = do
off <- pointB
deleteNAt Forward (R.length cs) off
insertNAt cs off
newlineB :: BufferM ()
newlineB = insertB '\n'
insertNAt :: YiString -> Point -> BufferM ()
insertNAt rope pnt = applyUpdate (Insert pnt Forward rope)
insertN :: YiString -> BufferM ()
insertN cs = pointB >>= insertNAt cs
insertB :: Char -> BufferM ()
insertB = insertN . R.singleton
deleteNAt :: Direction -> Int -> Point -> BufferM ()
deleteNAt _ 0 _ = return ()
deleteNAt dir n pos = do
els <- R.take n <$> streamB Forward pos
applyUpdate $ Delete pos dir els
curLn :: BufferM Int
curLn = do
p <- pointB
queryBuffer (lineAt p)
markLines :: BufferM (MarkSet Int)
markLines = mapM getLn =<< askMarks
where getLn m = use (markPointA m) >>= lineOf
gotoLn :: Int -> BufferM Int
gotoLn x = do
moveTo 0
succ <$> gotoLnFrom (x 1)
setMode0 :: forall syntax. Mode syntax -> FBuffer -> FBuffer
setMode0 m (FBuffer _ rb at) = FBuffer m (setSyntaxBI (modeHL m) rb) at
modifyMode0 :: (forall syntax. Mode syntax -> Mode syntax) -> FBuffer -> FBuffer
modifyMode0 f (FBuffer m rb f3) = FBuffer m' (setSyntaxBI (modeHL m') rb) f3
where m' = f m
setAnyMode :: AnyMode -> BufferM ()
setAnyMode (AnyMode m) = setMode m
setMode :: Mode syntax -> BufferM ()
setMode m = do
modify (setMode0 m)
assign keymapProcessA I.End
modeOnLoad m
modifyMode :: (forall syntax. Mode syntax -> Mode syntax) -> BufferM ()
modifyMode f = do
modify (modifyMode0 f)
assign keymapProcessA I.End
onMode :: (forall syntax. Mode syntax -> Mode syntax) -> AnyMode -> AnyMode
onMode f (AnyMode m) = AnyMode (f m)
withMode0 :: (forall syntax. Mode syntax -> a) -> FBuffer -> a
withMode0 f FBuffer {bmode = m} = f m
withModeB :: (forall syntax. Mode syntax -> BufferM a) -> BufferM a
withModeB = join . gets . withMode0
withSyntax0 :: (forall syntax. Mode syntax -> syntax -> a) -> WindowRef -> FBuffer -> a
withSyntax0 f wk (FBuffer bm rb _attrs) = f bm (getAst wk rb)
withSyntaxB :: (forall syntax. Mode syntax -> syntax -> a) -> BufferM a
withSyntaxB f = withSyntax0 f <$> askWindow wkey <*> use id
focusSyntax :: M.Map WindowRef Region -> FBuffer -> FBuffer
focusSyntax r = modifyRawbuf (focusAst r)
withSyntaxB' :: (forall syntax. Mode syntax -> syntax -> BufferM a) -> BufferM a
withSyntaxB' = join . withSyntaxB
regexRegionB :: SearchExp -> Region -> BufferM [Region]
regexRegionB regex region = queryBuffer $ regexRegionBI regex region
regexB :: Direction -> SearchExp -> BufferM [Region]
regexB dir rx = do
p <- pointB
s <- sizeB
regexRegionB rx (mkRegion p (case dir of Forward -> s; Backward -> 0))
modifyMarkRaw :: Mark -> (MarkValue -> MarkValue) -> FBuffer -> FBuffer
modifyMarkRaw m f = modifyRawbuf $ modifyMarkBI m f
modifyMarkB :: Mark -> (MarkValue -> MarkValue) -> BufferM ()
modifyMarkB = (modify .) . modifyMarkRaw
setMarkHereB :: BufferM Mark
setMarkHereB = getMarkB Nothing
setNamedMarkHereB :: String -> BufferM ()
setNamedMarkHereB name = do
p <- pointB
getMarkB (Just name) >>= (.= p) . markPointA
setVisibleSelection :: Bool -> BufferM ()
setVisibleSelection = assign highlightSelectionA
getInsMark :: BufferM Mark
getInsMark = insMark <$> askMarks
askMarks :: BufferM WinMarks
askMarks = do
Just ms <- getMarks =<< ask
return ms
getMarkB :: Maybe String -> BufferM Mark
getMarkB m = do
p <- pointB
queryAndModify (getMarkDefaultPosBI m p)
mayGetMarkB :: String -> BufferM (Maybe Mark)
mayGetMarkB m = queryBuffer (getMarkBI m)
moveN :: Int -> BufferM ()
moveN n = do
s <- sizeB
moveTo =<< min s . max 0 . (+~ Size n) <$> pointB
leftB :: BufferM ()
leftB = leftN 1
leftN :: Int -> BufferM ()
leftN n = moveN (n)
rightB :: BufferM ()
rightB = rightN 1
rightN :: Int -> BufferM ()
rightN = moveN
lineMoveRel :: Int -> BufferM Int
lineMoveRel = movingToPrefCol . gotoLnFrom
movingToPrefCol :: BufferM a -> BufferM a
movingToPrefCol f = do
prefCol <- use preferColA
targetCol <- maybe curCol return prefCol
r <- f
moveToColB targetCol
preferColA .= Just targetCol
return r
movingToPrefVisCol :: BufferM a -> BufferM a
movingToPrefVisCol f = do
prefCol <- use preferVisColA
targetCol <- maybe curVisCol return prefCol
r <- f
moveToVisColB targetCol
preferVisColA .= Just targetCol
return r
moveToColB :: Int -> BufferM ()
moveToColB targetCol = do
solPnt <- solPointB =<< pointB
chrs <- R.toString <$> nelemsB targetCol solPnt
is <- indentSettingsB
let cols = scanl (colMove is) 0 chrs
toSkip = takeWhile (\(char,col) -> char /= '\n' && col < targetCol) (zip chrs cols)
moveTo $ solPnt +~ fromIntegral (length toSkip)
moveToVisColB :: Int -> BufferM ()
moveToVisColB targetCol = do
col <- curCol
wid <- width <$> use lastActiveWindowA
let jumps = col `div` wid
moveToColB $ jumps * wid + targetCol
moveToLineColB :: Int -> Int -> BufferM ()
moveToLineColB line col = gotoLn line >> moveToColB col
pointOfLineColB :: Int -> Int -> BufferM Point
pointOfLineColB line col = savingPointB $ moveToLineColB line col >> pointB
forgetPreferCol :: BufferM ()
forgetPreferCol = preferColA .= Nothing >> preferVisColA .= Nothing
savingPrefCol :: BufferM a -> BufferM a
savingPrefCol f = do
pc <- use preferColA
pv <- use preferVisColA
result <- f
preferColA .= pc
preferVisColA .= pv
return result
lineUp :: BufferM ()
lineUp = void (lineMoveRel (1))
lineDown :: BufferM ()
lineDown = void (lineMoveRel 1)
elemsB :: BufferM YiString
elemsB = queryBuffer mem
betweenB :: Point
-> Point
-> BufferM YiString
betweenB (Point s) (Point e) =
if s >= e
then return mempty
else snd . R.splitAt s . fst . R.splitAt e <$> elemsB
readB :: BufferM Char
readB = pointB >>= readAtB
readAtB :: Point -> BufferM Char
readAtB i = R.head <$> nelemsB 1 i >>= return . \case
Nothing -> '\0'
Just c -> c
replaceCharB :: Char -> BufferM ()
replaceCharB c = do
writeB c
leftB
replaceCharWithBelowB :: BufferM ()
replaceCharWithBelowB = replaceCharWithVerticalOffset 1
replaceCharWithAboveB :: BufferM ()
replaceCharWithAboveB = replaceCharWithVerticalOffset (1)
insertCharWithBelowB :: BufferM ()
insertCharWithBelowB = maybe (return ()) insertB =<< maybeCharBelowB
insertCharWithAboveB :: BufferM ()
insertCharWithAboveB = maybe (return ()) insertB =<< maybeCharAboveB
replaceCharWithVerticalOffset :: Int -> BufferM ()
replaceCharWithVerticalOffset offset =
maybe (return ()) replaceCharB =<< maybeCharWithVerticalOffset offset
maybeCharBelowB :: BufferM (Maybe Char)
maybeCharBelowB = maybeCharWithVerticalOffset 1
maybeCharAboveB :: BufferM (Maybe Char)
maybeCharAboveB = maybeCharWithVerticalOffset (1)
maybeCharWithVerticalOffset :: Int -> BufferM (Maybe Char)
maybeCharWithVerticalOffset offset = savingPointB $ do
l0 <- curLn
c0 <- curCol
void $ lineMoveRel offset
l1 <- curLn
c1 <- curCol
curChar <- readB
return $ if c0 == c1
&& l0 + offset == l1
&& curChar `notElem` ("\n\0" :: String)
then Just curChar
else Nothing
deleteN :: Int -> BufferM ()
deleteN n = pointB >>= deleteNAt Forward n
indentSettingsB :: BufferM IndentSettings
indentSettingsB = withModeB $ return . modeIndentSettings
curCol :: BufferM Int
curCol = colOf =<< pointB
curVisCol :: BufferM Int
curVisCol = rem <$> curCol <*> (width <$> use lastActiveWindowA)
colOf :: Point -> BufferM Int
colOf p = do
is <- indentSettingsB
R.foldl' (colMove is) 0 <$> queryBuffer (charsFromSolBI p)
lineOf :: Point -> BufferM Int
lineOf p = queryBuffer $ lineAt p
lineCountB :: BufferM Int
lineCountB = lineOf =<< sizeB
colMove :: IndentSettings -> Int -> Char -> Int
colMove is col '\t' | tabSize is > 1 = col + tabSize is
colMove _ col _ = col + 1
solPointB :: Point -> BufferM Point
solPointB p = queryBuffer $ solPoint' p
eolPointB :: Point -> BufferM Point
eolPointB p = queryBuffer $ eolPoint' p
gotoLnFrom :: Int -> BufferM Int
gotoLnFrom x = do
l <- curLn
p' <- queryBuffer $ solPoint (l + x)
moveTo p'
l' <- curLn
return (l' l)
getBufferDyn :: (YiVariable a, MonadState FBuffer m, Functor m) => m a
getBufferDyn = fromMaybe def <$> getDyn (use bufferDynamicA) (assign bufferDynamicA)
putBufferDyn :: (YiVariable a, MonadState FBuffer m, Functor m) => a -> m ()
putBufferDyn = putDyn (use bufferDynamicA) (assign bufferDynamicA)
savingExcursionB :: BufferM a -> BufferM a
savingExcursionB f = do
m <- getMarkB Nothing
res <- f
moveTo =<< use (markPointA m)
return res
markPointA :: Mark -> Lens' FBuffer Point
markPointA mark = lens getter setter where
getter b = markPoint $ getMarkValueRaw mark b
setter b pos = modifyMarkRaw mark (\v -> v {markPoint = pos}) b
savingPointB :: BufferM a -> BufferM a
savingPointB f = savingPrefCol $ do
p <- pointB
res <- f
moveTo p
return res
savingPositionB :: BufferM a -> BufferM a
savingPositionB f = savingPrefCol $ do
(c, l) <- (,) <$> curCol <*> curLn
res <- f
moveToLineColB l c
return res
pointAt :: BufferM a -> BufferM Point
pointAt f = savingPointB (f *> pointB)
pointAfterCursorB :: Point -> BufferM Point
pointAfterCursorB p = pointAt $ do
moveTo p
rightB
destinationOfMoveB :: BufferM a -> BufferM Point
destinationOfMoveB f = savingPointB (f >> pointB)
askWindow :: (Window -> a) -> BufferM a
askWindow = asks
withEveryLineB :: BufferM () -> BufferM ()
withEveryLineB action = savingPointB $ do
lineCount <- lineCountB
forM_ [1 .. lineCount] $ \l -> do
void $ gotoLn l
action
makeLensesWithSuffix "A" ''IndentSettings
makeLensesWithSuffix "A" ''Mode