diff options
| -rw-r--r-- | lisp/net/shr.el | 15 | ||||
| -rw-r--r-- | test/lisp/net/shr-resources/blockquote.html | 2 | ||||
| -rw-r--r-- | test/lisp/net/shr-resources/blockquote.txt | 3 | ||||
| -rw-r--r-- | 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)) |