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