Gate -table-of-contents for -process-struct-tree

This commit is contained in:
John Whitington
2025-03-07 17:00:17 +00:00
parent 0a1be154ad
commit f94fb702ec

View File

@ -151,6 +151,7 @@ let add_to_parent_tree pdf p =
CropBox. Font size of title twice body font size. Null page labels added for
TOC, others bumped up and so preserved. *)
let typeset_table_of_contents ~font ~fontsize ~title ~bookmark ~dotleader ~process_struct_tree pdf =
let optional l = if process_struct_tree then l else [] in
Hashtbl.clear width_table_cache;
let marks = Pdfmarks.read_bookmarks pdf in
if marks = [] then (Pdfe.log "No bookmarks, not making table of contents\n"; pdf) else
@ -203,22 +204,22 @@ let typeset_table_of_contents ~font ~fontsize ~title ~bookmark ~dotleader ~proce
else [Cpdftype.HGlue space]
in
[Cpdftype.BeginDest (mark.Pdfmarks.target, Some mark.Pdfmarks.text); Cpdftype.HGlue indent]
@ [Cpdftype.Tag ("Link", 0)] @ textruns @ [Cpdftype.EndTag]
@ optional [(Cpdftype.Tag ("Link", 0))] @ textruns @ optional [Cpdftype.EndTag]
@ leader
@ [Cpdftype.Tag ("Link", 0)] @ labelruns @ [Cpdftype.EndTag]
@ optional [Cpdftype.Tag ("Link", 0)] @ labelruns @ optional [Cpdftype.EndTag]
@ [Cpdftype.EndDest; Cpdftype.NewLine])
(Pdfmarks.read_bookmarks pdf)
in
let toc_pages, toc_tags =
let title =
let glue = Cpdftype.VGlue (fontsize *. 2.) in
[Cpdftype.Tag ("P", 0)]
optional [Cpdftype.Tag ("P", 0)]
@ flatten
(map
(fun l -> l @ [Cpdftype.NewLine])
(map (of_utf8 fontpack (fontsize *. 2.)) (map implode (split_toc_title (explode title)))))
@
[Cpdftype.EndTag; glue]
optional [Cpdftype.EndTag] @ [glue]
in
let lm, rm, tm, bm =
match firstpage_cropbox with
@ -254,6 +255,8 @@ let typeset_table_of_contents ~font ~fontsize ~title ~bookmark ~dotleader ~proce
Pdfpagelabels.startpage = 1;
Pdfpagelabels.startvalue = 1}
in
if process_struct_tree then
begin
let struct_tree_root =
match Pdf.lookup_immediate "/StructTreeRoot" (Pdf.lookup_obj pdf pdf.Pdf.root) with
| Some (Pdf.Indirect i) -> i
@ -332,6 +335,7 @@ let typeset_table_of_contents ~font ~fontsize ~title ~bookmark ~dotleader ~proce
Pdf.replace_chain pdf ["/Root"; "/StructTreeRoot"; "/K"] (Pdf.Array (prepending_structitems @ [Pdf.Dictionary d]))
| _ ->
() (* None found. In future, may fabricate. For now, no. *)
end
end;
let labels' = label::map (fun l -> {l with Pdfpagelabels.startpage = l.Pdfpagelabels.startpage + toc_pages_len}) labels in
Pdfpagelabels.write pdf labels';