Mercurial > emacs
changeset 71262:70b055c73c8c
Merge from gnus--rel--5.10
Patches applied:
* gnus--rel--5.10 (patch 103-104)
- Update from CVS
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-295
| author | Miles Bader <miles@gnu.org> |
|---|---|
| date | Wed, 07 Jun 2006 16:39:16 +0000 |
| parents | c6e18badb0a7 |
| children | 1d43c64436be a8190f7e546e |
| files | lisp/gnus/ChangeLog lisp/gnus/gnus-agent.el lisp/gnus/gnus-art.el lisp/gnus/gnus-ml.el lisp/gnus/gnus-sum.el lisp/gnus/imap.el lisp/gnus/mail-source.el lisp/gnus/mm-util.el lisp/gnus/uudecode.el lisp/pgg-pgp.el lisp/pgg-pgp5.el man/ChangeLog man/gnus.texi |
| diffstat | 13 files changed, 588 insertions(+), 305 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/gnus/ChangeLog Wed Jun 07 13:34:42 2006 +0000 +++ b/lisp/gnus/ChangeLog Wed Jun 07 16:39:16 2006 +0000 @@ -1,3 +1,86 @@ +2006-06-06 Katsumi Yamaoka <yamaoka@jpl.org> + + * mm-util.el (mm-mime-mule-charset-alist): Use unicode-precedence-list + to fill the utf-8 entry. + +2006-06-05 Dan Christensen <jdc@uwo.ca> + + * gnus-sum.el (gnus-summary-read-group-1): When summary is unthreaded, + respect display group parameter and gnus-summary-expunge-below. + (gnus-articles-to-read): Remove unused reference to display group + parameter. + [ Merge 2004-07-06 change from the trunk. ] + +2006-05-29 Reiner Steib <Reiner.Steib@gmx.de> + + * gnus-ml.el (gnus-mailing-list-subscribe) + (gnus-mailing-list-unsubscribe, gnus-mailing-list-owner) + (gnus-mailing-list-message): Fix doc strings. + +2006-05-29 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> + + * gnus-ml.el (gnus-mailing-list-message): Use gnus-url-mailto instead + of doing it manually. + +2006-05-29 Kevin Greiner <kevin.greiner@compsol.cc> + + * gnus-agent.el (gnus-agent-possibly-synchronize-flags): A server + must be explicitly online rather than "not explicitly offline" for + its flags to be synchronized. + (gnus-agent-read-local): All symbols allocated in my-obarray + (gnus-agent-set-local): Skip invalid entries (min and/or max is nil). + (gnus-agent-regenerate-group): Check numeric names to see if they are + messages or groups. + +2006-05-29 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-save-all-headers): Mention it might be overridden. + (gnus-saved-headers): Ditto. + (gnus-default-article-saver): Doc fix; add + gnus-summary-write-body-to-file; mention functions may have properties. + (gnus-article-save-coding-system): New variable. + (gnus-article-save): Override gnus-save-all-headers and + gnus-saved-headers by :headers property which saver function may have. + (gnus-read-save-file-name): Add optional `dir-var' argument which + specifies directory in which files are saved; work even if optional + `variable' argument is not specified. + (gnus-summary-save-in-file): Add properties :decode and :headers. + (gnus-summary-write-to-file): Add properties :decode, :function, and + :headers; read file name. + (gnus-summary-save-body-in-file): Add :decode property; add optional + `overwrite' argument. + (gnus-summary-write-body-to-file): New function; add properties + :decode and :function. + (gnus-output-to-file): Add coding cookie and encode text according + to gnus-article-save-coding-system; don't use mm-append-to-file. + + * gnus-sum.el (gnus-newsgroup-last-directory): New variable. + (gnus-summary-local-variables): Add it. + (gnus-summary-save-map): Add gnus-summary-write-article-body-file. + (gnus-summary-save-article): Require gnus-art; save decoded articles + if function that gnus-default-article-saver specifies has `:decode' + property; bind gnus-prompt-before-saving to t when saving many + articles in a file; move point to article which will be saved. + (gnus-summary-write-article-body-file): New function. + +2006-05-26 Reiner Steib <Reiner.Steib@gmx.de> + + * uudecode.el (uudecode-decode-region-external): Fix previous commit. + +2006-05-26 Katsumi Yamaoka <yamaoka@jpl.org> + + * mm-util.el (mm-enrich-utf-8-by-mule-ucs): Don't edit + after-load-alist. + +2006-05-22 Reiner Steib <Reiner.Steib@gmx.de> + + * uudecode.el (uudecode-decode-region-external): nil isn't a valid + coding system in XEmacs, use binary. + + * mail-source.el (mail-sources): Fix custom type. + + * imap.el (Commentary): Fix typo. + 2006-05-18 Reiner Steib <Reiner.Steib@gmx.de> * gnus-sum.el (gnus-summary-save-article-mail): Clarify doc string.
--- a/lisp/gnus/gnus-agent.el Wed Jun 07 13:34:42 2006 +0000 +++ b/lisp/gnus/gnus-agent.el Wed Jun 07 16:39:16 2006 +0000 @@ -825,7 +825,7 @@ (save-excursion (dolist (gnus-command-method (gnus-agent-covered-methods)) (when (and (file-exists-p (gnus-agent-lib-file "flags")) - (not (eq (gnus-server-status gnus-command-method) 'offline))) + (eq (gnus-server-status gnus-command-method) 'ok)) (gnus-agent-possibly-synchronize-flags-server gnus-command-method))))) (defun gnus-agent-synchronize-flags-server (method) @@ -2133,7 +2133,8 @@ (let (group min max - (cur (current-buffer))) + (cur (current-buffer)) + (obarray my-obarray)) (setq group (read cur) min (read cur) max (read cur)) @@ -2214,7 +2215,9 @@ (if (cond ((and minmax (or (not (eq min (car minmax))) - (not (eq max (cdr minmax))))) + (not (eq max (cdr minmax)))) + min + max) (setcar minmax min) (setcdr minmax max) t) @@ -3743,8 +3746,10 @@ (dir (file-name-directory file)) point (downloaded (if (file-exists-p dir) - (sort (mapcar (lambda (name) (string-to-number name)) - (directory-files dir nil "^[0-9]+$" t)) + (sort (delq nil (mapcar (lambda (name) + (and (not (file-directory-p (nnheader-concat dir name))) + (string-to-number name))) + (directory-files dir nil "^[0-9]+$" t))) '>) (progn (gnus-make-directory dir) nil))) dl nov-arts
--- a/lisp/gnus/gnus-art.el Wed Jun 07 13:34:42 2006 +0000 +++ b/lisp/gnus/gnus-art.el Wed Jun 07 16:39:16 2006 +0000 @@ -492,7 +492,10 @@ :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) @@ -513,14 +516,17 @@ "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: @@ -530,7 +536,28 @@ * 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) @@ -539,8 +566,49 @@ (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-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. The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE." @@ -3249,10 +3317,13 @@ (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) @@ -3277,7 +3348,8 @@ (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) @@ -3290,6 +3362,10 @@ 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 @@ -3354,7 +3430,11 @@ ;; 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." @@ -3402,6 +3482,8 @@ (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. @@ -3420,13 +3502,21 @@ (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)) - -(defun gnus-summary-save-body-in-file (&optional filename) + (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)) + +(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'." @@ -3440,9 +3530,25 @@ (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 @@ -5182,17 +5288,55 @@ ;;; 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.
--- a/lisp/gnus/gnus-ml.el Wed Jun 07 13:34:42 2006 +0000 +++ b/lisp/gnus/gnus-ml.el Wed Jun 07 16:39:16 2006 +0000 @@ -4,7 +4,7 @@ ;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Julien Gilles <jgilles@free.fr> -;; Keywords: news +;; Keywords: news, mail ;; This file is part of GNU Emacs. @@ -51,8 +51,7 @@ "\C-c\C-nu" gnus-mailing-list-unsubscribe "\C-c\C-np" gnus-mailing-list-post "\C-c\C-no" gnus-mailing-list-owner - "\C-c\C-na" gnus-mailing-list-archive - )) + "\C-c\C-na" gnus-mailing-list-archive)) (defun gnus-mailing-list-make-menu-bar () (unless (boundp 'gnus-mailing-list-menu) @@ -103,7 +102,8 @@ ;; Set up the menu. (when (gnus-visual-p 'mailing-list-menu 'menu) (gnus-mailing-list-make-menu-bar)) - (gnus-add-minor-mode 'gnus-mailing-list-mode " Mailing-List" gnus-mailing-list-mode-map) + (gnus-add-minor-mode 'gnus-mailing-list-mode " Mailing-List" + gnus-mailing-list-mode-map) (gnus-run-hooks 'gnus-mailing-list-mode-hook)))) ;;; Commands @@ -118,7 +118,7 @@ (t (gnus-message 1 "no list-help in this group"))))) (defun gnus-mailing-list-subscribe () - "Subscribe" + "Subscribe to mailing list." (interactive) (let ((list-subscribe (with-current-buffer gnus-original-article-buffer @@ -127,7 +127,7 @@ (t (gnus-message 1 "no list-subscribe in this group"))))) (defun gnus-mailing-list-unsubscribe () - "Unsubscribe" + "Unsubscribe from mailing list." (interactive) (let ((list-unsubscribe (with-current-buffer gnus-original-article-buffer @@ -145,7 +145,7 @@ (t (gnus-message 1 "no list-post in this group"))))) (defun gnus-mailing-list-owner () - "Mail to the owner" + "Mail to the mailing list owner." (interactive) (let ((list-owner (with-current-buffer gnus-original-article-buffer @@ -154,7 +154,7 @@ (t (gnus-message 1 "no list-owner in this group"))))) (defun gnus-mailing-list-archive () - "Browse archive" + "Browse archive." (interactive) (require 'browse-url) (let ((list-archive @@ -169,33 +169,14 @@ ;;; Utility functions (defun gnus-mailing-list-message (address) - "" - (let ((mailto "") - (to ()) - (subject "None") - (body "") - ) - (cond - ((string-match "<mailto:\\([^>]*\\)>" address) - (let ((args (match-string 1 address))) - (cond ; with param - ((string-match "\\(.*\\)\\?\\(.*\\)" args) - (setq mailto (match-string 1 args)) - (let ((param (match-string 2 args))) - (if (string-match "subject=\\([^&]*\\)" param) - (setq subject (match-string 1 param))) - (if (string-match "body=\\([^&]*\\)" param) - (setq body (match-string 1 param))) - (if (string-match "to=\\([^&]*\\)" param) - (push (match-string 1 param) to)) - )) - (t (setq mailto args))))) ; without param - - ; other case <http://... to be done. - (t nil)) - (gnus-setup-message 'message (message-mail mailto subject)) - (insert body) - )) + "Send message to ADDRESS. +ADDRESS is specified by a \"mailto:\" URL." + (cond + ((string-match "<\\(mailto:[^>]*\\)>" address) + (require 'gnus-art) + (gnus-url-mailto (match-string 1 address))) + ;; other case <http://...> to be done. + (t nil))) (provide 'gnus-ml)
--- a/lisp/gnus/gnus-sum.el Wed Jun 07 13:34:42 2006 +0000 +++ b/lisp/gnus/gnus-sum.el Wed Jun 07 16:39:16 2006 +0000 @@ -1249,6 +1249,7 @@ (defvar gnus-newsgroup-last-mail nil) (defvar gnus-newsgroup-last-folder nil) (defvar gnus-newsgroup-last-file nil) +(defvar gnus-newsgroup-last-directory nil) (defvar gnus-newsgroup-auto-expire nil) (defvar gnus-newsgroup-active nil) @@ -1364,6 +1365,7 @@ gnus-newsgroup-begin gnus-newsgroup-end gnus-newsgroup-last-rmail gnus-newsgroup-last-mail gnus-newsgroup-last-folder gnus-newsgroup-last-file + gnus-newsgroup-last-directory gnus-newsgroup-auto-expire gnus-newsgroup-unreads gnus-newsgroup-unselected gnus-newsgroup-marked gnus-newsgroup-spam-marked @@ -1991,6 +1993,7 @@ "r" gnus-summary-save-article-rmail "f" gnus-summary-save-article-file "b" gnus-summary-save-article-body-file + "B" gnus-summary-write-article-body-file "h" gnus-summary-save-article-folder "v" gnus-summary-save-article-vm "p" gnus-summary-pipe-output @@ -3709,16 +3712,10 @@ (when gnus-build-sparse-threads (gnus-build-sparse-threads)) ;; Find the initial limit. - (if gnus-show-threads - (if show-all - (let ((gnus-newsgroup-dormant nil)) - (gnus-summary-initial-limit show-all)) + (if show-all + (let ((gnus-newsgroup-dormant nil)) (gnus-summary-initial-limit show-all)) - ;; When unthreaded, all articles are always shown. - (setq gnus-newsgroup-limit - (mapcar - (lambda (header) (mail-header-number header)) - gnus-newsgroup-headers))) + (gnus-summary-initial-limit show-all)) ;; Generate the summary buffer. (unless no-display (gnus-summary-prepare)) @@ -5419,8 +5416,7 @@ (defun gnus-articles-to-read (group &optional read-all) "Find out what articles the user wants to read." - (let* ((display (gnus-group-find-parameter group 'display)) - (articles + (let* ((articles ;; Select all articles if `read-all' is non-nil, or if there ;; are no unread articles. (if (or read-all @@ -10993,12 +10989,26 @@ If N is a negative number, save the N previous articles. If N is nil and any articles have been marked with the process mark, save those articles instead. -The variable `gnus-default-article-saver' specifies the saver function." +The variable `gnus-default-article-saver' specifies the saver function. + +If the optional second argument NOT-SAVED is non-nil, articles saved +will not be marked as saved." (interactive "P") + (require 'gnus-art) (let* ((articles (gnus-summary-work-articles n)) (save-buffer (save-excursion (nnheader-set-temp-buffer " *Gnus Save*"))) (num (length articles)) + ;; Whether to save decoded articles or raw articles. + (decode (when gnus-article-save-coding-system + (get gnus-default-article-saver :decode))) + ;; When saving many articles in a single file, use the other + ;; function to save articles other than the first one. + (saver2 (get gnus-default-article-saver :function)) + (gnus-prompt-before-saving (if saver2 + t + gnus-prompt-before-saving)) + (gnus-default-article-saver gnus-default-article-saver) header file) (dolist (article articles) (setq header (gnus-summary-article-header article)) @@ -11009,17 +11019,25 @@ (gnus-message 1 "Article %d is unsaveable" article)) ;; This is a real article. (save-window-excursion - (let ((gnus-display-mime-function nil) - (gnus-article-prepare-hook nil)) - (gnus-summary-select-article t nil nil article))) + (let ((gnus-display-mime-function (when decode + gnus-display-mime-function)) + (gnus-article-prepare-hook (when decode + gnus-article-prepare-hook))) + (gnus-summary-select-article t nil nil article) + (gnus-summary-goto-subject article))) (save-excursion (set-buffer save-buffer) (erase-buffer) - (insert-buffer-substring gnus-original-article-buffer)) + (insert-buffer-substring (if decode + gnus-article-buffer + gnus-original-article-buffer))) (setq file (gnus-article-save save-buffer file num)) (gnus-summary-remove-process-mark article) (unless not-saved - (gnus-summary-set-saved-mark article)))) + (gnus-summary-set-saved-mark article))) + (when saver2 + (setq gnus-default-article-saver saver2 + saver2 nil))) (gnus-kill-buffer save-buffer) (gnus-summary-position-point) (gnus-set-mode-line 'summary) @@ -11097,6 +11115,17 @@ (let ((gnus-default-article-saver 'gnus-summary-save-body-in-file)) (gnus-summary-save-article arg))) +(defun gnus-summary-write-article-body-file (&optional arg) + "Write the current article body to a file, deleting the previous file. +If N is a positive number, save the N next articles. +If N is a negative number, save the N previous articles. +If N is nil and any articles have been marked with the process mark, +save those articles instead." + (interactive "P") + (require 'gnus-art) + (let ((gnus-default-article-saver 'gnus-summary-write-body-to-file)) + (gnus-summary-save-article arg))) + (defun gnus-summary-muttprint (&optional arg) "Print the current article using Muttprint. If N is a positive number, save the N next articles.
--- a/lisp/gnus/imap.el Wed Jun 07 13:34:42 2006 +0000 +++ b/lisp/gnus/imap.el Wed Jun 07 16:39:16 2006 +0000 @@ -79,7 +79,7 @@ ;; (NAMESPACE), RFC2359 (UIDPLUS), the IMAP-part of RFC2595 (STARTTLS, ;; LOGINDISABLED) (with use of external library starttls.el and ;; program starttls) and the GSSAPI / kerberos V4 sections of RFC1731 -;; (with use of external program `imtest'). It also take advantage +;; (with use of external program `imtest'). It also takes advantage of ;; the UNSELECT extension in Cyrus IMAPD. ;; ;; Without the work of John McClary Prevost and Jim Radford this library
--- a/lisp/gnus/mail-source.el Wed Jun 07 13:34:42 2006 +0000 +++ b/lisp/gnus/mail-source.el Wed Jun 07 16:39:16 2006 +0000 @@ -63,175 +63,177 @@ See Info node `(gnus)Mail Source Specifiers'." :group 'mail-source :link '(custom-manual "(gnus)Mail Source Specifiers") - :type `(repeat - (choice :format "%[Value Menu%] %v" - :value (file) - (cons :tag "Spool file" - (const :format "" file) - (checklist :tag "Options" :greedy t - (group :inline t - (const :format "" :value :path) - file))) - (cons :tag "Several files in a directory" - (const :format "" directory) - (checklist :tag "Options" :greedy t - (group :inline t - (const :format "" :value :path) - (directory :tag "Path")) - (group :inline t - (const :format "" :value :suffix) - (string :tag "Suffix")) - (group :inline t - (const :format "" :value :predicate) - (function :tag "Predicate")) - (group :inline t - (const :format "" :value :prescript) - (choice :tag "Prescript" - :value nil - (string :format "%v") - (function :format "%v"))) - (group :inline t - (const :format "" :value :postscript) - (choice :tag "Postscript" - :value nil - (string :format "%v") - (function :format "%v"))) - (group :inline t - (const :format "" :value :plugged) - (boolean :tag "Plugged")))) - (cons :tag "POP3 server" - (const :format "" pop) - (checklist :tag "Options" :greedy t - (group :inline t - (const :format "" :value :server) - (string :tag "Server")) - (group :inline t - (const :format "" :value :port) - (choice :tag "Port" - :value "pop3" - (number :format "%v") - (string :format "%v"))) - (group :inline t - (const :format "" :value :user) - (string :tag "User")) - (group :inline t - (const :format "" :value :password) - (string :tag "Password")) - (group :inline t - (const :format "" :value :program) - (string :tag "Program")) - (group :inline t - (const :format "" :value :prescript) - (choice :tag "Prescript" - :value nil - (string :format "%v") - (function :format "%v"))) - (group :inline t - (const :format "" :value :postscript) - (choice :tag "Postscript" - :value nil - (string :format "%v") - (function :format "%v"))) - (group :inline t - (const :format "" :value :function) - (function :tag "Function")) - (group :inline t - (const :format "" - :value :authentication) - (choice :tag "Authentication" - :value apop - (const password) - (const apop))) - (group :inline t - (const :format "" :value :plugged) - (boolean :tag "Plugged")))) - (cons :tag "Maildir (qmail, postfix...)" - (const :format "" maildir) - (checklist :tag "Options" :greedy t - (group :inline t - (const :format "" :value :path) - (directory :tag "Path")) - (group :inline t - (const :format "" :value :plugged) - (boolean :tag "Plugged")))) - (cons :tag "IMAP server" - (const :format "" imap) - (checklist :tag "Options" :greedy t - (group :inline t - (const :format "" :value :server) - (string :tag "Server")) - (group :inline t - (const :format "" :value :port) - (choice :tag "Port" - :value 143 - number string)) - (group :inline t - (const :format "" :value :user) - (string :tag "User")) - (group :inline t - (const :format "" :value :password) - (string :tag "Password")) - (group :inline t - (const :format "" :value :stream) - (choice :tag "Stream" - :value network - ,@mail-source-imap-streams)) - (group :inline t - (const :format "" :value :program) - (string :tag "Program")) - (group :inline t - (const :format "" - :value :authenticator) - (choice :tag "Authenticator" - :value login - ,@mail-source-imap-authenticators)) - (group :inline t - (const :format "" :value :mailbox) - (string :tag "Mailbox" - :value "INBOX")) - (group :inline t - (const :format "" :value :predicate) - (string :tag "Predicate" - :value "UNSEEN UNDELETED")) - (group :inline t - (const :format "" :value :fetchflag) - (string :tag "Fetchflag" - :value "\\Deleted")) - (group :inline t - (const :format "" - :value :dontexpunge) - (boolean :tag "Dontexpunge")) - (group :inline t - (const :format "" :value :plugged) - (boolean :tag "Plugged")))) - (cons :tag "Webmail server" - (const :format "" webmail) - (checklist :tag "Options" :greedy t - (group :inline t - (const :format "" :value :subtype) - ;; Should be generated from - ;; `webmail-type-definition', but we - ;; can't require webmail without W3. - (choice :tag "Subtype" - :value hotmail - (const hotmail) - (const yahoo) - (const netaddress) - (const netscape) - (const my-deja))) - (group :inline t - (const :format "" :value :user) - (string :tag "User")) - (group :inline t - (const :format "" :value :password) - (string :tag "Password")) - (group :inline t - (const :format "" - :value :dontexpunge) - (boolean :tag "Dontexpunge")) - (group :inline t - (const :format "" :value :plugged) - (boolean :tag "Plugged"))))))) + :type `(choice + (const nil) + (repeat + (choice :format "%[Value Menu%] %v" + :value (file) + (cons :tag "Spool file" + (const :format "" file) + (checklist :tag "Options" :greedy t + (group :inline t + (const :format "" :value :path) + file))) + (cons :tag "Several files in a directory" + (const :format "" directory) + (checklist :tag "Options" :greedy t + (group :inline t + (const :format "" :value :path) + (directory :tag "Path")) + (group :inline t + (const :format "" :value :suffix) + (string :tag "Suffix")) + (group :inline t + (const :format "" :value :predicate) + (function :tag "Predicate")) + (group :inline t + (const :format "" :value :prescript) + (choice :tag "Prescript" + :value nil + (string :format "%v") + (function :format "%v"))) + (group :inline t + (const :format "" :value :postscript) + (choice :tag "Postscript" + :value nil + (string :format "%v") + (function :format "%v"))) + (group :inline t + (const :format "" :value :plugged) + (boolean :tag "Plugged")))) + (cons :tag "POP3 server" + (const :format "" pop) + (checklist :tag "Options" :greedy t + (group :inline t + (const :format "" :value :server) + (string :tag "Server")) + (group :inline t + (const :format "" :value :port) + (choice :tag "Port" + :value "pop3" + (number :format "%v") + (string :format "%v"))) + (group :inline t + (const :format "" :value :user) + (string :tag "User")) + (group :inline t + (const :format "" :value :password) + (string :tag "Password")) + (group :inline t + (const :format "" :value :program) + (string :tag "Program")) + (group :inline t + (const :format "" :value :prescript) + (choice :tag "Prescript" + :value nil + (string :format "%v") + (function :format "%v"))) + (group :inline t + (const :format "" :value :postscript) + (choice :tag "Postscript" + :value nil + (string :format "%v") + (function :format "%v"))) + (group :inline t + (const :format "" :value :function) + (function :tag "Function")) + (group :inline t + (const :format "" + :value :authentication) + (choice :tag "Authentication" + :value apop + (const password) + (const apop))) + (group :inline t + (const :format "" :value :plugged) + (boolean :tag "Plugged")))) + (cons :tag "Maildir (qmail, postfix...)" + (const :format "" maildir) + (checklist :tag "Options" :greedy t + (group :inline t + (const :format "" :value :path) + (directory :tag "Path")) + (group :inline t + (const :format "" :value :plugged) + (boolean :tag "Plugged")))) + (cons :tag "IMAP server" + (const :format "" imap) + (checklist :tag "Options" :greedy t + (group :inline t + (const :format "" :value :server) + (string :tag "Server")) + (group :inline t + (const :format "" :value :port) + (choice :tag "Port" + :value 143 + number string)) + (group :inline t + (const :format "" :value :user) + (string :tag "User")) + (group :inline t + (const :format "" :value :password) + (string :tag "Password")) + (group :inline t + (const :format "" :value :stream) + (choice :tag "Stream" + :value network + ,@mail-source-imap-streams)) + (group :inline t + (const :format "" :value :program) + (string :tag "Program")) + (group :inline t + (const :format "" + :value :authenticator) + (choice :tag "Authenticator" + :value login + ,@mail-source-imap-authenticators)) + (group :inline t + (const :format "" :value :mailbox) + (string :tag "Mailbox" + :value "INBOX")) + (group :inline t + (const :format "" :value :predicate) + (string :tag "Predicate" + :value "UNSEEN UNDELETED")) + (group :inline t + (const :format "" :value :fetchflag) + (string :tag "Fetchflag" + :value "\\Deleted")) + (group :inline t + (const :format "" + :value :dontexpunge) + (boolean :tag "Dontexpunge")) + (group :inline t + (const :format "" :value :plugged) + (boolean :tag "Plugged")))) + (cons :tag "Webmail server" + (const :format "" webmail) + (checklist :tag "Options" :greedy t + (group :inline t + (const :format "" :value :subtype) + ;; Should be generated from + ;; `webmail-type-definition', but we + ;; can't require webmail without W3. + (choice :tag "Subtype" + :value hotmail + (const hotmail) + (const yahoo) + (const netaddress) + (const netscape) + (const my-deja))) + (group :inline t + (const :format "" :value :user) + (string :tag "User")) + (group :inline t + (const :format "" :value :password) + (string :tag "Password")) + (group :inline t + (const :format "" + :value :dontexpunge) + (boolean :tag "Dontexpunge")) + (group :inline t + (const :format "" :value :plugged) + (boolean :tag "Plugged")))))))) (defcustom mail-source-ignore-errors nil "*Ignore errors when querying mail sources.
--- a/lisp/gnus/mm-util.el Wed Jun 07 13:34:42 2006 +0000 +++ b/lisp/gnus/mm-util.el Wed Jun 07 16:39:16 2006 +0000 @@ -364,14 +364,17 @@ (iso-2022-jp-3 latin-jisx0201 japanese-jisx0208-1978 japanese-jisx0208 japanese-jisx0213-1 japanese-jisx0213-2) (shift_jis latin-jisx0201 katakana-jisx0201 japanese-jisx0208) - ,(if (or (not (fboundp 'charsetp)) ;; non-Mule case - (charsetp 'unicode-a) - (not (mm-coding-system-p 'mule-utf-8))) - '(utf-8 unicode-a unicode-b unicode-c unicode-d unicode-e) - ;; If we have utf-8 we're in Mule 5+. - (append '(utf-8) - (delete 'ascii - (coding-system-get 'mule-utf-8 'safe-charsets))))) + ,(cond ((fboundp 'unicode-precedence-list) + (cons 'utf-8 (delq 'ascii (mapcar 'charset-name + (unicode-precedence-list))))) + ((or (not (fboundp 'charsetp)) ;; non-Mule case + (charsetp 'unicode-a) + (not (mm-coding-system-p 'mule-utf-8))) + '(utf-8 unicode-a unicode-b unicode-c unicode-d unicode-e)) + (t ;; If we have utf-8 we're in Mule 5+. + (append '(utf-8) + (delete 'ascii + (coding-system-get 'mule-utf-8 'safe-charsets)))))) "Alist of MIME-charset/MULE-charsets.") (defun mm-enrich-utf-8-by-mule-ucs () @@ -379,10 +382,6 @@ This function will run when the `un-define' module is loaded under XEmacs, and fill the `utf-8' entry in `mm-mime-mule-charset-alist' with Mule charsets. It is completely useless for Emacs." - (unless (cdr (delete '(mm-enrich-utf-8-by-mule-ucs) - (assoc "un-define" after-load-alist))) - (setq after-load-alist - (delete '("un-define") after-load-alist))) (when (boundp 'unicode-basic-translation-charset-order-list) (condition-case nil (let ((val (delq
--- a/lisp/gnus/uudecode.el Wed Jun 07 13:34:42 2006 +0000 +++ b/lisp/gnus/uudecode.el Wed Jun 07 16:39:16 2006 +0000 @@ -100,7 +100,11 @@ (make-temp-name "uu") uudecode-temporary-file-directory)))) (let ((cdir default-directory) - default-process-coding-system) + (default-process-coding-system + (if (featurep 'xemacs) + ;; In XEmacs, `nil' is not a valid coding system. + '(binary . binary) + nil))) (unwind-protect (with-temp-buffer (insert "begin 600 " (file-name-nondirectory tempfile) "\n")
--- a/lisp/pgg-pgp.el Wed Jun 07 13:34:42 2006 +0000 +++ b/lisp/pgg-pgp.el Wed Jun 07 16:39:16 2006 +0000 @@ -136,21 +136,21 @@ "Encrypt the current region between START and END." (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id)) (passphrase (or passphrase - (when sign - (pgg-read-passphrase - (format "PGP passphrase for %s: " - pgg-pgp-user-id) - pgg-pgp-user-id)))) + (when sign + (pgg-read-passphrase + (format "PGP passphrase for %s: " + pgg-pgp-user-id) + pgg-pgp-user-id)))) (args - (append - `("+encrypttoself=off +verbose=1" "+batchmode" - "+language=us" "-fate" - ,@(if recipients - (mapcar (lambda (rcpt) (concat "\"" rcpt "\"")) - (append recipients - (if pgg-encrypt-for-me - (list pgg-pgp-user-id)))))) - (if sign '("-s" "-u" pgg-pgp-user-id))))) + (append + `("+encrypttoself=off +verbose=1" "+batchmode" + "+language=us" "-fate" + ,@(if recipients + (mapcar (lambda (rcpt) (concat "\"" rcpt "\"")) + (append recipients + (if pgg-encrypt-for-me + (list pgg-pgp-user-id)))))) + (if sign '("-s" "-u" pgg-pgp-user-id))))) (pgg-pgp-process-region start end nil pgg-pgp-program args) (pgg-process-when-success nil))) @@ -162,11 +162,11 @@ (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id)) (key (pgg-pgp-lookup-key pgg-pgp-user-id 'encrypt)) (passphrase - (or passphrase - (pgg-read-passphrase - (format "PGP passphrase for %s: " pgg-pgp-user-id) key))) + (or passphrase + (pgg-read-passphrase + (format "PGP passphrase for %s: " pgg-pgp-user-id) key))) (args - '("+verbose=1" "+batchmode" "+language=us" "-f"))) + '("+verbose=1" "+batchmode" "+language=us" "-f"))) (pgg-pgp-process-region start end passphrase pgg-pgp-program args) (pgg-process-when-success (if pgg-cache-passphrase @@ -179,10 +179,10 @@ passphrase cache or user." (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id)) (passphrase - (or passphrase - (pgg-read-passphrase - (format "PGP passphrase for %s: " pgg-pgp-user-id) - (pgg-pgp-lookup-key pgg-pgp-user-id 'sign)))) + (or passphrase + (pgg-read-passphrase + (format "PGP passphrase for %s: " pgg-pgp-user-id) + (pgg-pgp-lookup-key pgg-pgp-user-id 'sign)))) (args (list (if clearsign "-fast" "-fbast") "+verbose=1" "+language=us" "+batchmode"
--- a/lisp/pgg-pgp5.el Wed Jun 07 13:34:42 2006 +0000 +++ b/lisp/pgg-pgp5.el Wed Jun 07 16:39:16 2006 +0000 @@ -147,23 +147,23 @@ "Encrypt the current region between START and END." (let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id)) (passphrase (or passphrase - (when sign - (pgg-read-passphrase - (format "PGP passphrase for %s: " - pgg-pgp5-user-id) - pgg-pgp5-user-id)))) + (when sign + (pgg-read-passphrase + (format "PGP passphrase for %s: " + pgg-pgp5-user-id) + pgg-pgp5-user-id)))) (args - (append - `("+NoBatchInvalidKeys=off" "-fat" "+batchmode=1" - ,@(if recipients - (apply #'append - (mapcar (lambda (rcpt) - (list "-r" - (concat "\"" rcpt "\""))) - (append recipients - (if pgg-encrypt-for-me - (list pgg-pgp5-user-id))))))) - (if sign '("-s" "-u" pgg-pgp5-user-id))))) + (append + `("+NoBatchInvalidKeys=off" "-fat" "+batchmode=1" + ,@(if recipients + (apply #'append + (mapcar (lambda (rcpt) + (list "-r" + (concat "\"" rcpt "\""))) + (append recipients + (if pgg-encrypt-for-me + (list pgg-pgp5-user-id))))))) + (if sign '("-s" "-u" pgg-pgp5-user-id))))) (pgg-pgp5-process-region start end nil pgg-pgp5-pgpe-program args) (pgg-process-when-success nil))) @@ -171,10 +171,10 @@ "Decrypt the current region between START and END." (let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id)) (passphrase - (or passphrase - (pgg-read-passphrase - (format "PGP passphrase for %s: " pgg-pgp5-user-id) - (pgg-pgp5-lookup-key pgg-pgp5-user-id 'encrypt)))) + (or passphrase + (pgg-read-passphrase + (format "PGP passphrase for %s: " pgg-pgp5-user-id) + (pgg-pgp5-lookup-key pgg-pgp5-user-id 'encrypt)))) (args '("+verbose=1" "+batchmode=1" "+language=us" "-f"))) (pgg-pgp5-process-region start end passphrase pgg-pgp5-pgpv-program args) @@ -184,10 +184,10 @@ "Make detached signature from text between START and END." (let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id)) (passphrase - (or passphrase - (pgg-read-passphrase - (format "PGP passphrase for %s: " pgg-pgp5-user-id) - (pgg-pgp5-lookup-key pgg-pgp5-user-id 'sign)))) + (or passphrase + (pgg-read-passphrase + (format "PGP passphrase for %s: " pgg-pgp5-user-id) + (pgg-pgp5-lookup-key pgg-pgp5-user-id 'sign)))) (args (list (if clearsign "-fat" "-fbat") "+verbose=1" "+language=us" "+batchmode=1"
--- a/man/ChangeLog Wed Jun 07 13:34:42 2006 +0000 +++ b/man/ChangeLog Wed Jun 07 16:39:16 2006 +0000 @@ -1,3 +1,7 @@ +2006-05-18 Reiner Steib <Reiner.Steib@gmx.de> + + * gnus.texi (Saving Articles): Clarify gnus-summary-save-article-mail. + 2006-06-07 Nick Roberts <nickrob@snap.net.nz> * building.texi (Watch Expressions): Move node to end.
--- a/man/gnus.texi Wed Jun 07 13:34:42 2006 +0000 +++ b/man/gnus.texi Wed Jun 07 16:39:16 2006 +0000 @@ -7456,7 +7456,7 @@ @vindex gnus-default-article-saver You can customize the @code{gnus-default-article-saver} variable to make -Gnus do what you want it to. You can use any of the six ready-made +Gnus do what you want it to. You can use any of the eight ready-made functions below, or you can create your own. @table @code @@ -7497,6 +7497,13 @@ @code{gnus-file-save-name} variable to get a file name to save the article in. The default is @code{gnus-numeric-save-name}. +@item gnus-summary-write-body-to-file +@findex gnus-summary-write-body-to-file +Write the article body straight to an ordinary file. The file is +overwritten if it exists. Uses the function in the +@code{gnus-file-save-name} variable to get a file name to save the +article in. The default is @code{gnus-numeric-save-name}. + @item gnus-summary-save-in-folder @findex gnus-summary-save-in-folder @findex gnus-folder-save-name @@ -7516,6 +7523,31 @@ reader to use this setting. @end table +The symbol of each function may have the following properties: + +@table @code +@item :decode +The value non-@code{nil} means save decoded articles. This is +meaningful only with @code{gnus-summary-save-in-file}, +@code{gnus-summary-save-body-in-file}, +@code{gnus-summary-write-to-file}, and +@code{gnus-summary-write-body-to-file}. + +@item :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, @code{gnus-prompt-before-saving} is bound to +@code{t} and all articles are saved in a single file. This is +meaningful only with @code{gnus-summary-write-to-file} and +@code{gnus-summary-write-body-to-file}. + +@item :headers +The value specifies the symbol of a variable of which the value +specifies headers to be saved. If it is omitted, +@code{gnus-save-all-headers} and @code{gnus-saved-headers} control what +headers should be saved. +@end table + @vindex gnus-article-save-directory All of these functions, except for the last one, will save the article in the @code{gnus-article-save-directory}, which is initialized from the