From: Lars Magne Ingebrigtsen Date: Tue, 7 Dec 2010 22:12:50 +0000 (+0000) Subject: shr.el (shr-tag-table-1): Use bg/gfcolor specs on tables. X-Git-Tag: emacs-pretest-24.0.90~104^2~275^2~438^2~45^2~24 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=60568d7458c91e54947bbe8c15af3cca79488b9b;p=emacs.git 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. --- 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 + + * 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 * 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))