Can now add page labels

cpdf.ml

@@ -3095,3 +3095,41 @@ let blank_document_paper papersize pages =
     let pdf, pageroot = Pdfpage.add_pagetree pdf_pages (Pdf.empty ()) in
       Pdfpage.add_root pageroot [] pdf
 
+(* Split the given range (which is in order) into multiple contiguous ones. *)
+let rec ranges_of_range curr prev = function
+  | [] -> begin match curr with [] -> rev prev | _ -> rev (rev curr::prev) end
+  | x::xs ->
+      match curr with
+      | [] -> ranges_of_range [x] prev xs
+      | c::cs when x = c + 1 -> ranges_of_range (x::curr) prev xs
+      | cs -> ranges_of_range [x] (rev cs::prev) xs
+
+(* Predicate which is true if at least one page range starts at page 1 *)
+let page1 labels =
+  mem true (map (function l -> l.Pdfpagelabels.startpage = 1) labels)
+
+let add_page_labels pdf style prefix offset range =
+  let ranges = map extremes (ranges_of_range [] [] range)
+  and labels = Pdfpagelabels.read pdf in
+    let labels =
+      if not (page1 labels) then
+        ref
+          ({Pdfpagelabels.labelstyle = Some Pdfpagelabels.DecimalArabic;
+            Pdfpagelabels.labelprefix = None;
+            Pdfpagelabels.startpage = 1;
+            Pdfpagelabels.startvalue = 1}::labels)
+      else
+        ref labels
+    in
+      iter
+        (function (s, e) ->
+           let label =
+             {Pdfpagelabels.labelstyle = style;
+              Pdfpagelabels.labelprefix = prefix;
+              Pdfpagelabels.startpage = s;
+              Pdfpagelabels.startvalue = s + offset}
+           in
+             labels := Pdfpagelabels.add_label !labels label e)
+        ranges;
+        Pdfpagelabels.write pdf !labels
+

cpdf.mli

@@ -396,6 +396,11 @@ val blank_document : float -> float -> int -> Pdf.t
 (** The same, but give a Pdfpaper.t paper size. *)
 val blank_document_paper : Pdfpaper.t -> int -> Pdf.t
 
+(** {2 Page labels} *)
+
+(** Add page labels. *)
+val add_page_labels : Pdf.t -> Pdfpagelabels.labelstyle option -> string option -> int -> int list -> unit 
+
 (** {2 Miscellany} *)
 
 (** Make all lines in the PDF at least a certain thickness. *)

cpdfcommand.ml

@@ -152,7 +152,7 @@ type op =
   | PrintLinearization
   | OpenAtPage of int
   | OpenAtPageFit of int
-  | AddPageLabels of string
+  | AddPageLabels
   | RemovePageLabels
   | PrintPageLabels
 
@@ -254,7 +254,10 @@ type args =
    mutable dont_overwrite_existing_files : bool;
    mutable makenewid : bool;
    mutable ismulti : bool;
-   mutable uprightstamp : bool}
+   mutable uprightstamp : bool;
+   mutable labelstyle : Pdfpagelabels.labelstyle option;
+   mutable labelprefix : string option;
+   mutable labeloffset : int option}
 
 (* List of all filenames in any AND stage - this is used to check that we don't
 overwrite any input file when -dont-overwrite-existing-files is used. *)
@@ -333,7 +336,10 @@ let args =
    dont_overwrite_existing_files = false;
    makenewid = false;
    ismulti = false;
-   uprightstamp = false}
+   uprightstamp = false;
+   labelstyle = None;
+   labelprefix = None;
+   labeloffset = None}
 
 let reset_arguments () =
   args.op <- None;
@@ -403,7 +409,10 @@ let reset_arguments () =
   args.keep_this_id <- None;
   args.makenewid <- false;
   args.ismulti <- false;
-  args.uprightstamp <- false
+  args.uprightstamp <- false;
+  args.labelstyle <- None;
+  args.labelprefix <- None;
+  args.labeloffset <- None
   (* We don't reset args.do_ask and args.verbose, because they operate on all
   parts of the AND-ed command line sent from cpdftk. *)
 
@@ -1190,8 +1199,23 @@ let setopenatpage n =
 let setopenatpagefit n =
   args.op <- Some (OpenAtPageFit n)
 
-let setaddpagelabels s =
+let setlabelstyle s =
-  args.op <- Some (AddPageLabels s)
+  let style =
+    match s with
+    | "DecimalArabic" -> Pdfpagelabels.DecimalArabic
+    | "UppercaseRoman" -> Pdfpagelabels.UppercaseRoman
+    | "LowercaseRoman" -> Pdfpagelabels.LowercaseRoman
+    | "UppercaseLetters" -> Pdfpagelabels.UppercaseLetters
+    | "LowercaseLetters" -> Pdfpagelabels.LowercaseLetters
+    | _ -> error "Unknown label style"
+  in
+    args.labelstyle <- Some style
+
+let setlabelprefix s =
+  args.labelprefix <- Some s
+
+let setlabeloffset i =
+  args.labeloffset <- Some i
 
 (* Parse a control file, make an argv, and then make Arg parse it. *)
 let rec make_control_argv_and_parse filename =
@@ -1660,8 +1684,17 @@ and specs =
       Arg.Unit (setop RemovePageLabels),
       " Remove page labels");
    ("-add-page-labels",
-      Arg.String setaddpagelabels,
+      Arg.Unit (setop AddPageLabels),
       " Add or replace page labels");
+   ("-label-style",
+      Arg.String setlabelstyle,
+      " Set label style (default DecimalArabic)");
+   ("-label-prefix",
+      Arg.String setlabelprefix,
+      " Set label prefix (default none)");
+   ("-label-offset",
+      Arg.Int setlabeloffset,
+      " Set label offset (default 1)");
    (* These items are for cpdftk *)
    ("-update-info", Arg.String setupdateinfo, "");
    ("-printf-format", Arg.Unit setprintfformat, "");
@@ -3367,7 +3400,14 @@ let go () =
            Pdfread.print_linearization (Pdfio.input_of_channel (open_in_bin inname))
       | _ -> raise (Arg.Bad "-print-linearization: supply a single file name")
       end
-  | Some (AddPageLabels labelspec) -> ()
+  | Some AddPageLabels ->
+      let pdf = get_single_pdf args.op false in
+        let range = parse_pagespec pdf (get_pagespec ()) in
+          let offset =
+            match args.labeloffset with None -> 0 | Some x -> x
+          in
+            Cpdf.add_page_labels pdf args.labelstyle args.labelprefix offset range;
+            write_pdf false pdf
   | Some RemovePageLabels ->
       let pdf = get_single_pdf args.op false in
         Pdfpagelabels.remove pdf;