Merge from origin/emacs-25

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

diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 09e368f8b477f48ac4b26274017fd7800e75687a..d24f0d37539eec14c85803ea5b90300b8566e4c3 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
@@ -63,6 +63,12 @@ fit these criteria."
   :group 'shr
   :type 'boolean)
 
+(defcustom shr-use-colors t
+  "If non-nil, respect color specifications in the HTML."
+  :version "25.2"
+  :group 'shr
+  :type 'boolean)
+
 (defcustom shr-table-horizontal-line nil
   "Character used to draw horizontal table lines.
 If nil, don't draw horizontal table lines."
@@ -135,6 +141,14 @@ cid: URL as the argument.")
 (defvar shr-inhibit-images nil
   "If non-nil, inhibit loading images.")
 
+(defvar shr-external-rendering-functions nil
+  "Alist of tag/function pairs used to alter how shr renders certain tags.
+For instance, eww uses this to alter rendering of title, forms
+and other things:
+((title . eww-tag-title)
+ (form . eww-tag-form)
+ ...)")
+
 ;;; Internal variables.
 
 (defvar shr-folding-mode nil)
@@ -150,7 +164,6 @@ cid: URL as the argument.")
 (defvar shr-depth 0)
 (defvar shr-warning nil)
 (defvar shr-ignore-cache nil)
-(defvar shr-external-rendering-functions nil)
 (defvar shr-target-id nil)
 (defvar shr-table-separator-length 1)
 (defvar shr-table-separator-pixel-width 0)
@@ -434,11 +447,10 @@ size, and full-buffer size."
 
 (defun shr-descend (dom)
   (let ((function
-        (or
-         ;; Allow other packages to override (or provide) rendering
-         ;; of elements.
-         (cdr (assq (dom-tag dom) shr-external-rendering-functions))
-         (intern (concat "shr-tag-" (symbol-name (dom-tag dom))) obarray)))
+         (intern (concat "shr-tag-" (symbol-name (dom-tag dom))) obarray))
+        ;; Allow other packages to override (or provide) rendering
+        ;; of elements.
+        (external (cdr (assq (dom-tag dom) shr-external-rendering-functions)))
        (style (dom-attr dom 'style))
        (shr-stylesheet shr-stylesheet)
        (shr-depth (1+ shr-depth))
@@ -453,9 +465,12 @@ size, and full-buffer size."
          (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 dom)
-         (shr-generic dom))
+        (cond (external
+               (funcall external dom))
+              ((fboundp function)
+               (funcall function dom))
+              (t
+               (shr-generic dom)))
        (when (and shr-target-id
                   (equal (dom-attr dom 'id) shr-target-id))
          ;; If the element was empty, we don't have anything to put the
@@ -1093,7 +1108,9 @@ ones, in case fg and bg are nil."
                (shr-color-visible bg fg)))))))
 
 (defun shr-colorize-region (start end fg &optional bg)
-  (when (and (or fg bg) (>= (display-color-cells) 88))
+  (when (and shr-use-colors
+             (or fg bg)
+             (>= (display-color-cells) 88))
     (let ((new-colors (shr-color-check fg bg)))
       (when new-colors
        (when fg