shr: colorize only in one place

[gnus] / lisp / shr.el

diff --git a/lisp/shr.el b/lisp/shr.el
index 7b7e008..8ee1e99 100644 (file)
--- a/lisp/shr.el
+++ b/lisp/shr.el
@@ -195,18 +195,19 @@ redirects somewhere else."
        (shr-stylesheet shr-stylesheet)
        (start (point)))
     (when (and style
+               ;; HACK: we only parse if there's color information, since
+               ;; that's the only thing we are rendering.
               (string-match "color" style))
       (setq shr-stylesheet (nconc (shr-parse-style style)
                                  shr-stylesheet)))
+    ;; Render content
     (if (fboundp function)
        (funcall function (cdr dom))
       (shr-generic (cdr dom)))
-    (let ((color (cdr (assq 'color shr-stylesheet)))
-         (background (cdr (assq 'background-color
-                                shr-stylesheet))))
-      (when (and shr-stylesheet
-                (or color background))
-       (shr-colorize-region start (point) color background)))))
+    ;; Apply style
+    (shr-colorize-region start (point)
+                         (cdr (assq 'color shr-stylesheet))
+                         (cdr (assq 'background-color shr-stylesheet)))))
 
 (defun shr-generic (cont)
   (dolist (sub cont)
@@ -301,12 +302,12 @@ redirects somewhere else."
                    (eq (following-char) ? )
                    (shr-char-breakable-p (preceding-char))
                    (shr-char-breakable-p (following-char))
-                   (and (eq (preceding-char) ?')
-                        (not (memq (char-after (- (point) 2))
-                                   (list nil ?\n ? ))))
-                   ;; There're some kinsoku CJK chars that aren't breakable.
-                   (and (shr-char-kinsoku-bol-p (preceding-char))
-                        (not (shr-char-kinsoku-bol-p (following-char))))
+                   (if (eq (preceding-char) ?')
+                       (not (memq (char-after (- (point) 2))
+                                  (list nil ?\n ? )))
+                     ;; There're some kinsoku CJK chars that aren't breakable.
+                     (and (shr-char-kinsoku-bol-p (preceding-char))
+                          (not (shr-char-kinsoku-bol-p (following-char)))))
                    (shr-char-kinsoku-eol-p (following-char))))
       (backward-char 1))
     (if (and (not (or failed (eolp)))
@@ -586,10 +587,11 @@ ones, in case fg and bg are nil."
                (shr-color-visible bg fg)))))))
 
 (defun shr-colorize-region (start end fg &optional bg)
-  (when fg
-    (let ((new-colors
-          (shr-color-check fg (or bg
-                                  (frame-parameter nil 'background-color)))))
+  "Colorize region from START to END.
+Use foreground color FG and background color BG.
+Apply color check via `shr-color-check'."
+  (when (or fg bg)
+    (let ((new-colors (shr-color-check fg bg)))
       (when new-colors
        (shr-put-color start end :foreground (cadr new-colors))
        (when bg
@@ -635,10 +637,15 @@ ones, in case fg and bg are nil."
   (let* ((start (point))
         (fgcolor (cdr (assq :fgcolor cont)))
         (bgcolor (cdr (assq :bgcolor cont)))
-        (shr-stylesheet (list (cons :color fgcolor)
-                              (cons :background-color bgcolor))))
-    (shr-generic cont)
-    (shr-colorize-region start (point) fgcolor bgcolor)))
+         (shr-stylesheet (if fgcolor
+                             (if bgcolor
+                                 `((color . ,fgcolor)
+                                   (background-color . ,bgcolor) ,@shr-stylesheet)
+                               `((color . ,fgcolor) ,@shr-stylesheet))
+                           (if bgcolor
+                               `((background-color . ,bgcolor) ,@shr-stylesheet)
+                             shr-stylesheet))))
+    (shr-generic cont)))
 
 (defun shr-tag-p (cont)
   (shr-ensure-paragraph)
@@ -839,10 +846,12 @@ ones, in case fg and bg are nil."
   (shr-heading cont 'bold 'underline))
 
 (defun shr-tag-font (cont)
-  (let ((start (point))
-        (color (cdr (assq :color cont))))
-    (shr-generic cont)
-    (shr-colorize-region start (point) color)))
+  (let* ((start (point))
+         (color (cdr (assq :color cont)))
+         (shr-stylesheet (if color
+                             `((color . ,fgcolor) ,@shr-stylesheet)
+                           shr-stylesheet)))
+    (shr-generic cont)))
 
 ;;; Table rendering algorithm.
 
@@ -1042,7 +1051,7 @@ ones, in case fg and bg are nil."
          (insert cache)
        (let ((shr-width width)
              (shr-indentation 0))
-         (shr-generic cont))
+         (shr-descend (cons 'td cont)))
        (delete-region
         (point)
         (+ (point)