[nongnu] elpa/annotate 54aefdec8d 114/372: Merge pull request #46 from cage2/master

[ELPA Syncer]

branch: elpa/annotate
commit 54aefdec8d7d366d0987aec9242f035a52c54aa2
Merge: d60feb9cab b180248ddc
Author: Bastian Bechtold <bastibe@users.noreply.github.com>
Commit: GitHub <noreply@github.com>

    Merge pull request #46 from cage2/master
    
    - added a secondary  color for highlight and annotation  text
---
 annotate.el | 166 ++++++++++++++++++++++++++++++++++++++++++++++--------------
 1 file changed, 127 insertions(+), 39 deletions(-)

diff --git a/annotate.el b/annotate.el
index 55e8cf348a..1c7cf94af7 100644
--- a/annotate.el
+++ b/annotate.el
@@ -82,11 +82,21 @@
   "Face for annotation highlights."
   :group 'annotate)
 
+(defface annotate-highlight-secondary
+  '((t (:underline "khaki")))
+  "Face for secondary annotation highlights."
+  :group 'annotate)
+
 (defface annotate-annotation
   '((t (:background "coral" :foreground "black")))
   "Face for annotations."
   :group 'annotate)
 
+(defface annotate-annotation-secondary
+  '((t (:background "khaki" :foreground "black")))
+  "Face for secondary annotations."
+  :group 'annotate)
+
 (defcustom annotate-annotation-column 85
   "Where annotations appear."
   :type 'number
@@ -173,11 +183,47 @@ major mode is a member of this list (space separated 
entries)."
          ,@body)
      (setf inhibit-modification-hooks t)))
 
+(defun annotate-end-of-line-pos ()
+ "Get the position of the end of line and rewind the point's
+position (so that it is unchanged after this function is called)."
+  (save-excursion
+    (end-of-line)
+    (point)))
+
+(defun annotate-beginning-of-line-pos ()
+  "Get the position of the beginning of line and rewind the point's
+position (so that it is unchanged after this function is called)."
+  (save-excursion
+    (beginning-of-line)
+    (point)))
+
+(defun annotate-before-change-fn (a b)
+ "This function is added to 'before-change-functions' hook and
+it is called any time the buffer content is changed (so, for
+example, text is added or deleted). In particular, it will
+rearrange the overlays bounds when an annotated text is
+modified (for example a newline is inserted)."
+  (annotate-with-inhibit-modification-hooks
+   (save-excursion
+     (let* ((bol (annotate-beginning-of-line-pos))
+            (eol (annotate-end-of-line-pos))
+            (ov  (cl-remove-if-not 'annotationp
+                                   (overlays-in bol eol))))
+       (dolist (overlay ov)
+         (annotate--remove-annotation-property (overlay-start overlay)
+                                               (overlay-end   overlay))
+         ;; move the overlay if we are breaking it
+         (when  (<= (overlay-start overlay)
+                    a
+                    (overlay-end overlay))
+           (move-overlay overlay (overlay-start overlay) a)))))))
+
 (defun annotate-initialize ()
   "Load annotations and set up save and display hooks."
   (annotate-load-annotations)
   (add-hook 'after-save-hook 'annotate-save-annotations t t)
   (add-hook 'window-configuration-change-hook 'font-lock-fontify-buffer  t t)
+  (add-hook 'before-change-functions          'annotate-before-change-fn t t)
   (font-lock-add-keywords
    nil
    '((annotate--font-lock-matcher (2 (annotate--annotation-builder))
@@ -188,6 +234,7 @@ major mode is a member of this list (space separated 
entries)."
   (annotate-clear-annotations)
   (remove-hook 'after-save-hook                  'annotate-save-annotations t)
   (remove-hook 'window-configuration-change-hook 'font-lock-fontify-buffer  t)
+  (remove-hook 'before-change-functions          'annotate-before-change-fn t)
   (font-lock-remove-keywords
    nil
    '((annotate--font-lock-matcher (2 (annotate--annotation-builder))
@@ -207,13 +254,16 @@ major mode is a member of this list (space separated 
entries)."
   "Create, modify, or delete annotation."
   (interactive)
   (let ((overlay (car (overlays-at (point)))))
-    (cond ((and (overlayp overlay) (overlay-get overlay 'annotation))
-           (annotate-change-annotation (point)))
-          (t
-           (cl-destructuring-bind (start end) (annotate-bounds)
-             (annotate-create-annotation start end)))))
-  (font-lock-fontify-block 1)
-  (set-buffer-modified-p t))
+    (cond
+     ((and (overlayp overlay)
+           (overlay-get overlay 'annotation))
+      (annotate-change-annotation (point))
+      (font-lock-fontify-buffer nil))
+     (t
+      (cl-destructuring-bind (start end) (annotate-bounds)
+        (annotate-create-annotation start end)
+        (font-lock-fontify-block 1))))
+    (set-buffer-modified-p t)))
 
 (defun annotate-next-annotation ()
   "Move point to the next annotation."
@@ -663,38 +713,65 @@ to 'maximum-width'."
   "Searches the line before point for annotations, and returns a
 `facespec` with the annotation in its `display` property."
   (save-excursion
-    (goto-char (1- (point))) ; we start at the start of the next line
-    ;; find overlays in the preceding line
-    (let ((prefix (annotate-make-prefix)) ; white space before first annotation
-          (bol (progn (beginning-of-line) (point)))
-          (eol (progn (end-of-line) (point)))
-          (text "")
-          (overlays nil))
-      ;; include previous line if point is at bol:
-      (when (eq nil (overlays-in bol eol))
-        (setq bol (1- bol)))
-      (setq overlays (sort (overlays-in bol eol)
-                           (lambda (x y)
-                             (< (overlay-end x) (overlay-end y)))))
-      ;; put each annotation on its own line
-      (dolist (ov overlays)
-        (if (overlay-get ov 'annotation)
+    (let ((newline-position (point)))
+      (goto-char (1- (point))) ; we start at the start of the previous line
+      ;; find overlays in the preceding line
+      (let ((prefix             (annotate-make-prefix)) ; white spaces before 
first annotation
+            (bol                (progn (beginning-of-line) (point)))
+            (eol                (progn (end-of-line) (point)))
+            (text               "")
+            (overlays           nil)
+            (annotation-counter 1))
+        ;; include previous line if point is at bol:
+        (when (eq nil (overlays-in bol eol))
+          (setq bol (1- bol)))
+        (setq overlays
+              (sort (cl-remove-if (lambda (a) (or (not (annotationp a))
+                                                  ;; if  an  annotated
+                                                  ;; text  contains  a
+                                                  ;; newline   (is   a
+                                                  ;; multiline one) do
+                                                  ;; not           add
+                                                  ;; annotation for it
+                                                  ;; here (i.e. remove
+                                                  ;; from  that list),
+                                                  ;; this   annotation
+                                                  ;; will be  shown on
+                                                  ;; the  next newline
+                                                  ;; instead
+                                                  (<= (overlay-start a)
+                                                      newline-position
+                                                      (overlay-end a))))
+                                      (overlays-in bol eol))
+                    (lambda (x y)
+                      (< (overlay-end x) (overlay-end y)))))
+        ;; put each annotation on its own line
+        (dolist (ov overlays)
+          (cl-incf annotation-counter)
+          (let ((face           (if (= (cl-rem annotation-counter 2) 0)
+                                    'annotate-annotation
+                                  'annotate-annotation-secondary))
+                (face-highlight (if (= (cl-rem annotation-counter 2) 0)
+                                    'annotate-highlight
+                                  'annotate-highlight-secondary)))
+            (overlay-put ov 'face face-highlight)
             (dolist (l (save-match-data
                          (split-string (annotate-lineate (overlay-get ov 
'annotation)
                                                          (- eol bol))
                                        "\n")))
               (setq text
-                    (concat text prefix
-                            (propertize l 'face 'annotate-annotation)
+                    (concat text
+                            prefix
+                            (propertize l 'face face)
                             "\n"))
               ;; white space before for all but the first annotation line
               (setq prefix (make-string annotate-annotation-column ? )))))
-      ;; build facespec with the annotation text as display property
-      (if (string= text "")
-          ;; annotation has been removed: remove display prop
-          (list 'face 'default 'display nil)
-        ;; annotation has been changed/added: change/add display prop
-        (list 'face 'default 'display text)))))
+        ;; build facespec with the annotation text as display property
+        (if (string= text "")
+            ;; annotation has been removed: remove display prop
+            (list 'face 'default 'display nil)
+          ;; annotation has been changed/added: change/add display prop
+          (list 'face 'default 'display text))))))
 
 (defun annotate--remove-annotation-property (begin end)
   "Cleans up annotation properties associated with a region."
@@ -880,7 +957,8 @@ essentially what you get from:
       (let ((highlight (make-overlay start end)))
         (overlay-put highlight 'face 'annotate-highlight)
         (overlay-put highlight 'annotation annotation))
-      (if (use-region-p) (deactivate-mark))))
+      (when (use-region-p)
+        (deactivate-mark))))
   (save-excursion
     (goto-char end)
     (font-lock-fontify-block 1)))
@@ -914,19 +992,29 @@ essentially what you get from:
                        (progn (end-of-line) (point))))
            (prefix-length (- annotate-annotation-column (string-width 
line-text))))
       (if (< prefix-length 1)
-          (concat "\n" (make-string annotate-annotation-column ? ))
+          (concat " \n" (make-string annotate-annotation-column ? ))
         (make-string prefix-length ? )))))
 
 (defun annotate-bounds ()
   "The bounds of the region or whatever is at point."
   (list (cond
-         ((use-region-p) (region-beginning))
-         ((thing-at-point 'symbol) (car (bounds-of-thing-at-point 'symbol)))
-         (t (point)))
+         ((use-region-p)
+          (region-beginning))
+         ((thing-at-point 'symbol)
+          (car (bounds-of-thing-at-point 'symbol)))
+         (t
+          (point)))
         (cond
-         ((use-region-p) (region-end))
-         ((thing-at-point 'symbol) (cdr (bounds-of-thing-at-point 'symbol)))
-         (t (1+ (point))))))
+         ((use-region-p)
+          (if (and (char-before (region-end))
+                   (char-equal (char-before (region-end))
+                               ?\n))
+              (1- (region-end))
+            (region-end)))
+         ((thing-at-point 'symbol)
+          (cdr (bounds-of-thing-at-point 'symbol)))
+         (t
+          (1+ (point))))))
 
 (defun annotate-describe-annotations ()
   "Return a list of all annotations in the current buffer."