Commits

Fabrice Gabolde committed 2681d93

Switched to using overlays for annotations.

Set the help-echo property to the annotation contents.

  • Participants
  • Parent commits 93cefe2

Comments (0)

Files changed (1)

+(require 'cl)
+
 (defface anote/annotation-face
   '((t :background "#f9f87f"
        :foreground "black"))
               (setq bound-right (cdr boundses)))
           (setq bound-left (point))
           (setq bound-right (1+ (point))))))
-    (anote/propertize-bounds
+    (anote/overlay-bounds
      (anote/store-annotation (current-buffer) contents bound-left bound-right)
      bound-left
      bound-right)))
 
+(defun anote/echo-annotation (window overlay position)
+  "Return the contents for this annotation.
+
+Suitable for the help-echo property."
+  (anote/get-annotation (overlay-buffer overlay)
+                        (overlay-get overlay 'annotation)))
+
 (defun anote/unannotate-this (&optional silent)
   "Remove the annotation under point."
   (interactive)
   (let* ((bound-right
-          (next-single-property-change (point) 'annotation nil nil))
+          (next-single-char-property-change (point) 'annotation nil nil))
          (bound-left
-          (previous-single-property-change (point) 'annotation nil nil)))
+          (previous-single-char-property-change (point) 'annotation nil nil)))
     (if (and bound-right bound-left)
         (progn
           (anote/remove-annotation (current-buffer)
-                                   (get-text-property bound-left 'annotation))
-          (anote/unpropertize-bounds bound-left bound-right))
+                                   (get-char-property bound-left 'annotation))
+          (anote/unoverlay-bounds bound-left bound-right))
       (unless silent
         (message "There is no annotation here."))
       nil)))
 (defun anote/get-this-annotation (&optional silent)
   "Display the annotation under point in the minibuffer."
   (interactive)
-  (let ((index (get-text-property (point) 'annotation)))
+  (let ((index (get-char-property (point) 'annotation)))
     (if index
         (let ((annotation (anote/get-annotation (current-buffer) index)))
           (if annotation
               (let ((new-annotation (read-from-minibuffer "New annotation: " annotation)))
                 (if (> (length new-annotation) 0)
                     (let* ((bound-right
-                            (next-single-property-change (point) 'annotation nil nil))
+                            (next-single-char-property-change (point) 'annotation nil nil))
                            (bound-left
-                            (previous-single-property-change (point) 'annotation nil nil)))
-                      (anote/propertize-bounds
+                            (previous-single-char-property-change (point) 'annotation nil nil)))
+                      (anote/overlay-bounds
                        (anote/store-annotation (current-buffer) new-annotation bound-left bound-right)
                        bound-left
                        bound-right))
       (unless silent
         (message "There is no annotation here.")))))
 
-(defun anote/propertize-bounds (index bound-left bound-right)
+(defun anote/overlay-bounds (index bound-left bound-right)
   "Set the correct annotation properties on a region in the
 current buffer."
-  (let ((old-flface (get-text-property bound-left 'font-lock-face)))
-    (anote/unannotate-this t)
-    (add-text-properties bound-left bound-right
-                         `(anote/old-font-lock-face ,old-flface))
-    (add-text-properties bound-left bound-right
-                         '(font-lock-face anote/annotation-face))
-    (add-text-properties bound-left bound-right
-                         `(annotation ,index))))
+  ;; (anote/unannotate-this t)
+  (let ((overlay (make-overlay bound-left bound-right (current-buffer))))
+    (overlay-put overlay 'face 'anote/annotation-face)
+    (overlay-put overlay 'help-echo 'anote/echo-annotation)
+    (overlay-put overlay 'annotation index)))
 
-(defun anote/unpropertize-bounds (bound-left bound-right)
+(defun anote/overlay-is-ours (overlay)
+  "Return a true value if the overlay is from anote, nil otherwise."
+  (overlay-get overlay 'annotation))
+
+(defun anote/unoverlay-bounds (bound-left bound-right)
   "Remove the annotation properties on a region in the current
 buffer."
-  (remove-text-properties bound-left bound-right '(annotation nil))
-  (add-text-properties bound-left bound-right
-                       `(font-lock-face ,(get-text-property bound-left 'anote/old-font-lock-face)))
-  (remove-text-properties bound-left bound-right '(anote/old-font-lock-face nil))
-  (when font-lock-fontified (font-lock-fontify-buffer)))
+  (let ((overlay (car (remove-if-not
+                       'anote/overlay-is-ours
+                       (overlays-at bound-left)))))
+    (delete-overlay overlay)))
 
 (defun anote/get-anote-buffer (&optional source-buffer-or-name)
   "Return the anote buffer associated to SOURCE-BUFFER-OR-NAME."
     (with-current-buffer source-buffer-or-name
       (let ((bound-left (point-min))
             (bound-right nil)
-            (is-annotated (get-text-property (point-min) 'annotation))))
+            (is-annotated (get-char-property (point-min) 'annotation))))
       (while (not (null bound-right))
-        (setq bound-right (next-single-property-change current-position 'annotation))
+        (setq bound-right (next-single-char-property-change current-position 'annotation))
         (when is-annotated
           (anote/update-annotation source-buffer-or-name
                                    index
                   (bound-right (string-to-number (match-string 3)))
                   (contents (match-string 4)))
               (with-current-buffer source-buffer-or-name
-                (anote/propertize-bounds index bound-left bound-right))))))))
+                (anote/overlay-bounds index bound-left bound-right))))))))