(eval-when-compile
(require 'cl)
(require 'static)
- (defvar tool-bar-map))
+ (defvar tool-bar-map)
+ (defvar w3m-minor-mode-map))
(require 'path-util)
(require 'gnus)
(defcustom gnus-mime-action-alist
'(("save to file" . gnus-mime-save-part)
("save and strip" . gnus-mime-save-part-and-strip)
+ ("replace with file" . gnus-mime-replace-part)
("delete part" . gnus-mime-delete-part)
("display as text" . gnus-mime-inline-part)
("view the part" . gnus-mime-view-part)
(autoload 'idna-to-unicode "idna")
(defun article-decode-idna-rhs ()
- "Decode IDNA strings in RHS in From:, To: and Cc: headers in current buffer."
+ "Decode IDNA strings in RHS in various headers in current buffer.
+The following headers are decoded: From:, To:, Cc:, Reply-To:,
+Mail-Reply-To: and Mail-Followup-To:."
(when gnus-use-idna
(save-restriction
(let ((inhibit-point-motion-hooks t)
(inhibit-read-only t))
(article-narrow-to-head)
(goto-char (point-min))
- (while (re-search-forward "@.*\\(xn--[-A-Za-z0-9.]*\\)[ \t\n\r,>]" nil t)
+ (while (re-search-forward "@[^ \t\n\r,>]*\\(xn--[-A-Za-z0-9.]*\\)[ \t\n\r,>]" nil t)
(let (ace unicode)
(when (save-match-data
(and (setq ace (match-string 1))
(save-excursion
(and (re-search-backward "^[^ \t]" nil t)
- (looking-at "From\\|To\\|Cc")))
+ (looking-at "From\\|To\\|Cc\\|Reply-To\\|Mail-Reply-To\\|Mail-Followup-To")))
(setq unicode (idna-to-unicode ace))))
(unless (string= ace unicode)
(replace-match unicode nil nil nil 1)))))))))
((null split-name)
(read-file-name
(concat prompt " (default "
- (file-name-nondirectory default-name) ") ")
+ (file-name-nondirectory default-name) "): ")
(file-name-directory default-name)
default-name))
;; A single group name is returned.
(symbol-value variable)))
(read-file-name
(concat prompt " (default "
- (file-name-nondirectory default-name) ") ")
+ (file-name-nondirectory default-name) "): ")
(file-name-directory default-name)
default-name))
;; A single split name was found
((file-exists-p name) name)
(t gnus-article-save-directory))))
(read-file-name
- (concat prompt " (default " name ") ")
+ (concat prompt " (default " name "): ")
dir name)))
;; A list of splits was found.
(t
(setq result
(expand-file-name
(read-file-name
- (concat prompt " (`M-p' for defaults) ")
+ (concat prompt " (`M-p' for defaults): ")
gnus-article-save-directory
(car split-name))
gnus-article-save-directory)))
Optional argument FILENAME specifies file name.
Directory to save to is default to `gnus-article-save-directory'."
(setq filename (gnus-read-save-file-name
- "Save %s in rmail file:" filename
+ "Save %s in rmail file" filename
gnus-rmail-save-name gnus-newsgroup-name
gnus-current-headers 'gnus-newsgroup-last-rmail))
(gnus-eval-in-buffer-window gnus-save-article-buffer
Optional argument FILENAME specifies file name.
Directory to save to is default to `gnus-article-save-directory'."
(setq filename (gnus-read-save-file-name
- "Save %s in Unix mail file:" filename
+ "Save %s in Unix mail file" filename
gnus-mail-save-name gnus-newsgroup-name
gnus-current-headers 'gnus-newsgroup-last-mail))
(gnus-eval-in-buffer-window gnus-save-article-buffer
Optional argument FILENAME specifies file name.
Directory to save to is default to `gnus-article-save-directory'."
(setq filename (gnus-read-save-file-name
- "Save %s in file:" filename
+ "Save %s in file" filename
gnus-file-save-name gnus-newsgroup-name
gnus-current-headers 'gnus-newsgroup-last-file))
(gnus-eval-in-buffer-window gnus-save-article-buffer
Optional argument FILENAME specifies file name.
The directory to save in defaults to `gnus-article-save-directory'."
(setq filename (gnus-read-save-file-name
- "Save %s body in file:" filename
+ "Save %s body in file" filename
gnus-file-save-name gnus-newsgroup-name
gnus-current-headers 'gnus-newsgroup-last-file))
(gnus-eval-in-buffer-window gnus-save-article-buffer
(gnus-mime-view-part-as-charset "C" "View As charset...")
(gnus-mime-save-part "o" "Save...")
(gnus-mime-save-part-and-strip "\C-o" "Save and Strip")
+ (gnus-mime-replace-part "r" "Replace part")
(gnus-mime-delete-part "d" "Delete part")
(gnus-mime-copy-part "c" "View As Text, In Other Buffer")
(gnus-mime-inline-part "i" "View As Text, In This Buffer")
- (gnus-mime-view-part-internally "E" "View Internally")
+ (gnus-mime-view-part-internally "E" "View Internally") ;; Why `E'?
(gnus-mime-view-part-externally "e" "View Externally")
(gnus-mime-print-part "p" "Print")
(gnus-mime-pipe-part "|" "Pipe To Command...")
(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."
+(defun gnus-mime-replace-part (file)
+ "Replace MIME part under point with an external body."
+ ;; Useful if file has already been saved to disk
+ (interactive
+ (list
+ (mm-with-multibyte
+ (read-file-name "Replace MIME part with file: "
+ (or mm-default-directory default-directory)
+ nil nil))))
+ (gnus-mime-save-part-and-strip file))
+
+(defun gnus-mime-save-part-and-strip (&optional file)
+ "Save the MIME part under point then replace it with an external body.
+If FILE is given, use it for the external part."
(interactive)
(gnus-article-check-buffer)
(when (gnus-group-read-only-p)
The current article has a complicated MIME structure, giving up..."))
(let* ((data (get-text-property (point) 'gnus-data))
(id (get-text-property (point) 'gnus-part))
- file param
+ param
(handles gnus-article-mime-handles))
- (setq file (and data (mm-save-part data "Delete MIME part and save to: ")))
+ (unless file
+ (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)
;; (set-buffer gnus-summary-buffer)
(gnus-article-edit-part handles id))))
+;; A function like `gnus-summary-save-parts' (`X m', `<MIME> <Extract all
+;; parts...>') but with stripping would be nice.
+
(defun gnus-mime-delete-part ()
"Delete the MIME part under point.
Replace it with some information about the removed part."
(if action-pair
(funcall (cdr action-pair)))))
-(defun gnus-article-part-wrapper (n function &optional no-handle)
+(defun gnus-article-part-wrapper (n function &optional no-handle interactive)
+ "Call FUNCTION on MIME part N.
+Unless NO-HANDLE, call FUNCTION with N-th MIME handle as it's only argument.
+If INTERACTIVE, call FUNCTION interactivly."
(let (window frame)
;; Check whether the article is displayed.
(unless (and (gnus-buffer-live-p gnus-article-buffer)
(overlay-arrow-string "=>")
(overlay-arrow-position (point-marker)))
(unwind-protect
- (if no-handle
- (funcall function)
+ (cond
+ ((and no-handle interactive)
+ (call-interactively function))
+ (no-handle
+ (funcall function))
+ (interactive
+ (call-interactively
+ function
+ (cdr (assq n gnus-article-mime-handle-alist))))
+ (t
(funcall function
- (cdr (assq n gnus-article-mime-handle-alist))))
+ (cdr (assq n gnus-article-mime-handle-alist)))))
(set-marker overlay-arrow-position nil)
(unless gnus-auto-select-part
(gnus-select-frame-set-input-focus frame)
(interactive "p")
(gnus-article-part-wrapper n 'gnus-mime-save-part-and-strip t))
+(defun gnus-article-replace-part (n)
+ "Replace MIME part N with an external body.
+N is the numerical prefix."
+ (interactive "p")
+ (gnus-article-part-wrapper n 'gnus-mime-replace-part t t))
+
(defun gnus-article-delete-part (n)
"Delete MIME part N and add some information about the removed part.
N is the numerical prefix."
(defun gnus-mime-display-part (handle)
(cond
+ ;; Maybe a broken MIME message.
+ ((null handle))
;; Single part.
((not (stringp (car handle)))
(gnus-mime-display-single handle))
(forward-line -1)
(setq beg (point)))
(gnus-article-insert-newline)
- (mm-display-inline handle)
+ (mm-insert-inline
+ handle
+ (let ((charset (mail-content-type-get (mm-handle-type handle)
+ 'charset)))
+ (cond ((not charset)
+ (mm-string-as-multibyte (mm-get-part handle)))
+ ((eq charset 'gnus-decoded)
+ (with-current-buffer (mm-handle-buffer handle)
+ (buffer-string)))
+ (t
+ (mm-decode-string (mm-get-part handle) charset)))))
(goto-char (point-max))))
;; Do highlighting.
(save-excursion
projects / elisp / gnus.git- / blobdiff