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-history-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-delete-future-history, eww-clone-previous-history): New functions. * test/lisp/net/eww-tests.el: New file. * etc/NEWS: Announce this change.
2024-02-17 20:49:15 -08:00 · 2024-02-17 20:49:15 -08:00 · 59e470dd5d
commit 59e470dd5d
parent b12059e4c3
4 changed files with 312 additions and 12 deletions
--- a/doc/misc/eww.texi
+++ b/doc/misc/eww.texi
@ -192,6 +192,15 @@ history press @kbd{H} (@code{eww-list-histories}) to open the history
 buffer @file{*eww history*}.  The history is lost when EWW is quit.
 If you want to remember websites you can use bookmarks.

+@vindex eww-before-browse-history-function
+  By default, when browsing to a new page from a ``historical'' one
+(i.e.@: a page loaded by navigating back via @code{eww-back-url}), EWW
+will first delete any history entries newer than the current page.  This
+is the same behavior as most other web browsers.  You can change this by
+customizing @code{eww-before-browse-history-function} to another value.
+For example, setting it to @code{ignore} will preserve the existing
+history entries and simply prepend the new page to the history list.
+
@vindex eww-history-limit
  Along with the URLs visited, EWW also remembers both the rendered
 page (as it appears in the buffer) and its source.  This can take a
--- a/etc/NEWS
+++ b/etc/NEWS
@ -1018,6 +1018,19 @@ 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 browsing to a new page from a "historical" one (i.e. a
+page loaded by navigating back through history), EWW deletes the history
+entries newer than the current page.  To change the behavior when
+browsing from "historical" pages, you can customize
+'eww-before-browse-history-function'.
+
 ** go-ts-mode

 +++
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@ -182,6 +182,33 @@ the tab bar is enabled."
                 (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-history-function #'eww-delete-future-history
+  "A function to call to update history before browsing to a new page.
+EWW provides the following values for this option:
+
+* `eww-delete-future-history': Delete any history entries after the
+  currently-shown one.  This is the default behavior, and works the same
+  as in most other web browsers.
+
+* `eww-clone-previous-history': Clone and prepend any history entries up
+  to the currently-shown one.  This is like `eww-delete-future-history',
+  except that it preserves the previous contents of the history list at
+  the end.
+
+* `ignore': Preserve the current history unchanged.  This will result in
+  the new page simply being prepended to the existing history list.
+
+You can also set this to any other function you wish."
+  :version "30.1"
+  :group 'eww
+  :type '(choice (function-item :tag "Delete future history"
+                                eww-delete-future-history)
+                 (function-item :tag "Clone previous history"
+                                eww-clone-previous-history)
+                 (function-item :tag "Preserve history"
+                                ignore)
+                 (function :tag "Custom function")))
+
 (defcustom eww-after-render-hook nil
  "A hook called after eww has finished rendering the buffer."
  :version "25.1"
@ -312,7 +339,10 @@ parameter, and should return the (possibly) transformed URL."

 (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 +432,7 @@ For more information, see Info node `(eww) Top'."
    (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 +685,6 @@ The renaming scheme is performed in accordance with
 	    (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 +935,11 @@ The renaming scheme is performed in accordance with
 		 `((?u . ,(or url ""))
 		   (?t . ,title))))))))

+(defun eww--before-browse ()
+  (funcall eww-before-browse-history-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 +1072,7 @@ the like."
         (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 +1165,9 @@ the like."
          ["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 +1191,9 @@ the like."
    (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 +1316,20 @@ instead of `browse-url-new-window-flag'."
  (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 +1999,7 @@ If EXTERNAL is double prefix, browse in new buffer."
 	   (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 +2330,69 @@ If ERROR-OUT, signal user-error if there are no bookmarks."
 ;;; 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-delete-future-history ()
+  "Remove any entries in `eww-history' after the currently-shown one.
+This is useful for `eww-before-browse-history-function' to make EWW's
+navigation to a new page from a historical one work like other web
+browsers: it will delete any \"future\" history elements before adding
+the new page to the end of the history.
+
+For example, if `eww-history' looks like this (going from newest to
+oldest, with \"*\" marking the current page):
+
+  E D C* B A
+
+then calling this function updates `eww-history' to:
+
+  C* B A"
+  (when (> eww-history-position 1)
+    (setq eww-history (nthcdr (1- eww-history-position) eww-history)
+          ;; We don't really need to set this since `eww--before-browse'
+          ;; sets it too, but this ensures that other callers can use
+          ;; this function and get the expected results.
+          eww-history-position 1)))
+
+(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 newest to
+oldest, with \"*\" marking the current page):
+
+  E D C* B A
+
+then calling this function updates `eww-history' to:
+
+  C* B A E D C B A
+
+This is useful for setting `eww-before-browse-history-function' (which
+see)."
+  (when (> eww-history-position 1)
+    (setq eww-history (take eww-history-limit
+                            (append (nthcdr (1- eww-history-position)
+                                            eww-history)
+                                    eww-history))
+          ;; As with `eww-delete-future-history', we don't really need
+          ;; to set this since `eww--before-browse' sets it too, but
+          ;; let's be thorough.
+          eww-history-position 1)))

 (defvar eww-current-buffer)

--- a/test/lisp/net/eww-tests.el
+++ 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/delete-future-history ()
+  "Test that going to a new page from a historical one deletes 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-history-function' to `ignore' to preserve
+history.  See bug#69232."
+  (let ((eww-before-browse-history-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-history-function' to
+`eww-clone-previous-history' to clone the history.  See bug#69232."
+  (let ((eww-before-browse-history-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