Archived
1
0
Fork 0
This repository has been archived on 2024-10-19. You can view files and clone it, but cannot push or open issues or pull requests.
emacs/org/elpa/pdf-tools-20220823.513/pdf-virtual.el

1040 lines
40 KiB
EmacsLisp
Raw Normal View History

2022-08-25 15:49:25 +00:00
;;; pdf-virtual.el --- Virtual PDF documents -*- lexical-binding: t; -*-
;; Copyright (C) 2015 Andreas Politz
;; Author: Andreas Politz <politza@hochschule-trier.de>
;; Keywords: multimedia, files
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; A virtual PDF is a collection of pages, or parts thereof, of
;; arbitrary documents in one particular order. This library acts as
;; an intermediate between pdf-info.el and all other packages, in
;; order to transparently make this collection appear as one single
;; document.
;;
;; The trickiest part is to make these intermediate functions behave
;; like the pdf-info-* equivalents in both the synchronous and
;; asynchronous case.
;;; Code:
(eval-when-compile
(unless (or (> emacs-major-version 24)
(and (= emacs-major-version 24)
(>= emacs-minor-version 4)))
(error "pdf-virtual.el only works with Emacs >= 24.4")))
(require 'let-alist)
(require 'pdf-info)
(require 'pdf-util)
(declare-function pdf-view-mode "pdf-view.el")
;; * ================================================================== *
;; * Variables
;; * ================================================================== *
(defconst pdf-virtual-magic-mode-regexp "^ *;+ *%VPDF\\_>"
"A regexp matching the first line in a vpdf file.")
(defvar-local pdf-virtual-document nil
"A list representing the virtual document.")
(put 'pdf-virtual-document 'permanent-local t)
(defvar pdf-virtual-adapter-alist nil
"Alist of server functions.
Each element looks like \(PDF-VIRTUAL-FN . PDF-INFO-FN\). This
list is filled by the macro `pdf-virtual-define-adapter' and used
to enable/disable the corresponding advices.")
;; * ================================================================== *
;; * VPDF datastructure
;; * ================================================================== *
(defun pdf-virtual-pagespec-normalize (page-spec &optional filename)
"Normalize PAGE-SPEC using FILENAME.
PAGE-SPEC should be as described in
`pdf-virtual-document-create'. FILENAME is used to determine the
last page number, if needed. The `current-buffer', if it is nil.
Returns a list \(\(FIRST . LAST\) . REGION\)\)."
(let ((page-spec (cond
((natnump page-spec)
(list (cons page-spec page-spec)))
((null (car page-spec))
(let ((npages (pdf-info-number-of-pages filename)))
(cons (cons 1 npages)
(cdr page-spec))))
((natnump (car page-spec))
(cond
((natnump (cdr page-spec))
(list page-spec))
(t
(cons (cons (car page-spec)
(car page-spec))
(cdr page-spec)))))
(t page-spec))))
(when (equal (cdr page-spec)
'(0 0 1 1))
(setq page-spec `((,(caar page-spec) . ,(cdar page-spec)))))
page-spec))
(cl-defstruct pdf-virtual-range
;; The PDF's filename.
filename
;; First page in this range.
first
;; Last page.
last
;; The edges selected for these pages.
region
;; The page-index corresponding to the first page in this range.
index-start)
(cl-defstruct pdf-virtual-document
;; Array of shared pdf-virtual-range structs, one element for each
;; page.
page-array
;; An alist mapping filenames to a list of pages.
file-map)
(defun pdf-virtual-range-length (page)
"Return the number of pages in PAGE."
(1+ (- (pdf-virtual-range-last page)
(pdf-virtual-range-first page))))
(defun pdf-virtual-document-create (list &optional directory
file-error-handler)
"Create a virtual PDF from LIST using DIRECTORY.
LIST should be a list of elements \(FILENAME . PAGE-SPECS\),
where FILENAME is a PDF document and PAGE-SPECS is a list of
PAGE-RANGE and/or \(PAGE-RANGE . EDGES\). In the later case,
EDGES should be a list of relative coordinates \(LEFT TOP RIGHT
BOT\) selecting a region of the page(s) in PAGE-RANGE. Giving no
PAGE-SPECs at all is equivalent to all pages of FILENAME.
See `pdf-info-normalize-page-range' for the valid formats of
PAGE-RANGE.
"
(unless (cl-every 'consp list)
(error "Every element should be a cons: %s" list))
(unless (cl-every 'stringp (mapcar 'car list))
(error "The car of every element should be a filename."))
(unless (cl-every (lambda (elt)
(cl-every (lambda (page)
(or (pdf-info-valid-page-spec-p page)
(and (consp page)
(pdf-info-valid-page-spec-p (car page))
(pdf-util-edges-p (cdr page) 'relative))))
elt))
(mapcar 'cdr list))
(error
"The cdr of every element should be a list of page-specs"))
(let* ((doc (pdf-virtual-document--normalize
list (or directory default-directory)
file-error-handler))
(npages 0)
document file-map)
(while doc
(let* ((elt (pop doc))
(filename (car elt))
(mapelt (assoc filename file-map))
(page-specs (cdr elt)))
(if mapelt
(setcdr mapelt (cons (1+ npages) (cdr mapelt)))
(push (list filename (1+ npages)) file-map))
(while page-specs
(let* ((ps (pop page-specs))
(first (caar ps))
(last (cdar ps))
(region (cdr ps))
(clx (make-pdf-virtual-range
:filename filename
:first first
:last last
:region region
:index-start npages)))
(cl-incf npages (1+ (- last first)))
(push (make-vector (1+ (- last first)) clx)
document)))))
(make-pdf-virtual-document
:page-array (apply 'vconcat (nreverse document))
:file-map (nreverse
(mapcar (lambda (f)
(setcdr f (nreverse (cdr f)))
f)
file-map)))))
(defun pdf-virtual-document--normalize (list &optional directory
file-error-handler)
(unless file-error-handler
(setq file-error-handler
(lambda (filename err)
(signal (car err)
(append (cdr err) (list filename))))))
(let ((default-directory
(or directory default-directory)))
(setq list (cl-remove-if-not
(lambda (filename)
(condition-case err
(progn
(unless (file-readable-p filename)
(signal 'file-error
(list "File not readable: " filename)))
(pdf-info-open filename)
t)
(error
(funcall file-error-handler filename err)
nil)))
list
:key 'car))
(let* ((file-attributes (make-hash-table :test 'equal))
(file-equal-p (lambda (f1 f2)
(let ((a1 (gethash f1 file-attributes))
(a2 (gethash f2 file-attributes)))
(if (and a1 a2)
(equal a1 a2)
(file-equal-p f1 f2)))))
files normalized)
;; Optimize file-equal-p by caching file-attributes, which is slow
;; and would be called quadratic times otherwise. (We don't want
;; the same file under different names.)
(dolist (f (mapcar 'car list))
(unless (find-file-name-handler f 'file-equal-p)
(puthash f (file-attributes f) file-attributes)))
(dolist (elt list)
(let ((file (cl-find (car elt) files :test file-equal-p)))
(unless file
(push (car elt) files)
(setq file (car elt)))
(let ((pages (mapcar (lambda (p)
(pdf-virtual-pagespec-normalize p file))
(or (cdr elt) '(nil))))
newpages)
(while pages
(let* ((spec (pop pages))
(first (caar spec))
(last (cdar spec))
(region (cdr spec)))
(while (and pages
(eq (1+ last)
(caar (car pages)))
(equal region (cdr (car pages))))
(setq last (cdar (pop pages))))
(push `((,first . ,last) . ,region) newpages)))
(push (cons file (nreverse newpages))
normalized))))
(nreverse normalized))))
(defmacro pdf-virtual-document-defun (name args &optional documentation &rest body)
"Define a PDF Document function.
Args are just like for `defun'. This macro will ensure, that the
DOCUMENT argument, which should be last, is setup properly in
case it is nil, i.e. check that the buffer passes
`pdf-virtual-buffer-assert-p' and use the variable
`pdf-virtual-document'."
(declare (doc-string 3) (indent defun)
(debug (&define name lambda-list
[&optional stringp]
def-body)))
(unless (stringp documentation)
(push documentation body)
(setq documentation nil))
(unless (memq '&optional args)
(setq args (append (butlast args)
(list '&optional)
(last args))))
(when (memq '&rest args)
(error "&rest argument not supported"))
(let ((doc-arg (car (last args)))
(fn (intern (format "pdf-virtual-document-%s" name))))
`(progn
(put ',fn 'definition-name ',name)
(defun ,fn
,args ,documentation
(setq ,doc-arg
(or ,doc-arg
(progn (pdf-virtual-buffer-assert-p)
pdf-virtual-document)))
(cl-check-type ,doc-arg pdf-virtual-document)
,@body))))
(pdf-virtual-document-defun filenames (doc)
"Return the list of filenames in DOC."
(mapcar 'car (pdf-virtual-document-file-map doc)))
(pdf-virtual-document-defun normalize-pages (pages doc)
"Normalize PAGES using DOC.
Like `pdf-info-normalize-page-range', except 0 is replaced by
DOC's last page."
(setq pages (pdf-info-normalize-page-range pages))
(if (eq 0 (cdr pages))
`(,(car pages) . ,(pdf-virtual-document-number-of-pages doc))
pages))
(pdf-virtual-document-defun page (page doc)
"Get PAGE of DOC.
Returns a list \(FILENAME FILE-PAGE REGION\)."
(let ((page (car (pdf-virtual-document-pages (cons page page) doc))))
(when page
(cl-destructuring-bind (filename first-last region)
page
(list filename (car first-last) region)))))
(pdf-virtual-document-defun pages (pages doc)
"Get PAGES of DOC.
PAGES should be a cons \(FIRST . LAST\). Return a list of
ranges corresponding to PAGES. Each element has the form
\(FILENAME \(FILE-FIRT-PAGE . FILE-LAST-PAGE\) REGION\)
.
"
(let ((begin (car pages))
(end (cdr pages)))
(unless (<= begin end)
(error "begin should not exceed end: %s" (cons begin end)))
(let ((arr (pdf-virtual-document-page-array doc))
result)
(when (or (< begin 1)
(> end (length arr)))
(signal 'args-out-of-range (list 'pages pages)))
(while (<= begin end)
(let* ((page (aref arr (1- begin)))
(filename (pdf-virtual-range-filename page))
(offset (- (1- begin)
(pdf-virtual-range-index-start page)))
(first (+ (pdf-virtual-range-first page)
offset))
(last (min (+ first (- end begin))
(pdf-virtual-range-last page)))
(region (pdf-virtual-range-region page)))
(push `(,filename (,first . ,last) ,region) result)
(cl-incf begin (1+ (- last first)))))
(nreverse result))))
(pdf-virtual-document-defun number-of-pages (doc)
"Return the number of pages in DOC."
(length (pdf-virtual-document-page-array doc)))
(pdf-virtual-document-defun page-of (filename &optional file-page limit doc)
"Return a page number displaying FILENAME's page FILE-PAGE in DOC.
If FILE-PAGE is nil, return the first page displaying FILENAME.
If LIMIT is non-nil, it should be a range \(FIRST . LAST\) in
which the returned page should fall. This is useful if there are
more than one page displaying FILE-PAGE. LIMIT is ignored, if
FILE-PAGE is nil.
Return nil if there is no matching page."
(if (null file-page)
(cadr (assoc filename (pdf-virtual-document-file-map doc)))
(let ((pages (pdf-virtual-document-page-array doc)))
(catch 'found
(mapc
(lambda (pn)
(while (and (<= pn (length pages))
(equal (pdf-virtual-range-filename (aref pages (1- pn)))
filename))
(let* ((page (aref pages (1- pn)))
(first (pdf-virtual-range-first page))
(last (pdf-virtual-range-last page)))
(when (and (>= file-page first)
(<= file-page last))
(let ((r (+ (pdf-virtual-range-index-start page)
(- file-page (pdf-virtual-range-first page))
1)))
(when (or (null limit)
(and (>= r (car limit))
(<= r (cdr limit))))
(throw 'found r))))
(cl-incf pn (1+ (- last first))))))
(cdr (assoc filename (pdf-virtual-document-file-map doc))))
nil))))
(pdf-virtual-document-defun find-matching-page (page predicate
&optional
backward-p doc)
(unless (and (>= page 1)
(<= page (length (pdf-virtual-document-page-array doc))))
(signal 'args-out-of-range (list 'page page)))
(let* ((pages (pdf-virtual-document-page-array doc))
(i (1- page))
(this (aref pages i))
other)
(while (and (< i (length pages))
(>= i 0)
(null other))
(setq i
(if backward-p
(1- (pdf-virtual-range-index-start this))
(+ (pdf-virtual-range-length this)
(pdf-virtual-range-index-start this))))
(when (and (< i (length pages))
(>= i 0))
(setq other (aref pages i))
(unless (funcall predicate this other)
(setq other nil))))
other))
(pdf-virtual-document-defun next-matching-page (page predicate doc)
(pdf-virtual-document-find-matching-page page predicate nil doc))
(pdf-virtual-document-defun previous-matching-page (page predicate doc)
(declare (indent 1))
(pdf-virtual-document-find-matching-page page predicate t doc))
(pdf-virtual-document-defun next-file (page doc)
"Return the next page displaying a different file than PAGE.
PAGE should be a page-number."
(let ((page (pdf-virtual-document-next-matching-page
page
(lambda (this other)
(not (equal (pdf-virtual-range-filename this)
(pdf-virtual-range-filename other)))))))
(when page
(1+ (pdf-virtual-range-index-start page)))))
(pdf-virtual-document-defun previous-file (page doc)
"Return the previous page displaying a different file than PAGE.
PAGE should be a page-number."
(let ((page (pdf-virtual-document-previous-matching-page
page
(lambda (this other)
(not (equal (pdf-virtual-range-filename this)
(pdf-virtual-range-filename other)))))))
(when page
(1+ (pdf-virtual-range-index-start page)))))
;; * ================================================================== *
;; * Modes
;; * ================================================================== *
(defvar pdf-virtual-edit-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map emacs-lisp-mode-map)
(define-key map (kbd "C-c C-c") 'pdf-virtual-view-mode)
map))
;;;###autoload
(define-derived-mode pdf-virtual-edit-mode emacs-lisp-mode "VPDF-Edit"
"Major mode when editing a virtual PDF buffer."
(buffer-enable-undo)
(setq-local buffer-read-only nil)
(unless noninteractive
(message (substitute-command-keys "Press \\[pdf-virtual-view-mode] to view."))))
;; FIXME: Provide filename/region from-windows-gathering functions.
(defvar pdf-virtual-view-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map pdf-view-mode-map)
(define-key map (kbd "C-c C-c") 'pdf-virtual-edit-mode)
(define-key map [remap backward-paragraph] 'pdf-virtual-buffer-backward-file)
(define-key map [remap forward-paragraph] 'pdf-virtual-buffer-forward-file)
(define-key map (kbd "C-c C-c") 'pdf-virtual-edit-mode)
map))
;;;###autoload
(define-derived-mode pdf-virtual-view-mode pdf-view-mode "VPDF-View"
"Major mode in virtual PDF buffers."
(setq-local write-contents-functions nil)
(remove-hook 'kill-buffer-hook 'pdf-view-close-document t)
(setq-local header-line-format
`(:eval (pdf-virtual-buffer-current-file)))
(unless noninteractive
(message (substitute-command-keys "Press \\[pdf-virtual-edit-mode] to edit."))))
;;;###autoload
(define-minor-mode pdf-virtual-global-minor-mode
"Enable recognition and handling of VPDF files."
:global t
:group 'pdf-tools
(let ((elt `(,pdf-virtual-magic-mode-regexp . pdf-virtual-view-mode)))
(cond
(pdf-virtual-global-minor-mode
(add-to-list 'magic-mode-alist elt))
(t
(setq magic-mode-alist
(remove elt magic-mode-alist))))
(dolist (elt pdf-virtual-adapter-alist)
(let ((fn (car elt))
(orig (cdr elt)))
(advice-remove orig fn)
(when pdf-virtual-global-minor-mode
(advice-add orig :around fn))))))
(advice-add 'pdf-virtual-view-mode
:around 'pdf-virtual-view-mode-prepare)
;; This needs to run before pdf-view-mode does its thing.
(defun pdf-virtual-view-mode-prepare (fn)
(let (list unreadable)
(save-excursion
(goto-char 1)
(unless (looking-at pdf-virtual-magic-mode-regexp)
(pdf-virtual-buffer-assert-p))
(setq list (read (current-buffer))))
(setq pdf-virtual-document
(pdf-virtual-document-create
list
nil
(lambda (filename _error)
(push filename unreadable))))
(when unreadable
(display-warning
'pdf-virtual
(format "Some documents could not be opened:\n%s"
(mapconcat (lambda (f)
(concat " " f))
unreadable "\n"))))
(if (= (pdf-virtual-document-number-of-pages) 0)
(error "Document is empty.")
(unless pdf-virtual-global-minor-mode
(pdf-virtual-global-minor-mode 1))
(funcall fn))))
;; * ================================================================== *
;; * Buffer handling
;; * ================================================================== *
;;;###autoload
(defun pdf-virtual-buffer-create (&optional filenames buffer-name display-p)
(interactive
(list (directory-files default-directory nil "\\.pdf\\'")
(read-string
"Buffer name (default: all.vpdf): " nil nil "all.vpdf") t))
(with-current-buffer (generate-new-buffer buffer-name)
(insert ";; %VPDF 1.0\n\n")
(insert ";; File Format
;;
;; FORMAT ::= ( FILES* )
;; FILES ::= ( FILE . PAGE-SPEC* )
;; PAGE-SPEC ::= PAGE | ( PAGE . REGION )
;; PAGE ::= NUMBER | ( FIRST . LAST )
;; REGION ::= ( LEFT TOP RIGHT BOT )
;;
;; 0 <= X <= 1, forall X in REGION .
")
(if (null filenames)
(insert "nil\n")
(insert "(")
(dolist (f filenames)
(insert (format "(%S)\n " f)))
(delete-char -2)
(insert ")\n"))
(pdf-virtual-edit-mode)
(when display-p
(pop-to-buffer (current-buffer)))
(current-buffer)))
(defun pdf-virtual-buffer-p (&optional buffer)
(save-current-buffer
(when buffer (set-buffer buffer))
(or (derived-mode-p 'pdf-virtual-view-mode 'pdf-virtual-edit-mode)
pdf-virtual-document)))
(defun pdf-virtual-view-window-p (&optional window)
(save-selected-window
(when window (select-window window 'norecord))
(derived-mode-p 'pdf-virtual-view-mode)))
(defun pdf-virtual-filename-p (filename)
(and (stringp filename)
(file-exists-p filename)
(with-temp-buffer
(save-excursion (insert-file-contents filename nil 0 128))
(looking-at pdf-virtual-magic-mode-regexp))))
(defun pdf-virtual-buffer-assert-p (&optional buffer)
(unless (pdf-virtual-buffer-p buffer)
(error "Buffer is not a virtual PDF buffer")))
(defun pdf-virtual-view-window-assert-p (&optional window)
(unless (pdf-virtual-view-window-p window)
(error "Window's buffer is not in `pdf-virtual-view-mode'.")))
(defun pdf-virtual-buffer-current-file (&optional window)
(pdf-virtual-view-window-assert-p window)
(pdf-virtual-range-filename
(aref (pdf-virtual-document-page-array
pdf-virtual-document)
(1- (pdf-view-current-page window)))))
(defun pdf-virtual-buffer-forward-file (&optional n interactive-p)
(interactive "p\np")
(pdf-virtual-view-window-assert-p)
(let* ((pn (pdf-view-current-page))
(pages (pdf-virtual-document-page-array
pdf-virtual-document))
(page (aref pages (1- pn)))
(first-filepage (1+ (pdf-virtual-range-index-start page))))
(when (and (< n 0)
(not (= first-filepage pn)))
(cl-incf n))
(setq pn first-filepage)
(let (next)
(while (and (> n 0)
(setq next (pdf-virtual-document-next-file pn)))
(setq pn next)
(cl-decf n)))
(let (previous)
(while (and (< n 0)
(setq previous (pdf-virtual-document-previous-file pn)))
(setq pn previous)
(cl-incf n)))
(when interactive-p
(when (< n 0)
(message "First file."))
(when (> n 0)
(message "Last file.")))
(pdf-view-goto-page pn)
n))
(defun pdf-virtual-buffer-backward-file (&optional n interactive-p)
(interactive "p\np")
(pdf-virtual-buffer-forward-file (- (or n 1)) interactive-p))
;; * ================================================================== *
;; * Helper functions
;; * ================================================================== *
(defmacro pdf-virtual-dopages (bindings pages &rest body)
(declare (indent 2) (debug (sexp form &rest form)))
(let ((page (make-symbol "page")))
`(dolist (,page ,pages)
(cl-destructuring-bind ,bindings
,page
,@body))))
(defun pdf-virtual--perform-search (string pages &optional regexp-p no-error)
(let* ((pages (pdf-virtual-document-normalize-pages pages))
(file-pages (pdf-virtual-document-pages pages)))
(pdf-info-compose-queries
((responses
(pdf-virtual-dopages (filename pages _region)
file-pages
(if regexp-p
(pdf-info-search-string string pages filename)
;; FIXME: no-error won't work with synchronous calls.
(pdf-info-search-regexp string pages no-error filename)))))
(let (result)
(pdf-virtual-dopages (filename _ region)
file-pages
(let ((matches (pop responses)))
(when region
(setq matches
(mapcar
(lambda (m)
(let-alist m
`((edges . ,(pdf-util-edges-transform region .edges t))
,@m)))
(pdf-virtual--filter-edges
region matches
(apply-partially 'alist-get 'edges)))))
(dolist (m matches)
(push `((page . ,(pdf-virtual-document-page-of
filename (alist-get 'page m)
pages))
,@m)
result))))
(nreverse result)))))
(defun pdf-virtual--filter-edges (region elts &optional edges-key-fn)
(if (null region)
elts
(cl-remove-if-not
(lambda (edges)
(or (null edges)
(if (consp (car edges))
(cl-some (apply-partially 'pdf-util-edges-intersection region) edges)
(pdf-util-edges-intersection region edges))))
elts
:key edges-key-fn)))
(defun pdf-virtual--transform-goto-dest (link filename region)
(let-alist link
(let ((local-page (pdf-virtual-document-page-of
filename .page)))
(if local-page
`((type . ,'goto-dest)
(title . , .title)
(page . ,local-page)
(top . ,(car (pdf-util-edges-transform
region (cons .top .top) t))))
`((type . ,'goto-remote)
(title . , .title)
(filename . ,filename)
(page . , .page)
(top . , .top))))))
;; * ================================================================== *
;; * Server adapter
;; * ================================================================== *
(defmacro pdf-virtual-define-adapter (name arglist &optional doc &rest body)
;; FIXME: Handle &optional + &rest argument.
(declare (doc-string 3) (indent 2)
(debug (&define name lambda-list
[&optional stringp]
def-body)))
(unless (stringp doc)
(push doc body)
(setq doc nil))
(let ((fn (intern (format "pdf-virtual-%s" name)))
(base-fn (intern (format "pdf-info-%s" name)))
(base-fn-arg (make-symbol "fn"))
(true-file-or-buffer (make-symbol "true-file-or-buffer"))
(args (cl-remove-if (lambda (elt)
(memq elt '(&optional &rest)))
arglist)))
(unless (fboundp base-fn)
(error "Base function is undefined: %s" base-fn))
(unless (memq 'file-or-buffer arglist)
(error "Argument list is missing a `file-or-buffer' argument: %s" arglist))
`(progn
(put ',fn 'definition-name ',name)
(add-to-list 'pdf-virtual-adapter-alist ',(cons fn base-fn))
(defun ,fn ,(cons base-fn-arg arglist)
,(format "%sPDF virtual adapter to `%s'.
This function delegates to `%s', unless the FILE-OR-BUFFER
argument denotes a VPDF document."
(if doc (concat doc "\n\n") "")
base-fn
base-fn)
(let ((,true-file-or-buffer
(cond
((or (bufferp file-or-buffer)
(stringp file-or-buffer)) file-or-buffer)
((or (null file-or-buffer)
,(not (null (memq '&rest arglist))))
(current-buffer)))))
(if (cond
((null ,true-file-or-buffer) t)
((bufferp ,true-file-or-buffer)
(not (pdf-virtual-buffer-p ,true-file-or-buffer)))
((stringp ,true-file-or-buffer)
(not (pdf-virtual-filename-p ,true-file-or-buffer))))
(,(if (memq '&rest arglist) 'apply 'funcall) ,base-fn-arg ,@args)
(when (stringp ,true-file-or-buffer)
(setq ,true-file-or-buffer
(find-file-noselect ,true-file-or-buffer)))
(save-current-buffer
(when (bufferp ,true-file-or-buffer)
(set-buffer ,true-file-or-buffer))
,@body)))))))
(define-error 'pdf-virtual-unsupported-operation
"Operation not supported in VPDF buffer")
(pdf-virtual-define-adapter open (&optional file-or-buffer password)
(mapc (lambda (file)
(pdf-info-open file password))
(pdf-virtual-document-filenames)))
(pdf-virtual-define-adapter close (&optional file-or-buffer)
(let ((files (cl-remove-if 'find-buffer-visiting
(pdf-virtual-document-filenames))))
(pdf-info-compose-queries
((results (mapc 'pdf-info-close files)))
(cl-some 'identity results))))
(pdf-virtual-define-adapter metadata (&optional file-or-buffer)
(pdf-info-compose-queries
((md (mapc 'pdf-info-metadata (pdf-virtual-document-filenames))))
(apply 'cl-mapcar (lambda (&rest elts)
(cons (caar elts)
(cl-mapcar 'cdr elts)))
md)))
(pdf-virtual-define-adapter search-string (string &optional pages file-or-buffer)
(pdf-virtual--perform-search
string (pdf-virtual-document-normalize-pages pages)))
(pdf-virtual-define-adapter search-regexp (pcre &optional
pages no-error file-or-buffer)
(pdf-virtual--perform-search
pcre (pdf-virtual-document-normalize-pages pages) 'regexp no-error))
(pdf-virtual-define-adapter pagelinks (page &optional file-or-buffer)
(cl-destructuring-bind (filename ext-page region)
(pdf-virtual-document-page page)
(pdf-info-compose-queries
((links (pdf-info-pagelinks ext-page filename)))
(mapcar
(lambda (link)
(let-alist link
(if (not (eq .type 'goto-dest))
link
`((edges . ,(pdf-util-edges-transform region .edges t))
,@(pdf-virtual--transform-goto-dest link filename region)))))
(pdf-virtual--filter-edges region (car links) 'car)))))
(pdf-virtual-define-adapter number-of-pages (&optional file-or-buffer)
(pdf-info-compose-queries nil (pdf-virtual-document-number-of-pages)))
(pdf-virtual-define-adapter outline (&optional file-or-buffer)
(let ((files (pdf-virtual-document-filenames)))
(pdf-info-compose-queries
((outlines (mapc 'pdf-info-outline files)))
(cl-mapcan
(lambda (outline filename)
`(((depth . 1)
(type . goto-dest)
(title . ,filename)
(page . ,(pdf-virtual-document-page-of filename))
(top . 0))
,@(delq
nil
(mapcar
(lambda (item)
(let-alist item
(if (not (eq .type 'goto-dest))
`((depth . ,(1+ .depth))
,@item)
(cl-check-type filename string)
(let ((page (pdf-virtual-document-page-of
filename .page)))
(when page
`((depth . ,(1+ .depth))
,@(pdf-virtual--transform-goto-dest
item filename
(nth 2 (pdf-virtual-document-page page)))))))))
outline))))
outlines files))))
(pdf-virtual-define-adapter gettext (page edges &optional
selection-style file-or-buffer)
(cl-destructuring-bind (filename file-page region)
(pdf-virtual-document-page page)
(let ((edges (pdf-util-edges-transform region edges)))
(pdf-info-gettext file-page edges selection-style filename))))
(pdf-virtual-define-adapter getselection (page edges &optional
selection-style file-or-buffer)
(cl-destructuring-bind (filename file-page region)
(pdf-virtual-document-page page)
(let ((edges (pdf-util-edges-transform region edges)))
(pdf-info-compose-queries
((results (pdf-info-getselection file-page edges selection-style filename)))
(pdf-util-edges-transform
region
(pdf-virtual--filter-edges region (car results)) t)))))
(pdf-virtual-define-adapter charlayout (page &optional edges-or-pos file-or-buffer)
(cl-destructuring-bind (filename file-page region)
(pdf-virtual-document-page page)
(let ((edges-or-pos (pdf-util-edges-transform region edges-or-pos)))
(pdf-info-compose-queries
((results (pdf-info-charlayout file-page edges-or-pos filename)))
(mapcar (lambda (elt)
`(,(car elt)
. ,(pdf-util-edges-transform region (cdr elt) t)))
(pdf-virtual--filter-edges region (car results) 'cadr))))))
(pdf-virtual-define-adapter pagesize (page &optional file-or-buffer)
(cl-destructuring-bind (filename file-page region)
(pdf-virtual-document-page page)
(pdf-info-compose-queries
((result (pdf-info-pagesize file-page filename)))
(if (null region)
(car result)
(pdf-util-with-edges (region)
(pdf-util-scale
(car result) (cons region-width region-height)))))))
(pdf-virtual-define-adapter getannots (&optional pages file-or-buffer)
(let* ((pages (pdf-virtual-document-normalize-pages pages))
(file-pages (pdf-virtual-document-pages pages)))
(pdf-info-compose-queries
((annotations
(pdf-virtual-dopages (filename file-pages _region)
file-pages
(pdf-info-getannots file-pages filename))))
(let ((page (car pages))
result)
(pdf-virtual-dopages (_filename file-pages region)
file-pages
(dolist (a (pop annotations))
(let ((edges (delq nil `(,(cdr (assq 'edges a))
,@(cdr (assq 'markup-edges a))))))
(when (pdf-virtual--filter-edges region edges)
(let-alist a
(setcdr (assq 'page a)
(+ page (- .page (car file-pages))))
(setcdr (assq 'id a)
(intern (format "%s/%d" .id (cdr (assq 'page a)))))
(when region
(when .edges
(setcdr (assq 'edges a)
(pdf-util-edges-transform region .edges t)))
(when .markup-edges
(setcdr (assq 'markup-edges a)
(pdf-util-edges-transform region .markup-edges t))))
(push a result)))))
(cl-incf page (1+ (- (cdr file-pages) (car file-pages)))))
(nreverse result)))))
(pdf-virtual-define-adapter getannot (id &optional file-or-buffer)
(let ((name (symbol-name id))
page)
(save-match-data
(when (string-match "\\(.*\\)/\\([0-9]+\\)\\'" name)
(setq id (intern (match-string 1 name))
page (string-to-number (match-string 2 name)))))
(if page
(cl-destructuring-bind (filename _ _)
(pdf-virtual-document-page page)
(pdf-info-compose-queries
((result (pdf-info-getannot id filename)))
(let ((a (car result)))
(cl-destructuring-bind (_ _ region)
(pdf-virtual-document-page page)
(setcdr (assq 'page a) page)
(let-alist a
(setcdr (assq 'id a)
(intern (format "%s/%d" .id (cdr (assq 'page a)))))
(when region
(when .edges
(setcdr (assq 'edges a)
(pdf-util-edges-transform region .edges t)))
(when .markup-edges
(setcdr (assq 'markup-edges a)
(pdf-util-edges-transform region .markup-edges t))))))
a)))
(pdf-info-compose-queries nil
(error "No such annotation: %s" id)))))
(pdf-virtual-define-adapter addannot (page edges type &optional
file-or-buffer &rest markup-edges)
(signal 'pdf-virtual-unsupported-operation (list 'addannot)))
(pdf-virtual-define-adapter delannot (id &optional file-or-buffer)
(signal 'pdf-virtual-unsupported-operation (list 'delannot)))
(pdf-virtual-define-adapter mvannot (id edges &optional file-or-buffer)
(signal 'pdf-virtual-unsupported-operation (list 'mvannot)))
(pdf-virtual-define-adapter editannot (id modifications &optional file-or-buffer)
(signal 'pdf-virtual-unsupported-operation (list 'editannot)))
(pdf-virtual-define-adapter save (&optional file-or-buffer)
(signal 'pdf-virtual-unsupported-operation (list 'save)))
;;(defvar-local pdf-virtual-annotation-mapping nil)
(pdf-virtual-define-adapter getattachment-from-annot
(id &optional do-save file-or-buffer)
(let ((name (symbol-name id))
page)
(save-match-data
(when (string-match "\\(.*\\)/\\([0-9]+\\)\\'" name)
(setq id (intern (match-string 1 name))
page (string-to-number (match-string 2 name)))))
(if page
(cl-destructuring-bind (filename _ _)
(pdf-virtual-document-page page)
(pdf-info-getattachment-from-annot id do-save filename))
(pdf-info-compose-queries nil
(error "No such annotation: %s" id)))))
(pdf-virtual-define-adapter getattachments (&optional do-save file-or-buffer)
(pdf-info-compose-queries
((results (mapc
(lambda (f)
(pdf-info-getattachments do-save f))
(pdf-virtual-document-filenames))))
(apply 'append results)))
(pdf-virtual-define-adapter synctex-forward-search
(source &optional line column file-or-buffer)
(signal 'pdf-virtual-unsupported-operation (list 'synctex-forward-search)))
(pdf-virtual-define-adapter synctex-backward-search (page &optional x y file-or-buffer)
(cl-destructuring-bind (filename file-page region)
(pdf-virtual-document-page page)
(cl-destructuring-bind (x &rest y)
(pdf-util-edges-transform region (cons x y))
(pdf-info-synctex-backward-search file-page x y filename))))
(pdf-virtual-define-adapter renderpage (page width &optional file-or-buffer
&rest commands)
(when (keywordp file-or-buffer)
(push file-or-buffer commands)
(setq file-or-buffer nil))
(cl-destructuring-bind (filename file-page region)
(pdf-virtual-document-page page)
(when region
(setq commands (append (list :crop-to region) commands)
width (pdf-util-with-edges (region)
(round (* width (max 1 (/ 1.0 (max 1e-6 region-width))))))))
(apply 'pdf-info-renderpage file-page width filename commands)))
(pdf-virtual-define-adapter boundingbox (page &optional file-or-buffer)
(cl-destructuring-bind (filename file-page region)
(pdf-virtual-document-page page)
(pdf-info-compose-queries
((results (unless region (pdf-info-boundingbox file-page filename))))
(if region
(list 0 0 1 1)
(car results)))))
(pdf-virtual-define-adapter pagelabels (&optional file-or-buffer)
(signal 'pdf-virtual-unsupported-operation (list 'pagelabels)))
(pdf-virtual-define-adapter setoptions (&optional file-or-buffer &rest options)
(when (keywordp file-or-buffer)
(push file-or-buffer options)
(setq file-or-buffer nil))
(pdf-info-compose-queries
((_ (dolist (f (pdf-virtual-document-filenames))
(apply 'pdf-info-setoptions f options))))
nil))
(pdf-virtual-define-adapter getoptions (&optional file-or-buffer)
(signal 'pdf-virtual-unsupported-operation (list 'getoptions)))
(pdf-virtual-define-adapter encrypted-p (&optional file-or-buffer)
nil)
(provide 'pdf-virtual)
;;; pdf-virtual.el ends here