bug fixes ; command so ; reintroduce batch mode

1 files changed, 77 insertions, 0 deletions

diff --git a/src/GF/GFModes.hs b/src/GF/GFModes.hs
new file mode 100644
index 000000000..6944dd0d3
--- /dev/null
+++ b/src/GF/GFModes.hs
@@ -0,0 +1,77 @@
+module GFModes where
+
+import Operations
+import UseIO
+import Option
+import ShellState
+import ShellCommands
+import Shell
+import SubShell
+import PShell
+import JGF
+import Char (isSpace)
+
+-- separated from GF Main 24/6/2003
+
+gfInteract :: HState -> IO HState
+gfInteract st@(env,_) = do
+  -- putStrFlush "> " M.F 25/01-02 prompt moved to Arch.
+  (s,cs) <- getCommandLines
+  case ifImpure cs of
+
+    -- these are the three impure commands
+    Just (ICQuit,_) -> do
+      putStrLnFlush "See you."
+      return st
+    Just (ICExecuteHistory file,_) -> do
+      ss  <- readFileIf file
+      let co = pCommandLines ss
+      st' <- execLinesH s co st      
+      gfInteract st'      
+    Just (ICEarlierCommand i,_) -> do
+      let line = earlierCommandH st i
+          co   = pCommandLine $ words line
+      st' <- execLinesH line [co] st       -- s would not work in execLinesH
+      gfInteract st'
+
+    Just (ICEditSession,os) -> 
+      editSession (addOptions os opts) env >> gfInteract st
+    Just (ICTranslateSession,os) -> 
+      translateSession (addOptions os opts) env >> gfInteract st
+
+    -- this is a normal command sequence
+    _ -> do
+      st' <- execLinesH s cs st
+      gfInteract st'
+   where
+     opts = globalOptions env
+
+gfBatch :: HState -> IO HState
+gfBatch st@(sh,_) = do
+  (s,cs) <- getCommandLinesBatch
+  if s == "q" then return st else do
+    st' <- if all isSpace s then return st else do
+        putVe "<gfcommand>"
+        putVe s
+        putVe "</gfcommand>"
+        putVe "<gfreply>"
+        (_,st') <- execLines True cs st
+        putVe "</gfreply>"
+        return st'
+    gfBatch st'
+ where
+   putVe = putVerb st
+
+putVerb st@(sh,_) s = if (oElem beSilent (globalOptions sh))
+                          then return ()
+                          else putStrLnFlush s 
+
+batchCompile :: Options -> FilePath -> IO ()
+batchCompile os file = do
+  let file' = mkGFC file
+  let s     = "i -o" +++ (unwords $ map ('-':) $ words $ prOpts os) +++ file
+  let cs    = pCommandLines s
+  execLines True cs (initHState emptyShellState)
+  return ()
+
+mkGFC = reverse . ("cfg" ++) . dropWhile (/='.') . reverse