mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-28 07:45:00 +00:00
Code Issues Releases Activity

Propertize all shr fragment IDs as shr-target-id

Browse Source 
* lisp/net/shr.el (shr-target-id): Add docstring.
(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.
This commit is contained in:
Basil L. Contovounesios 2020-05-08 00:25:38 +01:00
parent 453d30d92c
commit 3dd6b23cdf
2 changed files with 23 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
lisp/net/eww.el
View File

@ -25,13 +25,14 @@
;;; Code:
(require 'cl-lib)
(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))
(defgroup eww nil
"Emacs Web Wowser"
@ -542,10 +543,10 @@ Currently this means either text/html or application/xhtml+xml."
(goto-char point))
(shr-target-id
(goto-char (point-min))
(let ((point (next-single-property-change
(point-min) 'shr-target-id)))
(when point
(goto-char point))))
(let ((match (text-property-search-forward
'shr-target-id shr-target-id t)))
(when match
(goto-char (prop-match-beginning match)))))
(t
(goto-char (point-min))
;; Don't leave point inside forms, because the normal eww

25
lisp/net/shr.el
View File

@ -185,13 +185,15 @@ and other things:
(defvar shr-depth 0)
(defvar shr-warning nil)
(defvar shr-ignore-cache nil)
(defvar shr-target-id nil)
(defvar shr-table-separator-length 1)
(defvar shr-table-separator-pixel-width 0)
(defvar shr-table-id nil)
(defvar shr-current-font nil)
(defvar shr-internal-bullet nil)
(defvar shr-target-id nil
"Target fragment identifier anchor.")
(defvar shr-map
(let ((map (make-sparse-keymap)))
(define-key map "a" 'shr-show-alt-text)
@ -526,13 +528,13 @@ size, and full-buffer size."
(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
@ -1486,14 +1488,13 @@ ones, in case fg and bg are nil."
(start (point))
shr-start)
(shr-generic dom)
(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 (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))
(shr-ensure-newline)
(insert " "))
(put-text-property start (1+ start) 'shr-target-id shr-target-id))
(insert ?\s)
(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))))