summaryrefslogtreecommitdiff
path: root/elpa/pdf-tools-20200512.1524/pdf-annot.el
diff options
context:
space:
mode:
authorBlendoit <blendoit@gmail.com>2020-08-01 15:18:40 -0700
committerBlendoit <blendoit@gmail.com>2020-08-01 15:18:40 -0700
commit374ae3de24187512adddf01a56e5eb52c79db65f (patch)
tree847adf6824b56394f5a040ba45863e2dbdceac70 /elpa/pdf-tools-20200512.1524/pdf-annot.el
parent54fbf6576cf2dd94ef5af332a6075723a9dfa8b3 (diff)
Include contents of elpa/ sources + theme update.
Diffstat (limited to 'elpa/pdf-tools-20200512.1524/pdf-annot.el')
-rw-r--r--elpa/pdf-tools-20200512.1524/pdf-annot.el1790
1 files changed, 1790 insertions, 0 deletions
diff --git a/elpa/pdf-tools-20200512.1524/pdf-annot.el b/elpa/pdf-tools-20200512.1524/pdf-annot.el
new file mode 100644
index 0000000..efde0ec
--- /dev/null
+++ b/elpa/pdf-tools-20200512.1524/pdf-annot.el
@@ -0,0 +1,1790 @@
+;;; pdf-annot.el --- Annotation support for PDF files. -*- lexical-binding: t -*-
+
+;; Copyright (C) 2013, 2014 Andreas Politz
+
+;; Author: Andreas Politz <politza@fh-trier.de>
+;; Keywords:
+
+;; 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-view)
+(require 'pdf-info)
+(require 'pdf-cache)
+(require 'pdf-misc)
+(require 'facemenu) ;; list-colors-duplicates
+(require 'faces) ;; color-values
+(require 'org) ;; org-create-formula-image
+(require 'tablist)
+(require 'cl-lib)
+
+
+;; * ================================================================== *
+;; * Customizations
+;; * ================================================================== *
+
+(defgroup pdf-annot nil
+ "Annotation support for PDF documents."
+ :group 'pdf-tools)
+
+(defcustom pdf-annot-activate-handler-functions nil
+ "A list of functions to activate a annotation.
+
+The functions on this hook will be called when some annotation is
+activated, usually by a mouse-click. Each one is called with the
+annotation as a single argument and it should return a non-nil
+value if it has `handled' it. If no such function exists, the
+default handler `pdf-annot-default-handler' will be
+called.
+
+This hook is meant to allow for custom annotations. FIXME:
+Implement and describe basic org example."
+ :group 'pdf-annot
+ :type 'hook)
+
+(defcustom pdf-annot-default-text-annotation-properties nil
+ "Alist of initial properties for new text annotations."
+ :group 'pdf-annot
+ :type '(alist :key-type symbol :value-type sexp))
+
+(defcustom pdf-annot-default-markup-annotation-properties nil
+ "Alist of initial properties for new markup annotations."
+ :group 'pdf-annot
+ :type '(alist :key-type symbol :value-type sexp))
+
+(make-obsolete-variable 'pdf-annot-default-text-annotation-properties
+ 'pdf-annot-default-annotation-properties
+ "0.90")
+
+(make-obsolete-variable 'pdf-annot-default-markup-annotation-properties
+ 'pdf-annot-default-annotation-properties
+ "0.90")
+
+(defcustom pdf-annot-default-annotation-properties
+ `((t (label . ,user-full-name))
+ (text (icon . "Note")
+ (color . "#ff0000"))
+ (highlight (color . "yellow"))
+ (squiggly (color . "orange"))
+ (strike-out(color . "red"))
+ (underline (color . "blue")))
+ "An alist of initial properties for new annotations.
+
+The alist contains a sub-alist for each of the currently available
+annotation types, i.e. text, highlight, squiggly, strike-out and
+underline. Additionally a sub-alist with a key of t acts as a default
+entry.
+
+Each of these sub-alists contain default property-values of newly
+added annotations of its respective type.
+
+Some of the most important properties and their types are label
+\(a string\), contents \(a string\), color \(a color\) and, for
+text-annotations only, icon \(one of the standard icon-types, see
+`pdf-annot-standard-text-icons'\).
+
+For example a value of
+
+ \(\(t \(color . \"red\"\)
+ \(label . \"Joe\"\)
+ \(highlight \(color . \"green\"\)\)
+
+would use a green color for highlight and a red one for other
+annotations. Additionally the label for all annotations is set
+to \"Joe\"."
+
+ :group 'pdf-annot
+ :type (let* ((label '(cons :tag "Label" (const label) string))
+ (contents '(cons :tag "Contents" (const contents) string))
+ (color '(cons :tag "Color" (const color) color))
+ (icon `(cons :tag "Icon"
+ (const icon)
+ (choice
+ ,@(mapcar (lambda (icon)
+ `(const ,icon))
+ '("Note" "Comment" "Key" "Help" "NewParagraph"
+ "Paragraph" "Insert" "Cross" "Circle")))))
+ (other '(repeat
+ :tag "Other properties"
+ (cons :tag "Property"
+ (symbol :tag "Key ")
+ (sexp :tag "Value"))))
+ (text-properties
+ `(set ,label ,contents ,color ,icon ,other))
+ (markup-properties
+ `(set ,label ,contents ,color))
+ (all-properties
+ `(set ,label ,contents ,color ,icon ,other)))
+ `(set
+ (cons :tag "All Annotations" (const t) ,all-properties)
+ (cons :tag "Text Annotations" (const text) ,text-properties)
+ (cons :tag "Highlight Annotations" (const highlight) ,markup-properties)
+ (cons :tag "Underline Annotations" (const underline) ,markup-properties)
+ (cons :tag "Squiggly Annotations" (const squiggly) ,markup-properties)
+ (cons :tag "Strike-out Annotations" (const strike-out) ,markup-properties))))
+
+(defcustom pdf-annot-print-annotation-functions
+ '(pdf-annot-print-annotation-latex-maybe)
+ "A alist of functions for printing annotations, e.g. for the tooltip.
+
+The functions receive the annotation as single argument and
+should return either a string or nil. The first string returned
+will be used.
+
+If all of them return nil, the default function
+`pdf-annot-print-annotation-default' is used."
+ :group 'pdf-annot
+ :type 'hook)
+
+(defcustom pdf-annot-latex-string-predicate
+ (lambda (str)
+ (and str (string-match "\\`[[:space:]\n]*[$\\]" str)))
+ "A predicate for recognizing LaTeX fragments.
+
+It receives a string and should return non-nil, if string is a
+LaTeX fragment."
+ :group 'pdf-annot
+ :type 'function)
+
+(defcustom pdf-annot-latex-header
+ (concat org-format-latex-header
+ "\n\\setlength{\\textwidth}{12cm}")
+ "Header used when latex compiling annotations.
+
+The default value is `org-format-latex-header' + \
+\"\\n\\\\setlength{\\\\textwidth}{12cm}\"."
+ :group 'pdf-annot
+ :type 'string)
+
+(defcustom pdf-annot-tweak-tooltips t
+ "Whether this package should tweak some settings regarding tooltips.
+
+If this variable has a non-nil value,
+
+`x-gtk-use-system-tooltips' is set to nil if appropriate, in
+order to display text properties;
+
+`tooltip-hide-delay' is set to infinity, in order to not being
+annoyed while reading the annotations."
+ :group 'pdf-annot
+ :type 'boolean)
+
+(defcustom pdf-annot-activate-created-annotations nil
+ "Whether to activate (i.e. edit) created annotations."
+ :group 'pdf-annot
+ :type 'boolean)
+
+(defcustom pdf-annot-attachment-display-buffer-action nil
+ "The display action used when displaying attachments."
+ :group 'pdf-annot
+ :type display-buffer--action-custom-type)
+
+(defconst pdf-annot-annotation-types
+ '(3d caret circle file
+ free-text highlight ink line link movie poly-line polygon popup
+ printer-mark screen sound square squiggly stamp strike-out text
+ trap-net underline unknown watermark widget)
+ "Complete list of annotation types.")
+
+(defcustom pdf-annot-list-listed-types
+ (if (pdf-info-markup-annotations-p)
+ (list 'text 'file 'squiggly 'highlight 'underline 'strike-out)
+ (list 'text 'file))
+ "A list of annotation types displayed in the list buffer."
+ :group 'pdf-annot
+ :type `(set ,@(mapcar (lambda (type)
+ (list 'const type))
+ pdf-annot-annotation-types)))
+
+
+;; * ================================================================== *
+;; * Variables and Macros
+;; * ================================================================== *
+
+(defvar pdf-annot-color-history nil
+ "A list of recently used colors for annotations.")
+
+(defvar-local pdf-annot-modified-functions nil
+ "Functions to call, when an annotation was modified.
+
+A function on this hook should accept one argument: A CLOSURE
+containing inserted, changed and deleted annotations.
+
+It may access theses annotations by calling CLOSURE with one of
+these arguments:
+
+`:inserted' The list of recently added annotations.
+
+`:deleted' The list of recently deleted annotations.
+
+`:changed' The list of recently changed annotations.
+
+`t' The union of recently added, deleted or changed annotations.
+
+`nil' Just returns nil.
+
+Any other argument signals an error.")
+
+(defconst pdf-annot-text-annotation-size '(24 . 24)
+ "The Size of text and file annotations in PDF points.
+
+These values are hard-coded in poppler. And while the size of
+these annotations may be changed, i.e. the edges property, it has
+no effect on the rendering.")
+
+(defconst pdf-annot-markup-annotation-types
+ '(text link free-text line square
+ circle polygon poly-line highlight underline squiggly
+ strike-out stamp caret ink file sound)
+ "List of defined markup annotation types.")
+
+(defconst pdf-annot-standard-text-icons
+ '("Note" "Comment" "Key" "Help" "NewParagraph"
+ "Paragraph" "Insert" "Cross" "Circle")
+ "A list of standard icon properties for text annotations.")
+
+(defvar pdf-annot-inhibit-modification-hooks nil
+ "Non-nil, if running `pdf-annot-modified-functions' should be
+ inhibited after some annotation has changed.")
+
+(defvar-local pdf-annot-delayed-modified-annotations nil
+ "A plist of not yet propagated modifications.
+
+It contains three entries :change, :delete and :insert. Each one
+having a list of annotations as value.")
+
+(defvar-local pdf-annot--attachment-file-alist nil
+ "Alist mapping attachment ids to unique relative filenames.")
+
+(defmacro pdf-annot-with-atomic-modifications (&rest body)
+ "Execute BODY joining multiple modifications.
+
+The effect is, that `pdf-annot-modified-functions' will be called
+only once at the end of BODY.
+
+BODY should not modify annotations in a different then the
+current buffer, because that won't run the hooks properly."
+ (declare (indent 0) (debug t))
+ `(unwind-protect
+ (save-current-buffer
+ (let ((pdf-annot-inhibit-modification-hooks t))
+ (progn ,@body)))
+ (pdf-annot-run-modified-hooks)))
+
+
+;; * ================================================================== *
+;; * Minor mode
+;; * ================================================================== *
+
+(defcustom pdf-annot-minor-mode-map-prefix (kbd "C-c C-a")
+ "The prefix to use for `pdf-annot-minor-mode-map'.
+
+Setting this after the package was loaded has no effect."
+ :group 'pdf-annot
+ :type 'key-sequence)
+
+(defvar pdf-annot-minor-mode-map
+ (let ((kmap (make-sparse-keymap))
+ (smap (make-sparse-keymap)))
+ (define-key kmap pdf-annot-minor-mode-map-prefix smap)
+ (define-key smap "l" 'pdf-annot-list-annotations)
+ ;; (define-key smap "d" 'pdf-annot-toggle-display-annotations)
+ (define-key smap "a" 'pdf-annot-attachment-dired)
+ (when (pdf-info-writable-annotations-p)
+ (define-key smap "D" 'pdf-annot-delete)
+ (define-key smap "t" 'pdf-annot-add-text-annotation)
+ (when (pdf-info-markup-annotations-p)
+ (define-key smap "m" 'pdf-annot-add-markup-annotation)
+ (define-key smap "s" 'pdf-annot-add-squiggly-markup-annotation)
+ (define-key smap "u" 'pdf-annot-add-underline-markup-annotation)
+ (define-key smap "o" 'pdf-annot-add-strikeout-markup-annotation)
+ (define-key smap "h" 'pdf-annot-add-highlight-markup-annotation)))
+ kmap)
+ "Keymap used for `pdf-annot-minor-mode'.")
+
+(defvar savehist-minibuffer-history-variables)
+
+;;;###autoload
+(define-minor-mode pdf-annot-minor-mode
+ "Support for PDF Annotations.
+
+\\{pdf-annot-minor-mode-map}"
+ nil nil nil
+ (cond
+ (pdf-annot-minor-mode
+ (when pdf-annot-tweak-tooltips
+ (when (boundp 'x-gtk-use-system-tooltips)
+ (setq x-gtk-use-system-tooltips nil))
+ (setq tooltip-hide-delay 3600))
+ (pdf-view-add-hotspot-function 'pdf-annot-hotspot-function 9)
+ (add-hook 'pdf-info-close-document-hook
+ 'pdf-annot-attachment-delete-base-directory nil t)
+ (when (featurep 'savehist)
+ (add-to-list 'savehist-minibuffer-history-variables
+ 'pdf-annot-color-history)))
+ (t
+ (pdf-view-remove-hotspot-function 'pdf-annot-hotspot-function)
+ (remove-hook 'pdf-info-close-document-hook
+ 'pdf-annot-attachment-delete-base-directory t)))
+ (pdf-view-redisplay t))
+
+(defun pdf-annot-create-context-menu (a)
+ "Create a appropriate context menu for annotation A."
+ (let ((menu (make-sparse-keymap)))
+ ;; (when (and (bound-and-true-p pdf-misc-menu-bar-minor-mode)
+ ;; (bound-and-true-p pdf-misc-install-popup-menu))
+ ;; (set-keymap-parent menu
+ ;; (lookup-key pdf-misc-menu-bar-minor-mode-map
+ ;; [menu-bar pdf-tools]))
+ ;; (define-key menu [sep-99] menu-bar-separator))
+ (when (pdf-info-writable-annotations-p)
+ (define-key menu [delete-annotation]
+ `(menu-item "Delete annotation"
+ ,(lambda ()
+ (interactive)
+ (pdf-annot-delete a)
+ (message "Annotation deleted"))
+ :help
+ "Delete this annotation.")))
+ (define-key menu [goto-annotation]
+ `(menu-item "List annotation"
+ ,(lambda ()
+ (interactive)
+ (pdf-annot-show-annotation a t)
+ (pdf-annot-list-annotations)
+ (pdf-annot-list-goto-annotation a))
+ :help "Find this annotation in the list buffer."))
+ (when (pdf-annot-text-annotation-p a)
+ (define-key menu [change-text-icon]
+ `(menu-item "Change icon"
+ ,(pdf-annot-create-icon-submenu a)
+ :help "Change the appearance of this annotation.")))
+ (define-key menu [change-color]
+ `(menu-item "Change color"
+ ,(pdf-annot-create-color-submenu a)
+ :help "Change the appearance of this annotation."))
+ (define-key menu [activate-annotation]
+ `(menu-item "Activate"
+ ,(lambda ()
+ (interactive)
+ (pdf-annot-activate-annotation a))
+ :help "Activate this annotation."))
+ menu))
+
+(defun pdf-annot-create-color-submenu (a)
+ (let ((menu (make-sparse-keymap)))
+ (define-key menu [color-chooser]
+ `(menu-item "Choose ..."
+ ,(lambda ()
+ (interactive)
+ (list-colors-display
+ nil "*Choose annotation color*"
+ ;; list-colors-print does not like closures.
+ (let ((callback (make-symbol "xcallback")))
+ (fset callback
+ (lambda (color)
+ (pdf-annot-put a 'color color)
+ (setq pdf-annot-color-history
+ (cons color
+ (remove color pdf-annot-color-history)))
+ (quit-window t)))
+ (list 'function callback))))))
+ (dolist (color (butlast (reverse pdf-annot-color-history)
+ (max 0 (- (length pdf-annot-color-history)
+ 12))))
+ (define-key menu (vector (intern (format "color-%s" color)))
+ `(menu-item ,color
+ ,(lambda nil
+ (interactive)
+ (pdf-annot-put a 'color color)))))
+ menu))
+
+(defun pdf-annot-create-icon-submenu (a)
+ (let ((menu (make-sparse-keymap)))
+ (dolist (icon (reverse pdf-annot-standard-text-icons))
+ (define-key menu (vector (intern (format "icon-%s" icon)))
+ `(menu-item ,icon
+ ,(lambda nil
+ (interactive)
+ (pdf-annot-put a 'icon icon)))))
+ menu))
+
+;; * ================================================================== *
+;; * Annotation Basics
+;; * ================================================================== *
+
+(defun pdf-annot-create (alist &optional buffer)
+ "Create a annotation from ALIST in BUFFER.
+
+ALIST should be a property list as returned by
+`pdf-cache-getannots'. BUFFER should be the buffer of the
+corresponding PDF document. It defaults to the current buffer."
+
+ (cons `(buffer . ,(or buffer (current-buffer)))
+ alist))
+
+(defun pdf-annot-getannots (&optional pages types buffer)
+ "Return a list of annotations on PAGES of TYPES in BUFFER.
+
+See `pdf-info-normalize-pages' for valid values of PAGES. TYPES
+may be a symbol or list of symbols denoting annotation types.
+
+PAGES defaults to all pages, TYPES to all types and BUFFER to the
+current buffer."
+
+ (pdf-util-assert-pdf-buffer buffer)
+ (unless buffer
+ (setq buffer (current-buffer)))
+ (unless (listp types)
+ (setq types (list types)))
+ (with-current-buffer buffer
+ (let (result)
+ (dolist (a (pdf-info-getannots pages))
+ (when (or (null types)
+ (memq (pdf-annot-get a 'type) types))
+ (push (pdf-annot-create a) result)))
+ result)))
+
+(defun pdf-annot-getannot (id &optional buffer)
+ (pdf-annot-create
+ (pdf-info-getannot id buffer)
+ buffer))
+
+(defun pdf-annot-get (a property &optional default)
+ "Get annotation A's value of PROPERTY.
+
+Return DEFAULT, if value is nil."
+ (or (cdr (assq property a)) default))
+
+(defun pdf-annot-put (a property value)
+ "Set annotation A's PROPERTY to VALUE.
+
+Unless VALUE is `equal' to the current value, sets A's buffer's
+modified flag and runs the hook `pdf-annot-modified-functions'.
+
+Signals an error, if PROPERTY is not modifiable.
+
+Returns the modified annotation."
+
+ (declare (indent 2))
+ (unless (equal value (pdf-annot-get a property))
+ (unless (pdf-annot-property-modifiable-p a property)
+ (error "Property `%s' is read-only for this annotation"
+ property))
+ (with-current-buffer (pdf-annot-get-buffer a)
+ (setq a (pdf-annot-create
+ (pdf-info-editannot
+ (pdf-annot-get-id a)
+ `((,property . ,value)))))
+ (set-buffer-modified-p t)
+ (pdf-annot-run-modified-hooks :change a)))
+ a)
+
+(defun pdf-annot-run-modified-hooks (&optional operation &rest annotations)
+ "Run `pdf-annot-modified-functions' using OPERATION on ANNOTATIONS.
+
+OPERATION should be one of nil, :change, :insert or :delete. If
+nil, annotations should be empty.
+
+Redisplay modified pages.
+
+If `pdf-annot-inhibit-modification-hooks' in non-nil, this just
+saves ANNOTATIONS and does not call the hooks until later, when
+the variable is nil and this function is called again."
+
+ (unless (memq operation '(nil :insert :change :delete))
+ (error "Invalid operation: %s" operation))
+ (when (and (null operation) annotations)
+ (error "Missing operation argument"))
+
+ (when operation
+ (let ((list (plist-get pdf-annot-delayed-modified-annotations operation)))
+ (dolist (a annotations)
+ (cl-pushnew a list :test 'pdf-annot-equal))
+ (setq pdf-annot-delayed-modified-annotations
+ (plist-put pdf-annot-delayed-modified-annotations
+ operation list))))
+ (unless pdf-annot-inhibit-modification-hooks
+ (let* ((changed (plist-get pdf-annot-delayed-modified-annotations :change))
+ (inserted (mapcar (lambda (a)
+ (or (car (cl-member a changed :test 'pdf-annot-equal))
+ a))
+ (plist-get pdf-annot-delayed-modified-annotations :insert)))
+ (deleted (plist-get pdf-annot-delayed-modified-annotations :delete))
+ (union (cl-union (cl-union changed inserted :test 'pdf-annot-equal)
+ deleted :test 'pdf-annot-equal))
+ (closure (lambda (arg)
+ (cl-ecase arg
+ (:inserted (copy-sequence inserted))
+ (:changed (copy-sequence changed))
+ (:deleted (copy-sequence deleted))
+ (t (copy-sequence union))
+ (nil nil))))
+ (pages (mapcar (lambda (a) (pdf-annot-get a 'page)) union)))
+ (when union
+ (unwind-protect
+ (run-hook-with-args
+ 'pdf-annot-modified-functions closure)
+ (setq pdf-annot-delayed-modified-annotations nil)
+ (apply 'pdf-view-redisplay-pages pages))))))
+
+(defun pdf-annot-equal (a1 a2)
+ "Return non-nil, if annotations A1 and A2 are equal.
+
+Two annotations are equal, if they belong to the same buffer and
+have identical id properties."
+ (and (eq (pdf-annot-get-buffer a1)
+ (pdf-annot-get-buffer a2))
+ (eq (pdf-annot-get-id a1)
+ (pdf-annot-get-id a2))))
+
+(defun pdf-annot-get-buffer (a)
+ "Return annotation A's buffer."
+ (pdf-annot-get a 'buffer))
+
+(defun pdf-annot-get-id (a)
+ "Return id property of annotation A."
+ (pdf-annot-get a 'id))
+
+(defun pdf-annot-get-type (a)
+ "Return type property of annotation A."
+ (pdf-annot-get a 'type))
+
+(defun pdf-annot-get-display-edges (a)
+ "Return a list of EDGES used for display for annotation A.
+
+This returns a list of \(LEFT TOP RIGHT BOT\) demarking the
+rectangles of the page where A is rendered."
+
+ (or (pdf-annot-get a 'markup-edges)
+ (list (pdf-annot-get a 'edges))))
+
+(defun pdf-annot-delete (a)
+ "Delete annotation A.
+
+Sets A's buffer's modified flag and runs the hook
+`pdf-annot-modified-functions'.
+
+This function always returns nil."
+ (interactive
+ (list (pdf-annot-read-annotation
+ "Click on the annotation you wish to delete")))
+ (with-current-buffer (pdf-annot-get-buffer a)
+ (pdf-info-delannot
+ (pdf-annot-get-id a))
+ (set-buffer-modified-p t)
+ (pdf-annot-run-modified-hooks :delete a))
+ (when (called-interactively-p 'any)
+ (message "Annotation deleted"))
+ nil)
+
+(defun pdf-annot-text-annotation-p (a)
+ (eq 'text (pdf-annot-get a 'type)))
+
+(defun pdf-annot-markup-annotation-p (a)
+ (not (null
+ (memq (pdf-annot-get a 'type)
+ pdf-annot-markup-annotation-types))))
+
+(defun pdf-annot-property-modifiable-p (a property)
+ (or (memq property '(edges color flags contents))
+ (and (pdf-annot-markup-annotation-p a)
+ (memq property '(label opacity popup popup-is-open)))
+ (and (pdf-annot-text-annotation-p a)
+ (memq property '(icon is-open)))))
+
+(defun pdf-annot-activate-annotation (a)
+ (or (run-hook-with-args-until-success
+ 'pdf-annot-activate-handler-functions
+ a)
+ (pdf-annot-default-activate-handler a)))
+
+(defun pdf-annot-default-activate-handler (a)
+ (cond
+ ((pdf-annot-has-attachment-p a)
+ (pdf-annot-pop-to-attachment a))
+ (t (pdf-annot-edit-contents a))))
+
+
+;; * ================================================================== *
+;; * Handling attachments
+;; * ================================================================== *
+
+(defun pdf-annot-has-attachment-p (a)
+ "Return non-nil if annotation A's has data attached."
+ (eq 'file (pdf-annot-get a 'type)))
+
+(defun pdf-annot-get-attachment (a &optional do-save)
+ "Retrieve annotation A's attachment.
+
+The DO-SAVE argument is given to
+`pdf-info-getattachment-from-annot', which see."
+ (unless (pdf-annot-has-attachment-p a)
+ (error "Annotation has no data attached: %s" a))
+ (pdf-info-getattachment-from-annot
+ (pdf-annot-get-id a)
+ do-save
+ (pdf-annot-get-buffer a)))
+
+(defun pdf-annot-attachment-base-directory ()
+ "Return the base directory for saving attachments."
+ (let ((dir (pdf-util-expand-file-name "attachments")))
+ (unless (file-exists-p dir)
+ (make-directory dir))
+ dir))
+
+(defun pdf-annot-attachment-delete-base-directory ()
+ "Delete all saved attachment files of the current buffer."
+ (setq pdf-annot--attachment-file-alist nil)
+ (delete-directory (pdf-annot-attachment-base-directory) t))
+
+(defun pdf-annot-attachment-unique-filename (attachment)
+ "Return a unique absolute filename for ATTACHMENT."
+ (let* ((filename (or (cdr (assq 'filename attachment))
+ "attachment"))
+ (id (cdr (assq 'id attachment)))
+ (unique
+ (or (cdr (assoc id pdf-annot--attachment-file-alist))
+ (let* ((sans-ext
+ (expand-file-name
+ (concat (file-name-as-directory ".")
+ (file-name-sans-extension filename))
+ (pdf-annot-attachment-base-directory)))
+ (ext (file-name-extension filename))
+ (newname (concat sans-ext "." ext))
+ (i 0))
+ (while (rassoc newname pdf-annot--attachment-file-alist)
+ (setq newname (format "%s-%d.%s" sans-ext (cl-incf i) ext)))
+ (push (cons id newname) pdf-annot--attachment-file-alist)
+ newname)))
+ (directory (file-name-directory unique)))
+ (unless (file-exists-p directory)
+ (make-directory directory t))
+ unique))
+
+
+(defun pdf-annot-attachment-save (attachment &optional regenerate-p)
+ "Save ATTACHMENT's data to a unique filename and return it's name.
+
+If REGENERATE-P is non-nil, copy attachment's file even if the
+copy already exists.
+
+Signal an error, if ATTACHMENT has no, or a non-existing, `file'
+property, i.e. it was retrieved with an unset do-save argument.
+See `pdf-info-getattachments'"
+
+ (let ((datafile (cdr (assq 'file attachment))))
+ (unless (and datafile
+ (file-exists-p datafile))
+ (error "Attachment's file property is invalid"))
+ (let* ((filename
+ (pdf-annot-attachment-unique-filename attachment)))
+ (when (or regenerate-p
+ (not (file-exists-p filename)))
+ (copy-file datafile filename nil nil t t))
+ filename)))
+
+(defun pdf-annot-find-attachment-noselect (a)
+ "Find annotation A's attachment in a buffer, without selecting it.
+
+Signals an error, if A has no data attached."
+ (let ((attachment (pdf-annot-get-attachment a t)))
+ (unwind-protect
+ (find-file-noselect
+ (pdf-annot-attachment-save attachment))
+ (let ((tmpfile (cdr (assq 'file attachment))))
+ (when (and tmpfile
+ (file-exists-p tmpfile))
+ (delete-file tmpfile))))))
+
+(defun pdf-annot-attachment-dired (&optional regenerate-p)
+ "List all attachments in a dired buffer.
+
+If REGENERATE-P is non-nil, create attachment's files even if
+they already exist. Interactively REGENERATE-P is non-nil if a
+prefix argument was given.
+
+Return the dired buffer."
+ (interactive (list current-prefix-arg))
+ (let ((attachments (pdf-info-getattachments t)))
+ (unwind-protect
+ (progn
+ (dolist (a (pdf-annot-getannots nil 'file))
+ (push (pdf-annot-get-attachment a t)
+ attachments ))
+ (dolist (att attachments)
+ (pdf-annot-attachment-save att regenerate-p))
+ (unless attachments
+ (error "Document has no data attached"))
+ (dired (pdf-annot-attachment-base-directory)))
+ (dolist (att attachments)
+ (let ((tmpfile (cdr (assq 'file att))))
+ (when (and tmpfile (file-exists-p tmpfile))
+ (delete-file tmpfile)))))))
+
+(defun pdf-annot-display-attachment (a &optional display-action select-window-p)
+ "Display file annotation A's data in a buffer.
+
+DISPLAY-ACTION should be a valid `display-buffer' action. If
+nil, `pdf-annot-attachment-display-buffer-action' is used.
+
+Select the window, if SELECT-WINDOW-P is non-nil.
+
+Return the window attachment is displayed in."
+
+ (interactive
+ (list (pdf-annot-read-annotation
+ "Select a file annotation by clicking on it")))
+ (let* ((buffer (pdf-annot-find-attachment-noselect a))
+ (window (display-buffer
+ buffer (or display-action
+ pdf-annot-attachment-display-buffer-action))))
+ (when select-window-p
+ (select-window window))
+ window))
+
+(defun pdf-annot-pop-to-attachment (a)
+ "Display annotation A's attachment in a window and select it."
+ (interactive
+ (list (pdf-annot-read-annotation
+ "Select a file annotation by clicking on it")))
+ (pdf-annot-display-attachment a nil t))
+
+
+;; * ================================================================== *
+;; * Interfacing with the display
+;; * ================================================================== *
+
+(defun pdf-annot-image-position (a &optional image-size)
+ "Return the position of annotation A in image coordinates.
+
+IMAGE-SIZE should be a cons \(WIDTH . HEIGHT\) and defaults to
+the page-image of the selected window."
+
+ (unless image-size
+ (pdf-util-assert-pdf-window)
+ (setq image-size (pdf-view-image-size)))
+ (let ((e (pdf-util-scale
+ (pdf-annot-get a 'edges)
+ image-size)))
+ (pdf-util-with-edges (e)
+ `(,e-left . ,e-top))))
+
+(defun pdf-annot-image-set-position (a x y &optional image-size)
+ "Set annotation A's position to X,Y in image coordinates.
+
+See `pdf-annot-image-position' for IMAGE-SIZE."
+
+ (unless image-size
+ (pdf-util-assert-pdf-window)
+ (setq image-size (pdf-view-image-size)))
+ (let* ((edges (pdf-annot-get a 'edges))
+ (x (/ x (float (car image-size))))
+ (y (/ y (float (cdr image-size)))))
+ (pdf-util-with-edges (edges)
+ (let* ((w edges-width)
+ (h edges-height)
+ (x (max 0 (min x (- 1 w))))
+ (y (max 0 (min y (- 1 h)))))
+ (pdf-annot-put a 'edges
+ (list x y -1 -1))))))
+
+(defun pdf-annot-image-size (a &optional image-size)
+ "Return the size of annotation A in image coordinates.
+
+Returns \(WIDTH . HEIGHT\).
+
+See `pdf-annot-image-position' for IMAGE-SIZE."
+ (unless image-size
+ (pdf-util-assert-pdf-window)
+ (setq image-size (pdf-view-image-size)))
+ (let ((edges (pdf-util-scale
+ (pdf-annot-get a 'edges) image-size)))
+ (pdf-util-with-edges (edges)
+ (cons edges-width edges-height))))
+
+(defun pdf-annot-image-set-size (a &optional width height image-size)
+ "Set annotation A's size in image to WIDTH and/or HEIGHT.
+
+See `pdf-annot-image-position' for IMAGE-SIZE."
+ (unless image-size
+ (pdf-util-assert-pdf-window)
+ (setq image-size (pdf-view-image-size)))
+ (let* ((edges (pdf-annot-get a 'edges))
+ (w (and width
+ (/ width (float (car image-size)))))
+ (h (and height
+ (/ height (float (cdr image-size))))))
+ (pdf-util-with-edges (edges)
+ (pdf-annot-put a 'edges
+ (list edges-left
+ edges-top
+ (if w (+ edges-left w) edges-right)
+ (if h (+ edges-top h) edges-bot))))))
+
+(defun pdf-annot-at-position (pos)
+ "Return annotation at POS in the selected window.
+
+POS should be an absolute image position as a cons \(X . Y\).
+Alternatively POS may also be an event position, in which case
+`posn-window' and `posn-object-x-y' is used to find the image
+position.
+
+Return nil, if no annotation was found."
+ (let (window)
+ (when (posnp pos)
+ (setq window (posn-window pos)
+ pos (posn-object-x-y pos)))
+ (save-selected-window
+ (when window (select-window window))
+ (let* ((annots (pdf-annot-getannots (pdf-view-current-page)))
+ (size (pdf-view-image-size))
+ (rx (/ (car pos) (float (car size))))
+ (ry (/ (cdr pos) (float (cdr size))))
+ (rpos (cons rx ry)))
+ (or (cl-some (lambda (a)
+ (and (cl-some
+ (lambda (e)
+ (pdf-util-edges-inside-p e rpos))
+ (pdf-annot-get-display-edges a))
+ a))
+ annots)
+ (error "No annotation at this position"))))))
+
+(defun pdf-annot-mouse-move (event &optional annot)
+ "Start moving an annotation at EVENT's position.
+
+EVENT should be a mouse event originating the request and is used
+as a reference point.
+
+ANNOT is the annotation to operate on and defaults to the
+annotation at EVENT's start position.
+
+This function does not return until the operation is completed,
+i.e. a non mouse-movement event is read."
+
+ (interactive "@e")
+ (pdf-util-assert-pdf-window (posn-window (event-start event)))
+ (select-window (posn-window (event-start event)))
+ (let* ((mpos (posn-object-x-y (event-start event)))
+ (a (or annot
+ (pdf-annot-at-position mpos))))
+ (unless a
+ (error "No annotation at this position: %s" mpos))
+ (let* ((apos (pdf-annot-image-position a))
+ (offset (cons (- (car mpos) (car apos))
+ (- (cdr mpos) (cdr apos))))
+ (window (selected-window))
+ make-pointer-invisible)
+ (when (pdf-util-track-mouse-dragging (ev 0.1)
+ (when (and (eq window (posn-window (event-start ev)))
+ (eq 'image (car-safe (posn-object (event-start ev)))))
+ (let ((pdf-view-inhibit-hotspots t)
+ (pdf-annot-inhibit-modification-hooks t)
+ (pdf-cache-image-inihibit t)
+ (xy (posn-object-x-y (event-start ev))))
+ (pdf-annot-image-set-position
+ a (- (car xy) (car offset))
+ (- (cdr xy) (cdr offset)))
+ (pdf-view-redisplay))))
+ (pdf-annot-run-modified-hooks)))
+ nil))
+
+(defun pdf-annot-hotspot-function (page size)
+ "Create image hotspots for page PAGE of size SIZE."
+ (apply 'nconc (mapcar (lambda (a)
+ (unless (eq (pdf-annot-get a 'type)
+ 'link)
+ (pdf-annot-create-hotspots a size)))
+ (pdf-annot-getannots page))))
+
+(defun pdf-annot-create-hotspots (a size)
+ "Return a list of image hotspots for annotation A."
+ (let ((id (pdf-annot-get-id a))
+ (edges (pdf-util-scale
+ (pdf-annot-get-display-edges a)
+ size 'round))
+ (moveable-p (memq (pdf-annot-get a 'type)
+ '(file text)))
+ hotspots)
+ (dolist (e edges)
+ (pdf-util-with-edges (e)
+ (push `((rect . ((,e-left . ,e-top) . (,e-right . ,e-bot)))
+ ,id
+ (pointer
+ hand
+ help-echo
+ ,(pdf-annot-print-annotation a)))
+ hotspots)))
+ (pdf-annot-create-hotspot-binding id moveable-p a)
+ hotspots))
+
+;; FIXME: Define a keymap as a template for this. Much cleaner.
+(defun pdf-annot-create-hotspot-binding (id moveable-p annotation)
+ ;; Activating
+ (local-set-key
+ (vector id 'mouse-1)
+ (lambda ()
+ (interactive)
+ (pdf-annot-activate-annotation annotation)))
+ ;; Move
+ (when moveable-p
+ (local-set-key
+ (vector id 'down-mouse-1)
+ (lambda (ev)
+ (interactive "@e")
+ (pdf-annot-mouse-move ev annotation))))
+ ;; Context Menu
+ (local-set-key
+ (vector id 'down-mouse-3)
+ (lambda ()
+ (interactive "@")
+ (popup-menu (pdf-annot-create-context-menu annotation))))
+ ;; Everything else
+ (local-set-key
+ (vector id t)
+ 'pdf-util-image-map-mouse-event-proxy))
+
+(defun pdf-annot-show-annotation (a &optional highlight-p window)
+ "Make annotation A visible.
+
+Turn to A's page in WINDOW, and scroll it if necessary.
+
+If HIGHLIGHT-P is non-nil, visually distinguish annotation A from
+other annotations."
+
+ (save-selected-window
+ (when window (select-window window))
+ (pdf-util-assert-pdf-window)
+ (let ((page (pdf-annot-get a 'page))
+ (size (pdf-view-image-size)))
+ (unless (= page (pdf-view-current-page))
+ (pdf-view-goto-page page))
+ (let ((edges (pdf-annot-get-display-edges a)))
+ (when highlight-p
+ (pdf-view-display-image
+ (pdf-view-create-image
+ (pdf-cache-renderpage-highlight
+ page (car size)
+ `("white" "steel blue" 0.35 ,@edges))
+ :map (pdf-view-apply-hotspot-functions
+ window page size))))
+ (pdf-util-scroll-to-edges
+ (pdf-util-scale-relative-to-pixel (car edges)))))))
+
+(defun pdf-annot-read-annotation (&optional prompt)
+ "Let the user choose a annotation a mouse click using PROMPT."
+ (pdf-annot-at-position
+ (pdf-util-read-image-position
+ (or prompt "Choose a annotation by clicking on it"))))
+
+
+;; * ================================================================== *
+;; * Creating annotations
+;; * ================================================================== *
+
+(defun pdf-annot-add-annotation (type edges &optional property-alist page)
+ "Creates and adds a new annotation of type TYPE to the document.
+
+TYPE determines the kind of annotation to add and maybe one of
+`text', `squiggly', `underline', `strike-out' or `highlight'.
+
+EDGES determines where the annotation will appear on the page.
+If type is `text', this should be a single list of \(LEFT TOP
+RIGHT BOT\). Though, in this case only LEFT and TOP are used,
+since the size of text annotations is fixed. Otherwise EDGES may
+be a list of such elements. All values should be image relative
+coordinates, i.e. in the range \[0;1\].
+
+PROPERTY-ALIST is a list of annotation properties, which will be
+put on the created annotation.
+
+PAGE determines the page of the annotation. It defaults to the
+page currently displayed in the selected window.
+
+Signal an error, if PROPERTY-ALIST contains non-modifiable
+properties or PAGE is nil and the selected window does not
+display a PDF document or creating annotations of type TYPE is
+not supported.
+
+Set buffers modified flag and calls
+`pdf-annot-activate-annotation' if
+`pdf-annot-activate-created-annotations' is non-nil.
+
+Return the new annotation."
+
+ (unless (memq type (pdf-info-creatable-annotation-types))
+ (error "Unsupported annotation type: %s" type))
+ (unless page
+ (pdf-util-assert-pdf-window)
+ (setq page (pdf-view-current-page)))
+ (unless (consp (car-safe edges))
+ (setq edges (list edges)))
+ (when (and (eq type 'text)
+ (> (length edges) 1))
+ (error "Edges argument should be a single edge-list for text annotations"))
+ (let* ((a (apply 'pdf-info-addannot
+ page
+ (if (eq type 'text)
+ (car edges)
+ (apply #'pdf-util-edges-union
+ (apply #'append
+ (mapcar
+ (lambda (e)
+ (pdf-info-getselection page e))
+ edges))))
+ type
+ nil
+ (if (not (eq type 'text)) edges)))
+ (id (pdf-annot-get-id a)))
+ (when property-alist
+ (condition-case err
+ (setq a (pdf-info-editannot id property-alist))
+ (error
+ (pdf-info-delannot id)
+ (signal (car err) (cdr err)))))
+ (setq a (pdf-annot-create a))
+ (set-buffer-modified-p t)
+ (pdf-annot-run-modified-hooks :insert a)
+ (when pdf-annot-activate-created-annotations
+ (pdf-annot-activate-annotation a))
+ a))
+
+(defun pdf-annot-add-text-annotation (pos &optional icon property-alist)
+ "Add a new text annotation at POS in the selected window.
+
+POS should be a image position object or a cons \(X . Y\), both
+being image coordinates.
+
+ICON determines how the annotation is displayed and should be
+listed in `pdf-annot-standard-text-icons'. Any other value is ok
+as well, but will render the annotation invisible.
+
+Adjust X and Y accordingly, if the position would render the
+annotation off-page.
+
+Merge ICON as a icon property with PROPERTY-ALIST and
+`pdf-annot-default-text-annotation-properties' and apply the
+result to the created annotation.
+
+See also `pdf-annot-add-annotation'.
+
+Return the new annotation."
+
+ (interactive
+ (let* ((posn (pdf-util-read-image-position
+ "Click where a new text annotation should be added ..."))
+ (window (posn-window posn)))
+ (select-window window)
+ (list posn)))
+ (pdf-util-assert-pdf-window)
+ (when (posnp pos)
+ (setq pos (posn-object-x-y pos)))
+ (let ((isize (pdf-view-image-size))
+ (x (car pos))
+ (y (cdr pos)))
+ (unless (and (>= x 0)
+ (< x (car isize)))
+ (signal 'args-out-of-range (list pos)))
+ (unless (and (>= y 0)
+ (< y (cdr isize)))
+ (signal 'args-out-of-range (list pos)))
+ (let ((size (pdf-util-scale-points-to-pixel
+ pdf-annot-text-annotation-size 'round)))
+ (setcar size (min (car size) (car isize)))
+ (setcdr size (min (cdr size) (cdr isize)))
+ (cl-decf x (max 0 (- (+ x (car size)) (car isize))))
+ (cl-decf y (max 0 (- (+ y (cdr size)) (cdr isize))))
+ (pdf-annot-add-annotation
+ 'text (pdf-util-scale-pixel-to-relative
+ (list x y -1 -1))
+ (pdf-annot-merge-alists
+ (and icon `((icon . ,icon)))
+ property-alist
+ pdf-annot-default-text-annotation-properties
+ (cdr (assq 'text pdf-annot-default-annotation-properties))
+ (cdr (assq t pdf-annot-default-annotation-properties))
+ `((color . ,(car pdf-annot-color-history))))))))
+
+(defun pdf-annot-mouse-add-text-annotation (ev)
+ (interactive "@e")
+ (pdf-annot-add-text-annotation
+ (if (eq (car-safe ev)
+ 'menu-bar)
+ (let (echo-keystrokes)
+ (message nil)
+ (pdf-util-read-image-position
+ "Click where a new text annotation should be added ..."))
+ (event-start ev))))
+
+(defun pdf-annot-add-markup-annotation (list-of-edges type &optional color
+ property-alist)
+ "Add a new markup annotation in the selected window.
+
+LIST-OF-EDGES determines the marked up area and should be a list
+of \(LEFT TOP RIGHT BOT\), each value a relative coordinate.
+
+TYPE should be one of `squiggly', `underline', `strike-out' or
+`highlight'.
+
+Merge COLOR as a color property with PROPERTY-ALIST and
+`pdf-annot-default-markup-annotation-properties' and apply the
+result to the created annotation.
+
+See also `pdf-annot-add-annotation'.
+
+Return the new annotation."
+ (interactive
+ (list (pdf-view-active-region t)
+ (let ((type (completing-read "Markup type (default highlight): "
+ '("squiggly" "highlight" "underline" "strike-out")
+ nil t)))
+ (if (equal type "") 'highlight (intern type)))
+ (pdf-annot-read-color)))
+ (pdf-util-assert-pdf-window)
+ (pdf-annot-add-annotation
+ type
+ list-of-edges
+ (pdf-annot-merge-alists
+ (and color `((color . ,color)))
+ property-alist
+ pdf-annot-default-markup-annotation-properties
+ (cdr (assq type pdf-annot-default-annotation-properties))
+ (cdr (assq t pdf-annot-default-annotation-properties))
+ (when pdf-annot-color-history
+ `((color . ,(car pdf-annot-color-history))))
+ '((color . "#ffff00")))
+ (pdf-view-current-page)))
+
+(defun pdf-annot-add-squiggly-markup-annotation (list-of-edges
+ &optional color property-alist)
+ "Add a new squiggly annotation in the selected window.
+
+See also `pdf-annot-add-markup-annotation'."
+ (interactive (list (pdf-view-active-region t)))
+ (pdf-annot-add-markup-annotation list-of-edges 'squiggly color property-alist))
+
+(defun pdf-annot-add-underline-markup-annotation (list-of-edges
+ &optional color property-alist)
+ "Add a new underline annotation in the selected window.
+
+See also `pdf-annot-add-markup-annotation'."
+ (interactive (list (pdf-view-active-region t)))
+ (pdf-annot-add-markup-annotation list-of-edges 'underline color property-alist))
+
+(defun pdf-annot-add-strikeout-markup-annotation (list-of-edges
+ &optional color property-alist)
+ "Add a new strike-out annotation in the selected window.
+
+See also `pdf-annot-add-markup-annotation'."
+ (interactive (list (pdf-view-active-region t)))
+ (pdf-annot-add-markup-annotation list-of-edges 'strike-out color property-alist))
+
+(defun pdf-annot-add-highlight-markup-annotation (list-of-edges
+ &optional color property-alist)
+ "Add a new highlight annotation in the selected window.
+
+See also `pdf-annot-add-markup-annotation'."
+ (interactive (list (pdf-view-active-region t)))
+ (pdf-annot-add-markup-annotation list-of-edges 'highlight color property-alist))
+
+(defun pdf-annot-read-color (&optional prompt)
+ "Read and return a color using PROMPT.
+
+Offer `pdf-annot-color-history' as default values."
+ (let* ((defaults (append
+ (delq nil
+ (list
+ (cdr (assq 'color
+ pdf-annot-default-markup-annotation-properties))
+ (cdr (assq 'color
+ pdf-annot-default-text-annotation-properties))))
+ pdf-annot-color-history))
+ (prompt
+ (format "%s%s: "
+ (or prompt "Color")
+ (if defaults (format " (default %s)" (car defaults)) "")))
+ (current-completing-read-function completing-read-function)
+ (completing-read-function
+ (lambda (prompt collection &optional predicate require-match
+ initial-input _hist _def inherit-input-method)
+ (funcall current-completing-read-function
+ prompt collection predicate require-match
+ initial-input 'pdf-annot-color-history
+ defaults
+ inherit-input-method))))
+ (read-color prompt)))
+
+(defun pdf-annot-merge-alists (&rest alists)
+ "Merge ALISTS into a single one.
+
+Suppresses successive duplicate entries of keys after the first
+occurrence in ALISTS."
+
+ (let (merged)
+ (dolist (elt (apply 'append alists))
+ (unless (assq (car elt) merged)
+ (push elt merged)))
+ (nreverse merged)))
+
+
+
+;; * ================================================================== *
+;; * Displaying annotation contents
+;; * ================================================================== *
+
+(defun pdf-annot-print-property (a property)
+ "Pretty print annotation A's property PROPERTY."
+ (let ((value (pdf-annot-get a property)))
+ (cl-case property
+ (color
+ (propertize (or value "")
+ 'face (and value
+ `(:background ,value))))
+ ((created modified)
+ (let ((date value))
+ (if (null date)
+ "No date"
+ (current-time-string date))))
+ ;; print verbatim
+ (subject
+ (or value "No subject"))
+ (opacity
+ (let ((opacity (or value 1.0)))
+ (format "%d%%" (round (* 100 opacity)))))
+ (t (format "%s" (or value ""))))))
+
+(defun pdf-annot-print-annotation (a)
+ "Pretty print annotation A."
+ (or (run-hook-with-args-until-success
+ 'pdf-annot-print-annotation-functions a)
+ (pdf-annot-print-annotation-default a)))
+
+(defun pdf-annot-print-annotation-default (a)
+ "Default pretty printer for annotation A.
+
+The result consists of a header (as printed with
+`pdf-annot-print-annotation-header') a newline and A's contents
+property."
+ (concat
+ (pdf-annot-print-annotation-header a)
+ "\n"
+ (pdf-annot-get a 'contents)))
+
+(defun pdf-annot-print-annotation-header (a)
+ "Emit a suitable header string for annotation A."
+ (let ((header
+ (cond
+ ((eq 'file (pdf-annot-get a 'type))
+ (let ((att (pdf-annot-get-attachment a)))
+ (format "File attachment `%s' of %s"
+ (or (cdr (assq 'filename att)) "unnamed")
+ (if (cdr (assq 'size att))
+ (format "size %s" (file-size-human-readable
+ (cdr (assq 'size att))))
+ "unknown size"))))
+ (t
+ (format "%s"
+ (mapconcat
+ 'identity
+ (mapcar
+ (lambda (property)
+ (pdf-annot-print-property
+ a property))
+ `(subject
+ label
+ modified))
+ ";"))))))
+ (setq header (propertize header 'face 'header-line
+ 'intangible t 'read-only t))
+ ;; This `trick' makes the face apply in a tooltip.
+ (propertize header 'display header)))
+
+(defun pdf-annot-print-annotation-latex-maybe (a)
+ "Maybe print annotation A's content as a LaTeX fragment.
+
+See `pdf-annot-latex-string-predicate'."
+ (when (and (functionp pdf-annot-latex-string-predicate)
+ (funcall pdf-annot-latex-string-predicate
+ (pdf-annot-get a 'contents)))
+ (pdf-annot-print-annotation-latex a)))
+
+(defun pdf-annot-print-annotation-latex (a)
+ "Print annotation A's content as a LaTeX fragment.
+
+This compiles A's contents as a LaTeX fragment and puts the
+resulting image as a display property on the contents, prefixed
+by a header."
+
+ (let (tempfile)
+ (unwind-protect
+ (with-current-buffer (pdf-annot-get-buffer a)
+ (let* ((page (pdf-annot-get a 'page))
+ (header (pdf-annot-print-annotation-header a))
+ (contents (pdf-annot-get a 'contents))
+ (hash (sxhash (format
+ "pdf-annot-print-annotation-latex%s%s%s"
+ page header contents)))
+ (data (pdf-cache-lookup-image page 0 nil hash))
+ (org-format-latex-header
+ pdf-annot-latex-header)
+ (temporary-file-directory
+ (pdf-util-expand-file-name "pdf-annot-print-annotation-latex")))
+ (unless (file-directory-p temporary-file-directory)
+ (make-directory temporary-file-directory))
+ (unless data
+ (setq tempfile (make-temp-file "pdf-annot" nil ".png"))
+ ;; FIXME: Why is this with-temp-buffer needed (which it is) ?
+ (with-temp-buffer
+ (org-create-formula-image
+ contents tempfile org-format-latex-options t))
+ (setq data (pdf-util-munch-file tempfile))
+ (if (and (> (length data) 3)
+ (equal (substring data 1 4)
+ "PNG"))
+ (pdf-cache-put-image page 0 data hash)
+ (setq data nil)))
+ (concat
+ header
+ "\n"
+ (if data
+ (propertize
+ contents 'display (pdf-view-create-image data))
+ (propertize
+ contents
+ 'display
+ (concat
+ (propertize "Failed to compile latex fragment\n"
+ 'face 'error)
+ contents))))))
+ (when (and tempfile
+ (file-exists-p tempfile))
+ (delete-file tempfile)))))
+
+
+;; * ================================================================== *
+;; * Editing annotation contents
+;; * ================================================================== *
+
+(defvar-local pdf-annot-edit-contents--annotation nil)
+(put 'pdf-annot-edit-contents--annotation 'permanent-local t)
+(defvar-local pdf-annot-edit-contents--buffer nil)
+
+(defcustom pdf-annot-edit-contents-setup-function
+ (lambda (a)
+ (let ((mode (if (funcall pdf-annot-latex-string-predicate
+ (pdf-annot-get a 'contents))
+ 'latex-mode
+ 'text-mode)))
+ (unless (derived-mode-p mode)
+ (funcall mode))))
+ "A function for setting up, e.g. the major-mode, of the edit buffer.
+
+The function receives one argument, the annotation whose contents
+is about to be edited in this buffer.
+
+The default value turns on `latex-mode' if
+`pdf-annot-latex-string-predicate' returns non-nil on the
+annotation's contents and otherwise `text-mode'. "
+ :group 'pdf-annot
+ :type 'function)
+
+(defcustom pdf-annot-edit-contents-display-buffer-action
+ '((display-buffer-reuse-window
+ display-buffer-split-below-and-attach)
+ (inhibit-same-window . t)
+ (window-height . 0.25))
+ "Display action when showing the edit buffer."
+ :group 'pdf-annot
+ :type display-buffer--action-custom-type)
+
+(defvar pdf-annot-edit-contents-minor-mode-map
+ (let ((kmap (make-sparse-keymap)))
+ (set-keymap-parent kmap text-mode-map)
+ (define-key kmap (kbd "C-c C-c") 'pdf-annot-edit-contents-commit)
+ (define-key kmap (kbd "C-c C-q") 'pdf-annot-edit-contents-abort)
+ kmap))
+
+(define-minor-mode pdf-annot-edit-contents-minor-mode
+ "Active when editing the contents of annotations."
+ nil nil nil
+ (when pdf-annot-edit-contents-minor-mode
+ (message "%s"
+ (substitute-command-keys
+ "Press \\[pdf-annot-edit-contents-commit] to commit your changes, \\[pdf-annot-edit-contents-abort] to abandon them."))))
+
+(put 'pdf-annot-edit-contents-minor-mode 'permanent-local t)
+
+;; FIXME: Document pdf-annot-edit-* functions below.
+(defun pdf-annot-edit-contents-finalize (do-save &optional do-kill)
+ (when (buffer-modified-p)
+ (cond
+ ((eq do-save 'ask)
+ (save-window-excursion
+ (display-buffer (current-buffer) nil (selected-frame))
+ (when (y-or-n-p "Save changes to this annotation ?")
+ (pdf-annot-edit-contents-save-annotation))))
+ (do-save
+ (pdf-annot-edit-contents-save-annotation)))
+ (set-buffer-modified-p nil))
+ (dolist (win (get-buffer-window-list))
+ (quit-window do-kill win)))
+
+(defun pdf-annot-edit-contents-save-annotation ()
+ (when pdf-annot-edit-contents--annotation
+ (pdf-annot-put pdf-annot-edit-contents--annotation
+ 'contents
+ (buffer-substring-no-properties (point-min) (point-max)))
+ (set-buffer-modified-p nil)))
+
+(defun pdf-annot-edit-contents-commit ()
+ (interactive)
+ (pdf-annot-edit-contents-finalize t))
+
+(defun pdf-annot-edit-contents-abort ()
+ (interactive)
+ (pdf-annot-edit-contents-finalize nil t))
+
+(defun pdf-annot-edit-contents-noselect (a)
+ (with-current-buffer (pdf-annot-get-buffer a)
+ (when (and (buffer-live-p pdf-annot-edit-contents--buffer)
+ (not (eq a pdf-annot-edit-contents--annotation)))
+ (with-current-buffer pdf-annot-edit-contents--buffer
+ (pdf-annot-edit-contents-finalize 'ask)))
+ (unless (buffer-live-p pdf-annot-edit-contents--buffer)
+ (setq pdf-annot-edit-contents--buffer
+ (with-current-buffer (get-buffer-create
+ (format "*Edit Annotation %s*"
+ (buffer-name)))
+ (pdf-annot-edit-contents-minor-mode 1)
+ (current-buffer))))
+ (with-current-buffer pdf-annot-edit-contents--buffer
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (save-excursion (insert (pdf-annot-get a 'contents)))
+ (set-buffer-modified-p nil))
+ (setq pdf-annot-edit-contents--annotation a)
+ (funcall pdf-annot-edit-contents-setup-function a)
+ (current-buffer))))
+
+(defun pdf-annot-edit-contents (a)
+ (select-window
+ (display-buffer
+ (pdf-annot-edit-contents-noselect a)
+ pdf-annot-edit-contents-display-buffer-action)))
+
+(defun pdf-annot-edit-contents-mouse (ev)
+ (interactive "@e")
+ (let* ((pos (posn-object-x-y (event-start ev)))
+ (a (and pos (pdf-annot-at-position pos))))
+ (unless a
+ (error "No annotation at this position"))
+ (pdf-annot-edit-contents a)))
+
+
+
+;; * ================================================================== *
+;; * Listing annotations
+;; * ================================================================== *
+
+(defcustom pdf-annot-list-display-buffer-action
+ '((display-buffer-reuse-window
+ display-buffer-pop-up-window)
+ (inhibit-same-window . t))
+ "Display action used when displaying the list buffer."
+ :group 'pdf-annot
+ :type display-buffer--action-custom-type)
+
+(defcustom pdf-annot-list-format
+ '((page . 3)
+ (type . 10)
+ (label . 24)
+ (date . 24))
+ "Annotation properties visible in the annotation list.
+
+It should be a list of \(PROPERTIZE. WIDTH\), where PROPERTY is a
+symbol naming one of supported properties to list and WIDTH its
+desired column-width.
+
+Currently supported properties are page, type, label, date and contents."
+ :type '(alist :key-type (symbol))
+ :options '((page (integer :value 3 :tag "Column Width"))
+ (type (integer :value 10 :tag "Column Width" ))
+ (label (integer :value 24 :tag "Column Width"))
+ (date (integer :value 24 :tag "Column Width"))
+ (contents (integer :value 56 :tag "Column Width")))
+ :group 'pdf-annot)
+
+(defcustom pdf-annot-list-highlight-type nil
+ "Whether to highlight \"Type\" column annotation list with annotation color."
+ :group 'pdf-annot
+ :type 'boolean)
+
+(defvar-local pdf-annot-list-buffer nil)
+
+(defvar-local pdf-annot-list-document-buffer nil)
+
+(defvar pdf-annot-list-mode-map
+ (let ((km (make-sparse-keymap)))
+ (define-key km (kbd "C-c C-f") 'pdf-annot-list-follow-minor-mode)
+ (define-key km (kbd "SPC") 'pdf-annot-list-display-annotation-from-id)
+ km))
+
+(defun pdf-annot-property-completions (property)
+ "Return a list of completion candidates for annotation property PROPERTY.
+
+Return nil, if not available."
+ (cl-case property
+ (color (pdf-util-color-completions))
+ (icon (copy-sequence pdf-annot-standard-text-icons))))
+
+(defun pdf-annot-compare-annotations (a1 a2)
+ "Compare annotations A1 and A2.
+
+Return non-nil if A1's page is less than A2's one or if they
+belong to the same page and A1 is displayed above/left of A2."
+ (let ((p1 (pdf-annot-get a1 'page))
+ (p2 (pdf-annot-get a2 'page)))
+ (or (< p1 p2)
+ (and (= p1 p2)
+ (let ((e1 (pdf-util-scale
+ (car (pdf-annot-get-display-edges a1))
+ '(1000 . 1000)))
+ (e2 (pdf-util-scale
+ (car (pdf-annot-get-display-edges a2))
+ '(1000 . 1000))))
+ (pdf-util-with-edges (e1 e2)
+ (or (< e1-top e2-top)
+ (and (= e1-top e2-top)
+ (<= e1-left e2-left)))))))))
+
+(defun pdf-annot-list-entries ()
+ (unless (buffer-live-p pdf-annot-list-document-buffer)
+ (error "No PDF document associated with this buffer"))
+ (mapcar 'pdf-annot-list-create-entry
+ (sort (pdf-annot-getannots nil pdf-annot-list-listed-types
+ pdf-annot-list-document-buffer)
+ 'pdf-annot-compare-annotations)))
+
+(defun pdf-annot--make-entry-formatter (a)
+ (lambda (fmt)
+ (let ((entry-type (car fmt))
+ (entry-width (cdr fmt))
+ ;; Taken from css-mode.el
+ (contrasty-color
+ (lambda (name)
+ (if (> (color-distance name "black") 292485)
+ "black" "white")))
+ (prune-newlines
+ (lambda (str)
+ (replace-regexp-in-string "\n" " " str t t))))
+ (cl-ecase entry-type
+ (date (pdf-annot-print-property a 'modified))
+ (page (pdf-annot-print-property a 'page))
+ (label (funcall prune-newlines
+ (pdf-annot-print-property a 'label)))
+ (contents
+ (truncate-string-to-width
+ (funcall prune-newlines
+ (pdf-annot-print-property a 'contents))
+ entry-width))
+ (type
+ (let ((color (pdf-annot-get a 'color))
+ (type (pdf-annot-print-property a 'type)))
+ (if pdf-annot-list-highlight-type
+ (propertize
+ type 'face
+ `(:background ,color
+ :foreground ,(funcall contrasty-color color)))
+ type)))))))
+
+(defun pdf-annot-list-create-entry (a)
+ "Create a `tabulated-list-entries' entry for annotation A."
+ (list (pdf-annot-get-id a)
+ (vconcat
+ (mapcar (pdf-annot--make-entry-formatter a)
+ pdf-annot-list-format))))
+
+(define-derived-mode pdf-annot-list-mode tablist-mode "Annots"
+ (let* ((page-sorter
+ (lambda (a b)
+ (< (string-to-number (aref (cadr a) 0))
+ (string-to-number (aref (cadr b) 0)))))
+ (format-generator
+ (lambda (format)
+ (let ((field (car format))
+ (width (cdr format)))
+ (cl-case field
+ (page `("Pg." 3 ,page-sorter :read-only t :right-alight t))
+ (t (list
+ (capitalize (symbol-name field))
+ width t :read-only t)))))))
+ (setq tabulated-list-entries 'pdf-annot-list-entries
+ tabulated-list-format (vconcat
+ (mapcar
+ format-generator
+ pdf-annot-list-format))
+ tabulated-list-padding 2))
+ (set-keymap-parent pdf-annot-list-mode-map tablist-mode-map)
+ (use-local-map pdf-annot-list-mode-map)
+ (when (assq 'type pdf-annot-list-format)
+ (setq tablist-current-filter
+ `(not (== "Type" "link"))))
+ (tabulated-list-init-header))
+
+(defun pdf-annot-list-annotations ()
+ "List annotations in a dired like buffer.
+
+\\{pdf-annot-list-mode-map}"
+ (interactive)
+ (pdf-util-assert-pdf-buffer)
+ (let ((buffer (current-buffer)))
+ (with-current-buffer (get-buffer-create
+ (format "*%s's annots*"
+ (file-name-sans-extension
+ (buffer-name))))
+ (delay-mode-hooks
+ (unless (derived-mode-p 'pdf-annot-list-mode)
+ (pdf-annot-list-mode))
+ (setq pdf-annot-list-document-buffer buffer)
+ (tabulated-list-print)
+ (setq tablist-context-window-function
+ (lambda (id) (pdf-annot-list-context-function id buffer))
+ tablist-operations-function 'pdf-annot-list-operation-function)
+ (let ((list-buffer (current-buffer)))
+ (with-current-buffer buffer
+ (setq pdf-annot-list-buffer list-buffer))))
+ (run-mode-hooks)
+ (pop-to-buffer
+ (current-buffer)
+ pdf-annot-list-display-buffer-action)
+ (tablist-move-to-major-column)
+ (tablist-display-context-window))
+ (add-hook 'pdf-info-close-document-hook
+ 'pdf-annot-list-update nil t)
+ (add-hook 'pdf-annot-modified-functions
+ 'pdf-annot-list-update nil t)))
+
+(defun pdf-annot-list-goto-annotation (a)
+ (with-current-buffer (pdf-annot-get-buffer a)
+ (unless (and (buffer-live-p pdf-annot-list-buffer)
+ (get-buffer-window pdf-annot-list-buffer))
+ (pdf-annot-list-annotations))
+ (with-selected-window (get-buffer-window pdf-annot-list-buffer)
+ (goto-char (point-min))
+ (let ((id (pdf-annot-get-id a)))
+ (while (and (not (eobp))
+ (not (eq id (tabulated-list-get-id))))
+ (forward-line))
+ (unless (eq id (tabulated-list-get-id))
+ (error "Unable to find annotation"))
+ (when (invisible-p (point))
+ (tablist-suspend-filter t))
+ (tablist-move-to-major-column)))))
+
+
+(defun pdf-annot-list-update (&optional _fn)
+ (when (buffer-live-p pdf-annot-list-buffer)
+ (with-current-buffer pdf-annot-list-buffer
+ (unless tablist-edit-column-minor-mode
+ (tablist-revert))
+ (tablist-context-window-update))))
+
+(defun pdf-annot-list-context-function (id buffer)
+ (with-current-buffer (get-buffer-create "*Contents*")
+ (set-window-buffer nil (current-buffer))
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (when id
+ (save-excursion
+ (insert
+ (pdf-annot-print-annotation
+ (pdf-annot-getannot id buffer)))))
+ (read-only-mode 1))))
+
+(defun pdf-annot-list-operation-function (op &rest args)
+ (cl-ecase op
+ (supported-operations '(delete find-entry))
+ (delete
+ (cl-destructuring-bind (ids)
+ args
+ (when (buffer-live-p pdf-annot-list-document-buffer)
+ (with-current-buffer pdf-annot-list-document-buffer
+ (pdf-annot-with-atomic-modifications
+ (dolist (a (mapcar 'pdf-annot-getannot ids))
+ (pdf-annot-delete a)))))))
+ (find-entry
+ (cl-destructuring-bind (id)
+ args
+ (unless (buffer-live-p pdf-annot-list-document-buffer)
+ (error "No PDF document associated with this buffer"))
+ (let* ((buffer pdf-annot-list-document-buffer)
+ (a (pdf-annot-getannot id buffer))
+ (pdf-window (save-selected-window
+ (or (get-buffer-window buffer)
+ (display-buffer buffer))))
+ window)
+ (with-current-buffer buffer
+ (pdf-annot-activate-annotation a)
+ (setq window (selected-window)))
+ ;; Make it so that quitting the edit window returns to the
+ ;; list window.
+ (unless (memq window (list (selected-window) pdf-window))
+ (let* ((quit-restore
+ (window-parameter window 'quit-restore)))
+ (when quit-restore
+ (setcar (nthcdr 2 quit-restore) (selected-window))))))))))
+
+(defvar pdf-annot-list-display-annotation--timer nil)
+
+(defun pdf-annot-list-display-annotation-from-id (id)
+ (interactive (list (tabulated-list-get-id)))
+ (when id
+ (unless (buffer-live-p pdf-annot-list-document-buffer)
+ (error "PDF buffer was killed"))
+ (when (timerp pdf-annot-list-display-annotation--timer)
+ (cancel-timer pdf-annot-list-display-annotation--timer))
+ (setq pdf-annot-list-display-annotation--timer
+ (run-with-idle-timer 0.1 nil
+ (lambda (buffer a)
+ (when (buffer-live-p buffer)
+ (with-selected-window
+ (or (get-buffer-window buffer)
+ (display-buffer
+ buffer
+ '(nil (inhibit-same-window . t))))
+ (pdf-annot-show-annotation a t))))
+ pdf-annot-list-document-buffer
+ (pdf-annot-getannot id pdf-annot-list-document-buffer)))))
+
+(define-minor-mode pdf-annot-list-follow-minor-mode
+ "" nil nil nil
+ (unless (derived-mode-p 'pdf-annot-list-mode)
+ (error "No in pdf-annot-list-mode."))
+ (cond
+ (pdf-annot-list-follow-minor-mode
+ (add-hook 'tablist-selection-changed-functions
+ 'pdf-annot-list-display-annotation-from-id nil t)
+ (let ((id (tabulated-list-get-id)))
+ (when id
+ (pdf-annot-list-display-annotation-from-id id))))
+ (t
+ (remove-hook 'tablist-selection-changed-functions
+ 'pdf-annot-list-display-annotation-from-id t))))
+
+(provide 'pdf-annot)
+;;; pdf-annot.el ends here
Copyright 2019--2024 Marius PETER