module Yi.Editor ( Editor(..), EditorM(..), MonadEditor(..)
, runEditor
, acceptedInputsOtherWindow
, addJumpAtE
, addJumpHereE
, alternateBufferE
, askConfigVariableA
, bufferSet
, buffersA
, closeBufferAndWindowE
, closeBufferE
, closeOtherE
, clrStatus
, commonNamePrefix
, currentBuffer
, currentRegexA
, currentWindowA
, deleteBuffer
, deleteTabE
, emptyEditor
, findBuffer
, findBufferWith
, findBufferWithName
, findWindowWith
, focusWindowE
, getBufferStack
, getBufferWithName
, getBufferWithNameOrCurrent
, getEditorDyn
, getRegE
, jumpBackE
, jumpForwardE
, killringA
, layoutManagerNextVariantE
, layoutManagerPreviousVariantE
, layoutManagersNextE
, layoutManagersPreviousE
, moveTabE
, moveWinNextE
, moveWinPrevE
, newBufferE
, newEmptyBufferE
, newTabE
, newTempBufferE
, newWindowE
, nextTabE
, nextWinE
, pendingEventsA
, prevWinE
, previousTabE
, printMsg
, printMsgs
, printStatus
, pushWinToFirstE
, putEditorDyn
, searchDirectionA
, setDividerPosE
, setRegE
, setStatus
, shiftOtherWindow
, splitE
, statusLine
, statusLineInfo
, statusLinesA
, stringToNewBuffer
, swapWinWithFirstE
, switchToBufferE
, switchToBufferWithNameE
, tabsA
, tryCloseE
, windows
, windowsA
, windowsOnBufferE
, withCurrentBuffer
, withEveryBuffer
, withGivenBuffer
, withGivenBufferAndWindow
, withOtherWindow
, withWindowE
) where
import Control.Applicative
import Control.Lens
import Control.Monad
import Control.Monad.Reader hiding (mapM, forM_ )
import Control.Monad.State hiding (get, put, mapM, forM_)
import Data.Binary
import Data.Default
import qualified Data.DelayList as DelayList
import Data.DynamicState.Serializable
import Data.Foldable hiding (forM_)
import Data.List (delete, (\\))
import Data.List.NonEmpty (fromList, NonEmpty(..), nub)
import qualified Data.List.NonEmpty as NE
import qualified Data.List.PointedList as PL (atEnd, moveTo)
import qualified Data.List.PointedList.Circular as PL
import qualified Data.Map as M
import Data.Maybe
import qualified Data.Monoid as Mon
import Data.Semigroup
import qualified Data.Text as T
import Prelude hiding (foldl,concatMap,foldr,all)
import System.FilePath (splitPath)
import Yi.Buffer
import Yi.Config
import Yi.Interact as I
import Yi.JumpList
import Yi.KillRing
import Yi.Layout
import Yi.Monad
import Yi.Rope (YiString, fromText, empty)
import qualified Yi.Rope as R
import Yi.String
import Yi.Style (defaultStyle)
import Yi.Tab
import Yi.Types
import Yi.Utils hiding ((+~))
import Yi.Window
instance Binary Editor where
put (Editor bss bs supply ts dv _sl msh kr regex _dir _ev _cwa ) =
let putNE (x :| xs) = put x >> put xs
in putNE bss >> put bs >> put supply >> put ts
>> put dv >> put msh >> put kr >> put regex
get = do
bss <- (:|) <$> get <*> get
bs <- get
supply <- get
ts <- get
dv <- get
msh <- get
kr <- get
regex <- get
return $ emptyEditor { bufferStack = bss
, buffers = bs
, refSupply = supply
, tabs_ = ts
, dynamic = dv
, maxStatusHeight = msh
, killring = kr
, currentRegex = regex
}
emptyEditor :: Editor
emptyEditor = Editor
{ buffers = M.singleton (bkey buf) buf
, tabs_ = PL.singleton tab
, bufferStack = bkey buf :| []
, refSupply = 3
, currentRegex = Nothing
, searchDirection = Forward
, dynamic = mempty
, statusLines = DelayList.insert (maxBound, ([""], defaultStyle)) []
, killring = krEmpty
, pendingEvents = []
, maxStatusHeight = 1
, onCloseActions = M.empty
}
where buf = newB 0 (MemBuffer "console") mempty
win = (dummyWindow (bkey buf)) { wkey = WindowRef 1 , isMini = False }
tab = makeTab1 2 win
makeLensesWithSuffix "A" ''Editor
windows :: Editor -> PL.PointedList Window
windows e = e ^. windowsA
windowsA :: Lens' Editor (PL.PointedList Window)
windowsA = currentTabA . tabWindowsA
tabsA :: Lens' Editor (PL.PointedList Tab)
tabsA = fixCurrentBufferA_ . tabs_A
currentTabA :: Lens' Editor Tab
currentTabA = tabsA . PL.focus
askConfigVariableA :: (YiConfigVariable b, MonadEditor m) => m b
askConfigVariableA = do cfg <- askCfg
return $ cfg ^. configVariable
newRef :: MonadEditor m => m Int
newRef = withEditor (refSupplyA %= (+ 1) >> use refSupplyA)
newBufRef :: MonadEditor m => m BufferRef
newBufRef = liftM BufferRef newRef
stringToNewBuffer :: MonadEditor m
=> BufferId
-> YiString
-> m BufferRef
stringToNewBuffer nm cs = withEditor $ do
u <- newBufRef
defRegStyle <- configRegionStyle <$> askCfg
insertBuffer $ newB u nm cs
m <- asks configFundamentalMode
withGivenBuffer u $ do
putRegionStyle defRegStyle
setAnyMode m
return u
insertBuffer :: MonadEditor m => FBuffer -> m ()
insertBuffer b = withEditor . modify $ \e ->
e { bufferStack = nub (bufferStack e <> (bkey b :| []))
, buffers = M.insert (bkey b) b (buffers e)}
forceFold1 :: Foldable t => t a -> t a
forceFold1 x = foldr seq x x
forceFoldTabs :: Foldable t => t Tab -> t Tab
forceFoldTabs x = foldr (seq . forceTab) x x
deleteBuffer :: MonadEditor m => BufferRef -> m ()
deleteBuffer k = withEditor $ do
gets bufferStack >>= \case
_ :| [] -> return ()
_ -> M.lookup k <$> gets onCloseActions
>>= \m_action -> fromMaybe (return ()) m_action
bs <- gets bufferStack
ws <- use windowsA
case bs of
b0 :| nextB : _ -> do
let pickOther w = if bufkey w == k then w {bufkey = other} else w
visibleBuffers = bufkey <$> toList ws
bs' = NE.toList bs
other = head $ (bs' \\ visibleBuffers) ++ delete k bs'
when (b0 == k) $
switchToBufferE nextB
modify $ \e ->
e & bufferStackA %~ fromList . forceFold1 . NE.filter (k /=)
& buffersA %~ M.delete k
& tabs_A %~ forceFoldTabs . fmap (mapWindows pickOther)
windowsA . mapped . bufAccessListA %= forceFold1 . filter (k /=)
_ -> return ()
bufferSet :: Editor -> [FBuffer]
bufferSet = M.elems . buffers
commonNamePrefix :: Editor -> [FilePath]
commonNamePrefix = commonPrefix . fmap (dropLast . splitPath)
. fbufs . fmap (^. identA) . bufferSet
where dropLast [] = []
dropLast x = init x
fbufs xs = [ x | FileBuffer x <- xs ]
getBufferStack :: MonadEditor m => m (NonEmpty FBuffer)
getBufferStack = withEditor $ do
bufMap <- gets buffers
gets $ fmap (bufMap M.!) . bufferStack
findBuffer :: MonadEditor m => BufferRef -> m (Maybe FBuffer)
findBuffer k = withEditor (gets (M.lookup k . buffers))
findBufferWith :: BufferRef -> Editor -> FBuffer
findBufferWith k e = case M.lookup k (buffers e) of
Just x -> x
Nothing -> error "Editor.findBufferWith: no buffer has this key"
findBufferWithName :: T.Text -> Editor -> [BufferRef]
findBufferWithName n e =
let bufs = M.elems $ buffers e
sameIdent b = shortIdentString (length $ commonNamePrefix e) b == n
in map bkey $ filter sameIdent bufs
getBufferWithName :: MonadEditor m => T.Text -> m BufferRef
getBufferWithName bufName = withEditor $ do
bs <- gets $ findBufferWithName bufName
case bs of
[] -> fail ("Buffer not found: " ++ T.unpack bufName)
b:_ -> return b
openAllBuffersE :: EditorM ()
openAllBuffersE = do
bs <- gets bufferSet
forM_ bs $ ((%=) windowsA . PL.insertRight =<<) . newWindowE False . bkey
withGivenBuffer :: MonadEditor m => BufferRef -> BufferM a -> m a
withGivenBuffer k f = do
b <- gets (findBufferWith k)
withGivenBufferAndWindow (b ^. lastActiveWindowA) k f
withGivenBufferAndWindow :: MonadEditor m
=> Window -> BufferRef -> BufferM a -> m a
withGivenBufferAndWindow w k f = withEditor $ do
accum <- asks configKillringAccumulate
let edit e = let b = findBufferWith k e
(v, us, b') = runBufferFull w b f
in (e & buffersA .~ mapAdjust' (const b') k (buffers e)
& killringA %~
if accum && all updateIsDelete us
then foldl (.) id $ reverse [ krPut dir s
| Delete _ dir s <- us ]
else id
, (us, v))
(us, v) <- getsAndModify edit
updHandler <- return . bufferUpdateHandler =<< ask
unless (null us || null updHandler) $
forM_ updHandler (\h -> withGivenBufferAndWindow w k (h us))
return v
withCurrentBuffer :: MonadEditor m => BufferM a -> m a
withCurrentBuffer f = withEditor $ do
w <- use currentWindowA
withGivenBufferAndWindow w (bufkey w) f
withEveryBuffer :: MonadEditor m => BufferM a -> m [a]
withEveryBuffer action =
withEditor (gets bufferStack) >>= mapM (`withGivenBuffer` action) . NE.toList
currentWindowA :: Lens' Editor Window
currentWindowA = windowsA . PL.focus
currentBuffer :: Editor -> BufferRef
currentBuffer = NE.head . bufferStack
printMsg :: MonadEditor m => T.Text -> m ()
printMsg s = printStatus ([s], defaultStyle)
printMsgs :: MonadEditor m => [T.Text] -> m ()
printMsgs s = printStatus (s, defaultStyle)
printStatus :: MonadEditor m => Status -> m ()
printStatus = setTmpStatus 1
setStatus :: MonadEditor m => Status -> m ()
setStatus = setTmpStatus maxBound
clrStatus :: EditorM ()
clrStatus = setStatus ([""], defaultStyle)
statusLine :: Editor -> [T.Text]
statusLine = fst . statusLineInfo
statusLineInfo :: Editor -> Status
statusLineInfo = snd . head . statusLines
setTmpStatus :: MonadEditor m => Int -> Status -> m ()
setTmpStatus delay s = withEditor $ do
statusLinesA %= DelayList.insert (delay, s)
bs <- gets (filter ((== MemBuffer "messages") . view identA) . M.elems . buffers)
b <- case bs of
(b':_) -> return $ bkey b'
[] -> stringToNewBuffer (MemBuffer "messages") mempty
let m = listify $ R.fromText <$> fst s
withGivenBuffer b $ botB >> insertN (m `R.snoc` '\n')
setRegE :: R.YiString -> EditorM ()
setRegE s = killringA %= krSet s
getRegE :: EditorM R.YiString
getRegE = uses killringA krGet
getEditorDyn :: (MonadEditor m, YiVariable a, Default a, Functor m) => m a
getEditorDyn = fromMaybe def <$> getDyn (use dynamicA) (assign dynamicA)
putEditorDyn :: (MonadEditor m, YiVariable a, Functor m) => a -> m ()
putEditorDyn = putDyn (use dynamicA) (assign dynamicA)
newBufferE :: BufferId
-> YiString
-> EditorM BufferRef
newBufferE f s = do
b <- stringToNewBuffer f s
switchToBufferE b
return b
newEmptyBufferE :: BufferId -> EditorM BufferRef
newEmptyBufferE f = newBufferE f Yi.Rope.empty
alternateBufferE :: Int -> EditorM ()
alternateBufferE n = do
Window { bufAccessList = lst } <- use currentWindowA
if null lst || (length lst 1) < n
then fail "no alternate buffer"
else switchToBufferE $ lst!!n
newZeroSizeWindow :: Bool -> BufferRef -> WindowRef -> Window
newZeroSizeWindow mini bk ref = Window mini bk [] 0 0 emptyRegion ref 0 Nothing
newWindowE :: Bool -> BufferRef -> EditorM Window
newWindowE mini bk = newZeroSizeWindow mini bk . WindowRef <$> newRef
switchToBufferE :: BufferRef -> EditorM ()
switchToBufferE bk = windowsA . PL.focus %= \w ->
w & bufkeyA .~ bk
& bufAccessListA %~ forceFold1 . (bufkey w:) . filter (bk /=)
switchToBufferOtherWindowE :: BufferRef -> EditorM ()
switchToBufferOtherWindowE b = shiftOtherWindow >> switchToBufferE b
switchToBufferWithNameE :: T.Text -> EditorM ()
switchToBufferWithNameE "" = alternateBufferE 0
switchToBufferWithNameE bufName = switchToBufferE =<< getBufferWithName bufName
closeBufferE :: T.Text -> EditorM ()
closeBufferE nm = deleteBuffer =<< getBufferWithNameOrCurrent nm
getBufferWithNameOrCurrent :: MonadEditor m => T.Text -> m BufferRef
getBufferWithNameOrCurrent t = withEditor $
case T.null t of
True -> gets currentBuffer
False -> getBufferWithName t
closeBufferAndWindowE :: EditorM ()
closeBufferAndWindowE = do
b <- gets currentBuffer
tryCloseE
deleteBuffer b
nextWinE :: EditorM ()
nextWinE = windowsA %= PL.next
prevWinE :: EditorM ()
prevWinE = windowsA %= PL.previous
swapWinWithFirstE :: EditorM ()
swapWinWithFirstE = windowsA %= swapFocus (fromJust . PL.moveTo 0)
pushWinToFirstE :: EditorM ()
pushWinToFirstE = windowsA %= pushToFirst
where
pushToFirst ws = case PL.delete ws of
Nothing -> ws
Just ws' -> PL.insertLeft (ws ^. PL.focus) (fromJust $ PL.moveTo 0 ws')
moveWinNextE :: EditorM ()
moveWinNextE = windowsA %= swapFocus PL.next
moveWinPrevE :: EditorM ()
moveWinPrevE = windowsA %= swapFocus PL.previous
fixCurrentBufferA_ :: Lens' Editor Editor
fixCurrentBufferA_ = lens id (\_old new -> let
ws = windows new
b = findBufferWith (bufkey $ PL._focus ws) new
newBufferStack = nub (bkey b NE.<| bufferStack new)
in NE.length newBufferStack `seq` new & bufferStackA .~ newBufferStack)
fixCurrentWindowE :: EditorM ()
fixCurrentWindowE =
gets currentBuffer >>= \b -> windowsA . PL.focus . bufkeyA .= b
withWindowE :: Window -> BufferM a -> EditorM a
withWindowE w = withGivenBufferAndWindow w (bufkey w)
findWindowWith :: WindowRef -> Editor -> Window
findWindowWith k e =
head $ concatMap (\win -> [win | wkey win == k]) $ windows e
windowsOnBufferE :: BufferRef -> EditorM [Window]
windowsOnBufferE k = do
ts <- use tabsA
let tabBufEq = concatMap (\win -> [win | bufkey win == k]) . (^. tabWindowsA)
return $ concatMap tabBufEq ts
focusWindowE :: WindowRef -> EditorM ()
focusWindowE k = do
ts <- use tabsA
let check (False, i) win = if wkey win == k
then (True, i)
else (False, i + 1)
check r@(True, _) _win = r
searchWindowSet (False, tabIndex, _) ws =
case foldl check (False, 0) (ws ^. tabWindowsA) of
(True, winIndex) -> (True, tabIndex, winIndex)
(False, _) -> (False, tabIndex + 1, 0)
searchWindowSet r@(True, _, _) _ws = r
case foldl searchWindowSet (False, 0, 0) ts of
(False, _, _) -> fail $ "No window with key " ++ show wkey ++ "found. (focusWindowE)"
(True, tabIndex, winIndex) -> do
assign tabsA (fromJust $ PL.moveTo tabIndex ts)
windowsA %= fromJust . PL.moveTo winIndex
splitE :: EditorM ()
splitE = do
w <- gets currentBuffer >>= newWindowE False
windowsA %= PL.insertRight w
layoutManagersNextE :: EditorM ()
layoutManagersNextE = withLMStackE PL.next
layoutManagersPreviousE :: EditorM ()
layoutManagersPreviousE = withLMStackE PL.previous
withLMStackE :: (PL.PointedList AnyLayoutManager
-> PL.PointedList AnyLayoutManager)
-> EditorM ()
withLMStackE f = askCfg >>= \cfg ->
currentTabA . tabLayoutManagerA %= go (layoutManagers cfg)
where
go [] lm = lm
go lms lm =
case findPL (layoutManagerSameType lm) lms of
Nothing -> head lms
Just lmsPL -> f lmsPL ^. PL.focus
layoutManagerNextVariantE :: EditorM ()
layoutManagerNextVariantE = currentTabA . tabLayoutManagerA %= nextVariant
layoutManagerPreviousVariantE :: EditorM ()
layoutManagerPreviousVariantE =
currentTabA . tabLayoutManagerA %= previousVariant
setDividerPosE :: DividerRef -> DividerPosition -> EditorM ()
setDividerPosE ref = assign (currentTabA . tabDividerPositionA ref)
newTabE :: EditorM ()
newTabE = do
bk <- gets currentBuffer
win <- newWindowE False bk
ref <- newRef
tabsA %= PL.insertRight (makeTab1 ref win)
nextTabE :: EditorM ()
nextTabE = tabsA %= PL.next
previousTabE :: EditorM ()
previousTabE = tabsA %= PL.previous
moveTabE :: Maybe Int -> EditorM ()
moveTabE Nothing = do
count <- uses tabsA PL.length
tabsA %= fromJust . PL.moveTo (pred count)
moveTabE (Just n) = do
newTabs <- uses tabsA (PL.moveTo n)
when (isNothing newTabs) failure
assign tabsA $ fromJust newTabs
where failure = fail $ "moveTab " ++ show n ++ ": no such tab"
deleteTabE :: EditorM ()
deleteTabE = tabsA %= fromMaybe failure . deleteTab
where failure = error "deleteTab: cannot delete sole tab"
deleteTab tabs = if PL.atEnd tabs
then PL.deleteLeft tabs
else PL.deleteRight tabs
tryCloseE :: EditorM ()
tryCloseE = do
ntabs <- uses tabsA PL.length
nwins <- uses windowsA PL.length
unless (ntabs == 1 && nwins == 1) $ if nwins == 1
then tabsA %= fromJust . PL.deleteLeft
else windowsA %= fromJust . PL.deleteLeft
closeOtherE :: EditorM ()
closeOtherE = windowsA %= PL.deleteOthers
shiftOtherWindow :: MonadEditor m => m ()
shiftOtherWindow = withEditor $ do
len <- uses windowsA PL.length
if len == 1
then splitE
else nextWinE
withOtherWindow :: MonadEditor m => m a -> m a
withOtherWindow f = do
shiftOtherWindow
x <- f
withEditor prevWinE
return x
acceptedInputs :: EditorM [T.Text]
acceptedInputs = do
km <- defaultKm <$> askCfg
keymap <- withCurrentBuffer $ gets (withMode0 modeKeymap)
let l = I.accepted 3 . I.mkAutomaton . extractTopKeymap . keymap $ km
return $ fmap T.unwords l
acceptedInputsOtherWindow :: EditorM ()
acceptedInputsOtherWindow = do
ai <- acceptedInputs
b <- stringToNewBuffer (MemBuffer "keybindings") (fromText $ T.unlines ai)
w <- newWindowE False b
windowsA %= PL.insertRight w
onCloseBufferE :: BufferRef -> EditorM () -> EditorM ()
onCloseBufferE b a =
onCloseActionsA %= M.insertWith' (\_ old_a -> old_a >> a) b a
addJumpHereE :: EditorM ()
addJumpHereE = addJumpAtE =<< withCurrentBuffer pointB
addJumpAtE :: Point -> EditorM ()
addJumpAtE point = do
w <- use currentWindowA
shouldAddJump <- case jumpList w of
Just (PL.PointedList _ (Jump mark bf) _) -> do
bfStillAlive <- gets (M.lookup bf . buffers)
case bfStillAlive of
Nothing -> return False
_ -> do
p <- withGivenBuffer bf . use $ markPointA mark
return $! (p, bf) /= (point, bufkey w)
_ -> return True
when shouldAddJump $ do
m <- withCurrentBuffer setMarkHereB
let bf = bufkey w
j = Jump m bf
assign currentWindowA $ w & jumpListA %~ addJump j
return ()
jumpBackE :: EditorM ()
jumpBackE = addJumpHereE >> modifyJumpListE jumpBack
jumpForwardE :: EditorM ()
jumpForwardE = modifyJumpListE jumpForward
modifyJumpListE :: (JumpList -> JumpList) -> EditorM ()
modifyJumpListE f = do
w <- use currentWindowA
case f $ w ^. jumpListA of
Nothing -> return ()
Just (PL.PointedList _ (Jump mark bf) _) -> do
switchToBufferE bf
withCurrentBuffer $ use (markPointA mark) >>= moveTo
currentWindowA . jumpListA %= f
newTempBufferE :: EditorM BufferRef
newTempBufferE = do
e <- gets id
let find_next currentName (nextName:otherNames) =
case findBufferWithName currentName e of
(_b : _) -> find_next nextName otherNames
[] -> currentName
find_next _ [] = error "Looks like nearly infinite list has just ended."
next_tmp_name = find_next name names
(name : names) = (fmap (("tmp-" Mon.<>) . T.pack . show) [0 :: Int ..])
newEmptyBufferE (MemBuffer next_tmp_name)