{-# 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) })