[elpa] externals/adaptive-wrap 01e7d1f 14/15: adaptive-wrap: Fontify wrap-prefix

[Stefan Monnier]

branch: externals/adaptive-wrap
commit 01e7d1fe2153aca295fd7859eccbaa491fe34ffd
Author: Kévin Le Gouguec <kevin.legouguec@gmail.com>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    adaptive-wrap: Fontify wrap-prefix
    
    * packages/adaptive-wrap/adaptive-wrap.el
    (adaptive-wrap--face-extends): Compatibility shim for Emacs < 27.
    (adaptive-wrap--prefix-face): New function to determine what face to
    apply to the wrap-prefix.
    (adaptive-wrap--prefix): New function to compute the full wrap-prefix,
    extracted verbatim from adaptive-wrap-fill-context-prefix.
    (adaptive-wrap-fill-context-prefix): Call the new functions.
    
    * packages/adaptive-wrap/adaptive-wrap.el (adaptive-wrap--prefix): Use
    spaces; ignore the string returned by fill-context-prefix.
---
 adaptive-wrap.el | 58 +++++++++++++++++++++++++++++++++++++++-----------------
 1 file changed, 41 insertions(+), 17 deletions(-)

diff --git a/adaptive-wrap.el b/adaptive-wrap.el
index f8d89ac..b075b3b 100644
--- a/adaptive-wrap.el
+++ b/adaptive-wrap.el
@@ -59,6 +59,41 @@ extra indent = 2
   :group 'visual-line)
 (make-variable-buffer-local 'adaptive-wrap-extra-indent)
 
+(defun adaptive-wrap--face-extends (face)
+  (if (fboundp 'face-extend-p)
+      (face-extend-p face nil t)
+    ;; Before Emacs 27, faces always extended beyond EOL.  Check for a
+    ;; non-default background.
+    (face-background face nil t)))
+
+(defun adaptive-wrap--prefix-face (fcp beg end)
+  (cond ((get-text-property 0 'face fcp))
+        ;; If the last character is a newline and has a face that
+        ;; extends beyond EOL, assume that this face spans the whole
+        ;; line and apply it to the prefix to preserve the "block"
+        ;; visual effect.
+        ;; NB: the face might not actually span the whole line: see for
+        ;; example removed lines in diff-mode, where the first character
+        ;; has the diff-indicator-removed face, while the rest of the
+        ;; line has the diff-removed face.
+        ((= (char-before end) ?\n)
+         (let ((eol-face (get-text-property (1- end) 'face)))
+           (and eol-face (adaptive-wrap--face-extends eol-face) eol-face)))))
+
+(defun adaptive-wrap--prefix (fcp)
+  (let ((fcp-len (string-width fcp)))
+    (cond
+     ((= 0 adaptive-wrap-extra-indent)
+      fcp)
+     ((< 0 adaptive-wrap-extra-indent)
+      (concat fcp (make-string adaptive-wrap-extra-indent ?\s)))
+     ((< 0 (+ adaptive-wrap-extra-indent fcp-len))
+      (substring fcp
+                 0
+                 (+ adaptive-wrap-extra-indent fcp-len)))
+     (t
+      ""))))
+
 (defun adaptive-wrap-fill-context-prefix (beg end)
   "Like `fill-context-prefix', but with length adjusted by 
`adaptive-wrap-extra-indent'."
   (let* ((fcp
@@ -72,23 +107,12 @@ extra indent = 2
                     (fill-context-prefix beg end))
                   ;; Note: fill-context-prefix may return nil; See:
                   ;; http://article.gmane.org/gmane.emacs.devel/156285
-                  ""))
-         (fcp-len (string-width fcp))
-         (fill-char (if (< 0 fcp-len)
-                        (string-to-char (substring fcp -1))
-                      ?\ )))
-    (cond
-     ((= 0 adaptive-wrap-extra-indent)
-      fcp)
-     ((< 0 adaptive-wrap-extra-indent)
-      (concat fcp
-              (make-string adaptive-wrap-extra-indent fill-char)))
-     ((< 0 (+ adaptive-wrap-extra-indent fcp-len))
-      (substring fcp
-                 0
-                 (+ adaptive-wrap-extra-indent fcp-len)))
-     (t
-      ""))))
+              ""))
+         (prefix (adaptive-wrap--prefix fcp))
+         (face (adaptive-wrap--prefix-face fcp beg end)))
+    (if face
+        (propertize prefix 'face face)
+      prefix)))
 
 (defun adaptive-wrap-prefix-function (beg end)
   "Indent the region between BEG and END with adaptive filling."