module Yi.Buffer.Misc
( FBuffer (FBuffer, bmode)
, BufferM (..)
, WinMarks, MarkSet (..)
, bkey
, getMarks
, runBuffer
, runBufferFull
, runBufferDummyWindow
, screenTopLn
, screenMidLn
, screenBotLn
, curLn
, curCol
, colOf
, lineOf
, lineCountB
, sizeB
, pointB
, pointOfLineColB
, solPointB
, eolPointB
, markLines
, moveTo
, moveToColB
, moveToLineColB
, lineMoveRel
, lineUp
, lineDown
, newB
, MarkValue (..)
, Overlay
(overlayAnnotation, overlayBegin, overlayEnd, overlayOwner, overlayStyle)
, 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
, getVisibleSelection
, 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
, modeGotoDeclarationA
, 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
, stickyEolA
) where
import Prelude hiding (foldr, mapM, notElem)
import Control.Applicative (Applicative ((*>), (<*>), pure), (<$>))
import Control.Lens (Lens', assign, lens, use, uses, view, (%=), (%~), (.=), (^.))
import Control.Monad.RWS.Strict (Endo (Endo, appEndo),
MonadReader (ask), MonadState,
MonadWriter (tell),
Monoid (mconcat, mempty), asks,
gets, join, modify,
replicateM_, runRWS, void,
when, (<>))
import Data.Binary (Binary (..), Get)
import Data.Char (ord)
import Data.Default (Default (def))
import Data.DynamicState.Serializable (getDyn, putDyn)
import Data.Foldable (Foldable (foldr), forM_, notElem)
import qualified Data.Map as M (Map, empty, insert, lookup)
import Data.Maybe (fromMaybe, isNothing)
import qualified Data.Set as Set (Set)
import qualified Data.Text as T (Text, concat, justifyRight, pack, snoc, unpack)
import qualified Data.Text.Encoding as E (decodeUtf8, encodeUtf8)
import Data.Time (UTCTime (UTCTime))
import Data.Traversable (Traversable (mapM), forM)
import Numeric (showHex)
import System.FilePath (joinPath, splitPath)
import Yi.Buffer.Basic (BufferRef, Point (..), Size (Size), WindowRef)
import Yi.Buffer.Implementation
import Yi.Buffer.Undo
import Yi.Interact as I (P (End))
import Yi.Monad (getsAndModify)
import Yi.Region (Region, mkRegion)
import Yi.Rope (YiString)
import qualified Yi.Rope as R
import Yi.Syntax (ExtHL (ExtHL), Stroke, noHighlighter)
import Yi.Types
import Yi.Utils (SemiNum ((+~)), makeClassyWithSuffix, makeLensesWithSuffix)
import Yi.Window (Window (width, wkey, actualLines), dummyWindow)
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 :: T.Text
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
, stickyEol = False
, 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)
screenTopLn :: BufferM Int
screenTopLn = do
p <- use . markPointA =<< fromMark <$> askMarks
queryBuffer (lineAt p)
screenMidLn :: BufferM Int
screenMidLn = (+) <$> screenTopLn <*> (div <$> screenLines <*> pure 2)
screenBotLn :: BufferM Int
screenBotLn = (+) <$> screenTopLn <*> screenLines
screenLines :: BufferM Int
screenLines = pred <$> askWindow actualLines
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
getVisibleSelection :: BufferM Bool
getVisibleSelection = use 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 :: YiString)
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 :: forall m a. (Default a, YiVariable a, MonadState FBuffer m, Functor m) => m a
getBufferDyn = fromMaybe (def :: a) <$> 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