Reworking of -copy-annotations

This commit is contained in:
John Whitington 2015-07-29 16:04:36 +01:00
parent db170b428b
commit 32f62797b6
1 changed files with 60 additions and 49 deletions

109
cpdf.ml
View File

@ -2645,59 +2645,70 @@ let equalise_lengths a b =
(take (Pdfpage.pages_of_pagetree a) (Pdfpage.endpage b)) (take (Pdfpage.pages_of_pagetree a) (Pdfpage.endpage b))
else a else a
in in
a', b a', b
(* Copy annotations *)
let copy_annotations_page topdf frompdf frompage topage =
match Pdf.lookup_direct frompdf "/Annots" frompage.Pdfpage.rest with
Some (Pdf.Array frompage_annots as annots) ->
(* Rewrite any annotation destinations to point to pages in the
destination file. This prevents pages being copied, and ensures the
links are correct *)
List.iter
(function
x ->
Printf.printf "Copying annotation %s which is\n%s\n"
(Pdfwrite.string_of_pdf x)
(Pdfwrite.string_of_pdf (Pdf.direct frompdf x)))
frompage_annots;
let objects_to_copy = Pdf.objects_referenced [] [] frompdf annots in
iter
(fun n ->
ignore (Pdf.addobj_given_num topdf (n, Pdf.lookup_obj frompdf n)))
objects_to_copy;
let topage_annots =
match Pdf.lookup_direct frompdf "/Annots" topage.Pdfpage.rest with
| Some (Pdf.Array annots) -> annots
| _ -> []
in
let merged_dict = Pdf.Array (frompage_annots @ topage_annots) in
let topage' =
{topage with Pdfpage.rest =
Pdf.add_dict_entry topage.Pdfpage.rest "/Annots" merged_dict}
in
topdf, topage'
| Some x -> topdf, topage
| None -> topdf, topage
(* \section{Copy annotations} *)
let copy_annotations range frompdf topdf = let copy_annotations range frompdf topdf =
let frompdf, topdf = equalise_lengths frompdf topdf in let frompdf, topdf = equalise_lengths frompdf topdf in
let copy_annotations_page topdf frompdf frompage topage = match Pdf.renumber_pdfs [frompdf; topdf] with
match Pdf.lookup_direct frompdf "/Annots" frompage.Pdfpage.rest with | [frompdf; topdf] ->
| Some ((Pdf.Array frompage_annots) as annots) -> let frompdf_pages = Pdfpage.pages_of_pagetree frompdf
let objects_to_copy = Pdf.objects_referenced [] [] frompdf annots in in let topdf_pages = Pdfpage.pages_of_pagetree topdf in
iter let pdf = ref topdf
(fun n -> and pages = ref []
ignore (Pdf.addobj_given_num topdf (n, Pdf.lookup_obj frompdf n))) and pnum = ref 1
objects_to_copy; and frompdf_pages = ref frompdf_pages
let topage_annots = and topdf_pages = ref topdf_pages in
match Pdf.lookup_direct frompdf "/Annots" topage.Pdfpage.rest with (* Go through, updating pdf and collecting new pages. *)
| Some (Pdf.Array annots) -> annots while not (isnull !frompdf_pages) do
| _ -> [] let frompdf_page = hd !frompdf_pages
in and topdf_page = hd !topdf_pages in
let merged_dict = Pdf.Array (frompage_annots @ topage_annots) in Printf.printf "Page %i...\n" !pnum;
let topage' = let pdf', page =
{topage with Pdfpage.rest = if mem !pnum range
Pdf.add_dict_entry topage.Pdfpage.rest "/Annots" merged_dict} then copy_annotations_page !pdf frompdf frompdf_page topdf_page
else !pdf, topdf_page
in in
topdf, topage' pdf := pdf';
| Some x -> topdf, topage pages =| page;
| None -> topdf, topage incr pnum;
in frompdf_pages := tl !frompdf_pages;
match Pdf.renumber_pdfs [frompdf; topdf] with topdf_pages := tl !topdf_pages
| [frompdf; topdf] -> done;
let frompdf_pages = Pdfpage.pages_of_pagetree frompdf Pdfpage.change_pages true !pdf (rev !pages)
in let topdf_pages = Pdfpage.pages_of_pagetree topdf in | _ -> assert false
let pdf = ref topdf
and pages = ref []
and pnum = ref 1
and frompdf_pages = ref frompdf_pages
and topdf_pages = ref topdf_pages in
(* Go through, updating pdf and collecting new pages. *)
while not (isnull !frompdf_pages) do
let frompdf_page = hd !frompdf_pages
and topdf_page = hd !topdf_pages in
let pdf', page =
if mem !pnum range
then copy_annotations_page !pdf frompdf frompdf_page topdf_page
else !pdf, topdf_page
in
pdf := pdf';
pages =| page;
incr pnum;
frompdf_pages := tl !frompdf_pages;
topdf_pages := tl !topdf_pages
done;
Pdfpage.change_pages true !pdf (rev !pages)
| _ -> assert false
(* \section{N-up} *) (* \section{N-up} *)