From bf436aebaa5b84bbb50e305e8f7dc9ca4ae34299 Mon Sep 17 00:00:00 2001 From: peb Date: Thu, 24 Feb 2005 10:46:37 +0000 Subject: "Committed_by_peb" --- src/GF/Shell/Commands.hs | 98 ++++++++++++++++++++++++++++++------------------ 1 file changed, 62 insertions(+), 36 deletions(-) (limited to 'src/GF/Shell/Commands.hs') diff --git a/src/GF/Shell/Commands.hs b/src/GF/Shell/Commands.hs index a8162c48b..7dc93a4fe 100644 --- a/src/GF/Shell/Commands.hs +++ b/src/GF/Shell/Commands.hs @@ -1,15 +1,19 @@ ---------------------------------------------------------------------- -- | --- Module : (Module) --- Maintainer : (Maintainer) +-- Module : Commands +-- Maintainer : AR -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/02/18 19:21:20 $ +-- > CVS $Date: 2005/02/24 11:46:36 $ -- > CVS $Author: peb $ --- > CVS $Revision: 1.34 $ +-- > CVS $Revision: 1.35 $ -- --- (Description of the module) +-- temporary hacks for GF 2.0 +-- +-- Abstract command language for syntax editing. AR 22\/8\/2001. +-- Most arguments are strings, to make it easier to receive them from e.g. Java. +-- See "CommandsL" for a parser of a command language. ----------------------------------------------------------------------------- module Commands where @@ -52,7 +56,7 @@ import Option import Str (sstr) ---- import UTF8 ---- -import Random (mkStdGen, newStdGen) +import Random (StdGen, mkStdGen, newStdGen) import Monad (liftM2, foldM) import List (intersperse) @@ -91,41 +95,46 @@ data Command = | CView | CMenu | CQuit - | CHelp (CEnv -> String) -- help message depends on grammar and interface - | CError -- syntax error in command - | CVoid -- empty command, e.g. just + | CHelp (CEnv -> String) -- ^ help message depends on grammar and interface + | CError -- ^ syntax error in command + | CVoid -- ^ empty command, e.g. just \ --- commands affecting CEnv - | CCEnvImport String - | CCEnvEmptyAndImport String - | CCEnvOpenTerm String - | CCEnvOpenString String - | CCEnvEmpty + | CCEnvImport String -- ^ |-- commands affecting 'CEnv' + | CCEnvEmptyAndImport String -- ^ | + | CCEnvOpenTerm String -- ^ | + | CCEnvOpenString String -- ^ | + | CCEnvEmpty -- ^ | - | CCEnvOn String - | CCEnvOff String + | CCEnvOn String -- ^ | + | CCEnvOff String -- ^ | - | CCEnvGFShell String + | CCEnvGFShell String -- ^ |========== --- other commands using IO - | CCEnvRefineWithTree String - | CCEnvRefineParse String - | CCEnvSave String FilePath + | CCEnvRefineWithTree String -- ^ |-- other commands using 'IO' + | CCEnvRefineParse String -- ^ | + | CCEnvSave String FilePath -- ^ |========== +isQuit :: Command -> Bool isQuit CQuit = True isQuit _ = False --- an abstract environment type - +-- | an abstract environment type type CEnv = ShellState +grammarCEnv :: CEnv -> StateGrammar grammarCEnv = firstStateGrammar + +canCEnv :: CEnv -> CanonGrammar canCEnv = canModules + +concreteCEnv, abstractCEnv :: StateGrammar -> I.Ident concreteCEnv = cncId abstractCEnv = absId +stdGenCEnv :: CEnv -> SState -> StdGen stdGenCEnv env s = mkStdGen (length (displayJustStateIn env s) * 31 +11) --- +initSStateEnv :: CEnv -> SState initSStateEnv env = case getOptVal (stateOptions sgr) gStartCat of Just cat -> action2commandNext (newCat gr (abs, I.identC cat)) initSState _ -> initSState @@ -134,8 +143,7 @@ initSStateEnv env = case getOptVal (stateOptions sgr) gStartCat of abs = absId sgr gr = stateGrammarST sgr --- the main function - +-- | the main function execCommand :: CEnv -> Command -> SState -> IO (CEnv,SState) execCommand env c s = case c of @@ -301,14 +309,14 @@ string2varPair s = case words s of _ -> Bad "expected format 'x y'" - +startEditEnv :: CEnv -> CEnv startEditEnv env = addGlobalOptions (options [sizeDisplay "short"]) env --- seen on display - +-- | seen on display cMenuDisplay :: String -> Command cMenuDisplay s = CAddOption (menuDisplay s) +newCatMenu :: CEnv -> [(Command, String)] newCatMenu env = [(CNewCat (prQIdent c), printname env initSState c) | (c,[]) <- allCatsOf (canCEnv env)] @@ -378,16 +386,19 @@ mkRefineMenuAll env sstate = -- there are three orthogonal parameters: Abs/[conc], short/long, typed/untyped -- the default is Abs, long, untyped; the Menus menu changes the parameter +emptyMenuItem :: (Command, (String, String)) emptyMenuItem = (CVoid,("","")) ---- allStringCommands = snd $ customInfo customStringCommand -termCommandMenu, stringCommandMenu :: [(Command,String)] +termCommandMenu :: [(Command,String)] termCommandMenu = [(CTermCommand s, s) | s <- allTermCommands] +allTermCommands :: [String] allTermCommands = snd $ customInfo customEditCommand +stringCommandMenu :: [(Command,String)] stringCommandMenu = [] displayCommandMenu :: CEnv -> [(Command,String)] @@ -413,7 +424,7 @@ changeMenuLanguage s = CAddOption (menuDisplay s) changeMenuSize s = CAddOption (sizeDisplay s) changeMenuTyped s = CAddOption (typeDisplay s) - +menuState :: CEnv -> SState -> [String] menuState env = map snd . mkRefineMenu env prState :: State -> [String] @@ -437,7 +448,7 @@ displaySStateIn env state = (tree',msg,menu) where linAll = map lin grs 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 isNew env state = encodeUTF8 $ mkUnicode $ unlines $ tagXML "gfedit" $ concat [ @@ -467,8 +478,9 @@ displaySStateJavaX isNew env state = encodeUTF8 $ mkUnicode $ Just lang -> optDecodeUTF8 (stateGrammarOfLang env (language lang)) _ -> id --- the env is UTF8 if the display language is ---- should be independent +-- | the env is UTF8 if the display language is +-- +-- should be independent isCEnvUTF8 :: CEnv -> SState -> Bool isCEnvUTF8 env st = maybe False id $ do lang <- getOptVal opts menuDisplay @@ -477,6 +489,7 @@ isCEnvUTF8 env st = maybe False id $ do where opts = addOptions (optsSState st) (globalOptions env) +langAbstract, langXML :: I.Ident langAbstract = language "Abstract" langXML = language "XML" @@ -517,13 +530,26 @@ printname env state f = case getOptVal opts menuDisplay of gr = grammar sgr mf = ciq (cncId sgr) (snd f) ---- XML printing; does not belong here! +-- * XML printing; does not belong here! +tagsXML :: String -> [[String]] -> [String] tagsXML t = concatMap (tagXML t) + +tagAttrXML :: String -> (String, String) -> [String] -> [String] tagAttrXML t av ss = mkTagAttrXML t av : map (indent 2) ss ++ [mkEndTagXML t] + +tagXML :: String -> [String] -> [String] tagXML t ss = mkTagXML t : map (indent 2) ss ++ [mkEndTagXML t] + +mkTagXML :: String -> String mkTagXML t = '<':t ++ ">" + +mkEndTagXML :: String -> String mkEndTagXML t = mkTagXML ('/':t) + +mkTagAttrsXML :: String -> [(String, String)] -> String mkTagAttrsXML t avs = '<':t +++ unwords [a++"="++v | (a,v) <- avs] ++">" -mkTagAttrXML t av = mkTagAttrsXML t [av] + +mkTagAttrXML :: String -> (String, String) -> String +mkTagAttrXML t av = mkTagAttrsXML t [av] -- cgit v1.2.3