bug#40532: 28.0.50; eww/shr: Anchor link does not work

[Basil L. Contovounesios]

"Basil L. Contovounesios" <contovob@tcd.ie> writes:

> Lars Ingebrigtsen <larsi@gnus.org> writes:
>
>> "Basil L. Contovounesios" <contovob@tcd.ie> writes:
>>
>>> Perhaps shr should unconditionally (without requiring shr-target-id to
>>> be bound) mark all possible targets with text properties during
>>> rendering.  I'll see if I can get this or any other way working today or
>>> tomorrow, but either way this won't be fixed in Emacs 27.
>>
>> Hm...  marking all the targets sounds like overkill (if I understand you
>> correctly, but it's likely that I don't).  :-)
>
> Marking all the targets is what I meant, but I was only thinking aloud,
> not seriously suggesting it.  I'm still stepping through eww and shr
> trying to figure out why shr-target-id doesn't work sometimes (my
> current guess is shr modifies the DOM to avoid re-rendering tables, so
> shr-target-id doesn't get set in such cases); progress is slow.  :(

Now that I understand what's happening better, I think it's necessary to
mark all targets, and I don't think it's overkill.

The problem is indeed that shr caches rendered tables.  What this means
is that, if eww first visits a URL with no #target, then its tables will
be rendered and cached with no shr-target-id text property attached to
any fragment identifiers contained within them.

If eww-follow-link is subsequently invoked on a #target within the same
page, then the cached table contents will be inserted and so there will
be no shr-target-id property in the buffer.  The recipe provided in [1]
illustrates this.

[1]: https://debbugs.gnu.org/40532#51

OTOH if the shr-target-id property is always attached to the relevant
'id' and (deprecated) 'name' attributes, then cached table contents will
still be searchable.  This shouldn't be overkill in terms of performance
because yet another text property on a subet of the DOM should be
comparatively cheap, right?

So WDYT of the following fix?  Can you think of any better solutions?

>From ef0058cb4a70b1d78e55f6b61ff0e1e8ffad9169 Mon Sep 17 00:00:00 2001
From: "Basil L. Contovounesios" <contovob@tcd.ie>
Date: Fri, 8 May 2020 00:25:38 +0100
Subject: [PATCH] Propertize all shr fragment IDs as shr-target-id

* lisp/net/shr.el (shr-target-id): Add docstring.
(shr-descend, shr-tag-a): Display dummy anchor characters as the
empty string.  Give all relevant 'id' or 'name' fragment identifier
attributes the shr-target-id text property.  This ensures that
cached content, such as tables, retains the property across
renders.  (Bug#40532)

* lisp/net/eww.el (eww-display-html): Adapt shr-target-id property
search accordingly.
---
 lisp/net/eww.el | 19 ++++++++++---------
 lisp/net/shr.el | 26 ++++++++++++++------------
 2 files changed, 24 insertions(+), 21 deletions(-)

diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index a6c1abdbb1..acb7cc7e40 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -26,13 +26,14 @@
 
 (require 'cl-lib)
 (require 'format-spec)
-(require 'shr)
-(require 'url)
-(require 'url-queue)
-(require 'thingatpt)
 (require 'mm-url)
 (require 'puny)
-(eval-when-compile (require 'subr-x)) ;; for string-trim
+(require 'shr)
+(require 'text-property-search)
+(require 'thingatpt)
+(require 'url)
+(require 'url-queue)
+(eval-when-compile (require 'subr-x))
 
 (defgroup eww nil
   "Emacs Web Wowser"
@@ -543,10 +544,10 @@ eww-display-html
          (goto-char point))
         (shr-target-id
          (goto-char (point-min))
-         (let ((point (next-single-property-change
-                       (point-min) 'shr-target-id)))
-           (when point
-             (goto-char point))))
+          (let ((match (text-property-search-forward
+                        'shr-target-id shr-target-id t)))
+            (when match
+              (goto-char (prop-match-beginning match)))))
         (t
          (goto-char (point-min))
          ;; Don't leave point inside forms, because the normal eww
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 1f80ab74db..ea174e5d77 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -185,13 +185,15 @@ shr-base
 (defvar shr-depth 0)
 (defvar shr-warning nil)
 (defvar shr-ignore-cache nil)
-(defvar shr-target-id nil)
 (defvar shr-table-separator-length 1)
 (defvar shr-table-separator-pixel-width 0)
 (defvar shr-table-id nil)
 (defvar shr-current-font nil)
 (defvar shr-internal-bullet nil)
 
+(defvar shr-target-id nil
+  "Target fragment identifier anchor.")
+
 (defvar shr-map
   (let ((map (make-sparse-keymap)))
     (define-key map "a" 'shr-show-alt-text)
@@ -531,13 +533,13 @@ shr-descend
                (funcall function dom))
               (t
                (shr-generic dom)))
-       (when (and shr-target-id
-                  (equal (dom-attr dom 'id) shr-target-id))
+        (when-let* ((id (dom-attr dom 'id)))
          ;; If the element was empty, we don't have anything to put the
          ;; anchor on.  So just insert a dummy character.
          (when (= start (point))
-           (insert "*"))
-         (put-text-property start (1+ start) 'shr-target-id shr-target-id))
+            (insert ?*)
+            (put-text-property (1- (point)) (point) 'display ""))
+          (put-text-property start (1+ start) 'shr-target-id id))
        ;; If style is set, then this node has set the color.
        (when style
          (shr-colorize-region
@@ -1497,14 +1499,14 @@ shr-tag-a
        (start (point))
        shr-start)
     (shr-generic dom)
-    (when (and shr-target-id
-              (equal (dom-attr dom 'name) shr-target-id))
-      ;; We have a zero-length <a name="foo"> element, so just
-      ;; insert...  something.
+    (when-let* ((id (or (dom-attr dom 'id)
+                        ;; Obsolete since HTML5.
+                        (dom-attr dom 'name))))
+      ;; We have an empty element, so just insert... something.
       (when (= start (point))
-       (shr-ensure-newline)
-       (insert " "))
-      (put-text-property start (1+ start) 'shr-target-id shr-target-id))
+        (insert ?\s)
+        (put-text-property (1- (point)) (point) 'display ""))
+      (put-text-property start (1+ start) 'shr-target-id id))
     (when url
       (shr-urlify (or shr-start start) (shr-expand-url url) title))))
 
-- 
2.26.2

Thanks,

-- 
Basil