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