Deprecated: The each() function is deprecated. This message will be suppressed on further calls in /home/zhenxiangba/zhenxiangba.com/public_html/phproxy-improved-master/index.php on line 456
-- -fglasgow-exts for deriving Typeable -- -- Copyright (c) Tuomo Valkonen 2004. -- Copyright (c) Don Stewart 2004-5. http://www.cse.unsw.edu.au/~dons -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License as -- published by the Free Software Foundation; either version 2 of -- the License, or (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. -- -- Derived from: riot/UI.hs -- -- -- | 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 ( -- * Keymap module Yi.Keymap, Direction (..), -- * Construction and destruction startE, -- :: Kernel -> Maybe Editor -> [Action] -> IO () emptyE, -- :: Action runE, -- :: String -> Action quitE, -- :: Action rebootE, -- :: Action reloadE, -- :: Action reconfigE, loadE, unloadE, refreshE, -- :: Action suspendE, -- :: Action -- * Global editor actions BufferFileInfo ( .. ), nopE, -- :: Action msgE, -- :: String -> Action errorE, -- :: String -> Action msgClrE, -- :: Action bufInfoE, -- :: EditorM BufferFileInfo fileNameE, -- :: EditorM (Maybe FilePath) bufNameE, -- :: EditorM String setWindowFillE, -- :: Char -> Action setWindowStyleE,-- :: UIStyle -> Action -- * Window manipulation nextWinE, -- :: Action prevWinE, -- :: Action setWinE, -- :: Window -> Action closeE, -- :: Action closeOtherE, -- :: Action splitE, -- :: Action enlargeWinE, -- :: Action shrinkWinE, -- :: Action -- * File-based actions fnewE, -- :: FilePath -> Action fwriteE, -- :: Action fwriteAllE, -- :: Action fwriteToE, -- :: String -> Action backupE, -- :: FilePath -> Action -- * Buffer only stuff newBufferE, -- :: String -> String -> Action listBuffersE, -- :: Action closeBufferE, -- :: String -> Action isUnchangedE, -- :: EditorM Bool setUnchangedE, -- :: Action setSynE, -- :: String -> Action getBufferWithName, -- * Buffer/Window switchToBufferE, switchToBufferOtherWindowE, switchToBufferWithNameE, nextBufW, -- :: Action prevBufW, -- :: Action -- * Buffer point movement topE, -- :: Action botE, -- :: Action solE, -- :: Action eolE, -- :: Action downE, -- :: Action upE, -- :: Action leftE, -- :: Action rightE, -- :: Action leftOrSolE, -- :: Int -> Action rightOrEolE, -- :: Int -> Action gotoLnE, -- :: Int -> Action gotoLnFromE, -- :: Int -> Action gotoPointE, -- :: Int -> Action getPointE, -- :: EditorM Int getLineAndColE, -- :: EditorM (Int, Int) atSolE, -- :: EditorM Bool atEolE, -- :: EditorM Bool atSofE, -- :: EditorM Bool atEofE, -- :: EditorM Bool -- * Window-based movement upScreenE, -- :: Action upScreensE, -- :: Int -> Action downScreenE, -- :: Action downScreensE, -- :: Int -> Action downFromTosE, -- :: Int -> Action upFromBosE, -- :: Int -> Action middleE, -- :: Action -- * Buffer editing insertE, -- :: Char -> Action insertNE, -- :: String -> Action deleteE, -- :: Action deleteNE, -- :: Int -> Action killE, -- :: Action deleteRegionE, -- :: Region -> Action writeE, -- :: Char -> Action undoE, -- :: Action redoE, -- :: Action revertE, -- :: Action -- * Read parts of the buffer readE, -- :: EditorM Char readRegionE, -- :: Region -> EditorM String readLnE, -- :: EditorM String readNM, -- :: Int -> Int -> EditorM String readRestOfLnE, -- :: EditorM String readAllE, -- :: EditorM String swapE, -- :: Action -- * Basic registers setRegE, -- :: String -> Action getRegE, -- :: EditorM String -- * Marks setMarkE, getMarkE, unsetMarkE, exchangePointAndMarkE, getBookmarkE, getBookmarkPointE, setBookmarkPointE, -- * Dynamically extensible state getDynamic, setDynamic, -- * higher level ops mapRangeE, -- :: Int -> Int -> (Char -> Char) -> Action -- * Interacting with external commands pipeE, -- :: String -> String -> EditorM String -- * Minibuffer spawnMinibufferE, -- * Misc catchJustE, changeKeymapE, getNamesInScopeE ) where import Prelude hiding (error) import Yi.Debug import Yi.Buffer import Yi.Region import Yi.Window import Yi.String import Yi.Process ( popen ) import Yi.Editor import Yi.CoreUI import Yi.Kernel import Yi.Event import Yi.Keymap import Yi.Interact (anyEvent) import qualified Yi.Editor as Editor import qualified Yi.Style as Style import qualified Yi.UI as UI import Data.Maybe import Data.Dynamic import Data.List import qualified Data.Map as M ( lookup, insert ) import Data.IORef import System.Directory ( doesFileExist ) import Control.Monad.Reader import Control.Exception import Control.Concurrent import Control.Concurrent.Chan import qualified GHC import qualified DynFlags import qualified SrcLoc import qualified ErrUtils import Outputable import GHC.Exts ( unsafeCoerce# ) -- | A 'Direction' is either left or right. data Direction = GoLeft | GoRight nilKeymap :: Keymap nilKeymap = do c <- anyEvent write $ case eventToChar c of 'q' -> quitE 'r' -> reconfigE 'h' -> (configHelp >> return ()) _ -> errorE $ "Keymap not defined, type 'r' to reload config, 'q' to quit, 'h' for help." where configHelp = newBufferE "*configuration help*" $ unlines $ ["To get a standard reasonable keymap, you can run yi with either --as=vim or --as=emacs.", "You can also create your own ~/.yi/YiConfig.hs file,", "see http://haskell.org/haskellwiki/Yi#How_to_Configure_Yi for help on how to do that."] -- --------------------------------------------------------------------- -- | Start up the editor, setting any state with the user preferences -- and file names passed in, and turning on the UI -- startE :: Kernel -> Maybe Editor -> [Action] -> IO () startE kernel st commandLineActions = do logPutStrLn "Starting Core" -- restore the old state newSt <- newIORef $ maybe emptyEditor id st outCh <- newChan flip runReaderT newSt $ do modifyEditor_ $ \e -> return e { output = outCh, editorKernel = kernel, defaultKeymap = nilKeymap } UI.start -- Setting up the 1st buffer/window is a bit tricky because most functions assume there exists a "current window" -- or a "current buffer". stringToNewBuffer "*console*" "" >>= UI.newWindow False >>= UI.setWindow newBufferE "*messages*" "" >> return () withKernel $ \k -> do dflags <- getSessionDynFlags k setSessionDynFlags k dflags { GHC.log_action = ghcErrorReporter newSt } -- run user configuration loadE "YiConfig" runConfig when (isNothing st) $ do -- process options if booting for the first time sequence_ commandLineActions logPutStrLn "Starting event handler" let handler e = flip runReaderT newSt $ errorE (show e) -- | The editor's input main loop. -- Read key strokes from the ui and dispatches them to the buffer with focus. eventLoop :: IO () eventLoop = do ch <- liftM input $ readIORef newSt let run = mapM_ dispatch =<< getChanContents ch repeatM_ $ (handle handler run >> logPutStrLn "Dispatching loop ended") where dispatch action = flip runReaderT newSt $ withBuffer' $ \b -> writeChan (bufferInput b) action -- | Make an action suitable for an interactive run. -- Editor state will be refreshed after interactive :: Action -> IO () interactive action = do logPutStrLn ">>>>>>> interactively" runReaderT (UI.prepareAction >> action >> UI.scheduleRefresh) newSt logPutStrLn "<<<<<<<" -- | The editor's output main loop. execLoop :: IO () execLoop = do runReaderT UI.scheduleRefresh newSt let loop = sequence_ . map interactive =<< getChanContents outCh repeatM_ $ (handle handler loop >> logPutStrLn "Execing loop ended") t1 <- forkIO eventLoop t2 <- forkIO execLoop modifyIORef newSt $ \e -> e { threads = t1 : t2 : threads e } UI.main newSt -- transfer control to UI: GTK must run in the main thread, or else it's not happy. changeKeymapE :: Keymap -> Action changeKeymapE km = do modifyEditor_ $ \e -> return e { defaultKeymap = km } bs <- getBuffers lift $ mapM_ restartBufferThread bs -- --------------------------------------------------------------------- -- | @emptyE@ and @runE@ are for automated testing purposes. The former -- initialises the editor state, and returns, enabling the tester to -- invoke various core commands from a program. The latter runs the -- editor with string as input, and is useful for testing keymaps. -- emptyE takes no input -- the ui blocks on stdin. -- emptyE :: Action emptyE = modifyEditor_ $ const $ return $ emptyEditor -- need to get it into a state where we can just run core commands -- to make it reinitialisable, lets blank out the state -- make up an abitrary screen size -- no ui thread -- no eventloop -- for testing keymaps: runE :: String -> Action runE = undefined -- --------------------------------------------------------------------- -- Meta operations -- | Quit. quitE :: Action quitE = withUI UI.end -- | Reboot (!). Reboot the entire editor, reloading the Yi core. rebootE :: Action rebootE = do e <- readEditor id fn <- readEditor reboot Editor.shutdown lift $ fn (Just e) -- | (Re)compile and reload the user's config files reloadE :: EditorM [String] reloadE = do modules <- readEditor editorModules withKernel $ \kernel -> do targets <- mapM (\m -> guessTarget kernel m Nothing) modules setTargets kernel targets -- lift $ rts_revertCAFs -- FIXME: GHCi does this; It currently has undesired effects on logging; investigate. result <- withKernel loadAllTargets loaded <- withKernel setContextAfterLoad case result of GHC.Failed -> withOtherWindow (switchToBufferE =<< getBufferWithName "*console*") _ -> return () return $ map (moduleNameString . moduleName) loaded -- lift $ rts_revertCAFs --foreign import ccall "revertCAFs" rts_revertCAFs :: IO () -- Make it "safe", just in case -- | Reset the size, and force a complete redraw refreshE :: Action refreshE = UI.refreshAll -- | Do nothing nopE :: Action nopE = return () -- | Suspend the program suspendE :: Action suspendE = UI.suspend -- --------------------------------------------------------------------- -- Movement operations -- | Move cursor to origin topE :: Action topE = withBuffer $ moveTo 0 -- | Move cursor to end of buffer botE :: Action botE = withBuffer $ do n <- sizeB moveTo n -- | Move cursor to start of line solE :: Action solE = withBuffer moveToSol -- | Move cursor to end of line eolE :: Action eolE = withBuffer moveToEol -- | Move cursor down 1 line downE :: Action downE = withBuffer lineDown -- | Move cursor up to the same point on the previous line upE :: Action upE = withBuffer lineUp -- | Go to line number @n@ gotoLnE :: Int -> Action gotoLnE n = withBuffer (gotoLn n >> return ()) -- | Go to line @n@ offset from current line gotoLnFromE :: Int -> Action gotoLnFromE n = withBuffer (gotoLnFrom n >> return ()) -- | Go to a particular point. gotoPointE :: Int -> Action gotoPointE p = withBuffer $ moveTo p -- | Get the current point getPointE :: EditorM Int getPointE = withBuffer pointB -- | Get the current line and column number getLineAndColE :: EditorM (Int, Int) getLineAndColE = withBuffer lineAndColumn where lineAndColumn :: BufferM (Int, Int) lineAndColumn = do lineNo <- curLn colNo <- offsetFromSol return (lineNo, colNo) ------------------------------------------------------------------------ -- | Is the point at the start of the line atSolE :: EditorM Bool atSolE = withBuffer atSol -- | Is the point at the end of the line atEolE :: EditorM Bool atEolE = withBuffer atEol -- | Is the point at the start of the file atSofE :: EditorM Bool atSofE = withBuffer atSof -- | Is the point at the end of the file atEofE :: EditorM Bool atEofE = withBuffer atEof ------------------------------------------------------------------------ -- | Scroll up 1 screen upScreenE :: Action upScreenE = do (Just w) <- getWindow withBuffer (gotoLnFrom (- (height w - 1))) solE -- | Scroll up n screens upScreensE :: Int -> Action upScreensE n = do (Just w) <- getWindow withBuffer (gotoLnFrom (- (n * (height w - 1)))) solE -- | Scroll down 1 screen downScreenE :: Action downScreenE = do (Just w) <- getWindow withBuffer (gotoLnFrom (height w - 1)) return () -- | Scroll down n screens downScreensE :: Int -> Action downScreensE n = do (Just w) <- getWindow withBuffer (gotoLnFrom (n * (height w - 1))) return () -- | Move to @n@ lines down from top of screen downFromTosE :: Int -> Action downFromTosE n = do (i,fn) <- withWindow $ \w _ -> do let y = fst $ cursor w n' = min n (height w - 1 - 1) d = n' - y return (abs d, if d < 0 then upE else downE) replicateM_ i fn -- | Move to @n@ lines up from the bottom of the screen upFromBosE :: Int -> Action upFromBosE n = (withWindow $ \w _ -> return (height w -1 -1 - n)) >>= downFromTosE -- | Move to middle line in screen middleE :: Action middleE = (withWindow $ \w _ -> return ((height w -1-1) `div` 2)) >>= downFromTosE -- --------------------------------------------------------------------- -- | move the point left (backwards) in the buffer leftE :: Action leftE = withBuffer leftB -- | move the point right (forwards) in the buffer rightE :: Action rightE = withBuffer rightB -- | Move left @x@ or to start of line leftOrSolE :: Int -> Action leftOrSolE x = withBuffer $ moveXorSol x -- | Move right @x@ or to end of line rightOrEolE :: Int -> Action rightOrEolE x = withBuffer $ moveXorEol x -- --------------------------------------------------------------------- -- Window based operations -- {- -- | scroll window up scrollUpE :: Action scrollUpE = withWindow_ scrollUpW -- | scroll window down scrollDownE :: Action scrollDownE = withWindow_ scrollDownW -} ------------------------------------------------------------------------ -- | Insert new character insertE :: Char -> Action insertE c = insertNE [c] -- | Insert a string insertNE :: String -> Action insertNE str = withBuffer $ insertN str -- | Delete character under cursor deleteE :: Action deleteE = withBuffer $ deleteN 1 -- | Delete @n@ characters from under the cursor deleteNE :: Int -> Action deleteNE i = withBuffer $ deleteN i -- | Kill to end of line killE :: Action killE = withBuffer deleteToEol -- | Delete an arbitrary part of the buffer deleteRegionE :: Region -> Action deleteRegionE r = withBuffer $ deleteNAt (regionEnd r - regionStart r) (regionStart r) -- | Read the char under the cursor readE :: EditorM Char readE = withBuffer readB -- | Read an arbitrary part of the buffer readRegionE :: Region -> EditorM String readRegionE r = readNM (regionStart r) (regionEnd r) -- | Read the line the point is on readLnE :: EditorM String readLnE = withBuffer $ do i <- indexOfSol j <- indexOfEol nelemsB (j-i) i -- | Read from - to readNM :: Int -> Int -> EditorM String readNM i j = withBuffer $ nelemsB (j-i) i -- | Return the contents of the buffer as a string (note that this will -- be very expensive on large (multi-megabyte) buffers) readAllE :: EditorM String readAllE = withBuffer elemsB -- | Read from point to end of line readRestOfLnE :: EditorM String readRestOfLnE = withBuffer $ do p <- pointB j <- indexOfEol nelemsB (j-p) p -- | Write char to point writeE :: Char -> Action writeE c = withBuffer $ writeB c -- | Transpose two characters, (the Emacs C-t action) swapE :: Action swapE = do eol <- atEolE when eol leftE c <- readE deleteE leftE insertE c rightE -- --------------------------------------------------------------------- undoE :: Action undoE = withBuffer undo redoE :: Action redoE = withBuffer redo -- --------------------------------------------------------------------- -- registers (TODO these may be redundant now that it is easy to thread -- state in key bindings, or maybe not. -- -- | Put string into yank register setRegE :: String -> Action setRegE s = modifyEditor_ $ \e -> return e { yreg = s } -- | Return the contents of the yank register getRegE :: EditorM String getRegE = readEditor yreg -- ---------------------------------------------------- -- | Marks -- | Set the current buffer mark setMarkE :: Int -> Action setMarkE pos = withBuffer $ do m <- getSelectionMarkB; setMarkPointB m pos -- | Unset the current buffer mark so that there is no selection unsetMarkE :: Action unsetMarkE = withBuffer $ unsetMarkB -- | Get the current buffer mark getMarkE :: EditorM Int getMarkE = withBuffer $ do m <- getSelectionMarkB; getMarkPointB m -- | Exchange point & mark. -- Maybe this is better put in Emacs\/Mg common file exchangePointAndMarkE :: Action exchangePointAndMarkE = do m <- getMarkE p <- getPointE setMarkE p gotoPointE m getBookmarkE :: String -> EditorM Mark getBookmarkE nm = withBuffer $ getMarkB (Just nm) setBookmarkPointE :: Mark -> Point -> Action setBookmarkPointE bookmark pos = withBuffer $ setMarkPointB bookmark pos getBookmarkPointE :: Mark -> EditorM Point getBookmarkPointE bookmark = withBuffer $ getMarkPointB bookmark -- --------------------------------------------------------------------- -- | 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 the extensible state getDynamic :: Initializable a => EditorM a getDynamic = getDynamic' (undefined :: a) where getDynamic' :: Initializable b => b -> EditorM b getDynamic' a = do ps <- readEditor dynamic case M.lookup (show $ typeOf a) ps of Nothing -> lift $ initial Just x -> return $ fromJust $ fromDynamic x -- | Insert a value into the extensible state, keyed by its type setDynamic :: Typeable a => a -> Action setDynamic x = modifyEditor_ $ \e -> return e { dynamic = M.insert (show $ typeOf x) (toDyn x) (dynamic e) } ------------------------------------------------------------------------ -- | Pipe a string through an external command, returning the stdout -- chomp any trailing newline (is this desirable?) -- -- Todo: varients with marks? -- pipeE :: String -> String -> EditorM String pipeE cmd inp = do let (f:args) = split " " cmd (out,_err,_) <- lift $ popen f args (Just inp) return (chomp "\n" out) ------------------------------------------------------------------------ -- | Set the cmd buffer, and draw message at bottom of screen msgE :: String -> Action msgE s = do modifyEditor_ $ \e -> do UI.setCmdLine (ui e) s -- also show in the messages buffer, so we don't loose any message let [b] = findBufferWithName e "*messages*" runBuffer b $ do moveTo =<< sizeB; insertN (s ++ "\n") return e -- | Set the cmd buffer, and draw a pretty error message errorE :: String -> Action errorE s = do msgE ("error: " ++ s) lift $ logPutStrLn $ "errorE: " ++ s -- | Clear the message line at bottom of screen msgClrE :: Action msgClrE = msgE "" -- --------------------------------------------------------------------- -- Buffer operations data BufferFileInfo = BufferFileInfo { bufInfoFileName :: FilePath , bufInfoSize :: Int , bufInfoLineNo :: Int , bufInfoColNo :: Int , bufInfoCharNo :: Int , bufInfoPercent :: String , bufInfoModified :: Bool } -- | File info, size in chars, line no, col num, char num, percent bufInfoE :: EditorM BufferFileInfo bufInfoE = withBuffer $ do s <- sizeB p <- pointB m <- isUnchangedB l <- curLn c <- offsetFromSol nm <- nameB let bufInfo = BufferFileInfo { bufInfoFileName = nm , bufInfoSize = s , bufInfoLineNo = l , bufInfoColNo = c , bufInfoCharNo = p , bufInfoPercent = getPercent p s , bufInfoModified = not m } return bufInfo -- | Maybe a file associated with this buffer fileNameE :: EditorM (Maybe FilePath) fileNameE = withBuffer getfileB -- | Name of this buffer bufNameE :: EditorM String bufNameE = withBuffer $ nameB -- | A character to fill blank lines in windows with. Usually '~' for -- vi-like editors, ' ' for everything else setWindowFillE :: Char -> Action setWindowFillE c = modifyEditor_ $ \e -> return $ e { windowfill = c } -- | Sets the window style. setWindowStyleE :: Style.UIStyle -> Action setWindowStyleE sty = modifyEditor_ $ \e -> return $ e { uistyle = sty } -- | Attach the next buffer in the buffer list -- to the current window. nextBufW :: Action nextBufW = Editor.nextBuffer >>= switchToBufferE -- | edit the previous buffer in the buffer list prevBufW :: Action prevBufW = Editor.prevBuffer >>= switchToBufferE -- | If file exists, read contents of file into a new buffer, otherwise -- creating a new empty buffer. Replace the current window with a new -- window onto the new buffer. -- -- Need to clean up semantics for when buffers exist, and how to attach -- windows to buffers. -- fnewE :: FilePath -> Action fnewE f = do e <- lift $ doesFileExist f b <- if e then hNewBuffer f else stringToNewBuffer f [] lift $ runBuffer b $ setfileB f -- and associate with file f switchToBufferE b -- | Revert to the contents of the file on disk revertE :: Action revertE = do mfp <- withBuffer getfileB case mfp of Just fp -> do s <- liftIO $ readFile fp end <- withBuffer sizeB p <- getPointE deleteRegionE (mkRegion 0 end) topE insertNE s gotoPointE p withBuffer clearUndosB msgE ("Reverted from " ++ show fp) Nothing -> do msgE "Can't revert, no file associated with buffer." return () -- | Like fnewE, create a new buffer filled with the String @s@, -- Open up a new window onto this buffer. Doesn't associate any file -- with the buffer (unlike fnewE) and so is good for popup internal -- buffers (like scratch) newBufferE :: String -> String -> EditorM FBuffer newBufferE f s = do b <- stringToNewBuffer f s switchToBufferE b lift $ logPutStrLn "newBufferE ended" return b -- | Attach the specified buffer to the current window switchToBufferE :: FBuffer -> Action switchToBufferE b = getWindow >>= UI.setWindowBuffer b -- | Attach the specified buffer to some other window than the current one switchToBufferOtherWindowE :: FBuffer -> Action switchToBufferOtherWindowE b = shiftOtherWindow >> switchToBufferE b -- | Find buffer with given name. Raise exception if not found. getBufferWithName :: String -> EditorM FBuffer getBufferWithName bufName = do bs <- readEditor $ \e -> findBufferWithName e bufName case bs of [] -> fail ("Buffer not found: " ++ bufName) (b:_) -> return b -- | Switch to the buffer specified as parameter. If the buffer name is empty, switch to the next buffer. switchToBufferWithNameE :: String -> Action switchToBufferWithNameE "" = nextBufW switchToBufferWithNameE bufName = switchToBufferE =<< getBufferWithName bufName -- | Open a minibuffer window with the given prompt and keymap spawnMinibufferE :: String -> KeymapMod -> Action -> Action spawnMinibufferE prompt kmMod initialAction = do b <- stringToNewBuffer prompt [] lift $ setBufferKeymap b kmMod w <- UI.newWindow True b UI.setWindow w initialAction -- | Write current buffer to disk, if this buffer is associated with a file fwriteE :: Action fwriteE = withBuffer hPutB -- | Write current buffer to disk as @f@. If this buffer doesn't -- currently have a file associated with it, the file is set to @f@ fwriteToE :: String -> Action fwriteToE f = withBuffer $ do setfileB f hPutB -- | Write all open buffers fwriteAllE :: Action fwriteAllE = undefined -- | Make a backup copy of file backupE :: FilePath -> Action backupE = undefined -- | Return a list of all buffers, and their indicies listBuffersE :: EditorM [(String,Int)] listBuffersE = do bs <- getBuffers return $ zip (map name bs) [0..] -- | Release resources associated with buffer, close any windows open -- onto buffer. closeBufferE :: String -> Action closeBufferE f = killBufferAndWindows f ------------------------------------------------------------------------ -- | Is the current buffer unmodifed? (currently buggy, we need -- bounaries in the undo list) isUnchangedE :: EditorM Bool isUnchangedE = withBuffer isUnchangedB -- | Set the current buffer to be unmodifed setUnchangedE :: Action setUnchangedE = undefined -- | Set the current buffer's highlighting kind setSynE :: String -> Action setSynE sy = withBuffer $ setSyntaxB sy ------------------------------------------------------------------------ -- -- Window operations -- | Make the next window (down the screen) the current window nextWinE :: Action nextWinE = nextWindow -- | Make the previous window (up the screen) the current window prevWinE :: Action prevWinE = prevWindow -- | Make window with key @k@ the current window setWinE :: Window -> Action setWinE = UI.setWindow -- | Split the current window, opening a second window onto this buffer. -- Windows smaller than 3 lines cannot be split. splitE :: Action splitE = do canSplit <- UI.hasRoomForExtraWindow if canSplit then splitWindow else errorE "Not enough room to split" -- | Enlarge the current window enlargeWinE :: Action enlargeWinE = getWindow >>= UI.enlargeWindow -- | Shrink the current window shrinkWinE :: Action shrinkWinE = getWindow >>= UI.shrinkWindow -- | Close the current window. -- If this is the last window open, quit the program. TODO this -- behaviour may be undesirable closeE :: Action closeE = do deleteThisWindow i <- sizeWindows when (i == 0) quitE -- | Make the current window the only window on the screen closeOtherE :: Action closeOtherE = do this <- getWindow -- current window others <- modifyEditor $ \e -> do let ws = getWindows e return (e, (filter (/= this) (map Just ws))) mapM_ UI.deleteWindow others ------------------------------------------------------------------------ -- -- Map a char function over a range of the buffer. -- -- Fold over a range is probably useful too.. -- -- !!!This is a very bad implementation; delete; apply; and insert the result. mapRangeE :: Int -> Int -> (Char -> Char) -> Action mapRangeE from to fn | from < 0 = nopE | otherwise = do withBuffer $ do eof <- sizeB when (to < eof) $ do let loop j | j <= 0 = return () | otherwise = do readB >>= return . fn >>= writeB rightB loop (j-1) loop (max 0 (to - from)) moveTo from reconfigE :: Action reconfigE = reloadE >> runConfig runConfig :: Action runConfig = do loaded <- withKernel $ \kernel -> do let cfgMod = mkModuleName kernel "YiConfig" isLoaded kernel cfgMod if loaded then do result <- withKernel $ \kernel -> compileExpr kernel "YiConfig.yiMain :: Yi.Yi.EditorM ()" case result of Nothing -> errorE "Could not run YiConfig.yiMain :: Yi.Yi.EditorM ()" Just x -> (unsafeCoerce# x) else errorE "YiConfig not loaded" loadE :: String -> EditorM [String] loadE modul = do modifyEditor_ $ \e -> return e { editorModules = nub (editorModules e ++ [modul]) } reloadE unloadE :: String -> EditorM [String] unloadE modul = do modifyEditor_ $ \e -> return e { editorModules = delete modul (editorModules e) } reloadE getNamesInScopeE :: EditorM [String] getNamesInScopeE = do withKernel $ \k -> do names <- getRdrNamesInScope k return (map (nameToString k) names) savingExcursion :: BufferM a -> BufferM a savingExcursion f = do m <- getMarkB Nothing res <- f moveTo =<< getMarkPointB m return res ghcErrorReporter :: IORef Editor -> GHC.Severity -> SrcLoc.SrcSpan -> Outputable.PprStyle -> ErrUtils.Message -> IO () ghcErrorReporter editor severity srcSpan pprStyle message = -- the following is written in very bad style. flip runReaderT editor $ do e <- readEditor id let [b] = findBufferWithName e "*console*" lift $ runBuffer b $ savingExcursion $ do moveTo =<< getMarkPointB =<< getMarkB (Just "errorInsert") insertN msg insertN "\n" where msg = case severity of GHC.SevInfo -> show (message pprStyle) GHC.SevFatal -> show (message pprStyle) _ -> show ((ErrUtils.mkLocMessage srcSpan message) pprStyle)