2 files changed, 40 insertions, 22 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 652bc537ee5..12e98657af0 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -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.
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index cc90097102a..a4b004d7c1b 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -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."