[nongnu] elpa/annotate 44ac24f63d 274/372: Merge pull request #87 from cage2/overwrite-annotations

[ELPA Syncer]

branch: elpa/annotate
commit 44ac24f63dab3a5e052248d384082414b7af5f1d
Merge: 9320918b91 a4607c4184
Author: cage2 <1257703+cage2@users.noreply.github.com>
Commit: GitHub <noreply@github.com>

    Merge pull request #87 from cage2/overwrite-annotations
    
    two more features and a bugfix.
---
 Changelog   |  35 ++++++++
 NEWS.org    |  14 ++-
 README.org  |  15 ++++
 annotate.el | 281 +++++++++++++++++++++++++++++++++++++++++++++++++++---------
 4 files changed, 305 insertions(+), 40 deletions(-)

diff --git a/Changelog b/Changelog
index 899b64b189..9fde915a99 100644
--- a/Changelog
+++ b/Changelog
@@ -1,3 +1,38 @@
+2020-12-16 cage
+
+       * Changelog, NEWS.org, annotate.el:
+
+       Updated version and documentations.
+
+2020-12-07  cage
+
+        * README.org, annotate.el:
+
+       - fixed more typos.
+
+2020-12-01  cage
+
+        * README.org, annotate.el:
+
+       - allow overwriting (even partial)  of annotations.  That is, user
+       can place an annotation on top of an already existing one. The new
+       will  delete  overlapped  portion  of the  old  annotation.   This
+       feature    should   not    allow   to    break   an    annotation,
+       though. Annotations can not overlaps.
+
+       - added a new customizable variable:
+
+        'annotate-warn-if-hash-mismatch'  when  nil  prevent  printing  of
+       warning  when annotation  database's'  hash and  file  has do  not
+       match;
+
+       - fixed bug  in alternating coloring of  annotation and underlined
+       text;
+
+       - updated README;
+
+       - fixed some typos.
+
 2020-11-22  cage
 
         * annotate.el:
diff --git a/NEWS.org b/NEWS.org
index f6d985e8c7..caaede1872 100644
--- a/NEWS.org
+++ b/NEWS.org
@@ -141,9 +141,21 @@
   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:
+  For practical applications see:
 
   https://github.com/bastibe/annotate.el/issues/68
 
   Many thanks to gopar for spotting  this elusive bug and help testing
   the patch! :)
+
+- 2020-12-16 V1.0.0 Bastian Bechtold, cage ::
+
+  This version  allow overwrite of notes.  That is, user can  place an
+  annotation on  top of an already  existing one. The new  will delete
+  overlapped portion of the old annotation.
+
+  Also a new  customizable variable ('annotate-warn-if-hash-mismatch')
+  has  been  added.   When  nil   prevent  printing  of  warning  when
+  annotation database's' hash and file has do not match;
+
+  Also a problem with adjacent annotation's coloring has been fixed.
diff --git a/README.org b/README.org
index 615ede331d..44df957a2f 100644
--- a/README.org
+++ b/README.org
@@ -37,10 +37,22 @@ the  command ~annotate-switch-db~.   This  command will  
take care  to
 refresh/redraw   all   annotations   in    the   buffers   that   uses
 ~annotate-mode~.
 
+The database holds the hash of each  annotated file so it can print a
+warning if the file has been modified outside Emacs (for example).
+
+Warning     can     be     suppressed     setting     the     variable
+~annotate-warn-if-hash-mismatch~ to nil.
+
 Please note that switching database,  in this context, means rebinding
 the  aforementioned variable  (~annotate-file~).  This  means than  no
 more than a single database can be active for each Emacs session.
 
+To use multiple database in the same Emacs session ~annotate-file~ should be 
made
+[[https://www.gnu.org/software/emacs/manual/html_node/elisp/Buffer_002dLocal-Variables.html][buffer-local]],
+see:
+[[https://github.com/bastibe/annotate.el/issues/68][this thread]] and, in 
particular
+[[https://github.com/bastibe/annotate.el/issues/68#issuecomment-728218022][this
 message]].
+
 Users of
 [[https://github.com/emacscollective/no-littering][no-littering]]
 can take advantage of its packages generated files management.
@@ -48,6 +60,9 @@ can take advantage of its packages generated files management.
 **** related customizable variable
      - ~annotate-file~
 
+**** related customizable variable
+     - ~annotate-warn-if-hash-mismatch~
+
 ** keybindings
 
 *** ~C-c  C-a~ (function annotate-annotate)
diff --git a/annotate.el b/annotate.el
index 54b2db9972..8ff5875515 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.2
+;; Version: 1.0.0
 
 ;; This file is NOT part of GNU Emacs.
 
@@ -58,7 +58,7 @@
 ;;;###autoload
 (defgroup annotate nil
   "Annotate files without changing them."
-  :version "0.9.2"
+  :version "1.0.0"
   :group 'text)
 
 ;;;###autoload
@@ -184,6 +184,18 @@ the the buffer (the default)."
   :type 'boolean
   :group 'annotate)
 
+(defcustom annotate-warn-if-hash-mismatch t
+ "Whether a warning message should be printed if a mismatch
+occurs, for an annotated file, between the hash stored in the
+database annotations and the hash calculated from the actual
+file.
+
+This usually happens if an annotated file (a file with an entry in the
+database) is saved with annotated-mode *not* active or the file
+has been modified outside Emacs."
+  :type 'boolean
+  :group 'annotate)
+
 (defconst annotate-prop-chain-position
   'position)
 
@@ -514,6 +526,19 @@ that belong to some annotated text?"
             t
           nil)))))
 
+(defun annotate-delete-chains-in-region (from to)
+  "Deletes all the chains enclosed in the range specified by
+positions `from' and `to'."
+  (let* ((enclosed-chains (annotate-annotations-chain-in-range from to)))
+    (dolist (chain enclosed-chains)
+      (annotate--delete-annotation-chain (cl-first chain)))))
+
+(defun annotate-count-newline-in-region (from to)
+ "Counts the number of newlines character (?\n) in range
+specified by `from' and `to'."
+  (cl-count-if (lambda (a) (char-equal a ?\n))
+               (buffer-substring-no-properties from to)))
+
 (defun annotate-annotate ()
   "Create, modify, or delete annotation."
   (interactive)
@@ -524,21 +549,72 @@ that belong to some annotated text?"
                    (condition-case error-message
                        (annotate-create-annotation start end annotation-text 
nil)
                      (annotate-empty-annotation-text-error
-                      (user-error "Annotation text is empty.")))))))
+                      (user-error "Annotation text is empty."))))))
+              (cut-right (region-beg region-stop &optional delete-enclosed)
+                (let* ((last-of-chain-to-cut  (annotate-chain-last-at 
region-beg))
+                       (first-of-chain-to-cut (annotate-chain-first-at 
region-beg))
+                       (chain-start           (overlay-start 
first-of-chain-to-cut))
+                       (chain-end             (overlay-end   
last-of-chain-to-cut))
+                       (newlines-count        
(annotate-count-newline-in-region region-beg
+                                                                               
 chain-end))
+                       (cut-count             (- chain-end
+                                                 region-beg
+                                                 newlines-count)))
+                  (cl-loop repeat cut-count do
+                    (when (annotate-annotation-at chain-start)
+                      (annotate--cut-right-annotation first-of-chain-to-cut 
t)))
+                  (when delete-enclosed
+                    (annotate-delete-chains-in-region chain-end region-stop))))
+              (cut-left (region-beg region-stop &optional delete-enclosed)
+                (let* ((last-of-chain-to-cut  (annotate-chain-last-at 
region-stop))
+                       (first-of-chain-to-cut (annotate-chain-first-at 
region-stop))
+                       (chain-start           (overlay-start 
first-of-chain-to-cut))
+                       (chain-end             (overlay-end   
last-of-chain-to-cut))
+                       (newlines-count        
(annotate-count-newline-in-region chain-start
+                                                                               
 region-stop))
+                       (cut-count             (- region-stop
+                                                 chain-start
+                                                 newlines-count)))
+                  (cl-loop repeat cut-count do
+                    (when (annotate-annotation-at (1- chain-end))
+                      (annotate--cut-left-annotation last-of-chain-to-cut)))
+                  (when delete-enclosed
+                    (annotate-delete-chains-in-region chain-end 
region-stop)))))
     (let ((annotation (annotate-annotation-at (point))))
       (cond
        ((use-region-p)
-        (let* ((region-beg  (region-beginning))
-               (region-stop (region-end))
-               (annotations (cl-remove-if-not #'annotationp
-                                             (overlays-in region-beg
-                                                          region-stop))))
+        (let* ((region-beg      (region-beginning))
+               (region-stop     (region-end))
+               (enclosed-chains (annotate-annotations-chain-in-range 
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))
+           ((and (annotate--position-on-annotated-text-p region-beg)
+                 (annotate--position-on-annotated-text-p region-stop))
+            ;; aaaaaaaaaaaaaaaaaa
+            ;;   ^-----------^
+            (let ((starting-chain-at-start (annotate-chain-first-at 
region-beg))
+                  (starting-chain-at-end   (annotate-chain-first-at 
region-stop)))
+              (if (eq starting-chain-at-start
+                      starting-chain-at-end)
+                  (signal 'annotate-annotate-region-overlaps nil)
+                (let ((start-pos-last-annotation (overlay-start 
starting-chain-at-end)))
+                  (cut-left start-pos-last-annotation region-stop nil)
+                  (cut-right region-beg region-stop t)
+                  (create-new-annotation)))))
+           ((annotate--position-on-annotated-text-p region-beg)
+            ;; aaaabbcc**********
+            ;;   ^------------^
+            (cut-right region-beg region-stop t)
+            (create-new-annotation))
+           ((annotate--position-on-annotated-text-p region-stop)
+            ;; **********cccaaaa
+            ;;   ^------------^
+            (cut-left region-beg region-stop t)
+            (create-new-annotation))
+           (enclosed-chains
+            ;; ****aaaaaaaaaaaaaaa****
+            ;;  ^------------------^
+            (annotate-delete-chains-in-region region-beg region-stop)
+            (create-new-annotation))
            (t
             (create-new-annotation)))))
        (annotation
@@ -904,7 +980,7 @@ to 'maximum-width'."
         grouped))))
 
 (cl-defun annotate-safe-subseq (seq from to &optional (value-if-limits-invalid 
seq))
-  "This return 'value-if-limits-invalid' sequence if 'from' or 'to' are 
invalids"
+  "Returns 'value-if-limits-invalid' sequence if 'from' or 'to' are invalids"
   (cond
    ((< to from)
     value-if-limits-invalid)
@@ -984,15 +1060,22 @@ to 'maximum-width'."
         ;; variable: `annotate-annotation-position-policy'.
         (dolist (ov overlays)
           (let* ((face                (cond
+                                       ((annotate-previous-annotation ov)
+                                        (let* ((previous 
(annotate-previous-annotation ov))
+                                               (prev-face (overlay-get previous
+                                                                       
'annotation-face)))
+                                          (if (eq prev-face
+                                                  'annotate-annotation)
+                                              'annotate-annotation-secondary
+                                            'annotate-annotation)))
                                        ((not (annotate-chain-first-p ov))
                                         (let ((first-in-chain 
(annotate-chain-first ov)))
                                           (overlay-get first-in-chain
                                                        'annotation-face)))
-                                       ((= (cl-rem annotation-counter 2) 0)
-                                        'annotate-annotation)
                                        (t
-                                        'annotate-annotation-secondary)))
-                 (face-highlight      (if (= (cl-rem annotation-counter 2) 0)
+                                        'annotate-annotation)))
+                 (face-highlight      (if (eq face
+                                              'annotate-annotation)
                                           'annotate-highlight
                                         'annotate-highlight-secondary))
                  (annotation-long-p   (> (string-width (overlay-get ov 
'annotation))
@@ -1020,12 +1103,12 @@ to 'maximum-width'."
                                          "\n")))
             (cl-incf annotation-counter)
             (overlay-put ov 'face face-highlight)
-            (if (annotate-chain-first-p ov)
-                (overlay-put ov 'annotation-face face)
-                (let ((first-in-chain (annotate-chain-first ov)))
-                  (overlay-put ov
-                               'face
-                               (overlay-get first-in-chain 'face))))
+            (overlay-put ov 'annotation-face face)
+            (when (not (annotate-chain-first-p ov))
+              (let ((first-in-chain (annotate-chain-first ov)))
+                (overlay-put ov
+                             'face
+                             (overlay-get first-in-chain 'face))))
             (when (and (not annotate-use-echo-area)
                        (annotate-chain-last-p ov))
                 (when position-new-line-p
@@ -1069,6 +1152,33 @@ to 'maximum-width'."
        (setf buffer-undo-list saved-undo-list)
        (buffer-enable-undo)))))
 
+(defun annotate-annotations-overlay-in-range (from-position to-position)
+  "Returns the annotations overlays that are enclosed in the range
+defined by `from-position' and `to-position'."
+  (let ((annotations ()))
+    (cl-loop for  i
+             from (max 0 (1- from-position))
+             to   to-position
+             do
+      (let ((annotation (annotate-next-annotation-starts i)))
+        (annotate-ensure-annotation (annotation)
+          (let ((chain-end   (overlay-end   (annotate-chain-last  annotation)))
+                (chain-start (overlay-start (annotate-chain-first 
annotation))))
+            (when (and (>= chain-start from-position)
+                       (<= chain-end   to-position))
+              (cl-pushnew annotation annotations))))))
+    (reverse annotations)))
+
+(defun annotate-annotations-chain-in-range (from-position to-position)
+  "Returns the annotations (chains) that are enclosed in the range
+defined by `from-position' and `to-position'."
+  (let ((annotations (annotate-annotations-overlay-in-range from-position 
to-position))
+        (chains      ()))
+    (cl-loop for annotation in annotations do
+      (let ((chain (annotate-find-chain annotation)))
+        (cl-pushnew chain chains :test (lambda (a b) (eq (cl-first a) 
(cl-first b))))))
+    (reverse chains)))
+
 (defun annotate--change-guard ()
   "Returns a `facespec` with an `insert-behind-hooks` property
 that strips dangling `display` properties of text insertions if
@@ -1080,7 +1190,7 @@ an overlay and it's annotation."
         '(annotate--remove-annotation-property)))
 
 (defun annotate-context-before (pos)
- "Context lines before POS. Return nil if we reach a line before
+ "Context lines before POS. Returns nil if we reach a line before
 first line of the buffer"
   (save-excursion
     (goto-char pos)
@@ -1314,7 +1424,8 @@ example:
            (modified-p           (buffer-modified-p)))
       (if (old-format-p annotation-dump)
           (annotate-load-annotation-old-format)
-        (when (and (not (old-format-p annotation-dump))
+        (when (and annotate-warn-if-hash-mismatch
+                   (not (old-format-p annotation-dump))
                    old-checksum
                    new-checksum
                    (not (string= old-checksum new-checksum)))
@@ -1364,7 +1475,7 @@ annotation."
     (annotate-dump-annotation-data db)))
 
 (defun annotate-load-annotation-data (&optional ignore-errors)
-  "Read and return saved annotations."
+  "Read and returns saved annotations."
   (cl-flet ((%load-annotation-data ()
               (let ((annotations-file annotate-file))
                 (with-temp-buffer
@@ -1575,6 +1686,12 @@ of a chain of annotations"
     (annotate-ensure-annotation (annotation)
       (annotate-chain-last annotation))))
 
+(defun annotate-chain-at (pos)
+  "Find the chain of overlays where point `pos' belongs."
+  (let ((annotation (annotate-annotation-at pos)))
+    (annotate-ensure-annotation (annotation)
+      (annotate-find-chain 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"
@@ -1779,20 +1896,96 @@ See the variable: `annotate-use-echo-area'."
   (when annotate-use-echo-area
     (annotate-overlay-put-echo-help overlay annotation-text)))
 
+(defun annotate--delete-annotation-chain (annotation)
+  "Delete `annotation' from a buffer and the chain it belongs to.
+
+This function is not part of the public API."
+  (annotate-ensure-annotation (annotation)
+    (save-excursion
+      (let ((chain (annotate-find-chain annotation)))
+        (dolist (single-element chain)
+          (goto-char (overlay-end single-element))
+          (move-end-of-line nil)
+          (annotate--remove-annotation-property (overlay-start single-element)
+                                                (overlay-end   single-element))
+          (delete-overlay single-element))))))
+
+(defun annotate--delete-annotation-chain-ring (annotation-ring)
+  "Delete overlay of `annotation-ring' from a buffer.
+
+This function is not part of the public API."
+  (annotate-ensure-annotation (annotation-ring)
+    (save-excursion
+      (goto-char (overlay-end annotation-ring))
+      (move-end-of-line nil)
+      (annotate--remove-annotation-property (overlay-start annotation-ring)
+                                            (overlay-end   annotation-ring))
+      (delete-overlay annotation-ring))))
+
+(defun annotate-delete-chain-element (annotation)
+  "Delete a ring from a chain where `annotation' belong"
+  (annotate-ensure-annotation (annotation)
+    (let* ((chain                   (annotate-find-chain    annotation))
+           (first-of-chain-p        (annotate-chain-first-p annotation))
+           (last-of-chain-p         (annotate-chain-last-p  annotation))
+           (only-element-in-chain-p (= (length chain) 1)))
+      (annotate--delete-annotation-chain-ring annotation)
+      (when (not only-element-in-chain-p)
+        (cond
+         (first-of-chain-p
+          (let ((second-annotation (cl-second chain)))
+            (when (not (annotate-chain-last-p second-annotation))
+              (annotate-annotation-set-chain-first second-annotation))))
+         (last-of-chain-p
+          (let ((annotation-before (elt chain (- (length chain) 2))))
+            (annotate-annotation-set-chain-last annotation-before))))))))
+
+(defun annotate--cut-left-annotation (annotation)
+  "Trims `annotation' exactly one character from the start."
+  (annotate-ensure-annotation (annotation)
+    (let* ((chain                       (annotate-find-chain annotation))
+           (first-annotation            (annotate-chain-first annotation))
+           (chain-start-pos             (overlay-start first-annotation))
+           (first-annotation-ending-pos (overlay-end   first-annotation))
+           (new-starting-pos            (1+ chain-start-pos)))
+      (cond
+       ((>= new-starting-pos
+            first-annotation-ending-pos) ; delete chain element or entire 
annotation
+        (if (= (length chain)
+               1)                        ; the chain is formed by just one 
element, delete entirely
+            (annotate--delete-annotation-chain first-annotation)
+          (annotate-delete-chain-element first-annotation))) ; delete just the 
first element of the chain
+       (t
+        (move-overlay first-annotation new-starting-pos 
first-annotation-ending-pos))))))
+
+(defun annotate--cut-right-annotation (annotation &optional refontify-buffer)
+  "Trims `annotation' exactly one character from the end."
+  (annotate-ensure-annotation (annotation)
+    (let* ((chain                        (annotate-find-chain annotation))
+           (last-annotation              (annotate-chain-last annotation))
+           (last-annotation-ending-pos   (overlay-end last-annotation))
+           (last-annotation-starting-pos (overlay-start last-annotation))
+           (new-ending-pos               (1- last-annotation-ending-pos)))
+      (cond
+       ((<= new-ending-pos
+            last-annotation-starting-pos) ; delete chain element or entire 
annotation
+        (if (= (length chain) 1)          ; the chain is formed by just one 
element, delete entirely
+            (annotate--delete-annotation-chain last-annotation)
+          (progn ; delete just the last element of the chain
+            (annotate-delete-chain-element last-annotation)
+            (when refontify-buffer
+              (font-lock-fontify-buffer)))))
+       (t
+        (move-overlay last-annotation last-annotation-starting-pos 
new-ending-pos))))))
+
 (defun annotate-change-annotation (pos)
   "Change annotation at point. If empty, delete annotation."
   (let* ((highlight       (annotate-annotation-at pos))
          (annotation-text (read-from-minibuffer annotate-annotation-prompt
                                                 (overlay-get highlight 
'annotation))))
     (cl-labels ((delete (annotation)
-                 (let ((chain      (annotate-find-chain annotation)))
-                   (annotate-with-restore-modified-bit
-                    (dolist (single-element chain)
-                      (goto-char (overlay-end single-element))
-                      (move-end-of-line nil)
-                      (annotate--remove-annotation-property (overlay-start 
single-element)
-                                                            (overlay-end   
single-element))
-                      (delete-overlay single-element)))))
+                  (annotate-with-restore-modified-bit
+                    (annotate--delete-annotation-chain annotation)))
                 (change (annotation)
                   (let ((chain (annotate-find-chain annotation)))
                     (dolist (single-element chain)
@@ -1847,6 +2040,11 @@ NOTE this assumes that annotations never overlaps"
           (previous-annotation-ends (1- (overlay-start annotation)))
         (previous-annotation-ends pos)))))
 
+(defun annotate-previous-annotation (annotation)
+ "Returns the annotation before `annotations' or nil if no such
+annotation exists."
+ (annotate-previous-annotation-ends (overlay-start (annotate-chain-first 
annotation))))
+
 (defun annotate-next-annotation-starts (pos)
   "Returns the previous annotation that ends before pos or nil if no annotation
 was found.
@@ -1864,8 +2062,13 @@ NOTE this assumes that annotations never overlaps"
           (next-annotation-ends (overlay-end annotation))
         (next-annotation-ends pos)))))
 
+(defun annotate-next-annotation (annotation)
+ "Returns the annotation after `annotations' or nil if no such
+annotation exists."
+ (annotate-next-annotation-starts (overlay-end (annotate-chain-last 
annotation))))
+
 (defun annotate-symbol-strictly-at-point ()
- "Return non nil if a symbol is at char immediately following
+ "Returns 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."
@@ -1926,11 +2129,11 @@ content `annotation' and annotated text 
`annotated-text'."
   (list beginning ending annotation annotated-text))
 
 (defun annotate-all-annotations ()
-  "Return a list of all annotations in the current buffer."
+  "Returns a list of all annotations in the current buffer."
   (cl-remove-if-not #'annotationp (overlays-in 0 (buffer-size))))
 
 (defun annotate-describe-annotations ()
-  "Return a list, suitable for database dump, of all annotations in the 
current buffer."
+  "Returns a list, suitable for database dump, of all annotations in the 
current buffer."
   (let ((all-annotations (cl-remove-if-not #'annotationp (overlays-in 0 
(buffer-size))))
         (chain-visited   ()))
     (cl-remove-if #'null
@@ -2539,7 +2742,7 @@ OR         := 'or'
 NOT        := 'not'
 DELIMITER  := \" ; ASCII 34 (dec) 22 (hex)
 
-Note: this function return the annotation part of the record, see
+Note: this function returns the annotation part of the record, see
 `annotate-load-annotations'.
 
 "