procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Make shr stop descending into the dom before `max-specpdl-size' stops us

Browse source 
* net/shr.el (shr-descend): Don't descend further than
`max-specpdl-size' allows (bug#16587).
(shr-depth): New variable.
(shr-warning): New variable.
This commit is contained in:
Lars Magne Ingebrigtsen 2014-11-13 22:11:51 +01:00
parent fdae50c73f
commit f7a192cb5c
2 changed files with 40 additions and 22 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
lisp/ChangeLog
View file

@ -1,3 +1,10 @@
2014-11-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
* net/shr.el (shr-descend): Don't descend further than
`max-specpdl-size' allows (bug#16587).
(shr-depth): New variable.
(shr-warning): New variable.
2014-11-13 Ivan Shmakov <ivan@siamics.net>
* net/shr.el (shr-parse-base): Handle <base href=""> correctly.

55
lisp/net/shr.el
View file

@ -137,6 +137,8 @@ cid: URL as the argument.")
(defvar shr-table-depth 0)
(defvar shr-stylesheet nil)
(defvar shr-base nil)
(defvar shr-depth 0)
(defvar shr-warning nil)
(defvar shr-ignore-cache nil)
(defvar shr-external-rendering-functions nil)
(defvar shr-target-id nil)
@ -198,9 +200,13 @@ DOM should be a parse tree as generated by
(shr-state nil)
(shr-start nil)
(shr-base nil)
(shr-depth 0)
(shr-warning nil)
(shr-internal-width (or shr-width (1- (window-width)))))
(shr-descend (shr-transform-dom dom))
(shr-remove-trailing-whitespace start (point))))
(shr-remove-trailing-whitespace start (point))
(when shr-warning
(message "%s" shr-warning))))
(defun shr-remove-trailing-whitespace (start end)
(let ((width (window-width)))
@ -406,29 +412,34 @@ size, and full-buffer size."
(intern (concat "shr-tag-" (symbol-name (car dom))) obarray)))
(style (cdr (assq :style (cdr dom))))
(shr-stylesheet shr-stylesheet)
(shr-depth (1+ shr-depth))
(start (point)))
(when style
(if (string-match "color\\|display\\|border-collapse" style)
(setq shr-stylesheet (nconc (shr-parse-style style)
shr-stylesheet))
(setq style nil)))
;; If we have a display:none, then just ignore this part of the DOM.
(unless (equal (cdr (assq 'display shr-stylesheet)) "none")
(if (fboundp function)
(funcall function (cdr dom))
(shr-generic (cdr dom)))
(when (and shr-target-id
(equal (cdr (assq :id (cdr dom))) shr-target-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))
;; If style is set, then this node has set the color.
;; shr uses about 12 frames per nested node.
(if (> shr-depth (/ max-specpdl-size 12))
(setq shr-warning "Too deeply nested to render properly; consider increasing `max-specpdl-size'")
(when style
(shr-colorize-region start (point)
(cdr (assq 'color shr-stylesheet))
(cdr (assq 'background-color shr-stylesheet)))))))
(if (string-match "color\\|display\\|border-collapse" style)
(setq shr-stylesheet (nconc (shr-parse-style style)
shr-stylesheet))
(setq style nil)))
;; If we have a display:none, then just ignore this part of the DOM.
(unless (equal (cdr (assq 'display shr-stylesheet)) "none")
(if (fboundp function)
(funcall function (cdr dom))
(shr-generic (cdr dom)))
(when (and shr-target-id
(equal (cdr (assq :id (cdr dom))) shr-target-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))
;; If style is set, then this node has set the color.
(when style
(shr-colorize-region
start (point)
(cdr (assq 'color shr-stylesheet))
(cdr (assq 'background-color shr-stylesheet))))))))
(defmacro shr-char-breakable-p (char)
"Return non-nil if a line can be broken before and after CHAR."