Show "readable" status in the EWW mode line

* lisp/net/eww.el (eww-display-html): Check whether a readable form of
the document exists; if not, don't set ':readable' to t.
(eww-readable): Check whether a readable form of the document exists; if
not, warn the user and don't add to history.
(eww-readable-dom): Return nil if no readable form exists.
(eww-mode): Check the ':readable' property of 'eww-data' to show
"readable" state in the mode line.

* test/lisp/net/eww-tests.el
(eww-test/readable/default-readable/non-readable-page): New test
(bug#78958).
This commit is contained in:
Jim Porter 2025-07-04 16:23:45 -07:00
parent b93d49a378
commit d3c75a3d2d
2 changed files with 38 additions and 18 deletions

View file

@ -862,8 +862,9 @@ This replaces the region with the preprocessed HTML."
(plist-put eww-data :source source)))
(unless document
(let ((dom (eww--parse-html-region (point) (point-max) charset)))
(when (eww-default-readable-p url)
(setq dom (eww-readable-dom dom))
(when-let* (((eww-default-readable-p url))
(readable-dom (eww-readable-dom dom)))
(setq dom readable-dom)
(with-current-buffer buffer
(plist-put eww-data :readable t)))
(setq document (eww-document-base url dom))))
@ -1162,15 +1163,17 @@ adds a new entry to `eww-history'."
(eww--parse-html-region (point-min) (point-max))))
(base (plist-get eww-data :url)))
(when make-readable
(setq dom (eww-readable-dom dom)))
(when eww-readable-adds-to-history
(eww-save-history)
(eww--before-browse)
(dolist (elem '(:source :url :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)))
(unless (setq dom (eww-readable-dom dom))
(message "Unable to find readable content")))
(when dom
(when eww-readable-adds-to-history
(eww-save-history)
(eww--before-browse)
(dolist (elem '(:source :url :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--walk-readability (node callback &optional noscore)
"Walk through all children of NODE to score readability.
@ -1205,7 +1208,8 @@ non-nil, don't actually compute a score; just call the callback."
score))
(defun eww-readable-dom (dom)
"Return a readable version of DOM."
"Return a readable version of DOM.
If EWW can't create a readable version, return nil instead."
(let ((head-nodes nil)
(best-node nil)
(best-score most-negative-fixnum))
@ -1237,11 +1241,10 @@ non-nil, don't actually compute a score; just call the callback."
,@(when (length> inner-text 0)
(list inner-text)))))
(push new-node head-nodes))))))
(if (and best-node (not (eq best-node dom)))
`(html nil
(head nil ,@head-nodes)
(body nil ,best-node))
dom)))
(when (and best-node (not (eq best-node dom)))
`(html nil
(head nil ,@head-nodes)
(body nil ,best-node)))))
(defun eww-score-readability (node)
(declare (obsolete 'eww--walk-readability "31.1"))
@ -1409,7 +1412,11 @@ within text input fields."
;; Autoload cookie needed by desktop.el.
;;;###autoload
(define-derived-mode eww-mode special-mode "eww"
(define-derived-mode eww-mode special-mode
`("eww"
(:eval (when (plist-get eww-data :readable)
'(:propertize ":readable"
help-echo "Displaying readable content"))))
"Mode for browsing the web."
:interactive nil
(setq-local eww-data (list :title ""))

View file

@ -260,5 +260,18 @@ This sets `eww-before-browse-history-function' to
(should (length= base-tags 1))
(should (equal (dom-attr (car base-tags) 'href) "/foo/"))))))
(ert-deftest eww-test/readable/default-readable/non-readable-page ()
"Test that EWW handles readable-by-default correctly for non-readable pages."
(skip-unless (libxml-available-p))
(eww-test--with-mock-retrieve
(let* ((eww-test--response-function
(lambda (_url)
(concat "Content-Type: text/html\n\n"
"<html><body><h1>Hello</h1></body></html>")))
(eww-readable-urls '("://example\\.invalid/")))
(eww "example.invalid")
;; Make sure EWW doesn't use "readable" mode here.
(should-not (plist-get eww-data :readable)))))
(provide 'eww-tests)
;; eww-tests.el ends here