module Yi.Mode.Interactive where
import Control.Applicative ((<$>))
import Control.Concurrent (threadDelay)
import Control.Lens (use, (%~), (.=))
import Data.Monoid ((<>))
import qualified Data.Text as T (Text)
import Yi.Buffer
import Yi.Core (sendToProcess, startSubprocess, withSyntax)
import Yi.Editor
import Yi.History (historyFinishGen, historyMoveGen, historyStartGen)
import Yi.Keymap (YiM, topKeymapA)
import Yi.Keymap.Keys (Key (KEnter, KHome), char, choice, meta, spec, (<||), (?>>!))
import Yi.Lexer.Alex (Tok)
import Yi.Lexer.Compilation (Token)
import qualified Yi.Mode.Compilation as Compilation (mode)
import Yi.Modes (lookupMode)
import Yi.Monad (gets)
import qualified Yi.Rope as R (YiString, fromText, toString, toText)
import qualified Yi.Syntax.OnlineTree as OnlineTree (Tree)
import Yi.Utils (io)
mode :: Mode (OnlineTree.Tree (Tok Token))
mode = Compilation.mode
{ modeApplies = modeNeverApplies,
modeName = "interactive",
modeKeymap = topKeymapA %~ (<||)
(choice
[spec KHome ?>>! moveToSol,
spec KEnter ?>>! do
eof <- withCurrentBuffer atLastLine
if eof
then feedCommand
else withSyntax modeFollow,
meta (char 'p') ?>>! interactHistoryMove 1,
meta (char 'n') ?>>! interactHistoryMove (1)
])
}
interactId :: T.Text
interactId = "Interact"
interactHistoryMove :: Int -> EditorM ()
interactHistoryMove delta =
historyMoveGen interactId delta (R.toText <$> withCurrentBuffer getInput) >>= inp
where
inp = withCurrentBuffer . setInput . R.fromText
interactHistoryFinish :: EditorM ()
interactHistoryFinish =
historyFinishGen interactId (R.toText <$> withCurrentBuffer getInput)
interactHistoryStart :: EditorM ()
interactHistoryStart = historyStartGen interactId
getInputRegion :: BufferM Region
getInputRegion = do mo <- getMarkB (Just "StdOUT")
p <- pointAt botB
q <- use $ markPointA mo
return $ mkRegion p q
getInput :: BufferM R.YiString
getInput = readRegionB =<< getInputRegion
setInput :: R.YiString -> BufferM ()
setInput val = flip replaceRegionB val =<< getInputRegion
spawnProcess :: String -> [String] -> YiM BufferRef
spawnProcess = spawnProcessMode mode
spawnProcessMode :: Mode syntax -> FilePath -> [String] -> YiM BufferRef
spawnProcessMode interMode cmd args = do
b <- startSubprocess cmd args (const $ return ())
withEditor interactHistoryStart
mode' <- lookupMode $ AnyMode interMode
withCurrentBuffer $ do
m1 <- getMarkB (Just "StdERR")
m2 <- getMarkB (Just "StdOUT")
modifyMarkB m1 (\v -> v {markGravity = Backward})
modifyMarkB m2 (\v -> v {markGravity = Backward})
setAnyMode mode'
return b
feedCommand :: YiM ()
feedCommand = do
b <- gets currentBuffer
withEditor interactHistoryFinish
cmd <- withCurrentBuffer $ do
botB
newlineB
me <- getMarkB (Just "StdERR")
mo <- getMarkB (Just "StdOUT")
p <- pointB
q <- use $ markPointA mo
cmd <- readRegionB $ mkRegion p q
markPointA me .= p
markPointA mo .= p
return $ R.toString cmd
withEditor interactHistoryStart
sendToProcess b cmd
queryReply :: BufferRef -> String -> YiM R.YiString
queryReply buf cmd = do
start <- withGivenBuffer buf (botB >> pointB)
sendToProcess buf (cmd <> "\n")
io $ threadDelay 50000
withGivenBuffer buf $ do
botB
moveToSol
leftB
end <- pointB
result <- readRegionB (mkRegion start end)
botB
return result