term macro help

src-3.0/GF/Command/Commands.hs

@@ -114,14 +114,21 @@ allCommands pgf = Map.fromList [
      }),
   ("dt",  emptyCommandInfo {
      longname = "define_tree",
-     syntax = "dt IDENT (TREE | STRING)", -- | '<' COMMANDLINE)",
+     syntax = "dt IDENT (TREE | STRING | \"<\" COMMANDLINE)",
      synopsis = "define a tree or string macro",
      explanation = unlines [
        "Defines IDENT as macro for TREE or STRING, until IDENT gets redefined.",
-       -- "The defining value can also come from a command, preceded by '<'.",
+       "The defining value can also come from a command, preceded by \"<\".",
+       "If the command gives many values, the first one is selected.",
        "A use of the macro has the form %IDENT. Currently this use cannot be",
        "a subtree of another tree. This command must be a line of its own",
        "and thus cannot be a part of a pipe."
+       ],
+     examples = [
+       ("dt ex \"hello world\"                    -- define ex as string"),
+       ("dt ex UseN man_N                         -- define ex as string"),
+       ("dt ex < p -cat=NP \"the man in the car\" -- define ex as parse result"),
+       ("l -lang=LangSwe %ex | ps -to_utf8        -- linearize the tree ex")
        ] 
      }),
   ("e",  emptyCommandInfo {

src-3.0/GF/Command/Interpreter.hs

@@ -3,6 +3,7 @@ module GF.Command.Interpreter (
   mkCommandEnv,
   emptyCommandEnv,
   interpretCommandLine,
+  interpretPipe,
   getCommandOp
   ) where
 
@@ -36,15 +37,17 @@ interpretCommandLine :: CommandEnv -> String -> IO ()
 interpretCommandLine env line =
   case readCommandLine line of
     Just []    -> return ()
-    Just pipes -> do res <- runInterruptibly (mapM_ interPipe pipes)
+    Just pipes -> do res <- runInterruptibly (mapM_ (interpretPipe env) pipes)
                      case res of
                        Left ex -> putStrLnFlush (show ex)
                        Right x -> return x
     Nothing    -> putStrLnFlush "command not parsed"
- where
+
-   interPipe cs = do
+interpretPipe env cs = do
-     (_,s) <- intercs ([],"") cs
+     v@(_,s) <- intercs ([],"") cs
      putStrLnFlush s
+     return v
+  where
    intercs treess [] = return treess
    intercs (trees,_) (c:cs) = do
      treess2 <- interc trees c
@@ -52,7 +55,7 @@ interpretCommandLine env line =
    interc es comm@(Command co _ arg) = case co of
      '%':f -> case Map.lookup f (commandmacros env) of
        Just css -> do
-         mapM_ interPipe (appLine (getCommandArg env arg es) css) 
+         mapM_ (interpretPipe env) (appLine (getCommandArg env arg es) css) 
          return ([],[]) ---- return ?
        _ -> do
          putStrLn $ "command macro " ++ co ++ " not interpreted"

src-3.0/GFI.hs

@@ -60,13 +60,14 @@ loop opts gfenv0 = do
            ('-':w):ws2 -> (pTermPrintStyle w, ws2)
            _ -> (TermPrintDefault, ws)
        case pTerm (unwords term) >>= checkTerm sgr >>= computeTerm sgr of   ---- pipe!
-         Ok  x -> putStrLn (showTerm style x)
+         Ok  x -> putStrLnFlush (showTerm style x)
-         Bad s -> putStrLn s
+         Bad s -> putStrLnFlush s
        loopNewCPU gfenv
     "i":args -> do
         gfenv' <- case parseOptions args of
           Ok (opts',files) -> importInEnv gfenv (addOptions opts opts') files
-                    Bad err -> do putStrLn $ "Command parse error: " ++ err
+          Bad err -> do 
+            putStrLn $ "Command parse error: " ++ err
             return gfenv
         loopNewCPU gfenv'
 
@@ -82,7 +83,23 @@ loop opts gfenv0 = do
              commandmacros = Map.insert f comm (commandmacros env)
              }
            }
-         _ -> putStrLn "command definition not parsed" >> loopNewCPU gfenv
+         _ -> putStrLnFlush "command definition not parsed" >> loopNewCPU gfenv
+
+    "dt":f:"<":ws -> do
+       case readCommandLine (unwords ws) of
+         Just [pip] -> do
+           ip <- interpretPipe env pip
+           case ip of
+             (exp:es,_) -> do 
+               if null es then return () else
+                 putStrLnFlush $ "ambiguous definition, selected the first one"
+               loopNewCPU $ gfenv {
+                 commandenv = env {
+                   expmacros = Map.insert f exp (expmacros env)
+                   }
+                 }
+             _ -> putStrLnFlush "no value given in definition" >> loopNewCPU gfenv
+         _ -> putStrLnFlush "value definition not parsed" >> loopNewCPU gfenv
 
     "dt":f:ws -> do
        case readExp (unwords ws) of
@@ -91,10 +108,10 @@ loop opts gfenv0 = do
              expmacros = Map.insert f exp (expmacros env)
              }
            }
-         _ -> putStrLn "value definition not parsed" >> loopNewCPU gfenv
+         _ -> putStrLnFlush "value definition not parsed" >> loopNewCPU gfenv
 
-    "ph":_ -> mapM_ putStrLn (reverse (history gfenv0)) >> loopNewCPU gfenv
+    "ph":_ -> mapM_ putStrLnFlush (reverse (history gfenv0)) >> loopNewCPU gfenv
-    "q":_  -> putStrLn "See you." >> return gfenv
+    "q":_  -> putStrLnFlush "See you." >> return gfenv
 
   -- ordinary commands, working on CommandEnv
     _ -> do
@@ -108,10 +125,13 @@ importInEnv gfenv opts files
            return $ gfenv {sourcegrammar = src}
     | otherwise =
         do let opts' = addOptions (setOptimization OptCSE False) opts
-               pgf0 = multigrammar (commandenv gfenv)
+               cenv0 = commandenv gfenv
+               pgf0  = multigrammar cenv0 
            pgf1 <- importGrammar pgf0 opts' files
            putStrLnFlush $ unwords $ "\nLanguages:" : languages pgf1
-           return $ gfenv { commandenv = mkCommandEnv pgf1 }
+           return $ gfenv { commandenv = (mkCommandEnv pgf1) 
+             {commandmacros = commandmacros cenv0, expmacros = expmacros cenv0}}
+---           return $ gfenv { commandenv = cenv0 {multigrammar = pgf1} } -- WHY NOT
 
 welcome = unlines [
   "                              ",