[nongnu] elpa/annotate 9320918b91 270/372: Merge pull request #84 from cage2/fix-regression-multiline-annotations

[ELPA Syncer]

branch: elpa/annotate
commit 9320918b91c5ab3ee63f812a0479423233f95821
Merge: be998ca006 0b71184865
Author: cage2 <1257703+cage2@users.noreply.github.com>
Commit: GitHub <noreply@github.com>

    Merge pull request #84 from cage2/fix-regression-multiline-annotations
    
    Fixed a regression  and some bugs related to  incorrect calculation of 
multiline annotations.
    
    Also closes #68
---
 Changelog   | 120 ++++++++++++++++++++++++++++++++++
 NEWS.org    |  17 +++++
 annotate.el | 209 ++++++++++++++++++++++++++++++++++++++++++++++--------------
 3 files changed, 297 insertions(+), 49 deletions(-)

diff --git a/Changelog b/Changelog
index 25e8def880..899b64b189 100644
--- a/Changelog
+++ b/Changelog
@@ -1,3 +1,123 @@
+2020-11-22  cage
+
+        * annotate.el:
+
+       - added more docstrings.
+
+2020-11-12  cage
+
+        * annotate.el:
+
+       - prevented getting shared value for 'annotate-file' in
+        '%load-annotation-data'.
+
+       This  way  we can  ensure  that  'annotate-file' can  be  declared
+       buffer-local and  different annotation  databases can be  used from
+       different buffers.
+
+2020-11-11  cage
+
+        * annotate.el:
+       - fitted 'annotate-position-inside-chain-p' into   
'annotate--position-inside-annotated-text-p';
+       - fixed some typos.
+
+2020-11-06  cage
+
+        * annotate.el:
+
+       - Fixed a regression  and some bugs related to
+        incorrect calculation of of multiline annotations.
+
+       To reproduce the bugs:
+
+       legend:
+
+       a = annotated text
+       * = non annotated text
+
+       - First bug
+
+       Create a multiline annotation using region.
+
+       aaaa
+       aaaa
+       aaaa    ####
+
+       Place the cursor as below.
+
+       aaaa
+       ^ cursor
+       aaaa
+       aaaa    ####
+
+       type a character
+
+       a****
+       aaaa
+       aaaa    ####
+
+       The annotated text has a "gap"
+
+       Fix proposed: revert to the old (correct behaviour)
+
+       Second bug
+
+       aaaa
+       aaaa
+       aaaa    ####
+
+       Place the cursor as below.
+
+       aaaa
+       ^ cursor on the first column
+       aaaa
+       aaaa    ####
+
+       type some text
+
+       ***
+       aaa
+       aaa    ####
+
+       Save (C-x C-s)
+
+       you  get an  error  on  the echo  area:  "let*:  Wrong type  argument:
+       overlayp, nil" and the annotations are not correctly saved.
+
+       Fix proposed: remove the offending code.
+
+       Third bug
+
+       a multiline bug as before
+
+       aaaa
+       aaaa
+       aaaa    ####
+
+       place the cursor here:
+
+       aaaa
+       aaaa
+       ^ cursor
+       aaaa    ####
+
+       type some text
+
+       aaaa
+       *****
+       aaaa    ####
+
+       Then annotate the same line (C-c C-a):
+
+       aaaa
+       aaaa    ####
+       aaaa    ####
+
+       we  introduced  a  annotation  in  the gap  of  the  already  existing
+       multiline annotation.
+
+       Fix proposed: prevents annotating text inside an annotation.
+
 2020-09-29
         * README.org, annotate.el
        - updated README;
diff --git a/NEWS.org b/NEWS.org
index 98f8a20ca2..f6d985e8c7 100644
--- a/NEWS.org
+++ b/NEWS.org
@@ -130,3 +130,20 @@
 - 2020-09-29 V0.9.0 Bastian Bechtold, cage ::
   Added two new styles to render the annotation: using "pop-up" style
   or via a specializated summary window.
+
+- 2020-11-20 V0.9.2 Bastian Bechtold, cage ::
+
+  This version fix a regression and  some more bug that could breaks a
+  multiline  annotation  in  ways  that makes  the  annotation  system
+  inconsistent  and  renders the  annotated  text  in wrong  way  (for
+  details see the Changelog).
+
+  The 'annotate-file' can be now  safely declared buffer-local so that
+  multiple databases of annotations can be used on a per-buffer basis.
+
+  For pratical applications see:
+
+  https://github.com/bastibe/annotate.el/issues/68
+
+  Many thanks to gopar for spotting  this elusive bug and help testing
+  the patch! :)
diff --git a/annotate.el b/annotate.el
index 17ac590901..54b2db9972 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.9.0
+;; Version: 0.9.2
 
 ;; This file is NOT part of GNU Emacs.
 
@@ -58,7 +58,7 @@
 ;;;###autoload
 (defgroup annotate nil
   "Annotate files without changing them."
-  :version "0.9.0"
+  :version "0.9.2"
   :group 'text)
 
 ;;;###autoload
@@ -178,7 +178,7 @@ database is not filtered at all."
   :group 'annotate)
 
 (defcustom annotate-use-echo-area nil
- "Whether annotation text should apperar in the echo area only when mouse
+ "Whether annotation text should appear in the echo area only when mouse
 id positioned over the annotated text instead of positioning them in
 the the buffer (the default)."
   :type 'boolean
@@ -309,7 +309,7 @@ annotation as defined in the database."
          (setf inhibit-modification-hooks ,old-mode)))))
 
 (cl-defmacro annotate-with-restore-modified-bit (&rest body)
-  "Save the value of `buffer-modified-p' before `body' is exectuted
+  "Save the value of `buffer-modified-p' before `body' is executed
   and restore the saved value just after the end of `body'."
   (let ((modifiedp (gensym)))
     `(let ((,modifiedp (buffer-modified-p)))
@@ -336,11 +336,55 @@ position (so that it is unchanged after this function is 
called)."
      (overlay-end   annotation)))
 
 (defun annotate-annotation-force-newline-policy (annotation)
+  "Force annotate to place `annotation' on the line after the annotated text.
+
+See: `annotate-annotation-position-policy'
+"
   (overlay-put annotation 'force-newline-policy t))
 
 (defun annotate-annotation-newline-policy-forced-p (annotation)
+  "Is `annotation' forced  to place annotation on the  line after the
+annotated text?
+
+See: `annotate-annotation-position-policy'"
   (overlay-get annotation 'force-newline-policy))
 
+(defun annotate--remap-chain-pos (annotations)
+  "Remap an annotation 'chain'
+
+An annotation is a collection of one or more overlays that
+contains the property `annotate-prop-chain-position'.
+
+The value of `annotate-prop-chain-position' in each chain is an
+integer starting from:
+
+`annotate-prop-chain-pos-marker-first' and *always* ending with
+
+`annotate-prop-chain-pos-marker-last'
+
+This means that a value of said property for a chain that
+contains only an element is equal to
+`annotate-prop-chain-pos-marker-last'.
+
+This function ensure this constrains for the chain `annotation'
+belong."
+  (cond
+   ((< (length annotations)
+       1)
+    annotations)
+   ((= (length annotations)
+       1)
+    (annotate-annotation-set-chain-last (cl-first annotations)))
+   (t
+    (let ((all-but-last (butlast annotations))
+          (last-element (car (last annotations))))
+      (cl-loop for annotation in all-but-last
+               for i from annotate-prop-chain-pos-marker-first
+               do
+               (annotate-annotation-chain-position annotation i))
+      (when last-element
+        (annotate-annotation-set-chain-last last-element))))))
+
 (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
@@ -356,24 +400,17 @@ modified (for example a newline is inserted)."
        (dolist (overlay ov)
          (annotate--remove-annotation-property (overlay-start overlay)
                                                (overlay-end   overlay))
-         ;; move the overlay if we are breaking it
+         ;; check if we are breaking the overlay
          (when (<= (overlay-start overlay)
                    a
                    (overlay-end overlay))
-           (move-overlay overlay (overlay-start overlay) a)
-           ;; delete overlay if there is no more annotated text
-           (when (annotate-annotated-text-empty-p overlay)
-             ;; we  are  deleting  the  last element  of  a  chain  (a
-             ;; stopper)...
-             (when (annotate-chain-last-p overlay)
-               ;; move 'stopper' to the previous chain element
-               (let ((annot-before (annotate-previous-annotation-ends 
(overlay-start overlay))))
-                 ;; ...if such element exists
-                 (when annot-before
-                   (annotate-annotation-chain-position annot-before
-                                                       
annotate-prop-chain-pos-marker-last))))
-             (delete-overlay overlay)
-             (font-lock-fontify-buffer))))))))
+           (let ((start-overlay (overlay-start overlay)))
+             ;; delete overlay if there is no more annotated text
+             (when (<= a start-overlay)
+               (let ((chain (cl-remove overlay (annotate-find-chain overlay))))
+                 (delete-overlay overlay)
+                 (annotate--remap-chain-pos chain)
+                 (font-lock-fontify-buffer))))))))))
 
 (defun annotate-info-select-fn ()
   "The function to be called when an info buffer is updated"
@@ -423,6 +460,60 @@ modified (for example a newline is inserted)."
   "Is 'overlay' an annotation?"
   (annotate-overlay-filled-p overlay))
 
+(defun annotate--position-on-annotated-text-p (pos)
+  "Does `pos' (as buffer position) corresponds to a character
+that belong to some annotated text?"
+  (let ((annotation (annotate-annotation-at pos)))
+    (if annotation
+        t
+      ;; there is a chance that a point do not belong text rendered as
+      ;; annotated but belong to a chain anyway
+      ;; example:
+      ;;
+      ;; legend:
+      ;; a = annotated text
+      ;; * = non annotated text
+      ;; # = annotation
+      ;;
+      ;; Create a multiline annotation using region.
+      ;;
+      ;; aaaa
+      ;; aaaa
+      ;; aaaa
+      ;;
+      ;;
+      ;; aaaa
+      ;; aaaa
+      ;; aaaa    ####
+      ;;
+      ;; place the cursor here:
+      ;;
+      ;; aaaa
+      ;; aaaa
+      ;; ^ cursor
+      ;; aaaa    ####
+      ;;
+      ;; type some text
+      ;;
+      ;; aaaa
+      ;; *****
+      ;; aaaa    ####
+      ;;
+      ;; the text (the asterisks) is not rendered as annotated but as
+      ;; annotations can not have gaps so we enforce this limitation
+      ;; and consider it still parts of a chain formed by the
+      ;; surrounding annotated text.
+      (let* ((previous-annotation (annotate-previous-annotation-ends pos))
+             (next-annotation     (annotate-next-annotation-starts   pos))
+             (previous-chain      (annotate-chain-first previous-annotation))
+             (next-chain          (annotate-chain-first next-annotation)))
+        (if (and previous-chain
+                 next-chain
+                 (eq previous-chain
+                     next-chain))
+            t
+          nil)))))
+
 (defun annotate-annotate ()
   "Create, modify, or delete annotation."
   (interactive)
@@ -437,17 +528,26 @@ modified (for example a newline is inserted)."
     (let ((annotation (annotate-annotation-at (point))))
       (cond
        ((use-region-p)
-        (let ((annotations (cl-remove-if-not #'annotationp
-                                             (overlays-in (region-beginning)
-                                                          (region-end)))))
-          (if annotations
-              (signal 'annotate-annotate-region-overlaps annotations)
-            (create-new-annotation))))
+        (let* ((region-beg  (region-beginning))
+               (region-stop (region-end))
+               (annotations (cl-remove-if-not #'annotationp
+                                             (overlays-in region-beg
+                                                          region-stop))))
+          (cond
+           (annotations
+            (signal 'annotate-annotate-region-overlaps annotations))
+           ((or (annotate--position-on-annotated-text-p region-beg)
+                (annotate--position-on-annotated-text-p region-stop))
+            (signal 'annotate-annotate-region-overlaps nil))
+           (t
+            (create-new-annotation)))))
        (annotation
         (annotate-change-annotation (point))
         (font-lock-fontify-buffer nil))
        (t
-        (create-new-annotation)))
+        (if (annotate--position-on-annotated-text-p (point))
+            (signal 'annotate-annotate-region-overlaps nil)
+          (create-new-annotation))))
       (set-buffer-modified-p t))))
 
 (cl-defun annotate-goto-next-annotation (&key (startingp t))
@@ -1266,16 +1366,19 @@ annotation."
 (defun annotate-load-annotation-data (&optional ignore-errors)
   "Read and return saved annotations."
   (cl-flet ((%load-annotation-data ()
-              (with-temp-buffer
-                (if (file-exists-p annotate-file)
-                    (insert-file-contents annotate-file)
-                  (signal 'annotate-db-file-not-found (list annotate-file)))
-                (goto-char (point-max))
-                (cond ((= (point) 1)
-                       nil)
-                      (t
-                       (goto-char (point-min))
-                       (read (current-buffer)))))))
+              (let ((annotations-file annotate-file))
+                (with-temp-buffer
+                  (let* ((annotate-file annotations-file)
+                         (attributes    (file-attributes annotate-file)))
+                    (cond
+                     ((not (file-exists-p annotate-file))
+                      (signal 'annotate-db-file-not-found (list 
annotate-file)))
+                     ((= (file-attribute-size attributes)
+                         0)
+                      nil)
+                     (t
+                      (insert-file-contents annotate-file)
+                      (read (current-buffer)))))))))
     (if ignore-errors
         (ignore-errors (%load-annotation-data))
       (%load-annotation-data))))
@@ -1366,7 +1469,7 @@ annotation."
 In this context annotation means annotation loaded from local
 database not the annotation shown in the buffer (therefore these
 arguments are 'record' as called in the other database-related
-funcions).
+functions).
 "
   (< (annotate-beginning-of-annotation a)
      (annotate-beginning-of-annotation b)))
@@ -1472,6 +1575,16 @@ of a chain of annotations"
     (annotate-ensure-annotation (annotation)
       (annotate-chain-last annotation))))
 
+(defun annotate-annotation-set-chain-first (annotation)
+  "Set property's value that  define position of this annotation
+in a chain of annotations as first"
+  (annotate-annotation-chain-position annotation 
annotate-prop-chain-pos-marker-first))
+
+(defun annotate-annotation-set-chain-last (annotation)
+  "Set property's value that  define position of this annotation
+in a chain of annotations as last"
+  (annotate-annotation-chain-position annotation 
annotate-prop-chain-pos-marker-last))
+
 (defun annotate-find-chain (annotation)
   "Find all annotation that are parts of the chain where `annotation' belongs"
   (annotate-ensure-annotation (annotation)
@@ -1524,16 +1637,7 @@ interval and, if found, the buffer is annotated right 
there.
 The searched interval can be customized setting the variable:
 'annotate-search-region-lines-delta'.
 "
-  (cl-labels ((remap-chain-pos (annotations)
-               (if (<= (length annotations)
-                       1)
-                   annotations
-                 (let* ((all-but-last (butlast annotations)))
-                     (cl-loop for annotation in all-but-last
-                              for i from annotate-prop-chain-pos-marker-first
-                              do
-                              (annotate-annotation-chain-position annotation 
i)))))
-              (create-annotation (start end annotation-text)
+  (cl-labels ((create-annotation (start end annotation-text)
                (save-excursion
                  (let ((chain-pos 0)
                        (all-overlays ()))
@@ -1557,8 +1661,8 @@ The searched interval can be customized setting the 
variable:
                                                                    
annotate-prop-chain-pos-marker-last)
                                (push highlight all-overlays))))))
                      (setf start (point)))
-                   (remap-chain-pos (reverse (mapcar 
#'maybe-force-newline-policy
-                                                     all-overlays))))))
+                   (annotate--remap-chain-pos (reverse (mapcar 
#'maybe-force-newline-policy
+                                                               
all-overlays))))))
               (beginning-of-nth-line (start line-count)
                  (save-excursion
                    (goto-char start)
@@ -1816,6 +1920,9 @@ NOTE this assumes that annotations never overlaps"
           (right-ends))))
 
 (defun annotate-make-annotation (beginning ending annotation annotated-text)
+ "Make an annotation record that represent an annotation
+starting at `beginning', terminate at `ending' with annotation
+content `annotation' and annotated text `annotated-text'."
   (list beginning ending annotation annotated-text))
 
 (defun annotate-all-annotations ()
@@ -1908,6 +2015,8 @@ sophisticated way than plain text"
           (goto-char (button-get button 'go-to))))))))
 
 (defun annotate-summary-delete-annotation-button-pressed (button)
+ "Callback for summary window fired when a 'delete' button is
+pressed."
   (let* ((filename        (button-get button 'file))
          (beginning       (button-get button 'beginning))
          (ending          (button-get button 'ending))
@@ -1938,6 +2047,8 @@ sophisticated way than plain text"
       (update-visited-buffer-maybe))))
 
 (defun annotate-summary-replace-annotation-button-pressed (button)
+   "Callback for summary window fired when a 'replace' button is
+pressed."
   (let* ((filename             (button-get button 'file))
          (annotation-beginning (button-get button 'beginning))
          (annotation-ending    (button-get button 'ending))