Merge changes made in Gnus trunk.

shr-color.el (shr-color-visible): Really return original background if fixed.
shr.el (shr-insert-color-overlay): Replace deprecated syntax.
shr.el (shr-tag-body, shr-descend): Add background support.
shr.el (shr-tag-title): Add.
gnus-sum.el (gnus-summary-articles-in-thread): Fix a bug that causes this function to return incorrect results.
shr.el (shr-parse-style): Drop !important from styles.
message.el (message-goto-body): Remove the <#secure special-casing, which is too special.
mm-util.el (mm-enable-multibyte): Use `to' instead of t.  This fixes something or other in Emacs 23, and is backwards compatible.
message.el (message-goto-body): Use called-interactively-p.
message.el (message-in-body-p): message-goto-body returns point.
nnimap.el (nnimap-request-move-article): It's no longer necessary to clear marks before moving, since they're synced from the Gnus side first.
gnus-sum.el (gnus-summary-push-marks-to-backend): New function.
gnus-sum.el (gnus-summary-move-article): Copy over all marks before moving, so that IMAP doesn't think a new article has arrived.
message.el (message-goto-body): called-interactively-p needs a parameter, so use `any'.
gnus-cache.el (gnus-summary-insert-cached-articles): Use it.
gnus-sum.el (gnus-summary-include-articles): New function.
shr.el (shr-tag-table, shr-render-td): Add bgcolor support.
shr-color.el (shr-color-visible): Fix docstring.
shr.el (shr-insert-background-overlay): Fix typo.
shr.el (shr-render-td): Copy the background before rendering.

8 files changed, 227 insertions, 71 deletions

diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index e6cb7d11d94..4f06225f8ca 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,5 +1,64 @@
 2010-11-24  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
+        * gnus-cache.el (gnus-summary-insert-cached-articles): Use it.
+
+        * gnus-sum.el (gnus-summary-include-articles): New function.
+
+        * message.el (message-goto-body): called-interactively-p needs a
+        parameter, so use `any'.
+
+        * nnimap.el (nnimap-request-move-article): It's no longer necessary to
+        clear marks before moving, since they're synced from the Gnus side
+        first.
+
+        * gnus-sum.el (gnus-summary-push-marks-to-backend): New function.
+        (gnus-summary-move-article): Copy over all marks before moving, so that
+        IMAP doesn't think a new article has arrived.
+
+2010-11-24  Julien Danjou  <julien@danjou.info>
+
+        * shr.el (shr-insert-background-overlay): Fix typo.
+        (shr-render-td): Copy the background before rendering.
+
+        * shr-color.el (shr-color-visible): Fix docstring.
+
+        * shr.el (shr-tag-table): Add bgcolor support.
+        (shr-render-td): Add bgcolor support.
+        (shr-get-background): Add.
+        (shr-insert-foreground-overlay): Use shr-get-background.
+
+        * message.el (message-goto-body): Use called-interactively-p.
+        (message-in-body-p): message-goto-body returns point.
+
+2010-11-24  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+        * mm-util.el (mm-enable-multibyte): Use `to' instead of t.  This fixes
+        Fixes something or other in Emacs 23, and is backwards compatible.
+
+        * message.el (message-goto-body): Remove the <#secure special-casing,
+        which is too special.
+
+        * shr.el (shr-parse-style): Drop !important from styles.
+
+2010-11-24  Daniel Schoepe  <daniel.schoepe@googlemail.com>  (tiny change)
+
+        * gnus-sum.el (gnus-summary-articles-in-thread): Fix a bug that causes
+        this function to return incorrect results when calling it with an
+        explicit article argument different from
+        (gnus-summary-article-number).
+
+2010-11-24  Julien Danjou  <julien@danjou.info>
+
+        * shr.el (shr-insert-color-overlay): Replace deprecated syntax.
+        (shr-tag-body): Add background support.
+        (shr-descend): Add background support.
+        (shr-tag-title): Add.
+
+        * shr-color.el (shr-color-visible): Really return original background
+        if fixed.
+
+2010-11-24  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
         * shr.el (shr-color-check): Protect against non-existant colour names.
 
 2010-11-24  Julien Danjou  <julien@danjou.info>
@@ -46,7 +105,8 @@
 
         * shr.el (shr-parse-style): Replace \n with space in style parsing.
 
-        * shr-color.el (shr-color-hsl-to-rgb-fractions): Use shr-color-hue-to-rgb.
+        * shr-color.el (shr-color-hsl-to-rgb-fractions): Use
+        shr-color-hue-to-rgb.
         (shr-color->hexadecimal): Call shr-color-hsl-to-rgb-fractions.
 
 2010-11-23  Lars Magne Ingebrigtsen  <larsi@gnus.org>
diff --git a/lisp/gnus/gnus-cache.el b/lisp/gnus/gnus-cache.el
index 822996069cc..50ab1c64a23 100644
--- a/lisp/gnus/gnus-cache.el
+++ b/lisp/gnus/gnus-cache.el
@@ -383,9 +383,14 @@ Returns the list of articles removed."
   "Insert all the articles cached for this group into the current buffer."
   (interactive)
   (let ((gnus-verbose (max 6 gnus-verbose)))
-    (if (not gnus-newsgroup-cached)
-        (gnus-message 3 "No cached articles for this group")
-      (gnus-summary-goto-subjects gnus-newsgroup-cached))))
+    (cond
+     ((not gnus-newsgroup-cached)
+      (gnus-message 3 "No cached articles for this group"))
+     ;; This is faster if there are few articles to insert.
+     ((< (length gnus-newsgroup-cached) 20)
+      (gnus-summary-goto-subjects gnus-newsgroup-cached))
+     (t
+      (gnus-summary-include-articles gnus-newsgroup-cached)))))
 
 (defun gnus-summary-limit-include-cached ()
   "Limit the summary buffer to articles that are cached."
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index ff85d45d7b0..72b6d40defd 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -8500,6 +8500,18 @@ fetched for this group."
       (gnus-summary-limit (append gnus-newsgroup-dormant gnus-newsgroup-limit))
     (gnus-summary-position-point)))
 
+(defun gnus-summary-include-articles (articles)
+  "Fetch the headers for ARTICLES and then display the summary lines."
+  (let ((gnus-inhibit-demon t)
+        (gnus-agent nil)
+        (gnus-read-all-available-headers t))
+    (setq gnus-newsgroup-headers
+          (gnus-merge
+           'list gnus-newsgroup-headers
+           (gnus-fetch-headers articles nil t)
+           'gnus-article-sort-by-number))
+    (gnus-summary-limit (append articles gnus-newsgroup-limit))))
+
 (defun gnus-summary-limit-exclude-dormant ()
   "Hide all dormant articles."
   (interactive)
@@ -9705,6 +9717,9 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
                   articles)
     (while articles
       (setq article (pop articles))
+      ;; Set any marks that may have changed in the summary buffer.
+      (when gnus-preserve-marks
+        (gnus-summary-push-marks-to-backend article))
       (let ((gnus-newsgroup-original-name gnus-newsgroup-name)
             (gnus-article-original-subject
              (mail-header-subject
@@ -9921,6 +9936,25 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
     (gnus-summary-position-point)
     (gnus-set-mode-line 'summary)))
 
+(defun gnus-summary-push-marks-to-backend (article)
+  (let ((add nil)
+        (delete nil)
+        (marks gnus-article-mark-lists))
+    (if (memq article gnus-newsgroup-unreads)
+        (push 'read add)
+      (push 'read delete))
+    (while marks
+      (when (eq (gnus-article-mark-to-type (cdar marks)) 'list)
+        (if (memq article (symbol-value
+                           (intern (format "gnus-newsgroup-%s"
+                                           (caar marks)))))
+            (push (cdar marks) add)
+          (push (cdar marks) delete)))
+      (pop marks))
+    (gnus-request-set-mark gnus-newsgroup-name
+                           `(((,article) add ,add)
+                             ((,article) del ,delete)))))
+
 (defun gnus-summary-copy-article (&optional n to-newsgroup select-method)
   "Copy the current article to some other group.
 If TO-NEWSGROUP is string, do not prompt for a newsgroup to copy to.
@@ -11232,6 +11266,7 @@ with that article."
                   (mail-header-subject (gnus-data-header (car data)))))
                 (t nil)))
          (end-point (save-excursion
+                      (goto-char (gnus-data-pos (car data)))
                       (if (gnus-summary-go-to-next-thread)
                           (point) (point-max))))
          articles)
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 07ffaf14fcb..bd6aa82b77a 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -3047,10 +3047,10 @@ M-RET    `message-newline-and-reformat' (break the line and reformat)."
   (interactive)
   (message-position-on-field "Summary" "Subject"))
 
-(defun message-goto-body (&optional interactivep)
+(defun message-goto-body ()
   "Move point to the beginning of the message body."
-  (interactive (list t))
-  (when (and interactivep
+  (interactive)
+  (when (and (called-interactively-p 'any)
              (looking-at "[ \t]*\n"))
     (expand-abbrev))
   (goto-char (point-min))
@@ -3059,7 +3059,7 @@ M-RET    `message-newline-and-reformat' (break the line and reformat)."
 
 (defun message-in-body-p ()
   "Return t if point is in the message body."
-  (let ((body (save-excursion (message-goto-body) (point))))
+  (let ((body (save-excursion (message-goto-body))))
     (>= (point) body)))
 
 (defun message-goto-eoh ()
diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el
index 67b41e0cb3a..700c1a6bb64 100644
--- a/lisp/gnus/mm-util.el
+++ b/lisp/gnus/mm-util.el
@@ -903,7 +903,7 @@ mail with multiple parts is preferred to sending a Unicode one.")
       "Set the multibyte flag of the current buffer.
 Only do this if the default value of `enable-multibyte-characters' is
 non-nil.  This is a no-op in XEmacs."
-      (set-buffer-multibyte t)))
+      (set-buffer-multibyte 'to)))
 
   (if (featurep 'xemacs)
       (defalias 'mm-disable-multibyte 'ignore)
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index f6315a5aab7..86bba98c208 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -783,9 +783,6 @@ textual parts.")
         (if internal-move-group
             (let ((result
                    (with-current-buffer (nnimap-buffer)
-                     ;; Clear all flags before moving.
-                     (nnimap-send-command "UID STORE %d FLAGS.SILENT ()"
-                                          article)
                      (nnimap-command "UID COPY %d %S"
                                      article
                                      (utf7-encode internal-move-group t)))))
diff --git a/lisp/gnus/shr-color.el b/lisp/gnus/shr-color.el
index 78fd0395290..2a4a6b3d4b7 100644
--- a/lisp/gnus/shr-color.el
+++ b/lisp/gnus/shr-color.el
@@ -318,8 +318,8 @@ If FIXED is t, then val1 will not be touched."
 
 (defun shr-color-visible (bg fg &optional fixed-background)
   "Check that BG and FG colors are visible if they are drawn on each other.
-Return t if they are. If they are too similar, two new colors are
-returned instead.
+Return (bg fg) if they are. If they are too similar, two new
+colors are returned instead.
 If FIXED-BACKGROUND is set, and if the color are not visible, a
 new background color will not be computed. Only the foreground
 color will be adapted to be visible on BG."
@@ -337,11 +337,14 @@ color will be adapted to be visible on BG."
       (let ((Ls (set-minimum-interval (car bg-lab) (car fg-lab) 0 100
                                       shr-color-visible-luminance-min
                                       fixed-background)))
-        (setcar bg-lab (car Ls))
+        (unless fixed-background
+          (setcar bg-lab (car Ls)))
         (setcar fg-lab (cadr Ls))
         (list
-         (apply 'format "#%02x%02x%02x"
-                (mapcar (lambda (x) (* (max (min 1 x) 0) 255)) (apply 'lab->rgb bg-lab)))
+         (if fixed-background
+             bg
+           (apply 'format "#%02x%02x%02x"
+                  (mapcar (lambda (x) (* (max (min 1 x) 0) 255)) (apply 'lab->rgb bg-lab))))
          (apply 'format "#%02x%02x%02x"
                 (mapcar (lambda (x) (* (max (min 1 x) 0) 255)) (apply 'lab->rgb fg-lab))))))))
 
diff --git a/lisp/gnus/shr.el b/lisp/gnus/shr.el
index 36c8d703e46..26d2b3b4cd2 100644
--- a/lisp/gnus/shr.el
+++ b/lisp/gnus/shr.el
@@ -201,7 +201,10 @@ redirects somewhere else."
         (funcall function (cdr dom))
       (shr-generic (cdr dom)))
     (when (consp style)
-      (shr-insert-color-overlay (cdr (assq 'color style)) start (point)))))
+      (shr-insert-background-overlay (cdr (assq 'background-color style))
+                                     start)
+      (shr-insert-foreground-overlay (cdr (assq 'color style))
+                                     start (point)))))
 
 (defun shr-generic (cont)
   (dolist (sub cont)
@@ -494,23 +497,65 @@ START, and END."
 
 (autoload 'shr-color-visible "shr-color")
 (autoload 'shr-color->hexadecimal "shr-color")
-(defun shr-color-check (fg &optional bg)
-  "Check that FG is visible on BG."
-  (let ((hex-color (shr-color->hexadecimal fg)))
-    (when hex-color
-      (shr-color-visible (or (shr-color->hexadecimal bg)
-                             (frame-parameter nil 'background-color))
-                         hex-color (not bg)))))
-
-(defun shr-insert-color-overlay (color start end)
-  (when color
-    (let ((new-color (cadr (shr-color-check color))))
-      (when new-color
-        (overlay-put (make-overlay start end) 'face
-                     (cons 'foreground-color new-color))))))
+
+(defun shr-color-check (fg bg)
+  "Check that FG is visible on BG.
+Returns (fg bg) with corrected values.
+Returns nil if the colors that would be used are the default
+ones, in case fg and bg are nil."
+  (when (or fg bg)
+    (let ((fixed (cond ((null fg) 'fg)
+                       ((null bg) 'bg))))
+      ;; Convert colors to hexadecimal, or set them to default.
+      (let ((fg (or (shr-color->hexadecimal fg)
+                    (frame-parameter nil 'foreground-color)))
+            (bg (or (shr-color->hexadecimal bg)
+                    (frame-parameter nil 'background-color))))
+        (cond ((eq fixed 'bg)
+               ;; Only return the new fg
+               (list nil (cadr (shr-color-visible bg fg t))))
+              ((eq fixed 'fg)
+               ;; Invert args and results and return only the new bg
+               (list (cadr (shr-color-visible fg bg t)) nil))
+              (t
+               (shr-color-visible bg fg)))))))
+
+(defun shr-get-background (pos)
+  "Return background color at POS."
+  (dolist (overlay (overlays-in start (1+ start)))
+    (let ((background (plist-get (overlay-get overlay 'face)
+                                 :background)))
+      (when background
+        (return background)))))
+
+(defun shr-insert-foreground-overlay (fg start end)
+  (when fg
+    (let ((bg (shr-get-background start)))
+      (let ((new-colors (shr-color-check fg bg)))
+        (when new-colors
+          (overlay-put (make-overlay start end) 'face
+                       (list :foreground (cadr new-colors))))))))
+
+(defun shr-insert-background-overlay (bg start)
+  "Insert an overlay with background color BG at START.
+The overlay has rear-advance set to t, so it will be used when
+text will be inserted at start."
+  (when bg
+    (let ((new-colors (shr-color-check nil bg)))
+      (when new-colors
+        (overlay-put (make-overlay start start nil nil t) 'face
+                     (list :background (car new-colors)))))))
 
 ;;; Tag-specific rendering rules.
 
+(defun shr-tag-body (cont)
+  (let ((start (point))
+        (fgcolor (cdr (assq :fgcolor cont)))
+        (bgcolor (cdr (assq :bgcolor cont))))
+    (shr-insert-background-overlay bgcolor start)
+    (shr-generic cont)
+    (shr-insert-foreground-overlay fgcolor start (point))))
+
 (defun shr-tag-p (cont)
   (shr-ensure-paragraph)
   (shr-indent)
@@ -554,6 +599,8 @@ START, and END."
                      (cadr elem))
             (let ((name (replace-regexp-in-string "^ +\\| +$" "" (car elem)))
                   (value (replace-regexp-in-string "^ +\\| +$" "" (cadr elem))))
+              (when (string-match " *!important\\'" value)
+                (setq value (substring value 0 (match-beginning 0))))
               (push (cons (intern name obarray)
                           value)
                     plist)))))
@@ -703,11 +750,14 @@ START, and END."
   (shr-ensure-newline)
   (insert (make-string shr-width shr-hr-line) "\n"))
 
+(defun shr-tag-title (cont)
+  (shr-heading cont 'bold 'underline))
+
 (defun shr-tag-font (cont)
   (let ((start (point))
         (color (cdr (assq :color cont))))
     (shr-generic cont)
-    (shr-insert-color-overlay color start (point))))
+    (shr-insert-foreground-overlay color start (point))))
 
 ;;; Table rendering algorithm.
 
@@ -755,9 +805,11 @@ START, and END."
          (header (cdr (assq 'thead cont)))
          (body (or (cdr (assq 'tbody cont)) cont))
          (footer (cdr (assq 'tfoot cont)))
+         (bgcolor (cdr (assq :bgcolor cont)))
          (nheader (if header (shr-max-columns header)))
          (nbody (if body (shr-max-columns body)))
          (nfooter (if footer (shr-max-columns footer))))
+    (shr-insert-background-overlay bgcolor (point))
     (shr-tag-table-1
      (nconc
       (if caption `((tr (td ,@caption))))
@@ -900,44 +952,48 @@ START, and END."
     (nreverse trs)))
 
 (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-generic 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
-          (list max
-                (count-lines (point-min) (point-max))
-                (split-string (buffer-string) "\n")
-                (shr-collect-overlays))
-        (list max
-              (shr-natural-width))))))
+  (let ((background (shr-get-background (point))))
+    (with-temp-buffer
+      (let ((cache (cdr (assoc (cons width cont) shr-content-cache))))
+        (if cache
+            (insert cache)
+          (shr-insert-background-overlay (or (cdr (assq :bgcolor cont))
+                                             background)
+                                         (point))
+          (let ((shr-width width)
+                (shr-indentation 0))
+            (shr-generic 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
+            (list max
+                  (count-lines (point-min) (point-max))
+                  (split-string (buffer-string) "\n")
+                  (shr-collect-overlays))
+          (list max
+                (shr-natural-width)))))))
 
 (defun shr-natural-width ()
   (goto-char (point-min))