macro commands

4 files changed, 52 insertions, 26 deletions

diff --git a/src/GF/Shell/Commands.hs b/src/GF/Shell/Commands.hs
index b1160d151..8699c2fe7 100644
--- a/src/GF/Shell/Commands.hs
+++ b/src/GF/Shell/Commands.hs
@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/08/17 15:13:55 $ 
+-- > CVS $Date: 2005/10/06 10:02:33 $ 
 -- > CVS $Author: aarne $
--- > CVS $Revision: 1.41 $
+-- > CVS $Revision: 1.42 $
 --
 -- temporary hacks for GF 2.0
 --
@@ -162,8 +162,9 @@ execCommand env c s = case c of
     return (startEditEnv emptyShellState, initSState)
 
   CCEnvGFShell command -> do
-    let cs = PShell.pCommandLines command
-    (msg,(env',_)) <- Shell.execLines False cs (Shell.initHState env)
+    let hs = Shell.initHState env
+    let cs = PShell.pCommandLines hs command
+    (msg,(env',_)) <- Shell.execLines False cs hs
     return (env', changeMsg msg s) ----
 
   CCEnvOpenTerm file -> do
diff --git a/src/GF/Shell/HelpFile.hs b/src/GF/Shell/HelpFile.hs
index 187e18740..3e41e0745 100644
--- a/src/GF/Shell/HelpFile.hs
+++ b/src/GF/Shell/HelpFile.hs
@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/10/05 20:02:19 $
+-- > CVS $Date: 2005/10/06 10:02:34 $
 -- > CVS $Author: aarne $
--- > CVS $Revision: 1.14 $
+-- > CVS $Revision: 1.15 $
 --
 -- Help on shell commands. Generated from HelpFile by 'make help'.
 -- PLEASE DON'T EDIT THIS FILE.
@@ -90,6 +90,23 @@ txtHelpFile =
   "\ns,  strip: s" ++
   "\n      Prune the state by removing source and resource modules." ++
   "\n" ++
+  "\ndc, define_command Name Anything" ++
+  "\n      Add a new defined command. The Name must star with '%'. Later," ++
+  "\n      if 'Name X' is used, it is replaced by Anything where #1 is replaced" ++
+  "\n      by X. Currently at most one argument is possible. To see" ++
+  "\n      definitions in scope, use help -defs." ++
+  "\n  examples:" ++
+  "\n      dc %tnp p -cat=NP -lang=Eng #1 | l -lang=Swe    -- translate NPs" ++
+  "\n      %tnp \"this man\" | p -lang=Swe                   -- translate and parse" ++
+  "\n" ++
+  "\ndt, define_term Name Tree" ++
+  "\n      Add a constant for a tree. The constant can later be called by" ++
+  "\n      prefixing it with '$'. It is not yet usable as a subterm. To see" ++
+  "\n      definitions in scope, use help -defs." ++
+  "\n  examples:" ++
+  "\n      p -cat=NP \"this man\" | dt tm    -- define tm as parse result" ++
+  "\n      l -all $tm                      -- linearize tm in all forms" ++
+  "\n" ++
   "\n-- commands that give information about the state" ++
   "\n" ++
   "\npg, print_grammar: pg" ++
@@ -445,7 +462,8 @@ txtHelpFile =
   "\n      Displays the paragraph concerning the command from this help file." ++
   "\n      Without the argument, shows the first lines of all paragraphs." ++
   "\n  options" ++
-  "\n       -all  show the whole help file" ++
+  "\n       -all   show the whole help file" ++
+  "\n       -defs  show user-defined commands and terms" ++
   "\n  examples:" ++
   "\n       h print_grammar  -- show all information on the pg command" ++
   "\n" ++
diff --git a/src/GF/Shell/PShell.hs b/src/GF/Shell/PShell.hs
index d01366728..aefd066d5 100644
--- a/src/GF/Shell/PShell.hs
+++ b/src/GF/Shell/PShell.hs
@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/10/05 20:02:20 $ 
+-- > CVS $Date: 2005/10/06 10:02:34 $ 
 -- > CVS $Author: aarne $
--- > CVS $Revision: 1.26 $
+-- > CVS $Revision: 1.27 $
 --
 -- parsing GF shell commands. AR 11\/11\/2001
 -----------------------------------------------------------------------------
@@ -30,18 +30,19 @@ import System.IO.Error
 -- parsing GF shell commands. AR 11/11/2001
 
 -- | getting a sequence of command lines as input
-getCommandLines :: IO (String,[CommandLine])
-getCommandLines = do
+getCommandLines :: HState -> IO (String,[CommandLine])
+getCommandLines st = do
   s <- fetchCommand "> "
-  return (s,pCommandLines s)
+  return (s,pCommandLines st s)
 
-getCommandLinesBatch :: IO (String,[CommandLine])
-getCommandLinesBatch = do
+getCommandLinesBatch :: HState -> IO (String,[CommandLine])
+getCommandLinesBatch st = do
   s <- catch getLine (\e -> if isEOFError e then return "q" else ioError e)
-  return $ (s,pCommandLines s)
+  return $ (s,pCommandLines st s)
 
-pCommandLines :: String -> [CommandLine]
-pCommandLines = map pCommandLine . concatMap (chunks ";;" . wordsLits) . lines
+pCommandLines :: HState -> String -> [CommandLine]
+pCommandLines st = 
+  map (pCommandLine st) . concatMap (chunks ";;" . wordsLits) . lines
 
 -- | Like 'words', but does not split on whitespace inside
 --   double quotes.
@@ -60,23 +61,25 @@ unquote :: String -> String
 unquote (x:xs@(_:_)) | x `elem` "\"'" && x == last xs = init xs
 unquote s = s
 
-pCommandLine :: [String] -> CommandLine
-pCommandLine s = pFirst (chks s) where
+pCommandLine :: HState -> [String] -> CommandLine
+pCommandLine st (dc:c:def) | abbrevCommand dc == "dc" = ((CDefineCommand c def, noOptions),AUnit,[])
+pCommandLine st s = pFirst (chks s) where
   pFirst cos = case cos of
     (c,os,[a]) : cs -> ((c,os), a, pCont cs)
     _               -> ((CVoid,noOptions), AError "no parse", [])
   pCont cos = case cos of
     (c,os,_)   : cs -> (c,os) : pCont cs
     _               -> []
-  chks = map pCommandOpt . chunks "|"
+  chks = map (pCommandOpt st) . chunks "|"
 
-pCommandOpt :: [String] -> (Command, Options, [CommandArg])
-pCommandOpt (w:ws) = let 
+pCommandOpt :: HState -> [String] -> (Command, Options, [CommandArg])
+pCommandOpt st (c@('%':_):args) = pCommandOpt st $ resolveShMacro st c args 
+pCommandOpt _ (w:ws) = let 
   (os, co)     = getOptions "-" ws
   (comm, args) = pCommand (abbrevCommand w:co)
   in
   (comm, os, args)
-pCommandOpt s = (CVoid, noOptions, [AError "no parse"])
+pCommandOpt _ s = (CVoid, noOptions, [AError "no parse"])
 
 pInputString :: String -> [CommandArg]
 pInputString s = case s of
@@ -104,6 +107,7 @@ pCommand ws = case ws of
   "cl" : f : [] -> aUnit   (CConvertLatex f)
 
   "ph" : []     -> aUnit   CPrintHistory
+  "dt" : f : t  -> aTerm   (CDefineTerm (unquote f)) t
 
   "l"  : s      -> aTermLi CLinearize s
 
diff --git a/src/GF/Shell/ShellCommands.hs b/src/GF/Shell/ShellCommands.hs
index c2d2b367b..b41dc0b69 100644
--- a/src/GF/Shell/ShellCommands.hs
+++ b/src/GF/Shell/ShellCommands.hs
@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/10/05 20:02:20 $ 
+-- > CVS $Date: 2005/10/06 10:02:34 $ 
 -- > CVS $Author: aarne $
--- > CVS $Revision: 1.40 $
+-- > CVS $Revision: 1.41 $
 --
 -- The datatype of shell commands and the list of their options.
 -----------------------------------------------------------------------------
@@ -40,6 +40,9 @@ data Command =
  | CTransformGrammar FilePath
  | CConvertLatex FilePath
 
+ | CDefineCommand String [String]
+ | CDefineTerm String
+
  | CLinearize [()] ---- parameters
  | CParse
  | CTranslate Language Language
@@ -200,7 +203,7 @@ optionsOfCommand co = case co of
   CPrintMultiGrammar -> both "utf8 utf8id" "printer"
   CPrintSourceGrammar -> both "utf8" "printer"
 
-  CHelp _ -> opts "all filter length lexer unlexer printer transform depth number"
+  CHelp _ -> opts "all defs filter length lexer unlexer printer transform depth number"
 
   CImpure ICEditSession -> both "f" "file"
   CImpure ICTranslateSession -> both "f langs" "cat"