markup

examples/letter/letter.Eng.gf

@@ -3,7 +3,7 @@
 -- This file defines the English syntax of the grammar set 
 -- whose abstract syntax is $letter.Abs.gf$. 
 
-include letter.Abs.gf ;
+include letter.Abs.gf ; 
 
 flags lexer=textlit ; unlexer=textlit ;
 
@@ -44,8 +44,8 @@ Position   = SSDep ;
 
 lin
 MkLetter head mess end = 
-  ss (head.s ++ "," ++ "<p>" ++ 
-      mess.s ! end.n ! end.x ! head.n ! head.x ++ "." ++ "<p>" ++ 
+  ss (head.s ++ "," ++ "&-" ++ 
+      mess.s ! end.n ! end.x ! head.n ! head.x ++ "." ++ "&-" ++ 
       end.s ! head.n ! head.x) ;
 
 DearRec rec   = {s = "Dear" ++ rec.s ; n = rec.n ; x = rec.x} ;
@@ -62,10 +62,10 @@ PlainSent sent = sent ;
 
 FormalEnding auth = 
   {s = table {n => table {x => 
-     ["Sincerely yours <p>"] ++ auth.s ! n ! x}} ; n = auth.n ; x = auth.x} ;
+     ["Sincerely yours &-"] ++ auth.s ! n ! x}} ; n = auth.n ; x = auth.x} ;
 InformalEnding auth = 
   {s = table {n => table {x => 
-     ["With best regards <p>"] ++ auth.s ! n ! x}} ; n = auth.n ; x = auth.x} ;
+     ["With best regards &-"] ++ auth.s ! n ! x}} ; n = auth.n ; x = auth.x} ;
 
 ColleaguesHe  = {s = kollega ! pl ; n = pl ; x = masc} ;
 ColleaguesShe = {s = kollega ! pl ; n = pl ; x = fem} ;

examples/letter/letter.Fin.gf

@@ -84,8 +84,8 @@ Position   = SSDep ;
 
 lin
 MkLetter head mess end = 
-  ss (head.s ++ "," ++ "<p>" ++ 
-      mess.s ! end.n ! end.g ! head.n ! head.g ++ "." ++ "<p>" ++ 
+  ss (head.s ++ "," ++ "&-" ++ 
+      mess.s ! end.n ! end.g ! head.n ! head.g ++ "." ++ "&-" ++ 
       end.s ! head.n ! head.g) ;
 
 DearRec rec   = {s = cher ! rec.n ! rec.g ++ rec.s ; n = rec.n ; g = rec.g} ;
@@ -101,10 +101,10 @@ ModeSent mode sent =
 PlainSent sent = sent ;
 
 FormalEnding auth = 
-  {s = table {n => table {g => ["parhain terveisin <p>"] ++ auth.s ! n ! g}} ; 
+  {s = table {n => table {g => ["parhain terveisin &-"] ++ auth.s ! n ! g}} ; 
    n = auth.n ; g = auth.g} ;
 InformalEnding auth = 
-  {s = table {n => table {g => ["terveisin <p>"] ++ auth.s ! n ! g}} ; 
+  {s = table {n => table {g => ["terveisin &-"] ++ auth.s ! n ! g}} ; 
    n = auth.n ; g = auth.g} ;
 
 ColleaguesHe  = {s = regNom "kollega" ! pl  ; n = pl ; g = masc} ;

examples/letter/letter.Fra.gf

@@ -80,8 +80,8 @@ Position   = SSDep ;
 
 lin
 MkLetter head mess end = 
-  ss (head.s ++ "," ++ "<p>" ++ 
-      mess.s ! end.n ! end.g ! head.n ! head.g ++ "." ++ "<p>" ++ 
+  ss (head.s ++ "," ++ "&-" ++ 
+      mess.s ! end.n ! end.g ! head.n ! head.g ++ "." ++ "&-" ++ 
       end.s ! head.n ! head.g) ;
 
 DearRec rec   = {s = cher ! rec.n ! rec.g ++ rec.s ; n = rec.n ; g = rec.g} ;
@@ -100,10 +100,10 @@ FormalEnding auth =
   {s = 
      table {n => table {g => 
         "avec" ++ mes ! dep2num auth.n n ++ 
-        ["salutations distinguées <p>"] ++ auth.s ! n ! g}} ; 
+        ["salutations distinguées &-"] ++ auth.s ! n ! g}} ; 
    n = auth.n ; g = auth.g} ;
 InformalEnding auth = 
-  {s = table {n => table {g => ["Amicalement <p>"] ++ auth.s ! n ! g}} ; 
+  {s = table {n => table {g => ["Amicalement &-"] ++ auth.s ! n ! g}} ; 
    n = auth.n ; g = auth.g} ;
 
 ColleaguesHe  = {s = regNom "collègue" ! pl  ; n = pl ; g = masc} ;

examples/letter/letter.RusU.gf

@@ -85,8 +85,8 @@ Position   = SSDep ;
 
 lin
 MkLetter head mess end = 
-  ss (head.s ++ "," ++ "<p>" ++ 
-      mess.s ! end.n ! end.g ! head.n ! head.g ++ "." ++ "<p>" ++ 
+  ss (head.s ++ "," ++ "&-" ++ 
+      mess.s ! end.n ! end.g ! head.n ! head.g ++ "." ++ "&-" ++ 
       end.s ! head.n ! head.g) ;
 
 DearRec rec   = {s = regAdj "Дорог"
@@ -106,10 +106,10 @@ FormalEnding auth =
   {s = 
      table {n => table {g => 
         "С" ++  
-        ["наилучшими пожеланиями, <p>"] ++ auth.s ! n ! g}} ; 
+        ["наилучшими пожеланиями, &-"] ++ auth.s ! n ! g}} ; 
    n = auth.n ; g = auth.g} ;
 InformalEnding auth = 
-  {s = table {n => table {g => ["С дружеским приветом, <p>"] ++ auth.s ! n ! g}} ; 
+  {s = table {n => table {g => ["С дружеским приветом, &-"] ++ auth.s ! n ! g}} ; 
    n = auth.n ; g = auth.g} ;
 
 ColleaguesHe  = {s = "коллеги"   ; n = pl ; g = masc} ;

examples/letter/letter.Sve.gf

@@ -50,8 +50,8 @@ Position   = SSDep ;
 
 lin
 MkLetter head mess end = 
-  ss (head.s ++ "," ++ "<p>" ++ 
-      mess.s ! end.n ! end.x ! head.n ! head.x ++ "." ++ "<p>" ++ 
+  ss (head.s ++ "," ++ "&-" ++ 
+      mess.s ! end.n ! end.x ! head.n ! head.x ++ "." ++ "&-" ++ 
       end.s ! head.n ! head.x) ;
 
 DearRec rec   = {s = kaer ! rec.n ! rec.x ++ rec.s ; n = rec.n ; x = rec.x} ;
@@ -68,11 +68,11 @@ PlainSent sent = sent ;
 
 FormalEnding auth = 
   {s = table {n => table {x => 
-     ["Med vänlig hälsning <p>"] ++ auth.s ! n ! x}} ; n = auth.n ; x = auth.x} ;
+     ["Med vänlig hälsning &-"] ++ auth.s ! n ! x}} ; n = auth.n ; x = auth.x} ;
 
 InformalEnding auth = 
   {s = table {n => table {x => 
-     ["Med hälsningar <p>"] ++ auth.s ! n ! x}} ; n = auth.n ; x = auth.x} ;
+     ["Med hälsningar &-"] ++ auth.s ! n ! x}} ; n = auth.n ; x = auth.x} ;
 
 ColleaguesHe  = {s = kollega ! pl ; n = pl ; x = masc} ;
 ColleaguesShe = {s = kollega ! pl ; n = pl ; x = fem} ;

grammars/logic/ArithmEng.gf

@@ -1,3 +1,5 @@
+--# -path=.:../prelude
+
 concrete ArithmEng of Arithm = LogicEng ** open LogicResEng in {
 
 lin

grammars/logic/LogicEng.gf

@@ -1,4 +1,4 @@
-concrete LogicEng of Logic = open LogicResEng in {
+concrete LogicEng of Logic = open LogicResEng, Prelude in {
 
 flags lexer=vars ; unlexer=text ;
 
@@ -8,9 +8,10 @@ lincat
 
 lin 
 Statement A = {s = A.s ++ "."} ;
-ThmWithProof A a = {s = ["Theorem ."] ++ A.s ++ [". <p> Proof ."] ++ a.s ++ "."} ;
+ThmWithProof A a = {s = 
+  ["Theorem ."] ++ A.s ++ "." ++ PARA ++ "Proof" ++ "." ++ a.s ++ "."} ;
 ThmWithTrivialProof A a = 
-  {s = "Theorem" ++ "." ++ A.s ++ [". <p> Proof . Trivial ."]} ;
+  {s = "Theorem" ++ "." ++ A.s ++ "." ++ PARA ++ "Proof" ++ "." ++ "Trivial" ++ "."} ;
 Disj A B = {s = A.s ++ "or" ++ B.s} ;
 Conj A B = {s = A.s ++ "and" ++ B.s} ;
 Impl A B = {s = "if" ++ A.s ++ "then" ++ B.s} ;

grammars/prelude/Prelude.gf

@@ -94,6 +94,7 @@ oper
     glueOpt : Str -> Str -> Str = \x,y -> variants {glue x y ; x ++ y} ;
     noglueOpt : Str -> Str -> Str = \x,y -> variants {x ++ y ; glue x y} ;
 
--- this should be hidden, and never changed since it's hardcoded in (un)lexers
+-- these should be hidden, and never changed since it's hardcoded in (un)lexers
     BIND : Str = "&+" ;
+    PARA : Str = "&-" ;
 } ;

src/GF/Canon/AbsGFC.hs

@@ -129,6 +129,7 @@ data Term =
 
 data Tokn =
    KS String
+ | KM String
  | KP [String] [Variant]
   deriving (Eq,Ord,Show)
 

src/GF/Canon/CMacros.hs

@@ -16,37 +16,64 @@ import Monad
 -- macros for concrete syntax in GFC that do not need lookup in a grammar
 
 -- how to mark subtrees, dep. on node, position, whether focus
-type Marker = V.TrNode -> [Int] -> Bool -> (String, String)
+type JustMarker = V.TrNode -> [Int] -> Bool -> (String, String)
+
+-- also to process the text (needed for escapes e.g. in XML)
+type Marker = (JustMarker, Maybe (String -> String))
+
+defTMarker :: JustMarker -> Marker
+defTMarker = flip (curry id) Nothing
 
 markSubtree :: Marker -> V.TrNode -> [Int] -> Bool -> Term -> Term
-markSubtree mk n is = markSubterm . mk n is
+markSubtree (mk,esc) n is = markSubterm esc . mk n is
+
+escapeMkString :: Marker -> Maybe (String -> String)
+escapeMkString = snd
 
 -- if no marking is wanted, use the following
 noMark :: Marker
-noMark _ _ _ = ("","")
+noMark = defTMarker mk where
+  mk _ _ _ = ("","")
 
 -- for vanilla brackets, focus, and position, use
 markBracket :: Marker
-markBracket n p b = if b then ("[*" ++ show p,"*]") else ("[" ++ show p,"]")
+markBracket = defTMarker mk where
+  mk n p b = if b then ("[*" ++ show p,"*]") else ("[" ++ show p,"]")
 
 -- for focus only
 markFocus :: Marker
-markFocus n p b = if b then ("[*","*]") else ("","")
+markFocus = defTMarker mk where
+  mk n p b = if b then ("[*","*]") else ("","")
 
 -- for XML, use
-markXML :: Marker
-markXML n i b = 
+markJustXML :: JustMarker
+markJustXML n i b = 
   if b 
     then ("<focus"   +++ p +++ c ++ s ++ ">", "</focus>") 
     else ("<subtree" +++ p +++ c ++ s ++ ">", "</subtree>") 
    where 
      c = "type=" ++ prt (M.valNode n)
      p = "position=" ++ (show $ reverse i)
-     s = "" ---- if (null (M.constrsNode n)) then "" else " status=incorrect"
+     s = if (null (M.constrsNode n)) then "" else " status=incorrect"
+
+markXML :: Marker
+markXML = (markJustXML, Just esc) where
+  esc s = case s of
+   '\\':'<':cs  -> '\\':'<':esc cs
+   '\\':'>':cs  -> '\\':'>':esc cs
+   '\\':'\\':cs -> '\\':'\\':esc cs
+   ----- the first 3 needed because marking may revisit; needs to be fixed
+
+   '<':cs  -> '\\':'<':esc cs
+   '>':cs  -> '\\':'>':esc cs
+   '\\':cs -> '\\':'\\':esc cs
+   c  :cs  -> c     :esc cs
+   _ -> s
 
 -- for XML in JGF 1, use
 markXMLjgf :: Marker
-markXMLjgf n p b = 
+markXMLjgf = defTMarker mk where
+ mk n p b = 
   if b 
     then ("<focus" +++ c ++ ">", "</focus>") 
     else ("","")
@@ -54,19 +81,28 @@ markXMLjgf n p b =
      c = "type=" ++ prt (M.valNode n)
 
 -- the marking engine
-markSubterm :: (String,String) -> Term -> Term
-markSubterm (beg, end) t = case t of
+markSubterm :: Maybe (String -> String) -> (String,String) -> Term -> Term
+markSubterm esc (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 (tm beg ++ [mkEscIf t] ++ tm end)  -- t : Str guaranteed?
  where
-   mark = markSubterm (beg, end)
+   mark = markSubterm esc (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]
+   tm s = if null s then [] else [tM s]
+   mkEscIf t = case esc of
+     Just f -> mkEsc f t
+     _ -> t
+   mkEsc f t = case t of
+     K (KS s) -> K (KS (f s))
+     C u v    -> C (mkEsc f u) (mkEsc f v)
+     FV ts    -> FV (map (mkEsc f) ts)
+     _ -> t ---- do we need to look at other cases?
 
-tK :: String -> Term
+tK,tM :: String -> Term
 tK = K . KS
+tM = K . KM
 
 term2patt :: Term -> Err Patt
 term2patt trm = case trm of
@@ -120,6 +156,7 @@ valTableType t = case t of
 strsFromTerm :: Term -> Err [Str]
 strsFromTerm t = case t of
   K (KS s) -> return [str s]
+  K (KM s) -> return [str s]
   K (KP d vs) -> return $ [Str [TN d [(s,v) | Var s v <- vs]]]
   C s t -> do
     s' <- strsFromTerm s

src/GF/Canon/GFC.cf

@@ -115,6 +115,7 @@ E.    Term2 ::= "[" "]" ;
 
 KS.   Tokn  ::= String ;
 KP.   Tokn  ::= "[" "pre" [String] "{" [Variant] "}" "]" ;
+internal KM.   Tokn  ::= String ; -- mark-up
 
 Ass.  Assign  ::= Label "=" Term ;
 Cas.  Case    ::= [Patt] "=>" Term ;

src/GF/Canon/PrintGFC.hs

@@ -272,6 +272,7 @@ instance Print Term where
 instance Print Tokn where
   prt i e = case e of
    KS str -> prPrec i 0 (concatD [prt 0 str])
+   KM str -> prPrec i 0 (concatD [prt 0 str])
    KP strs variants -> prPrec i 0 (concatD [doc (showString "[") , doc (showString "pre") , prt 0 strs , doc (showString "{") , prt 0 variants , doc (showString "}") , doc (showString "]")])
 
 

src/GF/Canon/Unlex.hs

@@ -21,7 +21,7 @@ formatAsText = unwords . format . cap . words where
   cap [] = []
   major = flip elem (map (:[]) ".!?") 
   minor = flip elem (map (:[]) ",:;")
-  para  = (=="<p>") 
+  para  = (=="&-") 
 
 unlex :: [Str] -> String
 unlex = formatAsText . performBinds . concat . map sstr . take 1 ----

src/GF/Text/Text.hs

@@ -46,7 +46,7 @@ formatAsText = unwords . format . cap . words where
   cap [] = []
   major = flip elem (map singleton ".!?") 
   minor = flip elem (map singleton ",:;")
-  para  = (=="<p>") 
+  para  = (=="&-") 
 
 formatAsCode :: String -> String
 formatAsCode = rend 0 . words where