pdf-annot.el - dotemacs - My Emacs configuration

pdf-annot.el (71670B)
      1 ;;; pdf-annot.el --- Annotation support for PDF files.  -*- lexical-binding: t -*-
      2 
      3 ;; Copyright (C) 2013, 2014  Andreas Politz
      4 
      5 ;; Author: Andreas Politz <politza@fh-trier.de>
      6 ;; Keywords:
      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 
     25 (require 'pdf-view)
     26 (require 'pdf-info)
     27 (require 'pdf-cache)
     28 (require 'pdf-misc)
     29 (require 'facemenu) ;; list-colors-duplicates
     30 (require 'faces) ;; color-values
     31 (require 'org)   ;; org-create-formula-image
     32 (require 'tablist)
     33 (require 'cl-lib)
     34 
     35 
     36 ;; * ================================================================== *
     37 ;; * Customizations
     38 ;; * ================================================================== *
     39 
     40 ;;; Code:
     41 
     42 (defgroup pdf-annot nil
     43   "Annotation support for PDF documents."
     44   :group 'pdf-tools)
     45 
     46 (defcustom pdf-annot-activate-handler-functions nil
     47   "A list of functions to activate a annotation.
     48 
     49 The functions on this hook will be called when some annotation is
     50 activated, usually by a mouse-click.  Each one is called with the
     51 annotation as a single argument and it should return a non-nil
     52 value if it has `handled' it.  If no such function exists, the
     53 default handler `pdf-annot-default-activate-handler' will be
     54 called.
     55 
     56 This hook is meant to allow for custom annotations.  FIXME:
     57 Implement and describe basic org example."
     58   :type 'hook)
     59 
     60 (defcustom pdf-annot-default-text-annotation-properties nil
     61   "Alist of initial properties for new text annotations."
     62   :type '(alist :key-type symbol :value-type sexp))
     63 
     64 (defcustom pdf-annot-default-markup-annotation-properties nil
     65   "Alist of initial properties for new markup annotations."
     66   :type '(alist :key-type symbol :value-type sexp))
     67 
     68 (make-obsolete-variable 'pdf-annot-default-text-annotation-properties
     69                         'pdf-annot-default-annotation-properties
     70                         "0.90")
     71 
     72 (make-obsolete-variable 'pdf-annot-default-markup-annotation-properties
     73                         'pdf-annot-default-annotation-properties
     74                         "0.90")
     75 
     76 (defcustom pdf-annot-default-annotation-properties
     77   `((t (label . ,user-full-name))
     78     (text (icon . "Note")
     79           (color . "#ff0000"))
     80     (highlight (color . "yellow"))
     81     (squiggly (color . "orange"))
     82     (strike-out(color . "red"))
     83     (underline (color . "blue")))
     84   "An alist of initial properties for new annotations.
     85 
     86 The alist contains a sub-alist for each of the currently available
     87 annotation types, i.e. text, highlight, squiggly, strike-out and
     88 underline.  Additionally a sub-alist with a key of t acts as a default
     89 entry.
     90 
     91 Each of these sub-alists contain default property-values of newly
     92 added annotations of its respective type.
     93 
     94 Some of the most important properties and their types are label
     95 \(a string\), contents \(a string\), color \(a color\) and, for
     96 text-annotations only, icon \(one of the standard icon-types, see
     97 `pdf-annot-standard-text-icons'\).
     98 
     99 For example a value of
    100 
    101   \(\(t \(color . \"red\"\)
    102       \(label . \"Joe\"\)
    103    \(highlight \(color . \"green\"\)\)
    104 
    105 would use a green color for highlight and a red one for other
    106 annotations.  Additionally the label for all annotations is set
    107 to \"Joe\"."
    108 
    109   :type (let* ((label '(cons :tag "Label" (const label) string))
    110                (contents '(cons :tag "Contents" (const contents) string))
    111                (color '(cons :tag "Color" (const color) color))
    112                (icon `(cons :tag "Icon"
    113                             (const icon)
    114                             (choice
    115                              ,@(mapcar (lambda (icon)
    116                                          `(const ,icon))
    117                                        '("Note" "Comment" "Key" "Help" "NewParagraph"
    118                                          "Paragraph" "Insert" "Cross" "Circle")))))
    119                (other '(repeat
    120                         :tag "Other properties"
    121                         (cons :tag "Property"
    122                               (symbol :tag "Key  ")
    123                               (sexp :tag "Value"))))
    124                (text-properties
    125                 `(set ,label ,contents ,color ,icon ,other))
    126                (markup-properties
    127                 `(set ,label ,contents ,color))
    128                (all-properties
    129                 `(set ,label ,contents ,color ,icon ,other)))
    130           `(set
    131             (cons :tag "All Annotations" (const t) ,all-properties)
    132             (cons :tag "Text Annotations" (const text) ,text-properties)
    133             (cons :tag "Highlight Annotations" (const highlight) ,markup-properties)
    134             (cons :tag "Underline Annotations" (const underline) ,markup-properties)
    135             (cons :tag "Squiggly Annotations" (const squiggly) ,markup-properties)
    136             (cons :tag "Strike-out Annotations" (const strike-out) ,markup-properties))))
    137 
    138 (defcustom pdf-annot-print-annotation-functions
    139   '(pdf-annot-print-annotation-latex-maybe)
    140   "A alist of functions for printing annotations, e.g. for the tooltip.
    141 
    142 The functions receive the annotation as single argument and
    143 should return either a string or nil.  The first string returned
    144 will be used.
    145 
    146 If all of them return nil, the default function
    147 `pdf-annot-print-annotation-default' is used."
    148   :type 'hook)
    149 
    150 (defcustom pdf-annot-latex-string-predicate
    151   (lambda (str)
    152     (and str (string-match "\\`[[:space:]\n]*[$\\]" str)))
    153   "A predicate for recognizing LaTeX fragments.
    154 
    155 It receives a string and should return non-nil, if string is a
    156 LaTeX fragment."
    157   :type 'function)
    158 
    159 (defcustom pdf-annot-latex-header
    160   (concat org-format-latex-header
    161           "\n\\setlength{\\textwidth}{12cm}")
    162   "Header used when latex compiling annotations.
    163 The default value is `org-format-latex-header' +
    164 \"\\n\\\\setlength{\\\\textwidth}{12cm}\"."
    165   :type 'string)
    166 
    167 (defcustom pdf-annot-tweak-tooltips t
    168   "Whether this package should tweak some settings regarding tooltips.
    169 
    170 If this variable has a non-nil value,
    171 
    172 `x-gtk-use-system-tooltips' is set to nil if appropriate, in
    173 order to display text properties;
    174 
    175 `tooltip-hide-delay' is set to infinity, in order to not being
    176 annoyed while reading the annotations."
    177   :type 'boolean)
    178 
    179 (defcustom pdf-annot-activate-created-annotations nil
    180   "Whether to activate (i.e. edit) created annotations."
    181   :type 'boolean)
    182 
    183 (defcustom pdf-annot-attachment-display-buffer-action nil
    184   "The display action used when displaying attachments."
    185   :type display-buffer--action-custom-type)
    186 
    187 (defconst pdf-annot-annotation-types
    188   '(3d caret circle file
    189        free-text highlight ink line link movie poly-line polygon popup
    190        printer-mark screen sound square squiggly stamp strike-out text
    191        trap-net underline unknown watermark widget)
    192   "Complete list of annotation types.")
    193 
    194 (defcustom pdf-annot-list-listed-types
    195   (if (pdf-info-markup-annotations-p)
    196       (list 'text 'file 'squiggly 'highlight 'underline 'strike-out)
    197     (list 'text 'file))
    198   "A list of annotation types displayed in the list buffer."
    199   :type `(set ,@(mapcar (lambda (type)
    200                           (list 'const type))
    201                         pdf-annot-annotation-types)))
    202 
    203 
    204 ;; * ================================================================== *
    205 ;; * Variables and Macros
    206 ;; * ================================================================== *
    207 
    208 (defvar pdf-annot-color-history nil
    209   "A list of recently used colors for annotations.")
    210 
    211 (defvar-local pdf-annot-modified-functions nil
    212   "Functions to call, when an annotation was modified.
    213 
    214 A function on this hook should accept one argument: A CLOSURE
    215 containing inserted, changed and deleted annotations.
    216 
    217 It may access these annotations by calling CLOSURE with one of
    218 these arguments:
    219 
    220 `:inserted' The list of recently added annotations.
    221 
    222 `:deleted' The list of recently deleted annotations.
    223 
    224 `:changed' The list of recently changed annotations.
    225 
    226 t The union of recently added, deleted or changed annotations.
    227 
    228 nil Just returns nil.
    229 
    230 Any other argument signals an error.")
    231 
    232 (defconst pdf-annot-text-annotation-size '(24 . 24)
    233   "The Size of text and file annotations in PDF points.
    234 
    235 These values are hard-coded in poppler.  And while the size of
    236 these annotations may be changed, i.e. the edges property, it has
    237 no effect on the rendering.")
    238 
    239 (defconst pdf-annot-markup-annotation-types
    240   '(text link free-text line square
    241          circle polygon poly-line highlight underline squiggly
    242          strike-out stamp caret ink file sound)
    243   "List of defined markup annotation types.")
    244 
    245 (defconst pdf-annot-standard-text-icons
    246   '("Note" "Comment" "Key" "Help" "NewParagraph"
    247     "Paragraph" "Insert" "Cross" "Circle")
    248   "A list of standard icon properties for text annotations.")
    249 
    250 (defvar pdf-annot-inhibit-modification-hooks nil
    251   "Controls the behavior of `pdf-annot-modified-functions'.
    252 
    253 If non-nil, `pdf-annot-modified-functions' are not run on any
    254 annotation change.")
    255 
    256 (defvar-local pdf-annot-delayed-modified-annotations nil
    257   "A plist of not yet propagated modifications.
    258 
    259 It contains three entries :change, :delete and :insert.  Each one
    260 having a list of annotations as value.")
    261 
    262 (defvar-local pdf-annot--attachment-file-alist nil
    263   "Alist mapping attachment ids to unique relative filenames.")
    264 
    265 (defmacro pdf-annot-with-atomic-modifications (&rest body)
    266   "Execute BODY joining multiple modifications.
    267 
    268 The effect is, that `pdf-annot-modified-functions' will be called
    269 only once at the end of BODY.
    270 
    271 BODY should not modify annotations in a different then the
    272 current buffer, because that won't run the hooks properly."
    273   (declare (indent 0) (debug t))
    274   `(unwind-protect
    275        (save-current-buffer
    276          (let ((pdf-annot-inhibit-modification-hooks t))
    277            (progn ,@body)))
    278      (pdf-annot-run-modified-hooks)))
    279 
    280 
    281 ;; * ================================================================== *
    282 ;; * Minor mode
    283 ;; * ================================================================== *
    284 
    285 (defcustom pdf-annot-minor-mode-map-prefix (kbd "C-c C-a")
    286   "The prefix to use for `pdf-annot-minor-mode-map'.
    287 
    288 Setting this after the package was loaded has no effect."
    289   :type 'key-sequence)
    290 
    291 (defvar pdf-annot-minor-mode-map
    292   (let ((kmap (make-sparse-keymap))
    293         (smap (make-sparse-keymap)))
    294     (define-key kmap pdf-annot-minor-mode-map-prefix smap)
    295     (define-key smap "l" #'pdf-annot-list-annotations)
    296     (define-key smap "a" #'pdf-annot-attachment-dired)
    297     (when (pdf-info-writable-annotations-p)
    298       (define-key smap "D" #'pdf-annot-delete)
    299       (define-key smap "t" #'pdf-annot-add-text-annotation)
    300       (when (pdf-info-markup-annotations-p)
    301         (define-key smap "m" #'pdf-annot-add-markup-annotation)
    302         (define-key smap "s" #'pdf-annot-add-squiggly-markup-annotation)
    303         (define-key smap "u" #'pdf-annot-add-underline-markup-annotation)
    304         (define-key smap "o" #'pdf-annot-add-strikeout-markup-annotation)
    305         (define-key smap "h" #'pdf-annot-add-highlight-markup-annotation)))
    306     kmap)
    307   "Keymap used for `pdf-annot-minor-mode'.")
    308 
    309 (defvar savehist-minibuffer-history-variables)
    310 
    311 ;;;###autoload
    312 (define-minor-mode pdf-annot-minor-mode
    313   "Support for PDF Annotations.
    314 
    315 \\{pdf-annot-minor-mode-map}"
    316   :group 'pdf-annot
    317   (cond
    318    (pdf-annot-minor-mode
    319     (when pdf-annot-tweak-tooltips
    320       (when (boundp 'x-gtk-use-system-tooltips)
    321         (setq x-gtk-use-system-tooltips nil))
    322       (setq tooltip-hide-delay 3600))
    323     (pdf-view-add-hotspot-function 'pdf-annot-hotspot-function 9)
    324     (add-hook 'pdf-info-close-document-hook
    325               #'pdf-annot-attachment-delete-base-directory nil t)
    326     (when (featurep 'savehist)
    327       (add-to-list 'savehist-minibuffer-history-variables
    328                    'pdf-annot-color-history)))
    329    (t
    330     (pdf-view-remove-hotspot-function 'pdf-annot-hotspot-function)
    331     (remove-hook 'pdf-info-close-document-hook
    332                  #'pdf-annot-attachment-delete-base-directory t)))
    333   (pdf-view-redisplay t))
    334 
    335 (defun pdf-annot-create-context-menu (a)
    336   "Create a appropriate context menu for annotation A."
    337   (let ((menu (make-sparse-keymap)))
    338     ;; (when (and (bound-and-true-p pdf-misc-menu-bar-minor-mode)
    339     ;;            (bound-and-true-p pdf-misc-install-popup-menu))
    340     ;;   (set-keymap-parent menu
    341     ;;                      (lookup-key pdf-misc-menu-bar-minor-mode-map
    342     ;;                                  [menu-bar pdf-tools]))
    343     ;;   (define-key menu [sep-99] menu-bar-separator))
    344     (when (pdf-info-writable-annotations-p)
    345       (define-key menu [delete-annotation]
    346         `(menu-item "Delete annotation"
    347                     ,(lambda ()
    348                        (interactive)
    349                        (pdf-annot-delete a)
    350                        (message "Annotation deleted"))
    351                     :help
    352                     "Delete this annotation.")))
    353     (define-key menu [goto-annotation]
    354       `(menu-item "List annotation"
    355                   ,(lambda ()
    356                      (interactive)
    357                      (pdf-annot-show-annotation a t)
    358                      (pdf-annot-list-annotations)
    359                      (pdf-annot-list-goto-annotation a))
    360                   :help "Find this annotation in the list buffer."))
    361     (when (pdf-annot-text-annotation-p a)
    362       (define-key menu [change-text-icon]
    363         `(menu-item "Change icon"
    364                     ,(pdf-annot-create-icon-submenu a)
    365                     :help "Change the appearance of this annotation.")))
    366     (define-key menu [change-color]
    367       `(menu-item "Change color"
    368                   ,(pdf-annot-create-color-submenu a)
    369                   :help "Change the appearance of this annotation."))
    370     (define-key menu [activate-annotation]
    371       `(menu-item "Activate"
    372                   ,(lambda ()
    373                      (interactive)
    374                      (pdf-annot-activate-annotation a))
    375                   :help "Activate this annotation."))
    376     menu))
    377 
    378 (defun pdf-annot-create-color-submenu (a)
    379   "Show the user a color menu for their annotation A."
    380   (let ((menu (make-sparse-keymap)))
    381     (define-key menu [color-chooser]
    382                 `(menu-item "Choose ..."
    383                             ,(lambda ()
    384                                (interactive)
    385                                (list-colors-display
    386                                 nil "*Choose annotation color*"
    387                                 ;; list-colors-print does not like closures.
    388                                 (let ((callback (make-symbol "xcallback")))
    389                                   (fset callback
    390                                         (lambda (color)
    391                                           (pdf-annot-put a 'color color)
    392                                           (setq pdf-annot-color-history
    393                                                 (cons color
    394                                                       (remove color pdf-annot-color-history)))
    395                                           (quit-window t)))
    396                                   (list 'function callback))))))
    397     (dolist (color (butlast (reverse pdf-annot-color-history)
    398                             (max 0 (- (length pdf-annot-color-history)
    399                                       12))))
    400       (define-key menu (vector (intern (format "color-%s" color)))
    401                   `(menu-item ,color
    402                               ,(lambda nil
    403                                  (interactive)
    404                                  (pdf-annot-put a 'color color)))))
    405     menu))
    406 
    407 (defun pdf-annot-create-icon-submenu (a)
    408   "Show the user an icon menu for the annotation A."
    409   (let ((menu (make-sparse-keymap)))
    410     (dolist (icon (reverse pdf-annot-standard-text-icons))
    411       (define-key menu (vector (intern (format "icon-%s" icon)))
    412                   `(menu-item ,icon
    413                               ,(lambda nil
    414                                  (interactive)
    415                                  (pdf-annot-put a 'icon icon)))))
    416     menu))
    417 
    418 ;; * ================================================================== *
    419 ;; * Annotation Basics
    420 ;; * ================================================================== *
    421 
    422 (defun pdf-annot-create (alist &optional buffer)
    423   "Create a annotation from ALIST in BUFFER.
    424 
    425 ALIST should be a property list as returned by
    426 `pdf-cache-getannots'.  BUFFER should be the buffer of the
    427 corresponding PDF document. It defaults to the current buffer."
    428 
    429   (cons `(buffer . ,(or buffer (current-buffer)))
    430         alist))
    431 
    432 (defun pdf-annot-getannots (&optional pages types buffer)
    433   "Return a list of annotations on PAGES of TYPES in BUFFER.
    434 
    435 See `pdf-info-normalize-pages' for valid values of PAGES.  TYPES
    436 may be a symbol or list of symbols denoting annotation types.
    437 
    438 PAGES defaults to all pages, TYPES to all types and BUFFER to the
    439 current buffer."
    440 
    441   (pdf-util-assert-pdf-buffer buffer)
    442   (unless buffer
    443     (setq buffer (current-buffer)))
    444   (unless (listp types)
    445     (setq types (list types)))
    446   (with-current-buffer buffer
    447     (let (result)
    448       (dolist (a (pdf-info-getannots pages))
    449         (when (or (null types)
    450                   (memq (pdf-annot-get a 'type) types))
    451           (push (pdf-annot-create a) result)))
    452       result)))
    453 
    454 (defun pdf-annot-getannot (id &optional buffer)
    455   "Return the annotation object for annotation ID.
    456 
    457 Optionally take the BUFFER name of the PDF buffer. When none is
    458 provided, the `current-buffer' is picked up."
    459   (pdf-annot-create
    460    (pdf-info-getannot id buffer)
    461    buffer))
    462 
    463 (defun pdf-annot-get (a property &optional default)
    464   "Get annotation A's value of PROPERTY.
    465 
    466 Return DEFAULT, if value is nil."
    467   (or (cdr (assq property a)) default))
    468 
    469 (defun pdf-annot-put (a property value)
    470   "Set annotation A's PROPERTY to VALUE.
    471 
    472 Unless VALUE is `equal' to the current value, sets A's buffer's
    473 modified flag and runs the hook `pdf-annot-modified-functions'.
    474 
    475 Signals an error, if PROPERTY is not modifiable.
    476 
    477 Returns the modified annotation."
    478 
    479   (declare (indent 2))
    480   (unless (equal value (pdf-annot-get a property))
    481     (unless (pdf-annot-property-modifiable-p a property)
    482       (error "Property `%s' is read-only for this annotation"
    483              property))
    484     (with-current-buffer (pdf-annot-get-buffer a)
    485       (setq a (pdf-annot-create
    486                (pdf-info-editannot
    487                 (pdf-annot-get-id a)
    488                 `((,property . ,value)))))
    489       (set-buffer-modified-p t)
    490       (pdf-annot-run-modified-hooks :change a)))
    491   a)
    492 
    493 (defun pdf-annot-run-modified-hooks (&optional operation &rest annotations)
    494   "Run `pdf-annot-modified-functions' using OPERATION on ANNOTATIONS.
    495 
    496 OPERATION should be one of nil, :change, :insert or :delete.  If
    497 nil, annotations should be empty.
    498 
    499 Redisplay modified pages.
    500 
    501 If `pdf-annot-inhibit-modification-hooks' in non-nil, this just
    502 saves ANNOTATIONS and does not call the hooks until later, when
    503 the variable is nil and this function is called again."
    504 
    505   (unless (memq operation '(nil :insert :change :delete))
    506     (error "Invalid operation: %s" operation))
    507   (when (and (null operation) annotations)
    508     (error "Missing operation argument"))
    509 
    510   (when operation
    511     (let ((list (plist-get pdf-annot-delayed-modified-annotations operation)))
    512       (dolist (a annotations)
    513         (cl-pushnew a list :test 'pdf-annot-equal))
    514       (setq pdf-annot-delayed-modified-annotations
    515             (plist-put pdf-annot-delayed-modified-annotations
    516                        operation list))))
    517   (unless pdf-annot-inhibit-modification-hooks
    518     (let* ((changed (plist-get pdf-annot-delayed-modified-annotations :change))
    519            (inserted (mapcar (lambda (a)
    520                                (or (car (cl-member a changed :test 'pdf-annot-equal))
    521                                    a))
    522                              (plist-get pdf-annot-delayed-modified-annotations :insert)))
    523            (deleted (plist-get pdf-annot-delayed-modified-annotations :delete))
    524            (union (cl-union (cl-union changed inserted :test 'pdf-annot-equal)
    525                             deleted :test 'pdf-annot-equal))
    526            (closure (lambda (arg)
    527                       (when arg
    528                         (cl-case arg
    529                           (:inserted (copy-sequence inserted))
    530                           (:changed (copy-sequence changed))
    531                           (:deleted (copy-sequence deleted))
    532                           (t (copy-sequence union))))))
    533            (pages (mapcar (lambda (a) (pdf-annot-get a 'page)) union)))
    534       (when union
    535         (unwind-protect
    536             (run-hook-with-args
    537              'pdf-annot-modified-functions closure)
    538           (setq pdf-annot-delayed-modified-annotations nil)
    539           (apply #'pdf-view-redisplay-pages pages))))))
    540 
    541 (defun pdf-annot-equal (a1 a2)
    542   "Return non-nil, if annotations A1 and A2 are equal.
    543 
    544 Two annotations are equal, if they belong to the same buffer and
    545 have identical id properties."
    546   (and (eq (pdf-annot-get-buffer a1)
    547            (pdf-annot-get-buffer a2))
    548        (eq (pdf-annot-get-id a1)
    549            (pdf-annot-get-id a2))))
    550 
    551 (defun pdf-annot-get-buffer (a)
    552   "Return annotation A's buffer."
    553   (pdf-annot-get a 'buffer))
    554 
    555 (defun pdf-annot-get-id (a)
    556   "Return id property of annotation A."
    557   (pdf-annot-get a 'id))
    558 
    559 (defun pdf-annot-get-type (a)
    560   "Return type property of annotation A."
    561   (pdf-annot-get a 'type))
    562 
    563 (defun pdf-annot-get-display-edges (a)
    564   "Return a list of EDGES used for display for annotation A.
    565 
    566 This returns a list of \(LEFT TOP RIGHT BOT\) demarking the
    567 rectangles of the page where A is rendered."
    568 
    569   (or (pdf-annot-get a 'markup-edges)
    570       (list (pdf-annot-get a 'edges))))
    571 
    572 (defun pdf-annot-delete (a)
    573   "Delete annotation A.
    574 
    575 Sets A's buffer's modified flag and runs the hook
    576 `pdf-annot-modified-functions'.
    577 
    578 This function always returns nil."
    579   (interactive
    580    (list (pdf-annot-read-annotation
    581           "Click on the annotation you wish to delete")))
    582   (with-current-buffer (pdf-annot-get-buffer a)
    583     (pdf-info-delannot
    584      (pdf-annot-get-id a))
    585     (set-buffer-modified-p t)
    586     (pdf-annot-run-modified-hooks :delete a))
    587   (when (called-interactively-p 'any)
    588     (message "Annotation deleted"))
    589   nil)
    590 
    591 (defun pdf-annot-text-annotation-p (a)
    592   "Return non-nil if annotation A is of type text."
    593   (eq 'text (pdf-annot-get a 'type)))
    594 
    595 (defun pdf-annot-markup-annotation-p (a)
    596   "Return non-nil if annotation A is a known markup type.
    597 
    598 Annotation types are defined in `pdf-annot-markup-annotation-types'."
    599   (not (null
    600         (memq (pdf-annot-get a 'type)
    601               pdf-annot-markup-annotation-types))))
    602 
    603 (defun pdf-annot-property-modifiable-p (a property)
    604   "Return non-nil if PROPERTY for annotation A is editable."
    605   (or (memq property '(edges color flags contents))
    606       (and (pdf-annot-markup-annotation-p a)
    607            (memq property '(label opacity popup popup-is-open)))
    608       (and (pdf-annot-text-annotation-p a)
    609            (memq property '(icon is-open)))))
    610 
    611 (defun pdf-annot-activate-annotation (a)
    612   "Run handler functions on A to activate the annotation.
    613 
    614 Activation functions are defined in `pdf-annot-activate-handler-functions'."
    615   (or (run-hook-with-args-until-success
    616        'pdf-annot-activate-handler-functions
    617        a)
    618       (pdf-annot-default-activate-handler a)))
    619 
    620 (defun pdf-annot-default-activate-handler (a)
    621   "The default activation function to run on annotation A.
    622 
    623 Activation functions are defined in `pdf-annot-activate-handler-functions'."
    624   (cond
    625    ((pdf-annot-has-attachment-p a)
    626     (pdf-annot-pop-to-attachment a))
    627    (t (pdf-annot-edit-contents a))))
    628 
    629 
    630 ;; * ================================================================== *
    631 ;; * Handling attachments
    632 ;; * ================================================================== *
    633 
    634 (defun pdf-annot-has-attachment-p (a)
    635   "Return non-nil if annotation A's has data attached."
    636   (eq 'file (pdf-annot-get a 'type)))
    637 
    638 (defun pdf-annot-get-attachment (a &optional do-save)
    639   "Retrieve annotation A's attachment.
    640 
    641 The DO-SAVE argument is given to
    642 `pdf-info-getattachment-from-annot', which see."
    643   (unless (pdf-annot-has-attachment-p a)
    644     (error "Annotation has no data attached: %s" a))
    645   (pdf-info-getattachment-from-annot
    646    (pdf-annot-get-id a)
    647    do-save
    648    (pdf-annot-get-buffer a)))
    649 
    650 (defun pdf-annot-attachment-base-directory ()
    651   "Return the base directory for saving attachments."
    652   (let ((dir (pdf-util-expand-file-name "attachments")))
    653     (unless (file-exists-p dir)
    654       (make-directory dir))
    655     dir))
    656 
    657 (defun pdf-annot-attachment-delete-base-directory ()
    658   "Delete all saved attachment files of the current buffer."
    659   (setq pdf-annot--attachment-file-alist nil)
    660   (delete-directory (pdf-annot-attachment-base-directory) t))
    661 
    662 (defun pdf-annot-attachment-unique-filename (attachment)
    663   "Return a unique absolute filename for ATTACHMENT."
    664   (let* ((filename (or (cdr (assq 'filename attachment))
    665                        "attachment"))
    666          (id (cdr (assq 'id attachment)))
    667          (unique
    668           (or (cdr (assoc id pdf-annot--attachment-file-alist))
    669               (let* ((sans-ext
    670                       (expand-file-name
    671                        (concat (file-name-as-directory ".")
    672                                (file-name-sans-extension filename))
    673                        (pdf-annot-attachment-base-directory)))
    674                      (ext (file-name-extension filename))
    675                      (newname (concat sans-ext "." ext))
    676                      (i 0))
    677                 (while (rassoc newname pdf-annot--attachment-file-alist)
    678                   (setq newname (format "%s-%d.%s" sans-ext (cl-incf i) ext)))
    679                 (push (cons id newname) pdf-annot--attachment-file-alist)
    680                 newname)))
    681          (directory (file-name-directory unique)))
    682     (unless (file-exists-p directory)
    683       (make-directory directory t))
    684     unique))
    685 
    686 
    687 (defun pdf-annot-attachment-save (attachment &optional regenerate-p)
    688   "Save ATTACHMENT's data to a unique filename and return its name.
    689 
    690 If REGENERATE-P is non-nil, copy attachment's file even if the
    691 copy already exists.
    692 
    693 Signal an error, if ATTACHMENT has no, or a non-existing, `file'
    694 property, i.e. it was retrieved with an unset do-save argument.
    695 See `pdf-info-getattachments'"
    696 
    697   (let ((datafile (cdr (assq 'file attachment))))
    698     (unless (and datafile
    699                  (file-exists-p datafile))
    700       (error "Attachment's file property is invalid"))
    701     (let* ((filename
    702             (pdf-annot-attachment-unique-filename attachment)))
    703       (when (or regenerate-p
    704                 (not (file-exists-p filename)))
    705         (copy-file datafile filename nil nil t t))
    706       filename)))
    707 
    708 (defun pdf-annot-find-attachment-noselect (a)
    709   "Find annotation A's attachment in a buffer, without selecting it.
    710 
    711 Signals an error, if A has no data attached."
    712   (let ((attachment (pdf-annot-get-attachment a t)))
    713     (unwind-protect
    714         (find-file-noselect
    715          (pdf-annot-attachment-save attachment))
    716       (let ((tmpfile (cdr (assq 'file attachment))))
    717         (when (and tmpfile
    718                    (file-exists-p tmpfile))
    719           (delete-file tmpfile))))))
    720 
    721 (defun pdf-annot-attachment-dired (&optional regenerate-p)
    722   "List all attachments in a Dired buffer.
    723 
    724 If REGENERATE-P is non-nil, create attachment's files even if
    725 they already exist.  Interactively REGENERATE-P is non-nil if a
    726 prefix argument was given.
    727 
    728 Return the Dired buffer."
    729   (interactive (list current-prefix-arg))
    730   (let ((attachments (pdf-info-getattachments t)))
    731     (unwind-protect
    732         (progn
    733           (dolist (a (pdf-annot-getannots nil 'file))
    734             (push (pdf-annot-get-attachment a t)
    735                   attachments ))
    736           (dolist (att attachments)
    737             (pdf-annot-attachment-save att regenerate-p))
    738           (unless attachments
    739             (error "Document has no data attached"))
    740           (dired (pdf-annot-attachment-base-directory)))
    741       (dolist (att attachments)
    742         (let ((tmpfile (cdr (assq 'file att))))
    743           (when (and tmpfile (file-exists-p tmpfile))
    744             (delete-file tmpfile)))))))
    745 
    746 (defun pdf-annot-display-attachment (a &optional display-action select-window-p)
    747   "Display file annotation A's data in a buffer.
    748 
    749 DISPLAY-ACTION should be a valid `display-buffer' action.  If
    750 nil, `pdf-annot-attachment-display-buffer-action' is used.
    751 
    752 Select the window, if SELECT-WINDOW-P is non-nil.
    753 
    754 Return the window attachment is displayed in."
    755 
    756   (interactive
    757    (list (pdf-annot-read-annotation
    758           "Select a file annotation by clicking on it")))
    759   (let* ((buffer (pdf-annot-find-attachment-noselect a))
    760          (window (display-buffer
    761                   buffer (or display-action
    762                              pdf-annot-attachment-display-buffer-action))))
    763     (when select-window-p
    764       (select-window window))
    765     window))
    766 
    767 (defun pdf-annot-pop-to-attachment (a)
    768   "Display annotation A's attachment in a window and select it."
    769   (interactive
    770    (list (pdf-annot-read-annotation
    771           "Select a file annotation by clicking on it")))
    772   (pdf-annot-display-attachment a nil t))
    773 
    774 
    775 ;; * ================================================================== *
    776 ;; * Interfacing with the display
    777 ;; * ================================================================== *
    778 
    779 (defun pdf-annot-image-position (a &optional image-size)
    780   "Return the position of annotation A in image coordinates.
    781 
    782 IMAGE-SIZE should be a cons \(WIDTH . HEIGHT\) and defaults to
    783 the page-image of the selected window."
    784 
    785   (unless image-size
    786     (pdf-util-assert-pdf-window)
    787     (setq image-size (pdf-view-image-size)))
    788   (let ((e (pdf-util-scale
    789             (pdf-annot-get a 'edges)
    790             image-size)))
    791     (pdf-util-with-edges (e)
    792       `(,e-left . ,e-top))))
    793 
    794 (defun pdf-annot-image-set-position (a x y &optional image-size)
    795   "Set annotation A's position to X,Y in image coordinates.
    796 
    797 See `pdf-annot-image-position' for IMAGE-SIZE."
    798 
    799   (unless image-size
    800     (pdf-util-assert-pdf-window)
    801     (setq image-size (pdf-view-image-size)))
    802   (let* ((edges (pdf-annot-get a 'edges))
    803          (x (/ x (float (car image-size))))
    804          (y (/ y (float (cdr image-size)))))
    805     (pdf-util-with-edges (edges)
    806       (let* ((w edges-width)
    807              (h edges-height)
    808              (x (max 0 (min x (- 1 w))))
    809              (y (max 0 (min y (- 1 h)))))
    810         (pdf-annot-put a 'edges
    811           (list x y -1 -1))))))
    812 
    813 (defun pdf-annot-image-size (a &optional image-size)
    814   "Return the size of annotation A in image coordinates.
    815 
    816 Returns \(WIDTH . HEIGHT\).
    817 
    818 See `pdf-annot-image-position' for IMAGE-SIZE."
    819   (unless image-size
    820     (pdf-util-assert-pdf-window)
    821     (setq image-size (pdf-view-image-size)))
    822   (let ((edges (pdf-util-scale
    823                 (pdf-annot-get a 'edges) image-size)))
    824     (pdf-util-with-edges (edges)
    825       (cons edges-width edges-height))))
    826 
    827 (defun pdf-annot-image-set-size (a &optional width height image-size)
    828   "Set annotation A's size in image to WIDTH and/or HEIGHT.
    829 
    830 See `pdf-annot-image-position' for IMAGE-SIZE."
    831   (unless image-size
    832     (pdf-util-assert-pdf-window)
    833     (setq image-size (pdf-view-image-size)))
    834   (let* ((edges (pdf-annot-get a 'edges))
    835          (w (and width
    836                  (/ width (float (car image-size)))))
    837          (h (and height
    838                  (/ height (float (cdr image-size))))))
    839     (pdf-util-with-edges (edges)
    840       (pdf-annot-put a 'edges
    841         (list edges-left
    842               edges-top
    843               (if w (+ edges-left w) edges-right)
    844               (if h (+ edges-top h) edges-bot))))))
    845 
    846 (defun pdf-annot-at-position (pos)
    847   "Return annotation at POS in the selected window.
    848 
    849 POS should be an absolute image position as a cons \(X . Y\).
    850 Alternatively POS may also be an event position, in which case
    851 `posn-window' and `posn-object-x-y' is used to find the image
    852 position.
    853 
    854 Return nil, if no annotation was found."
    855   (let (window)
    856     (when (posnp pos)
    857       (setq window (posn-window pos)
    858             pos (posn-object-x-y pos)))
    859     (save-selected-window
    860       (when window (select-window window 'norecord))
    861       (let* ((annots (pdf-annot-getannots (pdf-view-current-page)))
    862              (size (pdf-view-image-size))
    863              (rx (/ (car pos) (float (car size))))
    864              (ry (/ (cdr pos) (float (cdr size))))
    865              (rpos (cons rx ry)))
    866         (or (cl-some (lambda (a)
    867                        (and (cl-some
    868                              (lambda (e)
    869                                (pdf-util-edges-inside-p e rpos))
    870                              (pdf-annot-get-display-edges a))
    871                             a))
    872                      annots)
    873             (error "No annotation at this position"))))))
    874 
    875 (defun pdf-annot-mouse-move (event &optional annot)
    876   "Start moving an annotation at EVENT's position.
    877 
    878 EVENT should be a mouse event originating the request and is used
    879 as a reference point.
    880 
    881 ANNOT is the annotation to operate on and defaults to the
    882 annotation at EVENT's start position.
    883 
    884 This function does not return until the operation is completed,
    885 i.e. a non mouse-movement event is read."
    886 
    887   (interactive "@e")
    888   (pdf-util-assert-pdf-window (posn-window (event-start event)))
    889   (select-window (posn-window (event-start event)))
    890   (let* ((mpos (posn-object-x-y (event-start event)))
    891          (a (or annot
    892                 (pdf-annot-at-position mpos))))
    893     (unless a
    894       (error "No annotation at this position: %s" mpos))
    895     (let* ((apos (pdf-annot-image-position a))
    896            (offset (cons (- (car mpos) (car apos))
    897                          (- (cdr mpos) (cdr apos))))
    898            (window (selected-window))
    899            make-pointer-invisible)
    900       (when (pdf-util-track-mouse-dragging (ev 0.1)
    901               (when (and (eq window (posn-window (event-start ev)))
    902                          (eq 'image (car-safe (posn-object (event-start ev)))))
    903                 (let ((pdf-view-inhibit-hotspots t)
    904                       (pdf-annot-inhibit-modification-hooks t)
    905                       (pdf-cache-image-inihibit t)
    906                       (xy (posn-object-x-y (event-start ev))))
    907                   (pdf-annot-image-set-position
    908                    a (- (car xy) (car offset))
    909                    (- (cdr xy) (cdr offset)))
    910                   (pdf-view-redisplay))))
    911         (pdf-annot-run-modified-hooks)))
    912     nil))
    913 
    914 (defun pdf-annot-hotspot-function (page size)
    915   "Create image hotspots for page PAGE of size SIZE."
    916   (apply #'nconc (mapcar (lambda (a)
    917                            (unless (eq (pdf-annot-get a 'type)
    918                                        'link)
    919                              (pdf-annot-create-hotspots a size)))
    920                          (pdf-annot-getannots page))))
    921 
    922 (defun pdf-annot-create-hotspots (a size)
    923   "Return a list of image hotspots for annotation A.
    924 
    925 SIZE is a cons (SX . SY), by which edges are scaled."
    926   (let ((id (pdf-annot-get-id a))
    927         (edges (pdf-util-scale
    928                 (pdf-annot-get-display-edges a)
    929                 size 'round))
    930         (moveable-p (memq (pdf-annot-get a 'type)
    931                           '(file text)))
    932         hotspots)
    933     (dolist (e edges)
    934       (pdf-util-with-edges (e)
    935         (push `((rect . ((,e-left . ,e-top) . (,e-right . ,e-bot)))
    936                 ,id
    937                 (pointer
    938                  hand
    939                  help-echo
    940                  ,(pdf-annot-print-annotation a)))
    941               hotspots)))
    942     (pdf-annot-create-hotspot-binding id moveable-p a)
    943     hotspots))
    944 
    945 ;; FIXME: Define a keymap as a template for this. Much cleaner.
    946 (defun pdf-annot-create-hotspot-binding (id moveable-p annotation)
    947   "Create a local keymap for interacting with ANNOTATION using the mouse.
    948 
    949 ID is the identifier for the ANNOTATION, as returned
    950 `pdf-annot-get-id'. MOVEABLE-P indicates whether the annotation
    951 is moveable."
    952   ;; Activating
    953   (local-set-key
    954    (vector id 'mouse-1)
    955    (lambda ()
    956      (interactive)
    957      (pdf-annot-activate-annotation annotation)))
    958   ;; Move
    959   (when moveable-p
    960     (local-set-key
    961      (vector id 'down-mouse-1)
    962      (lambda (ev)
    963        (interactive "@e")
    964        (pdf-annot-mouse-move ev annotation))))
    965   ;; Context Menu
    966   (local-set-key
    967    (vector id 'down-mouse-3)
    968    (lambda ()
    969      (interactive "@")
    970      (popup-menu (pdf-annot-create-context-menu annotation))))
    971   ;; Everything else
    972   (local-set-key
    973    (vector id t)
    974    'pdf-util-image-map-mouse-event-proxy))
    975 
    976 (defun pdf-annot-show-annotation (a &optional highlight-p window)
    977   "Make annotation A visible.
    978 
    979 Turn to A's page in WINDOW, and scroll it if necessary.
    980 
    981 If HIGHLIGHT-P is non-nil, visually distinguish annotation A from
    982 other annotations."
    983 
    984   (save-selected-window
    985     (when window (select-window window 'norecord))
    986     (pdf-util-assert-pdf-window)
    987     (let ((page (pdf-annot-get a 'page))
    988           (size (pdf-view-image-size)))
    989       (unless (= page (pdf-view-current-page))
    990         (pdf-view-goto-page page))
    991       (let ((edges (pdf-annot-get-display-edges a)))
    992         (when highlight-p
    993           (pdf-view-display-image
    994            (pdf-view-create-image
    995                (pdf-cache-renderpage-highlight
    996                 page (car size)
    997                 `("white" "steel blue" 0.35 ,@edges))
    998              :map (pdf-view-apply-hotspot-functions
    999                    window page size)
   1000              :width (car size))))
   1001         (pdf-util-scroll-to-edges
   1002          (pdf-util-scale-relative-to-pixel (car edges)))))))
   1003 
   1004 (defun pdf-annot-read-annotation (&optional prompt)
   1005   "Let the user choose a annotation a mouse click using PROMPT."
   1006   (pdf-annot-at-position
   1007    (pdf-util-read-image-position
   1008     (or prompt "Choose a annotation by clicking on it"))))
   1009 
   1010 
   1011 ;; * ================================================================== *
   1012 ;; * Creating annotations
   1013 ;; * ================================================================== *
   1014 
   1015 (defun pdf-annot-add-annotation (type edges &optional property-alist page)
   1016   "Create and add a new annotation of type TYPE to the document.
   1017 
   1018 TYPE determines the kind of annotation to add and maybe one of
   1019 `text', `squiggly', `underline', `strike-out' or `highlight'.
   1020 
   1021 EDGES determines where the annotation will appear on the page.
   1022 If type is `text', this should be a single list of \(LEFT TOP
   1023 RIGHT BOT\).  Though, in this case only LEFT and TOP are used,
   1024 since the size of text annotations is fixed. Otherwise EDGES may
   1025 be a list of such elements.  All values should be image relative
   1026 coordinates, i.e. in the range \[0;1\].
   1027 
   1028 PROPERTY-ALIST is a list of annotation properties, which will be
   1029 put on the created annotation.
   1030 
   1031 PAGE determines the page of the annotation. It defaults to the
   1032 page currently displayed in the selected window.
   1033 
   1034 Signal an error, if PROPERTY-ALIST contains non-modifiable
   1035 properties or PAGE is nil and the selected window does not
   1036 display a PDF document or creating annotations of type TYPE is
   1037 not supported.
   1038 
   1039 Set buffers modified flag and calls
   1040 `pdf-annot-activate-annotation' if
   1041 `pdf-annot-activate-created-annotations' is non-nil.
   1042 
   1043 Return the new annotation."
   1044 
   1045   (unless (memq type (pdf-info-creatable-annotation-types))
   1046     (error "Unsupported annotation type: %s" type))
   1047   (unless page
   1048     (pdf-util-assert-pdf-window)
   1049     (setq page (pdf-view-current-page)))
   1050   (unless (consp (car-safe edges))
   1051     (setq edges (list edges)))
   1052   (when (and (eq type 'text)
   1053              (> (length edges) 1))
   1054     (error "Edges argument should be a single edge-list for text annotations"))
   1055   (let* ((a (apply #'pdf-info-addannot
   1056                    page
   1057                    (if (eq type 'text)
   1058                        (car edges)
   1059                      (apply #'pdf-util-edges-union
   1060                             (apply #'append
   1061                                    (mapcar
   1062                                     (lambda (e)
   1063                                       (pdf-info-getselection page e))
   1064                                     edges))))
   1065                    type
   1066                    nil
   1067                    (if (not (eq type 'text)) edges)))
   1068          (id (pdf-annot-get-id a)))
   1069     (when property-alist
   1070       (condition-case err
   1071           (setq a (pdf-info-editannot id property-alist))
   1072         (error
   1073          (pdf-info-delannot id)
   1074          (signal (car err) (cdr err)))))
   1075     (setq a (pdf-annot-create a))
   1076     (set-buffer-modified-p t)
   1077     (pdf-annot-run-modified-hooks :insert a)
   1078     (when pdf-annot-activate-created-annotations
   1079       (pdf-annot-activate-annotation a))
   1080     a))
   1081 
   1082 (defun pdf-annot-add-text-annotation (pos &optional icon property-alist)
   1083   "Add a new text annotation at POS in the selected window.
   1084 
   1085 POS should be a image position object or a cons \(X . Y\), both
   1086 being image coordinates.
   1087 
   1088 ICON determines how the annotation is displayed and should be
   1089 listed in `pdf-annot-standard-text-icons'.  Any other value is ok
   1090 as well, but will render the annotation invisible.
   1091 
   1092 Adjust X and Y accordingly, if the position would render the
   1093 annotation off-page.
   1094 
   1095 Merge ICON as a icon property with PROPERTY-ALIST and
   1096 `pdf-annot-default-text-annotation-properties' and apply the
   1097 result to the created annotation.
   1098 
   1099 See also `pdf-annot-add-annotation'.
   1100 
   1101 Return the new annotation."
   1102 
   1103   (interactive
   1104    (let* ((posn (pdf-util-read-image-position
   1105                  "Click where a new text annotation should be added ..."))
   1106           (window (posn-window posn)))
   1107      (select-window window)
   1108      (list posn)))
   1109   (pdf-util-assert-pdf-window)
   1110   (when (posnp pos)
   1111     (setq pos (posn-object-x-y pos)))
   1112   (let ((isize (pdf-view-image-size))
   1113         (x (car pos))
   1114         (y (cdr pos)))
   1115     (unless (and (>= x 0)
   1116                  (< x (car isize)))
   1117       (signal 'args-out-of-range (list pos)))
   1118     (unless (and (>= y 0)
   1119                  (< y (cdr isize)))
   1120       (signal 'args-out-of-range (list pos)))
   1121     (let ((size (pdf-util-scale-points-to-pixel
   1122                  pdf-annot-text-annotation-size 'round)))
   1123       (setcar size (min (car size) (car isize)))
   1124       (setcdr size (min (cdr size) (cdr isize)))
   1125       (cl-decf x (max 0 (- (+ x (car size)) (car isize))))
   1126       (cl-decf y (max 0 (- (+ y (cdr size)) (cdr isize))))
   1127       (pdf-annot-add-annotation
   1128        'text (pdf-util-scale-pixel-to-relative
   1129               (list x y -1 -1))
   1130        (pdf-annot-merge-alists
   1131         (and icon `((icon . ,icon)))
   1132         property-alist
   1133         pdf-annot-default-text-annotation-properties
   1134         (cdr (assq 'text pdf-annot-default-annotation-properties))
   1135         (cdr (assq t pdf-annot-default-annotation-properties))
   1136         `((color . ,(car pdf-annot-color-history))))))))
   1137 
   1138 (defun pdf-annot-mouse-add-text-annotation (ev)
   1139   "Add a text annotation using the mouse.
   1140 
   1141 EV describes the captured mouse event."
   1142   (interactive "@e")
   1143   (pdf-annot-add-text-annotation
   1144    (if (eq (car-safe ev)
   1145            'menu-bar)
   1146        (let (echo-keystrokes)
   1147          (message nil)
   1148          (pdf-util-read-image-position
   1149           "Click where a new text annotation should be added ..."))
   1150      (event-start ev))))
   1151 
   1152 (defun pdf-annot-add-markup-annotation (list-of-edges type &optional color
   1153                                                       property-alist)
   1154   "Add a new markup annotation in the selected window.
   1155 
   1156 LIST-OF-EDGES determines the marked up area and should be a list
   1157 of \(LEFT TOP RIGHT BOT\), each value a relative coordinate.
   1158 
   1159 TYPE should be one of `squiggly', `underline', `strike-out' or
   1160 `highlight'.
   1161 
   1162 Merge COLOR as a color property with PROPERTY-ALIST and
   1163 `pdf-annot-default-markup-annotation-properties' and apply the
   1164 result to the created annotation.
   1165 
   1166 See also `pdf-annot-add-annotation'.
   1167 
   1168 Return the new annotation."
   1169   (interactive
   1170    (list (pdf-view-active-region t)
   1171          (let ((type (completing-read "Markup type (default highlight): "
   1172                                       '("squiggly" "highlight" "underline" "strike-out")
   1173                                       nil t)))
   1174            (if (equal type "") 'highlight (intern type)))
   1175          (pdf-annot-read-color)))
   1176   (pdf-util-assert-pdf-window)
   1177   (pdf-annot-add-annotation
   1178    type
   1179    list-of-edges
   1180    (pdf-annot-merge-alists
   1181     (and color `((color . ,color)))
   1182     property-alist
   1183     pdf-annot-default-markup-annotation-properties
   1184     (cdr (assq type pdf-annot-default-annotation-properties))
   1185     (cdr (assq t pdf-annot-default-annotation-properties))
   1186     (when pdf-annot-color-history
   1187       `((color . ,(car pdf-annot-color-history))))
   1188     '((color . "#ffff00")))
   1189    (pdf-view-current-page)))
   1190 
   1191 (defun pdf-annot-add-squiggly-markup-annotation (list-of-edges
   1192                                                  &optional color property-alist)
   1193   "Add a new squiggly annotation in the selected window.
   1194 
   1195 LIST-OF-EDGES defines the annotation boundary. COLOR defines the
   1196 annotation color and PROPERTY-ALIST defines additional annotation
   1197 properties. See also `pdf-annot-add-markup-annotation'."
   1198   (interactive (list (pdf-view-active-region t)))
   1199   (pdf-annot-add-markup-annotation list-of-edges 'squiggly color property-alist))
   1200 
   1201 (defun pdf-annot-add-underline-markup-annotation (list-of-edges
   1202                                                   &optional color property-alist)
   1203   "Add a new underline annotation in the selected window.
   1204 
   1205 LIST-OF-EDGES defines the annotation boundary. COLOR defines the
   1206 annotation color and PROPERTY-ALIST defines additional annotation
   1207 properties. See also `pdf-annot-add-markup-annotation'."
   1208   (interactive (list (pdf-view-active-region t)))
   1209   (pdf-annot-add-markup-annotation list-of-edges 'underline color property-alist))
   1210 
   1211 (defun pdf-annot-add-strikeout-markup-annotation (list-of-edges
   1212                                                   &optional color property-alist)
   1213   "Add a new strike-out annotation in the selected window.
   1214 
   1215 LIST-OF-EDGES defines the annotation boundary. COLOR defines the
   1216 annotation color and PROPERTY-ALIST defines additional annotation
   1217 properties. See also `pdf-annot-add-markup-annotation'."
   1218   (interactive (list (pdf-view-active-region t)))
   1219   (pdf-annot-add-markup-annotation list-of-edges 'strike-out color property-alist))
   1220 
   1221 (defun pdf-annot-add-highlight-markup-annotation (list-of-edges
   1222                                                   &optional color property-alist)
   1223   "Add a new highlight annotation in the selected window.
   1224 
   1225 LIST-OF-EDGES defines the annotation boundary. COLOR defines the
   1226 annotation color and PROPERTY-ALIST defines additional annotation
   1227 properties. See also `pdf-annot-add-markup-annotation'."
   1228   (interactive (list (pdf-view-active-region t)))
   1229   (pdf-annot-add-markup-annotation list-of-edges 'highlight color property-alist))
   1230 
   1231 (defun pdf-annot-read-color (&optional prompt)
   1232   "Read and return a color using PROMPT.
   1233 
   1234 Offer `pdf-annot-color-history' as default values."
   1235   (let* ((defaults (append
   1236                     (delq nil
   1237                           (list
   1238                            (cdr (assq 'color
   1239                                       pdf-annot-default-markup-annotation-properties))
   1240                            (cdr (assq 'color
   1241                                       pdf-annot-default-text-annotation-properties))))
   1242                     pdf-annot-color-history))
   1243          (prompt
   1244           (format "%s%s: "
   1245                   (or prompt "Color")
   1246                   (if defaults (format " (default %s)" (car defaults)) "")))
   1247          (current-completing-read-function completing-read-function)
   1248          (completing-read-function
   1249           (lambda (prompt collection &optional predicate require-match
   1250                           initial-input _hist _def inherit-input-method)
   1251             (funcall current-completing-read-function
   1252                      prompt collection predicate require-match
   1253                      initial-input 'pdf-annot-color-history
   1254                      defaults
   1255                      inherit-input-method))))
   1256     (read-color prompt)))
   1257 
   1258 (defun pdf-annot-merge-alists (&rest alists)
   1259   "Merge ALISTS into a single one.
   1260 
   1261 Suppresses successive duplicate entries of keys after the first
   1262 occurrence in ALISTS."
   1263 
   1264   (let (merged)
   1265     (dolist (elt (apply #'append alists))
   1266       (unless (assq (car elt) merged)
   1267         (push elt merged)))
   1268     (nreverse merged)))
   1269 
   1270 
   1271 
   1272 ;; * ================================================================== *
   1273 ;; * Displaying annotation contents
   1274 ;; * ================================================================== *
   1275 
   1276 (defun pdf-annot-print-property (a property)
   1277   "Pretty print annotation A's property PROPERTY."
   1278   (let ((value (pdf-annot-get a property)))
   1279     (cl-case property
   1280       (color
   1281        (propertize (or value "")
   1282                    'face (and value
   1283                               `(:background ,value))))
   1284       ((created modified)
   1285        (let ((date value))
   1286          (if (null date)
   1287              "No date"
   1288            (current-time-string date))))
   1289       ;; print verbatim
   1290       (subject
   1291        (or value "No subject"))
   1292       (opacity
   1293        (let ((opacity (or value 1.0)))
   1294          (format "%d%%" (round (* 100 opacity)))))
   1295       (t (format "%s" (or value ""))))))
   1296 
   1297 (defun pdf-annot-print-annotation (a)
   1298   "Pretty print annotation A."
   1299   (or (run-hook-with-args-until-success
   1300        'pdf-annot-print-annotation-functions a)
   1301       (pdf-annot-print-annotation-default a)))
   1302 
   1303 (defun pdf-annot-print-annotation-default (a)
   1304   "Default pretty printer for annotation A.
   1305 
   1306 The result consists of a header (as printed with
   1307 `pdf-annot-print-annotation-header') a newline and A's contents
   1308 property."
   1309   (concat
   1310    (pdf-annot-print-annotation-header a)
   1311    "\n"
   1312    (pdf-annot-get a 'contents)))
   1313 
   1314 (defun pdf-annot-print-annotation-header (a)
   1315   "Emit a suitable header string for annotation A."
   1316   (let ((header
   1317          (cond
   1318           ((eq 'file (pdf-annot-get a 'type))
   1319            (let ((att (pdf-annot-get-attachment a)))
   1320              (format "File attachment `%s' of %s"
   1321                      (or (cdr (assq 'filename att)) "unnamed")
   1322                      (if (cdr (assq 'size att))
   1323                          (format "size %s" (file-size-human-readable
   1324                                             (cdr (assq 'size att))))
   1325                        "unknown size"))))
   1326           (t
   1327            (format "%s"
   1328                    (mapconcat
   1329                     #'identity
   1330                     (mapcar
   1331                      (lambda (property)
   1332                        (pdf-annot-print-property
   1333                         a property))
   1334                      `(subject
   1335                        label
   1336                        modified))
   1337                     ";"))))))
   1338     (setq header (propertize header 'face 'header-line
   1339                              'intangible t 'read-only t))
   1340     ;; This `trick' makes the face apply in a tooltip.
   1341     (propertize header 'display header)))
   1342 
   1343 (defun pdf-annot-print-annotation-latex-maybe (a)
   1344   "Maybe print annotation A's content as a LaTeX fragment.
   1345 
   1346 See `pdf-annot-latex-string-predicate'."
   1347   (when (and (functionp pdf-annot-latex-string-predicate)
   1348              (funcall pdf-annot-latex-string-predicate
   1349                       (pdf-annot-get a 'contents)))
   1350     (pdf-annot-print-annotation-latex a)))
   1351 
   1352 (defun pdf-annot-print-annotation-latex (a)
   1353   "Print annotation A's content as a LaTeX fragment.
   1354 
   1355 This compiles A's contents as a LaTeX fragment and puts the
   1356 resulting image as a display property on the contents, prefixed
   1357 by a header."
   1358 
   1359   (let (tempfile)
   1360     (unwind-protect
   1361         (with-current-buffer (pdf-annot-get-buffer a)
   1362           (let* ((page (pdf-annot-get a 'page))
   1363                  (header (pdf-annot-print-annotation-header a))
   1364                  (contents (pdf-annot-get a 'contents))
   1365                  (hash (sxhash (format
   1366                                 "pdf-annot-print-annotation-latex%s%s%s"
   1367                                 page header contents)))
   1368                  (data (pdf-cache-lookup-image page 0 nil hash))
   1369                  ;; pdf-tools can only work with png files, so this
   1370                  ;; binding ensures that pdf-tools can print the
   1371                  ;; latex-preview regardless of the user
   1372                  ;; configuration.
   1373                  (org-preview-latex-default-process 'dvipng)
   1374                  (org-format-latex-header pdf-annot-latex-header)
   1375                  (temporary-file-directory
   1376                   (pdf-util-expand-file-name "pdf-annot-print-annotation-latex")))
   1377             (unless (file-directory-p temporary-file-directory)
   1378               (make-directory temporary-file-directory))
   1379             (unless data
   1380               (setq tempfile (make-temp-file "pdf-annot" nil ".png"))
   1381               ;; FIXME: Why is this with-temp-buffer needed (which it is) ?
   1382               (with-temp-buffer
   1383                 (org-create-formula-image
   1384                  contents tempfile org-format-latex-options t))
   1385               (setq data (pdf-util-munch-file tempfile))
   1386               (if (and (> (length data) 3)
   1387                        (equal (substring data 1 4)
   1388                               "PNG"))
   1389                   (pdf-cache-put-image page 0 data hash)
   1390                 (setq data nil)))
   1391             (concat
   1392              header
   1393              "\n"
   1394              (if data
   1395                  (propertize
   1396                   contents 'display (pdf-view-create-image data))
   1397                (propertize
   1398                 contents
   1399                 'display
   1400                 (concat
   1401                  (propertize "Failed to compile latex fragment\n"
   1402                              'face 'error)
   1403                  contents))))))
   1404       (when (and tempfile
   1405                  (file-exists-p tempfile))
   1406         (delete-file tempfile)))))
   1407 
   1408 
   1409 ;; * ================================================================== *
   1410 ;; * Editing annotation contents
   1411 ;; * ================================================================== *
   1412 
   1413 (defvar-local pdf-annot-edit-contents--annotation nil)
   1414 (put 'pdf-annot-edit-contents--annotation 'permanent-local t)
   1415 (defvar-local pdf-annot-edit-contents--buffer nil)
   1416 
   1417 (defcustom pdf-annot-edit-contents-setup-function
   1418   (lambda (a)
   1419     (let ((mode (if (funcall pdf-annot-latex-string-predicate
   1420                              (pdf-annot-get a 'contents))
   1421                     'latex-mode
   1422                   'org-mode)))
   1423       (unless (derived-mode-p mode)
   1424         (funcall mode))))
   1425   "A function for setting up, e.g. the major-mode, of the edit buffer.
   1426 
   1427 The function receives one argument, the annotation whose contents
   1428 is about to be edited in this buffer.
   1429 
   1430 The default value turns on `latex-mode' if
   1431 `pdf-annot-latex-string-predicate' returns non-nil on the
   1432 annotation's contents and otherwise `org-mode'."
   1433   :type 'function)
   1434 
   1435 (defcustom pdf-annot-edit-contents-display-buffer-action
   1436   '((display-buffer-reuse-window
   1437      display-buffer-split-below-and-attach)
   1438     (inhibit-same-window . t)
   1439     (window-height . 0.25))
   1440   "Display action when showing the edit buffer."
   1441   :type display-buffer--action-custom-type)
   1442 
   1443 (defvar pdf-annot-edit-contents-minor-mode-map
   1444   (let ((kmap (make-sparse-keymap)))
   1445     (set-keymap-parent kmap text-mode-map)
   1446     (define-key kmap (kbd "C-c C-c") #'pdf-annot-edit-contents-commit)
   1447     (define-key kmap (kbd "C-c C-q") #'pdf-annot-edit-contents-abort)
   1448     kmap))
   1449 
   1450 (define-minor-mode pdf-annot-edit-contents-minor-mode
   1451   "Active when editing the contents of annotations."
   1452   :group 'pdf-annot
   1453   (when pdf-annot-edit-contents-minor-mode
   1454     (message "%s"
   1455              (substitute-command-keys
   1456               "Press \\[pdf-annot-edit-contents-commit] to commit your changes, \\[pdf-annot-edit-contents-abort] to abandon them."))))
   1457 
   1458 (put 'pdf-annot-edit-contents-minor-mode 'permanent-local t)
   1459 
   1460 (defun pdf-annot-edit-contents-finalize (do-save &optional do-kill)
   1461   "Finalize edit-operations on an Annotation.
   1462 
   1463 If DO-SAVE is t, save the changes to annotation content without
   1464 asking. If DO-SAVE is `ask', check with the user if contents
   1465 should be saved.
   1466 
   1467 If DO-KILL is t, kill all windows displaying the annotation
   1468 contents. Else just bury the buffers."
   1469   (when (buffer-modified-p)
   1470     (cond
   1471      ((eq do-save 'ask)
   1472       (save-window-excursion
   1473         (display-buffer (current-buffer) nil (selected-frame))
   1474         (when (y-or-n-p "Save changes to this annotation ?")
   1475           (pdf-annot-edit-contents-save-annotation))))
   1476      (do-save
   1477       (pdf-annot-edit-contents-save-annotation)))
   1478     (set-buffer-modified-p nil))
   1479   (dolist (win (get-buffer-window-list))
   1480     (quit-window do-kill win)))
   1481 
   1482 (defun pdf-annot-edit-contents-save-annotation ()
   1483   "Internal function to save the contents of the annotation under editing."
   1484   (when pdf-annot-edit-contents--annotation
   1485     (pdf-annot-put pdf-annot-edit-contents--annotation
   1486         'contents
   1487       (buffer-substring-no-properties (point-min) (point-max)))
   1488     (set-buffer-modified-p nil)))
   1489 
   1490 (defun pdf-annot-edit-contents-commit ()
   1491   "Save the change made to the current annotation."
   1492   (interactive)
   1493   (pdf-annot-edit-contents-finalize t))
   1494 
   1495 (defun pdf-annot-edit-contents-abort ()
   1496   "Abort the change made to the current annotation."
   1497   (interactive)
   1498   (pdf-annot-edit-contents-finalize nil t))
   1499 
   1500 (defun pdf-annot-edit-contents-noselect (a)
   1501   "Internal function to setup all prerequisites for editing annotation A.
   1502 
   1503 At any given point of time, only one annotation can be in edit mode."
   1504   (with-current-buffer (pdf-annot-get-buffer a)
   1505     (when (and (buffer-live-p pdf-annot-edit-contents--buffer)
   1506                (not (eq a pdf-annot-edit-contents--annotation)))
   1507       (with-current-buffer pdf-annot-edit-contents--buffer
   1508         (pdf-annot-edit-contents-finalize 'ask)))
   1509     (unless (buffer-live-p pdf-annot-edit-contents--buffer)
   1510       (setq pdf-annot-edit-contents--buffer
   1511             (with-current-buffer (get-buffer-create
   1512                                   (format "*Edit Annotation %s*"
   1513                                           (buffer-name)))
   1514               (pdf-annot-edit-contents-minor-mode 1)
   1515               (current-buffer))))
   1516     (with-current-buffer pdf-annot-edit-contents--buffer
   1517       (let ((inhibit-read-only t))
   1518         (erase-buffer)
   1519         (save-excursion (insert (pdf-annot-get a 'contents)))
   1520         (set-buffer-modified-p nil))
   1521       (setq pdf-annot-edit-contents--annotation a)
   1522       (funcall pdf-annot-edit-contents-setup-function a)
   1523       (current-buffer))))
   1524 
   1525 (defun pdf-annot-edit-contents (a)
   1526   "Edit the contents of annotation A."
   1527   (select-window
   1528    (display-buffer
   1529     (pdf-annot-edit-contents-noselect a)
   1530     pdf-annot-edit-contents-display-buffer-action)))
   1531 
   1532 (defun pdf-annot-edit-contents-mouse (ev)
   1533   "Edit the contents of the annotation described by mouse event EV."
   1534   (interactive "@e")
   1535   (let* ((pos (posn-object-x-y (event-start ev)))
   1536          (a (and pos (pdf-annot-at-position pos))))
   1537     (unless a
   1538       (error "No annotation at this position"))
   1539     (pdf-annot-edit-contents a)))
   1540 
   1541 
   1542 
   1543 ;; * ================================================================== *
   1544 ;; * Listing annotations
   1545 ;; * ================================================================== *
   1546 
   1547 (defcustom pdf-annot-list-display-buffer-action
   1548   '((display-buffer-reuse-window
   1549      display-buffer-pop-up-window)
   1550     (inhibit-same-window . t))
   1551   "Display action used when displaying the list buffer."
   1552   :type display-buffer--action-custom-type)
   1553 
   1554 (defcustom pdf-annot-list-format
   1555   '((page . 3)
   1556     (type . 10)
   1557     (label . 24)
   1558     (date . 24))
   1559   "Annotation properties visible in the annotation list.
   1560 
   1561 It should be a list of \(PROPERTIZE. WIDTH\), where PROPERTY is a
   1562 symbol naming one of supported properties to list and WIDTH its
   1563 desired column-width.
   1564 
   1565 Currently supported properties are page, type, label, date and contents."
   1566   :type '(alist :key-type (symbol))
   1567   :options '((page (integer :value 3 :tag "Column Width"))
   1568              (type (integer :value 10 :tag "Column Width" ))
   1569              (label (integer :value 24 :tag "Column Width"))
   1570              (date (integer :value 24 :tag "Column Width"))
   1571              (contents (integer :value 56 :tag "Column Width"))))
   1572 
   1573 (defcustom pdf-annot-list-highlight-type t
   1574   "Whether to highlight \"Type\" column annotation list with annotation color."
   1575   :type 'boolean)
   1576 
   1577 (defvar-local pdf-annot-list-buffer nil)
   1578 
   1579 (defvar-local pdf-annot-list-document-buffer nil)
   1580 
   1581 (defvar pdf-annot-list-mode-map
   1582   (let ((km (make-sparse-keymap)))
   1583     (define-key km (kbd "C-c C-f") #'pdf-annot-list-follow-minor-mode)
   1584     (define-key km (kbd "SPC") #'pdf-annot-list-display-annotation-from-id)
   1585     km))
   1586 
   1587 (defun pdf-annot-property-completions (property)
   1588   "Return a list of completion candidates for annotation property PROPERTY.
   1589 
   1590 Return nil, if not available."
   1591   (cl-case property
   1592     (color (pdf-util-color-completions))
   1593     (icon (copy-sequence pdf-annot-standard-text-icons))))
   1594 
   1595 (defun pdf-annot-compare-annotations (a1 a2)
   1596   "Compare annotations A1 and A2.
   1597 
   1598 Return non-nil if A1's page is less than A2's one or if they
   1599 belong to the same page and A1 is displayed above/left of A2."
   1600   (let ((p1 (pdf-annot-get a1 'page))
   1601         (p2 (pdf-annot-get a2 'page)))
   1602     (or (< p1 p2)
   1603         (and (= p1 p2)
   1604              (let ((e1 (pdf-util-scale
   1605                         (car (pdf-annot-get-display-edges a1))
   1606                         '(1000 . 1000)))
   1607                    (e2 (pdf-util-scale
   1608                         (car (pdf-annot-get-display-edges a2))
   1609                         '(1000 . 1000))))
   1610                (pdf-util-with-edges (e1 e2)
   1611                  (or (< e1-top e2-top)
   1612                      (and (= e1-top e2-top)
   1613                           (<= e1-left e2-left)))))))))
   1614 
   1615 (defun pdf-annot-list-entries ()
   1616   "Return all the annotations of this PDF buffer as a `tabulated-list'."
   1617   (unless (buffer-live-p pdf-annot-list-document-buffer)
   1618     (error "No PDF document associated with this buffer"))
   1619   (mapcar #'pdf-annot-list-create-entry
   1620           (sort (pdf-annot-getannots nil pdf-annot-list-listed-types
   1621                                      pdf-annot-list-document-buffer)
   1622                 #'pdf-annot-compare-annotations)))
   1623 
   1624 (defun pdf-annot--make-entry-formatter (a)
   1625   "Return a formatter function for annotation A.
   1626 
   1627 A formatter function takes a format cons-cell and returns
   1628 pretty-printed output."
   1629   (lambda (fmt)
   1630     (let ((entry-type (car fmt))
   1631           (entry-width (cdr fmt))
   1632           ;; Taken from css-mode.el
   1633           (contrasty-color
   1634            (lambda (name)
   1635              (if (> (color-distance name "black") 292485)
   1636                  "black" "white")))
   1637           (prune-newlines
   1638            (lambda (str)
   1639              (replace-regexp-in-string "\n" " " str t t))))
   1640       (cl-ecase entry-type
   1641         (date (propertize (pdf-annot-print-property a 'modified)
   1642                           'date
   1643                           (pdf-annot-get a 'modified)))
   1644         (page (pdf-annot-print-property a 'page))
   1645         (label (funcall prune-newlines
   1646                         (pdf-annot-print-property a 'label)))
   1647         (contents
   1648          (truncate-string-to-width
   1649           (funcall prune-newlines
   1650                    (pdf-annot-print-property a 'contents))
   1651           entry-width))
   1652         (type
   1653          (let ((color (pdf-annot-get a 'color))
   1654                (type (pdf-annot-print-property a 'type)))
   1655            (if pdf-annot-list-highlight-type
   1656                (propertize
   1657                 type 'face
   1658                 `(:background ,color
   1659                               :foreground ,(funcall contrasty-color color)))
   1660              type)))))))
   1661 
   1662 (defun pdf-annot-list-create-entry (a)
   1663   "Create a `tabulated-list-entries' entry for annotation A."
   1664   (list (pdf-annot-get-id a)
   1665         (vconcat
   1666          (mapcar (pdf-annot--make-entry-formatter a)
   1667                  pdf-annot-list-format))))
   1668 
   1669 (define-derived-mode pdf-annot-list-mode tablist-mode "Annots"
   1670   ;; @TODO: Remove the hard-coded index values here, and figure out a
   1671   ;; way to properly link this to the index values of
   1672   ;; `pdf-annot-list-format'.
   1673 
   1674   ;; @TODO: Add tests for annotation formatting and display
   1675   (let* ((page-sorter
   1676           (lambda (a b)
   1677             (< (string-to-number (aref (cadr a) 0))
   1678                (string-to-number (aref (cadr b) 0)))))
   1679          (date-sorter
   1680           (lambda (a b)
   1681             (time-less-p (get-text-property 0 'date (aref (cadr a) 3))
   1682                          (get-text-property 0 'date (aref (cadr b) 3)))))
   1683          (format-generator
   1684           (lambda (format)
   1685             (let ((field (car format))
   1686                   (width (cdr format)))
   1687               (cl-case field
   1688                 (page `("Pg."
   1689                         ,width
   1690                         ,page-sorter
   1691                         :read-only t
   1692                         :right-align t))
   1693                 (date `("Date"
   1694                         ,width
   1695                         ,date-sorter
   1696                         :read-only t))
   1697                 (t (list
   1698                     (capitalize (symbol-name field))
   1699                     width
   1700                     t
   1701                     :read-only t)))))))
   1702     (setq tabulated-list-entries 'pdf-annot-list-entries
   1703           tabulated-list-format (vconcat
   1704                                  (mapcar
   1705                                   format-generator
   1706                                   pdf-annot-list-format))
   1707           tabulated-list-padding 2))
   1708   (set-keymap-parent pdf-annot-list-mode-map tablist-mode-map)
   1709   (use-local-map pdf-annot-list-mode-map)
   1710   (when (assq 'type pdf-annot-list-format)
   1711     (setq tablist-current-filter
   1712           `(not (== "Type" "link"))))
   1713   (tabulated-list-init-header))
   1714 
   1715 (defun pdf-annot-list-annotations ()
   1716   "List annotations in a Dired like buffer.
   1717 
   1718 \\{pdf-annot-list-mode-map}"
   1719   (interactive)
   1720   (pdf-util-assert-pdf-buffer)
   1721   (let ((buffer (current-buffer)))
   1722     (with-current-buffer (get-buffer-create
   1723                           (format "*%s's annots*"
   1724                                   (file-name-sans-extension
   1725                                    (buffer-name))))
   1726       (delay-mode-hooks
   1727         (unless (derived-mode-p 'pdf-annot-list-mode)
   1728           (pdf-annot-list-mode))
   1729         (setq pdf-annot-list-document-buffer buffer)
   1730         (tabulated-list-print)
   1731         (setq tablist-context-window-function
   1732               (lambda (id) (pdf-annot-list-context-function id buffer))
   1733               tablist-operations-function #'pdf-annot-list-operation-function)
   1734         (let ((list-buffer (current-buffer)))
   1735           (with-current-buffer buffer
   1736             (setq pdf-annot-list-buffer list-buffer))))
   1737       (run-mode-hooks)
   1738       (pop-to-buffer
   1739        (current-buffer)
   1740        pdf-annot-list-display-buffer-action)
   1741       (tablist-move-to-major-column)
   1742       (tablist-display-context-window))
   1743     (add-hook 'pdf-info-close-document-hook
   1744               #'pdf-annot-list-update nil t)
   1745     (add-hook 'pdf-annot-modified-functions
   1746               #'pdf-annot-list-update nil t)))
   1747 
   1748 (defun pdf-annot-list-goto-annotation (a)
   1749   "List all the annotations in the current buffer.
   1750 
   1751 Goto the annotation A in the list."
   1752   (with-current-buffer (pdf-annot-get-buffer a)
   1753     (unless (and (buffer-live-p pdf-annot-list-buffer)
   1754                  (get-buffer-window pdf-annot-list-buffer))
   1755       (pdf-annot-list-annotations))
   1756     (with-selected-window (get-buffer-window pdf-annot-list-buffer)
   1757       (goto-char (point-min))
   1758       (let ((id (pdf-annot-get-id a)))
   1759         (while (and (not (eobp))
   1760                     (not (eq id (tabulated-list-get-id))))
   1761           (forward-line))
   1762         (unless (eq id (tabulated-list-get-id))
   1763           (error "Unable to find annotation"))
   1764         (when (invisible-p (point))
   1765           (tablist-suspend-filter t))
   1766         (tablist-move-to-major-column)))))
   1767 
   1768 
   1769 (defun pdf-annot-list-update (&optional _fn)
   1770   "Update the list of annotations on any change.
   1771 
   1772 This is an internal function which runs as a hook in various situations."
   1773   (when (buffer-live-p pdf-annot-list-buffer)
   1774     (with-current-buffer pdf-annot-list-buffer
   1775       (unless tablist-edit-column-minor-mode
   1776         (tablist-revert))
   1777       (tablist-context-window-update))))
   1778 
   1779 (defun pdf-annot-list-context-function (id buffer)
   1780   "Show the contents of an Annotation.
   1781 
   1782 For an annotation identified by ID, belonging to PDF in BUFFER,
   1783 get the contents and display them on demand."
   1784   (with-current-buffer (get-buffer-create "*Contents*")
   1785     (set-window-buffer nil (current-buffer))
   1786     (let ((inhibit-read-only t))
   1787       (erase-buffer)
   1788       (when id
   1789         (save-excursion
   1790           (insert
   1791            (pdf-annot-print-annotation
   1792             (pdf-annot-getannot id buffer)))))
   1793       (read-only-mode 1))))
   1794 
   1795 (defun pdf-annot-list-operation-function (op &rest args)
   1796   "Define bulk operations in Annotation list buffer.
   1797 
   1798 OP is the operation that the user wants to execute. Supported
   1799 operations are `delete' and `find-entry'.
   1800 
   1801 ARGS contain the annotation-ids to operate on."
   1802   (cl-ecase op
   1803     (supported-operations '(delete find-entry))
   1804     (delete
   1805      (cl-destructuring-bind (ids)
   1806          args
   1807        (when (buffer-live-p pdf-annot-list-document-buffer)
   1808          (with-current-buffer pdf-annot-list-document-buffer
   1809            (pdf-annot-with-atomic-modifications
   1810              (dolist (a (mapcar #'pdf-annot-getannot ids))
   1811                (pdf-annot-delete a)))))))
   1812     (find-entry
   1813      (cl-destructuring-bind (id)
   1814          args
   1815        (unless (buffer-live-p pdf-annot-list-document-buffer)
   1816          (error "No PDF document associated with this buffer"))
   1817        (let* ((buffer pdf-annot-list-document-buffer)
   1818               (a (pdf-annot-getannot id buffer))
   1819               (pdf-window (save-selected-window
   1820                             (or (get-buffer-window buffer)
   1821                                 (display-buffer buffer))))
   1822               window)
   1823          (with-current-buffer buffer
   1824            (pdf-annot-activate-annotation a)
   1825            (setq window (selected-window)))
   1826          ;; Make it so that quitting the edit window returns to the
   1827          ;; list window.
   1828          (unless (memq window (list (selected-window) pdf-window))
   1829            (let* ((quit-restore
   1830                    (window-parameter window 'quit-restore)))
   1831              (when quit-restore
   1832                (setcar (nthcdr 2 quit-restore) (selected-window))))))))))
   1833 
   1834 (defvar pdf-annot-list-display-annotation--timer nil)
   1835 
   1836 (defun pdf-annot-list-display-annotation-from-id (id)
   1837   "Display the Annotation ID in the PDF file.
   1838 
   1839 This allows us to follow the tabulated-list of annotations and
   1840 have the PDF buffer automatically move along with us."
   1841   (interactive (list (tabulated-list-get-id)))
   1842   (when id
   1843     (unless (buffer-live-p pdf-annot-list-document-buffer)
   1844       (error "PDF buffer was killed"))
   1845     (when (timerp pdf-annot-list-display-annotation--timer)
   1846       (cancel-timer pdf-annot-list-display-annotation--timer))
   1847     (setq pdf-annot-list-display-annotation--timer
   1848           (run-with-idle-timer 0.1 nil
   1849             (lambda (buffer a)
   1850               (when (buffer-live-p buffer)
   1851                 (with-selected-window
   1852                     (or (get-buffer-window buffer)
   1853                         (display-buffer
   1854                          buffer
   1855                          '(nil (inhibit-same-window . t))))
   1856                   (pdf-annot-show-annotation a t))))
   1857             pdf-annot-list-document-buffer
   1858             (pdf-annot-getannot id pdf-annot-list-document-buffer)))))
   1859 
   1860 (define-minor-mode pdf-annot-list-follow-minor-mode
   1861   "Make the PDF follow the annotations in the list buffer."
   1862   :group 'pdf-annot
   1863   (unless (derived-mode-p 'pdf-annot-list-mode)
   1864     (error "Not in pdf-annot-list-mode"))
   1865   (cond
   1866    (pdf-annot-list-follow-minor-mode
   1867     (add-hook 'tablist-selection-changed-functions
   1868               #'pdf-annot-list-display-annotation-from-id nil t)
   1869     (let ((id (tabulated-list-get-id)))
   1870       (when id
   1871         (pdf-annot-list-display-annotation-from-id id))))
   1872    (t
   1873     (remove-hook 'tablist-selection-changed-functions
   1874                  #'pdf-annot-list-display-annotation-from-id t))))
   1875 
   1876 (provide 'pdf-annot)
   1877 ;;; pdf-annot.el ends here
	dotemacs My Emacs configuration
	git clone git://git.entf.net/dotemacs
	Log \| Files \| Refs \| LICENSE