bookmark-conf: Preserve annotation when overriding it.

* bookmark-conf.el (durand-bookmark-set-preserve-annotation-advice)
(bookmark-set-internal): Add an around advice to preserve the
annotation when desired.

1 files changed, 40 insertions, 0 deletions

diff --git a/bookmark-conf.el b/bookmark-conf.el
index 4e47910..45e0849 100644
--- a/bookmark-conf.el
+++ b/bookmark-conf.el
@@ -158,5 +158,45 @@ ARGS are ignored."
                `(,(rx bos (eval blist-buffer-name) eos)
                  (display-buffer-same-window)))))
 
+;;; Preserve annotation when overriding it
+
+(defun durand-bookmark-set-preserve-annotation-advice
+    (old-function prompt name overwrite-or-push)
+  "Preserve the annotation of the old bookmark if we overwrite it.
+OLD-FUNCTION should be `bookmark-set-internal'.
+
+PROMPT, NAME are passed to `bookmark-set-internal'.
+
+If OVERWRITE-OR-PUSH is non-nil, we set the overriding new
+bookmark to have the same annotations as the old bookmark, if
+any."
+  ;; if we are not overwriting, we do not modify the behaviour
+  (cond
+   ((or (not overwrite-or-push) (eq overwrite-or-push 'push))
+    (funcall old-function prompt name overwrite-or-push))
+   ;; This temporary record only serves the purpose of providing a
+   ;; default bookmark.
+   ((let* ((temp-record (bookmark-make-record))
+           (defaults (bookmark-prop-get temp-record 'defaults))
+           (default
+             (cond ((consp defaults) (car defaults)) (defaults)))
+           (name (or name
+                     (read-from-minibuffer
+                      (format-prompt prompt default)
+                      nil
+                      bookmark-minibuffer-read-name-map
+                      nil nil defaults)))
+           (name (cond ((string= name "") default) (name)))
+           (bookmark (bookmark-get-bookmark name t))
+           (annotation (cond
+                        (bookmark
+                         (bookmark-get-annotation bookmark)))))
+      (funcall old-function prompt name overwrite-or-push)
+      (bookmark-set-annotation bookmark annotation)))))
+
+(advice-add #'bookmark-set-internal
+            :around
+            #'durand-bookmark-set-preserve-annotation-advice)
+
 (provide 'bookmark-conf)
 ;;; bookmark-conf.el ends here