380 lines
14 KiB
EmacsLisp
380 lines
14 KiB
EmacsLisp
;;; 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}"
|
||
: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)
|
||
(cond
|
||
((fboundp 'org-link-open-from-string)
|
||
(org-link-open-from-string (format "[[%s]]" uri)))
|
||
;; For Org 9.2 and older
|
||
((fboundp 'org-open-link-from-string)
|
||
(org-open-link-from-string (format "[[%s]]" uri)))))
|
||
|
||
(provide 'pdf-links)
|
||
|
||
;;; pdf-links.el ends here
|