pdf-links.el (13776B)
1 ;;; pdf-links.el --- Handle PDF links. -*- 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 24 (require 'pdf-info) 25 (require 'pdf-util) 26 (require 'pdf-misc) 27 (require 'pdf-cache) 28 (require 'pdf-isearch) 29 (require 'let-alist) 30 (require 'org) 31 32 ;;; Code: 33 34 35 36 ;; * ================================================================== * 37 ;; * Customizations 38 ;; * ================================================================== * 39 40 (defgroup pdf-links nil 41 "Following links in PDF documents." 42 :group 'pdf-tools) 43 44 (defface pdf-links-read-link 45 '((((background dark)) (:background "red" :foreground "yellow")) 46 (((background light)) (:background "red" :foreground "yellow"))) 47 "Face used to determine the colors when reading links." 48 ;; :group 'pdf-links 49 :group 'pdf-tools-faces) 50 51 (defcustom pdf-links-read-link-convert-commands 52 '(;;"-font" "FreeMono" 53 "-pointsize" "%P" 54 "-undercolor" "%f" 55 "-fill" "%b" 56 "-draw" "text %X,%Y '%c'") 57 58 "The commands for the convert program, when decorating links for reading. 59 See `pdf-util-convert' for an explanation of the format. 60 61 Aside from the description there, two additional escape chars are 62 available. 63 64 %P -- The scaled font pointsize, i.e. IMAGE-WIDTH * SCALE (See 65 `pdf-links-convert-pointsize-scale'). 66 %c -- String describing the current link key (e.g. AA, AB, 67 etc.)." 68 :group 'pdf-links 69 :type '(repeat string) 70 :link '(variable-link pdf-isearch-convert-commands) 71 :link '(url-link "http://www.imagemagick.org/script/convert.php")) 72 73 (defcustom pdf-links-convert-pointsize-scale 0.01 74 "The scale factor for the -pointsize convert command. 75 76 This determines the relative size of the font, when interactively 77 reading links." 78 :group 'pdf-links 79 :type '(restricted-sexp :match-alternatives 80 ((lambda (x) (and (numberp x) 81 (<= x 1) 82 (>= x 0)))))) 83 84 (defcustom pdf-links-browse-uri-function 85 'pdf-links-browse-uri-default 86 "The function for handling uri links. 87 88 This function should accept one argument, the URI to follow, and 89 do something with it." 90 :group 'pdf-links 91 :type 'function) 92 93 94 ;; * ================================================================== * 95 ;; * Minor Mode 96 ;; * ================================================================== * 97 98 (defvar pdf-links-minor-mode-map 99 (let ((kmap (make-sparse-keymap))) 100 (define-key kmap (kbd "f") 'pdf-links-isearch-link) 101 (define-key kmap (kbd "F") 'pdf-links-action-perform) 102 kmap)) 103 104 ;;;###autoload 105 (define-minor-mode pdf-links-minor-mode 106 "Handle links in PDF documents.\\<pdf-links-minor-mode-map> 107 108 If this mode is enabled, most links in the document may be 109 activated by clicking on them or by pressing \\[pdf-links-action-perform] and selecting 110 one of the displayed keys, or by using isearch limited to 111 links via \\[pdf-links-isearch-link]. 112 113 \\{pdf-links-minor-mode-map}" 114 :group 'pdf-links 115 (pdf-util-assert-pdf-buffer) 116 (cond 117 (pdf-links-minor-mode 118 (pdf-view-add-hotspot-function 'pdf-links-hotspots-function 0)) 119 (t 120 (pdf-view-remove-hotspot-function 'pdf-links-hotspots-function))) 121 (pdf-view-redisplay t)) 122 123 (defun pdf-links-hotspots-function (page size) 124 "Create hotspots for links on PAGE using SIZE." 125 126 (let ((links (pdf-cache-pagelinks page)) 127 (id-fmt "link-%d-%d") 128 (i 0) 129 (pointer 'hand) 130 hotspots) 131 (dolist (l links) 132 (let ((e (pdf-util-scale 133 (cdr (assq 'edges l)) size 'round)) 134 (id (intern (format id-fmt page 135 (cl-incf i))))) 136 (push `((rect . ((,(nth 0 e) . ,(nth 1 e)) 137 . (,(nth 2 e) . ,(nth 3 e)))) 138 ,id 139 (pointer 140 ,pointer 141 help-echo ,(pdf-links-action-to-string l))) 142 hotspots) 143 (local-set-key 144 (vector id 'mouse-1) 145 (lambda nil 146 (interactive "@") 147 (pdf-links-action-perform l))) 148 (local-set-key 149 (vector id t) 150 'pdf-util-image-map-mouse-event-proxy))) 151 (nreverse hotspots))) 152 153 (defun pdf-links-action-to-string (link) 154 "Return a string representation of ACTION." 155 (let-alist link 156 (concat 157 (cl-case .type 158 (goto-dest 159 (if (> .page 0) 160 (format "Goto page %d" .page) 161 "Destination not found")) 162 (goto-remote 163 (if (and .filename (file-exists-p .filename)) 164 (format "Goto %sfile '%s'" 165 (if (> .page 0) 166 (format "p.%d of " .page) 167 "") 168 .filename) 169 (format "Link to nonexistent file '%s'" .filename))) 170 (uri 171 (if (> (length .uri) 0) 172 (format "Link to uri '%s'" .uri) 173 (format "Link to empty uri"))) 174 (t (format "Unrecognized link type: %s" .type))) 175 (if (> (length .title) 0) 176 (format " (%s)" .title))))) 177 178 ;;;###autoload 179 (defun pdf-links-action-perform (link) 180 "Follow LINK, depending on its type. 181 182 This may turn to another page, switch to another PDF buffer or 183 invoke `pdf-links-browse-uri-function'. 184 185 Interactively, link is read via `pdf-links-read-link-action'. 186 This function displays characters around the links in the current 187 page and starts reading characters (ignoring case). After a 188 sufficient number of characters have been read, the corresponding 189 link's link is invoked. Additionally, SPC may be used to 190 scroll the current page." 191 (interactive 192 (list (or (pdf-links-read-link-action "Activate link (SPC scrolls): ") 193 (error "No link selected")))) 194 (let-alist link 195 (cl-case .type 196 ((goto-dest goto-remote) 197 (let ((window (selected-window))) 198 (cl-case .type 199 (goto-dest 200 (unless (> .page 0) 201 (error "Link points to nowhere"))) 202 (goto-remote 203 (unless (and .filename (file-exists-p .filename)) 204 (error "Link points to nonexistent file %s" .filename)) 205 (setq window (display-buffer 206 (or (find-buffer-visiting .filename) 207 (find-file-noselect .filename)))))) 208 (with-selected-window window 209 (when (derived-mode-p 'pdf-view-mode) 210 (when (> .page 0) 211 (pdf-view-goto-page .page)) 212 (when .top 213 ;; Showing the tooltip delays displaying the page for 214 ;; some reason (sit-for/redisplay don't help), do it 215 ;; later. 216 (run-with-idle-timer 0.001 nil 217 (lambda () 218 (when (window-live-p window) 219 (with-selected-window window 220 (when (derived-mode-p 'pdf-view-mode) 221 (pdf-util-tooltip-arrow .top))))))))))) 222 (uri 223 (funcall pdf-links-browse-uri-function .uri)) 224 (t 225 (error "Unrecognized link type: %s" .type))) 226 nil)) 227 228 (defun pdf-links-read-link-action (prompt) 229 "Using PROMPT, interactively read a link-action. 230 231 See `pdf-links-action-perform' for the interface." 232 233 (pdf-util-assert-pdf-window) 234 (let* ((links (pdf-cache-pagelinks 235 (pdf-view-current-page))) 236 (keys (pdf-links-read-link-action--create-keys 237 (length links))) 238 (key-strings (mapcar (apply-partially 'apply 'string) 239 keys)) 240 (alist (cl-mapcar 'cons keys links)) 241 (size (pdf-view-image-size)) 242 (colors (pdf-util-face-colors 243 'pdf-links-read-link pdf-view-dark-minor-mode)) 244 (args (list 245 :foreground (car colors) 246 :background (cdr colors) 247 :formats 248 `((?c . ,(lambda (_edges) (pop key-strings))) 249 (?P . ,(number-to-string 250 (max 1 (* (cdr size) 251 pdf-links-convert-pointsize-scale))))) 252 :commands pdf-links-read-link-convert-commands 253 :apply (pdf-util-scale-relative-to-pixel 254 (mapcar (lambda (l) (cdr (assq 'edges l))) 255 links))))) 256 (unless links 257 (error "No links on this page")) 258 (unwind-protect 259 (let ((image-data 260 (pdf-cache-get-image 261 (pdf-view-current-page) 262 (car size) (car size) 'pdf-links-read-link-action))) 263 (unless image-data 264 (setq image-data (apply 'pdf-util-convert-page args )) 265 (pdf-cache-put-image 266 (pdf-view-current-page) 267 (car size) image-data 'pdf-links-read-link-action)) 268 (pdf-view-display-image 269 (create-image image-data (pdf-view-image-type) t)) 270 (pdf-links-read-link-action--read-chars prompt alist)) 271 (pdf-view-redisplay)))) 272 273 (defun pdf-links-read-link-action--read-chars (prompt alist) 274 (catch 'done 275 (let (key) 276 (while t 277 (let* ((chars (append (mapcar 'caar alist) 278 (mapcar 'downcase (mapcar 'caar alist)) 279 (list ?\s))) 280 (ch (read-char-choice prompt chars))) 281 (setq ch (upcase ch)) 282 (cond 283 ((= ch ?\s) 284 (when (= (window-vscroll) (image-scroll-up)) 285 (image-scroll-down (window-vscroll)))) 286 (t 287 (setq alist (delq nil (mapcar (lambda (elt) 288 (and (eq ch (caar elt)) 289 (cons (cdar elt) 290 (cdr elt)))) 291 alist)) 292 key (append key (list ch)) 293 prompt (concat prompt (list ch))) 294 (when (= (length alist) 1) 295 (message nil) 296 (throw 'done (cdar alist)))))))))) 297 298 (defun pdf-links-read-link-action--create-keys (n) 299 (when (> n 0) 300 (let ((len (1+ (floor (log n 26)))) 301 keys) 302 (dotimes (i n) 303 (let (key) 304 (dotimes (_x len) 305 (push (+ (% i 26) ?A) key) 306 (setq i (/ i 26))) 307 (push key keys))) 308 (nreverse keys)))) 309 310 (defun pdf-links-isearch-link () 311 (interactive) 312 (let* (quit-p 313 (isearch-mode-end-hook 314 (cons (lambda nil 315 (setq quit-p isearch-mode-end-hook-quit)) 316 isearch-mode-end-hook)) 317 (pdf-isearch-filter-matches-function 318 'pdf-links-isearch-link-filter-matches) 319 (pdf-isearch-narrow-to-page t) 320 (isearch-message-prefix-add "(Links)") 321 pdf-isearch-batch-mode) 322 (isearch-forward) 323 (unless (or quit-p (null pdf-isearch-current-match)) 324 (let* ((page (pdf-view-current-page)) 325 (match (car pdf-isearch-current-match)) 326 (size (pdf-view-image-size)) 327 (links (sort (cl-remove-if 328 (lambda (e) 329 (= 0 (pdf-util-edges-intersection-area (car e) match))) 330 (mapcar (lambda (l) 331 (cons (pdf-util-scale (alist-get 'edges l) size) 332 l)) 333 (pdf-cache-pagelinks page))) 334 (lambda (e1 e2) 335 (> (pdf-util-edges-intersection-area 336 (alist-get 'edges e1) match) 337 (pdf-util-edges-intersection-area 338 (alist-get 'edges e2) match)))))) 339 (unless links 340 (error "No link found at this position")) 341 (pdf-links-action-perform (car links)))))) 342 343 (defun pdf-links-isearch-link-filter-matches (matches) 344 (let ((links (pdf-util-scale 345 (mapcar (apply-partially 'alist-get 'edges) 346 (pdf-cache-pagelinks 347 (pdf-view-current-page))) 348 (pdf-view-image-size)))) 349 (cl-remove-if-not 350 (lambda (m) 351 (cl-some 352 (lambda (edges) 353 (cl-some (lambda (link) 354 (pdf-util-with-edges (link edges) 355 (let ((area (min (* link-width link-height) 356 (* edges-width edges-height)))) 357 (> (/ (pdf-util-edges-intersection-area edges link) 358 (float area)) 0.5)))) 359 links)) 360 m)) 361 matches))) 362 363 (defun pdf-links-browse-uri-default (uri) 364 "Open the string URI using Org. 365 366 Wraps the URI in \[\[ ... \]\] and calls `org-open-link-from-string' 367 on the resulting string." 368 (cl-check-type uri string) 369 (message "Opening `%s' with Org" uri) 370 (cond 371 ((fboundp 'org-link-open-from-string) 372 (org-link-open-from-string (format "[[%s]]" uri))) 373 ;; For Org 9.2 and older 374 ((fboundp 'org-open-link-from-string) 375 (org-open-link-from-string (format "[[%s]]" uri))))) 376 377 (provide 'pdf-links) 378 379 ;;; pdf-links.el ends here