yi-core-0.19.4: src/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
, doesBufferNameExist
, emptyEditor
, findBuffer
, findBufferWith
, findBufferWithName
, findWindowWith
, focusWindowE
, getBufferStack
, getBufferWithName
, getBufferWithNameOrCurrent
, getEditorDyn
, getRegE
, jumpBackE
, jumpForwardE
, killringA
, layoutManagerNextVariantE
, layoutManagerPreviousVariantE
, layoutManagersNextE
, layoutManagersPreviousE
, layoutManagersPrintMsgE
, maxStatusHeightA
, moveTabE
, moveWinNextE
, moveWinPrevE
, newBufferE
, newEmptyBufferE
, newTabE
, newTempBufferE
, newWindowE
, nextTabE
, nextWinE
, onCloseActionsA
, 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 Prelude hiding (all, concatMap, foldl, foldr)
import Lens.Micro.Platform (Lens', lens, mapped,
use, view, (%=), (%~),
(&), (.~), (^.))
import Control.Monad (forM_, liftM, unless, when)
import Control.Monad.Reader (MonadReader (ask), asks)
import Control.Monad.State (gets, modify)
import Data.Binary (Binary, get, put)
import Data.Default (Default, def)
import qualified Data.DelayList as DelayList (insert)
import Data.DynamicState.Serializable (getDyn, putDyn)
import Data.Foldable (Foldable (foldl, foldl', foldr), all, concatMap, toList)
import Data.List (delete, (\\))
import Data.List.NonEmpty (NonEmpty (..), fromList, nub)
import qualified Data.List.NonEmpty as NE (filter, head, length, toList, (<|))
import qualified Data.List.PointedList as PL (atEnd, moveTo)
import qualified Data.List.PointedList.Circular as PL (PointedList (..), delete,
deleteLeft, deleteOthers,
deleteRight, focus,
insertLeft, insertRight,
length, next, previous,
singleton, _focus)
import qualified Data.Map as M (delete, elems, empty,
insert, lookup, singleton, (!))
import Data.Maybe (fromJust, fromMaybe, isNothing)
import qualified Data.Monoid as Mon ((<>))
import Data.Semigroup ((<>))
import qualified Data.Sequence as S
import qualified Data.Text as T (Text, null, pack, unlines, unpack, unwords, isInfixOf)
import System.FilePath (splitPath)
import Yi.Buffer
import Yi.Config
import Yi.Interact as I (accepted, mkAutomaton)
import Yi.JumpList (Jump (..), JumpList, addJump, jumpBack, jumpForward)
import Yi.KillRing (krEmpty, krGet, krPut, krSet)
import Yi.Layout
import Yi.Monad (assign, getsAndModify, uses)
import Yi.Rope (YiString, empty, fromText)
import qualified Yi.Rope as R (YiString, fromText, snoc)
import Yi.String (listify)
import Yi.Style (defaultStyle)
import Yi.Tab
import Yi.Types
import Yi.Utils
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
}
-- | 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
hasInfix b = n `T.isInfixOf` identString b
in map bkey $ filter hasInfix bufs
doesBufferNameExist :: T.Text -> Editor -> Bool
doesBufferNameExist n e =
not $ null $ filter ((== n) . identString) $ M.elems $ buffers e
-- | 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
_ -> fail ("Ambiguous buffer name: " ++ T.unpack bufName)
------------------------------------------------------------------------
-- | 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 %~
(\kr ->
if accum && all updateIsDelete us
then let putDelKr kr' (Delete _ dir s) = krPut dir s kr'
putDelKr kr' _ = kr'
in foldl' putDelKr kr (S.reverse us)
else kr)
, (us, v))
(us, v) <- getsAndModify edit
updHandler <- return . bufferUpdateHandler =<< ask
unless (S.null us || S.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 result 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 /=)
-- | 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.
-- 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)
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 k ++ "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
-- | Prints the description of the current layout manager in the status bar
layoutManagersPrintMsgE :: EditorM ()
layoutManagersPrintMsgE = do
lm <- use $ currentTabA . tabLayoutManagerA
printMsg . T.pack $ describeLayout lm
-- | Cycle to the next layout manager, or the first one if the current
-- one is nonstandard.
layoutManagersNextE :: EditorM ()
layoutManagersNextE = withLMStackE PL.next >> layoutManagersPrintMsgE
-- | Cycle to the previous layout manager, or the first one if the
-- current one is nonstandard.
layoutManagersPreviousE :: EditorM ()
layoutManagersPreviousE = withLMStackE PL.previous >> layoutManagersPrintMsgE
-- | 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 = do
currentTabA . tabLayoutManagerA %= nextVariant
layoutManagersPrintMsgE
-- | Previous variant of the current layout manager, as given by
-- 'previousVariant'
layoutManagerPreviousVariantE :: EditorM ()
layoutManagerPreviousVariantE = do
currentTabA . tabLayoutManagerA %= previousVariant
layoutManagersPrintMsgE
-- | 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
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) =
if doesBufferNameExist currentName e
then find_next nextName otherNames
else 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)