X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-art.el;h=95608860f22fd499f96e0cf42916f4b68eb1fc3b;hb=7693ad423659f409f95c3faea25a601c954375e6;hp=0acc2ed142708d21e501c4640ecc9509627a23ff;hpb=1bb8aefeea724350d83dc2ad05a08a7abae4f293;p=gnus diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 0acc2ed14..95608860f 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -1,7 +1,7 @@ ;;; gnus-art.el --- article mode commands for Gnus ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006, 2007 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -15,7 +15,7 @@ ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License @@ -53,6 +53,8 @@ (autoload 'gnus-button-reply "gnus-msg" nil t) (autoload 'parse-time-string "parse-time" nil nil) (autoload 'ansi-color-apply-on-region "ansi-color") +(autoload 'mm-url-insert-file-contents-external "mm-url") +(autoload 'mm-extern-cache-contents "mm-extern") (defgroup gnus-article nil "Article display." @@ -156,7 +158,10 @@ "X-Virus-Scanned" "X-Delivery-Agent" "Posted-Date" "X-Gateway" "X-Local-Origin" "X-Local-Destination" "X-UserInfo1" "X-Received-Date" "X-Hashcash" "Face" "X-DMCA-Notifications" - "X-Abuse-and-DMCA-Info" "X-Postfilter" "X-Gpg-.*" "X-Disclaimer")) + "X-Abuse-and-DMCA-Info" "X-Postfilter" "X-Gpg-.*" "X-Disclaimer" + "Envelope-To" "X-Spam-Score" "System-Type" "X-Injected-Via-Gmane" + "X-Gmane-NNTP-Posting-Host" "Jabber-ID" "Archived-At" + "Envelope-Sender" "Envelope-Recipients")) "*All headers that start with this regexp will be hidden. This variable can also be a list of regexps of headers to be ignored. If `gnus-visible-headers' is non-nil, this variable will be ignored." @@ -247,7 +252,7 @@ This can also be a list of the above values." :type '(choice (const nil) (integer :value 200) (number :value 4.0) - (function :value fun) + function (regexp :value ".*")) :group 'gnus-article-signature) @@ -270,7 +275,7 @@ This can also be a list of the above values." display -")) "*String or function to be executed to display an X-Face header. If it is a string, the command will be executed in a sub-shell -asynchronously. The compressed face will be piped to this command." +asynchronously. The compressed face will be piped to this command." :type `(choice string (function-item gnus-display-x-face-in-from) function) @@ -497,7 +502,10 @@ be fed to `format-time-string'." :group 'gnus-article-washing) (defcustom gnus-save-all-headers t - "*If non-nil, don't remove any headers before saving." + "*If non-nil, don't remove any headers before saving. +This will be overridden by the `:headers' property that the symbol of +the saver function, which is specified by `gnus-default-article-saver', +might have." :group 'gnus-article-saving :type 'boolean) @@ -518,14 +526,17 @@ each invocation of the saving commands." "Headers to keep if `gnus-save-all-headers' is nil. If `gnus-save-all-headers' is non-nil, this variable will be ignored. If that variable is nil, however, all headers that match this regexp -will be kept while the rest will be deleted before saving." +will be kept while the rest will be deleted before saving. This and +`gnus-save-all-headers' will be overridden by the `:headers' property +that the symbol of the saver function, which is specified by +`gnus-default-article-saver', might have." :group 'gnus-article-saving :type 'regexp) (defcustom gnus-default-article-saver 'gnus-summary-save-in-rmail "A function to save articles in your favourite format. -The function must be interactively callable (in other words, it must -be an Emacs command). +The function will be called by way of the `gnus-summary-save-article' +command, and friends such as `gnus-summary-save-article-rmail'. Gnus provides the following functions: @@ -535,7 +546,28 @@ Gnus provides the following functions: * gnus-summary-save-in-file (article format) * gnus-summary-save-body-in-file (article body) * gnus-summary-save-in-vm (use VM's folder format) -* gnus-summary-write-to-file (article format -- overwrite)." +* gnus-summary-write-to-file (article format -- overwrite) +* gnus-summary-write-body-to-file (article body -- overwrite) + +The symbol of each function may have the following properties: + +* :decode +The value non-nil means save decoded articles. This is meaningful +only with `gnus-summary-save-in-file', `gnus-summary-save-body-in-file', +`gnus-summary-write-to-file', and `gnus-summary-write-body-to-file'. + +* :function +The value specifies an alternative function which appends, not +overwrites, articles to a file. This implies that when saving many +articles at a time, `gnus-prompt-before-saving' is bound to t and all +articles are saved in a single file. This is meaningful only with +`gnus-summary-write-to-file' and `gnus-summary-write-body-to-file'. + +* :headers +The value specifies the symbol of a variable of which the value +specifies headers to be saved. If it is omitted, +`gnus-save-all-headers' and `gnus-saved-headers' control what +headers should be saved." :group 'gnus-article-saving :type '(radio (function-item gnus-summary-save-in-rmail) (function-item gnus-summary-save-in-mail) @@ -543,7 +575,49 @@ Gnus provides the following functions: (function-item gnus-summary-save-in-file) (function-item gnus-summary-save-body-in-file) (function-item gnus-summary-save-in-vm) - (function-item gnus-summary-write-to-file))) + (function-item gnus-summary-write-to-file) + (function-item gnus-summary-write-body-to-file) + (function))) + +(defcustom gnus-article-save-coding-system + (or (and (mm-coding-system-p 'utf-8) 'utf-8) + (and (mm-coding-system-p 'iso-2022-7bit) 'iso-2022-7bit) + (and (mm-coding-system-p 'emacs-mule) 'emacs-mule) + (and (mm-coding-system-p 'escape-quoted) 'escape-quoted)) + "Coding system used to save decoded articles to a file. + +The recommended coding systems are `utf-8', `iso-2022-7bit' and so on, +which can safely encode any characters in text. This is used by the +commands including: + +* gnus-summary-save-article-file +* gnus-summary-save-article-body-file +* gnus-summary-write-article-file +* gnus-summary-write-article-body-file + +and the functions to which you may set `gnus-default-article-saver': + +* gnus-summary-save-in-file +* gnus-summary-save-body-in-file +* gnus-summary-write-to-file +* gnus-summary-write-body-to-file + +Those commands and functions save just text displayed in the article +buffer to a file if the value of this variable is non-nil. Note that +buttonized MIME parts will be lost in a saved file in that case. +Otherwise, raw articles will be saved." + :group 'gnus-article-saving + :type `(choice + :format "%{%t%}:\n %[Value Menu%] %v" + (const :tag "Save raw articles" nil) + ,@(delq nil + (mapcar + (lambda (arg) (if (mm-coding-system-p (nth 3 arg)) arg)) + '((const :tag "UTF-8" utf-8) + (const :tag "iso-2022-7bit" iso-2022-7bit) + (const :tag "Emacs internal" emacs-mule) + (const :tag "escape-quoted" escape-quoted)))) + (symbol :tag "Coding system"))) (defcustom gnus-rmail-save-name 'gnus-plain-save-name "A function generating a file name to save articles in Rmail format. @@ -587,13 +661,12 @@ non-nil. If the match is a string, it is used as a regexp match on the article. If the match is a symbol, that symbol will be funcalled -from the buffer of the article to be saved with the newsgroup as -the parameter. If it is a list, it will be evaled in the same -buffer. +from the buffer of the article to be saved with the newsgroup as the +parameter. If it is a list, it will be evaled in the same buffer. -If this form or function returns a string, this string will be -used as a possible file name; and if it returns a non-nil list, -that list will be used as possible file names." +If this form or function returns a string, this string will be used as a +possible file name; and if it returns a non-nil list, that list will be +used as possible file names." :group 'gnus-article-saving :type '(repeat (choice (list :value (fun) function) (cons :value ("" "") regexp (repeat string)) @@ -649,7 +722,12 @@ Each element is a regular expression." (make-obsolete-variable 'gnus-article-hide-pgp-hook "This variable is obsolete in Gnus 5.10.") -(defcustom gnus-article-button-face 'bold +(defface gnus-button + '((t (:weight bold))) + "Face used for highlighting a button in the article buffer." + :group 'gnus-article-buttons) + +(defcustom gnus-article-button-face 'gnus-button "Face used for highlighting buttons in the article buffer. An article button is a piece of text that you can activate by pressing @@ -684,7 +762,7 @@ Obsolete; use the face `gnus-signature' for customizations instead." (defface gnus-header-from '((((class color) (background dark)) - (:foreground "spring green")) + (:foreground "PaleGreen1")) (((class color) (background light)) (:foreground "red3")) @@ -699,7 +777,7 @@ Obsolete; use the face `gnus-signature' for customizations instead." (defface gnus-header-subject '((((class color) (background dark)) - (:foreground "SeaGreen3")) + (:foreground "SeaGreen1")) (((class color) (background light)) (:foreground "red4")) @@ -731,7 +809,7 @@ articles." (defface gnus-header-name '((((class color) (background dark)) - (:foreground "SeaGreen")) + (:foreground "SpringGreen2")) (((class color) (background light)) (:foreground "maroon")) @@ -746,7 +824,7 @@ articles." (defface gnus-header-content '((((class color) (background dark)) - (:foreground "forest green" :italic t)) + (:foreground "SpringGreen1" :italic t)) (((class color) (background light)) (:foreground "indianred4" :italic t)) @@ -783,6 +861,31 @@ be displayed by the first non-nil matching CONTENT face." (item :tag "skip" nil) (face :value default))))) +(defcustom gnus-face-properties-alist (if (featurep 'xemacs) + '((xface . (:face gnus-x-face))) + '((pbm . (:face gnus-x-face)) + (png . nil))) + "Alist of image types and properties applied to Face and X-Face images. +Here are examples: + +;; Specify the altitude of Face images in the From header. +\(setq gnus-face-properties-alist + '((pbm . (:face gnus-x-face :ascent 80)) + (png . (:ascent 80)))) + +;; Show Face images as pressed buttons. +\(setq gnus-face-properties-alist + '((pbm . (:face gnus-x-face :relief -2)) + (png . (:relief -2)))) + +See the manual for the valid properties for various image types. +Currently, `pbm' is used for X-Face images and `png' is used for Face +images in Emacs. Only the `:face' property is effective on the `xface' +image type in XEmacs if it is built with the libcompface library." + :version "23.0" ;; No Gnus + :group 'gnus-article-headers + :type '(repeat (cons :format "%v" (symbol :tag "Image type") plist))) + (defcustom gnus-article-decode-hook '(article-decode-charset article-decode-encoded-words article-decode-group-name article-decode-idna-rhs) @@ -798,6 +901,9 @@ be displayed by the first non-nil matching CONTENT face." (defvar gnus-decode-header-function 'mail-decode-encoded-word-region "Function used to decode headers.") +(defvar gnus-decode-address-function 'mail-decode-encoded-address-region + "Function used to decode addresses.") + (defvar gnus-article-dumbquotes-map '(("\200" "EUR") ("\202" ",") @@ -976,7 +1082,8 @@ parts. When nil, redisplay article." '(choice (const :tag "Off" nil) (const :tag "Header" head))) -(defvar gnus-article-treat-types '("text/plain") +(defvar gnus-article-treat-types '("text/plain" "text/x-verbatim" + "text/x-patch") "Parts to treat.") (defvar gnus-inhibit-treatment nil @@ -1249,6 +1356,18 @@ predicate. See Info node `(gnus)Customizing Articles'." :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) +(defcustom gnus-article-unfold-long-headers nil + "If non-nil, allow unfolding headers even if the header is long. +If it is a regexp, only long headers matching this regexp are unfolded. +If it is t, all long headers are unfolded. + +This variable has no effect if `gnus-treat-unfold-headers' is nil." + :version "23.0" ;; No Gnus + :group 'gnus-article-treat + :type '(choice (const nil) + (const :tag "all" t) + (regexp))) + (defcustom gnus-treat-fold-headers nil "Fold headers. Valid values are nil, t, `head', `first', `last', an integer or a @@ -1289,17 +1408,16 @@ predicate. See Info node `(gnus)Customizing Articles'." (defcustom gnus-treat-display-x-face (and (not noninteractive) - (or (and (fboundp 'image-type-available-p) - (image-type-available-p 'xbm) - (string-match "^0x" (shell-command-to-string "uncompface")) - (executable-find "icontopbm")) - (and (featurep 'xemacs) - (featurep 'xface))) + (gnus-image-type-available-p 'xbm) + (if (featurep 'xemacs) + (featurep 'xface) + (and (string-match "^0x" (shell-command-to-string "uncompface")) + (executable-find "icontopbm"))) 'head) "Display X-Face headers. -Valid values are nil, t, `head', `first', `last', an integer or a -predicate. See Info node `(gnus)Customizing Articles' and Info -node `(gnus)X-Face' for details." +Valid values are nil and `head'. +See Info node `(gnus)Customizing Articles' and Info node +`(gnus)X-Face' for details." :group 'gnus-article-treat :version "21.1" :link '(custom-manual "(gnus)Customizing Articles") @@ -1326,10 +1444,7 @@ node `(gnus)X-Face' for details." (defcustom gnus-treat-display-face (and (not noninteractive) - (or (and (fboundp 'image-type-available-p) - (image-type-available-p 'png)) - (and (featurep 'xemacs) - (featurep 'png))) + (gnus-image-type-available-p 'png) 'head) "Display Face headers. Valid values are nil, t, `head', `first', `last', an integer or a @@ -1342,12 +1457,7 @@ node `(gnus)X-Face' for details." :type gnus-article-treat-head-custom) (put 'gnus-treat-display-face 'highlight t) -(defcustom gnus-treat-display-smileys - (if (or (and (featurep 'xemacs) - (featurep 'xpm)) - (and (fboundp 'image-type-available-p) - (image-type-available-p 'pbm))) - t nil) +(defcustom gnus-treat-display-smileys (gnus-image-type-available-p 'xpm) "Display smileys. Valid values are nil, t, `head', `first', `last', an integer or a predicate. See Info node `(gnus)Customizing Articles' and Info @@ -1512,13 +1622,6 @@ This requires GNU Libidn, and by default only enabled if it is found." '("January" "February" "March" "April" "May" "June" "July" "August" "September" "October" "November" "December")) -(defvar gnus-button-regexp nil) -(defvar gnus-button-marker-list nil) -;; Regexp matching any of the regexps from `gnus-button-alist'. - -(defvar gnus-button-last nil) -;; The value of `gnus-button-alist' when `gnus-button-regexp' was build. - (defvar article-goto-body-goes-to-point-min-p nil) (defvar gnus-article-wash-types nil) (defvar gnus-article-emphasis-alist nil) @@ -1564,8 +1667,8 @@ This requires GNU Libidn, and by default only enabled if it is found." (gnus-treat-overstrike gnus-article-treat-overstrike) (gnus-treat-ansi-sequences gnus-article-treat-ansi-sequences) (gnus-treat-unfold-headers gnus-article-treat-unfold-headers) - (gnus-treat-fold-headers gnus-article-treat-fold-headers) (gnus-treat-fold-newsgroups gnus-article-treat-fold-newsgroups) + (gnus-treat-fold-headers gnus-article-treat-fold-headers) (gnus-treat-buttonize-head gnus-article-add-buttons-to-head) (gnus-treat-display-smileys gnus-treat-smiley) (gnus-treat-capitalize-sentences gnus-article-capitalize-sentences) @@ -1725,7 +1828,7 @@ Initialized from `text-mode-syntax-table.") (interactive) ;; This function might be inhibited. (unless gnus-inhibit-hiding - (let ((inhibit-read-only nil) + (let ((inhibit-read-only t) (case-fold-search t) (max (1+ (length gnus-sorted-header-list))) (inhibit-point-motion-hooks t) @@ -1887,7 +1990,11 @@ always hide." 'string<)))) (gnus-article-hide-header "reply-to"))))) ((eq elem 'date) - (let ((date (message-fetch-field "date"))) + (let ((date (with-current-buffer gnus-original-article-buffer + ;; If date in `gnus-article-buffer' is localized + ;; (`gnus-treat-date-user-defined'), + ;; `days-between' might fail. + (message-fetch-field "date")))) (when (and date (< (days-between (current-time-string) date) 4)) @@ -2056,16 +2163,21 @@ unfolded." (while (not (eobp)) (save-restriction (mail-header-narrow-to-field) - (let ((header (buffer-string))) + (let* ((header (buffer-string)) + (unfoldable + (or (equal gnus-article-unfold-long-headers t) + (and (stringp gnus-article-unfold-long-headers) + (string-match gnus-article-unfold-long-headers header))))) (with-temp-buffer (insert header) (goto-char (point-min)) (while (re-search-forward "\n[\t ]" nil t) (replace-match " " t t))) - (setq length (- (point-max) (point-min) 1))) - (when (< length (window-width)) - (while (re-search-forward "\n[\t ]" nil t) - (replace-match " " t t))) + (setq length (- (point-max) (point-min) 1)) + (when (or unfoldable + (< length (window-width))) + (while (re-search-forward "\n[\t ]" nil t) + (replace-match " " t t)))) (goto-char (point-max))))))) (defun gnus-article-treat-fold-headers () @@ -2112,6 +2224,39 @@ unfolded." (mail-header-fold-field) (goto-char (point-max)))))) +(defcustom gnus-article-truncate-lines default-truncate-lines + "Value of `truncate-lines' in Gnus Article buffer. +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles'." + :version "23.0" ;; No Gnus + :group 'gnus-article + ;; :link '(custom-manual "(gnus)Customizing Articles") + :type 'boolean) + +(defun gnus-article-toggle-truncate-lines (&optional arg) + "Toggle whether to fold or truncate long lines in article the buffer. +If ARG is non-nil and not a number, toggle +`gnus-article-truncate-lines' too. If ARG is a number, truncate +long lines iff arg is positive." + (interactive "P") + (cond + ((and (numberp arg) (> arg 0)) + (setq gnus-article-truncate-lines t)) + ((numberp arg) + (setq gnus-article-truncate-lines nil)) + (arg + (setq gnus-article-truncate-lines + (not gnus-article-truncate-lines)))) + (gnus-with-article-buffer + (cond + ((and (numberp arg) (> arg 0)) + (setq truncate-lines nil)) + ((numberp arg) + (setq truncate-lines t))) + ;; In versions of Emacs 22 (CVS) before 2006-05-26, + ;; `toggle-truncate-lines' needs an argument. + (toggle-truncate-lines))) + (defun gnus-article-treat-body-boundary () "Place a boundary line at the end of the headers." (interactive) @@ -2319,38 +2464,37 @@ If PROMPT (the prefix), prompt for a coding system to use." (error)) gnus-newsgroup-ignored-charsets)) ct cte ctl charset format) - (save-excursion - (save-restriction - (article-narrow-to-head) - (setq ct (message-fetch-field "Content-Type" t) - cte (message-fetch-field "Content-Transfer-Encoding" t) - ctl (and ct (ignore-errors - (mail-header-parse-content-type ct))) - charset (cond - (prompt - (mm-read-coding-system "Charset to decode: ")) - (ctl - (mail-content-type-get ctl 'charset))) - format (and ctl (mail-content-type-get ctl 'format))) - (when cte - (setq cte (mail-header-strip cte))) - (if (and ctl (not (string-match "/" (car ctl)))) - (setq ctl nil)) - (goto-char (point-max))) - (forward-line 1) - (save-restriction - (narrow-to-region (point) (point-max)) - (when (and (eq mail-parse-charset 'gnus-decoded) - (eq (mm-body-7-or-8) '8bit)) - ;; The text code could have been decoded. - (setq charset mail-parse-charset)) - (when (and (or (not ctl) - (equal (car ctl) "text/plain")) - (not format)) ;; article with format will decode later. - (mm-decode-body - charset (and cte (intern (downcase - (gnus-strip-whitespace cte)))) - (car ctl))))))) + (save-excursion + (save-restriction + (article-narrow-to-head) + (setq ct (message-fetch-field "Content-Type" t) + cte (message-fetch-field "Content-Transfer-Encoding" t) + ctl (and ct (mail-header-parse-content-type ct)) + charset (cond + (prompt + (mm-read-coding-system "Charset to decode: ")) + (ctl + (mail-content-type-get ctl 'charset))) + format (and ctl (mail-content-type-get ctl 'format))) + (when cte + (setq cte (mail-header-strip cte))) + (if (and ctl (not (string-match "/" (car ctl)))) + (setq ctl nil)) + (goto-char (point-max))) + (forward-line 1) + (save-restriction + (narrow-to-region (point) (point-max)) + (when (and (eq mail-parse-charset 'gnus-decoded) + (eq (mm-body-7-or-8) '8bit)) + ;; The text code could have been decoded. + (setq charset mail-parse-charset)) + (when (and (or (not ctl) + (equal (car ctl) "text/plain")) + (not format)) ;; article with format will decode later. + (mm-decode-body + charset (and cte (intern (downcase + (gnus-strip-whitespace cte)))) + (car ctl))))))) (defun article-decode-encoded-words () "Remove encoded-word encoding from headers." @@ -2361,50 +2505,51 @@ If PROMPT (the prefix), prompt for a coding system to use." (set-buffer gnus-summary-buffer) (error)) gnus-newsgroup-ignored-charsets)) - (inhibit-read-only t)) - (save-restriction - (article-narrow-to-head) - (funcall gnus-decode-header-function (point-min) (point-max))))) + (inhibit-read-only t) + end start) + (goto-char (point-min)) + (when (search-forward "\n\n" nil 'move) + (forward-line -1)) + (setq end (point)) + (while (not (bobp)) + (while (progn + (forward-line -1) + (and (not (bobp)) + (memq (char-after) '(?\t ? ))))) + (setq start (point)) + (if (looking-at "\ +\\(?:Resent-\\)?\\(?:From\\|Cc\\|To\\|Bcc\\|\\(?:In-\\)?Reply-To\\|Sender\ +\\|Mail-Followup-To\\|Mail-Copies-To\\|Approved\\):") + (funcall gnus-decode-address-function start end) + (funcall gnus-decode-header-function start end)) + (goto-char (setq end start))))) (defun article-decode-group-name () - "Decode group names in `Newsgroups:'." + "Decode group names in Newsgroups, Followup-To and Xref headers." (let ((inhibit-point-motion-hooks t) (inhibit-read-only t) - (method (gnus-find-method-for-group gnus-newsgroup-name))) + (method (gnus-find-method-for-group gnus-newsgroup-name)) + regexp) (when (and (or gnus-group-name-charset-method-alist gnus-group-name-charset-group-alist) (gnus-buffer-live-p gnus-original-article-buffer)) (save-restriction (article-narrow-to-head) - (with-current-buffer gnus-original-article-buffer - (goto-char (point-min))) - (while (re-search-forward - "^Newsgroups:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]" nil t) - (replace-match (save-match-data - (gnus-decode-newsgroups - ;; XXX how to use data in article buffer? - (with-current-buffer gnus-original-article-buffer - (re-search-forward - "^Newsgroups:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]" - nil t) - (match-string 1)) - gnus-newsgroup-name method)) - t t nil 1)) - (goto-char (point-min)) - (with-current-buffer gnus-original-article-buffer - (goto-char (point-min))) - (while (re-search-forward - "^Followup-To:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]" nil t) - (replace-match (save-match-data - (gnus-decode-newsgroups - ;; XXX how to use data in article buffer? - (with-current-buffer gnus-original-article-buffer - (re-search-forward - "^Followup-To:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]" - nil t) - (match-string 1)) - gnus-newsgroup-name method)) - t t nil 1)))))) + (dolist (header '("Newsgroups" "Followup-To" "Xref")) + (with-current-buffer gnus-original-article-buffer + (goto-char (point-min))) + (setq regexp (concat "^" header + ":\\([^\n]*\\(?:\n[\t ]+[^\n]+\\)*\\)\n")) + (while (re-search-forward regexp nil t) + (replace-match (save-match-data + (gnus-decode-newsgroups + ;; XXX how to use data in article buffer? + (with-current-buffer gnus-original-article-buffer + (re-search-forward regexp nil t) + (match-string 1)) + gnus-newsgroup-name method)) + t t nil 1)) + (goto-char (point-min))))))) (autoload 'idna-to-unicode "idna") @@ -2442,9 +2587,7 @@ If READ-CHARSET, ask for a coding system." (setq type (gnus-fetch-field "content-transfer-encoding")) (let* ((ct (gnus-fetch-field "content-type")) - (ctl (and ct - (ignore-errors - (mail-header-parse-content-type ct))))) + (ctl (and ct (mail-header-parse-content-type ct)))) (setq charset (and ctl (mail-content-type-get ctl 'charset))) (if (stringp charset) @@ -2472,9 +2615,7 @@ If READ-CHARSET, ask for a coding system." (setq type (gnus-fetch-field "content-transfer-encoding")) (let* ((ct (gnus-fetch-field "content-type")) - (ctl (and ct - (ignore-errors - (mail-header-parse-content-type ct))))) + (ctl (and ct (mail-header-parse-content-type ct)))) (setq charset (and ctl (mail-content-type-get ctl 'charset))) (if (stringp charset) @@ -2519,25 +2660,34 @@ If READ-CHARSET, ask for a coding system." (defun article-wash-html (&optional read-charset) "Format an HTML article. -If READ-CHARSET, ask for a coding system." +If READ-CHARSET, ask for a coding system. If it is a number, the +charset defined in `gnus-summary-show-article-charset-alist' is used." (interactive "P") (save-excursion (let ((inhibit-read-only t) charset) - (when (gnus-buffer-live-p gnus-original-article-buffer) - (with-current-buffer gnus-original-article-buffer - (let* ((ct (gnus-fetch-field "content-type")) - (ctl (and ct - (ignore-errors - (mail-header-parse-content-type ct))))) - (setq charset (and ctl - (mail-content-type-get ctl 'charset))) - (when (stringp charset) - (setq charset (intern (downcase charset))))))) - (when read-charset - (setq charset (mm-read-coding-system "Charset: " charset))) - (unless charset - (setq charset gnus-newsgroup-charset)) + (if read-charset + (if (or (and (numberp read-charset) + (setq charset + (cdr + (assq read-charset + gnus-summary-show-article-charset-alist)))) + (setq charset (mm-read-coding-system "Charset: "))) + (let ((gnus-summary-show-article-charset-alist + (list (cons 1 charset)))) + (with-current-buffer gnus-summary-buffer + (gnus-summary-show-article 1))) + (error "No charset is given")) + (when (gnus-buffer-live-p gnus-original-article-buffer) + (with-current-buffer gnus-original-article-buffer + (let* ((ct (gnus-fetch-field "content-type")) + (ctl (and ct (mail-header-parse-content-type ct)))) + (setq charset (and ctl + (mail-content-type-get ctl 'charset))) + (when (stringp charset) + (setq charset (intern (downcase charset))))))) + (unless charset + (setq charset gnus-newsgroup-charset))) (article-goto-body) (save-window-excursion (save-restriction @@ -2578,6 +2728,121 @@ If READ-CHARSET, ask for a coding system." ;; Put the mark meaning this part was rendered by emacs-w3m. 'mm-inline-text-html-with-w3m t)))) +(eval-when-compile (defvar charset)) ;; Bound by `article-wash-html'. + +(defun gnus-article-wash-html-with-w3m-standalone () + "Wash the current buffer with w3m." + (if (mm-w3m-standalone-supports-m17n-p) + (progn + (unless (mm-coding-system-p charset) ;; Bound by `article-wash-html'. + ;; The default. + (setq charset 'iso-8859-1)) + (let ((coding-system-for-write charset) + (coding-system-for-read charset)) + (call-process-region + (point-min) (point-max) + "w3m" t t nil "-dump" "-T" "text/html" + "-I" (symbol-name charset) "-O" (symbol-name charset)))) + (mm-inline-wash-with-stdin nil "w3m" "-dump" "-T" "text/html"))) + +(defvar gnus-article-browse-html-temp-list nil + "List of temporary files created by `gnus-article-browse-html-parts'. +Internal variable.") + +(defcustom gnus-article-browse-delete-temp 'ask + "What to do with temporary files from `gnus-article-browse-html-parts'. +If nil, don't delete temporary files. If it is t, delete them on +exit from the summary buffer. If it is the symbol `file', query +on each file, if it is `ask' ask once when exiting from the +summary buffer." + :group 'gnus-article + :version "23.0" ;; No Gnus + :type '(choice (const :tag "Don't delete" nil) + (const :tag "Don't ask" t) + (const :tag "Ask" ask) + (const :tag "Ask for each file" file))) + +;; Cf. mm-postponed-undisplay-list / mm-destroy-postponed-undisplay-list. + +(defun gnus-article-browse-delete-temp-files (&optional how) + "Delete temp-files created by `gnus-article-browse-html-parts'." + (when (and gnus-article-browse-html-temp-list + (or how + (setq how gnus-article-browse-delete-temp))) + (when (and (eq how 'ask) + (y-or-n-p (format + "Delete all %s temporary HTML file(s)? " + (length gnus-article-browse-html-temp-list))) + (setq how t))) + (dolist (file gnus-article-browse-html-temp-list) + (when (and (file-exists-p file) + (or (eq how t) + ;; `how' is neither `nil', `ask' nor `t' (i.e. `file'): + (gnus-y-or-n-p + (format "Delete temporary HTML file `%s'? " file)))) + (delete-file file))) + ;; Also remove file from the list when not deleted or if file doesn't + ;; exist anymore. + (setq gnus-article-browse-html-temp-list nil)) + gnus-article-browse-html-temp-list) + +(defun gnus-article-browse-html-parts (list) + "View all \"text/html\" parts from LIST. +Recurse into multiparts." + ;; Internal function used by `gnus-article-browse-html-article'. + (let ((showed)) + ;; Find and show the html-parts. + (dolist (handle list) + ;; If HTML, show it: + (when (listp handle) + (cond ((and (bufferp (car handle)) + (string-match "text/html" (car (mm-handle-type handle)))) + (let ((tmp-file (mm-make-temp-file + ;; Do we need to care for 8.3 filenames? + "mm-" nil ".html"))) + (mm-save-part-to-file handle tmp-file) + (add-to-list 'gnus-article-browse-html-temp-list tmp-file) + (add-hook 'gnus-summary-prepare-exit-hook + 'gnus-article-browse-delete-temp-files) + (add-hook 'gnus-exit-gnus-hook + (lambda () + (gnus-article-browse-delete-temp-files t))) + ;; FIXME: Warn if there's an tag? + (browse-url-of-file tmp-file) + (setq showed t))) + ;; If multipart, recurse + ((and (stringp (car handle)) + (string-match "^multipart/" (car handle)) + (setq showed + (or showed + (gnus-article-browse-html-parts handle)))))))) + showed)) + +;; FIXME: Documentation in texi/gnus.texi missing. +(defun gnus-article-browse-html-article () + "View \"text/html\" parts of the current article with a WWW browser. + +Warning: Spammers use links to images in HTML articles to verify +whether you have read the message. As +`gnus-article-browse-html-article' passes the unmodified HTML +content to the browser without eliminating these \"web bugs\" you +should only use it for mails from trusted senders." + ;; Cf. `mm-w3m-safe-url-regexp' + (interactive) + (save-window-excursion + ;; Open raw article and select the buffer + (gnus-summary-show-article t) + (gnus-summary-select-article-buffer) + (let ((parts (mm-dissect-buffer t t))) + ;; If singlepart, enforce a list. + (when (and (bufferp (car parts)) + (stringp (car (mm-handle-type parts)))) + (setq parts (list parts))) + ;; Process the list + (unless (gnus-article-browse-html-parts parts) + (gnus-error 3 "Mail doesn't contain a \"text/html\" part!")) + (gnus-summary-show-article)))) + (defun article-hide-list-identifiers () "Remove list identifies from the Subject header. The `gnus-list-identifiers' variable specifies what to do." @@ -2639,20 +2904,17 @@ always hide." (article-really-strip-banner (gnus-parameter-banner gnus-newsgroup-name))) (when gnus-article-address-banner-alist - ;; It is necessary to encode from fields before checking, - ;; because `mail-header-parse-addresses' does not work - ;; (reliably) on decoded headers. And more, it is - ;; impossible to use `gnus-fetch-original-field' here, - ;; because `article-strip-banner' may be called in draft - ;; buffers to preview them. + ;; Note that the From header is decoded here, so it is + ;; required that the *-extract-address-components function + ;; supports non-ASCII text. (let ((from (save-restriction (widen) (article-narrow-to-head) (mail-fetch-field "from")))) (when (and from (setq from - (caar (mail-header-parse-addresses - (mail-encode-encoded-word-string from))))) + (cadr (funcall gnus-extract-address-components + from)))) (catch 'found (dolist (pair gnus-article-address-banner-alist) (when (string-match (car pair) from) @@ -3277,10 +3539,13 @@ This format is defined by the `gnus-article-time-format' variable." (defun gnus-article-save (save-buffer file &optional num) "Save the currently selected article." - (unless gnus-save-all-headers - ;; Remove headers according to `gnus-saved-headers'. + (when (or (get gnus-default-article-saver :headers) + (not gnus-save-all-headers)) + ;; Remove headers according to `gnus-saved-headers' or the value + ;; of the `:headers' property that the saver function might have. (let ((gnus-visible-headers - (or gnus-saved-headers gnus-visible-headers)) + (or (symbol-value (get gnus-default-article-saver :headers)) + gnus-saved-headers gnus-visible-headers)) (gnus-article-buffer save-buffer)) (save-excursion (set-buffer save-buffer) @@ -3305,7 +3570,8 @@ This format is defined by the `gnus-article-time-format' variable." (funcall gnus-default-article-saver filename))))) (defun gnus-read-save-file-name (prompt &optional filename - function group headers variable) + function group headers variable + dir-var) (let ((default-name (funcall function group headers (symbol-value variable))) result) @@ -3318,6 +3584,10 @@ This format is defined by the `gnus-article-time-format' variable." default-name) (filename filename) (t + (when (symbol-value dir-var) + (setq default-name (expand-file-name + (file-name-nondirectory default-name) + (symbol-value dir-var)))) (let* ((split-name (gnus-get-split-value gnus-split-methods)) (prompt (format prompt @@ -3382,7 +3652,11 @@ This format is defined by the `gnus-article-time-format' variable." ;; Possibly translate some characters. (nnheader-translate-file-chars file)))))) (gnus-make-directory (file-name-directory result)) - (set variable result))) + (when variable + (set variable result)) + (when dir-var + (set dir-var (file-name-directory result))) + result)) (defun gnus-article-archive-name (group) "Return the first instance of an \"Archive-name\" in the current buffer." @@ -3430,6 +3704,8 @@ Directory to save to is default to `gnus-article-save-directory'." (gnus-output-to-mail filename))))) filename) +(put 'gnus-summary-save-in-file :decode t) +(put 'gnus-summary-save-in-file :headers 'gnus-saved-headers) (defun gnus-summary-save-in-file (&optional filename overwrite) "Append this article to file. Optional argument FILENAME specifies file name. @@ -3448,13 +3724,21 @@ Directory to save to is default to `gnus-article-save-directory'." (gnus-output-to-file filename)))) filename) +(put 'gnus-summary-write-to-file :decode t) +(put 'gnus-summary-write-to-file :function 'gnus-summary-save-in-file) +(put 'gnus-summary-write-to-file :headers 'gnus-saved-headers) (defun gnus-summary-write-to-file (&optional filename) "Write this article to a file, overwriting it if the file exists. Optional argument FILENAME specifies file name. The directory to save in defaults to `gnus-article-save-directory'." - (gnus-summary-save-in-file nil t)) + (setq filename (gnus-read-save-file-name + "Save %s in file" filename + gnus-file-save-name gnus-newsgroup-name + gnus-current-headers nil 'gnus-newsgroup-last-directory)) + (gnus-summary-save-in-file filename t)) -(defun gnus-summary-save-body-in-file (&optional filename) +(put 'gnus-summary-save-body-in-file :decode t) +(defun gnus-summary-save-body-in-file (&optional filename overwrite) "Append this article body to a file. Optional argument FILENAME specifies file name. The directory to save in defaults to `gnus-article-save-directory'." @@ -3468,9 +3752,25 @@ The directory to save in defaults to `gnus-article-save-directory'." (widen) (when (article-goto-body) (narrow-to-region (point) (point-max))) + (when (and overwrite + (file-exists-p filename)) + (delete-file filename)) (gnus-output-to-file filename)))) filename) +(put 'gnus-summary-write-body-to-file :decode t) +(put 'gnus-summary-write-body-to-file + :function 'gnus-summary-save-body-in-file) +(defun gnus-summary-write-body-to-file (&optional filename) + "Write this article body to a file, overwriting it if the file exists. +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 + gnus-file-save-name gnus-newsgroup-name + gnus-current-headers nil 'gnus-newsgroup-last-directory)) + (gnus-summary-save-body-in-file filename t)) + (defun gnus-summary-save-in-pipe (&optional command) "Pipe this article to subprocess." (setq command @@ -3534,7 +3834,7 @@ Otherwise, it is like ~/News/news/group/num." (defun gnus-numeric-save-name (newsgroup headers &optional last-file) "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE. If variable `gnus-use-long-file-name' is non-nil, it is -~/News/news.group/num. Otherwise, it is like ~/News/news/group/num." +~/News/news.group/num. Otherwise, it is like ~/News/news/group/num." (let ((default (expand-file-name (concat (if (gnus-use-long-file-name 'not-save) @@ -3829,8 +4129,11 @@ commands: (make-local-variable 'gnus-article-image-alist) (make-local-variable 'gnus-article-charset) (make-local-variable 'gnus-article-ignored-charsets) - ;; Prevent recent Emacsen from displaying non-break space as "\ ". + ;; Prevent Emacs 22 from displaying non-break space with `nobreak-space' + ;; face. (set (make-local-variable 'nobreak-char-display) nil) + (setq cursor-in-non-selected-windows nil) + (setq truncate-lines gnus-article-truncate-lines) (gnus-set-default-directory) (buffer-disable-undo) (setq buffer-read-only t @@ -3839,6 +4142,10 @@ commands: (mm-enable-multibyte) (gnus-run-mode-hooks 'gnus-article-mode-hook)) +(defvar gnus-button-marker-list nil + "Regexp matching any of the regexps from `gnus-button-alist'. +Internal variable.") + (defun gnus-article-setup-buffer () "Initialize the article buffer." (let* ((name (if gnus-single-article-buffer "*Article*" @@ -3850,10 +4157,9 @@ commands: (setq gnus-article-buffer name) (setq gnus-original-article-buffer original) (setq gnus-article-mime-handle-alist nil) - ;; This might be a variable local to the summary buffer. - (unless gnus-single-article-buffer - (save-excursion - (set-buffer gnus-summary-buffer) + (with-current-buffer gnus-summary-buffer + ;; This might be a variable local to the summary buffer. + (unless gnus-single-article-buffer (setq gnus-article-buffer name) (setq gnus-original-article-buffer original) (gnus-set-global-variables))) @@ -3894,23 +4200,27 @@ commands: (set-buffer (gnus-get-buffer-create name)) (gnus-article-mode) (make-local-variable 'gnus-summary-buffer) + (setq gnus-summary-buffer + (gnus-summary-buffer-name gnus-newsgroup-name)) (gnus-summary-set-local-parameters gnus-newsgroup-name) (current-buffer))))) ;; Set article window start at LINE, where LINE is the number of lines ;; from the head of the article. (defun gnus-article-set-window-start (&optional line) - (set-window-start - (gnus-get-buffer-window gnus-article-buffer t) - (save-excursion - (set-buffer gnus-article-buffer) - (goto-char (point-min)) - (if (not line) - (point-min) - (gnus-message 6 "Moved to bookmark") - (search-forward "\n\n" nil t) - (forward-line line) - (point))))) + (let ((article-window (gnus-get-buffer-window gnus-article-buffer t))) + (when article-window + (set-window-start + article-window + (save-excursion + (set-buffer gnus-article-buffer) + (goto-char (point-min)) + (if (not line) + (point-min) + (gnus-message 6 "Moved to bookmark") + (search-forward "\n\n" nil t) + (forward-line line) + (point))))))) (defun gnus-article-prepare (article &optional all-headers header) "Prepare ARTICLE in article mode buffer. @@ -4105,7 +4415,7 @@ General format specifiers can also be used. See Info node gnus-mime-button-menu gnus-mime-button-map "MIME button menu." `("MIME Part" ,@(mapcar (lambda (c) - (vector (caddr c) (car c) :enable t)) + (vector (caddr c) (car c) :active t)) gnus-mime-button-commands))) (defun gnus-mime-button-menu (event prefix) @@ -4247,6 +4557,9 @@ The current article has a complicated MIME structure, giving up...")) (insert "Content-Type: " (mm-handle-media-type data)) (mml-insert-parameter-string (cdr (mm-handle-type data)) '(charset)) + ;; Add a filename for the sake of saving the part again. + (mml-insert-parameter + (mail-header-encode-parameter "name" (file-name-nondirectory file))) (insert "\n") (insert "Content-ID: " (message-make-message-id) "\n") (insert "Content-Transfer-Encoding: binary\n") @@ -4280,9 +4593,8 @@ Deleting parts may malfunction or destroy the article; continue? ")) (handles gnus-article-mime-handles) (none "(none)") (description - (or - (mail-decode-encoded-word-string (or (mm-handle-description data) - none)))) + (mail-decode-encoded-word-string (or (mm-handle-description data) + none))) (filename (or (mail-content-type-get (mm-handle-disposition data) 'filename) none)) @@ -4348,8 +4660,10 @@ Deleting parts may malfunction or destroy the article; continue? ")) (def-type (and name (mm-default-file-encoding name)))) (and def-type (cons def-type 0)))) -(defun gnus-mime-view-part-as-type (&optional mime-type) - "Choose a MIME media type, and view the part as such." +(defun gnus-mime-view-part-as-type (&optional mime-type pred) + "Choose a MIME media type, and view the part as such. +If non-nil, PRED is a predicate to use during completion to limit the +available media-types." (interactive) (unless mime-type (setq mime-type @@ -4358,11 +4672,15 @@ Deleting parts may malfunction or destroy the article; continue? ")) (format "View as MIME type (default %s): " (car default)) (mapcar #'list (mailcap-mime-types)) - nil nil nil nil + pred nil nil nil (car default))))) (gnus-article-check-buffer) (let ((handle (get-text-property (point) 'gnus-data))) (when handle + (when (equal (mm-handle-media-type handle) "message/external-body") + (unless (mm-handle-cache handle) + (mm-extern-cache-contents handle)) + (setq handle (mm-handle-cache handle))) (setq handle (mm-make-handle (mm-handle-buffer handle) (cons mime-type (cdr (mm-handle-type handle))) @@ -4385,7 +4703,7 @@ are decompressed." (unless handle (setq handle (get-text-property (point) 'gnus-data))) (when handle - (let ((filename (or (mail-content-type-get (mm-handle-disposition handle) + (let ((filename (or (mail-content-type-get (mm-handle-type handle) 'name) (mail-content-type-get (mm-handle-disposition handle) 'filename))) @@ -4479,7 +4797,7 @@ Compressed files like .gz and .bz2 are decompressed." (mm-insert-part handle) (setq contents (or (mm-decompress-buffer - (or (mail-content-type-get (mm-handle-disposition handle) + (or (mail-content-type-get (mm-handle-type handle) 'name) (mail-content-type-get (mm-handle-disposition handle) 'filename)) @@ -4516,24 +4834,56 @@ Compressed files like .gz and .bz2 are decompressed." (mm-string-to-multibyte contents))) (goto-char b))))) +(defun gnus-mime-strip-charset-parameters (handle) + "Strip charset parameters from HANDLE." + (if (stringp (car handle)) + (mapc #'gnus-mime-strip-charset-parameters (cdr handle)) + (let* ((type (mm-handle-type (if (equal (mm-handle-media-type handle) + "message/external-body") + (progn + (unless (mm-handle-cache handle) + (mm-extern-cache-contents handle)) + (mm-handle-cache handle)) + handle))) + (charset (assq 'charset (cdr type)))) + (when charset + (delq charset type))))) + (defun gnus-mime-view-part-as-charset (&optional handle arg) "Insert the MIME part under point into the current buffer using the specified charset." (interactive (list nil current-prefix-arg)) (gnus-article-check-buffer) - (let* ((handle (or handle (get-text-property (point) 'gnus-data))) - contents charset - (b (point)) - (inhibit-read-only t)) + (let ((handle (or handle (get-text-property (point) 'gnus-data))) + (fun (get-text-property (point) 'gnus-callback)) + (gnus-newsgroup-ignored-charsets 'gnus-all) + gnus-newsgroup-charset form preferred parts) (when handle (if (mm-handle-undisplayer handle) (mm-remove-part handle)) - (let ((gnus-newsgroup-charset - (or (cdr (assq arg - gnus-summary-show-article-charset-alist)) - (mm-read-coding-system "Charset: "))) - (gnus-newsgroup-ignored-charsets 'gnus-all)) - (gnus-article-press-button))))) + (when fun + (setq gnus-newsgroup-charset + (or (cdr (assq arg gnus-summary-show-article-charset-alist)) + (mm-read-coding-system "Charset: "))) + (gnus-mime-strip-charset-parameters handle) + (when (and (consp (setq form (cdr-safe fun))) + (setq form (ignore-errors + (assq 'gnus-mime-display-alternative form))) + (setq preferred (caddr form)) + (progn + (when (eq (car preferred) 'quote) + (setq preferred (cadr preferred))) + (not (equal preferred + (get-text-property (point) 'gnus-data)))) + (setq parts (get-text-property (point) 'gnus-part)) + (setq parts (cdr (assq parts + gnus-article-mime-handle-alist))) + (equal (mm-handle-media-type parts) "multipart/alternative") + (setq parts (reverse (cdr parts)))) + (setcar (cddr form) + (list 'quote (or (cadr (member preferred parts)) + (car parts))))) + (funcall fun handle))))) (defun gnus-mime-view-part-externally (&optional handle) "View the MIME part under point with an external viewer." @@ -4544,12 +4894,18 @@ specified charset." (mm-inlined-types nil) (mail-parse-charset gnus-newsgroup-charset) (mail-parse-ignored-charsets - (with-current-buffer gnus-summary-buffer - gnus-newsgroup-ignored-charsets))) - (when handle - (if (mm-handle-undisplayer handle) - (mm-remove-part handle) - (mm-display-part handle))))) + (with-current-buffer gnus-summary-buffer + gnus-newsgroup-ignored-charsets)) + (type (mm-handle-media-type handle)) + (method (mailcap-mime-info type)) + (mm-enable-external t)) + (if (not (stringp method)) + (gnus-mime-view-part-as-type + nil (lambda (types) (stringp (mailcap-mime-info (car types))))) + (when handle + (if (mm-handle-undisplayer handle) + (mm-remove-part handle) + (mm-display-part handle)))))) (defun gnus-mime-view-part-internally (&optional handle) "View the MIME part under point with an internal viewer. @@ -4564,10 +4920,13 @@ If no internal viewer is available, use an external viewer." (with-current-buffer gnus-summary-buffer gnus-newsgroup-ignored-charsets)) (inhibit-read-only t)) - (when handle - (if (mm-handle-undisplayer handle) - (mm-remove-part handle) - (mm-display-part handle))))) + (if (not (mm-inlinable-p handle)) + (gnus-mime-view-part-as-type + nil (lambda (types) (mm-inlinable-p handle (car types)))) + (when handle + (if (mm-handle-undisplayer handle) + (mm-remove-part handle) + (mm-display-part handle)))))) (defun gnus-mime-action-on-part (&optional action) "Do something with the MIME attachment at \(point\)." @@ -4593,6 +4952,25 @@ If INTERACTIVE, call FUNCTION interactivly." (unless (with-current-buffer gnus-summary-buffer (eq gnus-current-article (gnus-summary-article-number))) (error "You should select the right article first")) + (if n + (setq n (prefix-numeric-value n)) + (let ((pt (point))) + (setq n (or (get-text-property pt 'gnus-part) + (and (not (bobp)) + (get-text-property (1- pt) 'gnus-part)) + (get-text-property (prog2 + (forward-line 1) + (point) + (goto-char pt)) + 'gnus-part) + (get-text-property + (or (and (setq pt (previous-single-property-change + pt 'gnus-part)) + (1- pt)) + (next-single-property-change (point) 'gnus-part) + (point)) + 'gnus-part) + 1)))) ;; Check whether the specified part exists. (when (> n (length gnus-article-mime-handle-alist)) (error "No such part"))) @@ -4643,58 +5021,64 @@ If INTERACTIVE, call FUNCTION interactivly." (defun gnus-article-pipe-part (n) "Pipe MIME part N, which is the numerical prefix." - (interactive "p") + (interactive "P") (gnus-article-part-wrapper n 'mm-pipe-part)) (defun gnus-article-save-part (n) "Save MIME part N, which is the numerical prefix." - (interactive "p") + (interactive "P") (gnus-article-part-wrapper n 'mm-save-part)) (defun gnus-article-interactively-view-part (n) "View MIME part N interactively, which is the numerical prefix." - (interactive "p") + (interactive "P") (gnus-article-part-wrapper n 'mm-interactively-view-part)) (defun gnus-article-copy-part (n) "Copy MIME part N, which is the numerical prefix." - (interactive "p") + (interactive "P") (gnus-article-part-wrapper n 'gnus-mime-copy-part)) (defun gnus-article-view-part-as-charset (n) "View MIME part N using a specified charset. N is the numerical prefix." - (interactive "p") + (interactive "P") (gnus-article-part-wrapper n 'gnus-mime-view-part-as-charset)) (defun gnus-article-view-part-externally (n) "View MIME part N externally, which is the numerical prefix." - (interactive "p") + (interactive "P") (gnus-article-part-wrapper n 'gnus-mime-view-part-externally)) (defun gnus-article-inline-part (n) "Inline MIME part N, which is the numerical prefix." - (interactive "p") + (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") + (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") + (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." - (interactive "p") + (interactive "P") (gnus-article-part-wrapper n 'gnus-mime-delete-part t)) +(defun gnus-article-view-part-as-type (n) + "Choose a MIME media type, and view part N as such. +N is the numerical prefix." + (interactive "P") + (gnus-article-part-wrapper n 'gnus-mime-view-part-as-type t)) + (defun gnus-article-mime-match-handle-first (condition) (if condition (let (n) @@ -4823,6 +5207,9 @@ N is the numerical prefix." ;; Exclude a newline. (1- (point)) (point))) + (when gnus-article-button-face + (gnus-overlay-put (gnus-make-overlay b e nil t) + 'face gnus-article-button-face)) (widget-convert-button 'link b e :mime-handle handle @@ -4907,7 +5294,11 @@ N is the numerical prefix." (article-goto-body) (narrow-to-region (point-min) (point)) (gnus-article-save-original-date - (gnus-treat-article 'head))))))))) + (gnus-treat-article 'head))))))) + ;; Cope with broken MIME messages. + (goto-char (point-max)) + (unless (bolp) + (insert "\n")))) (defcustom gnus-mime-display-multipart-as-mixed nil "Display \"multipart\" parts as \"multipart/mixed\". @@ -5011,6 +5402,13 @@ If displaying \"text/html\" is discouraged \(see (let ((id (1+ (length gnus-article-mime-handle-alist))) beg) (push (cons id handle) gnus-article-mime-handle-alist) + (when (and display + (equal (mm-handle-media-supertype handle) "message")) + (insert-char + ?\n + (cond ((not (bolp)) 2) + ((or (bobp) (eq (char-before (1- (point))) ?\n)) 0) + (t 1)))) (when (or (not display) (not (gnus-unbuttonized-mime-type-p type))) (gnus-insert-mime-button @@ -5260,17 +5658,55 @@ Provided for backwards compatibility." ;;; Article savers. (defun gnus-output-to-file (file-name) - "Append the current article to a file named FILE-NAME." - (let ((artbuf (current-buffer))) + "Append the current article to a file named FILE-NAME. +If `gnus-article-save-coding-system' is non-nil, it is used to encode +text and used as the value of the coding cookie which is added to the +top of a file. Otherwise, this function saves a raw article without +the coding cookie." + (let* ((artbuf (current-buffer)) + (file-name-coding-system nnmail-pathname-coding-system) + (coding gnus-article-save-coding-system) + (coding-system-for-read (if coding + nil ;; Rely on the coding cookie. + mm-text-coding-system)) + (coding-system-for-write (or coding + mm-text-coding-system-for-write + mm-text-coding-system)) + (exists (file-exists-p file-name))) (with-temp-buffer + (when exists + (insert-file-contents file-name) + (goto-char (point-min)) + ;; Remove the existing coding cookie. + (when (looking-at "X-Gnus-Coding-System: .+\n\n") + (delete-region (match-beginning 0) (match-end 0)))) + (goto-char (point-max)) (insert-buffer-substring artbuf) ;; Append newline at end of the buffer as separator, and then ;; save it to file. (goto-char (point-max)) (insert "\n") - (let ((file-name-coding-system nnmail-pathname-coding-system)) - (mm-append-to-file (point-min) (point-max) file-name)) - t))) + (when coding + ;; If the coding system is not suitable to encode the text, + ;; ask a user for a proper one. + (when (fboundp 'select-safe-coding-system) + (setq coding (coding-system-base + (save-window-excursion + (select-safe-coding-system (point-min) (point-max) + coding)))) + (setq coding-system-for-write + (or (cdr (assq coding '((mule-utf-8 . utf-8)))) + coding))) + (goto-char (point-min)) + ;; Add the coding cookie. + (insert (format "X-Gnus-Coding-System: -*- coding: %s; -*-\n\n" + coding-system-for-write))) + (if exists + (progn + (write-region (point-min) (point-max) file-name nil 'no-message) + (message "Appended to %s" file-name)) + (write-region (point-min) (point-max) file-name)))) + t) (defun gnus-narrow-to-page (&optional arg) "Narrow the article buffer to a page. @@ -5430,14 +5866,15 @@ not have a face in `gnus-article-boring-faces'." (boundp 'gnus-article-boring-faces) (symbol-value 'gnus-article-boring-faces)) (save-excursion - (catch 'only-boring - (while (re-search-forward "\\b\\w\\w" nil t) - (forward-char -1) - (when (not (gnus-intersection - (gnus-faces-at (point)) - (symbol-value 'gnus-article-boring-faces))) - (throw 'only-boring nil))) - (throw 'only-boring t))))) + (let ((inhibit-point-motion-hooks t)) + (catch 'only-boring + (while (re-search-forward "\\b\\w\\w" nil t) + (forward-char -1) + (when (not (gnus-intersection + (gnus-faces-at (point)) + (symbol-value 'gnus-article-boring-faces))) + (throw 'only-boring nil))) + (throw 'only-boring t)))))) (defun gnus-article-refer-article () "Read article specified by message-id around point." @@ -5483,7 +5920,7 @@ not have a face in `gnus-article-boring-faces'." "Execute the last keystroke in the summary buffer." (interactive) (let (func) - (pop-to-buffer gnus-article-current-summary 'norecord) + (pop-to-buffer gnus-article-current-summary nil (not (featurep 'xemacs))) (setq func (lookup-key (current-local-map) (this-command-keys))) (call-interactively func))) @@ -5517,64 +5954,96 @@ not have a face in `gnus-article-boring-faces'." (message "") - (if (or (member keys nosaves) - (member keys nosave-but-article) - (member keys nosave-in-article)) - (let (func) - (save-window-excursion - (pop-to-buffer gnus-article-current-summary 'norecord) - ;; We disable the pick minor mode commands. - (let (gnus-pick-mode) - (setq func (lookup-key (current-local-map) keys)))) - (if (or (not func) - (numberp func)) - (ding) - (unless (member keys nosave-in-article) - (set-buffer gnus-article-current-summary)) - (call-interactively func) - (setq new-sum-point (point))) - (when (member keys nosave-but-article) - (pop-to-buffer gnus-article-buffer 'norecord))) + (cond + ((eq (aref keys (1- (length keys))) ?\C-h) + (with-current-buffer gnus-article-current-summary + (describe-bindings (substring keys 0 -1)))) + ((or (member keys nosaves) + (member keys nosave-but-article) + (member keys nosave-in-article)) + (let (func) + (save-window-excursion + (pop-to-buffer gnus-article-current-summary + nil (not (featurep 'xemacs))) + ;; We disable the pick minor mode commands. + (let (gnus-pick-mode) + (setq func (lookup-key (current-local-map) keys)))) + (if (or (not func) + (numberp func)) + (ding) + (unless (member keys nosave-in-article) + (set-buffer gnus-article-current-summary)) + (call-interactively func) + (setq new-sum-point (point))) + (when (member keys nosave-but-article) + (pop-to-buffer gnus-article-buffer nil (not (featurep 'xemacs)))))) + (t ;; These commands should restore window configuration. (let ((obuf (current-buffer)) (owin (current-window-configuration)) - (opoint (point)) - win func in-buffer selected new-sum-start new-sum-hscroll) + win func in-buffer selected new-sum-start new-sum-hscroll err) (cond (not-restore-window - (pop-to-buffer gnus-article-current-summary 'norecord)) + (pop-to-buffer gnus-article-current-summary + nil (not (featurep 'xemacs))) + (setq win (selected-window))) ((setq win (get-buffer-window gnus-article-current-summary)) (select-window win)) (t - (switch-to-buffer gnus-article-current-summary 'norecord))) + (let ((summary-buffer gnus-article-current-summary)) + (gnus-configure-windows 'article) + (unless (setq win (get-buffer-window summary-buffer 'visible)) + (let ((gnus-buffer-configuration + '(article ((vertical 1.0 + (summary 0.25 point) + (article 1.0)))))) + (gnus-configure-windows 'article)) + (setq win (get-buffer-window summary-buffer 'visible))) + (gnus-select-frame-set-input-focus (window-frame win)) + (select-window win)))) (setq in-buffer (current-buffer)) ;; We disable the pick minor mode commands. (if (and (setq func (let (gnus-pick-mode) (lookup-key (current-local-map) keys))) - (functionp func)) + (functionp func) + (condition-case code + (progn + (call-interactively func) + t) + (error + (setq err code) + nil))) (progn - (call-interactively func) (when (eq win (selected-window)) (setq new-sum-point (point) new-sum-start (window-start win) new-sum-hscroll (window-hscroll win))) - (when (eq in-buffer (current-buffer)) + (when (or (eq in-buffer (current-buffer)) + (when (eq obuf (current-buffer)) + (set-buffer in-buffer) + t)) (setq selected (gnus-summary-select-article)) (set-buffer obuf) (unless not-restore-window (set-window-configuration owin)) - (when (eq selected 'old) - (article-goto-body) + (when (and (eq selected 'old) + new-sum-point) (set-window-start (get-buffer-window (current-buffer)) 1) (set-window-point (get-buffer-window (current-buffer)) - (point))) + (if (article-goto-body) + (1- (point)) + (point)))) (when (and (not not-restore-window) - new-sum-point) + new-sum-point + (with-current-buffer (window-buffer win) + (eq major-mode 'gnus-summary-mode))) (set-window-point win new-sum-point) (set-window-start win new-sum-start) (set-window-hscroll win new-sum-hscroll)))) (set-window-configuration owin) - (ding)))))) + (if err + (signal (car err) (cdr err)) + (ding)))))))) (defun gnus-article-describe-key (key) "Display documentation of the function invoked by KEY. KEY is a string." @@ -6057,9 +6526,24 @@ groups." ;;; Internal Variables: (defcustom gnus-button-url-regexp - (if (string-match "[[:digit:]]" "1") ;; support POSIX? - "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|nntp\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)\\(//[-a-z0-9_.]+:[0-9]*\\)?[-a-z0-9_=!?#$@~%&*+\\/:;.,[:word:]]+[-a-z0-9_=#$@~%&*+\\/[:word:]]\\)" - "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|nntp\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)\\(//[-a-z0-9_.]+:[0-9]*\\)?\\([-a-z0-9_=!?#$@~%&*+\\/:;.,]\\|\\w\\)+\\([-a-z0-9_=#$@~%&*+\\/]\\|\\w\\)\\)") + (concat + "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|" + "nntp\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)" + "\\(//[-a-z0-9_.]+:[0-9]*\\)?" + (if (string-match "[[:digit:]]" "1") ;; Support POSIX? + (let ((chars "-a-z0-9_=#$@~%&*+\\/[:word:]") + (punct "!?:;.,")) + (concat + "\\(?:" + ;; Match paired parentheses, e.g. in Wikipedia URLs: + "[" chars punct "]+" "(" "[" chars punct "]+" "[" chars "]*)" "[" chars "]" + "\\|" + "[" chars punct "]+" "[" chars "]" + "\\)")) + (concat ;; XEmacs 21.4 doesn't support POSIX. + "\\([-a-z0-9_=!?#$@~%&*+\\/:;.,]\\|\\w\\)+" + "\\([-a-z0-9_=#$@~%&*+\\/]\\|\\w\\)")) + "\\)") "Regular expression that matches URLs." :group 'gnus-article-buttons :type 'regexp) @@ -6073,7 +6557,7 @@ groups." ;; Regexp suggested by Felix Wiemann in <87oeuomcz9.fsf@news2.ososo.de> (defcustom gnus-button-valid-localpart-regexp - "[a-z0-9$%(*-=?[_][^<>\")!;:,{}\n\t ]*" + "[a-z0-9$%(*-=?[_][^<>\")!;:,{}\n\t @]*" "Regular expression that matches a localpart of mail addresses or MIDs." :version "22.1" :group 'gnus-article-buttons @@ -6144,7 +6628,7 @@ Strings like this can be either a message ID or a mail address. If it is one of the symbols `mid' or `mail', Gnus will always assume that the string is a message ID or a mail address, respectively. If this variable is set to the symbol `ask', always query the user what do do. If it is a function, this -function will be called with the string as it's only argument. The function +function will be called with the string as its only argument. The function must return `mid', `mail', `invalid' or `ask'." :version "22.1" :group 'gnus-article-buttons @@ -6315,7 +6799,10 @@ address, `ask' if unsure and `invalid' if the string is invalid." "Call function FUN on argument ARG. Both FUN and ARG are supposed to be strings. ARG will be passed as a symbol to FUN." - (funcall (intern fun) (intern arg))) + (funcall (intern fun) + (if (string-match "^customize-apropos" fun) + arg + (intern arg)))) (defvar gnus-button-handle-describe-prefix "^\\(C-h\\|?\\)") @@ -6459,6 +6946,8 @@ positives are possible." 0 (>= gnus-button-message-level 0) gnus-button-message-id 2) ("\\bin\\( +article\\| +message\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2 (>= gnus-button-message-level 0) gnus-button-message-id 3) + ("\\b\\(mid\\|message-id\\):? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" + 2 (>= gnus-button-message-level 0) gnus-button-message-id 3) ("\\( \n\t]+\\)>" 0 (>= gnus-button-message-level 0) gnus-url-mailto 2) ;; RFC 2368 (The mailto URL scheme) @@ -6514,7 +7003,7 @@ positives are possible." 1 (>= gnus-button-emacs-level 8) gnus-button-handle-library 1) ("`\\([a-z][-a-z0-9]+\\.el\\)'" 1 (>= gnus-button-emacs-level 8) gnus-button-handle-library 1) - ("`\\([a-z][a-z0-9]+-[a-z]+-[-a-z]+\\|\\(gnus\\|message\\)-[-a-z]+\\)'" + ("`\\([a-z][a-z0-9]+-[a-z0-9]+-[-a-z0-9]*[a-z]\\|\\(gnus\\|message\\)-[-a-z]+\\)'" 0 (>= gnus-button-emacs-level 8) gnus-button-handle-symbol 1) ("`\\([a-z][a-z0-9]+-[a-z]+\\)'" 0 (>= gnus-button-emacs-level 9) gnus-button-handle-symbol 1) @@ -6526,7 +7015,7 @@ positives are possible." 0 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-function 2) ("\\b\\(C-h\\|?\\)[ \t\n]+v[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET" 0 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-variable 2) - ("`\\(\\b\\(C-h\\|?\\)[ \t\n]+k[ \t\n]+\\([^']+\\)\\)'" + ("`\\(\\(C-h\\|?\\)[ \t\n]+k[ \t\n]+\\([^']+\\)\\)'" ;; Unlike the other regexps we really have to require quoting ;; here to determine where it ends. 1 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-key 3) @@ -6554,6 +7043,13 @@ positives are possible." ;; SoWWWAnchor(3iv), XSelectInput(3X11), X(1), X(7) ("\\b\\(\\(?:[a-z][-+_.:a-z0-9]+([1-9][X1a-z]*)\\)\\|\\b\\(?:X([1-9])\\)\\)\\W" 0 (>= gnus-button-man-level 5) gnus-button-handle-man 1) + ;; Recognizing patches to .el files. This is somewhat obscure, + ;; but considering the percentage of Gnus users who hack Emacs + ;; Lisp files... + ("^--- \\([^ .]+\\.el\\).*\n.*\n@@ -?\\([0-9]+\\)" 1 + (>= gnus-button-message-level 4) gnus-button-patch 1 2) + ("^\\*\\*\\* \\([^ .]+\\.el\\).*\n.*\n\\*+\n\\*\\*\\* \\([0-9]+\\)" 1 + (>= gnus-button-message-level 4) gnus-button-patch 1 2) ;; MID or mail: To avoid too many false positives we don't try to catch ;; all kind of allowed MIDs or mail addresses. Domain part must contain ;; at least one dot. TLD must contain two or three chars or be a know TLD @@ -6919,6 +7415,15 @@ specified by `gnus-button-alist'." (group (gnus-button-fetch-group url))))) +(defun gnus-button-patch (library line) + "Visit an Emacs Lisp library LIBRARY on line LINE." + (interactive) + (let ((file (locate-library (file-name-nondirectory library)))) + (unless file + (error "Couldn't find library %s" library)) + (find-file file) + (goto-line (string-to-number line)))) + (defun gnus-button-handle-man (url) "Fetch a man page." (gnus-message 9 "`%s' `%s'" gnus-button-man-handler url) @@ -6980,8 +7485,13 @@ specified by `gnus-button-alist'." (with-current-buffer gnus-summary-buffer (gnus-summary-refer-article message-id))) -(defun gnus-button-fetch-group (address) +(defun gnus-button-fetch-group (address &rest ignore) "Fetch GROUP specified by ADDRESS." + (when (string-match "\\`\\(nntp\\|news\\):\\(//\\)?\\(.*\\)\\'" + address) + ;; Allow to use `gnus-button-fetch-group' in `browse-url-browser-function' + ;; for nntp:// and news:// + (setq address (match-string 3 address))) (if (not (string-match "[:/]" address)) ;; This is just a simple group url. (gnus-group-read-ephemeral-group address gnus-select-method) @@ -7071,19 +7581,23 @@ specified by `gnus-button-alist'." map)) (defun gnus-insert-prev-page-button () - (let ((b (point)) + (let ((b (point)) e (inhibit-read-only t)) (gnus-eval-format gnus-prev-page-line-format nil `(keymap ,gnus-prev-page-map - gnus-prev t - gnus-callback gnus-article-button-prev-page - article-type annotation)) + gnus-prev t + gnus-callback gnus-article-button-prev-page + article-type annotation)) + (setq e (if (bolp) + ;; Exclude a newline. + (1- (point)) + (point))) + (when gnus-article-button-face + (gnus-overlay-put (gnus-make-overlay b e) + 'face gnus-article-button-face)) (widget-convert-button - 'link b (if (bolp) - ;; Exclude a newline. - (1- (point)) - (point)) + 'link b e :action 'gnus-button-prev-page :button-keymap gnus-prev-page-map))) @@ -7104,18 +7618,22 @@ specified by `gnus-button-alist'." (select-window win))) (defun gnus-insert-next-page-button () - (let ((b (point)) + (let ((b (point)) e (inhibit-read-only t)) (gnus-eval-format gnus-next-page-line-format nil `(keymap ,gnus-next-page-map - gnus-next t - gnus-callback gnus-article-button-next-page - article-type annotation)) + gnus-next t + gnus-callback gnus-article-button-next-page + article-type annotation)) + (setq e (if (bolp) + ;; Exclude a newline. + (1- (point)) + (point))) + (when gnus-article-button-face + (gnus-overlay-put (gnus-make-overlay b e) + 'face gnus-article-button-face)) (widget-convert-button - 'link b (if (bolp) - ;; Exclude a newline. - (1- (point)) - (point)) + 'link b e :action 'gnus-button-next-page :button-keymap gnus-next-page-map))) @@ -7343,12 +7861,51 @@ For example: (?d gnus-tmp-details ?s) (?D gnus-tmp-pressed-details ?s))) +(defvar gnus-mime-security-button-commands + '((gnus-article-press-button "\r" "Show Detail") + (undefined "v") + (undefined "t") + (undefined "C") + (gnus-mime-security-save-part "o" "Save...") + (undefined "\C-o") + (undefined "r") + (undefined "d") + (undefined "c") + (undefined "i") + (undefined "E") + (undefined "e") + (undefined "p") + (gnus-mime-security-pipe-part "|" "Pipe To Command...") + (undefined "."))) + (defvar gnus-mime-security-button-map (let ((map (make-sparse-keymap))) (define-key map gnus-mouse-2 'gnus-article-push-button) - (define-key map "\r" 'gnus-article-press-button) + (define-key map gnus-down-mouse-3 'gnus-mime-security-button-menu) + (dolist (c gnus-mime-security-button-commands) + (define-key map (cadr c) (car c))) map)) +(easy-menu-define + gnus-mime-security-button-menu gnus-mime-security-button-map + "Security button menu." + `("Security Part" + ,@(delq nil + (mapcar (lambda (c) + (unless (eq (car c) 'undefined) + (vector (caddr c) (car c) :active t))) + gnus-mime-security-button-commands)))) + +(defun gnus-mime-security-button-menu (event prefix) + "Construct a context-sensitive menu of security commands." + (interactive "e\nP") + (save-window-excursion + (let ((pos (event-start event))) + (select-window (posn-window pos)) + (goto-char (posn-point pos)) + (gnus-article-check-buffer) + (popup-menu gnus-mime-security-button-menu nil prefix)))) + (defvar gnus-mime-security-details-buffer nil) (defvar gnus-mime-security-button-pressed nil) @@ -7461,6 +8018,9 @@ For example: ;; Exclude a newline. (1- (point)) (point))) + (when gnus-article-button-face + (gnus-overlay-put (gnus-make-overlay b e) + 'face gnus-article-button-face)) (widget-convert-button 'link b e :mime-handle handle @@ -7473,8 +8033,9 @@ For example: (when (boundp 'help-echo-owns-message) (setq help-echo-owns-message t)) (format - "%S: show detail" - (aref gnus-mouse-2 0)))))) + "%S: show detail; %S: more options" + (aref gnus-mouse-2 0) + (aref gnus-down-mouse-3 0)))))) (defun gnus-mime-display-security (handle) (save-restriction @@ -7493,6 +8054,34 @@ For example: (cons (set-marker (make-marker) (point-min)) (set-marker (make-marker) (point-max)))))) +(defun gnus-mime-security-run-function (function) + "Run FUNCTION with the security part under point." + (gnus-article-check-buffer) + (let ((data (get-text-property (point) 'gnus-data)) + buffer handle) + (when (and (stringp (car-safe data)) + (setq buffer (mm-handle-multipart-original-buffer data)) + (setq handle (cadr data))) + (if (bufferp (mm-handle-buffer handle)) + (progn + (setq handle (cons buffer (copy-sequence (cdr handle)))) + (mm-handle-set-undisplayer handle nil)) + (setq handle (mm-make-handle + buffer + (mm-handle-multipart-ctl-parameter handle 'protocol) + nil nil nil nil nil nil))) + (funcall function handle)))) + +(defun gnus-mime-security-save-part () + "Save the security part under point." + (interactive) + (gnus-mime-security-run-function 'mm-save-part)) + +(defun gnus-mime-security-pipe-part () + "Pipe the security part under point to a process." + (interactive) + (gnus-mime-security-run-function 'mm-pipe-part)) + (gnus-ems-redefine) (provide 'gnus-art)