branch: elpa/annotate
commit de116813bee285e73c92351dbe2a88ef9b757b84
Merge: 9a9227f154 6cc6ac8872
Author: cage <cage-invalid@invalid>
Commit: cage <cage-invalid@invalid>
Merge branch 'master' into rethink-multiline-annotations
---
Changelog | 34 ++++++++++-
NEWS.org | 7 +++
README.org | 12 ++++
annotate.el | 186 +++++++++++++++++++++++++++++++++++++++---------------------
4 files changed, 172 insertions(+), 67 deletions(-)
diff --git a/Changelog b/Changelog
index c616997871..9c195efaf6 100644
--- a/Changelog
+++ b/Changelog
@@ -1,3 +1,21 @@
+2020-01-25 Bastian Bechtold, cage
+
+ * annotate.el (defun annotate-annotation-force-newline-policy,
+ annotate-annotation-newline-policy-forced-p,
+ annotate-create-annotation,
+ annotate-lineate,
+ annotate-summary-delete-annotation-button-pressed):
+ - mitigated bug that prevented rendering of annotation in
+ org-mode forcing 'newline' policy for annotation
+ positioning.
+ See the local function
+ 'maybe-force-newline-policy' in 'annotate-create-annotation'.
+ - choosen the window that contains the current buffer when resizing
the annotations
+ see variable 'current-window' in 'annotate-lineate';
+ - redraw buffer if one of its annotations is deleted
+ operating from the summary window.
+ see: 'annotate-summary-delete-annotation-button-pressed'.
+
2020-01-22 Bastian Bechtold, cage
* annotate.el (annotate--font-lock-matcher):
@@ -9,7 +27,7 @@
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)
+ * annotate.el (annotate--font-lock-matcher annotate-bounds
annotate-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
@@ -17,3 +35,17 @@
the file)
- prevented annotation of text marked with a region that overlap with
an existing annotation.
+
+2020-03-06 Bastian Bechtold, cage ::
+ * annotate.el (annotate-annotation-force-newline-policy
annotate-annotation-newline-policy-forced-p
annotate-summary-delete-annotation-button-pressed annotate--annotation-builder)
+
+ - used an heuristic to force newline policy when the annotated
+ text does not uses a standard fonts (using font height as
+ comparison);
+
+ - when, in summary window, the delete button is pressed the
+ software take care of reload annotate mode for the visited buffer
+ the annotation button is referring to;
+
+ - when re-flowing annotation the window width was calculated always
+ for the current buffer (the one with the focus).
diff --git a/NEWS.org b/NEWS.org
index 15ff059ff9..8023a9f418 100644
--- a/NEWS.org
+++ b/NEWS.org
@@ -93,3 +93,10 @@
- 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.
+
+- 2020-03-06 V0.5.3 Bastian Bechtold, cage ::
+ - Partially fixed bug that prevented annotation of buffer when org-mode was
used;
+ - when an user delete an annotation for a file using a button from
+ summary window force refresh of a buffer that is visiting said
+ file, if exists, to reflect the changes;
+ - fixed flowings of annotatinons when window's width is changed.
diff --git a/README.org b/README.org
index 64d6a997aa..5a8d333f85 100644
--- a/README.org
+++ b/README.org
@@ -180,6 +180,18 @@ annotation, like this:
As a shortcut, an empty query will match everything (just press
~return~ at prompt).
+* FAQ
+ Sometimes the package does not respect the customizable variable's value of
+ ~annotate-annotation-position-policy~, is this a bug?
+
+ No it is not, when a line which is using a non default font is
+ annotated the software force the ~:new-line~ policy, that is the
+ annotation will be displayed on a new line regardless of the value
+ of the variable mentioned in the question.
+
+ This is necessary to prevent the annotation to be pushed beyond the
+ window limits if an huge font is used by the annotated text.
+
* LICENSE
This package is released under the MIT license, see file [[./LICENSE][LICENSE]]
diff --git a/annotate.el b/annotate.el
index 1b3a7b3350..a7b5c3518f 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.2
+;; Version: 0.5.3
;; This file is NOT part of GNU Emacs.
@@ -55,7 +55,7 @@
;;;###autoload
(defgroup annotate nil
"Annotate files without changing them."
- :version "0.5.2"
+ :version "0.5.3"
:group 'text)
;;;###autoload
@@ -92,15 +92,21 @@ See https://github.com/bastibe/annotate.el/ for
documentation."
:group 'annotate)
(defface annotate-annotation
- '((t (:background "coral" :foreground "black")))
+ '((t (:background "coral" :foreground "black" :inherit default)))
"Face for annotations."
:group 'annotate)
(defface annotate-annotation-secondary
- '((t (:background "khaki" :foreground "black")))
+ '((t (:background "khaki" :foreground "black" :inherit default)))
"Face for secondary annotations."
:group 'annotate)
+(defface annotate-prefix
+ '((t (:inherit default)))
+ "Face for character used to pad annotation (fill space between
+text lines and annotation text)."
+ :group 'annotate)
+
(defcustom annotate-annotation-column 85
"Where annotations appear."
:type 'number
@@ -131,7 +137,7 @@ See https://github.com/bastibe/annotate.el/ for
documentation."
:type 'string
:group 'annotate)
-(defcustom annotate-blacklist-major-mode '(org-mode)
+(defcustom annotate-blacklist-major-mode '()
"Prevent loading of annotate-mode When the visited file's
major mode is a member of this list (space separated entries)."
:type '(repeat symbol)
@@ -153,7 +159,7 @@ database is not filtered at all."
(defcustom annotate-annotation-position-policy :by-length
"policy for annotation's position:
- - :newline
+ - :new-line
always in a new-line
- :margin
always on right margin
@@ -291,6 +297,12 @@ position (so that it is unchanged after this function is
called)."
(= (overlay-start annotation)
(overlay-end annotation)))
+(defun annotate-annotation-force-newline-policy (annotation)
+ (overlay-put annotation 'force-newline-policy t))
+
+(defun annotate-annotation-newline-policy-forced-p (annotation)
+ (overlay-get annotation 'force-newline-policy))
+
(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
@@ -762,24 +774,25 @@ to 'maximum-width'."
(if (= (length seq) 1)
nil
(annotate-safe-subseq seq from to nil))))
- (let* ((theoretical-line-width (- (window-body-width)
- annotate-annotation-column))
- (available-width (if (> theoretical-line-width 0)
- theoretical-line-width
- line-width))
- (lineated-list (annotate-group-by-width text
available-width))
- (max-width (apply #'max
- (mapcar #'string-width
lineated-list)))
- (all-but-last-lineated-list (%subseq lineated-list 0 (1- (length
lineated-list))))
- (last-line (if all-but-last-lineated-list
- (car (last lineated-list))
- (cl-first lineated-list)))
- (lineated (cl-mapcar (lambda (a)
- (pad a max-width t))
- all-but-last-lineated-list)))
- (apply #'concat
- (append lineated
- (list (pad last-line max-width nil)))))))
+ (let* ((current-window (get-buffer-window (current-buffer)))
+ (theoretical-line-width (- (window-body-width current-window)
+ annotate-annotation-column))
+ (available-width (if (> theoretical-line-width 0)
+ theoretical-line-width
+ line-width))
+ (lineated-list (annotate-group-by-width text
available-width))
+ (max-width (apply #'max
+ (mapcar #'string-width
lineated-list)))
+ (all-but-last-lineated-list (%subseq lineated-list 0 (1- (length
lineated-list))))
+ (last-line (if all-but-last-lineated-list
+ (car (last lineated-list))
+ (cl-first lineated-list)))
+ (lineated (cl-mapcar (lambda (a)
+ (pad a max-width t))
+ all-but-last-lineated-list)))
+ (apply #'concat
+ (append lineated
+ (list (pad last-line max-width nil)))))))
(defun annotate--annotation-builder ()
"Searches the line before point for annotations, and returns a
@@ -829,7 +842,8 @@ to 'maximum-width'."
(:new-line
t)
(:by-length
- annotation-long-p)
+ (or
(annotate-annotation-newline-policy-forced-p ov)
+ annotation-long-p))
(otherwise
nil)))
(multiline-annotation (if position-new-line-p
@@ -866,7 +880,7 @@ to 'maximum-width'."
(if position-new-line-p
(setq prefix-first (concat prefix-first prefix-rest))
(setq prefix-first prefix-rest))))))
- ;; build facespec with the annotation text as display property
+ ;; build facespec with the annotation text as display property
(if (string= annotation-text "")
;; annotation has been removed: remove display prop
(list 'face 'default 'display nil)
@@ -1438,11 +1452,10 @@ The searched interval can be customized setting the
variable:
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)))))
+ (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)
(save-excursion
(let ((chain-pos 0)
@@ -1465,33 +1478,63 @@ 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 all-overlays)))))
+ (remap-chain-pos (reverse (mapcar
#'maybe-force-newline-policy
+ all-overlays))))))
(beginning-of-nth-line (start line-count)
- (save-excursion
- (goto-char start)
- (forward-line line-count)
- (beginning-of-line)
- (point)))
+ (save-excursion
+ (goto-char start)
+ (forward-line line-count)
+ (beginning-of-line)
+ (point)))
(go-backward (start)
- (beginning-of-nth-line
- start
- (- annotate-search-region-lines-delta)))
+ (beginning-of-nth-line
+ start
+ (- annotate-search-region-lines-delta)))
(go-forward (start)
- (beginning-of-nth-line start
-
annotate-search-region-lines-delta))
+ (beginning-of-nth-line start
+ annotate-search-region-lines-delta))
(guess-match-and-add (start end annotated-text max)
- (cl-block surrounding
- (while (< start max)
- (let ((to-match (ignore-errors
-
(buffer-substring-no-properties start
-
end))))
- (if (and to-match
- (string= to-match
annotated-text))
- (cl-return-from surrounding
start))
- (progn
- (setf start (1+ start)
- end (1+ end)))))
- nil)))
+ (cl-block surrounding
+ (while (< start max)
+ (let ((to-match (ignore-errors
+ (buffer-substring-no-properties start
end))))
+ (if (and to-match
+ (string= to-match annotated-text))
+ (cl-return-from surrounding start))
+ (progn
+ (setf start (1+ start)
+ end (1+ end)))))
+ nil))
+ (maybe-force-newline-policy (annotation)
+ ;; force newline policy if height of any the face of
the
+ ;; overlay is different from height of default face
+ (save-excursion
+ (goto-char (overlay-start annotation))
+ (let* ((bol
(annotate-beginning-of-line-pos))
+ (eol (annotate-end-of-line-pos))
+ (changed-face-pos (min bol (overlay-start
annotation)))
+ (limit (max eol (overlay-end
annotation)))
+ (all-faces (list (get-text-property
changed-face-pos 'face)))
+ (default-face-height (face-attribute 'default
:height))
+ (all-faces-height ())
+ (force-newline-p nil))
+ (while (< changed-face-pos limit)
+ (setf changed-face-pos
+ (next-single-property-change changed-face-pos
+ 'face
+ (current-buffer)
+ limit))
+ (push (get-text-property changed-face-pos 'face)
+ all-faces))
+ (setf all-faces-height
+ (mapcar (lambda (face)
+ (face-attribute face :height nil
'default))
+ (cl-remove-if #'null all-faces)))
+ (setf force-newline-p
+ (cl-find-if (lambda (a) (/= a
default-face-height))
+ all-faces-height))
+ (when force-newline-p
+ (annotate-annotation-force-newline-policy
annotation))))))
(if (not (annotate-string-empty-p annotated-text))
(let ((text-to-match (ignore-errors
(buffer-substring-no-properties start end))))
@@ -1510,13 +1553,13 @@ The searched interval can be customized setting the
variable:
(create-annotation new-match
(+ new-match length-match)
annotation-text)))
- (lwarn '(annotate-mode)
+ (lwarn '(annotate-mode) ; if matches annotated text failed
:warning
annotate-warn-file-searching-annotation-failed-control-string
(annotate-actual-file-name)
annotation-text
text-to-match)))
- (create-annotation start end annotation-text))
+ (create-annotation start end annotation-text)) ; create new annotation
(when (use-region-p)
(deactivate-mark))
(save-excursion
@@ -1761,16 +1804,27 @@ sophisticated way than plain text"
(end-of-button (button-get button 'end-of-button))
(db (annotate-load-annotation-data))
(filtered (annotate-db-remove-annotation db filename beginning
ending)))
- (annotate-dump-annotation-data filtered)
- (with-current-buffer annotate-summary-buffer-name
- (read-only-mode -1)
- (save-excursion
- (button-put button 'invisible t)
- (let ((annotation-button (previous-button (point))))
- (button-put annotation-button 'face '(:strike-through t)))
- (let ((replace-button (next-button (point))))
- (button-put replace-button 'invisible t)))
- (read-only-mode 1))))
+ (annotate-dump-annotation-data filtered) ; save the new database with
entry removed
+ (cl-labels ((redraw-summary-window () ; update the summary window
+ (with-current-buffer annotate-summary-buffer-name
+ (read-only-mode -1)
+ (save-excursion
+ (button-put button 'invisible t)
+ (let ((annotation-button (previous-button (point))))
+ (button-put annotation-button 'face '(:strike-through
t)))
+ (let ((replace-button (next-button (point))))
+ (button-put replace-button 'invisible t)))
+ (read-only-mode 1)))
+ ;; if the file where the deleted annotation belong to is
visited,
+ ;; update the buffer
+ (update-visited-buffer-maybe ()
+ (let ((visited-buffer (find-buffer-visiting filename)))
+ (when visited-buffer ;; a buffer is visiting the file
+ (with-current-buffer visited-buffer
+ (annotate-mode -1)
+ (annotate-mode 1))))))
+ (redraw-summary-window)
+ (update-visited-buffer-maybe))))
(defun annotate-summary-replace-annotation-button-pressed (button)
(let* ((filename (button-get button 'file))
