dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

pdf-util.el (48331B)


      1 ;;; pdf-util.el --- PDF Utility functions. -*- lexical-binding: t -*-
      2 
      3 ;; Copyright (C) 2013, 2014  Andreas Politz
      4 
      5 ;; Author: Andreas Politz <politza@fh-trier.de>
      6 ;; Keywords: files, multimedia
      7 
      8 ;; This program is free software; you can redistribute it and/or modify
      9 ;; it under the terms of the GNU General Public License as published by
     10 ;; the Free Software Foundation, either version 3 of the License, or
     11 ;; (at your option) any later version.
     12 
     13 ;; This program is distributed in the hope that it will be useful,
     14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
     15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     16 ;; GNU General Public License for more details.
     17 
     18 ;; You should have received a copy of the GNU General Public License
     19 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
     20 
     21 ;;; Commentary:
     22 ;;
     23 ;;; Todo:
     24 ;;
     25 
     26 ;;; Code:
     27 
     28 (require 'pdf-macs)
     29 (require 'cl-lib)
     30 (require 'format-spec)
     31 (require 'faces)
     32 
     33 ;; These functions are only used after a PdfView window was asserted,
     34 ;; which won't succeed, if pdf-view.el isn't loaded.
     35 (declare-function pdf-view-image-size "pdf-view")
     36 (declare-function pdf-view-image-offset "pdf-view")
     37 (declare-function pdf-cache-pagesize "pdf-cache")
     38 (declare-function pdf-view-image-type "pdf-view")
     39 
     40 
     41 
     42 ;; * ================================================================== *
     43 ;; * Transforming coordinates
     44 ;; * ================================================================== *
     45 
     46 
     47 (defun pdf-util-scale (list-of-edges-or-pos scale &optional rounding-fn)
     48   "Scale LIST-OF-EDGES-OR-POS by SCALE.
     49 
     50 SCALE is a cons (SX . SY), by which edges/positions are scaled.
     51 If ROUNDING-FN is non-nil, it should be a function of one
     52 argument, a real value, returning a rounded
     53 value (e.g. `ceiling').
     54 
     55 The elements in LIST-OF-EDGES-OR-POS should be either a list
     56 \(LEFT TOP RIGHT BOT\) or a position \(X . Y\).
     57 
     58 LIST-OF-EDGES-OR-POS may also be a single such element.
     59 
     60 Return scaled list of edges if LIST-OF-EDGES-OR-POS was indeed a list,
     61 else return the scaled singleton."
     62 
     63   (let ((have-list-p (listp (car list-of-edges-or-pos))))
     64     (unless have-list-p
     65       (setq list-of-edges-or-pos (list list-of-edges-or-pos)))
     66     (let* ((sx (car scale))
     67            (sy (cdr scale))
     68            (result
     69             (mapcar
     70              (lambda (edges)
     71                (cond
     72                 ((consp (cdr edges))
     73                  (let ((e (list (* (nth 0 edges) sx)
     74                                 (* (nth 1 edges) sy)
     75                                 (* (nth 2 edges) sx)
     76                                 (* (nth 3 edges) sy))))
     77                    (if rounding-fn
     78                        (mapcar rounding-fn e)
     79                      e)))
     80                 (rounding-fn
     81                  (cons (funcall rounding-fn (* (car edges) sx))
     82                        (funcall rounding-fn (* (cdr edges) sy))))
     83                 (t
     84                  (cons (* (car edges) sx)
     85                        (* (cdr edges) sy)))))
     86              list-of-edges-or-pos)))
     87       (if have-list-p
     88           result
     89         (car result)))))
     90 
     91 (defun pdf-util-scale-to (list-of-edges from to &optional rounding-fn)
     92   "Scale LIST-OF-EDGES in FROM basis to TO.
     93 
     94 FROM and TO should both be a cons \(WIDTH . HEIGHT\).  See also
     95 `pdf-util-scale'."
     96 
     97   (pdf-util-scale list-of-edges
     98                   (cons (/ (float (car to))
     99                            (float (car from)))
    100                         (/ (float (cdr to))
    101                            (float (cdr from))))
    102                   rounding-fn))
    103 
    104 (defun pdf-util-scale-pixel-to-points (list-of-pixel-edges
    105                                        &optional rounding-fn displayed-p window)
    106   "Scale LIST-OF-PIXEL-EDGES to point values.
    107 
    108 The result depends on the currently displayed page in WINDOW.
    109 See also `pdf-util-scale'."
    110   (pdf-util-assert-pdf-window window)
    111   (pdf-util-scale-to
    112    list-of-pixel-edges
    113    (pdf-view-image-size displayed-p window)
    114    (pdf-cache-pagesize (pdf-view-current-page window))
    115    rounding-fn))
    116 
    117 (defun pdf-util-scale-points-to-pixel (list-of-points-edges
    118                                        &optional rounding-fn displayed-p window)
    119   "Scale LIST-OF-POINTS-EDGES to point values.
    120 
    121 The result depends on the currently displayed page in WINDOW.
    122 See also `pdf-util-scale'."
    123   (pdf-util-assert-pdf-window window)
    124   (pdf-util-scale-to
    125    list-of-points-edges
    126    (pdf-cache-pagesize (pdf-view-current-page window))
    127    (pdf-view-image-size displayed-p window)
    128    rounding-fn))
    129 
    130 (defun pdf-util-scale-relative-to-points (list-of-relative-edges
    131                                           &optional rounding-fn window)
    132   "Scale LIST-OF-RELATIVE-EDGES to point values.
    133 
    134 The result depends on the currently displayed page in WINDOW.
    135 See also `pdf-util-scale'."
    136   (pdf-util-assert-pdf-window window)
    137   (pdf-util-scale-to
    138    list-of-relative-edges
    139    '(1.0 . 1.0)
    140    (pdf-cache-pagesize (pdf-view-current-page window))
    141    rounding-fn))
    142 
    143 (defun pdf-util-scale-points-to-relative (list-of-points-edges
    144                                           &optional rounding-fn window)
    145   "Scale LIST-OF-POINTS-EDGES to relative values.
    146 
    147 See also `pdf-util-scale'."
    148   (pdf-util-assert-pdf-window window)
    149   (pdf-util-scale-to
    150    list-of-points-edges
    151    (pdf-cache-pagesize (pdf-view-current-page window))
    152    '(1.0 . 1.0)
    153    rounding-fn))
    154 
    155 (defun pdf-util-scale-pixel-to-relative (list-of-pixel-edges
    156                                          &optional rounding-fn displayed-p window)
    157   "Scale LIST-OF-PIXEL-EDGES to relative values.
    158 
    159 The result depends on the currently displayed page in WINDOW.
    160 See also `pdf-util-scale'."
    161   (pdf-util-assert-pdf-window window)
    162   (pdf-util-scale-to
    163    list-of-pixel-edges
    164    (pdf-view-image-size displayed-p window)
    165    '(1.0 . 1.0)
    166    rounding-fn))
    167 
    168 
    169 (defun pdf-util-scale-relative-to-pixel (list-of-relative-edges
    170                                          &optional rounding-fn displayed-p window)
    171   "Scale LIST-OF-EDGES to match SIZE.
    172 
    173 The result depends on the currently displayed page in WINDOW.
    174 See also `pdf-util-scale'."
    175   (pdf-util-assert-pdf-window window)
    176   (pdf-util-scale-to
    177    list-of-relative-edges
    178    '(1.0 . 1.0)
    179    (pdf-view-image-size displayed-p window)
    180    rounding-fn))
    181 
    182 (defun pdf-util-translate (list-of-edges-or-pos
    183                            offset &optional opposite-direction-p)
    184   "Translate LIST-OF-EDGES-OR-POS by OFFSET
    185 
    186 OFFSET should be a cons \(X . Y\), by which to translate
    187 LIST-OF-EDGES-OR-POS.  If OPPOSITE-DIRECTION-P is non-nil
    188 translate by \(-X . -Y\).
    189 
    190 See `pdf-util-scale' for the LIST-OF-EDGES-OR-POS argument."
    191 
    192   (let ((have-list-p (listp (car list-of-edges-or-pos))))
    193     (unless have-list-p
    194       (setq list-of-edges-or-pos (list list-of-edges-or-pos)))
    195     (let* ((ox (if opposite-direction-p
    196                    (- (car offset))
    197                  (car offset)))
    198            (oy (if opposite-direction-p
    199                    (- (cdr offset))
    200                  (cdr offset)))
    201            (result
    202             (mapcar
    203              (lambda (edges)
    204                (cond
    205                 ((consp (cdr edges))
    206                  (list (+ (nth 0 edges) ox)
    207                        (+ (nth 1 edges) oy)
    208                        (+ (nth 2 edges) ox)
    209                        (+ (nth 3 edges) oy)))
    210                 (t
    211                  (cons (+ (car edges) ox)
    212                        (+ (cdr edges) oy)))))
    213              list-of-edges-or-pos)))
    214       (if have-list-p
    215           result
    216         (car result)))))
    217 
    218 (defmacro pdf-util-with-edges (list-of-edges &rest body)
    219   "Provide some convenient macros for the edges in LIST-OF-EDGES.
    220 
    221 LIST-OF-EDGES should be a list of variables \(X ...\), each one
    222 holding a list of edges. Inside BODY the symbols X-left, X-top,
    223 X-right, X-bot, X-width and X-height expand to their respective
    224 values."
    225 
    226   (declare (indent 1) (debug (sexp &rest form)))
    227   (unless (cl-every 'symbolp list-of-edges)
    228     (error "Argument should be a list of symbols"))
    229   (let ((list-of-syms
    230          (mapcar (lambda (edge)
    231                    (cons edge (mapcar
    232                                (lambda (kind)
    233                                  (intern (format "%s-%s" edge kind)))
    234                                '(left top right bot width height))))
    235                  list-of-edges)))
    236     (macroexpand-all
    237      `(cl-symbol-macrolet
    238           ,(apply #'nconc
    239                   (mapcar
    240                    (lambda (edge-syms)
    241                      (let ((edge (nth 0 edge-syms))
    242                            (syms (cdr edge-syms)))
    243                        `((,(pop syms) (nth 0 ,edge))
    244                          (,(pop syms) (nth 1 ,edge))
    245                          (,(pop syms) (nth 2 ,edge))
    246                          (,(pop syms) (nth 3 ,edge))
    247                          (,(pop syms) (- (nth 2 ,edge)
    248                                          (nth 0 ,edge)))
    249                          (,(pop syms) (- (nth 3 ,edge)
    250                                          (nth 1 ,edge))))))
    251                    list-of-syms))
    252         ,@body))))
    253 
    254 (defun pdf-util-edges-transform (region elts &optional to-region-p)
    255   "Translate ELTS according to REGION.
    256 
    257 ELTS may be one edges list or a position or a list thereof.
    258 Translate each from region coordinates to (0 0 1 1) or the
    259 opposite, if TO-REGION-P is non-nil.  All coordinates should be
    260 relative.
    261 
    262 Returns the translated list of elements or the single one
    263 depending on the input."
    264 
    265   (when elts
    266     (let ((have-list-p (consp (car-safe elts))))
    267       (unless have-list-p
    268         (setq elts (list elts)))
    269       (let ((result
    270              (if (null region)
    271                  elts
    272                (mapcar (lambda (edges)
    273                          (let ((have-pos-p (numberp (cdr edges))))
    274                            (when have-pos-p
    275                              (setq edges (list (car edges) (cdr edges)
    276                                                (car edges) (cdr edges))))
    277                            (pdf-util-with-edges (edges region)
    278                              (let ((newedges
    279                                     (mapcar (lambda (n)
    280                                               (min 1.0 (max 0.0 n)))
    281                                             (if to-region-p
    282                                                 `(,(/ (- edges-left region-left)
    283                                                       region-width)
    284                                                   ,(/ (- edges-top region-top)
    285                                                       region-height)
    286                                                   ,(/ (- edges-right region-left)
    287                                                       region-width)
    288                                                   ,(/ (- edges-bot region-top)
    289                                                       region-height))
    290                                               `(,(+ (* edges-left region-width)
    291                                                     region-left)
    292                                                 ,(+ (* edges-top region-height)
    293                                                     region-top)
    294                                                 ,(+ (* edges-right region-width)
    295                                                     region-left)
    296                                                 ,(+ (* edges-bot region-height)
    297                                                     region-top))))))
    298                                (if have-pos-p
    299                                    (cons (car newedges) (cadr newedges))
    300                                  newedges)))))
    301                        elts))))
    302         (if have-list-p
    303             result
    304           (car result))))))
    305 
    306 ;; * ================================================================== *
    307 ;; * Scrolling
    308 ;; * ================================================================== *
    309 
    310 (defun pdf-util-image-displayed-edges (&optional window displayed-p)
    311   "Return the visible region of the image in WINDOW.
    312 
    313 Returns a list of pixel edges."
    314   (pdf-util-assert-pdf-window)
    315   (let* ((edges (window-inside-pixel-edges window))
    316          (isize (pdf-view-image-size displayed-p window))
    317          (offset (if displayed-p
    318                      `(0 . 0)
    319                    (pdf-view-image-offset window)))
    320          (hscroll (* (window-hscroll window)
    321                      (frame-char-width (window-frame window))))
    322          (vscroll (window-vscroll window t))
    323          (x0 (+ hscroll (car offset)))
    324          (y0 (+ vscroll (cdr offset)))
    325          (x1 (min (car isize)
    326                   (+ x0 (- (nth 2 edges) (nth 0 edges)))))
    327          (y1 (min (cdr isize)
    328                   (+ y0 (- (nth 3 edges) (nth 1 edges))))))
    329     (mapcar #'round (list x0 y0 x1 y1))))
    330 
    331 (defun pdf-util-required-hscroll (edges &optional eager-p context-pixel)
    332   "Return the amount of scrolling necessary, to make image EDGES visible.
    333 
    334 Scroll as little as necessary.  Unless EAGER-P is non-nil, in
    335 which case scroll as much as possible.
    336 
    337 Keep CONTEXT-PIXEL pixel of the image visible at the bottom and
    338 top of the window.  CONTEXT-PIXEL defaults to 0.
    339 
    340 Return the required hscroll in columns or nil, if scrolling is not
    341 needed."
    342 
    343   (pdf-util-assert-pdf-window)
    344   (unless context-pixel
    345     (setq context-pixel 0))
    346   (let* ((win (window-inside-pixel-edges))
    347          (image-width (car (pdf-view-image-size t)))
    348          (image-left (* (frame-char-width)
    349                         (window-hscroll)))
    350          (edges (pdf-util-translate
    351                  edges
    352                  (pdf-view-image-offset) t)))
    353     (pdf-util-with-edges (win edges)
    354       (let* ((edges-left (- edges-left context-pixel))
    355              (edges-right (+ edges-right context-pixel)))
    356         (if (< edges-left image-left)
    357             (round (/ (max 0 (if eager-p
    358                                  (- edges-right win-width)
    359                                edges-left))
    360                       (frame-char-width)))
    361           (if (> (min image-width
    362                       edges-right)
    363                  (+ image-left win-width))
    364               (round (/ (min (- image-width win-width)
    365                              (if eager-p
    366                                  edges-left
    367                                (- edges-right win-width)))
    368                         (frame-char-width)))))))))
    369 
    370 (defun pdf-util-required-vscroll (edges &optional eager-p context-pixel)
    371   "Return the amount of scrolling necessary, to make image EDGES visible.
    372 
    373 Scroll as little as necessary.  Unless EAGER-P is non-nil, in
    374 which case scroll as much as possible.
    375 
    376 Keep CONTEXT-PIXEL pixel of the image visible at the bottom and
    377 top of the window.  CONTEXT-PIXEL defaults to an equivalent pixel
    378 value of `next-screen-context-lines'.
    379 
    380 Return the required vscroll in pixels or nil, if scrolling is not
    381 needed.
    382 
    383 Note: For versions of emacs before 27 this will return lines instead of
    384 pixels. This is because of a change that occurred to `image-mode' in 27."
    385   (pdf-util-assert-pdf-window)
    386   (let* ((win (window-inside-pixel-edges))
    387          (image-height (cdr (pdf-view-image-size t)))
    388          (image-top (window-vscroll nil t))
    389          (edges (pdf-util-translate
    390                  edges
    391                  (pdf-view-image-offset) t)))
    392     (pdf-util-with-edges (win edges)
    393       (let* ((context-pixel (or context-pixel
    394                                 (* next-screen-context-lines
    395                                    (frame-char-height))))
    396              ;;Be careful not to modify edges.
    397              (edges-top (- edges-top context-pixel))
    398              (edges-bot (+ edges-bot context-pixel))
    399              (vscroll
    400               (cond ((< edges-top image-top)
    401                      (max 0 (if eager-p
    402                                 (- edges-bot win-height)
    403                               edges-top)))
    404                     ((> (min image-height
    405                              edges-bot)
    406                         (+ image-top win-height))
    407                      (min (- image-height win-height)
    408                           (if eager-p
    409                               edges-top
    410                             (- edges-bot win-height)))))))
    411 
    412 
    413         (when vscroll
    414           (round
    415            ;; `image-set-window-vscroll' changed in version 27 to using
    416            ;; pixels, not lines.
    417            (if (version< emacs-version "27")
    418                (/ vscroll (float (frame-char-height)))
    419                vscroll)))))))
    420 
    421 (defun pdf-util-scroll-to-edges (edges &optional eager-p)
    422   "Scroll window such that image EDGES are visible.
    423 
    424 Scroll as little as necessary.  Unless EAGER-P is non-nil, in
    425 which case scroll as much as possible."
    426 
    427   (let ((vscroll (pdf-util-required-vscroll edges eager-p))
    428         (hscroll (pdf-util-required-hscroll edges eager-p)))
    429     (when vscroll
    430       (image-set-window-vscroll vscroll))
    431     (when hscroll
    432       (image-set-window-hscroll hscroll))))
    433 
    434 
    435 
    436 ;; * ================================================================== *
    437 ;; * Temporary files
    438 ;; * ================================================================== *
    439 
    440 (defvar pdf-util--base-directory nil
    441   "Base directory for temporary files.")
    442 
    443 (defvar-local pdf-util--dedicated-directory nil
    444   "The relative name of buffer's dedicated directory.")
    445 
    446 (defun pdf-util-dedicated-directory ()
    447   "Return the name of a existing dedicated directory.
    448 
    449 The directory is exclusive to the current buffer.  It will be
    450 automatically deleted, if Emacs or the current buffer are
    451 killed."
    452   (with-file-modes #o0700
    453     (unless (and pdf-util--base-directory
    454                  (file-directory-p
    455                   pdf-util--base-directory)
    456                  (not (file-symlink-p
    457                        pdf-util--base-directory)))
    458       (add-hook 'kill-emacs-hook
    459                 (lambda nil
    460                   (when (and pdf-util--base-directory
    461                              (file-directory-p pdf-util--base-directory))
    462                     (delete-directory pdf-util--base-directory t))))
    463       (setq pdf-util--base-directory
    464             (make-temp-file "pdf-tools-" t)))
    465     (unless (and pdf-util--dedicated-directory
    466                  (file-directory-p pdf-util--dedicated-directory)
    467                  (not (file-symlink-p
    468                        pdf-util--base-directory)))
    469       (let ((temporary-file-directory
    470              pdf-util--base-directory))
    471         (setq pdf-util--dedicated-directory
    472               (make-temp-file (convert-standard-filename (pdf-util-temp-prefix))
    473                               t))
    474         (add-hook 'kill-buffer-hook #'pdf-util-delete-dedicated-directory
    475                   nil t)))
    476     pdf-util--dedicated-directory))
    477 
    478 (defun pdf-util-delete-dedicated-directory ()
    479   "Delete current buffer's dedicated directory."
    480   (delete-directory (pdf-util-dedicated-directory) t))
    481 
    482 (defun pdf-util-expand-file-name (name)
    483   "Expand filename against current buffer's dedicated directory."
    484   (expand-file-name name (pdf-util-dedicated-directory)))
    485 
    486 (defun pdf-util-temp-prefix ()
    487   "Create a temp-file prefix for the current buffer"
    488   (concat (if buffer-file-name
    489               (file-name-nondirectory buffer-file-name)
    490             (replace-regexp-in-string "[^[:alnum:]]+" "-" (buffer-name)))
    491           "-"))
    492 
    493 (defun pdf-util-make-temp-file (&optional prefix dir-flag suffix)
    494   "Create a temporary file in current buffer's dedicated directory.
    495 
    496 See `make-temp-file' for the arguments."
    497   (let ((temporary-file-directory (pdf-util-dedicated-directory)))
    498     (make-temp-file (convert-standard-filename
    499                      (or prefix (pdf-util-temp-prefix)))
    500                     dir-flag suffix)))
    501 
    502 
    503 ;; * ================================================================== *
    504 ;; * Various
    505 ;; * ================================================================== *
    506 
    507 (defmacro pdf-util-debug (&rest body)
    508   "Execute BODY only if debugging is enabled."
    509   (declare (indent 0) (debug t))
    510   `(when (bound-and-true-p pdf-tools-debug)
    511      ,@body))
    512 
    513 (defun pdf-util-pdf-buffer-p (&optional buffer)
    514   (and (or (null buffer)
    515            (buffer-live-p buffer))
    516        (save-current-buffer
    517          (and buffer (set-buffer buffer))
    518          (derived-mode-p 'pdf-view-mode))))
    519 
    520 (defun pdf-util-assert-pdf-buffer (&optional buffer)
    521   (unless (pdf-util-pdf-buffer-p buffer)
    522     (error "Buffer is not in PDFView mode")))
    523 
    524 (defun pdf-util-pdf-window-p (&optional window)
    525   (unless (or (null window)
    526               (window-live-p window))
    527     (signal 'wrong-type-argument (list 'window-live-p window)))
    528   (unless window (setq window (selected-window)))
    529   (and (window-live-p window)
    530        (with-selected-window window
    531          (pdf-util-pdf-buffer-p))))
    532 
    533 (defun pdf-util-assert-pdf-window (&optional window)
    534   (unless (pdf-util-pdf-window-p window)
    535     (error "Window's buffer is not in PdfView mode")))
    536 
    537 (defun pdf-util-munch-file (filename &optional multibyte-p)
    538   "Read contents from FILENAME and delete it.
    539 
    540 Return the file's content as a unibyte string, unless MULTIBYTE-P
    541 is non-nil."
    542   (unwind-protect
    543       (with-temp-buffer
    544         (set-buffer-multibyte multibyte-p)
    545         (insert-file-contents-literally filename)
    546         (buffer-substring-no-properties
    547          (point-min)
    548          (point-max)))
    549     (when (and filename
    550                (file-exists-p filename))
    551       (delete-file filename))))
    552 
    553 (defun pdf-util-hexcolor (color)
    554   "Return COLOR in hex-format.
    555 
    556 Signal an error, if color is invalid."
    557   (if (string-match "\\`#[[:xdigit:]]\\{6\\}\\'" color)
    558       color
    559     (let ((values (color-values color)))
    560       (unless values
    561         (signal 'wrong-type-argument (list 'color-defined-p color)))
    562       (apply #'format "#%02x%02x%02x"
    563              (mapcar (lambda (c) (ash c -8))
    564                      values)))))
    565 
    566 (defun pdf-util-highlight-regexp-in-string (regexp string &optional face)
    567   "Highlight all occurrences of REGEXP in STRING using FACE.
    568 
    569 FACE defaults to the `match' face.  Returns the new fontified
    570 string."
    571   (with-temp-buffer
    572     (save-excursion (insert string))
    573     (while (and (not (eobp))
    574                 (re-search-forward regexp nil t))
    575       (if (= (match-beginning 0)
    576              (match-end 0))
    577           (forward-char)
    578         (put-text-property
    579          (match-beginning 0)
    580          (point)
    581          'face (or face 'match))))
    582     (buffer-string)))
    583 
    584 (autoload 'list-colors-duplicates "facemenu")
    585 
    586 (defun pdf-util-color-completions ()
    587   "Return a fontified list of defined colors."
    588   (let ((color-list (list-colors-duplicates))
    589         colors)
    590     (dolist (cl color-list)
    591       (dolist (c (reverse cl))
    592         (push (propertize c 'face `(:background ,c))
    593               colors)))
    594     (nreverse colors)))
    595 
    596 (defun pdf-util-tooltip-in-window (text x y &optional window)
    597   (let* ((we (window-inside-absolute-pixel-edges window))
    598          (dx (round (+ x (nth 0 we))))
    599          (dy (round (+ y (nth 1 we))))
    600          (tooltip-frame-parameters
    601           `((left . ,dx)
    602             (top . ,dy)
    603             ,@tooltip-frame-parameters)))
    604     (tooltip-show text)))
    605 
    606 ;; FIXME: Defined in `pdf-view' but we can't require it here because it
    607 ;; requires us :-(
    608 (defvar pdf-view-midnight-colors)
    609 
    610 (defun pdf-util-tooltip-arrow (image-top &optional timeout)
    611   (pdf-util-assert-pdf-window)
    612   (when (floatp image-top)
    613     (setq image-top
    614           (round (* image-top (cdr (pdf-view-image-size))))))
    615   (let* (x-gtk-use-system-tooltips ;allow for display property in tooltip
    616          (dx (+ (or (car (window-margins)) 0)
    617                 (car (window-fringes))))
    618          (dy image-top)
    619          (pos (list dx dy dx (+ dy (* 2 (frame-char-height)))))
    620          (vscroll
    621           (pdf-util-required-vscroll pos))
    622          (tooltip-frame-parameters
    623           `((border-width . 0)
    624             (internal-border-width . 0)
    625             ,@tooltip-frame-parameters))
    626          (tooltip-hide-delay (or timeout 3)))
    627     (when vscroll
    628       (image-set-window-vscroll vscroll))
    629     (setq dy (max 0 (- dy
    630                        (cdr (pdf-view-image-offset))
    631                        (window-vscroll nil t)
    632                        (frame-char-height))))
    633     (when (overlay-get (pdf-view-current-overlay) 'before-string)
    634       (let* ((e (window-inside-pixel-edges))
    635              (xw (pdf-util-with-edges (e) e-width)))
    636         (cl-incf dx (/ (- xw (car (pdf-view-image-size t))) 2))))
    637     (pdf-util-tooltip-in-window
    638      (propertize
    639       " " 'display (propertize
    640                     "\u2192" ;;right arrow
    641                     'display '(height 2)
    642                     'face `(:foreground
    643                             "orange red"
    644                             :background
    645                             ,(cond
    646                               ((bound-and-true-p pdf-view-midnight-minor-mode)
    647                                (cdr pdf-view-midnight-colors))
    648                               ((bound-and-true-p pdf-view-themed-minor-mode)
    649                                (face-background 'default nil))
    650                               (t "white")))))
    651      dx dy)))
    652 
    653 (defvar pdf-util--face-colors-cache (make-hash-table))
    654 
    655 (advice-add 'enable-theme :after #'pdf-util--clear-faces-cache)
    656 (defun pdf-util--clear-faces-cache (&rest _)
    657   (clrhash pdf-util--face-colors-cache))
    658 
    659 (defun pdf-util-face-colors (face &optional dark-p)
    660   "Return both colors of FACE as a cons.
    661 
    662 Look also in inherited faces.  If DARK-P is non-nil, return dark
    663 colors, otherwise light."
    664   (let* ((bg (if dark-p 'dark 'light))
    665          (spec (list (get face 'face-defface-spec)
    666                      (get face 'theme-face)
    667                      (get face 'customized-face)))
    668          (cached (gethash face pdf-util--face-colors-cache)))
    669     (cl-destructuring-bind (&optional cspec color-alist)
    670         cached
    671       (or (and color-alist
    672                (equal cspec spec)
    673                (cdr (assq bg color-alist)))
    674           (let* ((this-bg (frame-parameter nil 'background-mode))
    675                  (frame-background-mode bg)
    676                  (f (and (not (eq bg this-bg))
    677                          (x-create-frame-with-faces '((visibility . nil))))))
    678             (with-selected-frame (or f (selected-frame))
    679               (unwind-protect
    680                   (let ((colors
    681                          (cons (face-attribute face :foreground nil 'default)
    682                                (face-attribute face :background nil 'default))))
    683                     (puthash face `(,(mapcar #'copy-sequence spec)
    684                                     ((,bg . ,colors) ,@color-alist))
    685                              pdf-util--face-colors-cache)
    686                     colors)
    687                 (when (and f (frame-live-p f))
    688                   (delete-frame f)))))))))
    689 
    690 (defun pdf-util-window-attach (awindow &optional window)
    691   "Attach AWINDOW to WINDOW.
    692 
    693 This has the following effect.  Whenever WINDOW, defaulting to
    694 the selected window, stops displaying the buffer it currently
    695 displays (e.g., by switching buffers or because it was deleted)
    696 AWINDOW is deleted."
    697   (unless window (setq window (selected-window)))
    698   (let ((buffer (window-buffer window))
    699         (hook (make-symbol "window-attach-hook")))
    700     (fset hook
    701           (lambda ()
    702             (when (or (not (window-live-p window))
    703                       (not (eq buffer (window-buffer window))))
    704               (remove-hook 'window-configuration-change-hook
    705                            hook)
    706               ;; Deleting windows inside wcch may cause errors in
    707               ;; windows.el .
    708               (run-with-timer
    709                0 nil (lambda (win)
    710                        (when (and (window-live-p win)
    711                                   (not (eq win (selected-window))))
    712                          (delete-window win)))
    713                awindow))))
    714     (add-hook 'window-configuration-change-hook hook)))
    715 
    716 (defun display-buffer-split-below-and-attach (buf alist)
    717   "Display buffer action using `pdf-util-window-attach'."
    718   (let ((window (selected-window))
    719         (height (cdr (assq 'window-height alist)))
    720         newwin)
    721     (when height
    722       (when (floatp height)
    723         (setq height (round (* height (frame-height)))))
    724       (setq height (- (max height window-min-height))))
    725     (setq newwin (window--display-buffer
    726                   buf
    727                   (split-window-below height)
    728                   'window alist))
    729     (pdf-util-window-attach newwin window)
    730     newwin))
    731 
    732 (defun pdf-util-goto-position (line &optional column)
    733   "Goto LINE and COLUMN in the current buffer.
    734 
    735 COLUMN defaults to 0.  Widen the buffer, if the position is
    736 outside the current limits."
    737   (let ((pos
    738          (when (> line 0)
    739            (save-excursion
    740              (save-restriction
    741                (widen)
    742                (goto-char 1)
    743                (when (= 0 (forward-line (1- line)))
    744                  (when (and column (> column 0))
    745                    (forward-char (1- column)))
    746                  (point)))))))
    747     (when pos
    748       (when (or (< pos (point-min))
    749                 (> pos (point-max)))
    750         (widen))
    751       (goto-char pos))))
    752 
    753 (defun pdf-util-seq-alignment (seq1 seq2 &optional similarity-fn alignment-type)
    754   "Return an alignment of sequences SEQ1 and SEQ2.
    755 
    756 SIMILARITY-FN should be a function. It is called with two
    757 arguments: One element from SEQ1 and one from SEQ2.  It should
    758 return a number determining how similar the elements are, where
    759 higher values mean `more similar'.  The default returns 1 if the
    760 elements are equal, else -1.
    761 
    762 ALIGNMENT-TYPE may be one of the symbols `prefix', `suffix',
    763 `infix' or nil.  If it is `prefix', trailing elements in SEQ2 may
    764 be ignored. For example the alignment of
    765 
    766 \(0 1\) and \(0 1 2\)
    767 
    768 using prefix matching is 0, since the prefixes are equal and the
    769 trailing 2 is ignored.  The other possible values have similar
    770 effects.  The default is nil, which means to match the whole
    771 sequences.
    772 
    773 Return a cons \(VALUE . ALIGNMENT\), where VALUE says how similar
    774 the sequences are and ALIGNMENT is a list of \(E1 . E2\), where
    775 E1 is an element from SEQ1 or nil, likewise for E2.  If one of
    776 them is nil, it means there is gap at this position in the
    777 respective sequence."
    778 
    779   (cl-macrolet ((make-matrix (rows columns)
    780                   `(apply #'vector
    781                           (cl-loop for i from 1 to ,rows
    782                                    collect (make-vector ,columns nil))))
    783                 (mset (matrix row column newelt)
    784                   `(aset (aref ,matrix ,row) ,column ,newelt))
    785                 (mref (matrix row column)
    786                   `(aref (aref ,matrix ,row) ,column)))
    787     (let* ((len1 (length seq1))
    788            (len2 (length seq2))
    789            (d (make-matrix (1+ len1) (1+ len2)))
    790            (prefix-p (memq alignment-type '(prefix infix)))
    791            (suffix-p (memq alignment-type '(suffix infix)))
    792            (similarity-fn (or similarity-fn
    793                               (lambda (a b)
    794                                 (if (equal a b) 1 -1)))))
    795 
    796       (cl-loop for i from 0 to len1 do
    797         (mset d i 0 (- i)))
    798       (cl-loop for j from 0 to len2 do
    799         (mset d 0 j (if suffix-p 0 (- j))))
    800 
    801       (cl-loop for i from 1 to len1 do
    802         (cl-loop for j from 1 to len2 do
    803           (let ((max (max
    804                       (1- (mref d (1- i) j))
    805                       (+ (mref d i (1- j))
    806                          (if (and prefix-p (= i len1)) 0 -1))
    807                       (+ (mref d (1- i) (1- j))
    808                          (funcall similarity-fn
    809                                   (elt seq1 (1- i))
    810                                   (elt seq2 (1- j)))))))
    811             (mset d i j max))))
    812 
    813       (let ((i len1)
    814             (j len2)
    815             alignment)
    816         (while (or (> i 0)
    817                    (> j 0))
    818           (cond
    819            ((and (> i 0)
    820                  (= (mref d i j)
    821                     (1- (mref d (1- i) j))))
    822             (cl-decf i)
    823             (push (cons (elt seq1 i) nil) alignment))
    824            ((and (> j 0)
    825                  (= (mref d i j)
    826                     (+ (mref d i (1- j))
    827                        (if (or (and (= i 0) suffix-p)
    828                                (and (= i len1) prefix-p))
    829                            0 -1))))
    830             (cl-decf j)
    831             (push (cons nil (elt seq2 j)) alignment))
    832            (t
    833             (cl-assert (and (> i 0) (> j 0)) t)
    834             (cl-decf i)
    835             (cl-decf j)
    836             (push (cons (elt seq1 i)
    837                         (elt seq2 j))
    838                   alignment))))
    839         (cons (mref d len1 len2) alignment)))))
    840 
    841 
    842 (defun pdf-util-pcre-quote (string)
    843   "Escape STRING for use as a PCRE.
    844 
    845 See also `regexp-quote'."
    846 
    847   (let ((to-escape
    848          (eval-when-compile (append "\0\\|()[]{}^$*+?." nil)))
    849         (chars (append string nil))
    850         escaped)
    851     (dolist (ch chars)
    852       (when (memq ch to-escape)
    853         (push ?\\ escaped))
    854       (push ch escaped))
    855     (apply #'string (nreverse escaped))))
    856 
    857 (defun pdf-util-frame-ppi ()
    858   "Return the PPI of the current frame."
    859   (condition-case nil
    860       (let* ((props (frame-monitor-attributes))
    861              (px (nthcdr 2 (alist-get 'geometry props)))
    862              (mm (alist-get 'mm-size props))
    863              (dp (sqrt (+ (expt (nth 0 px) 2)
    864                           (expt (nth 1 px) 2))))
    865              (di (sqrt (+ (expt (/ (nth 0 mm) 25.4) 2)
    866                           (expt (/ (nth 1 mm) 25.4) 2)))))
    867         (/ dp di))
    868     ;; Calculating frame-ppi failed, return 0 to indicate unknown.
    869     ;; This can happen when (frame-monitor-attributes) does not have
    870     ;; the right properties (Emacs 26, 27). It leads to the
    871     ;; wrong-type-argument error, which is the only one we are
    872     ;; catching here. We will catch more errors only if we see them
    873     ;; happening.
    874     (wrong-type-argument 0)))
    875 
    876 (defvar pdf-view-use-scaling)
    877 
    878 (defun pdf-util-frame-scale-factor ()
    879   "Return the frame scale factor depending on the image type used for display.
    880 When `pdf-view-use-scaling' is non-nil, return the scale factor of the frame
    881 if available. If the scale factor isn't available, return 2 if the
    882 frame's PPI is larger than 180. Otherwise, return 1."
    883   (if pdf-view-use-scaling
    884       (or (and (fboundp 'frame-scale-factor)
    885                (truncate (frame-scale-factor)))
    886           (and (fboundp 'frame-monitor-attributes)
    887                (cdr (assq 'backing-scale-factor (frame-monitor-attributes))))
    888           (if (>= (pdf-util-frame-ppi) 180)
    889               2
    890             1))
    891     1))
    892 
    893 
    894 ;; * ================================================================== *
    895 ;; * Imagemagick's convert
    896 ;; * ================================================================== *
    897 
    898 (defcustom pdf-util-convert-program
    899   ;; Avoid using the MS Windows command convert.exe .
    900   (unless (memq system-type '(ms-dos windows-nt))
    901     (executable-find "convert"))
    902   "Absolute path to the convert program."
    903   :group 'pdf-tools
    904   :type 'executable)
    905 
    906 (defcustom pdf-util-fast-image-format nil
    907   "An image format appropriate for fast displaying.
    908 
    909 This should be a cons \(TYPE . EXT\) where type is the Emacs
    910 image-type and EXT the appropriate file extension starting with a
    911 dot. If nil, the value is determined automatically.
    912 
    913 Different formats have different properties, with respect to
    914 Emacs loading time, convert creation time and the file-size.  In
    915 general, uncompressed formats are faster, but may need a fair
    916 amount of (temporary) disk space."
    917   :group 'pdf-tools
    918   :type '(cons symbol string))
    919 
    920 (defun pdf-util-assert-convert-program ()
    921   (unless (and pdf-util-convert-program
    922                (file-executable-p pdf-util-convert-program))
    923     (error "The pdf-util-convert-program is unset or non-executable")))
    924 
    925 (defun pdf-util-image-file-size (image-file)
    926   "Determine the size of the image in IMAGE-FILE.
    927 
    928 Returns a cons \(WIDTH . HEIGHT\)."
    929   (pdf-util-assert-convert-program)
    930   (with-temp-buffer
    931     (when (save-excursion
    932             (= 0 (call-process
    933                   pdf-util-convert-program
    934                   nil (current-buffer) nil
    935                   image-file "-format" "%w %h" "info:")))
    936       (let ((standard-input (current-buffer)))
    937         (cons (read) (read))))))
    938 
    939 (defun pdf-util-convert (in-file out-file &rest spec)
    940   "Convert image IN-FILE to OUT-FILE according to SPEC.
    941 
    942 IN-FILE should be the name of a file containing an image.  Write
    943 the result to OUT-FILE.  The extension of this filename usually
    944 determines the resulting image-type.
    945 
    946 SPEC is a property list, specifying what the convert program
    947 should do with the image.  All manipulations operate on a
    948 rectangle, see below.
    949 
    950 SPEC may contain the following keys, respectively values.
    951 
    952 `:foreground' Set foreground color for all following operations.
    953 
    954 `:background' Dito, for the background color.
    955 
    956 `:commands' A list of strings representing arguments to convert
    957 for image manipulations.  It may contain %-escape characters, as
    958 follows.
    959 
    960 %f -- Expands to the foreground color.
    961 %b -- Expands to the background color.
    962 %g -- Expands to the geometry of the current rectangle, i.e. WxH+X+Y.
    963 %x -- Expands to the left edge of rectangle.
    964 %X -- Expands to the right edge of rectangle.
    965 %y -- Expands to the top edge of rectangle.
    966 %Y -- Expands to the bottom edge of rectangle.
    967 %w -- Expands to the width of rectangle.
    968 %h -- Expands to the height of rectangle.
    969 
    970 Keep in mind, that every element of this list is seen by convert
    971 as a single argument.
    972 
    973 `:formats' An alist of additional %-escapes.  Every element
    974 should be a cons \(CHAR . STRING\) or \(CHAR . FUNCTION\).  In
    975 the first case, all occurrences of %-CHAR in the above commands
    976 will be replaced by STRING.  In the second case FUNCTION is
    977 called with the current rectangle and it should return the
    978 replacement string.
    979 
    980 `:apply' A list of rectangles \(\(LEFT TOP RIGHT BOT\) ...\) in
    981 IN-FILE coordinates. Each such rectangle triggers one execution
    982 of the last commands given earlier in SPEC. E.g. a call like
    983 
    984   (pdf-util-convert
    985    image-file out-file
    986    :foreground \"black\"
    987    :background \"white\"
    988    :commands \\='(\"-fill\" \"%f\" \"-draw\" \"rectangle %x,%y,%X,%Y\")
    989    :apply \\='((0 0 10 10) (10 10 20 20))
    990    :commands \\='(\"-fill\" \"%b\" \"-draw\" \"rectangle %x,%y,%X,%Y\")
    991    :apply \\='((10 0 20 10) (0 10 10 20)))
    992 
    993 would draw a 4x4 checkerboard pattern in the left corner of the
    994 image, while leaving the rest of it as it was.
    995 
    996 Returns OUT-FILE.
    997 
    998 See url `http://www.imagemagick.org/script/convert.php'."
    999   (pdf-util-assert-convert-program)
   1000   (let* ((cmds (pdf-util-convert--create-commands spec))
   1001          (status (apply #'call-process
   1002                         pdf-util-convert-program nil
   1003                         (get-buffer-create "*pdf-util-convert-output*")
   1004                         nil
   1005                         `(,in-file ,@cmds ,out-file))))
   1006     (unless (and (numberp status) (= 0 status))
   1007       (error "The convert program exited with error status: %s" status))
   1008     out-file))
   1009 
   1010 (defun pdf-util-convert-asynch (in-file out-file &rest spec-and-callback)
   1011   "Like `pdf-util-convert', but asynchronous.
   1012 
   1013 If the last argument is a function, it is installed as the
   1014 process sentinel.
   1015 
   1016 Returns the convert process."
   1017   (pdf-util-assert-convert-program)
   1018   (let ((callback (car (last spec-and-callback)))
   1019         spec)
   1020     (if (functionp callback)
   1021         (setq spec (butlast spec-and-callback))
   1022       (setq spec spec-and-callback
   1023             callback nil))
   1024     (let* ((cmds (pdf-util-convert--create-commands spec))
   1025            (proc
   1026             (apply #'start-process "pdf-util-convert"
   1027                    (get-buffer-create "*pdf-util-convert-output*")
   1028                    pdf-util-convert-program
   1029                    `(,in-file ,@cmds ,out-file))))
   1030       (when callback
   1031         (set-process-sentinel proc callback))
   1032       proc)))
   1033 
   1034 (defun pdf-util-convert-page (&rest specs)
   1035   "Convert image of current page according to SPECS.
   1036 
   1037 Return the converted PNG image as a string.  See also
   1038 `pdf-util-convert'."
   1039 
   1040   (pdf-util-assert-pdf-window)
   1041   (let ((in-file (make-temp-file "pdf-util-convert" nil ".png"))
   1042         (out-file (make-temp-file "pdf-util-convert" nil ".png")))
   1043     (unwind-protect
   1044         (let ((image-data
   1045                (plist-get (cdr (pdf-view-current-image)) :data)))
   1046           (with-temp-file in-file
   1047             (set-buffer-multibyte nil)
   1048             (set-buffer-file-coding-system 'binary)
   1049             (insert image-data))
   1050           (pdf-util-munch-file
   1051            (apply #'pdf-util-convert
   1052                   in-file out-file specs)))
   1053       (when (file-exists-p in-file)
   1054         (delete-file in-file))
   1055       (when (file-exists-p out-file)
   1056         (delete-file out-file)))))
   1057 
   1058 
   1059 (defun pdf-util-convert--create-commands (spec)
   1060   (let ((fg "red")
   1061         (bg "red")
   1062         formats result cmds s)
   1063     (while (setq s (pop spec))
   1064       (unless spec
   1065         (error "Missing value in convert spec:%s" (cons s spec)))
   1066       (cl-case s
   1067         (:foreground
   1068          (setq fg (pop spec)))
   1069         (:background
   1070          (setq bg (pop spec)))
   1071         (:commands
   1072          (setq cmds (pop spec)))
   1073         (:formats
   1074          (setq formats (append formats (pop spec) nil)))
   1075         (:apply
   1076          (dolist (m (pop spec))
   1077            (pdf-util-with-edges (m)
   1078              (let ((alist (append
   1079                            (mapcar (lambda (f)
   1080                                      (cons (car f)
   1081                                            (if (stringp (cdr f))
   1082                                                (cdr f)
   1083                                              (funcall (cdr f) m))))
   1084                                    formats)
   1085                            `((?g . ,(format "%dx%d+%d+%d"
   1086                                             m-width m-height
   1087                                             m-left m-top))
   1088                              (?x . ,m-left)
   1089                              (?X . ,m-right)
   1090                              (?y . ,m-top)
   1091                              (?Y . ,m-bot)
   1092                              (?w . ,(- m-right m-left))
   1093                              (?h . ,(- m-bot m-top))
   1094                              (?f . ,fg)
   1095                              (?b . ,bg)))))
   1096                (dolist (fmt cmds)
   1097                  (push (format-spec fmt alist) result))))))))
   1098     (nreverse result)))
   1099 
   1100 ;; FIXME: Check code below and document.
   1101 
   1102 (defun pdf-util-edges-p (obj &optional relative-p)
   1103   "Return non-nil, if OBJ look like edges.
   1104 
   1105 If RELATIVE-P is non-nil, also check that all values <= 1."
   1106 
   1107   (and (consp obj)
   1108        (ignore-errors (= 4 (length obj)))
   1109        (cl-every (lambda (x)
   1110                    (and (numberp x)
   1111                         (>= x 0)
   1112                         (or (null relative-p)
   1113                             (<= x 1))))
   1114                  obj)))
   1115 
   1116 (defun pdf-util-edges-empty-p (edges)
   1117   "Return non-nil, if EDGES area is empty."
   1118   (pdf-util-with-edges (edges)
   1119     (or (<= edges-width 0)
   1120         (<= edges-height 0))))
   1121 
   1122 (defun pdf-util-edges-inside-p (edges pos &optional epsilon)
   1123   (pdf-util-edges-contained-p
   1124    edges
   1125    (list (car pos) (cdr pos) (car pos) (cdr pos))
   1126    epsilon))
   1127 
   1128 (defun pdf-util-edges-contained-p (edges contained &optional epsilon)
   1129   (unless epsilon (setq epsilon 0))
   1130   (pdf-util-with-edges (edges contained)
   1131     (and (<= (- edges-left epsilon)
   1132              contained-left)
   1133          (>= (+ edges-right epsilon)
   1134              contained-right)
   1135          (<= (- edges-top epsilon)
   1136              contained-top)
   1137          (>= (+ edges-bot epsilon)
   1138              contained-bot))))
   1139 
   1140 (defun pdf-util-edges-intersection (e1 e2)
   1141   (pdf-util-with-edges (edges1 e1 e2)
   1142     (let ((left (max e1-left e2-left))
   1143           (top (max e1-top e2-top))
   1144           (right (min e1-right e2-right))
   1145           (bot (min e1-bot e2-bot)))
   1146       (when (and (<= left right)
   1147                  (<= top bot))
   1148         (list left top right bot)))))
   1149 
   1150 (defun pdf-util-edges-union (&rest edges)
   1151   (if (null (cdr edges))
   1152       (car edges)
   1153     (list (apply #'min (mapcar #'car edges))
   1154           (apply #'min (mapcar #'cadr edges))
   1155           (apply #'max (mapcar #'cl-caddr edges))
   1156           (apply #'max (mapcar #'cl-cadddr edges)))))
   1157 
   1158 (defun pdf-util-edges-intersection-area (e1 e2)
   1159   (let ((inters (pdf-util-edges-intersection e1 e2)))
   1160     (if (null inters)
   1161         0
   1162       (pdf-util-with-edges (inters)
   1163         (* inters-width inters-height)))))
   1164 
   1165 (defun pdf-util-read-image-position (prompt)
   1166   "Read a image position using prompt.
   1167 
   1168 Return the event position object."
   1169   (save-selected-window
   1170     (let ((ev (pdf-util-read-click-event
   1171                (propertize prompt 'face 'minibuffer-prompt)))
   1172           (buffer (current-buffer)))
   1173       (unless (mouse-event-p ev)
   1174         (error "Not a mouse event"))
   1175       (let ((posn (event-start ev)))
   1176         (unless (and (eq (window-buffer
   1177                           (posn-window posn))
   1178                          buffer)
   1179                      (eq 'image (car-safe (posn-object posn))))
   1180           (error "Invalid image position"))
   1181         posn))))
   1182 
   1183 (defun pdf-util-read-click-event (&optional prompt seconds)
   1184   (let ((down (read-event prompt seconds)))
   1185     (unless (and (mouse-event-p down)
   1186                  (equal (event-modifiers down)
   1187                         '(down)))
   1188       (error "No a mouse click event"))
   1189     (let ((up (read-event prompt seconds)))
   1190       (unless (and (mouse-event-p up)
   1191                    (equal (event-modifiers up)
   1192                           '(click)))
   1193         (error "No a mouse click event"))
   1194       up)))
   1195 
   1196 (defun pdf-util-image-map-mouse-event-proxy (event)
   1197   "Set POS-OR-AREA in EVENT to 1 and unread it."
   1198   (interactive "e")
   1199   (setcar (cdr (cadr event)) 1)
   1200   (setq unread-command-events (list event)))
   1201 
   1202 (defun pdf-util-image-map-divert-mouse-clicks (id &optional buttons)
   1203   (dolist (kind '("" "down-" "drag-"))
   1204     (dolist (b (or buttons '(2 3 4 5 6)))
   1205       (local-set-key
   1206        (vector id (intern (format "%smouse-%d" kind b)))
   1207        'pdf-util-image-map-mouse-event-proxy))))
   1208 
   1209 (defmacro pdf-util-do-events (event-resolution-unread-p condition &rest body)
   1210   "Read EVENTs while CONDITION executing BODY.
   1211 
   1212 Process at most 1/RESOLUTION events per second.  If UNREAD-p is
   1213 non-nil, unread the final non-processed event.
   1214 
   1215 \(FN (EVENT RESOLUTION &optional UNREAD-p) CONDITION &rest BODY\)"
   1216   (declare (indent 2) (debug ((symbolp form &optional form) form body)))
   1217   (cl-destructuring-bind (event resolution &optional unread-p)
   1218       event-resolution-unread-p
   1219     (let ((*seconds (make-symbol "seconds"))
   1220           (*timestamp (make-symbol "timestamp"))
   1221           (*clock (make-symbol "clock"))
   1222           (*unread-p (make-symbol "unread-p"))
   1223           (*resolution (make-symbol "resolution")))
   1224       `(let* ((,*unread-p ,unread-p)
   1225               (,*resolution ,resolution)
   1226               (,*seconds 0)
   1227               (,*timestamp (float-time))
   1228               (,*clock (lambda (&optional secs)
   1229                          (when secs
   1230                            (setq ,*seconds secs
   1231                                  ,*timestamp (float-time)))
   1232                          (- (+ ,*timestamp ,*seconds)
   1233                             (float-time))))
   1234               (,event (read-event)))
   1235          (while ,condition
   1236            (when (<= (funcall ,*clock) 0)
   1237              (progn ,@body)
   1238              (setq ,event nil)
   1239              (funcall ,*clock ,*resolution))
   1240            (setq ,event
   1241                  (or (read-event nil nil
   1242                                  (and ,event
   1243                                       (max 0 (funcall ,*clock))))
   1244                      ,event)))
   1245          (when (and ,*unread-p ,event)
   1246            (setq unread-command-events
   1247                  (append unread-command-events
   1248                          (list ,event))))))))
   1249 
   1250 (defmacro pdf-util-track-mouse-dragging (event-resolution &rest body)
   1251   "Read mouse movement events executing BODY.
   1252 
   1253 See also `pdf-util-do-events'.
   1254 
   1255 This macro should be used inside a command bound to a down-mouse
   1256 event.  It evaluates to t, if at least one event was processed in
   1257 BODY, otherwise nil.  In the latter case, the only event (usually
   1258 a mouse click event) is unread.
   1259 
   1260 \(FN (EVENT RESOLUTION) &rest BODY\)"
   1261   (declare (indent 1) (debug ((symbolp form) body)))
   1262   (let ((ran-once-p (make-symbol "ran-once-p")))
   1263     `(let (,ran-once-p)
   1264        (track-mouse
   1265          (pdf-util-do-events (,@event-resolution t)
   1266              (mouse-movement-p ,(car event-resolution))
   1267            (setq ,ran-once-p t)
   1268            ,@body))
   1269        (when (and ,ran-once-p
   1270                   unread-command-events)
   1271          (setq unread-command-events
   1272                (butlast unread-command-events)))
   1273        ,ran-once-p)))
   1274 
   1275 (defun pdf-util-remove-duplicates (list)
   1276   "Remove duplicates from LIST stably using `equal'."
   1277   (let ((ht (make-hash-table :test 'equal))
   1278         result)
   1279     (dolist (elt list (nreverse result))
   1280       (unless (gethash elt ht)
   1281         (push elt result)
   1282         (puthash elt t ht)))))
   1283 
   1284 (provide 'pdf-util)
   1285 
   1286 ;;; pdf-util.el ends here