master 7904cae 2/2: Rework how shr sets <span id='foo'> targets to make it more reliable

[Lars Ingebrigtsen]

branch: master
commit 7904cae492062ac70ae1539be5b21c5274dcdf46
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    Rework how shr sets <span id='foo'> targets to make it more reliable
    
    * lisp/net/eww.el (eww-display-html): The target is now a list.
    * lisp/net/shr.el (shr--link-targets): New variable.
    (shr-insert-document): Set the targets.
    (shr-descend): Save targets and apply them later.
    (shr-ensure-paragraph): Remove hack to avoid filling from removing
    targets.
    (shr-tag-a): Save targets for later.
    (shr-render-td-1): Bind and set targets (bug#52512).
---
 lisp/net/eww.el |  2 +-
 lisp/net/shr.el | 55 ++++++++++++++++++++++---------------------------------
 2 files changed, 23 insertions(+), 34 deletions(-)

diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index 0c66cf3..8930eb4 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -710,7 +710,7 @@ The renaming scheme is performed in accordance with
         (shr-target-id
          (goto-char (point-min))
           (let ((match (text-property-search-forward
-                        'shr-target-id shr-target-id t)))
+                        'shr-target-id shr-target-id #'member)))
             (when match
               (goto-char (prop-match-beginning match)))))
         (t
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index c18d69b..44fb5ec 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -262,6 +262,7 @@ and other things:
 
 (defvar shr-target-id nil
   "Target fragment identifier anchor.")
+(defvar shr--link-targets nil)
 
 (defvar-keymap shr-map
   "a" #'shr-show-alt-text
@@ -354,6 +355,7 @@ DOM should be a parse tree as generated by
               (* shr-width (frame-char-width)))
            (shr--window-width)))
         (max-specpdl-size max-specpdl-size)
+        (shr--link-targets nil)
         ;; `bidi-display-reordering' is supposed to be only used for
         ;; debugging purposes, but Shr's naïve filling algorithm
         ;; cannot cope with the complexity of RTL text in an LTR
@@ -377,9 +379,22 @@ DOM should be a parse tree as generated by
     (shr-descend dom)
     (shr-fill-lines start (point))
     (shr--remove-blank-lines-at-the-end start (point))
+    (shr--set-target-ids shr--link-targets)
     (when shr-warning
       (message "%s" shr-warning))))
 
+(defun shr--set-target-ids (ids)
+  ;; If the buffer is empty, there's no point in setting targets.
+  (unless (zerop (buffer-size))
+    ;; We may have several targets in the same place (if you have
+    ;; several <span id='foo'> things after one another).  So group
+    ;; them by position.
+    (dolist (group (seq-group-by #'cdr ids))
+      (let ((point (min (1- (point-max)) (car group))))
+        (put-text-property point (1+ point)
+                           'shr-target-id
+                           (mapcar #'car (cdr group)))))))
+
 (defun shr--remove-blank-lines-at-the-end (start end)
   (save-restriction
     (save-excursion
@@ -614,16 +629,8 @@ size, and full-buffer size."
                (funcall function dom))
               (t
                (shr-generic dom)))
-        (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))
-            (if (not (bolp))
-                (insert ? )
-              (insert ? )
-              (shr-mark-fill start))
-            (put-text-property (1- (point)) (point) 'display ""))
-          (put-text-property (1- (point)) (point) 'shr-target-id id))
+        (when-let ((id (dom-attr dom 'id)))
+          (push (cons id (point)) shr--link-targets))
        ;; If style is set, then this node has set the color.
        (when style
          (shr-colorize-region
@@ -893,22 +900,6 @@ size, and full-buffer size."
               (looking-at " *$")))
        ;; We're already at a new paragraph; do nothing.
        )
-       ((and (not (bolp))
-             (save-excursion
-               (beginning-of-line)
-               (looking-at " *$"))
-            (save-excursion
-              (forward-line -1)
-              (looking-at " *$"))
-             ;; Check all chars on the current line and see whether
-             ;; they're all placeholders.
-             (cl-loop for pos from (line-beginning-position) upto (1- (point))
-                      unless (get-text-property pos 'shr-target-id)
-                      return nil
-                      finally return t))
-       ;; We have some invisible markers from <div id="foo"></div>;
-       ;; do nothing.
-       )
        ((and prefix
             (= prefix (- (point) (line-beginning-position))))
        ;; Do nothing; we're at the start of a <li>.
@@ -1472,13 +1463,9 @@ ones, in case fg and bg are nil."
        (start (point))
        shr-start)
     (shr-generic dom)
-    (when-let* ((id (unless (dom-attr dom 'id) ; Handled by `shr-descend'.
-                      (dom-attr dom 'name))))  ; Obsolete since HTML5.
-      ;; We have an empty element, so just insert... something.
-      (when (= start (point))
-        (insert ?\s)
-        (put-text-property (1- (point)) (point) 'display ""))
-      (put-text-property start (1+ start) 'shr-target-id id))
+    (when-let* ((id (and (not (dom-attr dom 'id)) ; Handled by `shr-descend'.
+                         (dom-attr dom 'name)))) ; Obsolete since HTML5.
+      (push (cons id (point)) shr--link-targets))
     (when url
       (shr-urlify (or shr-start start) (shr-expand-url url) title))))
 
@@ -2470,6 +2457,7 @@ flags that control whether to collect or render objects."
          (style (dom-attr dom 'style))
          (shr-stylesheet shr-stylesheet)
          (max-width 0)
+          (shr--link-targets nil)
          natural-width)
       (when style
        (setq style (and (string-search "color" style)
@@ -2511,6 +2499,7 @@ flags that control whether to collect or render objects."
         (end-of-line)
         (point)))
       (goto-char (point-min))
+      (shr--set-target-ids shr--link-targets)
       (list max-width
            natural-width
            (count-lines (point-min) (point-max))