pdf-annot.el - dotemacs - My Emacs configuration

pdf-annot.el (71785B)
      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* ((selection-style pdf-view-selection-style)
   1056          (a (apply #'pdf-info-addannot
   1057                    page
   1058                    (if (eq type 'text)
   1059                        (car edges)
   1060                      (apply #'pdf-util-edges-union
   1061                             (apply #'append
   1062                                    (mapcar
   1063                                     (lambda (e)
   1064                                       (pdf-info-getselection page e selection-style))
   1065                                     edges))))
   1066                    type
   1067                    selection-style
   1068                    nil
   1069                    (if (not (eq type 'text)) edges)))
   1070          (id (pdf-annot-get-id a)))
   1071     (when property-alist
   1072       (condition-case err
   1073           (setq a (pdf-info-editannot id property-alist))
   1074         (error
   1075          (pdf-info-delannot id)
   1076          (signal (car err) (cdr err)))))
   1077     (setq a (pdf-annot-create a))
   1078     (set-buffer-modified-p t)
   1079     (pdf-annot-run-modified-hooks :insert a)
   1080     (when pdf-annot-activate-created-annotations
   1081       (pdf-annot-activate-annotation a))
   1082     a))
   1083 
   1084 (defun pdf-annot-add-text-annotation (pos &optional icon property-alist)
   1085   "Add a new text annotation at POS in the selected window.
   1086 
   1087 POS should be a image position object or a cons \(X . Y\), both
   1088 being image coordinates.
   1089 
   1090 ICON determines how the annotation is displayed and should be
   1091 listed in `pdf-annot-standard-text-icons'.  Any other value is ok
   1092 as well, but will render the annotation invisible.
   1093 
   1094 Adjust X and Y accordingly, if the position would render the
   1095 annotation off-page.
   1096 
   1097 Merge ICON as a icon property with PROPERTY-ALIST and
   1098 `pdf-annot-default-text-annotation-properties' and apply the
   1099 result to the created annotation.
   1100 
   1101 See also `pdf-annot-add-annotation'.
   1102 
   1103 Return the new annotation."
   1104 
   1105   (interactive
   1106    (let* ((posn (pdf-util-read-image-position
   1107                  "Click where a new text annotation should be added ..."))
   1108           (window (posn-window posn)))
   1109      (select-window window)
   1110      (list posn)))
   1111   (pdf-util-assert-pdf-window)
   1112   (when (posnp pos)
   1113     (setq pos (posn-object-x-y pos)))
   1114   (let ((isize (pdf-view-image-size))
   1115         (x (car pos))
   1116         (y (cdr pos)))
   1117     (unless (and (>= x 0)
   1118                  (< x (car isize)))
   1119       (signal 'args-out-of-range (list pos)))
   1120     (unless (and (>= y 0)
   1121                  (< y (cdr isize)))
   1122       (signal 'args-out-of-range (list pos)))
   1123     (let ((size (pdf-util-scale-points-to-pixel
   1124                  pdf-annot-text-annotation-size 'round)))
   1125       (setcar size (min (car size) (car isize)))
   1126       (setcdr size (min (cdr size) (cdr isize)))
   1127       (cl-decf x (max 0 (- (+ x (car size)) (car isize))))
   1128       (cl-decf y (max 0 (- (+ y (cdr size)) (cdr isize))))
   1129       (pdf-annot-add-annotation
   1130        'text (pdf-util-scale-pixel-to-relative
   1131               (list x y -1 -1))
   1132        (pdf-annot-merge-alists
   1133         (and icon `((icon . ,icon)))
   1134         property-alist
   1135         pdf-annot-default-text-annotation-properties
   1136         (cdr (assq 'text pdf-annot-default-annotation-properties))
   1137         (cdr (assq t pdf-annot-default-annotation-properties))
   1138         `((color . ,(car pdf-annot-color-history))))))))
   1139 
   1140 (defun pdf-annot-mouse-add-text-annotation (ev)
   1141   "Add a text annotation using the mouse.
   1142 
   1143 EV describes the captured mouse event."
   1144   (interactive "@e")
   1145   (pdf-annot-add-text-annotation
   1146    (if (eq (car-safe ev)
   1147            'menu-bar)
   1148        (let (echo-keystrokes)
   1149          (message nil)
   1150          (pdf-util-read-image-position
   1151           "Click where a new text annotation should be added ..."))
   1152      (event-start ev))))
   1153 
   1154 (defun pdf-annot-add-markup-annotation (list-of-edges type &optional color
   1155                                                       property-alist)
   1156   "Add a new markup annotation in the selected window.
   1157 
   1158 LIST-OF-EDGES determines the marked up area and should be a list
   1159 of \(LEFT TOP RIGHT BOT\), each value a relative coordinate.
   1160 
   1161 TYPE should be one of `squiggly', `underline', `strike-out' or
   1162 `highlight'.
   1163 
   1164 Merge COLOR as a color property with PROPERTY-ALIST and
   1165 `pdf-annot-default-markup-annotation-properties' and apply the
   1166 result to the created annotation.
   1167 
   1168 See also `pdf-annot-add-annotation'.
   1169 
   1170 Return the new annotation."
   1171   (interactive
   1172    (list (pdf-view-active-region t)
   1173          (let ((type (completing-read "Markup type (default highlight): "
   1174                                       '("squiggly" "highlight" "underline" "strike-out")
   1175                                       nil t)))
   1176            (if (equal type "") 'highlight (intern type)))
   1177          (pdf-annot-read-color)))
   1178   (pdf-util-assert-pdf-window)
   1179   (pdf-annot-add-annotation
   1180    type
   1181    list-of-edges
   1182    (pdf-annot-merge-alists
   1183     (and color `((color . ,color)))
   1184     property-alist
   1185     pdf-annot-default-markup-annotation-properties
   1186     (cdr (assq type pdf-annot-default-annotation-properties))
   1187     (cdr (assq t pdf-annot-default-annotation-properties))
   1188     (when pdf-annot-color-history
   1189       `((color . ,(car pdf-annot-color-history))))
   1190     '((color . "#ffff00")))
   1191    (pdf-view-current-page)))
   1192 
   1193 (defun pdf-annot-add-squiggly-markup-annotation (list-of-edges
   1194                                                  &optional color property-alist)
   1195   "Add a new squiggly annotation in the selected window.
   1196 
   1197 LIST-OF-EDGES defines the annotation boundary. COLOR defines the
   1198 annotation color and PROPERTY-ALIST defines additional annotation
   1199 properties. See also `pdf-annot-add-markup-annotation'."
   1200   (interactive (list (pdf-view-active-region t)))
   1201   (pdf-annot-add-markup-annotation list-of-edges 'squiggly color property-alist))
   1202 
   1203 (defun pdf-annot-add-underline-markup-annotation (list-of-edges
   1204                                                   &optional color property-alist)
   1205   "Add a new underline annotation in the selected window.
   1206 
   1207 LIST-OF-EDGES defines the annotation boundary. COLOR defines the
   1208 annotation color and PROPERTY-ALIST defines additional annotation
   1209 properties. See also `pdf-annot-add-markup-annotation'."
   1210   (interactive (list (pdf-view-active-region t)))
   1211   (pdf-annot-add-markup-annotation list-of-edges 'underline color property-alist))
   1212 
   1213 (defun pdf-annot-add-strikeout-markup-annotation (list-of-edges
   1214                                                   &optional color property-alist)
   1215   "Add a new strike-out annotation in the selected window.
   1216 
   1217 LIST-OF-EDGES defines the annotation boundary. COLOR defines the
   1218 annotation color and PROPERTY-ALIST defines additional annotation
   1219 properties. See also `pdf-annot-add-markup-annotation'."
   1220   (interactive (list (pdf-view-active-region t)))
   1221   (pdf-annot-add-markup-annotation list-of-edges 'strike-out color property-alist))
   1222 
   1223 (defun pdf-annot-add-highlight-markup-annotation (list-of-edges
   1224                                                   &optional color property-alist)
   1225   "Add a new highlight annotation in the selected window.
   1226 
   1227 LIST-OF-EDGES defines the annotation boundary. COLOR defines the
   1228 annotation color and PROPERTY-ALIST defines additional annotation
   1229 properties. See also `pdf-annot-add-markup-annotation'."
   1230   (interactive (list (pdf-view-active-region t)))
   1231   (pdf-annot-add-markup-annotation list-of-edges 'highlight color property-alist))
   1232 
   1233 (defun pdf-annot-read-color (&optional prompt)
   1234   "Read and return a color using PROMPT.
   1235 
   1236 Offer `pdf-annot-color-history' as default values."
   1237   (let* ((defaults (append
   1238                     (delq nil
   1239                           (list
   1240                            (cdr (assq 'color
   1241                                       pdf-annot-default-markup-annotation-properties))
   1242                            (cdr (assq 'color
   1243                                       pdf-annot-default-text-annotation-properties))))
   1244                     pdf-annot-color-history))
   1245          (prompt
   1246           (format "%s%s: "
   1247                   (or prompt "Color")
   1248                   (if defaults (format " (default %s)" (car defaults)) "")))
   1249          (current-completing-read-function completing-read-function)
   1250          (completing-read-function
   1251           (lambda (prompt collection &optional predicate require-match
   1252                           initial-input _hist _def inherit-input-method)
   1253             (funcall current-completing-read-function
   1254                      prompt collection predicate require-match
   1255                      initial-input 'pdf-annot-color-history
   1256                      defaults
   1257                      inherit-input-method))))
   1258     (read-color prompt)))
   1259 
   1260 (defun pdf-annot-merge-alists (&rest alists)
   1261   "Merge ALISTS into a single one.
   1262 
   1263 Suppresses successive duplicate entries of keys after the first
   1264 occurrence in ALISTS."
   1265 
   1266   (let (merged)
   1267     (dolist (elt (apply #'append alists))
   1268       (unless (assq (car elt) merged)
   1269         (push elt merged)))
   1270     (nreverse merged)))
   1271 
   1272 
   1273 
   1274 ;; * ================================================================== *
   1275 ;; * Displaying annotation contents
   1276 ;; * ================================================================== *
   1277 
   1278 (defun pdf-annot-print-property (a property)
   1279   "Pretty print annotation A's property PROPERTY."
   1280   (let ((value (pdf-annot-get a property)))
   1281     (cl-case property
   1282       (color
   1283        (propertize (or value "")
   1284                    'face (and value
   1285                               `(:background ,value))))
   1286       ((created modified)
   1287        (let ((date value))
   1288          (if (null date)
   1289              "No date"
   1290            (current-time-string date))))
   1291       ;; print verbatim
   1292       (subject
   1293        (or value "No subject"))
   1294       (opacity
   1295        (let ((opacity (or value 1.0)))
   1296          (format "%d%%" (round (* 100 opacity)))))
   1297       (t (format "%s" (or value ""))))))
   1298 
   1299 (defun pdf-annot-print-annotation (a)
   1300   "Pretty print annotation A."
   1301   (or (run-hook-with-args-until-success
   1302        'pdf-annot-print-annotation-functions a)
   1303       (pdf-annot-print-annotation-default a)))
   1304 
   1305 (defun pdf-annot-print-annotation-default (a)
   1306   "Default pretty printer for annotation A.
   1307 
   1308 The result consists of a header (as printed with
   1309 `pdf-annot-print-annotation-header') a newline and A's contents
   1310 property."
   1311   (concat
   1312    (pdf-annot-print-annotation-header a)
   1313    "\n"
   1314    (pdf-annot-get a 'contents)))
   1315 
   1316 (defun pdf-annot-print-annotation-header (a)
   1317   "Emit a suitable header string for annotation A."
   1318   (let ((header
   1319          (cond
   1320           ((eq 'file (pdf-annot-get a 'type))
   1321            (let ((att (pdf-annot-get-attachment a)))
   1322              (format "File attachment `%s' of %s"
   1323                      (or (cdr (assq 'filename att)) "unnamed")
   1324                      (if (cdr (assq 'size att))
   1325                          (format "size %s" (file-size-human-readable
   1326                                             (cdr (assq 'size att))))
   1327                        "unknown size"))))
   1328           (t
   1329            (format "%s"
   1330                    (mapconcat
   1331                     #'identity
   1332                     (mapcar
   1333                      (lambda (property)
   1334                        (pdf-annot-print-property
   1335                         a property))
   1336                      `(subject
   1337                        label
   1338                        modified))
   1339                     ";"))))))
   1340     (setq header (propertize header 'face 'header-line
   1341                              'intangible t 'read-only t))
   1342     ;; This `trick' makes the face apply in a tooltip.
   1343     (propertize header 'display header)))
   1344 
   1345 (defun pdf-annot-print-annotation-latex-maybe (a)
   1346   "Maybe print annotation A's content as a LaTeX fragment.
   1347 
   1348 See `pdf-annot-latex-string-predicate'."
   1349   (when (and (functionp pdf-annot-latex-string-predicate)
   1350              (funcall pdf-annot-latex-string-predicate
   1351                       (pdf-annot-get a 'contents)))
   1352     (pdf-annot-print-annotation-latex a)))
   1353 
   1354 (defun pdf-annot-print-annotation-latex (a)
   1355   "Print annotation A's content as a LaTeX fragment.
   1356 
   1357 This compiles A's contents as a LaTeX fragment and puts the
   1358 resulting image as a display property on the contents, prefixed
   1359 by a header."
   1360 
   1361   (let (tempfile)
   1362     (unwind-protect
   1363         (with-current-buffer (pdf-annot-get-buffer a)
   1364           (let* ((page (pdf-annot-get a 'page))
   1365                  (header (pdf-annot-print-annotation-header a))
   1366                  (contents (pdf-annot-get a 'contents))
   1367                  (hash (sxhash (format
   1368                                 "pdf-annot-print-annotation-latex%s%s%s"
   1369                                 page header contents)))
   1370                  (data (pdf-cache-lookup-image page 0 nil hash))
   1371                  ;; pdf-tools can only work with png files, so this
   1372                  ;; binding ensures that pdf-tools can print the
   1373                  ;; latex-preview regardless of the user
   1374                  ;; configuration.
   1375                  (org-preview-latex-default-process 'dvipng)
   1376                  (org-format-latex-header pdf-annot-latex-header)
   1377                  (temporary-file-directory
   1378                   (pdf-util-expand-file-name "pdf-annot-print-annotation-latex")))
   1379             (unless (file-directory-p temporary-file-directory)
   1380               (make-directory temporary-file-directory))
   1381             (unless data
   1382               (setq tempfile (make-temp-file "pdf-annot" nil ".png"))
   1383               ;; FIXME: Why is this with-temp-buffer needed (which it is) ?
   1384               (with-temp-buffer
   1385                 (org-create-formula-image
   1386                  contents tempfile org-format-latex-options t))
   1387               (setq data (pdf-util-munch-file tempfile))
   1388               (if (and (> (length data) 3)
   1389                        (equal (substring data 1 4)
   1390                               "PNG"))
   1391                   (pdf-cache-put-image page 0 data hash)
   1392                 (setq data nil)))
   1393             (concat
   1394              header
   1395              "\n"
   1396              (if data
   1397                  (propertize
   1398                   contents 'display (pdf-view-create-image data))
   1399                (propertize
   1400                 contents
   1401                 'display
   1402                 (concat
   1403                  (propertize "Failed to compile latex fragment\n"
   1404                              'face 'error)
   1405                  contents))))))
   1406       (when (and tempfile
   1407                  (file-exists-p tempfile))
   1408         (delete-file tempfile)))))
   1409 
   1410 
   1411 ;; * ================================================================== *
   1412 ;; * Editing annotation contents
   1413 ;; * ================================================================== *
   1414 
   1415 (defvar-local pdf-annot-edit-contents--annotation nil)
   1416 (put 'pdf-annot-edit-contents--annotation 'permanent-local t)
   1417 (defvar-local pdf-annot-edit-contents--buffer nil)
   1418 
   1419 (defcustom pdf-annot-edit-contents-setup-function
   1420   (lambda (a)
   1421     (let ((mode (if (funcall pdf-annot-latex-string-predicate
   1422                              (pdf-annot-get a 'contents))
   1423                     'latex-mode
   1424                   'org-mode)))
   1425       (unless (derived-mode-p mode)
   1426         (funcall mode))))
   1427   "A function for setting up, e.g. the major-mode, of the edit buffer.
   1428 
   1429 The function receives one argument, the annotation whose contents
   1430 is about to be edited in this buffer.
   1431 
   1432 The default value turns on `latex-mode' if
   1433 `pdf-annot-latex-string-predicate' returns non-nil on the
   1434 annotation's contents and otherwise `org-mode'."
   1435   :type 'function)
   1436 
   1437 (defcustom pdf-annot-edit-contents-display-buffer-action
   1438   '((display-buffer-reuse-window
   1439      display-buffer-split-below-and-attach)
   1440     (inhibit-same-window . t)
   1441     (window-height . 0.25))
   1442   "Display action when showing the edit buffer."
   1443   :type display-buffer--action-custom-type)
   1444 
   1445 (defvar pdf-annot-edit-contents-minor-mode-map
   1446   (let ((kmap (make-sparse-keymap)))
   1447     (set-keymap-parent kmap text-mode-map)
   1448     (define-key kmap (kbd "C-c C-c") #'pdf-annot-edit-contents-commit)
   1449     (define-key kmap (kbd "C-c C-q") #'pdf-annot-edit-contents-abort)
   1450     kmap))
   1451 
   1452 (define-minor-mode pdf-annot-edit-contents-minor-mode
   1453   "Active when editing the contents of annotations."
   1454   :group 'pdf-annot
   1455   (when pdf-annot-edit-contents-minor-mode
   1456     (message "%s"
   1457              (substitute-command-keys
   1458               "Press \\[pdf-annot-edit-contents-commit] to commit your changes, \\[pdf-annot-edit-contents-abort] to abandon them."))))
   1459 
   1460 (put 'pdf-annot-edit-contents-minor-mode 'permanent-local t)
   1461 
   1462 (defun pdf-annot-edit-contents-finalize (do-save &optional do-kill)
   1463   "Finalize edit-operations on an Annotation.
   1464 
   1465 If DO-SAVE is t, save the changes to annotation content without
   1466 asking. If DO-SAVE is `ask', check with the user if contents
   1467 should be saved.
   1468 
   1469 If DO-KILL is t, kill all windows displaying the annotation
   1470 contents. Else just bury the buffers."
   1471   (when (buffer-modified-p)
   1472     (cond
   1473      ((eq do-save 'ask)
   1474       (save-window-excursion
   1475         (display-buffer (current-buffer) nil (selected-frame))
   1476         (when (y-or-n-p "Save changes to this annotation ?")
   1477           (pdf-annot-edit-contents-save-annotation))))
   1478      (do-save
   1479       (pdf-annot-edit-contents-save-annotation)))
   1480     (set-buffer-modified-p nil))
   1481   (dolist (win (get-buffer-window-list))
   1482     (quit-window do-kill win)))
   1483 
   1484 (defun pdf-annot-edit-contents-save-annotation ()
   1485   "Internal function to save the contents of the annotation under editing."
   1486   (when pdf-annot-edit-contents--annotation
   1487     (pdf-annot-put pdf-annot-edit-contents--annotation
   1488         'contents
   1489       (buffer-substring-no-properties (point-min) (point-max)))
   1490     (set-buffer-modified-p nil)))
   1491 
   1492 (defun pdf-annot-edit-contents-commit ()
   1493   "Save the change made to the current annotation."
   1494   (interactive)
   1495   (pdf-annot-edit-contents-finalize t))
   1496 
   1497 (defun pdf-annot-edit-contents-abort ()
   1498   "Abort the change made to the current annotation."
   1499   (interactive)
   1500   (pdf-annot-edit-contents-finalize nil t))
   1501 
   1502 (defun pdf-annot-edit-contents-noselect (a)
   1503   "Internal function to setup all prerequisites for editing annotation A.
   1504 
   1505 At any given point of time, only one annotation can be in edit mode."
   1506   (with-current-buffer (pdf-annot-get-buffer a)
   1507     (when (and (buffer-live-p pdf-annot-edit-contents--buffer)
   1508                (not (eq a pdf-annot-edit-contents--annotation)))
   1509       (with-current-buffer pdf-annot-edit-contents--buffer
   1510         (pdf-annot-edit-contents-finalize 'ask)))
   1511     (unless (buffer-live-p pdf-annot-edit-contents--buffer)
   1512       (setq pdf-annot-edit-contents--buffer
   1513             (with-current-buffer (get-buffer-create
   1514                                   (format "*Edit Annotation %s*"
   1515                                           (buffer-name)))
   1516               (pdf-annot-edit-contents-minor-mode 1)
   1517               (current-buffer))))
   1518     (with-current-buffer pdf-annot-edit-contents--buffer
   1519       (let ((inhibit-read-only t))
   1520         (erase-buffer)
   1521         (save-excursion (insert (pdf-annot-get a 'contents)))
   1522         (set-buffer-modified-p nil))
   1523       (setq pdf-annot-edit-contents--annotation a)
   1524       (funcall pdf-annot-edit-contents-setup-function a)
   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     (with-current-buffer (get-buffer-create
   1725                           (format "*%s's annots*"
   1726                                   (file-name-sans-extension
   1727                                    (buffer-name))))
   1728       (delay-mode-hooks
   1729         (unless (derived-mode-p 'pdf-annot-list-mode)
   1730           (pdf-annot-list-mode))
   1731         (setq pdf-annot-list-document-buffer buffer)
   1732         (tabulated-list-print)
   1733         (setq tablist-context-window-function
   1734               (lambda (id) (pdf-annot-list-context-function id buffer))
   1735               tablist-operations-function #'pdf-annot-list-operation-function)
   1736         (let ((list-buffer (current-buffer)))
   1737           (with-current-buffer buffer
   1738             (setq pdf-annot-list-buffer list-buffer))))
   1739       (run-mode-hooks)
   1740       (pop-to-buffer
   1741        (current-buffer)
   1742        pdf-annot-list-display-buffer-action)
   1743       (tablist-move-to-major-column)
   1744       (tablist-display-context-window))
   1745     (add-hook 'pdf-info-close-document-hook
   1746               #'pdf-annot-list-update nil t)
   1747     (add-hook 'pdf-annot-modified-functions
   1748               #'pdf-annot-list-update nil t)))
   1749 
   1750 (defun pdf-annot-list-goto-annotation (a)
   1751   "List all the annotations in the current buffer.
   1752 
   1753 Goto the annotation A in the list."
   1754   (with-current-buffer (pdf-annot-get-buffer a)
   1755     (unless (and (buffer-live-p pdf-annot-list-buffer)
   1756                  (get-buffer-window pdf-annot-list-buffer))
   1757       (pdf-annot-list-annotations))
   1758     (with-selected-window (get-buffer-window pdf-annot-list-buffer)
   1759       (goto-char (point-min))
   1760       (let ((id (pdf-annot-get-id a)))
   1761         (while (and (not (eobp))
   1762                     (not (eq id (tabulated-list-get-id))))
   1763           (forward-line))
   1764         (unless (eq id (tabulated-list-get-id))
   1765           (error "Unable to find annotation"))
   1766         (when (invisible-p (point))
   1767           (tablist-suspend-filter t))
   1768         (tablist-move-to-major-column)))))
   1769 
   1770 
   1771 (defun pdf-annot-list-update (&optional _fn)
   1772   "Update the list of annotations on any change.
   1773 
   1774 This is an internal function which runs as a hook in various situations."
   1775   (when (buffer-live-p pdf-annot-list-buffer)
   1776     (with-current-buffer pdf-annot-list-buffer
   1777       (unless tablist-edit-column-minor-mode
   1778         (tablist-revert))
   1779       (tablist-context-window-update))))
   1780 
   1781 (defun pdf-annot-list-context-function (id buffer)
   1782   "Show the contents of an Annotation.
   1783 
   1784 For an annotation identified by ID, belonging to PDF in BUFFER,
   1785 get the contents and display them on demand."
   1786   (with-current-buffer (get-buffer-create "*Contents*")
   1787     (set-window-buffer nil (current-buffer))
   1788     (let ((inhibit-read-only t))
   1789       (erase-buffer)
   1790       (when id
   1791         (save-excursion
   1792           (insert
   1793            (pdf-annot-print-annotation
   1794             (pdf-annot-getannot id buffer)))))
   1795       (read-only-mode 1))))
   1796 
   1797 (defun pdf-annot-list-operation-function (op &rest args)
   1798   "Define bulk operations in Annotation list buffer.
   1799 
   1800 OP is the operation that the user wants to execute. Supported
   1801 operations are `delete' and `find-entry'.
   1802 
   1803 ARGS contain the annotation-ids to operate on."
   1804   (cl-ecase op
   1805     (supported-operations '(delete find-entry))
   1806     (delete
   1807      (cl-destructuring-bind (ids)
   1808          args
   1809        (when (buffer-live-p pdf-annot-list-document-buffer)
   1810          (with-current-buffer pdf-annot-list-document-buffer
   1811            (pdf-annot-with-atomic-modifications
   1812              (dolist (a (mapcar #'pdf-annot-getannot ids))
   1813                (pdf-annot-delete a)))))))
   1814     (find-entry
   1815      (cl-destructuring-bind (id)
   1816          args
   1817        (unless (buffer-live-p pdf-annot-list-document-buffer)
   1818          (error "No PDF document associated with this buffer"))
   1819        (let* ((buffer pdf-annot-list-document-buffer)
   1820               (a (pdf-annot-getannot id buffer))
   1821               (pdf-window (save-selected-window
   1822                             (or (get-buffer-window buffer)
   1823                                 (display-buffer buffer))))
   1824               window)
   1825          (with-current-buffer buffer
   1826            (pdf-annot-activate-annotation a)
   1827            (setq window (selected-window)))
   1828          ;; Make it so that quitting the edit window returns to the
   1829          ;; list window.
   1830          (unless (memq window (list (selected-window) pdf-window))
   1831            (let* ((quit-restore
   1832                    (window-parameter window 'quit-restore)))
   1833              (when quit-restore
   1834                (setcar (nthcdr 2 quit-restore) (selected-window))))))))))
   1835 
   1836 (defvar pdf-annot-list-display-annotation--timer nil)
   1837 
   1838 (defun pdf-annot-list-display-annotation-from-id (id)
   1839   "Display the Annotation ID in the PDF file.
   1840 
   1841 This allows us to follow the tabulated-list of annotations and
   1842 have the PDF buffer automatically move along with us."
   1843   (interactive (list (tabulated-list-get-id)))
   1844   (when id
   1845     (unless (buffer-live-p pdf-annot-list-document-buffer)
   1846       (error "PDF buffer was killed"))
   1847     (when (timerp pdf-annot-list-display-annotation--timer)
   1848       (cancel-timer pdf-annot-list-display-annotation--timer))
   1849     (setq pdf-annot-list-display-annotation--timer
   1850           (run-with-idle-timer 0.1 nil
   1851             (lambda (buffer a)
   1852               (when (buffer-live-p buffer)
   1853                 (with-selected-window
   1854                     (or (get-buffer-window buffer)
   1855                         (display-buffer
   1856                          buffer
   1857                          '(nil (inhibit-same-window . t))))
   1858                   (pdf-annot-show-annotation a t))))
   1859             pdf-annot-list-document-buffer
   1860             (pdf-annot-getannot id pdf-annot-list-document-buffer)))))
   1861 
   1862 (define-minor-mode pdf-annot-list-follow-minor-mode
   1863   "Make the PDF follow the annotations in the list buffer."
   1864   :group 'pdf-annot
   1865   (unless (derived-mode-p 'pdf-annot-list-mode)
   1866     (error "Not in pdf-annot-list-mode"))
   1867   (cond
   1868    (pdf-annot-list-follow-minor-mode
   1869     (add-hook 'tablist-selection-changed-functions
   1870               #'pdf-annot-list-display-annotation-from-id nil t)
   1871     (let ((id (tabulated-list-get-id)))
   1872       (when id
   1873         (pdf-annot-list-display-annotation-from-id id))))
   1874    (t
   1875     (remove-hook 'tablist-selection-changed-functions
   1876                  #'pdf-annot-list-display-annotation-from-id t))))
   1877 
   1878 (provide 'pdf-annot)
   1879 ;;; pdf-annot.el ends here
	dotemacs My Emacs configuration
	git clone git://git.entf.net/dotemacs
	Log \| Files \| Refs \| LICENSE