path: root/elpa/pdf-tools-20200512.1524/pdf-virtual.el

;;; 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 theses 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)


;; * ================================================================== *
;; * 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."
  nil nil nil
  :global t
  (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 "Docüment 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))
    (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