;;; gnus-art.el --- article mode commands for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005
-;; Free Software Foundation, Inc.
+
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+;; 2005 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
:type '(repeat (cons (string :tag "name")
(function))))
+(defcustom gnus-auto-select-part 1
+ "Advance to next MIME part when deleting or stripping parts.
+
+When 0, point will be placed on the same part as before. When
+positive (negative), move point forward (backwards) this many
+parts. When nil, redisplay article."
+ :version "23.0" ;; No Gnus
+ :group 'gnus-article-mime
+ :type '(choice (const nil :tag "Redisplay article.")
+ (const 1 :tag "Next part.")
+ (const 0 :tag "Current part.")
+ integer))
+
;;;
;;; The treatment variables
;;;
(delete-region (point) (point-max))
(mm-display-parts handles))))))
+(defun gnus-article-jump-to-part (n)
+ "Jump to MIME part N."
+ (interactive "P")
+ (pop-to-buffer gnus-article-buffer)
+ (let ((parts (length gnus-article-mime-handle-alist)))
+ (or n (setq n
+ (string-to-number
+ (read-string ;; Emacs 21 doesn't have `read-number'.
+ (format "Jump to part (2..%s): " parts)))))
+ (unless (and (integerp n) (<= n parts) (>= n 1))
+ (setq n
+ (progn
+ (gnus-message 7 "Invalid part `%s', using %s instead."
+ n parts)
+ parts)))
+ (gnus-message 9 "Jumping to part %s." n)
+ (gnus-article-goto-part n)))
+
(eval-when-compile
- (defsubst gnus-article-edit-part (handles)
+ (defsubst gnus-article-edit-part (handles &optional current-id)
"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-summary-edit-article-done
,(or (mail-header-references gnus-current-headers) "")
,(gnus-group-read-only-p)
- ,gnus-summary-buffer no-highlight)))
+ ,gnus-summary-buffer no-highlight))
+ t)
(gnus-article-edit-done)
(gnus-summary-expand-window)
- (gnus-summary-show-article)))
+ (gnus-summary-show-article)
+ (when (and current-id (integerp gnus-auto-select-part))
+ (gnus-article-jump-to-part
+ (+ current-id gnus-auto-select-part)))))
(defun gnus-mime-save-part-and-strip ()
"Save the MIME part under point then replace it with an external body."
(when (mm-complicated-handles gnus-article-mime-handles)
(error "\
The current article has a complicated MIME structure, giving up..."))
- (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)
- (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)))))
+ (let* ((data (get-text-property (point) 'gnus-data))
+ (id (get-text-property (point) 'gnus-part))
+ file param
+ (handles gnus-article-mime-handles))
+ (setq file (and data (mm-save-part data "Delete MIME part and save to: ")))
+ (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-part handles id))))
(defun gnus-mime-delete-part ()
"Delete the MIME part under point.
(when (mm-complicated-handles gnus-article-mime-handles)
(error "\
The current article has a complicated MIME structure, giving up..."))
- (when (gnus-yes-or-no-p "\
-Deleting parts may malfunction or destroy the article; continue? ")
+ (when (or gnus-expert-user
+ (gnus-yes-or-no-p "\
+Deleting parts may malfunction or destroy the article; continue? "))
(let* ((data (get-text-property (point) 'gnus-data))
+ (id (get-text-property (point) 'gnus-part))
(handles gnus-article-mime-handles)
(none "(none)")
(description
nil `("text/plain") nil nil
(list "attachment")
(format "Deleted attachment (%s bytes)" bsize))))))
- (set-buffer gnus-summary-buffer)
- (gnus-article-edit-part handles))))
+ ;; (set-buffer gnus-summary-buffer)
+ (gnus-article-edit-part handles id))))
(defun gnus-mime-save-part ()
"Save the MIME part under point."
(if action-pair
(funcall (cdr action-pair)))))
-(defun gnus-article-part-wrapper (n function)
+(defun gnus-article-part-wrapper (n function &optional no-handle)
(with-current-buffer gnus-article-buffer
(when (> n (length gnus-article-mime-handle-alist))
(error "No such part"))
(gnus-article-goto-part n)
- (let ((handle (cdr (assq n gnus-article-mime-handle-alist))))
- (funcall function handle))))
+ (if no-handle
+ (funcall function)
+ (let ((handle (cdr (assq n gnus-article-mime-handle-alist))))
+ (funcall function handle)))))
(defun gnus-article-pipe-part (n)
"Pipe MIME part N, which is the numerical prefix."
(interactive "p")
(gnus-article-part-wrapper n 'gnus-mime-inline-part))
+(defun gnus-article-save-part-and-strip (n)
+ "Save MIME part N and replace it with an external body.
+N is the numerical prefix."
+ (interactive "p")
+ (gnus-article-part-wrapper n 'gnus-mime-save-part-and-strip t))
+
+(defun gnus-article-delete-part (n)
+ "Delete MIME part N and add some information about the removed part.
+N is the numerical prefix."
+ (interactive "p")
+ (gnus-article-part-wrapper n 'gnus-mime-delete-part t))
+
(defun gnus-article-mime-match-handle-first (condition)
(if condition
(let (n)
,(or (mail-header-references gnus-current-headers) "")
,(gnus-group-read-only-p) ,gnus-summary-buffer no-highlight))))
-(defun gnus-article-edit-article (start-func exit-func)
+(defun gnus-article-edit-article (start-func exit-func &optional quiet)
"Start editing the contents of the current article buffer."
(let ((winconf (current-window-configuration)))
(set-buffer gnus-article-buffer)
(gnus-configure-windows 'edit-article)
(setq gnus-article-edit-done-function exit-func)
(setq gnus-prev-winconf winconf)
- (gnus-message 6 "C-c C-c to end edits")))
+ (unless quiet
+ (gnus-message 6 "C-c C-c to end edits"))))
(defun gnus-article-edit-done (&optional arg)
"Update the article edits and exit."
projects / gnus / blobdiff