Klimi's new dotfiles with stow.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

1346 regels
50 KiB

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