Synch to No Gnus 200403090837.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 021c23d..af6b041 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,10 @@
+2004-03-09  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+       * gnus-art.el (gnus-article-edit-part): New function.
+       (gnus-mime-save-part-and-strip): Use it; do query instead of
+       signaling an error; don't use mm-multiple-handles.
+       (gnus-mime-delete-part): Ditto.
+
 2004-03-08  Kevin Greiner <kgreiner@xpediantsolutions.com>
 
        * gnus-agent.el (gnus-agent-read-agentview): Removed support for

diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el
index 9b45e0b..347b7dd 100644 (file)
--- a/lisp/gnus-art.el
+++ b/lisp/gnus-art.el
@@ -4320,76 +4320,89 @@ General format specifiers can also be used.  See Info node
          (delete-region (point) (point-max))
          (mm-display-parts handles))))))
 
+(eval-when-compile
+  (defsubst gnus-article-edit-part (handles)
+    "Edit an article in order to delete a mime part.
+This function is exclusively used by `gnus-mime-save-part-and-strip'
+and `gnus-mime-delete-part', and not provided at run-time normally."
+    (gnus-article-edit-article
+     `(lambda ()
+       (erase-buffer)
+       (let ((mail-parse-charset (or gnus-article-charset
+                                     ',gnus-newsgroup-charset))
+             (mail-parse-ignored-charsets
+              (or gnus-article-ignored-charsets
+                  ',gnus-newsgroup-ignored-charsets))
+             (mbl mml-buffer-list))
+         (setq mml-buffer-list nil)
+         (insert-buffer gnus-original-article-buffer)
+         (mime-to-mml ',handles)
+         (setq gnus-article-mime-handles nil)
+         (let ((mbl1 mml-buffer-list))
+           (setq mml-buffer-list mbl)
+           (set (make-local-variable 'mml-buffer-list) mbl1))
+         (gnus-make-local-hook 'kill-buffer-hook)
+         (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t)))
+     `(lambda (no-highlight)
+       (let ((mail-parse-charset (or gnus-article-charset
+                                     ',gnus-newsgroup-charset))
+             (message-options message-options)
+             (message-options-set-recipient)
+             (mail-parse-ignored-charsets
+              (or gnus-article-ignored-charsets
+                  ',gnus-newsgroup-ignored-charsets)))
+         (mml-to-mime)
+         (mml-destroy-buffers)
+         (remove-hook 'kill-buffer-hook
+                      'mml-destroy-buffers t)
+         (kill-local-variable 'mml-buffer-list))
+       (gnus-summary-edit-article-done
+        ,(or (mail-header-references gnus-current-headers) "")
+        ,(gnus-group-read-only-p)
+        ,gnus-summary-buffer no-highlight)))
+    (gnus-article-edit-done)
+    (gnus-summary-expand-window)
+    (gnus-summary-show-article)))
+
 (defun gnus-mime-save-part-and-strip ()
   "Save the MIME part under point then replace it with an external body."
   (interactive)
   (gnus-article-check-buffer)
-  (let* ((data (get-text-property (point) 'gnus-data))
-        file param
-        (handles gnus-article-mime-handles))
-    (if (mm-multiple-handles gnus-article-mime-handles)
-       (error "This function is not implemented"))
-    (setq file (and data (mm-save-part data)))
-    (when file
-      (with-current-buffer (mm-handle-buffer data)
-       (erase-buffer)
-       (insert "Content-Type: " (mm-handle-media-type data))
-       (mml-insert-parameter-string (cdr (mm-handle-type data))
-                                    '(charset))
-       (insert "\n")
-       (insert "Content-ID: " (message-make-message-id) "\n")
-       (insert "Content-Transfer-Encoding: binary\n")
-       (insert "\n"))
-      (setcdr data
-             (cdr (mm-make-handle nil
-                                  `("message/external-body"
-                                    (access-type . "LOCAL-FILE")
-                                    (name . ,file)))))
-      (set-buffer gnus-summary-buffer)
-      (gnus-article-edit-article
-       `(lambda ()
+  (when (gnus-group-read-only-p)
+    (error "The current group does not support deleting of parts"))
+  (when (gnus-yes-or-no-p "\
+Deleting parts may malfunction or destroy the article; continue? ")
+    (let* ((data (get-text-property (point) 'gnus-data))
+          file param
+          (handles gnus-article-mime-handles))
+      (setq file (and data (mm-save-part data)))
+      (when file
+       (with-current-buffer (mm-handle-buffer data)
          (erase-buffer)
-         (let ((mail-parse-charset (or gnus-article-charset
-                                       ',gnus-newsgroup-charset))
-               (mail-parse-ignored-charsets
-                (or gnus-article-ignored-charsets
-                    ',gnus-newsgroup-ignored-charsets))
-               (mbl mml-buffer-list))
-           (setq mml-buffer-list nil)
-           (insert-buffer gnus-original-article-buffer)
-           (mime-to-mml ',handles)
-           (setq gnus-article-mime-handles nil)
-           (let ((mbl1 mml-buffer-list))
-             (setq mml-buffer-list mbl)
-             (set (make-local-variable 'mml-buffer-list) mbl1))
-           (gnus-make-local-hook 'kill-buffer-hook)
-           (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t)))
-       `(lambda (no-highlight)
-         (let ((mail-parse-charset (or gnus-article-charset
-                                       ',gnus-newsgroup-charset))
-               (message-options message-options)
-               (message-options-set-recipient)
-               (mail-parse-ignored-charsets
-                (or gnus-article-ignored-charsets
-                    ',gnus-newsgroup-ignored-charsets)))
-           (mml-to-mime)
-           (mml-destroy-buffers)
-           (remove-hook 'kill-buffer-hook
-                        'mml-destroy-buffers t)
-           (kill-local-variable 'mml-buffer-list))
-         (gnus-summary-edit-article-done
-          ,(or (mail-header-references gnus-current-headers) "")
-          ,(gnus-group-read-only-p)
-          ,gnus-summary-buffer no-highlight))))))
+         (insert "Content-Type: " (mm-handle-media-type data))
+         (mml-insert-parameter-string (cdr (mm-handle-type data))
+                                      '(charset))
+         (insert "\n")
+         (insert "Content-ID: " (message-make-message-id) "\n")
+         (insert "Content-Transfer-Encoding: binary\n")
+         (insert "\n"))
+       (setcdr data
+               (cdr (mm-make-handle nil
+                                    `("message/external-body"
+                                      (access-type . "LOCAL-FILE")
+                                      (name . ,file)))))
+       (set-buffer gnus-summary-buffer)
+       (gnus-article-edit-part handles)))))
 
 (defun gnus-mime-delete-part ()
   "Delete the MIME part under point.
 Replace it with some information about the removed part."
   (interactive)
   (gnus-article-check-buffer)
-  (unless (and gnus-novice-user
-              (not (gnus-yes-or-no-p
-                    "Really delete attachment forever? ")))
+  (when (gnus-group-read-only-p)
+    (error "The current group does not support deleting of parts"))
+  (when (gnus-yes-or-no-p "\
+Deleting parts may malfunction or destroy the article; continue? ")
     (let* ((data (get-text-property (point) 'gnus-data))
           (handles gnus-article-mime-handles)
           (none "(none)")
@@ -4401,8 +4414,6 @@ Replace it with some information about the removed part."
            (or (mail-content-type-get (mm-handle-disposition data) 'filename)
                none))
           (type (mm-handle-media-type data)))
-      (if (mm-multiple-handles gnus-article-mime-handles)
-         (error "This function is not implemented"))
       (with-current-buffer (mm-handle-buffer data)
        (let ((bsize (format "%s" (buffer-size))))
          (erase-buffer)
@@ -4422,47 +4433,7 @@ Replace it with some information about the removed part."
                        (list "attachment")
                        (format "Deleted attachment (%s bytes)" bsize))))))
       (set-buffer gnus-summary-buffer)
-      ;; FIXME: maybe some of the following code (borrowed from
-      ;; `gnus-mime-save-part-and-strip') isn't necessary?
-      (gnus-article-edit-article
-       `(lambda ()
-         (erase-buffer)
-         (let ((mail-parse-charset (or gnus-article-charset
-                                       ',gnus-newsgroup-charset))
-               (mail-parse-ignored-charsets
-                (or gnus-article-ignored-charsets
-                    ',gnus-newsgroup-ignored-charsets))
-               (mbl mml-buffer-list))
-           (setq mml-buffer-list nil)
-           (insert-buffer gnus-original-article-buffer)
-           (mime-to-mml ',handles)
-           (setq gnus-article-mime-handles nil)
-           (let ((mbl1 mml-buffer-list))
-             (setq mml-buffer-list mbl)
-             (set (make-local-variable 'mml-buffer-list) mbl1))
-           (gnus-make-local-hook 'kill-buffer-hook)
-           (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t)))
-       `(lambda (no-highlight)
-         (let ((mail-parse-charset (or gnus-article-charset
-                                       ',gnus-newsgroup-charset))
-               (message-options message-options)
-               (message-options-set-recipient)
-               (mail-parse-ignored-charsets
-                (or gnus-article-ignored-charsets
-                    ',gnus-newsgroup-ignored-charsets)))
-           (mml-to-mime)
-           (mml-destroy-buffers)
-           (remove-hook 'kill-buffer-hook
-                        'mml-destroy-buffers t)
-           (kill-local-variable 'mml-buffer-list))
-         (gnus-summary-edit-article-done
-          ,(or (mail-header-references gnus-current-headers) "")
-          ,(gnus-group-read-only-p)
-          ,gnus-summary-buffer no-highlight)))))
-  ;; Not in `gnus-mime-save-part-and-strip':
-  (gnus-article-edit-done)
-  (gnus-summary-expand-window)
-  (gnus-summary-show-article))
+      (gnus-article-edit-part handles))))
 
 (defun gnus-mime-save-part ()
   "Save the MIME part under point."