pdf-annot.el - dotemacs - My Emacs configuration

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