yi-0.8.0: src/library/Yi/Editor.hs
{-# LANGUAGE TemplateHaskell, GeneralizedNewtypeDeriving, DeriveDataTypeable, FlexibleContexts, StandaloneDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- Copyright (c) 2004-5, Don Stewart - http://www.cse.unsw.edu.au/~dons
-- Copyright (c) 2007-8, JP Bernardy
-- | The top level editor state, and operations on it.
module Yi.Editor where
import Prelude hiding (foldl,concatMap,foldr,all)
import Control.Monad.State hiding (get, put, mapM, forM_)
import Control.Monad.Reader hiding (mapM, forM_ )
import Control.Applicative
import Control.Monad
import Control.Lens
import Data.Binary
import Data.DeriveTH
import Data.Either (rights)
import Data.List (nub, delete, (\\))
import Data.Maybe
import Data.Typeable
import Data.Default
import Data.Foldable hiding (forM_)
import System.FilePath (splitPath)
import Yi.Buffer
import Yi.Config
import Yi.Dynamic
import Yi.Event (Event)
import Yi.Interact as I
import Yi.JumpList
import Yi.KillRing
import Yi.Layout
import Yi.Style (StyleName, defaultStyle)
import Yi.Tab
import Yi.Window
import Yi.Monad hiding (newRef)
import Yi.Utils
import Data.Rope (Rope)
import qualified Data.Rope as R
import qualified Data.DelayList as DelayList
import qualified Data.List.PointedList as PL (atEnd, moveTo)
import qualified Data.List.PointedList.Circular as PL
import qualified Data.Map as M
import {-# source #-} Yi.Keymap (extractTopKeymap)
type Status = ([String],StyleName)
type Statuses = DelayList.DelayList Status
-- | The Editor state
data Editor = Editor {
bufferStack :: ![BufferRef] -- ^ Stack of all the buffers.
-- Invariant: never empty
-- Invariant: first buffer is the current one.
,buffers :: !(M.Map BufferRef FBuffer)
,refSupply :: !Int -- ^ Supply for buffer, window and tab ids.
,tabs_ :: !(PL.PointedList Tab) -- ^ current tab contains the visible windows pointed list.
,dynamic :: !DynamicValues -- ^ dynamic components
,statusLines :: !Statuses
,maxStatusHeight :: !Int
,killring :: !Killring
,currentRegex :: !(Maybe SearchExp) -- ^ currently highlighted regex (also most recent regex for use in vim bindings)
,searchDirection :: !Direction
,pendingEvents :: ![Event] -- ^ Processed events that didn't yield any action yet.
,onCloseActions :: !(M.Map BufferRef (EditorM ())) -- ^ Actions to be run when the buffer is closed; should be scrapped.
}
deriving Typeable
instance Binary Editor where
put (Editor bss bs supply ts dv _sl msh kr _re _dir _ev _cwa ) = put bss >> put bs >> put supply >> put ts >> put dv >> put msh >> put kr
get = do
bss <- 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
}
newtype EditorM a = EditorM {fromEditorM :: ReaderT Config (State Editor) a}
deriving (Monad, MonadState Editor, MonadReader Config, Functor)
deriving instance Typeable1 EditorM
instance Applicative EditorM where
pure = return
(<*>) = ap
class (Monad m, MonadState Editor m) => MonadEditor m
where askCfg :: m Config
withEditor :: EditorM a -> m a
withEditor f = do
cfg <- askCfg
getsAndModify (runEditor cfg f)
liftEditor :: MonadEditor m => EditorM a -> m a
liftEditor = withEditor
instance MonadEditor EditorM where
askCfg = ask
withEditor = id
-- | 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 = def
,statusLines = DelayList.insert (maxBound, ([""], defaultStyle)) []
,killring = krEmpty
,pendingEvents = []
,maxStatusHeight = 1
,onCloseActions = M.empty
}
where buf = newB 0 (Left "console") (R.fromString "")
win = (dummyWindow (bkey buf)) {wkey = WindowRef 1, isMini = False}
tab = makeTab1 2 win
-- ---------------------------------------------------------------------
runEditor :: Config -> EditorM a -> Editor -> (Editor, a)
runEditor cfg f e = let (a, e') = runState (runReaderT (fromEditorM f) cfg) e in (e',a)
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 ^. configVarsA ^. configVariableA
dynA :: YiVariable a => Lens' Editor a
dynA = dynamicA . dynamicValueA
-- ---------------------------------------------------------------------
-- Buffer operations
newRef :: EditorM Int
newRef = do
(%=) refSupplyA (+ 1)
use refSupplyA
newBufRef :: EditorM BufferRef
newBufRef = 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 :: BufferId -- ^ The buffer indentifier
-> Rope -- ^ The contents with which to populate the buffer
-> EditorM BufferRef
stringToNewBuffer nm cs = do
u <- newBufRef
defRegStyle <- configRegionStyle <$> askCfg
insertBuffer $ set regionStyleA defRegStyle $ newB u nm cs
m <- asks configFundamentalMode
withGivenBuffer0 u $ setAnyMode m
return u
insertBuffer :: FBuffer -> EditorM ()
insertBuffer b = 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 :: BufferRef -> EditorM ()
deleteBuffer k = 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.
pure length <*> gets bufferStack
>>= \l -> case l of
1 -> return ()
_ -> pure (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 = fmap bufkey $ toList ws
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
modify $ \e -> e {bufferStack = forceFold1 $ filter (k /=) $ bufferStack e,
buffers = M.delete k (buffers e),
tabs_ = forceFoldTabs $ fmap (mapWindows pickOther) (tabs_ e)
-- all windows open on that buffer must switch to another buffer.
}
(%=) windowsA (fmap (\w -> w { bufAccessList = forceFold1 . filter (k/=) $ bufAccessList w }))
_ -> 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 -> [String]
commonNamePrefix = commonPrefix . fmap (dropLast . splitPath) . rights . fmap (^. identA) . bufferSet
where dropLast [] = []
dropLast x = init x
-- drop the last component, so that it is never hidden.
getBufferStack :: EditorM [FBuffer]
getBufferStack = do
bufMap <- gets buffers
gets (fmap (bufMap M.!) . bufferStack)
findBuffer :: BufferRef -> EditorM (Maybe FBuffer)
findBuffer k = gets (M.lookup k . buffers)
-- | Find buffer with this key
findBufferWith :: BufferRef -> Editor -> FBuffer
findBufferWith k e = fromMaybe (error "Editor.findBufferWith: no buffer has this key") (M.lookup k (buffers e))
-- | Find buffer with this name
findBufferWithName :: String -> Editor -> [BufferRef]
findBufferWithName n e = map bkey $ filter (\b -> shortIdentString (commonNamePrefix e) b == n) (M.elems $ buffers e)
-- | Find buffer with given name. Fail if not found.
getBufferWithName :: String -> EditorM BufferRef
getBufferWithName bufName = do
bs <- gets $ findBufferWithName bufName
case bs of
[] -> fail ("Buffer not found: " ++ 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
------------------------------------------------------------------------
-- | Rotate the buffer stack by the given amount.
shiftBuffer :: Int -> EditorM ()
shiftBuffer shift = do
(%=) bufferStackA rotate
fixCurrentWindow
where rotate l = take len $ drop (shift `mod` len) $ cycle l
where len = length l
------------------------------------------------------------------------
-- | Perform action with any given buffer, using the last window that was used for that buffer.
withGivenBuffer0 :: BufferRef -> BufferM a -> EditorM a
withGivenBuffer0 k f = do
b <- gets (findBufferWith k)
withGivenBufferAndWindow0 (b ^. lastActiveWindowA) k f
-- | Perform action with any given buffer
withGivenBufferAndWindow0 :: Window -> BufferRef -> BufferM a -> EditorM a
withGivenBufferAndWindow0 w k f = do
accum <- asks configKillringAccumulate
(us, v) <- getsAndModify (\e ->
let b = findBufferWith k e
(v, us, b') = runBufferFull w b f
in (e {buffers = mapAdjust' (const b') k (buffers e),
killring = (if accum && all updateIsDelete us
then foldl (.) id
(reverse [krPut dir (R.toString s) | Delete _ dir s <- us])
else id)
(killring e)
}, (us, v)))
updHandler <- return . bufferUpdateHandler =<< ask
unless (null us || null updHandler) $
forM_ updHandler (\h -> withGivenBufferAndWindow0 w k (h us))
return v
-- | Perform action with current window's buffer
withBuffer0 :: BufferM a -> EditorM a
withBuffer0 f = do
w <- use currentWindowA
withGivenBufferAndWindow0 w (bufkey w) f
withEveryBufferE :: BufferM a -> EditorM [a]
withEveryBufferE action =
gets bufferStack >>= mapM (`withGivenBuffer0` action)
currentWindowA :: Lens' Editor Window
currentWindowA = windowsA . PL.focus
-- | Return the current buffer
currentBuffer :: Editor -> BufferRef
currentBuffer = head . bufferStack
-----------------------
-- Handling of status
-- | Display a transient message
printMsg :: String -> EditorM ()
printMsg s = printStatus ([s], defaultStyle)
printMsgs :: [String] -> EditorM ()
printMsgs s = printStatus (s, defaultStyle)
printStatus :: Status -> EditorM ()
printStatus = setTmpStatus 1
-- | Set the "background" status line
setStatus :: Status -> EditorM ()
setStatus = setTmpStatus maxBound
-- | Clear the status line
clrStatus :: EditorM ()
clrStatus = setStatus ([""], defaultStyle)
statusLine :: Editor -> [String]
statusLine = fst . statusLineInfo
statusLineInfo :: Editor -> Status
statusLineInfo = snd . head . statusLines
setTmpStatus :: Int -> Status -> EditorM ()
setTmpStatus delay s = do
(%=) statusLinesA $ DelayList.insert (delay, s)
-- also show in the messages buffer, so we don't loose any message
bs <- gets (filter (\b -> b ^. identA == Left "messages") . M.elems . buffers)
b <- case bs of
(b':_) -> return $ bkey b'
[] -> stringToNewBuffer (Left "messages") (R.fromString "")
withGivenBuffer0 b $ do botB; insertN (show s ++ "\n")
-- ---------------------------------------------------------------------
-- kill-register (vim-style) interface to killring.
-- | Put string into yank register
setRegE :: String -> EditorM ()
setRegE s = (%=) killringA $ krSet s
-- | Return the contents of the yank register
getRegE :: EditorM String
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
getDynamic :: YiVariable a => EditorM a
getDynamic = use (dynamicA . dynamicValueA)
-- | Insert a value into the extensible state, keyed by its type
setDynamic :: YiVariable a => a -> EditorM ()
setDynamic = assign (dynamicA . dynamicValueA)
-- | Attach the next buffer in the buffer stack to the current window.
nextBufW :: EditorM ()
nextBufW = shiftBuffer 1
-- | Attach the previous buffer in the stack list to the current window.
prevBufW :: EditorM ()
prevBufW = shiftBuffer (negate 1)
-- | 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
-> Rope -- ^ buffer contents
-> EditorM BufferRef
newBufferE f s = do
b <- stringToNewBuffer f s
switchToBufferE b
return b
-- | Creates an in-memory buffer with a unique name.
--
-- A hint for the buffer naming scheme can be specified in the dynamic variable TempBufferNameHint
-- The new buffer always has a buffer ID that did not exist before newTempBufferE.
-- TODO: this probably a lot more complicated than it should be: why not count from zero every time?
newTempBufferE :: EditorM BufferRef
newTempBufferE = do
hint :: TempBufferNameHint <- getDynamic
e <- gets id
-- increment the index of the hint until no buffer is found with that name
let find_next in_name =
case findBufferWithName (show in_name) e of
(_b : _) -> find_next $ inc in_name
[] -> in_name
inc in_name = TempBufferNameHint (tmp_name_base in_name) (tmp_name_index in_name + 1)
next_tmp_name = find_next hint
b <- newBufferE (Left $ show next_tmp_name)
(R.fromString "")
setDynamic $ inc next_tmp_name
return b
-- | Specifies the hint for the next temp buffer's name.
data TempBufferNameHint = TempBufferNameHint
{ tmp_name_base :: String
, tmp_name_index :: Int
} deriving Typeable
instance Show TempBufferNameHint where
show (TempBufferNameHint s i) = s ++ "-" ++ show i
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 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 { bufkey = bk,
bufAccessList = forceFold1 $ (bufkey w:) . filter (bk/=) $ bufAccessList w })
-- | 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 :: String -> EditorM ()
switchToBufferWithNameE "" = alternateBufferE 0
switchToBufferWithNameE bufName = switchToBufferE =<< getBufferWithName bufName
-- | Close a buffer.
-- Note: close the current buffer if the empty string is given
closeBufferE :: String -> EditorM ()
closeBufferE nm = deleteBuffer =<< getBufferWithNameOrCurrent nm
getBufferWithNameOrCurrent :: String -> EditorM BufferRef
getBufferWithNameOrCurrent nm = if null nm then gets currentBuffer else getBufferWithName nm
------------------------------------------------------------------------
-- | 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 : bufferStack new)
-- make sure we do not hold to old versions by seqing the length.
in length newBufferStack `seq` new { bufferStack = newBufferStack } )
-- | Counterpart of fixCurrentBufferA_: fix the current window to point to the
-- right buffer.
fixCurrentWindow :: EditorM ()
fixCurrentWindow = do
b <- gets currentBuffer
(%=) (windowsA . PL.focus) (\w -> w {bufkey = b})
withWindowE :: Window -> BufferM a -> EditorM a
withWindowE w = withGivenBufferAndWindow0 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
return $ concatMap (concatMap (\win -> [win | bufkey win == k]) . (^. tabWindowsA)) 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
b <- gets currentBuffer
w <- newWindowE False b
(%=) windowsA (PL.insertRight w)
-- | Cycle to the next layout manager, or the first one if the current one is nonstandard.
layoutManagersNextE :: EditorM ()
layoutManagersNextE = withLMStack PL.next
-- | Cycle to the previous layout manager, or the first one if the current one is nonstandard.
layoutManagersPreviousE :: EditorM ()
layoutManagersPreviousE = withLMStack PL.previous
-- | Helper function for 'layoutManagersNext' and 'layoutManagersPrevious'
withLMStack :: (PL.PointedList AnyLayoutManager -> PL.PointedList AnyLayoutManager) -> EditorM ()
withLMStack 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
-- | Enlarge the current window
enlargeWinE :: EditorM ()
enlargeWinE = error "enlargeWinE: not implemented"
-- | Shrink the current window
shrinkWinE :: EditorM ()
shrinkWinE = error "shrinkWinE: not implemented"
-- | 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.
moveTab :: Maybe Int -> EditorM ()
moveTab Nothing = do count <- uses tabsA PL.length
(%=) tabsA $ fromJust . PL.moveTo (pred count)
moveTab (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 = liftEditor $ 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
liftEditor prevWinE
return x
acceptedInputs :: EditorM [String]
acceptedInputs = do
cfg <- askCfg
keymap <- withBuffer0 $ gets (withMode0 modeKeymap)
let l = I.accepted 3 $ I.mkAutomaton $ extractTopKeymap $ keymap $ defaultKm cfg
return $ fmap unwords l
-- | 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
-- put the template haskell at the end, to avoid 'variable not found' compile errors
$(derive makeBinary ''TempBufferNameHint)
-- For GHC 7.0 with template-haskell 2.5 (at least on my computer - coconnor) the Binary instance
-- needs to be defined before the YiVariable instance.
--
-- GHC 7.1 does not appear to have this issue.
instance Default TempBufferNameHint where
def = TempBufferNameHint "tmp" 0
instance YiVariable TempBufferNameHint
addJumpHereE :: EditorM ()
addJumpHereE = addJumpAtE =<< withBuffer0 pointB
addJumpAtE :: Point -> EditorM ()
addJumpAtE point = do
w <- use currentWindowA
let jl = jumpList w
shouldAddJump <- case jl of
Just (PL.PointedList _ (Jump mark bf) _) -> do
bfStillAlive <- gets (M.lookup bf . buffers)
case bfStillAlive of
Nothing -> return False
_ -> do
p <- withGivenBuffer0 bf $ getMarkPointB mark
return $! (p, bf) /= (point, bufkey w)
_ -> return True
when shouldAddJump $ do
m <- withBuffer0 setMarkHereB
let bf = bufkey w
j = Jump m bf
assign currentWindowA $ w { jumpList = addJump j (jumpList w) }
return ()
jumpBackE :: EditorM ()
jumpBackE = addJumpHereE >> modifyJumpListE jumpBack
jumpForwardE :: EditorM ()
jumpForwardE = modifyJumpListE jumpForward
modifyJumpListE :: (JumpList -> JumpList) -> EditorM ()
modifyJumpListE f = do
w <- use currentWindowA
let w' = w { jumpList = f (jumpList w) }
jl = jumpList w'
case jl of
Nothing -> return ()
Just (PL.PointedList _ (Jump mark bf) _) -> do
switchToBufferE bf
withBuffer0 $ getMarkPointB mark >>= moveTo
(%=) currentWindowA (\win -> win { jumpList = f (jumpList win) })