summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLars Ingebrigtsen <larsi@gnus.org>2021-12-19 13:44:21 +0100
committerLars Ingebrigtsen <larsi@gnus.org>2021-12-19 13:44:21 +0100
commit7904cae492062ac70ae1539be5b21c5274dcdf46 (patch)
tree9fa5bdd4fe71a12fe8e9380543db46aa0c871e67
parentae289486d039a443f74420f091a674a19ec9f378 (diff)
downloademacs-7904cae492062ac70ae1539be5b21c5274dcdf46.tar.gz
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).
-rw-r--r--lisp/net/eww.el2
-rw-r--r--lisp/net/shr.el55
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))