From 935d43d5ebfea92dc2dc84637090017c34fd16bb Mon Sep 17 00:00:00 2001
From: John Whitington <john@coherentgraphics.co.uk>
Date: Mon, 16 Sep 2024 18:34:44 +0100
Subject: [PATCH] Add impl for -no-auto-tag

---
 cpdfdraw.ml        | 31 +++++++++++++++++--------------
 cpdfdraw.mli       |  4 ++++
 cpdfdrawcontrol.ml | 22 +++++++++++++++++-----
 3 files changed, 38 insertions(+), 19 deletions(-)

diff --git a/cpdfdraw.ml b/cpdfdraw.ml
index edf51ca..0feacd3 100644
--- a/cpdfdraw.ml
+++ b/cpdfdraw.ml
@@ -3,6 +3,8 @@ open Cpdferror
 
 let do_add_artifacts = ref false
 
+let do_auto_tag = ref true
+
 type colspec =
    NoCol
  | RGB of float * float * float
@@ -56,6 +58,8 @@ type drawops =
   | TextScale of float
   | RenderMode of int
   | Rise of float
+  | Tag of string
+  | EndTag
   | STag of string
   | EndSTag
   | BeginArtifact
@@ -335,9 +339,9 @@ let rec ops_of_drawop struct_tree dryrun pdf endpage filename bates batespad num
         if not dryrun then structdata := StDataMCID ("/Figure", m, t)::!structdata;
       let pdfname = try fst (Hashtbl.find (res ()).images s) with _ -> error ("Image not found: " ^ s) in
         (res ()).page_names <- pdfname::(res ()).page_names;
-            (if struct_tree then [Pdfops.Op_BDC ("/Figure", Pdf.Dictionary ["/MCID", Pdf.Integer m])] else [])
+            (if struct_tree && !do_auto_tag then [Pdfops.Op_BDC ("/Figure", Pdf.Dictionary ["/MCID", Pdf.Integer m])] else [])
           @ [Pdfops.Op_Do pdfname]
-          @ (if struct_tree then [Pdfops.Op_EMC] else [])
+          @ (if struct_tree && !do_auto_tag then [Pdfops.Op_EMC] else [])
   | ImageXObject (s, obj) ->
       Hashtbl.replace (res ()).images s (fresh_name "/I", Pdf.addobj pdf obj); 
       []
@@ -394,11 +398,11 @@ let rec ops_of_drawop struct_tree dryrun pdf endpage filename bates batespad num
   | TextSection ops ->
       let m = mcid () in
         if not dryrun then structdata := StDataMCID ("/P", m, None)::!structdata;
-          (if struct_tree then [Pdfops.Op_BDC ("/P", Pdf.Dictionary ["/MCID", Pdf.Integer m])] else [])
+          (if struct_tree && !do_auto_tag then [Pdfops.Op_BDC ("/P", Pdf.Dictionary ["/MCID", Pdf.Integer m])] else [])
         @ [Pdfops.Op_BT]
         @ ops_of_drawops struct_tree dryrun pdf endpage filename bates batespad num page ops
         @ [Pdfops.Op_ET] 
-        @ (if struct_tree then [Pdfops.Op_EMC] else [])
+        @ (if struct_tree && !do_auto_tag then [Pdfops.Op_EMC] else [])
   | Text s ->
       if dryrun then iter (fun c -> Hashtbl.replace (res ()).current_fontpack_codepoints c ()) (Pdftext.codepoints_of_utf8 s);
       fst (runs_of_utf8 s)
@@ -416,16 +420,15 @@ let rec ops_of_drawop struct_tree dryrun pdf endpage filename bates batespad num
   | RenderMode i -> [Pdfops.Op_Tr i]
   | Rise f -> [Pdfops.Op_Ts f]
   | Newline -> [Pdfops.Op_T']
-  | STag s ->
-      structdata =| StDataBeginTree s;
-      []
-  | EndSTag ->
-      structdata =| StDataEndTree;
-      []
-  | BeginArtifact ->
-      [Pdfops.Op_BMC "/Artifact"]
-  | EndArtifact ->
-      [Pdfops.Op_EMC]
+  | Tag s ->
+      let m = mcid () in
+        if not dryrun then structdata := StDataMCID (s, m, None)::!structdata;
+        [Pdfops.Op_BDC (s, Pdf.Dictionary ["/MCID", Pdf.Integer m])]
+  | EndTag -> [Pdfops.Op_EMC]
+  | STag s -> structdata =| StDataBeginTree s; []
+  | EndSTag -> structdata =| StDataEndTree; []
+  | BeginArtifact -> [Pdfops.Op_BMC "/Artifact"]
+  | EndArtifact -> [Pdfops.Op_EMC]
 
 and ops_of_drawops struct_tree dryrun pdf endpage filename bates batespad num page drawops =
   flatten (map (ops_of_drawop struct_tree dryrun pdf endpage filename bates batespad num page) drawops)
diff --git a/cpdfdraw.mli b/cpdfdraw.mli
index 759a72a..8844f48 100644
--- a/cpdfdraw.mli
+++ b/cpdfdraw.mli
@@ -53,6 +53,8 @@ type drawops =
   | TextScale of float
   | RenderMode of int
   | Rise of float
+  | Tag of string
+  | EndTag
   | STag of string
   | EndSTag
   | BeginArtifact
@@ -60,6 +62,8 @@ type drawops =
 
 val do_add_artifacts : bool ref
 
+val do_auto_tag : bool ref
+
 (** Calling [draw fast underneath filename bates batespad range pdf drawops] draws on
     top of all the pages in the range. *)
 val draw : struct_tree:bool ->
diff --git a/cpdfdrawcontrol.ml b/cpdfdrawcontrol.ml
index 806e2e5..883f8d7 100644
--- a/cpdfdrawcontrol.ml
+++ b/cpdfdrawcontrol.ml
@@ -95,17 +95,29 @@ let setstroke s =
 let setfill s =
   addop (Cpdfdraw.SetFill (col_of_string s))
 
-let addtag t = ()
+let addtag t =
+  addop (Cpdfdraw.Tag t)
+
 let addstag t =
   addop (Cpdfdraw.STag t)
-let endtag () = ()
+
+let endtag () =
+  addop Cpdfdraw.EndTag
+
 let endstag () =
   addop Cpdfdraw.EndSTag
-let autotags b = ()
+
+let autotags b =
+  Cpdfdraw.do_auto_tag := b
+
 let autoartifacts b =
   Cpdfdraw.do_add_artifacts := b
-let artifact () = ()
-let endartifact () = ()
+
+let artifact () =
+  addop Cpdfdraw.BeginArtifact
+
+let endartifact () =
+  addop Cpdfdraw.EndArtifact
 
 let addrect s =
   let x, y, w, h = Cpdfcoord.parse_rectangle (Pdf.empty ()) s in