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

[Basil L. Contovounesios]

Lars Ingebrigtsen <larsi@gnus.org> writes:

> The patch is a bit hard to read, because it seems to have a lot of
> unrelated changes like:
>
>> -(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))

This is just adding (require 'text-property-search) and removing a stale
comment.  The only unrelated change is the lexicographic reordering.

> and
>
>> -    (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.

This is not an unrelated change; I'm changing the condition from:

  (and shr-target-id
       (equal (dom-attr dom 'name) shr-target-id))

to:

  (or (dom-attr dom 'id)
      (dom-attr dom 'name))

and storing the result of the condition for later reuse.  The key thing
to note is that the 'name' attribute is obsolete in HTML5 and the 'id'
attribute is recommended instead, which is why I'm checking both.

Though, now that I think about it again, we could avoid checking the
'id' attribute in both shr-tag-a and shr-descend by instead writing:

  (when-let* ((id (unless (dom-attr dom 'id) ; Handled by `shr-descend'.
                    (dom-attr dom 'name))))  ; Obsolete since HTML5.

> and
>
>> -        (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))
>
> so I can't really make out what the changes you're making in this area is...

Sorry, I didn't imagine a patch touching 20-odd lines would be
problematic.  Here's the updated patch in as minimal a form as possible:

>From 8cced1ac250078f2ea1cf1b82538c98621f7ca2f Mon Sep 17 00:00:00 2001
From: "Basil L. Contovounesios" <contovob@tcd.ie>
Date: Thu, 21 May 2020 23:18:33 +0100
Subject: [PATCH] Propertize all shr fragment IDs as shr-target-id

* lisp/net/shr.el (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 |  7 ++++---
 lisp/net/shr.el | 18 +++++++++---------
 2 files changed, 13 insertions(+), 12 deletions(-)

diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index a6c1abdbb1..b5780a6685 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -27,6 +27,7 @@
 (require 'cl-lib)
 (require 'format-spec)
 (require 'shr)
+(require 'text-property-search)
 (require 'url)
 (require 'url-queue)
 (require 'thingatpt)
@@ -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)))
+         (let ((point (text-property-search-forward
+                       'shr-target-id shr-target-id t)))
            (when point
-             (goto-char point))))
+             (goto-char (prop-match-beginning point)))))
         (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..55c0c1d8ad 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -531,13 +531,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 +1497,14 @@ shr-tag-a
        (start (point))
        shr-start)
     (shr-generic dom)
-    (when (and shr-target-id
-              (equal (dom-attr dom 'name) shr-target-id))
+    (when-let* ((id (unless (dom-attr dom 'id) ; Handled by `shr-descend'.
+                      (dom-attr dom 'name))))  ; Obsolete since HTML5.
       ;; We have a zero-length <a name="foo"> 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 " ")
+       (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

WDYT?  Thanks,

-- 
Basil