pdf-annot.el - config - Personal configuration.

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