From 162880cc7957dd33ca0c09573dc8ff526f3c8d69 Mon Sep 17 00:00:00 2001 From: yamaoka Date: Tue, 13 May 2003 23:27:47 +0000 Subject: [PATCH] Import Gnus v5.10.2. --- GNUS-NEWS | 104 +++++------ README | 2 +- lisp/ChangeLog | 386 ++++++++++++++++++++++++++++++++++++++++ lisp/dgnushack.el | 16 +- lisp/gnus-agent.el | 44 ++--- lisp/gnus-art.el | 8 +- lisp/gnus-cite.el | 72 ++++---- lisp/gnus-cus.el | 96 +++++----- lisp/gnus-ems.el | 29 +-- lisp/gnus-fun.el | 4 +- lisp/gnus-int.el | 3 +- lisp/gnus-picon.el | 8 +- lisp/gnus-registry.el | 219 ++++++++++++++++++----- lisp/gnus-start.el | 29 +-- lisp/gnus-sum.el | 107 +++++++---- lisp/gnus-util.el | 46 ++--- lisp/gnus-xmas.el | 7 + lisp/gnus.el | 41 +++-- lisp/ietf-drums.el | 1 - lisp/lpath.el | 4 +- lisp/mail-source.el | 15 +- lisp/message.el | 59 +++---- lisp/mm-bodies.el | 135 ++++++-------- lisp/mm-encode.el | 30 ++-- lisp/mm-extern.el | 8 +- lisp/mm-util.el | 161 +++++++---------- lisp/mml-smime.el | 1 + lisp/mml1991.el | 4 +- lisp/mml2015.el | 5 +- lisp/nndoc.el | 15 +- lisp/nnheader.el | 1 + lisp/nnrss.el | 84 ++++----- lisp/nntp.el | 4 + lisp/pgg.el | 3 +- lisp/pop3.el | 5 +- lisp/rfc2047.el | 469 +++++++++++++++++++++++++++++-------------------- lisp/rfc2231.el | 4 + lisp/sieve-manage.el | 3 +- lisp/sieve.el | 14 +- lisp/smime.el | 2 + lisp/spam-report.el | 6 +- lisp/spam.el | 2 +- lisp/utf7.el | 117 ++++++++---- texi/ChangeLog | 44 +++++ texi/gnus.texi | 147 ++++++++++++---- texi/gnusref.tex | 7 +- texi/message.texi | 2 +- texi/pgg.texi | 32 ++++ 48 files changed, 1737 insertions(+), 868 deletions(-) diff --git a/GNUS-NEWS b/GNUS-NEWS index 79b7cf7..9d08766 100644 --- a/GNUS-NEWS +++ b/GNUS-NEWS @@ -19,7 +19,7 @@ to this version. In particular, you will probably want to remove all .marks (nnml) and .mrk (nnfolder) files, so that flags are read from your ~/.newsrc.eld instead of from the .marks/.mrk file where this release store flags. See a later entry for more information about -marks. Note that downgrading isn't save in general. +marks. Note that downgrading isn't safe in general. ** Article Buttons @@ -42,7 +42,7 @@ nnrss RET RET' in the Group buffer. ** Single-part yenc encoded attachments can be decoded. ** Picons -The picons code has been reimplemented to work in GNU Emacs -- some of +The picons code has been reimplemented to work in Emacs 21 -- some of the previous options have been removed or renamed. Picons are small "personal icons" representing users, domain and @@ -73,8 +73,9 @@ the nnml back end allows compressed message files. ** Signed article headers (X-PGP-Sig) can be verified with `W p'. -** The Summary Buffer uses an arrow in the fringe to indicate the current -article. Use (setq gnus-summary-display-arrow nil) to disable it. +** The Summary Buffer uses an arrow in the fringe to indicate the +current article in Emacs 21 running on a graphical display. Customize +`gnus-summary-display-arrow' to disable it. ** Warn about email replies to news Do you often find yourself replying to news by email by mistake? Then @@ -117,11 +118,11 @@ argument to the batch-program should be the directory where xemacs.exe respectively emacs.exe is located, iff you want to install Gnus after compiling it, give make.bat /copy as the second parameter. -Make.bat has been rewritten from scratch, it now features automatic +`make.bat' has been rewritten from scratch, it now features automatic recognition of XEmacs and GNU Emacs, generates gnus-load.el, checks if errors occur while compilation and generation of info files and reports -them at the end of the build process. It now uses makeinfo if it is -available and falls back to infohack.el otherwise. Make.bat should now +them at the end of the build process. It now uses makeinfo if it is +available and falls back to infohack.el otherwise. `make.bat' should now install all files which are necessary to run Gnus and be generally a complete replacement for the "configure; make; make install" cycle used under Unix systems. @@ -174,13 +175,13 @@ expressions matching group names to group parameters, a'la: ** Smileys (":-)", ";-)" etc) are now iconized for Emacs too. -Put (setq gnus-treat-display-smileys nil) in ~/.emacs to disable it. +Customize `gnus-treat-display-smileys' to disable it. -** Gnus no longer generate the Sender: header automatically. +** Gnus no longer generates the Sender: header automatically. Earlier it was generated iff the user configurable email address was different from the Gnus guessed default user address. As the guessing -algorithm is rarely correct these days, and (more controversally) the +algorithm is rarely correct these days, and (more controversially) the only use of the Sender: header was to check if you are entitled to cancel/supersede news (which is now solved by Cancel Locks instead, see another entry), generation of the header has been disabled by @@ -197,12 +198,12 @@ note in the body for cross-postings and followups (see the variables `message-cross-post-*'). ** References and X-Draft-Headers are no longer generated when you - start composing messages and `message-generate-headers-first' is nil. +start composing messages and `message-generate-headers-first' is nil. ** Improved anti-spam features. Gnus is now able to take out spam from your mail and news streams -using a wide variety of programs and filter rules. Among the supported +using a wide variety of programs and filter rules. Among the supported methods are RBL blocklists, bogofilter and white/blacklists. Hooks for easy use of external packages such as SpamAssassin and Hashcash are also new. @@ -220,8 +221,8 @@ The estimated number of unread articles in the group buffer should now be correct for nnimap groups. This is achieved by calling `nnimap-fixup-unread-after-getting-new-news' from the `gnus-setup-news-hook' (called on startup) and -gnus-after-getting-new-news-hook. (called after getting new mail). If -you have modified those variables from the default, you may want to +`gnus-after-getting-new-news-hook' (called after getting new mail). +If you have modified those variables from the default, you may want to add n-f-u-a-g-n-n again. If you were happy with the estimate and want to save some (minimal) time when getting new mail, remove the function. @@ -245,25 +246,25 @@ not used any more. You can safely delete the entire hierarchy. ** gnus-agent -The Gnus Agent has seen a major updated and is now enabled by default, -and all nntp and nnimap servers from gnus-select-method and -gnus-secondary-select-method are agentized by default. Earlier only -the server in gnus-select-method was agentized by the default, and the +The Gnus Agent has seen a major update. It is now enabled by default, +and all nntp and nnimap servers from `gnus-select-method' and +`gnus-secondary-select-method' are agentized by default. Earlier only +the server in `gnus-select-method' was agentized by the default, and the agent was disabled by default. When the agent is enabled, headers are now also retrieved from the Agent cache instead of the backends when -possible. Earlier this only happened in the unplugged state. You can +possible. Earlier this only happened in the unplugged state. You can enroll or remove servers with `J a' and `J r' in the server buffer. Gnus will not download articles into the Agent cache, unless you instruct it to do so, though, by using `J u' or `J s' from the Group buffer. You revert to the old behaviour of having the Agent disabled -with `(setq gnus-agent nil)'. Note that putting (gnus-agentize) in +by customizing `gnus-agent'. Note that putting `(gnus-agentize)' in ~/.gnus is not needed any more. ** gnus-summary-line-format The default value changed to "%U%R%z%I%(%[%4L: %-23,23f%]%) %s\n". -Moreover gnus-extra-headers, nnmail-extra-headers and -gnus-ignored-from-addresses changed their default so that the users +Moreover `gnus-extra-headers', `nnmail-extra-headers' and +`gnus-ignored-from-addresses' changed their default so that the users name will be replaced by the recipient's name or the group name posting to for NNTP groups. @@ -274,9 +275,9 @@ broken Outlook (Express) articles. ** (require 'gnus-load) -If you use a stand-alone Gnus distribution, you'd better add (require -'gnus-load) into your ~/.emacs after adding the Gnus lisp directory -into load-path. +If you use a stand-alone Gnus distribution, you'd better add +"(require 'gnus-load)" to your ~/.emacs after adding the Gnus +lisp directory into load-path. File gnus-load.el contains autoload commands, functions and variables, some of which may not be included in distributions of Emacsen. @@ -287,33 +288,33 @@ A new command which starts gnus offline in slave mode. ** message-insinuate-rmail -Adding (message-insinuate-rmail) and (setq mail-user-agent -'gnus-user-agent) in .emacs convinces Rmail to compose, reply and -forward messages in message-mode, where you can enjoy the power of -MML. +Adding (message-insinuate-rmail) in .emacs and customizing +`mail-user-agent' to `gnus-user-agent' convinces Rmail to compose, +reply and forward messages in Message mode, where you can enjoy the +power of MML. ** message-minibuffer-local-map The line below enables BBDB in resending a message: -(define-key message-minibuffer-local-map [(tab)] 'bbdb-complete-name) +(define-key message-minibuffer-local-map [?\t] 'bbdb-complete-name) ** Externalizing and deleting of attachments. -If gnus-gcc-externalize-attachments (or -message-fcc-externalize-attachments) is non-nil, attach local files as -external parts. +If `gnus-gcc-externalize-attachments' (or +`message-fcc-externalize-attachments') is non-nil, attach local files +as external parts. -The command gnus-mime-save-part-and-strip (bound to `C-o' on MIME +The command `gnus-mime-save-part-and-strip' (bound to `C-o' on MIME buttons) saves a part and replaces the part with an external one. -gnus-mime-delete-part (bound to `d' on MIME buttons) removes a part. +`gnus-mime-delete-part' (bound to `d' on MIME buttons) removes a part. It works only on back ends that support editing. ** gnus-default-charset -The default value is determined from the current-language-environment -variable, instead of 'iso-8859-1. Also the ".*" item in -gnus-group-charset-alist is removed. +The default value now guesses on the basis of your environment instead +of using Latin-1. Also the ".*" item in gnus-group-charset-alist is +removed. ** gnus-posting-styles @@ -330,14 +331,14 @@ The old format like the lines below is obsolete, but still accepted. ** message-ignored-news-headers and message-ignored-mail-headers X-Draft-From and X-Gnus-Agent-Meta-Information have been added into -these two variables. If you customized those, perhaps you need add +these two variables. If you customized those, perhaps you need add those two headers too. ** Gnus reads the NOV and articles in the Agent if plugged. If one reads an article while plugged, and the article already exists -in the Agent, it won't get downloaded once more. (setq -gnus-agent-cache nil) reverts to the old behavior. +in the Agent, it won't get downloaded once more. Customize +`gnus-agent-cache' to revert to the old behavior. ** Gnus supports the "format=flowed" (RFC 2646) parameter. @@ -368,11 +369,11 @@ valid values. This means a header "Cancel-Lock" is inserted in news posting. It is used to determine if you wrote a article or not (for cancelling and superseding). Gnus generates a random password string the first time -you post a message, and saves it in your ~/.emacs using the Custom -system. While the variable is called `canlock-password', it is not -security sensitive data. Publishing your canlock string on the web -will not allow anyone to be able to anything she could not already do. -The behaviour can be changed by customizing `message-insert-canlock'. +you post a message, and saves it using the Custom system. While the +variable is called `canlock-password', it is not security sensitive +data. Publishing your canlock string on the web will not allow anyone +to be able to anything she could not already do. The behaviour can be +changed by customizing `message-insert-canlock'. ** Gnus supports server-side mail filtering using Sieve. @@ -385,9 +386,9 @@ Sieve manual, for more information. ** Extended format specs. Format spec "%&user-date;" is added into -gnus-summary-line-format-alist. Also, user defined extended format +`gnus-summary-line-format-alist'. Also, user defined extended format specs are supported. The extended format specs look like "%u&foo;", -which invokes function gnus-user-format-function-foo. Because "&" is +which invokes function `gnus-user-format-function-foo'. Because "&" is used as the escape character, old user defined format "%u&" is no longer supported. @@ -409,7 +410,7 @@ This is supposedly what USEFOR wanted to migrate to. See `gnus-group-name-charset-group-alist' and `gnus-group-name-charset-method-alist' for customization. -** The nnml and nnfolder backends store marks for each groups. +** The nnml and nnfolder backends store marks for each group. This makes it possible to take backup of nnml/nnfolder servers/groups separately of ~/.newsrc.eld, while preserving marks. It also makes it @@ -438,7 +439,8 @@ variables should change those regexps accordingly. For example: ("^han\\>" euc-kr) -> ("\\(^\\|:\\)han\\>" euc-kr) ** Gnus supports PGP (RFC 1991/2440), PGP/MIME (RFC 2015/3156) and -** S/MIME (RFC 2630-2633). +S/MIME (RFC 2630-2633). + It needs an external S/MIME and OpenPGP implementation, but no additional lisp libraries. This add several menu items to the Attachments menu, and C-c RET key bindings, when composing messages. @@ -509,7 +511,7 @@ ever-changing layouts. ---------------------------------------------------------------------- Copyright information: -Copyright (C) 1999, 2000, 2001, 2002 Free Software Foundation, Inc. +Copyright (C) 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc. Permission is granted to anyone to make or distribute verbatim copies of this document as received, in any medium, provided that the diff --git a/README b/README index 043068b..bb5c232 100644 --- a/README +++ b/README @@ -1,4 +1,4 @@ -This package contains a alpha version of Gnus. The lisp directory +This package contains a beta version of Gnus. The lisp directory contains the source lisp files, and the texi directory contains a draft of the Gnus info pages. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index f5e70a0..1540485 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,389 @@ +2003-05-14 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.10.2 is released. + +2003-05-14 Lars Magne Ingebrigtsen + + * mail-source.el (mail-source-delete-incoming): Changed to t. + + * rfc2047.el (rfc2047-syntax-table): Funcall. + + * lpath.el ((featurep 'xemacs)): Added set-char-table-range. + ((featurep 'xemacs)): No, don't. + + * rfc2047.el (rfc2047-encodable-p): Use the header charset. + + * gnus-sum.el (gnus-summary-reselect-current-group): Supply + leave-hidden. + +2003-05-14 Jonathan Kamens + + * gnus-sum.el (gnus-summary-exit): Added `leave-hidden'. (Tiny + patch.) + +2003-05-13 Lars Magne Ingebrigtsen + + * gnus-registry.el (gnus-registry-store-extra-entry): Use + gnus-assq-delete-all. + + * gnus-xmas.el (gnus-xmas-assq-delete-all): New function. + + * message.el (message-ignored-bounced-headers): Add Delivered-To. + + * gnus-sum.el (gnus-summary-find-next): Indent. + (gnus-summary-find-prev): Ditto. + (gnus-summary-catchup): Doc fix. + (gnus-summary-mark-current-read-and-unread-as-read): New function. + (gnus-summary-catchup): Really mark after point. + + * gnus-util.el (gnus-user-date): Use %d instead of %m. + (gnus-user-date): Use floating point time so that we don't get + overflows. + + * gnus-sum.el (gnus-summary-local-variables): Clean up. + + * gnus-fun.el (gnus-display-x-face-in-from): Don't use centering + since none of the other image things do. + +2003-05-13 Katsumi Yamaoka + + * dgnushack.el (assq-delete-all): New compiler macro for Emacs 20. + +2003-05-12 Katsumi Yamaoka + + * lpath.el: Fbind find-coding-system. + + * dgnushack.el (dgnushack-make-load): Remove redundant format call + in message. Suggested by Yoichi NAKAYAMA . + * pop3.el (pop3-movemail): Ditto. + +2003-05-12 Colin Marquardt (tiny change) + + * gnus.el (gnus-agent): Docstring fix. + +2003-05-12 Teodor Zlatanov + + * gnus-registry.el (gnus-registry-install): new variable + (gnus-registry-fetch-extra, gnus-registry-fetch-extra-entry) + (gnus-registry-store-extra-entry, gnus-registry-delete-group) + (gnus-registry-add-group): add a modification timestamp to each entry + (gnus-registry-install-hooks): new function + +2003-05-12 Kevin Greiner + + * gnus-agent.el (gnus-agent-cat-name): Eval macro while compiling. + (gnus-agent-cat-disable-undownloaded-faces): New function. + Accessor for new agent property + 'agent-disable-undownloaded-faces'. + gnus-cus.el (gnus-agent-parameters): Added + agent-disable-undownloaded-faces and corrected documentation. + (gnus-agent-cat-prepare-category-field, + gnus-agent-customize-category): Changed to avoid creating free + references to each field's symbol. + gnus-sum.el (gnus-summary-use-undownloaded-faces): New local variable. + (gnus-select-newgroup): Initialize it. + (gnus-summary-highlight-line): Use it. + +2003-05-12 Dave Love + + * rfc2047.el (rfc2047-point-at-bol, rfc2047-point-at-bol): Eval + and compile. + (rfc2047-syntax-table): Fix building table to work in Emacs 22. + (rfc2047-unfold-region): Delete unused var `leading'. + +2003-05-12 Simon Josefsson + + * pgg.el (pgg-temp-buffer-show-function): Reuse existing visible + output window if one is available. Tiny patch from Ville Skytt,Ad(B + . + +2003-05-11 Lars Magne Ingebrigtsen + + * gnus-agent.el (gnus-agent-expire-unagentized-dirs): Added + space. + +2003-05-11 Jesper Harder + + * gnus-sum.el (gnus-summary-enter-digest-group): Don't do article + washing etc. + (gnus-handle-ephemeral-exit): Don't reload article after exiting. + + * nndoc.el (nndoc-type-alist): `mime-digest' should be before + `mime-parts'. + +2003-05-10 Jesper Harder + + * gnus-cite.el (gnus-article-hide-citation-maybe): Make toggling + work. Update mode-line. + +2003-05-10 Lars Magne Ingebrigtsen + + * gnus.el (gnus-logo-color-alist): Added no colours. + +2003-05-09 Dave Love + + * utf7.el (mm-util): Require. + (utf7-direct-encoding-chars, utf7-imap-direct-encoding-chars): + Defconst, not defvar. + (utf7-utf-16-coding-system): New. + (utf7-encode-internal): Hoist concat out of loop. + (utf7-fragment-encode): Use mm-with-unibyte-current-buffer. + (utf7-get-u16char-converter) [utf7-utf-16-coding-system]: New + case. + (utf7-latin1-u16-char-converter): Encode the region. + (utf7-u16-latin1-char-converter): Decode the region. + (utf7-encode, utf7-decode): Fix multibyteness. + + * mm-bodies.el (mm-body-7-or-8): Don't special-case mule. + (mm-encode-body): Use mm-read-coding-system, not mm-read-charset. + (mm-uu-yenc-decode-function): Defvar when compiling. + (mm-encode-body, mm-decode-body): Doc fix. + +2003-05-09 Teodor Zlatanov + + * gnus-registry.el (gnus-registry-unregistered-group-regex): + removed in favor of the group/topic/global variables + (gnus-registry-register-message-ids): fixed test to omit + gnus-registry-unregistered-group-regex + + * gnus.el (gnus-variable-list): removed gnus-registry-alist and + gnus-registry-headers-alist from the list + (gnus-registry-headers-alist): removed + (registry-ignore): new parameter, with accompanying + gnus-registry-ignored-groups global variable + + * gnus-start.el (gnus-clear-system): no need to clear the + registry, we can do it ourselves + (gnus-gnus-to-quick-newsrc-format): extra parameters so it can be + used by gnus-registry.el + + * gnus-registry.el (gnus-registry-cache-file): new file variable + (gnus-registry-cache-read, gnus-registry-cache-save): new + functions + (gnus-registry-cache-whitespace): new function. From Dan + Christensen + (gnus-registry-save, gnus-registry-read): use the new + gnus-registry-cache-{read|save} functions, and change the name + from gnus-registry-translate-{from|to}-alist + (gnus-registry-clear): fixed so it doesn't refer to old function name + +2003-05-09 Jesper Harder + + * gnus-picon.el (gnus-picon-transform-address): Parse the encoded + address. + +2003-05-08 Teodor Zlatanov + + * gnus-start.el (gnus-clear-system): added gnus-registry-alist to + the list of cleared variables + + * gnus-registry.el (gnus-registry-split-fancy-with-parent): + nnmail-split-fancy-with-parent-ignore-groups can be a single regex + in addition to a list of regexes. + + * spam.el (spam-use-regex-headers): docstring fix. From Niklas + Morberg + +2003-05-08 Kai Gro,A_(Bjohann + + * gnus-sum.el (gnus-summary-next-page): Mention + `gnus-article-skip-boring' in docstring. + +2003-05-08 Jesper Harder + + * rfc2231.el (rfc2231-parse-string): "=" should have whitespace + syntax here. + + * ietf-drums.el (ietf-drums-syntax-table): "=" should not have + whitespace syntax class when parsing email addresses. + + * message.el (message-forward-subject-name-subject): Don't use + mail-decode-encoded-word-string before parsing from. + +2003-05-07 ShengHuo ZHU + + * message.el (message-setup-1): Setup alternative email before + generate-headers. + + (message-forward-subject-name-subject): Fix the case when the + field "from" doesn't exist. + +2003-05-07 Dave Love + + * rfc2047.el (rfc2047-encode-region): Skip \n as whitespace. + + * mm-util.el (mm-find-mime-charset-region): Expurgate utf-16 from + possible values. + +2003-05-07 Jesper Harder + + * message.el (message-kill-to-signature): Fix. + +2003-05-06 Jesper Harder + + * gnus-sum.el (gnus-auto-goto-ignores): Docstring fix. + + * gnus-art.el (gnus-mime-display-multipart-as-mixed) + (gnus-mime-display-multipart-related-as-mixed) + (gnus-button-mid-or-mail-heuristic-alist): do. + +2003-05-05 Dave Love + + * mm-util.el (mm-default-multibyte-p): New. + (mm-coding-system-p): Maybe use find-coding-systems. + +2003-05-04 Dave Love + + * rfc2047.el (with-syntax-table): Define if necessary. + (rfc2047-syntax-table): Fix last change for XEmacs. + (rfc2047-parse-and-decode): Revert last change. + +2003-05-03 Jesper Harder + + * gnus.el: Don't test for `mm-guess-mime-charset'. + + * mm-util.el (mm-guess-mime-charset): Remove. Not used any more. + + * gnus.el (gnus-default-charset): Set default value to + `undecided'. + + * gnus-art.el (article-decode-charset): Don't supply 4th arg to + mm-decode-body. + + * mm-bodies.el (mm-decode-coding-region-safely): Remove. + (mm-decode-body): Don't use mm-decode-coding-region-safely. + +2003-05-03 Vasily Korytov (tiny change) + + * gnus-util.el (gnus-multiple-choice): Add ", ?". + +2003-05-03 Dave Love + + * rfc2047.el (rfc2047-syntax-table): Don't call make-char-table + with 2 args. + (rfc2047-decode-string): Don't set the buffer multibyte before + calling buffer-string. + + * mm-encode.el (mm-long-lines-p): Autoload. + (mm-encode-content-transfer-encoding): Doc fix. Don't make buffer + unibyte. Signal error on unknown encoding. + (mm-encode-buffer, mm-qp-or-base64): Doc fix. + + * rfc2047.el (rfc2047-point-at-bol, rfc2047-point-at-eol): New. + Callers of gnus- versions changed to use them. + (rfc2047-header-encoding-alist): Add `address-mime' part. Doc + fixes. + (rfc2047-encoding-type): New. + (rfc2047-encode-message-header): Use mm-charset-to-coding-system. + Don't include header name field in encoding. Add `address-mime' + case and bind rfc2047-encoding-type for `mime' case. + (rfc2047-encodable-p): Deleted. + (rfc2047-syntax-table): New. + (rfc2047-encode-region, rfc2047-encode): Rewritten to take account + of rfc2047 rules with respect to rfc2822 tokens and to do encoding + in place rather than by passing strings. + (rfc2047-encode-string): Doc fix. + (rfc2047-q-encode-region): Don't use + mm-with-unibyte-current-buffer. + (rfc2047-encoded-word-regexp): eval-and-compile. + (rfc2047-decode-region): Avoid concatenation in loop. + (rfc2047-parse-and-decode): Remove useless disjunction. + +2003-05-02 Dave Love + + * rfc2047.el (rfc2047-q-encode-region, rfc2047-decode): Use + mm-with-unibyte-current-buffer. + (ietf-drums, gnus-util): don't require. + + * sieve.el (sieve-manage-mode-menu): Define before use. + + * mml-smime.el (message-narrow-to-headers): Autoload. + + * mm-util.el (mm-coding-system-p): Don't override nil from + coding-system-p. + (mm-mule4-p, mm-disable-multibyte-mule4) + (mm-with-unibyte-current-buffer-mule4): Deleted. + (mm-multibyte-p): Use defun, not defalias. + (mm-make-temp-file): Moved to group at top of file. + (mm-point-at-eol, mm-point-at-bol): New. + + * gnus-cite.el (gnus-art): Require. + + * gnus-ems.el (gnus-get-buffer-create) + (nnheader-find-etc-directory, message-text-with-property): + Autoload. + (gnus-tmp-unread, gnus-tmp-replied, gnus-tmp-score-char) + (gnus-tmp-indentation, gnus-tmp-opening-bracket, gnus-tmp-lines) + (gnus-tmp-name, gnus-tmp-closing-bracket, gnus-tmp-subject-or-nil) + (gnus-check-before-posting): Only defvar when compiling. + + * gnus-int.el (gnus-agent-expire): Autoload, don't defun. + + * gnus-util.el (rmail-default-rmail-file, mm-text-coding-system): + Defvar when compiling. + (gnus-output-to-rmail): Require mm-util. + + * mail-source.el (mail-source-callback): Use mm-make-temp-file. + (mail-source-make-complex-temp-name): Deleted. + + * message.el (message-use-idna): Use mm-coding-system-p. + (message-tokenize-header, message-make-organization) + (message-make-from): Use with-temp-buffer. + (message-set-work-buffer): Deleted. + (message-fill-paragraph): Use `if' not `and' for compiler warning. + (message-check-news-header-syntax): Remove useless lambda. + (message-forward-make-body): Use mm-disable-multibyte, + mm-with-unibyte-current-buffer, mm-enable-multibyte. + (message-replace-chars-in-string): Deleted. + + * mm-extern.el (mm-extern-local-file): Use mm-disable-multibyte. + (mm-extern-url): Use mm-with-unibyte-current-buffer, + mm-disable-multibyte. + (mm-extern-anon-ftp): Use mm-disable-multibyte. + + * mml1991.el (mml1991-mailcrypt-encrypt, mml1991-gpg-encrypt): Use + mm-with-unibyte-current-buffer. + + * mml2015.el (mml): Require. + (mml2015-mailcrypt-encrypt, mml2015-gpg-encrypt): Use + mm-with-unibyte-current-buffer. + + * nnheader.el (gnus-util): Require. + + * nntp.el (format-spec, format-spec-make, open-tls-stream): + Autoload. + + * rfc2231.el (mail-header-remove-comments, mm-encode-body) + (mail-header-remove-whitespace): Autoload. + + * sieve-manage.el (starttls-negotiate): Autoload. + +2003-05-01 Lars Magne Ingebrigtsen + + * nnrss.el (nnrss-find-rss-via-syndic8): Indent. + +2003-05-01 Mark A. Hershberger + + * nnrss.el (nnrss-find-rss-via-syndic8): Don't error out. + +2003-05-01 Lars Magne Ingebrigtsen + + * gnus.el (gnus-version-number): Bump. + +2003-05-01 Teodor Zlatanov + + * spam-report.el (spam-report-gmane-regex): docstring fix. From + Jon Ericson (tiny change) + + * gnus.el (gnus-install-group-spam-parameters): docstring fix. + From Jon Ericson (tiny change) + + * gnus-registry.el (gnus-registry-fetch-extra) + (gnus-registry-store-extra, gnus-registry-group-count): new functions + (gnus-registry-fetch-group, gnus-registry-delete-group) + (gnus-registry-add-group): changed to work with extra data element + if present + 2003-05-01 Lars Magne Ingebrigtsen * gnus.el: Gnus v5.10.1 is released. diff --git a/lisp/dgnushack.el b/lisp/dgnushack.el index 327b02c..1064b5f 100644 --- a/lisp/dgnushack.el +++ b/lisp/dgnushack.el @@ -50,6 +50,18 @@ ;; Define compiler macros for the functions provided by cl in old Emacsen. (unless (featurep 'xemacs) + (define-compiler-macro assq-delete-all (&whole form key alist) + (if (>= emacs-major-version 21) + form + `(let* ((key ,key) + (alist ,alist) + (tail alist)) + (while tail + (if (and (consp (car tail)) (eq (car (car tail)) key)) + (setq alist (delq (car tail) alist))) + (setq tail (cdr tail))) + alist))) + (define-compiler-macro butlast (&whole form x &optional n) (if (>= emacs-major-version 21) form @@ -290,7 +302,7 @@ Modify to suit your needs.")) (batch-update-autoloads))) (defun dgnushack-make-load () - (message (format "Generating %s..." dgnushack-gnus-load-file)) + (message "Generating %s..." dgnushack-gnus-load-file) (with-temp-file dgnushack-gnus-load-file (insert-file-contents dgnushack-cus-load-file) (delete-file dgnushack-cus-load-file) @@ -348,7 +360,7 @@ Modify to suit your needs.")) (search-forward "\n;;; Code:" nil t) (forward-line 1) (insert "\n(autoload 'custom-add-loads \"cus-load\")\n")))) - (message (format "Compiling %s..." dgnushack-gnus-load-file)) + (message "Compiling %s..." dgnushack-gnus-load-file) (byte-compile-file dgnushack-gnus-load-file)) ;;; dgnushack.el ends here diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index d8591d9..b75ed8b 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -310,29 +310,31 @@ manipulated as follows: value)) (list (quote ,name) --category--temp--) ; access-form ))))) - - (defmacro gnus-agent-cat-name (category) - `(car ,category)) ) +(defmacro gnus-agent-cat-name (category) + `(car ,category)) + +(gnus-agent-cat-defaccessor + gnus-agent-cat-days-until-old agent-days-until-old) (gnus-agent-cat-defaccessor - gnus-agent-cat-days-until-old agent-days-until-old) + gnus-agent-cat-enable-expiration agent-enable-expiration) (gnus-agent-cat-defaccessor - gnus-agent-cat-enable-expiration agent-enable-expiration) + gnus-agent-cat-groups agent-groups) (gnus-agent-cat-defaccessor - gnus-agent-cat-groups agent-groups) + gnus-agent-cat-high-score agent-high-score) (gnus-agent-cat-defaccessor - gnus-agent-cat-high-score agent-high-score) + gnus-agent-cat-length-when-long agent-length-when-long) (gnus-agent-cat-defaccessor - gnus-agent-cat-length-when-long agent-length-when-long) + gnus-agent-cat-length-when-short agent-length-when-short) (gnus-agent-cat-defaccessor - gnus-agent-cat-length-when-short agent-length-when-short) + gnus-agent-cat-low-score agent-low-score) (gnus-agent-cat-defaccessor - gnus-agent-cat-low-score agent-low-score) + gnus-agent-cat-predicate agent-predicate) (gnus-agent-cat-defaccessor - gnus-agent-cat-predicate agent-predicate) + gnus-agent-cat-score-file agent-score-file) (gnus-agent-cat-defaccessor - gnus-agent-cat-score-file agent-score-file) + gnus-agent-cat-disable-undownloaded-faces agent-disable-undownloaded-faces) (eval-when-compile (defsetf gnus-agent-cat-groups (category) (groups) @@ -1453,14 +1455,14 @@ variables. Returns the first non-nil value found." (symbol-value (cdr (assq symbol - '((agent-short-article . gnus-agent-short-article) - (agent-long-article . gnus-agent-long-article) - (agent-low-score . gnus-agent-low-score) - (agent-high-score . gnus-agent-high-score) - (agent-days-until-old . gnus-agent-expire-days) - (agent-enable-expiration - . gnus-agent-enable-expiration) - (agent-predicate . gnus-agent-predicate))))))) + '((agent-short-article . gnus-agent-short-article) + (agent-long-article . gnus-agent-long-article) + (agent-low-score . gnus-agent-low-score) + (agent-high-score . gnus-agent-high-score) + (agent-days-until-old . gnus-agent-expire-days) + (agent-enable-expiration + . gnus-agent-enable-expiration) + (agent-predicate . gnus-agent-predicate))))))) (defun gnus-agent-fetch-headers (group &optional force) "Fetch interesting headers into the agent. The group's overview @@ -2911,7 +2913,7 @@ articles in every agentized group.")) deleting them?"))) (while to-remove (let ((dir (pop to-remove))) - (if (gnus-y-or-n-p (format "Delete %s?" dir)) + (if (gnus-y-or-n-p (format "Delete %s? " dir)) (let* (delete-recursive (delete-recursive (function diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 2ebebb6..d8121ff 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -2108,7 +2108,7 @@ If PROMPT (the prefix), prompt for a coding system to use." (mm-decode-body charset (and cte (intern (downcase (gnus-strip-whitespace cte)))) - (car ctl) prompt)))))) + (car ctl))))))) (defun article-decode-encoded-words () "Remove encoded-word encoding from headers." @@ -4521,7 +4521,7 @@ If no internal viewer is available, use an external viewer." (defcustom gnus-mime-display-multipart-as-mixed nil "Display \"multipart\" parts as \"multipart/mixed\". -If `t', it overrides `nil' values of +If t, it overrides nil values of `gnus-mime-display-multipart-alternative-as-mixed' and `gnus-mime-display-multipart-related-as-mixed'." :group 'gnus-article-mime @@ -4537,7 +4537,7 @@ If `t', it overrides `nil' values of If displaying \"text/html\" is discouraged \(see `mm-discouraged-alternatives'\) images or other material inside a -\"multipart/related\" part might be overlooked when this variable is `nil'." +\"multipart/related\" part might be overlooked when this variable is nil." :group 'gnus-article-mime :type 'boolean) @@ -5753,7 +5753,7 @@ must return `mid', `mail', `invalid' or `ask'." "An alist of \(RATE . REGEXP\) pairs for `gnus-button-mid-or-mail-heuristic'. A negative RATE indicates a message IDs, whereas a positive indicates a mail -address. The REGEXP is processed with `case-fold-search' set to `nil'." +address. The REGEXP is processed with `case-fold-search' set to nil." :group 'gnus-article-buttons :type '(repeat (cons (number :tag "Rate") (regexp :tag "Regexp")))) diff --git a/lisp/gnus-cite.el b/lisp/gnus-cite.el index a119ac7..ce1b242 100644 --- a/lisp/gnus-cite.el +++ b/lisp/gnus-cite.el @@ -30,6 +30,7 @@ (require 'gnus) (require 'gnus-range) +(require 'gnus-art) (require 'message) ; for message-cite-prefix-regexp ;;; Customization: @@ -618,41 +619,44 @@ cited text with attributions. When called interactively, these two variables are ignored. See also the documentation for `gnus-article-highlight-citation'." (interactive (append (gnus-article-hidden-arg) '(force))) - (unless (gnus-article-check-hidden-text 'cite arg) - (save-excursion - (set-buffer gnus-article-buffer) - (gnus-cite-parse-maybe force) - (article-goto-body) - (let ((start (point)) - (atts gnus-cite-attribution-alist) - (buffer-read-only nil) - (inhibit-point-motion-hooks t) - (hidden 0) - total) - (goto-char (point-max)) - (gnus-article-search-signature) - (setq total (count-lines start (point))) - (while atts - (setq hidden (+ hidden (length (cdr (assoc (cdar atts) - gnus-cite-prefix-alist)))) - atts (cdr atts))) - (when (or force - (and (> (* 100 hidden) (* gnus-cite-hide-percentage total)) - (> hidden gnus-cite-hide-absolute))) - (setq atts gnus-cite-attribution-alist) + (with-current-buffer gnus-article-buffer + (gnus-delete-wash-type 'cite) + (unless (gnus-article-check-hidden-text 'cite arg) + (save-excursion + (gnus-cite-parse-maybe force) + (article-goto-body) + (let ((start (point)) + (atts gnus-cite-attribution-alist) + (buffer-read-only nil) + (inhibit-point-motion-hooks t) + (hidden 0) + total) + (goto-char (point-max)) + (gnus-article-search-signature) + (setq total (count-lines start (point))) (while atts - (setq total (cdr (assoc (cdar atts) gnus-cite-prefix-alist)) - atts (cdr atts)) - (while total - (setq hidden (car total) - total (cdr total)) - (goto-char (point-min)) - (forward-line (1- hidden)) - (unless (assq hidden gnus-cite-attribution-alist) - (gnus-add-text-properties - (point) (progn (forward-line 1) (point)) - (nconc (list 'article-type 'cite) - gnus-hidden-properties)))))))))) + (setq hidden (+ hidden (length (cdr (assoc (cdar atts) + gnus-cite-prefix-alist)))) + atts (cdr atts))) + (when (or force + (and (> (* 100 hidden) (* gnus-cite-hide-percentage total)) + (> hidden gnus-cite-hide-absolute))) + (gnus-add-wash-type 'cite) + (setq atts gnus-cite-attribution-alist) + (while atts + (setq total (cdr (assoc (cdar atts) gnus-cite-prefix-alist)) + atts (cdr atts)) + (while total + (setq hidden (car total) + total (cdr total)) + (goto-char (point-min)) + (forward-line (1- hidden)) + (unless (assq hidden gnus-cite-attribution-alist) + (gnus-add-text-properties + (point) (progn (forward-line 1) (point)) + (nconc (list 'article-type 'cite) + gnus-hidden-properties))))))))) + (gnus-set-mode-line 'article))) (defun gnus-article-hide-citation-in-followups () "Hide cited text in non-root articles." diff --git a/lisp/gnus-cus.el b/lisp/gnus-cus.el index c8c369e..e0d299e 100644 --- a/lisp/gnus-cus.el +++ b/lisp/gnus-cus.el @@ -309,16 +309,26 @@ has been stored locally for at least this many days." gnus-agent-cat-days-until-old) (agent-enable-expiration (radio :tag "Expire in this Group or Topic" :value nil -; (const :format "Inherit " nil) (const :format "Enable " ENABLE) (const :format "Disable " DISABLE)) "\nEnable, or disable, agent expiration in this group or topic." - gnus-agent-cat-enable-expiration) ) + gnus-agent-cat-enable-expiration) + (agent-disable-undownloaded-faces + (boolean :tag "Disable Agent Faces") + "Have the summary buffer ignore the agent's undownloaded faces. +These faces, when used, act as a warning that an article has not been +fetched into either the agent nor the cache. This is of most use to +users who use the agent as a cache (i.e. they only operate on articles +that have been downloaded). Disable to display normal article faces +even when the article hasn't been downloaded." + gnus-agent-cat-disable-undownloaded-faces)) "Alist of group parameters that are not also topic parameters. -Each entry has the form (NAME TYPE DOC), where NAME is the parameter -itself (a symbol), TYPE is the parameters type (a sexp widget), and -DOC is a documentation string for the parameter.")) +Each entry has the form (NAME TYPE DOC ACCESSOR), where NAME is the +parameter itself (a symbol), TYPE is the parameters type (a sexp +widget), DOC is a documentation string for the parameter, and ACCESSOR +is a function (symbol) that extracts the current value from the +category.")) (defvar gnus-custom-params) (defvar gnus-custom-method) @@ -878,16 +888,6 @@ articles in the thread. (eval-when-compile (defvar category-fields nil) - (defvar gnus-agent-cat-predicate nil) - (defvar gnus-agent-cat-score-file nil) - (defvar gnus-agent-cat-length-when-short nil) - (defvar gnus-agent-cat-length-when-long nil) - (defvar gnus-agent-cat-low-score nil) - (defvar gnus-agent-cat-high-score nil) - (defvar gnus-agent-cat-groups nil) - (defvar gnus-agent-cat-enable-expiration nil) - (defvar gnus-agent-cat-days-until-old nil) - (defvar gnus-agent-cat-name nil) ) (defun gnus-trim-whitespace (s) @@ -905,7 +905,8 @@ articles in the thread. (val (,field info)) (deflt (if (,field defaults) (concat " [" (gnus-trim-whitespace - (pp-to-string (,field defaults))) "]")))) + (pp-to-string (,field defaults))) "]"))) + symb) (if (eq (car type) 'radio) (let* ((rtype (nreverse type)) @@ -928,13 +929,14 @@ articles in the thread. (widget-insert "\n") - (set (make-local-variable ',field) - (if val - (widget-create type :value val) - (widget-create type))) - (widget-put ,field :default val) - (widget-put ,field :accessor ',field) - (push ,field category-fields)))) + (setq val (if val + (widget-create type :value val) + (widget-create type)) + symb (set (make-local-variable ',field) val)) + + (widget-put symb :default val) + (widget-put symb :accessor ',field) + (push symb category-fields)))) (defun gnus-agent-customize-category (category) "Edit the CATEGORY." @@ -1001,28 +1003,32 @@ articles in the thread. ;; gnus-agent-cat-prepare-category-field as I don't want the ;; group list to appear when customizing a topic. (widget-insert "\n") - (set (make-local-variable 'gnus-agent-cat-groups) - (widget-create - `(choice - :format "%[Select Member Groups%]\n%v" :value ignore - (const :menu-tag "do not change" :tag "" :value ignore) - (checklist :entry-format "%b %v" - :menu-tag "display group selectors" - :greedy t - :value ,(delq nil - (mapcar - (lambda (newsrc) - (car (member - (gnus-info-group newsrc) - (gnus-agent-cat-groups info)))) - (cdr gnus-newsrc-alist))) - ,@(mapcar (lambda (newsrc) - `(const ,(gnus-info-group newsrc))) - (cdr gnus-newsrc-alist)))))) - - (widget-put gnus-agent-cat-groups :default (gnus-agent-cat-groups info)) - (widget-put gnus-agent-cat-groups :accessor 'gnus-agent-cat-groups) - (push gnus-agent-cat-groups category-fields) + + (let ((symb + (set + (make-local-variable 'gnus-agent-cat-groups) + (widget-create + `(choice + :format "%[Select Member Groups%]\n%v" :value ignore + (const :menu-tag "do not change" :tag "" :value ignore) + (checklist :entry-format "%b %v" + :menu-tag "display group selectors" + :greedy t + :value + ,(delq nil + (mapcar + (lambda (newsrc) + (car (member + (gnus-info-group newsrc) + (gnus-agent-cat-groups info)))) + (cdr gnus-newsrc-alist))) + ,@(mapcar (lambda (newsrc) + `(const ,(gnus-info-group newsrc))) + (cdr gnus-newsrc-alist)))))))) + + (widget-put symb :default (gnus-agent-cat-groups info)) + (widget-put symb :accessor 'gnus-agent-cat-groups) + (push symb category-fields)) (widget-insert "\nExpiration Settings ") diff --git a/lisp/gnus-ems.el b/lisp/gnus-ems.el index 826431c..a9ab259 100644 --- a/lisp/gnus-ems.el +++ b/lisp/gnus-ems.el @@ -45,9 +45,13 @@ (eval-and-compile (autoload 'gnus-xmas-define "gnus-xmas") (autoload 'gnus-xmas-redefine "gnus-xmas") - (autoload 'appt-select-lowest-window "appt")) + (autoload 'appt-select-lowest-window "appt") + (autoload 'gnus-get-buffer-create "gnus") + (autoload 'nnheader-find-etc-directory "nnheader")) (autoload 'smiley-region "smiley") +;; Fixme: shouldn't require message +(autoload 'message-text-with-property "message") (defun gnus-kill-all-overlays () "Delete all overlays in the current buffer." @@ -79,16 +83,19 @@ (defvar gnus-mouse-face-prop 'mouse-face "Property used for highlighting mouse regions."))) -(defvar gnus-tmp-unread) -(defvar gnus-tmp-replied) -(defvar gnus-tmp-score-char) -(defvar gnus-tmp-indentation) -(defvar gnus-tmp-opening-bracket) -(defvar gnus-tmp-lines) -(defvar gnus-tmp-name) -(defvar gnus-tmp-closing-bracket) -(defvar gnus-tmp-subject-or-nil) -(defvar gnus-check-before-posting) +(eval-when-compile + (defvar gnus-tmp-unread) + (defvar gnus-tmp-replied) + (defvar gnus-tmp-score-char) + (defvar gnus-tmp-indentation) + (defvar gnus-tmp-opening-bracket) + (defvar gnus-tmp-lines) + (defvar gnus-tmp-name) + (defvar gnus-tmp-closing-bracket) + (defvar gnus-tmp-subject-or-nil) + (defvar gnus-check-before-posting) + (defvar gnus-mouse-face) + (defvar gnus-group-buffer)) (defun gnus-ems-redefine () (cond diff --git a/lisp/gnus-fun.el b/lisp/gnus-fun.el index 8791640..a174779 100644 --- a/lisp/gnus-fun.el +++ b/lisp/gnus-fun.el @@ -190,9 +190,9 @@ colors of the displayed X-Faces." (if (gnus-image-type-available-p 'xface) (gnus-create-image (concat "X-Face: " data) - 'xface t :ascent 'center :face 'gnus-x-face) + 'xface t :face 'gnus-x-face) (gnus-create-image - pbm 'pbm t :ascent 'center :face 'gnus-x-face)))) + pbm 'pbm t :face 'gnus-x-face)))) (gnus-add-wash-type 'xface)))))) (defun gnus-grab-cam-x-face () diff --git a/lisp/gnus-int.el b/lisp/gnus-int.el index 8c0146c..7c4b636 100644 --- a/lisp/gnus-int.el +++ b/lisp/gnus-int.el @@ -32,8 +32,7 @@ (require 'message) (require 'gnus-range) -(eval-when-compile - (defun gnus-agent-expire (a b c))) +(autoload 'gnus-agent-expire "gnus-agent") (defcustom gnus-open-server-hook nil "Hook called just before opening connection to the news server." diff --git a/lisp/gnus-picon.el b/lisp/gnus-picon.el index 188f071..9844b07 100644 --- a/lisp/gnus-picon.el +++ b/lisp/gnus-picon.el @@ -1,6 +1,6 @@ ;;; gnus-picon.el --- displaying pretty icons in Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Wes Hardaker @@ -151,7 +151,11 @@ GLYPH can be either a glyph or a string." (defun gnus-picon-transform-address (header category) (gnus-with-article-headers (let ((addresses - (mail-header-parse-addresses (mail-fetch-field header))) + (mail-header-parse-addresses + ;; mail-header-parse-addresses does not work (reliably) on + ;; decoded headers. + (mail-encode-encoded-word-string + (or (mail-fetch-field header) "")))) spec file point cache) (dolist (address addresses) (setq address (car address)) diff --git a/lisp/gnus-registry.el b/lisp/gnus-registry.el index 324155d..e97b1e4 100644 --- a/lisp/gnus-registry.el +++ b/lisp/gnus-registry.el @@ -40,19 +40,21 @@ (defvar gnus-registry-hashtb nil "*The article registry by Message ID.") -(defvar gnus-registry-headers-hashtb nil - "*The article header registry by Message ID. Unused for now.") - (defcustom gnus-registry-unfollowed-groups '("delayed" "drafts" "queue") "List of groups that gnus-registry-split-fancy-with-parent won't follow. The group names are matched, they don't have to be fully qualified." :group 'gnus-registry :type '(repeat string)) -(defcustom gnus-registry-unregistered-group-regex "^nntp" - "Group name regex that gnus-registry-register-message-ids won't process." +(defcustom gnus-registry-install nil + "Whether the registry should be installed." + :group 'gnus-registry + :type 'boolean) + +(defcustom gnus-registry-cache-file "~/.gnus.registry.eld" + "File where the Gnus registry will be stored." :group 'gnus-registry - :type 'regexp) + :type 'file) ;; Function(s) missing in Emacs 20 (when (memq nil (mapcar 'fboundp '(puthash))) @@ -61,10 +63,96 @@ The group names are matched, they don't have to be fully qualified." ;; alias puthash is missing from Emacs 20 cl-extra.el (defalias 'puthash 'cl-puthash))) -(defun gnus-registry-translate-to-alist () - (setq gnus-registry-alist (hashtable-to-alist gnus-registry-hashtb))) - -(defun gnus-registry-translate-from-alist () +(defun gnus-registry-cache-read () + "Read the registry cache file." + (interactive) + (let ((file gnus-registry-cache-file)) + (when (file-exists-p file) + (gnus-message 5 "Reading %s..." file) + (gnus-load file) + (gnus-message 5 "Reading %s...done" file)))) + +(defun gnus-registry-cache-save () + "Save the registry cache file." + (interactive) + (let ((file gnus-registry-cache-file)) + (save-excursion + ;; Save .newsrc.eld. + (set-buffer (gnus-get-buffer-create " *Gnus-registry-cache*")) + (make-local-variable 'version-control) + (setq version-control gnus-backup-startup-file) + (setq buffer-file-name file) + (setq default-directory (file-name-directory buffer-file-name)) + (buffer-disable-undo) + (erase-buffer) + (gnus-message 5 "Saving %s..." file) + (if gnus-save-startup-file-via-temp-buffer + (let ((coding-system-for-write gnus-ding-file-coding-system) + (standard-output (current-buffer))) + (gnus-gnus-to-quick-newsrc-format t "gnus registry startup file" 'gnus-registry-alist) + (gnus-registry-cache-whitespace file) + (save-buffer)) + (let ((coding-system-for-write gnus-ding-file-coding-system) + (version-control gnus-backup-startup-file) + (startup-file file) + (working-dir (file-name-directory file)) + working-file + (i -1)) + ;; Generate the name of a non-existent file. + (while (progn (setq working-file + (format + (if (and (eq system-type 'ms-dos) + (not (gnus-long-file-names))) + "%s#%d.tm#" ; MSDOS limits files to 8+3 + (if (memq system-type '(vax-vms axp-vms)) + "%s$tmp$%d" + "%s#tmp#%d")) + working-dir (setq i (1+ i)))) + (file-exists-p working-file))) + + (unwind-protect + (progn + (gnus-with-output-to-file working-file + (gnus-gnus-to-quick-newsrc-format t "gnus registry startup file" 'gnus-registry-alist)) + + ;; These bindings will mislead the current buffer + ;; into thinking that it is visiting the startup + ;; file. + (let ((buffer-backed-up nil) + (buffer-file-name startup-file) + (file-precious-flag t) + (setmodes (file-modes startup-file))) + ;; Backup the current version of the startup file. + (backup-buffer) + + ;; Replace the existing startup file with the temp file. + (rename-file working-file startup-file t) + (set-file-modes startup-file setmodes))) + (condition-case nil + (delete-file working-file) + (file-error nil))))) + + (gnus-kill-buffer (current-buffer)) + (gnus-message 5 "Saving %s...done" file)))) + +;; Idea from Dan Christensen +;; Save the gnus-registry file with extra line breaks. +(defun gnus-registry-cache-whitespace (filename) + (gnus-message 4 "Adding whitespace to %s" filename) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "^(\\|(\\\"" nil t) + (replace-match "\n\\&" t)) + (goto-char (point-min)) + (while (re-search-forward " $" nil t) + (replace-match "" t t)))) + +(defun gnus-registry-save () + (setq gnus-registry-alist (hashtable-to-alist gnus-registry-hashtb)) + (gnus-registry-cache-save)) + +(defun gnus-registry-read () + (gnus-registry-cache-read) (setq gnus-registry-hashtb (alist-to-hashtable gnus-registry-alist))) (defun alist-to-hashtable (alist) @@ -134,8 +222,11 @@ see which group that message was put in. This group is returned. See the Info node `(gnus)Fancy Mail Splitting' for more details." (let ((refstr (or (message-fetch-field "references") (message-fetch-field "in-reply-to"))) - (references nil) - (res nil)) + (nnmail-split-fancy-with-parent-ignore-groups + (if (listp nnmail-split-fancy-with-parent-ignore-groups) + nnmail-split-fancy-with-parent-ignore-groups + (list nnmail-split-fancy-with-parent-ignore-groups))) + references res) (when refstr (setq references (nreverse (gnus-split-references refstr))) (mapcar (lambda (x) @@ -156,8 +247,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (defun gnus-registry-register-message-ids () "Register the Message-ID of every article in the group" - (unless (and gnus-registry-unregistered-group-regex - (string-match gnus-registry-unregistered-group-regex gnus-newsgroup-name)) + (unless (gnus-parameter-registry-ignore gnus-newsgroup-name) (dolist (article gnus-newsgroup-articles) (let ((id (gnus-registry-fetch-message-id-fast article))) (unless (gnus-registry-fetch-group id) @@ -182,18 +272,56 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (string-match x word)) list))))) +(defun gnus-registry-fetch-extra (id &optional entry) + "Get the extra data of a message, based on the message ID. +Returns the first place where the trail finds a nonstring." + (let ((trail (gethash id gnus-registry-hashtb))) + (dolist (crumb trail) + (unless (stringp crumb) + (return (gnus-registry-fetch-extra-entry crumb entry)))))) + +(defun gnus-registry-fetch-extra-entry (alist &optional entry) + "Get the extra data of a message, or a specific entry in it." + (if entry + (assq entry alist) + alist)) + +(defun gnus-registry-store-extra (id extra) + "Store the extra data of a message, based on the message ID. +The message must have at least one group name." + (when (gnus-registry-group-count id) + ;; we now know the trail has at least 1 group name, so it's not empty + (let ((trail (gethash id gnus-registry-hashtb)) + (old-extra (gnus-registry-fetch-extra id))) + (puthash id (cons extra (delete old-extra trail)) + gnus-registry-hashtb)))) + +(defun gnus-registry-store-extra-entry (id key value) + "Put a specific entry in the extras field of the registry entry for id." + (let* ((extra (gnus-registry-fetch-extra id)) + (alist (cons (cons key value) + (gnus-assq-delete-all key (gnus-registry-fetch-extra id))))) + (gnus-registry-store-extra id alist))) + (defun gnus-registry-fetch-group (id) "Get the group of a message, based on the message ID. -Returns the first place where the trail finds a spool action." - (when id +Returns the first place where the trail finds a group name." + (when (gnus-registry-group-count id) + ;; we now know the trail has at least 1 group name (let ((trail (gethash id gnus-registry-hashtb))) - (if trail - (car trail) - nil)))) + (dolist (crumb trail) + (when (stringp crumb) + (return crumb)))))) + +(defun gnus-registry-group-count (id) + "Get the number of groups of a message, based on the message ID." + (let ((trail (gethash id gnus-registry-hashtb))) + (if (and trail (listp trail)) + (apply '+ (mapcar (lambda (x) (if (stringp x) 1 0)) trail)) + 0))) (defun gnus-registry-delete-group (id group) - "Get the group of a message, based on the message ID. -Returns the first place where the trail finds a spool action." + "Delete a group for a message, based on the message ID." (when group (when id (let ((trail (gethash id gnus-registry-hashtb)) @@ -202,41 +330,48 @@ Returns the first place where the trail finds a spool action." (delete group trail) nil) gnus-registry-hashtb)) - ;; now, clear the entry if it's empty - (unless (gethash id gnus-registry-hashtb) - (remhash id gnus-registry-hashtb))))) + ;; now, clear the entry if there are no more groups + (unless (gnus-registry-group-count id) + (remhash id gnus-registry-hashtb)) + (gnus-registry-store-extra-entry id 'mtime (current-time))))) -(defun gnus-registry-add-group (id group) - "Get the group of a message, based on the message ID. -Returns the first place where the trail finds a spool action." +(defun gnus-registry-add-group (id group &rest extra) + "Add a group for a message, based on the message ID." ;; make sure there are no duplicate entries (when group - (when id + (when (and id + (not (string-match "totally-fudged-out-message-id" id))) (let ((group (gnus-group-short-name group))) (gnus-registry-delete-group id group) (let ((trail (gethash id gnus-registry-hashtb))) (puthash id (if trail (cons group trail) (list group)) - gnus-registry-hashtb)))))) + gnus-registry-hashtb) + (when extra (gnus-registry-store-extra id extra)) + (gnus-registry-store-extra-entry id 'mtime (current-time))))))) (defun gnus-registry-clear () "Clear the Gnus registry." (interactive) - (setq gnus-registry-alist nil - gnus-registry-headers-alist nil) - (gnus-registry-translate-from-alist)) - -; also does copy, respool, and crosspost -(add-hook 'gnus-summary-article-move-hook 'gnus-register-action) -(add-hook 'gnus-summary-article-delete-hook 'gnus-register-action) -(add-hook 'gnus-summary-article-expire-hook 'gnus-register-action) -(add-hook 'nnmail-spool-hook 'gnus-register-spool-action) - -(add-hook 'gnus-save-newsrc-hook 'gnus-registry-translate-to-alist) -(add-hook 'gnus-read-newsrc-el-hook 'gnus-registry-translate-from-alist) + (setq gnus-registry-alist nil) + (setq gnus-registry-hashtb (alist-to-hashtable gnus-registry-alist))) -(add-hook 'gnus-summary-prepare-hook 'gnus-registry-register-message-ids) +(defun gnus-registry-install-hooks () + "Install the registry hooks." + (interactive) + (add-hook 'gnus-summary-article-move-hook 'gnus-register-action) + (add-hook 'gnus-summary-article-delete-hook 'gnus-register-action) + (add-hook 'gnus-summary-article-expire-hook 'gnus-register-action) + (add-hook 'nnmail-spool-hook 'gnus-register-spool-action) + + (add-hook 'gnus-save-newsrc-hook 'gnus-registry-save) + (add-hook 'gnus-read-newsrc-el-hook 'gnus-registry-read) + + (add-hook 'gnus-summary-prepare-hook 'gnus-registry-register-message-ids)) + +(when gnus-registry-install + (gnus-registry-install-hooks)) ;; TODO: a lot of things diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index 8649ba7..f530bc6 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -2631,16 +2631,21 @@ If FORCE is non-nil, the .newsrc file is read." (gnus-dribble-delete-file) (gnus-group-set-mode-line))))) -(defun gnus-gnus-to-quick-newsrc-format () +(defun gnus-gnus-to-quick-newsrc-format (&optional minimal name specific-variable) "Print Gnus variables such as gnus-newsrc-alist in lisp format." (princ ";; -*- emacs-lisp -*-\n") - (princ ";; Gnus startup file.\n") - (princ "\ + (if name + (princ (format ";; %s\n" name)) + (princ ";; Gnus startup file.\n")) + + (unless minimal + (princ "\ ;; Never delete this file -- if you want to force Gnus to read the ;; .newsrc file (if you have one), touch .newsrc instead.\n") - (princ "(setq gnus-newsrc-file-version ") - (princ (gnus-prin1-to-string gnus-version)) - (princ ")\n") + (princ "(setq gnus-newsrc-file-version ") + (princ (gnus-prin1-to-string gnus-version)) + (princ ")\n")) + (let* ((print-quoted t) (print-readably t) (print-escape-multibyte nil) @@ -2653,11 +2658,13 @@ If FORCE is non-nil, the .newsrc file is read." (stringp gnus-save-killed-list)) (gnus-strip-killed-list) gnus-killed-list)) - (variables - (if gnus-save-killed-list gnus-variable-list - ;; Remove the `gnus-killed-list' from the list of variables - ;; to be saved, if required. - (delq 'gnus-killed-list (copy-sequence gnus-variable-list)))) + (variables + (if specific-variable + (list specific-variable) + (if gnus-save-killed-list gnus-variable-list + ;; Remove the `gnus-killed-list' from the list of variables + ;; to be saved, if required. + (delq 'gnus-killed-list (copy-sequence gnus-variable-list))))) ;; Peel off the "dummy" group. (gnus-newsrc-alist (cdr gnus-newsrc-alist)) variable) diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 56f6188..23d350a 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -348,7 +348,7 @@ the first unread article." (defcustom gnus-auto-goto-ignores 'unfetched "*Says how to handle unfetched articles when maneuvering. -This variable can either be the symbols `nil' (maneuver to any +This variable can either be the symbols nil (maneuver to any article), `undownloaded' (maneuvering while unplugged ignores articles that have not been fetched), `always-undownloaded' (maneuvering always ignores articles that have not been fetched), `unfetched' (maneuvering @@ -1225,6 +1225,7 @@ the type of the variable (string, integer, character, etc).") (defvar gnus-newsgroup-data-reverse nil) (defvar gnus-newsgroup-limit nil) (defvar gnus-newsgroup-limits nil) +(defvar gnus-summary-use-undownloaded-faces nil) (defvar gnus-newsgroup-unreads nil "Sorted list of unread articles in the current newsgroup.") @@ -1365,7 +1366,8 @@ This list will always be a subset of gnus-newsgroup-undownloaded.") gnus-cache-removable-articles gnus-newsgroup-cached gnus-newsgroup-data gnus-newsgroup-data-reverse gnus-newsgroup-limit gnus-newsgroup-limits - gnus-newsgroup-charset gnus-newsgroup-display) + gnus-newsgroup-charset gnus-newsgroup-display + gnus-summary-use-undownloaded-faces) "Variables that are buffer-local to the summary buffers.") (defvar gnus-newsgroup-variables nil @@ -5024,7 +5026,12 @@ If SELECT-ARTICLES, only select those articles from GROUP." (active (gnus-active group))) (if (and (car alist) (< (caar alist) (car active))) - (gnus-set-active group (cons (caar alist) (cdr active)))))) + (gnus-set-active group (cons (caar alist) (cdr active))))) + + (setq gnus-summary-use-undownloaded-faces + (not (gnus-agent-find-parameter + group + 'agent-disable-undownloaded-faces)))) (setq gnus-newsgroup-name group gnus-newsgroup-unselected nil @@ -6088,7 +6095,8 @@ If EXCLUDE-GROUP, do not go to this group." (gnus-group-best-unread-group exclude-group)))) (defun gnus-summary-find-next (&optional unread article backward) - (if backward (gnus-summary-find-prev unread article) + (if backward + (gnus-summary-find-prev unread article) (let* ((dummy (gnus-summary-article-intangible-p)) (article (or article (gnus-summary-article-number))) (data (gnus-data-find-list article)) @@ -6103,14 +6111,18 @@ If EXCLUDE-GROUP, do not go to this group." (progn (while data (unless (memq (gnus-data-number (car data)) - (cond ((eq gnus-auto-goto-ignores 'always-undownloaded) - gnus-newsgroup-undownloaded) - (gnus-plugged - nil) - ((eq gnus-auto-goto-ignores 'unfetched) - gnus-newsgroup-unfetched) - ((eq gnus-auto-goto-ignores 'undownloaded) - gnus-newsgroup-undownloaded))) + (cond + ((eq gnus-auto-goto-ignores + 'always-undownloaded) + gnus-newsgroup-undownloaded) + (gnus-plugged + nil) + ((eq gnus-auto-goto-ignores + 'unfetched) + gnus-newsgroup-unfetched) + ((eq gnus-auto-goto-ignores + 'undownloaded) + gnus-newsgroup-undownloaded))) (when (gnus-data-unread-p (car data)) (setq result (car data) data nil))) @@ -6135,14 +6147,18 @@ If EXCLUDE-GROUP, do not go to this group." (progn (while data (unless (memq (gnus-data-number (car data)) - (cond ((eq gnus-auto-goto-ignores 'always-undownloaded) - gnus-newsgroup-undownloaded) - (gnus-plugged - nil) - ((eq gnus-auto-goto-ignores 'unfetched) - gnus-newsgroup-unfetched) - ((eq gnus-auto-goto-ignores 'undownloaded) - gnus-newsgroup-undownloaded))) + (cond + ((eq gnus-auto-goto-ignores + 'always-undownloaded) + gnus-newsgroup-undownloaded) + (gnus-plugged + nil) + ((eq gnus-auto-goto-ignores + 'unfetched) + gnus-newsgroup-unfetched) + ((eq gnus-auto-goto-ignores + 'undownloaded) + gnus-newsgroup-undownloaded))) (when (gnus-data-unread-p (car data)) (setq result (car data) data nil))) @@ -6377,7 +6393,7 @@ The prefix argument ALL means to select all articles." (let ((current-subject (gnus-summary-find-for-reselect)) (group gnus-newsgroup-name)) (setq gnus-newsgroup-begin nil) - (gnus-summary-exit) + (gnus-summary-exit nil 'leave-hidden) ;; We have to adjust the point of group mode buffer because ;; point was moved to the next unread newsgroup by exiting. (gnus-summary-jump-to-group group) @@ -6440,7 +6456,7 @@ If FORCE (the prefix), also save the .newsrc file(s)." (gnus-save-newsrc-file) (gnus-dribble-save))) -(defun gnus-summary-exit (&optional temporary) +(defun gnus-summary-exit (&optional temporary leave-hidden) "Exit reading current newsgroup, and then return to group selection mode. `gnus-exit-group-hook' is called with no arguments if that value is non-nil." (interactive) @@ -6530,11 +6546,14 @@ If FORCE (the prefix), also save the .newsrc file(s)." (when (eq mode 'gnus-summary-mode) (gnus-kill-buffer buf))) (setq gnus-current-select-method gnus-select-method) - (pop-to-buffer gnus-group-buffer) + (if leave-hidden + (set-buffer gnus-group-buffer) + (pop-to-buffer gnus-group-buffer)) (if (not quit-config) (progn (goto-char group-point) - (gnus-configure-windows 'group 'force)) + (unless leave-hidden + (gnus-configure-windows 'group 'force))) (gnus-handle-ephemeral-exit quit-config)) ;; Clear the current group name. (unless quit-config @@ -6616,7 +6635,10 @@ The state which existed when entering the ephemeral is reset." (progn ;; The current article may be from the ephemeral group ;; thus it is best that we reload this article - (gnus-summary-show-article) + ;; + ;; If we're exiting from a large digest, this can be + ;; extremely slow. So, it's better not to reload it. -- jh. + ;;(gnus-summary-show-article) (if (and (boundp 'gnus-pick-mode) (symbol-value 'gnus-pick-mode)) (gnus-configure-windows 'pick 'force) (gnus-configure-windows (cdr quit-config) 'force))) @@ -7158,7 +7180,9 @@ If CIRCULAR is non-nil, go to the start of the article instead of selecting the next article when reaching the end of the current article. -If STOP is non-nil, just stop when reaching the end of the message." +If STOP is non-nil, just stop when reaching the end of the message. + +Also see the variable `gnus-article-skip-boring'." (interactive "P") (setq gnus-summary-buffer (current-buffer)) (gnus-set-global-variables) @@ -8140,8 +8164,12 @@ If FORCE, force a digest interpretation. If not, try to guess what the document format is." (interactive "P") (let ((conf gnus-current-window-configuration)) - (save-excursion - (gnus-summary-select-article)) + (save-window-excursion + (save-excursion + (let (gnus-article-prepare-hook + gnus-display-mime-function + gnus-break-pages) + (gnus-summary-select-article)))) (setq gnus-current-window-configuration conf) (let* ((name (format "%s-%d" (gnus-group-prefixed-name @@ -10017,6 +10045,14 @@ The difference between N and the number of marks cleared is returned." (gnus-summary-mark-article gnus-current-article (or new-mark gnus-read-mark))))) +(defun gnus-summary-mark-current-read-and-unread-as-read (&optional new-mark) + "Intended to be used by `gnus-summary-mark-article-hook'." + (let ((mark (gnus-summary-article-mark))) + (when (or (gnus-unread-mark-p mark) + (gnus-read-mark-p mark)) + (gnus-summary-mark-article (gnus-summary-article-number) + (or new-mark gnus-read-mark))))) + (defun gnus-summary-mark-unread-as-ticked () "Intended to be used by `gnus-summary-mark-article-hook'." (when (memq gnus-current-article gnus-newsgroup-unreads) @@ -10119,10 +10155,14 @@ even ticked and dormant ones." If prefix argument ALL is non-nil, ticked and dormant articles will also be marked as read. If QUIETLY is non-nil, no questions will be asked. + If TO-HERE is non-nil, it should be a point in the buffer. All -articles before (after, if REVERSE is set) this point will be marked as read. +articles before (after, if REVERSE is set) this point will be marked +as read. + Note that this function will only catch up the unread article in the current summary buffer limitation. + The number of articles marked as read is returned." (interactive "P") (prog1 @@ -10156,7 +10196,8 @@ The number of articles marked as read is returned." (if (and to-here reverse) (progn (goto-char to-here) - (gnus-summary-mark-read-and-unread-as-read gnus-catchup-mark) + (gnus-summary-mark-current-read-and-unread-as-read + gnus-catchup-mark) (while (gnus-summary-find-next (not all)) (gnus-summary-mark-article-as-read gnus-catchup-mark))) (when (gnus-summary-first-subject (not all)) @@ -10190,8 +10231,8 @@ If ALL is non-nil, also mark ticked and dormant articles as read." ;; We check that there are unread articles. (when (or all (gnus-summary-find-next)) (gnus-summary-catchup all t beg nil t))))) - (gnus-summary-position-point)) + (defun gnus-summary-catchup-all (&optional quietly) "Mark all articles in this newsgroup as read. This command is dangerous. Normally, you want \\[gnus-summary-catchup] @@ -11194,8 +11235,8 @@ If REVERSE, save parts that do not match TYPE." (default gnus-summary-default-score) (default-high gnus-summary-default-high-score) (default-low gnus-summary-default-low-score) - (uncached (memq article gnus-newsgroup-undownloaded)) - (downloaded (not uncached))) + (uncached (and gnus-summary-use-undownloaded-faces + (memq article gnus-newsgroup-undownloaded)))) (let ((face (funcall (gnus-summary-highlight-line-0)))) (unless (eq face (get-text-property beg 'face)) (gnus-put-text-property-excluding-characters-with-faces diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index 23c418e..acbf843 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -29,6 +29,9 @@ ;; used by Gnus and may be used by any other package without loading ;; Gnus first. +;; [Unfortunately, it does depend on other parts of Gnus, e.g. the +;; autoloads below...] + ;;; Code: (require 'custom) @@ -332,6 +335,7 @@ ;; age-depending date representations. (e.g. just the time if it's ;; from today, the day of the week if it's within the last 7 days and ;; the full date if it's older) + (defun gnus-seconds-today () "Returns the number of seconds passed today" (let ((now (decode-time (current-time)))) @@ -379,26 +383,21 @@ respectively.") Returns \" ? \" if there's bad input or if an other error occurs. Input should look like this: \"Sun, 14 Oct 2001 13:34:39 +0200\"." (condition-case () - (let* ((messy-date (safe-date-to-time messy-date)) - (now (current-time)) + (let* ((messy-date (time-to-seconds (safe-date-to-time messy-date))) + (now (time-to-seconds (current-time))) ;;If we don't find something suitable we'll use this one - (my-format "%b %m '%y") - (high (lsh (- (car now) (car messy-date)) 16))) - (if (and (> high -1) (= (logand high 65535) 0)) - ;;overflow and bad input - (let* ((difference (+ high (- (car (cdr now)) - (car (cdr messy-date))))) - (templist gnus-user-date-format-alist) - (top (eval (caar templist)))) - (while (if (numberp top) (< top difference) (not top)) - (progn - (setq templist (cdr templist)) - (setq top (eval (caar templist))))) - (if (stringp (cdr (car templist))) - (setq my-format (cdr (car templist)))))) - (format-time-string (eval my-format) messy-date)) + (my-format "%b %d '%y")) + (let* ((difference (- now messy-date)) + (templist gnus-user-date-format-alist) + (top (eval (caar templist)))) + (while (if (numberp top) (< top difference) (not top)) + (progn + (setq templist (cdr templist)) + (setq top (eval (caar templist))))) + (if (stringp (cdr (car templist))) + (setq my-format (cdr (car templist))))) + (format-time-string (eval my-format) (seconds-to-time messy-date))) (error " ? "))) -;;end of Frank's code (defun gnus-dd-mmm (messy-date) "Return a string like DD-MMM from a big messy string." @@ -798,10 +797,14 @@ with potentially long computations." ;;; Functions for saving to babyl/mail files. -(defvar rmail-default-rmail-file) +(eval-when-compile + (defvar rmail-default-rmail-file) + (defvar mm-text-coding-system)) + (defun gnus-output-to-rmail (filename &optional ask) "Append the current article to an Rmail file named FILENAME." (require 'rmail) + (require 'mm-util) ;; Most of these codes are borrowed from rmailout.el. (setq filename (expand-file-name filename)) (setq rmail-default-rmail-file filename) @@ -1294,8 +1297,9 @@ CHOICE is a list of the choice char and help message at IDX." (while (not tchar) (message "%s (%s): " prompt - (mapconcat (lambda (s) (char-to-string (car s))) - choice ", ")) + (concat + (mapconcat (lambda (s) (char-to-string (car s))) + choice ", ") ", ?")) (setq tchar (read-char)) (when (not (assq tchar choice)) (setq tchar nil) diff --git a/lisp/gnus-xmas.el b/lisp/gnus-xmas.el index 9225a5a..a01366a 100644 --- a/lisp/gnus-xmas.el +++ b/lisp/gnus-xmas.el @@ -390,6 +390,7 @@ call it with the value of the `gnus-data' text property." (defalias 'gnus-put-text-property 'gnus-xmas-put-text-property) (defalias 'gnus-deactivate-mark 'ignore) (defalias 'gnus-window-edges 'window-pixel-edges) + (defalias 'gnus-assq-delete-all 'gnus-xmas-assq-delete-all) (if (and (<= emacs-major-version 19) (< emacs-minor-version 14)) @@ -885,6 +886,12 @@ Warning: Don't insert text immediately after the image." `(open-network-stream ,name ,buffer ,host ,service ,protocol) `(open-network-stream ,name ,buffer ,host ,service))) +(defun gnus-xmas-assq-delete-all (key alist) + (let ((elem nil)) + (while (setq elem (assq key alist)) + (setq alist (delq elem alist))) + alist)) + (provide 'gnus-xmas) ;;; gnus-xmas.el ends here diff --git a/lisp/gnus.el b/lisp/gnus.el index 4ec9990..672c0d2 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -35,10 +35,6 @@ (require 'mm-util) (require 'nnheader) -;; Make sure it was the right mm-util. -(unless (fboundp 'mm-guess-mime-charset) - (error "Wrong `mm-util' found in `load-path'. Make sure the Gnus one is found first.")) - (defgroup gnus nil "The coffee-brewing, all singing, all dancing, kitchen sink newsreader." :group 'news @@ -286,7 +282,7 @@ is restarted, and sometimes reloaded." :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-version-number "5.10.1" +(defconst gnus-version-number "5.10.2" "Version number for this version of Gnus.") (defconst gnus-version (format "Gnus v%s" gnus-version-number) @@ -323,6 +319,7 @@ be set in `.emacs' instead." (defalias 'gnus-appt-select-lowest-window 'appt-select-lowest-window) (defalias 'gnus-mail-strip-quoted-names 'mail-strip-quoted-names) (defalias 'gnus-character-to-event 'identity) + (defalias 'gnus-assq-delete-all 'assq-delete-all) (defalias 'gnus-add-text-properties 'add-text-properties) (defalias 'gnus-put-text-property 'put-text-property) (defvar gnus-mode-line-image-cache t) @@ -852,6 +849,7 @@ be set in `.emacs' instead." (storm "#666699" "#99ccff") (pdino "#9999cc" "#99ccff") (purp "#9999cc" "#666699") + (no "#000000" "#ff0000") (neutral "#b4b4b4" "#878787") (september "#bf9900" "#ffcc00")) "Color alist used for the Gnus logo.") @@ -1755,6 +1753,26 @@ articles to list when the group is a large newsgroup (see `gnus-large-newsgroup'). If it is nil, the default value is the total number of articles in the group.") +;; The Gnus registry's ignored groups +(gnus-define-group-parameter + registry-ignore + :type list + :function-document + "Whether this group should be ignored by the registry." + :variable gnus-registry-ignored-groups + :variable-default nil + :variable-document + "*Groups in which the registry should be turned off." + :variable-group gnus-registry + :variable-type '(repeat + (list + (regexp :tag "Group Name Regular Expression") + (boolean :tag "Ignored"))) + + :parameter-type '(boolean :tag "Group Ignored by the Registry") + :parameter-document + "Whether the Gnus Registry should ignore this group.") + ;; group parameters for spam processing added by Ted Zlatanov (defcustom gnus-install-group-spam-parameters t "*Disable the group parameters for spam detection. @@ -1875,8 +1893,7 @@ Only applicable to non-spam (unclassified and ham) groups.") "*Groups in which to automatically process spam or ham articles with a backend on summary exit. If non-nil, this should be a list of group name regexps that should match all groups in which to do automatic -spam processing, associated with the appropriate processor. This only makes sense -for mail groups." +spam processing, associated with the appropriate processor." :variable-group spam :variable-type '(repeat :tag "Spam/Ham Processors" (list :tag "Spam Summary Exit Processor Choices" @@ -2127,7 +2144,7 @@ You also need to enable `gnus-agent' for this to have any affect." :group 'gnus-agent :type 'boolean) -(defcustom gnus-default-charset (mm-guess-mime-charset) +(defcustom gnus-default-charset 'undecided "Default charset assumed to be used when viewing non-ASCII characters. This variable is overridden on a group-to-group basis by the `gnus-group-charset-alist' variable and is only used on groups not @@ -2137,7 +2154,7 @@ covered by that variable." (defcustom gnus-agent t "Whether we want to use the Gnus agent or not. -Putting (gnus-agentize) in ~/.gnus is obsolete by (setq gnus-agent t)." +Putting (gnus-agentize) in ~/.gnus is obsoleted by (setq gnus-agent t)." :version "21.3" :group 'gnus-agent :type 'boolean) @@ -2288,8 +2305,6 @@ such as a mark that says whether an article is stored in the cache '(gnus-newsrc-options gnus-newsrc-options-n gnus-newsrc-last-checked-date gnus-newsrc-alist gnus-server-alist - gnus-registry-alist - gnus-registry-headers-alist gnus-killed-list gnus-zombie-list gnus-topic-topology gnus-topic-alist gnus-agent-covered-methods gnus-format-specs) @@ -2303,10 +2318,6 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") "Assoc list of registry data. gnus-registry.el will populate this if it's loaded.") -(defvar gnus-registry-headers-alist nil - "Assoc list of registry header data. -gnus-registry.el will populate this if it's loaded.") - (defvar gnus-newsrc-hashtb nil "Hashtable of gnus-newsrc-alist.") diff --git a/lisp/ietf-drums.el b/lisp/ietf-drums.el index aa48c3a..c546316 100644 --- a/lisp/ietf-drums.el +++ b/lisp/ietf-drums.el @@ -64,7 +64,6 @@ backslash and doublequote.") (modify-syntax-entry ?> ")" table) (modify-syntax-entry ?@ "w" table) (modify-syntax-entry ?/ "w" table) - (modify-syntax-entry ?= " " table) (modify-syntax-entry ?* " " table) (modify-syntax-entry ?\; " " table) (modify-syntax-entry ?\' " " table) diff --git a/lisp/lpath.el b/lisp/lpath.el index 50f0ec4..51f5eca 100644 --- a/lisp/lpath.el +++ b/lisp/lpath.el @@ -11,8 +11,8 @@ (maybe-fbind '(Info-directory Info-menu bbdb-create-internal bbdb-records create-image - display-graphic-p display-time-event-handler find-image - image-size image-type-available-p insert-image + display-graphic-p display-time-event-handler find-coding-system + find-image image-size image-type-available-p insert-image make-mode-line-mouse-map make-temp-file open-ssl-stream propertize put-image replace-regexp-in-string rmail-msg-is-pruned rmail-msg-restore-non-pruned-header diff --git a/lisp/mail-source.el b/lisp/mail-source.el index b8458b8..87dd3ca 100644 --- a/lisp/mail-source.el +++ b/lisp/mail-source.el @@ -262,7 +262,7 @@ If non-nil, this maildrop will be checked periodically for new mail." :group 'mail-source :type 'integer) -(defcustom mail-source-delete-incoming nil +(defcustom mail-source-delete-incoming t "*If non-nil, delete incoming files after handling. If t, delete immediately, if nil, never delete. If a positive number, delete files older than number of days." @@ -511,17 +511,6 @@ Return the number of files that were found." (error "Cannot get new mail")) 0))))))))) -(eval-and-compile - (if (fboundp 'make-temp-file) - (defalias 'mail-source-make-complex-temp-name 'make-temp-file) - (defun mail-source-make-complex-temp-name (prefix) - (let ((newname (make-temp-name prefix)) - (newprefix prefix)) - (while (file-exists-p newname) - (setq newprefix (concat newprefix "x")) - (setq newname (make-temp-name newprefix))) - newname)))) - (defun mail-source-delete-old-incoming (&optional age confirm) "Remove incoming files older than AGE days. If CONFIRM is non-nil, ask for confirmation before removing a file." @@ -566,7 +555,7 @@ Pass INFO on to CALLBACK." (if (eq mail-source-delete-incoming t) (delete-file mail-source-crash-box) (let ((incoming - (mail-source-make-complex-temp-name + (mm-make-temp-file (expand-file-name mail-source-incoming-file-prefix mail-source-directory)))) diff --git a/lisp/message.el b/lisp/message.el index af5aed1..1dc96a2 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -144,7 +144,8 @@ If this variable is nil, no such courtesy message will be added." :group 'message-sending :type 'string) -(defcustom message-ignored-bounced-headers "^\\(Received\\|Return-Path\\):" +(defcustom message-ignored-bounced-headers + "^\\(Received\\|Return-Path\\|Delivered-To\\):" "*Regexp that matches headers to be removed in resent bounced mail." :group 'message-interface :type 'regexp) @@ -303,6 +304,8 @@ few false positives here." :group 'message-various :type 'regexp) +;; Fixme: Why are all these things autoloaded? + ;;; marking inserted text ;;;###autoload @@ -1305,8 +1308,7 @@ no, only reply back to the author." (defcustom message-use-idna (and (condition-case nil (require 'idna) (file-error)) - (fboundp 'coding-system-p) - (coding-system-p 'utf-8) + (mm-coding-system-p 'utf-8) 'ask) "Whether to encode non-ASCII in domain names into ASCII according to IDNA." :group 'message-headers @@ -1494,8 +1496,8 @@ is used by default." (beg 1) (first t) quoted elems paren) - (save-excursion - (message-set-work-buffer) + (with-temp-buffer + (mm-enable-multibyte) (insert header) (goto-char (point-min)) (while (not (eobp)) @@ -1588,15 +1590,6 @@ is used by default." (mail-narrow-to-head) (message-fetch-field header)))) -(defun message-set-work-buffer () - (if (get-buffer " *message work*") - (progn - (set-buffer " *message work*") - (erase-buffer)) - (set-buffer (get-buffer-create " *message work*")) - (kill-all-local-variables) - (mm-enable-multibyte))) - (defun message-functionp (form) "Return non-nil if FORM is funcallable." (or (and (symbolp form) (fboundp form)) @@ -2626,7 +2619,7 @@ With the prefix argument FORCE, insert the header anyway." (let ((point (point))) (message-goto-signature) (unless (eobp) - (forward-line -2)) + (end-of-line -1)) (kill-region point (point)) (unless (bolp) (insert "\n")))) @@ -2722,7 +2715,7 @@ Prefix arg means justify as well." (defun message-fill-paragraph (&optional arg) "Like `fill-paragraph'." (interactive (list (if current-prefix-arg 'full))) - (if (and (boundp 'filladapt-mode) filladapt-mode) + (if (if (boundp 'filladapt-mode) filladapt-mode) nil (message-newline-and-reformat arg t) t)) @@ -3928,7 +3921,7 @@ Otherwise, generate and save a value for `canlock-password' first." (length (setq to (completing-read "Followups to (default: no Followup-To header) " - (mapcar (lambda (g) (list g)) + (mapcar #'list (cons "poster" (message-tokenize-header newsgroups))))))))) @@ -4411,8 +4404,8 @@ If NOW, use that time instead." (if (message-functionp message-user-organization) (funcall message-user-organization) message-user-organization)))) - (save-excursion - (message-set-work-buffer) + (with-temp-buffer + (mm-enable-multibyte) (cond ((stringp organization) (insert organization)) ((and (eq t organization) @@ -4496,8 +4489,8 @@ If NOW, use that time instead." (user-full-name)))) (when (string= fullname "&") (setq fullname (user-login-name))) - (save-excursion - (message-set-work-buffer) + (with-temp-buffer + (mm-enable-multibyte) (cond ((or (null style) (equal fullname "")) @@ -5260,6 +5253,10 @@ are not included." (when message-default-mail-headers (insert message-default-mail-headers) (or (bolp) (insert ?\n))) + (save-restriction + (message-narrow-to-headers) + (if message-alternative-emails + (message-use-alternative-email-as-from))) (when message-generate-headers-first (message-generate-headers (message-headers-to-generate @@ -5271,8 +5268,6 @@ are not included." (message-insert-signature) (save-restriction (message-narrow-to-headers) - (if message-alternative-emails - (message-use-alternative-email-as-from)) (run-hooks 'message-header-setup-hook)) (set-buffer-modified-p nil) (setq buffer-undo-list nil) @@ -5857,10 +5852,9 @@ news, Source is the list of newsgroups is was posted to." (concat "[" (let ((prefix (or (message-fetch-field "newsgroups") - (cdr - (mail-header-parse-address - (mail-decode-encoded-word-string - (message-fetch-field "from")))) + (let ((from (message-fetch-field "from"))) + (and from + (cdr (mail-header-parse-address from)))) "(nowhere)"))) (if message-forward-decoded-p prefix @@ -5944,11 +5938,11 @@ Optional DIGEST will use digest to forward." (not message-forward-decoded-p)) (insert (with-temp-buffer - (mm-disable-multibyte-mule4) + (mm-disable-multibyte) (insert (with-current-buffer forward-buffer - (mm-with-unibyte-current-buffer-mule4 (buffer-string)))) - (mm-enable-multibyte-mule4) + (mm-with-unibyte-current-buffer (buffer-string)))) + (mm-enable-multibyte) (mime-to-mml) (goto-char (point-min)) (when (looking-at "From ") @@ -6396,11 +6390,6 @@ regexp varstr." (cdr local))))) locals))) -;;; Miscellaneous functions - -(defsubst message-replace-chars-in-string (string from to) - (mm-subst-char-in-string from to string)) - ;;; ;;; MIME functions ;;; diff --git a/lisp/mm-bodies.el b/lisp/mm-bodies.el index ee14049..219c903 100644 --- a/lisp/mm-bodies.el +++ b/lisp/mm-bodies.el @@ -47,6 +47,8 @@ (iso-2022-jp-2 . 7bit) ;; We MUST encode UTF-16 because it can contain \0's which is ;; known to break servers. + ;; Note: UTF-16 variants are invalid for text parts [RFC 2781], + ;; so this can't happen :-/. (utf-16 . base64) (utf-16be . base64) (utf-16le . base64)) @@ -63,9 +65,9 @@ Valid encodings are `7bit', `8bit', `quoted-printable' and `base64'." (defun mm-encode-body (&optional charset) "Encode a body. Should be called narrowed to the body that is to be encoded. -If there is more than one non-ASCII MULE charset, then list of found -MULE charsets are returned. -If CHARSET is non-nil, it is used. +If there is more than one non-ASCII MULE charset in the body, then the +list of MULE charsets found is returned. +If CHARSET is non-nil, it is used as the MIME charset to encode the body. If successful, the MIME charset is returned. If no encoding was done, nil is returned." (if (not (mm-multibyte-p)) @@ -79,7 +81,7 @@ If no encoding was done, nil is returned." (message-options-get 'mm-encody-body-charset) (message-options-set 'mm-encody-body-charset - (mm-read-charset "Charset used in the article: "))) + (mm-read-coding-system "Charset used in the article: "))) ;; The logic in `mml-generate-mime-1' confirms that it's OK ;; to return nil here. nil))) @@ -150,32 +152,19 @@ If no encoding was done, nil is returned." (defun mm-body-7-or-8 () "Say whether the body is 7bit or 8bit." - (cond - ((not (featurep 'mule)) - (if (save-excursion - (goto-char (point-min)) - (skip-chars-forward mm-7bit-chars) - (eobp)) - '7bit - '8bit)) - (t - ;; Mule version - (if (and (null (delq 'ascii - (mm-find-charset-region (point-min) (point-max)))) - ;;!!!The following is necessary because the function - ;;!!!above seems to return the wrong result under - ;;!!!Emacs 20.3. Sometimes. - (save-excursion - (goto-char (point-min)) - (skip-chars-forward mm-7bit-chars) - (eobp))) - '7bit - '8bit)))) + (if (save-excursion + (goto-char (point-min)) + (skip-chars-forward mm-7bit-chars) + (eobp)) + '7bit + '8bit)) ;;; ;;; Functions for decoding ;;; +(eval-when-compile (defvar mm-uu-yenc-decode-function)) + (defun mm-decode-content-transfer-encoding (encoding &optional type) "Decodes buffer encoded with ENCODING, returning success status. If TYPE is `text/plain' CRLF->LF translation may occur." @@ -234,66 +223,42 @@ If TYPE is `text/plain' CRLF->LF translation may occur." (while (search-forward "\r\n" nil t) (replace-match "\n" t t))))) -(defun mm-decode-body (charset &optional encoding type force) - "Decode the current article that has been encoded with ENCODING. -The characters in CHARSET should then be decoded. If FORCE is non-nil -use the supplied charset unconditionally." - (let ((charset-supplied charset)) - (when (stringp charset) - (setq charset (intern (downcase charset)))) - (when (or (not charset) - (eq 'gnus-all mail-parse-ignored-charsets) - (memq 'gnus-all mail-parse-ignored-charsets) - (memq charset mail-parse-ignored-charsets)) - (setq charset mail-parse-charset - charset-supplied nil)) - (save-excursion - (when encoding - (mm-decode-content-transfer-encoding encoding type)) - (when (featurep 'mule) - (let ((coding-system (mm-charset-to-coding-system charset))) - (if (and (not coding-system) - (listp mail-parse-ignored-charsets) - (memq 'gnus-unknown mail-parse-ignored-charsets)) - (setq coding-system - (mm-charset-to-coding-system mail-parse-charset))) - (when (and charset coding-system - ;; buffer-file-coding-system - ;;Article buffer is nil coding system - ;;in XEmacs - (mm-multibyte-p) - (or (not (eq coding-system 'ascii)) - (setq coding-system mail-parse-charset)) - (not (eq coding-system 'gnus-decoded))) - (if (or force - ;; If a charset was supplied, then use the - ;; supplied charset unconditionally. - charset-supplied) - (mm-decode-coding-region (point-min) (point-max) - coding-system) - ;; Otherwise allow Emacs to auto-detect the charset. - (mm-decode-coding-region-safely (point-min) (point-max) - coding-system))) - (setq buffer-file-coding-system - (if (boundp 'last-coding-system-used) - (symbol-value 'last-coding-system-used) - coding-system))))))) - -(defun mm-decode-coding-region-safely (start end coding-system) - "Decode region between START and END with CODING-SYSTEM. -If CODING-SYSTEM is not a valid coding system for the text, let Emacs -decide which coding system to use." - (let* ((orig (buffer-substring start end)) - charsets) - (save-restriction - (narrow-to-region start end) - (mm-decode-coding-region (point-min) (point-max) coding-system) - (setq charsets (find-charset-region (point-min) (point-max))) - (when (or (memq 'eight-bit-control charsets) - (memq 'eight-bit-graphic charsets)) - (delete-region (point-min) (point-max)) - (insert orig) - (mm-decode-coding-region (point-min) (point-max) 'undecided))))) +(defun mm-decode-body (charset &optional encoding type) + "Decode the current article that has been encoded with ENCODING to CHARSET. +ENCODING is a MIME content transfer encoding. +CHARSET is the MIME charset with which to decode the data after transfer +decoding. If it is nil, default to `mail-parse-charset'." + (when (stringp charset) + (setq charset (intern (downcase charset)))) + (when (or (not charset) + (eq 'gnus-all mail-parse-ignored-charsets) + (memq 'gnus-all mail-parse-ignored-charsets) + (memq charset mail-parse-ignored-charsets)) + (setq charset mail-parse-charset)) + (save-excursion + (when encoding + (mm-decode-content-transfer-encoding encoding type)) + (when (featurep 'mule) ; Fixme: Wrong test for unibyte session. + (let ((coding-system (mm-charset-to-coding-system charset))) + (if (and (not coding-system) + (listp mail-parse-ignored-charsets) + (memq 'gnus-unknown mail-parse-ignored-charsets)) + (setq coding-system + (mm-charset-to-coding-system mail-parse-charset))) + (when (and charset coding-system + ;; buffer-file-coding-system + ;;Article buffer is nil coding system + ;;in XEmacs + (mm-multibyte-p) + (or (not (eq coding-system 'ascii)) + (setq coding-system mail-parse-charset)) + (not (eq coding-system 'gnus-decoded))) + (mm-decode-coding-region (point-min) (point-max) + coding-system)) + (setq buffer-file-coding-system + (if (boundp 'last-coding-system-used) + (symbol-value 'last-coding-system-used) + coding-system)))))) (defun mm-decode-string (string charset) "Decode STRING with CHARSET." diff --git a/lisp/mm-encode.el b/lisp/mm-encode.el index 622e63f..f9585da 100644 --- a/lisp/mm-encode.el +++ b/lisp/mm-encode.el @@ -29,7 +29,8 @@ (require 'mail-parse) (require 'mailcap) (eval-and-compile - (autoload 'mm-body-7-or-8 "mm-bodies")) + (autoload 'mm-body-7-or-8 "mm-bodies") + (autoload 'mm-long-lines-p "mm-bodies")) (defcustom mm-content-transfer-encoding-defaults '(("text/x-patch" 8bit) @@ -85,7 +86,7 @@ This variable should never be set directly, but bound before a call to (mailcap-extension-to-mime (match-string 0 file)))) (defun mm-safer-encoding (encoding) - "Return a safer but similar encoding." + "Return an encoding similar to ENCODING but safer than it." (cond ((memq encoding '(7bit 8bit quoted-printable)) 'quoted-printable) ;; The remaining encodings are binary and base64 (and perhaps some @@ -93,33 +94,38 @@ This variable should never be set directly, but bound before a call to (t 'base64))) (defun mm-encode-content-transfer-encoding (encoding &optional type) + "Encode the current buffer with ENCODING for MIME type TYPE. +ENCODING can be: nil (do nothing); one of `quoted-printable', `base64'; +`7bit', `8bit' or `binary' (all do nothing); a function to do the encoding." (cond ((eq encoding 'quoted-printable) - (mm-with-unibyte-current-buffer-mule4 - (quoted-printable-encode-region (point-min) (point-max) t))) + ;; This used to try to make a multibyte buffer unibyte. That's + ;; completely wrong, since you'd get QP-encoded emacs-mule. If + ;; this gets run on multibyte text it's an error that needs + ;; fixing, and the encoding function will signal an error. + ;; Likewise base64 below. + (quoted-printable-encode-region (point-min) (point-max) t)) ((eq encoding 'base64) (when (equal type "text/plain") (goto-char (point-min)) (while (search-forward "\n" nil t) (replace-match "\r\n" t t))) - (condition-case error - (base64-encode-region (point-min) (point-max)) - (error - (message "Error while decoding: %s" error) - nil))) + (base64-encode-region (point-min) (point-max))) ((memq encoding '(7bit 8bit binary)) ;; Do nothing. ) ((null encoding) ;; Do nothing. ) + ;; Fixme: Ignoring errors here looks bogus. ((functionp encoding) (ignore-errors (funcall encoding (point-min) (point-max)))) (t - (message "Unknown encoding %s; treating it as 8bit" encoding)))) + (error "Unknown encoding %s" encoding)))) (defun mm-encode-buffer (type) - "Encode the buffer which contains data of TYPE. + "Encode the buffer which contains data of MIME type TYPE. +TYPE is a string or a list of the components. The encoding used is returned." (let* ((mime-type (if (stringp type) type (car type))) (encoding @@ -165,6 +171,8 @@ The encoding used is returned." (pop rules))))) (defun mm-qp-or-base64 () + "Return the type with which to encode the buffer. +This is either `base64' or `quoted-printable'." (if (equal mm-use-ultra-safe-encoding '(sign . "pgp")) ;; perhaps not always accurate? 'quoted-printable diff --git a/lisp/mm-extern.el b/lisp/mm-extern.el index 0103050..b6bf163 100644 --- a/lisp/mm-extern.el +++ b/lisp/mm-extern.el @@ -49,7 +49,7 @@ (coding-system-for-read mm-binary-coding-system)) (unless name (error "The filename is not specified")) - (mm-disable-multibyte-mule4) + (mm-disable-multibyte) (if (file-exists-p name) (mm-insert-file-contents name nil nil nil nil t) (error (format "File %s is gone" name))))) @@ -61,9 +61,9 @@ (coding-system-for-read mm-binary-coding-system)) (unless url (error "URL is not specified")) - (mm-with-unibyte-current-buffer-mule4 + (mm-with-unibyte-current-buffer (mm-url-insert-file-contents url)) - (mm-disable-multibyte-mule4) + (mm-disable-multibyte) (setq buffer-file-name name))) (defun mm-extern-anon-ftp (handle) @@ -79,7 +79,7 @@ (coding-system-for-read mm-binary-coding-system)) (unless name (error "The filename is not specified")) - (mm-disable-multibyte-mule4) + (mm-disable-multibyte) (mm-insert-file-contents path nil nil nil nil t))) (defun mm-extern-ftp (handle) diff --git a/lisp/mm-util.el b/lisp/mm-util.el index c50c3b5..3b18916 100644 --- a/lisp/mm-util.el +++ b/lisp/mm-util.el @@ -72,6 +72,16 @@ (string-make-unibyte . identity) (string-as-multibyte . identity) (multibyte-string-p . ignore) + ;; It is not a MIME function, but some MIME functions use it. + (make-temp-file . (lambda (prefix &optional dir-flag) + (let ((file (expand-file-name + (make-temp-name prefix) + (if (fboundp 'temp-directory) + (temp-directory) + temporary-file-directory)))) + (if dir-flag + (make-directory file)) + file))) (insert-byte . insert-char) (multibyte-char-to-unibyte . identity)))) @@ -82,6 +92,14 @@ ((fboundp 'char-valid-p) 'char-valid-p) (t 'identity)))) +;; Fixme: This seems always to be used to read a MIME charset, so it +;; should be re-named and fixed (in Emacs) to offer completion only on +;; proper charset names (base coding systems which have a +;; mime-charset defined). XEmacs doesn't believe in mime-charset; +;; test with +;; `(or (coding-system-get 'iso-8859-1 'mime-charset) +;; (coding-system-get 'iso-8859-1 :mime-charset))' +;; Actually, there should be an `mm-coding-system-mime-charset'. (eval-and-compile (defalias 'mm-read-coding-system (cond @@ -103,10 +121,15 @@ (or mm-coding-system-list (setq mm-coding-system-list (mm-coding-system-list)))) -(defun mm-coding-system-p (sym) - "Return non-nil if SYM is a coding system." - (or (and (fboundp 'coding-system-p) (coding-system-p sym)) - (memq sym (mm-get-coding-system-list)))) +(defun mm-coding-system-p (cs) + "Return non-nil if CS is a symbol naming a coding system. +In XEmacs, also return non-nil if CS is a coding system object." + (if (fboundp 'find-coding-system) + (find-coding-system cs) + (if (fboundp 'coding-system-p) + (coding-system-p cs) + ;; Is this branch ever actually useful? + (memq cs (mm-get-coding-system-list))))) (defvar mm-charset-synonym-alist `( @@ -119,8 +142,8 @@ ;; Apparently not defined in Emacs 20, but is a valid MIME name. ,@(unless (mm-coding-system-p 'gb2312) '((gb2312 . cn-gb-2312))) - ;; ISO-8859-15 is very similar to ISO-8859-1. - ,@(unless (mm-coding-system-p 'iso-8859-15) ; Emacs 21 defines it. + ;; ISO-8859-15 is very similar to ISO-8859-1. But it's _different_! + ,@(unless (mm-coding-system-p 'iso-8859-15) '((iso-8859-15 . iso-8859-1))) ;; Windows-1252 is actually a superset of Latin-1. See also ;; `gnus-article-dumbquotes-map'. @@ -380,12 +403,7 @@ used as the line break code type of the coding system." (boundp 'default-enable-multibyte-characters) default-enable-multibyte-characters (fboundp 'set-buffer-multibyte)) - "Emacs mule.") - - (defvar mm-mule4-p (and mm-emacs-mule - (fboundp 'charsetp) - (not (charsetp 'eight-bit-control))) - "Mule version 4.") + "True in Emacs with Mule.") (if mm-emacs-mule (defun mm-enable-multibyte () @@ -400,27 +418,14 @@ non-nil. This is a no-op in XEmacs." "Unset the multibyte flag of in the current buffer. This is a no-op in XEmacs." (set-buffer-multibyte nil)) - (defalias 'mm-disable-multibyte 'ignore)) - - (if mm-mule4-p - (defun mm-enable-multibyte-mule4 () - "Enable multibyte in the current buffer. -Only used in Emacs Mule 4." - (set-buffer-multibyte t)) - (defalias 'mm-enable-multibyte-mule4 'ignore)) - - (if mm-mule4-p - (defun mm-disable-multibyte-mule4 () - "Disable multibyte in the current buffer. -Only used in Emacs Mule 4." - (set-buffer-multibyte nil)) - (defalias 'mm-disable-multibyte-mule4 'ignore))) + (defalias 'mm-disable-multibyte 'ignore))) (defun mm-preferred-coding-system (charset) ;; A typo in some Emacs versions. (or (get-charset-property charset 'preferred-coding-system) (get-charset-property charset 'prefered-coding-system))) +;; Mule charsets shouldn't be used. (defsubst mm-guess-charset () "Guess Mule charset from the language environment." (or @@ -451,7 +456,7 @@ If the charset is `composition', return the actual one." (setq charset 'ascii) ;; charset-after is fake in some Emacsen. (setq charset (and (fboundp 'char-charset) (char-charset char))) - (if (eq charset 'composition) + (if (eq charset 'composition) ; Mule 4 (let ((p (or pos (point)))) (cadr (find-charset-region p (1+ p)))) (if (and charset (not (memq charset '(ascii eight-bit-control @@ -487,13 +492,23 @@ If the charset is `composition', return the actual one." (setq result (cons head result))) (nreverse result))) -(if (and (not (featurep 'xemacs)) - (boundp 'enable-multibyte-characters)) - (defalias 'mm-multibyte-p - (lambda () - "Say whether multibyte is enabled in the current buffer." - enable-multibyte-characters)) - (defalias 'mm-multibyte-p (lambda () (featurep 'mule)))) +;; Fixme: This is used in places when it should be testing the +;; default multibyteness. See mm-default-multibyte-p. +(eval-and-compile + (if (and (not (featurep 'xemacs)) + (boundp 'enable-multibyte-characters)) + (defun mm-multibyte-p () + "Non-nil if multibyte is enabled in the current buffer." + enable-multibyte-characters) + (defun mm-multibyte-p () (featurep 'mule)))) + +(defun mm-default-multibyte-p () + "Return non-nil if the session is multibyte. +This affects whether coding conversion should be attempted generally." + (if (featurep 'mule) + (if (boundp 'default-enable-multibyte-characters) + default-enable-multibyte-characters + t))) (defun mm-iso-8859-x-to-15-region (&optional b e) (if (fboundp 'char-charset) @@ -550,16 +565,24 @@ charset, and a longer list means no appropriate charset." ;; `compound-text' is not in the IANA list. We ;; shouldn't normally use anything here with a ;; mime-charset having an `x-' prefix. - ;; Fixme: allow this to be overridden, since + ;; Fixme: Allow this to be overridden, since ;; there is existing use of x-ctext. ;; Also people apparently need the coding system - ;; `iso-2022-jp-3', which Mule-UCS defines. + ;; `iso-2022-jp-3' (which Mule-UCS defines with + ;; mime-charset, though it's not valid). (if (and cs - (not (string-match "^[Xx]-" (symbol-name cs)))) + (not (string-match "^[Xx]-" (symbol-name cs))) + ;; UTF-16 of any variety is invalid for + ;; text parts and, unfortunately, has + ;; mime-charset defined both in Mule-UCS + ;; and versions of Emacs. (The name + ;; might be `mule-utf-16...' or + ;; `utf-16...'.) + (not (string-match "utf-16" (symbol-name cs)))) (setq systems nil charsets (list cs)))))) charsets)) - ;; Otherwise we're not multibyte, we're XEmacs or a single + ;; Otherwise we're not multibyte, we're XEmacs, or a single ;; coding system won't cover it. (setq charsets (mm-delete-duplicates @@ -592,7 +615,7 @@ Equivalent to `progn' in XEmacs" (let ((multibyte (make-symbol "multibyte")) (buffer (make-symbol "buffer"))) `(if mm-emacs-mule - (let ((,multibyte enable-multibyte-characters) + (let ((,multibyte enable-multibyte-characters) (,buffer (current-buffer))) (unwind-protect (let (default-enable-multibyte-characters) @@ -605,25 +628,6 @@ Equivalent to `progn' in XEmacs" (put 'mm-with-unibyte-current-buffer 'lisp-indent-function 0) (put 'mm-with-unibyte-current-buffer 'edebug-form-spec '(body)) -(defmacro mm-with-unibyte-current-buffer-mule4 (&rest forms) - "Evaluate FORMS there like `progn' in current buffer. -Mule4 only." - (let ((multibyte (make-symbol "multibyte")) - (buffer (make-symbol "buffer"))) - `(if mm-mule4-p - (let ((,multibyte enable-multibyte-characters) - (,buffer (current-buffer))) - (unwind-protect - (let (default-enable-multibyte-characters) - (set-buffer-multibyte nil) - ,@forms) - (set-buffer ,buffer) - (set-buffer-multibyte ,multibyte))) - (let (default-enable-multibyte-characters) - ,@forms)))) -(put 'mm-with-unibyte-current-buffer-mule4 'lisp-indent-function 0) -(put 'mm-with-unibyte-current-buffer-mule4 'edebug-form-spec '(body)) - (defmacro mm-with-unibyte (&rest forms) "Eval the FORMS with the default value of `enable-multibyte-characters' nil, ." `(let (default-enable-multibyte-characters) @@ -768,6 +772,7 @@ If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'." (push dir result)) (push path result)))) +;; Fixme: This doesn't look useful where it's used. (if (fboundp 'detect-coding-region) (defun mm-detect-coding-region (start end) "Like `detect-coding-region' except returning the best one." @@ -793,44 +798,6 @@ If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'." (let ((cs (mm-detect-coding-region start end))) cs))) -(defun mm-guess-mime-charset () - "Guess the default MIME charset from the language environment." - (let ((language-info - (and (boundp 'current-language-environment) - (assoc current-language-environment - language-info-alist))) - item) - (cond - ((null language-info) - 'iso-8859-1) - ((setq item - (cadr - (or (assq 'coding-priority language-info) - (assq 'coding-system language-info)))) - (if (fboundp 'coding-system-get) - (or (coding-system-get item 'mime-charset) - item) - item)) - ((setq item (car (last (assq 'charset language-info)))) - (if (eq item 'ascii) - 'iso-8859-1 - (mm-mime-charset item))) - (t - 'iso-8859-1)))) - -;; It is not a MIME function, but some MIME functions use it. -(defalias 'mm-make-temp-file - (if (fboundp 'make-temp-file) - 'make-temp-file - (lambda (prefix &optional dir-flag) - (let ((file (expand-file-name - (make-temp-name prefix) - (if (fboundp 'temp-directory) - (temp-directory) - temporary-file-directory)))) - (if dir-flag - (make-directory file)) - file)))) (provide 'mm-util) diff --git a/lisp/mml-smime.el b/lisp/mml-smime.el index bccc8a1..82d13df 100644 --- a/lisp/mml-smime.el +++ b/lisp/mml-smime.el @@ -27,6 +27,7 @@ (require 'smime) (require 'mm-decode) +(autoload 'message-narrow-to-headers "message") (defun mml-smime-sign (cont) (when (null smime-keys) diff --git a/lisp/mml1991.el b/lisp/mml1991.el index d72ceaa..60c3156 100644 --- a/lisp/mml1991.el +++ b/lisp/mml1991.el @@ -104,7 +104,7 @@ (while (looking-at "^Content[^ ]+:") (forward-line)) (unless (bobp) (delete-region (point-min) (point))) - (mm-with-unibyte-current-buffer-mule4 + (mm-with-unibyte-current-buffer (with-temp-buffer (setq cipher (current-buffer)) (insert-buffer-substring text) @@ -178,7 +178,7 @@ (while (looking-at "^Content[^ ]+:") (forward-line)) (unless (bobp) (delete-region (point-min) (point))) - (mm-with-unibyte-current-buffer-mule4 + (mm-with-unibyte-current-buffer (with-temp-buffer (flet ((gpg-encrypt-func (sign plaintext ciphertext result recipients &optional diff --git a/lisp/mml2015.el b/lisp/mml2015.el index e3e3c5a..fc3cc50 100644 --- a/lisp/mml2015.el +++ b/lisp/mml2015.el @@ -31,6 +31,7 @@ (eval-when-compile (require 'cl)) (require 'mm-decode) (require 'mm-util) +(require 'mml) (defvar mml2015-use (or (progn @@ -329,7 +330,7 @@ (or (y-or-n-p "Sign the message? ") 'not)))) 'never))) - (mm-with-unibyte-current-buffer-mule4 + (mm-with-unibyte-current-buffer (mc-encrypt-generic (or (message-options-get 'message-recipients) (message-options-set 'message-recipients @@ -581,7 +582,7 @@ (funcall mml-boundary-function (incf mml-multipart-number))) (text (current-buffer)) cipher) - (mm-with-unibyte-current-buffer-mule4 + (mm-with-unibyte-current-buffer (with-temp-buffer ;; set up a function to call the correct gpg encrypt routine ;; with the right arguments. (FIXME: this should be done diff --git a/lisp/nndoc.el b/lisp/nndoc.el index 00d799e..28b783d 100644 --- a/lisp/nndoc.el +++ b/lisp/nndoc.el @@ -58,6 +58,13 @@ from the document.") `((mmdf (article-begin . "^\^A\^A\^A\^A\n") (body-end . "^\^A\^A\^A\^A\n")) + (mime-digest + (article-begin . "") + (head-begin . "^ ?\n") + (head-end . "^ ?$") + (body-end . "") + (file-end . "") + (subtype digest guess)) (mime-parts (generate-head-function . nndoc-generate-mime-parts-head) (article-transform-function . nndoc-transform-mime-parts)) @@ -94,13 +101,7 @@ from the document.") (head-end . "^\t") (generate-head-function . nndoc-generate-clari-briefs-head) (article-transform-function . nndoc-transform-clari-briefs)) - (mime-digest - (article-begin . "") - (head-begin . "^ ?\n") - (head-end . "^ ?$") - (body-end . "") - (file-end . "") - (subtype digest guess)) + (standard-digest (first-article . ,(concat "^" (make-string 70 ?-) "\n *\n+")) (article-begin . ,(concat "^\n" (make-string 30 ?-) "\n *\n+")) diff --git a/lisp/nnheader.el b/lisp/nnheader.el index 61797df..9debd98 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -37,6 +37,7 @@ (require 'mail-utils) (require 'mm-util) +(require 'gnus-util) (eval-and-compile (autoload 'gnus-sorted-intersection "gnus-range") (autoload 'gnus-intersection "gnus-range") diff --git a/lisp/nnrss.el b/lisp/nnrss.el index fa6232c..f42e101 100644 --- a/lisp/nnrss.el +++ b/lisp/nnrss.el @@ -684,48 +684,48 @@ whether they are `offsite' or `onsite'." (defun nnrss-find-rss-via-syndic8 (url) "query syndic8 for the rss feeds it has for the url." - (if (locate-library "xml-rpc") - (progn (require 'xml-rpc) - (let ((feedid (xml-rpc-method-call - "http://www.syndic8.com/xmlrpc.php" - 'syndic8.FindSites - url))) - (if feedid - (let* ((feedinfo (xml-rpc-method-call - "http://www.syndic8.com/xmlrpc.php" - 'syndic8.GetFeedInfo - feedid)) - (urllist - (delq nil - (mapcar - (lambda (listinfo) - (if (string-equal - (cdr (assoc "status" listinfo)) - "Syndicated") - (cons - (cdr (assoc "sitename" listinfo)) - (list - (cons 'title - (cdr (assoc - "sitename" listinfo))) - (cons 'href - (cdr (assoc - "dataurl" listinfo))))))) - feedinfo)))) - (if (> (length urllist) 1) - (let ((completion-ignore-case t) - (selection - (mapcar (lambda (listinfo) - (cons (cdr (assoc "sitename" listinfo)) - (string-to-int - (cdr (assoc "feedid" listinfo))))) - feedinfo))) - (cdr (assoc - (completing-read - "Multiple feeds found. Select one: " - selection nil t) urllist))) - (cdar urllist)))))) - (error (message "XML-RPC is not available... not checking Syndic8.")))) + (if (not (locate-library "xml-rpc")) + (message "XML-RPC is not available... not checking Syndic8.") + (require 'xml-rpc) + (let ((feedid (xml-rpc-method-call + "http://www.syndic8.com/xmlrpc.php" + 'syndic8.FindSites + url))) + (when feedid + (let* ((feedinfo (xml-rpc-method-call + "http://www.syndic8.com/xmlrpc.php" + 'syndic8.GetFeedInfo + feedid)) + (urllist + (delq nil + (mapcar + (lambda (listinfo) + (if (string-equal + (cdr (assoc "status" listinfo)) + "Syndicated") + (cons + (cdr (assoc "sitename" listinfo)) + (list + (cons 'title + (cdr (assoc + "sitename" listinfo))) + (cons 'href + (cdr (assoc + "dataurl" listinfo))))))) + feedinfo)))) + (if (not (> (length urllist) 1)) + (cdar urllist) + (let ((completion-ignore-case t) + (selection + (mapcar (lambda (listinfo) + (cons (cdr (assoc "sitename" listinfo)) + (string-to-int + (cdr (assoc "feedid" listinfo))))) + feedinfo))) + (cdr (assoc + (completing-read + "Multiple feeds found. Select one: " + selection nil t) urllist))))))))) (defun nnrss-rss-p (data) "Test if data is an RSS feed. Simply ensures that the first diff --git a/lisp/nntp.el b/lisp/nntp.el index c45d6c4..c1228e5 100644 --- a/lisp/nntp.el +++ b/lisp/nntp.el @@ -1143,6 +1143,10 @@ password contained in '~/.nntp-authinfo'." (defun nntp-open-network-stream (buffer) (open-network-stream "nntpd" buffer nntp-address nntp-port-number)) +(autoload 'format-spec "format") +(autoload 'format-spec-make "format") +(autoload 'open-tls-stream "tls") + (defun nntp-open-ssl-stream (buffer) (let* ((process-connection-type nil) (proc (start-process "nntpd" buffer diff --git a/lisp/pgg.el b/lisp/pgg.el index 82a3805..b51bf2c 100644 --- a/lisp/pgg.el +++ b/lisp/pgg.el @@ -78,7 +78,8 @@ ,@body))) (defun pgg-temp-buffer-show-function (buffer) - (let ((window (split-window-vertically))) + (let ((window (or (get-buffer-window buffer 'visible) + (split-window-vertically)))) (set-window-buffer window buffer) (shrink-window-if-larger-than-buffer window))) diff --git a/lisp/pop3.el b/lisp/pop3.el index 2a968b5..b192853 100644 --- a/lisp/pop3.el +++ b/lisp/pop3.el @@ -85,8 +85,8 @@ Used for APOP authentication.") (setq message-count (car (pop3-stat process))) (unwind-protect (while (<= n message-count) - (message (format "Retrieving message %d of %d from %s..." - n message-count pop3-mailhost)) + (message "Retrieving message %d of %d from %s..." + n message-count pop3-mailhost) (pop3-retr process n crashbuf) (save-excursion (set-buffer crashbuf) @@ -348,6 +348,7 @@ This function currently does nothing.") (save-excursion (set-buffer (process-buffer process)) (while (not (re-search-forward "^\\.\r\n" nil t)) + ;; Fixme: Shouldn't depend on nnheader. (nnheader-accept-process-output process) ;; bill@att.com ... to save wear and tear on the heap ;; uncommented because the condensed version below is a problem for diff --git a/lisp/rfc2047.el b/lisp/rfc2047.el index df1fc9b..1c14bef 100644 --- a/lisp/rfc2047.el +++ b/lisp/rfc2047.el @@ -1,5 +1,5 @@ -;;; rfc2047.el --- Functions for encoding and decoding rfc2047 messages -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc. +;;; rfc2047.el --- functions for encoding and decoding rfc2047 messages +;; Copyright (C) 1998, 1999, 2000, 2002, 2003 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko @@ -29,23 +29,50 @@ (eval-when-compile (require 'cl) - (defvar message-posting-charset)) + (defvar message-posting-charset) + (unless (fboundp 'with-syntax-table) ; not in Emacs 20 + (defmacro with-syntax-table (table &rest body) + "Evaluate BODY with syntax table of current buffer set to TABLE. +The syntax table of the current buffer is saved, BODY is evaluated, and the +saved table is restored, even in case of an abnormal exit. +Value is what BODY returns." + (let ((old-table (make-symbol "table")) + (old-buffer (make-symbol "buffer"))) + `(let ((,old-table (syntax-table)) + (,old-buffer (current-buffer))) + (unwind-protect + (progn + (set-syntax-table ,table) + ,@body) + (save-current-buffer + (set-buffer ,old-buffer) + (set-syntax-table ,old-table)))))))) (require 'qp) (require 'mm-util) -(require 'ietf-drums) +;; Fixme: Avoid this (used for mail-parse-charset) mm dependence on gnus. (require 'mail-prsvr) (require 'base64) -;; Fixme: Avoid this (for gnus-point-at-...) mm dependence on gnus. -(require 'gnus-util) (autoload 'mm-body-7-or-8 "mm-bodies") +(eval-and-compile + ;; Avoid gnus-util for mm- code. + (defalias 'rfc2047-point-at-bol + (if (fboundp 'point-at-bol) + 'point-at-bol + 'line-beginning-position)) + + (defalias 'rfc2047-point-at-eol + (if (fboundp 'point-at-eol) + 'point-at-eol + 'line-end-position))) + (defvar rfc2047-header-encoding-alist '(("Newsgroups" . nil) ("Followup-To" . nil) ("Message-ID" . nil) ("\\(Resent-\\)?\\(From\\|Cc\\|To\\|Bcc\\|Reply-To\\|Sender\\)" . - "-A-Za-z0-9!*+/=_") + address-mime) (t . mime)) "*Header/encoding method alist. The list is traversed sequentially. The keys can either be @@ -55,10 +82,11 @@ The values can be: 1) nil, in which case no encoding is done; 2) `mime', in which case the header will be encoded according to RFC2047; -3) a charset, in which case it will be encoded as that charset; -4) `default', in which case the field will be encoded as the rest - of the article. -5) a string, like `mime', expect for using it as word-chars.") +3) `address-mime', like `mime', but takes account of the rules for address + fields (where quoted strings and comments must be treated separately); +4) a charset, in which case it will be encoded as that charset; +5) `default', in which case the field will be encoded as the rest + of the article.") (defvar rfc2047-charset-encoding-alist '((us-ascii . nil) @@ -128,6 +156,12 @@ quoted-printable and base64 respectively.") (re-search-forward ":[ \t\n]*" nil t) (buffer-substring (point) (point-max))))) +(defvar rfc2047-encoding-type 'address-mime + "The type of encoding done by `rfc2047-encode-region'. +This should be dynamically bound around calls to +`rfc2047-encode-region' to either `mime' or `address-mime'. See +`rfc2047-header-encoding-alist', for definitions.") + (defun rfc2047-encode-message-header () "Encode the message header according to `rfc2047-header-encoding-alist'. Should be called narrowed to the head of the message." @@ -145,11 +179,10 @@ Should be called narrowed to the head of the message." (mm-coding-system-p (car message-posting-charset))) ;; 8 bit must be decoded. - ;; Is message-posting-charset a coding system? (mm-encode-coding-region (point-min) (point-max) - (car message-posting-charset)) - nil) + (mm-charset-to-coding-system + (car message-posting-charset)))) ;; No encoding necessary, but folding is nice (rfc2047-fold-region (save-excursion @@ -168,46 +201,46 @@ Should be called narrowed to the head of the message." (eq (car elem) t)) (setq alist nil method (cdr elem)))) + (goto-char (point-min)) + (re-search-forward "^[^:]+: *" nil t) (cond - ((stringp method) - (rfc2047-encode-region (point-min) (point-max) method)) + ((eq method 'address-mime) + (rfc2047-encode-region (point) (point-max))) ((eq method 'mime) - (rfc2047-encode-region (point-min) (point-max))) + (let (rfc2047-encoding-type) + (rfc2047-encode-region (point) (point-max)))) ((eq method 'default) (if (and (featurep 'mule) (if (boundp 'default-enable-multibyte-characters) default-enable-multibyte-characters) mail-parse-charset) - (mm-encode-coding-region (point-min) (point-max) + (mm-encode-coding-region (point) (point-max) mail-parse-charset))) ;; We get this when CC'ing messsages to newsgroups with - ;; 8-bit names. The group name mail copy just get + ;; 8-bit names. The group name mail copy just got ;; unconditionally encoded. Previously, it would ask ;; whether to encode, which was quite confusing for the ;; user. If the new behaviour is wrong, tell me. I have ;; left the old code commented out below. ;; -- Per Abrahamsen Date: 2001-10-07. + ;; Modified by Dave Love, with the commented-out code changed + ;; in accordance with changes elsewhere. ((null method) - (when (delq 'ascii - (mm-find-charset-region (point-min) (point-max))) - (rfc2047-encode-region (point-min) (point-max)))) -;;; ((null method) -;;; (and (delq 'ascii -;;; (mm-find-charset-region (point-min) -;;; (point-max))) -;;; (if (or (message-options-get -;;; 'rfc2047-encode-message-header-encode-any) -;;; (message-options-set -;;; 'rfc2047-encode-message-header-encode-any -;;; (y-or-n-p -;;; "Some texts are not encoded. Encode anyway?"))) -;;; (rfc2047-encode-region (point-min) (point-max)) -;;; (error "Cannot send unencoded text")))) + (rfc2047-encode-region (point) (point-max))) +;;; ((null method) +;;; (if (or (message-options-get +;;; 'rfc2047-encode-message-header-encode-any) +;;; (message-options-set +;;; 'rfc2047-encode-message-header-encode-any +;;; (y-or-n-p +;;; "Some texts are not encoded. Encode anyway?"))) +;;; (rfc2047-encode-region (point-min) (point-max)) +;;; (error "Cannot send unencoded text"))) ((mm-coding-system-p method) (if (and (featurep 'mule) (if (boundp 'default-enable-multibyte-characters) default-enable-multibyte-characters)) - (mm-encode-coding-region (point-min) (point-max) method))) + (mm-encode-coding-region (point) (point-max) method))) ;; Hm. (t))) (goto-char (point-max))))))) @@ -221,137 +254,192 @@ Should be called narrowed to the head of the message." The buffer may be narrowed." (require 'message) ; for message-posting-charset (let ((charsets - (mapcar - 'mm-mime-charset - (mm-find-charset-region (point-min) (point-max)))) - (cs (list 'us-ascii (car message-posting-charset))) - found) - (while charsets - (unless (memq (pop charsets) cs) - (setq found t))) - found)) - -(defun rfc2047-dissect-region (b e &optional word-chars) - "Dissect the region between B and E into words." - (unless word-chars - ;; Anything except most CTLs, WSP - (setq word-chars "\010\012\014\041-\177")) - (let (mail-parse-mule-charset - words point current - result word) - (save-restriction - (narrow-to-region b e) - (goto-char (point-min)) - (skip-chars-forward "\000-\177") - (while (not (eobp)) - (setq point (point)) - (skip-chars-backward word-chars b) - (unless (eq b (point)) - (push (cons (buffer-substring b (point)) nil) words)) - (setq b (point)) - (goto-char point) - (setq current (mm-charset-after)) - (forward-char 1) - (skip-chars-forward word-chars) - (while (and (not (eobp)) - (eq (mm-charset-after) current)) - (forward-char 1) - (skip-chars-forward word-chars)) - (unless (eq b (point)) - (push (cons (buffer-substring b (point)) current) words)) - (setq b (point)) - (skip-chars-forward "\000-\177")) - (unless (eq b (point)) - (push (cons (buffer-substring b (point)) nil) words))) - ;; merge adjacent words - (setq word (pop words)) - (while word - (if (and (cdr word) - (caar words) - (not (cdar words)) - (not (string-match "[^ \t]" (caar words)))) - (if (eq (cdr (nth 1 words)) (cdr word)) - (progn - (setq word (cons (concat - (car (nth 1 words)) (caar words) - (car word)) - (cdr word))) - (pop words) - (pop words)) - (push (cons (concat (caar words) (car word)) (cdr word)) - result) - (pop words) - (setq word (pop words))) - (push word result) - (setq word (pop words)))) - result)) - -(defun rfc2047-encode-region (b e &optional word-chars) - "Encode all encodable words in region B to E." - (let ((words (rfc2047-dissect-region b e word-chars)) word) - (save-restriction - (narrow-to-region b e) - (delete-region (point-min) (point-max)) - (while (setq word (pop words)) - (if (not (cdr word)) - (insert (car word)) - (rfc2047-fold-region (gnus-point-at-bol) (point)) - (goto-char (point-max)) - (if (> (- (point) (save-restriction - (widen) - (gnus-point-at-bol))) 76) - (insert "\n ")) - ;; Insert blank between encoded words - (if (eq (char-before) ?=) (insert " ")) - (rfc2047-encode (point) - (progn (insert (car word)) (point)) - (cdr word)))) - (rfc2047-fold-region (point-min) (point-max))))) - -(defun rfc2047-encode-string (string &optional word-chars) - "Encode words in STRING." + (mm-find-mime-charset-region (point-min) (point-max)))) + (and charsets + (not (equal charsets (list (car message-posting-charset))))))) + +;; Use this syntax table when parsing into regions that may need +;; encoding. Double quotes are string delimiters, backslash is +;; character quoting, and all other RFC 2822 special characters are +;; treated as punctuation so we can use forward-sexp/forward-word to +;; skip to the end of regions appropriately. Nb. ietf-drums does +;; things differently. +(defconst rfc2047-syntax-table + ;; (make-char-table 'syntax-table '(2)) only works in Emacs. + (let ((table (make-syntax-table))) + ;; The following is done to work for setting all elements of the table + ;; in Emacs 21 and 22 and XEmacs; it appears to be the cleanest way. + ;; Play safe and don't assume the form of the word syntax entry -- + ;; copy it from ?a. + (if (fboundp 'set-char-table-range) ; Emacs + (funcall (intern "set-char-table-range") + table t (aref (standard-syntax-table) ?a)) + (if (fboundp 'put-char-table) + (if (fboundp 'get-char-table) ; warning avoidance + (put-char-table t (get-char-table ?a (standard-syntax-table)) + table)))) + (modify-syntax-entry ?\\ "\\" table) + (modify-syntax-entry ?\" "\"" table) + (modify-syntax-entry ?\( "." table) + (modify-syntax-entry ?\) "." table) + (modify-syntax-entry ?\< "." table) + (modify-syntax-entry ?\> "." table) + (modify-syntax-entry ?\[ "." table) + (modify-syntax-entry ?\] "." table) + (modify-syntax-entry ?: "." table) + (modify-syntax-entry ?\; "." table) + (modify-syntax-entry ?, "." table) + (modify-syntax-entry ?@ "." table) + table)) + +(defun rfc2047-encode-region (b e) + "Encode words in region B to E that need encoding. +By default, the region is treated as containing RFC2822 addresses. +Dynamically bind `rfc2047-encoding-type' to change that." + (save-restriction + (narrow-to-region b e) + (if (eq 'mime rfc2047-encoding-type) + ;; Simple case -- treat as single word. + (progn + (goto-char (point-min)) + ;; Does it need encoding? + (skip-chars-forward "\000-\177" e) + (unless (eobp) + (rfc2047-encode b e))) + ;; `address-mime' case -- take care of quoted words, comments. + (with-syntax-table rfc2047-syntax-table + (let ((start) ; start of current token + end ; end of current token + ;; Whether there's an encoded word before the current + ;; token, either immediately or separated by space. + last-encoded) + (goto-char (point-min)) + (condition-case nil ; in case of unbalanced quotes + ;; Look for rfc2822-style: sequences of atoms, quoted + ;; strings, specials, whitespace. (Specials mustn't be + ;; encoded.) + (while (not (eobp)) + (setq start (point)) + ;; Skip whitespace. + (unless (= 0 (skip-chars-forward " \t\n")) + (setq start (point))) + (cond + ((not (char-after))) ; eob + ;; else token start + ((eq ?\" (char-syntax (char-after))) + ;; Quoted word. + (forward-sexp) + (setq end (point)) + ;; Does it need encoding? + (goto-char start) + (skip-chars-forward "\000-\177" end) + (if (= end (point)) + (setq last-encoded nil) + ;; It needs encoding. Strip the quotes first, + ;; since encoded words can't occur in quotes. + (goto-char end) + (delete-backward-char 1) + (goto-char start) + (delete-char 1) + (when last-encoded + ;; There was a preceding quoted word. We need + ;; to include any separating whitespace in this + ;; word to avoid it getting lost. + (skip-chars-backward " \t") + ;; A space is needed between the encoded words. + (insert ? ) + (setq start (point) + end (1+ end))) + ;; Adjust the end position for the deleted quotes. + (rfc2047-encode start (- end 2)) + (setq last-encoded t))) ; record that it was encoded + ((eq ?. (char-syntax (char-after))) + ;; Skip other delimiters, but record that they've + ;; potentially separated quoted words. + (forward-char) + (setq last-encoded nil)) + (t ; normal token/whitespace sequence + ;; Find the end. + (forward-word 1) + (skip-chars-backward " \t") + (setq end (point)) + ;; Deal with encoding and leading space as for + ;; quoted words. + (goto-char start) + (skip-chars-forward "\000-\177" end) + (if (= end (point)) + (setq last-encoded nil) + (when last-encoded + (goto-char start) + (skip-chars-backward " \t") + (insert ? ) + (setq start (point) + end (1+ end))) + (rfc2047-encode start end) + (setq last-encoded t))))) + (error (error "Invalid data for rfc2047 encoding: %s" + (buffer-substring b e))))))) + (rfc2047-fold-region b (point)))) + +(defun rfc2047-encode-string (string) + "Encode words in STRING. +By default, the string is treated as containing addresses (see +`rfc2047-special-chars')." (with-temp-buffer (insert string) - (rfc2047-encode-region (point-min) (point-max) word-chars) + (rfc2047-encode-region (point-min) (point-max)) (buffer-string))) -(defun rfc2047-encode (b e charset) - "Encode the word in the region B to E with CHARSET." - (let* ((mime-charset (mm-mime-charset charset)) - (cs (mm-charset-to-coding-system mime-charset)) - (encoding (or (cdr (assq mime-charset +(defun rfc2047-encode (b e) + "Encode the word(s) in the region B to E. +By default, the region is treated as containing addresses (see +`rfc2047-special-chars')." + (let* ((mime-charset (mm-find-mime-charset-region b e)) + (cs (if (> (length mime-charset) 1) + ;; Fixme: Instead of this, try to break region into + ;; parts that can be encoded separately. + (error "Can't rfc2047-encode `%s'" + (buffer-substring b e)) + (setq mime-charset (car mime-charset)) + (mm-charset-to-coding-system mime-charset))) + ;; Fixme: Better, calculate the number of non-ASCII + ;; characters, at least for 8-bit charsets. + (encoding (if (assq mime-charset + rfc2047-charset-encoding-alist) + (cdr (assq mime-charset rfc2047-charset-encoding-alist)) - 'B)) + 'B)) (start (concat "=?" (downcase (symbol-name mime-charset)) "?" (downcase (symbol-name encoding)) "?")) (first t)) - (save-restriction - (narrow-to-region b e) - (when (eq encoding 'B) - ;; break into lines before encoding - (goto-char (point-min)) - (while (not (eobp)) - (goto-char (min (point-max) (+ 15 (point)))) - (unless (eobp) - (insert "\n")))) - (if (and (mm-multibyte-p) - (mm-coding-system-p cs)) - (mm-encode-coding-region (point-min) (point-max) cs)) - (funcall (cdr (assq encoding rfc2047-encoding-function-alist)) - (point-min) (point-max)) - (goto-char (point-min)) - (while (not (eobp)) - (unless first - (insert " ")) - (setq first nil) - (insert start) - (end-of-line) - (insert "?=") - (forward-line 1))))) + (if mime-charset + (save-restriction + (narrow-to-region b e) + (when (eq encoding 'B) + ;; break into lines before encoding + (goto-char (point-min)) + (while (not (eobp)) + (goto-char (min (point-max) (+ 15 (point)))) + (unless (eobp) + (insert ?\n)))) + (if (and (mm-multibyte-p) + (mm-coding-system-p cs)) + (mm-encode-coding-region (point-min) (point-max) cs)) + (funcall (cdr (assq encoding rfc2047-encoding-function-alist)) + (point-min) (point-max)) + (goto-char (point-min)) + (while (not (eobp)) + (unless first + (insert ? )) + (setq first nil) + (insert start) + (end-of-line) + (insert "?=") + (forward-line 1)))))) (defun rfc2047-fold-field () - "Fold the current line." + "Fold the current header field." (save-excursion (save-restriction (rfc2047-narrow-to-field) @@ -367,7 +455,7 @@ The buffer may be narrowed." (first t) (bol (save-restriction (widen) - (gnus-point-at-bol)))) + (rfc2047-point-at-bol)))) (while (not (eobp)) (when (and (or break qword-break) (> (- (point) bol) 76)) @@ -375,7 +463,7 @@ The buffer may be narrowed." (setq break nil qword-break nil) (if (looking-at "[ \t]") - (insert "\n") + (insert ?\n) (insert "\n ")) (setq bol (1- (point))) ;; Don't break before the first non-LWSP characters. @@ -414,7 +502,7 @@ The buffer may be narrowed." (setq break nil qword-break nil) (if (looking-at "[ \t]") - (insert "\n") + (insert ?\n) (insert "\n ")) (setq bol (1- (point))) ;; Don't break before the first non-LWSP characters. @@ -436,18 +524,18 @@ The buffer may be narrowed." (goto-char (point-min)) (let ((bol (save-restriction (widen) - (gnus-point-at-bol))) - (eol (gnus-point-at-eol))) + (rfc2047-point-at-bol))) + (eol (rfc2047-point-at-eol))) (forward-line 1) (while (not (eobp)) (if (and (looking-at "[ \t]") - (< (- (gnus-point-at-eol) bol) 76)) + (< (- (rfc2047-point-at-eol) bol) 76)) (delete-region eol (progn (goto-char eol) (skip-chars-forward "\r\n") (point))) - (setq bol (gnus-point-at-bol))) - (setq eol (gnus-point-at-eol)) + (setq bol (rfc2047-point-at-bol))) + (setq eol (rfc2047-point-at-eol)) (forward-line 1))))) (defun rfc2047-b-encode-region (b e) @@ -468,12 +556,10 @@ The buffer may be narrowed." (let ((alist rfc2047-q-encoding-alist) (bol (save-restriction (widen) - (gnus-point-at-bol)))) + (rfc2047-point-at-bol)))) (while alist (when (looking-at (caar alist)) - (mm-with-unibyte-current-buffer-mule4 - (quoted-printable-encode-region - (point-min) (point-max) nil (cdar alist))) + (quoted-printable-encode-region b e nil (cdar alist)) (subst-char-in-region (point-min) (point-max) ? ?_) (setq alist nil)) (pop alist)) @@ -487,15 +573,21 @@ The buffer may be narrowed." (goto-char (min (point-max) (+ 56 bol))) (search-backward "=" (- (point) 2) t) (unless (or (bobp) (eobp)) - (insert "\n") + (insert ?\n) (setq bol (point))))))))) ;;; ;;; Functions for decoding RFC2047 messages ;;; -(defvar rfc2047-encoded-word-regexp - "=\\?\\([^][\000-\040()<>@,\;:\\\"/?.=]+\\)\\?\\(B\\|Q\\)\\?\\([!->@-~ +]*\\)\\?=") +(eval-and-compile + (defconst rfc2047-encoded-word-regexp + "=\\?\\([^][\000-\040()<>@,\;:\\\"/?.=]+\\)\\?\\(B\\|Q\\)\ +\\?\\([!->@-~ +]*\\)\\?=")) + +;; Fixme: This should decode in place, not cons intermediate strings. +;; Also check whether it needs to worry about delimiting fields like +;; encoding. (defun rfc2047-decode-region (start end) "Decode MIME-encoded words in region between START and END." @@ -508,9 +600,10 @@ The buffer may be narrowed." (goto-char (point-min)) ;; Remove whitespace between encoded words. (while (re-search-forward - (concat "\\(" rfc2047-encoded-word-regexp "\\)" - "\\(\n?[ \t]\\)+" - "\\(" rfc2047-encoded-word-regexp "\\)") + (eval-when-compile + (concat "\\(" rfc2047-encoded-word-regexp "\\)" + "\\(\n?[ \t]\\)+" + "\\(" rfc2047-encoded-word-regexp "\\)")) nil t) (delete-region (goto-char (match-end 1)) (match-beginning 6))) ;; Decode the encoded words. @@ -521,8 +614,8 @@ The buffer may be narrowed." (prog1 (match-string 0) (delete-region (match-beginning 0) (match-end 0))))) - ;; Remove newlines between decoded words. Though such things - ;; must not be essentially there. + ;; Remove newlines between decoded words, though such things + ;; essentially must not be there. (save-restriction (narrow-to-region e (point)) (goto-char e) @@ -539,34 +632,37 @@ The buffer may be narrowed." mail-parse-charset (not (eq mail-parse-charset 'us-ascii)) (not (eq mail-parse-charset 'gnus-decoded))) - (mm-decode-coding-region-safely b (point-max) mail-parse-charset)))))) + (mm-decode-coding-region b (point-max) mail-parse-charset)))))) (defun rfc2047-decode-string (string) "Decode the quoted-printable-encoded STRING and return the results." (let ((m (mm-multibyte-p))) (if (string-match "=\\?" string) (with-temp-buffer + ;; Fixme: This logic is wrong, but seems to be required by + ;; Gnus summary buffer generation. The value of `m' depends + ;; on the current buffer, not global multibyteness or that + ;; of the string. Also the string returned should always be + ;; multibyte in a multibyte session, i.e. the buffer should + ;; be multibyte before `buffer-string' is called. (when m (mm-enable-multibyte)) (insert string) (inline (rfc2047-decode-region (point-min) (point-max))) (buffer-string)) + ;; Fixme: As above, `m' here is inappropriate. (if (and m mail-parse-charset (not (eq mail-parse-charset 'us-ascii)) (not (eq mail-parse-charset 'gnus-decoded))) - (let* ((decoded (mm-decode-coding-string string mail-parse-charset)) - (charsets (find-charset-string decoded))) - (if (or (memq 'eight-bit-control charsets) - (memq 'eight-bit-graphic charsets)) - (mm-decode-coding-string string 'undecided) - decoded)) - string)))) + (mm-decode-coding-string string mail-parse-charset) + (mm-string-as-multibyte string))))) (defun rfc2047-parse-and-decode (word) "Decode WORD and return it if it is an encoded word. -Return WORD if not." +Return WORD if it is not not an encoded word or if the charset isn't +decodable." (if (not (string-match rfc2047-encoded-word-regexp word)) word (or @@ -576,7 +672,7 @@ Return WORD if not." (upcase (match-string 2 word)) (match-string 3 word)) (error word)) - word))) + word))) ; un-decodable (defun rfc2047-pad-base64 (string) "Pad STRING to quartets." @@ -609,7 +705,8 @@ If your Emacs implementation can't decode CHARSET, return nil." (when (and (eq cs 'ascii) mail-parse-charset) (setq cs mail-parse-charset)) - (mm-with-unibyte-current-buffer-mule4 + ;; Fixme: What's this for? The following comment makes no sense. -- fx + (mm-with-unibyte-current-buffer ;; In Emacs Mule 4, decoding UTF-8 should be in unibyte mode. (mm-decode-coding-string (cond diff --git a/lisp/rfc2231.el b/lisp/rfc2231.el index 9240163..7f3a014 100644 --- a/lisp/rfc2231.el +++ b/lisp/rfc2231.el @@ -27,6 +27,9 @@ (eval-when-compile (require 'cl)) (require 'ietf-drums) (require 'rfc2047) +(autoload 'mm-encode-body "mm-bodies") +(autoload 'mail-header-remove-whitespace "mail-parse") +(autoload 'mail-header-remove-comments "mail-parse") (defun rfc2231-get-value (ct attribute) "Return the value of ATTRIBUTE from CT." @@ -53,6 +56,7 @@ The list will be on the form (mail-header-remove-comments string))) (let ((table (copy-syntax-table ietf-drums-syntax-table))) (modify-syntax-entry ?\' "w" table) + (modify-syntax-entry ?= " " table) ;; The following isn't valid, but one should be liberal ;; in what one receives. (modify-syntax-entry ?\: "w" table) diff --git a/lisp/sieve-manage.el b/lisp/sieve-manage.el index 8897dd1..bda44dc 100644 --- a/lisp/sieve-manage.el +++ b/lisp/sieve-manage.el @@ -74,7 +74,8 @@ (or (fboundp 'md5) (require 'md5)) (eval-and-compile - (autoload 'starttls-open-stream "starttls")) + (autoload 'starttls-open-stream "starttls") + (autoload 'starttls-negotiate "starttls")) ;; User customizable variables: diff --git a/lisp/sieve.el b/lisp/sieve.el index 8297f57..83dd4f3 100644 --- a/lisp/sieve.el +++ b/lisp/sieve.el @@ -131,6 +131,13 @@ require \"fileinto\"; (define-key sieve-manage-mode-map [(down-mouse-2)] 'sieve-edit-script) (define-key sieve-manage-mode-map [(down-mouse-3)] 'sieve-manage-mode-menu)) +(easy-menu-define sieve-manage-mode-menu sieve-manage-mode-map + "Sieve Menu." + '("Manage Sieve" + ["Edit script" sieve-edit-script t] + ["Activate script" sieve-activate t] + ["Deactivate script" sieve-deactivate t])) + (define-derived-mode sieve-manage-mode fundamental-mode "SIEVE" "Mode used for sieve script management." (setq mode-name "SIEVE") @@ -140,13 +147,6 @@ require \"fileinto\"; (put 'sieve-manage-mode 'mode-class 'special) -(easy-menu-define sieve-manage-mode-menu sieve-manage-mode-map - "Sieve Menu." - '("Manage Sieve" - ["Edit script" sieve-edit-script t] - ["Activate script" sieve-activate t] - ["Deactivate script" sieve-deactivate t])) - ;; This is necessary to allow correct handling of \\[cvs-mode-diff-map] ;; in substitute-command-keys. ;(fset 'sieve-manage-mode-map sieve-manage-mode-map) diff --git a/lisp/smime.el b/lisp/smime.el index 0df851f..7dc6b52 100644 --- a/lisp/smime.el +++ b/lisp/smime.el @@ -194,6 +194,7 @@ If nil, use system defaults." (defvar smime-details-buffer "*OpenSSL output*") +;; Use mm-util? (eval-and-compile (defalias 'smime-make-temp-file (if (fboundp 'make-temp-file) @@ -489,6 +490,7 @@ A string or a list of strings is returned." (caddr curkey) (smime-get-certfiles keyfile otherkeys))))) +;; Use mm-util? (eval-and-compile (defalias 'smime-point-at-eol (if (fboundp 'point-at-eol) diff --git a/lisp/spam-report.el b/lisp/spam-report.el index 46884c4..0d4c3e2 100644 --- a/lisp/spam-report.el +++ b/lisp/spam-report.el @@ -35,8 +35,10 @@ "Spam reporting configuration.") (defcustom spam-report-gmane-regex nil - "String matching Gmane newsgroups if wanted, e.g. \"^nntp+.*:gmane.\" -This is probably handled better with group/topic parameters." + "Regexp matching Gmane newsgroups, e.g. \"^nntp\\+.*:gmane\\.\" +If you are using spam.el, consider setting gnus-spam-process-newsgroups +or the gnus-group-spam-exit-processor-report-gmane group/topic parameter +instead." :type 'regexp :group 'spam-report) diff --git a/lisp/spam.el b/lisp/spam.el index 4a8fccb..5518eb1 100644 --- a/lisp/spam.el +++ b/lisp/spam.el @@ -144,7 +144,7 @@ are considered spam." (defcustom spam-use-regex-headers nil "Whether a header regular expression match should be used by spam-split. -Also see the variable `spam-spam-regex-headers' and `spam-ham-regex-headers'." +Also see the variables `spam-regex-headers-spam' and `spam-regex-headers-ham'." :type 'boolean :group 'spam) diff --git a/lisp/utf7.el b/lisp/utf7.el index 2a5e752..70186b0 100644 --- a/lisp/utf7.el +++ b/lisp/utf7.el @@ -1,7 +1,8 @@ -;;; utf7.el --- UTF-7 encoding/decoding for Emacs -;; Copyright (C) 1999, 2000 Free Software Foundation, Inc. +;;; utf7.el --- UTF-7 encoding/decoding for Emacs -*-coding: iso-8859-1;-*- +;; Copyright (C) 1999, 2000, 2003 Free Software Foundation, Inc. ;; Author: Jon K Hellan +;; Maintainer: bugs@gnus.org ;; Keywords: mail ;; This file is part of GNU Emacs. @@ -22,37 +23,69 @@ ;; Boston, MA 02111-1307, USA. ;;; Commentary: -;;; UTF-7 - A Mail-Safe Transformation Format of Unicode - RFC 2152 -;;; This is a transformation format of Unicode that contains only 7-bit -;;; ASCII octets and is intended to be readable by humans in the limiting -;;; case that the document consists of characters from the US-ASCII -;;; repertoire. -;;; In short, runs of characters outside US-ASCII are encoded as base64 -;;; inside delimiters. -;;; A variation of UTF-7 is specified in IMAP 4rev1 (RFC 2060) as the way -;;; to represent characters outside US-ASCII in mailbox names in IMAP. -;;; This library supports both variants, but the IMAP variation was the -;;; reason I wrote it. -;;; The routines convert UTF-7 -> UTF-16 (16 bit encoding of Unicode) -;;; -> current character set, and vice versa. -;;; However, until Emacs supports Unicode, the only Emacs character set -;;; supported here is ISO-8859.1, which can trivially be converted to/from -;;; Unicode. -;;; When decoding results in a character outside the Emacs character set, -;;; an error is thrown. It is up to the application to recover. + +;; UTF-7 - A Mail-Safe Transformation Format of Unicode - RFC 2152 +;; This is a transformation format of Unicode that contains only 7-bit +;; ASCII octets and is intended to be readable by humans in the limiting +;; case that the document consists of characters from the US-ASCII +;; repertoire. +;; In short, runs of characters outside US-ASCII are encoded as base64 +;; inside delimiters. +;; A variation of UTF-7 is specified in IMAP 4rev1 (RFC 2060) as the way +;; to represent characters outside US-ASCII in mailbox names in IMAP. +;; This library supports both variants, but the IMAP variation was the +;; reason I wrote it. +;; The routines convert UTF-7 -> UTF-16 (16 bit encoding of Unicode) +;; -> current character set, and vice versa. +;; However, until Emacs supports Unicode, the only Emacs character set +;; supported here is ISO-8859.1, which can trivially be converted to/from +;; Unicode. +;; When decoding results in a character outside the Emacs character set, +;; an error is thrown. It is up to the application to recover. + +;; UTF-7 should be done by providing a coding system. Mule-UCS does +;; already, but I don't know if it does the IMAP version and it's not +;; clear whether that should really be a coding system. The UTF-16 +;; part of the conversion can be done with coding systems available +;; with Mule-UCS or some versions of Emacs. Unfortunately these were +;; done wrongly (regarding handling of byte-order marks and how the +;; variants were named), so we don't have a consistent name for the +;; necessary coding system. The code below doesn't seem to DTRT +;; generally. E.g.: +;; +;; (utf7-encode "a+£") +;; => "a+ACsAow-" +;; +;; $ echo "a+£"|iconv -f iso-8859-1 -t utf-7 +;; a+-+AKM +;; +;; -- fx + ;;; Code: (require 'base64) (eval-when-compile (require 'cl)) +(require 'mm-util) -(defvar utf7-direct-encoding-chars " -%'-*,-[]-}" +(defconst utf7-direct-encoding-chars " -%'-*,-[]-}" "Character ranges which do not need escaping in UTF-7.") -(defvar utf7-imap-direct-encoding-chars +(defconst utf7-imap-direct-encoding-chars (concat utf7-direct-encoding-chars "+\\~") "Character ranges which do not need escaping in the IMAP variant of UTF-7.") +(defconst utf7-utf-16-coding-system + (cond ((mm-coding-system-p 'utf-16-be-no-signature) ; Mule-UCS + 'utf-16-be-no-signature) + ((and (mm-coding-system-p 'utf-16-be) ; Emacs 21.4 (?), Emacs 22 + ;; Avoid versions with BOM. + (= 2 (length (encode-coding-string "a" 'utf-16-be)))) + 'utf-16-be) + ((mm-coding-system-p 'utf-16-be-nosig) ; ? + 'utf-16-be-nosig)) + "Coding system which encodes big endian UTF-16 without a BOM signature.") + (defsubst utf7-imap-get-pad-length (len modulus) "Return required length of padding for IMAP modified base64 fragment." (mod (- len) modulus)) @@ -64,10 +97,11 @@ Use IMAP modification if FOR-IMAP is non-nil." (end (point-max))) (narrow-to-region start end) (goto-char start) - (let ((esc-char (if for-imap ?& ?+)) - (direct-encoding-chars - (if for-imap utf7-imap-direct-encoding-chars - utf7-direct-encoding-chars))) + (let* ((esc-char (if for-imap ?& ?+)) + (direct-encoding-chars + (if for-imap utf7-imap-direct-encoding-chars + utf7-direct-encoding-chars)) + (not-direct-encoding-chars (concat "^" direct-encoding-chars))) (while (not (eobp)) (skip-chars-forward direct-encoding-chars) (unless (eobp) @@ -75,7 +109,7 @@ Use IMAP modification if FOR-IMAP is non-nil." (let ((p (point)) (fc (following-char)) (run-length - (skip-chars-forward (concat "^" direct-encoding-chars)))) + (skip-chars-forward not-direct-encoding-chars))) (if (and (= fc esc-char) (= run-length 1)) ; Lone esc-char? (delete-backward-char 1) ; Now there's one too many @@ -88,7 +122,8 @@ Use IMAP modification if FOR-IMAP is non-nil." (save-restriction (narrow-to-region start end) (funcall (utf7-get-u16char-converter 'to-utf-16)) - (base64-encode-region start (point-max)) + (mm-with-unibyte-current-buffer + (base64-encode-region start (point-max))) (goto-char start) (let ((pm (point-max))) (when for-imap @@ -135,15 +170,24 @@ Use IMAP modification if FOR-IMAP is non-nil." (defun utf7-get-u16char-converter (which-way) "Return a function to convert between UTF-16 and current character set." - ;; Add test to check if we are really Latin-1. - ;; Support other character sets once Emacs groks Unicode. - (if (eq which-way 'to-utf-16) - 'utf7-latin1-u16-char-converter - 'utf7-u16-latin1-char-converter)) + (if utf7-utf-16-coding-system + (if (eq which-way 'to-utf-16) + (lambda () + (encode-coding-region (point-min) (point-max) + utf7-utf-16-coding-system)) + (lambda () + (decode-coding-region (point-min) (point-max) + utf7-utf-16-coding-system))) + ;; Add test to check if we are really Latin-1. + (if (eq which-way 'to-utf-16) + 'utf7-latin1-u16-char-converter + 'utf7-u16-latin1-char-converter))) (defun utf7-latin1-u16-char-converter () "Convert latin 1 (ISO-8859.1) characters to 16 bit Unicode. Characters are converted to raw byte pairs in narrowed buffer." + (mm-encode-coding-region (point-min) (point-max) 'iso-8859-1) + (mm-disable-multibyte) (goto-char (point-min)) (while (not (eobp)) (insert 0) @@ -157,11 +201,13 @@ Characters are in raw byte pairs in narrowed buffer." (if (= 0 (following-char)) (delete-char 1) (error "Unable to convert from Unicode")) - (forward-char))) + (forward-char)) + (mm-decode-coding-region (point-min) (point-max) 'iso-8859-1) + (mm-enable-multibyte)) (defun utf7-encode (string &optional for-imap) "Encode UTF-7 STRING. Use IMAP modification if FOR-IMAP is non-nil." - (let ((default-enable-multibyte-characters nil)) + (let ((default-enable-multibyte-characters t)) (with-temp-buffer (insert string) (utf7-encode-internal for-imap) @@ -173,6 +219,7 @@ Characters are in raw byte pairs in narrowed buffer." (with-temp-buffer (insert string) (utf7-decode-internal for-imap) + (mm-enable-multibyte) (buffer-string)))) (provide 'utf7) diff --git a/texi/ChangeLog b/texi/ChangeLog index 08041c4..e351903 100644 --- a/texi/ChangeLog +++ b/texi/ChangeLog @@ -1,3 +1,47 @@ +2003-05-13 Lars Magne Ingebrigtsen + + * gnus.texi (Anti-Spam Basics): Removed mention of gnus-junk. + +2003-05-13 Jesper Harder + + * gnus.texi (Agent Variables, Score File Format) + (Troubleshooting, Editing IMAP ACLs, Conformity): a -> an. + + * message.texi (Insertion Variables): do. + +2003-05-13 Simon Josefsson + + * gnus.texi (IMAP, Agent and IMAP, Oort Gnus): s/a/an/. Tiny + patch from Niklas Morberg . + +2003-05-12 Kevin Greiner + + * gnus.texi (Agent Visuals): Add. + +2003-05-09 Simon Josefsson + + * pgg.texi (Default user identity): Add. + +2003-05-08 Jesper Harder + + * gnus.texi (Selecting a Group): Mention nil value + gnus-large-newsgroup. + +2003-05-07 Jesper Harder + + * gnus.texi (MIME Commands): Fix typo. + +2003-05-05 Jesper Harder + + * gnusref.tex: Additions. + + * gnus.texi (Oort Gnus): Fix typo. + +2003-05-03 Kai Gro,A_(Bjohann + + * gnus.texi (Agent Basics): Explain that some servers can be + agentized, whereas others aren't. + 2003-05-01 Reiner Steib * gnus.texi (Oort Gnus): Add prefix limit feature. diff --git a/texi/gnus.texi b/texi/gnus.texi index 9b22c48..7cb87c7 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -33,7 +33,7 @@ \makeindex \begin{document} -\newcommand{\gnusversionname}{Gnus v5.10.1} +\newcommand{\gnusversionname}{Gnus v5.10.2} \newcommand{\gnuschaptername}{} \newcommand{\gnussectionname}{} @@ -389,7 +389,7 @@ can be gotten by any nefarious means you can think of---@acronym{NNTP}, local spool or your mbox file. All at the same time, if you want to push your luck. -This manual corresponds to Gnus v5.10.1. +This manual corresponds to Gnus v5.10.2. @end ifinfo @@ -757,6 +757,7 @@ Gnus Unplugged * Agent Basics:: How it all is supposed to work. * Agent Categories:: How to tell the Gnus Agent what to download. * Agent Commands:: New commands for all the buffers. +* Agent Visuals:: Ways that the agent may effect your summary buffer. * Agent as Cache:: The Agent is a big cache too. * Agent Expiry:: How to make old articles go away. * Agent Regeneration:: How to recover from lost connections and other accidents. @@ -2119,17 +2120,19 @@ manner will have no permanent effects. @end table @vindex gnus-large-newsgroup -The @code{gnus-large-newsgroup} variable says what Gnus should consider -to be a big group. This is 200 by default. If the group has more +The @code{gnus-large-newsgroup} variable says what Gnus should +consider to be a big group. If it is @code{nil}, no groups are +considered big. The default vaule is 200. If the group has more (unread and/or ticked) articles than this, Gnus will query the user -before entering the group. The user can then specify how many articles -should be fetched from the server. If the user specifies a negative -number (@code{-n}), the @code{n} oldest articles will be fetched. If it -is positive, the @code{n} articles that have arrived most recently will -be fetched. +before entering the group. The user can then specify how many +articles should be fetched from the server. If the user specifies a +negative number (@var{-n}), the @var{n} oldest articles will be +fetched. If it is positive, the @var{n} articles that have arrived +most recently will be fetched. @vindex gnus-large-ephemeral-newsgroup -Same as @code{gnus-large-newsgroup}, but only used for ephemeral +@code{gnus-large-ephemeral-newsgroup} is the same as +@code{gnus-large-newsgroup}, but is only used for ephemeral newsgroups. @vindex gnus-select-group-hook @@ -9213,7 +9216,7 @@ To have all Vcards be ignored, you'd say something like this: @item gnus-article-loose-mime @vindex gnus-article-loose-mime -If non-@code{nil}, Gnus won't required the @samp{MIME-Version} header +If non-@code{nil}, Gnus won't require the @samp{MIME-Version} header before interpreting the message as a @acronym{MIME} message. This helps when reading messages from certain broken mail user agents. The default is @code{nil}. @@ -15949,7 +15952,7 @@ Unlike Parmenides the @acronym{IMAP} designers has decided that things that doesn't exist actually does exist. More specifically, @acronym{IMAP} has this concept of marking articles @code{Deleted} which doesn't actually delete them, and this (marking them @code{Deleted}, that is) is what -nnimap does when you delete a article in Gnus (with @kbd{B DEL} or +nnimap does when you delete an article in Gnus (with @kbd{B DEL} or similar). Since the articles aren't really removed when we mark them with the @@ -16261,8 +16264,8 @@ limiting (or enabling) other users access to your mail boxes. Not all @acronym{IMAP} servers support this, this function will give an error if it doesn't. -To edit a ACL for a mailbox, type @kbd{G l} -(@code{gnus-group-edit-nnimap-acl}) and you'll be presented with a ACL +To edit an ACL for a mailbox, type @kbd{G l} +(@code{gnus-group-edit-nnimap-acl}) and you'll be presented with an ACL editing window with detailed instructions. Some possible uses: @@ -17238,6 +17241,7 @@ Of course, to use it as such, you have to learn a few new commands. * Agent Basics:: How it all is supposed to work. * Agent Categories:: How to tell the Gnus Agent what to download. * Agent Commands:: New commands for all the buffers. +* Agent Visuals:: Ways that the agent may effect your summary buffer. * Agent as Cache:: The Agent is a big cache too. * Agent Expiry:: How to make old articles go away. * Agent Regeneration:: How to recover from lost connections and other accidents. @@ -17266,6 +17270,29 @@ connected to the net continuously. @dfn{Downloading} means fetching things from the net to your local machine. @dfn{Uploading} is doing the opposite. +You know that Gnus gives you all the opportunity you'd ever want for +shooting yourself in the foot. Some people call it flexibility. Gnus +is also customizable to a great extent, which means that the user has a +say on how Gnus behaves. Other newsreaders might unconditionally shoot +you in your foot, but with Gnus, you have a choice! + +Gnus is never really in plugged or unplugged state. Rather, it applies +that state to each server individually. This means that some servers +can be plugged while others can be unplugged. Additionally, some +servers can be ignored by the Agent altogether (which means that +they're kinda like plugged always). + +So when you unplug the Agent and then wonder why is Gnus opening a +connection to the Net, the next step to do is to look whether all +servers are agentized. If there is an unagentized server, you found +the culprit. + +Another thing is the @dfn{offline} state. Sometimes, servers aren't +reachable. When Gnus notices this, it asks you whether you want the +server to be switched to offline state. If you say yes, then the +server will behave somewhat as if it was unplugged, except that Gnus +will ask you whether you want to switch it back online again. + Let's take a typical Gnus session using the Agent. @itemize @bullet @@ -17311,7 +17338,7 @@ Agent. Go to the server buffer (@kbd{^} in the group buffer) and press @kbd{J a} on the server (or servers) that you wish to have covered by the Agent (@pxref{Server Agent Commands}), or @kbd{J r} on automatically added servers you do not wish to have covered by the Agent. By default, -all @code{nntp} and @code{nnimap} groups in @code{gnus-select-method} and +all @code{nntp} and @code{nnimap} servers in @code{gnus-select-method} and @code{gnus-secondary-select-methods} are agentized. @item @@ -17954,6 +17981,68 @@ Agent (@code{gnus-agent-remove-server}). @end table +@node Agent Visuals +@subsection Agent Visuals + +If you open a summary while unplugged and, Gnus knows from the group's +active range that there are more articles than the headers currently +stored in the Agent, you may see some articles whose subject looks +something like @samp{[Undownloaded article #####]}. These are +placeholders for the missing headers. Aside from setting a mark, +there is not much that can be done with one of these placeholders. +When Gnus finally gets a chance to fetch the group's headers, the +placeholders will automatically be replaced by the actual headers. +You can configure the summary buffer's maneuvering to skip over the +placeholders if you care (See @code{gnus-auto-goto-ignores}). + +While it may be obvious to all, the only headers and articles +available while unplugged are those headers and articles that were +fetched into the Agent while previously plugged. To put it another +way, "If you forget to fetch something while plugged, you might have a +less than satisfying unplugged session". For this reason, the Agent +adds two visual effects to your summary buffer. These effects display +the download status of each article so that you always know which +articles will be available when unplugged. + +The first visual effect is the @samp{%O} spec. If you customize +gnus-summary-line-format to include this specifier, you will add a +single character field that indicates an article's download status. +Articles that have been fetched into either the Agent or the Cache, +will display @code{gnus-downloaded-mark} (defaults to @samp{+}). All +other articles will display @code{gnus-undownloaded-mark} (defaults to +@samp{-}). If you open a group that has not been agentized, a space +(@samp{ }) will be displayed. + +The second visual effect are the undownloaded faces. The faces, there +are three indicating the article's score (low, normal, high), seem to +result in a love/hate response from many Gnus users. The problem is +that the face selection is controlled by a list of condition tests and +face names (See @code{gnus-summary-highlight}). Each condition is +tested in the order in which it appears in the list so early +conditions have precedence over later conditions. All of this means +that, if you tick an undownloaded article, the article will continue +to be displayed in the undownloaded face rather than the ticked face. + +If you use the Agent as a cache (to avoid downloading the same article +each time you visit it or to minimize your connection time), the +undownloaded face will probably seem like a good idea. The reason +being that you do all of our work (marking, reading, deleting) with +downloaded articles so the normal faces always appear. + +For occasional Agent users, the undownloaded faces may appear to be an +absolutely horrible idea. The issue being that, since most of their +articles have not been fetched into the Agent, most of the normal +faces will be obscured by the undownloaded faces. If this is your +situation, you have two choices available. First, you can completely +disable the undownload faces by customizing +@code{gnus-summary-highlight} to delete the three cons-cells that +refer to the gnus-summary*-undownloaded-face faces. Second, if you +prefer to take a more fine-grained approach, you may set the +@code{agent-disable-undownloaded-faces} group parameter to t. This +parameter, like all other agent parameters, may be set on an Agent +Category (@pxref{Agent Categories}), a Group Topic (@pxref{Topic +Parameters}), or an individual group (@pxref{Group Parameters}). + @node Agent as Cache @subsection Agent as Cache @@ -18094,7 +18183,7 @@ Creating/deleting nnimap groups when unplugged. Technical note: the synchronization algorithm does not work by ``pushing'' all local flags to the server, but rather incrementally update the server view of flags by changing only those flags that were changed by -the user. Thus, if you set one flag on a article, quit the group and +the user. Thus, if you set one flag on an article, quit the group and re-select the group and remove the flag; the flag will be set and removed from the server when you ``synchronize''. The queued flag operations can be found in the per-server @code{flags} file in the Agent @@ -18187,7 +18276,7 @@ see any cycling. @item gnus-server-unopen-status @vindex gnus-server-unopen-status -Perhaps not a Agent variable, but closely related to the Agent, this +Perhaps not an Agent variable, but closely related to the Agent, this variable says what will happen if Gnus cannot open a server. If the Agent is enabled, the default, @code{nil}, makes Gnus ask the user whether to deny the server or whether to unplug the agent. If the @@ -18197,7 +18286,7 @@ is only valid if the Agent is used. @item gnus-auto-goto-ignores @vindex gnus-auto-goto-ignores -Another variable that isn't a Agent variable, yet so closely related +Another variable that isn't an Agent variable, yet so closely related that most will look for it here, this variable tells the summary buffer how to maneuver around undownloaded (only headers stored in the agent) and unfetched (neither article nor headers stored) articles. @@ -18857,7 +18946,7 @@ final ``header'' you can score on is @code{Followup}. These score entries will result in new score entries being added for all follow-ups to articles that matches these score entries. -Following this key is a arbitrary number of score entries, where each +Following this key is an arbitrary number of score entries, where each score entry has one to four elements. @enumerate @@ -21938,12 +22027,6 @@ check for legitimate mail, though. If you feel like being a good net citizen, you can even send off complaints to the proper authorities on each unsolicited commercial email---at your leisure. -If you are also a lazy net citizen, you will probably prefer complaining -automatically with the @file{gnus-junk.el} package, available FOR FREE -at @* @uref{http://stud2.tuwien.ac.at/~e9426626/gnus-junk.html}. -Since most e-mail spam is sent automatically, this may reconcile the -cosmic balance somewhat. - This works for me. It allows people an easy way to contact me (they can just press @kbd{r} in the usual way), and I'm not bothered at all with spam. It's a win-win situation. Forging @code{From} headers to point @@ -23518,7 +23601,7 @@ Message Mode is able to request notifications from the receiver. @cindex RFC 1991 @cindex RFC 2440 RFC 1991 is the original @acronym{PGP} message specification, -published as a Information RFC. RFC 2440 was the follow-up, now +published as an informational RFC. RFC 2440 was the follow-up, now called Open PGP, and put on the Standards Track. Both document a non-@acronym{MIME} aware @acronym{PGP} format. Gnus supports both encoding (signing and encryption) and decoding (verification and @@ -24702,7 +24785,7 @@ appearance of all article buttons. @xref{Article Button Levels}. Dired integration @code{gnus-dired-minor-mode} installs key bindings in dired buffers to send -a file as an attachment (@kbd{C-c C-a}), open a file using the approriate +a file as an attachment (@kbd{C-c C-a}), open a file using the appropriate mailcap entry (@kbd{C-c C-l}), and print a file using the mailcap entry (@kbd{C-c P}). It is enabled with @lisp @@ -24889,7 +24972,7 @@ Gnus no longer generate the Sender: header automatically. Earlier it was generated iff the user configurable email address was different from the Gnus guessed default user address. As the guessing -algorithm is rarely correct these days, and (more controversally) the +algorithm is rarely correct these days, and (more controversially) the only use of the Sender: header was to check if you are entitled to cancel/supersede news (which is now solved by Cancel Locks instead, see another entry), generation of the header has been disabled by @@ -25113,7 +25196,7 @@ the valid values. Gnus supports Cancel Locks in News. This means a header @samp{Cancel-Lock} is inserted in news posting. It is -used to determine if you wrote a article or not (for cancelling and +used to determine if you wrote an article or not (for cancelling and superseding). Gnus generates a random password string the first time you post a message, and saves it in your @file{~/.emacs} using the Custom system. While the variable is called @code{canlock-password}, it is not @@ -25150,7 +25233,7 @@ out other articles. @item Some limiting commands accept a @kbd{C-u} prefix to negate the match. If @kbd{C-u} is used on subject, author or extra headers, i.e., @kbd{/ -s'}, @kbd{/ a}, and @kbd{/ x} +s}, @kbd{/ a}, and @kbd{/ x} (@code{gnus-summary-limit-to-@{subject,author,extra@}}) respectively, the result will be to display all articles that do not match the expression. @@ -25162,7 +25245,7 @@ This is supposedly what USEFOR wanted to migrate to. See @code{gnus-group-name-charset-method-alist} for customization. @item -The nnml and nnfolder backends store marks for each groups. +The nnml and nnfolder back ends store marks for each groups. This makes it possible to take backup of nnml/nnfolder servers/groups separately of @file{~/.newsrc.eld}, while preserving marks. It also @@ -25737,7 +25820,7 @@ evaluate expressions using @kbd{M-:} or inspect variables using @cindex elp @cindex profile @cindex slow -Sometimes, a problem do not directly generate a elisp error but +Sometimes, a problem do not directly generate an elisp error but manifests itself by causing Gnus to be very slow. In these cases, you can use @kbd{M-x toggle-debug-on-quit} and press @kbd{C-g} when things are slow, and then try to analyze the backtrace (repeating the procedure diff --git a/texi/gnusref.tex b/texi/gnusref.tex index 208c8e4..17d9660 100644 --- a/texi/gnusref.tex +++ b/texi/gnusref.tex @@ -1,7 +1,7 @@ %% include file for the Gnus refcard and booklet \def\progver{5.10}\def\refver{5.10-1} % program and refcard versions -\def\date{Jan, 2003} +\def\date{May, 2003} \def\author{Gnus Bugfixing Girls + Boys $<$bugs@gnus.org$>$} %% @@ -146,6 +146,7 @@ ? & (?, M ?) Dormant (only followups are interesting).\\ E & (E, M e, M x) {\bf Expirable}. Only has effect in mail groups.\\ G & (C, B DEL) Canceled article (or deleted in mailgroups).\\ + \$ & (M-d, M s x, S x). Marked as spam.\\ \hline\hline \multicolumn{2}{|p{\markdblcolwidth}|} {The marks below mean that the article @@ -171,6 +172,7 @@ \# & (\#, M \#, M P p) Processable (will be affected by the next operation). [2]\\ A & {\bf Answered} (followed-up or replied). [2]\\ + F & Forwarded. [2]\\ $\ast$ & Cached. [2]\\ S & Saved. [2]\\ N & Recently arrived. [2]\\ @@ -688,7 +690,8 @@ RET & (BUTTON-2) Toggle display of the MIME object.\\ v & Prompt for a method and then view object using this method.\\ o & Prompt for a filename and save the MIME object.\\ - C-o & Prompt for a filename to save the MIME object to and remove it.\\ + C-o & Prompt for a filename to save the MIME object to and remove it.\\ + d & {\bf Delete} the MIME object.\\ c & {\bf Copy} the MIME object to a new buffer and display this buffer.\\ i & Display the MIME object in this buffer.\\ C & Copy the MIME object to a new buffer and display this buffer using {\bf Charset} \\ diff --git a/texi/message.texi b/texi/message.texi index 0c7cde1..e650b0e 100644 --- a/texi/message.texi +++ b/texi/message.texi @@ -1742,7 +1742,7 @@ is @samp{> }. @cindex yanking @cindex cited @cindex quoting -When yanking text from a article which contains no text or already +When yanking text from an article which contains no text or already cited text, each line will be prefixed with the contents of this variable. The default is @samp{>}. See also @code{message-yank-prefix}. diff --git a/texi/pgg.texi b/texi/pgg.texi index fc15392..a57fe11 100644 --- a/texi/pgg.texi +++ b/texi/pgg.texi @@ -13,6 +13,7 @@ @ifinfo This file describes the PGG. +Copyright (C) 2003 Free Software Foundation, Inc. Copyright (C) 2001 Daiki Ueno. Permission is granted to copy, distribute and/or modify this document @@ -119,6 +120,7 @@ list autoload setting for desired functions as follows. * User Commands:: * Selecting an implementation:: * Caching passphrase:: +* Default user identity:: @end menu @node User Commands @@ -220,6 +222,36 @@ you could stop caching with setting it @code{nil}. Elapsed time for expiration in seconds. @end defvar +@node Default user identity +@section Default user identity + +The PGP implementation is usually able to select the proper key to use +for signing and decryption, but if you have more than one key, you may +need to specify the key id to use. + +@defvar pgg-default-user-id +User ID of your default identity. It defaults to the value returned +by @samp{(user-login-name)}. You can customize this variable. +@end defvar + +@defvar pgg-gpg-user-id +User ID of the GnuPG default identity. It defaults to @samp{nil}. +This overrides @samp{pgg-default-user-id}. You can customize this +variable. +@end defvar + +@defvar pgg-pgp-user-id +User ID of the PGP 2.x/6.x default identity. It defaults to +@samp{nil}. This overrides @samp{pgg-default-user-id}. You can +customize this variable. +@end defvar + +@defvar pgg-pgp5-user-id +User ID of the PGP 5.x default identity. It defaults to @samp{nil}. +This overrides @samp{pgg-default-user-id}. You can customize this +variable. +@end defvar + @node Architecture @chapter Architecture -- 1.7.10.4