[nongnu] elpa/annotate 54d112e8d3 174/372: [bugfix] mitigated bug that prevented rendering of annotation when

[ELPA Syncer]

branch: elpa/annotate
commit 54d112e8d37bd4f62ee34db96265c16f2006e0e1
Author: cage <cage-invalid@invalid>
Commit: cage <cage-invalid@invalid>

      [bugfix] mitigated  bug that prevented rendering  of annotation when
      ORG major mode is used.
---
 annotate.el | 117 +++++++++++++++++++++++++++++++++++++++++-------------------
 1 file changed, 80 insertions(+), 37 deletions(-)

diff --git a/annotate.el b/annotate.el
index 535110bcd6..dd0e7efb60 100644
--- a/annotate.el
+++ b/annotate.el
@@ -89,15 +89,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
@@ -279,6 +285,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
@@ -833,7 +845,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
@@ -856,7 +869,7 @@ to 'maximum-width'."
             (dolist (l multiline-annotation)
               (setq annotation-text
                     (concat annotation-text
-                            prefix-first
+                            (propertize prefix-first 'face 'annotate-prefix)
                             (propertize l 'face face)
                             annotation-stopper))
               ;; white space before for all but the first annotation line
@@ -1308,36 +1321,65 @@ 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 ((create-annotation     (start end annotation-text)
-                                     (let ((highlight (make-overlay start 
end)))
-                                       (overlay-put highlight 'face 
'annotate-highlight)
-                                       (overlay-put highlight 'annotation 
annotation-text)))
-              (beginning-of-nth-line (start line-count)
-                                     (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)))
-              (go-forward            (start)
-                                     (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)))
+  (let ((new-annotation nil))
+    (cl-labels ((create-annotation     (start end annotation-text)
+                                       (let ((highlight (make-overlay start 
end)))
+                                         (overlay-put highlight 'face 
'annotate-highlight)
+                                         (overlay-put highlight 'annotation 
annotation-text)
+                                         (setf new-annotation highlight)))
+                (beginning-of-nth-line (start line-count)
+                                       (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)))
+                (go-forward            (start)
+                                       (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))
+                (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))))
@@ -1356,18 +1398,19 @@ 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
         (goto-char end)
-        (font-lock-fontify-block 1))))
+        (font-lock-fontify-block 1))
+      (maybe-force-newline-policy new-annotation))))
 
 (defun annotate-change-annotation (pos)
   "Change annotation at point. If empty, delete annotation."