summaryrefslogtreecommitdiff
path: root/src/GF/Shell
diff options
context:
space:
mode:
Diffstat (limited to 'src/GF/Shell')
-rw-r--r--src/GF/Shell/CommandL.hs25
-rw-r--r--src/GF/Shell/Commands.hs98
-rw-r--r--src/GF/Shell/JGF.hs22
-rw-r--r--src/GF/Shell/PShell.hs16
-rw-r--r--src/GF/Shell/ShellCommands.hs8
-rw-r--r--src/GF/Shell/SubShell.hs12
-rw-r--r--src/GF/Shell/TeachYourself.hs16
7 files changed, 116 insertions, 81 deletions
diff --git a/src/GF/Shell/CommandL.hs b/src/GF/Shell/CommandL.hs
index e7b78c222..8419038b6 100644
--- a/src/GF/Shell/CommandL.hs
+++ b/src/GF/Shell/CommandL.hs
@@ -1,13 +1,13 @@
----------------------------------------------------------------------
-- |
--- Module : (Module)
--- Maintainer : (Maintainer)
+-- Module : CommandL
+-- 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.13 $
+-- > CVS $Revision: 1.14 $
--
-- (Description of the module)
-----------------------------------------------------------------------------
@@ -32,8 +32,7 @@ import Monad (foldM)
import UTF8
--- a line-based shell
-
+-- | a line-based shell
initEditLoop :: CEnv -> IO () -> IO ()
initEditLoop env resume = do
let env' = startEditEnv env
@@ -55,8 +54,7 @@ editLoop env state resume = do
editLoop env' state' resume
--- execute a command script and return a tree
-
+-- | execute a command script and return a tree
execCommandHistory :: CEnv -> String -> IO (CEnv,Tree)
execCommandHistory env s = do
let env' = startEditEnv env
@@ -77,14 +75,14 @@ getCommand = do
s <- getLine
return $ pCommand s
--- 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
-
getCommandUTF :: Bool -> IO Command
getCommandUTF u = do
s <- getLine
return $ pCommand $ if u then s else decodeUTF8 s
+pCommand :: String -> Command
pCommand = pCommandWords . words where
pCommandWords s = case s of
"n" : cat : _ -> CNewCat cat
@@ -147,7 +145,8 @@ pCommand = pCommandWords . words where
[] -> CVoid
_ -> CError
--- well, this lists the commands of the line-based editor
+-- | well, this lists the commands of the line-based editor
+initEditMsg :: CEnv -> String
initEditMsg env = unlines $
"State-dependent editing commands are given in the menu:" :
" n [Cat] = new, r [Fun] = refine, w [Fun] [Int] = wrap,":
@@ -166,17 +165,19 @@ initEditMsg env = unlines $
---- (" f [" ++ unwords (intersperse "|" allStringCommands) ++ "] = modify output") :
[]
+initEditMsgEmpty :: CEnv -> String
initEditMsgEmpty env = initEditMsg env +++++ unlines (
"Start editing by n Cat selecting category\n\n" :
"-------------\n" :
["n" +++ cat | (_,cat) <- newCatMenu env]
)
+showCurrentState :: CEnv -> SState -> String
showCurrentState env' state' =
unlines (tr ++ ["",""] ++ msg ++ ["",""] ++ map fst menu)
where (tr,msg,menu) = displaySStateIn env' state'
--- to read position; borrowed from Prelude; should be elsewhere
+-- | to read position; borrowed from Prelude; should be elsewhere
readIntList :: String -> [Int]
readIntList s = case [x | (x,t) <- reads s, ("","") <- lex t] of
[x] -> x
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 <enter>
+ | CHelp (CEnv -> String) -- ^ help message depends on grammar and interface
+ | CError -- ^ syntax error in command
+ | CVoid -- ^ empty command, e.g. just \<enter\>
--- 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]
diff --git a/src/GF/Shell/JGF.hs b/src/GF/Shell/JGF.hs
index 17bd563e9..9404ababc 100644
--- a/src/GF/Shell/JGF.hs
+++ b/src/GF/Shell/JGF.hs
@@ -1,15 +1,15 @@
----------------------------------------------------------------------
-- |
--- Module : (Module)
--- Maintainer : (Maintainer)
+-- Module : JGF
+-- Maintainer : AR
-- Stability : (stable)
-- Portability : (portable)
--
--- > CVS $Date: 2005/02/18 19:21:20 $
+-- > CVS $Date: 2005/02/24 11:46:37 $
-- > CVS $Author: peb $
--- > CVS $Revision: 1.9 $
+-- > CVS $Revision: 1.10 $
--
--- (Description of the module)
+-- GF editing session controlled by e.g. a Java program. AR 16\/11\/2001
-----------------------------------------------------------------------------
module JGF where
@@ -31,16 +31,16 @@ import UTF8
-- GF editing session controlled by e.g. a Java program. AR 16/11/2001
----- the Boolean is a temporary hack to have two parallel GUIs
+-- | the Boolean is a temporary hack to have two parallel GUIs
sessionLineJ :: Bool -> ShellState -> IO ()
sessionLineJ isNew env = do
putStrLnFlush $ initEditMsgJavaX env
let env' = addGlobalOptions (options [sizeDisplay "short",beSilent]) env
editLoopJnewX isNew env' (initSState)
--- this is the real version, with XML
-
----- the Boolean is a temporary hack to have two parallel GUIs
+-- | this is the real version, with XML
+--
+-- 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) ----
@@ -60,10 +60,12 @@ editLoopJnewX isNew env state = do
putStrLnFlush package
editLoopJnewX isNew env' state'
+welcome :: String
welcome =
"An experimental GF Editor for Java." ++
"(c) Kristofer Johannisson, Janna Khegai, and Aarne Ranta 2002 under CNU GPL."
+initEditMsgJavaX :: CEnv -> String
initEditMsgJavaX env = encodeUTF8 $ mkUnicode $ unlines $ tagXML "gfinit" $
tagsXML "newcat" [["n" +++ cat] | (_,cat) <- newCatMenu env] ++
tagXML "topic" [abstractName env] ++
@@ -71,5 +73,7 @@ initEditMsgJavaX env = encodeUTF8 $ mkUnicode $ unlines $ tagXML "gfinit" $
concat [tagAttrXML "language" ("file",file) [prLanguage lang] |
(file,lang) <- zip (allGrammarFileNames env) (allLanguages env)]
+
+initAndEditMsgJavaX :: Bool -> CEnv -> SState -> String
initAndEditMsgJavaX isNew env state =
initEditMsgJavaX env ++++ displaySStateJavaX isNew env state
diff --git a/src/GF/Shell/PShell.hs b/src/GF/Shell/PShell.hs
index cc5731ff2..bb375d00d 100644
--- a/src/GF/Shell/PShell.hs
+++ b/src/GF/Shell/PShell.hs
@@ -1,15 +1,15 @@
----------------------------------------------------------------------
-- |
--- Module : (Module)
--- Maintainer : (Maintainer)
+-- Module : PShell
+-- Maintainer : AR
-- Stability : (stable)
-- Portability : (portable)
--
--- > CVS $Date: 2005/02/18 19:21:20 $
+-- > CVS $Date: 2005/02/24 11:46:37 $
-- > CVS $Author: peb $
--- > CVS $Revision: 1.17 $
+-- > CVS $Revision: 1.18 $
--
--- (Description of the module)
+-- parsing GF shell commands. AR 11\/11\/2001
-----------------------------------------------------------------------------
module PShell where
@@ -29,8 +29,7 @@ import IO
-- parsing GF shell commands. AR 11/11/2001
--- getting a sequence of command lines as input
-
+-- | getting a sequence of command lines as input
getCommandLines :: IO (String,[CommandLine])
getCommandLines = do
s <- fetchCommand "> "
@@ -67,8 +66,7 @@ pInputString s = case s of
('"':_:_) -> [AString (init (tail s))]
_ -> [AError "illegal string"]
--- command rl can be written remove_language etc.
-
+-- | command @rl@ can be written @remove_language@ etc.
abbrevCommand :: String -> String
abbrevCommand = hds . words . map u2sp where
u2sp c = if c=='_' then ' ' else c
diff --git a/src/GF/Shell/ShellCommands.hs b/src/GF/Shell/ShellCommands.hs
index b7e678e4c..a2ef91eab 100644
--- a/src/GF/Shell/ShellCommands.hs
+++ b/src/GF/Shell/ShellCommands.hs
@@ -1,13 +1,13 @@
----------------------------------------------------------------------
-- |
--- Module : (Module)
--- Maintainer : (Maintainer)
+-- Module : ShellCommands
+-- Maintainer : AR
-- Stability : (stable)
-- Portability : (portable)
--
--- > CVS $Date: 2005/02/18 19:21:20 $
+-- > CVS $Date: 2005/02/24 11:46:37 $
-- > CVS $Author: peb $
--- > CVS $Revision: 1.22 $
+-- > CVS $Revision: 1.23 $
--
-- The datatype of shell commands and the list of their options.
-----------------------------------------------------------------------------
diff --git a/src/GF/Shell/SubShell.hs b/src/GF/Shell/SubShell.hs
index cad79fce0..66d7f5253 100644
--- a/src/GF/Shell/SubShell.hs
+++ b/src/GF/Shell/SubShell.hs
@@ -1,13 +1,13 @@
----------------------------------------------------------------------
-- |
--- Module : (Module)
--- Maintainer : (Maintainer)
+-- Module : SubShell
+-- Maintainer : AR
-- Stability : (stable)
-- Portability : (portable)
--
--- > CVS $Date: 2005/02/18 19:21:20 $
+-- > CVS $Date: 2005/02/24 11:46:37 $
-- > CVS $Author: peb $
--- > CVS $Revision: 1.6 $
+-- > CVS $Revision: 1.7 $
--
-- (Description of the module)
-----------------------------------------------------------------------------
@@ -35,7 +35,10 @@ editSession opts st
st' = addGlobalOptions opts st
font = maybe myUniFont mkOptFont $ getOptVal opts useFont
+myUniFont :: String
myUniFont = "-mutt-clearlyu-medium-r-normal--0-0-100-100-p-0-iso10646-1"
+
+mkOptFont :: String -> String
mkOptFont = id
translateSession :: Options -> ShellState -> IO ()
@@ -49,6 +52,7 @@ translateSession opts st = do
else translateBetweenAll grs cat s
translateLoop opts trans
+translateLoop :: Options -> (String -> String) -> IO ()
translateLoop opts trans = do
let fud = oElem makeFudget opts
font = maybe myUniFont mkOptFont $ getOptVal opts useFont
diff --git a/src/GF/Shell/TeachYourself.hs b/src/GF/Shell/TeachYourself.hs
index 0a006c4ac..7cb3594f7 100644
--- a/src/GF/Shell/TeachYourself.hs
+++ b/src/GF/Shell/TeachYourself.hs
@@ -1,15 +1,15 @@
----------------------------------------------------------------------
-- |
--- Module : (Module)
--- Maintainer : (Maintainer)
+-- Module : TeachYourself
+-- Maintainer : AR
-- Stability : (stable)
-- Portability : (portable)
--
--- > CVS $Date: 2005/02/18 19:21:20 $
+-- > CVS $Date: 2005/02/24 11:46:37 $
-- > CVS $Author: peb $
--- > CVS $Revision: 1.4 $
+-- > CVS $Revision: 1.5 $
--
--- (Description of the module)
+-- translation and morphology quiz. AR 10\/5\/2000 -- 12\/4\/2002
-----------------------------------------------------------------------------
module TeachYourself where
@@ -71,15 +71,17 @@ morphoTrainList opts ig number = do
gr = grammar ig
cnc = cncId ig
--- compare answer to the list of right answers, increase score and give feedback
+-- | compare answer to the list of right answers, increase score and give feedback
mkAnswer :: [String] -> String -> (Integer, String)
mkAnswer as s = if (elem (norml s) as)
then (1,"Yes.")
else (0,"No, not" +++ s ++ ", but" ++++ unlines as)
+
+norml :: String -> String
norml = unwords . words
---- the maximal number of precompiled quiz problems
+-- | the maximal number of precompiled quiz problems
infinity :: Integer
infinity = 123
generated by cgit v1.2.3 (git 2.39.1) at 2026-05-20 07:05:02 +0000