yi-0.11.0: src/library/Yi/Editor.hs
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_HADDOCK show-extensions #-}
-- |
-- Module : Yi.Editor
-- License : GPL-2
-- Maintainer : yi-devel@googlegroups.com
-- Stability : experimental
-- Portability : portable
--
-- The top level editor state, and operations on it. This is inside an
-- internal module for easy re-export with Yi.Types bits.
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 _re _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
get = do
bss <- (:|) <$> get <*> get
bs <- get
supply <- get
ts <- get
dv <- get
msh <- get
kr <- get
return $ emptyEditor { bufferStack = bss
, buffers = bs
, refSupply = supply
, tabs_ = ts
, dynamic = dv
, maxStatusHeight = msh
, killring = kr
}
-- | The initial state
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
-- ---------------------------------------------------------------------
-- Buffer operations
newRef :: MonadEditor m => m Int
newRef = withEditor (refSupplyA %= (+ 1) >> use refSupplyA)
newBufRef :: MonadEditor m => m BufferRef
newBufRef = liftM BufferRef newRef
-- | Create and fill a new buffer, using contents of string.
-- | Does not focus the window, or make it the current window.
-- | Call newWindowE or switchToBufferE to take care of that.
stringToNewBuffer :: MonadEditor m
=> BufferId -- ^ The buffer indentifier
-> YiString -- ^ The contents with which to populate
-- the buffer
-> 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 ->
-- insert buffers at the end, so that
-- "background" buffers do not interfere.
e { bufferStack = nub (bufferStack e <> (bkey b :| []))
, buffers = M.insert (bkey b) b (buffers e)}
-- Prevent possible space leaks in the editor structure
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
-- | Delete a buffer (and release resources associated with it).
deleteBuffer :: MonadEditor m => BufferRef -> m ()
deleteBuffer k = withEditor $ do
-- If the buffer has an associated close action execute that now.
-- Unless the buffer is the last buffer in the editor. In which case
-- it cannot be closed and, I think, the close action should not be
-- applied.
--
-- The close actions seem dangerous, but I know of no other simple
-- way to resolve issues related to what buffer receives actions
-- after the minibuffer closes.
gets bufferStack >>= \case
_ :| [] -> return ()
_ -> M.lookup k <$> gets onCloseActions
>>= \m_action -> fromMaybe (return ()) m_action
-- Now try deleting the buffer. Checking, once again, that it is not
-- the last buffer.
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
-- This ‘head’ always works because we witness that length of
-- bs ≥ 2 (through case) and ‘delete’ only deletes up to 1
-- element so we at worst we end up with something like
-- ‘head $ [] ++ [foo]’ when bs ≡ visibleBuffers
bs' = NE.toList bs
other = head $ (bs' \\ visibleBuffers) ++ delete k bs'
when (b0 == k) $
-- we delete the currently selected buffer: the next buffer
-- will become active in the main window, therefore it must be
-- assigned a new window.
switchToBufferE nextB
-- NOTE: This *only* works if not all bufferStack buffers are
-- equivalent to ‘k’. Assuring that there are no duplicates in
-- the bufferStack is equivalent in this case because of its
-- length.
modify $ \e ->
e & bufferStackA %~ fromList . forceFold1 . NE.filter (k /=)
& buffersA %~ M.delete k
& tabs_A %~ forceFoldTabs . fmap (mapWindows pickOther)
-- all windows open on that buffer must switch to another
-- buffer.
windowsA . mapped . bufAccessListA %= forceFold1 . filter (k /=)
_ -> return () -- Don't delete the last buffer.
-- | Return the buffers we have, /in no particular order/
bufferSet :: Editor -> [FBuffer]
bufferSet = M.elems . buffers
-- | Return a prefix that can be removed from all buffer paths while
-- keeping them unique.
commonNamePrefix :: Editor -> [FilePath]
commonNamePrefix = commonPrefix . fmap (dropLast . splitPath)
. fbufs . fmap (^. identA) . bufferSet
where dropLast [] = []
dropLast x = init x
fbufs xs = [ x | FileBuffer x <- xs ]
-- drop the last component, so that it is never hidden.
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))
-- | Find buffer with this key
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"
-- | Find buffers with this name
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
-- | Find buffer with given name. Fail if not found.
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
-- | Make all buffers visible by splitting the current window list.
-- FIXME: rename to displayAllBuffersE; make sure buffers are not open twice.
openAllBuffersE :: EditorM ()
openAllBuffersE = do
bs <- gets bufferSet
forM_ bs $ ((%=) windowsA . PL.insertRight =<<) . newWindowE False . bkey
------------------------------------------------------------------------
-- | Perform action with any given buffer, using the last window that
-- was used for that buffer.
withGivenBuffer :: MonadEditor m => BufferRef -> BufferM a -> m a
withGivenBuffer k f = do
b <- gets (findBufferWith k)
withGivenBufferAndWindow (b ^. lastActiveWindowA) k f
-- | Perform action with any given buffer
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
-- | Perform action with current window's buffer
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
-- | Return the current buffer
currentBuffer :: Editor -> BufferRef
currentBuffer = NE.head . bufferStack
-----------------------
-- Handling of status
-- | Prints a message with 'defaultStyle'.
printMsg :: MonadEditor m => T.Text -> m ()
printMsg s = printStatus ([s], defaultStyle)
-- | Prints a all given messages with 'defaultStyle'.
printMsgs :: MonadEditor m => [T.Text] -> m ()
printMsgs s = printStatus (s, defaultStyle)
printStatus :: MonadEditor m => Status -> m ()
printStatus = setTmpStatus 1
-- | Set the "background" status line
setStatus :: MonadEditor m => Status -> m ()
setStatus = setTmpStatus maxBound
-- | Clear the status line
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)
-- also show in the messages buffer, so we don't loose any message
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')
-- ---------------------------------------------------------------------
-- kill-register (vim-style) interface to killring.
--
-- Note that our vim keymap currently has its own registers
-- and doesn't use killring.
-- | Put string into yank register
setRegE :: R.YiString -> EditorM ()
setRegE s = killringA %= krSet s
-- | Return the contents of the yank register
getRegE :: EditorM R.YiString
getRegE = uses killringA krGet
-- ---------------------------------------------------------------------
-- | Dynamically-extensible state components.
--
-- These hooks are used by keymaps to store values that result from
-- Actions (i.e. that restult from IO), as opposed to the pure values
-- they generate themselves, and can be stored internally.
--
-- The `dynamic' field is a type-indexed map.
--
-- | Retrieve a value from the extensible state
getEditorDyn :: (MonadEditor m, YiVariable a, Default a, Functor m) => m a
getEditorDyn = fromMaybe def <$> getDyn (use dynamicA) (assign dynamicA)
-- | Insert a value into the extensible state, keyed by its type
putEditorDyn :: (MonadEditor m, YiVariable a, Functor m) => a -> m ()
putEditorDyn = putDyn (use dynamicA) (assign dynamicA)
-- | Like fnewE, create a new buffer filled with the String @s@,
-- Switch the current window to this buffer. Doesn't associate any
-- file with the buffer (unlike fnewE) and so is good for popup
-- internal buffers (like scratch)
newBufferE :: BufferId -- ^ buffer name
-> YiString -- ^ buffer contents
-> EditorM BufferRef
newBufferE f s = do
b <- stringToNewBuffer f s
switchToBufferE b
return b
-- | Like 'newBufferE' but defaults to empty contents.
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
-- | Create a new zero size window on a given buffer
newZeroSizeWindow :: Bool -> BufferRef -> WindowRef -> Window
newZeroSizeWindow mini bk ref = Window mini bk [] 0 0 emptyRegion ref 0 Nothing
-- | Create a new window onto the given buffer.
newWindowE :: Bool -> BufferRef -> EditorM Window
newWindowE mini bk = newZeroSizeWindow mini bk . WindowRef <$> newRef
-- | Attach the specified buffer to the current window
switchToBufferE :: BufferRef -> EditorM ()
switchToBufferE bk = windowsA . PL.focus %= \w ->
w & bufkeyA .~ bk
& bufAccessListA %~ forceFold1 . (bufkey w:) . filter (bk /=)
-- | Attach the specified buffer to some other window than the current one
switchToBufferOtherWindowE :: BufferRef -> EditorM ()
switchToBufferOtherWindowE b = shiftOtherWindow >> switchToBufferE b
-- | Switch to the buffer specified as parameter. If the buffer name
-- is empty, switch to the next buffer.
switchToBufferWithNameE :: T.Text -> EditorM ()
switchToBufferWithNameE "" = alternateBufferE 0
switchToBufferWithNameE bufName = switchToBufferE =<< getBufferWithName bufName
-- | Close a buffer.
-- Note: close the current buffer if the empty string is given
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
------------------------------------------------------------------------
-- | Close current buffer and window, unless it's the last one.
closeBufferAndWindowE :: EditorM ()
closeBufferAndWindowE = do
-- Fetch the current buffer *before* closing the window. Required
-- for the onCloseBufferE actions to work as expected by the
-- minibuffer. The tryCloseE, since it uses tabsA, will have the
-- current buffer "fixed" to the buffer of the window that is
-- brought into focus. If the current buffer is accessed after the
-- tryCloseE then the current buffer may not be the same as the
-- buffer before tryCloseE. This would be bad.
b <- gets currentBuffer
tryCloseE
deleteBuffer b
-- | Rotate focus to the next window
nextWinE :: EditorM ()
nextWinE = windowsA %= PL.next
-- | Rotate focus to the previous window
prevWinE :: EditorM ()
prevWinE = windowsA %= PL.previous
-- | Swaps the focused window with the first window. Useful for
-- layouts such as 'HPairOneStack', for which the first window is the
-- largest.
swapWinWithFirstE :: EditorM ()
swapWinWithFirstE = windowsA %= swapFocus (fromJust . PL.moveTo 0)
-- | Moves the focused window to the first window, and moves all other
-- windows down the stack.
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')
-- | Swap focused window with the next one
moveWinNextE :: EditorM ()
moveWinNextE = windowsA %= swapFocus PL.next
-- | Swap focused window with the previous one
moveWinPrevE :: EditorM ()
moveWinPrevE = windowsA %= swapFocus PL.previous
-- | A "fake" accessor that fixes the current buffer after a change of
-- the current window.
--
-- Enforces invariant that top of buffer stack is the buffer of the
-- current window.
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)
-- make sure we do not hold to old versions by seqing the length.
in NE.length newBufferStack `seq` new & bufferStackA .~ newBufferStack)
-- | Counterpart of fixCurrentBufferA_: fix the current window to point to the
-- right buffer.
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
-- | Return the windows that are currently open on the buffer whose
-- key is given
windowsOnBufferE :: BufferRef -> EditorM [Window]
windowsOnBufferE k = do
ts <- use tabsA
let tabBufEq = concatMap (\win -> [win | bufkey win == k]) . (^. tabWindowsA)
return $ concatMap tabBufEq ts
-- | bring the editor focus the window with the given key.
--
-- Fails if no window with the given key is found.
focusWindowE :: WindowRef -> EditorM ()
focusWindowE k = do
-- Find the tab index and window index
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
-- | Split the current window, opening a second window onto current buffer.
-- TODO: unfold newWindowE here?
splitE :: EditorM ()
splitE = do
w <- gets currentBuffer >>= newWindowE False
windowsA %= PL.insertRight w
-- | Cycle to the next layout manager, or the first one if the current
-- one is nonstandard.
layoutManagersNextE :: EditorM ()
layoutManagersNextE = withLMStackE PL.next
-- | Cycle to the previous layout manager, or the first one if the
-- current one is nonstandard.
layoutManagersPreviousE :: EditorM ()
layoutManagersPreviousE = withLMStackE PL.previous
-- | Helper function for 'layoutManagersNext' and 'layoutManagersPrevious'
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
-- | Next variant of the current layout manager, as given by 'nextVariant'
layoutManagerNextVariantE :: EditorM ()
layoutManagerNextVariantE = currentTabA . tabLayoutManagerA %= nextVariant
-- | Previous variant of the current layout manager, as given by
-- 'previousVariant'
layoutManagerPreviousVariantE :: EditorM ()
layoutManagerPreviousVariantE =
currentTabA . tabLayoutManagerA %= previousVariant
-- | Sets the given divider position on the current tab
setDividerPosE :: DividerRef -> DividerPosition -> EditorM ()
setDividerPosE ref = assign (currentTabA . tabDividerPositionA ref)
-- | Creates a new tab containing a window that views the current buffer.
newTabE :: EditorM ()
newTabE = do
bk <- gets currentBuffer
win <- newWindowE False bk
ref <- newRef
tabsA %= PL.insertRight (makeTab1 ref win)
-- | Moves to the next tab in the round robin set of tabs
nextTabE :: EditorM ()
nextTabE = tabsA %= PL.next
-- | Moves to the previous tab in the round robin set of tabs
previousTabE :: EditorM ()
previousTabE = tabsA %= PL.previous
-- | Moves the focused tab to the given index, or to the end if the
-- index is not specified.
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"
-- | Deletes the current tab. If there is only one tab open then error out.
-- When the last tab is focused, move focus to the left, otherwise
-- move focus to the right.
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
-- | Close the current window. If there is only one tab open and the tab
-- contains only one window then do nothing.
tryCloseE :: EditorM ()
tryCloseE = do
ntabs <- uses tabsA PL.length
nwins <- uses windowsA PL.length
unless (ntabs == 1 && nwins == 1) $ if nwins == 1
-- Could the Maybe response from deleteLeft be used instead of the
-- def 'if'?
then tabsA %= fromJust . PL.deleteLeft
else windowsA %= fromJust . PL.deleteLeft
-- | Make the current window the only window on the screen
closeOtherE :: EditorM ()
closeOtherE = windowsA %= PL.deleteOthers
-- | Switch focus to some other window. If none is available, create one.
shiftOtherWindow :: MonadEditor m => m ()
shiftOtherWindow = withEditor $ do
len <- uses windowsA PL.length
if len == 1
then splitE
else nextWinE
-- | Execute the argument in the context of an other window. Create
-- one if necessary. The current window is re-focused after the
-- argument has completed.
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
-- | Shows the current key bindings in a new window
acceptedInputsOtherWindow :: EditorM ()
acceptedInputsOtherWindow = do
ai <- acceptedInputs
b <- stringToNewBuffer (MemBuffer "keybindings") (fromText $ T.unlines ai)
w <- newWindowE False b
windowsA %= PL.insertRight w
-- | Defines an action to be executed when the current buffer is closed.
--
-- Used by the minibuffer to assure the focus is restored to the
-- buffer that spawned the minibuffer.
--
-- todo: These actions are not restored on reload.
--
-- todo: These actions should probably be very careful at what they
-- do.
--
-- TODO: All in all, this is a very ugly way to achieve the purpose.
-- The nice way to proceed is to somehow attach the miniwindow to the
-- window that has spawned it.
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
-- | Creates an in-memory buffer with a unique name.
newTempBufferE :: EditorM BufferRef
newTempBufferE = do
e <- gets id
-- increment the index of the hint until no buffer is found with that name
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)