pdf-links.el

;;; pdf-links.el --- Handle PDF links. -*- lexical-binding: t -*-

;; Copyright (C) 2013, 2014  Andreas Politz

;; Author: Andreas Politz <politza@fh-trier.de>
;; Keywords: files, multimedia

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:
;;

(require 'pdf-info)
(require 'pdf-util)
(require 'pdf-misc)
(require 'pdf-cache)
(require 'pdf-isearch)
(require 'let-alist)
(require 'org)

;;; Code:



;; * ================================================================== *
;; * Customizations
;; * ================================================================== *

(defgroup pdf-links nil
  "Following links in PDF documents."
  :group 'pdf-tools)

(defface pdf-links-read-link
  '((((background dark)) (:background "red" :foreground "yellow"))
    (((background light)) (:background "red" :foreground "yellow")))
  "Face used to determine the colors when reading links."
  ;; :group 'pdf-links
  :group 'pdf-tools-faces)

(defcustom pdf-links-read-link-convert-commands
  '(;;"-font" "FreeMono"
    "-pointsize" "%P"
    "-undercolor" "%f"
    "-fill" "%b"
    "-draw" "text %X,%Y '%c'")

  "The commands for the convert program, when decorating links for reading.
See `pdf-util-convert' for an explanation of the format.

Aside from the description there, two additional escape chars are
available.

%P -- The scaled font pointsize, i.e. IMAGE-WIDTH * SCALE (See
 `pdf-links-convert-pointsize-scale').
%c -- String describing the current link key (e.g. AA, AB,
 etc.)."
  :group 'pdf-links
  :type '(repeat string)
  :link '(variable-link pdf-isearch-convert-commands)
  :link '(url-link "http://www.imagemagick.org/script/convert.php"))

(defcustom pdf-links-convert-pointsize-scale 0.01
  "The scale factor for the -pointsize convert command.

This determines the relative size of the font, when interactively
reading links."
  :group 'pdf-links
  :type '(restricted-sexp :match-alternatives
                          ((lambda (x) (and (numberp x)
                                            (<= x 1)
                                            (>= x 0))))))

(defcustom pdf-links-browse-uri-function
  'pdf-links-browse-uri-default
  "The function for handling uri links.

This function should accept one argument, the URI to follow, and
do something with it."
  :group 'pdf-links
  :type 'function)


;; * ================================================================== *
;; * Minor Mode
;; * ================================================================== *

(defvar pdf-links-minor-mode-map
  (let ((kmap (make-sparse-keymap)))
    (define-key kmap (kbd "f") 'pdf-links-isearch-link)
    (define-key kmap (kbd "F") 'pdf-links-action-perform)
    kmap))

;;;###autoload
(define-minor-mode pdf-links-minor-mode
  "Handle links in PDF documents.\\<pdf-links-minor-mode-map>

If this mode is enabled, most links in the document may be
activated by clicking on them or by pressing \\[pdf-links-action-perform] and selecting
one of the displayed keys, or by using isearch limited to
links via \\[pdf-links-isearch-link].

\\{pdf-links-minor-mode-map}"

  nil nil nil
  :group 'pdf-links
  (pdf-util-assert-pdf-buffer)
  (cond
   (pdf-links-minor-mode
    (pdf-view-add-hotspot-function 'pdf-links-hotspots-function 0))
   (t
    (pdf-view-remove-hotspot-function 'pdf-links-hotspots-function)))
  (pdf-view-redisplay t))

(defun pdf-links-hotspots-function (page size)
  "Create hotspots for links on PAGE using SIZE."

  (let ((links (pdf-cache-pagelinks page))
        (id-fmt "link-%d-%d")
        (i 0)
        (pointer 'hand)
        hotspots)
    (dolist (l links)
      (let ((e (pdf-util-scale
                (cdr (assq 'edges l)) size 'round))
            (id (intern (format id-fmt page
                                (cl-incf i)))))
        (push `((rect . ((,(nth 0 e) . ,(nth 1 e))
                         . (,(nth 2 e) . ,(nth 3 e))))
                ,id
                (pointer
                 ,pointer
                 help-echo ,(pdf-links-action-to-string l)))
              hotspots)
        (local-set-key
         (vector id 'mouse-1)
         (lambda nil
           (interactive "@")
           (pdf-links-action-perform l)))
        (local-set-key
         (vector id t)
         'pdf-util-image-map-mouse-event-proxy)))
    (nreverse hotspots)))

(defun pdf-links-action-to-string (link)
  "Return a string representation of ACTION."
  (let-alist link
    (concat
     (cl-case .type
       (goto-dest
        (if (> .page 0)
            (format "Goto page %d" .page)
          "Destination not found"))
       (goto-remote
        (if (and .filename (file-exists-p .filename))
            (format "Goto %sfile '%s'"
                    (if (> .page 0)
                        (format "p.%d of " .page)
                      "")
                    .filename)
          (format "Link to nonexistent file '%s'" .filename)))
       (uri
        (if (> (length .uri) 0)
            (format "Link to uri '%s'" .uri)
          (format "Link to empty uri")))
       (t (format "Unrecognized link type: %s" .type)))
     (if (> (length .title) 0)
         (format " (%s)" .title)))))

;;;###autoload
(defun pdf-links-action-perform (link)
  "Follow LINK, depending on its type.

This may turn to another page, switch to another PDF buffer or
invoke `pdf-links-browse-uri-function'.

Interactively, link is read via `pdf-links-read-link-action'.
This function displays characters around the links in the current
page and starts reading characters (ignoring case).  After a
sufficient number of characters have been read, the corresponding
link's link is invoked.  Additionally, SPC may be used to
scroll the current page."
  (interactive
   (list (or (pdf-links-read-link-action "Activate link (SPC scrolls): ")
             (error "No link selected"))))
  (let-alist link
    (cl-case .type
      ((goto-dest goto-remote)
       (let ((window (selected-window)))
         (cl-case .type
           (goto-dest
            (unless (> .page 0)
              (error "Link points to nowhere")))
           (goto-remote
            (unless (and .filename (file-exists-p .filename))
              (error "Link points to nonexistent file %s" .filename))
            (setq window (display-buffer
                          (or (find-buffer-visiting .filename)
                              (find-file-noselect .filename))))))
         (with-selected-window window
           (when (derived-mode-p 'pdf-view-mode)
             (when (> .page 0)
               (pdf-view-goto-page .page))
             (when .top
               ;; Showing the tooltip delays displaying the page for
               ;; some reason (sit-for/redisplay don't help), do it
               ;; later.
               (run-with-idle-timer 0.001 nil
                 (lambda ()
                   (when (window-live-p window)
                     (with-selected-window window
                       (when (derived-mode-p 'pdf-view-mode)
                         (pdf-util-tooltip-arrow .top)))))))))))
      (uri
       (funcall pdf-links-browse-uri-function .uri))
      (t
       (error "Unrecognized link type: %s" .type)))
    nil))

(defun pdf-links-read-link-action (prompt)
  "Using PROMPT, interactively read a link-action.

See `pdf-links-action-perform' for the interface."

  (pdf-util-assert-pdf-window)
  (let* ((links (pdf-cache-pagelinks
                 (pdf-view-current-page)))
         (keys (pdf-links-read-link-action--create-keys
                (length links)))
         (key-strings (mapcar (apply-partially 'apply 'string)
                              keys))
         (alist (cl-mapcar 'cons keys links))
         (size (pdf-view-image-size))
         (colors (pdf-util-face-colors
                  'pdf-links-read-link pdf-view-dark-minor-mode))
         (args (list
                :foreground (car colors)
                :background (cdr colors)
                :formats
                 `((?c . ,(lambda (_edges) (pop key-strings)))
                   (?P . ,(number-to-string
                           (max 1 (* (cdr size)
                                     pdf-links-convert-pointsize-scale)))))
                 :commands pdf-links-read-link-convert-commands
                 :apply (pdf-util-scale-relative-to-pixel
                         (mapcar (lambda (l) (cdr (assq 'edges l)))
                                 links)))))
    (unless links
      (error "No links on this page"))
    (unwind-protect
        (let ((image-data
               (pdf-cache-get-image
                (pdf-view-current-page)
                (car size) (car size) 'pdf-links-read-link-action)))
          (unless image-data
            (setq image-data (apply 'pdf-util-convert-page args ))
            (pdf-cache-put-image
             (pdf-view-current-page)
             (car size) image-data 'pdf-links-read-link-action))
          (pdf-view-display-image
           (create-image image-data (pdf-view-image-type) t))
          (pdf-links-read-link-action--read-chars prompt alist))
      (pdf-view-redisplay))))

(defun pdf-links-read-link-action--read-chars (prompt alist)
  (catch 'done
    (let (key)
      (while t
        (let* ((chars (append (mapcar 'caar alist)
                              (mapcar 'downcase (mapcar 'caar alist))
                              (list ?\s)))
               (ch (read-char-choice prompt chars)))
          (setq ch (upcase ch))
          (cond
           ((= ch ?\s)
            (when (= (window-vscroll) (image-scroll-up))
              (image-scroll-down (window-vscroll))))
           (t
            (setq alist (delq nil (mapcar (lambda (elt)
                                            (and (eq ch (caar elt))
                                                 (cons (cdar elt)
                                                       (cdr elt))))
                                          alist))
                  key (append key (list ch))
                  prompt (concat prompt (list ch)))
            (when (= (length alist) 1)
              (message nil)
              (throw 'done (cdar alist))))))))))

(defun pdf-links-read-link-action--create-keys (n)
  (when (> n 0)
    (let ((len (1+ (floor (log n 26))))
          keys)
      (dotimes (i n)
        (let (key)
          (dotimes (_x len)
            (push (+ (% i 26) ?A) key)
            (setq i (/ i 26)))
          (push key keys)))
      (nreverse keys))))

(defun pdf-links-isearch-link ()
  (interactive)
  (let* (quit-p
         (isearch-mode-end-hook
          (cons (lambda nil
                  (setq quit-p isearch-mode-end-hook-quit))
                isearch-mode-end-hook))
         (pdf-isearch-filter-matches-function
          'pdf-links-isearch-link-filter-matches)
         (pdf-isearch-narrow-to-page t)
         (isearch-message-prefix-add "(Links)")
         pdf-isearch-batch-mode)
    (isearch-forward)
    (unless (or quit-p (null pdf-isearch-current-match))
      (let* ((page (pdf-view-current-page))
             (match (car pdf-isearch-current-match))
             (size (pdf-view-image-size))
             (links (sort (cl-remove-if
                           (lambda (e)
                             (= 0 (pdf-util-edges-intersection-area (car e) match)))
                           (mapcar (lambda (l)
                                     (cons (pdf-util-scale (alist-get 'edges l) size)
                                           l))
                                   (pdf-cache-pagelinks page)))
                          (lambda (e1 e2)
                            (> (pdf-util-edges-intersection-area
                                (alist-get 'edges e1) match)
                               (pdf-util-edges-intersection-area
                                (alist-get 'edges e2) match))))))
        (unless links
          (error "No link found at this position"))
        (pdf-links-action-perform (car links))))))

(defun pdf-links-isearch-link-filter-matches (matches)
  (let ((links (pdf-util-scale
                (mapcar (apply-partially 'alist-get 'edges)
                        (pdf-cache-pagelinks
                         (pdf-view-current-page)))
                (pdf-view-image-size))))
    (cl-remove-if-not
     (lambda (m)
       (cl-some
        (lambda (edges)
          (cl-some (lambda (link)
                     (pdf-util-with-edges (link edges)
                       (let ((area (min (* link-width link-height)
                                        (* edges-width edges-height))))
                         (>  (/  (pdf-util-edges-intersection-area edges link)
                                 (float area)) 0.5))))
                   links))
        m))
     matches)))

(defun pdf-links-browse-uri-default (uri)
  "Open the string URI using Org.

Wraps the URI in \[\[ ... \]\] and calls `org-open-link-from-string'
on the resulting string."
  (cl-check-type uri string)
  (message "Opening `%s' with Org" uri)
  (org-open-link-from-string (format "[[%s]]" uri)))

(provide 'pdf-links)

;;; pdf-links.el ends here