master 09ab6693515: Keep indenting text when 'shr-fill-text' is nil (bug#69555)

[Kévin Le Gouguec]

branch: master
commit 09ab66935154ea0cc4a351b8320bc0e9276b7780
Author: Kévin Le Gouguec <kevin.legouguec@gmail.com>
Commit: Kévin Le Gouguec <kevin.legouguec@gmail.com>

    Keep indenting text when 'shr-fill-text' is nil (bug#69555)
    
    The 'shr-fill-...' functions handle both hard-filling (adding
    newlines to break long lines) and indentation.  Setting
    'shr-fill-text' to nil currently causes these functions to be
    short-circuited completely, so e.g. blockquotes are no longer
    indented, whereas the intent of this user option is only to
    prevent hard-filling to let visual-line-mode reflow text.
    
    * lisp/net/shr.el (shr-fill-lines): Document that the function
    handles more than just filling; move the 'shr-fill-text' check...
    (shr-fill-line): ... here, after indentation has been taken care
    of.
    * test/lisp/net/shr-resources/blockquote.html:
    * test/lisp/net/shr-resources/blockquote.txt: New test resources.
    * test/lisp/net/shr-tests.el (shr-test--rendering-check): Rename
    from 'shr-test', to make the relationship with the 'rendering'
    testcase clearer; prefer 'file-name-concat' to 'format'; raise
    ERT failure if need be, calling (ert-fail ...) directly instead
    of (should (not (list ...))).
    (shr-test--rendering-extra-configs): New variable to easily check
    that user customizations do not degrade rendering.
    (rendering): Consult that new variable; delegate failure-raising
    to reduce duplication.
---
 lisp/net/shr.el                             | 15 ++++--
 test/lisp/net/shr-resources/blockquote.html |  2 +
 test/lisp/net/shr-resources/blockquote.txt  |  3 ++
 test/lisp/net/shr-tests.el                  | 72 +++++++++++++++++++++--------
 4 files changed, 67 insertions(+), 25 deletions(-)

diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index e23fc6104d2..09df5f5a9bb 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -784,8 +784,9 @@ size, and full-buffer size."
                               (or shr-current-font 'shr-text)))))))))
 
 (defun shr-fill-lines (start end)
-  (if (or (not shr-fill-text) (<= shr-internal-width 0))
-      nil
+  "Indent and fill text from START to END.
+When `shr-fill-text' is nil, only indent."
+  (unless (<= shr-internal-width 0)
     (save-restriction
       (narrow-to-region start end)
       (goto-char start)
@@ -807,6 +808,8 @@ size, and full-buffer size."
       (forward-char 1))))
 
 (defun shr-fill-line ()
+  "Indent and fill the current line.
+When `shr-fill-text' is nil, only indent."
   (let ((shr-indentation (or (get-text-property (point) 'shr-indentation)
                              shr-indentation))
        (continuation (get-text-property
@@ -821,9 +824,11 @@ size, and full-buffer size."
                           `,(shr-face-background face))))
     (setq start (point))
     (setq shr-indentation (or continuation shr-indentation))
-    ;; If we have an indentation that's wider than the width we're
-    ;; trying to fill to, then just give up and don't do any filling.
-    (when (< shr-indentation shr-internal-width)
+    ;; Fill the current line, unless `shr-fill-text' is unset, or we
+    ;; have an indentation that's wider than the width we're trying to
+    ;; fill to.
+    (when (and shr-fill-text
+               (< shr-indentation shr-internal-width))
       (shr-vertical-motion shr-internal-width)
       (when (looking-at " $")
         (delete-region (point) (line-end-position)))
diff --git a/test/lisp/net/shr-resources/blockquote.html 
b/test/lisp/net/shr-resources/blockquote.html
new file mode 100644
index 00000000000..412caf8bae6
--- /dev/null
+++ b/test/lisp/net/shr-resources/blockquote.html
@@ -0,0 +1,2 @@
+<blockquote>Citation.</blockquote>
+<div>Reply.</div>
diff --git a/test/lisp/net/shr-resources/blockquote.txt 
b/test/lisp/net/shr-resources/blockquote.txt
new file mode 100644
index 00000000000..8ed610b8ea2
--- /dev/null
+++ b/test/lisp/net/shr-resources/blockquote.txt
@@ -0,0 +1,3 @@
+    Citation.
+
+Reply.
diff --git a/test/lisp/net/shr-tests.el b/test/lisp/net/shr-tests.el
index 0c6e2c091bf..17138053450 100644
--- a/test/lisp/net/shr-tests.el
+++ b/test/lisp/net/shr-tests.el
@@ -29,30 +29,62 @@
 
 (declare-function libxml-parse-html-region "xml.c")
 
-(defun shr-test (name)
-  (with-temp-buffer
-    (insert-file-contents (format (concat (ert-resource-directory) "/%s.html") 
name))
-    (let ((dom (libxml-parse-html-region (point-min) (point-max)))
-          (shr-width 80)
-          (shr-use-fonts nil))
-      (erase-buffer)
-      (shr-insert-document dom)
-      (cons (buffer-substring-no-properties (point-min) (point-max))
-            (with-temp-buffer
-              (insert-file-contents
-               (format (concat (ert-resource-directory) "/%s.txt") name))
-              (while (re-search-forward "%\\([0-9A-F][0-9A-F]\\)" nil t)
-                (replace-match (string (string-to-number (match-string 1) 16))
-                               t t))
-              (buffer-string))))))
+(defun shr-test--rendering-check (name &optional context)
+  "Render NAME.html and compare it to NAME.txt.
+Raise a test failure if the rendered buffer does not match NAME.txt.
+Append CONTEXT to the failure data, if non-nil."
+  (let ((text-file (file-name-concat (ert-resource-directory) (concat name 
".txt")))
+        (html-file (file-name-concat (ert-resource-directory) (concat name 
".html")))
+        (description (if context (format "%s (%s)" name context) name)))
+    (with-temp-buffer
+      (insert-file-contents html-file)
+      (let ((dom (libxml-parse-html-region (point-min) (point-max)))
+            (shr-width 80)
+            (shr-use-fonts nil))
+        (erase-buffer)
+        (shr-insert-document dom)
+        (let ((result (buffer-substring-no-properties (point-min) (point-max)))
+              (expected
+               (with-temp-buffer
+                 (insert-file-contents text-file)
+                 (while (re-search-forward "%\\([0-9A-F][0-9A-F]\\)" nil t)
+                   (replace-match (string (string-to-number (match-string 1) 
16))
+                                  t t))
+                 (buffer-string))))
+          (unless (equal result expected)
+            (ert-fail (list description result expected))))))))
+
+(defconst shr-test--rendering-extra-configs
+  '(("blockquote"
+     ;; Make sure blockquotes remain indented even when filling is
+     ;; disabled (bug#69555).
+     . ((shr-fill-text . nil))))
+  "Extra customizations which can impact rendering.
+This is a list of (NAME . SETTINGS) pairs.  NAME is the basename of a
+set of txt/html files under shr-resources/, as passed to `shr-test'.
+SETTINGS is a list of (OPTION . VALUE) pairs that are interesting to
+validate for the NAME testcase.
+
+The `rendering' testcase will test NAME once without altering any
+settings, then once more for each (OPTION . VALUE) pair.")
 
 (ert-deftest rendering ()
   (skip-unless (fboundp 'libxml-parse-html-region))
   (dolist (file (directory-files (ert-resource-directory) nil "\\.html\\'"))
-    (let* ((name (replace-regexp-in-string "\\.html\\'" "" file))
-           (result (shr-test name)))
-      (unless (equal (car result) (cdr result))
-        (should (not (list name (car result) (cdr result))))))))
+    (let* ((name (string-remove-suffix ".html" file))
+           (extra-options (alist-get name shr-test--rendering-extra-configs
+                                     nil nil 'string=)))
+      ;; Test once with default settings.
+      (shr-test--rendering-check name)
+      ;; Test once more for every extra option for this specific NAME.
+      (pcase-dolist (`(,option-sym ,option-val)
+                     extra-options)
+        (let ((option-old (symbol-value option-sym)))
+          (set option-sym option-val)
+          (unwind-protect
+              (shr-test--rendering-check
+               name (format "with %s %s" option-sym option-val))
+            (set option-sym option-old)))))))
 
 (ert-deftest use-cookies ()
   (let ((shr-cookie-policy 'same-origin))