From 3c19a9d1054e341f806d39714ddf1d70b03ef142 Mon Sep 17 00:00:00 2001 From: yamaoka Date: Sun, 2 Jul 2000 23:48:10 +0000 Subject: [PATCH] Importing Gnus v5.8.7. --- lisp/ChangeLog | 1008 +++++++++++++++++++++++++++++++++++++++++---------- lisp/gnus-agent.el | 43 ++- lisp/gnus-art.el | 101 ++++-- lisp/gnus-cache.el | 5 +- lisp/gnus-cus.el | 6 +- lisp/gnus-demon.el | 3 +- lisp/gnus-ems.el | 78 ++-- lisp/gnus-group.el | 278 ++++++++++---- lisp/gnus-int.el | 6 +- lisp/gnus-msg.el | 53 ++- lisp/gnus-score.el | 12 +- lisp/gnus-soup.el | 19 +- lisp/gnus-srvr.el | 23 +- lisp/gnus-start.el | 66 ++-- lisp/gnus-sum.el | 176 ++++++--- lisp/gnus-topic.el | 63 ++-- lisp/gnus-util.el | 30 +- lisp/gnus-uu.el | 173 ++++++--- lisp/gnus-xmas.el | 3 + lisp/gnus.el | 60 +-- lisp/imap.el | 9 +- lisp/lpath.el | 4 +- lisp/mail-source.el | 36 +- lisp/mailcap.el | 37 +- lisp/message.el | 216 +++++++---- lisp/mm-bodies.el | 6 +- lisp/mm-decode.el | 26 +- lisp/mm-util.el | 7 +- lisp/mm-uu.el | 2 +- lisp/mm-view.el | 15 +- lisp/mml.el | 388 +++++++++++--------- lisp/nndoc.el | 11 +- lisp/nndraft.el | 12 +- lisp/nnfolder.el | 2 +- lisp/nnheader.el | 10 +- lisp/nnimap.el | 72 ++-- lisp/nnmail.el | 11 +- lisp/nnmh.el | 12 +- lisp/nnml.el | 10 +- lisp/nnslashdot.el | 46 ++- lisp/nnsoup.el | 13 +- lisp/nnwarchive.el | 4 +- lisp/pop3.el | 2 +- lisp/qp.el | 35 +- lisp/rfc2047.el | 49 ++- lisp/webmail.el | 26 +- texi/ChangeLog | 30 ++ texi/gnus.texi | 132 ++++++- texi/message.texi | 8 +- 49 files changed, 2459 insertions(+), 978 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 43754b3..27e082d 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,7 +1,621 @@ +Sun Jul 2 15:11:35 2000 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.8.7 is released. + +2000-05-19 06:32:52 Lars Magne Ingebrigtsen + + * mm-decode.el (mm-insert-part): Characters doubly decoded. + +2000-07-01 10:23:08 Shenghuo ZHU + + * message.el (message-do-fcc): Encode MIME. + +2000-06-28 13:52:57 Shenghuo ZHU + + * lpath.el: Fbind image-size. + +2000-06-28 Simon Josefsson + + * nnimap.el (nnimap-split-rule): Update doc with extended syntax. + (nnimap-assoc-match): New function. + (nnimap-split-find-rule): Support extended syntax. + +2000-06-28 Simon Josefsson + + * nnimap.el (nnimap-open-connection): Use port stuff. + + * gnus-util.el (gnus-netrc-machine): Add defaultport parameter, + document port and defaultport. + +2000-06-27 Paul Stodghill + + * gnus-agent.el (gnus-agent-synchronize): Kill flags buffer. + +2000-06-26 Dave Love + + * mm-decode.el (mm-image-fit-p): Use `image-size' in Emacs. + + * message.el: Remove unnecessary `require'ments. Defvar + gnus-list-identifiers when compiling. Don't try to autoload + variable `gnus-list-identifiers'. Autoload + gnus-group-name-charset. + (message-fetch-field): Don't assume `format' removes text + properties. + (message-strip-list-identifiers, message-reply, message-followup): + Require gnus-sum. + (message-mode): Tidy XEmacs conditionals. + (message-replace-chars-in-string): Use subst-char-in-string when + available. + + * gnus-xmas.el (gnus-xmas-define) : + Define if necessary. + + * gnus-art.el (gnus-article-edit-exit): Don't assume `format' + removes text properties. + + * gnus-srvr.el (gnus-browse-group-name): Likewise. + + * gnus-msg.el (gnus-copy-article-buffer): Likewise. + + * gnus-score.el (gnus-summary-score-entry): Likewise. + +2000-06-26 11:18:57 Katsumi Yamaoka + + * nnimap.el (nnimap-request-post): Fix parenthesis. + +2000-06-26 Paul Stodghill + + * message.el (message-unquote-tokens): New function. + + * gnus-msg.el (gnus-inews-do-gcc): Unquote gcc tokens. + + * nnimap.el (nnimap-request-post): Ditto. + +2000-06-21 Simon Josefsson + + * gnus.el (gnus-asynchronous): Removed (defined in gnus-async.el). + + * nnimap.el (nnimap-callback): Update for IMAP4rev1 servers (see + patch commited 2000-04-02). + +2000-06-20 Simon Josefsson + + * imap.el (imap-mailbox-examine-1): New function. + (imap-message-copyuid-1): + (imap-message-appenduid-1): Use it, instead of + `imap-mailbox-examine' which would utf-7 encode mailbox name + twice. + +2000-06-19 Dave Love + + * mm-uu.el Don't require message. Require cl when compiling. + +2000-06-17 18:58:46 Shenghuo ZHU + + * gnus-sum.el (gnus-summary-local-variables): gnus-orphan-score is + a local variable. + * gnus-sum.el (gnus-orphan-score): Move here. + +2000-06-10 09:33:36 Shenghuo ZHU + + * message.el (message-forward): Remove show-mml condition. + (message-forward-ignored-headers): Remove X-Gnus headers. + +2000-06-08 Simon Josefsson + + * gnus-cus.el (gnus-extra-group-parameters): Add uidvalidity. + +2000-06-08 12:34:26 Urban Engberg + + * gnus-demon.el (gnus-demon-scan-mail): Bind nnmail-fetched-sources. + +2000-06-08 12:27:55 Shenghuo ZHU + + * message.el (message-syntax-checks): Add type. + +2000-06-07 Dave Love + + * mm-view.el (mm-inline-image-emacs): Don't specify string for + put-image. + (mm-inline-image): Defalias, not fset. + + * gnus.el (gnus-group-startup-message): Don't specify string for + insert-image. + + * gnus-ems.el (gnus-add-minor-mode): Make it an alias if + add-minor-mode is available. + (gnus-article-display-xface): Don't specify string for + insert-image. + +2000-06-06 13:28:53 Shenghuo ZHU + + * gnus-topic.el (gnus-topic-remove-topic): Set hidden. + (gnus-topic-insert-topic-line): Use shownp. + (gnus-topic-hide-topic): Don't use hidden. + (gnus-topic-show-topic): Don't use hidden. + +2000-06-05 22:25:12 Shenghuo ZHU + + * gnus-cache.el (gnus-cache-possibly-enter-article): Bind coding + system. + * gnus-soup.el (gnus-soup-write-prefixes): Ditto. + * gnus-start.el (gnus-slave-save-newsrc): Ditto. + * gnus-util.el (gnus-output-to-rmail): Ditto. + (gnus-output-to-mail): Ditto. + (gnus-write-buffer): Ditto. + * gnus-uu.el (gnus-uu-save-article): Ditto. + +2000-06-04 15:05:16 Shenghuo ZHU + + * message.el (message-read-from-minibuffer): Typo. + +2000-06-03 13:36:46 Shenghuo ZHU + + * gnus-art.el (article-decode-charset): Override non-MIME forward + charset. + +2000-06-02 12:04:26 Shenghuo ZHU + + * mml.el (mml-quote-region): Correct the regexp. + * gnus-msg.el (gnus-summary-reply): mml-quote it. + +2000-06-02 11:57:15 Shenghuo ZHU + + * message.el (message-forward): Insert raw text. + * mml.el (mml-parse-1): Get raw text in unibyte mode. + (mml-generate-mime-1): Insert raw text in unibyte mode. + +2000-06-01 Florian Weimer + + * mm-bodies.el (mm-body-encoding): Always encoded if + `mm-use-ultra-safe-encoding' is set. + +2000-05-31 14:50:52 Shenghuo ZHU + + * mml.el (ange-ftp-name-format): Typo. + +2000-05-30 Simon Josefsson + + * gnus-start.el (gnus-get-unread-articles): If + `gnus-activate-group' and/or `gnus-check-server' return nil, don't + try to do anything on that server. + +2000-05-25 Simon Josefsson + + * gnus-group.el (gnus-group-nnimap-edit-acl): Help text updated + from latest draft. + +2000-05-08 Simon Josefsson + + * gnus-group.el (gnus-group-expire-articles-1): Make sure server + is open. + +2000-05-24 Dave Love + + * mml.el (mml-parse-file-name): Fix ange-ftp part. + +2000-05-22 Didier Verna + + * gnus.el (gnus-redefine-select-method-widget): new function, call + it once. Add an "other" entry for unknown but editable backend + name symbols. + * gnus-start.el (gnus-declare-backend): use it. + +2000-05-19 Dave Love + + * gnus-art.el (gnus-article-next-page): Revert last change. + +2000-05-19 09:56:07 Shenghuo ZHU + + * gnus-agent.el (gnus-agent-open-history): Open history in binary mode. + +2000-05-19 Dave Love + + * gnus-art.el (gnus-mime-externalize-part): Bind mm-inlined-types, + not mm-inline-large-images. + +2000-05-19 01:45:40 Shenghuo ZHU + + * mml.el (mml-parse-1): Don't test multiple-charsets within mml tag. + +2000-05-18 Dave Love + + * gnus-art.el: Use defalias, not fset. + (gnus-article-x-face-command): Don't test for xbm. + (gnus-article-next-page): Redisplay before testing point in window. + +2000-05-17 21:16:54 Shenghuo ZHU + + * gnus-group.el (gnus-group-mode-map): Add M-SPACE. + * mml.el (mml-mode-map): Comment out mml-narrow-to-part. + +2000-05-17 21:13:38 Jim Davidson + + * gnus-sum.el (gnus-summary-save-article-rmail): Use + gnus-summary-save-in-rmail. + * message.el (message-output): Ditto. + +2000-05-17 22:37:25 Katsumi Yamaoka + + * gnus-art.el (gnus-emphasize-whitespace-regexp): Doc fix. + +2000-05-17 14:03:49 Shenghuo ZHU + + * rfc2047.el (rfc2047-encode-message-header): Encode if the method + is a charset. + * message.el (message-send-news): Check group name charset. + * gnus-msg.el (gnus-post-news): Decode group name. + (gnus-inews-do-gcc): Encode group name. + +2000-05-17 10:16:32 Karl Kleinpaste + + * gnus-art.el (gnus-emphasize-whitespace-regexp): New variable. + * gnus-util.el (gnus-put-text-property-excluding-newlines): Use it. + +2000-05-17 02:25:11 Shenghuo ZHU + + * gnus-group.el (gnus-group-mark-line-p): New function. + (gnus-group-goto-group): New parameter. + (gnus-group-remove-mark): Use it. + * gnus-topic.el (gnus-topic-move-group): Ditto. + (gnus-topic-remove-group): Ditto. + +2000-05-17 00:49:09 Shenghuo ZHU + + * gnus-group.el (gnus-group-list-dormant): New function. + +2000-05-16 23:20:42 Shenghuo ZHU + + * gnus-agent.el (gnus-agent-synchronize): Use + nnheader-insert-file-contents. + (gnus-agent-save-active-1): Ditto. + (gnus-agent-write-active): Ditto. + (gnus-agent-expire): Ditto. + * gnus-cache.el (gnus-cache-read-active): Ditto. + * gnus-start.el (gnus-master-read-slave-newsrc): Ditto. + * gnus-sum.el (gnus-summary-import-article): Ditto. + + * gnus-agent.el (gnus-agent-write-servers): Bind coding-system. + (gnus-agent-save-group-info): Ditto. + (gnus-agent-save-alist): Ditto. + * gnus-util.el (gnus-make-directory): Ditto. + + * gnus-agent.el (gnus-agent-save-group-info): Disable multibyte. + +2000-05-16 21:13:24 Shenghuo ZHU + + * mml.el (mml-generate-mime-preprocess-function): New variable. + (mml-generate-mime-postprocess-function): New variable. + (mml-generate-mime-1): Use them. + +2000-05-16 18:15:24 Shenghuo ZHU + + * gnus-group.el (gnus-group-apropos): Group name charset. + * gnus-sum.el (gnus-set-mode-line): Ditto. + * gnus-group.el (gnus-group-decoded-name): New function. + (gnus-group-edit-group): Use it. + * gnus-cus.el (gnus-group-customize): Use it. + +2000-05-16 17:55:57 Karl Kleinpaste + + * gnus-util.el (gnus-put-text-property-excluding-newlines): Improve. + +2000-05-16 16:22:17 Shenghuo ZHU + + * gnus-group.el (gnus-group-name-charset-method-alist): New variable. + (gnus-group-name-charset-group-alist): Ditto. + (gnus-group-name-charset): New function. + (gnus-group-name-decode): New function. + (gnus-group-insert-group-line): Use them. + (gnus-group-prepare-flat-list-dead): Ditto. + (gnus-group-list-active): Ditto. + (gnus-group-describe-all-groups): Ditto. + (gnus-group-prepare-flat-list-dead-predicate): Ditto. + * gnus-srvr.el: (gnus-browse-foreign-server): Decode group name and + add gnus-group property. + (gnus-browse-group-name): Read gnus-group property. + +2000-05-16 15:27:08 Shenghuo ZHU + + * nnfolder.el (nnfolder-possibly-change-group): Use + file-name-coding-system instead of pathname-coding-system. + * nnmail.el (nnmail-find-file): Ditto. + (nnmail-write-region): Ditto. + * nnmh.el (nnmh-retrieve-headers): Ditto. + (nnmh-request-article): Ditto. + (nnmh-request-group): Ditto. + (nnmh-request-list): Ditto. + (nnmh-possibly-change-directory): Ditto. + (nnmh-active-number): Ditto. + * nnml.el (nnml-possibly-change-directory): Ditto. + (nnml-request-list): Ditto. + (nnml-request-article): Ditto. + (nnml-retrieve-headers): Ditto. + +2000-05-16 Simon Josefsson + + * nnimap.el (nnimap-request-accept-article): Don't unselect + mailbox if no mailbox is selected. + +2000-05-15 Per Abrahamsen + + * gnus-art.el (gnus-button-url-regexp): Revert earlier change. + Recognize domain names starting with `www.' as starting an URL. + +2000-05-15 09:46:47 Shenghuo ZHU + + * mail-source.el (mail-source-fetch-maildir): Insert "From ". + (mail-source-keyword-map): Add "subdirs" for maildir. + +2000-05-14 16:19:28 Shenghuo ZHU + + * nnmail.el (nnmail-scan-directory-mail-source-once): New variable. + (nnmail-get-new-mail): Use it. + * gnus-start.el (gnus-get-unread-articles): Ditto. + +2000-05-14 14:02:12 Shenghuo ZHU + + * gnus-sum.el (gnus-summary-edit-article): Better support for + nndraft:drafts. + * nndraft.el (nndraft-request-replace-article): New function, + bind nnmail-file-coding-system. + +2000-05-14 Dave Love + + * nnheader.el: Replace uses of `fset' with `defalias'. + (jka-compr-compression-info-list): Only defvar when compiling. + +2000-05-14 12:30:28 Shenghuo ZHU + + * webmail.el (webmail-netaddress-article): Refresh redirect. + +2000-05-13 20:41:10 Shenghuo ZHU + + * mm-view.el (mm-inline-text): w3 might not recognize utf-8. + +2000-05-13 16:49:41 Shenghuo ZHU + + * webmail.el: Translate   to SP. + +2000-05-13 13:00:17 Robin S. Socha + + * message.el (message-bounce): Doc typo. + +2000-05-13 12:25:21 Shenghuo ZHU + + * gnus-soup.el (gnus-soup-encoding-type): u is USENET news format. + (gnus-soup-store): Ditto. + (gnus-soup-send-packet): Ditto. + * nnsoup.el (nnsoup-replies-format-type): Ditto. + (nnsoup-dissect-buffer): Ditto. + (nnsoup-narrow-to-article): Ditto. + (nnsoup-make-active): Ditto + +2000-05-13 12:03:29 Shenghuo ZHU + + * message.el (message-mode): Two parameters for local-variable-p. + +2000-05-13 00:54:46 Shenghuo ZHU + + * message.el (message-strip-list-identifiers): New function. + (message-reply): Use it and use message-strip-subject-re. + (message-followup): Ditto. + * gnus-art.el (article-hide-list-identifiers): Remove more. + * gnus-sum.el (gnus-summary-remove-list-identifiers): Ditto. + +2000-05-12 22:28:54 Shenghuo ZHU + + * gnus-uu.el (gnus-uu-digest-mail-forward): Bind + mail-parset-charset and use non-numeric argument. + +2000-05-12 20:54:11 Shenghuo ZHU + + * mml.el (mml-buffer-list): New variable. + (mml-generate-new-buffer): New function. + (mml-destroy-buffers): Ditto. + (mml-insert-mime): Use them. + * gnus-msg.el (gnus-setup-message): mml-buffer leaks. + * gnus-sum.el (gnus-summary-edit-article): Ditto. + * message.el (message-mode): Ditto. + * gnus-uu.el (gnus-uu-digest-headers): Keep MIME headers. + (gnus-uu-save-article): Support show-as-mml. + * message.el (message-forward): Ditto. + +2000-05-12 15:15:55 Shenghuo ZHU + + * nndoc.el (nndoc-type-alist): mime-digest head-begin. + (nndoc-mime-digest-type-p): Locate article head precisely. + * mml.el (mml-generate-default-type): New variable. + (mml-generate-mime-1): Use it. + (mml-insert-mime-headers): Use it. + * gnus-uu.el (gnus-uu-digest-buffer): New variable. + (gnus-uu-digest-mail-forward): Use it and call message-forward + with argument digest. + (gnus-uu-save-article): Support message-forward-as-mime. + * message.el (message-forward): Add parameter digest. + * mm-decode.el (mm-dissect-default-type): New variable. + (mm-dissect-buffer): Use it. + +2000-05-11 11:08:03 Shenghuo ZHU + + * mml.el (mml-parse-singlepart-with-multiple-charsets): Set space, + newline and paragraph to nil when got a non-ascii character. Test + paragraph before newline. + +2000-05-10 12:17:58 Shenghuo ZHU + + * qp.el (quoted-printable-encode-region): Bind tab-width to 1. Set + limit to 76. + +2000-05-10 09:11:48 Lars Magne Ingebrigtsen + + * nnslashdot.el (nnslashdot-sid-strip): New function. + (nnslashdot-threaded-retrieve-headers): New format. + (nnslashdot-sane-retrieve-headers): Ditto. + (nnslashdot-request-article): Ditto. + (nnslashdot-threaded-retrieve-headers): Thread properly. + (nnslashdot-request-article): Be more lenient. + (nnslashdot-threaded-retrieve-headers): Regexp search. + +2000-05-09 13:23:50 Shenghuo ZHU + + * gnus-sum.el (gnus-with-article): Define it before use it. + +2000-05-08 22:34:19 Shenghuo ZHU + + * message.el (message-supersede): Use mime-to-mml. + * mm-decode.el (mm-insert-part): Test the buffer if no encoding. + +2000-05-08 22:34:24 Katsumi Yamaoka + + * gnus-group.el (gnus-group-list-cached): Don't use + `subst-char-in-string'. + +2000-05-08 Dave Love + + * pop3.el (pop3-open-server): Fix creating name of trace buffer. + +2000-05-08 01:07:47 Shenghuo ZHU + + * mm-decode.el (mm-interactively-view-part): Append %s if the + method is a single word. + * nnwarchive.el (nnwarchive-type-definition): Typo. + +2000-05-07 17:24:01 Shenghuo ZHU + + * gnus-group.el (gnus-group-prepare-flat-list-dead-predicate): New + function. + (gnus-group-prepare-flat-predicate): Use it. + (gnus-group-list-cached): List dead groups. + +2000-05-07 10:50:02 Shenghuo ZHU + + * gnus-art.el (article-decode-charset): Don't decode message with + format. + +2000-05-07 Florian Weimer + + * mailcap.el (mailcap-maybe-eval): Honor user request not to + evaluate the Lisp code. + +2000-05-06 17:40:20 Shenghuo ZHU + + * gnus-art.el (article-wash-html): New function. + (gnus-article-wash-html): Bind. + (gnus-article-make-menu-bar): Menu item. + * gnus-sum.el (gnus-summary-wash-map): Bind 'h'. + (gnus-summary-make-menu-bar): Menu item. + * gnus.el: Autoload. + +2000-05-06 Florian Weimer + + * gnus-uu.el (gnus-uu-unshar-warning): New variable. + (gnus-uu-unshar-article): Use it. + + * mailcap.el (mailcap-maybe-eval-warning): New variable. + (mailcap-maybe-eval): Use it. + + * gnus-msg.el (gnus-group-posting-charset-alist): Speling mistake + in docstring. + + * mml.el (mml-generate-mime-1): Small comment. + +2000-05-05 12:27:53 Shenghuo ZHU + + * gnus-art.el (article-de-base64-unreadable): New function. + (gnus-article-de-base64-unreadable): Bind. + (gnus-article-make-menu-bar): Menu item. + * gnus-sum.el (gnus-summary-wash-map): Bind '6' and 'Z'. + (gnus-summary-make-menu-bar): Menu item. + * gnus.el: Autoload. + +2000-05-05 10:32:27 Shenghuo ZHU + + * gnus-sum.el (gnus-summary-show-article): Remove en/disable multibyte. + (gnus-summary-select-article): Add en/disable multibyte. + +2000-05-05 02:47:23 Shenghuo ZHU + + * gnus-sum.el (gnus-summary-edit-article): Enable multibyte. + (gnus-summary-edit-article): New feature: editing raw articles. + +2000-05-05 00:30:12 Shenghuo ZHU + + * rfc2047.el (rfc2047-encode-region): Insert a space before encoding. + Emacs MULE can not encode adjacent iso-2022-jp and cn-gb-2312. + * gnus-msg.el (gnus-summary-mail-forward): Use unibyte buffer. + Emacs MULE can not copy some 8bit characters in multibyte buffers. + * mm-decode.el (mm-insert-part): Ditto. + +2000-05-04 17:49:04 Shenghuo ZHU + + * nndoc.el (nndoc-type-alist): Extend forward regexp. + (nndoc-forward-type-p): Ditto. + +2000-05-04 17:13:04 Shenghuo ZHU + + * mm-util.el (mm-with-unibyte-current-buffer): Set the default + value of enable-multibyte-characters. + +2000-05-04 10:31:24 Shenghuo ZHU + + * gnus-sum.el (gnus-summary-show-article): En/disable multibyte. + +2000-05-03 Dave Love + + * gnus-ems.el (gnus-article-xface-ring-internal) + (gnus-article-xface-ring-size): New variable. + (gnus-article-display-xface): Use them to cache data. Don't try + to use XPM. Set up binary coding for PBM's sake. + +2000-05-03 14:23:38 Shenghuo ZHU + + * gnus-msg.el (gnus-inews-do-gcc): Set mail-parse-charset. + * gnus-int.el (gnus-request-accept-article): Ditto. + (gnus-request-replace-article): Ditto. + * mm-util.el (mm-mime-mule-charset-alist): Add a fake mule-charset. + +2000-05-03 14:11:23 Shenghuo ZHU + + * rfc2047.el (rfc2047-encode): Test the validity of coding-system. + +2000-05-03 11:35:15 Shenghuo ZHU + + * rfc2047.el (rfc2047-encode-message-header): Encode field by + field. + * mml.el (mml-to-mime): Use message-default-charset. + (mml-preview): Narrow to headers. + * message.el (message-send-mail): Use message-default-charset. + (message-send-news): Narrow to headers; + use message-default-charset. + +2000-05-03 08:09:14 Shenghuo ZHU + + * mm-bodies.el (mm-decode-content-transfer-encoding): A better junk + detect. + * mml.el (mml-parse-singlepart-with-multiple-charsets): Save + restriction. + (mml-parse-1): Warning message. + (mml-preview): Disable multibyte. + +2000-05-03 Dave Love + + * gnus.el (gnus-group-startup-message): Add newline before image. + +2000-05-02 21:34:10 Shenghuo ZHU + + * rfc2047.el (rfc2047-encode-message-header): Check the coding-system. + * message.el (message-send-mail): Use unibyte-buffer. + (message-send-mail): Ditto. + Mon May 1 15:09:46 2000 Lars Magne Ingebrigtsen * gnus.el: Gnus v5.8.6 is released. +2000-05-01 07:45:43 Shenghuo ZHU + + * mml.el (mml-parse-1): Set no-markup-p and warn to nil. + 2000-04-28 21:14:21 Shenghuo ZHU * rfc2047.el (rfc2047-q-encoding-alist): Encode HTAB. @@ -23,7 +637,7 @@ Mon May 1 15:09:46 2000 Lars Magne Ingebrigtsen 2000-04-28 14:23:14 Shenghuo ZHU * mml.el (mml-preview): Set gnus-newsgroup-charset. - * rfc2047.el (rfc2047-encode-message-header): Encode non-ascii + * rfc2047.el (rfc2047-encode-message-header): Encode non-ascii as 8-bit. * lpath.el: Fbind image functions. @@ -59,7 +673,7 @@ Mon May 1 15:09:46 2000 Lars Magne Ingebrigtsen 2000-04-27 23:23:37 Shenghuo ZHU - * nndoc.el (nndoc-type-alist): Change forward regexp. + * nndoc.el (nndoc-type-alist): Change forward regexp. 2000-04-27 21:57:10 Shenghuo ZHU @@ -105,7 +719,7 @@ Mon May 1 15:09:46 2000 Lars Magne Ingebrigtsen * message.el (message-send-mail-partially-limit): New variable. (message-send-mail-partially): New function. (message-send-mail): Use it. - * mm-bodies.el (mm-decode-content-transfer-encoding): Remove + * mm-bodies.el (mm-decode-content-transfer-encoding): Remove all blank lines inside of base64. * mm-partial.el (mm-inline-partial): Add an option. Remove tail blank lines. @@ -137,7 +751,7 @@ Mon May 1 15:09:46 2000 Lars Magne Ingebrigtsen 2000-04-24 00:56:00 Björn Torkelsson * rfc2047.el (rfc2047-encode-message-header): Fixing typo. - + 2000-04-26 12:27:41 Shenghuo ZHU * gnus-draft.el (gnus-draft-send): Move gnus-draft-setup inside of @@ -219,14 +833,14 @@ Mon Apr 24 21:12:06 2000 Lars Magne Ingebrigtsen 2000-04-23 23:27:25 Shenghuo ZHU - * mm-view.el (mm-inline-message): Disable prepare-hook. + * mm-view.el (mm-inline-message): Disable prepare-hook. 2000-04-23 00:32:32 Lars Magne Ingebrigtsen * gnus.el: Fix copyright statements. * gnus-sum.el (gnus-alter-articles-to-read-function): New - variable. + variable. (gnus-articles-to-read): Use it. * message.el (message-get-reply-headers): Bind free variable. @@ -254,7 +868,7 @@ Mon Apr 24 21:12:06 2000 Lars Magne Ingebrigtsen 2000-04-22 14:25:05 Lars Magne Ingebrigtsen * nnweb.el (nnweb-dejanews-create-mapping): Remove the context - string. + string. (nnweb-request-group): Don't scan twice. (nnweb-request-scan): Don't nix out the hashtb. @@ -263,7 +877,7 @@ Mon Apr 24 21:12:06 2000 Lars Magne Ingebrigtsen 2000-04-22 14:12:41 David Aspinwall * gnus-art.el (gnus-button-url-regexp): New value to match naked - urls. + urls. 2000-04-22 01:23:59 Lars Magne Ingebrigtsen @@ -292,7 +906,7 @@ Mon Apr 24 21:12:06 2000 Lars Magne Ingebrigtsen 2000-03-01 Simon Josefsson - * gnus-sum.el (gnus-read-move-group-name): + * gnus-sum.el (gnus-read-move-group-name): (gnus-summary-move-article): Use `gnus-group-method' to find out what method the manually entered group belong to. `gnus-group-name-to-method' doesn't return any method parameters @@ -302,7 +916,7 @@ Mon Apr 24 21:12:06 2000 Lars Magne Ingebrigtsen 2000-04-21 22:27:15 Lars Magne Ingebrigtsen * gnus-msg.el (gnus-configure-posting-styles): Allow nil values to - override. + override. 2000-04-21 21:58:20 Kai Großjohann @@ -316,7 +930,7 @@ Mon Apr 24 21:12:06 2000 Lars Magne Ingebrigtsen 2000-04-21 21:20:32 Mike Fabian - * gnus-group.el (gnus-group-catchup-current): Doc fix. + * gnus-group.el (gnus-group-catchup-current): Doc fix. 2000-04-21 20:36:21 Lars Magne Ingebrigtsen @@ -329,7 +943,7 @@ Mon Apr 24 21:12:06 2000 Lars Magne Ingebrigtsen * gnus-xmas.el (gnus-group-add-icon): Moved here. * gnus-group.el (gnus-group-glyph-directory): Don't depend on - xmas. + xmas. (gnus-group-glyph-directory): Removed. 2000-04-21 20:26:23 Jaap-Henk Hoepman @@ -359,13 +973,13 @@ Mon Apr 24 21:12:06 2000 Lars Magne Ingebrigtsen 2000-04-21 18:20:10 Lars Magne Ingebrigtsen * mailcap.el (mailcap-mime-info): Use the first match; not the - last. + last. * gnus-agent.el (gnus-category-kill): Save the category list. 2000-04-21 16:41:50 Chris Brierley - * gnus-sum.el (gnus-summary-move-article): Do something or other. + * gnus-sum.el (gnus-summary-move-article): Do something or other. 2000-04-21 16:07:07 Lars Magne Ingebrigtsen @@ -391,7 +1005,7 @@ Mon Apr 24 21:12:06 2000 Lars Magne Ingebrigtsen 2000-04-21 15:21:30 Katsumi Yamaoka - * mm-bodies.el (mm-body-charset-encoding-alist): defcustomized. + * mm-bodies.el (mm-body-charset-encoding-alist): defcustomized. 2000-04-21 15:15:41 Lars Magne Ingebrigtsen @@ -415,7 +1029,7 @@ Mon Apr 24 21:12:06 2000 Lars Magne Ingebrigtsen 2000-04-21 14:11:39 David S. Goldberg * gnus-art.el (gnus-boring-article-headers): Work on long CCs as - well. + well. 2000-04-21 14:06:43 Rui Zhu @@ -428,7 +1042,7 @@ Mon Apr 24 21:12:06 2000 Lars Magne Ingebrigtsen * flow-fill.el (flow-fill): Fix provide. * gnus-draft.el (gnus-draft-send): Bind message-setup-hook to - nil. + nil. 2000-04-20 22:24:04 Shenghuo ZHU @@ -472,7 +1086,7 @@ Mon Apr 24 21:12:06 2000 Lars Magne Ingebrigtsen * gnus-util.el (gnus-parse-netrc): Allow "port". (gnus-netrc-machine): Take a port param. - (gnus-netrc-machine): + (gnus-netrc-machine): * gnus-art.el (gnus-request-article-this-buffer): Allow re-selecting referenced articles. @@ -482,17 +1096,17 @@ Mon Apr 24 21:12:06 2000 Lars Magne Ingebrigtsen 2000-04-20 21:03:54 William M. Perry - * mm-view.el (mm-inline-image-emacs): New function. + * mm-view.el (mm-inline-image-emacs): New function. 2000-04-20 20:44:55 Lars Magne Ingebrigtsen * mail-source.el (mail-source-delete-incoming): Change default in - cvs. + cvs. 2000-04-20 20:43:34 Kim-Minh Kaplan * gnus-art.el (gnus-mime-view-part-as-type-internal): New - function. + function. 2000-04-20 14:45:20 Lars Magne Ingebrigtsen @@ -508,7 +1122,7 @@ Mon Apr 24 21:12:06 2000 Lars Magne Ingebrigtsen 2000-04-20 02:25:39 Lars Magne Ingebrigtsen * message.el (message-generate-headers): Respect the syntax check - spec. + spec. * gnus-sum.el (gnus-remove-thread-1): Show thread. (gnus-remove-thread): Don't show all threads. @@ -530,7 +1144,7 @@ Thu Apr 20 01:39:25 2000 Lars Magne Ingebrigtsen 2000-04-14 18:50:04 Shenghuo ZHU * mm-util.el (mm-char-or-char-int-p): New alias. - * nnweb.el (nnweb-decode-entities): Check the validity of numeric + * nnweb.el (nnweb-decode-entities): Check the validity of numeric entities. 2000-04-10 Daiki Ueno @@ -543,7 +1157,7 @@ Thu Apr 20 01:39:25 2000 Lars Magne Ingebrigtsen * mail-source.el (mail-source-fetch-webmail): Use the default password provided in mail-sources; use webmail:subtype:user as the key. - + 2000-04-10 20:35:46 John Wiegley * mail-source.el (mail-source-fetch-webmail): Use @@ -587,7 +1201,7 @@ Thu Apr 20 01:39:25 2000 Lars Magne Ingebrigtsen 2000-03-20 00:12:42 Lars Magne Ingebrigtsen * nnslashdot.el (nnslashdot-request-list): Use the new slashdot - format. + format. 2000-03-16 Simon Josefsson @@ -615,7 +1229,7 @@ Thu Apr 20 01:39:25 2000 Lars Magne Ingebrigtsen 2000-03-15 Simon Josefsson * nnheader.el (nnheader-group-pathname): Make sure to return a - directory. + directory. * nnmail.el (nnmail-group-pathname): Ditto. 2000-02-08 Per Abrahamsen @@ -628,20 +1242,20 @@ Thu Apr 20 01:39:25 2000 Lars Magne Ingebrigtsen * gnus-srvr.el (gnus-server-kill-server): Offer to kill all the groups from the server. - * gnus-sum.el (gnus-summary-save-parts): Fix interactive spec. + * gnus-sum.el (gnus-summary-save-parts): Fix interactive spec. (gnus-summary-toggle-header): Update the wash status. * gnus-uu.el ((gnus-uu-extract-map "X" gnus-summary-mode-map)): Moved here. * gnus-agent.el (gnus-agent-save-group-info): Respect old - setting. + setting. * nnmail.el (nnmail-get-active): Use it. (nnmail-parse-active): New function. * mm-view.el (mm-inline-text): Support the new version of - vcard.el. + vcard.el. * gnus-sum.el (gnus-summary-move-article): Only delete article when moving junk. @@ -658,17 +1272,17 @@ Thu Apr 20 01:39:25 2000 Lars Magne Ingebrigtsen 2000-03-10 14:57:58 Lars Magne Ingebrigtsen - * message.el (message-send-mail): Protect against unloaded Gnus. + * message.el (message-send-mail): Protect against unloaded Gnus. * gnus-topic.el (gnus-topic-update-topic-line): Don't update the - parent. + parent. (gnus-topic-update-topic-line): Yes, do. (gnus-topic-goto-missing-group): Tally the correct number of unread articles before inserting the topic line. 2000-03-01 09:55:26 Lars Magne Ingebrigtsen - * nnultimate.el (nnultimate-retrieve-headers): Ignore errors. + * nnultimate.el (nnultimate-retrieve-headers): Ignore errors. 2000-02-13 13:53:08 Lars Magne Ingebrigtsen @@ -712,7 +1326,7 @@ Thu Apr 20 01:39:25 2000 Lars Magne Ingebrigtsen * qp.el (quoted-printable-decode-region): Add charset parameter. (quoted-printable-decode-string): Ditto. - + * gnus-art.el (article-de-quoted-unreadable): Use it. 2000-01-21 Simon Josefsson @@ -765,7 +1379,7 @@ Thu Apr 20 01:39:25 2000 Lars Magne Ingebrigtsen 2000-01-06 18:32:53 Lars Magne Ingebrigtsen * gnus-art.el (gnus-article-mode-map): "e" is - gnus-summary-edit-article. + gnus-summary-edit-article. 2000-01-06 18:25:37 Jari Aalto @@ -782,12 +1396,12 @@ Thu Apr 20 01:39:25 2000 Lars Magne Ingebrigtsen 2000-01-06 13:41:11 Lars Magne Ingebrigtsen - * nnfolder.el (nnfolder-read-folder): Use nnfolder-save-buffer. + * nnfolder.el (nnfolder-read-folder): Use nnfolder-save-buffer. * gnus.el: Really always pop up a new frame. * parse-time.el (parse-time-rules): Allow 100-110 to be - 2000-2010. + 2000-2010. * time-date.el (date-to-time): Don't use timezone. @@ -824,7 +1438,7 @@ Thu Apr 20 01:39:25 2000 Lars Magne Ingebrigtsen point. * gnus-group.el (gnus-fetch-group): Complete over - gnus-active-hashtb. + gnus-active-hashtb. Wed Jan 5 17:06:41 2000 Lars Magne Ingebrigtsen @@ -847,7 +1461,7 @@ Wed Jan 5 17:06:41 2000 Lars Magne Ingebrigtsen 2000-01-04 Simon Josefsson - * imap.el (imap-parse-literal): + * imap.el (imap-parse-literal): (imap-parse-flag-list): Don't care about props. (imap-parse-string): Handle quoted characters. @@ -859,7 +1473,7 @@ Wed Jan 5 17:06:41 2000 Lars Magne Ingebrigtsen (t): Changed keystroke for gnus-summary-customize-parameters. * gnus-art.el (gnus-article-mode-map): Use gnus-article-edit for - "e". + "e". (gnus-article-mode-map): No, don't. * gnus-sum.el (gnus-summary-next-subject): Don't show the thread @@ -890,7 +1504,7 @@ Wed Jan 5 17:06:41 2000 Lars Magne Ingebrigtsen 1999-12-14 10:18:30 Lars Magne Ingebrigtsen * nnslashdot.el (nnslashdot-request-article): Translate
into -

. +

. 1999-12-28 12:20:18 Shenghuo ZHU @@ -937,17 +1551,17 @@ Wed Jan 5 17:06:41 2000 Lars Magne Ingebrigtsen * message.el (message-send-mail): Bind `message-this-is-mail' and `message-posting-charset'. - (message-send-news): Dito, and honour new layout of + (message-send-news): Dito, and honour new layout of `message-posting-charset'. (message-encode-message-body): Ignore `message-posting-charset'. - + * mm-bodies.el (mm-body-encoding): Consider `message-posting-charset' when deciding whether to use 8bit. * rfc2047.el (rfc2047-encode-message-header): Back out change. (rfc2047-encodable-p): Now solely for headers; use `message-posting-charset'. - + 1999-12-20 14:10:39 Shenghuo ZHU * nnwarchive.el (nnwarchive-type-definition): Set default value. @@ -962,7 +1576,7 @@ Wed Jan 5 17:06:41 2000 Lars Magne Ingebrigtsen * gnus-cite.el (gnus-article-toggle-cited-text): Restore beg and end (referenced by instructions in `gnus-cited-opened-text-button-line-format-alist'). - + 1999-12-18 Simon Josefsson * imap.el (imap-starttls-open): Typo. @@ -975,7 +1589,7 @@ Wed Jan 5 17:06:41 2000 Lars Magne Ingebrigtsen 1999-12-18 Florian Weimer - * mml.el (mml-generate-multipart-alist): Correct default value. + * mml.el (mml-generate-multipart-alist): Correct default value. * mm-encode.el (mm-use-ultra-safe-encoding): New variable. (mm-safer-encoding): New function. @@ -1106,7 +1720,7 @@ Wed Jan 5 17:06:41 2000 Lars Magne Ingebrigtsen * nnslashdot.el (nnslashdot-date-to-date): Error proof when input is bad. - * gnus-sum.el (gnus-list-of-unread-articles): When (car read) + * gnus-sum.el (gnus-list-of-unread-articles): When (car read) is not 1. 1999-12-13 18:22:08 Shenghuo ZHU @@ -1137,15 +1751,15 @@ Wed Jan 5 17:06:41 2000 Lars Magne Ingebrigtsen * nnweb.el (nnweb-decode-entities): Decode numerical entities. (nnweb-decode-entities-string): New function. - + * nnwarchive.el (nnwarchive-decode-entities-string): Rename to nnweb-* and move to nnweb.el. * nnwarchive.el: Use nnweb-decode-entities, etc. * webmail.el: Ditto. - + * nnslashdot.el: Use nnweb-decode-entities-string. (nnslashdot-decode-entities): Remove. - + 1999-12-13 10:40:56 Eric Marsden * nnslashdot.el: Decode entities. @@ -1155,7 +1769,7 @@ Wed Jan 5 17:06:41 2000 Lars Magne Ingebrigtsen * gnus-agent.el (gnus-category-edit-groups) (gnus-category-edit-score, gnus-category-edit-predicate): Replace expansion of setf, fixed. - + 1999-12-12 12:50:30 Shenghuo ZHU * gnus-agent.el: Revoke last Dave Love's patch, because of @@ -1208,7 +1822,7 @@ Wed Jan 5 17:06:41 2000 Lars Magne Ingebrigtsen * mm-view.el (mm-inline-message): Require cl when compiling. Avoid ignore-errors at runtime. (mm-inline-text): Avoid mapc. - + 1999-12-12 10:36:51 Shenghuo ZHU * gnus-art.el (article-decode-charset): Widen is bad. @@ -1263,11 +1877,11 @@ Wed Jan 5 17:06:41 2000 Lars Magne Ingebrigtsen (mm-find-mime-charset-region): Set charsets after delete-duplicates and use find-coding-systems-region. (mm-find-charset-region): Remove composition. - + * mm-bodies.el (mm-encode-body): Use mm-charset-after. * mml.el (mml-parse-singlepart-with-multiple-charsets): Ditto. - + 1999-12-09 17:47:56 Shenghuo ZHU * mm-util.el (mm-find-mime-charset-region): Revoke last change. @@ -1303,7 +1917,7 @@ Wed Jan 5 17:06:41 2000 Lars Magne Ingebrigtsen * gnus-msg.el (gnus-group-posting-charset-alist): Use iso-8859-1 for the `de' newsgroups hierarchy, as it is common practice there. - + 1999-12-07 16:17:12 Shenghuo ZHU @@ -1355,7 +1969,7 @@ Wed Jan 5 17:06:41 2000 Lars Magne Ingebrigtsen * nnslashdot.el (nnslashdot-request-delete-group): New function. * gnus-sum.el (gnus-summary-refer-article): Work for lists with - current. + current. (gnus-refer-article-methods): New function. (gnus-summary-refer-article): Use it. @@ -1364,8 +1978,8 @@ Wed Jan 5 17:06:41 2000 Lars Magne Ingebrigtsen * nnimap.el (nnimap-retrieve-groups): Return active format. * nnimap.el (nnimap-replace-in-string): Removed. - (nnimap-request-list): - (nnimap-retrieve-groups): + (nnimap-request-list): + (nnimap-retrieve-groups): (nnimap-request-newgroups): Quote group instead of escaping SPC. 1999-12-05 Simon Josefsson @@ -1409,7 +2023,7 @@ Wed Jan 5 17:06:41 2000 Lars Magne Ingebrigtsen * gnus-msg.el (gnus-setup-message): One backtick too many. - * gnus-art.el (gnus-mime-view-part-as-type): mailcap-mime-types is + * gnus-art.el (gnus-mime-view-part-as-type): mailcap-mime-types is a function, not a variable. 1999-12-04 08:14:08 Max Froumentin @@ -1440,12 +2054,12 @@ Wed Jan 5 17:06:41 2000 Lars Magne Ingebrigtsen * nnmh.el (nnmh-be-safe): Doc fix. - * gnus-sum.el (gnus-summary-exit): Write cache active file. + * gnus-sum.el (gnus-summary-exit): Write cache active file. - * nntp.el (nntp-retrieve-headers-with-xover): Make sure the entire + * nntp.el (nntp-retrieve-headers-with-xover): Make sure the entire status line has arrived before we count it. - * mailcap.el (mailcap-mime-data): Removed save-file from audio/*. + * mailcap.el (mailcap-mime-data): Removed save-file from audio/*. * gnus-sum.el (gnus-thread-header): Fixed after indent. Whitespace problems. @@ -1521,7 +2135,7 @@ Wed Jan 5 17:06:41 2000 Lars Magne Ingebrigtsen 1999-12-04 00:38:24 Andrea Arcangeli * message.el (message-send-mail-with-sendmail): Use - message-make-address. + message-make-address. Fri Dec 3 20:34:11 1999 Lars Magne Ingebrigtsen @@ -1553,12 +2167,12 @@ Fri Dec 3 20:09:41 1999 Lars Magne Ingebrigtsen 1999-12-03 01:26:55 Lars Magne Ingebrigtsen - * gnus-art.el (gnus-button-embedded-url): Always call browse-url. + * gnus-art.el (gnus-button-embedded-url): Always call browse-url. 1999-12-02 18:00:15 Lars Magne Ingebrigtsen * nnultimate.el (nnultimate-retrieve-headers): Use - mm-with-unibyte-current-buffer. + mm-with-unibyte-current-buffer. (nnultimate-request-article): Ditto. 1999-12-02 14:57:46 Shenghuo ZHU @@ -1570,7 +2184,7 @@ Fri Dec 3 20:09:41 1999 Lars Magne Ingebrigtsen * mm-util.el (mm-with-unibyte-current-buffer): New macro. * nnweb.el (nnweb-retrieve-headers): Use it. (nnweb-request-article): Use it. - + * nnweb.el (nnweb-dejanews-create-mapping): Set a default date in case matching failed. @@ -1611,7 +2225,7 @@ Fri Dec 3 20:09:41 1999 Lars Magne Ingebrigtsen 1999-12-01 21:59:36 Lars Magne Ingebrigtsen * gnus-msg.el (gnus-configure-posting-styles): Ignore nil - signatures. + signatures. * nnweb.el (nnweb-dejanews-create-mapping): Get the data. (nnweb-dejanews-create-mapping): Do the properish date. @@ -1626,12 +2240,12 @@ Fri Dec 3 20:09:41 1999 Lars Magne Ingebrigtsen 1999-12-01 21:59:36 Lars Magne Ingebrigtsen * mm-view.el (mm-inline-message): Check whether charset is a - string. + string. * nnslashdot.el (nnslashdot-request-post): Insert

's. * message.el (message-mode-map): Changed keystroke for - message-yank-buffer. + message-yank-buffer. 1999-11-26 Hrvoje Niksic @@ -1646,7 +2260,7 @@ Fri Dec 3 20:09:41 1999 Lars Magne Ingebrigtsen 1999-12-01 21:08:48 Lars Magne Ingebrigtsen - * mm-view.el (mm-inline-message): Not the right type of charset is + * mm-view.el (mm-inline-message): Not the right type of charset is being fetched here. Let the group charset rule. (mm-inline-message): Ignore us-ascii. @@ -1693,7 +2307,7 @@ Fri Dec 3 20:09:41 1999 Lars Magne Ingebrigtsen * gnus-sum.el (gnus-summary-show-article): Support numbered ARG for charset. (gnus-summary-show-article-charset-alist): New variable. - + * mm-bodies.el (mm-decode-string): Support gnus-all and gnus-unknown. (mm-decode-body): Ditto. @@ -1713,19 +2327,19 @@ Wed Dec 1 16:31:31 1999 Lars Magne Ingebrigtsen * dgnushack.el (dgnushack-compile): No webmail under Emacs. * gnus-sum.el (gnus-summary-refer-article): Wrong interactive - spec. + spec. * gnus-msg.el (gnus-configure-posting-styles): Eval `eval'. (gnus-configure-posting-styles): No, don't. (gnus-configure-posting-styles): Allow overriding files. * gnus-art.el (gnus-header-button-alist): Use browse-url - directly. + directly. * mm-decode.el (mm-inline-media-tests): Check feature vcard. * gnus-msg.el (gnus-summary-yank-message): New command and - keystroke. + keystroke. * message.el (message-yank-buffer): New command. (message-buffers): New function. @@ -1750,7 +2364,7 @@ Wed Dec 1 16:31:31 1999 Lars Magne Ingebrigtsen 1999-11-28 20:22:37 Lars Magne Ingebrigtsen * gnus-art.el (gnus-treatment-function-alist): Do - gnus-treat-capitalize-sentences. + gnus-treat-capitalize-sentences. 1999-11-30 09:07:53 Shenghuo ZHU @@ -1769,7 +2383,7 @@ Wed Dec 1 16:31:31 1999 Lars Magne Ingebrigtsen read groups file. * nnslashdot.el (nnslashdot-request-article): Convert

to -

. +

. 1999-11-24 20:18:24 Lars Magne Ingebrigtsen @@ -1801,7 +2415,7 @@ Wed Dec 1 16:31:31 1999 Lars Magne Ingebrigtsen 1999-11-23 02:33:13 Shenghuo ZHU * webmail.el: Support mail.yahoo.com. - + * mail-source.el (mail-source-fetch-webmail): Add password check. (mail-source-keyword-map): Use `subtype'. @@ -1822,7 +2436,7 @@ Wed Dec 1 16:31:31 1999 Lars Magne Ingebrigtsen 1999-11-20 12:54:25 Lars Magne Ingebrigtsen - * nnultimate.el (nnultimate-request-list): Add fetch-time slot. + * nnultimate.el (nnultimate-request-list): Add fetch-time slot. (nnultimate-prune-days): New function. (nnultimate-create-mapping): Use it. (nnultimate-request-group): Only fetch the groups list if it has @@ -1857,16 +2471,16 @@ Wed Dec 1 16:31:31 1999 Lars Magne Ingebrigtsen * mm-uu.el (mm-uu-dissect): Use fake charset `gnus-decoded'. (mm-uu-test): Now it is in restricted region. - + * gnus-art.el (article-decode-charset): Don't mm-uu-test. - + * mm-view.el (mm-view-message): Fix buffer leak. (mm-inline-message): Support 'gnus-decoded. - + * mm-bodies.el (mm-decode-body): Ditto. * rfc2047.el (rfc2047-decode-region): Ditto. - + 1999-11-18 Matthias Andree * imap.el (require): Added autoload for base64-encode-string. @@ -1874,7 +2488,7 @@ Wed Dec 1 16:31:31 1999 Lars Magne Ingebrigtsen 1999-11-17 Per Abrahamsen * gnus.el (gnus-refer-article-method): Made list value - customizable. + customizable. 1999-11-17 13:09:37 Shenghuo ZHU @@ -1924,7 +2538,7 @@ Wed Dec 1 16:31:31 1999 Lars Magne Ingebrigtsen * gnus.el (gnus-refer-article-method): Doc fix. * gnus-sum.el: Do not accept a prefix. - (gnus-summary-refer-article): Accept a list of select methods. + (gnus-summary-refer-article): Accept a list of select methods. 1999-11-15 21:28:40 Shenghuo ZHU @@ -1977,7 +2591,7 @@ Wed Dec 1 16:31:31 1999 Lars Magne Ingebrigtsen 1999-11-13 Florian Weimer - * mm-util.el (mm-find-mime-charset-region): Use UTF-8 if + * mm-util.el (mm-find-mime-charset-region): Use UTF-8 if it's available and makes sense. 1999-11-12 19:56:23 Fabrice POPINEAU @@ -1997,10 +2611,10 @@ Wed Dec 1 16:31:31 1999 Lars Magne Ingebrigtsen `defconst'. * gnus-cus.el (gnus-group-parameters): Changed from `defcustom' to - `defconst'. - Mention that it is both for group and topic parameters. + `defconst'. + Mention that it is both for group and topic parameters. (gnus-extra-topic-parameters): New constant, including `subscribe' - parameter. + parameter. (gnus-extra-group-parameters): New constant. (gnus-group-customize): Use them. @@ -2012,17 +2626,17 @@ Wed Dec 1 16:31:31 1999 Lars Magne Ingebrigtsen * gnus-int.el (gnus-server-opened): Ignore denied servers. * gnus-ems.el (gnus-mule-max-width-function): New backquote - syntax. + syntax. * nndoc.el (nndoc-mime-digest-type-p): Reinstated. * nnslashdot.el (nnslashdot-group-number): Changed default. - * nnweb.el (nnweb-dejanews-create-mapping): Work with new deja. + * nnweb.el (nnweb-dejanews-create-mapping): Work with new deja. (nnweb-dejanews-wash-article): Removed. (nnweb-type-definition): Fetch by id. - * gnus-msg.el (gnus-configure-posting-styles): Don't insert unless + * gnus-msg.el (gnus-configure-posting-styles): Don't insert unless we mean it. * nnslashdot.el (nnslashdot-group-number): Doc fix. @@ -2041,7 +2655,7 @@ Wed Dec 1 16:31:31 1999 Lars Magne Ingebrigtsen 1999-11-11 10:58:38 Lars Magne Ingebrigtsen * nnultimate.el (nnultimate-retrieve-headers): Work with american - dates. + dates. (nnultimate-retrieve-headers): Wrong ordering. 1999-11-11 07:31:51 Matt Pharr @@ -2066,12 +2680,12 @@ Wed Dec 1 16:31:31 1999 Lars Magne Ingebrigtsen 1999-11-10 12:13:30 Lars Magne Ingebrigtsen - * nnultimate.el (nnultimate-retrieve-headers): Work for multi-page + * nnultimate.el (nnultimate-retrieve-headers): Work for multi-page subjects. 1999-11-10 11:33:23 Rajappa Iyer - * gnus-salt.el (gnus-pick-article-or-thread): Don't move point. + * gnus-salt.el (gnus-pick-article-or-thread): Don't move point. 1999-11-10 05:22:56 Lars Magne Ingebrigtsen @@ -2143,7 +2757,7 @@ Wed Dec 1 16:31:31 1999 Lars Magne Ingebrigtsen (nnslashdot-generate-active): New function. (nnslashdot-request-newgroups): Use it. - * gnus-start.el (gnus-active-to-gnus-format): Intern strings group + * gnus-start.el (gnus-active-to-gnus-format): Intern strings group names. * nnslashdot.el (nnslashdot-request-newgroups): New function. @@ -2159,11 +2773,11 @@ Wed Dec 1 16:31:31 1999 Lars Magne Ingebrigtsen 1999-11-07 01:17:53 Lars Magne Ingebrigtsen - * gnus-start.el (gnus-subscribe-newsgroup-method): Doc fix. + * gnus-start.el (gnus-subscribe-newsgroup-method): Doc fix. * gnus-topic.el (gnus-subscribe-topic): New function. - * nnslashdot.el (nnslashdot-request-list): Give out extended group + * nnslashdot.el (nnslashdot-request-list): Give out extended group names. * gnus-start.el (gnus-ignored-newsgroups): Disregard bogus chars @@ -2181,10 +2795,10 @@ Wed Dec 1 16:31:31 1999 Lars Magne Ingebrigtsen * nnheader.el (nnheader-insert-header): New function. * gnus-art.el (gnus-mime-internalize-part): Bind - mm-inlined-types. + mm-inlined-types. * nndraft.el (nndraft-request-expire-articles): Do all the backup - files. + files. 1999-10-29 David S. Goldberg @@ -2213,7 +2827,7 @@ Wed Dec 1 16:31:31 1999 Lars Magne Ingebrigtsen 1999-11-06 23:16:24 Lars Magne Ingebrigtsen * gnus-art.el (gnus-article-mode-map): Use the summary article - edit. + edit. 1999-11-06 22:56:49 Jens-Ulrik Petersen @@ -2255,7 +2869,7 @@ Wed Dec 1 16:31:31 1999 Lars Magne Ingebrigtsen 1999-11-06 03:51:24 Lars Magne Ingebrigtsen - * message.el (message-newline-and-reformat): Don't insert too many + * message.el (message-newline-and-reformat): Don't insert too many newlines. (message-newline-and-reformat): Work even if not sc. @@ -2274,12 +2888,12 @@ Wed Dec 1 16:31:31 1999 Lars Magne Ingebrigtsen 1999-11-06 02:17:54 Lars Magne Ingebrigtsen * gnus-sum.el (gnus-read-move-group-name): Subscribe to the - group. + group. * message.el (message-forward): Narrow to the right header. * gnus-sum.el (gnus-summary-limit-to-age): Protect against bogus - dates. + dates. * gnus-msg.el (gnus-configure-posting-styles): Use the user-full-name function. @@ -2294,13 +2908,13 @@ Wed Dec 1 16:31:31 1999 Lars Magne Ingebrigtsen 1999-11-05 20:28:27 Lars Magne Ingebrigtsen * gnus-sum.el (gnus-cut-thread): Also cut for numberp - gnus-fetch-old-headers. + gnus-fetch-old-headers. (gnus-cut-threads): Ditto. (gnus-summary-initial-limit): Ditto. (gnus-summary-limit-children): Ditto. * gnus-msg.el (gnus-configure-posting-styles): Allow `header' - matches. + matches. 1999-11-06 Simon Josefsson @@ -2454,7 +3068,7 @@ Fri Nov 5 19:10:02 1999 Lars Magne Ingebrigtsen 1999-09-29 Shenghuo ZHU * mm-uu.el (mm-uu-forward-begin-line): Change the regexp. - (mm-uu-forward-end-line): Ditto. + (mm-uu-forward-end-line): Ditto. 1999-09-29 Didier Verna @@ -2482,11 +3096,11 @@ Fri Nov 5 19:10:02 1999 Lars Magne Ingebrigtsen * rfc1843.el (rfc1843-decode-article-body): Don't decode twice. 1999-09-10 Shenghuo ZHU - + * gnus-art.el (article-make-date-line): Add time-zone in iso8601 format. (article-date-ut): Find correct insert position. - + 1999-09-03 Shenghuo ZHU * mm-uu.el (mm-uu-dissect): Do not dissect quoted-printable @@ -2495,22 +3109,22 @@ Fri Nov 5 19:10:02 1999 Lars Magne Ingebrigtsen 1999-09-27 20:33:41 Lars Magne Ingebrigtsen * gnus-topic.el (gnus-topic-find-groups): Work for unactivated - groups. + groups. - * message.el (message-resend): Use message mode when prompting. + * message.el (message-resend): Use message mode when prompting. * gnus-art.el (article-hide-headers): Mark wash. (article-emphasize): Ditto. 1999-09-27 19:52:14 Vladimir Volovich - * message.el (message-newline-and-reformat): Work for SC. + * message.el (message-newline-and-reformat): Work for SC. 1999-09-27 19:38:33 Lars Magne Ingebrigtsen * gnus-msg.el (gnus-group-posting-charset-alist): 2047 in de.*. - * gnus-sum.el (gnus-newsgroup-ignored-charsets): Add x-unknown. + * gnus-sum.el (gnus-newsgroup-ignored-charsets): Add x-unknown. 1999-10-20 David S. Goldberg @@ -2544,21 +3158,21 @@ Mon Sep 27 15:18:05 1999 Lars Magne Ingebrigtsen buffer for params. * gnus-xmas.el (gnus-xmas-summary-recenter): Display one more - line. + line. * message.el (message-forward-ignored-headers): New variable. * gnus-art.el (gnus-article-prepare-display): Nix out - gnus-article-wash-types. + gnus-article-wash-types. * gnus-agent.el (gnus-agent-create-buffer): New function. (gnus-agent-fetch-group-1): Use it. (gnus-agent-start-fetch): Ditto. * gnus-sum.el (gnus-summary-exit): Don't use - `gnus-use-adaptive-scoring'. + `gnus-use-adaptive-scoring'. - * mail-source.el (mail-source-fetch-pop): Only store password when + * mail-source.el (mail-source-fetch-pop): Only store password when successful. * gnus-nocem.el (gnus-nocem-scan-groups): Message better. @@ -2575,7 +3189,7 @@ Mon Sep 27 15:18:05 1999 Lars Magne Ingebrigtsen * message.el (message-bounce): Work for non-MIME. * gnus.el (gnus-short-group-name): Short the right parts of the - name. + name. 1999-09-24 18:17:48 Johan Kullstam @@ -2605,7 +3219,7 @@ Mon Sep 27 15:18:05 1999 Lars Magne Ingebrigtsen 1999-09-24 18:10:56 Robert Bihlmeyer * gnus-score.el (gnus-summary-increase-score): Allow editing of - Message-ID. + Message-ID. 1999-09-08 Shenghuo ZHU @@ -2643,15 +3257,15 @@ Mon Sep 27 15:18:05 1999 Lars Magne Ingebrigtsen 1999-08-27 20:46:11 Lars Magne Ingebrigtsen - * gnus-cache.el (gnus-cache-write-active): Write full names. + * gnus-cache.el (gnus-cache-write-active): Write full names. - * gnus-util.el (gnus-write-active-file): Accept full name. + * gnus-util.el (gnus-write-active-file): Accept full name. - * mm-decode.el (mm-inlinable-p): Use string-match on the types. + * mm-decode.el (mm-inlinable-p): Use string-match on the types. (mm-assoc-string-match): New function. (mm-display-inline): Use it. - * gnus-group.el (gnus-group-set-info): Work for nil group params. + * gnus-group.el (gnus-group-set-info): Work for nil group params. * gnus-msg.el (gnus-configure-posting-styles): Allow eval. @@ -2709,7 +3323,7 @@ Fri Aug 27 13:17:48 1999 Lars Magne Ingebrigtsen 1999-08-27 15:02:58 Florian Weimer * gnus-score.el (gnus-home-score-file): Work with absolute path - names. + names. 1999-07-17 Shenghuo ZHU @@ -2761,7 +3375,7 @@ Fri Aug 27 13:17:48 1999 Lars Magne Ingebrigtsen * mml.el (mml-generate-mime-1): Insert non-text literally. - * gnus.el: Change most mm-insert-file-contents back to nnheader. + * gnus.el: Change most mm-insert-file-contents back to nnheader. 1999-07-13 Hrvoje Niksic @@ -2770,7 +3384,7 @@ Fri Aug 27 13:17:48 1999 Lars Magne Ingebrigtsen 1999-08-27 14:53:42 Oleg S. Tihonov * gnus-sum.el (gnus-group-charset-alist): Default fido7 to - koi8-r. + koi8-r. 1999-07-11 Shenghuo ZHU @@ -2779,7 +3393,7 @@ Fri Aug 27 13:17:48 1999 Lars Magne Ingebrigtsen 1999-07-11 Shenghuo ZHU - * mm-view.el (mm-inline-text): Check + * mm-view.el (mm-inline-text): Check w3-meta-content-type-charset-regexp. 1999-07-10 Simon Josefsson @@ -2807,7 +3421,7 @@ Fri Aug 27 13:17:48 1999 Lars Magne Ingebrigtsen 1999-08-27 14:38:14 Lars Magne Ingebrigtsen * gnus-group.el (gnus-group-kill-all-zombies): Only prompt when - interactive. + interactive. 1999-07-12 Shenghuo ZHU @@ -2824,7 +3438,7 @@ Fri Aug 27 13:17:48 1999 Lars Magne Ingebrigtsen 1999-08-27 14:22:39 Jon Kv - * nnfolder.el (nnfolder-request-list-newsgroups): Faster expiry. + * nnfolder.el (nnfolder-request-list-newsgroups): Faster expiry. 1999-07-10 Mike McEwan @@ -2851,15 +3465,15 @@ Fri Aug 27 13:17:48 1999 Lars Magne Ingebrigtsen 1999-07-11 11:02:03 Lars Magne Ingebrigtsen - * mm-encode.el (mm-qp-or-base64): Also consider control chars. + * mm-encode.el (mm-qp-or-base64): Also consider control chars. (mm-qp-or-base64): Reversed logic. * mm-decode.el (mm-save-part-to-file): Let coding system be - binary. + binary. 1999-07-15 Mike McEwan - * gnus-agent.el (gnus-agent-fetch-group-1): Allow 'agent-score' to + * gnus-agent.el (gnus-agent-fetch-group-1): Allow 'agent-score' to be set in topic parameters. 1999-07-10 Mike McEwan @@ -2939,7 +3553,7 @@ Fri Jul 9 19:28:29 1999 Lars Magne Ingebrigtsen 1999-07-09 18:52:22 Lars Magne Ingebrigtsen * gnus-art.el (gnus-mime-view-part-as-media): New command and - keystroke. + keystroke. * mailcap.el (mailcap-mime-types): New function. @@ -2955,7 +3569,7 @@ Fri Jul 9 19:28:29 1999 Lars Magne Ingebrigtsen 1999-07-09 18:36:21 Lars Magne Ingebrigtsen * gnus-group.el (gnus-group-make-menu-bar): Removed double bug - report. + report. 1999-07-08 Shenghuo ZHU @@ -2985,7 +3599,7 @@ Wed Jul 7 18:40:30 1999 Shenghuo ZHU 1999-07-08 08:41:10 Lars Magne Ingebrigtsen * mailcap.el (mailcap-mime-extensions): Changed patch to - text/x-patch. + text/x-patch. * mm-decode.el (mm-display-external): Wrong placement of paren. @@ -3026,19 +3640,19 @@ Wed Jul 7 13:09:51 1999 Lars Magne Ingebrigtsen * pop3.el: New version. -1999-07-05 Simon Josefsson +1999-07-05 Simon Josefsson * gnus-srvr.el (gnus-browse-foreign-server): Use read. 1999-07-07 10:37:26 Lars Magne Ingebrigtsen - * gnus-art.el (gnus-mime-display-alternative): Do treatment. + * gnus-art.el (gnus-mime-display-alternative): Do treatment. 1999-07-06 Shenghuo ZHU * gnus-util.el (gnus-write-active-file): Use real name. - * gnus-agent.el (gnus-agent-expire): Update active file + * gnus-agent.el (gnus-agent-expire): Update active file method by method. 1999-07-06 Shenghuo ZHU @@ -3091,12 +3705,12 @@ Tue Jul 6 10:59:24 1999 Lars Magne Ingebrigtsen 1999-07-06 12:30:59 Johannes Weinert - * gnus-sum.el (gnus-summary-catchup-and-exit): Doc fix. + * gnus-sum.el (gnus-summary-catchup-and-exit): Doc fix. 1999-07-06 07:41:07 Lars Magne Ingebrigtsen * nntp.el (nntp-retrieve-groups): Don't do anything when not - connected. + connected. * gnus-start.el (gnus-active-to-gnus-format): Only save active when plugged. @@ -3106,17 +3720,17 @@ Tue Jul 6 10:59:24 1999 Lars Magne Ingebrigtsen * gnus-agent.el (gnus-agent-write-active): Check whether orig sym is bound. - * gnus-msg.el (gnus-summary-mail-forward): Rename From_ lines. + * gnus-msg.el (gnus-summary-mail-forward): Rename From_ lines. - * nndoc.el (nndoc-guess-type): Remove blank lines at the start. + * nndoc.el (nndoc-guess-type): Remove blank lines at the start. * nnfolder.el (nnfolder-read-folder): Remove blank lines at the - start. + start. * message.el (message-fill-yanked-message): Remove `t' arg. * gnus-group.el (gnus-group-kill-group): Message killing of - groups. + groups. * mm-util.el (mm-preferred-coding-system): New function. (mm-mime-charset): Use it. @@ -3130,14 +3744,14 @@ Tue Jul 6 10:59:24 1999 Lars Magne Ingebrigtsen 1999-07-06 05:47:57 Lars Magne Ingebrigtsen * mm-decode.el (mm-inline-Media-tests): Changed from forms to - functions. + functions. (mm-attachment-override-p): Take a handle instead of a type. (mm-inlined-p): Ditto. (mm-automatic-display-p): Ditto, (mm-inlinable-p): Ditto. * nndraft.el (nndraft-request-expire-articles): Delete backup - files. + files. * mailcap.el (mailcap-parse-mailcap): Regexp-quote stuff. @@ -3151,7 +3765,7 @@ Tue Jul 6 10:59:24 1999 Lars Magne Ingebrigtsen * mm-decode.el (mm-inline-large-images-p): Renamed. - * gnus-art.el (article-date-ut): Always look in the current buffer + * gnus-art.el (article-date-ut): Always look in the current buffer for the Date header. * mml.el (mml-validate): New command. @@ -3209,7 +3823,7 @@ Sun Jul 4 06:31:01 1999 Lars Magne Ingebrigtsen * mml.el (mml-generate-mime-1): Ditto. * gnus.el: Use mm-insert-file-contents throughout instead of - nnheader. + nnheader. * mm-util.el (mm-insert-file-contents): New function. @@ -3308,7 +3922,7 @@ Sat Jul 3 07:35:35 1999 Lars Magne Ingebrigtsen 1999-07-03 09:15:35 Simon Josefsson * gnus-sum.el (gnus-summary-move-article): Fix something or - other. + other. 1999-06-29 Shenghuo ZHU @@ -3410,7 +4024,7 @@ Tue Jun 15 04:13:01 1999 Lars Magne Ingebrigtsen 1999-06-15 04:13:45 Lars Magne Ingebrigtsen * gnus-sum.el (gnus-summary-save-parts): Destroy handles after - usage. + usage. * nnmail.el (nnmail-get-new-mail): Save info. @@ -3420,13 +4034,13 @@ Mon Jun 14 01:15:59 1999 Lars Magne Ingebrigtsen 1999-06-14 02:46:05 Lars Magne Ingebrigtsen - * mail-source.el (mail-source-fetch-file): Use prescript-delay. + * mail-source.el (mail-source-fetch-file): Use prescript-delay. (mail-source-run-script): New function. (mail-source-fetch-pop): Use it. 1999-06-13 09:52:11 Lars Magne Ingebrigtsen - * gnus-art.el (gnus-article-setup-highlight-words): Moved here. + * gnus-art.el (gnus-article-setup-highlight-words): Moved here. Sun Jun 13 07:30:40 1999 Lars Magne Ingebrigtsen @@ -3447,7 +4061,7 @@ Sun Jun 13 07:30:40 1999 Lars Magne Ingebrigtsen * gnus-art.el (article-babel): Narrow a bit. - * gnus-agent.el (gnus-agent-get-undownloaded-list): Was too slow. + * gnus-agent.el (gnus-agent-get-undownloaded-list): Was too slow. 1999-06-12 Simon Josefsson @@ -3459,7 +4073,7 @@ Sun Jun 13 07:30:40 1999 Lars Magne Ingebrigtsen 1999-06-13 03:01:35 Lars Magne Ingebrigtsen * gnus-sum.el (gnus-summary-limit-to-extra): New command and - keystroke. + keystroke. * gnus-art.el (gnus-article-x-face-command): Ditto. @@ -3480,7 +4094,7 @@ Sun Jun 13 07:30:40 1999 Lars Magne Ingebrigtsen * gnus-util.el (gnus-parse-netrc): Skip lines with #'s. (gnus-netrc-syntax-table): Removed. - (gnus-parse-netrc): Don't use syntax table; just use whitespace. + (gnus-parse-netrc): Don't use syntax table; just use whitespace. Wed May 5 13:51:13 1999 Shenghuo ZHU @@ -3493,7 +4107,7 @@ Wed May 5 01:15:08 1999 Shenghuo ZHU 1999-06-12 07:29:39 Lars Magne Ingebrigtsen * nnmail.el (nnmail-split-incoming): Return the number of split - mails. + mails. (nnmail-process-babyl-mail-format): Ditto. (nnmail-process-unix-mail-format): Ditto. (nnmail-process-mmdf-mail-format): Ditto. @@ -3524,7 +4138,7 @@ Sun May 2 01:00:02 1999 Shenghuo ZHU * gnus-cache.el (gnus-cache-possibly-enter-article): Remove parameter `headers'. (gnus-cache-enter-article): Ditto. - (gnus-cache-update-article): Ditto. + (gnus-cache-update-article): Ditto. * gnus-sum.el (gnus-summary-move-article): Ditto. (gnus-summary-mark-article-as-unread): Ditto. (gnus-summary-mark-article): Ditto. @@ -3552,7 +4166,7 @@ Sat Jun 12 00:19:57 1999 Lars Magne Ingebrigtsen 1999-06-12 02:09:49 Lars Magne Ingebrigtsen * nndoc.el (nndoc-mime-parts-type-p): Accept space before - semicolon. + semicolon. 1999-05-24 Simon Josefsson @@ -3601,11 +4215,11 @@ Sat Jun 12 00:19:57 1999 Lars Magne Ingebrigtsen 1999-05-22 00:26:46 Lars Magne Ingebrigtsen * gnus-sum.el (gnus-summary-save-parts): New command and - keystroke. + keystroke. (gnus-summary-save-parts-1): New function. (gnus-summary-iterate): Buggy. - * mm-decode.el (mm-save-part-to-file): Made into own function. + * mm-decode.el (mm-save-part-to-file): Made into own function. 1999-05-11 05:53:16 Lars Magne Ingebrigtsen @@ -3663,24 +4277,24 @@ Sat May 1 20:27:43 1999 Lars Magne Ingebrigtsen * gnus-art.el (gnus-article-date-lapsed-new-header): Default to nil. - * qp.el (quoted-printable-encode-region): Encode whitespace at the + * qp.el (quoted-printable-encode-region): Encode whitespace at the end of lines. * message.el (message-mode): Doc fix. - * gnus-art.el (article-hide-headers): Delete the hidden headers. + * gnus-art.el (article-hide-headers): Delete the hidden headers. - * gnus-msg.el (gnus-setup-posting-charset): Default group to "". + * gnus-msg.el (gnus-setup-posting-charset): Default group to "". * gnus-art.el (article-date-ut): Rewrite. * mm-decode.el (mm-preferred-alternative-precedence): Reverse the - order. + order. * gnus-msg.el (gnus-message-insert-stylings): Remove duplicate - headers. + headers. - * gnus-art.el (gnus-article-date-lapsed-new-header): Doc fix. + * gnus-art.el (gnus-article-date-lapsed-new-header): Doc fix. 1999-04-18 Didier Verna @@ -3690,7 +4304,7 @@ Sat May 1 20:27:43 1999 Lars Magne Ingebrigtsen 1999-04-18 20:06:20 Lars Magne Ingebrigtsen * mail-source.el (mail-source-fetch-pop): Call script - asynchronously. + asynchronously. Sun Apr 18 12:40:04 1999 Lars Magne Ingebrigtsen @@ -3704,12 +4318,12 @@ Sun Apr 18 12:40:04 1999 Lars Magne Ingebrigtsen * gnus-uu.el (gnus-uu-mark-thread): Save hidden threads. - * gnus-art.el (gnus-mime-inline-part): Don't do a charset param. + * gnus-art.el (gnus-mime-inline-part): Don't do a charset param. * gnus-msg.el (gnus-bug): Use application/x-emacs-lisp. * message.el (message-generate-headers): Accept continuation - headers. + headers. 1999-04-18 10:48:57 Renaud Rioboo @@ -3723,12 +4337,12 @@ Sun Apr 18 12:40:04 1999 Lars Magne Ingebrigtsen * message.el (message-inhibit-body-encoding): Typo. (message-resend): Inhibit encoding. - * gnus-sum.el (gnus-summary-toggle-header): Decode rfc2047. + * gnus-sum.el (gnus-summary-toggle-header): Decode rfc2047. * gnus-art.el (article-remove-cr): Use re-search. * rfc2231.el (rfc2231-parse-string): Allow broken elm MIME - headers. + headers. * mm-decode.el (mm-quote-arg): Quote '. @@ -3741,10 +4355,10 @@ Sun Apr 18 12:40:04 1999 Lars Magne Ingebrigtsen 1999-04-17 18:51:54 Lars Magne Ingebrigtsen - * nnvirtual.el (nnvirtual-request-expire-articles): New function. + * nnvirtual.el (nnvirtual-request-expire-articles): New function. * gnus-group.el (gnus-group-expire-articles-1): Made into own - function. + function. Sat Apr 17 16:41:30 1999 Lars Magne Ingebrigtsen @@ -3757,7 +4371,7 @@ Sat Apr 17 16:41:30 1999 Lars Magne Ingebrigtsen 1999-04-17 18:23:50 Lars Magne Ingebrigtsen - * mm-util.el (mm-charset-synonym-alist): Remove iso-2022-jp-2 from + * mm-util.el (mm-charset-synonym-alist): Remove iso-2022-jp-2 from synonym alist. 1999-04-17 18:03:38 Adam P. Jenkins @@ -3766,7 +4380,7 @@ Sat Apr 17 16:41:30 1999 Lars Magne Ingebrigtsen 1999-04-17 18:02:05 Ettore Perazzoli - * mail-source.el (mail-source-fetch): Ask before bugging out. + * mail-source.el (mail-source-fetch): Ask before bugging out. 1999-03-19 Hrvoje Niksic @@ -3776,7 +4390,7 @@ Sat Apr 17 16:41:30 1999 Lars Magne Ingebrigtsen 1999-03-18 Simon Josefsson * gnus-sum.el (gnus-update-marks): - (gnus-update-read-articles): + (gnus-update-read-articles): (gnus-summary-expire-articles): Check server. 1999-03-16 Simon Josefsson @@ -3786,7 +4400,7 @@ Sat Apr 17 16:41:30 1999 Lars Magne Ingebrigtsen 1999-04-17 17:10:21 William M. Perry * mail-source.el (mail-source-fetch-file): Return the right - value. + value. 1999-04-17 07:52:17 Lars Magne Ingebrigtsen @@ -3806,7 +4420,7 @@ Sat Apr 17 16:41:30 1999 Lars Magne Ingebrigtsen * mail-source.el (mail-sources): New variable. - * gnus-art.el (article-remove-cr): Remove several trailing CRs. + * gnus-art.el (article-remove-cr): Remove several trailing CRs. * mm-decode.el (mm-valid-image-format-p): New function. (mm-inline-media-tests): Use it. @@ -3818,7 +4432,7 @@ Sat Apr 17 16:41:30 1999 Lars Magne Ingebrigtsen 1999-04-12 Didier Verna * nnmail.el (nnmail-article-group): in case of a group name - containing "\\n" constructs, be sure to pass the expanded value to + containing "\\n" constructs, be sure to pass the expanded value to nn*-save-mail. Sat Apr 17 05:40:45 1999 Lars Magne Ingebrigtsen @@ -3862,7 +4476,7 @@ Sat Apr 17 05:40:45 1999 Lars Magne Ingebrigtsen 1999-03-28 13:19:50 Jae-you Chung * gnus.el (gnus-short-group-name): Use - gnus-group-uncollapsed-levels. + gnus-group-uncollapsed-levels. 1999-03-28 13:11:43 Lars Magne Ingebrigtsen @@ -3875,7 +4489,7 @@ Sat Apr 17 05:40:45 1999 Lars Magne Ingebrigtsen 1999-03-14 16:09:10 Lars Magne Ingebrigtsen - * mail-source.el (mail-source-fetch-pop): Check for symbol first. + * mail-source.el (mail-source-fetch-pop): Check for symbol first. * nnheader.el (nnheader-insert-file-contents): Bind enable-local-eval to nil. @@ -3896,15 +4510,15 @@ Sat Apr 17 05:40:45 1999 Lars Magne Ingebrigtsen * nnmail.el (nnmail-split-header-length-limit): Increased. (nnmail-article-group): Allow nil. - * gnus-cite.el (gnus-cite-parse-wrapper): Inhibit point-motion. + * gnus-cite.el (gnus-cite-parse-wrapper): Inhibit point-motion. * nndoc.el (nndoc-generate-mime-parts-head): Insert real headers - first. + first. * mml.el (mml-minibuffer-read-type): Include types from - mailcap-mime-data. + mailcap-mime-data. - * nndraft.el (nndraft-request-article): Would clobber Japanese. + * nndraft.el (nndraft-request-article): Would clobber Japanese. 1999-03-05 Hrvoje Niksic @@ -3947,7 +4561,7 @@ Sat Apr 17 05:40:45 1999 Lars Magne Ingebrigtsen * gnus-picon.el (gnus-picons-x-face-file-name): Removed. (gnus-picons-convert-x-face): Removed. (gnus-picons-article-display-x-face): Removed. - (gnus-picons-x-face-sentinel): Ditto. + (gnus-picons-x-face-sentinel): Ditto. (gnus-picons-display-x-face): Ditto. Thu Mar 4 01:38:00 1999 Lars Magne Ingebrigtsen @@ -3956,7 +4570,7 @@ Thu Mar 4 01:38:00 1999 Lars Magne Ingebrigtsen 1999-03-02 16:04:30 Lars Magne Ingebrigtsen - * gnus-art.el (gnus-mm-display-part): Narrow to the part itself. + * gnus-art.el (gnus-mm-display-part): Narrow to the part itself. * gnus-sum.el (gnus-with-article): Moved here. @@ -3990,7 +4604,7 @@ Thu Mar 4 01:38:00 1999 Lars Magne Ingebrigtsen 1999-02-27 23:44:52 paul stevenson - * gnus-sum.el (gnus-summary-toggle-header): Narrow to head first. + * gnus-sum.el (gnus-summary-toggle-header): Narrow to head first. 1999-02-27 17:17:47 Lars Magne Ingebrigtsen @@ -4001,7 +4615,7 @@ Thu Mar 4 01:38:00 1999 Lars Magne Ingebrigtsen * message.el (message-mode): Doc fix. * mm-encode.el (mm-content-transfer-encoding-defaults): Use 8bit - encoding. + encoding. * gnus.el (gnus-methods-equal-p): Moved here. @@ -4012,7 +4626,7 @@ Thu Mar 4 01:38:00 1999 Lars Magne Ingebrigtsen 1999-02-27 lantz moore - * nnmail.el (nnmail-get-new-mail): honor suffix for spool-files of + * nnmail.el (nnmail-get-new-mail): honor suffix for spool-files of type directory. 1999-03-04 Robert Bihlmeyer @@ -4026,7 +4640,7 @@ Fri Feb 26 18:54:16 1999 Lars Magne Ingebrigtsen 1999-02-26 18:11:04 Lars Magne Ingebrigtsen - * gnus-cite.el (gnus-cite-toggle): Don't remove highlighting. + * gnus-cite.el (gnus-cite-toggle): Don't remove highlighting. * mml.el (mml-mode): Don't use add-minor-mode. @@ -4049,7 +4663,7 @@ Fri Feb 26 17:00:25 1999 Lars Magne Ingebrigtsen * gnus-ems.el (gnus-mule-cite-add-face): Removed. * gnus-sum.el (gnus-summary-sort-by-chars): New command and - keystroke. + keystroke. * gnus-art.el (gnus-narrow-to-page): Revert. @@ -4057,7 +4671,7 @@ Fri Feb 26 17:00:25 1999 Lars Magne Ingebrigtsen (gnus-cite-parse-maybe): Always reparse. * message.el (message-encode-message-body): Don't insert - "multipart warning". + "multipart warning". * gnus-art.el (gnus-article-treat-head-custom): New variable. @@ -4070,7 +4684,7 @@ Fri Feb 26 17:00:25 1999 Lars Magne Ingebrigtsen 1999-02-26 07:39:33 Justin Sheehy * nnmail.el (nnmail-get-new-mail): Only get mail for the one - group. + group. 1999-02-26 07:38:08 SeokChan LEE @@ -4109,7 +4723,7 @@ Fri Feb 26 17:00:25 1999 Lars Magne Ingebrigtsen * mml.el (mml-insert-buffer): New function. - * message.el (message-forward): Insert the buffer in the buffer. + * message.el (message-forward): Insert the buffer in the buffer. Sun Feb 21 01:20:50 1999 Shenghuo ZHU @@ -4128,14 +4742,14 @@ Sat Feb 20 21:34:28 1999 Lars Magne Ingebrigtsen * gnus-art.el (gnus-displaying-mime): New variable. (article-narrow-to-head): New function. - * mail-source.el (mail-source-fetch-pop): Include pre/postscript. + * mail-source.el (mail-source-fetch-pop): Include pre/postscript. Default to pop instead of pop3. 1999-02-19 16:16:04 Lars Magne Ingebrigtsen * gnus-art.el (article-hide-pgp): Goto body. - * gnus-uu.el (gnus-uu-digest-mail-forward): Don't kill buffer. + * gnus-uu.el (gnus-uu-digest-mail-forward): Don't kill buffer. * gnus-cite.el: Don't use goto-line. @@ -4169,7 +4783,7 @@ Sat Feb 20 21:34:28 1999 Lars Magne Ingebrigtsen 1999-02-19 14:40:37 Lars Magne Ingebrigtsen - * gnus-group.el (gnus-group-get-new-news): Require nnmail. + * gnus-group.el (gnus-group-get-new-news): Require nnmail. 1999-02-18 Michael Cook @@ -4206,7 +4820,7 @@ Sat Feb 20 21:34:28 1999 Lars Magne Ingebrigtsen 1999-02-11 Matt Pharr * gnus-msg.el (gnus-bug): Encode environment info as a MIME - attachment. + attachment. Thu Feb 11 04:58:51 1999 Lars Magne Ingebrigtsen diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index fae871e..45f2b36 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -433,7 +433,7 @@ Currently sends flag setting requests, if any." (when (file-exists-p (gnus-agent-lib-file "flags")) (set-buffer (get-buffer-create " *Gnus Agent flag synchronize*")) (erase-buffer) - (insert-file-contents (gnus-agent-lib-file "flags")) + (nnheader-insert-file-contents (gnus-agent-lib-file "flags")) (if (null (gnus-check-server gnus-command-method)) (message "Couldn't open server %s" (nth 1 gnus-command-method)) (while (not (eobp)) @@ -443,7 +443,8 @@ Currently sends flag setting requests, if any." (write-file (gnus-agent-lib-file "flags")) (error "Couldn't set flags from file %s" (gnus-agent-lib-file "flags")))) - (write-file (gnus-agent-lib-file "flags"))))))) + (write-file (gnus-agent-lib-file "flags"))) + (kill-buffer nil))))) ;;; ;;; Server mode commands @@ -483,8 +484,10 @@ Currently sends flag setting requests, if any." (defun gnus-agent-write-servers () "Write the alist of covered servers." (gnus-make-directory (nnheader-concat gnus-agent-directory "lib")) - (with-temp-file (nnheader-concat gnus-agent-directory "lib/servers") - (prin1 gnus-agent-covered-methods (current-buffer)))) + (let ((coding-system-for-write nnheader-file-coding-system) + (file-name-coding-system nnmail-pathname-coding-system)) + (with-temp-file (nnheader-concat gnus-agent-directory "lib/servers") + (prin1 gnus-agent-covered-methods (current-buffer))))) ;;; ;;; Summary commands @@ -591,7 +594,7 @@ the actual number of articles toggled is returned." (funcall function nil new) (gnus-agent-write-active file new) (erase-buffer) - (insert-file-contents-literally file)))) + (nnheader-insert-file-contents file)))) (defun gnus-agent-write-active (file new) (let ((orig (gnus-make-hashtable (count-lines (point-min) (point-max)))) @@ -599,7 +602,7 @@ the actual number of articles toggled is returned." elem osym) (when (file-exists-p file) (with-temp-buffer - (insert-file-contents file) + (nnheader-insert-file-contents file) (gnus-active-to-gnus-format nil orig)) (mapatoms (lambda (sym) @@ -621,10 +624,14 @@ the actual number of articles toggled is returned." (defun gnus-agent-save-group-info (method group active) (when (gnus-agent-method-p method) (let* ((gnus-command-method method) + (coding-system-for-write nnheader-file-coding-system) + (file-name-coding-system nnmail-pathname-coding-system) (file (gnus-agent-lib-file "active")) oactive) (gnus-make-directory (file-name-directory file)) (with-temp-file file + ;; Emacs got problem to match non-ASCII group in multibyte buffer. + (mm-disable-multibyte) (when (file-exists-p file) (nnheader-insert-file-contents file)) (goto-char (point-min)) @@ -684,11 +691,12 @@ the actual number of articles toggled is returned." (format " *Gnus agent %s history*" (gnus-agent-method))))) gnus-agent-history-buffers) + (mm-disable-multibyte) ;; everything is binary (erase-buffer) (insert "\n") (let ((file (gnus-agent-lib-file "history"))) (when (file-exists-p file) - (insert-file file)) + (nnheader-insert-file-contents file)) (set (make-local-variable 'gnus-agent-file-name) file)))) (defun gnus-agent-save-history () @@ -956,15 +964,16 @@ the actual number of articles toggled is returned." (defun gnus-agent-save-alist (group &optional articles state dir) "Save the article-state alist for GROUP." - (with-temp-file (if dir - (concat dir ".agentview") - (gnus-agent-article-name ".agentview" group)) - (princ (setq gnus-agent-article-alist - (nconc gnus-agent-article-alist - (mapcar (lambda (article) (cons article state)) - articles))) - (current-buffer)) - (insert "\n"))) + (let ((file-name-coding-system nnmail-pathname-coding-system)) + (with-temp-file (if dir + (concat dir ".agentview") + (gnus-agent-article-name ".agentview" group)) + (princ (setq gnus-agent-article-alist + (nconc gnus-agent-article-alist + (mapcar (lambda (article) (cons article state)) + articles))) + (current-buffer)) + (insert "\n")))) (defun gnus-agent-article-name (article group) (concat (gnus-agent-directory) (gnus-agent-group-path group) "/" @@ -1448,7 +1457,7 @@ The following commands are available: (while (setq gnus-command-method (pop methods)) (when (file-exists-p (gnus-agent-lib-file "active")) (with-temp-buffer - (insert-file-contents (gnus-agent-lib-file "active")) + (nnheader-insert-file-contents (gnus-agent-lib-file "active")) (gnus-active-to-gnus-format gnus-command-method (setq orig (gnus-make-hashtable diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 94d97e5..cbe7460 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -198,10 +198,11 @@ regexp. If it matches, the text in question is not a signature." :type 'sexp :group 'gnus-article-hiding) +;; Fixme: This isn't the right thing for mixed graphical and and +;; non-graphical frames in a session. (defcustom gnus-article-x-face-command (if (and (fboundp 'image-type-available-p) - (or (image-type-available-p 'xpm) - (image-type-available-p 'xbm))) + (image-type-available-p 'xbm)) 'gnus-article-display-xface "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | display -") "*String or function to be executed to display an X-Face header. @@ -253,6 +254,14 @@ is the face used for highlighting." face)) :group 'gnus-article-emphasis) +(defcustom gnus-emphasize-whitespace-regexp "^[ \t]+\\|[ \t]*\n" + "A regexp to describe whitespace which should not be emphasized. +Typical values are \"^[ \\t]+\\\\|[ \\t]*\\n\" and \"[ \\t]+\\\\|[ \\t]*\\n\". +The former avoids underlining of leading and trailing whitespace, +and the latter avoids underlining any whitespace at all." + :group 'gnus-article-emphasis + :type 'regexp) + (defface gnus-emphasis-bold '((t (:bold t))) "Face used for displaying strong emphasized text (*word*)." :group 'gnus-article-emphasis) @@ -1446,7 +1455,7 @@ If PROMPT (the prefix), prompt for a coding system to use." (set-buffer gnus-summary-buffer) (error)) gnus-newsgroup-ignored-charsets)) - ct cte ctl charset) + ct cte ctl charset format) (save-excursion (save-restriction (article-narrow-to-head) @@ -1458,7 +1467,8 @@ If PROMPT (the prefix), prompt for a coding system to use." (prompt (mm-read-coding-system "Charset to decode: ")) (ctl - (mail-content-type-get ctl 'charset)))) + (mail-content-type-get ctl 'charset))) + format (and ctl (mail-content-type-get ctl 'format))) (when cte (setq cte (mail-header-strip cte))) (if (and ctl (not (string-match "/" (car ctl)))) @@ -1467,8 +1477,13 @@ If PROMPT (the prefix), prompt for a coding system to use." (forward-line 1) (save-restriction (narrow-to-region (point) (point-max)) + (if (and (eq mail-parse-charset 'gnus-decoded) + (eq (mm-body-7-or-8) '8bit)) + ;; The text code could have been decoded. + (setq charset mail-parse-charset)) (when (and (or (not ctl) - (equal (car ctl) "text/plain"))) + (equal (car ctl) "text/plain")) + (not format)) ;; article with format will decode later. (mm-decode-body charset (and cte (intern (downcase (gnus-strip-whitespace cte)))) @@ -1502,6 +1517,23 @@ or not." (article-goto-body) (quoted-printable-decode-region (point) (point-max) charset))))) +(defun article-de-base64-unreadable (&optional force) + "Translate a base64 article. +If FORCE, decode the article whether it is marked as base64 not." + (interactive (list 'force)) + (save-excursion + (let ((buffer-read-only nil) + (type (gnus-fetch-field "content-transfer-encoding")) + (charset gnus-newsgroup-charset)) + (when (or force + (and type (string-match "quoted-printable" (downcase type)))) + (article-goto-body) + (save-restriction + (narrow-to-region (point) (point-max)) + (base64-decode-region (point-min) (point-max)) + (if (mm-coding-system-p charset) + (mm-decode-coding-region (point-min) (point-max) charset))))))) + (eval-when-compile (require 'rfc1843)) @@ -1513,6 +1545,23 @@ or not." (let ((buffer-read-only nil)) (rfc1843-decode-region (point-min) (point-max))))) +(defun article-wash-html () + "Format an html article." + (interactive) + (save-excursion + (let ((buffer-read-only nil) + (charset gnus-newsgroup-charset)) + (article-goto-body) + (save-window-excursion + (save-restriction + (narrow-to-region (point) (point-max)) + (mm-setup-w3) + (let ((w3-strict-width (window-width)) + (url-standalone-mode t)) + (condition-case var + (w3-region (point-min) (point-max)) + (error)))))))) + (defun article-hide-list-identifiers () "Remove list identifies from the Subject header. The `gnus-list-identifiers' variable specifies what to do." @@ -1527,9 +1576,14 @@ The `gnus-list-identifiers' variable specifies what to do." (when regexp (goto-char (point-min)) (when (re-search-forward - (concat "^Subject: +\\(Re: +\\)?\\(" regexp " *\\)") + (concat "^Subject: +\\(\\(\\(Re: +\\)?\\(" regexp + " *\\)\\)+\\(Re: +\\)?\\)") nil t) - (delete-region (match-beginning 2) (match-end 0))))))))) + (let ((s (or (match-string 3) (match-string 5)))) + (delete-region (match-beginning 1) (match-end 1)) + (when s + (goto-char (match-beginning 1)) + (insert s)))))))))) (defun article-hide-pgp () "Remove any PGP headers and signatures in the current article." @@ -2425,17 +2479,16 @@ If variable `gnus-use-long-file-name' is non-nil, it is gfunc (cdr func)) (setq afunc func gfunc (intern (format "gnus-%s" func)))) - (fset gfunc - (if (not (fboundp afunc)) - nil - `(lambda (&optional interactive &rest args) - ,(documentation afunc t) - (interactive (list t)) - (save-excursion - (set-buffer gnus-article-buffer) - (if interactive - (call-interactively ',afunc) - (apply ',afunc args)))))))) + (defalias gfunc + (if (fboundp afunc) + `(lambda (&optional interactive &rest args) + ,(documentation afunc t) + (interactive (list t)) + (save-excursion + (set-buffer gnus-article-buffer) + (if interactive + (call-interactively ',afunc) + (apply ',afunc args)))))))) '(article-hide-headers article-hide-boring-headers article-treat-overstrike @@ -2444,7 +2497,9 @@ If variable `gnus-use-long-file-name' is non-nil, it is article-remove-cr article-display-x-face article-de-quoted-unreadable + article-de-base64-unreadable article-decode-HZ + article-wash-html article-mime-decode-quoted-printable article-hide-list-identifiers article-hide-pgp @@ -2529,6 +2584,8 @@ If variable `gnus-use-long-file-name' is non-nil, it is ["Treat overstrike" gnus-article-treat-overstrike t] ["Remove carriage return" gnus-article-remove-cr t] ["Remove quoted-unreadable" gnus-article-de-quoted-unreadable t] + ["Remove base64" gnus-article-de-base64-unreadable t] + ["Treat html" gnus-article-wash-html t] ["Decode HZ" gnus-article-decode-HZ t])) ;; Note "Commands" menu is defined in gnus-sum.el for consistency @@ -2930,7 +2987,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (gnus-article-check-buffer) (let* ((handle (or handle (get-text-property (point) 'gnus-data))) (mm-user-display-methods nil) - (mm-inline-large-images nil) + (mm-inlined-types nil) (mail-parse-charset gnus-newsgroup-charset) (mail-parse-ignored-charsets (save-excursion (set-buffer gnus-summary-buffer) @@ -3408,7 +3465,7 @@ In no internal viewer is available, use an external viewer." (if overstrike ?o ? ) (if emphasis ?e ? ))))) -(fset 'gnus-article-hide-headers-if-wanted 'gnus-article-maybe-hide-headers) +(defalias 'gnus-article-hide-headers-if-wanted 'gnus-article-maybe-hide-headers) (defun gnus-article-maybe-hide-headers () "Hide unwanted headers if `gnus-have-all-headers' is nil. @@ -3976,7 +4033,7 @@ groups." "Exit the article editing without updating." (interactive) ;; We remove all text props from the article buffer. - (let ((buf (format "%s" (buffer-string))) + (let ((buf (buffer-substring-no-properties (point-min) (point-max))) (curbuf (current-buffer)) (p (point)) (window-start (window-start))) @@ -4008,7 +4065,7 @@ groups." ;;; Internal Variables: -(defcustom gnus-button-url-regexp "\\b\\(\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?\\([-a-zA-Z0-9_=!?#$@~`%&*+|\\/:;.,]\\|\\w\\)+\\([-a-zA-Z0-9_=#$@~`%&*+|\\/]\\|\\w\\)\\)\\|[-a-zA-Z0-9_]+\\.[-a-zA-Z0-9_]+\\(\\.[-a-zA-Z0-9_]+[-a-zA-Z0-9_/]+\\)+" +(defcustom gnus-button-url-regexp "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):\\)\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?\\([-a-zA-Z0-9_=!?#$@~`%&*+|\\/:;.,]\\|\\w\\)+\\([-a-zA-Z0-9_=#$@~`%&*+|\\/]\\|\\w\\)\\)" "Regular expression that matches URLs." :group 'gnus-article-buttons :type 'regexp) diff --git a/lisp/gnus-cache.el b/lisp/gnus-cache.el index 0432cf5..545f54a 100644 --- a/lisp/gnus-cache.el +++ b/lisp/gnus-cache.el @@ -181,7 +181,8 @@ it's not cached." (gnus-article-decode-hook nil)) (gnus-request-article-this-buffer number group)) (when (> (buffer-size) 0) - (gnus-write-buffer file) + (let ((coding-system-for-write gnus-cache-coding-system)) + (gnus-write-buffer file)) (setq headers (nnheader-parse-head t)) (mail-header-set-number headers number) (gnus-cache-change-buffer group) @@ -584,7 +585,7 @@ $ emacs -batch -l ~/.emacs -l gnus -f gnus-jog-cache" ;; We simply read the active file. (save-excursion (gnus-set-work-buffer) - (insert-file-contents gnus-cache-active-file) + (nnheader-insert-file-contents gnus-cache-active-file) (gnus-active-to-gnus-format nil (setq gnus-cache-active-hashtb (gnus-make-hashtable diff --git a/lisp/gnus-cus.el b/lisp/gnus-cus.el index 1bc3c6c..95a9c87 100644 --- a/lisp/gnus-cus.el +++ b/lisp/gnus-cus.el @@ -256,7 +256,9 @@ 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.") -(defconst gnus-extra-group-parameters nil +(defconst gnus-extra-group-parameters + '((uidvalidity (string :tag "IMAP uidvalidity") "\ +Server-assigned value attached to IMAP groups, used to maintain consistency.")) "Alist of group parameters that are not also topic parameters. Each entry has the form (NAME TYPE DOC), where NAME is the parameter @@ -305,7 +307,7 @@ DOC is a documentation string for the parameter.") :tag "topic parameters" "(gnus)Topic Parameters")) (widget-insert " for <") - (widget-insert (or group topic)) + (widget-insert (gnus-group-decoded-name (or group topic))) (widget-insert "> and press ") (widget-create 'push-button :tag "done" diff --git a/lisp/gnus-demon.el b/lisp/gnus-demon.el index e3704d0..75b8765 100644 --- a/lisp/gnus-demon.el +++ b/lisp/gnus-demon.el @@ -272,7 +272,8 @@ minutes, the connection is closed." (defun gnus-demon-scan-mail () (save-window-excursion (let ((servers gnus-opened-servers) - server) + server + (nnmail-fetched-sources (list t))) (while (setq server (car (pop servers))) (and (gnus-check-backend-function 'request-scan (car server)) (or (gnus-server-opened server) diff --git a/lisp/gnus-ems.el b/lisp/gnus-ems.el index 844513f..9410b92 100644 --- a/lisp/gnus-ems.el +++ b/lisp/gnus-ems.el @@ -156,9 +156,9 @@ (boundp 'mark-active) mark-active)) -(defun gnus-add-minor-mode (mode name map) - (if (fboundp 'add-minor-mode) - (add-minor-mode mode name map) +(if (fboundp 'add-minor-mode) + (defalias 'gnus-add-minor-mode 'add-minor-mode) + (defun gnus-add-minor-mode (mode name map) (set (make-local-variable mode) t) (unless (assq mode minor-mode-alist) (push `(,mode ,name) minor-mode-alist)) @@ -200,40 +200,56 @@ (goto-char (point-min)) (sit-for 0)))))) +(defvar gnus-article-xface-ring-internal nil + "Cache for face data.") + +;; Worth customizing? +(defvar gnus-article-xface-ring-size 6 + "Length of the ring used for `gnus-article-xface-ring-internal'.") + (defun gnus-article-display-xface (beg end) "Display an XFace header from between BEG and END in the current article. -This requires support for XPM or XBM images in your Emacs and the -external programs `uncompface', `icontopbm' and either `ppmtoxpm' (for -XPM support) or `ppmtoxbm' (for XBM support). On a GNU/Linux system -these might be in packages with names like `compface' or `faces-xface' -and `netpbm' or `libgr-progs', for instance. +This requires support images in your Emacs and the external programs +`uncompface', `icontopbm' and `ppmtoxbm'. On a GNU/Linux system these +might be in packages with names like `compface' or `faces-xface' and +`netpbm' or `libgr-progs', for instance. This function is for Emacs 21+. See `gnus-xmas-article-display-xface' for XEmacs." + ;; It might be worth converting uncompface's output in Lisp. + + (unless gnus-article-xface-ring-internal ; Only load ring when needed. + (setq gnus-article-xface-ring-internal + (make-ring gnus-article-xface-ring-size))) (save-excursion - (let ((cur (current-buffer)) - image type) - (when (and (fboundp 'image-type-available-p) - (cond ((image-type-available-p 'xpm) (setq type 'xpm)) - ((image-type-available-p 'xbm) (setq type 'xbm)))) - (with-temp-buffer - (insert-buffer-substring cur beg end) - (call-process-region (point-min) (point-max) "uncompface" - 'delete '(t nil)) - (goto-char (point-min)) - (insert "/* Width=48, Height=48 */\n") - (and (eq 0 (call-process-region (point-min) (point-max) "icontopbm" - 'delete '(t nil))) - (eq 0 (call-process-region (point-min) (point-max) - (if (eq type 'xpm) - "ppmtoxpm" - "pbmtoxbm") - 'delete '(t nil))) - (setq image (create-image (buffer-string) type t)))) - (when image - (goto-char (point-min)) - (re-search-forward "^From:" nil 'move) - (insert-image image " ")))))) + (let* ((cur (current-buffer)) + (data (buffer-substring beg end)) + (image (cdr-safe (assoc data (ring-elements + gnus-article-xface-ring-internal))))) + (when (if (fboundp 'display-graphic-p) + (display-graphic-p)) + (unless image + (let ((coding-system-for-read 'binary) + (coding-system-for-write 'binary)) + (with-temp-buffer + (insert data) + (and (eq 0 (call-process-region (point-min) (point-max) + "uncompface" + 'delete '(t nil))) + (goto-char (point-min)) + (progn (insert "/* Width=48, Height=48 */\n") t) + (eq 0 (call-process-region (point-min) (point-max) + "icontopbm" + 'delete '(t nil))) + (eq 0 (call-process-region (point-min) (point-max) + "pbmtoxbm" + 'delete '(t nil))) + (setq image (create-image (buffer-string) 'xbm t))))) + (ring-insert gnus-article-xface-ring-internal (cons data image)))) + (when image + (goto-char (point-min)) + (re-search-forward "^From:" nil 'move) + (insert-image image))))) (provide 'gnus-ems) diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index 64d1881..1f711b3 100644 --- a/lisp/gnus-group.el +++ b/lisp/gnus-group.el @@ -394,6 +394,24 @@ ticked: The number of ticked articles." :group 'gnus-group-icons :type '(repeat (cons (sexp :tag "Form") file))) +(defcustom gnus-group-name-charset-method-alist nil + "*Alist of method and the charset for group names. + +For example: + (((nntp \"news.com.cn\") . cn-gb-2312)) +" + :group 'gnus-charset + :type '(repeat (cons (sexp :tag "Method") (symbol :tag "Charset")))) + +(defcustom gnus-group-name-charset-group-alist nil + "*Alist of group regexp and the charset for group names. + +For example: + ((\"\\.com\\.cn:\" . cn-gb-2312)) +" + :group 'gnus-charset + :type '(repeat (cons (regexp :tag "Group") (symbol :tag "Charset")))) + ;;; Internal variables (defvar gnus-group-sort-alist-function 'gnus-group-sort-flat @@ -477,6 +495,7 @@ ticked: The number of ticked articles." "=" gnus-group-select-group "\r" gnus-group-select-group "\M-\r" gnus-group-quick-select-group + "\M- " gnus-group-visible-select-group [(meta control return)] gnus-group-select-group-ephemerally "j" gnus-group-jump-to-group "n" gnus-group-next-unread-group @@ -605,7 +624,8 @@ ticked: The number of ticked articles." "m" gnus-group-list-matching "M" gnus-group-list-all-matching "l" gnus-group-list-level - "c" gnus-group-list-cached) + "c" gnus-group-list-cached + "?" gnus-group-list-dormant) (gnus-define-keys (gnus-group-score-map "W" gnus-group-mode-map) "f" gnus-score-flush-cache) @@ -682,7 +702,8 @@ ticked: The number of ticked articles." ["List groups matching..." gnus-group-list-matching t] ["List all groups matching..." gnus-group-list-all-matching t] ["List active file" gnus-group-list-active t] - ["List groups with cached" gnus-group-list-cached t]) + ["List groups with cached" gnus-group-list-cached t] + ["List groups with dormant" gnus-group-list-dormant t]) ("Sort" ["Default sort" gnus-group-sort-groups t] ["Sort by method" gnus-group-sort-groups-by-method t] @@ -874,6 +895,29 @@ The following commands are available: (when gnus-carpal (gnus-carpal-setup-buffer 'group)))) +(defsubst gnus-group-name-charset (method group) + (if (null method) + (setq method (gnus-find-method-for-group group))) + (let ((item (assoc method gnus-group-name-charset-method-alist)) + (alist gnus-group-name-charset-group-alist) + result) + (if item + (cdr item) + (while (setq item (pop alist)) + (if (string-match (car item) group) + (setq alist nil + result (cdr item)))) + result))) + +(defsubst gnus-group-name-decode (string charset) + (if (and string charset (featurep 'mule)) + (mm-decode-coding-string string charset) + string)) + +(defun gnus-group-decoded-name (string) + (let ((charset (gnus-group-name-charset nil string))) + (gnus-group-name-decode string charset))) + (defun gnus-group-list-groups (&optional level unread lowest) "List newsgroups with level LEVEL or lower that have unread articles. Default is all subscribed groups. @@ -1017,16 +1061,24 @@ If REGEXP, only list groups matching REGEXP." (when (string-match regexp group) (gnus-add-text-properties (point) (prog1 (1+ (point)) - (insert " " mark " *: " group "\n")) + (insert " " mark " *: " + (gnus-group-name-decode group + (gnus-group-name-charset + nil group)) + "\n")) (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb) 'gnus-unread t 'gnus-level level)))) ;; This loop is used when listing all groups. (while groups + (setq group (pop groups)) (gnus-add-text-properties (point) (prog1 (1+ (point)) (insert " " mark " *: " - (setq group (pop groups)) "\n")) + (gnus-group-name-decode group + (gnus-group-name-charset + nil group)) + "\n")) (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb) 'gnus-unread t 'gnus-level level)))))) @@ -1078,7 +1130,11 @@ If REGEXP, only list groups matching REGEXP." gnus-tmp-marked number gnus-tmp-method) "Insert a group line in the group buffer." - (let* ((gnus-tmp-active (gnus-active gnus-tmp-group)) + (let* ((gnus-tmp-method + (gnus-server-get-method gnus-tmp-group gnus-tmp-method)) + (group-name-charset (gnus-group-name-charset gnus-tmp-method + gnus-tmp-group)) + (gnus-tmp-active (gnus-active gnus-tmp-group)) (gnus-tmp-number-total (if gnus-tmp-active (1+ (- (cdr gnus-tmp-active) (car gnus-tmp-active))) @@ -1095,10 +1151,14 @@ If REGEXP, only list groups matching REGEXP." ((<= gnus-tmp-level gnus-level-unsubscribed) ?U) ((= gnus-tmp-level gnus-level-zombie) ?Z) (t ?K))) - (gnus-tmp-qualified-group (gnus-group-real-name gnus-tmp-group)) + (gnus-tmp-qualified-group + (gnus-group-name-decode (gnus-group-real-name gnus-tmp-group) + group-name-charset)) (gnus-tmp-newsgroup-description (if gnus-description-hashtb - (or (gnus-gethash gnus-tmp-group gnus-description-hashtb) "") + (or (gnus-group-name-decode + (gnus-gethash gnus-tmp-group gnus-description-hashtb) + group-name-charset) "") "")) (gnus-tmp-moderated (if (and gnus-moderated-hashtb @@ -1107,8 +1167,6 @@ If REGEXP, only list groups matching REGEXP." (gnus-tmp-moderated-string (if (eq gnus-tmp-moderated ?m) "(m)" "")) (gnus-tmp-group-icon "==&&==") - (gnus-tmp-method - (gnus-server-get-method gnus-tmp-group gnus-tmp-method)) ; (gnus-tmp-news-server (or (cadr gnus-tmp-method) "")) (gnus-tmp-news-method (or (car gnus-tmp-method) "")) (gnus-tmp-news-method-string @@ -1364,6 +1422,12 @@ If FIRST-TOO, the current line is also eligible as a target." ;; Group marking. +(defun gnus-group-mark-line-p () + (save-excursion + (beginning-of-line) + (forward-char (or (cdr (assq 'process gnus-group-mark-positions)) 2)) + (eq (char-after) gnus-process-mark))) + (defun gnus-group-mark-group (n &optional unmark no-advance) "Mark the current group." (interactive "p") @@ -1430,10 +1494,10 @@ If UNMARK, remove the mark instead." (gnus-group-set-mark group)))) (gnus-group-position-point)) -(defun gnus-group-remove-mark (group) +(defun gnus-group-remove-mark (group &optional test-marked) "Remove the process mark from GROUP and move point there. Return nil if the group isn't displayed." - (if (gnus-group-goto-group group) + (if (gnus-group-goto-group group nil test-marked) (save-excursion (gnus-group-mark-group 1 'unmark t) t) @@ -1512,7 +1576,7 @@ Take into consideration N (the prefix) and the list of marked groups." (eval `(defun gnus-group-iterate (arg ,function) "Iterate FUNCTION over all process/prefixed groups. -FUNCTION will be called with the group name as the paremeter +FUNCTION will be called with the group name as the parameter and with point over the group in question." (let ((,groups (gnus-group-process-prefix arg)) (,window (selected-window)) @@ -1701,41 +1765,56 @@ Return the name of the group if selection was successful." ;; Adjust cursor point. (gnus-group-position-point)) -(defun gnus-group-goto-group (group &optional far) +(defun gnus-group-goto-group (group &optional far test-marked) "Goto to newsgroup GROUP. -If FAR, it is likely that the group is not on the current line." +If FAR, it is likely that the group is not on the current line. +If TEST-MARKED, the line must be marked." (when group - (if far - (gnus-goto-char - (text-property-any - (point-min) (point-max) - 'gnus-group (gnus-intern-safe group gnus-active-hashtb))) - (beginning-of-line) - (cond - ;; It's quite likely that we are on the right line, so - ;; we check the current line first. - ((eq (get-text-property (point) 'gnus-group) - (gnus-intern-safe group gnus-active-hashtb)) - (point)) - ;; Previous and next line are also likely, so we check them as well. - ((save-excursion - (forward-line -1) - (eq (get-text-property (point) 'gnus-group) - (gnus-intern-safe group gnus-active-hashtb))) - (forward-line -1) - (point)) - ((save-excursion - (forward-line 1) - (eq (get-text-property (point) 'gnus-group) - (gnus-intern-safe group gnus-active-hashtb))) - (forward-line 1) - (point)) - (t - ;; Search through the entire buffer. - (gnus-goto-char - (text-property-any - (point-min) (point-max) - 'gnus-group (gnus-intern-safe group gnus-active-hashtb)))))))) + (beginning-of-line) + (cond + ;; It's quite likely that we are on the right line, so + ;; we check the current line first. + ((and (not far) + (eq (get-text-property (point) 'gnus-group) + (gnus-intern-safe group gnus-active-hashtb)) + (or (not test-marked) (gnus-group-mark-line-p))) + (point)) + ;; Previous and next line are also likely, so we check them as well. + ((and (not far) + (save-excursion + (forward-line -1) + (and (eq (get-text-property (point) 'gnus-group) + (gnus-intern-safe group gnus-active-hashtb)) + (or (not test-marked) (gnus-group-mark-line-p))))) + (forward-line -1) + (point)) + ((and (not far) + (save-excursion + (forward-line 1) + (and (eq (get-text-property (point) 'gnus-group) + (gnus-intern-safe group gnus-active-hashtb)) + (or (not test-marked) (gnus-group-mark-line-p))))) + (forward-line 1) + (point)) + (test-marked + (goto-char (point-min)) + (let (found) + (while (and (not found) + (gnus-goto-char + (text-property-any + (point) (point-max) + 'gnus-group + (gnus-intern-safe group gnus-active-hashtb)))) + (if (gnus-group-mark-line-p) + (setq found t) + (forward-line 1))) + found)) + (t + ;; Search through the entire buffer. + (gnus-goto-char + (text-property-any + (point-min) (point-max) + 'gnus-group (gnus-intern-safe group gnus-active-hashtb))))))) (defun gnus-group-next-group (n &optional silent) "Go to next N'th newsgroup. @@ -2008,7 +2087,7 @@ and NEW-NAME will be prompted for." ((eq part 'method) "select method") ((eq part 'params) "group parameters") (t "group info")) - group) + (gnus-group-decoded-name group)) `(lambda (form) (gnus-group-edit-group-done ',part ,group form))))) @@ -2352,14 +2431,14 @@ score file entries for articles to include in the group." l - lookup (mailbox is visible to LIST/LSUB commands) r - read (SELECT the mailbox, perform CHECK, FETCH, PARTIAL, SEARCH, COPY from mailbox) - s - keep seen/unseen information across sessions (STORE SEEN flag) - w - write (STORE flags other than SEEN and DELETED) + s - keep seen/unseen information across sessions (STORE \\SEEN flag) + w - write (STORE flags other than \\SEEN and \\DELETED) i - insert (perform APPEND, COPY into mailbox) p - post (send mail to submission address for mailbox, not enforced by IMAP4 itself) - c - create (CREATE new sub-mailboxes in any implementation-defined - hierarchy) - d - delete (STORE DELETED flag, perform EXPUNGE) + c - create and delete mailbox (CREATE new sub-mailboxes in any + implementation-defined hierarchy, RENAME or DELETE mailbox) + d - delete messages (STORE \\DELETED flag, perform EXPUNGE) a - administer (perform SETACL)" group) `(lambda (form) (nnimap-acl-edit @@ -2691,6 +2770,7 @@ or nil if no action could be taken." (or (gnus-group-find-parameter group 'expiry-target) nnmail-expiry-target))) (when expirable + (gnus-check-group group) (setcdr expirable (gnus-compress-sequence @@ -3040,10 +3120,14 @@ entail asking the server for the groups." group) (erase-buffer) (while groups + (setq group (pop groups)) (gnus-add-text-properties (point) (prog1 (1+ (point)) (insert " *: " - (setq group (pop groups)) "\n")) + (gnus-group-name-decode group + (gnus-group-name-charset + nil group)) + "\n")) (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb) 'gnus-unread t 'gnus-level (inline (gnus-group-level group))))) @@ -3202,8 +3286,12 @@ to use." (mapatoms (lambda (group) (setq b (point)) - (insert (format " *: %-20s %s\n" (symbol-name group) - (symbol-value group))) + (let ((charset (gnus-group-name-charset nil (symbol-name group)))) + (insert (format " *: %-20s %s\n" + (gnus-group-name-decode + (symbol-name group) charset) + (gnus-group-name-decode + (symbol-value group) charset)))) (gnus-add-text-properties b (1+ b) (list 'gnus-group group 'gnus-unread t 'gnus-marked nil @@ -3245,11 +3333,13 @@ to use." (while groups ;; Groups may be entered twice into the list of groups. (when (not (string= (car groups) prev)) - (insert (setq prev (car groups)) "\n") - (when (and gnus-description-hashtb - (setq des (gnus-gethash (car groups) - gnus-description-hashtb))) - (insert " " des "\n"))) + (setq prev (car groups)) + (let ((charset (gnus-group-name-charset nil prev))) + (insert (gnus-group-name-decode prev charset) "\n") + (when (and gnus-description-hashtb + (setq des (gnus-gethash (car groups) + gnus-description-hashtb))) + (insert " " (gnus-group-name-decode des charset) "\n")))) (setq groups (cdr groups))) (goto-char (point-min)))) (pop-to-buffer obuf))) @@ -3568,10 +3658,31 @@ or `gnus-group-catchup-group-hook'." "" (gnus-time-iso8601 time)))) -(defun gnus-group-prepare-flat-predicate (level predicate &optional lowest) +(defun gnus-group-prepare-flat-list-dead-predicate + (groups level mark predicate) + (let (group) + (if predicate + ;; This loop is used when listing groups that match some + ;; regexp. + (while (setq group (pop groups)) + (when (funcall predicate group) + (gnus-add-text-properties + (point) (prog1 (1+ (point)) + (insert " " mark " *: " + (gnus-group-name-decode group + (gnus-group-name-charset + nil group)) + "\n")) + (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb) + 'gnus-unread t + 'gnus-level level))))))) + +(defun gnus-group-prepare-flat-predicate (level predicate &optional lowest + dead-predicate) "List all newsgroups with unread articles of level LEVEL or lower. If LOWEST is non-nil, list all newsgroups of level LOWEST or higher. -If PREDICATE, only list groups which PREDICATE returns non-nil." +If PREDICATE, only list groups which PREDICATE returns non-nil. +If DEAD-PREDICATE, list dead groups which DEAD-PREDICATE returns non-nil." (set-buffer gnus-group-buffer) (let ((buffer-read-only nil) (newsrc (cdr gnus-newsrc-alist)) @@ -3593,6 +3704,17 @@ If PREDICATE, only list groups which PREDICATE returns non-nil." group (gnus-info-level info) (gnus-info-marks info) unread (gnus-info-method info)))) + ;; List dead groups. + (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie) + (gnus-group-prepare-flat-list-dead-predicate + (setq gnus-zombie-list (sort gnus-zombie-list 'string<)) + gnus-level-zombie ?Z + dead-predicate)) + (and (>= level gnus-level-killed) (<= lowest gnus-level-killed) + (gnus-group-prepare-flat-list-dead-predicate + (setq gnus-killed-list (sort gnus-killed-list 'string<)) + gnus-level-killed ?K dead-predicate)) + (gnus-group-set-mode-line) (setq gnus-group-list-mode (cons level t)) (gnus-run-hooks 'gnus-group-prepare-hook) @@ -3608,10 +3730,42 @@ This command may read the active file." (interactive "P") (when level (setq level (prefix-numeric-value level))) - (gnus-group-prepare-flat-predicate (or level gnus-level-killed) + (when (or (not level) (>= level gnus-level-zombie)) + (gnus-cache-open)) + (gnus-group-prepare-flat-predicate (or level gnus-level-subscribed) #'(lambda (info) (let ((marks (gnus-info-marks info))) (assq 'cache marks))) + lowest + #'(lambda (group) + (or (gnus-gethash group + gnus-cache-active-hashtb) + ;; Cache active file might use "." + ;; instead of ":". + (gnus-gethash + (mapconcat 'identity + (split-string group ":") + ".") + gnus-cache-active-hashtb)))) + (goto-char (point-min)) + (gnus-group-position-point)) + +(defun gnus-group-list-dormant (level &optional lowest) + "List all groups with dormant articles. +If the prefix LEVEL is non-nil, it should be a number that says which +level to cut off listing groups. +If LOWEST, don't list groups with level lower than LOWEST. + +This command may read the active file." + (interactive "P") + (when level + (setq level (prefix-numeric-value level))) + (when (or (not level) (>= level gnus-level-zombie)) + (gnus-cache-open)) + (gnus-group-prepare-flat-predicate (or level gnus-level-subscribed) + #'(lambda (info) + (let ((marks (gnus-info-marks info))) + (assq 'dormant marks))) lowest) (goto-char (point-min)) (gnus-group-position-point)) diff --git a/lisp/gnus-int.el b/lisp/gnus-int.el index 5f3f384..bdd0227 100644 --- a/lisp/gnus-int.el +++ b/lisp/gnus-int.el @@ -460,7 +460,8 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned." (unless no-encode (save-restriction (message-narrow-to-head) - (mail-encode-encoded-word-buffer)) + (let ((mail-parse-charset message-default-charset)) + (mail-encode-encoded-word-buffer))) (message-encode-message-body)) (let ((func (car (or gnus-command-method (gnus-find-method-for-group group))))) @@ -473,7 +474,8 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned." (unless no-encode (save-restriction (message-narrow-to-head) - (mail-encode-encoded-word-buffer)) + (let ((mail-parse-charset message-default-charset)) + (mail-encode-encoded-word-buffer))) (message-encode-message-body)) (let ((func (car (gnus-group-name-to-method group)))) (funcall (intern (format "%s-request-replace-article" func)) diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index 31e42c0..e8f5a1b 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -116,7 +116,7 @@ BODY-LIST is a list of charsets which may be encoded using 8bit content-transfer encoding in the body, or one of the special values nil (always encode using quoted-printable) or t (always use 8bit). -Note that any value other tha nil for HEADER infringes some RFCs, so +Note that any value other than nil for HEADER infringes some RFCs, so use this option with care." :type '(repeat (list :tag "Permitted unencoded charsets" (choice :tag "Where" @@ -216,7 +216,9 @@ Thank you for your help in stamping out bugs. (,group gnus-newsgroup-name) (message-header-setup-hook (copy-sequence message-header-setup-hook)) + (mbl mml-buffer-list) (message-mode-hook (copy-sequence message-mode-hook))) + (setq mml-buffer-list nil) (add-hook 'message-header-setup-hook 'gnus-inews-insert-gcc) (add-hook 'message-header-setup-hook 'gnus-inews-insert-archive-gcc) (add-hook 'message-mode-hook 'gnus-configure-posting-styles) @@ -228,7 +230,17 @@ Thank you for your help in stamping out bugs. (set (make-local-variable 'gnus-message-group-art) (cons ,group ,article)) (set (make-local-variable 'gnus-newsgroup-name) ,group) - (gnus-run-hooks 'gnus-message-setup-hook)) + (gnus-run-hooks 'gnus-message-setup-hook) + (if (eq major-mode 'message-mode) + ;; Make mml-buffer-list local. + ;; Restore global mml-buffer-list value as mbl. + ;; What a hack! -- Shenghuo + (let ((mml-buffer-list mml-buffer-list)) + (setq mml-buffer-list mbl) + (make-local-variable 'mml-buffer-list) + (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t)) + (mml-destroy-buffers) + (setq mml-buffer-list mbl))) (gnus-add-buffer) (gnus-configure-windows ,config t) (set-buffer-modified-p nil)))) @@ -434,7 +446,7 @@ header line with the old Message-ID." (gnus-remove-text-with-property 'gnus-next) (insert (prog1 - (format "%s" (buffer-string)) + (buffer-substring-no-properties (point-min) (point-max)) (erase-buffer))) ;; Find the original headers. (set-buffer gnus-original-article-buffer) @@ -462,6 +474,7 @@ header line with the old Message-ID." (article-buffer 'reply) (t 'message)) (let* ((group (or group gnus-newsgroup-name)) + (charset (gnus-group-name-charset nil group)) (pgroup group) to-address to-group mailing-list to-list newsgroup-p) @@ -472,7 +485,8 @@ header line with the old Message-ID." newsgroup-p (gnus-group-find-parameter group 'newsgroup) mailing-list (when gnus-mailing-list-groups (string-match gnus-mailing-list-groups group)) - group (gnus-group-real-name group))) + group (gnus-group-name-decode (gnus-group-real-name group) + charset))) (if (or (and to-group (gnus-news-group-p to-group)) newsgroup-p @@ -636,6 +650,10 @@ automatically." (gnus-summary-select-article) (set-buffer (gnus-copy-article-buffer)) (gnus-msg-treat-broken-reply-to) + (save-restriction + (message-narrow-to-head) + (goto-char (point-max))) + (mml-quote-region (point) (point-max)) (message-reply nil wide) (when yank (gnus-inews-yank-articles yank))))) @@ -691,22 +709,20 @@ If POST, post instead of mail." text) (save-excursion (set-buffer gnus-original-article-buffer) - (setq text (buffer-string))) + (mm-with-unibyte-current-buffer + (setq text (buffer-string)))) (set-buffer - (if message-forward-show-mml - (gnus-get-buffer-create - (generate-new-buffer-name " *Gnus forward*")) - (mm-with-unibyte-current-buffer - ;; create an unibyte buffer - (gnus-get-buffer-create - (generate-new-buffer-name " *Gnus forward*"))))) + (gnus-get-buffer-create + (generate-new-buffer-name " *Gnus forward*"))) (erase-buffer) + (mm-disable-multibyte) (insert text) (goto-char (point-min)) (when (looking-at "From ") (replace-match "X-From-Line: ") ) - (if message-forward-show-mml - (mime-to-mml)) + (when message-forward-show-mml + (mm-enable-multibyte) + (mime-to-mml)) (message-forward post))))) (defun gnus-summary-resend-message (address n) @@ -1021,7 +1037,8 @@ this is a reply." (when gcc (message-remove-header "gcc") (widen) - (setq groups (message-tokenize-header gcc " ,")) + (setq groups (message-unquote-tokens + (message-tokenize-header gcc " ,"))) ;; Copy the article over to some group(s). (while (setq group (pop groups)) (gnus-check-server @@ -1048,7 +1065,11 @@ this is a reply." (message-encode-message-body) (save-restriction (message-narrow-to-headers) - (mail-encode-encoded-word-buffer)) + (let ((mail-parse-charset message-default-charset) + (rfc2047-header-encoding-alist + (cons '("Newsgroups" . default) + rfc2047-header-encoding-alist))) + (mail-encode-encoded-word-buffer))) (goto-char (point-min)) (when (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$") diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el index 49232b0..4ddc313 100644 --- a/lisp/gnus-score.el +++ b/lisp/gnus-score.el @@ -139,12 +139,6 @@ will be expired along with non-matching score entries." :group 'gnus-score-expire :type 'boolean) -(defcustom gnus-orphan-score nil - "*All orphans get this score added. Set in the score file." - :group 'gnus-score-default - :type '(choice (const nil) - integer)) - (defcustom gnus-decay-scores nil "*If non-nil, decay non-permanent scores." :group 'gnus-score-decay @@ -787,8 +781,9 @@ If optional argument `EXTRA' is non-nil, it's a non-standard overview header." ((eq type 'f) (setq match (gnus-simplify-subject-fuzzy match)))) (let ((score (gnus-score-delta-default score)) - (header (format "%s" (downcase header))) + (header (downcase header)) new) + (set-text-properties 0 (length header) nil header) (when prompt (setq match (read-string (format "Match %s on %s, %s: " @@ -803,8 +798,7 @@ If optional argument `EXTRA' is non-nil, it's a non-standard overview header." (int-to-string match) match)))) - ;; Get rid of string props. - (setq match (format "%s" match)) + (set-text-properties 0 (length match) nil match) ;; If this is an integer comparison, we transform from string to int. (when (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-integer) diff --git a/lisp/gnus-soup.el b/lisp/gnus-soup.el index 0af5707..de67cc7 100644 --- a/lisp/gnus-soup.el +++ b/lisp/gnus-soup.el @@ -67,9 +67,9 @@ The SOUP packet file name will be inserted at the %s.") ;;; Internal Variables: -(defvar gnus-soup-encoding-type ?n +(defvar gnus-soup-encoding-type ?u "*Soup encoding type. -`n' is news format, `m' is Unix mbox format, and `M' is MMDF mailbox +`u' is USENET news format, `m' is Unix mbox format, and `M' is MMDF mailbox format.") (defvar gnus-soup-index-type ?c @@ -245,7 +245,8 @@ Note -- this function hasn't been implemented yet." ;; a soup header. (setq head-line (cond - ((= gnus-soup-encoding-type ?n) + ((or (= gnus-soup-encoding-type ?u) + (= gnus-soup-encoding-type ?n)) ;;Gnus back compatibility. (format "#! rnews %d\n" (buffer-size))) ((= gnus-soup-encoding-type ?m) (while (search-forward "\nFrom " nil t) @@ -335,7 +336,8 @@ If NOT-ALL, don't pack ticked articles." (while (setq prefix (pop prefixes)) (erase-buffer) (insert (format "(setq gnus-soup-prev-prefix %d)\n" (cdr prefix))) - (gnus-write-buffer (concat (car prefix) gnus-soup-prefix-file)))))) + (let ((coding-system-for-write mm-text-coding-system)) + (gnus-write-buffer (concat (car prefix) gnus-soup-prefix-file))))))) (defun gnus-soup-pack (dir packer) (let* ((files (mapconcat 'identity @@ -513,9 +515,12 @@ Return whether the unpacking was successful." (tmp-buf (gnus-get-buffer-create " *soup send*")) beg end) (cond - ((/= (gnus-soup-encoding-format - (gnus-soup-reply-encoding (car replies))) - ?n) + ((and (/= (gnus-soup-encoding-format + (gnus-soup-reply-encoding (car replies))) + ?u) + (/= (gnus-soup-encoding-format + (gnus-soup-reply-encoding (car replies))) + ?n)) ;; Gnus back compatibility. (error "Unsupported encoding")) ((null msg-buf) t) diff --git a/lisp/gnus-srvr.el b/lisp/gnus-srvr.el index b45fed0..0a7304f 100644 --- a/lisp/gnus-srvr.el +++ b/lisp/gnus-srvr.el @@ -626,11 +626,17 @@ The following commands are available: (setq groups (sort groups (lambda (l1 l2) (string< (car l1) (car l2))))) - (let ((buffer-read-only nil)) + (let ((buffer-read-only nil) charset) (while groups (setq group (car groups)) - (insert - (format "K%7d: %s\n" (cdr group) (car group))) + (setq charset (gnus-group-name-charset method group)) + (gnus-add-text-properties + (point) + (prog1 (1+ (point)) + (insert + (format "K%7d: %s\n" (cdr group) + (gnus-group-name-decode (car group) charset)))) + (list 'gnus-group (car group))) (setq groups (cdr groups)))) (switch-to-buffer (current-buffer)) (goto-char (point-min)) @@ -718,11 +724,12 @@ buffer. (defun gnus-browse-group-name () (save-excursion (beginning-of-line) - (when (re-search-forward ": \\(.*\\)$" (gnus-point-at-eol) t) - (gnus-group-prefixed-name - ;; Remove text props. - (format "%s" (match-string 1)) - gnus-browse-current-method)))) + (let ((name (get-text-property (point) 'gnus-group))) + (when (re-search-forward ": \\(.*\\)$" (gnus-point-at-eol) t) + (gnus-group-prefixed-name + (or name + (match-string-no-properties 1)) + gnus-browse-current-method))))) (defun gnus-browse-unsubscribe-group () "Toggle subscription of the current group in the browse buffer." diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index 58f8b70..70edf24 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -1523,8 +1523,8 @@ newsgroup." (setq method (gnus-server-get-method nil method))))) (not (gnus-secondary-method-p method))) ;; These groups are foreign. Check the level. - (when (<= (gnus-info-level info) foreign-level) - (setq active (gnus-activate-group group 'scan)) + (when (and (<= (gnus-info-level info) foreign-level) + (setq active (gnus-activate-group group 'scan))) ;; Let the Gnus agent save the active file. (when (and gnus-agent gnus-plugged active) (gnus-agent-save-group-info @@ -1551,16 +1551,22 @@ newsgroup." ;; hack: `nnmail-get-new-mail' changes the mail-source depending ;; on the group, so we must perform a scan for every group ;; if the users has any directory mail sources. - (if (and (null (assq 'directory + ;; hack: if `nnmail-scan-directory-mail-source-once' is non-nil, + ;; for it scan all spool files even when the groups are + ;; not required. + (if (and + (or nnmail-scan-directory-mail-source-once + (null (assq 'directory (or mail-sources - (if (listp nnmail-spool-file) + (if (listp nnmail-spool-file) nnmail-spool-file - (list nnmail-spool-file))))) - (member method scanned-methods)) + (list nnmail-spool-file)))))) + (member method scanned-methods)) (setq active (gnus-activate-group group)) (setq active (gnus-activate-group group 'scan)) (push method scanned-methods)) - (inline (gnus-close-group group)))))) + (when active + (gnus-close-group group)))))) ;; Get the number of unread articles in the group. (cond @@ -1582,23 +1588,23 @@ newsgroup." (let* ((mg (pop retrievegroups)) (method (or (car mg) gnus-select-method)) (groups (cdr mg))) - (gnus-check-server method) - ;; Request that the backend scan its incoming messages. - (when (gnus-check-backend-function 'request-scan (car method)) - (gnus-request-scan nil method)) - (gnus-read-active-file-2 (mapcar (lambda (group) - (gnus-group-real-name group)) - groups) method) - (dolist (group groups) - (cond - ((setq active (gnus-active (gnus-info-group - (setq info (gnus-get-info group))))) - (inline (gnus-get-unread-articles-in-group info active t))) - (t - ;; The group couldn't be reached, so we nix out the number of - ;; unread articles and stuff. - (gnus-set-active group nil) - (setcar (gnus-gethash group gnus-newsrc-hashtb) t)))))) + (when (gnus-check-server method) + ;; Request that the backend scan its incoming messages. + (when (gnus-check-backend-function 'request-scan (car method)) + (gnus-request-scan nil method)) + (gnus-read-active-file-2 (mapcar (lambda (group) + (gnus-group-real-name group)) + groups) method) + (dolist (group groups) + (cond + ((setq active (gnus-active (gnus-info-group + (setq info (gnus-get-info group))))) + (inline (gnus-get-unread-articles-in-group info active t))) + (t + ;; The group couldn't be reached, so we nix out the number of + ;; unread articles and stuff. + (gnus-set-active group nil) + (setcar (gnus-gethash group gnus-newsrc-hashtb) t))))))) (gnus-message 5 "Checking new news...done"))) @@ -1783,14 +1789,14 @@ newsgroup." (gnus-check-server method) (let ((list-type (gnus-retrieve-groups groups method))) (cond ((not list-type) - (gnus-error + (gnus-error 1.2 "Cannot read partial active file from %s server." (car method))) ((eq list-type 'active) (gnus-active-to-gnus-format method gnus-active-hashtb nil t)) (t (gnus-groups-to-gnus-format method gnus-active-hashtb t))))))) - + ;; Read an active file and place the results in `gnus-active-hashtb'. (defun gnus-active-to-gnus-format (&optional method hashtb ignore-errors real-active) @@ -2497,7 +2503,8 @@ If FORCE is non-nil, the .newsrc file is read." (make-temp-name (concat gnus-current-startup-file "-slave-"))) (modes (ignore-errors (file-modes (concat gnus-current-startup-file ".eld"))))) - (gnus-write-buffer slave-name) + (let ((coding-system-for-write gnus-startup-file-coding-system)) + (gnus-write-buffer slave-name)) (when modes (set-file-modes slave-name modes))))) @@ -2527,7 +2534,7 @@ If FORCE is non-nil, the .newsrc file is read." (while slave-files (erase-buffer) (setq file (nth 1 (car slave-files))) - (insert-file-contents file) + (nnheader-insert-file-contents file) (when (condition-case () (progn (eval-buffer (current-buffer)) @@ -2646,7 +2653,8 @@ If FORCE is non-nil, the .newsrc file is read." "Declare backend NAME with ABILITIES as a Gnus backend." (setq gnus-valid-select-methods (nconc gnus-valid-select-methods - (list (apply 'list name abilities))))) + (list (apply 'list name abilities)))) + (gnus-redefine-select-method-widget)) (defun gnus-set-default-directory () "Set the default directory in the current buffer to `gnus-default-directory'. diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 7d239f5..1570b81 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -879,6 +879,12 @@ For example: ((1 . cn-gb-2312) (2 . big5))." :type 'function :group 'gnus-summary) +(defcustom gnus-orphan-score nil + "*All orphans get this score added. Set in the score file." + :group 'gnus-score-default + :type '(choice (const nil) + integer)) + ;;; Internal variables (defvar gnus-article-mime-handles nil) @@ -1096,6 +1102,7 @@ variable (string, integer, character, etc).") gnus-score-alist gnus-current-score-file (gnus-summary-expunge-below . global) (gnus-summary-mark-below . global) + (gnus-orphan-score . global) gnus-newsgroup-active gnus-scores-exclude-files gnus-newsgroup-history gnus-newsgroup-ancient gnus-newsgroup-sparse gnus-newsgroup-process-stack @@ -1531,6 +1538,9 @@ increase the score of each group you read." "C" gnus-article-capitalize-sentences "c" gnus-article-remove-cr "q" gnus-article-de-quoted-unreadable + "6" gnus-article-de-base64-unreadable + "Z" gnus-article-decode-HZ + "h" gnus-article-wash-html "f" gnus-article-display-x-face "l" gnus-summary-stop-page-breaking "r" gnus-summary-caesar-message @@ -1681,6 +1691,7 @@ increase the score of each group you read." ["Words" gnus-article-decode-mime-words t] ["Charset" gnus-article-decode-charset t] ["QP" gnus-article-de-quoted-unreadable t] + ["Base64" gnus-article-de-base64-unreadable t] ["View all" gnus-mime-view-all-parts t]) ("Date" ["Local" gnus-article-date-local t] @@ -1707,6 +1718,7 @@ increase the score of each group you read." ["CR" gnus-article-remove-cr t] ["Show X-Face" gnus-article-display-x-face t] ["Quoted-Printable" gnus-article-de-quoted-unreadable t] + ["Base64" gnus-article-de-base64-unreadable t] ["Rot 13" gnus-summary-caesar-message t] ["Unix pipe" gnus-summary-pipe-message t] ["Add buttons" gnus-article-add-buttons t] @@ -1714,6 +1726,7 @@ increase the score of each group you read." ["Stop page breaking" gnus-summary-stop-page-breaking t] ["Verbose header" gnus-summary-verbose-headers t] ["Toggle header" gnus-summary-toggle-header t] + ["Html" gnus-article-wash-html t] ["HZ" gnus-article-decode-HZ t]) ("Output" ["Save in default format" gnus-summary-save-article t] @@ -4068,13 +4081,17 @@ or a straight list of headers." gnus-list-identifiers (mapconcat 'identity gnus-list-identifiers " *\\|")))) (dolist (header gnus-newsgroup-headers) - (when (string-match (concat "\\(Re: +\\)?\\(" regexp " *\\)") + (when (string-match (concat "\\(\\(\\(Re: +\\)?\\(" regexp + " *\\)\\)+\\(Re: +\\)?\\)") (mail-header-subject header)) (mail-header-set-subject header (concat (substring (mail-header-subject header) - 0 (match-beginning 2)) + 0 (match-beginning 1)) + (or + (match-string 3 (mail-header-subject header)) + (match-string 5 (mail-header-subject header))) (substring (mail-header-subject header) - (match-end 2)))))))) + (match-end 1)))))))) (defun gnus-select-newsgroup (group &optional read-all select-articles) "Select newsgroup GROUP. @@ -4450,7 +4467,11 @@ If WHERE is `summary', the summary mode line format will be used." (let* ((mformat (symbol-value (intern (format "gnus-%s-mode-line-format-spec" where)))) - (gnus-tmp-group-name gnus-newsgroup-name) + (gnus-tmp-group-name (gnus-group-name-decode + gnus-newsgroup-name + (gnus-group-name-charset + nil + gnus-newsgroup-name))) (gnus-tmp-article-number (or gnus-current-article 0)) (gnus-tmp-unread gnus-newsgroup-unreads) (gnus-tmp-unread-and-unticked (length gnus-newsgroup-unreads)) @@ -5837,7 +5858,14 @@ be displayed." force) ;; The requested article is different from the current article. (progn + (when (gnus-buffer-live-p gnus-article-buffer) + (with-current-buffer gnus-article-buffer + (mm-enable-multibyte))) (gnus-summary-display-article article all-headers) + (when (gnus-buffer-live-p gnus-article-buffer) + (with-current-buffer gnus-article-buffer + (if (not gnus-article-decoded-p) ;; a local variable + (mm-disable-multibyte)))) (when (or all-headers gnus-show-all-headers) (gnus-article-show-all-headers)) (gnus-article-set-window-start @@ -7600,7 +7628,7 @@ latter case, they will be copied into the relevant groups." (save-excursion (set-buffer (gnus-get-buffer-create " *import file*")) (erase-buffer) - (insert-file-contents file) + (nnheader-insert-file-contents file) (goto-char (point-min)) (unless (nnheader-article-p) ;; This doesn't look like an article, so we fudge some headers. @@ -7729,31 +7757,63 @@ delete these instead." (gnus-set-mode-line 'summary) not-deleted)) -(defun gnus-summary-edit-article (&optional force) +(defun gnus-summary-edit-article (&optional arg) "Edit the current article. This will have permanent effect only in mail groups. -If FORCE is non-nil, allow editing of articles even in read-only +If ARG is nil, edit the decoded articles. +If ARG is 1, edit the raw articles. +If ARG is 2, edit the raw articles even in read-only groups. +Otherwise, allow editing of articles even in read-only groups." (interactive "P") - (save-excursion - (set-buffer gnus-summary-buffer) - (let ((mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets)) - (gnus-set-global-variables) - (when (and (not force) - (gnus-group-read-only-p)) - (error "The current newsgroup does not support article editing")) - (gnus-summary-show-article t) - (gnus-article-edit-article - 'mime-to-mml - `(lambda (no-highlight) - (let ((mail-parse-charset ',gnus-newsgroup-charset) - (mail-parse-ignored-charsets - ',gnus-newsgroup-ignored-charsets)) - (mml-to-mime) - (gnus-summary-edit-article-done - ,(or (mail-header-references gnus-current-headers) "") - ,(gnus-group-read-only-p) ,gnus-summary-buffer no-highlight))))))) + (let (force raw) + (cond + ((null arg)) + ((eq arg 1) (setq raw t)) + ((eq arg 2) (setq raw t + force t)) + (t (setq force t))) + (if (and raw (not force) (equal gnus-newsgroup-name "nndraft:drafts")) + (error "Can't edit the raw article in group nndraft:drafts.")) + (save-excursion + (set-buffer gnus-summary-buffer) + (let ((mail-parse-charset gnus-newsgroup-charset) + (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets)) + (gnus-set-global-variables) + (when (and (not force) + (gnus-group-read-only-p)) + (error "The current newsgroup does not support article editing")) + (gnus-summary-show-article t) + (when (and (not raw) (gnus-buffer-live-p gnus-article-buffer)) + (with-current-buffer gnus-article-buffer + (mm-enable-multibyte))) + (if (equal gnus-newsgroup-name "nndraft:drafts") + (setq raw t)) + (gnus-article-edit-article + (if raw 'ignore + #'(lambda () + (let ((mbl mml-buffer-list)) + (setq mml-buffer-list nil) + (mime-to-mml) + (make-local-hook 'kill-buffer-hook) + (let ((mml-buffer-list mml-buffer-list)) + (setq mml-buffer-list mbl) + (make-local-variable 'mml-buffer-list)) + (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t)))) + `(lambda (no-highlight) + (let ((mail-parse-charset ',gnus-newsgroup-charset) + (mail-parse-ignored-charsets + ',gnus-newsgroup-ignored-charsets)) + ,(if (not raw) '(progn + (mml-to-mime) + (mml-destroy-buffers) + (remove-hook 'kill-buffer-hook + 'mml-destroy-buffers t) + (kill-local-variable 'mml-buffer-list))) + (gnus-summary-edit-article-done + ,(or (mail-header-references gnus-current-headers) "") + ,(gnus-group-read-only-p) + ,gnus-summary-buffer no-highlight)))))))) (defalias 'gnus-summary-edit-article-postpone 'gnus-article-edit-exit) @@ -8513,6 +8573,37 @@ read." (gnus-summary-catchup all)) (gnus-summary-next-group)) +;;; +;;; with article +;;; + +(defmacro gnus-with-article (article &rest forms) + "Select ARTICLE and perform FORMS in the original article buffer. +Then replace the article with the result." + `(progn + ;; We don't want the article to be marked as read. + (let (gnus-mark-article-hook) + (gnus-summary-select-article t t nil ,article)) + (set-buffer gnus-original-article-buffer) + ,@forms + (if (not (gnus-check-backend-function + 'request-replace-article (car gnus-article-current))) + (gnus-message 5 "Read-only group; not replacing") + (unless (gnus-request-replace-article + ,article (car gnus-article-current) + (current-buffer) t) + (error "Couldn't replace article"))) + ;; The cache and backlog have to be flushed somewhat. + (when gnus-keep-backlog + (gnus-backlog-remove-article + (car gnus-article-current) (cdr gnus-article-current))) + (when gnus-use-cache + (gnus-cache-update-article + (car gnus-article-current) (cdr gnus-article-current))))) + +(put 'gnus-with-article 'lisp-indent-function 1) +(put 'gnus-with-article 'edebug-form-spec '(form body)) + ;; Thread-based commands. (defun gnus-summary-articles-in-thread (&optional article) @@ -8929,7 +9020,7 @@ If N is a negative number, save the N previous articles. If N is nil and any articles have been marked with the process mark, save those articles instead." (interactive "P") - (let ((gnus-default-article-saver 'rmail-output-to-rmail-file)) + (let ((gnus-default-article-saver 'gnus-summary-save-in-rmail)) (gnus-summary-save-article arg))) (defun gnus-summary-save-article-file (&optional arg) @@ -9520,37 +9611,6 @@ treated as multipart/mixed." (gnus-summary-show-article))) ;;; -;;; with article -;;; - -(defmacro gnus-with-article (article &rest forms) - "Select ARTICLE and perform FORMS in the original article buffer. -Then replace the article with the result." - `(progn - ;; We don't want the article to be marked as read. - (let (gnus-mark-article-hook) - (gnus-summary-select-article t t nil ,article)) - (set-buffer gnus-original-article-buffer) - ,@forms - (if (not (gnus-check-backend-function - 'request-replace-article (car gnus-article-current))) - (gnus-message 5 "Read-only group; not replacing") - (unless (gnus-request-replace-article - ,article (car gnus-article-current) - (current-buffer) t) - (error "Couldn't replace article"))) - ;; The cache and backlog have to be flushed somewhat. - (when gnus-keep-backlog - (gnus-backlog-remove-article - (car gnus-article-current) (cdr gnus-article-current))) - (when gnus-use-cache - (gnus-cache-update-article - (car gnus-article-current) (cdr gnus-article-current))))) - -(put 'gnus-with-article 'lisp-indent-function 1) -(put 'gnus-with-article 'edebug-form-spec '(form body)) - -;;; ;;; Generic summary marking commands ;;; diff --git a/lisp/gnus-topic.el b/lisp/gnus-topic.el index 631251e..88fe35d 100644 --- a/lisp/gnus-topic.el +++ b/lisp/gnus-topic.el @@ -505,7 +505,7 @@ articles in the topic and its subtopics." (let ((data (cadr (gnus-topic-find-topology topic)))) (setcdr data (list (if insert 'visible 'invisible) - (if hide 'hide nil) + hide (cadddr data)))) (if total-remove (setq gnus-topic-alist @@ -544,15 +544,16 @@ articles in the topic and its subtopics." (gnus-topic-update-unreads name unread) (beginning-of-line) ;; Insert the text. - (gnus-add-text-properties - (point) - (prog1 (1+ (point)) - (eval gnus-topic-line-format-spec)) - (list 'gnus-topic (intern name) - 'gnus-topic-level level - 'gnus-topic-unread unread - 'gnus-active active-topic - 'gnus-topic-visible visiblep)))) + (if shownp + (gnus-add-text-properties + (point) + (prog1 (1+ (point)) + (eval gnus-topic-line-format-spec)) + (list 'gnus-topic (intern name) + 'gnus-topic-level level + 'gnus-topic-unread unread + 'gnus-active active-topic + 'gnus-topic-visible visiblep))))) (defun gnus-topic-update-unreads (topic unreads) (setq gnus-topic-unreads (delq (assoc topic gnus-topic-unreads) @@ -1130,13 +1131,21 @@ When used interactively, PARENT will be the topic under point." (gnus-group-list-groups) (gnus-topic-goto-topic topic)) +;; FIXME: +;; 1. When the marked groups are overlapped with the process +;; region, the behavior of move or remove is not right. +;; 2. Can't process on several marked groups with a same name, +;; because gnus-group-marked only keeps one copy. + (defun gnus-topic-move-group (n topic &optional copyp) "Move the next N groups to TOPIC. If COPYP, copy the groups instead." (interactive (list current-prefix-arg (completing-read "Move to topic: " gnus-topic-alist nil t))) - (let ((groups (gnus-group-process-prefix n)) + (let ((use-marked (and (not n) (not (gnus-region-active-p)) + gnus-group-marked t)) + (groups (gnus-group-process-prefix n)) (topicl (assoc topic gnus-topic-alist)) (start-topic (gnus-group-topic-name)) (start-group (progn (forward-line 1) (gnus-group-group-name))) @@ -1145,7 +1154,7 @@ If COPYP, copy the groups instead." (gnus-topic-move start-topic topic) (mapcar (lambda (g) - (gnus-group-remove-mark g) + (gnus-group-remove-mark g use-marked) (when (and (setq entry (assoc (gnus-current-topic) gnus-topic-alist)) (not copyp)) @@ -1158,18 +1167,24 @@ If COPYP, copy the groups instead." (gnus-topic-goto-topic start-topic)) (gnus-group-list-groups)))) -(defun gnus-topic-remove-group (&optional arg) +(defun gnus-topic-remove-group (&optional n) "Remove the current group from the topic." (interactive "P") - (gnus-group-iterate arg - (lambda (group) - (let ((topicl (assoc (gnus-current-topic) gnus-topic-alist)) - (buffer-read-only nil)) - (when (and topicl group) - (gnus-delete-line) - (gnus-delete-first group topicl)) - (gnus-topic-update-topic) - (gnus-group-position-point))))) + (let ((use-marked (and (not n) (not (gnus-region-active-p)) + gnus-group-marked t)) + (groups (gnus-group-process-prefix n))) + (mapcar + (lambda (group) + (gnus-group-remove-mark group use-marked) + (let ((topicl (assoc (gnus-current-topic) gnus-topic-alist)) + (buffer-read-only nil)) + (when (and topicl group) + (gnus-delete-line) + (gnus-delete-first group topicl)) + (gnus-topic-update-topic))) + groups) + (gnus-topic-enter-dribble) + (gnus-group-position-point))) (defun gnus-topic-copy-group (n topic) "Copy the current group to a topic." @@ -1246,13 +1261,13 @@ If COPYP, copy the groups instead." (interactive) (when (gnus-current-topic) (gnus-topic-goto-topic (gnus-current-topic)) - (gnus-topic-remove-topic nil nil 'hidden))) + (gnus-topic-remove-topic nil nil))) (defun gnus-topic-show-topic () "Show the hidden topic." (interactive) (when (gnus-group-topic-p) - (gnus-topic-remove-topic t nil 'shown))) + (gnus-topic-remove-topic t nil))) (defun gnus-topic-mark-topic (topic &optional unmark) "Mark all groups in the topic with the process mark." diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index 1df730a..dbe3ac7 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -539,17 +539,19 @@ Bind `print-quoted' and `print-readably' to t while printing." (defun gnus-make-directory (directory) "Make DIRECTORY (and all its parents) if it doesn't exist." - (when (and directory - (not (file-exists-p directory))) - (make-directory directory t)) + (let ((file-name-coding-system nnmail-pathname-coding-system)) + (when (and directory + (not (file-exists-p directory))) + (make-directory directory t))) t) (defun gnus-write-buffer (file) "Write the current buffer's contents to FILE." ;; Make sure the directory exists. (gnus-make-directory (file-name-directory file)) - ;; Write the buffer. - (write-region (point-min) (point-max) file nil 'quietly)) + (let ((file-name-coding-system nnmail-pathname-coding-system)) + ;; Write the buffer. + (write-region (point-min) (point-max) file nil 'quietly))) (defun gnus-delete-file (file) "Delete FILE if it exists." @@ -568,7 +570,7 @@ Bind `print-quoted' and `print-readably' to t while printing." (save-excursion (save-restriction (goto-char beg) - (while (re-search-forward "[ \t]*\n" end 'move) + (while (re-search-forward gnus-emphasize-whitespace-regexp end 'move) (gnus-put-text-property beg (match-beginning 0) prop val) (setq beg (point))) (gnus-put-text-property beg (point) prop val))))) @@ -681,7 +683,8 @@ with potentially long computations." (save-excursion (set-buffer file-buffer) (rmail-insert-rmail-file-header) - (let ((require-final-newline nil)) + (let ((require-final-newline nil) + (coding-system-for-write mm-text-coding-system)) (gnus-write-buffer filename))) (kill-buffer file-buffer)) (error "Output file does not exist"))) @@ -732,7 +735,8 @@ with potentially long computations." (let ((file-buffer (create-file-buffer filename))) (save-excursion (set-buffer file-buffer) - (let ((require-final-newline nil)) + (let ((require-final-newline nil) + (coding-system-for-write mm-text-coding-system)) (gnus-write-buffer filename))) (kill-buffer file-buffer)) (error "Output file does not exist"))) @@ -855,8 +859,10 @@ ARG is passed to the first function." (forward-line 1)) (nreverse result))))) -(defun gnus-netrc-machine (list machine &optional port) - "Return the netrc values from LIST for MACHINE or for the default entry." +(defun gnus-netrc-machine (list machine &optional port defaultport) + "Return the netrc values from LIST for MACHINE or for the default entry. +If PORT specified, only return entries with matching port tokens. +Entries without port tokens default to DEFAULTPORT." (let ((rest list) result) (while list @@ -872,9 +878,9 @@ ARG is passed to the first function." (when result (setq result (nreverse result)) (while (and result - (not (equal (or port "nntp") + (not (equal (or port defaultport "nntp") (or (gnus-netrc-get (car result) "port") - "nntp")))) + defaultport "nntp")))) (pop result)) (car result)))) diff --git a/lisp/gnus-uu.el b/lisp/gnus-uu.el index 56c6812..c1960f6 100644 --- a/lisp/gnus-uu.el +++ b/lisp/gnus-uu.el @@ -295,7 +295,9 @@ so I simply dropped them." (defcustom gnus-uu-digest-headers '("^Date:" "^From:" "^To:" "^Cc:" "^Subject:" "^Message-ID:" "^Keywords:" - "^Summary:" "^References:" "^Content-Type:" "^Content-Transfer-Encoding:") + "^Summary:" "^References:" "^Content-Type:" "^Content-Transfer-Encoding:" + "^MIME-Version:" "^Content-Disposition:" "^Content-Description:" + "^Content-ID:") "*List of regexps to match headers included in digested messages. The headers will be included in the sequence they are matched." :group 'gnus-extract @@ -349,6 +351,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (defvar gnus-uu-default-dir gnus-article-save-directory) (defvar gnus-uu-digest-from-subject nil) +(defvar gnus-uu-digest-buffer nil) ;; Keymaps @@ -519,15 +522,19 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (interactive "P") (let ((gnus-uu-save-in-digest t) (file (make-temp-name (nnheader-concat gnus-uu-tmp-dir "forward"))) - buf subject from) + (message-forward-as-mime message-forward-as-mime) + (mail-parse-charset gnus-newsgroup-charset) + (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets) + gnus-uu-digest-buffer subject from) + (if (and n (not (numberp n))) + (setq message-forward-as-mime (not message-forward-as-mime) + n nil)) (gnus-setup-message 'forward (setq gnus-uu-digest-from-subject nil) + (setq gnus-uu-digest-buffer + (gnus-get-buffer-create " *gnus-uu-forward*")) (gnus-uu-decode-save n file) - (setq buf (switch-to-buffer - (gnus-get-buffer-create " *gnus-uu-forward*"))) - (erase-buffer) - (insert-file file) - (delete-file file) + (switch-to-buffer gnus-uu-digest-buffer) (let ((fs gnus-uu-digest-from-subject)) (when fs (setq from (caar fs) @@ -557,7 +564,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (when (re-search-forward "^From: ") (delete-region (point) (gnus-point-at-eol)) (insert from)) - (message-forward post)) + (message-forward post t)) (setq gnus-uu-digest-from-subject nil))) (defun gnus-uu-digest-post-forward (&optional n) @@ -816,8 +823,9 @@ When called interactively, prompt for REGEXP." (gnus-uu-save-separate-articles (save-excursion (set-buffer buffer) - (gnus-write-buffer - (concat gnus-uu-saved-article-name gnus-current-article)) + (let ((coding-system-for-write mm-text-coding-system)) + (gnus-write-buffer + (concat gnus-uu-saved-article-name gnus-current-article))) (cond ((eq in-state 'first) (list gnus-uu-saved-article-name 'begin)) ((eq in-state 'first-and-last) (list gnus-uu-saved-article-name 'begin 'end)) @@ -850,8 +858,13 @@ When called interactively, prompt for REGEXP." (set-buffer (gnus-get-buffer-create "*gnus-uu-pre*")) (erase-buffer) (insert (format - "Date: %s\nFrom: %s\nSubject: %s Digest\n\nTopics:\n" - (current-time-string) name name)))) + "Date: %s\nFrom: %s\nSubject: %s Digest\n\n" + (current-time-string) name name)) + (when (and message-forward-as-mime gnus-uu-digest-buffer) + ;; The default part in multipart/digest is message/rfc822. + ;; Subject is a fake head. + (insert "<#part type=text/plain>\nSubject: Topics\n\n")) + (insert "Topics:\n"))) (when (not (eq in-state 'end)) (setq state (list 'middle)))) (save-excursion @@ -865,14 +878,20 @@ When called interactively, prompt for REGEXP." ;; These two are necessary for XEmacs 19.12 fascism. (put-text-property (point-min) (point-max) 'invisible nil) (put-text-property (point-min) (point-max) 'intangible nil)) + (when (and message-forward-as-mime + message-forward-show-mml + gnus-uu-digest-buffer) + (mm-enable-multibyte) + (mime-to-mml)) (goto-char (point-min)) (re-search-forward "\n\n") - ;; Quote all 30-dash lines. - (save-excursion - (while (re-search-forward "^-" nil t) - (beginning-of-line) - (delete-char 1) - (insert "- "))) + (unless (and message-forward-as-mime gnus-uu-digest-buffer) + ;; Quote all 30-dash lines. + (save-excursion + (while (re-search-forward "^-" nil t) + (beginning-of-line) + (delete-char 1) + (insert "- ")))) (setq body (buffer-substring (1- (point)) (point-max))) (narrow-to-region (point-min) (point)) (if (not (setq headers gnus-uu-digest-headers)) @@ -890,30 +909,66 @@ When called interactively, prompt for REGEXP." (1- (point))) (progn (forward-line 1) (point))))))))) (widen))) - (insert sorthead) (goto-char (point-max)) - (insert body) (goto-char (point-max)) - (insert (concat "\n" (make-string 30 ?-) "\n\n")) + (if (and message-forward-as-mime gnus-uu-digest-buffer) + (if message-forward-show-mml + (progn + (insert "\n<#mml type=message/rfc822>\n") + (insert sorthead) (goto-char (point-max)) + (insert body) (goto-char (point-max)) + (insert "\n<#/mml>\n")) + (let ((buf (mml-generate-new-buffer " *mml*"))) + (with-current-buffer buf + (insert sorthead) + (goto-char (point-min)) + (when (re-search-forward "^Subject: \\(.*\\)$" nil t) + (setq subj (buffer-substring (match-beginning 1) + (match-end 1)))) + (goto-char (point-max)) + (insert body)) + (insert "\n<#part type=message/rfc822" + " buffer=\"" (buffer-name buf) "\">\n"))) + (insert sorthead) (goto-char (point-max)) + (insert body) (goto-char (point-max)) + (insert (concat "\n" (make-string 30 ?-) "\n\n"))) (goto-char beg) (when (re-search-forward "^Subject: \\(.*\\)$" nil t) - (setq subj (buffer-substring (match-beginning 1) (match-end 1))) + (setq subj (buffer-substring (match-beginning 1) (match-end 1)))) + (when subj (save-excursion (set-buffer "*gnus-uu-pre*") (insert (format " %s\n" subj))))) (when (or (eq in-state 'last) (eq in-state 'first-and-last)) - (save-excursion - (set-buffer "*gnus-uu-pre*") - (insert (format "\n\n%s\n\n" (make-string 70 ?-))) - (gnus-write-buffer gnus-uu-saved-article-name)) - (save-excursion - (set-buffer "*gnus-uu-body*") - (goto-char (point-max)) - (insert - (concat (setq end-string (format "End of %s Digest" name)) - "\n")) - (insert (concat (make-string (length end-string) ?*) "\n")) - (write-region - (point-min) (point-max) gnus-uu-saved-article-name t)) + (if (and message-forward-as-mime gnus-uu-digest-buffer) + (with-current-buffer gnus-uu-digest-buffer + (erase-buffer) + (insert-buffer "*gnus-uu-pre*") + (goto-char (point-max)) + (insert-buffer "*gnus-uu-body*")) + (save-excursion + (set-buffer "*gnus-uu-pre*") + (insert (format "\n\n%s\n\n" (make-string 70 ?-))) + (if gnus-uu-digest-buffer + (with-current-buffer gnus-uu-digest-buffer + (erase-buffer) + (insert-buffer "*gnus-uu-pre*")) + (let ((coding-system-for-write mm-text-coding-system)) + (gnus-write-buffer gnus-uu-saved-article-name)))) + (save-excursion + (set-buffer "*gnus-uu-body*") + (goto-char (point-max)) + (insert + (concat (setq end-string (format "End of %s Digest" name)) + "\n")) + (insert (concat (make-string (length end-string) ?*) "\n")) + (if gnus-uu-digest-buffer + (with-current-buffer gnus-uu-digest-buffer + (goto-char (point-max)) + (insert-buffer "*gnus-uu-body*")) + (let ((coding-system-for-write mm-text-coding-system) + (file-name-coding-system nnmail-pathname-coding-system)) + (write-region + (point-min) (point-max) gnus-uu-saved-article-name t))))) (gnus-kill-buffer "*gnus-uu-pre*") (gnus-kill-buffer "*gnus-uu-body*") (push 'end state)) @@ -1481,6 +1536,21 @@ When called interactively, prompt for REGEXP." (cons (if (= (length files) 1) (car files) files) state) state)))) +(defvar gnus-uu-unshar-warning + "*** WARNING *** + +Shell archives are an archaic method of bundling files for distribution +across computer networks. During the unpacking process, arbitrary commands +are executed on your system, and all kinds of nasty things can happen. +Please examine the archive very carefully before you instruct Emacs to +unpack it. You can browse the archive buffer using \\[scroll-other-window]. + +If you are unsure what to do, please answer \"no\"." + "Text of warning message displayed by `gnus-uu-unshar-article'. +Make sure that this text consists only of few text lines. Otherwise, +Gnus might fail to display all of it.") + + ;; This function is used by `gnus-uu-grab-articles' to treat ;; a shared article. (defun gnus-uu-unshar-article (process-buffer in-state) @@ -1491,14 +1561,31 @@ When called interactively, prompt for REGEXP." (goto-char (point-min)) (if (not (re-search-forward gnus-uu-shar-begin-string nil t)) (setq state (list 'wrong-type)) - (beginning-of-line) - (setq start-char (point)) - (call-process-region - start-char (point-max) shell-file-name nil - (gnus-get-buffer-create gnus-uu-output-buffer-name) nil - shell-command-switch - (concat "cd " gnus-uu-work-dir " " - gnus-shell-command-separator " sh")))) + (save-window-excursion + (save-excursion + (switch-to-buffer (current-buffer)) + (delete-other-windows) + (let ((buffer (get-buffer-create (generate-new-buffer-name + "*Warning*")))) + (unless + (unwind-protect + (with-current-buffer buffer + (insert (substitute-command-keys + gnus-uu-unshar-warning)) + (goto-char (point-min)) + (display-buffer buffer) + (yes-or-no-p "This is a shell archive, unshar it? ")) + (kill-buffer buffer)) + (setq state (list 'error)))))) + (unless (memq 'error state) + (beginning-of-line) + (setq start-char (point)) + (call-process-region + start-char (point-max) shell-file-name nil + (gnus-get-buffer-create gnus-uu-output-buffer-name) nil + shell-command-switch + (concat "cd " gnus-uu-work-dir " " + gnus-shell-command-separator " sh"))))) state)) ;; Returns the name of what the shar file is going to unpack. diff --git a/lisp/gnus-xmas.el b/lisp/gnus-xmas.el index fd6ea7f..9172371 100644 --- a/lisp/gnus-xmas.el +++ b/lisp/gnus-xmas.el @@ -442,6 +442,9 @@ call it with the value of the `gnus-data' text property." (list 'funcall fval) (cons 'progn (cdr (cdr fval)))))) + (unless (fboundp 'match-string-no-properties) + (fset 'match-string-no-properties 'match-string)) + (fset 'gnus-x-color-values (if (fboundp 'x-color-values) 'x-color-values diff --git a/lisp/gnus.el b/lisp/gnus.el index d972c7e..3caec43 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -257,7 +257,7 @@ is restarted, and sometimes reloaded." :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-version-number "5.8.6" +(defconst gnus-version-number "5.8.7" "Version number for this version of Gnus.") (defconst gnus-version (format "Gnus v%s" gnus-version-number) @@ -753,7 +753,9 @@ be set in `.emacs' instead." (let ((image (find-image '((:type xpm :file "gnus.xpm") (:type xbm :file "gnus.xbm"))))) (when image - (insert-image image " ") + (newline) ; Have somewhere for cursor to + ; go, not stretched over image. + (insert-image image) (goto-char (point-min)) (while (not (eobp)) (insert (make-string (/ (max (- (window-width) (or x 35)) 0) 2) @@ -1019,12 +1021,12 @@ list, Gnus will try all the methods in the list until it finds a match." :type '(choice (const :tag "default" nil) (const :tag "DejaNews" (nnweb "refer" (nnweb-type dejanews))) gnus-select-method - (repeat :menu-tag "Try multiple" + (repeat :menu-tag "Try multiple" :tag "Multiple" :value (current (nnweb "refer" (nnweb-type dejanews))) (choice :tag "Method" (const current) - (const :tag "DejaNews" + (const :tag "DejaNews" (nnweb "refer" (nnweb-type dejanews))) gnus-select-method)))) @@ -1085,11 +1087,6 @@ newsgroups." :group 'gnus-summary-marks :type 'character) -(defcustom gnus-asynchronous nil - "*If non-nil, Gnus will supply backends with data needed for async article fetching." - :group 'gnus-asynchronous - :type 'boolean) - (defcustom gnus-large-newsgroup 200 "*The number of articles which indicates a large newsgroup. If the number of articles in a newsgroup is greater than this value, @@ -1286,21 +1283,28 @@ this variable. I think." (const :format "%v " virtual) (const respool))))) -(define-widget 'gnus-select-method 'list - "Widget for entering a select method." - :value '(nntp "") - :tag "Select Method" - :args `((choice :tag "Method" - ,@(mapcar (lambda (entry) - (list 'const :format "%v\n" - (intern (car entry)))) - gnus-valid-select-methods)) - (string :tag "Address") - (repeat :tag "Options" - :inline t - (list :format "%v" - variable - (sexp :tag "Value"))))) +(defun gnus-redefine-select-method-widget () + "Recomputes the select-method widget based on the value of +`gnus-valid-select-methods'." + (define-widget 'gnus-select-method 'list + "Widget for entering a select method." + :value '(nntp "") + :tag "Select Method" + :args `((choice :tag "Method" + ,@(mapcar (lambda (entry) + (list 'const :format "%v\n" + (intern (car entry)))) + gnus-valid-select-methods) + (symbol :tag "other")) + (string :tag "Address") + (repeat :tag "Options" + :inline t + (list :format "%v" + variable + (sexp :tag "Value")))) + )) + +(gnus-redefine-select-method-widget) (defcustom gnus-updated-mode-lines '(group article summary tree) "List of buffers that should update their mode lines. @@ -1762,10 +1766,12 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") gnus-article-delete-invisible-text gnus-treat-article) ("gnus-art" :interactive t gnus-article-hide-headers gnus-article-hide-boring-headers - gnus-article-treat-overstrike + gnus-article-treat-overstrike gnus-article-remove-cr gnus-article-remove-trailing-blank-lines gnus-article-display-x-face gnus-article-de-quoted-unreadable + gnus-article-de-base64-unreadable gnus-article-decode-HZ + gnus-article-wash-html gnus-article-hide-pgp gnus-article-hide-pem gnus-article-hide-signature gnus-article-strip-leading-blank-lines gnus-article-date-local @@ -2831,7 +2837,7 @@ Allow completion over sensible values." (or (let ((opened gnus-opened-servers)) (while (and opened (not (equal (format "%s:%s" method address) - (format "%s:%s" (caaar opened) + (format "%s:%s" (caaar opened) (cadaar opened))))) (pop opened)) (caar opened)) @@ -2879,7 +2885,7 @@ As opposed to `gnus', this command will not connect to the local server." ;;(setq thing ? ; this is a comment ;; more 'yes) - + ;;;###autoload (defun gnus (&optional arg dont-connect slave) "Read network news. diff --git a/lisp/imap.el b/lisp/imap.el index 0b01b42..7aff9c5 100644 --- a/lisp/imap.el +++ b/lisp/imap.el @@ -950,6 +950,10 @@ If EXAMINE is non-nil, do a read-only select." (imap-utf7-decode (imap-mailbox-select-1 (imap-utf7-encode mailbox) examine)))) +(defun imap-mailbox-examine-1 (mailbox &optional buffer) + (with-current-buffer (or buffer (current-buffer)) + (imap-mailbox-select-1 mailbox 'exmine))) + (defun imap-mailbox-examine (mailbox &optional buffer) "Examine MAILBOX on server in BUFFER." (imap-mailbox-select mailbox 'exmine buffer)) @@ -1288,7 +1292,7 @@ is non-nil return theese properties." (let ((old-mailbox imap-current-mailbox) (state imap-state) (imap-message-data (make-vector 2 0))) - (when (imap-mailbox-examine mailbox) + (when (imap-mailbox-examine-1 mailbox) (prog1 (and (imap-fetch "*" "UID") (list (imap-mailbox-get-1 'uidvalidity mailbox) @@ -1329,7 +1333,7 @@ first element, rest of list contain the saved articles' UIDs." (let ((old-mailbox imap-current-mailbox) (state imap-state) (imap-message-data (make-vector 2 0))) - (when (imap-mailbox-examine mailbox) + (when (imap-mailbox-examine-1 mailbox) (prog1 (and (imap-fetch "*" "UID") (list (imap-mailbox-get-1 'uidvalidity mailbox) @@ -2372,6 +2376,7 @@ Return nil if no complete line has arrived." imap-current-mailbox-p imap-mailbox-select-1 imap-mailbox-select + imap-mailbox-examine-1 imap-mailbox-examine imap-mailbox-unselect imap-mailbox-expunge diff --git a/lisp/lpath.el b/lisp/lpath.el index 519625c..c4fceac 100644 --- a/lisp/lpath.el +++ b/lisp/lpath.el @@ -44,7 +44,7 @@ find-coding-systems-for-charsets sc-cite-regexp vcard-pretty-print image-type-available-p put-image create-image display-graphic-p - find-image insert-image + find-image insert-image image-size make-overlay overlay-put)) (maybe-bind '(global-face-data mark-active transient-mark-mode mouse-selection-click-count @@ -98,7 +98,7 @@ url-generic-parse-url valid-image-instantiator-format-p babel-fetch babel-wash babel-as-string sc-cite-regexp put-image create-image display-graphic-p - find-image insert-image + find-image insert-image image-size vcard-pretty-print image-type-available-p))) (setq load-path (cons "." load-path)) diff --git a/lisp/mail-source.el b/lisp/mail-source.el index 506fc3d..be0cea4 100644 --- a/lisp/mail-source.el +++ b/lisp/mail-source.el @@ -114,7 +114,8 @@ Common keywords should be listed here.") (:password) (:authentication password)) (maildir - (:path "~/Maildir/new/") + (:path (or (getenv "MAILDIR") "~/Maildir/")) + (:subdirs ("new" "cur")) (:function)) (imap (:server (getenv "MAILHOST")) @@ -606,13 +607,32 @@ This only works when `display-time' is enabled." "Fetcher for maildir sources." (mail-source-bind (maildir source) (let ((found 0) - (mail-source-string (format "maildir:%s" path))) - (dolist (file (directory-files path t)) - (when (and (not (file-directory-p file)) - (not (if function - (funcall function file mail-source-crash-box) - (rename-file file mail-source-crash-box)))) - (incf found (mail-source-callback callback file)))) + mail-source-string) + (unless (string-match "/$" path) + (setq path (concat path "/"))) + (dolist (subdir subdirs) + (when (file-directory-p (concat path subdir)) + (setq mail-source-string (format "maildir:%s%s" path subdir)) + (dolist (file (directory-files (concat path subdir) t)) + (when (and (not (file-directory-p file)) + (not (if function + (funcall function file mail-source-crash-box) + (let ((coding-system-for-write + mm-text-coding-system) + (coding-system-for-read + mm-text-coding-system)) + (with-temp-file mail-source-crash-box + (insert-file-contents file) + (goto-char (point-min)) + (unless (looking-at "\n*From ") + (insert "From maildir " + (current-time-string) "\n")) + (while (re-search-forward "^From " nil t) + (replace-match ">From ")) + (goto-char (point-max)) + (insert "\n\n")) + (delete-file file))))) + (incf found (mail-source-callback callback file)))))) found))) (eval-and-compile diff --git a/lisp/mailcap.el b/lisp/mailcap.el index 3450905..407c67e 100644 --- a/lisp/mailcap.el +++ b/lisp/mailcap.el @@ -286,11 +286,42 @@ not.") (write-region (point-min) (point-max) file)) (kill-buffer (current-buffer)))) +(defvar mailcap-maybe-eval-warning + "*** WARNING *** + +This MIME part contains untrusted and possibly harmful content. +If you evaluate the Emacs Lisp code contained in it, a lot of nasty +things can happen. Please examine the code very carefully before you +instruct Emacs to evaluate it. You can browse the buffer containing +the code using \\[scroll-other-window]. + +If you are unsure what to do, please answer \"no\"." + "Text of warning message displayed by `mailcap-maybe-eval'. +Make sure that this text consists only of few text lines. Otherwise, +Gnus might fail to display all of it.") + (defun mailcap-maybe-eval () "Maybe evaluate a buffer of emacs lisp code." - (if (yes-or-no-p "This is emacs-lisp code, evaluate it? ") - (eval-buffer (current-buffer)) - (emacs-lisp-mode))) + (let ((lisp-buffer (current-buffer))) + (goto-char (point-min)) + (when + (save-window-excursion + (delete-other-windows) + (let ((buffer (get-buffer-create (generate-new-buffer-name + "*Warning*")))) + (unwind-protect + (with-current-buffer buffer + (insert (substitute-command-keys + mailcap-maybe-eval-warning)) + (goto-char (point-min)) + (display-buffer buffer) + (yes-or-no-p "This is emacs-lisp code, evaluate it? ")) + (kill-buffer buffer)))) + (eval-buffer (current-buffer))) + (when (buffer-live-p lisp-buffer) + (with-current-buffer lisp-buffer + (emacs-lisp-mode))))) + ;;; ;;; The mailcap parser diff --git a/lisp/message.el b/lisp/message.el index 8c1cc95..015f9c8 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -30,16 +30,12 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile + (require 'cl) + (defvar gnus-list-identifiers)) ; gnus-sum is required where necessary (require 'mailheader) (require 'nnheader) -(require 'easymenu) -(if (string-match "XEmacs\\|Lucid" emacs-version) - (require 'mail-abbrevs) - (require 'mailabbrev)) (require 'mail-parse) -(require 'mm-bodies) -(require 'mm-encode) (require 'mml) (defgroup message '((user-mail-address custom-variable) @@ -170,7 +166,8 @@ long-lines control-chars size new-text redirected-followup signature approved sender empty empty-headers message-id from subject shorten-followup-to existing-newsgroups buffer-file-name unchanged newsgroups." - :group 'message-news) + :group 'message-news + :type '(repeat sexp)) (defcustom message-required-news-headers '(From Newsgroups Subject Date Message-ID @@ -319,7 +316,7 @@ The provided functions are: :group 'message-interface :type 'regexp) -(defcustom message-forward-ignored-headers "Content-Transfer-Encoding" +(defcustom message-forward-ignored-headers "^Content-Transfer-Encoding:\\|^X-Gnus" "*All headers that match this regexp will be deleted when forwarding a message." :group 'message-forwarding :type '(choice (const :tag "None" nil) @@ -1005,6 +1002,7 @@ should be sent in several parts. If it is nil, the size is unlimited." (autoload 'mh-send-letter "mh-comp") (autoload 'gnus-point-at-eol "gnus-util") (autoload 'gnus-point-at-bol "gnus-util") + (autoload 'gnus-output-to-rmail "gnus-util") (autoload 'gnus-output-to-mail "gnus-util") (autoload 'mail-abbrev-in-expansion-header-p "mailabbrev") (autoload 'nndraft-request-associate-buffer "nndraft") @@ -1012,6 +1010,7 @@ should be sent in several parts. If it is nil, the size is unlimited." (autoload 'gnus-open-server "gnus-int") (autoload 'gnus-request-post "gnus-int") (autoload 'gnus-alive-p "gnus-util") + (autoload 'gnus-group-name-charset "gnus-group") (autoload 'rmail-output "rmail")) @@ -1029,9 +1028,19 @@ should be sent in several parts. If it is nil, the size is unlimited." `(delete-region (progn (beginning-of-line) (point)) (progn (forward-line ,(or n 1)) (point)))) +(defun message-unquote-tokens (elems) + "Remove leading and trailing double quotes (\") from quoted strings +in list." + (mapcar (lambda (item) + (if (string-match "^\"\\(.*\\)\"$" item) + (match-string 1 item) + item)) + elems)) + (defun message-tokenize-header (header &optional separator) "Split HEADER into a list of header elements. -\",\" is used as the separator." +SEPARATOR is a string of characters to be used as separators. \",\" +is used by default." (if (not header) nil (let ((regexp (format "[%s]+" (or separator ","))) @@ -1061,7 +1070,7 @@ should be sent in several parts. If it is nil, the size is unlimited." ((and (eq (char-after) ?\)) (not quoted)) (setq paren nil)))) - (nreverse elems))))) + (nreverse elems))))) (defun message-mail-file-mbox-p (file) "Say whether FILE looks like a Unix mbox file." @@ -1081,8 +1090,8 @@ should be sent in several parts. If it is nil, the size is unlimited." (when value (while (string-match "\n[\t ]+" value) (setq value (replace-match " " t t value))) - ;; We remove all text props. - (format "%s" value)))) + (set-text-properties 0 (length value) nil value) + value))) (defun message-narrow-to-field () "Narrow the buffer to the header on the current line." @@ -1135,6 +1144,21 @@ should be sent in several parts. If it is nil, the size is unlimited." (and (listp form) (eq (car form) 'lambda)) (byte-code-function-p form))) +(defun message-strip-list-identifiers (subject) + "Remove list identifiers in `gnus-list-identifiers'." + (require 'gnus-sum) ; for gnus-list-identifiers + (let ((regexp (if (stringp gnus-list-identifiers) + gnus-list-identifiers + (mapconcat 'identity gnus-list-identifiers " *\\|")))) + (if (string-match (concat "\\(\\(\\(Re: +\\)?\\(" regexp + " *\\)\\)+\\(Re: +\\)?\\)") subject) + (concat (substring subject 0 (match-beginning 1)) + (or (match-string 3 subject) + (match-string 5 subject)) + (substring subject + (match-end 1))) + subject))) + (defun message-strip-subject-re (subject) "Remove \"Re:\" from subject lines." (if (string-match message-subject-re-regexp subject) @@ -1412,6 +1436,8 @@ C-c C-r message-caesar-buffer-body (rot13 the message body). C-c C-a mml-attach-file (attach a file as MIME). M-RET message-newline-and-reformat (break the line and reformat)." (interactive) + (if (local-variable-p 'mml-buffer-list (current-buffer)) + (mml-destroy-buffers)) (kill-all-local-variables) (set (make-local-variable 'message-reply-buffer) nil) (make-local-variable 'message-send-actions) @@ -1460,8 +1486,10 @@ M-RET message-newline-and-reformat (break the line and reformat)." (set (make-local-variable 'message-mime-part) 0) ;;(when (fboundp 'mail-hist-define-keys) ;; (mail-hist-define-keys)) - (when (string-match "XEmacs\\|Lucid" emacs-version) - (message-setup-toolbar)) + (if (featurep 'xemacs) + (message-setup-toolbar) + (set (make-local-variable 'font-lock-defaults) + '(message-font-lock-keywords t))) (easy-menu-add message-mode-menu message-mode-map) (easy-menu-add message-mode-field-menu message-mode-map) ;; Allow mail alias things. @@ -1470,9 +1498,6 @@ M-RET message-newline-and-reformat (break the line and reformat)." (mail-abbrevs-setup) (mail-aliases-setup))) (message-set-auto-save-file-name) - (unless (string-match "XEmacs" emacs-version) - (set (make-local-variable 'font-lock-defaults) - '(message-font-lock-keywords t))) (make-local-variable 'adaptive-fill-regexp) (setq adaptive-fill-regexp (concat "[ \t]*[-a-z0-9A-Z]*\\(>[ \t]*\\)+[ \t]*\\|" adaptive-fill-regexp)) @@ -2218,7 +2243,8 @@ It should typically alter the sending method in some way or other." (goto-char (point-max)) (insert "\n") (widen) - (funcall message-send-mail-function)) + (mm-with-unibyte-current-buffer + (funcall message-send-mail-function))) (setq n (+ n 1)) (setq p (pop plist)) (erase-buffer))) @@ -2261,7 +2287,8 @@ It should typically alter the sending method in some way or other." (message-generate-headers '(Lines))) ;; Remove some headers. (message-remove-header message-ignored-mail-headers t) - (mail-encode-encoded-word-buffer)) + (let ((mail-parse-charset message-default-charset)) + (mail-encode-encoded-word-buffer))) (goto-char (point-max)) ;; require one newline at the end. (or (= (preceding-char) ?\n) @@ -2273,7 +2300,8 @@ It should typically alter the sending method in some way or other." (if (or (not message-send-mail-partially-limit) (< (point-max) message-send-mail-partially-limit) (not (y-or-n-p "The message size is too large, should it be sent partially?"))) - (funcall message-send-mail-function) + (mm-with-unibyte-current-buffer + (funcall message-send-mail-function)) (message-send-mail-partially))) (kill-buffer tembuf)) (set-buffer mailbuf) @@ -2410,6 +2438,12 @@ to find out how to use this." (method (if (message-functionp message-post-method) (funcall message-post-method arg) message-post-method)) + (group-name-charset (gnus-group-name-charset method "")) + (rfc2047-header-encoding-alist + (if group-name-charset + (cons (cons "Newsgroups" group-name-charset) + rfc2047-header-encoding-alist) + rfc2047-header-encoding-alist)) (messbuf (current-buffer)) (message-syntax-checks (if arg @@ -2418,7 +2452,9 @@ to find out how to use this." message-syntax-checks)) (message-this-is-news t) (message-posting-charset (gnus-setup-posting-charset - (message-fetch-field "Newsgroups"))) + (save-restriction + (message-narrow-to-headers-or-head) + (message-fetch-field "Newsgroups")))) result) (if (not (message-check-news-body-syntax)) nil @@ -2428,6 +2464,10 @@ to find out how to use this." (message-generate-headers message-required-news-headers) ;; Let the user do all of the above. (run-hooks 'message-header-hook)) + (if group-name-charset + (setq message-syntax-checks + (cons '(valid-newsgroups . disabled) + message-syntax-checks))) (message-cleanup-headers) (if (not (message-check-news-syntax)) nil @@ -2450,7 +2490,7 @@ to find out how to use this." (message-generate-headers '(Lines))) ;; Remove some headers. (message-remove-header message-ignored-news-headers t) - (let ((mail-parse-charset (car message-posting-charset))) + (let ((mail-parse-charset message-default-charset)) (mail-encode-encoded-word-buffer))) (goto-char (point-max)) ;; require one newline at the end. @@ -2776,9 +2816,19 @@ to find out how to use this." (while (setq file (message-fetch-field "fcc")) (push file list) (message-remove-header "fcc" nil t))) + (message-encode-message-body) + (save-restriction + (message-narrow-to-headers) + (let ((mail-parse-charset message-default-charset) + (rfc2047-header-encoding-alist + (cons '("Newsgroups" . default) + rfc2047-header-encoding-alist))) + (mail-encode-encoded-word-buffer))) (goto-char (point-min)) - (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) - (replace-match "" t t) + (when (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "$") + nil t) + (replace-match "" t t )) ;; Process FCC operations. (while list (setq file (pop list)) @@ -2798,14 +2848,13 @@ to find out how to use this." (rmail-output file 1 nil t) (let ((mail-use-rfc822 t)) (rmail-output file 1 t t)))))) - (kill-buffer (current-buffer))))) (defun message-output (filename) "Append this article to Unix/babyl mail file.." (if (and (file-readable-p filename) (mail-file-babyl-p filename)) - (rmail-output-to-rmail-file filename t) + (gnus-output-to-rmail filename t) (gnus-output-to-mail filename t))) (defun message-cleanup-headers () @@ -3646,6 +3695,7 @@ OTHER-HEADERS is an alist of header/value pairs." (defun message-reply (&optional to-address wide) "Start editing a reply to the article in the current buffer." (interactive) + (require 'gnus-sum) ; for gnus-list-identifiers (let ((cur (current-buffer)) from subject date reply-to to cc references message-id follow-to @@ -3669,11 +3719,9 @@ OTHER-HEADERS is an alist of header/value pairs." date (message-fetch-field "date") from (message-fetch-field "from") subject (or (message-fetch-field "subject") "none")) - ;; Remove any (buggy) Re:'s that are present and make a - ;; proper one. - (when (string-match message-subject-re-regexp subject) - (setq subject (substring subject (match-end 0)))) - (setq subject (concat "Re: " subject)) + (if gnus-list-identifiers + (setq subject (message-strip-list-identifiers subject))) + (setq subject (concat "Re: " (message-strip-subject-re subject))) (when (and (setq gnus-warning (message-fetch-field "gnus-warning")) (string-match "<[^>]+>" gnus-warning)) @@ -3710,6 +3758,7 @@ OTHER-HEADERS is an alist of header/value pairs." "Follow up to the message in the current buffer. If TO-NEWSGROUPS, use that as the new Newsgroups line." (interactive) + (require 'gnus-sum) ; for gnus-list-identifiers (let ((cur (current-buffer)) from subject date reply-to mct references message-id follow-to @@ -3744,11 +3793,9 @@ If TO-NEWSGROUPS, use that as the new Newsgroups line." (let ((case-fold-search t)) (string-match "world" distribution))) (setq distribution nil)) - ;; Remove any (buggy) Re:'s that are present and make a - ;; proper one. - (when (string-match message-subject-re-regexp subject) - (setq subject (substring subject (match-end 0)))) - (setq subject (concat "Re: " subject)) + (if gnus-list-identifiers + (setq subject (message-strip-list-identifiers subject))) + (setq subject (concat "Re: " (message-strip-subject-re subject))) (widen)) (message-pop-to-buffer (message-buffer-name "followup" from newsgroups)) @@ -3891,6 +3938,7 @@ header line with the old Message-ID." ;; Get a normal message buffer. (message-pop-to-buffer (message-buffer-name "supersede")) (insert-buffer-substring cur) + (mime-to-mml) (message-narrow-to-head) ;; Remove unwanted headers. (when message-ignored-supersedes-headers @@ -3999,9 +4047,10 @@ the message." subject)))) ;;;###autoload -(defun message-forward (&optional news) +(defun message-forward (&optional news digest) "Forward the current message via mail. -Optional NEWS will use news to forward instead of mail." +Optional NEWS will use news to forward instead of mail. +Optional DIGEST will use digest to forward." (interactive "P") (let* ((cur (current-buffer)) (subject (if message-forward-show-mml @@ -4018,32 +4067,44 @@ Optional NEWS will use news to forward instead of mail." (message-goto-body) (goto-char (point-max))) (if message-forward-as-mime - (if message-forward-show-mml - (insert "\n\n<#mml type=message/rfc822 disposition=inline>\n") - (insert "\n\n<#part type=message/rfc822 disposition=inline" - " buffer=\"" (buffer-name cur) "\">\n")) + (if digest + (insert "\n<#multipart type=digest>\n") + (if message-forward-show-mml + (insert "\n\n<#mml type=message/rfc822 disposition=inline>\n") + (insert "\n\n<#part type=message/rfc822 disposition=inline raw=t>\n"))) (insert "\n-------------------- Start of forwarded message --------------------\n")) - (let ((b (point)) - e) - (if message-forward-show-mml - (insert-buffer-substring cur) - (unless message-forward-as-mime - (mml-insert-buffer cur))) + (let ((b (point)) e) + (if digest + (if message-forward-as-mime + (insert-buffer-substring cur) + (mml-insert-buffer cur)) + (if message-forward-show-mml + (insert-buffer-substring cur) + (mm-with-unibyte-current-buffer + (mml-insert-buffer cur)))) (setq e (point)) (if message-forward-as-mime - (if message-forward-show-mml - (insert "<#/mml>\n") - (insert "<#/part>\n")) + (if digest + (insert "<#/multipart>\n") + (if message-forward-show-mml + (insert "<#/mml>\n") + (insert "<#/part>\n"))) (insert "\n-------------------- End of forwarded message --------------------\n")) - (when (and (or message-forward-show-mml - (not message-forward-as-mime)) - (not current-prefix-arg) - message-forward-ignored-headers) - (save-restriction - (narrow-to-region b e) - (goto-char b) - (narrow-to-region (point) (or (search-forward "\n\n" nil t) (point))) - (message-remove-header message-forward-ignored-headers t)))) + (if (and digest message-forward-as-mime) + (save-restriction + (narrow-to-region b e) + (goto-char b) + (narrow-to-region (point) + (or (search-forward "\n\n" nil t) (point))) + (delete-region (point-min) (point-max))) + (when (and (not current-prefix-arg) + message-forward-ignored-headers) + (save-restriction + (narrow-to-region b e) + (goto-char b) + (narrow-to-region (point) + (or (search-forward "\n\n" nil t) (point))) + (message-remove-header message-forward-ignored-headers t))))) (message-position-point))) ;;;###autoload @@ -4098,7 +4159,7 @@ Optional NEWS will use news to forward instead of mail." ;;;###autoload (defun message-bounce () "Re-mail the current message. -This only makes sense if the current message is a bounce message than +This only makes sense if the current message is a bounce message that contains some mail you have written which has been bounced back to you." (interactive) @@ -4346,17 +4407,20 @@ regexp varstr." ;;; Miscellaneous functions ;; stolen (and renamed) from nnheader.el -(defun message-replace-chars-in-string (string from to) - "Replace characters in STRING from FROM to TO." - (let ((string (substring string 0)) ;Copy string. - (len (length string)) - (idx 0)) - ;; Replace all occurrences of FROM with TO. - (while (< idx len) - (when (= (aref string idx) from) - (aset string idx to)) - (setq idx (1+ idx))) - string)) +(if (fboundp 'subst-char-in-string) + (defsubst message-replace-chars-in-string (string from to) + (subst-char-in-string from to string)) + (defun message-replace-chars-in-string (string from to) + "Replace characters in STRING from FROM to TO." + (let ((string (substring string 0)) ;Copy string. + (len (length string)) + (idx 0)) + ;; Replace all occurrences of FROM with TO. + (while (< idx len) + (when (= (aref string idx) from) + (aset string idx to)) + (setq idx (1+ idx))) + string))) ;;; ;;; MIME functions @@ -4412,9 +4476,9 @@ regexp varstr." (if (fboundp 'mail-abbrevs-setup) (let ((mail-abbrev-mode-regexp "") (minibuffer-setup-hook 'mail-abbrevs-setup)) - (read-from-minibuffer prompt))) - (let ((minibuffer-setup-hook 'mail-abbrev-minibuffer-setup-hook)) - (read-string prompt))) + (read-from-minibuffer prompt)) + (let ((minibuffer-setup-hook 'mail-abbrev-minibuffer-setup-hook)) + (read-string prompt)))) (provide 'message) diff --git a/lisp/mm-bodies.el b/lisp/mm-bodies.el index 8c42436..410d9f8 100644 --- a/lisp/mm-bodies.el +++ b/lisp/mm-bodies.el @@ -108,7 +108,7 @@ If no encoding was done, nil is returned." "Do Content-Transfer-Encoding and return the encoding of the current buffer." (let ((bits (mm-body-7-or-8))) (cond - ((eq bits '7bit) + ((and (not mm-use-ultra-safe-encoding) (eq bits '7bit)) bits) ((and (not mm-use-ultra-safe-encoding) (or (eq t (cdr message-posting-charset)) @@ -170,6 +170,10 @@ If no encoding was done, nil is returned." (goto-char (point-min)) (while (re-search-forward "^[\t ]*\r?\n" nil t) (delete-region (match-beginning 0) (match-end 0))) + (goto-char (point-max)) + (when (re-search-backward "^[A-Za-z0-9+/]+=*[\t ]*$" nil t) + (forward-line) + (delete-region (point) (point-max))) (point-max)))) ((memq encoding '(7bit 8bit binary)) ;; Do nothing. diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el index 6e8413e..694b2e6 100644 --- a/lisp/mm-decode.el +++ b/lisp/mm-decode.el @@ -210,6 +210,11 @@ to: (defvar mm-last-shell-command "") (defvar mm-content-id-alist nil) +;; According to RFC2046, in particular, in a digest, the default +;; Content-Type value for a body part is changed from "text/plain" to +;; "message/rfc822". +(defvar mm-dissect-default-type "text/plain") + ;;; The functions. (defun mm-dissect-buffer (&optional no-strict-mime) @@ -231,7 +236,7 @@ to: (if (or (not ctl) (not (string-match "/" (car ctl)))) (mm-dissect-singlepart - '("text/plain") + (list mm-dissect-default-type) (and cte (intern (downcase (mail-header-remove-whitespace (mail-header-remove-comments cte))))) @@ -245,7 +250,10 @@ to: result (cond ((equal type "multipart") - (cons (car ctl) (mm-dissect-multipart ctl))) + (let ((mm-dissect-default-type (if (equal subtype "digest") + "message/rfc822" + "text/plain"))) + (cons (car ctl) (mm-dissect-multipart ctl)))) (t (mm-dissect-singlepart ctl @@ -632,7 +640,7 @@ external if displayed external." (save-excursion (if (member (mm-handle-media-supertype handle) '("text" "message")) (with-temp-buffer - (insert-buffer-substring (mm-handle-buffer handle)) + (insert-buffer-substring (mm-handle-buffer handle)) (mm-decode-content-transfer-encoding (mm-handle-encoding handle) (mm-handle-media-type handle)) @@ -699,6 +707,8 @@ external if displayed external." (method (completing-read "Viewer: " methods))) (when (string= method "") (error "No method given")) + (if (string-match "^[^% \t]+$" method) + (setq method (concat method " %s"))) (mm-display-external (copy-sequence handle) method))) (defun mm-preferred-alternative (handles &optional preferred) @@ -787,10 +797,12 @@ external if displayed external." (or mm-inline-large-images (and (< (glyph-width image) (window-pixel-width)) (< (glyph-height image) (window-pixel-height)))) - ;; Let's just inline everything under Emacs 21, since the image - ;; specification there doesn't actually get the width/height - ;; until you render the image. - t))) + (let* ((size (image-size image)) + (w (car size)) + (h (cdr size))) + (or mm-inline-large-images + (and (< h (1- (window-height))) ; Don't include mode line. + (< w (window-width)))))))) (defun mm-valid-image-format-p (format) "Say whether FORMAT can be displayed natively by Emacs." diff --git a/lisp/mm-util.el b/lisp/mm-util.el index e945a2f..74cd23f 100644 --- a/lisp/mm-util.el +++ b/lisp/mm-util.el @@ -33,7 +33,10 @@ (iso-8859-3 latin-iso8859-3) (iso-8859-4 latin-iso8859-4) (iso-8859-5 cyrillic-iso8859-5) - (koi8-r cyrillic-iso8859-5) + ;; Non-mule (X)Emacs uses the last mule-charset for 8bit characters. + ;; The fake mule-charset, gnus-koi8-r, tells Gnus that the default + ;; charset is koi8-r, not iso-8859-5. + (koi8-r cyrillic-iso8859-5 gnus-koi8-r) (iso-8859-6 arabic-iso8859-6) (iso-8859-7 greek-iso8859-7) (iso-8859-8 hebrew-iso8859-8) @@ -331,7 +334,9 @@ See also `with-temp-file' and `with-output-to-string'." (coding-system-for-read mm-binary-coding-system) (coding-system-for-write mm-binary-coding-system)) (set-buffer-multibyte nil) + (setq-default enable-multibyte-characters nil) ,@forms) + (setq-default enable-multibyte-characters ,multibyte) (set-buffer-multibyte ,multibyte)))))) (put 'mm-with-unibyte-current-buffer 'lisp-indent-function 0) (put 'mm-with-unibyte-current-buffer 'edebug-form-spec '(body)) diff --git a/lisp/mm-uu.el b/lisp/mm-uu.el index 3b00898..61cae2d 100644 --- a/lisp/mm-uu.el +++ b/lisp/mm-uu.el @@ -26,8 +26,8 @@ ;;; Code: +(eval-when-compile (require 'cl)) (require 'mail-parse) -(require 'message) (require 'nnheader) (require 'mm-decode) (require 'mailcap) diff --git a/lisp/mm-view.el b/lisp/mm-view.el index fe36cf6..6fb7289 100644 --- a/lisp/mm-view.el +++ b/lisp/mm-view.el @@ -43,7 +43,7 @@ (let ((b (point-marker)) buffer-read-only) (insert "\n") - (put-image (mm-get-image handle) b "x") + (put-image (mm-get-image handle) b) (mm-handle-set-undisplayer handle `(lambda () (remove-images ,b (1+ ,b)))))) @@ -65,8 +65,8 @@ (eval-and-compile (if (string-match "XEmacs" (emacs-version)) - (fset 'mm-inline-image 'mm-inline-image-xemacs) - (fset 'mm-inline-image 'mm-inline-image-emacs))) + (defalias 'mm-inline-image 'mm-inline-image-xemacs) + (defalias 'mm-inline-image 'mm-inline-image-emacs))) (defvar mm-w3-setup nil) (defun mm-setup-w3 () @@ -103,10 +103,11 @@ (and (boundp 'w3-meta-charset-content-type-regexp) (re-search-forward w3-meta-charset-content-type-regexp nil t))) - (setq charset (w3-coding-system-for-mime-charset - (buffer-substring-no-properties - (match-beginning 2) - (match-end 2))))) + (setq charset (or (w3-coding-system-for-mime-charset + (buffer-substring-no-properties + (match-beginning 2) + (match-end 2))) + charset))) (delete-region (point-min) (point-max)) (insert (mm-decode-string text charset)) (save-window-excursion diff --git a/lisp/mml.el b/lisp/mml.el index b966a17..d4a04b6 100644 --- a/lisp/mml.el +++ b/lisp/mml.el @@ -72,6 +72,29 @@ unknown encoding; `use-ascii': always use ASCII for those characters with unknown encoding; `multipart': always send messages with more than one charsets.") +(defvar mml-generate-mime-preprocess-function nil + "A function called before generating a mime part. +The function is called with one parameter, which is the part to be +generated.") + +(defvar mml-generate-mime-postprocess-function nil + "A function called after generating a mime part. +The function is called with one parameter, which is the generated part.") + +(defvar mml-generate-default-type "text/plain") + +(defvar mml-buffer-list nil) + +(defun mml-generate-new-buffer (name) + (let ((buf (generate-new-buffer name))) + (push buf mml-buffer-list) + buf)) + +(defun mml-destroy-buffers () + (let (kill-buffer-hook) + (mapcar 'kill-buffer mml-buffer-list) + (setq mml-buffer-list nil))) + (defun mml-parse () "Parse the current buffer as an MML document." (goto-char (point-min)) @@ -84,7 +107,7 @@ one charsets.") (defun mml-parse-1 () "Parse the current buffer as an MML document." - (let (struct tag point contents charsets warn use-ascii no-markup-p) + (let (struct tag point contents charsets warn use-ascii no-markup-p raw) (while (and (not (eobp)) (not (looking-at "<#/multipart"))) (cond @@ -95,14 +118,21 @@ one charsets.") struct)) (t (if (or (looking-at "<#part") (looking-at "<#mml")) - (setq tag (mml-read-tag)) + (setq tag (mml-read-tag) + no-markup-p nil + warn nil) (setq tag (list 'part '(type . "text/plain")) no-markup-p t warn t)) - (setq point (point) - contents (mml-read-part (eq 'mml (car tag))) - charsets (mm-find-mime-charset-region point (point))) - (when (memq nil charsets) + (setq raw (cdr (assq 'raw tag)) + point (point) + contents (if raw + (mm-with-unibyte-current-buffer + (mml-read-part (eq 'mml (car tag)))) + (mml-read-part (eq 'mml (car tag)))) + charsets (if raw nil + (mm-find-mime-charset-region point (point)))) + (when (and (not raw) (memq nil charsets)) (if (or (memq 'unknown-encoding mml-confirmation-set) (y-or-n-p "Warning: You message contains characters with unknown encoding. Really send?")) @@ -112,7 +142,9 @@ one charsets.") (setq charsets (delq nil charsets)) (setq warn nil)) (error "Edit your message to remove those characters"))) - (if (< (length charsets) 2) + (if (or raw + (eq 'mml (car tag)) + (< (length charsets) 2)) (if (or (not no-markup-p) (string-match "[^ \t\r\n]" contents)) ;; Don't create blank parts. @@ -125,7 +157,7 @@ one charsets.") (not (y-or-n-p (format - "Warning: Your message contains %d parts. Really send? " + "Warning: Your message contains more than %d parts. Really send? " (length nstruct))))) (error "Edit your message to use only one charset")) (setq struct (nconc nstruct struct))))))) @@ -136,56 +168,60 @@ one charsets.") (defun mml-parse-singlepart-with-multiple-charsets (orig-tag beg end &optional use-ascii) (save-excursion - (narrow-to-region beg end) - (goto-char (point-min)) - (let ((current (or (mm-mime-charset (mm-charset-after)) - (and use-ascii 'us-ascii))) - charset struct space newline paragraph) - (while (not (eobp)) - (cond - ;; The charset remains the same. - ((or (eq (setq charset (mm-mime-charset (mm-charset-after))) - 'us-ascii) - (and use-ascii (not charset)) - (eq charset current))) - ;; The initial charset was ascii. - ((eq current 'us-ascii) - (setq current charset - space nil - newline nil - paragraph nil)) - ;; We have a change in charsets. - (t - (push (append - orig-tag - (list (cons 'contents - (buffer-substring-no-properties - beg (or paragraph newline space (point)))))) - struct) - (setq beg (or paragraph newline space (point)) - current charset - space nil - newline nil - paragraph nil))) - ;; Compute places where it might be nice to break the part. - (cond - ((memq (following-char) '(? ?\t)) - (setq space (1+ (point)))) - ((eq (following-char) ?\n) - (setq newline (1+ (point)))) - ((and (eq (following-char) ?\n) - (not (bobp)) - (eq (char-after (1- (point))) ?\n)) - (setq paragraph (point)))) - (forward-char 1)) - ;; Do the final part. - (unless (= beg (point)) - (push (append orig-tag - (list (cons 'contents - (buffer-substring-no-properties - beg (point))))) - struct)) - struct))) + (save-restriction + (narrow-to-region beg end) + (goto-char (point-min)) + (let ((current (or (mm-mime-charset (mm-charset-after)) + (and use-ascii 'us-ascii))) + charset struct space newline paragraph) + (while (not (eobp)) + (setq charset (mm-mime-charset (mm-charset-after))) + (cond + ;; The charset remains the same. + ((eq charset 'us-ascii)) + ((or (and use-ascii (not charset)) + (eq charset current)) + (setq space nil + newline nil + paragraph nil)) + ;; The initial charset was ascii. + ((eq current 'us-ascii) + (setq current charset + space nil + newline nil + paragraph nil)) + ;; We have a change in charsets. + (t + (push (append + orig-tag + (list (cons 'contents + (buffer-substring-no-properties + beg (or paragraph newline space (point)))))) + struct) + (setq beg (or paragraph newline space (point)) + current charset + space nil + newline nil + paragraph nil))) + ;; Compute places where it might be nice to break the part. + (cond + ((memq (following-char) '(? ?\t)) + (setq space (1+ (point)))) + ((and (eq (following-char) ?\n) + (not (bobp)) + (eq (char-after (1- (point))) ?\n)) + (setq paragraph (point))) + ((eq (following-char) ?\n) + (setq newline (1+ (point))))) + (forward-char 1)) + ;; Do the final part. + (unless (= beg (point)) + (push (append orig-tag + (list (cons 'contents + (buffer-substring-no-properties + beg (point))))) + struct)) + struct)))) (defun mml-read-tag () "Read a tag and return the contents." @@ -254,111 +290,125 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (buffer-string))))) (defun mml-generate-mime-1 (cont) - (cond - ((or (eq (car cont) 'part) (eq (car cont) 'mml)) - (let (coded encoding charset filename type) - (setq type (or (cdr (assq 'type cont)) "text/plain")) - (if (member (car (split-string type "/")) '("text" "message")) - (with-temp-buffer + (save-restriction + (narrow-to-region (point) (point)) + (if mml-generate-mime-preprocess-function + (funcall mml-generate-mime-preprocess-function cont)) + (cond + ((or (eq (car cont) 'part) (eq (car cont) 'mml)) + (let ((raw (cdr (assq 'raw cont))) + coded encoding charset filename type) + (setq type (or (cdr (assq 'type cont)) "text/plain")) + (if (and (not raw) + (member (car (split-string type "/")) '("text" "message"))) + (with-temp-buffer + (cond + ((cdr (assq 'buffer cont)) + (insert-buffer-substring (cdr (assq 'buffer cont)))) + ((and (setq filename (cdr (assq 'filename cont))) + (not (equal (cdr (assq 'nofile cont)) "yes"))) + (mm-insert-file-contents filename)) + ((eq 'mml (car cont)) + (insert (cdr (assq 'contents cont)))) + (t + (save-restriction + (narrow-to-region (point) (point)) + (insert (cdr (assq 'contents cont))) + ;; Remove quotes from quoted tags. + (goto-char (point-min)) + (while (re-search-forward + "<#!+/?\\(part\\|multipart\\|external\\|mml\\)" nil t) + (delete-region (+ (match-beginning 0) 2) + (+ (match-beginning 0) 3)))))) + (cond + ((eq (car cont) 'mml) + (let ((mml-boundary (funcall mml-boundary-function + (incf mml-multipart-number))) + (mml-generate-default-type "text/plain")) + (mml-to-mime)) + (let ((mm-7bit-chars (concat mm-7bit-chars "\x1b"))) + ;; ignore 0x1b, it is part of iso-2022-jp + (setq encoding (mm-body-7-or-8)))) + ((string= (car (split-string type "/")) "message") + (let ((mm-7bit-chars (concat mm-7bit-chars "\x1b"))) + ;; ignore 0x1b, it is part of iso-2022-jp + (setq encoding (mm-body-7-or-8)))) + (t + (setq charset (mm-encode-body)) + (setq encoding (mm-body-encoding + charset (cdr (assq 'encoding cont)))))) + (setq coded (buffer-string))) + (mm-with-unibyte-buffer (cond ((cdr (assq 'buffer cont)) (insert-buffer-substring (cdr (assq 'buffer cont)))) ((and (setq filename (cdr (assq 'filename cont))) (not (equal (cdr (assq 'nofile cont)) "yes"))) - (mm-insert-file-contents filename)) - ((eq 'mml (car cont)) - (insert (cdr (assq 'contents cont)))) + (let ((coding-system-for-read mm-binary-coding-system)) + (mm-insert-file-contents filename nil nil nil nil t))) (t - (save-restriction - (narrow-to-region (point) (point)) - (insert (cdr (assq 'contents cont))) - ;; Remove quotes from quoted tags. - (goto-char (point-min)) - (while (re-search-forward - "<#!+/?\\(part\\|multipart\\|external\\|mml\\)" nil t) - (delete-region (+ (match-beginning 0) 2) - (+ (match-beginning 0) 3)))))) - (cond - ((eq (car cont) 'mml) - (let ((mml-boundary (funcall mml-boundary-function - (incf mml-multipart-number)))) - (mml-to-mime)) - (let ((mm-7bit-chars (concat mm-7bit-chars "\x1b"))) - ;; ignore 0x1b, it is part of iso-2022-jp - (setq encoding (mm-body-7-or-8)))) - ((string= (car (split-string type "/")) "message") - (let ((mm-7bit-chars (concat mm-7bit-chars "\x1b"))) - ;; ignore 0x1b, it is part of iso-2022-jp - (setq encoding (mm-body-7-or-8)))) - (t - (setq charset (mm-encode-body)) - (setq encoding (mm-body-encoding - charset (cdr (assq 'encoding cont)))))) - (setq coded (buffer-string))) - (mm-with-unibyte-buffer - (cond - ((cdr (assq 'buffer cont)) - (insert-buffer-substring (cdr (assq 'buffer cont)))) - ((and (setq filename (cdr (assq 'filename cont))) - (not (equal (cdr (assq 'nofile cont)) "yes"))) - (let ((coding-system-for-read mm-binary-coding-system)) - (mm-insert-file-contents filename nil nil nil nil t))) - (t - (insert (cdr (assq 'contents cont))))) - (setq encoding (mm-encode-buffer type) - coded (buffer-string)))) - (mml-insert-mime-headers cont type charset encoding) - (insert "\n") - (insert coded))) - ((eq (car cont) 'external) - (insert "Content-Type: message/external-body") - (let ((parameters (mml-parameter-string - cont '(expiration size permission))) - (name (cdr (assq 'name cont)))) - (when name - (setq name (mml-parse-file-name name)) - (if (stringp name) + (insert (cdr (assq 'contents cont))))) + (setq encoding (mm-encode-buffer type) + coded (buffer-string)))) + (mml-insert-mime-headers cont type charset encoding) + (insert "\n") + (mm-with-unibyte-current-buffer + (insert coded)))) + ((eq (car cont) 'external) + (insert "Content-Type: message/external-body") + (let ((parameters (mml-parameter-string + cont '(expiration size permission))) + (name (cdr (assq 'name cont)))) + (when name + (setq name (mml-parse-file-name name)) + (if (stringp name) + (mml-insert-parameter + (mail-header-encode-parameter "name" name) + "access-type=local-file") (mml-insert-parameter - (mail-header-encode-parameter "name" name) - "access-type=local-file") - (mml-insert-parameter - (mail-header-encode-parameter - "name" (file-name-nondirectory (nth 2 name))) - (mail-header-encode-parameter "site" (nth 1 name)) - (mail-header-encode-parameter - "directory" (file-name-directory (nth 2 name)))) - (mml-insert-parameter - (concat "access-type=" - (if (member (nth 0 name) '("ftp@" "anonymous@")) - "anon-ftp" - "ftp"))))) - (when parameters - (mml-insert-parameter-string - cont '(expiration size permission)))) - (insert "\n\n") - (insert "Content-Type: " (cdr (assq 'type cont)) "\n") - (insert "Content-ID: " (message-make-message-id) "\n") - (insert "Content-Transfer-Encoding: " - (or (cdr (assq 'encoding cont)) "binary")) - (insert "\n\n") - (insert (or (cdr (assq 'contents cont)))) - (insert "\n")) - ((eq (car cont) 'multipart) - (let* ((type (or (cdr (assq 'type cont)) "mixed")) - (handler (assoc type mml-generate-multipart-alist))) - (if handler - (funcall (cdr handler) cont) - ;; No specific handler. Use default one. - (let ((mml-boundary (mml-compute-boundary cont))) - (insert (format "Content-Type: multipart/%s; boundary=\"%s\"\n" - type mml-boundary)) - (setq cont (cddr cont)) - (while cont - (insert "\n--" mml-boundary "\n") - (mml-generate-mime-1 (pop cont))) - (insert "\n--" mml-boundary "--\n"))))) - (t - (error "Invalid element: %S" cont)))) + (mail-header-encode-parameter + "name" (file-name-nondirectory (nth 2 name))) + (mail-header-encode-parameter "site" (nth 1 name)) + (mail-header-encode-parameter + "directory" (file-name-directory (nth 2 name)))) + (mml-insert-parameter + (concat "access-type=" + (if (member (nth 0 name) '("ftp@" "anonymous@")) + "anon-ftp" + "ftp"))))) + (when parameters + (mml-insert-parameter-string + cont '(expiration size permission)))) + (insert "\n\n") + (insert "Content-Type: " (cdr (assq 'type cont)) "\n") + (insert "Content-ID: " (message-make-message-id) "\n") + (insert "Content-Transfer-Encoding: " + (or (cdr (assq 'encoding cont)) "binary")) + (insert "\n\n") + (insert (or (cdr (assq 'contents cont)))) + (insert "\n")) + ((eq (car cont) 'multipart) + (let* ((type (or (cdr (assq 'type cont)) "mixed")) + (mml-generate-default-type (if (equal type "digest") + "message/rfc822" + "text/plain")) + (handler (assoc type mml-generate-multipart-alist))) + (if handler + (funcall (cdr handler) cont) + ;; No specific handler. Use default one. + (let ((mml-boundary (mml-compute-boundary cont))) + (insert (format "Content-Type: multipart/%s; boundary=\"%s\"\n" + type mml-boundary)) + ;; Skip `multipart' and `type' elements. + (setq cont (cddr cont)) + (while cont + (insert "\n--" mml-boundary "\n") + (mml-generate-mime-1 (pop cont))) + (insert "\n--" mml-boundary "--\n"))))) + (t + (error "Invalid element: %S" cont))) + (if mml-generate-mime-postprocess-function + (funcall mml-generate-mime-postprocess-function cont)))) (defun mml-compute-boundary (cont) "Return a unique boundary that does not exist in CONT." @@ -413,7 +463,7 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." cont '(name access-type expiration size permission))) (when (or charset parameters - (not (equal type "text/plain"))) + (not (equal type mml-generate-default-type))) (when (consp charset) (error "Can't encode a part with several charsets.")) @@ -466,13 +516,13 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (mail-header-encode-parameter (symbol-name type) value)))))) -(defvar ange-ftp-path-format) +(defvar ange-ftp-name-format) (defvar efs-path-regexp) (defun mml-parse-file-name (path) (if (if (boundp 'efs-path-regexp) (string-match efs-path-regexp path) - (if (boundp 'ange-ftp-path-format) - (string-match (car ange-ftp-path-format)))) + (if (boundp 'ange-ftp-name-format) + (string-match (car ange-ftp-name-format) path))) (list (match-string 1 path) (match-string 2 path) (substring path (1+ (match-end 2)))) path)) @@ -515,7 +565,8 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (message-encode-message-body) (save-restriction (message-narrow-to-headers-or-head) - (mail-encode-encoded-word-buffer))) + (let ((mail-parse-charset message-default-charset)) + (mail-encode-encoded-word-buffer)))) (defun mml-insert-mime (handle &optional no-markup) (let (textp buffer mmlp) @@ -523,7 +574,7 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (unless (stringp (car handle)) (unless (setq textp (equal (mm-handle-media-supertype handle) "text")) (save-excursion - (set-buffer (setq buffer (generate-new-buffer " *mml*"))) + (set-buffer (setq buffer (mml-generate-new-buffer " *mml*"))) (mm-insert-part handle) (if (setq mmlp (equal (mm-handle-media-type handle) "message/rfc822")) @@ -597,7 +648,7 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (define-key map "p" 'mml-insert-part) (define-key map "v" 'mml-validate) (define-key map "P" 'mml-preview) - (define-key map "n" 'mml-narrow-to-part) + ;;(define-key map "n" 'mml-narrow-to-part) (define-key main "\M-m" map) main)) @@ -611,7 +662,7 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." ("Insert" ["Multipart" mml-insert-multipart t] ["Part" mml-insert-part t]) - ["Narrow" mml-narrow-to-part t] + ;;["Narrow" mml-narrow-to-part t] ["Quote" mml-quote-region t] ["Validate" mml-validate t] ["Preview" mml-preview t])) @@ -702,7 +753,7 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (goto-char (point-min)) ;; Quote parts. (while (re-search-forward - "<#/?!*\\(multipart\\|part\\|external\\|mml\\)" nil t) + "<#!*/?\\(multipart\\|part\\|external\\|mml\\)" nil t) ;; Insert ! after the #. (goto-char (+ (match-beginning 0) 2)) (insert "!"))))) @@ -792,7 +843,9 @@ If RAW, don't highlight the article." (interactive "P") (let ((buf (current-buffer)) (message-posting-charset (or (gnus-setup-posting-charset - (message-fetch-field "Newsgroups")) + (save-restriction + (message-narrow-to-headers-or-head) + (message-fetch-field "Newsgroups"))) message-posting-charset))) (switch-to-buffer (get-buffer-create (concat (if raw "*Raw MIME preview of " @@ -803,7 +856,8 @@ If RAW, don't highlight the article." (concat "^" (regexp-quote mail-header-separator) "\n") nil t) (replace-match "\n")) (mml-to-mime) - (unless raw + (if raw + (mm-disable-multibyte) (let ((gnus-newsgroup-charset (car message-posting-charset))) (run-hooks 'gnus-article-decode-hook) (let ((gnus-newsgroup-name "dummy")) diff --git a/lisp/nndoc.el b/lisp/nndoc.el index afdeab8..2386eae 100644 --- a/lisp/nndoc.el +++ b/lisp/nndoc.el @@ -71,8 +71,8 @@ from the document.") (body-begin-function . nndoc-babyl-body-begin) (head-begin-function . nndoc-babyl-head-begin)) (forward - (article-begin . "^-+ \\(Start of \\)?forwarded message -+\n+") - (body-end . "^-+ End \\(of \\)?forwarded message -+$") + (article-begin . "^-+ \\(Start of \\)?forwarded message.*\n+") + (body-end . "^-+ End \\(of \\)?forwarded message.*$") (prepare-body-function . nndoc-unquote-dashes)) (rfc934 (article-begin . "^--.*\n+") @@ -87,6 +87,7 @@ from the document.") (article-transform-function . nndoc-transform-clari-briefs)) (mime-digest (article-begin . "") + (head-begin . "^ ?\n") (head-end . "^ ?$") (body-end . "") (file-end . "") @@ -433,7 +434,8 @@ from the document.") t)) (defun nndoc-forward-type-p () - (when (and (re-search-forward "^-+ Start of forwarded message -+\n+" nil t) + (when (and (re-search-forward "^-+ \\(Start of \\)?forwarded message.*\n+" + nil t) (not (re-search-forward "^Subject:.*digest" nil t)) (not (re-search-backward "^From:" nil t 2)) (not (re-search-forward "^From:" nil t 2))) @@ -527,10 +529,11 @@ from the document.") nil t) (match-beginning 1)) (setq boundary-id (match-string 1) - b-delimiter (concat "\n--" boundary-id "[\n \t]+")) + b-delimiter (concat "\n--" boundary-id "[ \t]*$")) (setq entry (assq 'mime-digest nndoc-type-alist)) (setcdr entry (list + (cons 'head-begin "^ ?\n") (cons 'head-end "^ ?$") (cons 'body-begin "^ ?\n") (cons 'article-begin b-delimiter) diff --git a/lisp/nndraft.el b/lisp/nndraft.el index 22a76c1..1d320a5 100644 --- a/lisp/nndraft.el +++ b/lisp/nndraft.el @@ -198,6 +198,15 @@ (nnoo-parent-function 'nndraft 'nnmh-request-accept-article (list group server last noinsert)))) +(deffoo nndraft-request-replace-article (article group buffer) + (nndraft-possibly-change-group group) + (let ((nnmail-file-coding-system + (if (equal group "drafts") + mm-auto-save-coding-system + mm-text-coding-system))) + (nnoo-parent-function 'nndraft 'nnmh-request-replace-article + (list article group buffer)))) + (deffoo nndraft-request-create-group (group &optional server args) (nndraft-possibly-change-group group) (if (file-exists-p nndraft-current-directory) @@ -251,8 +260,7 @@ nnmh-close-group nnmh-request-list nnmh-request-newsgroups - nnmh-request-move-article - nnmh-request-replace-article)) + nnmh-request-move-article)) (provide 'nndraft) diff --git a/lisp/nnfolder.el b/lisp/nnfolder.el index 2c77996..d782835 100644 --- a/lisp/nnfolder.el +++ b/lisp/nnfolder.el @@ -584,7 +584,7 @@ deleted. Point is left where the deleted region was." ;; Change group. (when (and group (not (equal group nnfolder-current-group))) - (let ((pathname-coding-system nnmail-pathname-coding-system)) + (let ((file-name-coding-system nnmail-pathname-coding-system)) (nnmail-activate 'nnfolder) (when (and (not (assoc group nnfolder-group-alist)) (not (file-exists-p diff --git a/lisp/nnheader.el b/lisp/nnheader.el index d0f484e..ddc69a6 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -560,7 +560,7 @@ the line could be found." (erase-buffer)) (current-buffer)) -(defvar jka-compr-compression-info-list) +(eval-when-compile (defvar jka-compr-compression-info-list)) (defvar nnheader-numerical-files (if (boundp 'jka-compr-compression-info-list) (concat "\\([0-9]+\\)\\(" @@ -868,11 +868,11 @@ find-file-hooks, etc. "Strip all \r's from the current buffer." (nnheader-skeleton-replace "\r")) -(fset 'nnheader-run-at-time 'run-at-time) -(fset 'nnheader-cancel-timer 'cancel-timer) -(fset 'nnheader-cancel-function-timers 'cancel-function-timers) +(defalias 'nnheader-run-at-time 'run-at-time) +(defalias 'nnheader-cancel-timer 'cancel-timer) +(defalias 'nnheader-cancel-function-timers 'cancel-function-timers) -(when (string-match "XEmacs\\|Lucid" emacs-version) +(when (string-match "XEmacs" emacs-version) (require 'nnheaderxm)) (run-hooks 'nnheader-load-hook) diff --git a/lisp/nnimap.el b/lisp/nnimap.el index af1de33..699ef5d 100644 --- a/lisp/nnimap.el +++ b/lisp/nnimap.el @@ -37,7 +37,6 @@ ;; Todo, minor things: ;; ;; o Don't require half of Gnus -- backends should be standalone -;; o Support escape characters in `message-tokenize-header' ;; o Verify that we don't use IMAP4rev1 specific things (RFC2060 App B) ;; o Dont uid fetch 1,* in nnimap-retrive-groups (slow) ;; o Split up big fetches (1,* header especially) in smaller chunks @@ -113,10 +112,6 @@ element in each \"rule\" is the name of the IMAP mailbox, and the second is a regexp that nnimap will try to match on the header to find a fit. -The first element can also be a list. In that case, the first element -is the server the second element is the group on that server in which -the matching article will be stored. - The second element can also be a function. In that case, it will be called narrowed to the headers with the first element of the rule as the argument. It should return a non-nil value if it thinks that the @@ -124,7 +119,25 @@ mail belongs in that group. This variable can also have a function as its value, the function will be called with the headers narrowed and should return a group where it -thinks the article should be splitted to.") +thinks the article should be splitted to. See `nnimap-split-fancy'. + +To allow for different split rules on different virtual servers, and +even different split rules in different inboxes on the same server, +the syntax of this variable have been extended along the lines of: + +(setq nnimap-split-rule + '((\"my1server\" (\".*\" ((\"ding\" \"ding@gnus.org\") + (\"junk\" \"From:.*Simon\"))) + (\"my2server\" (\"INBOX\" nnimap-split-fancy)) + (\"my[34]server\" (\".*\" ((\"private\" \"To:.*Simon\") + (\"junk\" my-junk-func))))) + +The virtual server name is in fact a regexp, so that the same rules +may apply to several servers. In the example, the servers +\"my3server\" and \"my4server\" both use the same rules. Similarly, +the inbox string is also a regexp. The actual splitting rules are as +before, either a function, or a list with group/regexp or +group/function elements.") (defvar nnimap-split-predicate "UNSEEN UNDELETED" "The predicate used to find articles to split. @@ -524,15 +537,14 @@ If EXAMINE is non-nil the group is selected read-only." (imap-capability 'IMAP4rev1 nnimap-server-buffer)) (imap-close nnimap-server-buffer) (nnheader-report 'nnimap "Server %s is not IMAP4 compliant" server)) - (let (list alist user passwd) - (and (fboundp 'gnus-parse-netrc) - (setq list (gnus-parse-netrc nnimap-authinfo-file) - alist (or (and (gnus-netrc-get - (gnus-netrc-machine list server) "machine") - (gnus-netrc-machine list server)) - (gnus-netrc-machine list nnimap-address)) - user (gnus-netrc-get alist "login") - passwd (gnus-netrc-get alist "password"))) + (let* ((list (gnus-parse-netrc nnimap-authinfo-file)) + (port (if nnimap-server-port + (int-to-string nnimap-server-port) + "imap")) + (alist (or (gnus-netrc-machine list server port "imap") + (gnus-netrc-machine list nnimap-address port "imap"))) + (user (gnus-netrc-get alist "login")) + (passwd (gnus-netrc-get alist "password"))) (if (imap-authenticate user passwd nnimap-server-buffer) (prog1 (push (list server nnimap-server-buffer) @@ -610,7 +622,12 @@ function is generally only called when Gnus is shutting down." (with-current-buffer nnimap-callback-buffer (insert (with-current-buffer nnimap-server-buffer - (nnimap-demule (imap-message-get (imap-current-message) 'RFC822)))) ;xxx + (nnimap-demule + (if (imap-capability 'IMAP4rev1) + ;; xxx don't just use car? alist doesn't contain + ;; anything else now, but it might... + (nth 2 (car (imap-message-get (imap-current-message) 'BODYDETAIL))) + (imap-message-get (imap-current-message) 'RFC822))))) (nnheader-ms-strip-cr) (funcall nnimap-callback-callback-function t))) @@ -736,8 +753,9 @@ function is generally only called when Gnus is shutting down." (deffoo nnimap-request-post (&optional server) (let ((success t)) - (dolist (mbx (message-tokenize-header - (message-fetch-field "Newsgroups")) success) + (dolist (mbx (message-unquote-tokens + (message-tokenize-header + (message-fetch-field "Newsgroups") ", ")) success) (let ((to-newsgroup (gnus-group-prefixed-name mbx gnus-command-method))) (or (gnus-active to-newsgroup) (gnus-activate-group to-newsgroup) @@ -895,8 +913,19 @@ function is generally only called when Gnus is shutting down." (or nnimap-split-crosspost (throw 'split-done to-groups)))))))))) +(defun nnimap-assoc-match (key alist) + (let (element) + (while (and alist (not element)) + (if (string-match (car (car alist)) key) + (setq element (car alist))) + (setq alist (cdr alist))) + element)) + (defun nnimap-split-find-rule (server inbox) - nnimap-split-rule) + (if (listp (cadar nnimap-split-rule)) ;; extended format? + (cadr (nnimap-assoc-match inbox (cdr (nnimap-assoc-match + server nnimap-split-rule)))) + nnimap-split-rule)) (defun nnimap-split-find-inbox (server) (if (listp nnimap-split-inbox) @@ -1061,8 +1090,9 @@ function is generally only called when Gnus is shutting down." (goto-char (point-min)) (while (search-forward "\n" nil t) (replace-match "\r\n"))) - ;; next line for Cyrus server bug - (imap-mailbox-unselect nnimap-server-buffer) + ;; this 'or' is for Cyrus server bug + (or (null (imap-current-mailbox nnimap-server-buffer)) + (imap-mailbox-unselect nnimap-server-buffer)) (imap-message-append group (current-buffer) nil nil nnimap-server-buffer))) (cons group (nth 1 uid)) diff --git a/lisp/nnmail.el b/lisp/nnmail.el index a5ff525..8b81eb3 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -191,6 +191,12 @@ This variable is obsolete; `mail-sources' should be used instead." :group 'nnmail-procmail :type 'boolean) +(defcustom nnmail-scan-directory-mail-source-once nil + "*If non-nil, scan all incoming procmail sorted mails once. +It scans low-level sorted spools even when not required." + :group 'nnmail-procmail + :type 'boolean) + (defcustom nnmail-delete-file-function 'delete-file "Function called to delete files in some mail backends." :group 'nnmail-files @@ -462,7 +468,7 @@ parameter. It should return nil, `warn' or `delete'." (condition-case () (let ((coding-system-for-read nnmail-file-coding-system) (auto-mode-alist (mm-auto-mode-alist)) - (pathname-coding-system nnmail-pathname-coding-system)) + (file-name-coding-system nnmail-pathname-coding-system)) (insert-file-contents file) t) (file-error nil)))) @@ -1520,6 +1526,7 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." nil)) ;; Hack to only fetch the contents of a single group's spool file. (when (and (eq (car source) 'directory) + (null nnmail-scan-directory-mail-source-once) group) (mail-source-bind (directory source) (setq source (append source @@ -1616,7 +1623,7 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (defun nnmail-write-region (start end filename &optional append visit lockname) "Do a `write-region', and then set the file modes." (let ((coding-system-for-write nnmail-file-coding-system) - (pathname-coding-system nnmail-pathname-coding-system)) + (file-name-coding-system nnmail-pathname-coding-system)) (write-region start end filename append visit lockname) (set-file-modes filename nnmail-default-file-modes))) diff --git a/lisp/nnmh.el b/lisp/nnmh.el index 6272d54..da72c95 100644 --- a/lisp/nnmh.el +++ b/lisp/nnmh.el @@ -83,7 +83,7 @@ as unread by Gnus.") (large (and (numberp nnmail-large-newsgroup) (> number nnmail-large-newsgroup))) (count 0) - (pathname-coding-system 'binary) + (file-name-coding-system nnmail-pathname-coding-system) beg article) (nnmh-possibly-change-directory newsgroup server) ;; We don't support fetching by Message-ID. @@ -142,7 +142,7 @@ as unread by Gnus.") (let ((file (if (stringp id) nil (concat nnmh-current-directory (int-to-string id)))) - (pathname-coding-system 'binary) + (file-name-coding-system nnmail-pathname-coding-system) (nntp-server-buffer (or buffer nntp-server-buffer))) (and (stringp file) (file-exists-p file) @@ -154,7 +154,7 @@ as unread by Gnus.") (nnheader-init-server-buffer) (nnmh-possibly-change-directory group server) (let ((pathname (nnmail-group-pathname group nnmh-directory)) - (pathname-coding-system 'binary) + (file-name-coding-system nnmail-pathname-coding-system) dir) (cond ((not (file-directory-p pathname)) @@ -197,7 +197,7 @@ as unread by Gnus.") (deffoo nnmh-request-list (&optional server dir) (nnheader-insert "") (nnmh-possibly-change-directory nil server) - (let ((pathname-coding-system 'binary) + (let ((file-name-coding-system nnmail-pathname-coding-system) (nnmh-toplev (file-truename (or dir (file-name-as-directory nnmh-directory))))) (nnmh-request-list-1 nnmh-toplev)) @@ -410,7 +410,7 @@ as unread by Gnus.") (nnmh-open-server server)) (when newsgroup (let ((pathname (nnmail-group-pathname newsgroup nnmh-directory)) - (pathname-coding-system 'binary)) + (file-name-coding-system nnmail-pathname-coding-system)) (if (file-directory-p pathname) (setq nnmh-current-directory pathname) (error "No such newsgroup: %s" newsgroup))))) @@ -459,7 +459,7 @@ as unread by Gnus.") "Compute the next article number in GROUP." (let ((active (cadr (assoc group nnmh-group-alist))) (dir (nnmail-group-pathname group nnmh-directory)) - (pathname-coding-system 'binary) + (file-name-coding-system nnmail-pathname-coding-system) file) (unless active ;; The group wasn't known to nnmh, so we just create an active diff --git a/lisp/nnml.el b/lisp/nnml.el index 07fdbc6..9fef341 100644 --- a/lisp/nnml.el +++ b/lisp/nnml.el @@ -103,7 +103,7 @@ all. This may very well take some time.") (let ((file nil) (number (length sequence)) (count 0) - (pathname-coding-system 'binary) + (file-name-coding-system nnmail-pathname-coding-system) beg article) (if (stringp (car sequence)) 'headers @@ -164,7 +164,7 @@ all. This may very well take some time.") (deffoo nnml-request-article (id &optional group server buffer) (nnml-possibly-change-directory group server) (let* ((nntp-server-buffer (or buffer nntp-server-buffer)) - (pathname-coding-system 'binary) + (file-name-coding-system nnmail-pathname-coding-system) path gpath group-num) (if (stringp id) (when (and (setq group-num (nnml-find-group-number id)) @@ -195,7 +195,7 @@ all. This may very well take some time.") (string-to-int (file-name-nondirectory path))))))) (deffoo nnml-request-group (group &optional server dont-check) - (let ((pathname-coding-system 'binary)) + (let ((file-name-coding-system nnmail-pathname-coding-system)) (cond ((not (nnml-possibly-change-directory group server)) (nnheader-report 'nnml "Invalid group (no such directory)")) @@ -253,7 +253,7 @@ all. This may very well take some time.") (deffoo nnml-request-list (&optional server) (save-excursion (let ((nnmail-file-coding-system nnmail-active-file-coding-system) - (pathname-coding-system 'binary)) + (file-name-coding-system nnmail-pathname-coding-system)) (nnmail-find-file nnml-active-file)) (setq nnml-group-alist (nnmail-get-active)) t)) @@ -569,7 +569,7 @@ all. This may very well take some time.") (if (not group) t (let ((pathname (nnmail-group-pathname group nnml-directory)) - (pathname-coding-system 'binary)) + (file-name-coding-system nnmail-pathname-coding-system)) (when (not (equal pathname nnml-current-directory)) (setq nnml-current-directory pathname nnml-current-group group diff --git a/lisp/nnslashdot.el b/lisp/nnslashdot.el index 7d7ebf4..15f1ed6 100644 --- a/lisp/nnslashdot.el +++ b/lisp/nnslashdot.el @@ -104,7 +104,8 @@ (let ((case-fold-search t)) (erase-buffer) (when (= start 1) - (nnweb-insert (format nnslashdot-article-url sid) t) + (nnweb-insert (format nnslashdot-article-url + (nnslashdot-sid-strip sid)) t) (goto-char (point-min)) (search-forward "Posted by ") (when (looking-at "]+>\\([^<]+\\)") @@ -115,20 +116,23 @@ (forward-line 2) (setq lines (count-lines (point) - (search-forward - "A href=http://slashdot.org/article" nil t))) + (re-search-forward + "A href=\"\\(http://slashdot.org\\)?/article" nil t))) (push (cons 1 (make-full-mail-header - 1 group from date (concat "<" sid "%1@slashdot>") + 1 group from date + (concat "<" (nnslashdot-sid-strip sid) "%1@slashdot>") "" 0 lines nil nil)) headers)) (while (and (setq start (pop startats)) (< start last)) (setq point (goto-char (point-max))) (nnweb-insert - (format nnslashdot-comments-url sid nnslashdot-threshold 0 start) + (format nnslashdot-comments-url + (nnslashdot-sid-strip sid) + nnslashdot-threshold 0 start) t) (when first-comments (setq first-comments nil) @@ -163,7 +167,7 @@ (setq lines (/ (abs (- (search-forward ""))) 70)) - (forward-line 2) + (forward-line 4) (setq parent (if (looking-at ".*cid=\\([0-9]+\\)") (match-string 1) @@ -176,11 +180,11 @@ (1+ article) (concat subject " (" score ")") from date - (concat "<" sid "%" + (concat "<" (nnslashdot-sid-strip sid) "%" (number-to-string (1+ article)) "@slashdot>") (if parent - (concat "<" sid "%" + (concat "<" (nnslashdot-sid-strip sid) "%" (number-to-string (1+ (string-to-number parent))) "@slashdot>") "") @@ -204,7 +208,8 @@ (set-buffer nnslashdot-buffer) (erase-buffer) (when (= start 1) - (nnweb-insert (format nnslashdot-article-url sid) t) + (nnweb-insert (format nnslashdot-article-url + (nnslashdot-sid-strip sid)) t) (goto-char (point-min)) (search-forward "Posted by ") (when (looking-at "]+>\\([^<]+\\)") @@ -214,13 +219,14 @@ (buffer-substring (point) (1- (search-forward "<"))))) (forward-line 2) (setq lines (count-lines (point) - (search-forward - "A href=http://slashdot.org/article"))) + (re-search-forward + "A href=\"\\(http://slashdot.org\\)?/article"))) (push (cons 1 (make-full-mail-header - 1 group from date (concat "<" sid "%1@slashdot>") + 1 group from date (concat "<" (nnslashdot-sid-strip sid) + "%1@slashdot>") "" 0 lines nil nil)) headers)) (while (or (not article) @@ -230,7 +236,8 @@ (setq start (1+ article))) (setq point (goto-char (point-max))) (nnweb-insert - (format nnslashdot-comments-url sid nnslashdot-threshold 4 start) + (format nnslashdot-comments-url (nnslashdot-sid-strip sid) + nnslashdot-threshold 4 start) t) (goto-char point) (while (re-search-forward @@ -269,11 +276,11 @@ (make-full-mail-header (1+ article) (concat subject " (" score ")") from date - (concat "<" sid "%" + (concat "<" (nnslashdot-sid-strip sid) "%" (number-to-string (1+ article)) "@slashdot>") (if parent - (concat "<" sid "%" + (concat "<" (nnslashdot-sid-strip sid) "%" (number-to-string (1+ (string-to-number parent))) "@slashdot>") "") @@ -329,7 +336,7 @@ (point) (progn (re-search-forward - "

.*A href=http://slashdot\\.org/article") + "

.*A href=\"\\(http://slashdot.org\\)?/article") (match-beginning 0))))) (search-forward (format "" (1- article))) (setq contents @@ -423,7 +430,7 @@ (deffoo nnslashdot-request-post (&optional server) (nnslashdot-possibly-change-server nil server) - (let ((sid (message-fetch-field "newsgroups")) + (let ((sid (nnslashdot-sid-strip (message-fetch-field "newsgroups"))) (subject (message-fetch-field "subject")) (references (car (last (split-string (message-fetch-field "references"))))) @@ -532,6 +539,11 @@ (defun nnslashdot-lose (why) (error "Slashdot HTML has changed; please get a new version of nnslashdot")) +(defun nnslashdot-sid-strip (sid) + (if (string-match "^00/" sid) + (substring sid (match-end 0)) + sid)) + (provide 'nnslashdot) ;;; nnslashdot.el ends here diff --git a/lisp/nnsoup.el b/lisp/nnsoup.el index be3ec20..efe5baa 100644 --- a/lisp/nnsoup.el +++ b/lisp/nnsoup.el @@ -47,7 +47,7 @@ (defvoo nnsoup-replies-directory (concat nnsoup-directory "replies/") "*Directory where outgoing packets will be composed.") -(defvoo nnsoup-replies-format-type ?n +(defvoo nnsoup-replies-format-type ?u ;; u is USENET news format. "*Format of the replies packages.") (defvoo nnsoup-replies-index-type ?n @@ -255,7 +255,7 @@ backend for the messages.") (nth 1 (nnsoup-article-to-area article nnsoup-current-group)))))) (cond ((= kind ?m) 'mail) - ((= kind ?n) 'news) + ((= kind ?n) 'news) (t 'unknown))))) (deffoo nnsoup-close-group (group &optional server) @@ -476,7 +476,8 @@ backend for the messages.") (goto-char (point-min)) (cond ;; rnews batch format - ((= format ?n) + ((or (= format ?u) + (= format ?n)) ;; Gnus back compatibility. (while (looking-at "^#! *rnews \\(+[0-9]+\\) *$") (forward-line 1) (push (list @@ -590,7 +591,7 @@ backend for the messages.") (let ((format (gnus-soup-encoding-format (gnus-soup-area-encoding (nth 1 area))))) (goto-char end) - (when (or (= format ?n) (= format ?m)) + (when (or (= format ?u) (= format ?n) (= format ?m)) (setq end (progn (forward-line -1) (point)))))) (set-buffer msg-buf)) (widen) @@ -766,13 +767,13 @@ backend for the messages.") (if (not (setq elem (assoc group active))) (push (list group (cons 1 lines) (list (cons 1 lines) - (vector ident group "ncm" "" lines))) + (vector ident group "ucm" "" lines))) active) (nconc elem (list (list (cons (1+ (setq min (cdadr elem))) (+ min lines)) - (vector ident group "ncm" "" lines)))) + (vector ident group "ucm" "" lines)))) (setcdr (cadr elem) (+ min lines))) (setq files (cdr files))) (nnheader-message 5 "") diff --git a/lisp/nnwarchive.el b/lisp/nnwarchive.el index f888a62..5103b55 100644 --- a/lisp/nnwarchive.el +++ b/lisp/nnwarchive.el @@ -68,9 +68,9 @@ (list-dissect . nnwarchive-egroups-list) (list-groups . nnwarchive-egroups-list-groups) (xover-url - "http://www.egroups.com/message/%s/%d" group aux) + "http://www.egroups.com/messages/%s/%d" group aux) (xover-last-url - "http://www.egroups.com/message/%s/" group) + "http://www.egroups.com/messages/%s/" group) (xover-page-size . 13) (xover-dissect . nnwarchive-egroups-xover) (article-url diff --git a/lisp/pop3.el b/lisp/pop3.el index ca6476a..02630b5 100644 --- a/lisp/pop3.el +++ b/lisp/pop3.el @@ -119,7 +119,7 @@ Returns the process associated with the connection." (coding-system-for-write 'binary) process) (save-excursion - (set-buffer (get-buffer-create (concat " trace of POP session to %s" + (set-buffer (get-buffer-create (concat " trace of POP session to " mailhost))) (erase-buffer) (setq pop3-read-point (point-min)) diff --git a/lisp/qp.el b/lisp/qp.el index 93c3f7e..ea2a818 100644 --- a/lisp/qp.el +++ b/lisp/qp.el @@ -115,23 +115,24 @@ encode lines starting with \"From\"." (delete-char 1))))) (when (or fold mm-use-ultra-safe-encoding) ;; Fold long lines. - (goto-char (point-min)) - (while (not (eobp)) - ;; In ultra-safe mode, encode "From " at the beginning of a - ;; line. - (when mm-use-ultra-safe-encoding - (beginning-of-line) - (when (looking-at "From ") - (replace-match "From=20" nil t))) - (end-of-line) - (while (> (current-column) 72) - (beginning-of-line) - (forward-char 71);; 71 char plus an "=" - (search-backward "=" (- (point) 2) t) - (insert "=\n") - (end-of-line)) - (unless (eobp) - (forward-line))))))) + (let ((tab-width 1)) ;; HTAB is one character. + (goto-char (point-min)) + (while (not (eobp)) + ;; In ultra-safe mode, encode "From " at the beginning of a + ;; line. + (when mm-use-ultra-safe-encoding + (beginning-of-line) + (when (looking-at "From ") + (replace-match "From=20" nil t))) + (end-of-line) + (while (> (current-column) 76) ;; tab-width must be 1. + (beginning-of-line) + (forward-char 75);; 75 chars plus an "=" + (search-backward "=" (- (point) 2) t) + (insert "=\n") + (end-of-line)) + (unless (eobp) + (forward-line)))))))) (defun quoted-printable-encode-string (string) "QP-encode STRING and return the results." diff --git a/lisp/rfc2047.el b/lisp/rfc2047.el index d404285..7a86311 100644 --- a/lisp/rfc2047.el +++ b/lisp/rfc2047.el @@ -107,19 +107,23 @@ Should be called narrowed to the head of the message." (interactive "*") (save-excursion (goto-char (point-min)) - (let ((alist rfc2047-header-encoding-alist) - elem method) + (let (alist elem method) (while (not (eobp)) (save-restriction (rfc2047-narrow-to-field) (if (not (rfc2047-encodable-p)) - (if (mm-body-7-or-8) - ;; 8 bit must be decoded. - (if (car message-posting-charset) - ;; Is message-posting-charset a coding system? - (mm-encode-coding-region (point-min) (point-max) - (car message-posting-charset)))) + (if (and (eq (mm-body-7-or-8) '8bit) + (mm-multibyte-p) + (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))) ;; We found something that may perhaps be encoded. + (setq method nil + alist rfc2047-header-encoding-alist) (while (setq elem (pop alist)) (when (or (and (stringp (car elem)) (looking-at (car elem))) @@ -130,12 +134,17 @@ Should be called narrowed to the head of the message." ((eq method 'mime) (rfc2047-encode-region (point-min) (point-max)) (rfc2047-fold-region (point-min) (point-max))) + ((eq method 'default) + (if (and (featurep 'mule) + mail-parse-charset) + (mm-encode-coding-region (point-min) (point-max) + mail-parse-charset))) + ((mm-coding-system-p method) + (if (featurep 'mule) + (mm-encode-coding-region (point-min) (point-max) method))) ;; Hm. (t))) - (goto-char (point-max))))) - (when mail-parse-charset - (mm-encode-coding-region - (point-min) (point-max) mail-parse-charset)))) + (goto-char (point-max))))))) (defun rfc2047-encodable-p (&optional header) "Say whether the current (narrowed) buffer contains characters that need encoding in headers." @@ -215,10 +224,14 @@ Should be called narrowed to the head of the message." (if (equal (nth 2 word) current) (setq beg (nth 0 word)) (when current - (when (prog1 (and (eq beg (nth 1 word)) (nth 2 word)) - (rfc2047-encode beg end current)) - (goto-char beg) - (insert " "))) + (if (and (eq beg (nth 1 word)) (nth 2 word)) + (progn + ;; There might be a bug in Emacs Mule. + ;; A space must be inserted before encoding. + (goto-char beg) + (insert " ") + (rfc2047-encode (1+ beg) (1+ end) current)) + (rfc2047-encode beg end current))) (setq current (nth 2 word) beg (nth 0 word) end (nth 1 word)))) @@ -251,7 +264,9 @@ Should be called narrowed to the head of the message." (goto-char (min (point-max) (+ 15 (point)))) (unless (eobp) (insert "\n")))) - (mm-encode-coding-region (point-min) (point-max) mime-charset) + (if (and (mm-multibyte-p) + (mm-coding-system-p mime-charset)) + (mm-encode-coding-region (point-min) (point-max) mime-charset)) (funcall (cdr (assq encoding rfc2047-encoding-function-alist)) (point-min) (point-max)) (goto-char (point-min)) diff --git a/lisp/webmail.el b/lisp/webmail.el index bc33f3a..2110624 100644 --- a/lisp/webmail.el +++ b/lisp/webmail.el @@ -454,7 +454,8 @@ (webmail-error "article@3.1")) (delete-region (match-beginning 0) (point-max)) (nnweb-remove-markup) - (nnweb-decode-entities) + (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities))) + (nnweb-decode-entities)) (goto-char (point-min)) (while (re-search-forward "\r\n?" nil t) (replace-match "\n")) @@ -483,7 +484,8 @@ (search-forward "" nil t) (delete-region p (match-end 0))) (nnweb-remove-markup) - (nnweb-decode-entities) + (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities))) + (nnweb-decode-entities)) (goto-char (point-min)) (delete-blank-lines) (goto-char (point-min)) @@ -539,7 +541,8 @@ (if (looking-at "$") (forward-char)) (delete-region (point-min) (point)) (nnweb-remove-markup) - (nnweb-decode-entities) + (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities))) + (nnweb-decode-entities)) nil) (t (setq mime t) @@ -633,7 +636,8 @@ (search-forward "" nil t) (delete-region p (match-end 0))) (nnweb-remove-markup) - (nnweb-decode-entities) + (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities))) + (nnweb-decode-entities)) (goto-char (point-min)) (delete-blank-lines) (goto-char (point-max)) @@ -650,7 +654,8 @@ (webmail-error "article@5")) (narrow-to-region p (match-end 0)) (nnweb-remove-markup) - (nnweb-decode-entities) + (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities))) + (nnweb-decode-entities)) (goto-char (point-min)) (delete-blank-lines) (setq ct (mail-fetch-field "content-type") @@ -721,6 +726,7 @@ (webmail-error "login@1"))) (defun webmail-netaddress-list () + (webmail-refresh-redirect) (let (item id) (goto-char (point-min)) (when (re-search-forward @@ -753,7 +759,8 @@ (while (re-search-forward "
" nil t) (replace-match "\n")) (nnweb-remove-markup) - (nnweb-decode-entities) + (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities))) + (nnweb-decode-entities)) nil) (t (insert "<#part type=\"text/html\" disposition=inline>") @@ -762,6 +769,7 @@ t))) (defun webmail-netaddress-article (file id) + (webmail-refresh-redirect) (let (p p1 attachment count mime type) (save-restriction (webmail-encode-8bit) @@ -781,7 +789,8 @@ (while (search-forward "" nil t) (replace-match "\n")) (nnweb-remove-markup) - (nnweb-decode-entities) + (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities))) + (nnweb-decode-entities)) (goto-char (point-min)) (delete-blank-lines) (goto-char (point-min)) @@ -906,7 +915,8 @@ (while (search-forward "" nil t) (replace-match "\n")) (nnweb-remove-markup) - (nnweb-decode-entities) + (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities))) + (nnweb-decode-entities)) (goto-char (point-min)) (delete-blank-lines) (goto-char (point-min)) diff --git a/texi/ChangeLog b/texi/ChangeLog index 1c05270..b8ab0ea 100644 --- a/texi/ChangeLog +++ b/texi/ChangeLog @@ -1,3 +1,33 @@ +2000-06-28 Simon Josefsson + + * gnus.texi (Splitting in IMAP): Update. + +2000-05-19 15:18:32 Dmitry Yaitskov + + * message.texi (Reply): Doc fix. + +2000-05-17 00:50:29 Shenghuo ZHU + + * gnus.texi (Listing Groups): Addition. + +2000-05-16 21:46:40 Shenghuo ZHU + + * gnus.texi (Misc Group Stuff): Addition. + (Article Washing): Ditto. + +2000-05-15 10:16:29 Shenghuo ZHU + + * gnus.texi (Mail Source Specifiers): Update maildir. + +2000-05-02 Pavel Janik + + * gnus.texi (MIME comands): Spelling fix. + +2000-05-03 21:12:05 Shenghuo ZHU + + * gnus.texi (Summary Mail Commands): Addition. + (Summary Post Commands): Ditto. + 2000-04-27 Dave Love * gnus.texi (Article Washing): Update x-face bit. diff --git a/texi/gnus.texi b/texi/gnus.texi index 51562e5..c2ff745 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -355,7 +355,7 @@ can be gotten by any nefarious means you can think of---@sc{nntp}, local spool or your mbox file. All at the same time, if you want to push your luck. -This manual corresponds to Gnus 5.8.6. +This manual corresponds to Gnus 5.8.7. @end ifinfo @@ -2771,6 +2771,11 @@ List all groups that have names or descriptions that match a regexp @findex gnus-group-list-cached List all groups with cached articles (@code{gnus-group-list-cached}). +@item A ? +@kindex A ? (Group) +@findex gnus-group-list-dormant +List all groups with dormant articles (@code{gnus-group-list-dormant}). + @end table @vindex gnus-permanently-visible-groups @@ -3547,8 +3552,29 @@ generated. It may be used to move point around, for instance. Groups matching this regexp will always be listed in the group buffer, whether they are empty or not. -@end table +@item gnus-group-name-charset-method-alist +@vindex gnus-group-name-charset-method-alist +An alist of method and the charset for group names. It is used to show +non-ASCII group names. + +For example: +@lisp +(setq gnus-group-name-charset-method-alist + '(((nntp "news.com.cn") . cn-gb-2312))) +@end lisp + +@item gnus-group-name-charset-group-alist +@vindex gnus-group-name-charset-group-alist +An alist of regexp of group name and the charset for group names. +It is used to show non-ASCII group names. + +For example: +@lisp +(setq gnus-group-name-charset-group-alist + '(("\\.com\\.cn:" . cn-gb-2312))) +@end lisp +@end table @node Scanning New Messages @subsection Scanning New Messages @@ -4485,12 +4511,21 @@ message (@code{gnus-summary-wide-reply-with-original}). This command uses the process/prefix convention. @item S o m +@itemx C-c C-f @kindex S o m (Summary) +@kindex C-c C-f (Summary) @findex gnus-summary-mail-forward @c @icon{gnus-summary-mail-forward} Forward the current article to some other person -(@code{gnus-summary-mail-forward}). If given a prefix, include the full -headers of the forwarded article. +(@code{gnus-summary-mail-forward}). If no prefix is given, the message +is forwarded according to the value of (@code{message-forward-as-mime}) +and (@code{message-forward-show-mml}); if the prefix is 1, decode the +message and forward directly inline; if the prefix is 2, foward message +as an rfc822 MIME section; if the prefix is 3, decode message and +forward as an rfc822 MIME section; if the prefix is 4, foward message +directly inline; otherwise, the message is forwarded as no prefix given +but use the flipped value of (@code{message-forward-as-mime}). By +default, the message is decoded and forwarded as an rfc822 MIME section. @item S m @itemx m @@ -4615,8 +4650,16 @@ the process/prefix convention. @kindex S o p (Summary) @findex gnus-summary-post-forward Forward the current article to a newsgroup -(@code{gnus-summary-post-forward}). If given a prefix, include the full -headers of the forwarded article. +(@code{gnus-summary-post-forward}). + If no prefix is given, the message is forwarded according to the value +of (@code{message-forward-as-mime}) and +(@code{message-forward-show-mml}); if the prefix is 1, decode the +message and forward directly inline; if the prefix is 2, foward message +as an rfc822 MIME section; if the prefix is 3, decode message and +forward as an rfc822 MIME section; if the prefix is 4, foward message +directly inline; otherwise, the message is forwarded as no prefix given +but use the flipped value of (@code{message-forward-as-mime}). By +default, the message is decoded and forwarded as an rfc822 MIME section. @item S O p @kindex S O p (Summary) @@ -7313,6 +7356,31 @@ readable to me. Note that the this is usually done automatically by Gnus if the message in question has a @code{Content-Transfer-Encoding} header that says that this encoding has been done. +@item W 6 +@kindex W 6 (Summary) +@findex gnus-article-de-base64-unreadable +Treat base64 (@code{gnus-article-de-base64-unreadable}). +Base64 is one common @sc{mime} encoding employed when sending non-ASCII +(i. e., 8-bit) articles. Note that the this is usually done +automatically by Gnus if the message in question has a +@code{Content-Transfer-Encoding} header that says that this encoding has +been done. + +@item W Z +@kindex W Z (Summary) +@findex gnus-article-decode-HZ +Treat HZ or HZP (@code{gnus-article-decode-HZ}). HZ (or HZP) is one +common encoding employed when sending Chinese articles. It typically +makes strings look like @samp{~@{<:Ky2;S@{#,NpJ)l6HK!#~@}}. + +@item W h +@kindex W h (Summary) +@findex gnus-article-wash-html +Treat HTML (@code{gnus-article-wash-html}). +Note that the this is usually done automatically by Gnus if the message +in question has a @code{Content-Type} header that says that this type +has been done. + @item W f @kindex W f (Summary) @cindex x-face @@ -7697,7 +7765,7 @@ the same manner: @table @kbd @item K b @kindex K b (Summary) -Make all the @sc{mime} parts have buttons in from of them. This is +Make all the @sc{mime} parts have buttons in front of them. This is mostly useful if you wish to save (or perform other actions) on inlined parts. @@ -9407,6 +9475,12 @@ headers will be included in the sequence they are matched. If non-@code{nil}, add a @code{to-list} group parameter to mail groups that have none when you do a @kbd{a}. +@item message-send-mail-partially-limit +@vindex message-send-mail-partially-limit +The limitation of messages sent as message/partial. +The lower bound of message size in characters, beyond which the message +should be sent in several parts. If it is nil, the size is unlimited. + @end table @@ -10974,7 +11048,9 @@ Alter this script to fit find the @samp{movemail} you want to use. @item directory Get mail from several files in a directory. This is typically used when -you have procmail split the incoming mail into several files. +you have procmail split the incoming mail into several files. Setting +@code{nnmail-scan-directory-mail-source-once} to non-nil force Gnus to +scan the mail source only once. Keywords: @@ -11111,12 +11187,16 @@ Keywords: @table @code @item :path The path of the directory where the mails are stored. The default is -@samp{~/Maildir/new}. +taken from the @code{MAILDIR} environment variable or +@samp{~/Maildir/}. +@item :subdirs +The subdirectories of the Maildir. The default is +@samp{("new" "cur")}. -If you sometimes look at your mail through a pop3 daemon before fetching -them with Gnus, you may also have to fetch your mails from the -@code{cur} directory inside the maildir, like in the first example -below. +@c If you sometimes look at your mail through a pop3 daemon before fetching +@c them with Gnus, you may also have to fetch your mails from the +@c @code{cur} directory inside the maildir, like in the first example +@c below. You can also get mails from remote hosts (because maildirs don't suffer from locking problems). @@ -11126,11 +11206,11 @@ from locking problems). Two example maildir mail sources: @lisp -(maildir :path "/home/user-name/Maildir/cur") +(maildir :path "/home/user-name/Maildir/" :subdirs ("cur" "new")) @end lisp @lisp -(maildir :path "/user@@remotehost.org:~/Maildir/new") +(maildir :path "/user@@remotehost.org:~/Maildir/" :subdirs ("new")) @end lisp @item imap @@ -13642,10 +13722,30 @@ crossposting enabled. In that case, all matching rules will "win". This variable can also have a function as its value, the function will be called with the headers narrowed and should return a group where it -thinks the article should be splitted to. +thinks the article should be splitted to. See @code{nnimap-split-fancy}. The splitting code tries to create mailboxes if it need too. +To allow for different split rules on different virtual servers, and +even different split rules in different inboxes on the same server, +the syntax of this variable have been extended along the lines of: + +@lisp +(setq nnimap-split-rule + '(("my1server" (".*" (("ding" "ding@@gnus.org") + ("junk" "From:.*Simon"))) + ("my2server" ("INBOX" nnimap-split-fancy)) + ("my[34]server" (".*" (("private" "To:.*Simon") + ("junk" my-junk-func))))) +@end lisp + +The virtual server name is in fact a regexp, so that the same rules +may apply to several servers. In the example, the servers +@code{my3server} and @code{my4server} both use the same rules. +Similarly, the inbox string is also a regexp. The actual splitting +rules are as before, either a function, or a list with group/regexp or +group/function elements. + Nnmail equivalent: @code{nnmail-split-methods}. @item nnimap-split-predicate diff --git a/texi/message.texi b/texi/message.texi index da25d5e..bb9eeb1 100644 --- a/texi/message.texi +++ b/texi/message.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename message -@settitle Message 5.8.6 Manual +@settitle Message 5.8.7 Manual @synindex fn cp @synindex vr cp @synindex pg cp @@ -42,7 +42,7 @@ into another language, under the above conditions for modified versions. @tex @titlepage -@title Message 5.8.6 Manual +@title Message 5.8.7 Manual @author by Lars Magne Ingebrigtsen @page @@ -83,7 +83,7 @@ Message mode buffers. * Key Index:: List of Message mode keys. @end menu -This manual corresponds to Message 5.8.6. Message is distributed with +This manual corresponds to Message 5.8.7. Message is distributed with the Gnus distribution bearing the same version number as this manual. @@ -152,7 +152,7 @@ If you want the replies to go to the @code{Sender} instead of the (setq message-reply-to-function (lambda () (cond ((equal (mail-fetch-field "from") "somebody") - (mail-fetch-field "sender")) + (list (cons 'To (mail-fetch-field "sender")))) (t nil)))) @end lisp -- 1.7.10.4