[nongnu] elpa/annotate 6cc6ac8872 210/372: Merge pull request #61 from cage2/org-mode-fix

[ELPA Syncer]

branch: elpa/annotate
commit 6cc6ac887220cd26b8e72f1ec95555517faf0e80
Merge: 818f66f4a3 a81a7d9386
Author: cage2 <1257703+cage2@users.noreply.github.com>
Commit: GitHub <noreply@github.com>

    Merge pull request #61 from cage2/org-mode-fix
    
    Org mode partial fix
---
 Changelog   |  34 ++++++++++-
 NEWS.org    |   7 +++
 README.org  |  12 ++++
 annotate.el | 193 ++++++++++++++++++++++++++++++++++++++----------------------
 4 files changed, 176 insertions(+), 70 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 1345d344d8..26a6a5b485 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 c982185bf9..c755760703 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.
 
@@ -52,7 +52,7 @@
 ;;;###autoload
 (defgroup annotate nil
   "Annotate files without changing them."
-  :version "0.5.2"
+  :version "0.5.3"
   :group 'text)
 
 ;;;###autoload
@@ -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
@@ -128,7 +134,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)
@@ -150,7 +156,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
@@ -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
@@ -767,24 +779,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
@@ -843,7 +856,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'."
             (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
@@ -1317,36 +1331,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))))
@@ -1365,18 +1408,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."
@@ -1603,16 +1647,27 @@ is activated"
          (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)
   "Function to be called when a 'replace' button in summary window