andros/emacs-gpu
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Rework how shr sets <span id='foo'> targets to make it more reliable

Browse source 
* 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).
This commit is contained in:
Lars Ingebrigtsen 2021-12-19 13:44:21 +01:00
parent ae289486d0
commit 7904cae492
2 changed files with 23 additions and 34 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
lisp/net/eww.el
View file

@ -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

55
lisp/net/shr.el
View file

@ -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))