[Emacs-diffs] /srv/bzr/emacs/trunk r102604: shr.el (shr-tag-table-1): Use bg/gfcolor specs on tables.

[Katsumi Yamaoka]

------------------------------------------------------------
revno: 102604
author: Lars Magne Ingebrigtsen <address@hidden>
committer: Katsumi Yamaoka <address@hidden>
branch nick: trunk
timestamp: Tue 2010-12-07 22:12:50 +0000
message:
  shr.el (shr-tag-table-1): Use bg/gfcolor specs on tables.
   (shr-render-td): Handle td style="" better.
   (shr-tag-table): Use the color from the style sheet.
   (shr-render-td): Make sure we copy over all the overlays, too.
  nnimap.el (nnimap-parse-flags): Tweak VANISHED regexp to avoid regexp 
overflow, possibly.
modified:
  lisp/gnus/ChangeLog
  lisp/gnus/nnimap.el
  lisp/gnus/shr.el

=== modified file 'lisp/gnus/ChangeLog'
--- a/lisp/gnus/ChangeLog       2010-12-07 14:10:11 +0000
+++ b/lisp/gnus/ChangeLog       2010-12-07 22:12:50 +0000
@@ -1,3 +1,13 @@
+2010-12-07  Lars Magne Ingebrigtsen  <address@hidden>
+
+       * nnimap.el (nnimap-parse-flags): Tweak VANISHED regexp to avoid regexp
+       overflow, possibly.
+
+       * shr.el (shr-tag-table-1): Use bg/gfcolor specs on tables.
+       (shr-render-td): Handle td style="" better.
+       (shr-tag-table): Use the color from the style sheet.
+       (shr-render-td): Make sure we copy over all the overlays, too.
+
 2010-12-07  Andrew Cohen  <address@hidden>
 
        * nnir.el (nnir-run-gmane): Restore sub-optimal test for gmane server.

=== modified file 'lisp/gnus/nnimap.el'
--- a/lisp/gnus/nnimap.el       2010-12-06 22:16:10 +0000
+++ b/lisp/gnus/nnimap.el       2010-12-07 22:12:50 +0000
@@ -1384,7 +1384,7 @@
                 (goto-char start)
                 (setq vanished
                       (and (eq flag-sequence 'qresync)
-                           (re-search-forward "VANISHED.* \\([0-9:,]+\\)"
+                           (re-search-forward "^\\* VANISHED .* \\([0-9:,]+\\)"
                                               (or end (point-min)) t)
                            (match-string 1)))
                 (goto-char start)

=== modified file 'lisp/gnus/shr.el'
--- a/lisp/gnus/shr.el  2010-12-07 01:21:09 +0000
+++ b/lisp/gnus/shr.el  2010-12-07 22:12:50 +0000
@@ -589,7 +589,8 @@
   (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 fg
+         (shr-put-color start end :foreground (cadr new-colors)))
        (when bg
          (shr-put-color start end :background (car new-colors)))))))
 
@@ -896,6 +897,9 @@
         (body (or (cdr (assq 'tbody cont)) cont))
         (footer (cdr (assq 'tfoot cont)))
          (bgcolor (cdr (assq :bgcolor cont)))
+        (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)))
         (nfooter (if footer (shr-max-columns footer))))
@@ -936,7 +940,10 @@
                       `((tr (td (table (tbody ,@footer))))))))
          (if caption
              `((tr (td (table (tbody ,@body)))))
-           body)))))))
+           body)))))
+    (when bgcolor
+      (shr-colorize-region start (point) (cdr (assq 'color shr-stylesheet))
+                          bgcolor))))
 
 (defun shr-find-elements (cont type)
   (let (result)
@@ -1042,43 +1049,73 @@
 
 (defun shr-render-td (cont width fill)
   (with-temp-buffer
-    (let ((cache (cdr (assoc (cons width cont) shr-content-cache))))
-      (if cache
-         (insert cache)
-       (let ((shr-width width)
-             (shr-indentation 0))
-         (shr-descend (cons 'td cont)))
-       (delete-region
-        (point)
-        (+ (point)
-           (skip-chars-backward " \t\n")))
-       (push (cons (cons width cont) (buffer-string))
-             shr-content-cache)))
-    (goto-char (point-min))
-    (let ((max 0))
-      (while (not (eobp))
-       (end-of-line)
-       (setq max (max max (current-column)))
-       (forward-line 1))
-      (when fill
-       (goto-char (point-min))
-       ;; If the buffer is totally empty, then put a single blank
-       ;; line here.
-       (if (zerop (buffer-size))
-           (insert (make-string width ? ))
-         ;; Otherwise, fill the buffer.
-         (while (not (eobp))
-           (end-of-line)
-           (when (> (- width (current-column)) 0)
-             (insert (make-string (- width (current-column)) ? )))
-           (forward-line 1))))
-      (if fill
+    (let ((bgcolor (cdr (assq :bgcolor cont)))
+         (fgcolor (cdr (assq :fgcolor cont)))
+         (style (cdr (assq :style cont)))
+         (shr-stylesheet shr-stylesheet)
+         overlays)
+      (when style
+       (setq style (and (string-match "color" style)
+                        (shr-parse-style style))))
+      (when bgcolor
+       (setq style (nconc (list (cons 'background-color bgcolor)) style)))
+      (when fgcolor
+       (setq style (nconc (list (cons 'color fgcolor)) style)))
+      (when style
+       (setq shr-stylesheet (append style shr-stylesheet)))
+      (let ((cache (cdr (assoc (cons width cont) shr-content-cache))))
+       (if cache
+           (progn
+             (insert (car cache))
+             (let ((end (length (car cache))))
+               (dolist (overlay (cadr cache))
+                 (let ((new-overlay
+                        (make-overlay (1+ (- end (nth 0 overlay)))
+                                      (1+ (- end (nth 1 overlay)))))
+                       (properties (nth 2 overlay)))
+                   (while properties
+                     (overlay-put new-overlay
+                                  (pop properties) (pop properties)))))))
+         (let ((shr-width width)
+               (shr-indentation 0))
+           (shr-descend (cons 'td cont)))
+         (delete-region
+          (point)
+          (+ (point)
+             (skip-chars-backward " \t\n")))
+         (push (list (cons width cont) (buffer-string)
+                     (shr-overlays-in-region (point-min) (point-max)))
+               shr-content-cache)))
+      (goto-char (point-min))
+      (let ((max 0))
+       (while (not (eobp))
+         (end-of-line)
+         (setq max (max max (current-column)))
+         (forward-line 1))
+       (when fill
+         (goto-char (point-min))
+         ;; If the buffer is totally empty, then put a single blank
+         ;; line here.
+         (if (zerop (buffer-size))
+             (insert (make-string width ? ))
+           ;; Otherwise, fill the buffer.
+           (while (not (eobp))
+             (end-of-line)
+             (when (> (- width (current-column)) 0)
+               (insert (make-string (- width (current-column)) ? )))
+             (forward-line 1))))
+       (when style
+         (shr-colorize-region
+          (point-min) (point-max)
+          (cdr (assq 'color shr-stylesheet))
+          (cdr (assq 'background-color shr-stylesheet))))
+       (if fill
+           (list max
+                 (count-lines (point-min) (point-max))
+                 (split-string (buffer-string) "\n")
+                 (shr-collect-overlays))
          (list max
-               (count-lines (point-min) (point-max))
-               (split-string (buffer-string) "\n")
-               (shr-collect-overlays))
-       (list max
-             (shr-natural-width))))))
+               (shr-natural-width)))))))
 
 (defun shr-natural-width ()
   (goto-char (point-min))