-

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

diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 66a9c04a8f6acec01c319529e54334d7d5286b95..9064b9668f4edcb2ed5acbbe0af095bf843e5fe0 100644 (file)
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -64,6 +64,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."
@@ -136,6 +142,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)
@@ -151,7 +165,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)
@@ -435,11 +448,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))
@@ -454,9 +466,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
@@ -1094,7 +1109,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
@@ -1213,9 +1230,6 @@ ones, in case fg and bg are nil."
 (defun shr-tag-s (dom)
   (shr-fontize-dom dom 'shr-strike-through))
 
-(defun shr-tag-del (dom)
-  (shr-fontize-dom dom 'shr-strike-through))
-
 (defun shr-tag-b (dom)
   (shr-fontize-dom dom 'bold))
 
@@ -1235,6 +1249,24 @@ ones, in case fg and bg are nil."
   (let ((shr-current-font 'default))
     (shr-generic dom)))
 
+(defun shr-tag-ins (cont)
+  (let* ((start (point))
+         (color "green")
+         (shr-stylesheet (nconc (list (cons 'color color))
+                               shr-stylesheet)))
+    (shr-generic cont)
+    (shr-colorize-region start (point) color
+                         (cdr (assq 'background-color shr-stylesheet)))))
+
+(defun shr-tag-del (cont)
+  (let* ((start (point))
+         (color "red")
+         (shr-stylesheet (nconc (list (cons 'color color))
+                               shr-stylesheet)))
+    (shr-fontize-dom cont 'shr-strike-through)
+    (shr-colorize-region start (point) color
+                         (cdr (assq 'background-color shr-stylesheet)))))
+
 (defun shr-parse-style (style)
   (when style
     (save-match-data