mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-05-29 12:48:54 -06:00
hmsg for Hajo's editor
This commit is contained in:
@@ -5,9 +5,9 @@
|
|||||||
-- Stability : (stable)
|
-- Stability : (stable)
|
||||||
-- Portability : (portable)
|
-- Portability : (portable)
|
||||||
--
|
--
|
||||||
-- > CVS $Date: 2005/02/24 11:46:36 $
|
-- > CVS $Date: 2005/03/10 11:14:11 $
|
||||||
-- > CVS $Author: peb $
|
-- > CVS $Author: aarne $
|
||||||
-- > CVS $Revision: 1.14 $
|
-- > CVS $Revision: 1.15 $
|
||||||
--
|
--
|
||||||
-- (Description of the module)
|
-- (Description of the module)
|
||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
@@ -77,13 +77,19 @@ getCommand = do
|
|||||||
|
|
||||||
-- | decodes UTF8 if u==False, i.e. if the grammar does not use UTF8;
|
-- | decodes UTF8 if u==False, i.e. if the grammar does not use UTF8;
|
||||||
-- used in the Java GUI, which always uses UTF8
|
-- used in the Java GUI, which always uses UTF8
|
||||||
getCommandUTF :: Bool -> IO Command
|
getCommandUTF :: Bool -> IO (String,Command)
|
||||||
getCommandUTF u = do
|
getCommandUTF u = do
|
||||||
s <- getLine
|
s <- getLine
|
||||||
return $ pCommand $ if u then s else decodeUTF8 s
|
return $ pCommandMsg $ if u then s else decodeUTF8 s
|
||||||
|
|
||||||
pCommand :: String -> Command
|
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
|
pCommandWords s = case s of
|
||||||
"n" : cat : _ -> CNewCat cat
|
"n" : cat : _ -> CNewCat cat
|
||||||
"t" : ws -> CNewTree $ unwords ws
|
"t" : ws -> CNewTree $ unwords ws
|
||||||
|
|||||||
@@ -5,9 +5,9 @@
|
|||||||
-- Stability : (stable)
|
-- Stability : (stable)
|
||||||
-- Portability : (portable)
|
-- Portability : (portable)
|
||||||
--
|
--
|
||||||
-- > CVS $Date: 2005/02/24 11:46:36 $
|
-- > CVS $Date: 2005/03/10 11:14:11 $
|
||||||
-- > CVS $Author: peb $
|
-- > CVS $Author: aarne $
|
||||||
-- > CVS $Revision: 1.35 $
|
-- > CVS $Revision: 1.36 $
|
||||||
--
|
--
|
||||||
-- temporary hacks for GF 2.0
|
-- temporary hacks for GF 2.0
|
||||||
--
|
--
|
||||||
@@ -449,9 +449,10 @@ displaySStateIn env state = (tree',msg,menu) where
|
|||||||
separ = singleton . map unlines . intersperse [replicate 72 '*']
|
separ = singleton . map unlines . intersperse [replicate 72 '*']
|
||||||
|
|
||||||
-- | the Boolean is a temporary hack to have two parallel GUIs
|
-- | the Boolean is a temporary hack to have two parallel GUIs
|
||||||
displaySStateJavaX :: Bool -> CEnv -> SState -> String
|
displaySStateJavaX :: Bool -> CEnv -> SState -> String -> String
|
||||||
displaySStateJavaX isNew env state = encodeUTF8 $ mkUnicode $
|
displaySStateJavaX isNew env state m = encodeUTF8 $ mkUnicode $
|
||||||
unlines $ tagXML "gfedit" $ concat [
|
unlines $ tagXML "gfedit" $ concat [
|
||||||
|
if null m then [] else tagXML "hmsg" [m],
|
||||||
tagXML "linearizations" (concat
|
tagXML "linearizations" (concat
|
||||||
[tagAttrXML "lin" ("lang", prLanguage lang) ss | (lang,ss) <- lins]),
|
[tagAttrXML "lin" ("lang", prLanguage lang) ss | (lang,ss) <- lins]),
|
||||||
tagXML "tree" tree,
|
tagXML "tree" tree,
|
||||||
|
|||||||
@@ -5,9 +5,9 @@
|
|||||||
-- Stability : (stable)
|
-- Stability : (stable)
|
||||||
-- Portability : (portable)
|
-- Portability : (portable)
|
||||||
--
|
--
|
||||||
-- > CVS $Date: 2005/02/24 11:46:37 $
|
-- > CVS $Date: 2005/03/10 11:14:11 $
|
||||||
-- > CVS $Author: peb $
|
-- > CVS $Author: aarne $
|
||||||
-- > CVS $Revision: 1.10 $
|
-- > CVS $Revision: 1.11 $
|
||||||
--
|
--
|
||||||
-- GF editing session controlled by e.g. a Java program. AR 16\/11\/2001
|
-- 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
|
-- the Boolean is a temporary hack to have two parallel GUIs
|
||||||
editLoopJnewX :: Bool -> CEnv -> SState -> IO ()
|
editLoopJnewX :: Bool -> CEnv -> SState -> IO ()
|
||||||
editLoopJnewX isNew env state = do
|
editLoopJnewX isNew env state = do
|
||||||
c <- getCommandUTF (isCEnvUTF8 env state) ----
|
(m,c) <- getCommandUTF (isCEnvUTF8 env state) ----
|
||||||
case c of
|
case c of
|
||||||
CQuit -> return ()
|
CQuit -> return ()
|
||||||
|
|
||||||
c -> do
|
c -> do
|
||||||
(env',state') <- execCommand env c state
|
(env',state') <- execCommand env c state
|
||||||
let inits = initAndEditMsgJavaX isNew env' state'
|
let inits = initAndEditMsgJavaX isNew env' state' m
|
||||||
let package = case c of
|
let package = case c of
|
||||||
CCEnvImport _ -> inits
|
CCEnvImport _ -> inits
|
||||||
CCEnvEmptyAndImport _ -> inits
|
CCEnvEmptyAndImport _ -> inits
|
||||||
CCEnvOpenTerm _ -> inits
|
CCEnvOpenTerm _ -> inits
|
||||||
CCEnvOpenString _ -> inits
|
CCEnvOpenString _ -> inits
|
||||||
CCEnvEmpty -> initEditMsgJavaX env'
|
CCEnvEmpty -> initEditMsgJavaX env'
|
||||||
_ -> displaySStateJavaX isNew env' state'
|
_ -> displaySStateJavaX isNew env' state' m
|
||||||
putStrLnFlush package
|
putStrLnFlush package
|
||||||
editLoopJnewX isNew env' state'
|
editLoopJnewX isNew env' state'
|
||||||
|
|
||||||
@@ -74,6 +74,6 @@ initEditMsgJavaX env = encodeUTF8 $ mkUnicode $ unlines $ tagXML "gfinit" $
|
|||||||
(file,lang) <- zip (allGrammarFileNames env) (allLanguages env)]
|
(file,lang) <- zip (allGrammarFileNames env) (allLanguages env)]
|
||||||
|
|
||||||
|
|
||||||
initAndEditMsgJavaX :: Bool -> CEnv -> SState -> String
|
initAndEditMsgJavaX :: Bool -> CEnv -> SState -> String -> String
|
||||||
initAndEditMsgJavaX isNew env state =
|
initAndEditMsgJavaX isNew env state m =
|
||||||
initEditMsgJavaX env ++++ displaySStateJavaX isNew env state
|
initEditMsgJavaX env ++++ displaySStateJavaX isNew env state m
|
||||||
|
|||||||
Reference in New Issue
Block a user