bug#41810: [PATCH][ELPA] adaptive-wrap: Fontify wrap-prefix

["Kévin Le Gouguec" <kevin.legouguec@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 92 bytes --]

OK, here is a patch that I think should be good to push, tested against
Emacs 28 and 26.3.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: patch1.patch --]
[-- Type: text/x-patch, Size: 4521 bytes --]

From bcb32db22a65d90422aed5255e665356e50f2e49 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com>
Date: Mon, 15 Jun 2020 23:02:08 +0200
Subject: [PATCH] Fontify adaptive-wrap's wrap-prefix

This attempts to fix at least two suboptimal situations:

1. when extra-indent is positive, and the padding character is not a
space: the extra-indent characters were not fontified, so they clashed
between the fontified prefix returned by fill-context-prefix and the
fontified continuation line.

2. when the wrapped line has a background that extends beyond
end-of-line (e.g. removed/added lines in diff-mode): the unfontified
wrap-prefixes looked like "holes" in the otherwise uniform background.

See bug#41810 for motivating use-cases and implementation rationale.

* 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 | 64 ++++++++++++++++++-------
 1 file changed, 47 insertions(+), 17 deletions(-)

diff --git a/packages/adaptive-wrap/adaptive-wrap.el b/packages/adaptive-wrap/adaptive-wrap.el
index f8d89ac69..ed4fed900 100644
--- a/packages/adaptive-wrap/adaptive-wrap.el
+++ b/packages/adaptive-wrap/adaptive-wrap.el
@@ -59,6 +59,47 @@ 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)
+  (or (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.
+      (when (= (char-before end) ?\n)
+        (let ((eol-face (get-text-property (1- end) 'face)))
+          (when (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
+                    (if (< 0 fcp-len)
+                        (string-to-char (substring fcp -1))
+                      ?\ ))))
+     ((< 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 +113,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."
-- 
2.27.0


[-- Attachment #3: Type: text/plain, Size: 231 bytes --]


Some before/after screenshots:

- patch1-diff-1.png: regular diff,
- patch1-diff-2.png: diff with background-less indicator faces,
- patch1-nospace-1.png: when (substring fcp -1) is not a space,
- patch1-nospace-2.png: likewise.


[-- Attachment #4: patch1-diff-1.png --]
[-- Type: image/png, Size: 100448 bytes --]

[-- Attachment #5: patch1-diff-2.png --]
[-- Type: image/png, Size: 100489 bytes --]

[-- Attachment #6: patch1-nospace-1.png --]
[-- Type: image/png, Size: 60481 bytes --]

[-- Attachment #7: patch1-nospace-2.png --]
[-- Type: image/png, Size: 93031 bytes --]

[-- Attachment #8: Type: text/plain, Size: 52 bytes --]


Screenshots generated with the following scripts:


[-- Attachment #9: repro.el --]
[-- Type: text/x-emacs-lisp, Size: 2436 bytes --]

(defun bug41810-setup ()
  (require 'adaptive-wrap)
  (add-hook 'visual-line-mode-hook 'adaptive-wrap-prefix-mode)
  (setq-default adaptive-wrap-extra-indent 2)
  (setq visual-line-fringe-indicators '(left-curly-arrow right-curly-arrow))
  (global-visual-line-mode))

(defun bug41810-teardown (screenshot)
  (text-scale-increase 2)
  ;; AFAICT unless we force redisplay, ImageMagick only captures the
  ;; *scratch* buffer.

  ;; Also, sometimes the scroll bar refuses to be drawn.  I've tried
  ;; various permutations of sit-for, redraw-frame, redraw-display,
  ;; force-window-update…  The following is the most "robust" way I
  ;; found to have the scroll bar show up and smile for the camera.

  ;; tl;dr I have no idea what I'm doing 💻🐾👔🐕
  (redisplay)
  (sleep-for 0.1)
  (redisplay)
  (call-process "magick" nil nil nil
                "import"
                "-window" (frame-parameter (selected-frame) 'window-id)
                "-frame"
                (expand-file-name
                 (concat
                  (buffer-local-value 'default-directory (get-buffer "*scratch*"))
                  screenshot)))
  (kill-emacs))

(defmacro defexample-bug41810 (name &rest body)
  (declare (indent defun))
  (list 'defun (intern (format "bug41810-%s" name)) '(description)
        '(bug41810-setup)
        `(progn
           ,@body)
        `(bug41810-teardown
          (format "%s-%s.png" ,(symbol-name name) description))))

(defexample-bug41810 nospace-1
  (find-library "cl-indent")
  (goto-char (point-max))
  (recenter -1))

(defexample-bug41810 nospace-2
  (switch-to-buffer "*example*")
  (url-insert-file-contents "https://code.orgmode.org/bzg/worg/raw/master/worgmap.org")
  (org-mode))

(defexample-bug41810 diff-1
  (switch-to-buffer "*example*")
  (url-insert-file-contents "https://git.savannah.gnu.org/cgit/emacs.git/patch/?id=be5d0c0f63081b5aee5efe2fbcc5c4ace6ca9a02")
  (diff-mode)
  (search-forward "diff --git")
  (recenter 0))

(defexample-bug41810 diff-2
  (switch-to-buffer "*example*")
  (url-insert-file-contents "https://git.savannah.gnu.org/cgit/emacs.git/patch/?id=be5d0c0f63081b5aee5efe2fbcc5c4ace6ca9a02")
  (diff-mode)
  (set-face-background 'diff-indicator-added (face-background 'default))
  (set-face-background 'diff-indicator-removed (face-background 'default))
  (search-forward "diff --git")
  (recenter 0))

[-- Attachment #10: repro.sh --]
[-- Type: application/x-shellscript, Size: 775 bytes --]

[-- Attachment #11: Type: text/plain, Size: 1029 bytes --]


Open questions:

- Since "check that a face spans the whole line" is neither
  straightforward nor sufficient (cf. diff-mode), I went with a fairly
  naive heuristic.  If anyone wants to describe a more sensible
  algorithm, or point out counter-examples where this logic breaks down,
  I'm all ears!

- The (or … (when … (let … (when (and …))))) chain looks clumsy but I
  don't really know how to improve it off the top of my head.  Maybe a
  when-let or two would help?  That'd mean requiring Emacs 25.1 though.

- (More of a nerd-snipe than an actual question, and definitely not
  related to this bug report, but if any expert on redisplay can look at
  bug41810-teardown in repro.el and tell me what is up with those pesky
  scroll bars, I'd be very grateful.)

Finally, I'd like to suggest this second patch to apply on top of the
first one.  I know there is no consensus that spaces are better than
(substring fcp -1), but I still can't think of a situation were the
latter looks better.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #12: patch2.patch --]
[-- Type: text/x-patch, Size: 1227 bytes --]

From 38202afa73e5612700d33ba4aa985e955f36ac02 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com>
Date: Sun, 21 Jun 2020 12:43:34 +0200
Subject: [PATCH] Always use spaces for extra-indent in adaptive-wrap
 (bug#41810)

* packages/adaptive-wrap/adaptive-wrap.el (adaptive-wrap--prefix): Use
spaces; ignore the string returned by fill-context-prefix.
---
 packages/adaptive-wrap/adaptive-wrap.el | 7 +------
 1 file changed, 1 insertion(+), 6 deletions(-)

diff --git a/packages/adaptive-wrap/adaptive-wrap.el b/packages/adaptive-wrap/adaptive-wrap.el
index ed4fed900..ce54fd915 100644
--- a/packages/adaptive-wrap/adaptive-wrap.el
+++ b/packages/adaptive-wrap/adaptive-wrap.el
@@ -87,12 +87,7 @@ extra indent = 2
      ((= 0 adaptive-wrap-extra-indent)
       fcp)
      ((< 0 adaptive-wrap-extra-indent)
-      (concat
-       fcp
-       (make-string adaptive-wrap-extra-indent
-                    (if (< 0 fcp-len)
-                        (string-to-char (substring fcp -1))
-                      ?\ ))))
+      (concat fcp (make-string adaptive-wrap-extra-indent ?\s)))
      ((< 0 (+ adaptive-wrap-extra-indent fcp-len))
       (substring fcp
                  0
-- 
2.27.0


[-- Attachment #13: Type: text/plain, Size: 15 bytes --]


Screenshots:


[-- Attachment #14: patch2-nospace-1.png --]
[-- Type: image/png, Size: 59614 bytes --]

[-- Attachment #15: patch2-nospace-2.png --]
[-- Type: image/png, Size: 91835 bytes --]

[-- Attachment #16: Type: text/plain, Size: 30 bytes --]


Thank you for your patience.