diff --git a/bin/forester/theme/style.css b/bin/forester/theme/style.css
index 5091bd1..8775f39 100644
--- a/bin/forester/theme/style.css
+++ b/bin/forester/theme/style.css
@@ -250,11 +250,22 @@ span.taxon {
font-weight: bolder;
}
+.mainmatter,
+ul.block {
+ counter-reset: section-num;
+}
-.link-list>section>details>summary>header h1 {
- font-size: 12pt;
+.numbered {
+ counter-increment: section-num;
+}
+
+.section-number::before {
+ content: " " counters(section-num, ".") ". ";
}
+.link-list > section > details > summary > header h1 {
+ font-size: 12pt;
+}
article>section>details>summary>header>h1 {
font-size: 1.5em;
diff --git a/lib/frontend/Headers.ml b/lib/frontend/Headers.ml
index 0ba5dfc..e056d93 100644
--- a/lib/frontend/Headers.ml
+++ b/lib/frontend/Headers.ml
@@ -76,14 +76,11 @@ let parse_section_flags (header : Http.Header.t) : T.section_flags option =
expanded;
}
-let of_numbering ~(number : int list) =
- `Assoc
- [("Number-Path", `String (String.concat "," (List.map string_of_int number)))]
-
-let parse_numbering (header : Http.Header.t) : int list =
- match Http.Header.get header "Number-Path" with
- | None | Some "" -> []
- | Some s -> String.split_on_char ',' s |> List.map int_of_string
+let of_numbering ~(numbered : bool) =
+ `Assoc [("Numbered-Effective", `String (Bool.to_string numbered))]
+
+let parse_numbering (header : Http.Header.t) : bool =
+ parse_flag "Numbered-Effective" header
let of_scope (scope : URI.t option) =
match scope with
diff --git a/lib/frontend/Html_client.ml b/lib/frontend/Html_client.ml
index 058920a..872dc98 100644
--- a/lib/frontend/Html_client.ml
+++ b/lib/frontend/Html_client.ml
@@ -18,6 +18,7 @@ open struct
module X = Xml_forester
module H = P.HTML
module Hx = P.Hx
+ module S = Saturn
type query = (string, T.content T.vertex) Forester_core.Datalog_expr.query
[@@deriving repr]
@@ -30,15 +31,22 @@ type 'a control =
type 'a client = 'a control -> P.node
+type mainmatter_cache = (URI.t * bool, P.node list) S.Htbl.t
+
+let create_mainmatter_cache () : mainmatter_cache = S.Htbl.create ()
+
+let default_xmlns () =
+ Xmlns.init ~reserved:[{prefix = ""; xmlns = "http://www.w3.org/1999/xhtml"}]
+
type env = {
forest: State.t;
scope: URI.t option;
loops: Loop_detection.t;
xmlns: Xmlns.t;
in_backmatter: bool;
- number: int list;
numbered: bool;
mode: mode;
+ mainmatter_cache: mainmatter_cache;
}
let is_counted : T.section_flags -> _ =
@@ -54,16 +62,10 @@ let section_flags_of_node : T.(content content_node) -> T.section_flags option =
| T.Results_of_datalog_query _ | T.Xml_elt _ ->
None
-let number_node ~env node counter =
+let numbered_node ~env node =
match section_flags_of_node node with
- | Some flags ->
- if env.numbered && is_counted flags then begin
- incr counter;
- let n = !counter :: env.number in
- (Some n, n, true)
- end
- else (None, env.number, false)
- | None -> (None, env.number, env.numbered)
+ | Some flags -> env.numbered && is_counted flags
+ | None -> env.numbered
(* Generate an id from a tree's frontmatter. The source_path field is omitted
since it carries an absolute path since this changes with every cram test.
@@ -191,7 +193,9 @@ let rec render_control : type a. env:env -> a client =
function
| Transclusion {href; target; range = _} ->
let (`Assoc target_headers) = Headers.of_content_target target in
- let (`Assoc number_headers) = Headers.of_numbering ~number:env.number in
+ let (`Assoc number_headers) =
+ Headers.of_numbering ~numbered:env.numbered
+ in
let (`Assoc scope_headers) = Headers.of_scope env.scope in
let headers =
Yojson.Safe.to_string
@@ -261,13 +265,11 @@ and default_env ~forest =
forest;
scope = None;
loops = Loop_detection.empty;
- xmlns =
- Xmlns.init
- ~reserved:[{prefix = ""; xmlns = "http://www.w3.org/1999/xhtml"}];
+ xmlns = default_xmlns ();
in_backmatter = false;
mode = Static;
- number = [];
numbered = true;
+ mainmatter_cache = create_mainmatter_cache ();
}
and dynamic_env ~forest = {(default_env ~forest) with mode = Dynamic}
@@ -281,39 +283,32 @@ and dynamic_env ~forest = {(default_env ~forest) with mode = Dynamic}
*)
and render_content ~env (Content content : T.content) =
- render_content_nodes ~env ~counter:(ref 0) content
+ render_content_nodes ~env content
-and render_content_nodes ~env ~counter content =
+and render_content_nodes ~env content =
List.concat
@@ List.map
(fun node ->
- let number, prefix, numbered = number_node ~env node counter in
- render_content_node
- ~env:{env with number = prefix; numbered}
- ~counter ~number node)
+ let numbered = numbered_node ~env node in
+ render_content_node ~env:{env with numbered} node)
content
and render_toc ~env (Content content : T.content) =
assert (not env.in_backmatter);
- match render_toc_entries ~env ~counter:(ref 0) content with
+ match render_toc_entries ~env content with
| [] -> []
| items -> [H.ul [H.class_ "block"] items]
-and render_toc_entries ~env ~counter content =
+and render_toc_entries ~env content =
List.concat
@@ List.filter_map
(fun node ->
- let number, prefix, numbered = number_node ~env node counter in
- let items =
- render_toc_item
- ~env:{env with number = prefix; numbered}
- ~counter ~number node
- in
+ let numbered = numbered_node ~env node in
+ let items = render_toc_item ~env:{env with numbered} node in
if List.length items > 0 then Some items else None)
content
-and render_content_node ~env ~counter ~number (node : _ T.content_node) :
- P.node list =
+and render_content_node ~env (node : _ T.content_node) : P.node list =
match node with
| Text str -> [P.txt "%s" str]
| CDATA str -> [P.txt "%s" str]
@@ -323,7 +318,7 @@ and render_content_node ~env ~counter ~number (node : _ T.content_node) :
let xmlns_attrs = Xmlns.xmlns_attrs_for_elt elt env.xmlns in
let env = {env with xmlns = Xmlns.extend xmlns_attrs env.xmlns} in
let (Content elt_content) = elt.content in
- let content = render_content_nodes ~env ~counter elt_content in
+ let content = render_content_nodes ~env elt_content in
[
P.std_tag name
(List.map render_xmlns_prefix xmlns_attrs
@@ -355,28 +350,30 @@ and render_content_node ~env ~counter ~number (node : _ T.content_node) :
[P.txt "%s" tex];
]
| Artefact artefact -> render_content ~env @@ artefact.content
- | Section section -> [render_section ?number ~env section]
- | Transclude ({target = Full _; _} as t) -> begin
- match env.mode with
+ | Section section -> [render_section ~numbered:env.numbered ~env section]
+ | Transclude ({target = Full _; _} as t) ->
+ begin match env.mode with
| Dynamic -> [render_control ~env (Transclusion t)]
- | Static -> begin
- match State.get_section ~forest:env.forest t with
- | Some section -> [render_section ?number ~env section]
+ | Static ->
+ begin match State.get_section ~forest:env.forest t with
+ | Some section -> [render_section ~numbered:env.numbered ~env section]
| None ->
Error.(yield @@ broken_transclusion t);
[
P.txt "failed to render transclusion %s"
(Format.asprintf "%a" URI.pp t.href);
]
+ end
end
- end
| Transclude t -> [render_control ~env (Transclusion t)]
| Link link -> [render_control ~env (Link link)]
| Results_of_datalog_query q -> [render_control ~env (Query q)]
| Datalog_script _ -> []
-and toc_item_template ~env ~number (T.{uri; title; _} as frontmatter) children =
- H.li []
+and toc_item_template ~env ~numbered (T.{uri; title; _} as frontmatter) children
+ =
+ H.li
+ [conditional_ numbered (H.class_ "numbered")]
[
H.a
[
@@ -410,13 +407,14 @@ and toc_item_template ~env ~number (T.{uri; title; _} as frontmatter) children =
[
H.span
[H.class_ "taxon"]
- [render_tree_taxon_with_number ~env ?number frontmatter];
+ [render_tree_taxon_with_number ~env ~numbered frontmatter];
H.null @@ render_title ~env frontmatter;
];
children;
]
-and render_toc_item ~env ~counter ~number node =
+and render_toc_item ~env node =
+ let numbered = env.numbered in
match node with
| T.Transclude
({target = Full {included_in_toc = true; _}; _} as transclusion) -> begin
@@ -424,7 +422,7 @@ and render_toc_item ~env ~counter ~number node =
| Some T.{frontmatter; mainmatter; _} ->
let scope = frontmatter.uri in
let children = render_toc ~env:{env with scope} mainmatter in
- [toc_item_template ~env ~number frontmatter (H.null children)]
+ [toc_item_template ~env ~numbered frontmatter (H.null children)]
| None -> []
end
| T.Transclude ({target = Mainmatter; _} as transclusion) -> begin
@@ -432,7 +430,7 @@ and render_toc_item ~env ~counter ~number node =
| Some T.{frontmatter; mainmatter; _} ->
let scope = frontmatter.uri in
let children = render_toc ~env:{env with scope} mainmatter in
- [toc_item_template ~env ~number frontmatter (H.null children)]
+ [toc_item_template ~env ~numbered frontmatter (H.null children)]
| None -> []
end
| T.Section {frontmatter; mainmatter; flags = {included_in_toc; _}} ->
@@ -441,9 +439,8 @@ and render_toc_item ~env ~counter ~number node =
let children =
render_toc ~env:{env with scope = frontmatter.uri} mainmatter
in
- [toc_item_template ~env ~number frontmatter (H.null children)]
- | T.Xml_elt {content = Content content; _} ->
- render_toc_entries ~env ~counter content
+ [toc_item_template ~env ~numbered frontmatter (H.null children)]
+ | T.Xml_elt {content = Content content; _} -> render_toc_entries ~env content
| _ -> []
and render_query_result ~env q =
@@ -629,17 +626,11 @@ and render_bibtex ~env frontmatter =
optional (get_meta frontmatter "bibtex") (fun c ->
H.pre [] (render_content ~env c))
-and render_tree_taxon_with_number ~env ?number
+and render_tree_taxon_with_number ~env ?(numbered = false)
(T.{taxon; _} : T.(content frontmatter)) =
- let number = match number with Some [] -> None | n -> n in
let show_taxon = Option.is_some taxon in
- let dot = conditional (Option.is_some number || show_taxon) (P.txt ". ") in
- let number =
- match number with
- | None -> H.null []
- | Some number ->
- P.txt " %s" @@ String.concat "." (List.rev_map Int.to_string number)
- in
+ let number = conditional numbered (H.span [H.class_ "section-number"] []) in
+ let dot = conditional (show_taxon && not numbered) (P.txt ". ") in
let taxon =
if show_taxon then optional taxon (fun c -> H.null (render_content ~env c))
else H.null []
@@ -664,14 +655,15 @@ and render_display_uri ~env ?(slug = false) uri : P.node =
]
[P.txt "["; P.txt "%s" path_string; P.txt "]"]
-and render_frontmatter ~env ?number (frontmatter : _ T.frontmatter) : P.node =
+and render_frontmatter ~env ?(numbered = false) (frontmatter : _ T.frontmatter)
+ : P.node =
H.header []
[
H.h1 []
[
H.span
[H.class_ "taxon"]
- [render_tree_taxon_with_number ~env ?number frontmatter];
+ [render_tree_taxon_with_number ~env ~numbered frontmatter];
H.null @@ render_title ~env frontmatter;
P.txt " ";
render_display_uri ~env ~slug:true frontmatter.uri;
@@ -696,7 +688,39 @@ and render_frontmatter ~env ?number (frontmatter : _ T.frontmatter) : P.node =
];
]
-and render_section ~env ?number
+and render_mainmatter ~env ~numbered (frontmatter : _ T.frontmatter) mainmatter
+ : P.node list =
+ match frontmatter.uri with
+ | None ->
+ let env =
+ {
+ env with
+ loops = Loop_detection.add_seen_uri_opt frontmatter.uri env.loops;
+ scope = frontmatter.uri;
+ }
+ in
+ render_content ~env mainmatter
+ | Some uri -> begin
+ let key = (uri, numbered) in
+ match S.Htbl.find_opt env.mainmatter_cache key with
+ | Some nodes -> nodes
+ | None ->
+ let cache_env =
+ {
+ env with
+ loops =
+ Loop_detection.add_seen_uri_opt frontmatter.uri Loop_detection.empty;
+ scope = frontmatter.uri;
+ xmlns = default_xmlns ();
+ numbered;
+ }
+ in
+ let nodes = render_content ~env:cache_env mainmatter in
+ ignore @@ S.Htbl.try_add env.mainmatter_cache key nodes;
+ nodes
+ end
+
+and render_section ~env ?(numbered = false)
({flags; mainmatter; frontmatter} : T.content T.section) : P.node =
let T.{metadata_shown; header_shown; expanded; hidden_when_empty; _} =
flags
@@ -713,8 +737,10 @@ and render_section ~env ?number
else
H.section
[
- (if not metadata_shown then H.class_ "block hide-metadata"
- else H.class_ "block");
+ (let base =
+ if not metadata_shown then "block hide-metadata" else "block"
+ in
+ H.class_ "%s" (if numbered then base ^ " numbered" else base));
taxon_attr;
]
[
@@ -724,17 +750,11 @@ and render_section ~env ?number
H.details
[open_; H.id "%s" @@ stable_id_of_frontmatter frontmatter]
[
- H.summary [] [render_frontmatter ?number ~env frontmatter];
- (let env =
- {
- env with
- loops =
- Loop_detection.add_seen_uri_opt frontmatter.uri env.loops;
- scope = frontmatter.uri;
- }
- in
- H.null @@ render_content ~env mainmatter);
- render_bibtex ~env frontmatter;
+ H.summary [] [render_frontmatter ~numbered ~env frontmatter];
+ H.div
+ [H.class_ "mainmatter"]
+ (render_mainmatter ~env ~numbered frontmatter mainmatter
+ @ [render_bibtex ~env frontmatter]);
]
else H.null @@ render_content ~env mainmatter);
]
@@ -804,17 +824,21 @@ let render_article ~env (article : T.content T.article) : P.node =
[H.class_ "block"]
[
H.details [H.open_]
- (H.summary [] [render_frontmatter ~env article.frontmatter]
- :: render_content
- ~env:
- {
- env with
- loops =
- Loop_detection.add_seen_uri_opt article.frontmatter.uri
- env.loops;
- }
- article.mainmatter
- @ [render_bibtex ~env article.frontmatter]);
+ [
+ H.summary [] [render_frontmatter ~env article.frontmatter];
+ H.div
+ [H.class_ "mainmatter"]
+ (render_content
+ ~env:
+ {
+ env with
+ loops =
+ Loop_detection.add_seen_uri_opt article.frontmatter.uri
+ env.loops;
+ }
+ article.mainmatter
+ @ [render_bibtex ~env article.frontmatter]);
+ ];
];
conditional should_render_backmatter
@@ H.footer [] [render_backmatter ~env article.backmatter];
@@ -829,9 +853,14 @@ let render_article_as_div ~(forest : State.t) (article : T.content T.article) :
(List.map render_xmlns_prefix reserved)
[H.null @@ render_content ~env article.mainmatter]
-let render_article_and_toc ~forest ?(mode = Static)
+let render_article_and_toc ~forest ?(mode = Static) ?mainmatter_cache
({frontmatter; mainmatter; _} as tree : _ T.article) =
let env = {(default_env ~forest) with scope = frontmatter.uri; mode} in
+ let env =
+ match mainmatter_cache with
+ | Some mainmatter_cache -> {env with mainmatter_cache}
+ | None -> env
+ in
let toc = render_toc ~env mainmatter in
[
render_article ~env tree;
@@ -878,7 +907,7 @@ let collect_and_report_errors ~(forest : State.t) (f : unit -> 'a) :
report_errors ~forest errors;
(result, errors)
-let render_page ~forest ?(mode = Static)
+let render_page ~forest ?(mode = Static) ?mainmatter_cache
({frontmatter; _} as tree : _ T.article) : P.node * Error.t list =
let@ () = collect_errors in
let env = {(default_env ~forest) with scope = frontmatter.uri; mode} in
@@ -893,7 +922,7 @@ let render_page ~forest ?(mode = Static)
in
let is_home = is_home ~env frontmatter.uri in
let dev = forest.dev in
- let content = render_article_and_toc ~forest tree in
+ let content = render_article_and_toc ~forest ?mainmatter_cache tree in
let ctx = Router.page_context ~forest ~mode ~dev in
Templates.page ~ctx ~is_home ~title_string:ttl
~source_path:frontmatter.source_path content
diff --git a/lib/frontend/Html_client.mli b/lib/frontend/Html_client.mli
index e13f0e2..b236d7e 100644
--- a/lib/frontend/Html_client.mli
+++ b/lib/frontend/Html_client.mli
@@ -10,15 +10,19 @@ module X := Forester_compiler.Xml_forester
module H := P.HTML
module Hx := P.Hx
+type mainmatter_cache
+
+val create_mainmatter_cache : unit -> mainmatter_cache
+
type env = {
forest: Forester_compiler.State.t;
scope: Forester_core.URI.t option;
loops: Loop_detection.t;
xmlns: Forester_xml_names.Xmlns.t;
in_backmatter: bool;
- number: int list;
numbered: bool;
mode: Forester_core.mode;
+ mainmatter_cache: mainmatter_cache;
}
val default_env : forest:Forester_compiler.State.t -> env
@@ -34,6 +38,7 @@ val render_toc : env:env -> T.content -> P.node list
val render_page :
forest:Forester_compiler.State.t ->
?mode:Forester_core.mode ->
+ ?mainmatter_cache:mainmatter_cache ->
T.content T.article ->
P.node * Forester_compiler.Error.t list
@@ -51,5 +56,4 @@ val html_redirect : path:string -> Pure_html.node
val render_article : env:env -> T.content T.article -> P.node
-val render_section :
- env:env -> ?number:int list -> T.content T.section -> P.node
+val render_section : env:env -> ?numbered:bool -> T.content T.section -> P.node
diff --git a/lib/frontend/dune b/lib/frontend/dune
index b0309da..9bf2315 100644
--- a/lib/frontend/dune
+++ b/lib/frontend/dune
@@ -45,4 +45,5 @@
pure-html
logs
uri
- routes))
+ routes
+ saturn))
diff --git a/lib/server/Server.ml b/lib/server/Server.ml
index d00a5a9..363e1fa 100644
--- a/lib/server/Server.ml
+++ b/lib/server/Server.ml
@@ -97,20 +97,11 @@ let tree_handler ~(forest : State.t) ~request_headers ~href =
let content, _errors =
let@ () = Html_client.collect_and_report_errors ~forest in
match Headers.parse_content_target request_headers with
- | Some (T.Full flags as target) ->
- (* Rendering this through State.get_content_of_transclusion
- with a fresh counter would always yield "1" as the section number.
- Instead we parse the numbering context from the headers. *)
- let number = Headers.parse_numbering request_headers in
- let env = {env with number; numbered = flags.numbered} in
+ | Some (T.Full _ as target) ->
+ let numbered = Headers.parse_numbering request_headers in
Option.map
(fun section ->
- H.null
- [
- Html_client.render_section ~env
- ?number:(if flags.numbered then Some number else None)
- section;
- ])
+ H.null [Html_client.render_section ~env ~numbered section])
(State.get_section ~forest {target; href; range = None})
| Some target ->
Option.map (render >>> H.null)
diff --git a/test/htmx-numbering.t b/test/htmx-numbering.t
index 753e897..8678609 100644
--- a/test/htmx-numbering.t
+++ b/test/htmx-numbering.t
@@ -1,7 +1,5 @@
-Transclusions rendered in HTMX mode must not reset their section numbering to 1
-on every independent fetch. The HTML client encodes the number into the
-hx-headers payload, and tree_handler decodes it to seed the fragment's render
-with the right number instead of always starting over from a fresh counter.
+Numbering is done via CSS, so this code just verifies that the appropriate CSS
+classes are being set
$ forester init > /dev/null
@@ -32,28 +30,16 @@ This is what the server would do via the headers encoded in the page:
$ curl -s -H "Hx-Request: true" -H "Full: true" -H "Included-In-Toc: true" \
> -H "Header-Shown: true" -H "Metadata-Shown: false" \
- > -H "Numbered: true" -H "Expanded: true" \
- > -H "Number-Path: 2" \
- > http://localhost:8082/preview/b/ | grep -oE '[^<]*'
- 2.
+ > -H "Numbered-Effective: true" -H "Expanded: true" \
+ > http://localhost:8082/preview/b/ | grep -oE '[^<]*()?[^<]*'
+
-
-But we can request the section to be returned with arbitrary numbering:
-
- $ curl -s -H "Hx-Request: true" -H "Full: true" -H "Included-In-Toc: true" \
- > -H "Header-Shown: true" -H "Metadata-Shown: false" \
- > -H "Numbered: true" -H "Expanded: true" \
- > -H "Number-Path: 2,3,6" \
- > http://localhost:8082/preview/b/ | grep -oE '[^<]*'
- 6.3.2.
-
-We can also disable numbering, via the Numbered flag:
+We can also disable numbering, via the Numbered-Effective flag:
$ curl -s -H "Hx-Request: true" -H "Full: true" -H "Included-In-Toc: true" \
> -H "Header-Shown: true" -H "Metadata-Shown: false" \
- > -H "Numbered: false" -H "Expanded: true" \
- > -H "Number-Path: 2" \
- > http://localhost:8082/preview/b/ | grep -oE '[^<]*'
+ > -H "Numbered-Effective: false" -H "Expanded: true" \
+ > http://localhost:8082/preview/b/ | grep -oE '[^<]*()?[^<]*'
$ kill $SERVER_PID
diff --git a/test/ok.t b/test/ok.t
index b814de0..a6a058b 100644
--- a/test/ok.t
+++ b/test/ok.t
@@ -30,7 +30,18 @@
-
Hello, world!
+
+
+
+ Hello, world!
+
@@ -43,5 +54,6 @@
A tree with no metadata should have an empty metadata list rather than a stray
meta-item that produces a leading bullet.
- $ grep -o '.*
' output/index/index.html
-
+ $ grep -c 'class="meta-item"' output/index/index.html
+ 0
+ [1]
diff --git a/test/queries.t b/test/queries.t
index a01887e..0e71b74 100644
--- a/test/queries.t
+++ b/test/queries.t
@@ -72,27 +72,31 @@ TODO: use grep to verify what we want:
-
-
-
-
- Reference. Some novel result [paper]
-
-
-
-
-
+
+
+
+
+
+ Reference. Some novel result [paper]
+
+
+
+
+
+
+
+
Person 1. Foo Bar [foo]
' output/index/index.html
- Person 1. Foo Bar [foo]
+ $ grep -Fo 'PersonFoo Bar [foo]
' output/index/index.html
+ PersonFoo Bar [foo]