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.

(cherry picked from commit 09ab66935154ea0cc4a351b8320bc0e9276b7780)

diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index e23fc6104d29ae641d51fdcc8d57249398eb1a65..09df5f5a9bbde50895834124b0ee43276d0fdfea 100644 (file)
--- 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 (file)
index 0000000..412caf8
--- /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 (file)
index 0000000..8ed610b
--- /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 0c6e2c091bf9bd71bd5890280d3f44f330273cae..171380534504e972b9664e05b7ec8364583c39c3 100644 (file)
--- 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))