From 6719aedde34c3a4f0ccb78931968c6fe490b3282 Mon Sep 17 00:00:00 2001
From: aarne <unknown>
Date: Fri, 26 Mar 2004 20:08:30 +0000
Subject: Better help.

---
 src/GF/Canon/CMacros.hs   |  5 +++--
 src/GF/Data/Operations.hs |  6 ++++++
 src/GF/Grammar/Macros.hs  | 14 ++++++++++++++
 src/GF/Infra/Option.hs    |  2 ++
 src/GF/Shell.hs           |  9 ++++++---
 src/GF/Shell/PShell.hs    |  3 ++-
 6 files changed, 33 insertions(+), 6 deletions(-)

(limited to 'src/GF')

diff --git a/src/GF/Canon/CMacros.hs b/src/GF/Canon/CMacros.hs
index 85a465871..0a8b360be 100644
--- a/src/GF/Canon/CMacros.hs
+++ b/src/GF/Canon/CMacros.hs
@@ -58,11 +58,12 @@ markSubterm (beg, end) t = case t of
   R rs -> R $ map markField rs 
   T ty cs -> T ty [Cas p (mark v) | Cas p v <- cs]
   FV ts -> FV $ map mark ts
-  _    -> foldr1 C [tK beg, t, tK end]  -- t : Str guaranteed?
+  _    -> foldr1 C (tk beg ++ [t] ++ tk end)  -- t : Str guaranteed?
  where
    mark = markSubterm (beg, end)
    markField lt@(Ass l t) = if isLinLabel l then (Ass l (mark t)) else lt
-   
+   tk s = if null s then [] else [tK s]
+
 tK :: String -> Term
 tK = K . KS
 
diff --git a/src/GF/Data/Operations.hs b/src/GF/Data/Operations.hs
index 08ebdd45c..dd8e37380 100644
--- a/src/GF/Data/Operations.hs
+++ b/src/GF/Data/Operations.hs
@@ -311,6 +311,12 @@ type WParser a b = [a] -> [(b,[a])] -- old Wadler style parser
 wParseResults :: WParser a b -> [a] -> [b]
 wParseResults p aa = [b | (b,[]) <- p aa]
 
+paragraphs :: String -> [String]
+paragraphs = map unlines . chop . lines where
+  chop [] = []
+  chop ss = let (ps,rest) = break empty ss in ps : chop (dropWhile empty rest)
+  empty = all isSpace
+
 -- printing
 
 indent :: Int -> String -> String
diff --git a/src/GF/Grammar/Macros.hs b/src/GF/Grammar/Macros.hs
index cc43377cb..075da2a9d 100644
--- a/src/GF/Grammar/Macros.hs
+++ b/src/GF/Grammar/Macros.hs
@@ -128,6 +128,20 @@ unComputed t = case t of
   Computed v -> unComputed v
   _ -> t --- composSafeOp unComputed t
 
+
+{- 
+--- defined (better) in compile/PrOld
+
+stripTerm :: Term -> Term
+stripTerm t = case t of
+  Q _ c  -> Cn c
+  QC _ c -> Cn c
+  T ti psts -> T ti [(stripPatt p, stripTerm v) | (p,v) <- psts]
+  _ -> composSafeOp stripTerm t
+ where
+   stripPatt p = errVal p $ term2patt $ stripTerm $ patt2term p
+-}
+
 computed = Computed
 
 termForm :: Term -> Err ([(Ident)], Term, [Term])
diff --git a/src/GF/Infra/Option.hs b/src/GF/Infra/Option.hs
index a46127f16..fe56c23fc 100644
--- a/src/GF/Infra/Option.hs
+++ b/src/GF/Infra/Option.hs
@@ -160,6 +160,8 @@ doCompute    = iOpt "c"
 optimizeCanon = iOpt "opt"
 stripQualif   = iOpt "strip"
 nostripQualif = iOpt "nostrip"
+showAll      = iOpt "all"
+fromSource   = iOpt "src"
 
 -- mainly for stand-alone
 useUnicode    = iOpt "unicode"
diff --git a/src/GF/Shell.hs b/src/GF/Shell.hs
index e6a0880ff..5136a00d0 100644
--- a/src/GF/Shell.hs
+++ b/src/GF/Shell.hs
@@ -80,7 +80,7 @@ data Command =
  | CPrintCanonXML
  | CPrintCanonXMLStruct 
  | CPrintHistory
- | CHelp
+ | CHelp (Maybe String)
 
  | CImpure ImpureCommand
 
@@ -177,7 +177,7 @@ execC co@(comm, opts0) sa@((st,(h,_)),a) = case comm of
   CTestTokenizer -> changeArg (AString . optTokenizer opts gro . prCommandArg) sa
 
   CComputeConcrete m t -> 
-    justOutput (putStrLn (err id prt (
+    justOutput (putStrLn (err id (prt . stripTerm) (
                 string2srcTerm src m t >>= Co.computeConcrete src))) sa
 
   CTranslationQuiz il ol -> justOutput (teachTranslation opts (sgr il) (sgr ol)) sa
@@ -201,7 +201,10 @@ execC co@(comm, opts0) sa@((st,(h,_)),a) = case comm of
   CSetFlag           -> changeState (addGlobalOptions opts0) sa
 ---- deprec!  CSetLocalFlag lang -> changeState (addLocalOptions lang opts0) sa
 
-  CHelp              -> returnArg   (AString txtHelpFile) sa
+  CHelp (Just c) -> returnArg   (AString (txtHelpCommand c)) sa
+  CHelp _
+    | oElem showAll opts  -> returnArg   (AString txtHelpFile) sa
+    | otherwise           -> returnArg   (AString txtHelpFileSummary) sa
 
   CPrintGrammar
     | oElem showOld opts -> returnArg (AString $ printGrammarOld (canModules st)) sa
diff --git a/src/GF/Shell/PShell.hs b/src/GF/Shell/PShell.hs
index f890a8dcf..0157112c8 100644
--- a/src/GF/Shell/PShell.hs
+++ b/src/GF/Shell/PShell.hs
@@ -104,7 +104,8 @@ pCommand ws = case ws of
   "pm"  : []     -> aUnit CPrintMultiGrammar
   "po"  : []     -> aUnit CPrintGlobalOptions
   "pl"  : []     -> aUnit CPrintLanguages
-  "h"   : []     -> aUnit CHelp
+  "h"   : c : [] -> aUnit $ CHelp (Just (abbrevCommand c))
+  "h"   : []     -> aUnit $ CHelp Nothing
 
   "q"  : []     -> aImpure ICQuit
   "eh" : f : [] -> aImpure (ICExecuteHistory f)
-- 
cgit v1.2.3