diff --git a/cpdf.ml b/cpdf.ml index ab6f65d..fab39fc 100644 --- a/cpdf.ml +++ b/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 + diff --git a/cpdf.mli b/cpdf.mli index b08dbb7..c83dffa 100644 --- a/cpdf.mli +++ b/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. *) diff --git a/cpdfcommand.ml b/cpdfcommand.ml index 830084d..f80cdd0 100644 --- a/cpdfcommand.ml +++ b/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 = - args.op <- Some (AddPageLabels s) +let setlabelstyle 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;