From: Reiner Steib Date: Mon, 21 Apr 2003 18:18:50 +0000 (+0000) Subject: (gnus-mime-delete-part): Require confirmation. X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=commitdiff_plain;h=ded090cba419d872bc2b7aa102db21af0a04a134 (gnus-mime-delete-part): Require confirmation. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 2a2d83c06..d8fab2498 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,7 @@ +2003-04-21 Reiner Steib + + * gnus-art.el (gnus-mime-delete-part): Require confirmation. + 2003-04-21 Jesper Harder * smime.el (smime-decrypt-region): Insert From header. diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index d8f154ce0..4455b2c25 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -3943,77 +3943,80 @@ General format specifiers can also be used. See Info node Replace it with some information about the removed part." (interactive) (gnus-article-check-buffer) - (let* ((data (get-text-property (point) 'gnus-data)) - (handles gnus-article-mime-handles) - (none "(none)") - (description - (or - (mail-decode-encoded-word-string (or (mm-handle-description data) - none)))) - (filename - (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) - (insert - (concat - "<#part type=text/plain nofile=yes disposition=attachment" - " description=\"Deleted attachment (" bsize " Byte)\">" - ",----\n" - "| The following attachment has been deleted:\n" - "|\n" - "| Type: " type "\n" - "| Filename: " filename "\n" - "| Size (encoded): " bsize " Byte\n" - "| Description: " description "\n" - "`----\n" - "<#/part>")) - (setcdr data - (cdr (mm-make-handle nil `("text/plain")))))) - (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)) - ;; LOCAL argument of add-hook differs between GNU Emacs - ;; and XEmacs. make-local-hook makes sure they are local. - (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)))) + (unless (and gnus-novice-user + (not (gnus-yes-or-no-p + "Really delete attachment forever? "))) + (let* ((data (get-text-property (point) 'gnus-data)) + (handles gnus-article-mime-handles) + (none "(none)") + (description + (or + (mail-decode-encoded-word-string (or (mm-handle-description data) + none)))) + (filename + (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) + (insert + (concat + "<#part type=text/plain nofile=yes disposition=attachment" + " description=\"Deleted attachment (" bsize " Byte)\">" + ",----\n" + "| The following attachment has been deleted:\n" + "|\n" + "| Type: " type "\n" + "| Filename: " filename "\n" + "| Size (encoded): " bsize " Byte\n" + "| Description: " description "\n" + "`----\n" + "<#/part>")) + (setcdr data + (cdr (mm-make-handle nil `("text/plain")))))) + (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)) + ;; LOCAL argument of add-hook differs between GNU Emacs + ;; and XEmacs. make-local-hook makes sure they are local. + (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)