From 7904cae492062ac70ae1539be5b21c5274dcdf46 Mon Sep 17 00:00:00 2001
From: Lars Ingebrigtsen <larsi@gnus.org>
Date: Sun, 19 Dec 2021 13:44:21 +0100
Subject: 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 0c66cf3a0d7..8930eb427d2 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 c18d69b5926..44fb5ec6e9a 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))
-- 
cgit v1.2.3