config

Personal configuration.
git clone git://code.dwrz.net/config
Log | Files | Refs

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