aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/net/eww.el17
-rw-r--r--lisp/net/shr.el25
2 files changed, 22 insertions, 20 deletions
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index cf31d37f072..2f6528de948 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -25,13 +25,14 @@
25;;; Code: 25;;; Code:
26 26
27(require 'cl-lib) 27(require 'cl-lib)
28(require 'mm-url)
29(require 'puny)
28(require 'shr) 30(require 'shr)
31(require 'text-property-search)
32(require 'thingatpt)
29(require 'url) 33(require 'url)
30(require 'url-queue) 34(require 'url-queue)
31(require 'thingatpt) 35(eval-when-compile (require 'subr-x))
32(require 'mm-url)
33(require 'puny)
34(eval-when-compile (require 'subr-x)) ;; for string-trim
35 36
36(defgroup eww nil 37(defgroup eww nil
37 "Emacs Web Wowser" 38 "Emacs Web Wowser"
@@ -542,10 +543,10 @@ Currently this means either text/html or application/xhtml+xml."
542 (goto-char point)) 543 (goto-char point))
543 (shr-target-id 544 (shr-target-id
544 (goto-char (point-min)) 545 (goto-char (point-min))
545 (let ((point (next-single-property-change 546 (let ((match (text-property-search-forward
546 (point-min) 'shr-target-id))) 547 'shr-target-id shr-target-id t)))
547 (when point 548 (when match
548 (goto-char point)))) 549 (goto-char (prop-match-beginning match)))))
549 (t 550 (t
550 (goto-char (point-min)) 551 (goto-char (point-min))
551 ;; Don't leave point inside forms, because the normal eww 552 ;; Don't leave point inside forms, because the normal eww
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 03260c9e70a..a3f04968a27 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -185,13 +185,15 @@ and other things:
185(defvar shr-depth 0) 185(defvar shr-depth 0)
186(defvar shr-warning nil) 186(defvar shr-warning nil)
187(defvar shr-ignore-cache nil) 187(defvar shr-ignore-cache nil)
188(defvar shr-target-id nil)
189(defvar shr-table-separator-length 1) 188(defvar shr-table-separator-length 1)
190(defvar shr-table-separator-pixel-width 0) 189(defvar shr-table-separator-pixel-width 0)
191(defvar shr-table-id nil) 190(defvar shr-table-id nil)
192(defvar shr-current-font nil) 191(defvar shr-current-font nil)
193(defvar shr-internal-bullet nil) 192(defvar shr-internal-bullet nil)
194 193
194(defvar shr-target-id nil
195 "Target fragment identifier anchor.")
196
195(defvar shr-map 197(defvar shr-map
196 (let ((map (make-sparse-keymap))) 198 (let ((map (make-sparse-keymap)))
197 (define-key map "a" 'shr-show-alt-text) 199 (define-key map "a" 'shr-show-alt-text)
@@ -526,13 +528,13 @@ size, and full-buffer size."
526 (funcall function dom)) 528 (funcall function dom))
527 (t 529 (t
528 (shr-generic dom))) 530 (shr-generic dom)))
529 (when (and shr-target-id 531 (when-let* ((id (dom-attr dom 'id)))
530 (equal (dom-attr dom 'id) shr-target-id))
531 ;; If the element was empty, we don't have anything to put the 532 ;; If the element was empty, we don't have anything to put the
532 ;; anchor on. So just insert a dummy character. 533 ;; anchor on. So just insert a dummy character.
533 (when (= start (point)) 534 (when (= start (point))
534 (insert "*")) 535 (insert ?*)
535 (put-text-property start (1+ start) 'shr-target-id shr-target-id)) 536 (put-text-property (1- (point)) (point) 'display ""))
537 (put-text-property start (1+ start) 'shr-target-id id))
536 ;; If style is set, then this node has set the color. 538 ;; If style is set, then this node has set the color.
537 (when style 539 (when style
538 (shr-colorize-region 540 (shr-colorize-region
@@ -1486,14 +1488,13 @@ ones, in case fg and bg are nil."
1486 (start (point)) 1488 (start (point))
1487 shr-start) 1489 shr-start)
1488 (shr-generic dom) 1490 (shr-generic dom)
1489 (when (and shr-target-id 1491 (when-let* ((id (unless (dom-attr dom 'id) ; Handled by `shr-descend'.
1490 (equal (dom-attr dom 'name) shr-target-id)) 1492 (dom-attr dom 'name)))) ; Obsolete since HTML5.
1491 ;; We have a zero-length <a name="foo"> element, so just 1493 ;; We have an empty element, so just insert... something.
1492 ;; insert... something.
1493 (when (= start (point)) 1494 (when (= start (point))
1494 (shr-ensure-newline) 1495 (insert ?\s)
1495 (insert " ")) 1496 (put-text-property (1- (point)) (point) 'display ""))
1496 (put-text-property start (1+ start) 'shr-target-id shr-target-id)) 1497 (put-text-property start (1+ start) 'shr-target-id id))
1497 (when url 1498 (when url
1498 (shr-urlify (or shr-start start) (shr-expand-url url) title)))) 1499 (shr-urlify (or shr-start start) (shr-expand-url url) title))))
1499 1500