bug#69555: 30.0.50; shr - Preserve indentation when shr-fill-text is nil

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

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

Kévin Le Gouguec <kevin.legouguec@gmail.com> writes:

>                                 Will post an updated patch once I have a
> bug number to replace the "bug#TODO" placeholders.

See attached.


[-- Attachment #2: 0001-Keep-indenting-text-when-shr-fill-text-is-nil-bug-69.patch --]
[-- Type: text/x-patch, Size: 8314 bytes --]

From ea41aa4ef92357f00bc7814d7020a81104e4b95f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com>
Date: Sun, 3 Mar 2024 17:20:56 +0100
Subject: [PATCH] Keep indenting text when 'shr-fill-text' is nil (bug#69555)
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

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(-)
 create mode 100644 test/lisp/net/shr-resources/blockquote.html
 create mode 100644 test/lisp/net/shr-resources/blockquote.txt

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 @@ shr-insert
 			       (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 @@ shr-vertical-motion
       (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 @@ shr-fill-line
 			   `,(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))
-- 
2.44.0