Synch with Gnus.
[elisp/gnus.git-] / lisp / gnus-sum.el
index 09ddf09..6c3e5c4 100644 (file)
@@ -49,6 +49,7 @@
   (autoload 'pgg-verify-region "pgg" nil t))
 
 (autoload 'gnus-summary-limit-include-cached "gnus-cache" nil t)
   (autoload 'pgg-verify-region "pgg" nil t))
 
 (autoload 'gnus-summary-limit-include-cached "gnus-cache" nil t)
+(autoload 'gnus-cache-write-active "gnus-cache")
 (autoload 'gnus-set-summary-default-charset "gnus-i18n" nil t)
 
 (defcustom gnus-kill-summary-on-exit t
 (autoload 'gnus-set-summary-default-charset "gnus-i18n" nil t)
 
 (defcustom gnus-kill-summary-on-exit t
@@ -936,6 +937,14 @@ For example: ((1 . cn-gb-2312) (2 . big5))."
   :type '(choice (const nil)
                 integer))
 
   :type '(choice (const nil)
                 integer))
 
+(defcustom gnus-summary-save-parts-default-mime "image/.*"
+  "*A regexp to match MIME parts when saving multiple parts of a message
+with gnus-summary-save-parts (X m). This regexp will be used by default
+when prompting the user for which type of files to save."
+  :group 'gnus-summary
+  :type 'regexp)
+
+
 ;;; Internal variables
 
 (defvar gnus-article-mime-handles nil)
 ;;; Internal variables
 
 (defvar gnus-article-mime-handles nil)
@@ -953,6 +962,9 @@ For example: ((1 . cn-gb-2312) (2 . big5))."
 (defvar gnus-sort-gathered-threads-function 'gnus-thread-sort-by-number
   "Function called to sort the articles within a thread after it has been gathered together.")
 
 (defvar gnus-sort-gathered-threads-function 'gnus-thread-sort-by-number
   "Function called to sort the articles within a thread after it has been gathered together.")
 
+(defvar gnus-summary-save-parts-type-history nil)
+(defvar gnus-summary-save-parts-last-directory nil)
+
 ;; Avoid highlighting in kill files.
 (defvar gnus-summary-inhibit-highlight nil)
 (defvar gnus-newsgroup-selected-overlay nil)
 ;; Avoid highlighting in kill files.
 (defvar gnus-summary-inhibit-highlight nil)
 (defvar gnus-newsgroup-selected-overlay nil)
@@ -2442,12 +2454,13 @@ marks of articles."
 
 (defun gnus-restore-hidden-threads-configuration (config)
   "Restore hidden threads configuration from CONFIG."
 
 (defun gnus-restore-hidden-threads-configuration (config)
   "Restore hidden threads configuration from CONFIG."
-  (let (point buffer-read-only)
-    (while (setq point (pop config))
-      (when (and (< point (point-max))
-                (goto-char point)
-                (eq (char-after) ?\n))
-       (subst-char-in-region point (1+ point) ?\n ?\r)))))
+  (save-excursion
+    (let (point buffer-read-only)
+      (while (setq point (pop config))
+       (when (and (< point (point-max))
+                  (goto-char point)
+                  (eq (char-after) ?\n))
+         (subst-char-in-region point (1+ point) ?\n ?\r))))))
 
 ;; Various summary mode internalish functions.
 
 
 ;; Various summary mode internalish functions.
 
@@ -2663,9 +2676,8 @@ buffer that was in action when the last article was fetched."
          (cond
           ((string-match "<[^>]+> *$" gnus-tmp-from)
            (let ((beg (match-beginning 0)))
          (cond
           ((string-match "<[^>]+> *$" gnus-tmp-from)
            (let ((beg (match-beginning 0)))
-             (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from)
-                      (substring gnus-tmp-from (1+ (match-beginning 0))
-                                 (1- (match-end 0))))
+             (or (and (string-match "^\".+\"" gnus-tmp-from)
+                      (substring gnus-tmp-from 1 (1- (match-end 0))))
                  (substring gnus-tmp-from 0 beg))))
           ((string-match "(.+)" gnus-tmp-from)
            (substring gnus-tmp-from
                  (substring gnus-tmp-from 0 beg))))
           ((string-match "(.+)" gnus-tmp-from)
            (substring gnus-tmp-from
@@ -3096,7 +3108,7 @@ If SHOW-ALL is non-nil, already read articles are also listed."
     result))
 
 (defun gnus-sort-gathered-threads (threads)
     result))
 
 (defun gnus-sort-gathered-threads (threads)
-  "Sort subtreads inside each gathered thread by article number."
+  "Sort subtreads inside each gathered thread by `gnus-sort-gathered-threads-function'."
   (let ((result threads))
     (while threads
       (when (stringp (caar threads))
   (let ((result threads))
     (while threads
       (when (stringp (caar threads))
@@ -3270,7 +3282,7 @@ Returns HEADER if it was entered in the DEPENDENCIES.  Returns nil otherwise."
     (mapcar
      (lambda (relation)
        (when (gnus-dependencies-add-header
     (mapcar
      (lambda (relation)
        (when (gnus-dependencies-add-header
-             (make-full-mail-header
+             (make-full-mail-header-from-decoded-header
               gnus-reffed-article-number
               (nth 3 relation) "" (or (nth 4 relation) "")
               (nth 1 relation)
               gnus-reffed-article-number
               (nth 3 relation) "" (or (nth 4 relation) "")
               (nth 1 relation)
@@ -3313,22 +3325,29 @@ Returns HEADER if it was entered in the DEPENDENCIES.  Returns nil otherwise."
        header)
 
     ;; overview: [num subject from date id refs chars lines misc]
        header)
 
     ;; overview: [num subject from date id refs chars lines misc]
-    (unless (eobp)
-      (forward-char))
-
-    (setq header
-         (make-full-mail-header
-          number                               ; number
-          (nnheader-nov-field)                 ; subject
-          (nnheader-nov-field)                 ; from
-          (nnheader-nov-field)                 ; date
-          (nnheader-nov-read-message-id)       ; id
-          (nnheader-nov-field)                 ; refs
-          (nnheader-nov-read-integer)          ; chars
-          (nnheader-nov-read-integer)          ; lines
-          (unless (eobp)
-            (nnheader-nov-field))              ; misc
-          (nnheader-nov-parse-extra)))         ; extra
+    (unwind-protect
+       (progn
+         (narrow-to-region (point) eol)
+         (unless (eobp)
+           (forward-char))
+
+         (setq header
+               (make-full-mail-header
+                number                         ; number
+                (nnheader-nov-field)           ; subject
+                (nnheader-nov-field)           ; from
+                (nnheader-nov-field)           ; date
+                (nnheader-nov-read-message-id) ; id
+                (nnheader-nov-field)           ; refs
+                (nnheader-nov-read-integer)    ; chars
+                (nnheader-nov-read-integer)    ; lines
+                (unless (eobp)
+                  (if (looking-at "Xref: ")
+                      (goto-char (match-end 0)))
+                  (nnheader-nov-field))        ; Xref
+                (nnheader-nov-parse-extra))))  ; extra
+
+      (widen))
 
     (when gnus-alter-header-function
       (funcall gnus-alter-header-function header))
 
     (when gnus-alter-header-function
       (funcall gnus-alter-header-function header))
@@ -3664,13 +3683,22 @@ If LINE, insert the rebuilt thread starting on line LINE."
              (1+ (gnus-point-at-eol))
            (gnus-delete-line)))))))
 
              (1+ (gnus-point-at-eol))
            (gnus-delete-line)))))))
 
+(defun gnus-sort-threads-1 (threads func)
+  (sort (mapcar (lambda (thread)
+                 (cons (car thread)
+                       (and (cdr thread)
+                            (gnus-sort-threads-1 (cdr thread) func))))
+               threads) func))
+
 (defun gnus-sort-threads (threads)
   "Sort THREADS."
   (if (not gnus-thread-sort-functions)
       threads
     (gnus-message 8 "Sorting threads...")
     (prog1
 (defun gnus-sort-threads (threads)
   "Sort THREADS."
   (if (not gnus-thread-sort-functions)
       threads
     (gnus-message 8 "Sorting threads...")
     (prog1
-       (sort threads (gnus-make-sort-function gnus-thread-sort-functions))
+       (gnus-sort-threads-1 
+        threads 
+        (gnus-make-sort-function gnus-thread-sort-functions))
       (gnus-message 8 "Sorting threads...done"))))
 
 (defun gnus-sort-articles (articles)
       (gnus-message 8 "Sorting threads...done"))))
 
 (defun gnus-sort-articles (articles)
@@ -4036,9 +4064,8 @@ or a straight list of headers."
             (cond
              ((string-match "<[^>]+> *$" gnus-tmp-from)
               (setq beg-match (match-beginning 0))
             (cond
              ((string-match "<[^>]+> *$" gnus-tmp-from)
               (setq beg-match (match-beginning 0))
-              (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from)
-                       (substring gnus-tmp-from (1+ (match-beginning 0))
-                                  (1- (match-end 0))))
+              (or (and (string-match "^\".+\"" gnus-tmp-from)
+                       (substring gnus-tmp-from 1 (1- (match-end 0))))
                   (substring gnus-tmp-from 0 beg-match)))
              ((string-match "(.+)" gnus-tmp-from)
               (substring gnus-tmp-from
                   (substring gnus-tmp-from 0 beg-match)))
              ((string-match "(.+)" gnus-tmp-from)
               (substring gnus-tmp-from
@@ -4307,7 +4334,9 @@ If SELECT-ARTICLES, only select those articles from GROUP."
                    (if (string-match "^[ \t]*$" input)
                        number input)))
                 (t number))
                    (if (string-match "^[ \t]*$" input)
                        number input)))
                 (t number))
-             (quit nil))))))
+             (quit
+              (message "Quit getting the articles to read")
+              nil))))))
     (setq select (if (stringp select) (string-to-number select) select))
     (if (or (null select) (zerop select))
        select
     (setq select (if (stringp select) (string-to-number select) select))
     (if (or (null select) (zerop select))
        select
@@ -4741,19 +4770,20 @@ The resulting hash table is returned, or nil if no Xrefs were found."
            (progn
              (goto-char p)
              (if (search-forward "\nsubject: " nil t)
            (progn
              (goto-char p)
              (if (search-forward "\nsubject: " nil t)
-                 (buffer-substring (match-end 0) (std11-field-end))
+                 (nnheader-header-value)
                "(none)"))
            ;; From.
            (progn
              (goto-char p)
                "(none)"))
            ;; From.
            (progn
              (goto-char p)
-             (if (search-forward "\nfrom: " nil t)
-                 (buffer-substring (match-end 0) (std11-field-end))
+             (if (or (search-forward "\nfrom: " nil t)
+                     (search-forward "\nfrom:" nil t))
+                 (nnheader-header-value)
                "(nobody)"))
            ;; Date.
            (progn
              (goto-char p)
              (if (search-forward "\ndate: " nil t)
                "(nobody)"))
            ;; Date.
            (progn
              (goto-char p)
              (if (search-forward "\ndate: " nil t)
-                 (buffer-substring (match-end 0) (std11-field-end))
+                 (nnheader-header-value)
                ""))
            ;; Message-ID.
            (progn
                ""))
            ;; Message-ID.
            (progn
@@ -4774,7 +4804,7 @@ The resulting hash table is returned, or nil if no Xrefs were found."
                  (progn
                    (setq end (point))
                    (prog1
                  (progn
                    (setq end (point))
                    (prog1
-                       (buffer-substring (match-end 0) (std11-field-end))
+                       (nnheader-header-value)
                      (setq ref
                            (buffer-substring
                             (progn
                      (setq ref
                            (buffer-substring
                             (progn
@@ -4788,9 +4818,7 @@ The resulting hash table is returned, or nil if no Xrefs were found."
                ;; were no references and the in-reply-to header looks
                ;; promising.
                (if (and (search-forward "\nin-reply-to: " nil t)
                ;; were no references and the in-reply-to header looks
                ;; promising.
                (if (and (search-forward "\nin-reply-to: " nil t)
-                        (setq in-reply-to
-                              (buffer-substring (match-end 0)
-                                                (std11-field-end)))
+                        (setq in-reply-to (nnheader-header-value))
                         (string-match "<[^>]+>" in-reply-to))
                    (let (ref2)
                      (setq ref (substring in-reply-to (match-beginning 0)
                         (string-match "<[^>]+>" in-reply-to))
                    (let (ref2)
                      (setq ref (substring in-reply-to (match-beginning 0)
@@ -4820,7 +4848,7 @@ The resulting hash table is returned, or nil if no Xrefs were found."
            (progn
              (goto-char p)
              (and (search-forward "\nxref: " nil t)
            (progn
              (goto-char p)
              (and (search-forward "\nxref: " nil t)
-                  (buffer-substring (match-end 0) (std11-field-end))))
+                  (nnheader-header-value)))
            ;; Extra.
            (when gnus-extra-headers
              (let ((extra gnus-extra-headers)
            ;; Extra.
            (when gnus-extra-headers
              (let ((extra gnus-extra-headers)
@@ -4829,16 +4857,12 @@ The resulting hash table is returned, or nil if no Xrefs were found."
                  (goto-char p)
                  (when (search-forward
                         (concat "\n" (symbol-name (car extra)) ": ") nil t)
                  (goto-char p)
                  (when (search-forward
                         (concat "\n" (symbol-name (car extra)) ": ") nil t)
-                   (push (cons (car extra)
-                               (buffer-substring (match-end 0)
-                                                 (std11-field-end)))
-                         out))
+                   (push (cons (car extra) (nnheader-header-value)) out))
                  (pop extra))
                out))))
          (goto-char p)
          (if (and (search-forward "\ncontent-type: " nil t)
                  (pop extra))
                out))))
          (goto-char p)
          (if (and (search-forward "\ncontent-type: " nil t)
-                  (setq ctype
-                        (buffer-substring (match-end 0) (std11-field-end))))
+                  (setq ctype (nnheader-header-value)))
              (mime-entity-set-content-type-internal
               header (mime-parse-Content-Type ctype)))
          (when (equal id ref)
              (mime-entity-set-content-type-internal
               header (mime-parse-Content-Type ctype)))
          (when (equal id ref)
@@ -6892,7 +6916,8 @@ of what's specified by the `gnus-refer-thread-limit' variable."
    ((eq 'current gnus-refer-article-method)
     (list gnus-current-select-method))
    ;; List of select methods.
    ((eq 'current gnus-refer-article-method)
     (list gnus-current-select-method))
    ;; List of select methods.
-   ((not (stringp (cadr gnus-refer-article-method)))
+   ((not (and (symbolp (car gnus-refer-article-method))
+             (assq (car gnus-refer-article-method) nnoo-definition-alist)))
     (let (out)
       (dolist (method gnus-refer-article-method)
        (push (if (eq 'current method)
     (let (out)
       (dolist (method gnus-refer-article-method)
        (push (if (eq 'current method)
@@ -6942,7 +6967,10 @@ to guess what the document format is."
        ;; the parent article.
        (when (setq to-address (or (message-fetch-field "reply-to")
                                   (message-fetch-field "from")))
        ;; the parent article.
        (when (setq to-address (or (message-fetch-field "reply-to")
                                   (message-fetch-field "from")))
-         (setq params (append (list (cons 'to-address to-address)))))
+         (setq params (append 
+                       (list (cons 'to-address 
+                                   (funcall gnus-decode-encoded-word-function
+                                            to-address))))))
        (setq dig (nnheader-set-temp-buffer " *gnus digest buffer*"))
        (insert-buffer-substring gnus-original-article-buffer)
        ;; Remove lines that may lead nndoc to misinterpret the
        (setq dig (nnheader-set-temp-buffer " *gnus digest buffer*"))
        (insert-buffer-substring gnus-original-article-buffer)
        ;; Remove lines that may lead nndoc to misinterpret the
@@ -7372,7 +7400,26 @@ without any article massaging functions being run."
           (or (cdr (assq arg gnus-summary-show-article-charset-alist))
               (read-coding-system "Charset: ")))
          (gnus-newsgroup-ignored-charsets 'gnus-all))
           (or (cdr (assq arg gnus-summary-show-article-charset-alist))
               (read-coding-system "Charset: ")))
          (gnus-newsgroup-ignored-charsets 'gnus-all))
-      (gnus-summary-select-article nil 'force)))
+      (gnus-summary-select-article nil 'force)
+      (let ((deps gnus-newsgroup-dependencies)
+           head header)
+       (save-excursion
+         (set-buffer gnus-original-article-buffer)
+         (save-restriction
+           (message-narrow-to-head)
+           (setq head (buffer-string)))
+         (with-temp-buffer
+           (insert (format "211 %d Article retrieved.\n"
+                           (cdr gnus-article-current)))
+           (insert head)
+           (insert ".\n")
+           (let ((nntp-server-buffer (current-buffer)))
+             (setq header (car (gnus-get-newsgroup-headers deps t))))))
+       (gnus-data-set-header
+        (gnus-data-find (cdr gnus-article-current))
+        header)
+       (gnus-summary-update-article-line
+        (cdr gnus-article-current) header))))
    ((not arg)
     ;; Select the article the normal way.
     (gnus-summary-select-article nil 'force))
    ((not arg)
     ;; Select the article the normal way.
     (gnus-summary-select-article nil 'force))
@@ -7849,6 +7896,9 @@ This will be the case if the article has both been mailed and posted."
           (expiry-wait (if now 'immediate
                          (gnus-group-find-parameter
                           gnus-newsgroup-name 'expiry-wait)))
           (expiry-wait (if now 'immediate
                          (gnus-group-find-parameter
                           gnus-newsgroup-name 'expiry-wait)))
+          (nnmail-expiry-target
+           (or (gnus-group-find-parameter gnus-newsgroup-name 'expiry-target)
+               nnmail-expiry-target))
           es)
       (when expirable
        ;; There are expirable articles in this group, so we run them
           es)
       (when expirable
        ;; There are expirable articles in this group, so we run them
@@ -7864,19 +7914,19 @@ This will be the case if the article has both been mailed and posted."
                (setq es (gnus-request-expire-articles
                          expirable gnus-newsgroup-name)))
            (setq es (gnus-request-expire-articles
                (setq es (gnus-request-expire-articles
                          expirable gnus-newsgroup-name)))
            (setq es (gnus-request-expire-articles
-                     expirable gnus-newsgroup-name))))
-       (unless total
-         (setq gnus-newsgroup-expirable es))
-       ;; We go through the old list of expirable, and mark all
-       ;; really expired articles as nonexistent.
-       (unless (eq es expirable)       ;If nothing was expired, we don't mark.
-         (let ((gnus-use-cache nil))
-           (while expirable
-             (unless (memq (car expirable) es)
-               (when (gnus-data-find (car expirable))
-                 (gnus-summary-mark-article
-                  (car expirable) gnus-canceled-mark)))
-             (setq expirable (cdr expirable)))))
+                     expirable gnus-newsgroup-name)))
+         (unless total
+           (setq gnus-newsgroup-expirable es))
+         ;; We go through the old list of expirable, and mark all
+         ;; really expired articles as nonexistent.
+         (unless (eq es expirable)     ;If nothing was expired, we don't mark.
+           (let ((gnus-use-cache nil))
+             (while expirable
+               (unless (memq (car expirable) es)
+                 (when (gnus-data-find (car expirable))
+                   (gnus-summary-mark-article
+                    (car expirable) gnus-canceled-mark)))
+               (setq expirable (cdr expirable))))))
        (gnus-message 6 "Expiring articles...done")))))
 
 (defun gnus-summary-expire-articles-now ()
        (gnus-message 6 "Expiring articles...done")))))
 
 (defun gnus-summary-expire-articles-now ()
@@ -7903,6 +7953,8 @@ delete these instead."
   (unless (gnus-check-backend-function 'request-expire-articles
                                       gnus-newsgroup-name)
     (error "The current newsgroup does not support article deletion"))
   (unless (gnus-check-backend-function 'request-expire-articles
                                       gnus-newsgroup-name)
     (error "The current newsgroup does not support article deletion"))
+  (unless (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name))
+    (error "Couldn't open server"))
   ;; Compute the list of articles to delete.
   (let ((articles (sort (copy-sequence (gnus-summary-work-articles n)) '<))
        not-deleted)
   ;; Compute the list of articles to delete.
   (let ((articles (sort (copy-sequence (gnus-summary-work-articles n)) '<))
        not-deleted)
@@ -7948,6 +8000,8 @@ groups."
        'ignore
        `(lambda (no-highlight)
          (let ((mail-parse-charset ',gnus-newsgroup-charset)
        'ignore
        `(lambda (no-highlight)
          (let ((mail-parse-charset ',gnus-newsgroup-charset)
+               (message-options message-options)
+               (message-options-set-recipient)
                (mail-parse-ignored-charsets
                 ',gnus-newsgroup-ignored-charsets))
            (gnus-summary-edit-article-done
                (mail-parse-ignored-charsets
                 ',gnus-newsgroup-ignored-charsets))
            (gnus-summary-edit-article-done
@@ -8823,14 +8877,16 @@ is non-nil or the Subject: of both articles are the same."
        (unless (and message-id (not (equal message-id "")))
          (error "No message-id in desired parent"))
        (gnus-with-article current-article
        (unless (and message-id (not (equal message-id "")))
          (error "No message-id in desired parent"))
        (gnus-with-article current-article
-         (goto-char (point-min))
-         (if (re-search-forward "^References: " nil t)
-             (progn
-               (re-search-forward "^[^ \t]" nil t)
-               (forward-line -1)
-               (end-of-line)
-               (insert " " message-id))
-           (insert "References: " message-id "\n")))
+         (save-restriction
+           (goto-char (point-min))
+           (message-narrow-to-head)
+           (if (re-search-forward "^References: " nil t)
+               (progn
+                 (re-search-forward "^[^ \t]" nil t)
+                 (forward-line -1)
+                 (end-of-line)
+                 (insert " " message-id))
+             (insert "References: " message-id "\n"))))
        (set-buffer gnus-summary-buffer)
        (gnus-summary-unmark-all-processable)
        (gnus-summary-update-article current-article)
        (set-buffer gnus-summary-buffer)
        (gnus-summary-unmark-all-processable)
        (gnus-summary-update-article current-article)
@@ -9082,6 +9138,8 @@ Argument REVERSE means reverse order."
              thread
            `(lambda (t1 t2)
               (,thread t2 t1))))
              thread
            `(lambda (t1 t2)
               (,thread t2 t1))))
+        (gnus-sort-gathered-threads-function
+         gnus-thread-sort-functions)
         (gnus-article-sort-functions
          (if (not reverse)
              article
         (gnus-article-sort-functions
          (if (not reverse)
              article
@@ -9215,7 +9273,7 @@ save those articles instead."
        (set-buffer gnus-original-article-buffer)
        (save-restriction
          (nnheader-narrow-to-headers)
        (set-buffer gnus-original-article-buffer)
        (save-restriction
          (nnheader-narrow-to-headers)
-         (while methods
+         (while (and methods (not split-name))
            (goto-char (point-min))
            (setq method (pop methods))
            (setq match (car method))
            (goto-char (point-min))
            (setq method (pop methods))
            (setq match (car method))
@@ -9234,7 +9292,7 @@ save those articles instead."
                    (save-restriction
                      (widen)
                      (setq result (eval match)))))
                    (save-restriction
                      (widen)
                      (setq result (eval match)))))
-             (setq split-name (append (cdr method) split-name))
+             (setq split-name (cdr method))
              (cond ((stringp result)
                     (push (expand-file-name
                            result gnus-article-save-directory)
              (cond ((stringp result)
                     (push (expand-file-name
                            result gnus-article-save-directory)
@@ -9303,8 +9361,14 @@ save those articles instead."
   "Save parts matching TYPE to DIR.
 If REVERSE, save parts that do not match TYPE."
   (interactive
   "Save parts matching TYPE to DIR.
 If REVERSE, save parts that do not match TYPE."
   (interactive
-   (list (read-string "Save parts of type: " "image/.*")
-        (read-file-name "Save to directory: " nil nil t)
+   (list (read-string "Save parts of type: " 
+                     (or (car gnus-summary-save-parts-type-history)
+                         gnus-summary-save-parts-default-mime)
+                     'gnus-summary-save-parts-type-history)
+        (setq gnus-summary-save-parts-last-directory
+              (read-file-name "Save to directory: " 
+                              gnus-summary-save-parts-last-directory
+                              nil t))
         current-prefix-arg))
   (gnus-summary-iterate n
     (let ((gnus-display-mime-function nil)
         current-prefix-arg))
   (gnus-summary-iterate n
     (let ((gnus-display-mime-function nil)
@@ -9312,10 +9376,12 @@ If REVERSE, save parts that do not match TYPE."
       (gnus-summary-select-article))
     (save-excursion
       (set-buffer gnus-article-buffer)
       (gnus-summary-select-article))
     (save-excursion
       (set-buffer gnus-article-buffer)
-      (let ((handles (or (mm-dissect-buffer) (mm-uu-dissect))))
+      (let ((handles (or gnus-article-mime-handles
+                        (mm-dissect-buffer) (mm-uu-dissect))))
        (when handles
          (gnus-summary-save-parts-1 type dir handles reverse)
        (when handles
          (gnus-summary-save-parts-1 type dir handles reverse)
-         (mm-destroy-parts handles))))))
+         (unless gnus-article-mime-handles ;; Don't destroy this case.
+           (mm-destroy-parts handles)))))))
 
 (defun gnus-summary-save-parts-1 (type dir handle reverse)
   (if (stringp (car handle))
 
 (defun gnus-summary-save-parts-1 (type dir handle reverse)
   (if (stringp (car handle))
@@ -9621,23 +9687,32 @@ If REVERSE, save parts that do not match TYPE."
       (if compute
          read
        (save-excursion
       (if compute
          read
        (save-excursion
-         (set-buffer gnus-group-buffer)
-         (gnus-undo-register
-           `(progn
-              (gnus-info-set-marks ',info ',(gnus-info-marks info) t)
-              (gnus-info-set-read ',info ',(gnus-info-read info))
-              (gnus-get-unread-articles-in-group ',info (gnus-active ,group))
-              (gnus-group-update-group ,group t))))
-       ;; Propagate the read marks to the backend.
-       (if (gnus-check-backend-function 'request-set-mark group)
-           (let ((del (gnus-remove-from-range (gnus-info-read info) read))
-                 (add (gnus-remove-from-range read (gnus-info-read info))))
-             (when (or add del)
-               (unless (gnus-check-group group)
-                 (error "Can't open server for %s" group))
-               (gnus-request-set-mark
-                group (delq nil (list (if add (list add 'add '(read)))
-                                      (if del (list del 'del '(read)))))))))
+         (let (setmarkundo)
+           ;; Propagate the read marks to the backend.
+           (when (gnus-check-backend-function 'request-set-mark group)
+             (let ((del (gnus-remove-from-range (gnus-info-read info) read))
+                   (add (gnus-remove-from-range read (gnus-info-read info))))
+               (when (or add del)
+                 (unless (gnus-check-group group)
+                   (error "Can't open server for %s" group))
+                 (gnus-request-set-mark
+                  group (delq nil (list (if add (list add 'add '(read)))
+                                        (if del (list del 'del '(read))))))
+                 (setq setmarkundo
+                       `(gnus-request-set-mark
+                         ,group
+                         ',(delq nil (list
+                                      (if del (list del 'add '(read)))
+                                      (if add (list add 'del '(read))))))))))
+           (set-buffer gnus-group-buffer)
+           (gnus-undo-register
+             `(progn
+                (gnus-info-set-marks ',info ',(gnus-info-marks info) t)
+                (gnus-info-set-read ',info ',(gnus-info-read info))
+                (gnus-get-unread-articles-in-group ',info 
+                                                   (gnus-active ,group))
+                (gnus-group-update-group ,group t)
+                ,setmarkundo))))
        ;; Enter this list into the group info.
        (gnus-info-set-read info read)
        ;; Set the number of unread articles in gnus-newsrc-hashtb.
        ;; Enter this list into the group info.
        (gnus-info-set-read info read)
        ;; Set the number of unread articles in gnus-newsrc-hashtb.