Update copyright year to 2016

[gnu-emacs] / lisp / net / shr.el

diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index a48d098fe2605229f1fea801379aed2fa8193fc8..979b0caeea59d1632019337a45fede48b6c737fb 100644 (file)
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -1,6 +1,6 @@
 ;;; shr.el --- Simple HTML Renderer
 
-;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2016 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: html
@@ -244,7 +244,13 @@ DOM should be a parse tree as generated by
                                      (if (and (null shr-width)
                                               (not (shr--have-one-fringe-p)))
                                          (* (frame-char-width) 2)
-                                       0))))))
+                                       0)))))
+        bidi-display-reordering)
+    ;; If the window was hscrolled for some reason, shr-fill-lines
+    ;; below will misbehave, because it silently assumes that it
+    ;; starts with a non-hscrolled window (vertical-motion will move
+    ;; to a wrong place otherwise).
+    (set-window-hscroll nil 0)
     (shr-descend dom)
     (shr-fill-lines start (point))
     (shr-remove-trailing-whitespace start (point))
@@ -303,13 +309,25 @@ redirects somewhere else."
 (defun shr-next-link ()
   "Skip to the next link."
   (interactive)
-  (let ((skip (text-property-any (point) (point-max) 'help-echo nil)))
-    (if (or (eobp)
-           (not (setq skip (text-property-not-all skip (point-max)
-                                                  'help-echo nil))))
-       (message "No next link")
+  (let ((current (get-text-property (point) 'shr-url))
+        (start (point))
+        skip)
+    (while (and (not (eobp))
+                (equal (get-text-property (point) 'shr-url) current))
+      (forward-char 1))
+    (cond
+     ((and (not (eobp))
+           (get-text-property (point) 'shr-url))
+      ;; The next link is adjacent.
+      (message "%s" (get-text-property (point) 'help-echo)))
+     ((or (eobp)
+          (not (setq skip (text-property-not-all (point) (point-max)
+                                                 'shr-url nil))))
+      (goto-char start)
+      (message "No next link"))
+     (t
       (goto-char skip)
-      (message "%s" (get-text-property (point) 'help-echo)))))
+      (message "%s" (get-text-property (point) 'help-echo))))))
 
 (defun shr-previous-link ()
   "Skip to the previous link."
@@ -425,8 +443,8 @@ size, and full-buffer size."
        (shr-stylesheet shr-stylesheet)
        (shr-depth (1+ shr-depth))
        (start (point)))
-    ;; shr uses about 12 frames per nested node.
-    (if (> shr-depth (/ max-specpdl-size 12))
+    ;; shr uses many frames per nested node.
+    (if (> shr-depth (/ max-specpdl-size 15))
        (setq shr-warning "Too deeply nested to render properly; consider increasing `max-specpdl-size'")
       (when style
        (if (string-match "color\\|display\\|border-collapse" style)
@@ -1102,6 +1120,15 @@ ones, in case fg and bg are nil."
 
 ;;; Tag-specific rendering rules.
 
+(defun shr-tag-html (dom)
+  (let ((dir (dom-attr dom 'dir)))
+    (cond
+     ((equal dir "ltr")
+      (setq bidi-paragraph-direction 'left-to-right))
+     ((equal dir "rtl")
+      (setq bidi-paragraph-direction 'right-to-left))))
+  (shr-generic dom))
+
 (defun shr-tag-body (dom)
   (let* ((start (point))
         (fgcolor (or (dom-attr dom 'fgcolor) (dom-attr dom 'text)))
@@ -1152,7 +1179,9 @@ ones, in case fg and bg are nil."
 
 (defun shr-tag-svg (dom)
   (when (and (image-type-available-p 'svg)
-            (not shr-inhibit-images))
+            (not shr-inhibit-images)
+             (dom-attr dom 'width)
+             (dom-attr dom 'height))
     (funcall shr-put-image-function (list (shr-dom-to-xml dom) 'image/svg+xml)
             "SVG Image")))
 
@@ -1570,19 +1599,30 @@ The preference is a float determined from `shr-prefer-media-type'."
     ;; Then render the table again with these new "hard" widths.
     (shr-insert-table (shr-make-table dom sketch-widths t) sketch-widths)))
 
+(defun shr-table-body (dom)
+  (let ((tbodies (dom-by-tag dom 'tbody)))
+    (cond
+     ((null tbodies)
+      dom)
+     ((= (length tbodies) 1)
+      (car tbodies))
+     (t
+      ;; Table with multiple tbodies.  Convert into a single tbody.
+      `(tbody nil ,@(cl-reduce 'append
+                               (mapcar 'dom-non-text-children tbodies)))))))
+
 (defun shr-tag-table (dom)
   (shr-ensure-paragraph)
   (let* ((caption (dom-children (dom-child-by-tag dom 'caption)))
         (header (dom-non-text-children (dom-child-by-tag dom 'thead)))
-        (body (dom-non-text-children (or (dom-child-by-tag dom 'tbody)
-                                         dom)))
+        (body (dom-non-text-children (shr-table-body dom)))
         (footer (dom-non-text-children (dom-child-by-tag dom 'tfoot)))
          (bgcolor (dom-attr dom 'bgcolor))
         (start (point))
         (shr-stylesheet (nconc (list (cons 'background-color bgcolor))
                                shr-stylesheet))
         (nheader (if header (shr-max-columns header)))
-        (nbody (if body (shr-max-columns body)))
+        (nbody (if body (shr-max-columns body) 0))
         (nfooter (if footer (shr-max-columns footer))))
     (if (and (not caption)
             (not header)