diff options
Diffstat (limited to 'elpa/pdf-tools-20200512.1524/pdf-virtual.el')
-rw-r--r-- | elpa/pdf-tools-20200512.1524/pdf-virtual.el | 1038 |
1 files changed, 0 insertions, 1038 deletions
diff --git a/elpa/pdf-tools-20200512.1524/pdf-virtual.el b/elpa/pdf-tools-20200512.1524/pdf-virtual.el deleted file mode 100644 index 5d6458f..0000000 --- a/elpa/pdf-tools-20200512.1524/pdf-virtual.el +++ /dev/null @@ -1,1038 +0,0 @@ -;;; 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 |