[nongnu] elpa/annotate 818f66f4a3 203/372: Merge pull request #58 from cage2/master

[ELPA Syncer]

branch: elpa/annotate
commit 818f66f4a3d6a33ae90c4e5de12f8dce770e7875
Merge: c21b95273e bcffdb9f24
Author: cage2 <1257703+cage2@users.noreply.github.com>
Commit: GitHub <noreply@github.com>

    Merge pull request #58 from cage2/master
    
    Prevented fails of fontification of annotated regions
---
 Changelog   |  20 +++++--
 NEWS.org    |   8 +++
 README.org  |   3 +
 annotate.el | 182 +++++++++++++++++++++++++++++++++++++++++++++---------------
 4 files changed, 164 insertions(+), 49 deletions(-)

diff --git a/Changelog b/Changelog
index 9d9f09e3fd..c616997871 100644
--- a/Changelog
+++ b/Changelog
@@ -2,8 +2,18 @@
 
         * annotate.el (annotate--font-lock-matcher):
         - fixed error for regexp search
-         Sometimes some modes/package puts overlay on the last character of a
-         buffer (notably SLIME when the parenthesis of a form are not
-          balanced). This will make 're-search-forward' in the aforementioned
-          function fails and font lock becomes a mess (e.g. text color
-          disappears).
+       Sometimes some modes/package puts overlay on the last character of a
+       buffer (notably SLIME when the parenthesis of a form are not
+        balanced). This will make 're-search-forward' in the aforementioned
+        function fails and font lock becomes a mess (e.g. text color
+        disappears).
+
+2020-02-10 Bastian Bechtold, cage
+       * annotate.el (annotate--font-lock-matcher annotate-bounds 
nnotate-symbol-strictly-at-point annotate-next-annotation-change 
annotate-previous-annotation-change annotate-clear-annotations 
annotate-annotate)
+       - prevented fails of fontification of annotated regions
+       As we walk across the overlays we can get past the limit;
+       - mark buffer as modified even if the only action the user performed
+       was clearing annotation (and at least an annotation was present in
+       the file)
+       - prevented annotation of text marked with a region that overlap with
+       an existing annotation.
diff --git a/NEWS.org b/NEWS.org
index 14f9889c14..15ff059ff9 100644
--- a/NEWS.org
+++ b/NEWS.org
@@ -85,3 +85,11 @@
 - 2020-01-22 V0.5.1 Bastian Bechtold, cage ::
   - fixed bug that prevented correct fontifications for major modes
     that puts overlays on the buffer's text (e.g. SLIME).
+
+- 2020-02-10 V0.5.2 Bastian Bechtold, cage ::
+
+  - fixed bugs that makes some annotations overlaps;
+  - fixed some bugs in fontifications of multiline annotation;
+  - when the only user interactions, before saving, with a visited file was
+    the call of 'annotate-clear-annotations' the annotations
+    will shows again at reload, this should be fixed now.
diff --git a/README.org b/README.org
index 4439f50aa1..1345d344d8 100644
--- a/README.org
+++ b/README.org
@@ -114,6 +114,9 @@ as comments into the current buffer, like this:
    incompatibility with the way source blocks are highlighted and the
    way annotations are displayed.
 
+   Annotating a region that contains newline(s) can results in various
+   issues.
+
    Deleting the first  character of an annotated text  will remove the
    annotation (this turned out to be useful, though).
 
diff --git a/annotate.el b/annotate.el
index 884424ed06..c982185bf9 100644
--- a/annotate.el
+++ b/annotate.el
@@ -7,7 +7,7 @@
 ;; Maintainer: Bastian Bechtold
 ;; URL: https://github.com/bastibe/annotate.el
 ;; Created: 2015-06-10
-;; Version: 0.5.1
+;; Version: 0.5.2
 
 ;; This file is NOT part of GNU Emacs.
 
@@ -52,7 +52,7 @@
 ;;;###autoload
 (defgroup annotate nil
   "Annotate files without changing them."
-  :version "0.5.1"
+  :version "0.5.2"
   :group 'text)
 
 ;;;###autoload
@@ -346,19 +346,26 @@ modified (for example a newline is inserted)."
 (defun annotate-annotate ()
   "Create, modify, or delete annotation."
   (interactive)
-  (let ((overlay (car (overlays-at (point)))))
-    (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)
-        (let ((annotation-text (read-from-minibuffer 
annotate-annotation-prompt)))
-          (annotate-create-annotation start end annotation-text nil)
-          (font-lock-fontify-block 1)))))
-    (set-buffer-modified-p t)))
+  (cl-labels ((create-new-annotation ()
+               (cl-destructuring-bind (start end)
+                   (annotate-bounds)
+                 (let ((annotation-text (read-from-minibuffer 
annotate-annotation-prompt)))
+                   (annotate-create-annotation start end annotation-text 
nil)))))
+    (let ((overlay (car (overlays-at (point)))))
+      (cond
+       ((use-region-p)
+        (let ((annotations (cl-remove-if-not #'annotationp
+                                             (overlays-in (region-beginning)
+                                                          (region-end)))))
+          (if annotations
+              (message "Error: the region overlaps with at least an already 
existings annotation")
+            (create-new-annotation))))
+       ((annotationp overlay)
+        (annotate-change-annotation (point))
+        (font-lock-fontify-buffer nil))
+       (t
+        (create-new-annotation)))
+      (set-buffer-modified-p t))))
 
 (defun annotate-next-annotation ()
   "Move point to the next annotation."
@@ -639,10 +646,14 @@ annotation plus the newline."
       nil ; no match found before limit
     (progn
       ;; go to the end of the longest annotation under point
-      (let ((overlays (sort (cl-remove-if-not 'annotationp
-                                              (overlays-at (point)))
+      (let ((overlays (sort (cl-remove-if (lambda (a)
+                                            (not (and (annotationp a)
+                                                      (< (overlay-end a)
+                                                         limit))))
+                                          (overlays-at (point)))
                             (lambda (x y)
-                              (> (overlay-end x) (overlay-end y))))))
+                              (> (overlay-end x)
+                                 (overlay-end y))))))
         (when overlays
           (goto-char (overlay-end (car overlays)))))
       ;; capture the area from the overlay to EOL (regexp match #1)
@@ -1264,19 +1275,18 @@ annotation."
 (defun annotate-clear-annotations ()
   "Clear all current annotations."
   (interactive)
-  (let ((overlays
-         (overlays-in 0 (buffer-size)))
-        (modified-p (buffer-modified-p)))
+  (let ((overlays   (overlays-in 0 (buffer-size)))
+        (modifiedp (buffer-modified-p)))
     ;; only remove annotations, not all overlays
     (setq overlays (cl-remove-if
                     (lambda (ov) (not (annotationp ov)))
                     overlays))
     (dolist (ov overlays)
-      (annotate--remove-annotation-property
-       (overlay-start ov)
-       (overlay-end ov))
-      (delete-overlay ov))
-    (set-buffer-modified-p modified-p)))
+      (annotate--remove-annotation-property (overlay-start ov)
+                                            (overlay-end ov))
+      (delete-overlay ov)
+      (setf modifiedp t)
+    (set-buffer-modified-p modifiedp))))
 
 (defun annotate-string-empty-p (a)
   "Is the arg an empty string or null?"
@@ -1400,28 +1410,108 @@ The searched interval can be customized setting the 
variable:
           (concat " \n" (make-string annotate-annotation-column ? ))
         (make-string prefix-length ? )))))
 
+(defun annotate-annotation-at (pos)
+  "Returns the annotations (overlay where (annotationp overlay) -> t)
+at positions pos or nil if no annotations exists at pos.
+
+NOTE this assumes that annotations never overlaps so the list of
+all annotations can contains only one element maximum."
+  (let ((all (cl-remove-if-not #'annotationp
+                               (overlays-at pos))))
+    (cl-first all)))
+
+(defun annotate-previous-annotation-ends (pos)
+  "Returns the previous annotation that ends before pos or nil if no annotation
+was found.
+NOTE this assumes that annotations never overlaps"
+  (cl-labels ((previous-annotation-ends (start)
+                (let ((annotation (annotate-annotation-at start)))
+                  (while (and (>= (1- start)
+                                  (point-min))
+                              (null annotation))
+                    (setf start (1- start))
+                    (setf annotation (annotate-annotation-at (1- start))))
+                  annotation)))
+    (let ((annotation (annotate-annotation-at pos)))
+      (if annotation
+          (previous-annotation-ends (1- (overlay-start annotation)))
+        (previous-annotation-ends pos)))))
+
+(defun annotate-next-annotation-starts (pos)
+  "Returns the previous annotation that ends before pos or nil if no annotation
+was found.
+NOTE this assumes that annotations never overlaps"
+  (cl-labels ((next-annotation-ends (start)
+                (let ((annotation (annotate-annotation-at start)))
+                  (while (and (<= (1+ start)
+                                  (point-max))
+                              (null annotation))
+                    (setf start (1+ start))
+                    (setf annotation (annotate-annotation-at (1+ start))))
+                  annotation)))
+    (let ((annotation (annotate-annotation-at pos)))
+      (if annotation
+          (next-annotation-ends (overlay-end annotation))
+        (next-annotation-ends pos)))))
+
+(defun annotate-symbol-strictly-at-point ()
+ "Return non nil if a symbol is at char immediately following
+ the point. This is needed as `thing-at-point' family of
+ functions returns non nil if the thing (a symbol in this case)
+ is around the point, according to the documentation."
+  (cl-labels ((after-point ()
+               (save-excursion
+                 (goto-char (1+ (point)))
+                 (bounds-of-thing-at-point 'symbol))))
+    (let ((sym-on-point     (bounds-of-thing-at-point 'symbol))
+          (sym-after-point  (after-point)))
+      (and  sym-on-point
+            sym-after-point
+            (cl-equalp sym-on-point
+                       sym-after-point)))))
+
 (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)))
-        (cond
-         ((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))))))
+  (cl-labels ((left-ends ()
+               (cond
+                ((use-region-p)
+                 (region-beginning))
+                ((annotate-symbol-strictly-at-point)
+                 (let* ((annotation-before (annotate-previous-annotation-ends 
(point)))
+                        (boundaries        (bounds-of-thing-at-point 'symbol))
+                        (symbol-start      (car boundaries))
+                        (annotation-end    (if annotation-before
+                                               (overlay-end annotation-before)
+                                             -1)))
+                   (max symbol-start
+                        annotation-end)))
+                (t
+                 (point))))
+              (right-ends ()
+               (cond
+                ((use-region-p)
+                 (if (and (char-before (region-end))
+                          (char-equal (char-before (region-end))
+                                      ?\n))
+                     (1- (region-end))
+                   (region-end)))
+                ((annotate-symbol-strictly-at-point)
+                 (let* ((annotation-after (annotate-next-annotation-starts 
(point)))
+                        (boundaries       (bounds-of-thing-at-point 'symbol))
+                        (symbol-end       (cdr boundaries))
+                        (annotation-start (if annotation-after
+                                              (overlay-start annotation-after)
+                                            (1+ symbol-end))))
+                       (min symbol-end
+                            annotation-start)))
+                (t
+                 (1+ (point))))))
+    (list (left-ends)
+          (right-ends))))
 
 (defun annotate-make-annotation (beginning ending annotation annotated-text)
+ "Build a annotation data structure that can be dumped on a
+metadata file database"
   (list beginning ending annotation annotated-text))
 
 (defun annotate-describe-annotations ()
@@ -1504,6 +1594,8 @@ sophisticated way than plain text"
           (goto-char (button-get button 'go-to))))))))
 
 (defun annotate-summary-delete-annotation-button-pressed (button)
+ "Function to be called when a 'delete' button in summary window
+is activated"
   (let* ((filename        (button-get button 'file))
          (beginning       (button-get button 'beginning))
          (ending          (button-get button 'ending))
@@ -1523,6 +1615,8 @@ sophisticated way than plain text"
       (read-only-mode 1))))
 
 (defun annotate-summary-replace-annotation-button-pressed (button)
+  "Function to be called when a 'replace' button in summary window
+is activated"
   (let* ((filename             (button-get button 'file))
          (annotation-beginning (button-get button 'beginning))
          (annotation-ending    (button-get button 'ending))