maranget · cspiel · Jun 15, 2020 · Jul 23, 2020 · Aug 27, 2020 · Sep 2, 2020
diff --git a/doc/text.tex b/doc/text.tex
diff --git a/html.ml b/html.ml
@@ -496,6 +496,7 @@ and has_mod = has_mod
 and clearstyle = clearstyle
 and nostyle = nostyle
 and get_fontsize = get_fontsize
+and get_pending_styles = get_pending_styles
 and to_string = to_string
 
 (****************************************)

diff --git a/html/hevea.hva b/html/hevea.hva
@@ -311,7 +311,7 @@
 }\fi
 \@print{</head>
 }%
-\@print{<body }\@notags{\@bodyargs}\@print{>
+\@print{<body class="serif" }\@notags{\@bodyargs}\@print{>
 }%
 \@print{<!--HEVEA command line is: }\usebox{\@heveacomline}\@print{-->
 }%
@@ -431,11 +431,27 @@
 \newcommand{\@open@quote}[1]{\@open{blockquote}{#1}}
 \newcommand{\@close@quote}{\@close{blockquote}}
 %%%%%%%%%%%%%%%% LaTeX 2.09 style declarations
-\newenvironment{tt}{\@span{style="font-family:monospace"}}{}
-\newenvironment{bf}{\@span{style="font-weight:bold"}}{}
+\newstyle{.serif}{font-family: serif}
+\newstyle{.sansserif}{font-family: sans-serif}
+\newstyle{.monospace}{font-family: monospace}
+\newstyle{.italic}{font-style: italic}
+\newstyle{.slanted}{font-style: oblique}
+\newstyle{.smallcaps}{font-variant: small-caps}
+\newstyle{.bold}{font-weight: bold}
+%
+\newsavebox{\@pending@style}
+\newcommand{\@main@styles}{serif,sansserif,monospace,cursive,fantasy}
+\newcommand{\@main@modifier@styles}{bold,italic,slanted,smallcaps}
+\newcommand{\@save@top@style}{\sbox{\@pending@style}{\@top@pending@style{\@main@styles}}}
+\newcommand{\@save@all@styles}{\sbox{\@pending@style}{\@all@pending@styles{\@main@modifier@styles}}}
+\newcommand{\@use@pending@style}{\@getprint{\@pending@style}}
+%
+\newenvironment{tt}{\@save@all@styles\@span{class="\@use@pending@style monospace"}}{}
+\newenvironment{bf}{\@save@top@style\@span{class="\@use@pending@style bold"}}{}
 \newenvironment{em}{\@style{em}}{}
-\newenvironment{it}{\@span{style="font-style:italic"}}{}
-\newenvironment{rm}{\@anti{\it,\bf,\em,\sf,\tt}}{}
+\newenvironment{it}{\@save@top@style\@span{class="\@use@pending@style italic"}}{}
+\newenvironment{rm}{\@anti{\em,\sf,\tt}\@save@all@styles\@span{class="\@use@pending@style serif"}}{}
+\newenvironment{oldstyle}{\@span{class="oldstyle"}}{}
 \newenvironment{tiny}{\@fontsize{1}}{}
 \newenvironment{footnotesize}{\@fontsize{2}}{}
 \newenvironment{scriptsize}{\@fontsize{2}}{}
@@ -464,13 +480,13 @@
 \newenvironment{blue}{\@fontcolor{blue}}{}
 \newenvironment{teal}{\@fontcolor{teal}}{}
 \newenvironment{aqua}{\@fontcolor{aqua}}{}
-\def\cal{\ifmath\ifmathml\@style{font-family: cursive }%
+\def\cal{\ifmath\ifmathml\@style{font-family: cursive}%
 \else\red\fi\else\red\fi}
-\def\sf{\ifmath\ifmathml\@style{font-family: sans-serif }%
-\else\@span{style="font-family:sans-serif"}\fi\else\@span{style="font-family:sans-serif"}\fi}
-\def\sl{\ifmath\ifmathml\@style{font-family: fantasy; font-style: italic }%
-\else\@span{style="font-style:oblique"}\fi\else\@span{style="font-style:oblique"}\fi}
-\def\sc{\@span{style="font-variant:small-caps"}}%
+\def\sf{\ifmath\ifmathml\@style{font-family: sans-serif}%
+\else\@span{class="sansserif"}\fi\else\@span{class="sansserif"}\fi}
+\def\sl{\ifmath\ifmathml\@style{font-family: fantasy; font-style: italic}%
+\else\@span{class="slanted"}\fi\else\@save@top@style\@span{class="\@use@pending@style slanted"}\fi}
+\def\sc{\@save@top@style\@span{class="\@use@pending@style smallcaps"}}%
 %%%% LaTeX2e verbose declarations
 \newenvironment{mdseries}{\@anti{\bf}}{}
 \newenvironment{bfseries}{\bf}{}
@@ -481,7 +497,7 @@
 \newenvironment{itshape}{\@anti{\sl,\sc}\it}{}
 \newenvironment{slshape}{\@anti{\it,\sc}\sl}{}
 \newenvironment{scshape}{\@anti{\it,\sl}\sc}{}
-\newenvironment{normalfont}{\rm\mdseries\upshape}{}
+\newenvironment{normalfont}{\@anti{\em,\bf,\sf,\tt}\upshape}{}
 %%%%%%%%%%%%%%%%
 \def\textrm#1{\mbox{\rmfamily#1}}
 \def\textup#1{\mbox{\upshape#1}}
@@ -494,6 +510,7 @@
 \def\textsl#1{\mbox{\slshape#1}}
 \def\textsc#1{\mbox{\scshape#1}}
 \newcommand{\emph}[1]{\mbox{\em#1}}
+\newcommand{\oldstylenums}[1]{\mbox{\oldstyle#1}}%
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 %  New implementation of \sc & \textsc using "small-caps" style. %
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

diff --git a/htmlCommon.ml b/htmlCommon.ml
@@ -824,6 +824,28 @@ let all_to_pending out =
 
 let all_to_active out = activate "all_to_active" (all_to_pending out)
 
+let get_pending_styles () =
+  let {pending = pending_styles; active = _active_environments; top = _top_info} = !cur_out in
+    List.fold_left
+      (fun accumulator style ->
+        match style with
+        | StyleAttr (_element, attribute) ->
+           (*prerr_endline ("get_pending_styles: StyleAttr: " ^ element ^ ", " ^ attribute);*)
+           List.fold_left
+             (fun a {Scanattr.name = attribute_name; value = attribute_value} ->
+               match attribute_name with
+               | "class" -> a @ String.split_on_char ' ' attribute_value
+               | _other -> a)
+             accumulator
+             (Scanattr.scan_html_attribute (Lexing.from_string attribute))
+        | Style _s ->
+           (*prerr_endline ("get_pending_styles: Style " ^ s);*)
+           accumulator
+        | Font _index -> accumulator
+        | Color _name -> accumulator)
+      []
+      pending_styles
+
 (* Clear styles *)
 let clearstyle () =
   close_active_mods !cur_out.active ;

diff --git a/info.ml b/info.ml
@@ -22,6 +22,7 @@ let restart = Text.restart;;
 let is_empty=Text.is_empty;;
 
 let get_fontsize=Text.get_fontsize;;
+let get_pending_styles=Text.get_pending_styles;;
 let nostyle=Text.nostyle;;
 let clearstyle=Text.clearstyle;;
 let open_mod=open_mod;;

diff --git a/latexscan.mll b/latexscan.mll
@@ -2534,6 +2534,44 @@ def_code "\\@anti"
     Dest.erase_mods envs)
 ;;
 
+def_code "\\@all@pending@styles"
+  (fun lexbuf ->
+    let wanted_styles = String.split_on_char ',' (get_prim_arg lexbuf)
+    and pending_styles = Dest.get_pending_styles () in
+      let rec iter = function
+        | top :: rest ->
+           if wanted_styles = [] || List.mem top wanted_styles then
+             begin
+               Dest.put top;
+               Dest.put_char ' '
+             end;
+           iter rest
+        | [] -> ()
+      in
+        iter pending_styles)
+;;
+
+def_code "\\@top@pending@style"
+  (fun lexbuf ->
+    let wanted_styles = String.split_on_char ',' (get_prim_arg lexbuf)
+    and pending_styles = Dest.get_pending_styles () in
+      let rec iter = function
+        | top :: rest ->
+           if List.mem top wanted_styles then
+             begin
+               Dest.put top;
+               Dest.put_char ' '
+             end
+           else
+             iter rest
+        | [] -> ()
+      in
+        (*prerr_endline ("@top@pending@style: " ^ String.concat ", " pending_styles);*)
+        (* This is an ugly heuristic: if we find no style pending, assume the first
+           of the [wanted_styles] is active. *)
+        iter (if pending_styles = [] then wanted_styles else pending_styles))
+;;
+
 let styles_stack = MyStack.create "styles"
 ;;
 

diff --git a/outManager.mli b/outManager.mli
@@ -18,6 +18,7 @@ val restart : unit -> unit
 val is_empty : unit -> bool
 
 val get_fontsize : unit -> int
+val get_pending_styles : unit -> string list
 val nostyle : unit -> unit
 val clearstyle : unit -> unit
 val open_mod : Element.text -> unit

diff --git a/scanattr.mli b/scanattr.mli
@@ -0,0 +1,16 @@
+(*
+ *  This file is distributed under the terms of the GNU General Public
+ *  License either version 2 of the License, or (at your option) any
+ *  later version, as detailed in the file LICENSE.
+ *
+ *  Copyright (C) 2020  Christoph L. Spiel
+ *)
+
+
+type html_attribute = {
+    name: string;
+    value: string;
+}
+
+
+val scan_html_attribute: Lexing.lexbuf -> html_attribute list
diff --git a/scanattr.mll b/scanattr.mll
@@ -0,0 +1,60 @@
+(*
+ *  This file is distributed under the terms of the GNU General Public
+ *  License either version 2 of the License, or (at your option) any
+ *  later version, as detailed in the file LICENSE.
+ *
+ *  Copyright (C) 2020  Christoph L. Spiel
+ *)
+
+
+{
+  type html_attribute = {
+    name: string;
+    value: string;
+  }
+}
+
+
+let optional_white = ['\t' '\n' '\r' ' ']*
+let attribute_name = [^ '\x00'-'\x1F' '\x20' '\x22' '\x27' '\x2F' '\x3D' '\x3E' '\x7F'-'\x9F']+
+let unquoted_value = [^ '\x20' '"' '\'' '=' '<' '>' '`']+
+let single_quoted_value = [^ '\'']+
+let double_quoted_value = [^ '"']+
+
+
+rule scan attributes = parse
+| ['\t' '\n' '\r' ' ']+
+  {
+    scan attributes lexbuf
+  }
+| (attribute_name as name)
+  {
+    {name; value = ""} :: attributes
+  }
+| (attribute_name as name) optional_white '=' optional_white (unquoted_value as attribute_value)
+  {
+    {name; value = attribute_value} :: attributes
+  }
+| (attribute_name as name) optional_white '=' optional_white '\'' (single_quoted_value as attribute_value) '\''
+  {
+    {name; value = attribute_value} :: attributes
+  }
+| (attribute_name as name) optional_white '=' optional_white '"' (double_quoted_value as attribute_value) '"'
+  {
+    {name; value = attribute_value} :: attributes
+  }
+| eof
+  {
+    []
+  }
+
+
+{
+  let scan_html_attribute a_lexbuffer =
+    let rec scan_all a =
+      match scan a a_lexbuffer with
+      | [] -> List.rev a
+      | xs -> scan_all xs
+    in
+      scan_all []
+}
diff --git a/text.ml b/text.ml
@@ -633,7 +633,7 @@ let is_list = function
 ;;
 
 let get_fontsize () = 3;;
-
+let get_pending_styles () = [];;
 let nostyle () = !cur_out.nostyle<-true
 ;;
-Original file line number
+Diff line change
@@ Expand Up / @@ -633,7 +633,7 @@ let is_list = function @@
     ;;
     let get_fontsize () = 3;;
+    let get_pending_styles () = [];;
     let nostyle () = !cur_out.nostyle<-true
     ;;
@@ Expand Down @@