summaryrefslogtreecommitdiff
path: root/elpa/pdf-tools-20200512.1524/pdf-virtual.el
diff options
context:
space:
mode:
authorBlendoit <blendoit@gmail.com>2020-08-01 15:18:40 -0700
committerBlendoit <blendoit@gmail.com>2020-08-01 15:18:40 -0700
commit374ae3de24187512adddf01a56e5eb52c79db65f (patch)
tree847adf6824b56394f5a040ba45863e2dbdceac70 /elpa/pdf-tools-20200512.1524/pdf-virtual.el
parent54fbf6576cf2dd94ef5af332a6075723a9dfa8b3 (diff)
Include contents of elpa/ sources + theme update.
Diffstat (limited to 'elpa/pdf-tools-20200512.1524/pdf-virtual.el')
-rw-r--r--elpa/pdf-tools-20200512.1524/pdf-virtual.el1038
1 files changed, 1038 insertions, 0 deletions
diff --git a/elpa/pdf-tools-20200512.1524/pdf-virtual.el b/elpa/pdf-tools-20200512.1524/pdf-virtual.el
new file mode 100644
index 0000000..5d6458f
--- /dev/null
+++ b/elpa/pdf-tools-20200512.1524/pdf-virtual.el
@@ -0,0 +1,1038 @@
+;;; 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
Copyright 2019--2024 Marius PETER