master 4b0f5cdb01f 2/2: Add 'eww-readable-urls'

[Jim Porter]

branch: master
commit 4b0f5cdb01fbd05c8184a89fa8543eb5600fb4f8
Author: Jim Porter <jporterbugs@gmail.com>
Commit: Jim Porter <jporterbugs@gmail.com>

    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 (bug#68254).
---
 doc/misc/eww.texi          | 16 ++++++++++++++++
 etc/NEWS                   |  6 ++++++
 lisp/net/eww.el            | 43 ++++++++++++++++++++++++++++++++++++++-----
 test/lisp/net/eww-tests.el | 12 ++++++++++++
 4 files changed, 72 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 @@ 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.
 
+@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 30eaaf40385..c6b654a9d3b 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1073,6 +1073,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..39ea964d47a 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -275,6 +275,22 @@ parameter, and should return the (possibly) transformed 
URL."
   :type '(repeat function)
   :version "29.1")
 
+(defcustom eww-readable-urls nil
+  "A list of regexps matching URLs to display in readable mode by default.
+EWW will display matching URLs using `eww-readable' (which see).
+
+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 +825,15 @@ This replaces the region with the preprocessed 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 +1179,19 @@ adds a new entry to `eww-history'."
          (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 @@ This sets `eww-before-browse-history-function' to
                "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