branch: elpa/annotate
commit 9320918b91c5ab3ee63f812a0479423233f95821
Merge: be998ca006 0b71184865
Author: cage2 <1257703+ca...@users.noreply.github.com>
Commit: GitHub <nore...@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))
