2000-11-02 23:35:50 ShengHuo ZHU <zsh@cs.rochester.edu>

	* mm-decode.el (mm-save-part): Return the filename.
	* gnus-sum.el (gnus-summary-edit-article): Remove a hack.
	* gnus-art.el (gnus-mime-save-part-and-strip): New function.
	(gnus-mime-action-alist): Use it.
	(gnus-mime-button-commands): USe it.
	* mm-extern.el (mm-extern-local-file): Error when the file is gone.
	(mm-inline-external-body): unwind-protect.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 8119030..682be2c 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,13 @@
+2000-11-02 23:35:50  ShengHuo ZHU  <zsh@cs.rochester.edu>
+
+       * mm-decode.el (mm-save-part): Return the filename.
+       * gnus-sum.el (gnus-summary-edit-article): Remove a hack.
+       * gnus-art.el (gnus-mime-save-part-and-strip): New function.
+       (gnus-mime-action-alist): Use it.
+       (gnus-mime-button-commands): USe it.
+       * mm-extern.el (mm-extern-local-file): Error when the file is gone.
+       (mm-inline-external-body): unwind-protect.
+
 2000-11-02 21:08:49  ShengHuo ZHU  <zsh@cs.rochester.edu>
 
        * gnus-art.el (gnus-insert-mime-button): Show url.

diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el
index cff74ed..4ae78ad 100644 (file)
--- a/lisp/gnus-art.el
+++ b/lisp/gnus-art.el
@@ -659,6 +659,7 @@ used."
 
 (defcustom gnus-mime-action-alist
   '(("save to file" . gnus-mime-save-part)
+    ("save and strip" . gnus-mime-save-part-and-strip)
     ("display as text" . gnus-mime-inline-part)
     ("view the part" . gnus-mime-view-part)
     ("pipe to command" . gnus-mime-pipe-part)
@@ -2923,6 +2924,7 @@ If ALL-HEADERS is non-nil, no headers are hidden."
     (gnus-mime-view-part "v" "View Interactively...")
     (gnus-mime-view-part-as-type "t" "View As Type...")
     (gnus-mime-save-part "o" "Save...")
+    (gnus-mime-save-part-and-strip "\C-o" "Save and Strip")
     (gnus-mime-copy-part "c" "View As Text, In Other Buffer")
     (gnus-mime-inline-part "i" "View As Text, In This Buffer")
     (gnus-mime-internalize-part "E" "View Internally")
@@ -2974,6 +2976,77 @@ If ALL-HEADERS is non-nil, no headers are hidden."
          (gnus-mime-view-all-parts (cdr handles))
        (mapcar 'mm-display-part handles)))))
 
+(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 (mm-save-part data))
+        param)
+    (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 () 
+          (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))
+            (insert-buffer gnus-original-article-buffer)
+            (save-restriction
+              (message-narrow-to-head)
+              (message-remove-header "Content-Type")
+              (message-remove-header "MIME-Version")
+              (message-remove-header "Content-Transfer-Encoding")
+              (mail-decode-encoded-word-region (point-min) (point-max))
+              (goto-char (point-max)))
+            (forward-char 1)
+            (delete-region (point) (point-max))
+            (setq mml-buffer-list nil)
+            (if (stringp (car gnus-article-mime-handles))
+                (mml-insert-mime gnus-article-mime-handles)
+              (mml-insert-mime gnus-article-mime-handles t))
+            (mm-destroy-parts gnus-article-mime-handles)
+            (setq gnus-article-mime-handles nil)
+            (make-local-hook 'kill-buffer-hook)
+            (let ((mbl1 mml-buffer-list))
+              (setq mml-buffer-list mbl)
+              (set (make-local-variable 'mml-buffer-list) mbl1))
+            (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))))))
+
 (defun gnus-mime-save-part ()
   "Save the MIME part under point."
   (interactive)

diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el
index 0448d57..5901a5c 100644 (file)
--- a/lisp/gnus-sum.el
+++ b/lisp/gnus-sum.el
@@ -7902,9 +7902,9 @@ groups."
                 (setq mml-buffer-list nil)
                 (mime-to-mml)
                 (make-local-hook 'kill-buffer-hook)
-                (let ((mml-buffer-list mml-buffer-list))
+                (let ((mbl1 mml-buffer-list))
                   (setq mml-buffer-list mbl)
-                  (make-local-variable 'mml-buffer-list))
+                  (set (make-local-variable 'mml-buffer-list) mbl1))
                 (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))))
         `(lambda (no-highlight)
            (let ((mail-parse-charset ',gnus-newsgroup-charset)

diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el
index 9f30ae4..1cfcd1c 100644 (file)
--- a/lisp/mm-decode.el
+++ b/lisp/mm-decode.el
@@ -718,10 +718,12 @@ external if displayed external."
                           (or filename name "")
                           (or mm-default-directory default-directory))))
     (setq mm-default-directory (file-name-directory file))
-    (when (or (not (file-exists-p file))
-             (yes-or-no-p (format "File %s already exists; overwrite? "
-                                  file)))
-      (mm-save-part-to-file handle file))))
+    (and (or (not (file-exists-p file))
+            (yes-or-no-p (format "File %s already exists; overwrite? "
+                                 file)))
+        (progn
+          (mm-save-part-to-file handle file)
+          file))))
 
 (defun mm-save-part-to-file (handle file)
   (mm-with-unibyte-buffer

diff --git a/lisp/mm-extern.el b/lisp/mm-extern.el
index dfd3ca6..2fb535b 100644 (file)
--- a/lisp/mm-extern.el
+++ b/lisp/mm-extern.el
@@ -50,7 +50,9 @@
     (unless name
       (error "The filename is not specified."))
     (mm-disable-multibyte-mule4)
-    (mm-insert-file-contents name nil nil nil nil t)))
+    (if (file-exists-p name)
+       (mm-insert-file-contents name nil nil nil nil t)
+      (error "The file is gone."))))
 
 (defun mm-extern-url (handle)
   (erase-buffer)
@@ -131,11 +133,13 @@ If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing."
        (error "Multipart external body is not supported."))
       (save-excursion ;; single part
        (set-buffer (setq buf (mm-handle-buffer handles)))
-       (condition-case err
-           (funcall func handle)
-         (error 
-          (mm-destroy-parts handles)
-          (error err)))
+       (let (good)
+         (unwind-protect
+             (progn
+               (funcall func handle)
+               (setq good t))
+           (unless good
+             (mm-destroy-parts handles))))
        (mm-handle-set-cache handle handles))
       (push handles gnus-article-mime-handles))
     (unless no-display