summaryrefslogtreecommitdiff
path: root/lisp
diff options
context:
space:
mode:
authorLars Magne Ingebrigtsen <larsi@gnus.org>2010-12-07 22:12:50 +0000
committerKatsumi Yamaoka <yamaoka@jpl.org>2010-12-07 22:12:50 +0000
commit60568d7458c91e54947bbe8c15af3cca79488b9b (patch)
tree40b3ba9175d7b65d895da42ac346f629159e51ee /lisp
parent11c31b99b3df49323d3d59aea118d3f17c1291a4 (diff)
downloademacs-60568d7458c91e54947bbe8c15af3cca79488b9b.tar.gz
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.
Diffstat (limited to 'lisp')
-rw-r--r--lisp/gnus/ChangeLog10
-rw-r--r--lisp/gnus/nnimap.el2
-rw-r--r--lisp/gnus/shr.el113
3 files changed, 86 insertions, 39 deletions
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 2d4d79af2cc..2a1bdad398b 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,13 @@
+2010-12-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * 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 <cohen@andy.bu.edu>
* nnir.el (nnir-run-gmane): Restore sub-optimal test for gmane server.
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index c7d61399dec..0462cf946eb 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -1384,7 +1384,7 @@ textual parts.")
(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)
diff --git a/lisp/gnus/shr.el b/lisp/gnus/shr.el
index 4f3af112a32..da9405a0ccf 100644
--- a/lisp/gnus/shr.el
+++ b/lisp/gnus/shr.el
@@ -589,7 +589,8 @@ ones, in case fg and bg are nil."
(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 @@ ones, in case fg and bg are nil."
(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 @@ ones, in case fg and bg are nil."
`((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 @@ ones, in case fg and bg are nil."
(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))