diff options
Diffstat (limited to 'elpa/pdf-tools-20200512.1524/pdf-util.el')
| -rw-r--r-- | elpa/pdf-tools-20200512.1524/pdf-util.el | 1346 |
1 files changed, 1346 insertions, 0 deletions
diff --git a/elpa/pdf-tools-20200512.1524/pdf-util.el b/elpa/pdf-tools-20200512.1524/pdf-util.el new file mode 100644 index 0000000..cdb0f26 --- /dev/null +++ b/elpa/pdf-tools-20200512.1524/pdf-util.el @@ -0,0 +1,1346 @@ +;;; pdf-util.el --- PDF Utility functions. -*- lexical-binding: t -*- + +;; Copyright (C) 2013, 2014 Andreas Politz + +;; Author: Andreas Politz <politza@fh-trier.de> +;; Keywords: files, multimedia + +;; 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: +;; +;;; Todo: +;; + +;;; Code: + +(require 'cl-lib) +(require 'format-spec) +(require 'faces) + +;; These functions are only used after a PdfView window was asserted, +;; which won't succeed, if pdf-view.el isn't loaded. +(declare-function pdf-view-image-size "pdf-view") +(declare-function pdf-view-image-offset "pdf-view") +(declare-function pdf-view-current-image "pdf-view") +(declare-function pdf-view-current-overlay "pdf-view") +(declare-function pdf-cache-pagesize "pdf-cache") + +(declare-function pdf-view-image-type "pdf-view") + + + +;; * ================================================================== * +;; * Compatibility with older Emacssen (< 25.1) +;; * ================================================================== * + +;; The with-file-modes macro is only available in recent Emacs +;; versions. +(eval-when-compile + (unless (fboundp 'with-file-modes) + (defmacro with-file-modes (modes &rest body) + "Execute BODY with default file permissions temporarily set to MODES. +MODES is as for `set-default-file-modes'." + (declare (indent 1) (debug t)) + (let ((umask (make-symbol "umask"))) + `(let ((,umask (default-file-modes))) + (unwind-protect + (progn + (set-default-file-modes ,modes) + ,@body) + (set-default-file-modes ,umask))))))) + +(unless (fboundp 'alist-get) ;;25.1 + (defun alist-get (key alist &optional default remove) + "Get the value associated to KEY in ALIST. +DEFAULT is the value to return if KEY is not found in ALIST. +REMOVE, if non-nil, means that when setting this element, we should +remove the entry if the new value is `eql' to DEFAULT." + (ignore remove) ;;Silence byte-compiler. + (let ((x (assq key alist))) + (if x (cdr x) default)))) + +(require 'register) +(unless (fboundp 'register-read-with-preview) + (defalias 'register-read-with-preview 'read-char + "Compatibility alias for pdf-tools.")) + +;; In Emacs 24.3 window-width does not have a PIXELWISE argument. +(defmacro pdf-util-window-pixel-width (&optional window) + "Return the width of WINDOW in pixel." + (if (< (cdr (subr-arity (symbol-function 'window-body-width))) 2) + (let ((window* (make-symbol "window"))) + `(let ((,window* ,window)) + (* (window-body-width ,window*) + (frame-char-width (window-frame ,window*))))) + `(window-body-width ,window t))) + +;; In Emacs 24.3 image-mode-winprops leads to infinite recursion. +(unless (or (> emacs-major-version 24) + (and (= emacs-major-version 24) + (>= emacs-minor-version 4))) + (require 'image-mode) + (defvar image-mode-winprops-original-function + (symbol-function 'image-mode-winprops)) + (eval-after-load "image-mode" + '(defun image-mode-winprops (&optional window cleanup) + (if (not (eq major-mode 'pdf-view-mode)) + (funcall image-mode-winprops-original-function + window cleanup) + (cond ((null window) + (setq window + (if (eq (current-buffer) (window-buffer)) (selected-window) t))) + ((eq window t)) + ((not (windowp window)) + (error "Not a window: %s" window))) + (when cleanup + (setq image-mode-winprops-alist + (delq nil (mapcar (lambda (winprop) + (let ((w (car-safe winprop))) + (if (or (not (windowp w)) (window-live-p w)) + winprop))) + image-mode-winprops-alist)))) + (let ((winprops (assq window image-mode-winprops-alist))) + ;; For new windows, set defaults from the latest. + (if winprops + ;; Move window to front. + (setq image-mode-winprops-alist + (cons winprops (delq winprops image-mode-winprops-alist))) + (setq winprops (cons window + (copy-alist (cdar image-mode-winprops-alist)))) + ;; Add winprops before running the hook, to avoid inf-loops if the hook + ;; triggers window-configuration-change-hook. + (setq image-mode-winprops-alist + (cons winprops image-mode-winprops-alist)) + (run-hook-with-args 'image-mode-new-window-functions winprops)) + winprops))))) + + + +;; * ================================================================== * +;; * Transforming coordinates +;; * ================================================================== * + + +(defun pdf-util-scale (list-of-edges-or-pos scale &optional rounding-fn) + "Scale LIST-OF-EDGES-OR-POS by SCALE. + +SCALE is a cons (SX . SY), by which edges/positions are scaled. +If ROUNDING-FN is non-nil, it should be a function of one +argument, a real value, returning a rounded +value (e.g. `ceiling'). + +The elements in LIST-OF-EDGES-OR-POS should be either a list +\(LEFT TOP RIGHT BOT\) or a position \(X . Y\). + +LIST-OF-EDGES-OR-POS may also be a single such element. + +Return scaled list of edges if LIST-OF-EDGES-OR-POS was indeed a list, +else return the scaled singleton." + + (let ((have-list-p (listp (car list-of-edges-or-pos)))) + (unless have-list-p + (setq list-of-edges-or-pos (list list-of-edges-or-pos))) + (let* ((sx (car scale)) + (sy (cdr scale)) + (result + (mapcar + (lambda (edges) + (cond + ((consp (cdr edges)) + (let ((e (list (* (nth 0 edges) sx) + (* (nth 1 edges) sy) + (* (nth 2 edges) sx) + (* (nth 3 edges) sy)))) + (if rounding-fn + (mapcar rounding-fn e) + e))) + (rounding-fn + (cons (funcall rounding-fn (* (car edges) sx)) + (funcall rounding-fn (* (cdr edges) sy)))) + (t + (cons (* (car edges) sx) + (* (cdr edges) sy))))) + list-of-edges-or-pos))) + (if have-list-p + result + (car result))))) + +(defun pdf-util-scale-to (list-of-edges from to &optional rounding-fn) + "Scale LIST-OF-EDGES in FROM basis to TO. + +FROM and TO should both be a cons \(WIDTH . HEIGHT\). See also +`pdf-util-scale'." + + (pdf-util-scale list-of-edges + (cons (/ (float (car to)) + (float (car from))) + (/ (float (cdr to)) + (float (cdr from)))) + rounding-fn)) + +(defun pdf-util-scale-pixel-to-points (list-of-pixel-edges + &optional rounding-fn displayed-p window) + "Scale LIST-OF-PIXEL-EDGES to point values. + +The result depends on the currently displayed page in WINDOW. +See also `pdf-util-scale'." + (pdf-util-assert-pdf-window window) + (pdf-util-scale-to + list-of-pixel-edges + (pdf-view-image-size displayed-p window) + (pdf-cache-pagesize (pdf-view-current-page window)) + rounding-fn)) + +(defun pdf-util-scale-points-to-pixel (list-of-points-edges + &optional rounding-fn displayed-p window) + "Scale LIST-OF-POINTS-EDGES to point values. + +The result depends on the currently displayed page in WINDOW. +See also `pdf-util-scale'." + (pdf-util-assert-pdf-window window) + (pdf-util-scale-to + list-of-points-edges + (pdf-cache-pagesize (pdf-view-current-page window)) + (pdf-view-image-size displayed-p window) + rounding-fn)) + +(defun pdf-util-scale-relative-to-points (list-of-relative-edges + &optional rounding-fn window) + "Scale LIST-OF-RELATIVE-EDGES to point values. + +The result depends on the currently displayed page in WINDOW. +See also `pdf-util-scale'." + (pdf-util-assert-pdf-window window) + (pdf-util-scale-to + list-of-relative-edges + '(1.0 . 1.0) + (pdf-cache-pagesize (pdf-view-current-page window)) + rounding-fn)) + +(defun pdf-util-scale-points-to-relative (list-of-points-edges + &optional rounding-fn window) + "Scale LIST-OF-POINTS-EDGES to relative values. + +See also `pdf-util-scale'." + (pdf-util-assert-pdf-window window) + (pdf-util-scale-to + list-of-points-edges + (pdf-cache-pagesize (pdf-view-current-page window)) + '(1.0 . 1.0) + rounding-fn)) + +(defun pdf-util-scale-pixel-to-relative (list-of-pixel-edges + &optional rounding-fn displayed-p window) + "Scale LIST-OF-PIXEL-EDGES to relative values. + +The result depends on the currently displayed page in WINDOW. +See also `pdf-util-scale'." + (pdf-util-assert-pdf-window window) + (pdf-util-scale-to + list-of-pixel-edges + (pdf-view-image-size displayed-p window) + '(1.0 . 1.0) + rounding-fn)) + + +(defun pdf-util-scale-relative-to-pixel (list-of-relative-edges + &optional rounding-fn displayed-p window) + "Scale LIST-OF-EDGES to match SIZE. + +The result depends on the currently displayed page in WINDOW. +See also `pdf-util-scale'." + (pdf-util-assert-pdf-window window) + (pdf-util-scale-to + list-of-relative-edges + '(1.0 . 1.0) + (pdf-view-image-size displayed-p window) + rounding-fn)) + +(defun pdf-util-translate (list-of-edges-or-pos + offset &optional opposite-direction-p) + "Translate LIST-OF-EDGES-OR-POS by OFFSET + +OFFSET should be a cons \(X . Y\), by which to translate +LIST-OF-EDGES-OR-POS. If OPPOSITE-DIRECTION-P is non-nil +translate by \(-X . -Y\). + +See `pdf-util-scale' for the LIST-OF-EDGES-OR-POS argument." + + (let ((have-list-p (listp (car list-of-edges-or-pos)))) + (unless have-list-p + (setq list-of-edges-or-pos (list list-of-edges-or-pos))) + (let* ((ox (if opposite-direction-p + (- (car offset)) + (car offset))) + (oy (if opposite-direction-p + (- (cdr offset)) + (cdr offset))) + (result + (mapcar + (lambda (edges) + (cond + ((consp (cdr edges)) + (list (+ (nth 0 edges) ox) + (+ (nth 1 edges) oy) + (+ (nth 2 edges) ox) + (+ (nth 3 edges) oy))) + (t + (cons (+ (car edges) ox) + (+ (cdr edges) oy))))) + list-of-edges-or-pos))) + (if have-list-p + result + (car result))))) + +(defun pdf-util-edges-transform (region elts &optional to-region-p) + "Translate ELTS according to REGION. + +ELTS may be one edges list or a position or a list thereof. +Translate each from region coordinates to (0 0 1 1) or the +opposite, if TO-REGION-P is non-nil. All coordinates should be +relative. + +Returns the translated list of elements or the single one +depending on the input." + + (when elts + (let ((have-list-p (consp (car-safe elts)))) + (unless have-list-p + (setq elts (list elts))) + (let ((result + (if (null region) + elts + (mapcar (lambda (edges) + (let ((have-pos-p (numberp (cdr edges)))) + (when have-pos-p + (setq edges (list (car edges) (cdr edges) + (car edges) (cdr edges)))) + (pdf-util-with-edges (edges region) + (let ((newedges + (mapcar (lambda (n) + (min 1.0 (max 0.0 n))) + (if to-region-p + `(,(/ (- edges-left region-left) + region-width) + ,(/ (- edges-top region-top) + region-height) + ,(/ (- edges-right region-left) + region-width) + ,(/ (- edges-bot region-top) + region-height)) + `(,(+ (* edges-left region-width) + region-left) + ,(+ (* edges-top region-height) + region-top) + ,(+ (* edges-right region-width) + region-left) + ,(+ (* edges-bot region-height) + region-top)))))) + (if have-pos-p + (cons (car newedges) (cadr newedges)) + newedges))))) + elts)))) + (if have-list-p + result + (car result)))))) + +(defmacro pdf-util-with-edges (list-of-edges &rest body) + "Provide some convenient macros for the edges in LIST-OF-EDGES. + +LIST-OF-EDGES should be a list of variables \(X ...\), each one +holding a list of edges. Inside BODY the symbols X-left, X-top, +X-right, X-bot, X-width and X-height expand to their respective +values." + + (declare (indent 1) (debug (sexp &rest form))) + (unless (cl-every 'symbolp list-of-edges) + (error "Argument should be a list of symbols")) + (let ((list-of-syms + (mapcar (lambda (edge) + (cons edge (mapcar + (lambda (kind) + (intern (format "%s-%s" edge kind))) + '(left top right bot width height)))) + list-of-edges))) + (macroexpand-all + `(cl-symbol-macrolet + ,(apply 'nconc + (mapcar + (lambda (edge-syms) + (let ((edge (nth 0 edge-syms)) + (syms (cdr edge-syms))) + `((,(pop syms) (nth 0 ,edge)) + (,(pop syms) (nth 1 ,edge)) + (,(pop syms) (nth 2 ,edge)) + (,(pop syms) (nth 3 ,edge)) + (,(pop syms) (- (nth 2 ,edge) + (nth 0 ,edge))) + (,(pop syms) (- (nth 3 ,edge) + (nth 1 ,edge)))))) + list-of-syms)) + ,@body)))) + + +;; * ================================================================== * +;; * Scrolling +;; * ================================================================== * + +(defun pdf-util-image-displayed-edges (&optional window displayed-p) + "Return the visible region of the image in WINDOW. + +Returns a list of pixel edges." + (pdf-util-assert-pdf-window) + (let* ((edges (window-inside-pixel-edges window)) + (isize (pdf-view-image-size displayed-p window)) + (offset (if displayed-p + `(0 . 0) + (pdf-view-image-offset window))) + (hscroll (* (window-hscroll window) + (frame-char-width (window-frame window)))) + (vscroll (window-vscroll window t)) + (x0 (+ hscroll (car offset))) + (y0 (+ vscroll (cdr offset))) + (x1 (min (car isize) + (+ x0 (- (nth 2 edges) (nth 0 edges))))) + (y1 (min (cdr isize) + (+ y0 (- (nth 3 edges) (nth 1 edges)))))) + (mapcar 'round (list x0 y0 x1 y1)))) + +(defun pdf-util-required-hscroll (edges &optional eager-p context-pixel) + "Return the amount of scrolling necessary, to make image EDGES visible. + +Scroll as little as necessary. Unless EAGER-P is non-nil, in +which case scroll as much as possible. + +Keep CONTEXT-PIXEL pixel of the image visible at the bottom and +top of the window. CONTEXT-PIXEL defaults to 0. + +Return the required hscroll in columns or nil, if scrolling is not +needed." + + (pdf-util-assert-pdf-window) + (unless context-pixel + (setq context-pixel 0)) + (let* ((win (window-inside-pixel-edges)) + (image-width (car (pdf-view-image-size t))) + (image-left (* (frame-char-width) + (window-hscroll))) + (edges (pdf-util-translate + edges + (pdf-view-image-offset) t))) + (pdf-util-with-edges (win edges) + (let* ((edges-left (- edges-left context-pixel)) + (edges-right (+ edges-right context-pixel))) + (if (< edges-left image-left) + (round (/ (max 0 (if eager-p + (- edges-right win-width) + edges-left)) + (frame-char-width))) + (if (> (min image-width + edges-right) + (+ image-left win-width)) + (round (/ (min (- image-width win-width) + (if eager-p + edges-left + (- edges-right win-width))) + (frame-char-width))))))))) + +(defun pdf-util-required-vscroll (edges &optional eager-p context-pixel) + "Return the amount of scrolling necessary, to make image EDGES visible. + +Scroll as little as necessary. Unless EAGER-P is non-nil, in +which case scroll as much as possible. + +Keep CONTEXT-PIXEL pixel of the image visible at the bottom and +top of the window. CONTEXT-PIXEL defaults to an equivalent pixel +value of `next-screen-context-lines'. + +Return the required vscroll in lines or nil, if scrolling is not +needed." + + (pdf-util-assert-pdf-window) + (let* ((win (window-inside-pixel-edges)) + (image-height (cdr (pdf-view-image-size t))) + (image-top (window-vscroll nil t)) + (edges (pdf-util-translate + edges + (pdf-view-image-offset) t))) + (pdf-util-with-edges (win edges) + (let* ((context-pixel (or context-pixel + (* next-screen-context-lines + (frame-char-height)))) + ;;Be careful not to modify edges. + (edges-top (- edges-top context-pixel)) + (edges-bot (+ edges-bot context-pixel))) + (if (< edges-top image-top) + (round (/ (max 0 (if eager-p + (- edges-bot win-height) + edges-top)) + (float (frame-char-height)))) + (if (> (min image-height + edges-bot) + (+ image-top win-height)) + (round (/ (min (- image-height win-height) + (if eager-p + edges-top + (- edges-bot win-height))) + (float (frame-char-height)))))))))) + +(defun pdf-util-scroll-to-edges (edges &optional eager-p) + "Scroll window such that image EDGES are visible. + +Scroll as little as necessary. Unless EAGER-P is non-nil, in +which case scroll as much as possible." + + (let ((vscroll (pdf-util-required-vscroll edges eager-p)) + (hscroll (pdf-util-required-hscroll edges eager-p))) + (when vscroll + (image-set-window-vscroll vscroll)) + (when hscroll + (image-set-window-hscroll hscroll)))) + + + +;; * ================================================================== * +;; * Temporary files +;; * ================================================================== * + +(defvar pdf-util--base-directory nil + "Base directory for temporary files.") + +(defvar-local pdf-util--dedicated-directory nil + "The relative name of buffer's dedicated directory.") + +(defun pdf-util-dedicated-directory () + "Return the name of a existing dedicated directory. + +The directory is exclusive to the current buffer. It will be +automatically deleted, if Emacs or the current buffer are +killed." + (with-file-modes #o0700 + (unless (and pdf-util--base-directory + (file-directory-p + pdf-util--base-directory) + (not (file-symlink-p + pdf-util--base-directory))) + (add-hook 'kill-emacs-hook + (lambda nil + (when (and pdf-util--base-directory + (file-directory-p pdf-util--base-directory)) + (delete-directory pdf-util--base-directory t)))) + (setq pdf-util--base-directory + (make-temp-file "pdf-tools-" t))) + (unless (and pdf-util--dedicated-directory + (file-directory-p pdf-util--dedicated-directory) + (not (file-symlink-p + pdf-util--base-directory))) + (let ((temporary-file-directory + pdf-util--base-directory)) + (setq pdf-util--dedicated-directory + (make-temp-file (convert-standard-filename + (concat (if buffer-file-name + (file-name-nondirectory + buffer-file-name) + (buffer-name)) + "-")) + t)) + (add-hook 'kill-buffer-hook 'pdf-util-delete-dedicated-directory + nil t))) + pdf-util--dedicated-directory)) + +(defun pdf-util-delete-dedicated-directory () + "Delete current buffer's dedicated directory." + (delete-directory (pdf-util-dedicated-directory) t)) + +(defun pdf-util-expand-file-name (name) + "Expand filename against current buffer's dedicated directory." + (expand-file-name name (pdf-util-dedicated-directory))) + +(defun pdf-util-make-temp-file (prefix &optional dir-flag suffix) + "Create a temporary file in current buffer's dedicated directory. + +See `make-temp-file' for the arguments." + (let ((temporary-file-directory + (pdf-util-dedicated-directory))) + (make-temp-file (convert-standard-filename prefix) dir-flag suffix))) + + +;; * ================================================================== * +;; * Various +;; * ================================================================== * + +(defmacro pdf-util-debug (&rest body) + "Execute BODY only if debugging is enabled." + (declare (indent 0) (debug t)) + `(when (bound-and-true-p pdf-tools-debug) + ,@body)) + +(defun pdf-util-pdf-buffer-p (&optional buffer) + (and (or (null buffer) + (buffer-live-p buffer)) + (save-current-buffer + (and buffer (set-buffer buffer)) + (derived-mode-p 'pdf-view-mode)))) + +(defun pdf-util-assert-pdf-buffer (&optional buffer) + (unless (pdf-util-pdf-buffer-p buffer) + (error "Buffer is not in PDFView mode"))) + +(defun pdf-util-pdf-window-p (&optional window) + (unless (or (null window) + (window-live-p window)) + (signal 'wrong-type-argument (list 'window-live-p window))) + (unless window (setq window (selected-window))) + (and (window-live-p window) + (with-selected-window window + (pdf-util-pdf-buffer-p)))) + +(defun pdf-util-assert-pdf-window (&optional window) + (unless (pdf-util-pdf-window-p window) + (error "Window's buffer is not in PdfView mode"))) + +(defun pdf-util-munch-file (filename &optional multibyte-p) + "Read contents from FILENAME and delete it. + +Return the file's content as a unibyte string, unless MULTIBYTE-P +is non-nil." + (unwind-protect + (with-temp-buffer + (set-buffer-multibyte multibyte-p) + (insert-file-contents-literally filename) + (buffer-substring-no-properties + (point-min) + (point-max))) + (when (and filename + (file-exists-p filename)) + (delete-file filename)))) + +(defun pdf-util-hexcolor (color) + "Return COLOR in hex-format. + +Signal an error, if color is invalid." + (if (string-match "\\`#[[:xdigit:]]\\{6\\}\\'" color) + color + (let ((values (color-values color))) + (unless values + (signal 'wrong-type-argument (list 'color-defined-p color))) + (apply 'format "#%02x%02x%02x" + (mapcar (lambda (c) (lsh c -8)) + values))))) + +(defun pdf-util-highlight-regexp-in-string (regexp string &optional face) + "Highlight all occurrences of REGEXP in STRING using FACE. + +FACE defaults to the `match' face. Returns the new fontified +string." + (with-temp-buffer + (save-excursion (insert string)) + (while (and (not (eobp)) + (re-search-forward regexp nil t)) + (if (= (match-beginning 0) + (match-end 0)) + (forward-char) + (put-text-property + (match-beginning 0) + (point) + 'face (or face 'match)))) + (buffer-string))) + +(defun pdf-util-color-completions () + "Return a fontified list of defined colors." + (let ((color-list (list-colors-duplicates)) + colors) + (dolist (cl color-list) + (dolist (c (reverse cl)) + (push (propertize c 'face `(:background ,c)) + colors))) + (nreverse colors))) + +(defun pdf-util-tooltip-in-window (text x y &optional window) + (let* ((we (window-inside-absolute-pixel-edges window)) + (dx (round (+ x (nth 0 we)))) + (dy (round (+ y (nth 1 we)))) + (tooltip-frame-parameters + `((left . ,dx) + (top . ,dy) + ,@tooltip-frame-parameters))) + (tooltip-show text))) + +(defun pdf-util-tooltip-arrow (image-top &optional timeout) + (pdf-util-assert-pdf-window) + (when (floatp image-top) + (setq image-top + (round (* image-top (cdr (pdf-view-image-size)))))) + (let* (x-gtk-use-system-tooltips ;allow for display property in tooltip + (dx (+ (or (car (window-margins)) 0) + (car (window-fringes)))) + (dy image-top) + (pos (list dx dy dx (+ dy (* 2 (frame-char-height))))) + (vscroll + (pdf-util-required-vscroll pos)) + (tooltip-frame-parameters + `((border-width . 0) + (internal-border-width . 0) + ,@tooltip-frame-parameters)) + (tooltip-hide-delay (or timeout 3))) + (when vscroll + (image-set-window-vscroll vscroll)) + (setq dy (max 0 (- dy + (cdr (pdf-view-image-offset)) + (window-vscroll nil t) + (frame-char-height)))) + (when (overlay-get (pdf-view-current-overlay) 'before-string) + (let* ((e (window-inside-pixel-edges)) + (xw (pdf-util-with-edges (e) e-width))) + (cl-incf dx (/ (- xw (car (pdf-view-image-size t))) 2)))) + (pdf-util-tooltip-in-window + (propertize + " " 'display (propertize + "\u2192" ;;right arrow + 'display '(height 2) + 'face `(:foreground + "orange red" + :background + ,(if (bound-and-true-p pdf-view-midnight-minor-mode) + (cdr pdf-view-midnight-colors) + "white")))) + dx dy))) + +(defvar pdf-util--face-colors-cache (make-hash-table)) + +(defadvice enable-theme (after pdf-util-clear-faces-cache activate) + (clrhash pdf-util--face-colors-cache)) + +(defun pdf-util-face-colors (face &optional dark-p) + "Return both colors of FACE as a cons. + +Look also in inherited faces. If DARK-P is non-nil, return dark +colors, otherwise light." + (let* ((bg (if dark-p 'dark 'light)) + (spec (list (get face 'face-defface-spec) + (get face 'theme-face) + (get face 'customized-face))) + (cached (gethash face pdf-util--face-colors-cache))) + (cl-destructuring-bind (&optional cspec color-alist) + cached + (or (and color-alist + (equal cspec spec) + (cdr (assq bg color-alist))) + (let* ((this-bg (frame-parameter nil 'background-mode)) + (frame-background-mode bg) + (f (and (not (eq bg this-bg)) + (x-create-frame-with-faces '((visibility . nil)))))) + (with-selected-frame (or f (selected-frame)) + (unwind-protect + (let ((colors + (cons (face-attribute face :foreground nil 'default) + (face-attribute face :background nil 'default)))) + (puthash face `(,(mapcar 'copy-sequence spec) + ((,bg . ,colors) ,@color-alist)) + pdf-util--face-colors-cache) + colors) + (when (and f (frame-live-p f)) + (delete-frame f))))))))) + +(defun pdf-util-window-attach (awindow &optional window) + "Attach AWINDOW to WINDOW. + +This has the following effect. Whenever WINDOW, defaulting to +the selected window, stops displaying the buffer it currently +displays (e.g., by switching buffers or because it was deleted) +AWINDOW is deleted." + (unless window (setq window (selected-window))) + (let ((buffer (window-buffer window)) + (hook (make-symbol "window-attach-hook"))) + (fset hook + (lambda () + (when (or (not (window-live-p window)) + (not (eq buffer (window-buffer window)))) + (remove-hook 'window-configuration-change-hook + hook) + ;; Deleting windows inside wcch may cause errors in + ;; windows.el . + (run-with-timer + 0 nil (lambda (win) + (when (and (window-live-p win) + (not (eq win (selected-window)))) + (delete-window win))) + awindow)))) + (add-hook 'window-configuration-change-hook hook))) + +(defun display-buffer-split-below-and-attach (buf alist) + "Display buffer action using `pdf-util-window-attach'." + (let ((window (selected-window)) + (height (cdr (assq 'window-height alist))) + newwin) + (when height + (when (floatp height) + (setq height (round (* height (frame-height))))) + (setq height (- (max height window-min-height)))) + (setq newwin (window--display-buffer + buf + (split-window-below height) + 'window alist)) + (pdf-util-window-attach newwin window) + newwin)) + +(defun pdf-util-goto-position (line &optional column) + "Goto LINE and COLUMN in the current buffer. + +COLUMN defaults to 0. Widen the buffer, if the position is +outside the current limits." + (let ((pos + (when (> line 0) + (save-excursion + (save-restriction + (widen) + (goto-char 1) + (when (= 0 (forward-line (1- line))) + (when (and column (> column 0)) + (forward-char (1- column))) + (point))))))) + (when pos + (when (or (< pos (point-min)) + (> pos (point-max))) + (widen)) + (goto-char pos)))) + +(defun pdf-util-seq-alignment (seq1 seq2 &optional similarity-fn alignment-type) + "Return an alignment of sequences SEQ1 and SEQ2. + +SIMILARITY-FN should be a function. It is called with two +arguments: One element from SEQ1 and one from SEQ2. It should +return a number determining how similar the elements are, where +higher values mean `more similar'. The default returns 1 if the +elements are equal, else -1. + +ALIGNMENT-TYPE may be one of the symbols `prefix', `suffix', +`infix' or nil. If it is `prefix', trailing elements in SEQ2 may +be ignored. For example the alignment of + +\(0 1\) and \(0 1 2\) + +using prefix matching is 0, since the prefixes are equal and the +trailing 2 is ignored. The other possible values have similar +effects. The default is nil, which means to match the whole +sequences. + +Return a cons \(VALUE . ALIGNMENT\), where VALUE says how similar +the sequences are and ALIGNMENT is a list of \(E1 . E2\), where +E1 is an element from SEQ1 or nil, likewise for E2. If one of +them is nil, it means there is gap at this position in the +respective sequence." + + (cl-macrolet ((make-matrix (rows columns) + (list 'apply (list 'quote 'vector) + (list 'cl-loop 'for 'i 'from 1 'to rows + 'collect (list 'make-vector columns nil)))) + (mset (matrix row column newelt) + (list 'aset (list 'aref matrix row) column newelt)) + (mref (matrix row column) + (list 'aref (list 'aref matrix row) column))) + (let* ((nil-value nil) + (len1 (length seq1)) + (len2 (length seq2)) + (d (make-matrix (1+ len1) (1+ len2))) + (prefix-p (memq alignment-type '(prefix infix))) + (suffix-p (memq alignment-type '(suffix infix))) + (similarity-fn (or similarity-fn + (lambda (a b) + (if (equal a b) 1 -1))))) + + (cl-loop for i from 0 to len1 do + (mset d i 0 (- i))) + (cl-loop for j from 0 to len2 do + (mset d 0 j (if suffix-p 0 (- j)))) + + (cl-loop for i from 1 to len1 do + (cl-loop for j from 1 to len2 do + (let ((max (max + (1- (mref d (1- i) j)) + (+ (mref d i (1- j)) + (if (and prefix-p (= i len1)) 0 -1)) + (+ (mref d (1- i) (1- j)) + (funcall similarity-fn + (elt seq1 (1- i)) + (elt seq2 (1- j))))))) + (mset d i j max)))) + + (let ((i len1) + (j len2) + alignment) + (while (or (> i 0) + (> j 0)) + (cond + ((and (> i 0) + (= (mref d i j) + (1- (mref d (1- i) j)))) + (cl-decf i) + (push (cons (elt seq1 i) nil-value) alignment)) + ((and (> j 0) + (= (mref d i j) + (+ (mref d i (1- j)) + (if (or (and (= i 0) suffix-p) + (and (= i len1) prefix-p)) + 0 -1)))) + (cl-decf j) + (push (cons nil-value (elt seq2 j)) alignment)) + (t + (cl-assert (and (> i 0) (> j 0)) t) + (cl-decf i) + (cl-decf j) + (push (cons (elt seq1 i) + (elt seq2 j)) alignment)))) + (cons (mref d len1 len2) alignment))))) + + +(defun pdf-util-pcre-quote (string) + "Escape STRING for use as a PCRE. + +See also `regexp-quote'." + + (let ((to-escape + (eval-when-compile (append "\0\\|()[]{}^$*+?." nil))) + (chars (append string nil)) + escaped) + (dolist (ch chars) + (when (memq ch to-escape) + (push ?\\ escaped)) + (push ch escaped)) + (apply 'string (nreverse escaped)))) + +(defun pdf-util-frame-ppi () + "Return the PPI of the current frame." + (let* ((props (frame-monitor-attributes)) + (px (nthcdr 2 (alist-get 'geometry props))) + (mm (alist-get 'mm-size props)) + (dp (sqrt (+ (expt (nth 0 px) 2) + (expt (nth 1 px) 2)))) + (di (sqrt (+ (expt (/ (nth 0 mm) 25.4) 2) + (expt (/ (nth 1 mm) 25.4) 2))))) + (/ dp di))) + +(defvar pdf-view-use-scaling) + +(defun pdf-util-frame-scale-factor () + "Return the frame scale factor depending on the image type used for display. +When `pdf-view-use-scaling' is non-nil and imagemagick or +image-io are used as the image type for display, return the +backing-scale-factor of the frame if available. If a +backing-scale-factor attribute isn't available, return 2 if the +frame's PPI is larger than 180. Otherwise, return 1." + (if (and pdf-view-use-scaling + (memq (pdf-view-image-type) '(imagemagick image-io)) + (fboundp 'frame-monitor-attributes)) + (or (cdr (assq 'backing-scale-factor (frame-monitor-attributes))) + (if (>= (pdf-util-frame-ppi) 180) + 2 + 1)) + 1)) + + +;; * ================================================================== * +;; * Imagemagick's convert +;; * ================================================================== * + +(defcustom pdf-util-convert-program + ;; Avoid using the MS Windows command convert.exe . + (unless (memq system-type '(ms-dos windows-nt)) + (executable-find "convert")) + "Absolute path to the convert program." + :group 'pdf-tools + :type 'executable) + +(defcustom pdf-util-fast-image-format nil + "An image format appropriate for fast displaying. + +This should be a cons \(TYPE . EXT\) where type is the Emacs +image-type and EXT the appropriate file extension starting with a +dot. If nil, the value is determined automatically. + +Different formats have different properties, with respect to +Emacs loading time, convert creation time and the file-size. In +general, uncompressed formats are faster, but may need a fair +amount of (temporary) disk space." + :group 'pdf-tools + :type '(cons symbol string)) + +(defun pdf-util-assert-convert-program () + (unless (and pdf-util-convert-program + (file-executable-p pdf-util-convert-program)) + (error "The pdf-util-convert-program is unset or non-executable"))) + +(defun pdf-util-image-file-size (image-file) + "Determine the size of the image in IMAGE-FILE. + +Returns a cons \(WIDTH . HEIGHT\)." + (pdf-util-assert-convert-program) + (with-temp-buffer + (when (save-excursion + (= 0 (call-process + pdf-util-convert-program + nil (current-buffer) nil + image-file "-format" "%w %h" "info:"))) + (let ((standard-input (current-buffer))) + (cons (read) (read)))))) + +(defun pdf-util-convert (in-file out-file &rest spec) + "Convert image IN-FILE to OUT-FILE according to SPEC. + +IN-FILE should be the name of a file containing an image. Write +the result to OUT-FILE. The extension of this filename usually +determines the resulting image-type. + +SPEC is a property list, specifying what the convert program +should do with the image. All manipulations operate on a +rectangle, see below. + +SPEC may contain the following keys, respectively values. + +`:foreground' Set foreground color for all following operations. + +`:background' Dito, for the background color. + +`:commands' A list of strings representing arguments to convert +for image manipulations. It may contain %-escape characters, as +follows. + +%f -- Expands to the foreground color. +%b -- Expands to the background color. +%g -- Expands to the geometry of the current rectangle, i.e. WxH+X+Y. +%x -- Expands to the left edge of rectangle. +%X -- Expands to the right edge of rectangle. +%y -- Expands to the top edge of rectangle. +%Y -- Expands to the bottom edge of rectangle. +%w -- Expands to the width of rectangle. +%h -- Expands to the height of rectangle. + +Keep in mind, that every element of this list is seen by convert +as a single argument. + +`:formats' An alist of additional %-escapes. Every element +should be a cons \(CHAR . STRING\) or \(CHAR . FUNCTION\). In +the first case, all occurrences of %-CHAR in the above commands +will be replaced by STRING. In the second case FUNCTION is +called with the current rectangle and it should return the +replacement string. + +`:apply' A list of rectangles \(\(LEFT TOP RIGHT BOT\) ...\) in +IN-FILE coordinates. Each such rectangle triggers one execution +of the last commands given earlier in SPEC. E.g. a call like + +\(pdf-util-convert + image-file out-file + :foreground \"black\" + :background \"white\" + :commands '\(\"-fill\" \"%f\" \"-draw\" \"rectangle %x,%y,%X,%Y\"\) + :apply '\(\(0 0 10 10\) \(10 10 20 20\)\) + :commands '\(\"-fill\" \"%b\" \"-draw\" \"rectangle %x,%y,%X,%Y\"\) + :apply '\(\(10 0 20 10\) \(0 10 10 20\)\)\) + +would draw a 4x4 checkerboard pattern in the left corner of the +image, while leaving the rest of it as it was. + +Returns OUT-FILE. + +See url `http://www.imagemagick.org/script/convert.php'." + (pdf-util-assert-convert-program) + (let* ((cmds (pdf-util-convert--create-commands spec)) + (status (apply 'call-process + pdf-util-convert-program nil + (get-buffer-create "*pdf-util-convert-output*") + nil + `(,in-file ,@cmds ,out-file)))) + (unless (and (numberp status) (= 0 status)) + (error "The convert program exited with error status: %s" status)) + out-file)) + +(defun pdf-util-convert-asynch (in-file out-file &rest spec-and-callback) + "Like `pdf-util-convert', but asynchronous. + +If the last argument is a function, it is installed as the +process sentinel. + +Returns the convert process." + (pdf-util-assert-convert-program) + (let ((callback (car (last spec-and-callback))) + spec) + (if (functionp callback) + (setq spec (butlast spec-and-callback)) + (setq spec spec-and-callback + callback nil)) + (let* ((cmds (pdf-util-convert--create-commands spec)) + (proc + (apply 'start-process "pdf-util-convert" + (get-buffer-create "*pdf-util-convert-output*") + pdf-util-convert-program + `(,in-file ,@cmds ,out-file)))) + (when callback + (set-process-sentinel proc callback)) + proc))) + +(defun pdf-util-convert-page (&rest specs) + "Convert image of current page according to SPECS. + +Return the converted PNG image as a string. See also +`pdf-util-convert'." + + (pdf-util-assert-pdf-window) + (let ((in-file (make-temp-file "pdf-util-convert" nil ".png")) + (out-file (make-temp-file "pdf-util-convert" nil ".png"))) + (unwind-protect + (let ((image-data + (plist-get (cdr (pdf-view-current-image)) :data))) + (with-temp-file in-file + (set-buffer-multibyte nil) + (set-buffer-file-coding-system 'binary) + (insert image-data)) + (pdf-util-munch-file + (apply 'pdf-util-convert + in-file out-file specs))) + (when (file-exists-p in-file) + (delete-file in-file)) + (when (file-exists-p out-file) + (delete-file out-file))))) + + +(defun pdf-util-convert--create-commands (spec) + (let ((fg "red") + (bg "red") + formats result cmds s) + (while (setq s (pop spec)) + (unless spec + (error "Missing value in convert spec:%s" (cons s spec))) + (cl-case s + (:foreground + (setq fg (pop spec))) + (:background + (setq bg (pop spec))) + (:commands + (setq cmds (pop spec))) + (:formats + (setq formats (append formats (pop spec) nil))) + (:apply + (dolist (m (pop spec)) + (pdf-util-with-edges (m) + (let ((alist (append + (mapcar (lambda (f) + (cons (car f) + (if (stringp (cdr f)) + (cdr f) + (funcall (cdr f) m)))) + formats) + `((?g . ,(format "%dx%d+%d+%d" + m-width m-height + m-left m-top)) + (?x . ,m-left) + (?X . ,m-right) + (?y . ,m-top) + (?Y . ,m-bot) + (?w . ,(- m-right m-left)) + (?h . ,(- m-bot m-top)) + (?f . ,fg) + (?b . ,bg))))) + (dolist (fmt cmds) + (push (format-spec fmt alist) result)))))))) + (nreverse result))) + +;; FIXME: Check code below and document. + +(defun pdf-util-edges-p (obj &optional relative-p) + "Return non-nil, if OBJ look like edges. + +If RELATIVE-P is non-nil, also check that all values <= 1." + + (and (consp obj) + (ignore-errors (= 4 (length obj))) + (cl-every (lambda (x) + (and (numberp x) + (>= x 0) + (or (null relative-p) + (<= x 1)))) + obj))) + +(defun pdf-util-edges-empty-p (edges) + "Return non-nil, if EDGES area is empty." + (pdf-util-with-edges (edges) + (or (<= edges-width 0) + (<= edges-height 0)))) + +(defun pdf-util-edges-inside-p (edges pos &optional epsilon) + (pdf-util-edges-contained-p + edges + (list (car pos) (cdr pos) (car pos) (cdr pos)) + epsilon)) + +(defun pdf-util-edges-contained-p (edges contained &optional epsilon) + (unless epsilon (setq epsilon 0)) + (pdf-util-with-edges (edges contained) + (and (<= (- edges-left epsilon) + contained-left) + (>= (+ edges-right epsilon) + contained-right) + (<= (- edges-top epsilon) + contained-top) + (>= (+ edges-bot epsilon) + contained-bot)))) + +(defun pdf-util-edges-intersection (e1 e2) + (pdf-util-with-edges (edges1 e1 e2) + (let ((left (max e1-left e2-left)) + (top (max e1-top e2-top)) + (right (min e1-right e2-right)) + (bot (min e1-bot e2-bot))) + (when (and (<= left right) + (<= top bot)) + (list left top right bot))))) + +(defun pdf-util-edges-union (&rest edges) + (if (null (cdr edges)) + (car edges) + (list (apply 'min (mapcar 'car edges)) + (apply 'min (mapcar 'cadr edges)) + (apply 'max (mapcar 'cl-caddr edges)) + (apply 'max (mapcar 'cl-cadddr edges))))) + +(defun pdf-util-edges-intersection-area (e1 e2) + (let ((inters (pdf-util-edges-intersection e1 e2))) + (if (null inters) + 0 + (pdf-util-with-edges (inters) + (* inters-width inters-height))))) + +(defun pdf-util-read-image-position (prompt) + "Read a image position using prompt. + +Return the event position object." + (save-selected-window + (let ((ev (pdf-util-read-click-event + (propertize prompt 'face 'minibuffer-prompt))) + (buffer (current-buffer))) + (unless (mouse-event-p ev) + (error "Not a mouse event")) + (let ((posn (event-start ev))) + (unless (and (eq (window-buffer + (posn-window posn)) + buffer) + (eq 'image (car-safe (posn-object posn)))) + (error "Invalid image position")) + posn)))) + +(defun pdf-util-read-click-event (&optional prompt seconds) + (let ((down (read-event prompt seconds))) + (unless (and (mouse-event-p down) + (equal (event-modifiers down) + '(down))) + (error "No a mouse click event")) + (let ((up (read-event prompt seconds))) + (unless (and (mouse-event-p up) + (equal (event-modifiers up) + '(click))) + (error "No a mouse click event")) + up))) + +(defun pdf-util-image-map-mouse-event-proxy (event) + "Set POS-OR-AREA in EVENT to 1 and unread it." + (interactive "e") + (setcar (cdr (cadr event)) 1) + (setq unread-command-events (list event))) + +(defun pdf-util-image-map-divert-mouse-clicks (id &optional buttons) + (dolist (kind '("" "down-" "drag-")) + (dolist (b (or buttons '(2 3 4 5 6))) + (local-set-key + (vector id (intern (format "%smouse-%d" kind b))) + 'pdf-util-image-map-mouse-event-proxy)))) + +(defmacro pdf-util-do-events (event-resolution-unread-p condition &rest body) + "Read EVENTs while CONDITION executing BODY. + +Process at most 1/RESOLUTION events per second. If UNREAD-p is +non-nil, unread the final non-processed event. + +\(FN (EVENT RESOLUTION &optional UNREAD-p) CONDITION &rest BODY\)" + (declare (indent 2) (debug ((symbolp form &optional form) form body))) + (cl-destructuring-bind (event resolution &optional unread-p) + event-resolution-unread-p + (let ((*seconds (make-symbol "seconds")) + (*timestamp (make-symbol "timestamp")) + (*clock (make-symbol "clock")) + (*unread-p (make-symbol "unread-p")) + (*resolution (make-symbol "resolution"))) + `(let* ((,*unread-p ,unread-p) + (,*resolution ,resolution) + (,*seconds 0) + (,*timestamp (float-time)) + (,*clock (lambda (&optional secs) + (when secs + (setq ,*seconds secs + ,*timestamp (float-time))) + (- (+ ,*timestamp ,*seconds) + (float-time)))) + (,event (read-event))) + (while ,condition + (when (<= (funcall ,*clock) 0) + (progn ,@body) + (setq ,event nil) + (funcall ,*clock ,*resolution)) + (setq ,event + (or (read-event nil nil + (and ,event + (max 0 (funcall ,*clock)))) + ,event))) + (when (and ,*unread-p ,event) + (setq unread-command-events + (append unread-command-events + (list ,event)))))))) + +(defmacro pdf-util-track-mouse-dragging (event-resolution &rest body) + "Read mouse movement events executing BODY. + +See also `pdf-util-do-events'. + +This macro should be used inside a command bound to a down-mouse +event. It evaluates to t, if at least one event was processed in +BODY, otherwise nil. In the latter case, the only event (usually +a mouse click event) is unread. + +\(FN (EVENT RESOLUTION) &rest BODY\)" + (declare (indent 1) (debug ((symbolp form) body))) + (let ((ran-once-p (make-symbol "ran-once-p"))) + `(let (,ran-once-p) + (track-mouse + (pdf-util-do-events (,@event-resolution t) + (mouse-movement-p ,(car event-resolution)) + (setq ,ran-once-p t) + ,@body)) + (when (and ,ran-once-p + unread-command-events) + (setq unread-command-events + (butlast unread-command-events))) + ,ran-once-p))) + +(defun pdf-util-remove-duplicates (list) + "Remove duplicates from LIST stably using `equal'." + (let ((ht (make-hash-table :test 'equal)) + result) + (dolist (elt list (nreverse result)) + (unless (gethash elt ht) + (push elt result) + (puthash elt t ht))))) + +(provide 'pdf-util) + +;;; pdf-util.el ends here |