First stab at -hard-box

cpdf.ml

@@ -2536,6 +2536,29 @@ let crop_pdf xywhlist pdf range =
   in
     process_pages crop_page pdf range
 
+(* Clip a page to one of its boxes, or the media box if that box is not
+ * present. This is a hard clip, done by using a clipping rectangle, so that
+ * the page may then be used as a stamp without extraneous material reapearing.
+ * *)
+let hard_box pdf range boxname mediabox_if_missing fast =
+  process_pages
+    (fun pagenum page ->
+       let minx, miny, maxx, maxy =
+         if boxname = "/MediaBox" then
+           Pdf.parse_rectangle page.Pdfpage.mediabox
+         else
+           match Pdf.lookup_direct pdf boxname page.Pdfpage.rest with
+           | Some a -> Pdf.parse_rectangle a
+           | _ ->
+               if mediabox_if_missing
+                 then Pdf.parse_rectangle page.Pdfpage.mediabox
+                 else error "hard_box: Box not found"
+       in
+         let ops = [Pdfops.Op_re (minx, miny, maxx, maxy); Pdfops.Op_W; Pdfops.Op_n] in
+           Pdfpage.prepend_operators pdf ops ~fast:fast page)
+    pdf
+    range
+
 let remove_cropping_pdf pdf range =
   let remove_cropping_page _ page =
     {page with

cpdf.mli

@@ -307,6 +307,8 @@ val hasbox : Pdf.t -> int -> string -> bool
 (** [crop_pdf xywhlist pdf range] sets the cropbox on the given pages. *)
 val crop_pdf : (float * float * float * float) list -> Pdf.t -> int list -> Pdf.t
 
+val hard_box : Pdf.t -> int list -> string -> bool -> bool -> Pdf.t
+
 (** [set_mediabox xywhlist pdf range] sets the media box on the given pages. *)
 val set_mediabox : (float * float * float * float) list -> Pdf.t -> int list -> Pdf.t
 

cpdfcommand.ml

@@ -116,6 +116,7 @@ type op =
   | CopyCropBoxToMediaBox
   | CopyBox
   | MediaBox
+  | HardBox of string
   | Rotate of int
   | Rotateby of int
   | RotateContents of float
@@ -220,6 +221,7 @@ let string_of_op = function
   | CopyCropBoxToMediaBox -> "CopyCropBoxToMediaBox"
   | CopyBox -> "CopyBox"
   | MediaBox -> "MediaBox"
+  | HardBox _ -> "HardBox"
   | Rotate _ -> "Rotate"
   | Rotateby _ -> "Rotateby"
   | RotateContents _ -> "RotateContents"
@@ -609,7 +611,7 @@ let banned banlist = function
   | CSP1|CSP3|TwoUp|TwoUpStack|RemoveBookmarks|AddRectangle|RemoveText|
     Draft|Shift|Scale|ScaleToFit|RemoveAttachedFiles|
     RemoveAnnotations|RemoveMetadata|RemoveFonts|Crop|RemoveCrop|
-    CopyCropBoxToMediaBox|CopyBox|MediaBox|SetTrapped|SetUntrapped|Presentation|
+    CopyCropBoxToMediaBox|CopyBox|MediaBox|HardBox _|SetTrapped|SetUntrapped|Presentation|
     BlackText|BlackLines|BlackFills|CopyFont _|CSP2 _|StampOn _|StampUnder _|
     AddText _|ScaleContents _|AttachFile _|CopyAnnotations _|SetMetadata _|
     ThinLines _|SetAuthor _|SetTitle _|SetSubject _|SetKeywords _|SetCreate _|
@@ -1527,6 +1529,9 @@ let setstayonerror () =
 let setnoembedfont () =
   args.embedfonts <- false
 
+let sethardbox box =
+  args.op <- Some (HardBox box)
+
 (* Parse a control file, make an argv, and then make Arg parse it. *)
 let rec make_control_argv_and_parse filename =
   control_args := !control_args @ parse_control_file filename
@@ -1658,6 +1663,9 @@ and specs =
    ("-crop",
        Arg.String setcrop,
        " Crop specified pages");
+   ("-hard-box",
+       Arg.String sethardbox,
+       " Hard crop specified pages to the given box");
    ("-remove-crop",
        Arg.Unit (setop RemoveCrop),
        " Remove cropping on specified pages");
@@ -3394,6 +3402,15 @@ let go () =
                   write_pdf false pdf
       | _ -> error "set media box: bad command line"
       end
+  | Some (HardBox box) ->
+      begin match args.inputs, args.out with
+      | (_, pagespec, _, _, _, _)::_, _ ->
+          let pdf = get_single_pdf (Some (HardBox box)) false in
+          let range = parse_pagespec pdf pagespec in
+            let pdf = Cpdf.hard_box pdf range box args.mediabox_if_missing args.fast in
+              write_pdf false pdf
+      | _ -> error "hard box: bad command line"
+      end
   | Some CopyBox ->
       begin match args.inputs, args.out with
       | (_, pagespec, _, _, _, _)::_, _ ->