bug#69232: 30.0.50; [PATCH] EWW history navigation gets caught in a loop

[Jim Porter <jporterbugs@gmail.com>]

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

On 2/29/2024 5:00 PM, Jim Porter wrote:
> I already found one issue with reloading messing up history, but that 
> was an easy fix. Once I finish up the other parts of my v3 patch, I'll 
> post it here.

I've only lightly tested this so far, but this version adds an 
'eww-before-browse-function' option which lets you customize how EWW 
manipulates history before browsing to a new page. I've added functions 
for the default behavior ('eww-clear-future-history'), and for cloning 
all the "parent" entries ('eww-clone-previous-history')[1]. You can also 
set it to 'ignore', which will just preserve the old entries and add the 
new page to the end (which is the behavior v1 of my patch had).

I've also added more regression tests to make sure this all works as 
expected.

How does this look?

[1] See the docstring for a longer explanation of how this works.

[-- Attachment #2: 0001-When-navigating-through-history-in-EWW-don-t-keep-ad.patch --]
[-- Type: text/plain, Size: 16668 bytes --]

From 6391bcf13fe0a26aba67ef3e77a51ec7b9ca6cc1 Mon Sep 17 00:00:00 2001
From: Jim Porter <jporterbugs@gmail.com>
Date: Sat, 17 Feb 2024 20:49:15 -0800
Subject: [PATCH] When navigating through history in EWW, don't keep adding to
 'eww-history'

This resolves an issue where navigating back and then forward kept
adding new history entries so you could never hit the "end" (bug#69232).

* lisp/net/eww.el (eww-before-browse-function): New option.
(eww-history-position): Add docstring.
(eww-mode-map, eww-context-menu): Use correct predicates for when to
enable back/forward.
(eww-save-history): Save history entry in its original place when
viewing a historical page.
(eww--before-browse): New function...
(eww, eww-follow-link, eww-readable): ... call it.
(eww-render): Don't set 'eww-history-position' here...
(eww--before-browse): ... instead, set it here.
(eww-back-url): Set 'eww-history-position' based on the result of
'eww-save-history'.
(eww-forward-url): Set 'eww-history-position' directly, since
'eww-save-history' no longer adds a new entry in this case.
(eww-clear-future-history, eww-clone-previous-history): New functions.

* test/lisp/net/eww-tests.el: New file.

* etc/NEWS: Announce this change.
---
 etc/NEWS                   |  12 +++
 lisp/net/eww.el            |  84 ++++++++++++++---
 test/lisp/net/eww-tests.el | 179 +++++++++++++++++++++++++++++++++++++
 3 files changed, 263 insertions(+), 12 deletions(-)
 create mode 100644 test/lisp/net/eww-tests.el

diff --git a/etc/NEWS b/etc/NEWS
index 6d444daf152..62f360bc112 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1004,6 +1004,18 @@ When invoked with the prefix argument ('C-u'),
 This is useful for continuing reading the URL in the current buffer
 when the new URL is fetched.
 
+---
+*** History navigation in EWW now works like other browsers.
+Previously, when navigating back and forward through page history, EWW
+would add a duplicate entry to the end of the history list each time.
+This made it impossible to navigate to the "end" of the history list.
+Now, navigating through history in EWW simply changes your position in
+the history list, allowing you to reach the end as expected.  In
+addition, when navigating to a new page from a historical one, EWW
+deletes the history entries after the current page.  To change the
+behavior when navigating from historical pages, you can customize
+'eww-before-browse-function'.
+
 ** go-ts-mode
 
 +++
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index 5a25eef9e3c..8c82f92af2a 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -182,6 +182,14 @@ eww-browse-url-new-window-is-tab
                  (const :tag "Open new tab when tab bar is enabled" tab-bar)
                  (const :tag "Never open URL in new tab" nil)))
 
+(defcustom eww-before-browse-function #'eww-clear-future-history
+  "A function to call before browsing to a new page.
+By default, this removes any entries in the history that come after the
+current page (see `eww-clear-future-history')."
+  :version "30.1"
+  :group 'eww
+  :type 'function)
+
 (defcustom eww-after-render-hook nil
   "A hook called after eww has finished rendering the buffer."
   :version "25.1"
@@ -312,7 +320,10 @@ eww-valid-certificate
 
 (defvar eww-data nil)
 (defvar eww-history nil)
-(defvar eww-history-position 0)
+(defvar eww-history-position 0
+  "The 1-indexed position in `eww-history'.
+If zero, EWW is at the newest page, which isn't yet present in
+`eww-history'.")
 (defvar eww-prompt-history nil)
 
 (defvar eww-local-regex "localhost"
@@ -402,6 +413,7 @@ eww
     (t
      (get-buffer-create "*eww*"))))
   (eww-setup-buffer)
+  (eww--before-browse)
   ;; Check whether the domain only uses "Highly Restricted" Unicode
   ;; IDNA characters.  If not, transform to punycode to indicate that
   ;; there may be funny business going on.
@@ -654,7 +666,6 @@ eww-render
 	    (with-current-buffer buffer
 	      (plist-put eww-data :url url)
 	      (eww--after-page-change)
-	      (setq eww-history-position 0)
 	      (and last-coding-system-used
 		   (set-buffer-file-coding-system last-coding-system-used))
               (unless shr-fill-text
@@ -905,6 +916,11 @@ eww-update-header-line-format
 		 `((?u . ,(or url ""))
 		   (?t . ,title))))))))
 
+(defun eww--before-browse ()
+  (funcall eww-before-browse-function)
+  (setq eww-history-position 0
+        eww-data (list :title "")))
+
 (defun eww--after-page-change ()
   (eww-update-header-line-format)
   (eww--rename-buffer))
@@ -1037,6 +1053,7 @@ eww-readable
          (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))
@@ -1129,9 +1146,9 @@ eww-mode-map
           ["Reload" eww-reload t]
           ["Follow URL in new buffer" eww-open-in-new-buffer]
           ["Back to previous page" eww-back-url
-           :active (not (zerop (length eww-history)))]
+           :active (< eww-history-position (length eww-history))]
           ["Forward to next page" eww-forward-url
-           :active (not (zerop eww-history-position))]
+           :active (> eww-history-position 1)]
           ["Browse with external browser" eww-browse-with-external-browser t]
           ["Download" eww-download t]
           ["View page source" eww-view-source]
@@ -1155,9 +1172,9 @@ eww-context-menu
     (easy-menu-define nil easy-menu nil
       '("Eww"
         ["Back to previous page" eww-back-url
-	 :visible (not (zerop (length eww-history)))]
+	 :active (< eww-history-position (length eww-history))]
 	["Forward to next page" eww-forward-url
-	 :visible (not (zerop eww-history-position))]
+	 :active (> eww-history-position 1)]
 	["Reload" eww-reload t]))
     (dolist (item (reverse (lookup-key easy-menu [menu-bar eww])))
       (when (consp item)
@@ -1280,16 +1297,20 @@ eww-back-url
   (interactive nil eww-mode)
   (when (>= eww-history-position (length eww-history))
     (user-error "No previous page"))
-  (eww-save-history)
-  (setq eww-history-position (+ eww-history-position 2))
+  (if (eww-save-history)
+      ;; We were at the latest page (which was just added to the
+      ;; history), so go back two entries.
+      (setq eww-history-position 2)
+    (setq eww-history-position (1+ eww-history-position)))
   (eww-restore-history (elt eww-history (1- eww-history-position))))
 
 (defun eww-forward-url ()
   "Go to the next displayed page."
   (interactive nil eww-mode)
-  (when (zerop eww-history-position)
+  (when (<= eww-history-position 1)
     (user-error "No next page"))
   (eww-save-history)
+  (setq eww-history-position (1- eww-history-position))
   (eww-restore-history (elt eww-history (1- eww-history-position))))
 
 (defun eww-restore-history (elem)
@@ -1959,6 +1980,7 @@ eww-follow-link
 	   (eww-same-page-p url (plist-get eww-data :url)))
       (let ((point (point)))
 	(eww-save-history)
+        (eww--before-browse)
 	(plist-put eww-data :url url)
         (goto-char (point-min))
         (if-let ((match (text-property-search-forward 'shr-target-id target #'member)))
@@ -2289,11 +2311,49 @@ eww-bookmark-mode
 ;;; History code
 
 (defun eww-save-history ()
+  "Save the current page's data to the history.
+If the current page is a historial one loaded from
+`eww-history' (e.g. by calling `eww-back-url'), this will update the
+page's entry in `eww-history' and return nil.  Otherwise, add a new
+entry to `eww-history' and return t."
   (plist-put eww-data :point (point))
   (plist-put eww-data :text (buffer-string))
-  (let ((history-delete-duplicates nil))
-    (add-to-history 'eww-history eww-data eww-history-limit t))
-  (setq eww-data (list :title "")))
+  (if (zerop eww-history-position)
+      (let ((history-delete-duplicates nil))
+        (add-to-history 'eww-history eww-data eww-history-limit t)
+        (setq eww-history-position 1)
+        t)
+    (setf (elt eww-history (1- eww-history-position)) eww-data)
+    nil))
+
+(defun eww-clear-future-history ()
+  "Remove any entries in `eww-history' after the currently-shown one.
+This is useful for `eww-before-browse-function' to make EWW's navigation
+to a new page from a historical one work like other web browsers: it
+will clear any \"future\" history elements before adding the new page to
+the end of the history."
+  (when (> eww-history-position 1)
+    (setq eww-history (nthcdr (1- eww-history-position) eww-history))))
+
+(defun eww-clone-previous-history ()
+  "Clone and prepend entries in `eww-history' up to the currently-shown one.
+These cloned entries get added to the beginning of `eww-history' so that
+it's possible to navigate back to the very first page for this EWW
+without deleting any history entries.
+
+For example, if `eww-history' looks like this (going from oldest to
+newest, with \"*\" marking the current page):
+
+  A B C* D E
+
+then calling this function updates `eww-history' to:
+
+  A B C D E A B C*
+
+This is useful for setting `eww-before-browse-function' (which see)."
+  (when (> eww-history-position 1)
+    (setq eww-history (append (nthcdr (1- eww-history-position) eww-history)
+                              eww-history))))
 
 (defvar eww-current-buffer)
 
diff --git a/test/lisp/net/eww-tests.el b/test/lisp/net/eww-tests.el
new file mode 100644
index 00000000000..8e056521fc7
--- /dev/null
+++ b/test/lisp/net/eww-tests.el
@@ -0,0 +1,179 @@
+;;; eww-tests.el --- tests for eww.el  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2024 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'eww)
+
+(defvar eww-test--response-function (lambda (url) (concat "\n" url))
+  "A function for returning a mock response for URL.
+The default just returns an empty list of headers URL as the body.")
+
+(defmacro eww-test--with-mock-retrieve (&rest body)
+  "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))
+    `(cl-letf (((symbol-function 'eww-retrieve)
+                (lambda (url callback args)
+                  (with-temp-buffer
+                    (insert (funcall eww-test--response-function url))
+                    (apply callback nil args)))))
+       (with-temp-buffer
+         (eww-mode)
+         ,@body)))
+
+(defun eww-test--history-urls ()
+  (mapcar (lambda (elem) (plist-get elem :url)) eww-history))
+
+;;; Tests:
+
+(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
+    (eww "one.invalid")
+    (eww "two.invalid")
+    (should (equal (eww-test--history-urls)
+                   '("http://one.invalid/")))
+    (eww "three.invalid")
+    (should (equal (eww-test--history-urls)
+                   '("http://two.invalid/"
+                     "http://one.invalid/")))))
+
+(ert-deftest eww-test/history/back-forward ()
+  "Test that navigating through history just changes our history position.
+See bug#69232."
+  (eww-test--with-mock-retrieve
+    (eww "one.invalid")
+    (eww "two.invalid")
+    (eww "three.invalid")
+    (let ((url-history '("http://three.invalid/"
+                         "http://two.invalid/"
+                         "http://one.invalid/")))
+      ;; Go back one page.  This should add "three.invalid" to the
+      ;; history, making our position in the list 2.
+      (eww-back-url)
+      (should (equal (eww-test--history-urls) url-history))
+      (should (= eww-history-position 2))
+      ;; Go back again.
+      (eww-back-url)
+      (should (equal (eww-test--history-urls) url-history))
+      (should (= eww-history-position 3))
+      ;; At the beginning of the history, so trying to go back should
+      ;; signal an error.
+      (should-error (eww-back-url))
+      ;; Go forward once.
+      (eww-forward-url)
+      (should (equal (eww-test--history-urls) url-history))
+      (should (= eww-history-position 2))
+      ;; Go forward again.
+      (eww-forward-url)
+      (should (equal (eww-test--history-urls) url-history))
+      (should (= eww-history-position 1))
+      ;; At the end of the history, so trying to go forward should
+      ;; signal an error.
+      (should-error (eww-forward-url)))))
+
+(ert-deftest eww-test/history/reload-in-place ()
+  "Test that reloading historical pages updates their history entry in-place.
+See bug#69232."
+  (eww-test--with-mock-retrieve
+    (eww "one.invalid")
+    (eww "two.invalid")
+    (eww "three.invalid")
+    (eww-back-url)
+    ;; Make sure our history has the original page text.
+    (should (equal (plist-get (nth 1 eww-history) :text)
+                   "http://two.invalid/"))
+    (should (= eww-history-position 2))
+    ;; Reload the page.
+    (let ((eww-test--response-function
+           (lambda (url) (concat "\nreloaded " url))))
+      (eww-reload)
+      (should (= eww-history-position 2)))
+    ;; Go to another page, and make sure the history is correct,
+    ;; including the reloaded page text.
+    (eww "four.invalid")
+    (should (equal (eww-test--history-urls) '("http://two.invalid/"
+                                              "http://one.invalid/")))
+    (should (equal (plist-get (nth 0 eww-history) :text)
+                   "reloaded http://two.invalid/"))
+    (should (= eww-history-position 0))))
+
+(ert-deftest eww-test/history/before-navigate/clear-future-history ()
+  "Test that going to a new page from a historical one clears future history.
+See bug#69232."
+  (eww-test--with-mock-retrieve
+    (eww "one.invalid")
+    (eww "two.invalid")
+    (eww "three.invalid")
+    (eww-back-url)
+    (eww "four.invalid")
+    (eww "five.invalid")
+    (should (equal (eww-test--history-urls) '("http://four.invalid/"
+                                              "http://two.invalid/"
+                                              "http://one.invalid/")))
+    (should (= eww-history-position 0))))
+
+(ert-deftest eww-test/history/before-navigate/ignore-history ()
+  "Test that going to a new page from a historical one preserves history.
+This sets `eww-before-browse-function' to `ignore' to preserve history.
+See bug#69232."
+  (let ((eww-before-browse-function #'ignore))
+    (eww-test--with-mock-retrieve
+      (eww "one.invalid")
+      (eww "two.invalid")
+      (eww "three.invalid")
+      (eww-back-url)
+      (eww "four.invalid")
+      (eww "five.invalid")
+      (should (equal (eww-test--history-urls) '("http://four.invalid/"
+                                                "http://three.invalid/"
+                                                "http://two.invalid/"
+                                                "http://one.invalid/")))
+      (should (= eww-history-position 0)))))
+
+(ert-deftest eww-test/history/before-navigate/clone-previous ()
+  "Test that going to a new page from a historical one clones prior history.
+This sets `eww-before-browse-function' to `eww-clone-previous-history'
+to clone the history.  See bug#69232."
+  (let ((eww-before-browse-function #'eww-clone-previous-history))
+    (eww-test--with-mock-retrieve
+      (eww "one.invalid")
+      (eww "two.invalid")
+      (eww "three.invalid")
+      (eww-back-url)
+      (eww "four.invalid")
+      (eww "five.invalid")
+      (should (equal (eww-test--history-urls)
+                     '(;; New page and cloned history.
+                       "http://four.invalid/"
+                       "http://two.invalid/"
+                       "http://one.invalid/"
+                       ;; Original history.
+                       "http://three.invalid/"
+                       "http://two.invalid/"
+                       "http://one.invalid/")))
+      (should (= eww-history-position 0)))))
+
+(provide 'eww-tests)
+;; eww-tests.el ends here
-- 
2.25.1