pdf-virtual.el (40434B)
1 ;;; pdf-virtual.el --- Virtual PDF documents -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2015 Andreas Politz 4 5 ;; Author: Andreas Politz <politza@hochschule-trier.de> 6 ;; Keywords: multimedia, files 7 8 ;; This program is free software; you can redistribute it and/or modify 9 ;; it under the terms of the GNU General Public License as published by 10 ;; the Free Software Foundation, either version 3 of the License, or 11 ;; (at your option) any later version. 12 13 ;; This program is distributed in the hope that it will be useful, 14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 ;; GNU General Public License for more details. 17 18 ;; You should have received a copy of the GNU General Public License 19 ;; along with this program. If not, see <http://www.gnu.org/licenses/>. 20 21 ;;; Commentary: 22 23 ;; A virtual PDF is a collection of pages, or parts thereof, of 24 ;; arbitrary documents in one particular order. This library acts as 25 ;; an intermediate between pdf-info.el and all other packages, in 26 ;; order to transparently make this collection appear as one single 27 ;; document. 28 ;; 29 ;; The trickiest part is to make these intermediate functions behave 30 ;; like the pdf-info-* equivalents in both the synchronous and 31 ;; asynchronous case. 32 33 ;;; Code: 34 (eval-when-compile 35 (unless (or (> emacs-major-version 24) 36 (and (= emacs-major-version 24) 37 (>= emacs-minor-version 4))) 38 (error "pdf-virtual.el only works with Emacs >= 24.4"))) 39 40 (require 'let-alist) 41 (require 'pdf-info) 42 (require 'pdf-util) 43 44 45 ;; * ================================================================== * 46 ;; * Variables 47 ;; * ================================================================== * 48 49 (defconst pdf-virtual-magic-mode-regexp "^ *;+ *%VPDF\\_>" 50 "A regexp matching the first line in a vpdf file.") 51 52 (defvar-local pdf-virtual-document nil 53 "A list representing the virtual document.") 54 55 (put 'pdf-virtual-document 'permanent-local t) 56 57 (defvar pdf-virtual-adapter-alist nil 58 "Alist of server functions. 59 60 Each element looks like \(PDF-VIRTUAL-FN . PDF-INFO-FN\). This 61 list is filled by the macro `pdf-virtual-define-adapter' and used 62 to enable/disable the corresponding advices.") 63 64 65 ;; * ================================================================== * 66 ;; * VPDF datastructure 67 ;; * ================================================================== * 68 69 (defun pdf-virtual-pagespec-normalize (page-spec &optional filename) 70 "Normalize PAGE-SPEC using FILENAME. 71 72 PAGE-SPEC should be as described in 73 `pdf-virtual-document-create'. FILENAME is used to determine the 74 last page number, if needed. The `current-buffer', if it is nil. 75 76 Returns a list \(\(FIRST . LAST\) . REGION\)\)." 77 78 (let ((page-spec (cond 79 ((natnump page-spec) 80 (list (cons page-spec page-spec))) 81 ((null (car page-spec)) 82 (let ((npages (pdf-info-number-of-pages filename))) 83 (cons (cons 1 npages) 84 (cdr page-spec)))) 85 ((natnump (car page-spec)) 86 (cond 87 ((natnump (cdr page-spec)) 88 (list page-spec)) 89 (t 90 (cons (cons (car page-spec) 91 (car page-spec)) 92 (cdr page-spec))))) 93 (t page-spec)))) 94 (when (equal (cdr page-spec) 95 '(0 0 1 1)) 96 (setq page-spec `((,(caar page-spec) . ,(cdar page-spec))))) 97 page-spec)) 98 99 (cl-defstruct pdf-virtual-range 100 ;; The PDF's filename. 101 filename 102 ;; First page in this range. 103 first 104 ;; Last page. 105 last 106 ;; The edges selected for these pages. 107 region 108 ;; The page-index corresponding to the first page in this range. 109 index-start) 110 111 (cl-defstruct pdf-virtual-document 112 ;; Array of shared pdf-virtual-range structs, one element for each 113 ;; page. 114 page-array 115 ;; An alist mapping filenames to a list of pages. 116 file-map) 117 118 (defun pdf-virtual-range-length (page) 119 "Return the number of pages in PAGE." 120 (1+ (- (pdf-virtual-range-last page) 121 (pdf-virtual-range-first page)))) 122 123 (defun pdf-virtual-document-create (list &optional directory 124 file-error-handler) 125 "Create a virtual PDF from LIST using DIRECTORY. 126 127 LIST should be a list of elements \(FILENAME . PAGE-SPECS\), 128 where FILENAME is a PDF document and PAGE-SPECS is a list of 129 PAGE-RANGE and/or \(PAGE-RANGE . EDGES\). In the later case, 130 EDGES should be a list of relative coordinates \(LEFT TOP RIGHT 131 BOT\) selecting a region of the page(s) in PAGE-RANGE. Giving no 132 PAGE-SPECs at all is equivalent to all pages of FILENAME. 133 134 See `pdf-info-normalize-page-range' for the valid formats of 135 PAGE-RANGE. 136 " 137 138 (unless (cl-every 'consp list) 139 (error "Every element should be a cons: %s" list)) 140 (unless (cl-every 'stringp (mapcar 'car list)) 141 (error "The car of every element should be a filename.")) 142 (unless (cl-every (lambda (elt) 143 (cl-every (lambda (page) 144 (or (pdf-info-valid-page-spec-p page) 145 (and (consp page) 146 (pdf-info-valid-page-spec-p (car page)) 147 (pdf-util-edges-p (cdr page) 'relative)))) 148 elt)) 149 (mapcar 'cdr list)) 150 (error 151 "The cdr of every element should be a list of page-specs")) 152 (let* ((doc (pdf-virtual-document--normalize 153 list (or directory default-directory) 154 file-error-handler)) 155 (npages 0) 156 document file-map) 157 (while doc 158 (let* ((elt (pop doc)) 159 (filename (car elt)) 160 (mapelt (assoc filename file-map)) 161 (page-specs (cdr elt))) 162 (if mapelt 163 (setcdr mapelt (cons (1+ npages) (cdr mapelt))) 164 (push (list filename (1+ npages)) file-map)) 165 (while page-specs 166 (let* ((ps (pop page-specs)) 167 (first (caar ps)) 168 (last (cdar ps)) 169 (region (cdr ps)) 170 (clx (make-pdf-virtual-range 171 :filename filename 172 :first first 173 :last last 174 :region region 175 :index-start npages))) 176 (cl-incf npages (1+ (- last first))) 177 (push (make-vector (1+ (- last first)) clx) 178 document))))) 179 (make-pdf-virtual-document 180 :page-array (apply 'vconcat (nreverse document)) 181 :file-map (nreverse 182 (mapcar (lambda (f) 183 (setcdr f (nreverse (cdr f))) 184 f) 185 file-map))))) 186 187 (defun pdf-virtual-document--normalize (list &optional directory 188 file-error-handler) 189 (unless file-error-handler 190 (setq file-error-handler 191 (lambda (filename err) 192 (signal (car err) 193 (append (cdr err) (list filename)))))) 194 (let ((default-directory 195 (or directory default-directory))) 196 (setq list (cl-remove-if-not 197 (lambda (filename) 198 (condition-case err 199 (progn 200 (unless (file-readable-p filename) 201 (signal 'file-error 202 (list "File not readable: " filename))) 203 (pdf-info-open filename) 204 t) 205 (error 206 (funcall file-error-handler filename err) 207 nil))) 208 list 209 :key 'car)) 210 (let* ((file-attributes (make-hash-table :test 'equal)) 211 (file-equal-p (lambda (f1 f2) 212 (let ((a1 (gethash f1 file-attributes)) 213 (a2 (gethash f2 file-attributes))) 214 (if (and a1 a2) 215 (equal a1 a2) 216 (file-equal-p f1 f2))))) 217 files normalized) 218 ;; Optimize file-equal-p by caching file-attributes, which is slow 219 ;; and would be called quadratic times otherwise. (We don't want 220 ;; the same file under different names.) 221 (dolist (f (mapcar 'car list)) 222 (unless (find-file-name-handler f 'file-equal-p) 223 (puthash f (file-attributes f) file-attributes))) 224 (dolist (elt list) 225 (let ((file (cl-find (car elt) files :test file-equal-p))) 226 (unless file 227 (push (car elt) files) 228 (setq file (car elt))) 229 (let ((pages (mapcar (lambda (p) 230 (pdf-virtual-pagespec-normalize p file)) 231 (or (cdr elt) '(nil)))) 232 newpages) 233 (while pages 234 (let* ((spec (pop pages)) 235 (first (caar spec)) 236 (last (cdar spec)) 237 (region (cdr spec))) 238 (while (and pages 239 (eq (1+ last) 240 (caar (car pages))) 241 (equal region (cdr (car pages)))) 242 (setq last (cdar (pop pages)))) 243 (push `((,first . ,last) . ,region) newpages))) 244 (push (cons file (nreverse newpages)) 245 normalized)))) 246 (nreverse normalized)))) 247 248 (defmacro pdf-virtual-document-defun (name args &optional documentation &rest body) 249 "Define a PDF Document function. 250 251 Args are just like for `defun'. This macro will ensure, that the 252 DOCUMENT argument, which should be last, is setup properly in 253 case it is nil, i.e. check that the buffer passes 254 `pdf-virtual-buffer-assert-p' and use the variable 255 `pdf-virtual-document'." 256 257 (declare (doc-string 3) (indent defun) 258 (debug (&define name lambda-list 259 [&optional stringp] 260 def-body))) 261 (unless (stringp documentation) 262 (push documentation body) 263 (setq documentation nil)) 264 (unless (memq '&optional args) 265 (setq args (append (butlast args) 266 (list '&optional) 267 (last args)))) 268 (when (memq '&rest args) 269 (error "&rest argument not supported")) 270 (let ((doc-arg (car (last args))) 271 (fn (intern (format "pdf-virtual-document-%s" name)))) 272 `(progn 273 (put ',fn 'definition-name ',name) 274 (defun ,fn 275 ,args ,documentation 276 (setq ,doc-arg 277 (or ,doc-arg 278 (progn (pdf-virtual-buffer-assert-p) 279 pdf-virtual-document))) 280 (cl-check-type ,doc-arg pdf-virtual-document) 281 ,@body)))) 282 283 (pdf-virtual-document-defun filenames (doc) 284 "Return the list of filenames in DOC." 285 (mapcar 'car (pdf-virtual-document-file-map doc))) 286 287 (pdf-virtual-document-defun normalize-pages (pages doc) 288 "Normalize PAGES using DOC. 289 290 Like `pdf-info-normalize-page-range', except 0 is replaced by 291 DOC's last page." 292 293 (setq pages (pdf-info-normalize-page-range pages)) 294 (if (eq 0 (cdr pages)) 295 `(,(car pages) . ,(pdf-virtual-document-number-of-pages doc)) 296 pages)) 297 298 (pdf-virtual-document-defun page (page doc) 299 "Get PAGE of DOC. 300 301 Returns a list \(FILENAME FILE-PAGE REGION\)." 302 (let ((page (car (pdf-virtual-document-pages (cons page page) doc)))) 303 (when page 304 (cl-destructuring-bind (filename first-last region) 305 page 306 (list filename (car first-last) region))))) 307 308 (pdf-virtual-document-defun pages (pages doc) 309 "Get PAGES of DOC. 310 311 PAGES should be a cons \(FIRST . LAST\). Return a list of 312 ranges corresponding to PAGES. Each element has the form 313 314 \(FILENAME \(FILE-FIRT-PAGE . FILE-LAST-PAGE\) REGION\) 315 . 316 " 317 318 (let ((begin (car pages)) 319 (end (cdr pages))) 320 (unless (<= begin end) 321 (error "begin should not exceed end: %s" (cons begin end))) 322 (let ((arr (pdf-virtual-document-page-array doc)) 323 result) 324 (when (or (< begin 1) 325 (> end (length arr))) 326 (signal 'args-out-of-range (list 'pages pages))) 327 (while (<= begin end) 328 (let* ((page (aref arr (1- begin))) 329 (filename (pdf-virtual-range-filename page)) 330 (offset (- (1- begin) 331 (pdf-virtual-range-index-start page))) 332 (first (+ (pdf-virtual-range-first page) 333 offset)) 334 (last (min (+ first (- end begin)) 335 (pdf-virtual-range-last page))) 336 (region (pdf-virtual-range-region page))) 337 (push `(,filename (,first . ,last) ,region) result) 338 (cl-incf begin (1+ (- last first))))) 339 (nreverse result)))) 340 341 (pdf-virtual-document-defun number-of-pages (doc) 342 "Return the number of pages in DOC." 343 (length (pdf-virtual-document-page-array doc))) 344 345 (pdf-virtual-document-defun page-of (filename &optional file-page limit doc) 346 "Return a page number displaying FILENAME's page FILE-PAGE in DOC. 347 348 If FILE-PAGE is nil, return the first page displaying FILENAME. 349 If LIMIT is non-nil, it should be a range \(FIRST . LAST\) in 350 which the returned page should fall. This is useful if there are 351 more than one page displaying FILE-PAGE. LIMIT is ignored, if 352 FILE-PAGE is nil. 353 354 Return nil if there is no matching page." 355 356 (if (null file-page) 357 (cadr (assoc filename (pdf-virtual-document-file-map doc))) 358 (let ((pages (pdf-virtual-document-page-array doc))) 359 (catch 'found 360 (mapc 361 (lambda (pn) 362 (while (and (<= pn (length pages)) 363 (equal (pdf-virtual-range-filename (aref pages (1- pn))) 364 filename)) 365 (let* ((page (aref pages (1- pn))) 366 (first (pdf-virtual-range-first page)) 367 (last (pdf-virtual-range-last page))) 368 (when (and (>= file-page first) 369 (<= file-page last)) 370 (let ((r (+ (pdf-virtual-range-index-start page) 371 (- file-page (pdf-virtual-range-first page)) 372 1))) 373 (when (or (null limit) 374 (and (>= r (car limit)) 375 (<= r (cdr limit)))) 376 (throw 'found r)))) 377 (cl-incf pn (1+ (- last first)))))) 378 (cdr (assoc filename (pdf-virtual-document-file-map doc)))) 379 nil)))) 380 381 (pdf-virtual-document-defun find-matching-page (page predicate 382 &optional 383 backward-p doc) 384 (unless (and (>= page 1) 385 (<= page (length (pdf-virtual-document-page-array doc)))) 386 (signal 'args-out-of-range (list 'page page))) 387 (let* ((pages (pdf-virtual-document-page-array doc)) 388 (i (1- page)) 389 (this (aref pages i)) 390 other) 391 (while (and (< i (length pages)) 392 (>= i 0) 393 (null other)) 394 (setq i 395 (if backward-p 396 (1- (pdf-virtual-range-index-start this)) 397 (+ (pdf-virtual-range-length this) 398 (pdf-virtual-range-index-start this)))) 399 (when (and (< i (length pages)) 400 (>= i 0)) 401 (setq other (aref pages i)) 402 (unless (funcall predicate this other) 403 (setq other nil)))) 404 other)) 405 406 (pdf-virtual-document-defun next-matching-page (page predicate doc) 407 (pdf-virtual-document-find-matching-page page predicate nil doc)) 408 409 (pdf-virtual-document-defun previous-matching-page (page predicate doc) 410 (declare (indent 1)) 411 (pdf-virtual-document-find-matching-page page predicate t doc)) 412 413 (pdf-virtual-document-defun next-file (page doc) 414 "Return the next page displaying a different file than PAGE. 415 416 PAGE should be a page-number." 417 (let ((page (pdf-virtual-document-next-matching-page 418 page 419 (lambda (this other) 420 (not (equal (pdf-virtual-range-filename this) 421 (pdf-virtual-range-filename other))))))) 422 (when page 423 (1+ (pdf-virtual-range-index-start page))))) 424 425 (pdf-virtual-document-defun previous-file (page doc) 426 "Return the previous page displaying a different file than PAGE. 427 428 PAGE should be a page-number." 429 (let ((page (pdf-virtual-document-previous-matching-page 430 page 431 (lambda (this other) 432 (not (equal (pdf-virtual-range-filename this) 433 (pdf-virtual-range-filename other))))))) 434 (when page 435 (1+ (pdf-virtual-range-index-start page))))) 436 437 438 ;; * ================================================================== * 439 ;; * Modes 440 ;; * ================================================================== * 441 442 (defvar pdf-virtual-edit-mode-map 443 (let ((map (make-sparse-keymap))) 444 (set-keymap-parent map emacs-lisp-mode-map) 445 (define-key map (kbd "C-c C-c") 'pdf-virtual-view-mode) 446 map)) 447 448 449 ;;;###autoload 450 (define-derived-mode pdf-virtual-edit-mode emacs-lisp-mode "VPDF-Edit" 451 "Major mode when editing a virtual PDF buffer." 452 (buffer-enable-undo) 453 (setq-local buffer-read-only nil) 454 (unless noninteractive 455 (message (substitute-command-keys "Press \\[pdf-virtual-view-mode] to view.")))) 456 457 ;; FIXME: Provide filename/region from-windows-gathering functions. 458 (defvar pdf-virtual-view-mode-map 459 (let ((map (make-sparse-keymap))) 460 (set-keymap-parent map pdf-view-mode-map) 461 (define-key map (kbd "C-c C-c") 'pdf-virtual-edit-mode) 462 (define-key map [remap backward-paragraph] 'pdf-virtual-buffer-backward-file) 463 (define-key map [remap forward-paragraph] 'pdf-virtual-buffer-forward-file) 464 (define-key map (kbd "C-c C-c") 'pdf-virtual-edit-mode) 465 map)) 466 467 ;;;###autoload 468 (define-derived-mode pdf-virtual-view-mode pdf-view-mode "VPDF-View" 469 "Major mode in virtual PDF buffers." 470 (setq-local write-contents-functions nil) 471 (remove-hook 'kill-buffer-hook 'pdf-view-close-document t) 472 (setq-local header-line-format 473 `(:eval (pdf-virtual-buffer-current-file))) 474 (unless noninteractive 475 (message (substitute-command-keys "Press \\[pdf-virtual-edit-mode] to edit.")))) 476 477 ;;;###autoload 478 (define-minor-mode pdf-virtual-global-minor-mode 479 "Enable recognition and handling of VPDF files." 480 :global t 481 :group 'pdf-tools 482 (let ((elt `(,pdf-virtual-magic-mode-regexp . pdf-virtual-view-mode))) 483 (cond 484 (pdf-virtual-global-minor-mode 485 (add-to-list 'magic-mode-alist elt)) 486 (t 487 (setq magic-mode-alist 488 (remove elt magic-mode-alist)))) 489 (dolist (elt pdf-virtual-adapter-alist) 490 (let ((fn (car elt)) 491 (orig (cdr elt))) 492 (advice-remove orig fn) 493 (when pdf-virtual-global-minor-mode 494 (advice-add orig :around fn)))))) 495 496 (advice-add 'pdf-virtual-view-mode 497 :around 'pdf-virtual-view-mode-prepare) 498 499 ;; This needs to run before pdf-view-mode does its thing. 500 (defun pdf-virtual-view-mode-prepare (fn) 501 (let (list unreadable) 502 (save-excursion 503 (goto-char 1) 504 (unless (looking-at pdf-virtual-magic-mode-regexp) 505 (pdf-virtual-buffer-assert-p)) 506 (setq list (read (current-buffer)))) 507 (setq pdf-virtual-document 508 (pdf-virtual-document-create 509 list 510 nil 511 (lambda (filename _error) 512 (push filename unreadable)))) 513 (when unreadable 514 (display-warning 515 'pdf-virtual 516 (format "Some documents could not be opened:\n%s" 517 (mapconcat (lambda (f) 518 (concat " " f)) 519 unreadable "\n")))) 520 (if (= (pdf-virtual-document-number-of-pages) 0) 521 (error "Document is empty.") 522 (unless pdf-virtual-global-minor-mode 523 (pdf-virtual-global-minor-mode 1)) 524 (funcall fn)))) 525 526 527 ;; * ================================================================== * 528 ;; * Buffer handling 529 ;; * ================================================================== * 530 531 ;;;###autoload 532 (defun pdf-virtual-buffer-create (&optional filenames buffer-name display-p) 533 (interactive 534 (list (directory-files default-directory nil "\\.pdf\\'") 535 (read-string 536 "Buffer name (default: all.vpdf): " nil nil "all.vpdf") t)) 537 (with-current-buffer (generate-new-buffer buffer-name) 538 (insert ";; %VPDF 1.0\n\n") 539 (insert ";; File Format 540 ;; 541 ;; FORMAT ::= ( FILES* ) 542 ;; FILES ::= ( FILE . PAGE-SPEC* ) 543 ;; PAGE-SPEC ::= PAGE | ( PAGE . REGION ) 544 ;; PAGE ::= NUMBER | ( FIRST . LAST ) 545 ;; REGION ::= ( LEFT TOP RIGHT BOT ) 546 ;; 547 ;; 0 <= X <= 1, forall X in REGION . 548 549 ") 550 (if (null filenames) 551 (insert "nil\n") 552 (insert "(") 553 (dolist (f filenames) 554 (insert (format "(%S)\n " f))) 555 (delete-char -2) 556 (insert ")\n")) 557 (pdf-virtual-edit-mode) 558 (when display-p 559 (pop-to-buffer (current-buffer))) 560 (current-buffer))) 561 562 (defun pdf-virtual-buffer-p (&optional buffer) 563 (save-current-buffer 564 (when buffer (set-buffer buffer)) 565 (or (derived-mode-p 'pdf-virtual-view-mode 'pdf-virtual-edit-mode) 566 pdf-virtual-document))) 567 568 (defun pdf-virtual-view-window-p (&optional window) 569 (save-selected-window 570 (when window (select-window window 'norecord)) 571 (derived-mode-p 'pdf-virtual-view-mode))) 572 573 (defun pdf-virtual-filename-p (filename) 574 (and (stringp filename) 575 (file-exists-p filename) 576 (with-temp-buffer 577 (save-excursion (insert-file-contents filename nil 0 128)) 578 (looking-at pdf-virtual-magic-mode-regexp)))) 579 580 (defun pdf-virtual-buffer-assert-p (&optional buffer) 581 (unless (pdf-virtual-buffer-p buffer) 582 (error "Buffer is not a virtual PDF buffer"))) 583 584 (defun pdf-virtual-view-window-assert-p (&optional window) 585 (unless (pdf-virtual-view-window-p window) 586 (error "Window's buffer is not in `pdf-virtual-view-mode'."))) 587 588 (defun pdf-virtual-buffer-current-file (&optional window) 589 (pdf-virtual-view-window-assert-p window) 590 (pdf-virtual-range-filename 591 (aref (pdf-virtual-document-page-array 592 pdf-virtual-document) 593 (1- (pdf-view-current-page window))))) 594 595 (defun pdf-virtual-buffer-forward-file (&optional n interactive-p) 596 (interactive "p\np") 597 (pdf-virtual-view-window-assert-p) 598 (let* ((pn (pdf-view-current-page)) 599 (pages (pdf-virtual-document-page-array 600 pdf-virtual-document)) 601 (page (aref pages (1- pn))) 602 (first-filepage (1+ (pdf-virtual-range-index-start page)))) 603 604 (when (and (< n 0) 605 (not (= first-filepage pn))) 606 (cl-incf n)) 607 (setq pn first-filepage) 608 609 (let (next) 610 (while (and (> n 0) 611 (setq next (pdf-virtual-document-next-file pn))) 612 (setq pn next) 613 (cl-decf n))) 614 (let (previous) 615 (while (and (< n 0) 616 (setq previous (pdf-virtual-document-previous-file pn))) 617 (setq pn previous) 618 (cl-incf n))) 619 (when interactive-p 620 (when (< n 0) 621 (message "First file.")) 622 (when (> n 0) 623 (message "Last file."))) 624 (pdf-view-goto-page pn) 625 n)) 626 627 (defun pdf-virtual-buffer-backward-file (&optional n interactive-p) 628 (interactive "p\np") 629 (pdf-virtual-buffer-forward-file (- (or n 1)) interactive-p)) 630 631 632 ;; * ================================================================== * 633 ;; * Helper functions 634 ;; * ================================================================== * 635 636 637 (defmacro pdf-virtual-dopages (bindings pages &rest body) 638 (declare (indent 2) (debug (sexp form &rest form))) 639 (let ((page (make-symbol "page"))) 640 `(dolist (,page ,pages) 641 (cl-destructuring-bind ,bindings 642 ,page 643 ,@body)))) 644 645 (defun pdf-virtual--perform-search (string pages &optional regexp-p no-error) 646 (let* ((pages (pdf-virtual-document-normalize-pages pages)) 647 (file-pages (pdf-virtual-document-pages pages))) 648 (pdf-info-compose-queries 649 ((responses 650 (pdf-virtual-dopages (filename pages _region) 651 file-pages 652 (if regexp-p 653 (pdf-info-search-string string pages filename) 654 ;; FIXME: no-error won't work with synchronous calls. 655 (pdf-info-search-regexp string pages no-error filename))))) 656 (let (result) 657 (pdf-virtual-dopages (filename _ region) 658 file-pages 659 (let ((matches (pop responses))) 660 (when region 661 (setq matches 662 (mapcar 663 (lambda (m) 664 (let-alist m 665 `((edges . ,(pdf-util-edges-transform region .edges t)) 666 ,@m))) 667 (pdf-virtual--filter-edges 668 region matches 669 (apply-partially 'alist-get 'edges))))) 670 (dolist (m matches) 671 (push `((page . ,(pdf-virtual-document-page-of 672 filename (alist-get 'page m) 673 pages)) 674 ,@m) 675 result)))) 676 (nreverse result))))) 677 678 (defun pdf-virtual--filter-edges (region elts &optional edges-key-fn) 679 (if (null region) 680 elts 681 (cl-remove-if-not 682 (lambda (edges) 683 (or (null edges) 684 (if (consp (car edges)) 685 (cl-some (apply-partially 'pdf-util-edges-intersection region) edges) 686 (pdf-util-edges-intersection region edges)))) 687 elts 688 :key edges-key-fn))) 689 690 (defun pdf-virtual--transform-goto-dest (link filename region) 691 (let-alist link 692 (let ((local-page (pdf-virtual-document-page-of 693 filename .page))) 694 (if local-page 695 `((type . ,'goto-dest) 696 (title . , .title) 697 (page . ,local-page) 698 (top . ,(car (pdf-util-edges-transform 699 region (cons .top .top) t)))) 700 `((type . ,'goto-remote) 701 (title . , .title) 702 (filename . ,filename) 703 (page . , .page) 704 (top . , .top)))))) 705 706 707 ;; * ================================================================== * 708 ;; * Server adapter 709 ;; * ================================================================== * 710 711 (defmacro pdf-virtual-define-adapter (name arglist &optional doc &rest body) 712 ;; FIXME: Handle &optional + &rest argument. 713 (declare (doc-string 3) (indent 2) 714 (debug (&define name lambda-list 715 [&optional stringp] 716 def-body))) 717 (unless (stringp doc) 718 (push doc body) 719 (setq doc nil)) 720 (let ((fn (intern (format "pdf-virtual-%s" name))) 721 (base-fn (intern (format "pdf-info-%s" name))) 722 (base-fn-arg (make-symbol "fn")) 723 (true-file-or-buffer (make-symbol "true-file-or-buffer")) 724 (args (cl-remove-if (lambda (elt) 725 (memq elt '(&optional &rest))) 726 arglist))) 727 (unless (fboundp base-fn) 728 (error "Base function is undefined: %s" base-fn)) 729 (unless (memq 'file-or-buffer arglist) 730 (error "Argument list is missing a `file-or-buffer' argument: %s" arglist)) 731 `(progn 732 (put ',fn 'definition-name ',name) 733 (add-to-list 'pdf-virtual-adapter-alist ',(cons fn base-fn)) 734 (defun ,fn ,(cons base-fn-arg arglist) 735 ,(format "%sPDF virtual adapter to `%s'. 736 737 This function delegates to `%s', unless the FILE-OR-BUFFER 738 argument denotes a VPDF document." 739 (if doc (concat doc "\n\n") "") 740 base-fn 741 base-fn) 742 (let ((,true-file-or-buffer 743 (cond 744 ((or (bufferp file-or-buffer) 745 (stringp file-or-buffer)) file-or-buffer) 746 ((or (null file-or-buffer) 747 ,(not (null (memq '&rest arglist)))) 748 (current-buffer))))) 749 (if (cond 750 ((null ,true-file-or-buffer) t) 751 ((bufferp ,true-file-or-buffer) 752 (not (pdf-virtual-buffer-p ,true-file-or-buffer))) 753 ((stringp ,true-file-or-buffer) 754 (not (pdf-virtual-filename-p ,true-file-or-buffer)))) 755 (,(if (memq '&rest arglist) 'apply 'funcall) ,base-fn-arg ,@args) 756 (when (stringp ,true-file-or-buffer) 757 (setq ,true-file-or-buffer 758 (find-file-noselect ,true-file-or-buffer))) 759 (save-current-buffer 760 (when (bufferp ,true-file-or-buffer) 761 (set-buffer ,true-file-or-buffer)) 762 ,@body))))))) 763 764 (define-error 'pdf-virtual-unsupported-operation 765 "Operation not supported in VPDF buffer") 766 767 (pdf-virtual-define-adapter open (&optional file-or-buffer password) 768 (mapc (lambda (file) 769 (pdf-info-open file password)) 770 (pdf-virtual-document-filenames))) 771 772 (pdf-virtual-define-adapter close (&optional file-or-buffer) 773 (let ((files (cl-remove-if 'find-buffer-visiting 774 (pdf-virtual-document-filenames)))) 775 (pdf-info-compose-queries 776 ((results (mapc 'pdf-info-close files))) 777 (cl-some 'identity results)))) 778 779 (pdf-virtual-define-adapter metadata (&optional file-or-buffer) 780 (pdf-info-compose-queries 781 ((md (mapc 'pdf-info-metadata (pdf-virtual-document-filenames)))) 782 (apply 'cl-mapcar (lambda (&rest elts) 783 (cons (caar elts) 784 (cl-mapcar 'cdr elts))) 785 md))) 786 787 (pdf-virtual-define-adapter search-string (string &optional pages file-or-buffer) 788 (pdf-virtual--perform-search 789 string (pdf-virtual-document-normalize-pages pages))) 790 791 (pdf-virtual-define-adapter search-regexp (pcre &optional 792 pages no-error file-or-buffer) 793 (pdf-virtual--perform-search 794 pcre (pdf-virtual-document-normalize-pages pages) 'regexp no-error)) 795 796 (pdf-virtual-define-adapter pagelinks (page &optional file-or-buffer) 797 (cl-destructuring-bind (filename ext-page region) 798 (pdf-virtual-document-page page) 799 (pdf-info-compose-queries 800 ((links (pdf-info-pagelinks ext-page filename))) 801 (mapcar 802 (lambda (link) 803 (let-alist link 804 (if (not (eq .type 'goto-dest)) 805 link 806 `((edges . ,(pdf-util-edges-transform region .edges t)) 807 ,@(pdf-virtual--transform-goto-dest link filename region))))) 808 (pdf-virtual--filter-edges region (car links) 'car))))) 809 810 (pdf-virtual-define-adapter number-of-pages (&optional file-or-buffer) 811 (pdf-info-compose-queries nil (pdf-virtual-document-number-of-pages))) 812 813 (pdf-virtual-define-adapter outline (&optional file-or-buffer) 814 (let ((files (pdf-virtual-document-filenames))) 815 (pdf-info-compose-queries 816 ((outlines (mapc 'pdf-info-outline files))) 817 (cl-mapcan 818 (lambda (outline filename) 819 `(((depth . 1) 820 (type . goto-dest) 821 (title . ,filename) 822 (page . ,(pdf-virtual-document-page-of filename)) 823 (top . 0)) 824 ,@(delq 825 nil 826 (mapcar 827 (lambda (item) 828 (let-alist item 829 (if (not (eq .type 'goto-dest)) 830 `((depth . ,(1+ .depth)) 831 ,@item) 832 (cl-check-type filename string) 833 (let ((page (pdf-virtual-document-page-of 834 filename .page))) 835 (when page 836 `((depth . ,(1+ .depth)) 837 ,@(pdf-virtual--transform-goto-dest 838 item filename 839 (nth 2 (pdf-virtual-document-page page))))))))) 840 outline)))) 841 outlines files)))) 842 843 (pdf-virtual-define-adapter gettext (page edges &optional 844 selection-style file-or-buffer) 845 (cl-destructuring-bind (filename file-page region) 846 (pdf-virtual-document-page page) 847 (let ((edges (pdf-util-edges-transform region edges))) 848 (pdf-info-gettext file-page edges selection-style filename)))) 849 850 (pdf-virtual-define-adapter getselection (page edges &optional 851 selection-style file-or-buffer) 852 (cl-destructuring-bind (filename file-page region) 853 (pdf-virtual-document-page page) 854 (let ((edges (pdf-util-edges-transform region edges))) 855 (pdf-info-compose-queries 856 ((results (pdf-info-getselection file-page edges selection-style filename))) 857 (pdf-util-edges-transform 858 region 859 (pdf-virtual--filter-edges region (car results)) t))))) 860 861 (pdf-virtual-define-adapter charlayout (page &optional edges-or-pos file-or-buffer) 862 (cl-destructuring-bind (filename file-page region) 863 (pdf-virtual-document-page page) 864 (let ((edges-or-pos (pdf-util-edges-transform region edges-or-pos))) 865 (pdf-info-compose-queries 866 ((results (pdf-info-charlayout file-page edges-or-pos filename))) 867 (mapcar (lambda (elt) 868 `(,(car elt) 869 . ,(pdf-util-edges-transform region (cdr elt) t))) 870 (pdf-virtual--filter-edges region (car results) 'cadr)))))) 871 872 (pdf-virtual-define-adapter pagesize (page &optional file-or-buffer) 873 (cl-destructuring-bind (filename file-page region) 874 (pdf-virtual-document-page page) 875 (pdf-info-compose-queries 876 ((result (pdf-info-pagesize file-page filename))) 877 (if (null region) 878 (car result) 879 (pdf-util-with-edges (region) 880 (pdf-util-scale 881 (car result) (cons region-width region-height))))))) 882 883 (pdf-virtual-define-adapter getannots (&optional pages file-or-buffer) 884 (let* ((pages (pdf-virtual-document-normalize-pages pages)) 885 (file-pages (pdf-virtual-document-pages pages))) 886 (pdf-info-compose-queries 887 ((annotations 888 (pdf-virtual-dopages (filename file-pages _region) 889 file-pages 890 (pdf-info-getannots file-pages filename)))) 891 (let ((page (car pages)) 892 result) 893 (pdf-virtual-dopages (_filename file-pages region) 894 file-pages 895 (dolist (a (pop annotations)) 896 (let ((edges (delq nil `(,(cdr (assq 'edges a)) 897 ,@(cdr (assq 'markup-edges a)))))) 898 (when (pdf-virtual--filter-edges region edges) 899 (let-alist a 900 (setcdr (assq 'page a) 901 (+ page (- .page (car file-pages)))) 902 (setcdr (assq 'id a) 903 (intern (format "%s/%d" .id (cdr (assq 'page a))))) 904 (when region 905 (when .edges 906 (setcdr (assq 'edges a) 907 (pdf-util-edges-transform region .edges t))) 908 (when .markup-edges 909 (setcdr (assq 'markup-edges a) 910 (pdf-util-edges-transform region .markup-edges t)))) 911 (push a result))))) 912 (cl-incf page (1+ (- (cdr file-pages) (car file-pages))))) 913 (nreverse result))))) 914 915 (pdf-virtual-define-adapter getannot (id &optional file-or-buffer) 916 (let ((name (symbol-name id)) 917 page) 918 (save-match-data 919 (when (string-match "\\(.*\\)/\\([0-9]+\\)\\'" name) 920 (setq id (intern (match-string 1 name)) 921 page (string-to-number (match-string 2 name))))) 922 (if page 923 (cl-destructuring-bind (filename _ _) 924 (pdf-virtual-document-page page) 925 (pdf-info-compose-queries 926 ((result (pdf-info-getannot id filename))) 927 (let ((a (car result))) 928 (cl-destructuring-bind (_ _ region) 929 (pdf-virtual-document-page page) 930 (setcdr (assq 'page a) page) 931 (let-alist a 932 (setcdr (assq 'id a) 933 (intern (format "%s/%d" .id (cdr (assq 'page a))))) 934 (when region 935 (when .edges 936 (setcdr (assq 'edges a) 937 (pdf-util-edges-transform region .edges t))) 938 (when .markup-edges 939 (setcdr (assq 'markup-edges a) 940 (pdf-util-edges-transform region .markup-edges t)))))) 941 a))) 942 (pdf-info-compose-queries nil 943 (error "No such annotation: %s" id))))) 944 945 (pdf-virtual-define-adapter addannot (page edges type &optional 946 file-or-buffer &rest markup-edges) 947 (signal 'pdf-virtual-unsupported-operation (list 'addannot))) 948 949 (pdf-virtual-define-adapter delannot (id &optional file-or-buffer) 950 (signal 'pdf-virtual-unsupported-operation (list 'delannot))) 951 952 (pdf-virtual-define-adapter mvannot (id edges &optional file-or-buffer) 953 (signal 'pdf-virtual-unsupported-operation (list 'mvannot))) 954 955 (pdf-virtual-define-adapter editannot (id modifications &optional file-or-buffer) 956 (signal 'pdf-virtual-unsupported-operation (list 'editannot))) 957 958 (pdf-virtual-define-adapter save (&optional file-or-buffer) 959 (signal 'pdf-virtual-unsupported-operation (list 'save))) 960 961 ;;(defvar-local pdf-virtual-annotation-mapping nil) 962 963 (pdf-virtual-define-adapter getattachment-from-annot 964 (id &optional do-save file-or-buffer) 965 (let ((name (symbol-name id)) 966 page) 967 (save-match-data 968 (when (string-match "\\(.*\\)/\\([0-9]+\\)\\'" name) 969 (setq id (intern (match-string 1 name)) 970 page (string-to-number (match-string 2 name))))) 971 (if page 972 (cl-destructuring-bind (filename _ _) 973 (pdf-virtual-document-page page) 974 (pdf-info-getattachment-from-annot id do-save filename)) 975 (pdf-info-compose-queries nil 976 (error "No such annotation: %s" id))))) 977 978 (pdf-virtual-define-adapter getattachments (&optional do-save file-or-buffer) 979 (pdf-info-compose-queries 980 ((results (mapc 981 (lambda (f) 982 (pdf-info-getattachments do-save f)) 983 (pdf-virtual-document-filenames)))) 984 (apply 'append results))) 985 986 (pdf-virtual-define-adapter synctex-forward-search 987 (source &optional line column file-or-buffer) 988 (signal 'pdf-virtual-unsupported-operation (list 'synctex-forward-search))) 989 990 (pdf-virtual-define-adapter synctex-backward-search (page &optional x y file-or-buffer) 991 (cl-destructuring-bind (filename file-page region) 992 (pdf-virtual-document-page page) 993 (cl-destructuring-bind (x &rest y) 994 (pdf-util-edges-transform region (cons x y)) 995 (pdf-info-synctex-backward-search file-page x y filename)))) 996 997 (pdf-virtual-define-adapter renderpage (page width &optional file-or-buffer 998 &rest commands) 999 (when (keywordp file-or-buffer) 1000 (push file-or-buffer commands) 1001 (setq file-or-buffer nil)) 1002 (cl-destructuring-bind (filename file-page region) 1003 (pdf-virtual-document-page page) 1004 (when region 1005 (setq commands (append (list :crop-to region) commands) 1006 width (pdf-util-with-edges (region) 1007 (round (* width (max 1 (/ 1.0 (max 1e-6 region-width)))))))) 1008 (apply 'pdf-info-renderpage file-page width filename commands))) 1009 1010 (pdf-virtual-define-adapter boundingbox (page &optional file-or-buffer) 1011 (cl-destructuring-bind (filename file-page region) 1012 (pdf-virtual-document-page page) 1013 (pdf-info-compose-queries 1014 ((results (unless region (pdf-info-boundingbox file-page filename)))) 1015 (if region 1016 (list 0 0 1 1) 1017 (car results))))) 1018 1019 (pdf-virtual-define-adapter pagelabels (&optional file-or-buffer) 1020 (signal 'pdf-virtual-unsupported-operation (list 'pagelabels))) 1021 1022 (pdf-virtual-define-adapter setoptions (&optional file-or-buffer &rest options) 1023 (when (keywordp file-or-buffer) 1024 (push file-or-buffer options) 1025 (setq file-or-buffer nil)) 1026 (pdf-info-compose-queries 1027 ((_ (dolist (f (pdf-virtual-document-filenames)) 1028 (apply 'pdf-info-setoptions f options)))) 1029 nil)) 1030 1031 (pdf-virtual-define-adapter getoptions (&optional file-or-buffer) 1032 (signal 'pdf-virtual-unsupported-operation (list 'getoptions))) 1033 1034 (pdf-virtual-define-adapter encrypted-p (&optional file-or-buffer) 1035 nil) 1036 1037 (provide 'pdf-virtual) 1038 ;;; pdf-virtual.el ends here