bug#68254: EWW ‘readable’ by default

[Jim Porter <jporterbugs@gmail.com>]

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

On 3/21/2024 3:51 AM, Eli Zaretskii wrote:
> Yes, tests would be good.

I've now added tests. (Good thing too, since I found a minor bug while 
writing them!)

>> ++++
>> +*** 'eww-readable' now toggles display of the readable parts of a web page.
>> +When called interactively, 'eww-readable' toggles whether to display
>> +only the readable parts of a page or the full page.  With a positive
>> +prefix argument, always display the readable parts, and with a zero or
>> +negative prefix, always display the full page.
> 
> You say "toggles", but then "display".  It is better to make the style
> consistent.

Fixed.

>> +(defun eww--parse-html-region (start end &optional encode)
>> +  "Parse the HTML between START and END, returning the DOM as an S-expression.
>> +Use ENCODE to decode the region; if nil, decode as UTF-8.
> 
> It is better to call the argument DECODE, not ENCODE.

I changed this to CODING-SYSTEM, since that's what 
'decode-coding-region' calls the argument.

>> +@vindex eww-readable-urls
>> +  If you want EWW to render a certain page in ``readable'' mode by
>> +default, you can add a regular expression matching its URL to
>> +@code{eww-readable-urls}.  Each entry can either be a regular expression
>> +as a string or a cons cell of the form @code{(@var{regexp}
>> +. @var{readability})}. If @var{readability} is non-@code{nil}, this
>                          ^^
> Please use @w to prevent breaking long expressions between two lines.
> Also, please leave two spaces between sentences.

Thanks, both fixed. I never knew about @w.

>> +(defcustom eww-readable-urls nil
>> +  "A list of regexps matching URLs to display in readable mode by default.
>> +Each element can be either a string regexp or a cons cell of the
>> +form (REGEXP . READABILITY).  If READABILITY is non-nil, this behaves
>> +the same as the string form; otherwise, URLs matching REGEXP will never
>     ^^^^^^^^^^^^^^^^^^^^^^^^^^^
> What do you mean by "the same as the string form"? which string form?

I've tried to clarify this. By "string form", I meant the "string 
regexp" mentioned previously; in my new patch, I describe that as "a 
regular expression in string form".

[-- Attachment #2: 0001-Allow-toggling-readable-mode-in-EWW.patch --]
[-- Type: text/plain, Size: 14455 bytes --]

From 59d3e64d46434cf8ad13d3329ef73e78bd0b56b6 Mon Sep 17 00:00:00 2001
From: Jim Porter <jporterbugs@gmail.com>
Date: Sun, 17 Mar 2024 12:01:59 -0700
Subject: [PATCH 1/2] Allow toggling "readable" mode in EWW

Additionally, add an option to prevent adding a new history entry for
each call of 'eww-readable' (bug#68254).

* lisp/net/eww.el (eww-retrieve):

* lisp/net/eww.el (eww-readable-adds-to-history): New option.
(eww-retrieve): Make sure we call CALLBACK in all configurations.
(eww-render): Simplify how to pass encoding.
(eww--parse-html-region, eww-display-document): New functions, extracted
from...
(eww-display-html): ... here.
(eww-document-base): New function.
(eww-readable): Toggle "readable" mode interactively, like with a minor
mode.  Consult 'eww-readable-adds-to-history'.
(eww-reload): Use 'eshell-display-document'.

* test/lisp/net/eww-tests.el (eww-test--with-mock-retrieve): Fix indent.
(eww-test/display/html, eww-test/readable/toggle-display): New tests.

* doc/misc/eww.texi (Basics): Describe the new behavior.

* etc/NEWS: Announce this change.
---
 doc/misc/eww.texi          |   5 ++
 etc/NEWS                   |  12 ++++
 lisp/net/eww.el            | 127 ++++++++++++++++++++++++-------------
 test/lisp/net/eww-tests.el |  57 ++++++++++++++++-
 4 files changed, 155 insertions(+), 46 deletions(-)

diff --git a/doc/misc/eww.texi b/doc/misc/eww.texi
index d31fcf1802b..522034c874d 100644
--- a/doc/misc/eww.texi
+++ b/doc/misc/eww.texi
@@ -146,6 +146,11 @@ Basics
 which part of the document contains the ``readable'' text, and will
 only display this part.  This usually gets rid of menus and the like.
 
+  When called interactively, this command toggles the display of the
+readable parts.  With a positive prefix argument, this command always
+displays the readable parts, and with a zero or negative prefix, it
+always displays the full page.
+
 @findex eww-toggle-fonts
 @vindex shr-use-fonts
 @kindex F
diff --git a/etc/NEWS b/etc/NEWS
index b02712dd21c..dd4c1ea2fac 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1054,6 +1054,18 @@ entries newer than the current page.  To change the behavior when
 browsing from "historical" pages, you can customize
 'eww-before-browse-history-function'.
 
++++
+*** 'eww-readable' now toggles display of the readable parts of a web page.
+When called interactively, 'eww-readable' toggles whether to display
+only the readable parts of a page or the full page.  With a positive
+prefix argument, it always displays the readable parts, and with a zero
+or negative prefix, it always displays the full page.
+
+---
+*** New option 'eww-readable-adds-to-history'.
+When non-nil (the default), calling 'eww-readable' adds a new entry to
+the EWW page history.
+
 ** go-ts-mode
 
 +++
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index 54847bdf396..54b65d35164 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -275,6 +275,11 @@ eww-url-transformers
   :type '(repeat function)
   :version "29.1")
 
+(defcustom eww-readable-adds-to-history t
+  "If non-nil, calling `eww-readable' adds a new entry to the history."
+  :type 'boolean
+  :version "30.1")
+
 (defface eww-form-submit
   '((((type x w32 ns haiku pgtk android) (class color))	; Like default mode line
      :box (:line-width 2 :style released-button)
@@ -464,11 +469,11 @@ eww
 (defun eww-retrieve (url callback cbargs)
   (cond
    ((null eww-retrieve-command)
-    (url-retrieve url #'eww-render cbargs))
+    (url-retrieve url callback cbargs))
    ((eq eww-retrieve-command 'sync)
     (let ((data-buffer (url-retrieve-synchronously url)))
       (with-current-buffer data-buffer
-        (apply #'eww-render nil cbargs))))
+        (apply callback nil cbargs))))
    (t
     (let ((buffer (generate-new-buffer " *eww retrieve*"))
           (error-buffer (generate-new-buffer " *eww error*")))
@@ -673,9 +678,9 @@ eww-render
               (insert (format "<a href=%S>Direct link to the document</a>"
                               url))
               (goto-char (point-min))
-	      (eww-display-html charset url nil point buffer encode))
+              (eww-display-html (or encode charset) url nil point buffer))
 	     ((eww-html-p (car content-type))
-	      (eww-display-html charset url nil point buffer encode))
+              (eww-display-html (or encode charset) url nil point buffer))
 	     ((equal (car content-type) "application/pdf")
 	      (eww-display-pdf))
 	     ((string-match-p "\\`image/" (car content-type))
@@ -726,34 +731,40 @@ eww-detect-charset
 (declare-function libxml-parse-html-region "xml.c"
 		  (start end &optional base-url discard-comments))
 
-(defun eww-display-html (charset url &optional document point buffer encode)
+(defun eww--parse-html-region (start end &optional coding-system)
+  "Parse the HTML between START and END, returning the DOM as an S-expression.
+Use CODING-SYSTEM to decode the region; if nil, decode as UTF-8.
+
+This replaces the region with the preprocessed HTML."
+  (setq coding-system (or coding-system 'utf-8))
+  (with-restriction start end
+    (condition-case nil
+        (decode-coding-region (point-min) (point-max) coding-system)
+      (coding-system-error nil))
+    ;; Remove CRLF and replace NUL with &#0; before parsing.
+    (while (re-search-forward "\\(\r$\\)\\|\0" nil t)
+      (replace-match (if (match-beginning 1) "" "&#0;") t t))
+    (eww--preprocess-html (point-min) (point-max))
+    (libxml-parse-html-region (point-min) (point-max))))
+
+(defsubst eww-document-base (url dom)
+  `(base ((href . ,url)) ,dom))
+
+(defun eww-display-document (document &optional point buffer)
   (unless (fboundp 'libxml-parse-html-region)
     (error "This function requires Emacs to be compiled with libxml2"))
+  (setq buffer (or buffer (current-buffer)))
   (unless (buffer-live-p buffer)
     (error "Buffer %s doesn't exist" buffer))
   ;; There should be a better way to abort loading images
   ;; asynchronously.
   (setq url-queue nil)
-  (let ((document
-	 (or document
-	     (list
-	      'base (list (cons 'href url))
-	      (progn
-		(setq encode (or encode charset 'utf-8))
-		(condition-case nil
-		    (decode-coding-region (point) (point-max) encode)
-		  (coding-system-error nil))
-		(save-excursion
-		  ;; Remove CRLF and replace NUL with &#0; before parsing.
-		  (while (re-search-forward "\\(\r$\\)\\|\0" nil t)
-		    (replace-match (if (match-beginning 1) "" "&#0;") t t)))
-                (eww--preprocess-html (point) (point-max))
-		(libxml-parse-html-region (point) (point-max))))))
-	(source (and (null document)
-		     (buffer-substring (point) (point-max)))))
+  (let ((url (when (eq (car document) 'base)
+               (alist-get 'href (cadr document)))))
+    (unless url
+      (error "Document is missing base URL"))
     (with-current-buffer buffer
       (setq bidi-paragraph-direction nil)
-      (plist-put eww-data :source source)
       (plist-put eww-data :dom document)
       (let ((inhibit-read-only t)
 	    (inhibit-modification-hooks t)
@@ -794,6 +805,16 @@ eww-display-html
 	    (forward-line 1)))))
       (eww-size-text-inputs))))
 
+(defun eww-display-html (charset url &optional document point buffer)
+  (let ((source (buffer-substring (point) (point-max))))
+    (with-current-buffer buffer
+      (plist-put eww-data :source source)))
+  (eww-display-document
+   (or document
+       (eww-document-base
+        url (eww--parse-html-region (point) (point-max) charset)))
+   point buffer))
+
 (defun eww-handle-link (dom)
   (let* ((rel (dom-attr dom 'rel))
 	 (href (dom-attr dom 'href))
@@ -1055,30 +1076,47 @@ eww-toggle-paragraph-direction
                "automatic"
              bidi-paragraph-direction)))
 
-(defun eww-readable ()
-  "View the main \"readable\" parts of the current web page.
+(defun eww-readable (&optional arg)
+  "Toggle display of only the main \"readable\" parts of the current web page.
 This command uses heuristics to find the parts of the web page that
-contains the main textual portion, leaving out navigation menus and
-the like."
-  (interactive nil eww-mode)
+contain the main textual portion, leaving out navigation menus and the
+like.
+
+If called interactively, toggle the display of the readable parts.  If
+the prefix argument is positive, display the readable parts, and if it
+is zero or negative, display the full page.
+
+If called from Lisp, toggle the display of the readable parts if ARG is
+`toggle'.  Display the readable parts if ARG is nil, omitted, or is a
+positive number.  Display the full page if ARG is a negative number.
+
+When `eww-readable-adds-to-history' is non-nil, calling this function
+adds a new entry to `eww-history'."
+  (interactive (list (if current-prefix-arg
+                         (prefix-numeric-value current-prefix-arg)
+                       'toggle))
+               eww-mode)
   (let* ((old-data eww-data)
-	 (dom (with-temp-buffer
+	 (make-readable (cond
+                         ((eq arg 'toggle)
+                          (not (plist-get old-data :readable)))
+                         ((and (numberp arg) (< arg 1))
+                          nil)
+                         (t t)))
+         (dom (with-temp-buffer
 		(insert (plist-get old-data :source))
-		(condition-case nil
-		    (decode-coding-region (point-min) (point-max) 'utf-8)
-		  (coding-system-error nil))
-                (eww--preprocess-html (point-min) (point-max))
-		(libxml-parse-html-region (point-min) (point-max))))
+                (eww--parse-html-region (point-min) (point-max))))
          (base (plist-get eww-data :url)))
-    (eww-score-readability dom)
-    (eww-save-history)
-    (eww--before-browse)
-    (eww-display-html nil nil
-                      (list 'base (list (cons 'href base))
-                            (eww-highest-readability dom))
-		      nil (current-buffer))
-    (dolist (elem '(:source :url :title :next :previous :up :peer))
-      (plist-put eww-data elem (plist-get old-data elem)))
+    (when make-readable
+      (eww-score-readability dom)
+      (setq dom (eww-highest-readability dom)))
+    (when eww-readable-adds-to-history
+      (eww-save-history)
+      (eww--before-browse)
+      (dolist (elem '(:source :url :title :next :previous :up :peer))
+        (plist-put eww-data elem (plist-get old-data elem))))
+    (eww-display-document (eww-document-base base dom))
+    (plist-put eww-data :readable make-readable)
     (eww--after-page-change)))
 
 (defun eww-score-readability (node)
@@ -1398,8 +1436,7 @@ eww-reload
     (if local
 	(if (null (plist-get eww-data :dom))
 	    (error "No current HTML data")
-	  (eww-display-html 'utf-8 url (plist-get eww-data :dom)
-			    (point) (current-buffer)))
+	  (eww-display-document (plist-get eww-data :dom) (point)))
       (let ((parsed (url-generic-parse-url url)))
         (if (equal (url-type parsed) "file")
             ;; Use Tramp instead of url.el for files (since url.el
diff --git a/test/lisp/net/eww-tests.el b/test/lisp/net/eww-tests.el
index bd00893d503..a09e0a4f279 100644
--- a/test/lisp/net/eww-tests.el
+++ b/test/lisp/net/eww-tests.el
@@ -33,7 +33,7 @@ eww-test--with-mock-retrieve
   "Evaluate BODY with a mock implementation of `eww-retrieve'.
 This avoids network requests during our tests.  Additionally, prepare a
 temporary EWW buffer for our tests."
-  (declare (indent 1))
+  (declare (indent 0))
     `(cl-letf (((symbol-function 'eww-retrieve)
                 (lambda (url callback args)
                   (with-temp-buffer
@@ -48,6 +48,24 @@ eww-test--history-urls
 
 ;;; Tests:
 
+(ert-deftest eww-test/display/html ()
+  "Test displaying a simple HTML page."
+  (eww-test--with-mock-retrieve
+    (let ((eww-test--response-function
+           (lambda (url)
+             (concat "Content-Type: text/html\n\n"
+                     (format "<html><body><h1>Hello</h1>%s</body></html>"
+                             url)))))
+      (eww "example.invalid")
+      ;; Check that the buffer contains the rendered HTML.
+      (should (equal (buffer-string) "Hello\n\n\nhttp://example.invalid/\n"))
+      (should (equal (get-text-property (point-min) 'face)
+                     '(shr-text shr-h1)))
+      ;; Check that the DOM includes the `base'.
+      (should (equal (pcase (plist-get eww-data :dom)
+                       (`(base ((href . ,url)) ,_) url))
+                     "http://example.invalid/")))))
+
 (ert-deftest eww-test/history/new-page ()
   "Test that when visiting a new page, the previous one goes into the history."
   (eww-test--with-mock-retrieve
@@ -176,5 +194,42 @@ eww-test/history/before-navigate/clone-previous
                        "http://one.invalid/")))
       (should (= eww-history-position 0)))))
 
+(ert-deftest eww-test/readable/toggle-display ()
+  "Test toggling the display of the \"readable\" parts of a web page."
+  (eww-test--with-mock-retrieve
+    (let* ((shr-width most-positive-fixnum)
+           (shr-use-fonts nil)
+           (words (string-join
+                   (make-list
+                    20 "All work and no play makes Jack a dull boy.")
+                   " "))
+           (eww-test--response-function
+            (lambda (_url)
+              (concat "Content-Type: text/html\n\n"
+                      "<html><body>"
+                      "<a>This is an uninteresting sentence.</a>"
+                      "<div>"
+                      words
+                      "</div>"
+                      "</body></html>"))))
+      (eww "example.invalid")
+      ;; Make sure EWW renders the whole document.
+      (should-not (plist-get eww-data :readable))
+      (should (string-prefix-p
+               "This is an uninteresting sentence."
+               (buffer-substring-no-properties (point-min) (point-max))))
+      (eww-readable 'toggle)
+      ;; Now, EWW should render just the "readable" parts.
+      (should (plist-get eww-data :readable))
+      (should (string-match-p
+               (concat "\\`" (regexp-quote words) "\n*\\'")
+               (buffer-substring-no-properties (point-min) (point-max))))
+      (eww-readable 'toggle)
+      ;; Finally, EWW should render the whole document again.
+      (should-not (plist-get eww-data :readable))
+      (should (string-prefix-p
+               "This is an uninteresting sentence."
+               (buffer-substring-no-properties (point-min) (point-max)))))))
+
 (provide 'eww-tests)
 ;; eww-tests.el ends here
-- 
2.25.1


[-- Attachment #3: 0002-Add-eww-readable-urls.patch --]
[-- Type: text/plain, Size: 6013 bytes --]

From e12c94d8590f25e9bc9f64b3e269bc4ab10996dd Mon Sep 17 00:00:00 2001
From: Jim Porter <jporterbugs@gmail.com>
Date: Mon, 18 Mar 2024 16:52:34 -0700
Subject: [PATCH 2/2] Add 'eww-readable-urls'

* lisp/net/eww.el (eww-readable-urls): New option.
(eww-default-readable-p): New function...
(eww-display-html): ... use it.

* test/lisp/net/eww-tests.el (eww-test/readable/default-readable): New
test.

* doc/misc/eww.texi (Basics): Document 'eww-readable-urls'.

* etc/NEWS: Announce this change.
---
 doc/misc/eww.texi          | 16 +++++++++++++++
 etc/NEWS                   |  6 ++++++
 lisp/net/eww.el            | 41 +++++++++++++++++++++++++++++++++-----
 test/lisp/net/eww-tests.el | 12 +++++++++++
 4 files changed, 70 insertions(+), 5 deletions(-)

diff --git a/doc/misc/eww.texi b/doc/misc/eww.texi
index 522034c874d..eec6b3c3299 100644
--- a/doc/misc/eww.texi
+++ b/doc/misc/eww.texi
@@ -151,6 +151,22 @@ Basics
 displays the readable parts, and with a zero or negative prefix, it
 always displays the full page.
 
+@vindex eww-readable-urls
+  If you want EWW to render a certain page in ``readable'' mode by
+default, you can add a regular expression matching its URL to
+@code{eww-readable-urls}.  Each entry can either be a regular expression
+in string form or a cons cell of the form
+@w{@code{(@var{regexp} . @var{readability})}}.  If @var{readability} is
+non-@code{nil}, this behaves the same as the string form; otherwise,
+URLs matching @var{regexp} will never be displayed in readable mode by
+default.  For example, you can use this to make all pages default to
+readable mode, except for a few outliers:
+
+@example
+(setq eww-readable-urls '(("https://example\\.com/" . nil)
+                          ".*"))
+@end example
+
 @findex eww-toggle-fonts
 @vindex shr-use-fonts
 @kindex F
diff --git a/etc/NEWS b/etc/NEWS
index dd4c1ea2fac..3704888dd9f 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1061,6 +1061,12 @@ only the readable parts of a page or the full page.  With a positive
 prefix argument, it always displays the readable parts, and with a zero
 or negative prefix, it always displays the full page.
 
++++
+*** New option 'eww-readable-urls'.
+This is a list of regular expressions matching the URLs where EWW should
+display only the readable parts by default.  For more details, see
+"(eww) Basics" in the EWW manual.
+
 ---
 *** New option 'eww-readable-adds-to-history'.
 When non-nil (the default), calling 'eww-readable' adds a new entry to
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index 54b65d35164..a04bae7b931 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -275,6 +275,20 @@ eww-url-transformers
   :type '(repeat function)
   :version "29.1")
 
+(defcustom eww-readable-urls nil
+  "A list of regexps matching URLs to display in readable mode by default.
+Each element can be one of the following forms: a regular expression in
+string form or a cons cell of the form (REGEXP . READABILITY).  If
+READABILITY is non-nil, this behaves the same as the string form;
+otherwise, URLs matching REGEXP will never be displayed in readable mode
+by default."
+  :type '(repeat (choice (string :tag "Readable URL")
+                         (cons :tag "URL and Readability"
+                               (string :tag "URL")
+                               (radio (const :tag "Readable" t)
+                                      (const :tag "Non-readable" nil)))))
+  :version "30.1")
+
 (defcustom eww-readable-adds-to-history t
   "If non-nil, calling `eww-readable' adds a new entry to the history."
   :type 'boolean
@@ -809,11 +823,15 @@ eww-display-html
   (let ((source (buffer-substring (point) (point-max))))
     (with-current-buffer buffer
       (plist-put eww-data :source source)))
-  (eww-display-document
-   (or document
-       (eww-document-base
-        url (eww--parse-html-region (point) (point-max) charset)))
-   point buffer))
+  (unless document
+    (let ((dom (eww--parse-html-region (point) (point-max) charset)))
+      (when (eww-default-readable-p url)
+        (eww-score-readability dom)
+        (setq dom (eww-highest-readability dom))
+        (with-current-buffer buffer
+          (plist-put eww-data :readable t)))
+      (setq document (eww-document-base url dom))))
+  (eww-display-document document point buffer))
 
 (defun eww-handle-link (dom)
   (let* ((rel (dom-attr dom 'rel))
@@ -1159,6 +1177,19 @@ eww-highest-readability
 	  (setq result highest))))
     result))
 
+(defun eww-default-readable-p (url)
+  "Return non-nil if URL should be displayed in readable mode by default.
+This consults the entries in `eww-readable-urls' (which see)."
+  (catch 'found
+    (let (result)
+      (dolist (regexp eww-readable-urls)
+        (if (consp regexp)
+            (setq result (cdr regexp)
+                  regexp (car regexp))
+          (setq result t))
+        (when (string-match regexp url)
+          (throw 'found result))))))
+
 (defvar-keymap eww-mode-map
   "g" #'eww-reload             ;FIXME: revert-buffer-function instead!
   "G" #'eww
diff --git a/test/lisp/net/eww-tests.el b/test/lisp/net/eww-tests.el
index a09e0a4f279..b83435e0bd9 100644
--- a/test/lisp/net/eww-tests.el
+++ b/test/lisp/net/eww-tests.el
@@ -231,5 +231,17 @@ eww-test/readable/toggle-display
                "This is an uninteresting sentence."
                (buffer-substring-no-properties (point-min) (point-max)))))))
 
+(ert-deftest eww-test/readable/default-readable ()
+  "Test that EWW displays readable parts of pages by default when applicable."
+    (eww-test--with-mock-retrieve
+    (let* ((eww-test--response-function
+            (lambda (_url)
+              (concat "Content-Type: text/html\n\n"
+                      "<html><body>Hello there</body></html>")))
+           (eww-readable-urls '("://example\\.invalid/")))
+      (eww "example.invalid")
+      ;; Make sure EWW uses "readable" mode.
+      (should (plist-get eww-data :readable)))))
+
 (provide 'eww-tests)
 ;; eww-tests.el ends here
-- 
2.25.1