hmsg for Hajo's editor

3 files changed, 28 insertions, 21 deletions

diff --git a/src/GF/Shell/CommandL.hs b/src/GF/Shell/CommandL.hs
index 8419038b6..9f7315c56 100644
--- a/src/GF/Shell/CommandL.hs
+++ b/src/GF/Shell/CommandL.hs
@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/24 11:46:36 $ 
--- > CVS $Author: peb $
--- > CVS $Revision: 1.14 $
+-- > CVS $Date: 2005/03/10 11:14:11 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.15 $
 --
 -- (Description of the module)
 -----------------------------------------------------------------------------
@@ -77,13 +77,19 @@ getCommand = do
 
 -- | decodes UTF8 if u==False, i.e. if the grammar does not use UTF8;
 -- used in the Java GUI, which always uses UTF8
-getCommandUTF :: Bool -> IO Command
+getCommandUTF :: Bool -> IO (String,Command)
 getCommandUTF u = do
   s <- getLine
-  return $ pCommand $ if u then s else decodeUTF8 s 
+  return $ pCommandMsg $ if u then s else decodeUTF8 s 
 
 pCommand :: String -> Command
-pCommand = pCommandWords . words where 
+pCommand = snd . pCommandMsg
+
+pCommandMsg :: String -> (String,Command)
+pCommandMsg s = (m,pCommandWords $ words c) where
+  (m,c) = case s of
+    '[':s2 -> let (a,b) = span (/=']') s2 in (a,drop 1 b)
+    _ -> ("",s) 
   pCommandWords s = case s of
     "n" : cat : _ -> CNewCat cat
     "t" : ws      -> CNewTree $ unwords ws
diff --git a/src/GF/Shell/Commands.hs b/src/GF/Shell/Commands.hs
index 7dc93a4fe..03cd7cbe2 100644
--- a/src/GF/Shell/Commands.hs
+++ b/src/GF/Shell/Commands.hs
@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/24 11:46:36 $ 
--- > CVS $Author: peb $
--- > CVS $Revision: 1.35 $
+-- > CVS $Date: 2005/03/10 11:14:11 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.36 $
 --
 -- temporary hacks for GF 2.0
 --
@@ -449,9 +449,10 @@ displaySStateIn env state = (tree',msg,menu) where
   separ  = singleton . map unlines . intersperse [replicate 72 '*']
 
 -- | the Boolean is a temporary hack to have two parallel GUIs
-displaySStateJavaX :: Bool -> CEnv -> SState -> String
-displaySStateJavaX isNew env state = encodeUTF8 $ mkUnicode $
-                                     unlines $ tagXML "gfedit" $ concat [
+displaySStateJavaX :: Bool -> CEnv -> SState -> String -> String
+displaySStateJavaX isNew env state m = encodeUTF8 $ mkUnicode $
+                                       unlines $ tagXML "gfedit" $ concat [
+  if null m then [] else tagXML "hmsg" [m],
   tagXML "linearizations" (concat 
     [tagAttrXML "lin" ("lang", prLanguage lang) ss | (lang,ss) <- lins]),
   tagXML "tree"           tree,
diff --git a/src/GF/Shell/JGF.hs b/src/GF/Shell/JGF.hs
index 9404ababc..e3438a33c 100644
--- a/src/GF/Shell/JGF.hs
+++ b/src/GF/Shell/JGF.hs
@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/24 11:46:37 $ 
--- > CVS $Author: peb $
--- > CVS $Revision: 1.10 $
+-- > CVS $Date: 2005/03/10 11:14:11 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.11 $
 --
 -- GF editing session controlled by e.g. a Java program. AR 16\/11\/2001
 -----------------------------------------------------------------------------
@@ -43,20 +43,20 @@ sessionLineJ isNew env = do
 -- the Boolean is a temporary hack to have two parallel GUIs
 editLoopJnewX :: Bool -> CEnv -> SState -> IO ()
 editLoopJnewX isNew env state = do
-  c <- getCommandUTF (isCEnvUTF8 env state) ----
+  (m,c) <- getCommandUTF (isCEnvUTF8 env state) ----
   case c of
     CQuit -> return ()
 
     c -> do
       (env',state') <- execCommand env c state
-      let inits = initAndEditMsgJavaX isNew env' state'
+      let inits = initAndEditMsgJavaX isNew env' state' m
       let package = case c of
             CCEnvImport _         -> inits
             CCEnvEmptyAndImport _ -> inits
             CCEnvOpenTerm _       -> inits
             CCEnvOpenString _     -> inits
             CCEnvEmpty            -> initEditMsgJavaX env'
-            _ -> displaySStateJavaX isNew env' state'
+            _ -> displaySStateJavaX isNew env' state' m
       putStrLnFlush package
       editLoopJnewX isNew env' state'
 
@@ -74,6 +74,6 @@ initEditMsgJavaX env = encodeUTF8 $ mkUnicode $ unlines $ tagXML "gfinit" $
            (file,lang) <- zip (allGrammarFileNames env) (allLanguages env)]
 
 
-initAndEditMsgJavaX :: Bool -> CEnv -> SState -> String
-initAndEditMsgJavaX isNew env state = 
-  initEditMsgJavaX env ++++ displaySStateJavaX isNew env state
+initAndEditMsgJavaX :: Bool -> CEnv -> SState -> String -> String
+initAndEditMsgJavaX isNew env state m = 
+  initEditMsgJavaX env ++++ displaySStateJavaX isNew env state m