{-# LANGUAGE BangPatterns               #-}
{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE DeriveFoldable             #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE DeriveTraversable          #-}
{-# LANGUAGE ExistentialQuantification  #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE TupleSections              #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Yi.Buffer.Misc
-- License     :  GPL-2
-- Maintainer  :  yi-devel@googlegroups.com
-- Stability   :  experimental
-- Portability :  portable
--
-- The 'Buffer' module defines monadic editing operations over one-dimensional
-- buffers, maintaining a current /point/.

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
  , 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
  , stickyEolA
  , queryBuffer
  ) where

import           Prelude                        hiding (foldr, mapM, notElem)

import           Control.Applicative (liftA2)
import           Control.Monad (when, void, replicateM_, join)
import           Data.Monoid
import           Control.Monad.Reader
import           Control.Monad.State.Strict     hiding (get, put)
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.Strict                as M (Map, empty, insert, lookup)
import           Data.Maybe                     (fromMaybe, isNothing)
import qualified Data.Sequence                  as S
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           Lens.Micro.Platform            (Lens', lens, (&), (.~), (%~), (^.), use, (.=), (%=), view)
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, uses)
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)

-- In addition to Buffer's text, this manages (among others):
--  * Log of updates mades
--  * Undo

makeClassyWithSuffix "A" ''Attributes

instance HasAttributes FBuffer where
    attributesA :: (Attributes -> f Attributes) -> FBuffer -> f FBuffer
attributesA = (FBuffer -> Attributes)
-> (FBuffer -> Attributes -> FBuffer) -> Lens' FBuffer Attributes
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens FBuffer -> Attributes
attributes (\(FBuffer Mode syntax
f1 BufferImpl syntax
f2 Attributes
_) Attributes
a -> Mode syntax -> BufferImpl syntax -> Attributes -> FBuffer
forall syntax.
Mode syntax -> BufferImpl syntax -> Attributes -> FBuffer
FBuffer Mode syntax
f1 BufferImpl syntax
f2 Attributes
a)

-- | Gets a short identifier of a buffer. If we're given a 'MemBuffer'
-- then just wraps the buffer name like so: @*name*@. If we're given a
-- 'FileBuffer', it drops the number of path components.
--
-- >>> let memBuf = newB (BufferRef 0) (MemBuffer "foo/bar/hello") ""
-- >>> shortIdentString 2 memBuf
-- "*foo/bar/hello*"
-- >>> let fileBuf = newB (BufferRef 0) (FileBuffer "foo/bar/hello") ""
-- >>> shortIdentString 2 fileBuf
-- "hello"
shortIdentString :: Int -- ^ Number of characters to drop from FileBuffer names
                 -> FBuffer -- ^ Buffer to work with
                 -> T.Text
shortIdentString :: Int -> FBuffer -> Text
shortIdentString Int
dl FBuffer
b = case FBuffer
b FBuffer -> Getting BufferId FBuffer BufferId -> BufferId
forall s a. s -> Getting a s a -> a
^. Getting BufferId FBuffer BufferId
forall c. HasAttributes c => Lens' c BufferId
identA of
  MemBuffer Text
bName -> Text
"*" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
bName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"*"
  FileBuffer FilePath
fName -> FilePath -> Text
T.pack (FilePath -> Text)
-> ([FilePath] -> FilePath) -> [FilePath] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
joinPath ([FilePath] -> FilePath)
-> ([FilePath] -> [FilePath]) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [FilePath] -> [FilePath]
forall a. Int -> [a] -> [a]
drop Int
dl ([FilePath] -> Text) -> [FilePath] -> Text
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
splitPath FilePath
fName

-- | Gets the buffer's identifier string, emphasising the 'MemBuffer':
--
-- >>> let memBuf = newB (BufferRef 0) (MemBuffer "foo/bar/hello") ""
-- >>> identString memBuf
-- "*foo/bar/hello*"
-- >>> let fileBuf = newB (BufferRef 0) (FileBuffer "foo/bar/hello") ""
-- >>> identString fileBuf
-- "foo/bar/hello"
identString :: FBuffer -> T.Text
identString :: FBuffer -> Text
identString FBuffer
b = case FBuffer
b FBuffer -> Getting BufferId FBuffer BufferId -> BufferId
forall s a. s -> Getting a s a -> a
^. Getting BufferId FBuffer BufferId
forall c. HasAttributes c => Lens' c BufferId
identA of
  MemBuffer Text
bName -> Text
"*" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
bName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"*"
  FileBuffer FilePath
fName -> FilePath -> Text
T.pack FilePath
fName


-- TODO: proper instance + de-orphan
instance Show FBuffer where
    show :: FBuffer -> FilePath
show FBuffer
b = [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
Prelude.concat [ FilePath
"Buffer #", BufferRef -> FilePath
forall a. Show a => a -> FilePath
show (FBuffer -> BufferRef
bkey FBuffer
b)
                            , FilePath
" (",  Text -> FilePath
T.unpack (FBuffer -> Text
identString FBuffer
b), FilePath
")" ]


miniIdentString :: FBuffer -> T.Text
miniIdentString :: FBuffer -> Text
miniIdentString FBuffer
b = case FBuffer
b FBuffer -> Getting BufferId FBuffer BufferId -> BufferId
forall s a. s -> Getting a s a -> a
^. Getting BufferId FBuffer BufferId
forall c. HasAttributes c => Lens' c BufferId
identA of
  MemBuffer Text
bufName -> Text
bufName
  FileBuffer FilePath
_ -> Text
"MINIFILE:"

-- unfortunately the dynamic stuff can't be read.
instance Binary FBuffer where
    put :: FBuffer -> Put
put (FBuffer Mode syntax
binmode BufferImpl syntax
r Attributes
attributes_) =
      let strippedRaw :: BufferImpl ()
          strippedRaw :: BufferImpl ()
strippedRaw = ExtHL () -> BufferImpl syntax -> BufferImpl ()
forall syntax oldSyntax.
ExtHL syntax -> BufferImpl oldSyntax -> BufferImpl syntax
setSyntaxBI (Mode () -> ExtHL ()
forall syntax. Mode syntax -> ExtHL syntax
modeHL Mode ()
forall syntax. Mode syntax
emptyMode) BufferImpl syntax
r
      in do
          Mode syntax -> Put
forall t. Binary t => t -> Put
put Mode syntax
binmode
          BufferImpl () -> Put
forall t. Binary t => t -> Put
put BufferImpl ()
strippedRaw
          Attributes -> Put
forall t. Binary t => t -> Put
put Attributes
attributes_
    get :: Get FBuffer
get =
        Mode () -> BufferImpl () -> Attributes -> FBuffer
forall syntax.
Mode syntax -> BufferImpl syntax -> Attributes -> FBuffer
FBuffer (Mode () -> BufferImpl () -> Attributes -> FBuffer)
-> Get (Mode ()) -> Get (BufferImpl () -> Attributes -> FBuffer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Mode ())
forall t. Binary t => Get t
get Get (BufferImpl () -> Attributes -> FBuffer)
-> Get (BufferImpl ()) -> Get (Attributes -> FBuffer)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get (BufferImpl ())
getStripped Get (Attributes -> FBuffer) -> Get Attributes -> Get FBuffer
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Attributes
forall t. Binary t => Get t
get
      where getStripped :: Get (BufferImpl ())
            getStripped :: Get (BufferImpl ())
getStripped = Get (BufferImpl ())
forall t. Binary t => Get t
get

-- | update the syntax information (clear the dirty "flag")
clearSyntax :: FBuffer -> FBuffer
clearSyntax :: FBuffer -> FBuffer
clearSyntax = (forall syntax. BufferImpl syntax -> BufferImpl syntax)
-> FBuffer -> FBuffer
modifyRawbuf forall syntax. BufferImpl syntax -> BufferImpl syntax
updateSyntax

queryRawbuf :: (forall syntax. BufferImpl syntax -> x) -> FBuffer -> x
queryRawbuf :: (forall syntax. BufferImpl syntax -> x) -> FBuffer -> x
queryRawbuf forall syntax. BufferImpl syntax -> x
f (FBuffer Mode syntax
_ BufferImpl syntax
fb Attributes
_) = BufferImpl syntax -> x
forall syntax. BufferImpl syntax -> x
f BufferImpl syntax
fb

modifyRawbuf :: (forall syntax. BufferImpl syntax -> BufferImpl syntax) -> FBuffer -> FBuffer
modifyRawbuf :: (forall syntax. BufferImpl syntax -> BufferImpl syntax)
-> FBuffer -> FBuffer
modifyRawbuf forall syntax. BufferImpl syntax -> BufferImpl syntax
f (FBuffer Mode syntax
f1 BufferImpl syntax
f2 Attributes
f3) = Mode syntax -> BufferImpl syntax -> Attributes -> FBuffer
forall syntax.
Mode syntax -> BufferImpl syntax -> Attributes -> FBuffer
FBuffer Mode syntax
f1 (BufferImpl syntax -> BufferImpl syntax
forall syntax. BufferImpl syntax -> BufferImpl syntax
f BufferImpl syntax
f2) Attributes
f3

queryAndModifyRawbuf :: (forall syntax. BufferImpl syntax -> (BufferImpl syntax,x)) ->
                     FBuffer -> (FBuffer, x)
queryAndModifyRawbuf :: (forall syntax. BufferImpl syntax -> (BufferImpl syntax, x))
-> FBuffer -> (FBuffer, x)
queryAndModifyRawbuf forall syntax. BufferImpl syntax -> (BufferImpl syntax, x)
f (FBuffer Mode syntax
f1 BufferImpl syntax
f5 Attributes
f3) =
    let (BufferImpl syntax
f5', x
x) = BufferImpl syntax -> (BufferImpl syntax, x)
forall syntax. BufferImpl syntax -> (BufferImpl syntax, x)
f BufferImpl syntax
f5
    in (Mode syntax -> BufferImpl syntax -> Attributes -> FBuffer
forall syntax.
Mode syntax -> BufferImpl syntax -> Attributes -> FBuffer
FBuffer Mode syntax
f1 BufferImpl syntax
f5' Attributes
f3, x
x)

file :: FBuffer -> Maybe FilePath
file :: FBuffer -> Maybe FilePath
file FBuffer
b = case FBuffer
b FBuffer -> Getting BufferId FBuffer BufferId -> BufferId
forall s a. s -> Getting a s a -> a
^. Getting BufferId FBuffer BufferId
forall c. HasAttributes c => Lens' c BufferId
identA of
  FileBuffer FilePath
f -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
f
  MemBuffer Text
_ -> Maybe FilePath
forall a. Maybe a
Nothing

highlightSelectionA :: Lens' FBuffer Bool
highlightSelectionA :: (Bool -> f Bool) -> FBuffer -> f FBuffer
highlightSelectionA = (SelectionStyle -> f SelectionStyle) -> FBuffer -> f FBuffer
forall c. HasAttributes c => Lens' c SelectionStyle
selectionStyleA ((SelectionStyle -> f SelectionStyle) -> FBuffer -> f FBuffer)
-> ((Bool -> f Bool) -> SelectionStyle -> f SelectionStyle)
-> (Bool -> f Bool)
-> FBuffer
-> f FBuffer
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (SelectionStyle -> Bool)
-> (SelectionStyle -> Bool -> SelectionStyle)
-> Lens SelectionStyle SelectionStyle Bool Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SelectionStyle -> Bool
highlightSelection (\SelectionStyle
e Bool
x -> SelectionStyle
e { highlightSelection :: Bool
highlightSelection = Bool
x })

rectangleSelectionA :: Lens' FBuffer Bool
rectangleSelectionA :: (Bool -> f Bool) -> FBuffer -> f FBuffer
rectangleSelectionA = (SelectionStyle -> f SelectionStyle) -> FBuffer -> f FBuffer
forall c. HasAttributes c => Lens' c SelectionStyle
selectionStyleA ((SelectionStyle -> f SelectionStyle) -> FBuffer -> f FBuffer)
-> ((Bool -> f Bool) -> SelectionStyle -> f SelectionStyle)
-> (Bool -> f Bool)
-> FBuffer
-> f FBuffer
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (SelectionStyle -> Bool)
-> (SelectionStyle -> Bool -> SelectionStyle)
-> Lens SelectionStyle SelectionStyle Bool Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SelectionStyle -> Bool
rectangleSelection (\SelectionStyle
e Bool
x -> SelectionStyle
e { rectangleSelection :: Bool
rectangleSelection = Bool
x })

-- | Just stores the mode name.
instance Binary (Mode syntax) where
    put :: Mode syntax -> Put
put = ByteString -> Put
forall t. Binary t => t -> Put
put (ByteString -> Put)
-> (Mode syntax -> ByteString) -> Mode syntax -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
E.encodeUtf8 (Text -> ByteString)
-> (Mode syntax -> Text) -> Mode syntax -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mode syntax -> Text
forall syntax. Mode syntax -> Text
modeName
    get :: Get (Mode syntax)
get = do
      Text
n <- ByteString -> Text
E.decodeUtf8 (ByteString -> Text) -> Get ByteString -> Get Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
forall t. Binary t => Get t
get
      Mode syntax -> Get (Mode syntax)
forall (m :: * -> *) a. Monad m => a -> m a
return (Mode syntax
forall syntax. Mode syntax
emptyMode {modeName :: Text
modeName = Text
n})

-- | Increases the font size in the buffer by specified number. What
-- this number actually means depends on the front-end.
increaseFontSize :: Int -> BufferM ()
increaseFontSize :: Int -> BufferM ()
increaseFontSize Int
x = (Int -> Identity Int) -> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c Int
fontsizeVariationA ((Int -> Identity Int) -> FBuffer -> Identity FBuffer)
-> (Int -> Int) -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= \Int
fs -> Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int
fs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x)

-- | Decreases the font size in the buffer by specified number. What
-- this number actually means depends on the front-end.
decreaseFontSize :: Int -> BufferM ()
decreaseFontSize :: Int -> BufferM ()
decreaseFontSize Int
x = (Int -> Identity Int) -> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c Int
fontsizeVariationA ((Int -> Identity Int) -> FBuffer -> Identity FBuffer)
-> (Int -> Int) -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= \Int
fs -> Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int
fs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x)

-- | Given a buffer, and some information update the modeline
--
-- N.B. the contents of modelines should be specified by user, and
-- not hardcoded.
getModeLine :: [T.Text] -> BufferM T.Text
getModeLine :: [Text] -> BufferM Text
getModeLine [Text]
prefix = (forall syntax. Mode syntax -> BufferM Text) -> BufferM Text
forall a. (forall syntax. Mode syntax -> BufferM a) -> BufferM a
withModeB (Mode syntax -> [Text] -> BufferM Text
forall syntax. Mode syntax -> [Text] -> BufferM Text
`modeModeLine` [Text]
prefix)

defaultModeLine :: [T.Text] -> BufferM T.Text
defaultModeLine :: [Text] -> BufferM Text
defaultModeLine [Text]
prefix = do
    Int
col <- BufferM Int
curCol
    Point
pos <- BufferM Point
pointB
    Int
ln <- BufferM Int
curLn
    Point
p <- BufferM Point
pointB
    Point
s <- BufferM Point
sizeB
    Char
curChar <- BufferM Char
readB
    Bool
ro <-Getting Bool FBuffer Bool -> BufferM Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Bool FBuffer Bool
forall c. HasAttributes c => Lens' c Bool
readOnlyA
    Text
modeNm <- (FBuffer -> Text) -> BufferM Text
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((forall syntax. Mode syntax -> Text) -> FBuffer -> Text
forall a. (forall syntax. Mode syntax -> a) -> FBuffer -> a
withMode0 forall syntax. Mode syntax -> Text
modeName)
    Bool
unchanged <- (FBuffer -> Bool) -> BufferM Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FBuffer -> Bool
isUnchangedBuffer
    let pct :: Text
pct
          | Point
pos Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
0 Bool -> Bool -> Bool
|| Point
s Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
0 = Text
" Top"
          | Point
pos Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
s = Text
" Bot"
          | Bool
otherwise = Point -> Point -> Text
getPercent Point
p Point
s
        changed :: Text
changed = if Bool
unchanged then Text
"-" else Text
"*"
        readOnly' :: Text
readOnly' = if Bool
ro then Text
"%" else Text
changed
        hexxed :: Text
hexxed = FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex (Char -> Int
ord Char
curChar) FilePath
""
        hexChar :: Text
hexChar = Text
"0x" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Char -> Text -> Text
T.justifyRight Int
2 Char
'0' Text
hexxed
        toT :: Int -> Text
toT = FilePath -> Text
T.pack (FilePath -> Text) -> (Int -> FilePath) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FilePath
forall a. Show a => a -> FilePath
show

    Text
nm <- (FBuffer -> Text) -> BufferM Text
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((FBuffer -> Text) -> BufferM Text)
-> (FBuffer -> Text) -> BufferM Text
forall a b. (a -> b) -> a -> b
$ Int -> FBuffer -> Text
shortIdentString ([Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
prefix)
    Text -> BufferM Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> BufferM Text) -> Text -> BufferM Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [ Text
readOnly', Text
changed, Text
" ", Text
nm
                      , Text
"     ", Text
hexChar, Text
"  "
                      , Text
"L", Int -> Char -> Text -> Text
T.justifyRight Int
5 Char
' ' (Int -> Text
toT Int
ln)
                      , Text
"  "
                      , Text
"C", Int -> Char -> Text -> Text
T.justifyRight Int
3 Char
' ' (Int -> Text
toT Int
col)
                      , Text
"  ", Text
pct , Text
"  ", Text
modeNm , Text
"  ", Int -> Text
toT (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Point -> Int
fromPoint Point
p
                      ]

-- | Given a point, and the file size, gives us a percent string
getPercent :: Point -> Point -> T.Text
getPercent :: Point -> Point -> Text
getPercent Point
a Point
b = Int -> Char -> Text -> Text
T.justifyRight Int
3 Char
' ' (FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
p) Text -> Char -> Text
`T.snoc` Char
'%'
    where p :: Int
p = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Double
aa Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
bb Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
100.0 :: Double) :: Int
          aa :: Double
aa = Point -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Point
a :: Double
          bb :: Double
bb = Point -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Point
b :: Double

queryBuffer :: (forall syntax. BufferImpl syntax -> x) -> BufferM x
queryBuffer :: (forall syntax. BufferImpl syntax -> x) -> BufferM x
queryBuffer forall syntax. BufferImpl syntax -> x
x = (FBuffer -> x) -> BufferM x
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((forall syntax. BufferImpl syntax -> x) -> FBuffer -> x
forall x. (forall syntax. BufferImpl syntax -> x) -> FBuffer -> x
queryRawbuf forall syntax. BufferImpl syntax -> x
x)

modifyBuffer :: (forall syntax. BufferImpl syntax -> BufferImpl syntax) -> BufferM ()
modifyBuffer :: (forall syntax. BufferImpl syntax -> BufferImpl syntax)
-> BufferM ()
modifyBuffer forall syntax. BufferImpl syntax -> BufferImpl syntax
x = (FBuffer -> FBuffer) -> BufferM ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((forall syntax. BufferImpl syntax -> BufferImpl syntax)
-> FBuffer -> FBuffer
modifyRawbuf forall syntax. BufferImpl syntax -> BufferImpl syntax
x)

queryAndModify :: (forall syntax. BufferImpl syntax -> (BufferImpl syntax,x)) -> BufferM x
queryAndModify :: (forall syntax. BufferImpl syntax -> (BufferImpl syntax, x))
-> BufferM x
queryAndModify forall syntax. BufferImpl syntax -> (BufferImpl syntax, x)
x = (FBuffer -> (FBuffer, x)) -> BufferM x
forall s (m :: * -> *) a. MonadState s m => (s -> (s, a)) -> m a
getsAndModify ((forall syntax. BufferImpl syntax -> (BufferImpl syntax, x))
-> FBuffer -> (FBuffer, x)
forall x.
(forall syntax. BufferImpl syntax -> (BufferImpl syntax, x))
-> FBuffer -> (FBuffer, x)
queryAndModifyRawbuf forall syntax. BufferImpl syntax -> (BufferImpl syntax, x)
x)

-- | Adds an "overlay" to the buffer
addOverlayB :: Overlay -> BufferM ()
addOverlayB :: Overlay -> BufferM ()
addOverlayB Overlay
ov = do
  (Seq UIUpdate -> Identity (Seq UIUpdate))
-> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c (Seq UIUpdate)
pendingUpdatesA ((Seq UIUpdate -> Identity (Seq UIUpdate))
 -> FBuffer -> Identity FBuffer)
-> (Seq UIUpdate -> Seq UIUpdate) -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Seq UIUpdate -> UIUpdate -> Seq UIUpdate
forall a. Seq a -> a -> Seq a
S.|> Overlay -> UIUpdate
overlayUpdate Overlay
ov)
  (forall syntax. BufferImpl syntax -> BufferImpl syntax)
-> BufferM ()
modifyBuffer ((forall syntax. BufferImpl syntax -> BufferImpl syntax)
 -> BufferM ())
-> (forall syntax. BufferImpl syntax -> BufferImpl syntax)
-> BufferM ()
forall a b. (a -> b) -> a -> b
$ Overlay -> BufferImpl syntax -> BufferImpl syntax
forall syntax. Overlay -> BufferImpl syntax -> BufferImpl syntax
addOverlayBI Overlay
ov

getOverlaysOfOwnerB :: R.YiString -> BufferM (Set.Set Overlay)
getOverlaysOfOwnerB :: YiString -> BufferM (Set Overlay)
getOverlaysOfOwnerB YiString
owner = (forall syntax. BufferImpl syntax -> Set Overlay)
-> BufferM (Set Overlay)
forall x. (forall syntax. BufferImpl syntax -> x) -> BufferM x
queryBuffer (YiString -> BufferImpl syntax -> Set Overlay
forall syntax. YiString -> BufferImpl syntax -> Set Overlay
getOverlaysOfOwnerBI YiString
owner)

-- | Remove an existing "overlay"
delOverlayB :: Overlay -> BufferM ()
delOverlayB :: Overlay -> BufferM ()
delOverlayB Overlay
ov = do
  (Seq UIUpdate -> Identity (Seq UIUpdate))
-> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c (Seq UIUpdate)
pendingUpdatesA ((Seq UIUpdate -> Identity (Seq UIUpdate))
 -> FBuffer -> Identity FBuffer)
-> (Seq UIUpdate -> Seq UIUpdate) -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Seq UIUpdate -> UIUpdate -> Seq UIUpdate
forall a. Seq a -> a -> Seq a
S.|> Overlay -> UIUpdate
overlayUpdate Overlay
ov)
  (forall syntax. BufferImpl syntax -> BufferImpl syntax)
-> BufferM ()
modifyBuffer ((forall syntax. BufferImpl syntax -> BufferImpl syntax)
 -> BufferM ())
-> (forall syntax. BufferImpl syntax -> BufferImpl syntax)
-> BufferM ()
forall a b. (a -> b) -> a -> b
$ Overlay -> BufferImpl syntax -> BufferImpl syntax
forall syntax. Overlay -> BufferImpl syntax -> BufferImpl syntax
delOverlayBI Overlay
ov

delOverlaysOfOwnerB :: R.YiString -> BufferM ()
delOverlaysOfOwnerB :: YiString -> BufferM ()
delOverlaysOfOwnerB YiString
owner =
  (forall syntax. BufferImpl syntax -> BufferImpl syntax)
-> BufferM ()
modifyBuffer ((forall syntax. BufferImpl syntax -> BufferImpl syntax)
 -> BufferM ())
-> (forall syntax. BufferImpl syntax -> BufferImpl syntax)
-> BufferM ()
forall a b. (a -> b) -> a -> b
$ YiString -> BufferImpl syntax -> BufferImpl syntax
forall syntax. YiString -> BufferImpl syntax -> BufferImpl syntax
delOverlaysOfOwnerBI YiString
owner

isPointInsideOverlay :: Point -> Overlay -> Bool
isPointInsideOverlay :: Point -> Overlay -> Bool
isPointInsideOverlay Point
point Overlay
overlay =
    let Overlay YiString
_ (MarkValue Point
start Direction
_) (MarkValue Point
finish Direction
_) StyleName
_ YiString
_ = Overlay
overlay
    in Point
start Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
<= Point
point Bool -> Bool -> Bool
&& Point
point Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
<= Point
finish

-- | Execute a @BufferM@ value on a given buffer and window.  The new state of
-- the buffer is returned alongside the result of the computation.
runBuffer :: Window -> FBuffer -> BufferM a -> (a, FBuffer)
runBuffer :: Window -> FBuffer -> BufferM a -> (a, FBuffer)
runBuffer Window
w FBuffer
b BufferM a
f =
    let (a
a, Seq Update
_, FBuffer
b') = Window -> FBuffer -> BufferM a -> (a, Seq Update, FBuffer)
forall a.
Window -> FBuffer -> BufferM a -> (a, Seq Update, FBuffer)
runBufferFull Window
w FBuffer
b BufferM a
f
    in (a
a, FBuffer
b')

getMarks :: Window -> BufferM (Maybe WinMarks)
getMarks :: Window -> BufferM (Maybe WinMarks)
getMarks = (FBuffer -> Maybe WinMarks) -> BufferM (Maybe WinMarks)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((FBuffer -> Maybe WinMarks) -> BufferM (Maybe WinMarks))
-> (Window -> FBuffer -> Maybe WinMarks)
-> Window
-> BufferM (Maybe WinMarks)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> FBuffer -> Maybe WinMarks
getMarksRaw

getMarksRaw :: Window -> FBuffer -> Maybe WinMarks
getMarksRaw :: Window -> FBuffer -> Maybe WinMarks
getMarksRaw Window
w FBuffer
b = WindowRef -> Map WindowRef WinMarks -> Maybe WinMarks
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Window -> WindowRef
wkey Window
w) (FBuffer
b FBuffer
-> Getting
     (Map WindowRef WinMarks) FBuffer (Map WindowRef WinMarks)
-> Map WindowRef WinMarks
forall s a. s -> Getting a s a -> a
^. Getting (Map WindowRef WinMarks) FBuffer (Map WindowRef WinMarks)
forall c. HasAttributes c => Lens' c (Map WindowRef WinMarks)
winMarksA)

runBufferFull :: Window -> FBuffer -> BufferM a -> (a, S.Seq Update, FBuffer)
runBufferFull :: Window -> FBuffer -> BufferM a -> (a, Seq Update, FBuffer)
runBufferFull Window
w FBuffer
b BufferM a
f =
    let (a
a, FBuffer
b') = State FBuffer a -> FBuffer -> (a, FBuffer)
forall s a. State s a -> s -> (a, s)
runState (ReaderT Window (State FBuffer) a -> Window -> State FBuffer a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (BufferM a -> ReaderT Window (State FBuffer) a
forall a. BufferM a -> ReaderT Window (State FBuffer) a
fromBufferM BufferM a
f') Window
w) FBuffer
b
        updates :: Seq Update
updates = FBuffer
b' FBuffer -> Getting (Seq Update) FBuffer (Seq Update) -> Seq Update
forall s a. s -> Getting a s a -> a
^. Getting (Seq Update) FBuffer (Seq Update)
forall c. HasAttributes c => Lens' c (Seq Update)
updateStreamA
        -- We're done running BufferM, don't store updates in editor
        -- state.
        !newSt :: FBuffer
newSt = FBuffer
b' FBuffer -> (FBuffer -> FBuffer) -> FBuffer
forall a b. a -> (a -> b) -> b
& (Seq Update -> Identity (Seq Update))
-> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c (Seq Update)
updateStreamA ((Seq Update -> Identity (Seq Update))
 -> FBuffer -> Identity FBuffer)
-> Seq Update -> FBuffer -> FBuffer
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Seq Update
forall a. Monoid a => a
mempty
        f' :: BufferM a
f' = do
            Maybe WinMarks
ms <- Window -> BufferM (Maybe WinMarks)
getMarks Window
w
            Bool -> BufferM () -> BufferM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe WinMarks -> Bool
forall a. Maybe a -> Bool
isNothing Maybe WinMarks
ms) (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$ do
                -- this window has no marks for this buffer yet; have to create them.
                MarkSet MarkValue
newMarkValues <- if Window -> WindowRef
wkey (FBuffer
b FBuffer -> Getting Window FBuffer Window -> Window
forall s a. s -> Getting a s a -> a
^. Getting Window FBuffer Window
forall c. HasAttributes c => Lens' c Window
lastActiveWindowA) WindowRef -> WindowRef -> Bool
forall a. Eq a => a -> a -> Bool
== WindowRef
forall a. Default a => a
def
                    then MarkSet MarkValue -> BufferM (MarkSet MarkValue)
forall (m :: * -> *) a. Monad m => a -> m a
return
                        -- no previous window, create some marks from scratch.
                         MarkSet :: forall a. a -> a -> a -> MarkSet a
MarkSet { insMark :: MarkValue
insMark = Point -> Direction -> MarkValue
MarkValue Point
0 Direction
Forward,
                                   selMark :: MarkValue
selMark = Point -> Direction -> MarkValue
MarkValue Point
0 Direction
Backward, -- sel
                                   fromMark :: MarkValue
fromMark = Point -> Direction -> MarkValue
MarkValue Point
0 Direction
Backward } -- from
                    else do
                        Just WinMarks
mrks  <- Getting (Map WindowRef WinMarks) FBuffer (Map WindowRef WinMarks)
-> (Map WindowRef WinMarks -> Maybe WinMarks)
-> BufferM (Maybe WinMarks)
forall s (m :: * -> *) a b.
MonadState s m =>
Getting a s a -> (a -> b) -> m b
uses Getting (Map WindowRef WinMarks) FBuffer (Map WindowRef WinMarks)
forall c. HasAttributes c => Lens' c (Map WindowRef WinMarks)
winMarksA (WindowRef -> Map WindowRef WinMarks -> Maybe WinMarks
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (WindowRef -> Map WindowRef WinMarks -> Maybe WinMarks)
-> WindowRef -> Map WindowRef WinMarks -> Maybe WinMarks
forall a b. (a -> b) -> a -> b
$ Window -> WindowRef
wkey (FBuffer
b FBuffer -> Getting Window FBuffer Window -> Window
forall s a. s -> Getting a s a -> a
^. Getting Window FBuffer Window
forall c. HasAttributes c => Lens' c Window
lastActiveWindowA))
                        WinMarks
-> (Mark -> BufferM MarkValue) -> BufferM (MarkSet MarkValue)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM WinMarks
mrks Mark -> BufferM MarkValue
getMarkValueB
                WinMarks
newMrks <- MarkSet MarkValue
-> (MarkValue -> BufferM Mark) -> BufferM WinMarks
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM MarkSet MarkValue
newMarkValues MarkValue -> BufferM Mark
newMarkB
                (Map WindowRef WinMarks -> Identity (Map WindowRef WinMarks))
-> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c (Map WindowRef WinMarks)
winMarksA ((Map WindowRef WinMarks -> Identity (Map WindowRef WinMarks))
 -> FBuffer -> Identity FBuffer)
-> (Map WindowRef WinMarks -> Map WindowRef WinMarks) -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= WindowRef
-> WinMarks -> Map WindowRef WinMarks -> Map WindowRef WinMarks
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Window -> WindowRef
wkey Window
w) WinMarks
newMrks
            (Window -> Identity Window) -> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c Window
lastActiveWindowA ((Window -> Identity Window) -> FBuffer -> Identity FBuffer)
-> Window -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Window
w
            BufferM a
f
    in (a
a, Seq Update
updates, (Seq UIUpdate -> Identity (Seq UIUpdate))
-> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c (Seq UIUpdate)
pendingUpdatesA ((Seq UIUpdate -> Identity (Seq UIUpdate))
 -> FBuffer -> Identity FBuffer)
-> (Seq UIUpdate -> Seq UIUpdate) -> FBuffer -> FBuffer
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Seq UIUpdate -> Seq UIUpdate -> Seq UIUpdate
forall a. Seq a -> Seq a -> Seq a
S.>< (Update -> UIUpdate) -> Seq Update -> Seq UIUpdate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Update -> UIUpdate
TextUpdate Seq Update
updates) (FBuffer -> FBuffer) -> FBuffer -> FBuffer
forall a b. (a -> b) -> a -> b
$ FBuffer
newSt)

getMarkValueRaw :: Mark -> FBuffer -> MarkValue
getMarkValueRaw :: Mark -> FBuffer -> MarkValue
getMarkValueRaw Mark
m = MarkValue -> Maybe MarkValue -> MarkValue
forall a. a -> Maybe a -> a
fromMaybe (Point -> Direction -> MarkValue
MarkValue Point
0 Direction
Forward) (Maybe MarkValue -> MarkValue)
-> (FBuffer -> Maybe MarkValue) -> FBuffer -> MarkValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall syntax. BufferImpl syntax -> Maybe MarkValue)
-> FBuffer -> Maybe MarkValue
forall x. (forall syntax. BufferImpl syntax -> x) -> FBuffer -> x
queryRawbuf (Mark -> BufferImpl syntax -> Maybe MarkValue
forall syntax. Mark -> BufferImpl syntax -> Maybe MarkValue
getMarkValueBI Mark
m)

getMarkValueB :: Mark -> BufferM MarkValue
getMarkValueB :: Mark -> BufferM MarkValue
getMarkValueB = (FBuffer -> MarkValue) -> BufferM MarkValue
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((FBuffer -> MarkValue) -> BufferM MarkValue)
-> (Mark -> FBuffer -> MarkValue) -> Mark -> BufferM MarkValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mark -> FBuffer -> MarkValue
getMarkValueRaw

newMarkB :: MarkValue -> BufferM Mark
newMarkB :: MarkValue -> BufferM Mark
newMarkB MarkValue
v = (forall syntax. BufferImpl syntax -> (BufferImpl syntax, Mark))
-> BufferM Mark
forall x.
(forall syntax. BufferImpl syntax -> (BufferImpl syntax, x))
-> BufferM x
queryAndModify ((forall syntax. BufferImpl syntax -> (BufferImpl syntax, Mark))
 -> BufferM Mark)
-> (forall syntax. BufferImpl syntax -> (BufferImpl syntax, Mark))
-> BufferM Mark
forall a b. (a -> b) -> a -> b
$ MarkValue -> BufferImpl syntax -> (BufferImpl syntax, Mark)
forall syntax.
MarkValue -> BufferImpl syntax -> (BufferImpl syntax, Mark)
newMarkBI MarkValue
v

deleteMarkB :: Mark -> BufferM ()
deleteMarkB :: Mark -> BufferM ()
deleteMarkB Mark
m = (forall syntax. BufferImpl syntax -> BufferImpl syntax)
-> BufferM ()
modifyBuffer ((forall syntax. BufferImpl syntax -> BufferImpl syntax)
 -> BufferM ())
-> (forall syntax. BufferImpl syntax -> BufferImpl syntax)
-> BufferM ()
forall a b. (a -> b) -> a -> b
$ Mark -> BufferImpl syntax -> BufferImpl syntax
forall syntax. Mark -> BufferImpl syntax -> BufferImpl syntax
deleteMarkValueBI Mark
m

-- | Execute a @BufferM@ value on a given buffer, using a dummy window.  The new state of
-- the buffer is discarded.
runBufferDummyWindow :: FBuffer -> BufferM a -> a
runBufferDummyWindow :: FBuffer -> BufferM a -> a
runBufferDummyWindow FBuffer
b = (a, FBuffer) -> a
forall a b. (a, b) -> a
fst ((a, FBuffer) -> a)
-> (BufferM a -> (a, FBuffer)) -> BufferM a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> FBuffer -> BufferM a -> (a, FBuffer)
forall a. Window -> FBuffer -> BufferM a -> (a, FBuffer)
runBuffer (BufferRef -> Window
dummyWindow (BufferRef -> Window) -> BufferRef -> Window
forall a b. (a -> b) -> a -> b
$ FBuffer -> BufferRef
bkey FBuffer
b) FBuffer
b


-- | Mark the current point in the undo list as a saved state.
markSavedB :: UTCTime -> BufferM ()
markSavedB :: UTCTime -> BufferM ()
markSavedB UTCTime
t = do
    (URList -> Identity URList) -> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c URList
undosA ((URList -> Identity URList) -> FBuffer -> Identity FBuffer)
-> (URList -> URList) -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= URList -> URList
setSavedFilePointU
    (UTCTime -> Identity UTCTime) -> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c UTCTime
lastSyncTimeA ((UTCTime -> Identity UTCTime) -> FBuffer -> Identity FBuffer)
-> UTCTime -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= UTCTime
t

bkey :: FBuffer -> BufferRef
bkey :: FBuffer -> BufferRef
bkey = Getting BufferRef FBuffer BufferRef -> FBuffer -> BufferRef
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting BufferRef FBuffer BufferRef
forall c. HasAttributes c => Lens' c BufferRef
bkey__A

isUnchangedBuffer :: FBuffer -> Bool
isUnchangedBuffer :: FBuffer -> Bool
isUnchangedBuffer = URList -> Bool
isAtSavedFilePointU (URList -> Bool) -> (FBuffer -> URList) -> FBuffer -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting URList FBuffer URList -> FBuffer -> URList
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting URList FBuffer URList
forall c. HasAttributes c => Lens' c URList
undosA

startUpdateTransactionB :: BufferM ()
startUpdateTransactionB :: BufferM ()
startUpdateTransactionB = do
  Bool
transactionPresent <- Getting Bool FBuffer Bool -> BufferM Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Bool FBuffer Bool
forall c. HasAttributes c => Lens' c Bool
updateTransactionInFlightA
  Bool -> BufferM () -> BufferM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
transactionPresent) (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$ do
    (URList -> Identity URList) -> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c URList
undosA ((URList -> Identity URList) -> FBuffer -> Identity FBuffer)
-> (URList -> URList) -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Change -> URList -> URList
addChangeU Change
InteractivePoint
    (Bool -> Identity Bool) -> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c Bool
updateTransactionInFlightA ((Bool -> Identity Bool) -> FBuffer -> Identity FBuffer)
-> Bool -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True

commitUpdateTransactionB :: BufferM ()
commitUpdateTransactionB :: BufferM ()
commitUpdateTransactionB = do
  Bool
transactionPresent <- Getting Bool FBuffer Bool -> BufferM Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Bool FBuffer Bool
forall c. HasAttributes c => Lens' c Bool
updateTransactionInFlightA
  if Bool -> Bool
not Bool
transactionPresent
  then FilePath -> BufferM ()
forall a. HasCallStack => FilePath -> a
error FilePath
"Not in update transaction"
  else do
    (Bool -> Identity Bool) -> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c Bool
updateTransactionInFlightA ((Bool -> Identity Bool) -> FBuffer -> Identity FBuffer)
-> Bool -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
False
    Seq Update
transacAccum <- Getting (Seq Update) FBuffer (Seq Update) -> BufferM (Seq Update)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Seq Update) FBuffer (Seq Update)
forall c. HasAttributes c => Lens' c (Seq Update)
updateTransactionAccumA
    (Seq Update -> Identity (Seq Update))
-> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c (Seq Update)
updateTransactionAccumA ((Seq Update -> Identity (Seq Update))
 -> FBuffer -> Identity FBuffer)
-> Seq Update -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Seq Update
forall a. Monoid a => a
mempty

    (URList -> Identity URList) -> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c URList
undosA ((URList -> Identity URList) -> FBuffer -> Identity FBuffer)
-> (URList -> URList) -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Endo URList -> URList -> URList
forall a. Endo a -> a -> a
appEndo (Endo URList -> URList -> URList)
-> (Seq (Endo URList) -> Endo URList)
-> Seq (Endo URList)
-> URList
-> URList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Endo URList -> Endo URList -> Endo URList)
-> Endo URList -> Seq (Endo URList) -> Endo URList
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Endo URList -> Endo URList -> Endo URList
forall a. Semigroup a => a -> a -> a
(<>) Endo URList
forall a. Monoid a => a
mempty) ((URList -> URList) -> Endo URList
forall a. (a -> a) -> Endo a
Endo ((URList -> URList) -> Endo URList)
-> (Update -> URList -> URList) -> Update -> Endo URList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Change -> URList -> URList
addChangeU (Change -> URList -> URList)
-> (Update -> Change) -> Update -> URList -> URList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Update -> Change
AtomicChange (Update -> Endo URList) -> Seq Update -> Seq (Endo URList)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq Update
transacAccum)
    (URList -> Identity URList) -> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c URList
undosA ((URList -> Identity URList) -> FBuffer -> Identity FBuffer)
-> (URList -> URList) -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Change -> URList -> URList
addChangeU Change
InteractivePoint


undoRedo :: (forall syntax. Mark -> URList -> BufferImpl syntax
             -> (BufferImpl syntax, (URList, S.Seq Update)))
         -> BufferM ()
undoRedo :: (forall syntax.
 Mark
 -> URList
 -> BufferImpl syntax
 -> (BufferImpl syntax, (URList, Seq Update)))
-> BufferM ()
undoRedo forall syntax.
Mark
-> URList
-> BufferImpl syntax
-> (BufferImpl syntax, (URList, Seq Update))
f = do
  Bool
isTransacPresent <- Getting Bool FBuffer Bool -> BufferM Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Bool FBuffer Bool
forall c. HasAttributes c => Lens' c Bool
updateTransactionInFlightA
  if Bool
isTransacPresent
  then FilePath -> BufferM ()
forall a. HasCallStack => FilePath -> a
error FilePath
"Can't undo while undo transaction is in progress"
  else do
      Mark
m <- BufferM Mark
getInsMark
      URList
ur <- Getting URList FBuffer URList -> BufferM URList
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting URList FBuffer URList
forall c. HasAttributes c => Lens' c URList
undosA
      (URList
ur', Seq Update
updates) <- (forall syntax.
 BufferImpl syntax -> (BufferImpl syntax, (URList, Seq Update)))
-> BufferM (URList, Seq Update)
forall x.
(forall syntax. BufferImpl syntax -> (BufferImpl syntax, x))
-> BufferM x
queryAndModify (Mark
-> URList
-> BufferImpl syntax
-> (BufferImpl syntax, (URList, Seq Update))
forall syntax.
Mark
-> URList
-> BufferImpl syntax
-> (BufferImpl syntax, (URList, Seq Update))
f Mark
m URList
ur)
      (URList -> Identity URList) -> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c URList
undosA ((URList -> Identity URList) -> FBuffer -> Identity FBuffer)
-> URList -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= URList
ur'
      (Seq Update -> Identity (Seq Update))
-> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c (Seq Update)
updateStreamA ((Seq Update -> Identity (Seq Update))
 -> FBuffer -> Identity FBuffer)
-> (Seq Update -> Seq Update) -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Seq Update -> Seq Update -> Seq Update
forall a. Semigroup a => a -> a -> a
<> Seq Update
updates)

undoB :: BufferM ()
undoB :: BufferM ()
undoB = (forall syntax.
 Mark
 -> URList
 -> BufferImpl syntax
 -> (BufferImpl syntax, (URList, Seq Update)))
-> BufferM ()
undoRedo forall syntax.
Mark
-> URList
-> BufferImpl syntax
-> (BufferImpl syntax, (URList, Seq Update))
undoU

redoB :: BufferM ()
redoB :: BufferM ()
redoB = (forall syntax.
 Mark
 -> URList
 -> BufferImpl syntax
 -> (BufferImpl syntax, (URList, Seq Update)))
-> BufferM ()
undoRedo forall syntax.
Mark
-> URList
-> BufferImpl syntax
-> (BufferImpl syntax, (URList, Seq Update))
redoU

-- | Undo all updates that happened since last save,
-- perform a given action and redo all updates again.
-- Given action must not modify undo history.
retroactivelyAtSavePointB :: BufferM a -> BufferM a
retroactivelyAtSavePointB :: BufferM a -> BufferM a
retroactivelyAtSavePointB BufferM a
action = do
    (Int
undoDepth, a
result) <- Int -> BufferM (Int, a)
forall t. Num t => t -> BufferM (t, a)
go Int
0
    Int -> BufferM () -> BufferM ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
undoDepth BufferM ()
redoB
    a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result
    where
        go :: t -> BufferM (t, a)
go t
step = do
            Bool
atSavedPoint <- (FBuffer -> Bool) -> BufferM Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FBuffer -> Bool
isUnchangedBuffer
            if Bool
atSavedPoint
            then (t
step,) (a -> (t, a)) -> BufferM a -> BufferM (t, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM a
action
            else BufferM ()
undoB BufferM () -> BufferM (t, a) -> BufferM (t, a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> t -> BufferM (t, a)
go (t
step t -> t -> t
forall a. Num a => a -> a -> a
+ t
1)


-- | Analogous to const, but returns a function that takes two parameters,
-- rather than one.
const2 :: t -> t1 -> t2 -> t
const2 :: t -> t1 -> t2 -> t
const2 t
x t1
_ t2
_ = t
x

-- | Mode applies function that always returns True.
modeAlwaysApplies :: a -> b -> Bool
modeAlwaysApplies :: a -> b -> Bool
modeAlwaysApplies = Bool -> a -> b -> Bool
forall t t1 t2. t -> t1 -> t2 -> t
const2 Bool
True

-- | Mode applies function that always returns False.
modeNeverApplies :: a -> b -> Bool
modeNeverApplies :: a -> b -> Bool
modeNeverApplies = Bool -> a -> b -> Bool
forall t t1 t2. t -> t1 -> t2 -> t
const2 Bool
False

emptyMode :: Mode syntax
emptyMode :: Mode syntax
emptyMode = Mode :: forall syntax.
Text
-> (FilePath -> YiString -> Bool)
-> ExtHL syntax
-> (syntax -> BufferM ())
-> (KeymapSet -> KeymapSet)
-> (syntax -> IndentBehaviour -> BufferM ())
-> (syntax -> Action)
-> IndentSettings
-> Maybe (BufferM ())
-> (syntax -> Point -> Point -> Point -> [Stroke])
-> BufferM ()
-> ([Text] -> BufferM Text)
-> BufferM ()
-> Mode syntax
Mode
  {
   modeName :: Text
modeName = Text
"empty",
   modeApplies :: FilePath -> YiString -> Bool
modeApplies = FilePath -> YiString -> Bool
forall a b. a -> b -> Bool
modeNeverApplies,
   modeHL :: ExtHL syntax
modeHL = Highlighter () syntax -> ExtHL syntax
forall syntax cache. Highlighter cache syntax -> ExtHL syntax
ExtHL Highlighter () syntax
forall syntax. Highlighter () syntax
noHighlighter,
   modePrettify :: syntax -> BufferM ()
modePrettify = BufferM () -> syntax -> BufferM ()
forall a b. a -> b -> a
const (BufferM () -> syntax -> BufferM ())
-> BufferM () -> syntax -> BufferM ()
forall a b. (a -> b) -> a -> b
$ () -> BufferM ()
forall (m :: * -> *) a. Monad m => a -> m a
return (),
   modeKeymap :: KeymapSet -> KeymapSet
modeKeymap = KeymapSet -> KeymapSet
forall a. a -> a
id,
   modeIndent :: syntax -> IndentBehaviour -> BufferM ()
modeIndent = \syntax
_ IndentBehaviour
_ -> () -> BufferM ()
forall (m :: * -> *) a. Monad m => a -> m a
return (),
   modeFollow :: syntax -> Action
modeFollow = Action -> syntax -> Action
forall a b. a -> b -> a
const Action
emptyAction,
   modeIndentSettings :: IndentSettings
modeIndentSettings = IndentSettings :: Bool -> Int -> Int -> IndentSettings
IndentSettings
   { expandTabs :: Bool
expandTabs = Bool
True
   , tabSize :: Int
tabSize = Int
8
   , shiftWidth :: Int
shiftWidth = Int
4
   },
   modeToggleCommentSelection :: Maybe (BufferM ())
modeToggleCommentSelection = Maybe (BufferM ())
forall a. Maybe a
Nothing,
   modeGetStrokes :: syntax -> Point -> Point -> Point -> [Stroke]
modeGetStrokes = \syntax
_ Point
_ Point
_ Point
_ -> [],
   modeOnLoad :: BufferM ()
modeOnLoad = () -> BufferM ()
forall (m :: * -> *) a. Monad m => a -> m a
return (),
   modeGotoDeclaration :: BufferM ()
modeGotoDeclaration = () -> BufferM ()
forall (m :: * -> *) a. Monad m => a -> m a
return (),
   modeModeLine :: [Text] -> BufferM Text
modeModeLine = [Text] -> BufferM Text
defaultModeLine
  }

-- | Create buffer named @nm@ with contents @s@
newB :: BufferRef -> BufferId -> YiString -> FBuffer
newB :: BufferRef -> BufferId -> YiString -> FBuffer
newB BufferRef
unique BufferId
nm YiString
s =
 FBuffer :: forall syntax.
Mode syntax -> BufferImpl syntax -> Attributes -> FBuffer
FBuffer { bmode :: Mode ()
bmode  = Mode ()
forall syntax. Mode syntax
emptyMode
         , rawbuf :: BufferImpl ()
rawbuf = YiString -> BufferImpl ()
newBI YiString
s
         , attributes :: Attributes
attributes =
 Attributes :: BufferId
-> BufferRef
-> URList
-> DynamicState
-> Maybe Int
-> Maybe Int
-> Bool
-> Seq UIUpdate
-> SelectionStyle
-> KeymapProcess
-> Map WindowRef WinMarks
-> Window
-> UTCTime
-> Bool
-> Bool
-> Bool
-> Set WindowRef
-> Bool
-> Seq Update
-> Int
-> Seq Update
-> Attributes
Attributes { ident :: BufferId
ident  = BufferId
nm
            , bkey__ :: BufferRef
bkey__ = BufferRef
unique
            , undos :: URList
undos  = URList
emptyU
            , preferCol :: Maybe Int
preferCol = Maybe Int
forall a. Maybe a
Nothing
            , preferVisCol :: Maybe Int
preferVisCol = Maybe Int
forall a. Maybe a
Nothing
            , stickyEol :: Bool
stickyEol = Bool
False
            , bufferDynamic :: DynamicState
bufferDynamic = DynamicState
forall a. Monoid a => a
mempty
            , pendingUpdates :: Seq UIUpdate
pendingUpdates = Seq UIUpdate
forall a. Monoid a => a
mempty
            , selectionStyle :: SelectionStyle
selectionStyle = Bool -> Bool -> SelectionStyle
SelectionStyle Bool
False Bool
False
            , keymapProcess :: KeymapProcess
keymapProcess = KeymapProcess
forall event w. P event w
I.End
            , winMarks :: Map WindowRef WinMarks
winMarks = Map WindowRef WinMarks
forall k a. Map k a
M.empty
            , lastActiveWindow :: Window
lastActiveWindow = BufferRef -> Window
dummyWindow BufferRef
unique
            , lastSyncTime :: UTCTime
lastSyncTime = UTCTime
epoch
            , readOnly :: Bool
readOnly = Bool
False
            , directoryContent :: Bool
directoryContent = Bool
False
            , inserting :: Bool
inserting = Bool
True
            , pointFollowsWindow :: Set WindowRef
pointFollowsWindow = Set WindowRef
forall a. Monoid a => a
mempty
            , updateTransactionInFlight :: Bool
updateTransactionInFlight = Bool
False
            , updateTransactionAccum :: Seq Update
updateTransactionAccum = Seq Update
forall a. Monoid a => a
mempty
            , fontsizeVariation :: Int
fontsizeVariation = Int
0
            , updateStream :: Seq Update
updateStream = Seq Update
forall a. Monoid a => a
mempty
            } }

epoch :: UTCTime
epoch :: UTCTime
epoch = Day -> DiffTime -> UTCTime
UTCTime (Int -> Day
forall a. Enum a => Int -> a
toEnum Int
0) (Int -> DiffTime
forall a. Enum a => Int -> a
toEnum Int
0)

-- | Point of eof
sizeB :: BufferM Point
sizeB :: BufferM Point
sizeB = (forall syntax. BufferImpl syntax -> Point) -> BufferM Point
forall x. (forall syntax. BufferImpl syntax -> x) -> BufferM x
queryBuffer forall syntax. BufferImpl syntax -> Point
sizeBI

-- | Extract the current point
pointB :: BufferM Point
pointB :: BufferM Point
pointB = Getting Point FBuffer Point -> BufferM Point
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting Point FBuffer Point -> BufferM Point)
-> (Mark -> Getting Point FBuffer Point) -> Mark -> BufferM Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mark -> Getting Point FBuffer Point
Mark -> Lens' FBuffer Point
markPointA (Mark -> BufferM Point) -> BufferM Mark -> BufferM Point
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BufferM Mark
getInsMark

nelemsB :: Int -> Point -> BufferM YiString
nelemsB :: Int -> Point -> BufferM YiString
nelemsB Int
n Point
i = Int -> YiString -> YiString
R.take Int
n (YiString -> YiString) -> BufferM YiString -> BufferM YiString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Direction -> Point -> BufferM YiString
streamB Direction
Forward Point
i

streamB :: Direction -> Point -> BufferM YiString
streamB :: Direction -> Point -> BufferM YiString
streamB Direction
dir Point
i = (forall syntax. BufferImpl syntax -> YiString) -> BufferM YiString
forall x. (forall syntax. BufferImpl syntax -> x) -> BufferM x
queryBuffer ((forall syntax. BufferImpl syntax -> YiString)
 -> BufferM YiString)
-> (forall syntax. BufferImpl syntax -> YiString)
-> BufferM YiString
forall a b. (a -> b) -> a -> b
$ Direction -> Point -> BufferImpl syntax -> YiString
forall syntax. Direction -> Point -> BufferImpl syntax -> YiString
getStream Direction
dir Point
i

indexedStreamB :: Direction -> Point -> BufferM [(Point,Char)]
indexedStreamB :: Direction -> Point -> BufferM [(Point, Char)]
indexedStreamB Direction
dir Point
i = (forall syntax. BufferImpl syntax -> [(Point, Char)])
-> BufferM [(Point, Char)]
forall x. (forall syntax. BufferImpl syntax -> x) -> BufferM x
queryBuffer ((forall syntax. BufferImpl syntax -> [(Point, Char)])
 -> BufferM [(Point, Char)])
-> (forall syntax. BufferImpl syntax -> [(Point, Char)])
-> BufferM [(Point, Char)]
forall a b. (a -> b) -> a -> b
$ Direction -> Point -> BufferImpl syntax -> [(Point, Char)]
forall syntax.
Direction -> Point -> BufferImpl syntax -> [(Point, Char)]
getIndexedStream Direction
dir Point
i

strokesRangesB :: Maybe SearchExp -> Region -> BufferM [[Stroke]]
strokesRangesB :: Maybe SearchExp -> Region -> BufferM [[Stroke]]
strokesRangesB Maybe SearchExp
regex Region
r = do
  Point
p <- BufferM Point
pointB
  Point -> Point -> Point -> [Stroke]
getStrokes <- (forall syntax.
 Mode syntax -> syntax -> Point -> Point -> Point -> [Stroke])
-> BufferM (Point -> Point -> Point -> [Stroke])
forall a. (forall syntax. Mode syntax -> syntax -> a) -> BufferM a
withSyntaxB forall syntax.
Mode syntax -> syntax -> Point -> Point -> Point -> [Stroke]
modeGetStrokes
  (forall syntax. BufferImpl syntax -> [[Stroke]])
-> BufferM [[Stroke]]
forall x. (forall syntax. BufferImpl syntax -> x) -> BufferM x
queryBuffer ((forall syntax. BufferImpl syntax -> [[Stroke]])
 -> BufferM [[Stroke]])
-> (forall syntax. BufferImpl syntax -> [[Stroke]])
-> BufferM [[Stroke]]
forall a b. (a -> b) -> a -> b
$ (Point -> Point -> Point -> [Stroke])
-> Maybe SearchExp
-> Region
-> Point
-> BufferImpl syntax
-> [[Stroke]]
forall syntax.
(Point -> Point -> Point -> [Stroke])
-> Maybe SearchExp
-> Region
-> Point
-> BufferImpl syntax
-> [[Stroke]]
strokesRangesBI Point -> Point -> Point -> [Stroke]
getStrokes Maybe SearchExp
regex Region
r Point
p

------------------------------------------------------------------------
-- Point based operations

-- | Move point in buffer to the given index
moveTo :: Point -> BufferM ()
moveTo :: Point -> BufferM ()
moveTo Point
x = do
  BufferM ()
forgetPreferCol
  Point
maxP <- BufferM Point
sizeB
  let p :: Point
p = case () of
        ()
_ | Point
x Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
< Point
0 -> Int -> Point
Point Int
0
          | Point
x Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
> Point
maxP -> Point
maxP
          | Bool
otherwise -> Point
x
  (ASetter FBuffer FBuffer Point Point -> Point -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Point
p) (ASetter FBuffer FBuffer Point Point -> BufferM ())
-> (Mark -> ASetter FBuffer FBuffer Point Point)
-> Mark
-> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mark -> ASetter FBuffer FBuffer Point Point
Mark -> Lens' FBuffer Point
markPointA (Mark -> BufferM ()) -> BufferM Mark -> BufferM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BufferM Mark
getInsMark

------------------------------------------------------------------------

setInserting :: Bool -> BufferM ()
setInserting :: Bool -> BufferM ()
setInserting = ((Bool -> Identity Bool) -> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c Bool
insertingA ((Bool -> Identity Bool) -> FBuffer -> Identity FBuffer)
-> Bool -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.=)

checkRO :: BufferM Bool
checkRO :: BufferM Bool
checkRO = do
  Bool
ro <- Getting Bool FBuffer Bool -> BufferM Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Bool FBuffer Bool
forall c. HasAttributes c => Lens' c Bool
readOnlyA
  Bool -> BufferM () -> BufferM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
ro (FilePath -> BufferM ()
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Read Only Buffer")
  Bool -> BufferM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
ro

applyUpdate :: Update -> BufferM ()
applyUpdate :: Update -> BufferM ()
applyUpdate Update
update = do
  Bool
runp <- (Bool -> Bool -> Bool)
-> BufferM Bool -> BufferM Bool -> BufferM Bool
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(&&) (Bool -> Bool
not (Bool -> Bool) -> BufferM Bool -> BufferM Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM Bool
checkRO) ((forall syntax. BufferImpl syntax -> Bool) -> BufferM Bool
forall x. (forall syntax. BufferImpl syntax -> x) -> BufferM x
queryBuffer (Update -> BufferImpl syntax -> Bool
forall syntax. Update -> BufferImpl syntax -> Bool
isValidUpdate Update
update))
  Bool -> BufferM () -> BufferM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
runp (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$ do
    BufferM ()
forgetPreferCol
    (forall syntax. BufferImpl syntax -> BufferImpl syntax)
-> BufferM ()
modifyBuffer (Update -> BufferImpl syntax -> BufferImpl syntax
forall syntax. Update -> BufferImpl syntax -> BufferImpl syntax
applyUpdateI Update
update)
    Bool
isTransacPresent <- Getting Bool FBuffer Bool -> BufferM Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Bool FBuffer Bool
forall c. HasAttributes c => Lens' c Bool
updateTransactionInFlightA
    if Bool
isTransacPresent
    then (Seq Update -> Identity (Seq Update))
-> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c (Seq Update)
updateTransactionAccumA ((Seq Update -> Identity (Seq Update))
 -> FBuffer -> Identity FBuffer)
-> (Seq Update -> Seq Update) -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Update -> Update
reverseUpdateI Update
update Update -> Seq Update -> Seq Update
forall a. a -> Seq a -> Seq a
S.<|)
    else (URList -> Identity URList) -> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c URList
undosA ((URList -> Identity URList) -> FBuffer -> Identity FBuffer)
-> (URList -> URList) -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Change -> URList -> URList
addChangeU (Update -> Change
AtomicChange (Update -> Change) -> Update -> Change
forall a b. (a -> b) -> a -> b
$ Update -> Update
reverseUpdateI Update
update)

    (Seq Update -> Identity (Seq Update))
-> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c (Seq Update)
updateStreamA ((Seq Update -> Identity (Seq Update))
 -> FBuffer -> Identity FBuffer)
-> (Seq Update -> Seq Update) -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Seq Update -> Update -> Seq Update
forall a. Seq a -> a -> Seq a
S.|> Update
update)


-- | Revert all the pending updates; don't touch the point.
revertPendingUpdatesB :: BufferM ()
revertPendingUpdatesB :: BufferM ()
revertPendingUpdatesB = do
  Seq UIUpdate
updates <- Getting (Seq UIUpdate) FBuffer (Seq UIUpdate)
-> BufferM (Seq UIUpdate)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Seq UIUpdate) FBuffer (Seq UIUpdate)
forall c. HasAttributes c => Lens' c (Seq UIUpdate)
pendingUpdatesA
  (forall syntax. BufferImpl syntax -> BufferImpl syntax)
-> BufferM ()
modifyBuffer ((forall syntax. BufferImpl syntax -> BufferImpl syntax)
 -> BufferM ())
-> (forall syntax. BufferImpl syntax -> BufferImpl syntax)
-> BufferM ()
forall a b. (a -> b) -> a -> b
$ \BufferImpl syntax
stx ->
    let applyTextUpdate :: UIUpdate -> BufferImpl syntax -> BufferImpl syntax
applyTextUpdate (TextUpdate Update
u) BufferImpl syntax
bi = Update -> BufferImpl syntax -> BufferImpl syntax
forall syntax. Update -> BufferImpl syntax -> BufferImpl syntax
applyUpdateI (Update -> Update
reverseUpdateI Update
u) BufferImpl syntax
bi
        applyTextUpdate UIUpdate
_ BufferImpl syntax
bi = BufferImpl syntax
bi
    in (UIUpdate -> BufferImpl syntax -> BufferImpl syntax)
-> BufferImpl syntax -> Seq UIUpdate -> BufferImpl syntax
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr UIUpdate -> BufferImpl syntax -> BufferImpl syntax
forall syntax. UIUpdate -> BufferImpl syntax -> BufferImpl syntax
applyTextUpdate BufferImpl syntax
stx Seq UIUpdate
updates

-- | Write an element into the buffer at the current point.
writeB :: Char -> BufferM ()
writeB :: Char -> BufferM ()
writeB Char
c = do
  Int -> BufferM ()
deleteN Int
1
  Char -> BufferM ()
insertB Char
c

-- | Write the list into the buffer at current point.
writeN :: YiString -> BufferM ()
writeN :: YiString -> BufferM ()
writeN YiString
cs = do
  Point
off <- BufferM Point
pointB
  Direction -> Int -> Point -> BufferM ()
deleteNAt Direction
Forward (YiString -> Int
R.length YiString
cs) Point
off
  YiString -> Point -> BufferM ()
insertNAt YiString
cs Point
off

-- | Insert newline at current point.
newlineB :: BufferM ()
newlineB :: BufferM ()
newlineB = Char -> BufferM ()
insertB Char
'\n'

------------------------------------------------------------------------

-- | Insert given 'YiString' at specified point, extending size of the
-- buffer.
insertNAt :: YiString -> Point -> BufferM ()
insertNAt :: YiString -> Point -> BufferM ()
insertNAt YiString
rope Point
pnt = Update -> BufferM ()
applyUpdate (Point -> Direction -> YiString -> Update
Insert Point
pnt Direction
Forward YiString
rope)

-- | Insert the 'YiString' at current point, extending size of buffer
insertN :: YiString -> BufferM ()
insertN :: YiString -> BufferM ()
insertN YiString
cs = BufferM Point
pointB BufferM Point -> (Point -> BufferM ()) -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= YiString -> Point -> BufferM ()
insertNAt YiString
cs

-- | Insert the char at current point, extending size of buffer
--
-- Implementation note: This just 'insertB's a 'R.singleton'. This
-- seems sub-optimal because we should be able to do much better
-- without spewing chunks of size 1 everywhere. This approach is
-- necessary however so an 'Update' can be recorded. A possible
-- improvement for space would be to have ‘yi-rope’ package optimise
-- for appends with length 1.
insertB :: Char -> BufferM ()
insertB :: Char -> BufferM ()
insertB = YiString -> BufferM ()
insertN (YiString -> BufferM ())
-> (Char -> YiString) -> Char -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> YiString
R.singleton

------------------------------------------------------------------------

-- | @deleteNAt n p@ deletes @n@ characters forwards from position @p@
deleteNAt :: Direction -> Int -> Point -> BufferM ()
deleteNAt :: Direction -> Int -> Point -> BufferM ()
deleteNAt Direction
_ Int
0 Point
_ = () -> BufferM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
deleteNAt Direction
dir Int
n Point
pos = do
  YiString
els <- Int -> YiString -> YiString
R.take Int
n (YiString -> YiString) -> BufferM YiString -> BufferM YiString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Direction -> Point -> BufferM YiString
streamB Direction
Forward Point
pos
  Update -> BufferM ()
applyUpdate (Update -> BufferM ()) -> Update -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Point -> Direction -> YiString -> Update
Delete Point
pos Direction
dir YiString
els


------------------------------------------------------------------------
-- Line based editing

-- | Return the current line number
curLn :: BufferM Int
curLn :: BufferM Int
curLn = do
    Point
p <- BufferM Point
pointB
    (forall syntax. BufferImpl syntax -> Int) -> BufferM Int
forall x. (forall syntax. BufferImpl syntax -> x) -> BufferM x
queryBuffer (Point -> BufferImpl syntax -> Int
forall syntax. Point -> BufferImpl syntax -> Int
lineAt Point
p)


-- | Top line of the screen
screenTopLn :: BufferM Int
screenTopLn :: BufferM Int
screenTopLn = do
    Point
p <- Getting Point FBuffer Point -> BufferM Point
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting Point FBuffer Point -> BufferM Point)
-> (Mark -> Getting Point FBuffer Point) -> Mark -> BufferM Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mark -> Getting Point FBuffer Point
Mark -> Lens' FBuffer Point
markPointA (Mark -> BufferM Point) -> BufferM Mark -> BufferM Point
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< WinMarks -> Mark
forall a. MarkSet a -> a
fromMark (WinMarks -> Mark) -> BufferM WinMarks -> BufferM Mark
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM WinMarks
askMarks
    (forall syntax. BufferImpl syntax -> Int) -> BufferM Int
forall x. (forall syntax. BufferImpl syntax -> x) -> BufferM x
queryBuffer (Point -> BufferImpl syntax -> Int
forall syntax. Point -> BufferImpl syntax -> Int
lineAt Point
p)


-- | Middle line of the screen
screenMidLn :: BufferM Int
screenMidLn :: BufferM Int
screenMidLn = Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) (Int -> Int -> Int) -> BufferM Int -> BufferM (Int -> Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM Int
screenTopLn BufferM (Int -> Int) -> BufferM Int -> BufferM Int
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> Int -> Int
forall a. Integral a => a -> a -> a
div (Int -> Int -> Int) -> BufferM Int -> BufferM (Int -> Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM Int
screenLines BufferM (Int -> Int) -> BufferM Int -> BufferM Int
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> BufferM Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
2)


-- | Bottom line of the screen
screenBotLn :: BufferM Int
screenBotLn :: BufferM Int
screenBotLn = Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) (Int -> Int -> Int) -> BufferM Int -> BufferM (Int -> Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM Int
screenTopLn BufferM (Int -> Int) -> BufferM Int -> BufferM Int
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BufferM Int
screenLines


-- | Amount of lines in the screen
screenLines :: BufferM Int
screenLines :: BufferM Int
screenLines = Int -> Int
forall a. Enum a => a -> a
pred (Int -> Int) -> BufferM Int -> BufferM Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Window -> Int) -> BufferM Int
forall a. (Window -> a) -> BufferM a
askWindow Window -> Int
actualLines


-- | Return line numbers of marks
markLines :: BufferM (MarkSet Int)
markLines :: BufferM (MarkSet Int)
markLines = (Mark -> BufferM Int) -> WinMarks -> BufferM (MarkSet Int)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Mark -> BufferM Int
getLn (WinMarks -> BufferM (MarkSet Int))
-> BufferM WinMarks -> BufferM (MarkSet Int)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BufferM WinMarks
askMarks
        where getLn :: Mark -> BufferM Int
getLn Mark
m = Getting Point FBuffer Point -> BufferM Point
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Mark -> Lens' FBuffer Point
markPointA Mark
m) BufferM Point -> (Point -> BufferM Int) -> BufferM Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Point -> BufferM Int
lineOf


-- | Go to line number @n@. @n@ is indexed from 1. Returns the
-- actual line we went to (which may be not be the requested line,
-- if it was out of range)
gotoLn :: Int -> BufferM Int
gotoLn :: Int -> BufferM Int
gotoLn Int
x = do
  Point -> BufferM ()
moveTo Point
0
  Int -> Int
forall a. Enum a => a -> a
succ (Int -> Int) -> BufferM Int -> BufferM Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> BufferM Int
gotoLnFrom (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

---------------------------------------------------------------------

setMode0 :: forall syntax. Mode syntax -> FBuffer -> FBuffer
setMode0 :: Mode syntax -> FBuffer -> FBuffer
setMode0 Mode syntax
m (FBuffer Mode syntax
_ BufferImpl syntax
rb Attributes
at) = Mode syntax -> BufferImpl syntax -> Attributes -> FBuffer
forall syntax.
Mode syntax -> BufferImpl syntax -> Attributes -> FBuffer
FBuffer Mode syntax
m (ExtHL syntax -> BufferImpl syntax -> BufferImpl syntax
forall syntax oldSyntax.
ExtHL syntax -> BufferImpl oldSyntax -> BufferImpl syntax
setSyntaxBI (Mode syntax -> ExtHL syntax
forall syntax. Mode syntax -> ExtHL syntax
modeHL Mode syntax
m) BufferImpl syntax
rb) Attributes
at

modifyMode0 :: (forall syntax. Mode syntax -> Mode syntax) -> FBuffer -> FBuffer
modifyMode0 :: (forall syntax. Mode syntax -> Mode syntax) -> FBuffer -> FBuffer
modifyMode0 forall syntax. Mode syntax -> Mode syntax
f (FBuffer Mode syntax
m BufferImpl syntax
rb Attributes
f3) = Mode syntax -> BufferImpl syntax -> Attributes -> FBuffer
forall syntax.
Mode syntax -> BufferImpl syntax -> Attributes -> FBuffer
FBuffer Mode syntax
m' (ExtHL syntax -> BufferImpl syntax -> BufferImpl syntax
forall syntax oldSyntax.
ExtHL syntax -> BufferImpl oldSyntax -> BufferImpl syntax
setSyntaxBI (Mode syntax -> ExtHL syntax
forall syntax. Mode syntax -> ExtHL syntax
modeHL Mode syntax
m') BufferImpl syntax
rb) Attributes
f3
  where m' :: Mode syntax
m' = Mode syntax -> Mode syntax
forall syntax. Mode syntax -> Mode syntax
f Mode syntax
m

-- | Set the mode
setAnyMode :: AnyMode -> BufferM ()
setAnyMode :: AnyMode -> BufferM ()
setAnyMode (AnyMode Mode syntax
m) = Mode syntax -> BufferM ()
forall syntax. Mode syntax -> BufferM ()
setMode Mode syntax
m

setMode :: Mode syntax -> BufferM ()
setMode :: Mode syntax -> BufferM ()
setMode Mode syntax
m = do
  (FBuffer -> FBuffer) -> BufferM ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Mode syntax -> FBuffer -> FBuffer
forall syntax. Mode syntax -> FBuffer -> FBuffer
setMode0 Mode syntax
m)
  -- reset the keymap process so we use the one of the new mode.
  (KeymapProcess -> Identity KeymapProcess)
-> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c KeymapProcess
keymapProcessA ((KeymapProcess -> Identity KeymapProcess)
 -> FBuffer -> Identity FBuffer)
-> KeymapProcess -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= KeymapProcess
forall event w. P event w
I.End
  Mode syntax -> BufferM ()
forall syntax. Mode syntax -> BufferM ()
modeOnLoad Mode syntax
m

-- | Modify the mode
modifyMode :: (forall syntax. Mode syntax -> Mode syntax) -> BufferM ()
modifyMode :: (forall syntax. Mode syntax -> Mode syntax) -> BufferM ()
modifyMode forall syntax. Mode syntax -> Mode syntax
f = do
  (FBuffer -> FBuffer) -> BufferM ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((forall syntax. Mode syntax -> Mode syntax) -> FBuffer -> FBuffer
modifyMode0 forall syntax. Mode syntax -> Mode syntax
f)
  -- reset the keymap process so we use the one of the new mode.
  (KeymapProcess -> Identity KeymapProcess)
-> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c KeymapProcess
keymapProcessA ((KeymapProcess -> Identity KeymapProcess)
 -> FBuffer -> Identity FBuffer)
-> KeymapProcess -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= KeymapProcess
forall event w. P event w
I.End

onMode :: (forall syntax. Mode syntax -> Mode syntax) -> AnyMode -> AnyMode
onMode :: (forall syntax. Mode syntax -> Mode syntax) -> AnyMode -> AnyMode
onMode forall syntax. Mode syntax -> Mode syntax
f (AnyMode Mode syntax
m) = Mode syntax -> AnyMode
forall syntax. Mode syntax -> AnyMode
AnyMode (Mode syntax -> Mode syntax
forall syntax. Mode syntax -> Mode syntax
f Mode syntax
m)

withMode0 :: (forall syntax. Mode syntax -> a) -> FBuffer -> a
withMode0 :: (forall syntax. Mode syntax -> a) -> FBuffer -> a
withMode0 forall syntax. Mode syntax -> a
f FBuffer {bmode :: ()
bmode = Mode syntax
m} = Mode syntax -> a
forall syntax. Mode syntax -> a
f Mode syntax
m

withModeB :: (forall syntax. Mode syntax -> BufferM a) -> BufferM a
withModeB :: (forall syntax. Mode syntax -> BufferM a) -> BufferM a
withModeB forall syntax. Mode syntax -> BufferM a
x = BufferM (BufferM a) -> BufferM a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ((FBuffer -> BufferM a) -> BufferM (BufferM a)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((forall syntax. Mode syntax -> BufferM a) -> FBuffer -> BufferM a
forall a. (forall syntax. Mode syntax -> a) -> FBuffer -> a
withMode0 forall syntax. Mode syntax -> BufferM a
x))

withSyntax0 :: (forall syntax. Mode syntax -> syntax -> a) -> WindowRef -> FBuffer -> a
withSyntax0 :: (forall syntax. Mode syntax -> syntax -> a)
-> WindowRef -> FBuffer -> a
withSyntax0 forall syntax. Mode syntax -> syntax -> a
f WindowRef
wk (FBuffer Mode syntax
bm BufferImpl syntax
rb Attributes
_attrs) = Mode syntax -> syntax -> a
forall syntax. Mode syntax -> syntax -> a
f Mode syntax
bm (WindowRef -> BufferImpl syntax -> syntax
forall syntax. WindowRef -> BufferImpl syntax -> syntax
getAst WindowRef
wk BufferImpl syntax
rb)


withSyntaxB :: (forall syntax. Mode syntax -> syntax -> a) -> BufferM a
withSyntaxB :: (forall syntax. Mode syntax -> syntax -> a) -> BufferM a
withSyntaxB forall syntax. Mode syntax -> syntax -> a
f = (forall syntax. Mode syntax -> syntax -> a)
-> WindowRef -> FBuffer -> a
forall a.
(forall syntax. Mode syntax -> syntax -> a)
-> WindowRef -> FBuffer -> a
withSyntax0 forall syntax. Mode syntax -> syntax -> a
f (WindowRef -> FBuffer -> a)
-> BufferM WindowRef -> BufferM (FBuffer -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Window -> WindowRef) -> BufferM WindowRef
forall a. (Window -> a) -> BufferM a
askWindow Window -> WindowRef
wkey BufferM (FBuffer -> a) -> BufferM FBuffer -> BufferM a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Getting FBuffer FBuffer FBuffer -> BufferM FBuffer
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting FBuffer FBuffer FBuffer
forall a. a -> a
id


focusSyntax ::  M.Map WindowRef Region -> FBuffer -> FBuffer
focusSyntax :: Map WindowRef Region -> FBuffer -> FBuffer
focusSyntax Map WindowRef Region
r = (forall syntax. BufferImpl syntax -> BufferImpl syntax)
-> FBuffer -> FBuffer
modifyRawbuf (Map WindowRef Region -> BufferImpl syntax -> BufferImpl syntax
forall syntax.
Map WindowRef Region -> BufferImpl syntax -> BufferImpl syntax
focusAst Map WindowRef Region
r)

withSyntaxB' :: (forall syntax. Mode syntax -> syntax -> BufferM a) -> BufferM a
withSyntaxB' :: (forall syntax. Mode syntax -> syntax -> BufferM a) -> BufferM a
withSyntaxB' forall syntax. Mode syntax -> syntax -> BufferM a
x = BufferM (BufferM a) -> BufferM a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ((forall syntax. Mode syntax -> syntax -> BufferM a)
-> BufferM (BufferM a)
forall a. (forall syntax. Mode syntax -> syntax -> a) -> BufferM a
withSyntaxB forall syntax. Mode syntax -> syntax -> BufferM a
x)

-- | Return indices of strings in buffer matched by regex in the
-- given region.
regexRegionB :: SearchExp -> Region -> BufferM [Region]
regexRegionB :: SearchExp -> Region -> BufferM [Region]
regexRegionB SearchExp
regex Region
region = (forall syntax. BufferImpl syntax -> [Region]) -> BufferM [Region]
forall x. (forall syntax. BufferImpl syntax -> x) -> BufferM x
queryBuffer ((forall syntax. BufferImpl syntax -> [Region])
 -> BufferM [Region])
-> (forall syntax. BufferImpl syntax -> [Region])
-> BufferM [Region]
forall a b. (a -> b) -> a -> b
$ SearchExp -> Region -> forall syntax. BufferImpl syntax -> [Region]
regexRegionBI SearchExp
regex Region
region

-- | Return indices of next string in buffer matched by regex in the
-- given direction
regexB :: Direction -> SearchExp -> BufferM [Region]
regexB :: Direction -> SearchExp -> BufferM [Region]
regexB Direction
dir SearchExp
rx = do
  Point
p <- BufferM Point
pointB
  Point
s <- BufferM Point
sizeB
  SearchExp -> Region -> BufferM [Region]
regexRegionB SearchExp
rx (Point -> Point -> Region
mkRegion Point
p (case Direction
dir of Direction
Forward -> Point
s; Direction
Backward -> Point
0))

---------------------------------------------------------------------

modifyMarkRaw :: Mark -> (MarkValue -> MarkValue) -> FBuffer -> FBuffer
modifyMarkRaw :: Mark -> (MarkValue -> MarkValue) -> FBuffer -> FBuffer
modifyMarkRaw Mark
m MarkValue -> MarkValue
f = (forall syntax. BufferImpl syntax -> BufferImpl syntax)
-> FBuffer -> FBuffer
modifyRawbuf ((forall syntax. BufferImpl syntax -> BufferImpl syntax)
 -> FBuffer -> FBuffer)
-> (forall syntax. BufferImpl syntax -> BufferImpl syntax)
-> FBuffer
-> FBuffer
forall a b. (a -> b) -> a -> b
$ Mark
-> (MarkValue -> MarkValue)
-> forall syntax. BufferImpl syntax -> BufferImpl syntax
modifyMarkBI Mark
m MarkValue -> MarkValue
f

modifyMarkB :: Mark -> (MarkValue -> MarkValue) -> BufferM ()
modifyMarkB :: Mark -> (MarkValue -> MarkValue) -> BufferM ()
modifyMarkB = ((FBuffer -> FBuffer) -> BufferM ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((FBuffer -> FBuffer) -> BufferM ())
-> ((MarkValue -> MarkValue) -> FBuffer -> FBuffer)
-> (MarkValue -> MarkValue)
-> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) (((MarkValue -> MarkValue) -> FBuffer -> FBuffer)
 -> (MarkValue -> MarkValue) -> BufferM ())
-> (Mark -> (MarkValue -> MarkValue) -> FBuffer -> FBuffer)
-> Mark
-> (MarkValue -> MarkValue)
-> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mark -> (MarkValue -> MarkValue) -> FBuffer -> FBuffer
modifyMarkRaw

setMarkHereB :: BufferM Mark
setMarkHereB :: BufferM Mark
setMarkHereB = Maybe FilePath -> BufferM Mark
getMarkB Maybe FilePath
forall a. Maybe a
Nothing

setNamedMarkHereB :: String -> BufferM ()
setNamedMarkHereB :: FilePath -> BufferM ()
setNamedMarkHereB FilePath
name = do
    Point
p <- BufferM Point
pointB
    Maybe FilePath -> BufferM Mark
getMarkB (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
name) BufferM Mark -> (Mark -> BufferM ()) -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ASetter FBuffer FBuffer Point Point -> Point -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Point
p) (ASetter FBuffer FBuffer Point Point -> BufferM ())
-> (Mark -> ASetter FBuffer FBuffer Point Point)
-> Mark
-> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mark -> ASetter FBuffer FBuffer Point Point
Mark -> Lens' FBuffer Point
markPointA

-- | Highlight the selection
setVisibleSelection :: Bool -> BufferM ()
setVisibleSelection :: Bool -> BufferM ()
setVisibleSelection = ((Bool -> Identity Bool) -> FBuffer -> Identity FBuffer
Lens' FBuffer Bool
highlightSelectionA ((Bool -> Identity Bool) -> FBuffer -> Identity FBuffer)
-> Bool -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.=)

-- | Whether the selection is highlighted
getVisibleSelection :: BufferM Bool
getVisibleSelection :: BufferM Bool
getVisibleSelection = Getting Bool FBuffer Bool -> BufferM Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Bool FBuffer Bool
Lens' FBuffer Bool
highlightSelectionA

getInsMark :: BufferM Mark
getInsMark :: BufferM Mark
getInsMark = WinMarks -> Mark
forall a. MarkSet a -> a
insMark (WinMarks -> Mark) -> BufferM WinMarks -> BufferM Mark
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM WinMarks
askMarks

askMarks :: BufferM WinMarks
askMarks :: BufferM WinMarks
askMarks = do
  Just !WinMarks
ms <- Window -> BufferM (Maybe WinMarks)
getMarks (Window -> BufferM (Maybe WinMarks))
-> BufferM Window -> BufferM (Maybe WinMarks)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BufferM Window
forall r (m :: * -> *). MonadReader r m => m r
ask
  WinMarks -> BufferM WinMarks
forall (m :: * -> *) a. Monad m => a -> m a
return WinMarks
ms

getMarkB :: Maybe String -> BufferM Mark
getMarkB :: Maybe FilePath -> BufferM Mark
getMarkB Maybe FilePath
m = do
  Point
p <- BufferM Point
pointB
  (forall syntax. BufferImpl syntax -> (BufferImpl syntax, Mark))
-> BufferM Mark
forall x.
(forall syntax. BufferImpl syntax -> (BufferImpl syntax, x))
-> BufferM x
queryAndModify (Maybe FilePath
-> Point -> BufferImpl syntax -> (BufferImpl syntax, Mark)
forall syntax.
Maybe FilePath
-> Point -> BufferImpl syntax -> (BufferImpl syntax, Mark)
getMarkDefaultPosBI Maybe FilePath
m Point
p)

mayGetMarkB :: String -> BufferM (Maybe Mark)
mayGetMarkB :: FilePath -> BufferM (Maybe Mark)
mayGetMarkB FilePath
m = (forall syntax. BufferImpl syntax -> Maybe Mark)
-> BufferM (Maybe Mark)
forall x. (forall syntax. BufferImpl syntax -> x) -> BufferM x
queryBuffer (FilePath -> BufferImpl syntax -> Maybe Mark
forall syntax. FilePath -> BufferImpl syntax -> Maybe Mark
getMarkBI FilePath
m)

-- | Move point by the given number of characters.
-- A negative offset moves backwards a positive one forward.
moveN :: Int -> BufferM ()
moveN :: Int -> BufferM ()
moveN Int
n = do
    Point
s <- BufferM Point
sizeB
    Point -> BufferM ()
moveTo (Point -> BufferM ()) -> BufferM Point -> BufferM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Point -> Point -> Point
forall a. Ord a => a -> a -> a
min Point
s (Point -> Point) -> (Point -> Point) -> Point -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> Point -> Point
forall a. Ord a => a -> a -> a
max Point
0 (Point -> Point) -> (Point -> Point) -> Point -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Point -> Size -> Point
forall absolute relative.
SemiNum absolute relative =>
absolute -> relative -> absolute
+~ Int -> Size
Size Int
n) (Point -> Point) -> BufferM Point -> BufferM Point
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM Point
pointB

-- | Move point -1
leftB :: BufferM ()
leftB :: BufferM ()
leftB = Int -> BufferM ()
leftN Int
1

-- | Move cursor -n
leftN :: Int -> BufferM ()
leftN :: Int -> BufferM ()
leftN Int
n = Int -> BufferM ()
moveN (-Int
n)

-- | Move cursor +1
rightB :: BufferM ()
rightB :: BufferM ()
rightB = Int -> BufferM ()
rightN Int
1

-- | Move cursor +n
rightN :: Int -> BufferM ()
rightN :: Int -> BufferM ()
rightN = Int -> BufferM ()
moveN

-- ---------------------------------------------------------------------
-- Line based movement and friends

-- | Move point down by @n@ lines. @n@ can be negative.
-- Returns the actual difference in lines which we moved which
-- may be negative if the requested line difference is negative.
lineMoveRel :: Int -> BufferM Int
lineMoveRel :: Int -> BufferM Int
lineMoveRel = BufferM Int -> BufferM Int
forall a. BufferM a -> BufferM a
movingToPrefCol (BufferM Int -> BufferM Int)
-> (Int -> BufferM Int) -> Int -> BufferM Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> BufferM Int
gotoLnFrom

movingToPrefCol :: BufferM a -> BufferM a
movingToPrefCol :: BufferM a -> BufferM a
movingToPrefCol BufferM a
f = do
  Maybe Int
prefCol <- Getting (Maybe Int) FBuffer (Maybe Int) -> BufferM (Maybe Int)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Maybe Int) FBuffer (Maybe Int)
forall c. HasAttributes c => Lens' c (Maybe Int)
preferColA
  Int
targetCol <- BufferM Int -> (Int -> BufferM Int) -> Maybe Int -> BufferM Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe BufferM Int
curCol Int -> BufferM Int
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
prefCol
  a
r <- BufferM a
f
  Int -> BufferM ()
moveToColB Int
targetCol
  (Maybe Int -> Identity (Maybe Int)) -> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c (Maybe Int)
preferColA ((Maybe Int -> Identity (Maybe Int))
 -> FBuffer -> Identity FBuffer)
-> Maybe Int -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int -> Maybe Int
forall a. a -> Maybe a
Just Int
targetCol
  a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r

-- | Moves to a visual column within the current line as shown
-- on the editor (ie, moving within the current width of a
-- single visual line)
movingToPrefVisCol :: BufferM a -> BufferM a
movingToPrefVisCol :: BufferM a -> BufferM a
movingToPrefVisCol BufferM a
f = do
  Maybe Int
prefCol <- Getting (Maybe Int) FBuffer (Maybe Int) -> BufferM (Maybe Int)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Maybe Int) FBuffer (Maybe Int)
forall c. HasAttributes c => Lens' c (Maybe Int)
preferVisColA
  Int
targetCol <- BufferM Int -> (Int -> BufferM Int) -> Maybe Int -> BufferM Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe BufferM Int
curVisCol Int -> BufferM Int
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
prefCol
  a
r <- BufferM a
f
  Int -> BufferM ()
moveToVisColB Int
targetCol
  (Maybe Int -> Identity (Maybe Int)) -> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c (Maybe Int)
preferVisColA ((Maybe Int -> Identity (Maybe Int))
 -> FBuffer -> Identity FBuffer)
-> Maybe Int -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int -> Maybe Int
forall a. a -> Maybe a
Just Int
targetCol
  a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r

moveToColB :: Int -> BufferM ()
moveToColB :: Int -> BufferM ()
moveToColB Int
targetCol = do
  Point
solPnt <- Point -> BufferM Point
solPointB (Point -> BufferM Point) -> BufferM Point -> BufferM Point
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BufferM Point
pointB
  FilePath
chrs <- YiString -> FilePath
R.toString (YiString -> FilePath) -> BufferM YiString -> BufferM FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Point -> BufferM YiString
nelemsB Int
targetCol Point
solPnt
  IndentSettings
is <- BufferM IndentSettings
indentSettingsB
  let cols :: [Int]
cols = (Int -> Char -> Int) -> Int -> FilePath -> [Int]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (IndentSettings -> Int -> Char -> Int
colMove IndentSettings
is) Int
0 FilePath
chrs    -- columns corresponding to the char
      toSkip :: [(Char, Int)]
toSkip = ((Char, Int) -> Bool) -> [(Char, Int)] -> [(Char, Int)]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\(Char
char,Int
col) -> Char
char Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n' Bool -> Bool -> Bool
&& Int
col Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
targetCol) (FilePath -> [Int] -> [(Char, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip FilePath
chrs [Int]
cols)
  Point -> BufferM ()
moveTo (Point -> BufferM ()) -> Point -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Point
solPnt Point -> Size -> Point
forall absolute relative.
SemiNum absolute relative =>
absolute -> relative -> absolute
+~ Int -> Size
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([(Char, Int)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Char, Int)]
toSkip)

moveToVisColB :: Int -> BufferM ()
moveToVisColB :: Int -> BufferM ()
moveToVisColB Int
targetCol = do
  Int
col <- BufferM Int
curCol
  Int
wid <- Window -> Int
width (Window -> Int) -> BufferM Window -> BufferM Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting Window FBuffer Window -> BufferM Window
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Window FBuffer Window
forall c. HasAttributes c => Lens' c Window
lastActiveWindowA
  let jumps :: Int
jumps = Int
col Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
wid
  Int -> BufferM ()
moveToColB (Int -> BufferM ()) -> Int -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Int
jumps Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
wid Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
targetCol

moveToLineColB :: Int -> Int -> BufferM ()
moveToLineColB :: Int -> Int -> BufferM ()
moveToLineColB Int
line Int
col = Int -> BufferM Int
gotoLn Int
line BufferM Int -> BufferM () -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> BufferM ()
moveToColB Int
col

pointOfLineColB :: Int -> Int -> BufferM Point
pointOfLineColB :: Int -> Int -> BufferM Point
pointOfLineColB Int
line Int
col = BufferM Point -> BufferM Point
forall a. BufferM a -> BufferM a
savingPointB (BufferM Point -> BufferM Point) -> BufferM Point -> BufferM Point
forall a b. (a -> b) -> a -> b
$ Int -> Int -> BufferM ()
moveToLineColB Int
line Int
col BufferM () -> BufferM Point -> BufferM Point
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferM Point
pointB

forgetPreferCol :: BufferM ()
forgetPreferCol :: BufferM ()
forgetPreferCol = do
  (Maybe Int -> Identity (Maybe Int)) -> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c (Maybe Int)
preferColA ((Maybe Int -> Identity (Maybe Int))
 -> FBuffer -> Identity FBuffer)
-> Maybe Int -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe Int
forall a. Maybe a
Nothing
  (Maybe Int -> Identity (Maybe Int)) -> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c (Maybe Int)
preferVisColA ((Maybe Int -> Identity (Maybe Int))
 -> FBuffer -> Identity FBuffer)
-> Maybe Int -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe Int
forall a. Maybe a
Nothing
  !FBuffer
st <- (FBuffer -> FBuffer) -> BufferM FBuffer
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FBuffer -> FBuffer
forall a. a -> a
id
  () -> BufferM ()
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> BufferM ()) -> () -> BufferM ()
forall a b. (a -> b) -> a -> b
$! (FBuffer
st FBuffer -> () -> ()
`seq` ())

savingPrefCol :: BufferM a -> BufferM a
savingPrefCol :: BufferM a -> BufferM a
savingPrefCol BufferM a
f = do
  Maybe Int
pc <- Getting (Maybe Int) FBuffer (Maybe Int) -> BufferM (Maybe Int)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Maybe Int) FBuffer (Maybe Int)
forall c. HasAttributes c => Lens' c (Maybe Int)
preferColA
  Maybe Int
pv <- Getting (Maybe Int) FBuffer (Maybe Int) -> BufferM (Maybe Int)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Maybe Int) FBuffer (Maybe Int)
forall c. HasAttributes c => Lens' c (Maybe Int)
preferVisColA
  a
result <- BufferM a
f
  (Maybe Int -> Identity (Maybe Int)) -> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c (Maybe Int)
preferColA ((Maybe Int -> Identity (Maybe Int))
 -> FBuffer -> Identity FBuffer)
-> Maybe Int -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe Int
pc
  (Maybe Int -> Identity (Maybe Int)) -> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c (Maybe Int)
preferVisColA ((Maybe Int -> Identity (Maybe Int))
 -> FBuffer -> Identity FBuffer)
-> Maybe Int -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe Int
pv
  a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result

-- | Move point up one line
lineUp :: BufferM ()
lineUp :: BufferM ()
lineUp = BufferM Int -> BufferM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Int -> BufferM Int
lineMoveRel (-Int
1))

-- | Move point down one line
lineDown :: BufferM ()
lineDown :: BufferM ()
lineDown = BufferM Int -> BufferM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Int -> BufferM Int
lineMoveRel Int
1)

-- | Return the contents of the buffer.
elemsB :: BufferM YiString
elemsB :: BufferM YiString
elemsB = (forall syntax. BufferImpl syntax -> YiString) -> BufferM YiString
forall x. (forall syntax. BufferImpl syntax -> x) -> BufferM x
queryBuffer forall syntax. BufferImpl syntax -> YiString
mem

-- | Returns the contents of the buffer between the two points.
--
-- If the @startPoint >= endPoint@, empty string is returned. If the
-- points are out of bounds, as much of the content as possible is
-- taken: you're not guaranteed to get @endPoint - startPoint@
-- characters.
betweenB :: Point -- ^ Point to start at
         -> Point -- ^ Point to stop at
         -> BufferM YiString
betweenB :: Point -> Point -> BufferM YiString
betweenB (Point Int
s) (Point Int
e) =
  if Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
e
  then YiString -> BufferM YiString
forall (m :: * -> *) a. Monad m => a -> m a
return (YiString
forall a. Monoid a => a
mempty :: YiString)
  else (YiString, YiString) -> YiString
forall a b. (a, b) -> b
snd ((YiString, YiString) -> YiString)
-> (YiString -> (YiString, YiString)) -> YiString -> YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> YiString -> (YiString, YiString)
R.splitAt Int
s (YiString -> (YiString, YiString))
-> (YiString -> YiString) -> YiString -> (YiString, YiString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (YiString, YiString) -> YiString
forall a b. (a, b) -> a
fst ((YiString, YiString) -> YiString)
-> (YiString -> (YiString, YiString)) -> YiString -> YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> YiString -> (YiString, YiString)
R.splitAt Int
e (YiString -> YiString) -> BufferM YiString -> BufferM YiString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM YiString
elemsB

-- | Read the character at the current point
readB :: BufferM Char
readB :: BufferM Char
readB = BufferM Point
pointB BufferM Point -> (Point -> BufferM Char) -> BufferM Char
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Point -> BufferM Char
readAtB

-- | Read the character at the given index
-- This is an unsafe operation: character NUL is returned when out of bounds
readAtB :: Point -> BufferM Char
readAtB :: Point -> BufferM Char
readAtB Point
i = YiString -> Maybe Char
R.head (YiString -> Maybe Char)
-> BufferM YiString -> BufferM (Maybe Char)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Point -> BufferM YiString
nelemsB Int
1 Point
i BufferM (Maybe Char)
-> (Maybe Char -> BufferM Char) -> BufferM Char
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Char -> BufferM Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> BufferM Char)
-> (Maybe Char -> Char) -> Maybe Char -> BufferM Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
  Maybe Char
Nothing -> Char
'\0'
  Just Char
c  -> Char
c

replaceCharB :: Char -> BufferM ()
replaceCharB :: Char -> BufferM ()
replaceCharB Char
c = do
    Char -> BufferM ()
writeB Char
c
    BufferM ()
leftB

replaceCharWithBelowB :: BufferM ()
replaceCharWithBelowB :: BufferM ()
replaceCharWithBelowB = Int -> BufferM ()
replaceCharWithVerticalOffset Int
1

replaceCharWithAboveB :: BufferM ()
replaceCharWithAboveB :: BufferM ()
replaceCharWithAboveB = Int -> BufferM ()
replaceCharWithVerticalOffset (-Int
1)

insertCharWithBelowB :: BufferM ()
insertCharWithBelowB :: BufferM ()
insertCharWithBelowB = BufferM () -> (Char -> BufferM ()) -> Maybe Char -> BufferM ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> BufferM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Char -> BufferM ()
insertB (Maybe Char -> BufferM ()) -> BufferM (Maybe Char) -> BufferM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BufferM (Maybe Char)
maybeCharBelowB

insertCharWithAboveB :: BufferM ()
insertCharWithAboveB :: BufferM ()
insertCharWithAboveB = BufferM () -> (Char -> BufferM ()) -> Maybe Char -> BufferM ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> BufferM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Char -> BufferM ()
insertB (Maybe Char -> BufferM ()) -> BufferM (Maybe Char) -> BufferM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BufferM (Maybe Char)
maybeCharAboveB

replaceCharWithVerticalOffset :: Int -> BufferM ()
replaceCharWithVerticalOffset :: Int -> BufferM ()
replaceCharWithVerticalOffset Int
offset =
    BufferM () -> (Char -> BufferM ()) -> Maybe Char -> BufferM ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> BufferM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Char -> BufferM ()
replaceCharB (Maybe Char -> BufferM ()) -> BufferM (Maybe Char) -> BufferM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> BufferM (Maybe Char)
maybeCharWithVerticalOffset Int
offset

maybeCharBelowB :: BufferM (Maybe Char)
maybeCharBelowB :: BufferM (Maybe Char)
maybeCharBelowB = Int -> BufferM (Maybe Char)
maybeCharWithVerticalOffset Int
1

maybeCharAboveB :: BufferM (Maybe Char)
maybeCharAboveB :: BufferM (Maybe Char)
maybeCharAboveB = Int -> BufferM (Maybe Char)
maybeCharWithVerticalOffset (-Int
1)

maybeCharWithVerticalOffset :: Int -> BufferM (Maybe Char)
maybeCharWithVerticalOffset :: Int -> BufferM (Maybe Char)
maybeCharWithVerticalOffset Int
offset = BufferM (Maybe Char) -> BufferM (Maybe Char)
forall a. BufferM a -> BufferM a
savingPointB (BufferM (Maybe Char) -> BufferM (Maybe Char))
-> BufferM (Maybe Char) -> BufferM (Maybe Char)
forall a b. (a -> b) -> a -> b
$ do
    Int
l0 <- BufferM Int
curLn
    Int
c0 <- BufferM Int
curCol
    BufferM Int -> BufferM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (BufferM Int -> BufferM ()) -> BufferM Int -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Int -> BufferM Int
lineMoveRel Int
offset
    Int
l1 <- BufferM Int
curLn
    Int
c1 <- BufferM Int
curCol
    Char
curChar <- BufferM Char
readB
    Maybe Char -> BufferM (Maybe Char)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Char -> BufferM (Maybe Char))
-> Maybe Char -> BufferM (Maybe Char)
forall a b. (a -> b) -> a -> b
$ if Int
c0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
c1
                Bool -> Bool -> Bool
&& Int
l0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
l1
                Bool -> Bool -> Bool
&& Char
curChar Char -> FilePath -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (FilePath
"\n\0" :: String)
             then Char -> Maybe Char
forall a. a -> Maybe a
Just Char
curChar
             else Maybe Char
forall a. Maybe a
Nothing

-- | Delete @n@ characters forward from the current point
deleteN :: Int -> BufferM ()
deleteN :: Int -> BufferM ()
deleteN Int
n = BufferM Point
pointB BufferM Point -> (Point -> BufferM ()) -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction -> Int -> Point -> BufferM ()
deleteNAt Direction
Forward Int
n

------------------------------------------------------------------------

-- | Gives the 'IndentSettings' for the current buffer.
indentSettingsB :: BufferM IndentSettings
indentSettingsB :: BufferM IndentSettings
indentSettingsB = (forall syntax. Mode syntax -> BufferM IndentSettings)
-> BufferM IndentSettings
forall a. (forall syntax. Mode syntax -> BufferM a) -> BufferM a
withModeB ((forall syntax. Mode syntax -> BufferM IndentSettings)
 -> BufferM IndentSettings)
-> (forall syntax. Mode syntax -> BufferM IndentSettings)
-> BufferM IndentSettings
forall a b. (a -> b) -> a -> b
$ IndentSettings -> BufferM IndentSettings
forall (m :: * -> *) a. Monad m => a -> m a
return (IndentSettings -> BufferM IndentSettings)
-> (Mode syntax -> IndentSettings)
-> Mode syntax
-> BufferM IndentSettings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mode syntax -> IndentSettings
forall syntax. Mode syntax -> IndentSettings
modeIndentSettings

-- | Current column.
-- Note that this is different from offset or number of chars from sol.
-- (This takes into account tabs, unicode chars, etc.)
curCol :: BufferM Int
curCol :: BufferM Int
curCol = Point -> BufferM Int
colOf (Point -> BufferM Int) -> BufferM Point -> BufferM Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BufferM Point
pointB

-- | Current column, visually.
curVisCol :: BufferM Int
curVisCol :: BufferM Int
curVisCol = Int -> Int -> Int
forall a. Integral a => a -> a -> a
rem (Int -> Int -> Int) -> BufferM Int -> BufferM (Int -> Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM Int
curCol BufferM (Int -> Int) -> BufferM Int -> BufferM Int
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Window -> Int
width (Window -> Int) -> BufferM Window -> BufferM Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting Window FBuffer Window -> BufferM Window
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Window FBuffer Window
forall c. HasAttributes c => Lens' c Window
lastActiveWindowA)

colOf :: Point -> BufferM Int
colOf :: Point -> BufferM Int
colOf Point
p = do
  IndentSettings
is <- BufferM IndentSettings
indentSettingsB
  (Int -> Char -> Int) -> Int -> YiString -> Int
forall a. (a -> Char -> a) -> a -> YiString -> a
R.foldl' (IndentSettings -> Int -> Char -> Int
colMove IndentSettings
is) Int
0 (YiString -> Int) -> BufferM YiString -> BufferM Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall syntax. BufferImpl syntax -> YiString) -> BufferM YiString
forall x. (forall syntax. BufferImpl syntax -> x) -> BufferM x
queryBuffer (Point -> BufferImpl syntax -> YiString
forall syntax. Point -> BufferImpl syntax -> YiString
charsFromSolBI Point
p)

lineOf :: Point -> BufferM Int
lineOf :: Point -> BufferM Int
lineOf Point
p = (forall syntax. BufferImpl syntax -> Int) -> BufferM Int
forall x. (forall syntax. BufferImpl syntax -> x) -> BufferM x
queryBuffer ((forall syntax. BufferImpl syntax -> Int) -> BufferM Int)
-> (forall syntax. BufferImpl syntax -> Int) -> BufferM Int
forall a b. (a -> b) -> a -> b
$ Point -> BufferImpl syntax -> Int
forall syntax. Point -> BufferImpl syntax -> Int
lineAt Point
p

lineCountB :: BufferM Int
lineCountB :: BufferM Int
lineCountB = Point -> BufferM Int
lineOf (Point -> BufferM Int) -> BufferM Point -> BufferM Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BufferM Point
sizeB

-- | Decides which column we should be on after the given character.
colMove :: IndentSettings -> Int -> Char -> Int
colMove :: IndentSettings -> Int -> Char -> Int
colMove IndentSettings
is Int
col Char
'\t' | IndentSettings -> Int
tabSize IndentSettings
is Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 = Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ IndentSettings -> Int
tabSize IndentSettings
is
colMove IndentSettings
_  Int
col Char
_    = Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

-- | Returns start of line point for a given point @p@
solPointB :: Point -> BufferM Point
solPointB :: Point -> BufferM Point
solPointB Point
p = (forall syntax. BufferImpl syntax -> Point) -> BufferM Point
forall x. (forall syntax. BufferImpl syntax -> x) -> BufferM x
queryBuffer ((forall syntax. BufferImpl syntax -> Point) -> BufferM Point)
-> (forall syntax. BufferImpl syntax -> Point) -> BufferM Point
forall a b. (a -> b) -> a -> b
$ Point -> BufferImpl syntax -> Point
forall syntax. Point -> BufferImpl syntax -> Point
solPoint' Point
p

-- | Returns end of line for given point.
eolPointB :: Point -> BufferM Point
eolPointB :: Point -> BufferM Point
eolPointB Point
p = (forall syntax. BufferImpl syntax -> Point) -> BufferM Point
forall x. (forall syntax. BufferImpl syntax -> x) -> BufferM x
queryBuffer ((forall syntax. BufferImpl syntax -> Point) -> BufferM Point)
-> (forall syntax. BufferImpl syntax -> Point) -> BufferM Point
forall a b. (a -> b) -> a -> b
$ Point -> BufferImpl syntax -> Point
forall syntax. Point -> BufferImpl syntax -> Point
eolPoint' Point
p

-- | Go to line indexed from current point
-- Returns the actual moved difference which of course
-- may be negative if the requested difference was negative.
gotoLnFrom :: Int -> BufferM Int
gotoLnFrom :: Int -> BufferM Int
gotoLnFrom Int
x = do
    Int
l <- BufferM Int
curLn
    Point
p' <- (forall syntax. BufferImpl syntax -> Point) -> BufferM Point
forall x. (forall syntax. BufferImpl syntax -> x) -> BufferM x
queryBuffer ((forall syntax. BufferImpl syntax -> Point) -> BufferM Point)
-> (forall syntax. BufferImpl syntax -> Point) -> BufferM Point
forall a b. (a -> b) -> a -> b
$ Int -> BufferImpl syntax -> Point
forall syntax. Int -> BufferImpl syntax -> Point
solPoint (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x)
    Point -> BufferM ()
moveTo Point
p'
    Int
l' <- BufferM Int
curLn
    Int -> BufferM Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
l' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l)

-- | Access to a value into the extensible state, keyed by its type.
--   This allows you to retrieve inside a 'BufferM' monad, ie:
--
-- > value <- getBufferDyn
getBufferDyn :: forall m a. (Default a, YiVariable a, MonadState FBuffer m, Functor m) => m a
getBufferDyn :: m a
getBufferDyn = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe (a
forall a. Default a => a
def :: a) (Maybe a -> a) -> m (Maybe a) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m DynamicState -> (DynamicState -> m ()) -> m (Maybe a)
forall (m :: * -> *) a.
(Typeable a, Binary a, Monad m) =>
m DynamicState -> (DynamicState -> m ()) -> m (Maybe a)
getDyn (Getting DynamicState FBuffer DynamicState -> m DynamicState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting DynamicState FBuffer DynamicState
forall c. HasAttributes c => Lens' c DynamicState
bufferDynamicA) ((DynamicState -> Identity DynamicState)
-> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c DynamicState
bufferDynamicA ((DynamicState -> Identity DynamicState)
 -> FBuffer -> Identity FBuffer)
-> DynamicState -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.=)

-- | Access to a value into the extensible state, keyed by its type.
--   This allows you to save inside a 'BufferM' monad, ie:
--
-- > putBufferDyn updatedvalue
putBufferDyn :: (YiVariable a, MonadState FBuffer m, Functor m) => a -> m ()
putBufferDyn :: a -> m ()
putBufferDyn = m DynamicState -> (DynamicState -> m ()) -> a -> m ()
forall (m :: * -> *) a.
(Typeable a, Binary a, Monad m) =>
m DynamicState -> (DynamicState -> m ()) -> a -> m ()
putDyn (Getting DynamicState FBuffer DynamicState -> m DynamicState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting DynamicState FBuffer DynamicState
forall c. HasAttributes c => Lens' c DynamicState
bufferDynamicA) ((DynamicState -> Identity DynamicState)
-> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c DynamicState
bufferDynamicA ((DynamicState -> Identity DynamicState)
 -> FBuffer -> Identity FBuffer)
-> DynamicState -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.=)

-- | perform a @BufferM a@, and return to the current point. (by using a mark)
savingExcursionB :: BufferM a -> BufferM a
savingExcursionB :: BufferM a -> BufferM a
savingExcursionB BufferM a
f = do
    Mark
m <- Maybe FilePath -> BufferM Mark
getMarkB Maybe FilePath
forall a. Maybe a
Nothing
    a
res <- BufferM a
f
    Point -> BufferM ()
moveTo (Point -> BufferM ()) -> BufferM Point -> BufferM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Getting Point FBuffer Point -> BufferM Point
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Mark -> Lens' FBuffer Point
markPointA Mark
m)
    a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res

markPointA :: Mark -> Lens' FBuffer Point
markPointA :: Mark -> Lens' FBuffer Point
markPointA Mark
mark = (FBuffer -> Point)
-> (FBuffer -> Point -> FBuffer) -> Lens' FBuffer Point
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens FBuffer -> Point
getter FBuffer -> Point -> FBuffer
setter where
  getter :: FBuffer -> Point
getter FBuffer
b = MarkValue -> Point
markPoint (MarkValue -> Point) -> MarkValue -> Point
forall a b. (a -> b) -> a -> b
$ Mark -> FBuffer -> MarkValue
getMarkValueRaw Mark
mark FBuffer
b
  setter :: FBuffer -> Point -> FBuffer
setter FBuffer
b Point
pos = Mark -> (MarkValue -> MarkValue) -> FBuffer -> FBuffer
modifyMarkRaw Mark
mark (\MarkValue
v -> MarkValue
v {markPoint :: Point
markPoint = Point
pos}) FBuffer
b

-- | Perform an @BufferM a@, and return to the current point.
savingPointB :: BufferM a -> BufferM a
savingPointB :: BufferM a -> BufferM a
savingPointB BufferM a
f = BufferM a -> BufferM a
forall a. BufferM a -> BufferM a
savingPrefCol (BufferM a -> BufferM a) -> BufferM a -> BufferM a
forall a b. (a -> b) -> a -> b
$ do
  Point
p <- BufferM Point
pointB
  a
res <- BufferM a
f
  Point -> BufferM ()
moveTo Point
p
  a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res

-- | Perform an @BufferM a@, and return to the current line and column
-- number. The difference between this and 'savingPointB' is that here
-- we attempt to return to the specific line and column number, rather
-- than a specific number of characters from the beginning of the
-- buffer.
--
-- In case the column is further away than EOL, the point is left at
-- EOL: 'moveToLineColB' is used internally.
savingPositionB :: BufferM a -> BufferM a
savingPositionB :: BufferM a -> BufferM a
savingPositionB BufferM a
f = BufferM a -> BufferM a
forall a. BufferM a -> BufferM a
savingPrefCol (BufferM a -> BufferM a) -> BufferM a -> BufferM a
forall a b. (a -> b) -> a -> b
$ do
  (Int
c, Int
l) <- (,) (Int -> Int -> (Int, Int))
-> BufferM Int -> BufferM (Int -> (Int, Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM Int
curCol BufferM (Int -> (Int, Int)) -> BufferM Int -> BufferM (Int, Int)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BufferM Int
curLn
  a
res <- BufferM a
f
  Int -> Int -> BufferM ()
moveToLineColB Int
l Int
c
  a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res

pointAt :: BufferM a -> BufferM Point
pointAt :: BufferM a -> BufferM Point
pointAt BufferM a
f = BufferM Point -> BufferM Point
forall a. BufferM a -> BufferM a
savingPointB (BufferM a
f BufferM a -> BufferM Point -> BufferM Point
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> BufferM Point
pointB)

pointAfterCursorB :: Point -> BufferM Point
pointAfterCursorB :: Point -> BufferM Point
pointAfterCursorB Point
p = BufferM () -> BufferM Point
forall a. BufferM a -> BufferM Point
pointAt (BufferM () -> BufferM Point) -> BufferM () -> BufferM Point
forall a b. (a -> b) -> a -> b
$ do
  Point -> BufferM ()
moveTo Point
p
  BufferM ()
rightB

-- | What would be the point after doing the given action?
-- The argument must not modify the buffer.
destinationOfMoveB :: BufferM a -> BufferM Point
destinationOfMoveB :: BufferM a -> BufferM Point
destinationOfMoveB BufferM a
f = BufferM Point -> BufferM Point
forall a. BufferM a -> BufferM a
savingPointB (BufferM a
f BufferM a -> BufferM Point -> BufferM Point
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferM Point
pointB)

-------------
-- Window

askWindow :: (Window -> a) -> BufferM a
askWindow :: (Window -> a) -> BufferM a
askWindow = (Window -> a) -> BufferM a
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks

withEveryLineB :: BufferM () -> BufferM ()
withEveryLineB :: BufferM () -> BufferM ()
withEveryLineB BufferM ()
action = BufferM () -> BufferM ()
forall a. BufferM a -> BufferM a
savingPointB (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$ do
  Int
lineCount <- BufferM Int
lineCountB
  [Int] -> (Int -> BufferM ()) -> BufferM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
1 .. Int
lineCount] ((Int -> BufferM ()) -> BufferM ())
-> (Int -> BufferM ()) -> BufferM ()
forall a b. (a -> b) -> a -> b
$ \Int
l -> do
    BufferM Int -> BufferM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (BufferM Int -> BufferM ()) -> BufferM Int -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Int -> BufferM Int
gotoLn Int
l
    BufferM ()
action

makeLensesWithSuffix "A" ''IndentSettings
makeLensesWithSuffix "A" ''Mode