yi-0.4: Yi/Core.hs
{-# LANGUAGE PatternSignatures, RecursiveDo, Rank2Types #-}
-- Copyright (c) Tuomo Valkonen 2004.
-- Copyright (c) Don Stewart 2004-5. http://www.cse.unsw.edu.au/~dons
-- Copyright (c) Jean-Philippe Bernardy 2007-8
-- | The core actions of yi. This module is the link between the editor
-- and the UI. Key bindings, and libraries should manipulate Yi through
-- the interface defined here.
module Yi.Core
( module Yi.Dynamic
-- * Keymap
, module Yi.Keymap
-- * Construction and destruction
, startEditor
, quitEditor -- :: YiM ()
, reloadEditor -- :: YiM ()
, getAllNamesInScope
, refreshEditor -- :: YiM ()
, suspendEditor -- :: YiM ()
-- * Global editor actions
, msgEditor -- :: String -> YiM ()
, errorEditor -- :: String -> YiM ()
, closeWindow -- :: YiM ()
-- * Interacting with external commands
, runProcessWithInput -- :: String -> String -> YiM String
, startSubprocess -- :: FilePath -> [String] -> YiM ()
-- * Misc
, runAction
, withMode
, withSyntax
)
where
import Prelude ()
import Yi.Prelude
import Yi.Config
import Yi.Debug
import Yi.Undo
import Yi.Buffer
import Yi.Dynamic
import Yi.String
import Yi.Process ( popen, createSubprocess, readAvailable, SubprocessId, SubprocessInfo(..) )
import Yi.Editor
import Yi.Event (Event, prettyEvent)
import Yi.Keymap
import Yi.KillRing (krEndCmd)
import qualified Yi.Interact as I
import Yi.Monad
import Yi.Accessor
import qualified Yi.WindowSet as WS
import qualified Yi.Editor as Editor
import qualified Yi.UI.Common as UI
import Yi.UI.Common as UI (UI)
import qualified Data.DelayList as DelayList
import Data.List (intersperse)
import Data.Maybe
import qualified Data.Map as M
import Data.IORef
import Data.Foldable (mapM_, all)
import System.IO ( Handle, hWaitForInput )
import System.FilePath
import System.Process ( getProcessExitCode, ProcessHandle )
import Control.Monad (when,forever)
import Control.Monad.Reader (runReaderT, ask, asks)
import Control.Monad.Trans
import Control.Monad.Error ()
import Control.Monad.State (gets)
import Control.Exception
import Control.Concurrent
-- | Make an action suitable for an interactive run.
-- UI will be refreshed.
interactive :: Action -> YiM ()
interactive action = do
logPutStrLn ">>> interactively"
prepAction <- withUI UI.prepareAction
withEditor $ do prepAction
modifyAllA buffersA undosA (addChangeU InteractivePoint)
runAction action
withEditor $ modifyA killringA krEndCmd
refreshEditor
logPutStrLn "<<<"
return ()
-- ---------------------------------------------------------------------
-- | Start up the editor, setting any state with the user preferences
-- and file names passed in, and turning on the UI
--
startEditor :: Config -> Maybe Editor -> IO ()
startEditor cfg st = do
let uiStart = startFrontEnd cfg
logPutStrLn "Starting Core"
-- restore the old state
let initEditor = maybe emptyEditor id st
newSt <- newIORef initEditor
-- Setting up the 1st window is a bit tricky because most functions assume there exists a "current window"
startThreads <- newIORef []
startSubprocessId <- newIORef 1
startSubprocesses <- newIORef M.empty
(ui, runYi) <- mdo let handler e = runYi $ (errorEditor (show e) >> refreshEditor)
inF ev = handle handler (runYi (dispatch ev))
outF act = handle handler (runYi (interactive act))
ui <- uiStart cfg inF outF initEditor
let runYi f = runReaderT (runYiM f) yi
yi = Yi newSt ui startThreads inF outF startSubprocessId startSubprocesses cfg
return (ui, runYi)
runYi $ do
withEditor $ newBufferE "*messages*" (fromString "") >> return ()
when (isNothing st) $ do -- process options if booting for the first time
postActions $ startActions cfg
runYi refreshEditor
UI.main ui -- transfer control to UI
postActions :: [Action] -> YiM ()
postActions actions = do yi <- ask; liftIO $ mapM_ (output yi) actions
-- | Process an event by advancing the current keymap automaton an
-- execing the generated actions
dispatch :: Event -> YiM ()
dispatch ev =
do yi <- ask
(actions,_p') <- withBuffer $ do
keymap <- withModeB modeKeymap
p0 <- getA keymapProcessA
let defKm = defaultKm $ yiConfig $ yi
let freshP = I.mkAutomaton $ forever $ keymap $ defKm
-- Note the use of "forever": this has quite subtle implications, as it means that
-- failures in one iteration can yield to jump to the next iteration seamlessly.
-- eg. in emacs keybinding, failures in incremental search, like <left>, will "exit"
-- incremental search and immediately move to the left.
p = case p0 of
I.End -> freshP
I.Fail -> freshP
_ -> p0
(actions, p') = I.processOneEvent p ev
possibilities = I.possibleActions p'
ambiguous = not (null possibilities) && all isJust possibilities
setA keymapProcessA (if ambiguous then freshP else p')
let actions0 = case p' of
I.Fail -> [makeAction $ msgEditor $ "Unrecognized input (on = "++ show ev ++")"]
_ -> actions
actions1 = if ambiguous
then [makeAction $ msgEditor "Keymap was in an ambiguous state! Resetting it."]
else []
return (actions0 ++ actions1,p')
--logPutStrLn $ "Processing: " ++ show ev
--logPutStrLn $ "Actions posted:" ++ show actions
--logPutStrLn $ "New automation: " ++ show p'
withEditor $ modifyA statusLinesA (DelayList.decrease 1)
if (null actions)
then do evs <- withEditor $ getsAndModifyA pendingEventsA $
\evs -> (evs, evs ++ [ev])
msgEditor $ concat $ intersperse " " $ fmap prettyEvent evs
refreshEditor
else postActions actions
-- ---------------------------------------------------------------------
-- Meta operations
-- | Quit.
quitEditor :: YiM ()
quitEditor = withUI UI.end
-- | Redraw
refreshEditor :: YiM ()
refreshEditor = do e0 <- with yiEditor readRef
let e1 = modifier buffersA (fmap (clearSyntax . clearHighlight)) e0
e2 = modifier buffersA (fmap clearUpdates) e1
withUI $ flip UI.refresh e1
with yiEditor (flip writeRef e2)
where clearHighlight fb@FBuffer {pendingUpdates = us, highlightSelection = h}
= modifier highlightSelectionA (const (h && null us)) fb
-- if there were updates, then hide the selection.
clearUpdates fb = modifier pendingUpdatesA (const []) fb
-- | Suspend the program
suspendEditor :: YiM ()
suspendEditor = withUI UI.suspend
------------------------------------------------------------------------
------------------------------------------------------------------------
-- | Pipe a string through an external command, returning the stdout
-- chomp any trailing newline (is this desirable?)
--
-- Todo: varients with marks?
--
runProcessWithInput :: String -> String -> YiM String
runProcessWithInput cmd inp = do
let (f:args) = split " " cmd
(out,_err,_) <- liftIO $ popen f args (Just inp)
return (chomp "\n" out)
------------------------------------------------------------------------
-- | Same as msgEditor, but do nothing instead of printing @()@
msgEditor' :: String -> YiM ()
msgEditor' "()" = return ()
msgEditor' s = msgEditor s
runAction :: Action -> YiM ()
runAction (YiA act) = do
act >>= msgEditor' . show
return ()
runAction (EditorA act) = do
withEditor act >>= msgEditor' . show
return ()
runAction (BufferA act) = do
withBuffer act >>= msgEditor' . show
return ()
msgEditor :: String -> YiM ()
msgEditor = withEditor . printMsg
-- | Show an error on the status line and log it.
errorEditor :: String -> YiM ()
errorEditor s = do msgEditor ("error: " ++ s)
logPutStrLn $ "errorEditor: " ++ s
-- | Close the current window.
-- If this is the last window open, quit the program.
-- FIXME: call quitEditor when there are no other window in the interactive command.
closeWindow :: YiM ()
closeWindow = do
n <- withEditor $ withWindows WS.size
when (n == 1) quitEditor
withEditor $ tryCloseE
reloadEditor :: YiM ()
reloadEditor = msgEditor "reloadEditor: Not supported"
getAllNamesInScope :: YiM [String]
getAllNamesInScope = do
acts <- asks (publishedActions . yiConfig)
return (M.keys acts)
-- | Start a subprocess with the given command and arguments.
startSubprocess :: FilePath -> [String] -> YiM BufferRef
startSubprocess cmd args = do
let buffer_name = "output from " ++ cmd ++ " " ++ show args
bufref <- withEditor $ newBufferE buffer_name (fromString "")
procid <- modifiesThenReadsRef yiSubprocessIdSupply (+1)
procinfo <- liftIO $ createSubprocess cmd args bufref
yi <- ask
startSubprocessWatchers (output yi) procid procinfo
modifiesRef yiSubprocesses $ M.insert procid procinfo
msgEditor ("Launched process: " ++ cmd)
return bufref
startSubprocessWatchers :: (Action -> IO ()) -> SubprocessId -> SubprocessInfo -> YiM ()
startSubprocessWatchers chan procid procinfo = do
mapM_ (liftIO . forkOS) [ pipeToBuffer (hOut procinfo) append,
pipeToBuffer (hErr procinfo) append,
waitForExit (procHandle procinfo) >>= reportExit ]
where append s = send $ appendToBuffer (bufRef procinfo) s
reportExit s = append s >> (send $ removeSubprocess procid)
send a = chan $ makeAction a
removeSubprocess :: SubprocessId -> YiM ()
removeSubprocess procid = modifiesRef yiSubprocesses $ M.delete procid
appendToBuffer :: BufferRef -> String -> YiM ()
appendToBuffer bufref s = withGivenBuffer bufref $ savingExcursionB $ (sizeB >>= insertNAt s)
pipeToBuffer :: Handle -> (String -> IO ()) -> IO ()
pipeToBuffer h append =
handle (\_ -> return ()) $ forever $ (hWaitForInput h (-1) >> readAvailable h >>= append)
waitForExit :: ProcessHandle -> IO String
waitForExit ph =
handle (\_ -> return "Process killed") $ do
ec <- getProcessExitCode ph
if (isJust ec) then return "Process exited"
else threadDelay (500*1000) >> waitForExit ph
withMode :: (Show x, YiAction a x) => (forall syntax. Mode syntax -> a) -> YiM ()
withMode f = do
b <- withEditor Editor.getBuffer
act <- withBufferMode b f
runAction $ makeAction $ act
withSyntax :: (Show x, YiAction a x) => (forall syntax. Mode syntax -> syntax -> a) -> YiM ()
withSyntax f = do
b <- withEditor Editor.getBuffer
act <- withGivenBuffer b $ gets (withSyntax0 f)
runAction $ makeAction $ act