From: keiichi Date: Thu, 27 Apr 2000 07:31:30 +0000 (+0000) Subject: Sync up with Gnus 5.8.5. X-Git-Tag: nana-gnus-7_1_0_22~21 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=1633f5459307e01ec457bff29d56f82c53833dce;p=elisp%2Fgnus.git- Sync up with Gnus 5.8.5. --- diff --git a/GNUS-NEWS b/GNUS-NEWS index ae36555..057a7f6 100644 --- a/GNUS-NEWS +++ b/GNUS-NEWS @@ -7,6 +7,22 @@ internationalization and mail-fetching. *** The mail-fetching functions have changed. See the manual for the many details. In particular, all procmail fetching variables are gone. +If you used procmail like in + +(setq nnmail-use-procmail t) +(setq nnmail-spool-file 'procmail) +(setq nnmail-procmail-directory "~/mail/incoming/") +(setq nnmail-procmail-suffix "\\.in") + +this now has changed to + +(setq mail-sources + '((directory :path "~/mail/incoming/" + :suffix ".in"))) + +More information is available in the info doc at Select Methods -> +Getting Mail -> Mail Sources + *** Gnus is now a MIME-capable reader. This affects many parts of Gnus, and adds a slew of new commands. See the manual for details. @@ -31,3 +47,8 @@ ever-changing layouts. *** Gnus can now read IMAP mail via nnimap. + +Local variables: +mode: outline +paragraph-separate: "[ ]*$" +end: diff --git a/README b/README index e487c43..d99625f 100644 --- a/README +++ b/README @@ -24,6 +24,13 @@ To enable reading the Gnus manual, you could say something like: (setq Info-default-directory-list (cons "~/gnus-5.6.53/texi" Info-default-directory-list)) +or + + (setq Info-directory-list + (cons "~/gnus-5.6.53/texi" Info-directory-list)) + +depending on which version of Emacs or XEmacs you're using. + Note that Gnus and GNUS can't coexist in a single Emacs. They both use the same function and variable names. If you have been running GNUS in your Emacs, you should probably exit that Emacs and start a new one diff --git a/aclocal.m4 b/aclocal.m4 index 1e00601..1b62c54 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -4,7 +4,7 @@ AC_DEFUN(AM_PATH_LISPDIR, [# If set to t, that means we are running in a shell under Emacs. # If you have an Emacs named "t", then use the full path. test "$EMACS" = t && EMACS= - AC_PATH_PROGS(EMACS, emacs xemacs, no) + test "$EMACS" || AC_PATH_PROGS(EMACS, emacs xemacs, no) if test $EMACS != "no"; then AC_MSG_CHECKING([where .elc files should go]) dnl Set default value diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 7eeca12..dcd5c94 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,624 @@ +Mon Apr 24 21:12:06 2000 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.8.5 is released. + +2000-04-24 16:29:07 Lars Magne Ingebrigtsen + + * rfc2047.el (rfc2047-header-encoding-alist): Doc fix. + + * gnus-util.el (gnus-netrc-machine): Default to nntp. + + * mml.el (mml-generate-mime-1): Force 8bit on message/rfc822. + +2000-04-23 23:27:25 Shenghuo ZHU + + * 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. + (gnus-articles-to-read): Use it. + + * message.el (message-get-reply-headers): Bind free variable. + +2000-04-23 01:14:28 Shenghuo ZHU + + * message.el (message-get-reply-headers): Fix to-address. + +2000-04-22 22:51:46 Shenghuo ZHU + + * webmail.el: Hotmail fix. Add a debug function. + +2000-04-23 00:32:32 Lars Magne Ingebrigtsen + + * gnus-sum.el (t): M-down and M-up. + +2000-04-22 20:22:03 Kai Großjohann + + * gnus-sum.el: Doc fix. + +2000-04-22 10:25:56 Shenghuo ZHU + + * nnwarchive.el (nnwarchive-egroups-article): Remove < and >. + +2000-04-22 14:25:05 Lars Magne Ingebrigtsen + + * nnweb.el (nnweb-dejanews-create-mapping): Remove the context + string. + (nnweb-request-group): Don't scan twice. + (nnweb-request-scan): Don't nix out the hashtb. + + * message.el (message-get-reply-headers): Return a value. + +2000-04-22 14:12:41 David Aspinwall + + * gnus-art.el (gnus-button-url-regexp): New value to match naked + urls. + +2000-04-22 01:23:59 Lars Magne Ingebrigtsen + + * gnus-cache.el (gnus-summary-insert-cached-articles): Reverse the + order messages are inserted. + + * mml.el (mml-generate-mime-1): rfc2047-encode the heads of + message/rfc822 parts. + + * gnus-art.el (gnus-article-read-summary-keys): Check for + numerical values. + + * message.el (message-get-headers): Made into own function. + (message-reply): Use it. + (message-get-reply-headers): Renamed. + (message-widen-reply): New command. + +2000-04-21 20:52:09 Shenghuo ZHU + + * nntp.el (nntp-retrieve-data): Report the error and return nil. + +2000-04-21 19:38:43 Shenghuo ZHU + + * mm-bodies.el (mm-decode-content-transfer-encoding): Don't remove + non-base64 text at the end if not found. + +2000-03-01 Simon Josefsson + + * 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 + and `gnus-find-method-for-group' uses `gnus-group-name-to-method' + for new groups so they wouldn't work. + +2000-04-21 22:27:15 Lars Magne Ingebrigtsen + + * gnus-msg.el (gnus-configure-posting-styles): Allow nil values to + override. + +2000-04-21 21:58:20 Kai Großjohann + + * nnmail.el (nnmail-cache-insert): Does some stuff that is + probably good to do, or something. I dunno. I just write these + ChangeLog entries, and my name is Lars. + +1999-12-06 Hrvoje Niksic + + * message.el (message-caesar-region): Use translate-region. + +2000-04-21 21:20:32 Mike Fabian + + * gnus-group.el (gnus-group-catchup-current): Doc fix. + +2000-04-21 20:36:21 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-setup-buffer): Don't kill local + variables, because that makes Emacs flash. + + * gnus-group.el (gnus-group-insert-group-line): Don't call + gnus-group-add-icon unconditionally. + + * gnus-xmas.el (gnus-group-add-icon): Moved here. + + * gnus-group.el (gnus-group-glyph-directory): Don't depend on + xmas. + (gnus-group-glyph-directory): Removed. + +2000-04-21 20:26:23 Jaap-Henk Hoepman + + * gnus-msg.el (gnus-inews-insert-archive-gcc): Don't do stuff if + gnus-newsgroup-name is "". + +2000-04-21 Florian Weimer + + * mm-util.el (mm-mime-mule-charset-alist): Add support for UTF-8 + in conjunction with MULE-UCS. + +1999-12-13 Per Abrahamsen + + * rfc2047.el (rfc2047-fold-region): Don't use the same break twice. + +1999-12-14 04:14:44 Katsumi Yamaoka + + * dgnushack.el (last, mapcon, member-if, union): New compiler + macros for emulating cl functions. + +1999-12-21 Jan Vroonhof + + * message.el (message-shorten-references): Only cater to broken + INN for news. This caters for broken smtpd. + +2000-04-21 18:20:10 Lars Magne Ingebrigtsen + + * mailcap.el (mailcap-mime-info): Use the first match; not the + 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. + +2000-04-21 16:07:07 Lars Magne Ingebrigtsen + + * gnus-group.el (gnus-group-add-icon): Fixed indentation. + +2000-04-21 16:07:07 Lars Magne Ingebrigtsen + + * gnus-group.el (gnus-group-add-icon): Fixed indentation. + +2000-04-21 10:43:16 Shenghuo ZHU + + * gnus-group.el (gnus-group-prepare-flat-predicate): New function. + (gnus-group-list-cached): Use it. + +2000-04-21 16:07:07 Lars Magne Ingebrigtsen + + * gnus.el: Update all the copyright notices. + +2000-04-21 15:38:06 Vladimir Volovich + + * mm-bodies.el (mm-decode-content-transfer-encoding): Remove + non-base64 text at the end. + +2000-04-21 15:21:30 Katsumi Yamaoka + + * mm-bodies.el (mm-body-charset-encoding-alist): defcustomized. + +2000-04-21 15:15:41 Lars Magne Ingebrigtsen + + * nnheader.el: Don't autoload cancel-function-timers. + + * message.el (message-fetch-field): Fold case. + +2000-04-21 15:11:09 + + * message.el (message-forward-before-signature): New variable. + +2000-04-21 15:10:31 Alexandre Oliva + + * gnus-mlspl.el: Fix stuff. + +2000-04-21 14:41:09 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-summary-update-article-line): Don't hide + subjects when unthreaded. + +2000-04-21 14:11:39 David S. Goldberg + + * gnus-art.el (gnus-boring-article-headers): Work on long CCs as + well. + +2000-04-21 14:06:43 Rui Zhu + + * gnus-art.el (gnus-article-mode): Fix variable name. + +2000-04-21 13:54:51 Lars Magne Ingebrigtsen + + * mm-view.el: Fix autoload. + + * flow-fill.el (flow-fill): Fix provide. + + * gnus-draft.el (gnus-draft-send): Bind message-setup-hook to + nil. + +2000-04-20 22:24:04 Shenghuo ZHU + + * gnus-win.el (gnus-configure-windows): Revert to switch-to-buffer. + +2000-04-21 05:22:18 Katsumi Yamaoka + + * gnus-util.el (gnus-netrc-machine): Didn't work. + +2000-04-20 21:22:10 Shenghuo ZHU + + * gnus-draft.el (gnus-draft-setup): Restore to mml. + +2000-04-21 01:24:41 Lars Magne Ingebrigtsen + + * flow-fill.el: Renamed from fill-flowed. + + * message.el (message-forward-ignored-headers): Default to + removing CTE. + +2000-04-21 00:48:48 + + * message.el (message-mode): Don't fill headers. + +2000-04-20 23:12:43 Lars Magne Ingebrigtsen + + * message.el (message-pipe-buffer-body): Use shell + +2000-02-21 Yoshiki Hayashi + + * nnvirtual.el (nnvirtual-request-article): + Bind gnus-override-method to nil. + (nnvirtual-request-update-mark): Don't update mark when + article is not there. + +2000-04-20 16:35:41 Shenghuo ZHU + + * mm-uu.el (mm-uu-dissect): Check forwarded message. + +2000-04-20 21:17:48 Lars Magne Ingebrigtsen + + * gnus-util.el (gnus-parse-netrc): Allow "port". + (gnus-netrc-machine): Take a port param. + (gnus-netrc-machine): + + * gnus-art.el (gnus-request-article-this-buffer): Allow + re-selecting referenced articles. + + * message.el (message-cancel-news): Allow editing. + (message-cancel-message): Add newline. + +2000-04-20 21:03:54 William M. Perry + + * 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. + +2000-04-20 20:43:34 Kim-Minh Kaplan + + * gnus-art.el (gnus-mime-view-part-as-type-internal): New + function. + +2000-04-20 14:45:20 Lars Magne Ingebrigtsen + + * nnml.el (nnml-request-expire-articles): Use it. + + * nnmail.el (nnmail-expiry-target): New variable. + (nnmail-expiry-target-group): New function. + +2000-04-20 02:36:31 Emerick Rogul + + * message.el (message-forward): Add non-MIME separators. + +2000-04-20 02:25:39 Lars Magne Ingebrigtsen + + * message.el (message-generate-headers): Respect the syntax check + spec. + + * gnus-sum.el (gnus-remove-thread-1): Show thread. + (gnus-remove-thread): Don't show all threads. + +Thu Apr 20 01:39:25 2000 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v5.8.4 is released. + +2000-04-19 Dave Love + + * mailcap.el (mailcap-parse-mimetypes): Add ...mime.types. + +2000-04-18 12:28:24 Shenghuo ZHU + + * nnwarchive.el (nnwarchive-type-definition): New egroups html. + (nnwarchive-egroups-*): Ditto. + (nnwarchive-url): Unibyte buffer and single line cookie. + +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 + entities. + +2000-04-10 Daiki Ueno + + * lisp/imap.el (imap-body-lines): Check Content-Type: of the + article case insensitively. + +2000-04-10 20:35:46 Shenghuo ZHU + + * 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 + mail-source-password-cache. + +2000-04-09 18:13:47 Shenghuo ZHU + + * webmail.el: Add netscape mail and fix HotMail mail. + +2000-04-08 Simon Josefsson + + * imap.el (imap-kerberos4-open): Work with recent `imtest's. + +2000-04-02 Simon Josefsson + + * nnimap.el (nnimap-request-article): Use BODY.PEEK[] instead of + RFC822.PEEK if server support IMAP4rev1. + (nnimap-request-body): Use BODY.PEEK[TEXT] instead of + RFC822.TEXT.PEEK if server support IMAP4rev1. + (nnimap-request-head): Use BODY.PEEK[HEADER] instead of + RFC822.HEADER if server support IMAP4rev1. + (nnimap-request-article-part): Support bodydetail in response + data. + +2000-03-11 Simon Josefsson + + * fill-flowed.el: New file. + + * mm-decode.el (mm-dissect-singlepart): Create a MIME handle for + text/plain parts with `format' parameters. + + * mm-view.el (autoload): Autoload fill-flowed. + (mm-inline-text): For "plain" parts with a format=flowed + parameter, call `fill-flowed'. + +2000-03-21 10:32:44 Lars Magne Ingebrigtsen + + * nnslashdot.el (nnslashdot-request-list): Fudge new-style + slashdot ids. + +2000-03-20 00:12:42 Lars Magne Ingebrigtsen + + * nnslashdot.el (nnslashdot-request-list): Use the new slashdot + format. + +2000-03-16 Simon Josefsson + + * imap.el: GSSAPI support, support kerberos 4 with Cyrus v1.6.x + `imtest' too. + (imap-kerberos4-program): Renamed from `imap-imtest-program'. + (imap-gssapi-program): New variable. + (imap-streams): Add gssapi. + (imap-stream-alist): Ditto. + (imap-authenticators): Ditto. + (imap-authenticator-alist): Ditto. + (imap-kerberos4-stream-p): Rename from `imap-kerberos4s-p'. + (imap-kerberos4-open): Loop over imtest programs, support Cyrus + 1.6.x `imtest' syntax. + (imap-gssapi-stream-p): New function. + (imap-gssapi-open): Ditto. + (imap-gssapi-auth-p): Ditto. + (imap-gssapi-auth): Ditto. + (imap-kerberos4-auth-p): Renamed from `imap-kerberos4a-p'. + (imap-send-command): Use buffer-local `imap-client-eol' value. + + * nnimap.el (nnimap-retrieve-headers-progress): Fold continuation + lines and turn TAB into SPC before parsing. + +2000-03-15 Simon Josefsson + + * nnheader.el (nnheader-group-pathname): Make sure to return a + directory. + * nnmail.el (nnmail-group-pathname): Ditto. + +2000-02-08 Per Abrahamsen + + * nnmail.el (nnmail-fix-eudora-headers): Fix `In-Reply-To' too, it + might split in the middle of a message-id. + +2000-03-13 13:51:38 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-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. + + * 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. + + * gnus-sum.el (gnus-summary-move-article): Only delete article + when moving junk. + (gnus-deaden-summary): Bury the buffer. + + * nnmail.el (nnmail-group-pathname): Ditto. + + * nnheader.el (nnheader-group-pathname): Use expand-file-name. + +2000-03-13 20:23:06 Christoph Rohland + + * rfc2047.el (rfc2047-encode-message-header): Encode no matter + whether Mule. + +2000-03-10 14:57:58 Lars Magne Ingebrigtsen + + * message.el (message-send-mail): Protect against unloaded Gnus. + + * gnus-topic.el (gnus-topic-update-topic-line): Don't update the + 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. + +2000-02-13 13:53:08 Lars Magne Ingebrigtsen + + * mm-decode.el (mm-dissect-buffer): Ditto. + + * gnus-art.el (article-decode-charset): Strip CTE. + + * ietf-drums.el (ietf-drums-strip): New function. + + * gnus-sum.el (gnus-summary-move-article): Don't use the prefix + when prompting in read-only groups. + +2000-02-23 Simon Josefsson + + * imap.el (imap-send-command): Change EOL-chars when + `imap-client-eol' differs from default, not only for kerberos4. + (imap-mailbox-status): Get encoded mailbox's status. + +2000-02-19 Simon Josefsson + + * mail-source.el (mail-source-fetch-imap): Copy `imap-password' + into `mail-source-password-cache'. + +2000-02-17 Florian Weimer + + * mm-util.el (mm-mime-charset): Check for presence of + `coding-system-get' and `get-charset-property' (recent XEmacs has + the former, but not the latter). + +2000-01-28 Dave Love + + * message.el (message-check-news-header-syntax): Fix typo + `newsgroyps'. + (message-talkative-question): Put temp buffer in fundamental-mode. + (message-recover): Use fundamental-mode in the right buffer. + + * nnmail.el (nnmail-split-history): Use fundamental-mode in the + right buffer. + +2000-01-26 12:01:18 Shenghuo ZHU + + * 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 + + * nnimap.el (nnimap-split-predicate): New variable. + (nnimap-split-articles): Use it. + +2000-01-20 Simon Josefsson + + * utf7.el: Change email address. + +2000-01-18 22:03:51 Lars Magne Ingebrigtsen + + * gnus-group.el (gnus-group-catchup): Purge split history. + +2000-01-14 02:43:55 Shenghuo ZHU + + * nnmail.el (nnmail-generate-active): Support extended group name. + (nnmail-get-active): Ditto. + +2000-01-13 15:16:10 Shenghuo ZHU + + * gnus-agent.el (gnus-agent-write-active): Since no prefix in + group names, don't remove anything. + +2000-01-13 15:10:53 Shenghuo ZHU + + * webmail.el (webmail-my-deja-open): My-deja changes. + +2000-01-13 Simon Josefsson + + * nnimap.el (nnimap-retrieve-headers-progress): Create xref field. + +2000-01-10 23:35:33 Shenghuo ZHU + + * gnus-agent.el (gnus-agent-fetch-headers): Translate full path. + +2000-01-09 22:52:35 Shenghuo ZHU + + * gnus.el (gnus-other-frame): Fix typo. + +1999-06-25 Andreas Jaeger + + * gnus-cus.el (gnus-group-customize): Fix typo. + +2000-01-08 08:36:13 Lars Magne Ingebrigtsen + + * nnweb.el (nnweb-insert): Simplified. + +2000-01-06 18:32:53 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-mode-map): "e" is + gnus-summary-edit-article. + +2000-01-06 18:25:37 Jari Aalto + + * mailcap.el (mailcap-mime-extensions): Add .diff. + +2000-01-06 00:06:40 Kim-Minh Kaplan + + * mm-decode.el (mm-mailcap-command): handle "%%" and the case where + there is no "%s" in the method. + +2000-01-08 21:01:04 Kim-Minh Kaplan + + * gnus-sum.el (gnus-summary-select-article): Return 'old. + +2000-01-06 13:41:11 Lars Magne Ingebrigtsen + + * 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. + + * time-date.el (date-to-time): Don't use timezone. + +2000-01-06 Dave Love + + * time-date.el: Add keywords. + (date-to-time): Add autoload cookie. Canonicalize with + timezone-make-date-arpa-standard. + (time-to-seconds): Avoid caddr. + (safe-date-to-time): Add autoload cookie. + + * base64.el: Require cl when compiling. + +2000-01-05 BrYan P. Johnson + + * gnus-group.el (gnus-group-line-format-alist): Added %E for + eyecandy. + (gnus-group-insert-group-line): Now groks %E and inserts icon in + group line using gnus-group-add-icon. + (gnus-group-icons): Added customize group. + (gnus-group-icon-list): Added variable. + (gnus-group-glyph-directory): Added variable. + (gnus-group-icon-cache): Added variable. + (gnus-group-running-xemacs): Added variable. + (gnus-group-add-icon): Added function. Add an icon to the current + line according to gnus-group-icon-list. + (gnus-group-icon-create-glyph): Added function. + +2000-01-05 17:31:52 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-summary-select-article): Return whether we + selected something new. + (gnus-summary-search-article): Start searching at the window + point. + + * gnus-group.el (gnus-fetch-group): Complete over + gnus-active-hashtb. + Wed Jan 5 17:06:41 2000 Lars Magne Ingebrigtsen * gnus.el: Pterodactyl Gnus v5.8.3 is released. @@ -558,6 +1179,11 @@ Wed Jan 5 17:06:41 2000 Lars Magne Ingebrigtsen (mm-7bit-chars): New variable. (mm-body-7-or-8): Use it in both cases. +1999-12-04 Michael Welsh Duggan + + * gnus-start.el (gnus-site-init-file): Don't use cl macros in + defcustom definitions. + 1999-12-04 Simon Josefsson * mm-decode.el (mm-display-part): Let mm-display-external return diff --git a/lisp/base64.el b/lisp/base64.el index 2635349..36e1374 100644 --- a/lisp/base64.el +++ b/lisp/base64.el @@ -25,6 +25,8 @@ ;;; Boston, MA 02111-1307, USA. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(eval-when-compile (require 'cl)) + ;; For non-MULE (if (not (fboundp 'char-int)) (fset 'char-int 'identity)) diff --git a/lisp/dgnushack.el b/lisp/dgnushack.el index 4f9e306..94fcfba 100644 --- a/lisp/dgnushack.el +++ b/lisp/dgnushack.el @@ -1,5 +1,6 @@ ;;; dgnushack.el --- a hack to set the load path for byte-compiling -;; Copyright (C) 1994,95,96,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Version: 4.19 @@ -30,6 +31,83 @@ (require 'cl) +(push "/usr/share/emacs/site-lisp" load-path) + +(unless (featurep 'xemacs) + (define-compiler-macro last (&whole form x &optional n) + (if (and (fboundp 'last) + (subrp (symbol-function 'last))) + form + (if n + `(let* ((x ,x) + (n ,n) + (m 0) + (p x)) + (while (consp p) + (incf m) + (pop p)) + (if (<= n 0) + p + (if (< n m) + (nthcdr (- m n) x) + x))) + `(let ((x ,x)) + (while (consp (cdr x)) + (pop x)) + x)))) + + (define-compiler-macro mapcon (&whole form fn seq &rest rest) + (if (and (fboundp 'mapcon) + (subrp (symbol-function 'mapcon))) + form + (if rest + `(let (res + (args (list ,seq ,@rest)) + p) + (while (not (memq nil args)) + (push (apply ,fn args) res) + (setq p args) + (while p + (setcar p (cdr (pop p))) + )) + (apply (function nconc) (nreverse res))) + `(let (res + (arg ,seq)) + (while arg + (push (funcall ,fn arg) res) + (setq arg (cdr arg))) + (apply (function nconc) (nreverse res)))))) + + (define-compiler-macro member-if (&whole form pred list) + (if (and (fboundp 'member-if) + (subrp (symbol-function 'member-if))) + form + `(let ((fn ,pred) + (seq ,list)) + (while (and seq + (not (funcall fn (car seq)))) + (pop seq)) + seq))) + + (define-compiler-macro union (&whole form list1 list2) + (if (and (fboundp 'union) + (subrp (symbol-function 'union))) + form + `(let ((a ,list1) + (b ,list2)) + (cond ((null a) b) + ((null b) a) + ((equal a b) a) + (t + (or (>= (length a) (length b)) + (setq a (prog1 b (setq b a)))) + (while b + (or (memq (car b) a) + (push (car b) a)) + (pop b)) + a))))) + ) + ;; If we are building w3 in a different directory than the source ;; directory, we must read *.el from source directory and write *.elc ;; into the building directory. For that, we define this function diff --git a/lisp/fill-flowed.el b/lisp/fill-flowed.el new file mode 100644 index 0000000..b0883de --- /dev/null +++ b/lisp/fill-flowed.el @@ -0,0 +1,94 @@ +;;; fill-flowed.el --- interprete RFC2646 "flowed" text +;; Copyright (C) 2000 Free Software Foundation, Inc. + +;; Author: Simon Josefsson +;; Keywords: mail + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +;;; Commentary: + +;; This implement decoding of RFC2646 formatted text, including the +;; quoted-depth wins rules. + +;; Theory of operation: search for lines ending with SPC, save quote +;; length of line, remove SPC and concatenate line with the following +;; line if quote length of following line matches current line. + +;; When no further concatenations are possible, we've found a +;; paragraph and we let `fill-region' fill the long line into several +;; lines with the quote prefix as `fill-prefix'. + +;; Todo: encoding + +;; History: + +;; 2000-02-17 posted on ding mailing list +;; 2000-02-19 use `point-at-{b,e}ol' in XEmacs +;; 2000-03-11 no compile warnings for point-at-bol stuff +;; 2000-03-26 commited to gnus cvs + +;;; Code: + +(eval-and-compile + (fset 'fill-flowed-point-at-bol + (if (fboundp 'point-at-bol) + 'point-at-bol + 'line-beginning-position)) + + (fset 'fill-flowed-point-at-eol + (if (fboundp 'point-at-eol) + 'point-at-eol + 'line-end-position))) + +(defun fill-flowed (&optional buffer) + (save-excursion + (set-buffer (or (current-buffer) buffer)) + (goto-char (point-min)) + (while (re-search-forward " $" nil t) + (when (save-excursion + (beginning-of-line) + (looking-at "^\\(>*\\)\\( ?\\)")) + (let ((quote (match-string 1))) + (if (string= quote "") + (setq quote nil)) + (when (and quote (string= (match-string 2) "")) + (save-excursion + ;; insert SP after quote for pleasant reading of quoted lines + (beginning-of-line) + (when (> (skip-chars-forward ">") 0) + (insert " ")))) + (while (and (save-excursion + (backward-char 3) + (looking-at "[^-][^-] ")) + (save-excursion + (unless (eobp) + (forward-char 1) + (if quote + (looking-at (format "^\\(%s\\)\\([^>]\\)" quote)) + (looking-at "^ ?"))))) + (save-excursion + (replace-match (if (string= (match-string 2) " ") + "" "\\2"))) + (backward-delete-char -1) + (end-of-line)) + (let ((fill-prefix (when quote (concat quote " ")))) + (fill-region (fill-flowed-point-at-bol) + (fill-flowed-point-at-eol) + 'left 'nosqueeze))))))) + +(provide 'fill-flowed) + +;;; fill-flowed.el ends here diff --git a/lisp/flow-fill.el b/lisp/flow-fill.el new file mode 100644 index 0000000..9aae7c4 --- /dev/null +++ b/lisp/flow-fill.el @@ -0,0 +1,94 @@ +;;; flow-fill.el --- interprete RFC2646 "flowed" text +;; Copyright (C) 2000 Free Software Foundation, Inc. + +;; Author: Simon Josefsson +;; Keywords: mail + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +;;; Commentary: + +;; This implement decoding of RFC2646 formatted text, including the +;; quoted-depth wins rules. + +;; Theory of operation: search for lines ending with SPC, save quote +;; length of line, remove SPC and concatenate line with the following +;; line if quote length of following line matches current line. + +;; When no further concatenations are possible, we've found a +;; paragraph and we let `fill-region' fill the long line into several +;; lines with the quote prefix as `fill-prefix'. + +;; Todo: encoding + +;; History: + +;; 2000-02-17 posted on ding mailing list +;; 2000-02-19 use `point-at-{b,e}ol' in XEmacs +;; 2000-03-11 no compile warnings for point-at-bol stuff +;; 2000-03-26 commited to gnus cvs + +;;; Code: + +(eval-and-compile + (fset 'fill-flowed-point-at-bol + (if (fboundp 'point-at-bol) + 'point-at-bol + 'line-beginning-position)) + + (fset 'fill-flowed-point-at-eol + (if (fboundp 'point-at-eol) + 'point-at-eol + 'line-end-position))) + +(defun fill-flowed (&optional buffer) + (save-excursion + (set-buffer (or (current-buffer) buffer)) + (goto-char (point-min)) + (while (re-search-forward " $" nil t) + (when (save-excursion + (beginning-of-line) + (looking-at "^\\(>*\\)\\( ?\\)")) + (let ((quote (match-string 1))) + (if (string= quote "") + (setq quote nil)) + (when (and quote (string= (match-string 2) "")) + (save-excursion + ;; insert SP after quote for pleasant reading of quoted lines + (beginning-of-line) + (when (> (skip-chars-forward ">") 0) + (insert " ")))) + (while (and (save-excursion + (backward-char 3) + (looking-at "[^-][^-] ")) + (save-excursion + (unless (eobp) + (forward-char 1) + (if quote + (looking-at (format "^\\(%s\\)\\([^>]\\)" quote)) + (looking-at "^ ?"))))) + (save-excursion + (replace-match (if (string= (match-string 2) " ") + "" "\\2"))) + (backward-delete-char -1) + (end-of-line)) + (let ((fill-prefix (when quote (concat quote " ")))) + (fill-region (fill-flowed-point-at-bol) + (fill-flowed-point-at-eol) + 'left 'nosqueeze))))))) + +(provide 'flow-fill) + +;;; flow-fill.el ends here diff --git a/lisp/format-spec.el b/lisp/format-spec.el index 8986dc0..6cd39ed 100644 --- a/lisp/format-spec.el +++ b/lisp/format-spec.el @@ -1,5 +1,5 @@ ;;; format-spec.el --- functions for formatting arbitrary formatting strings -;; Copyright (C) 1999 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: tools diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index 7b867e5..fae871e 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -1,5 +1,5 @@ ;;; gnus-agent.el --- unplugged support for Gnus -;; Copyright (C) 1997,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1997, 1998, 1999, 2000 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; This file is part of GNU Emacs. @@ -611,7 +611,9 @@ the actual number of articles toggled is returned." new)) (gnus-make-directory (file-name-directory file)) (let ((coding-system-for-write gnus-agent-file-coding-system)) - (gnus-write-active-file file orig)))) + ;; The hashtable contains real names of groups, no more prefix + ;; removing, so set `full' to `t'. + (gnus-write-active-file file orig t)))) (defun gnus-agent-save-groups (method) (gnus-agent-save-active-1 method 'gnus-groups-to-gnus-format)) @@ -619,7 +621,8 @@ 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) - (file (gnus-agent-lib-file "active"))) + (file (gnus-agent-lib-file "active")) + oactive) (gnus-make-directory (file-name-directory file)) (with-temp-file file (when (file-exists-p file) @@ -627,9 +630,17 @@ the actual number of articles toggled is returned." (goto-char (point-min)) (when (re-search-forward (concat "^" (regexp-quote group) " ") nil t) + (save-excursion + (save-restriction + (narrow-to-region (match-beginning 0) + (progn + (forward-line 1) + (point))) + (setq oactive (car (nnmail-parse-active))))) (gnus-delete-line)) - (insert (format "%S %d %d y\n" (intern group) (cdr active) - (car active))) + (insert (format "%S %d %d y\n" (intern group) + (cdr active) + (or (car oactive) (car active)))) (goto-char (point-max)) (while (search-backward "\\." nil t) (delete-char 1)))))) @@ -851,12 +862,12 @@ the actual number of articles toggled is returned." (let ((articles (gnus-list-of-unread-articles group)) (gnus-decode-encoded-word-function 'identity) (file (gnus-agent-article-name ".overview" group))) - ;; add article with marks to list of article headers we want to fetch + ;; Add article with marks to list of article headers we want to fetch. (dolist (arts (gnus-info-marks (gnus-get-info group))) (setq articles (union (gnus-uncompress-sequence (cdr arts)) articles))) (setq articles (sort articles '<)) - ;; remove known articles + ;; Remove known articles. (when (gnus-agent-load-alist group) (setq articles (gnus-sorted-intersection articles @@ -865,7 +876,7 @@ the actual number of articles toggled is returned." (cdr (gnus-active group))))))) ;; Fetch them. (gnus-make-directory (nnheader-translate-file-chars - (file-name-directory file))) + (file-name-directory file) t)) (when articles (gnus-message 7 "Fetching headers for %s..." group) (save-excursion @@ -1297,8 +1308,8 @@ The following commands are available: (let ((info (assq category gnus-category-alist)) (buffer-read-only nil)) (gnus-delete-line) - (gnus-category-write) - (setq gnus-category-alist (delq info gnus-category-alist)))) + (setq gnus-category-alist (delq info gnus-category-alist)) + (gnus-category-write))) (defun gnus-category-copy (category to) "Copy the current category." diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 253e22b..57112fe 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -1,5 +1,5 @@ ;;; gnus-art.el --- article mode commands for Gnus -;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2000 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -169,8 +169,8 @@ Possible values in this list are `empty', `newsgroups', `followup-to', (const :tag "Followup-to identical to newsgroups." followup-to) (const :tag "Reply-to identical to from." reply-to) (const :tag "Date less than four days old." date) - (const :tag "Very long To header." long-to) - (const :tag "Multiple To headers." many-to)) + (const :tag "Very long To and/or Cc header." long-to) + (const :tag "Multiple To and/or Cc headers." many-to)) :group 'gnus-article-hiding) (defcustom gnus-signature-separator '("^-- $" "^-- *$") @@ -1167,11 +1167,15 @@ always hide." 4)) (gnus-article-hide-header "date")))) ((eq elem 'long-to) - (let ((to (message-fetch-field "to"))) + (let ((to (message-fetch-field "to")) + (cc (message-fetch-field "cc"))) (when (> (length to) 1024) - (gnus-article-hide-header "to")))) + (gnus-article-hide-header "to")) + (when (> (length cc) 1024) + (gnus-article-hide-header "cc")))) ((eq elem 'many-to) - (let ((to-count 0)) + (let ((to-count 0) + (cc-count 0)) (goto-char (point-min)) (while (re-search-forward "^to:" nil t) (setq to-count (1+ to-count))) @@ -1183,7 +1187,19 @@ always hide." (forward-line -1) (narrow-to-region (point) (point-max)) (gnus-article-hide-header "to")) - (setq to-count (1- to-count))))))))))))) + (setq to-count (1- to-count)))) + (goto-char (point-min)) + (while (re-search-forward "^cc:" nil t) + (setq cc-count (1+ cc-count))) + (when (> cc-count 1) + (while (> cc-count 0) + (goto-char (point-min)) + (save-restriction + (re-search-forward "^cc:" nil nil cc-count) + (forward-line -1) + (narrow-to-region (point) (point-max)) + (gnus-article-hide-header "cc")) + (setq cc-count (1- cc-count))))))))))))) (defun gnus-article-hide-header (header) (save-excursion @@ -1439,16 +1455,16 @@ If PROMPT (the prefix), prompt for a coding system to use." (ctl (mail-content-type-get ctl 'charset)))) (goto-char (point-max))) - (forward-line 1) - (save-restriction - (narrow-to-region (point) (point-max)) - (when (and (or (not ctl) - (and (eq (mime-content-type-primary-type ctl) 'text) - (eq (mime-content-type-subtype ctl) 'plain)))) - (mm-decode-body - charset (and cte (intern (downcase - (gnus-strip-whitespace cte)))) - (car ctl))))))) + (forward-line 1) + (save-restriction + (narrow-to-region (point) (point-max)) + (when (and (or (not ctl) + (and (eq (mime-content-type-primary-type ctl) 'text) + (eq (mime-content-type-subtype ctl) 'plain)))) + (mm-decode-body + charset (and cte (intern (downcase + (gnus-strip-whitespace cte)))) + (car ctl))))))) (defun article-decode-encoded-words () "Remove encoded-word encoding from headers." @@ -1476,11 +1492,7 @@ or not." (when (or force (and type (string-match "quoted-printable" (downcase type)))) (article-goto-body) - (save-restriction - (narrow-to-region (point) (point-max)) - (quoted-printable-decode-region (point-min) (point-max)) - (when charset - (mm-decode-body charset))))))) + (quoted-printable-decode-region (point) (point-max) charset))))) (eval-when-compile (require 'rfc1843)) @@ -2472,7 +2484,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is "s" gnus-article-show-summary "\C-c\C-m" gnus-article-mail "?" gnus-article-describe-briefly - "e" gnus-summary-article-edit + "e" gnus-summary-edit-article "<" beginning-of-buffer ">" end-of-buffer "\C-c\C-i" gnus-info-find-node @@ -2550,7 +2562,7 @@ commands: (make-local-variable 'gnus-article-mime-handles) (make-local-variable 'gnus-article-decoded-p) (make-local-variable 'gnus-article-mime-handle-alist) - (make-local-variable 'gnus-article-washed-types) + (make-local-variable 'gnus-article-wash-types) (gnus-set-default-directory) (buffer-disable-undo) (setq buffer-read-only t) @@ -2586,9 +2598,8 @@ commands: (if (get-buffer name) (save-excursion (set-buffer name) - (if gnus-article-mime-handles - (mm-destroy-parts gnus-article-mime-handles)) - (kill-all-local-variables) + (when gnus-article-mime-handles + (mm-destroy-parts gnus-article-mime-handles)) (buffer-disable-undo) (setq buffer-read-only t) (unless (eq major-mode 'gnus-article-mode) @@ -2655,8 +2666,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (message "Message marked for downloading")) (gnus-summary-mark-article article gnus-canceled-mark) (unless (memq article gnus-newsgroup-sparse) - (gnus-error 1 - "No such article (may have expired or been canceled)"))))) + (gnus-error 1 "No such article (may have expired or been canceled)"))))) (if (or (eq result 'pseudo) (eq result 'nneething)) (progn @@ -2848,14 +2858,34 @@ If ALL-HEADERS is non-nil, no headers are hidden." (let ((data (get-text-property (point) 'gnus-data))) (mm-interactively-view-part data))) -(defun gnus-mime-view-part-as-type () +(defun gnus-mime-view-part-as-type-internal () + (gnus-article-check-buffer) + (let* ((name (mail-content-type-get + (mm-handle-type (get-text-property (point) 'gnus-data)) + 'name)) + (def-type (and name (mm-default-file-encoding name)))) + (and def-type (cons def-type 0)))) + +(defun gnus-mime-view-part-as-type (mime-type) "Choose a MIME media type, and view the part as such." (interactive - (list (completing-read "View as MIME type: " - (mapcar 'list (mailcap-mime-types))))) + (list (completing-read + "View as MIME type: " + (mapcar (lambda (i) (list i i)) (mailcap-mime-types)) + nil nil + (gnus-mime-view-part-as-type-internal)))) (gnus-article-check-buffer) (let ((handle (get-text-property (point) 'gnus-data))) - (gnus-mm-display-part handle))) + (gnus-mm-display-part + (mm-make-handle (mm-handle-parent handle) + (mm-handle-body handle) + (cons mime-type (cdr (mm-handle-type handle))) + (mm-handle-encoding handle) + (mm-handle-undisplayer handle) + (mm-handle-disposition handle) + (mm-handle-description handle) + (mm-handle-cache handle) + (mm-handle-id handle))))) (defun gnus-mime-copy-part (&optional handle) "Put the the MIME part under point into a new buffer." @@ -3126,7 +3156,7 @@ In no internal viewer is available, use an external viewer." (when (and (not ihandles) (not gnus-displaying-mime)) ;; Top-level call; we clean up. - (when gnus-article-mime-handles + (unless (eq parent gnus-article-mime-handles) (mm-destroy-parts gnus-article-mime-handles) (setq gnus-article-mime-handle-alist nil));; A trick. (setq gnus-article-mime-handles handles) @@ -3646,7 +3676,8 @@ Argument LINES specifies lines to be scrolled down." ;; We disable the pick minor mode commands. (let (gnus-pick-mode) (setq func (lookup-key (current-local-map) keys)))) - (if (not func) + (if (or (not func) + (numberp func)) (ding) (unless (member keys nosave-in-article) (set-buffer gnus-article-current-summary)) @@ -3804,7 +3835,8 @@ If given a prefix, show the hidden text instead." (gnus-cache-request-article article group)) 'article) ;; Get the article and put into the article buffer. - ((or (stringp article) (numberp article)) + ((or (stringp article) + (numberp article)) (let ((gnus-override-method gnus-override-method) (methods (and (stringp article) gnus-refer-article-method)) @@ -3812,11 +3844,14 @@ If given a prefix, show the hidden text instead." (buffer-read-only nil)) (setq methods (if (listp methods) - (delq 'current methods) + methods (list methods))) - (if (and (null gnus-override-method) methods) - (setq gnus-override-method (pop methods))) + (when (and (null gnus-override-method) + methods) + (setq gnus-override-method (pop methods))) (while (not result) + (when (eq gnus-override-method 'current) + (setq gnus-override-method gnus-current-select-method)) (erase-buffer) (gnus-kill-all-overlays) (let ((gnus-newsgroup-name group)) @@ -4029,7 +4064,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\\)" +(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_/]+\\)+" "Regular expression that matches URLs." :group 'gnus-article-buttons :type 'regexp) @@ -4604,7 +4639,10 @@ For example: val elem) (gnus-run-hooks 'gnus-part-display-hook) (while (setq elem (pop alist)) - (setq val (symbol-value (car elem))) + (setq val + (save-excursion + (set-buffer gnus-summary-buffer) + (symbol-value (car elem)))) (when (and (or (consp val) treated-type) (gnus-treat-predicate val) diff --git a/lisp/gnus-async.el b/lisp/gnus-async.el index 79063ed..1cd7d7b 100644 --- a/lisp/gnus-async.el +++ b/lisp/gnus-async.el @@ -1,5 +1,5 @@ ;;; gnus-async.el --- asynchronous support for Gnus -;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2000 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news diff --git a/lisp/gnus-bcklg.el b/lisp/gnus-bcklg.el index 701cf38..5a9cbf6 100644 --- a/lisp/gnus-bcklg.el +++ b/lisp/gnus-bcklg.el @@ -1,5 +1,5 @@ ;;; gnus-bcklg.el --- backlog functions for Gnus -;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2000 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news diff --git a/lisp/gnus-cache.el b/lisp/gnus-cache.el index b787045..acda99e 100644 --- a/lisp/gnus-cache.el +++ b/lisp/gnus-cache.el @@ -1,5 +1,6 @@ ;;; gnus-cache.el --- cache interface for Gnus -;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -365,7 +366,7 @@ Returns the list of articles removed." (defun gnus-summary-insert-cached-articles () "Insert all the articles cached for this group into the current buffer." (interactive) - (let ((cached (sort (copy-sequence gnus-newsgroup-cached) '<)) + (let ((cached (sort (copy-sequence gnus-newsgroup-cached) '>)) (gnus-verbose (max 6 gnus-verbose))) (unless cached (gnus-message 3 "No cached articles for this group")) diff --git a/lisp/gnus-cite.el b/lisp/gnus-cite.el index 4044e36..a1e1ebb 100644 --- a/lisp/gnus-cite.el +++ b/lisp/gnus-cite.el @@ -1,5 +1,6 @@ ;;; gnus-cite.el --- parse citations in articles for Gnus -;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Per Abhiddenware; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by diff --git a/lisp/gnus-cus.el b/lisp/gnus-cus.el index 92baaca..1bc3c6c 100644 --- a/lisp/gnus-cus.el +++ b/lisp/gnus-cus.el @@ -323,7 +323,7 @@ DOC is a documentation string for the parameter.") :tag "Parameters" :format "%t:\n%h%v" :doc "\ -These special paramerters are recognized by Gnus. +These special parameters are recognized by Gnus. Check the [ ] for the parameters you want to apply to this group or to the groups in this topic, then edit the value to suit your taste." ,@types) diff --git a/lisp/gnus-draft.el b/lisp/gnus-draft.el index 64b5fe3..ebe9002 100644 --- a/lisp/gnus-draft.el +++ b/lisp/gnus-draft.el @@ -1,5 +1,6 @@ ;;; gnus-draft.el --- draft message support for Gnus -;; Copyright (C) 1997,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -125,6 +126,7 @@ 'dont-check-for-anything-just-trust-me)) (message-send-hook (and group (not (equal group "nndraft:queue")) message-send-hook)) + (message-setup-hook nil) type method) ;; We read the meta-information that says how and where ;; this message is to be sent. diff --git a/lisp/gnus-dup.el b/lisp/gnus-dup.el index 691381f..96609cb 100644 --- a/lisp/gnus-dup.el +++ b/lisp/gnus-dup.el @@ -1,5 +1,6 @@ ;;; gnus-dup.el --- suppression of duplicate articles in Gnus -;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news diff --git a/lisp/gnus-eform.el b/lisp/gnus-eform.el index 09f2bb5..9fe7242 100644 --- a/lisp/gnus-eform.el +++ b/lisp/gnus-eform.el @@ -1,5 +1,6 @@ ;;; gnus-eform.el --- a mode for editing forms for Gnus -;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news diff --git a/lisp/gnus-ems.el b/lisp/gnus-ems.el index 8b9e712..9866398 100644 --- a/lisp/gnus-ems.el +++ b/lisp/gnus-ems.el @@ -1,5 +1,6 @@ ;;; gnus-ems.el --- functions for making Gnus work under different Emacsen -;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index f465afc..64d1881 100644 --- a/lisp/gnus-group.el +++ b/lisp/gnus-group.el @@ -1,5 +1,6 @@ ;;; gnus-group.el --- group mode commands for Gnus -;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -161,6 +162,7 @@ with some simple extensions. %n Select from where (string) %z A string that look like `<%s:%n>' if a foreign select method is used %d The date the group was last entered. +%E Icon as defined by `gnus-group-icon-list'. %u User defined specifier. The next character in the format string should be a letter. Gnus will call the function gnus-user-format-function-X, where X is the letter following %u. The function will be passed the @@ -360,6 +362,38 @@ ticked: The number of ticked articles." :group 'gnus-group-visual :type 'character) +(defgroup gnus-group-icons nil + "Add Icons to your group buffer. " + :group 'gnus-group-visual) + +(defcustom gnus-group-icon-list + nil + "*Controls the insertion of icons into group buffer lines. + +Below is a list of `Form'/`File' pairs. When deciding how a +particular group line should be displayed, each form is evaluated. +The icon from the file field after the first true form is used. You +can change how those group lines are displayed by editing the file +field. The File will either be found in the +`gnus-group-glyph-directory' or by designating absolute path to the +file. + +It is also possible to change and add form fields, but currently that +requires an understanding of Lisp expressions. Hopefully this will +change in a future release. For now, you can use the following +variables in the Lisp expression: + +group: The name of the group. +unread: The number of unread articles in the group. +method: The select method used. +mailp: Whether it's a mail group or not. +newsp: Whether it's a news group or not +level: The level of the group. +score: The score of the group. +ticked: The number of ticked articles." + :group 'gnus-group-icons + :type '(repeat (cons (sexp :tag "Form") file))) + ;;; Internal variables (defvar gnus-group-sort-alist-function 'gnus-group-sort-flat @@ -404,6 +438,7 @@ ticked: The number of ticked articles." (?s gnus-tmp-news-server ?s) (?n gnus-tmp-news-method ?s) (?P gnus-group-indentation ?s) + (?E gnus-tmp-group-icon ?s) (?l gnus-tmp-grouplens ?s) (?z gnus-tmp-news-method-string ?s) (?m (gnus-group-new-mail gnus-tmp-group) ?c) @@ -426,6 +461,10 @@ ticked: The number of ticked articles." (defvar gnus-group-list-mode nil) + +(defvar gnus-group-icon-cache nil) +(defvar gnus-group-running-xemacs (string-match "XEmacs" emacs-version)) + ;;; ;;; Gnus group mode ;;; @@ -565,7 +604,8 @@ ticked: The number of ticked articles." "d" gnus-group-description-apropos "m" gnus-group-list-matching "M" gnus-group-list-all-matching - "l" gnus-group-list-level) + "l" gnus-group-list-level + "c" gnus-group-list-cached) (gnus-define-keys (gnus-group-score-map "W" gnus-group-mode-map) "f" gnus-score-flush-cache) @@ -641,7 +681,8 @@ ticked: The number of ticked articles." ["Group and description apropos..." gnus-group-description-apropos t] ["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 active file" gnus-group-list-active t] + ["List groups with cached" gnus-group-list-cached t]) ("Sort" ["Default sort" gnus-group-sort-groups t] ["Sort by method" gnus-group-sort-groups-by-method t] @@ -1065,6 +1106,7 @@ If REGEXP, only list groups matching REGEXP." ?m ? )) (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) "")) @@ -1100,8 +1142,8 @@ If REGEXP, only list groups matching REGEXP." gnus-marked ,gnus-tmp-marked-mark gnus-indentation ,gnus-group-indentation gnus-level ,gnus-tmp-level)) + (forward-line -1) (when (inline (gnus-visual-p 'group-highlight 'highlight)) - (forward-line -1) (gnus-run-hooks 'gnus-group-update-hook) (forward-line)) ;; Allow XEmacs to remove front-sticky text properties. @@ -1570,7 +1612,7 @@ be permanent." (defun gnus-fetch-group (group) "Start Gnus if necessary and enter GROUP. Returns whether the fetching was successful or not." - (interactive "sGroup name: ") + (interactive (list (completing-read "Group name: " gnus-active-hashtb))) (unless (get-buffer gnus-group-buffer) (gnus-no-server)) (gnus-group-read-group nil nil group)) @@ -2546,7 +2588,7 @@ sort in reverse order." ;; Group catching up. (defun gnus-group-catchup-current (&optional n all) - "Mark all articles not marked as unread in current newsgroup as read. + "Mark all unread articles in the current newsgroup as read. If prefix argument N is numeric, the next N newsgroups will be caught up. If ALL is non-nil, marked articles will also be marked as read. Cross references (Xref: header) of articles are ignored. @@ -2599,6 +2641,8 @@ The return value is the number of articles that were marked as read, or nil if no action could be taken." (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) (num (car entry))) + ;; Remove entries for this group. + (nnmail-purge-split-history (gnus-group-real-name group)) ;; Do the updating only if the newsgroup isn't killed. (if (not (numberp (car entry))) (gnus-message 1 "Can't catch up %s; non-active group" group) @@ -2642,7 +2686,10 @@ or nil if no action could be taken." (expirable (if (gnus-group-total-expirable-p group) (cons nil (gnus-list-of-read-articles group)) (assq 'expire (gnus-info-marks info)))) - (expiry-wait (gnus-group-find-parameter group 'expiry-wait))) + (expiry-wait (gnus-group-find-parameter group 'expiry-wait)) + (nnmail-expiry-target + (or (gnus-group-find-parameter group 'expiry-target) + nnmail-expiry-target))) (when expirable (setcdr expirable @@ -3521,6 +3568,54 @@ or `gnus-group-catchup-group-hook'." "" (gnus-time-iso8601 time)))) +(defun gnus-group-prepare-flat-predicate (level predicate &optional lowest) + "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." + (set-buffer gnus-group-buffer) + (let ((buffer-read-only nil) + (newsrc (cdr gnus-newsrc-alist)) + (lowest (or lowest 1)) + info clevel unread group params) + (erase-buffer) + ;; List living groups. + (while newsrc + (setq info (car newsrc) + group (gnus-info-group info) + params (gnus-info-params info) + newsrc (cdr newsrc) + unread (car (gnus-gethash group gnus-newsrc-hashtb))) + (and unread ; This group might be unchecked + (funcall predicate info) + (<= (setq clevel (gnus-info-level info)) level) + (>= clevel lowest) + (gnus-group-insert-group-line + group (gnus-info-level info) + (gnus-info-marks info) unread (gnus-info-method info)))) + + (gnus-group-set-mode-line) + (setq gnus-group-list-mode (cons level t)) + (gnus-run-hooks 'gnus-group-prepare-hook) + t)) + +(defun gnus-group-list-cached (level &optional lowest) + "List all groups with cached 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))) + (gnus-group-prepare-flat-predicate (or level gnus-level-killed) + #'(lambda (info) + (let ((marks (gnus-info-marks info))) + (assq 'cache marks))) + lowest) + (goto-char (point-min)) + (gnus-group-position-point)) + (provide 'gnus-group) ;;; gnus-group.el ends here diff --git a/lisp/gnus-int.el b/lisp/gnus-int.el index ec71f40..094c50e 100644 --- a/lisp/gnus-int.el +++ b/lisp/gnus-int.el @@ -1,5 +1,6 @@ ;;; gnus-int.el --- backend interface functions for Gnus -;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news diff --git a/lisp/gnus-kill.el b/lisp/gnus-kill.el index c5dbd2f..a5d17c0 100644 --- a/lisp/gnus-kill.el +++ b/lisp/gnus-kill.el @@ -1,5 +1,6 @@ ;;; gnus-kill.el --- kill commands for Gnus -;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen diff --git a/lisp/gnus-logic.el b/lisp/gnus-logic.el index 0b14ce0..56964ff 100644 --- a/lisp/gnus-logic.el +++ b/lisp/gnus-logic.el @@ -1,5 +1,6 @@ ;;; gnus-logic.el --- advanced scoring code for Gnus -;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news diff --git a/lisp/gnus-mh.el b/lisp/gnus-mh.el index 665e361..f737712 100644 --- a/lisp/gnus-mh.el +++ b/lisp/gnus-mh.el @@ -1,5 +1,6 @@ ;;; gnus-mh.el --- mh-e interface for Gnus -;; Copyright (C) 1994,95,96,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen diff --git a/lisp/gnus-mlspl.el b/lisp/gnus-mlspl.el index 51aed76..73c7e16 100644 --- a/lisp/gnus-mlspl.el +++ b/lisp/gnus-mlspl.el @@ -1,7 +1,8 @@ ;;; gnus-mlspl.el --- a group params-based mail splitting mechanism -;; Copyright (C) 1998,1999 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000 +;; Free Software Foundation, Inc. -;; Author: Alexandre Oliva +;; Author: Alexandre Oliva ;; Keywords: news, mail ;; This program is free software; you can redistribute it and/or modify @@ -134,7 +135,7 @@ Calling (gnus-group-split-fancy nil nil \"mail.misc\") returns: (memq group groups)) (and (stringp groups) (string-match groups group))) - (let ((split-spec (cdr (assoc 'split-spec params))) group-clean) + (let ((split-spec (assoc 'split-spec params)) group-clean) ;; Remove backend from group name (setq group-clean (string-match ":" group)) (setq group-clean @@ -142,12 +143,13 @@ Calling (gnus-group-split-fancy nil nil \"mail.misc\") returns: (substring group (1+ group-clean)) group)) (if split-spec - (if (eq split-spec 'catch-all) - ;; Emit catch-all only when requested - (when catch-all - (setq catch-all group-clean)) - ;; Append split-spec to the main split - (push split-spec split)) + (when (setq split-spec (cdr split-spec)) + (if (eq split-spec 'catch-all) + ;; Emit catch-all only when requested + (when catch-all + (setq catch-all group-clean)) + ;; Append split-spec to the main split + (push split-spec split))) ;; Let's deduce split-spec from other params (let ((to-address (cdr (assoc 'to-address params))) (to-list (cdr (assoc 'to-list params))) diff --git a/lisp/gnus-move.el b/lisp/gnus-move.el index 38de4d5..8c0cc75 100644 --- a/lisp/gnus-move.el +++ b/lisp/gnus-move.el @@ -1,5 +1,6 @@ ;;; gnus-move.el --- commands for moving Gnus from one server to another -;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index e8aac35..8716c26 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -1,5 +1,6 @@ ;;; gnus-msg.el --- mail and post interface for Gnus -;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen @@ -1036,6 +1037,7 @@ this is a reply." (group (or group gnus-newsgroup-name "")) (gcc-self-val (and gnus-newsgroup-name + (not (equal gnus-newsgroup-name "")) (gnus-group-find-parameter gnus-newsgroup-name 'gcc-self))) result @@ -1188,36 +1190,35 @@ this is a reply." (setq results (delq name (delq address results))) (make-local-variable 'message-setup-hook) (dolist (result results) - (when (cdr result) - (add-hook 'message-setup-hook - (cond - ((eq 'eval (car result)) - 'ignore) - ((eq 'body (car result)) + (add-hook 'message-setup-hook + (cond + ((eq 'eval (car result)) + 'ignore) + ((eq 'body (car result)) + `(lambda () + (save-excursion + (message-goto-body) + (insert ,(cdr result))))) + ((eq 'signature (car result)) + (set (make-local-variable 'message-signature) nil) + (set (make-local-variable 'message-signature-file) nil) + (if (not (cdr result)) + 'ignore + `(lambda () + (save-excursion + (let ((message-signature ,(cdr result))) + (when message-signature + (message-insert-signature))))))) + (t + (let ((header + (if (symbolp (car result)) + (capitalize (symbol-name (car result))) + (car result)))) `(lambda () (save-excursion - (message-goto-body) - (insert ,(cdr result))))) - ((eq 'signature (car result)) - (set (make-local-variable 'message-signature) nil) - (set (make-local-variable 'message-signature-file) nil) - (if (not (cdr result)) - 'ignore - `(lambda () - (save-excursion - (let ((message-signature ,(cdr result))) - (when message-signature - (message-insert-signature))))))) - (t - (let ((header - (if (symbolp (car result)) - (capitalize (symbol-name (car result))) - (car result)))) - `(lambda () - (save-excursion - (message-remove-header ,header) - (message-goto-eoh) - (insert ,header ": " ,(cdr result) "\n"))))))))) + (message-remove-header ,header) + (message-goto-eoh) + (insert ,header ": " ,(cdr result) "\n")))))))) (when (or name address) (add-hook 'message-setup-hook `(lambda () diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el index 451de41..5425262 100644 --- a/lisp/gnus-score.el +++ b/lisp/gnus-score.el @@ -1,5 +1,6 @@ ;;; gnus-score.el --- scoring code for Gnus -;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Per Abrahamsen ;; Lars Magne Ingebrigtsen @@ -2886,10 +2887,10 @@ If ADAPT, return the home adaptive file instead." ;; Function. ((gnus-functionp elem) (funcall elem group)) - ;; Regexp-file cons + ;; Regexp-file cons. ((consp elem) (when (string-match (gnus-globalify-regexp (car elem)) group) - (replace-match (cadr elem) t nil group )))))) + (replace-match (cadr elem) t nil group)))))) (when found (if (file-name-absolute-p found) found diff --git a/lisp/gnus-spec.el b/lisp/gnus-spec.el index f325e9f..64fbd6a 100644 --- a/lisp/gnus-spec.el +++ b/lisp/gnus-spec.el @@ -1,5 +1,6 @@ ;;; gnus-spec.el --- format spec functions for Gnus -;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news diff --git a/lisp/gnus-srvr.el b/lisp/gnus-srvr.el index bba79f0..b45fed0 100644 --- a/lisp/gnus-srvr.el +++ b/lisp/gnus-srvr.el @@ -1,5 +1,6 @@ ;;; gnus-srvr.el --- virtual server support for Gnus -;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -296,6 +297,18 @@ The following commands are available: (push (assoc server gnus-server-alist) gnus-server-killed-servers) (setq gnus-server-alist (delq (car gnus-server-killed-servers) gnus-server-alist)) + (let ((groups (gnus-groups-from-server server))) + (when (and groups + (gnus-yes-or-no-p + (format "Kill all %s groups from this server? " + (length groups)))) + (dolist (group groups) + (setq gnus-newsrc-alist + (delq (assoc group gnus-newsrc-alist) + gnus-newsrc-alist)) + (when gnus-group-change-level-function + (funcall gnus-group-change-level-function + group gnus-level-killed 3))))) (gnus-server-position-point)) (defun gnus-server-yank-server () diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index 32be0b1..a094a8d 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -1,5 +1,6 @@ ;;; gnus-start.el --- startup functions for Gnus -;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -1917,7 +1918,10 @@ newsgroup." (gnus-group-prefixed-name "" method)))) ;; Let the Gnus agent save the active file. - (if (and gnus-agent real-active gnus-plugged (gnus-agent-method-p method)) + (if (and gnus-agent + real-active + gnus-plugged + (gnus-agent-method-p method)) (progn (gnus-agent-save-groups method) (gnus-active-to-gnus-format method hashtb nil real-active)) diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index c4926f9..8b06e80 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -1,5 +1,6 @@ ;;; gnus-sum.el --- summary mode commands for Gnus -;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -173,9 +174,11 @@ This variable will only be used if the value of This applies to marking commands as well as other commands that \"naturally\" select the next article, like, for instance, `SPC' at the end of an article. -If nil, only the marking commands will go to the next (un)read article. -If `never', commands that usually go to the next unread article, will -go to the next article, whether it is read or not." + +If nil, the marking commands do NOT go to the next unread article +(they go to the next article instead). If `never', commands that +usually go to the next unread article, will go to the next article, +whether it is read or not." :group 'gnus-summary-marks :link '(custom-manual "(gnus)Setting Marks") :type '(choice (const :tag "off" nil) @@ -697,7 +700,8 @@ is not run if `gnus-visual' is nil." :type 'hook) (defcustom gnus-exit-group-hook nil - "*A hook called when exiting (not quitting) summary mode." + "*A hook called when exiting summary mode. +This hook is not called from the non-updating exit commands like `Q'." :group 'gnus-various :type 'hook) @@ -871,6 +875,11 @@ For example: ((1 . cn-gb-2312) (2 . big5))." :type 'boolean :group 'gnus-summary-marks) +(defcustom gnus-alter-articles-to-read-function nil + "Function to be called to alter the list of articles to be selected." + :type 'function + :group 'gnus-summary) + ;;; Internal variables (defvar gnus-article-mime-handles nil) @@ -1330,6 +1339,8 @@ increase the score of each group you read." "\M-\C-h" gnus-summary-hide-thread "\M-\C-f" gnus-summary-next-thread "\M-\C-b" gnus-summary-prev-thread + [(meta down)] gnus-summary-next-thread + [(meta up)] gnus-summary-prev-thread "\M-\C-u" gnus-summary-up-thread "\M-\C-d" gnus-summary-down-thread "&" gnus-summary-execute-command @@ -3375,17 +3386,19 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (memq article gnus-newsgroup-expirable) ;; Only insert the Subject string when it's different ;; from the previous Subject string. - (if (gnus-subject-equal - (condition-case () - (mail-header-subject - (gnus-data-header - (cadr - (gnus-data-find-list - article - (gnus-data-list t))))) - ;; Error on the side of excessive subjects. - (error "")) - (mail-header-subject header)) + (if (and + gnus-show-threads + (gnus-subject-equal + (condition-case () + (mail-header-subject + (gnus-data-header + (cadr + (gnus-data-find-list + article + (gnus-data-list t))))) + ;; Error on the side of excessive subjects. + (error "")) + (mail-header-subject header))) "" (mail-header-subject header)) nil (cdr (assq article gnus-newsgroup-scored)) @@ -3599,7 +3612,6 @@ If LINE, insert the rebuilt thread starting on line LINE." (while thread (gnus-remove-thread-1 (car thread)) (setq thread (cdr thread)))) - (gnus-summary-show-all-threads) (gnus-remove-thread-1 thread)))))))) (defun gnus-remove-thread-1 (thread) @@ -3611,6 +3623,7 @@ If LINE, insert the rebuilt thread starting on line LINE." (gnus-remove-thread-1 (pop thread))) (when (setq d (gnus-data-find number)) (goto-char (gnus-data-pos d)) + (gnus-summary-show-thread) (gnus-data-remove number (- (gnus-point-at-bol) @@ -4275,6 +4288,12 @@ If SELECT-ARTICLES, only select those articles from GROUP." (gnus-sorted-intersection gnus-newsgroup-unreads (gnus-sorted-complement gnus-newsgroup-unreads articles))) + (when gnus-alter-articles-to-read-function + (setq gnus-newsgroup-unreads + (sort + (funcall gnus-alter-articles-to-read-function + gnus-newsgroup-name gnus-newsgroup-unreads) + '<))) articles))) (defun gnus-killed-articles (killed articles) @@ -5102,7 +5121,8 @@ articles with that subject. If BACKWARD, search backward instead." "Center point in window and redisplay frame. Also do horizontal recentering." (interactive "P") - (when (and gnus-auto-center-summary + (when (and nil + gnus-auto-center-summary (not (eq gnus-auto-center-summary 'vertical))) (gnus-horizontal-recenter)) (recenter n)) @@ -5113,6 +5133,7 @@ If `gnus-auto-center-summary' is nil, or the article buffer isn't displayed, no centering will be performed." ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle). ;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu. + (interactive) (let* ((top (cond ((< (window-height) 4) 0) ((< (window-height) 7) 1) (t (if (numberp gnus-auto-center-summary) @@ -5541,7 +5562,8 @@ The state which existed when entering the ephemeral is reset." (rename-buffer (concat (substring name 0 (match-beginning 0)) "Dead " (substring name (match-beginning 0))) - t)))) + t) + (bury-buffer)))) (defun gnus-kill-or-deaden-summary (buffer) "Kill or deaden the summary BUFFER." @@ -5800,37 +5822,34 @@ be displayed." (set-buffer gnus-summary-buffer)) (let ((article (or article (gnus-summary-article-number))) (all-headers (not (not all-headers))) ;Must be T or NIL. - gnus-summary-display-article-function - did) + gnus-summary-display-article-function) (and (not pseudo) (gnus-summary-article-pseudo-p article) (error "This is a pseudo-article")) - (prog1 - (save-excursion - (set-buffer gnus-summary-buffer) - (if (or (and gnus-single-article-buffer - (or (null gnus-current-article) - (null gnus-article-current) - (null (get-buffer gnus-article-buffer)) - (not (eq article (cdr gnus-article-current))) - (not (equal (car gnus-article-current) - gnus-newsgroup-name)))) - (and (not gnus-single-article-buffer) - (or (null gnus-current-article) - (not (eq gnus-current-article article)))) - force) - ;; The requested article is different from the current article. - (prog1 - (gnus-summary-display-article article all-headers) - (setq did article) - (when (or all-headers gnus-show-all-headers) - (gnus-article-show-all-headers))) + (save-excursion + (set-buffer gnus-summary-buffer) + (if (or (and gnus-single-article-buffer + (or (null gnus-current-article) + (null gnus-article-current) + (null (get-buffer gnus-article-buffer)) + (not (eq article (cdr gnus-article-current))) + (not (equal (car gnus-article-current) + gnus-newsgroup-name)))) + (and (not gnus-single-article-buffer) + (or (null gnus-current-article) + (not (eq gnus-current-article article)))) + force) + ;; The requested article is different from the current article. + (progn + (gnus-summary-display-article article all-headers) (when (or all-headers gnus-show-all-headers) (gnus-article-show-all-headers)) - 'old)) - (when did - (gnus-article-set-window-start - (cdr (assq article gnus-newsgroup-bookmarks))))))) + (gnus-article-set-window-start + (cdr (assq article gnus-newsgroup-bookmarks))) + article) + (when (or all-headers gnus-show-all-headers) + (gnus-article-show-all-headers)) + 'old)))) (defun gnus-summary-set-current-mark (&optional current-mark) "Obsolete function." @@ -6990,6 +7009,7 @@ Optional argument BACKWARD means do search for backward. (gnus-save-hidden-threads (gnus-summary-select-article) (set-buffer gnus-article-buffer) + (goto-char (window-point (get-buffer-window (current-buffer)))) (when backward (forward-line -1)) (while (not found) @@ -7240,8 +7260,11 @@ If ARG is a negative number, hide the unwanted header lines." (if hidden (let ((gnus-treat-hide-headers nil) (gnus-treat-hide-boring-headers nil)) + (setq gnus-article-wash-types + (delq 'headers gnus-article-wash-types)) (gnus-treat-article 'head)) - (gnus-treat-article 'head))))))) + (gnus-treat-article 'head))) + (gnus-set-mode-line 'article))))) (defun gnus-summary-show-all-headers () "Make all header lines visible." @@ -7308,7 +7331,10 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." 'request-replace-article gnus-newsgroup-name))) (error "The current group does not support article editing"))) (let ((articles (gnus-summary-work-articles n)) - (prefix (gnus-group-real-prefix gnus-newsgroup-name)) + (prefix (if (gnus-check-backend-function + 'request-move-article gnus-newsgroup-name) + (gnus-group-real-prefix gnus-newsgroup-name) + "")) (names '((move "Move" "Moving") (copy "Copy" "Copying") (crosspost "Crosspost" "Crossposting"))) @@ -7327,7 +7353,8 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." articles prefix)) (set (intern (format "gnus-current-%s-group" action)) to-newsgroup)) (setq to-method (or select-method - (gnus-group-name-to-method to-newsgroup))) + (gnus-server-to-method + (gnus-group-method to-newsgroup)))) ;; Check the method we are to move this article to... (unless (gnus-check-backend-function 'request-accept-article (car to-method)) @@ -7397,10 +7424,10 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (gnus-message 1 "Couldn't %s article %s: %s" (cadr (assq action names)) article (nnheader-get-report (car to-method)))) - ((and (eq art-group 'junk) - (eq action 'move)) - (gnus-summary-mark-article article gnus-canceled-mark) - (gnus-message 4 "Deleted article %s" article)) + ((eq art-group 'junk) + (when (eq action 'move) + (gnus-summary-mark-article article gnus-canceled-mark) + (gnus-message 4 "Deleted article %s" article))) (t (let* ((pto-group (gnus-group-prefixed-name (car art-group) to-method)) @@ -9024,7 +9051,8 @@ save those articles instead." (mapcar (lambda (el) (list el)) (nreverse split-name)) nil nil nil - 'gnus-group-history))))) + 'gnus-group-history)))) + (to-method (gnus-server-to-method (gnus-group-method to-newsgroup)))) (when to-newsgroup (if (or (string= to-newsgroup "") (string= to-newsgroup prefix)) @@ -9032,25 +9060,23 @@ save those articles instead." (unless to-newsgroup (error "No group name entered")) (or (gnus-active to-newsgroup) - (gnus-activate-group to-newsgroup) + (gnus-activate-group to-newsgroup nil nil to-method) (if (gnus-y-or-n-p (format "No such group: %s. Create it? " to-newsgroup)) - (or (and (gnus-request-create-group - to-newsgroup (gnus-group-name-to-method to-newsgroup)) + (or (and (gnus-request-create-group to-newsgroup to-method) (gnus-activate-group - to-newsgroup nil nil - (gnus-group-name-to-method to-newsgroup)) + to-newsgroup nil nil to-method) (gnus-subscribe-group to-newsgroup)) (error "Couldn't create group %s" to-newsgroup))) (error "No such group: %s" to-newsgroup))) to-newsgroup)) -(defun gnus-summary-save-parts (type dir n reverse) +(defun gnus-summary-save-parts (type dir n &optional reverse) "Save parts matching TYPE to DIR. If REVERSE, save parts that do not match TYPE." (interactive (list (read-string "Save parts of type: " "image/.*") - (read-file-name "Save to directory: " t nil t) + (read-file-name "Save to directory: " nil nil t) current-prefix-arg)) (gnus-summary-iterate n (let ((gnus-display-mime-function nil) diff --git a/lisp/gnus-topic.el b/lisp/gnus-topic.el index 34f5a7b..631251e 100644 --- a/lisp/gnus-topic.el +++ b/lisp/gnus-topic.el @@ -1,5 +1,6 @@ ;;; gnus-topic.el --- a folding minor mode for Gnus group buffers -;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Ilja Weis ;; Lars Magne Ingebrigtsen @@ -594,7 +595,8 @@ articles in the topic and its subtopics." (let* ((topic (gnus-group-topic group)) (groups (cdr (assoc topic gnus-topic-alist))) (g (cdr (member group groups))) - (unfound t)) + (unfound t) + entry) ;; Try to jump to a visible group. (while (and g (not (gnus-group-goto-group (car g) t))) (pop g)) @@ -608,8 +610,20 @@ articles in the topic and its subtopics." (when (and unfound topic (not (gnus-topic-goto-missing-topic topic))) - (gnus-topic-insert-topic-line - topic t t (car (gnus-topic-find-topology topic)) nil 0))))) + (let* ((top (gnus-topic-find-topology topic)) + (children (cddr top)) + (type (cadr top)) + (unread 0) + (entries (gnus-topic-find-groups + (car type) (car gnus-group-list-mode) + (cdr gnus-group-list-mode)))) + (while children + (incf unread (gnus-topic-unread (caar (pop children))))) + (while (setq entry (pop entries)) + (when (numberp (car entry)) + (incf unread (car entry)))) + (gnus-topic-insert-topic-line + topic t t (car (gnus-topic-find-topology topic)) nil unread)))))) (defun gnus-topic-goto-missing-topic (topic) (if (gnus-topic-goto-topic topic) diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index 88b3996..6c5bf66 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -1,5 +1,6 @@ ;;; gnus-util.el --- utility functions for Gnus -;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -805,7 +806,8 @@ ARG is passed to the first function." (when (file-exists-p file) (with-temp-buffer (let ((tokens '("machine" "default" "login" - "password" "account" "macdef" "force")) + "password" "account" "macdef" "force" + "port")) alist elem result pair) (insert-file-contents file) (goto-char (point-min)) @@ -853,16 +855,27 @@ ARG is passed to the first function." (forward-line 1)) (nreverse result))))) -(defun gnus-netrc-machine (list machine) +(defun gnus-netrc-machine (list machine &optional port) "Return the netrc values from LIST for MACHINE or for the default entry." - (let ((rest list)) - (while (and list - (not (equal (cdr (assoc "machine" (car list))) machine))) + (let ((rest list) + result) + (while list + (when (equal (cdr (assoc "machine" (car list))) machine) + (push (car list) result)) (pop list)) - (car (or list - (progn (while (and rest (not (assoc "default" (car rest)))) - (pop rest)) - rest))))) + (unless result + ;; No machine name matches, so we look for default entries. + (while rest + (when (assoc "default" (car rest)) + (push (car rest) result)) + (pop rest))) + (when result + (setq result (nreverse result)) + (while (and result + (not (equal (or port "nntp") + (gnus-netrc-get (car result) "port")))) + (pop result)) + (car result)))) (defun gnus-netrc-get (alist type) "Return the value of token TYPE from ALIST." diff --git a/lisp/gnus-uu.el b/lisp/gnus-uu.el index 8418f26..56c6812 100644 --- a/lisp/gnus-uu.el +++ b/lisp/gnus-uu.el @@ -1,5 +1,6 @@ ;;; gnus-uu.el --- extract (uu)encoded files in Gnus -;; Copyright (C) 198,995,86,87,93,94,95,96,97,98 Free Software Foundation, Inc. +;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Created: 2 Oct 1993 @@ -369,12 +370,11 @@ didn't work, and overwrite existing files. Otherwise, ask each time." "k" gnus-summary-kill-process-mark "y" gnus-summary-yank-process-mark "w" gnus-summary-save-process-mark - "i" gnus-uu-invert-processable - "m" gnus-summary-save-parts) + "i" gnus-uu-invert-processable) (gnus-define-keys (gnus-uu-extract-map "X" gnus-summary-mode-map) ;;"x" gnus-uu-extract-any - ;;"m" gnus-uu-extract-mime + "m" gnus-summary-save-parts "u" gnus-uu-decode-uu "U" gnus-uu-decode-uu-and-save "s" gnus-uu-decode-unshar diff --git a/lisp/gnus-win.el b/lisp/gnus-win.el index 6a335e8..6a9ce29 100644 --- a/lisp/gnus-win.el +++ b/lisp/gnus-win.el @@ -1,5 +1,6 @@ ;;; gnus-win.el --- window configuration functions for Gnus -;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -446,12 +447,12 @@ See the Gnus manual for an explanation of the syntax used.") (gnus-delete-windows-in-gnusey-frames)) ;; Just remove some windows. (gnus-remove-some-windows) - (set-buffer nntp-server-buffer)) + (switch-to-buffer nntp-server-buffer)) (select-frame frame))) (let (gnus-window-frame-focus) - (set-buffer nntp-server-buffer) - (gnus-configure-frame split) + (switch-to-buffer nntp-server-buffer) + (gnus-configure-frame split) (when gnus-window-frame-focus (select-frame (window-frame gnus-window-frame-focus)))))))) diff --git a/lisp/gnus-xmas.el b/lisp/gnus-xmas.el index d6addab..fd6ea7f 100644 --- a/lisp/gnus-xmas.el +++ b/lisp/gnus-xmas.el @@ -793,6 +793,76 @@ XEmacs compatibility workaround." (goto-char (event-point event)) (funcall (event-function response) (event-object response)))) +(defun gnus-group-add-icon () + "Add an icon to the current line according to `gnus-group-icon-list'." + (let* ((p (point)) + (end (progn (end-of-line) (point))) + ;; now find out where the line starts and leave point there. + (beg (progn (beginning-of-line) (point)))) + (save-restriction + (narrow-to-region beg end) + (goto-char beg) + (when (search-forward "==&&==" nil t) + (let* ((group (gnus-group-group-name)) + (entry (gnus-group-entry group)) + (unread (if (numberp (car entry)) (car entry) 0)) + (active (gnus-active group)) + (total (if active (1+ (- (cdr active) (car active))) 0)) + (info (nth 2 entry)) + (method (gnus-server-get-method group (gnus-info-method info))) + (marked (gnus-info-marks info)) + (mailp (memq 'mail (assoc (symbol-name + (car (or method gnus-select-method))) + gnus-valid-select-methods))) + (level (or (gnus-info-level info) gnus-level-killed)) + (score (or (gnus-info-score info) 0)) + (ticked (gnus-range-length (cdr (assq 'tick marked)))) + (group-age (gnus-group-timestamp-delta group)) + (inhibit-read-only t) + (list gnus-group-icon-list) + (mystart (match-beginning 0)) + (myend (match-end 0))) + (goto-char (point-min)) + (while (and list + (not (eval (caar list)))) + (setq list (cdr list))) + (if list + (let* ((file (cdar list)) + (glyph (gnus-group-icon-create-glyph + (buffer-substring mystart myend) + file))) + (if glyph + (progn + (mapcar 'delete-annotation (annotations-at myend)) + (let ((ext (make-extent mystart myend)) + (ant (make-annotation glyph myend 'text))) + ;; set text extent params + (set-extent-property ext 'end-open t) + (set-extent-property ext 'start-open t) + (set-extent-property ext 'invisible t))) + (delete-region mystart myend))) + (delete-region mystart myend)))) + (widen)) + (goto-char p))) + +(defun gnus-group-icon-create-glyph (substring pixmap) + "Create a glyph for insertion into a group line." + (and + gnus-group-running-xemacs + (or + (cdr-safe (assoc pixmap gnus-group-icon-cache)) + (let* ((glyph (make-glyph + (list + (cons 'x + (expand-file-name pixmap gnus-xmas-glyph-directory)) + (cons 'mswindows + (expand-file-name pixmap gnus-xmas-glyph-directory)) + (cons 'tty substring))))) + (setq gnus-group-icon-cache + (cons (cons pixmap glyph) gnus-group-icon-cache)) + (set-glyph-face glyph 'default) + glyph)))) + (provide 'gnus-xmas) ;;; gnus-xmas.el ends here diff --git a/lisp/gnus.el b/lisp/gnus.el index f6167dd..3dfda7d 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -1,5 +1,7 @@ ;;; gnus.el --- a newsreader for GNU Emacs -;; Copyright (C) 1987-1990,1993-1999 Free Software Foundation, Inc. +;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996, +;; 1997, 1998, 2000 +;; Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen @@ -261,7 +263,7 @@ is restarted, and sometimes reloaded." :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-original-version-number "5.8.3" +(defconst gnus-original-version-number "5.8.5" "Version number for this version of original Gnus.") (defconst gnus-original-version @@ -1644,17 +1646,16 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") (when (consp function) (setq keymap (car (memq 'keymap function))) (setq function (car function))) - (autoload function (car package) nil interactive keymap))) + (unless (fboundp function) + (autoload function (car package) nil interactive keymap)))) (if (eq (nth 1 package) ':interactive) - (cdddr package) + (nthcdr 3 package) (cdr package))))) - '(("metamail" metamail-buffer) - ("info" Info-goto-node) + '(("info" :interactive t Info-goto-node) ("pp" pp pp-to-string pp-eval-expression) ("qp" quoted-printable-decode-region quoted-printable-decode-string) ("ps-print" ps-print-preprint) - ("mail-extr" mail-extract-address-components) - ("browse-url" browse-url) + ("browse-url" :interactive t browse-url) ("message" :interactive t message-send-and-exit message-yank-original) ("babel" babel-as-string) @@ -1698,7 +1699,8 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") gnus-cache-possibly-remove-articles gnus-cache-request-article gnus-cache-retrieve-headers gnus-cache-possibly-alter-active gnus-cache-enter-remove-article gnus-cached-article-p - gnus-cache-open gnus-cache-close gnus-cache-update-article) + gnus-cache-open gnus-cache-close gnus-cache-update-article + gnus-cache-articles-in-group) ("gnus-cache" :interactive t gnus-jog-cache gnus-cache-enter-article gnus-cache-remove-article gnus-summary-insert-cached-articles) ("gnus-score" :interactive t @@ -2891,10 +2893,13 @@ As opposed to `gnus', this command will not connect to the local server." (let ((window (get-buffer-window gnus-group-buffer))) (cond (window (select-frame (window-frame window))) - (t - (other-frame 1)))) + (t + (select-frame (make-frame))))) (gnus arg)) +;;(setq thing ? ; this is a comment +;; more 'yes) + ;;;###autoload (defun gnus (&optional arg dont-connect slave) "Read network news. diff --git a/lisp/ietf-drums.el b/lisp/ietf-drums.el index 6ef4fc1..853c208 100644 --- a/lisp/ietf-drums.el +++ b/lisp/ietf-drums.el @@ -1,5 +1,6 @@ ;;; ietf-drums.el --- Functions for parsing RFC822bis headers -;; Copyright (C) 1998,99 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; This file is part of GNU Emacs. @@ -115,7 +116,7 @@ (buffer-string)))) (defun ietf-drums-remove-whitespace (string) - "Remove comments from STRING." + "Remove whitespace from STRING." (with-temp-buffer (ietf-drums-init string) (let (c) @@ -151,6 +152,10 @@ (forward-char 1)))) result))) +(defun ietf-drums-strip (string) + "Remove comments and whitespace from STRING." + (ietf-drums-remove-whitespace (ietf-drums-remove-comments string))) + (defun ietf-drums-parse-address (string) "Parse STRING and return a MAILBOX / DISPLAY-NAME pair." (with-temp-buffer diff --git a/lisp/imap.el b/lisp/imap.el index 7460431..0b01b42 100644 --- a/lisp/imap.el +++ b/lisp/imap.el @@ -1,5 +1,6 @@ ;;; imap.el --- imap library -;; Copyright (C) 1998,1999 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Simon Josefsson ;; Keywords: mail @@ -74,9 +75,11 @@ ;; ;; imap.el support RFC1730/2060 (IMAP4/IMAP4rev1), implemented IMAP ;; extensions are RFC2195 (CRAM-MD5), RFC2086 (ACL), RFC2342 -;; (NAMESPACE), RFC2359 (UIDPLUS), and the kerberos V4 part of RFC1731 -;; (with use of external program `imtest'). It also take advantage -;; the UNSELECT extension in Cyrus IMAPD. +;; (NAMESPACE), RFC2359 (UIDPLUS), the IMAP-part of RFC2595 (STARTTLS) +;; (with use of external library starttls.el and program starttls) and +;; the GSSAPI / kerberos V4 sections of RFC1731 (with use of external +;; program `imtest'). It also take advantage the UNSELECT extension +;; in Cyrus IMAPD. ;; ;; Without the work of John McClary Prevost and Jim Radford this library ;; would not have seen the light of day. Many thanks. @@ -122,7 +125,6 @@ ;; o Don't use `read' at all (important places already fixed) ;; o Accept list of articles instead of message set string in most ;; imap-message-* functions. -;; o Cyrus IMAPd 1.6.x `imtest' support in the imtest wrapper ;; ;; Revision history: ;; @@ -154,11 +156,18 @@ ;; User variables. -(defvar imap-imtest-program "imtest -kp %s %p" - "How to call program for Kerberos 4 authentication. -%s is replaced with server and %p with port to connect to. The -program should accept IMAP commands on stdin and return responses to -stdout.") +(defvar imap-kerberos4-program '("imtest -m kerberos_v4 -u %l -p %p %s" + "imtest -kp %s %p") + "List of strings containing commands for Kerberos 4 authentication. +%s is replaced with server hostname, %p with port to connect to, and +%l with the value of `imap-default-user'. The program should accept +IMAP commands on stdin and return responses to stdout.") + +(defvar imap-gssapi-program '("imtest -m gssapi -u %l -p %p %s") + "List of strings containing commands for GSSAPI (krb5) authentication. +%s is replaced with server hostname, %p with port to connect to, and +%l with the value of `imap-default-user'. The program should accept +IMAP commands on stdin and return responses to stdout.") (defvar imap-ssl-program '("openssl s_client -ssl3 -connect %s:%p" "openssl s_client -ssl2 -connect %s:%p" @@ -180,14 +189,15 @@ stdin and return responses to stdout.") (defvar imap-fetch-data-hook nil "Hooks called after receiving each FETCH response.") -(defvar imap-streams '(kerberos4 starttls ssl network) +(defvar imap-streams '(gssapi kerberos4 starttls ssl network) "Priority of streams to consider when opening connection to server.") (defvar imap-stream-alist - '((kerberos4 imap-kerberos4s-p imap-kerberos4-open) - (ssl imap-ssl-p imap-ssl-open) - (network imap-network-p imap-network-open) - (starttls imap-starttls-p imap-starttls-open)) + '((gssapi imap-gssapi-stream-p imap-gssapi-open) + (kerberos4 imap-kerberos4-stream-p imap-kerberos4-open) + (ssl imap-ssl-p imap-ssl-open) + (network imap-network-p imap-network-open) + (starttls imap-starttls-p imap-starttls-open)) "Definition of network streams. (NAME CHECK OPEN) @@ -196,15 +206,21 @@ NAME names the stream, CHECK is a function returning non-nil if the server support the stream and OPEN is a function for opening the stream.") -(defvar imap-authenticators '(kerberos4 digest-md5 cram-md5 login anonymous) +(defvar imap-authenticators '(gssapi + kerberos4 + digest-md5 + cram-md5 + login + anonymous) "Priority of authenticators to consider when authenticating to server.") (defvar imap-authenticator-alist - '((kerberos4 imap-kerberos4a-p imap-kerberos4-auth) - (cram-md5 imap-cram-md5-p imap-cram-md5-auth) - (login imap-login-p imap-login-auth) - (anonymous imap-anonymous-p imap-anonymous-auth) - (digest-md5 imap-digest-md5-p imap-digest-md5-auth)) + '((gssapi imap-gssapi-auth-p imap-gssapia-auth) + (kerberos4 imap-kerberos4-auth-p imap-kerberos4-auth) + (cram-md5 imap-cram-md5-p imap-cram-md5-auth) + (login imap-login-p imap-login-auth) + (anonymous imap-anonymous-p imap-anonymous-auth) + (digest-md5 imap-digest-md5-p imap-digest-md5-auth)) "Definition of authenticators. (NAME CHECK AUTHENTICATE) @@ -376,46 +392,119 @@ If ARGS, PROMPT is used as an argument to `format'." ;; Server functions; stream stuff: -(defun imap-kerberos4s-p (buffer) +(defun imap-kerberos4-stream-p (buffer) (imap-capability 'AUTH=KERBEROS_V4 buffer)) (defun imap-kerberos4-open (name buffer server port) - (message "Opening Kerberized IMAP connection...") - (let* ((port (or port imap-default-port)) - (coding-system-for-read imap-coding-system-for-read) - (coding-system-for-write imap-coding-system-for-write) - (process (start-process - name buffer shell-file-name shell-command-switch - (format-spec - imap-imtest-program - (format-spec-make ?s server ?p (number-to-string port)))))) - (when process - (with-current-buffer buffer - (setq imap-client-eol "\n") - ;; Result of authentication is a string: __Full privacy protection__ - (while (and (memq (process-status process) '(open run)) - (goto-char (point-min)) - (not (and (imap-parse-greeting) - (re-search-forward "__\\(.*\\)__\n" nil t)))) - (accept-process-output process 1) - (sit-for 1)) - (and imap-log - (with-current-buffer (get-buffer-create imap-log) - (imap-disable-multibyte) - (buffer-disable-undo) - (goto-char (point-max)) - (insert-buffer-substring buffer))) - (let ((response (match-string 1))) - (erase-buffer) - (message "Kerberized IMAP connection: %s" response) - (if (and response (let ((case-fold-search nil)) - (not (string-match "failed" response)))) - process - (if (memq (process-status process) '(open run)) - (imap-send-command-wait "LOGOUT")) - (delete-process process) - nil)))))) + (let ((cmds imap-kerberos4-program) + cmd done) + (while (and (not done) (setq cmd (pop cmds))) + (message "Opening Kerberos 4 IMAP connection with `%s'..." cmd) + (let* ((port (or port imap-default-port)) + (coding-system-for-read imap-coding-system-for-read) + (coding-system-for-write imap-coding-system-for-write) + (process (start-process + name buffer shell-file-name shell-command-switch + (format-spec + cmd + (format-spec-make + ?s server + ?p (number-to-string port) + ?l imap-default-user)))) + response) + (when process + (with-current-buffer buffer + (setq imap-client-eol "\n") + (while (and (memq (process-status process) '(open run)) + (goto-char (point-min)) + ;; cyrus 1.6.x (13? < x <= 22) queries capabilities + (or (while (looking-at "^C:") + (forward-line)) + t) + ;; cyrus 1.6 imtest print "S: " before server greeting + (or (not (looking-at "S: ")) + (forward-char 3) + t) + (not (and (imap-parse-greeting) + ;; success in imtest < 1.6: + (or (re-search-forward + "^__\\(.*\\)__\n" nil t) + ;; success in imtest 1.6: + (re-search-forward + "^\\(Authenticat.*\\)" nil t)) + (setq response (match-string 1))))) + (accept-process-output process 1) + (sit-for 1)) + (and imap-log + (with-current-buffer (get-buffer-create imap-log) + (imap-disable-multibyte) + (buffer-disable-undo) + (goto-char (point-max)) + (insert-buffer-substring buffer))) + (erase-buffer) + (message "Kerberos 4 IMAP connection: %s" (or response "failed")) + (if (and response (let ((case-fold-search nil)) + (not (string-match "failed" response)))) + (setq done process) + (if (memq (process-status process) '(open run)) + (imap-send-command-wait "LOGOUT")) + (delete-process process) + nil))))) + done)) +(defun imap-gssapi-stream-p (buffer) + (imap-capability 'AUTH=GSSAPI buffer)) + +(defun imap-gssapi-open (name buffer server port) + (let ((cmds imap-gssapi-program) + cmd done) + (while (and (not done) (setq cmd (pop cmds))) + (message "Opening GSSAPI IMAP connection with `%s'..." cmd) + (let* ((port (or port imap-default-port)) + (coding-system-for-read imap-coding-system-for-read) + (coding-system-for-write imap-coding-system-for-write) + (process (start-process + name buffer shell-file-name shell-command-switch + (format-spec + cmd + (format-spec-make + ?s server + ?p (number-to-string port) + ?l imap-default-user)))) + response) + (when process + (with-current-buffer buffer + (setq imap-client-eol "\n") + (while (and (memq (process-status process) '(open run)) + (goto-char (point-min)) + ;; cyrus 1.6 imtest print "S: " before server greeting + (or (not (looking-at "S: ")) + (forward-char 3) + t) + (not (and (imap-parse-greeting) + ;; success in imtest 1.6: + (re-search-forward + "^\\(Authenticat.*\\)" nil t) + (setq response (match-string 1))))) + (accept-process-output process 1) + (sit-for 1)) + (and imap-log + (with-current-buffer (get-buffer-create imap-log) + (imap-disable-multibyte) + (buffer-disable-undo) + (goto-char (point-max)) + (insert-buffer-substring buffer))) + (erase-buffer) + (message "GSSAPI IMAP connection: %s" (or response "failed")) + (if (and response (let ((case-fold-search nil)) + (not (string-match "failed" response)))) + (setq done process) + (if (memq (process-status process) '(open run)) + (imap-send-command-wait "LOGOUT")) + (delete-process process) + nil))))) + done)) + (defun imap-ssl-p (buffer) nil) @@ -558,7 +647,13 @@ Returns t if login was successful, nil otherwise." ;; passwd nil)))) ret))) -(defun imap-kerberos4a-p (buffer) +(defun imap-gssapi-auth-p (buffer) + (imap-capability 'AUTH=GSSAPI buffer)) + +(defun imap-gssapi-auth (buffer) + (eq imap-stream 'gssapi)) + +(defun imap-kerberos4-auth-p (buffer) (imap-capability 'AUTH=KERBEROS_V4 buffer)) (defun imap-kerberos4-auth (buffer) @@ -1001,9 +1096,9 @@ returned, if ITEMS is a symbol only it's value is returned." (list items)))))) (if (listp items) (mapcar (lambda (item) - (imap-mailbox-get-1 item mailbox)) + (imap-mailbox-get item mailbox)) items) - (imap-mailbox-get-1 items mailbox))))) + (imap-mailbox-get items mailbox))))) (defun imap-mailbox-acl-get (&optional mailbox buffer) "Get ACL on mailbox from server in BUFFER." @@ -1265,10 +1360,11 @@ on failure." "Return number of lines in article by looking at the mime bodystructure BODY." (if (listp body) (if (stringp (car body)) - (cond ((and (string= (car body) "TEXT") + ;; upcase for bug in courier imap server + (cond ((and (string= (upcase (car body)) "TEXT") (numberp (nth 7 body))) (nth 7 body)) - ((and (string= (car body) "MESSAGE") + ((and (string= (upcase (car body)) "MESSAGE") (numberp (nth 9 body))) (nth 9 body)) (t 0)) @@ -1318,13 +1414,14 @@ on failure." (if (not (eq (imap-wait-for-tag tag) 'INCOMPLETE)) (setq command nil);; abort command if no cont-req (let ((process imap-process) - (stream imap-stream)) + (stream imap-stream) + (eol imap-client-eol)) (with-current-buffer cmd - (when (eq stream 'kerberos4) + (when (not (equal eol "\r\n")) ;; XXX modifies buffer! (goto-char (point-min)) (while (search-forward "\r\n" nil t) - (replace-match "\n"))) + (replace-match eol))) (and imap-log (with-current-buffer (get-buffer-create imap-log) diff --git a/lisp/lpath.el b/lisp/lpath.el index 8fe4c16..1f89b48 100644 --- a/lisp/lpath.el +++ b/lisp/lpath.el @@ -41,7 +41,9 @@ rmail-summary-exists rmail-select-summary rmail-update-summary url-retrieve temp-directory babel-fetch babel-wash - find-coding-systems-for-charsets sc-cite-regexp)) + find-coding-systems-for-charsets sc-cite-regexp + vcard-pretty-print image-type-available-p + make-overlay overlay-put)) (maybe-bind '(global-face-data mark-active transient-mark-mode mouse-selection-click-count mouse-selection-click-count-buffer buffer-display-table @@ -57,7 +59,8 @@ url-current-callback-func url-current-callback-data url-be-asynchronous temporary-file-directory babel-translations babel-history - display-time-mail-function))) + display-time-mail-function imap-password + ))) (maybe-bind '(mail-mode-hook enable-multibyte-characters browse-url-browser-function adaptive-fill-first-line-regexp adaptive-fill-regexp @@ -65,7 +68,7 @@ w3-meta-content-type-charset-regexp w3-meta-charset-content-type-regexp babel-translations babel-history - display-time-mail-function)) + display-time-mail-function imap-password)) (maybe-fbind '(color-instance-rgb-components temp-directory glyph-width annotation-glyph window-pixel-width glyph-height @@ -91,7 +94,8 @@ w3-coding-system-for-mime-charset rmail-summary-exists rmail-select-summary rmail-update-summary url-generic-parse-url valid-image-instantiator-format-p - babel-fetch babel-wash babel-as-string sc-cite-regexp))) + babel-fetch babel-wash babel-as-string sc-cite-regexp + vcard-pretty-print image-type-available-p))) (setq load-path (cons "." load-path)) (require 'custom) diff --git a/lisp/mail-parse.el b/lisp/mail-parse.el index e9c39e5..c874bb6 100644 --- a/lisp/mail-parse.el +++ b/lisp/mail-parse.el @@ -1,5 +1,6 @@ ;;; mail-parse.el --- Interface functions for parsing mail -;; Copyright (C) 1998,99 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; This file is part of GNU Emacs. @@ -51,6 +52,7 @@ (defalias 'mail-header-remove-comments 'ietf-drums-remove-comments) (defalias 'mail-header-remove-whitespace 'ietf-drums-remove-whitespace) +(defalias 'mail-header-strip 'ietf-drums-strip) (defalias 'mail-header-get-comment 'ietf-drums-get-comment) (defalias 'mail-header-parse-address 'ietf-drums-parse-address) (defalias 'mail-header-parse-addresses 'ietf-drums-parse-addresses) diff --git a/lisp/mail-prsvr.el b/lisp/mail-prsvr.el index de43787..2566abc 100644 --- a/lisp/mail-prsvr.el +++ b/lisp/mail-prsvr.el @@ -1,5 +1,5 @@ ;;; mail-prsvr.el --- Interface variables for parsing mail -;; Copyright (C) 1999 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; This file is part of GNU Emacs. diff --git a/lisp/mail-source.el b/lisp/mail-source.el index be06416..96b0ece 100644 --- a/lisp/mail-source.el +++ b/lisp/mail-source.el @@ -1,5 +1,5 @@ ;;; mail-source.el --- functions for fetching mail -;; Copyright (C) 1999 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news, mail @@ -62,7 +62,7 @@ If non-nil, this maildrop will be checked periodically for new mail." :group 'mail-source :type 'integer) -(defcustom mail-source-delete-incoming t +(defcustom mail-source-delete-incoming nil "*If non-nil, delete incoming files after handling." :group 'mail-source :type 'boolean) @@ -634,15 +634,23 @@ This only works when `display-time' is enabled." (defun mail-source-fetch-imap (source callback) "Fetcher for imap sources." (mail-source-bind (imap source) - (let ((found 0) + (let ((from (format "%s:%s:%s" server user port)) + (found 0) (buf (get-buffer-create (generate-new-buffer-name " *imap source*"))) (mail-source-string (format "imap:%s:%s" server mailbox)) remove) (if (and (imap-open server port stream authentication buf) - (imap-authenticate user password buf) + (imap-authenticate + user (or (cdr (assoc from mail-source-password-cache)) + password) buf) (imap-mailbox-select mailbox nil buf)) (let (str (coding-system-for-write 'binary)) (with-temp-file mail-source-crash-box + ;; remember password + (with-current-buffer buf + (when (or imap-password + (assoc from mail-source-password-cache)) + (push (cons from imap-password) mail-source-password-cache))) ;; if predicate is nil, use all uids (dolist (uid (imap-search (or predicate "1:*") buf)) (when (setq str (imap-fetch uid "RFC822.PEEK" 'RFC822 nil buf)) @@ -663,6 +671,11 @@ This only works when `display-time' is enabled." (imap-mailbox-close buf)) (imap-close buf)) (imap-close buf) + ;; We nix out the password in case the error + ;; was because of a wrong password being given. + (setq mail-source-password-cache + (delq (assoc from mail-source-password-cache) + mail-source-password-cache)) (error (imap-error-text buf))) (kill-buffer buf) found))) @@ -679,8 +692,15 @@ This only works when `display-time' is enabled." (when (eq authentication 'password) (setq password (or password + (cdr (assoc (format "webmail:%s:%s" subtype user) + mail-source-password-cache)) (mail-source-read-passwd - (format "Password for %s at %s: " user subtype))))) + (format "Password for %s at %s: " user subtype)))) + (when (and password + (not (assoc (format "webmail:%s:%s" subtype user) + mail-source-password-cache))) + (push (cons (format "webmail:%s:%s" subtype user) password) + mail-source-password-cache))) (webmail-fetch mail-source-crash-box subtype user password) (mail-source-callback callback (symbol-name subtype))))) diff --git a/lisp/message.el b/lisp/message.el index 8563863..555a582 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -1,5 +1,6 @@ ;;; message.el --- composing mail and news messages -;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko @@ -44,7 +45,6 @@ (require 'nnheader) (require 'timezone) (require 'easymenu) -(require 'custom) (if (string-match "XEmacs\\|Lucid" emacs-version) (require 'mail-abbrevs) (require 'mailabbrev)) @@ -375,7 +375,7 @@ The provided functions are: :group 'message-insertion :type 'regexp) -(defcustom message-cancel-message "I am canceling my own article." +(defcustom message-cancel-message "I am canceling my own article.\n" "Message to be inserted in the cancel message." :group 'message-interface :type 'string) @@ -462,6 +462,11 @@ might set this variable to '(\"-f\" \"you@some.where\")." :group 'message-sending :type '(repeat string)) +(defvar message-cater-to-broken-inn t + "Non-nil means Gnus should not fold the `References' header. +Folding `References' makes ancient versions of INN create incorrect +NOV lines.") + (defvar gnus-post-method) (defvar gnus-select-method) (defcustom message-post-method @@ -748,6 +753,13 @@ If nil, Message won't auto-save." :group 'message-buffers :type 'directory) +(defcustom message-dont-reply-to-names rmail-dont-reply-to-names + "*A regexp specifying names to prune when doing wide replies. +A value of nil means exclude your own name only." + :group 'message + :type '(choice (const :tag "Yourself" nil) + regexp)) + ;;; Internal variables. ;;; Well, not really internal. @@ -1141,6 +1153,7 @@ The cdr of ech entry is a function for applying the face to a region.") (defun message-fetch-field (header &optional not-all) "The same as `mail-fetch-field', only remove all newlines." (let* ((inhibit-point-motion-hooks t) + (case-fold-search t) (value (mail-fetch-field header nil (not not-all)))) (when value (nnheader-replace-chars-in-string value ?\n ? )))) @@ -1511,6 +1524,11 @@ C-c C-r message-caesar-buffer-body (rot13 the message body)." (setq adaptive-fill-first-line-regexp (concat "[ \t]*[-a-z0-9A-Z]*>+[ \t]*\\|" adaptive-fill-first-line-regexp)) + (make-local-variable 'auto-fill-inhibit-regexp) + (setq auto-fill-inhibit-regexp "^[A-Z][^: \n\t]+:") + (mm-enable-multibyte) + (make-local-variable 'indent-tabs-mode) ;Turn off tabs for indentation. + (setq indent-tabs-mode nil) (run-hooks 'text-mode-hook 'message-mode-hook)) @@ -1620,6 +1638,24 @@ With the prefix argument FORCE, insert the header anyway." (insert (or (message-fetch-reply-field "reply-to") (message-fetch-reply-field "from") ""))) +(defun message-widen-reply () + "Widen the reply to include maximum recipients." + (interactive) + (let ((follow-to + (and message-reply-buffer + (buffer-name message-reply-buffer) + (save-excursion + (set-buffer message-reply-buffer) + (message-get-reply-headers t))))) + (save-excursion + (save-restriction + (message-narrow-to-headers) + (dolist (elem follow-to) + (message-remove-header (symbol-name (car elem))) + (goto-char (point-min)) + (insert (symbol-name (car elem)) ": " + (cdr elem) "\n")))))) + (defun message-insert-newsgroups () "Insert the Newsgroups header from the article being replied to." (interactive) @@ -1743,13 +1779,7 @@ text was killed." (/= (aref message-caesar-translation-table ?a) (+ ?a n))) (setq message-caesar-translation-table (message-make-caesar-translation-table n))) - ;; Then we translate the region. Do it this way to retain - ;; text properties. - (while (< b e) - (subst-char-in-region - b (1+ b) (char-after b) - (aref message-caesar-translation-table (char-after b))) - (incf b)))) + (translate-region b e message-caesar-translation-table))) (defun message-make-caesar-translation-table (n) "Create a rot table with offset N." @@ -1786,11 +1816,8 @@ Mail and USENET news headers are not rotated." (save-restriction (when (message-goto-body) (narrow-to-region (point) (point-max))) - (let ((body (buffer-substring (point-min) (point-max)))) - (unless (equal 0 (call-process-region - (point-min) (point-max) program t t)) - (insert body) - (message "%s failed." program)))))) + (shell-command-on-region + (point-min) (point-max) program nil t)))) (defun message-rename-buffer (&optional enter-string) "Rename the *message* buffer to \"*message* RECIPIENT\". @@ -1998,6 +2025,8 @@ be added to \"References\" field. (if (listp message-indent-citation-function) message-indent-citation-function (list message-indent-citation-function))))) + ;; Allow undoing. + (undo-boundary) (goto-char end) (when (re-search-backward "^-- $" start t) ;; Also peel off any blank lines before the signature. @@ -2405,7 +2434,8 @@ This sub function is for exclusive use of `message-send-mail'." (defun message-send-mail-with-sendmail () "Send off the prepared buffer with sendmail." (let ((errbuf (if message-interactive - (generate-new-buffer " sendmail errors") + (message-generate-new-buffer-clone-locals + " sendmail errors") 0)) resend-to-addresses delimline) (let ((case-fold-search t)) @@ -2695,6 +2725,15 @@ This sub function is for exclusive use of `message-send-news'." (defun message-check-news-header-syntax () (and + ;; Check Newsgroups header. + (message-check 'newsgroups + (let ((group (message-fetch-field "newsgroups"))) + (or + (and group + (not (string-match "\\`[ \t]*\\'" group))) + (ignore + (message + "The newsgroups field is empty or missing. Posting is denied."))))) ;; Check the Subject header. (message-check 'subject (let* ((case-fold-search t) @@ -3447,7 +3486,7 @@ Headers already prepared in the buffer are not modified." ;; The element is a symbol. We insert the value ;; of this symbol, if any. (symbol-value header)) - (t + ((not (message-check-element header)) ;; We couldn't generate a value for this header, ;; so we just ask the user. (read-from-minibuffer @@ -3578,23 +3617,60 @@ Headers already prepared in the buffer are not modified." (replace-match " " t t)) (goto-char (point-max))))) +(defun message-shorten-1 (list cut surplus) + ;; Cut SURPLUS elements out of LIST, beginning with CUTth one. + (setcdr (nthcdr (- cut 2) list) + (nthcdr (+ (- cut 2) surplus 1) list))) + (defun message-shorten-references (header references) "Limit REFERENCES to be shorter than 988 characters." - (let ((max 988) - (cut 4) + (let ((maxcount 988) + (count 0) + (cut 6) refs) (with-temp-buffer (insert references) (goto-char (point-min)) (while (re-search-forward "<[^>]+>" nil t) (push (match-string 0) refs)) - (setq refs (nreverse refs)) - (while (> (length (mapconcat 'identity refs " ")) max) - (when (< (length refs) (1+ cut)) - (decf cut)) - (setcdr (nthcdr cut refs) (cddr (nthcdr cut refs))))) - (insert (capitalize (symbol-name header)) ": " - (mapconcat 'identity refs " ") "\n"))) + (setq refs (nreverse refs) + count (length refs))) + + ;; If the list has more than MAXCOUNT elements, trim it by + ;; removing the CUTth element and the required number of + ;; elements that follow. + (when (> count maxcount) + (let ((surplus (- count maxcount))) + (message-shorten-1 refs cut surplus) + (decf count surplus))) + + ;; If folding is disallowed, make sure the total length (including + ;; the spaces between) will be less than MAXSIZE characters. + ;; + ;; Only disallow folding for News messages. At this point the headers + ;; have not been generated, thus we use message-this-is-news directly. + (when (and message-this-is-news message-cater-to-broken-inn) + (let ((maxsize 988) + (totalsize (+ (apply #'+ (mapcar #'length refs)) + (1- count))) + (surplus 0) + (ptr (nthcdr (1- cut) refs))) + ;; Decide how many elements to cut off... + (while (> totalsize maxsize) + (decf totalsize (1+ (length (car ptr)))) + (incf surplus) + (setq ptr (cdr ptr))) + ;; ...and do it. + (when (> surplus 0) + (message-shorten-1 refs cut surplus)))) + + ;; Finally, collect the references back into a string and insert + ;; it into the buffer. + (let ((refstring (mapconcat #'identity refs " "))) + (if (and message-this-is-news message-cater-to-broken-inn) + (insert (capitalize (symbol-name header)) ": " + refstring "\n") + (message-fill-header header refstring))))) (defun message-position-point () "Move point to where the user probably wants to find it." @@ -3807,6 +3883,68 @@ OTHER-HEADERS is an alist of header/value pairs." (message-setup `((Newsgroups . ,(or newsgroups "")) (Subject . ,(or subject "")))))) +(defun message-get-reply-headers (wide &optional to-address) + (let (follow-to mct never-mct from to cc reply-to ccalist) + ;; Find all relevant headers we need. + (setq from (message-fetch-field "from") + to (message-fetch-field "to") + cc (message-fetch-field "cc") + mct (message-fetch-field "mail-copies-to") + reply-to (message-fetch-field "reply-to")) + + ;; Handle special values of Mail-Copies-To. + (when mct + (cond ((or (equal (downcase mct) "never") + (equal (downcase mct) "nobody")) + (setq never-mct t) + (setq mct nil)) + ((or (equal (downcase mct) "always") + (equal (downcase mct) "poster")) + (setq mct (or reply-to from))))) + + (if (or (not wide) + to-address) + (progn + (setq follow-to (list (cons 'To (or to-address reply-to from)))) + (when (and wide mct) + (push (cons 'Cc mct) follow-to))) + (let (ccalist) + (save-excursion + (message-set-work-buffer) + (unless never-mct + (insert (or reply-to from ""))) + (insert (if to (concat (if (bolp) "" ", ") to "") "")) + (insert (if mct (concat (if (bolp) "" ", ") mct) "")) + (insert (if cc (concat (if (bolp) "" ", ") cc) "")) + (goto-char (point-min)) + (while (re-search-forward "[ \t]+" nil t) + (replace-match " " t t)) + ;; Remove addresses that match `rmail-dont-reply-to-names'. + (let ((rmail-dont-reply-to-names message-dont-reply-to-names)) + (insert (prog1 (rmail-dont-reply-to (buffer-string)) + (erase-buffer)))) + (goto-char (point-min)) + ;; Perhaps "Mail-Copies-To: never" removed the only address? + (when (eobp) + (insert (or reply-to from ""))) + (setq ccalist + (mapcar + (lambda (addr) + (cons (mail-strip-quoted-names addr) addr)) + (message-tokenize-header (buffer-string)))) + (let ((s ccalist)) + (while s + (setq ccalist (delq (assoc (car (pop s)) s) ccalist))))) + (setq follow-to (list (cons 'To (cdr (pop ccalist))))) + (when ccalist + (let ((ccs (cons 'Cc (mapconcat + (lambda (addr) (cdr addr)) ccalist ", ")))) + (when (string-match "^ +" (cdr ccs)) + (setcdr ccs (substring (cdr ccs) (match-end 0)))) + (push ccs follow-to))))) + follow-to)) + + ;;;###autoload (defun message-reply (&optional to-address wide) "Start editing a reply to the article in the current buffer." @@ -3815,7 +3953,8 @@ OTHER-HEADERS is an alist of header/value pairs." from subject date reply-to to cc references message-id follow-to (inhibit-point-motion-hooks t) - mct never-mct gnus-warning in-reply-to) + (message-this-is-mail t) + gnus-warning in-reply-to) (save-restriction (message-narrow-to-head) ;; Allow customizations to have their say. @@ -3828,16 +3967,11 @@ OTHER-HEADERS is an alist of header/value pairs." (save-excursion (setq follow-to (funcall message-wide-reply-to-function))))) - ;; Find all relevant headers we need. - (setq from (message-fetch-field "from") - date (message-fetch-field "date") - subject (or (message-fetch-field "subject") "none") - to (message-fetch-field "to") - cc (message-fetch-field "cc") - mct (message-fetch-field "mail-copies-to") - reply-to (message-fetch-field "reply-to") + (setq message-id (message-fetch-field "message-id" t) references (message-fetch-field "references") - message-id (message-fetch-field "message-id" t)) + date (message-fetch-field "date") + from (message-fetch-field "from") + subject (or (message-fetch-field "subject") "none")) ;; Get the references from "In-Reply-To" field if there were ;; no references and "In-Reply-To" field looks promising. (unless references @@ -3853,63 +3987,14 @@ OTHER-HEADERS is an alist of header/value pairs." (when (and (setq gnus-warning (message-fetch-field "gnus-warning")) (string-match "<[^>]+>" gnus-warning)) (setq message-id (match-string 0 gnus-warning))) - - ;; Handle special values of Mail-Copies-To. - (when mct - (cond ((equal (downcase mct) "never") - (setq never-mct t) - (setq mct nil)) - ((equal (downcase mct) "always") - (setq mct (or reply-to from))))) - + (unless follow-to - (if (or (not wide) - to-address) - (progn - (setq follow-to (list (cons 'To (or to-address reply-to from)))) - (when (and wide mct) - (push (cons 'Cc mct) follow-to))) - (let (ccalist) - (save-excursion - (message-set-work-buffer) - (unless never-mct - (insert (or reply-to from ""))) - (insert (if to (concat (if (bolp) "" ", ") to "") "")) - (insert (if mct (concat (if (bolp) "" ", ") mct) "")) - (insert (if cc (concat (if (bolp) "" ", ") cc) "")) - (goto-char (point-min)) - (while (re-search-forward "[ \t]+" nil t) - (replace-match " " t t)) - ;; Remove addresses that match `rmail-dont-reply-to-names'. - (insert (prog1 (rmail-dont-reply-to (buffer-string)) - (erase-buffer))) - (goto-char (point-min)) - ;; Perhaps Mail-Copies-To: never removed the only address? - (when (eobp) - (insert (or reply-to from ""))) - (setq ccalist - (mapcar - (lambda (addr) - (cons (mail-strip-quoted-names addr) addr)) - (message-tokenize-header (buffer-string)))) - (let ((s ccalist)) - (while s - (setq ccalist (delq (assoc (car (pop s)) s) ccalist)))) - (when (functionp message-mail-follow-up-address-checker) - (setq ccalist (funcall message-mail-follow-up-address-checker - ccalist)))) - (setq follow-to (list (cons 'To (cdr (pop ccalist))))) - (when ccalist - (let ((ccs (cons 'Cc (mapconcat - (lambda (addr) (cdr addr)) ccalist ", ")))) - (when (string-match "^ +" (cdr ccs)) - (setcdr ccs (substring (cdr ccs) (match-end 0)))) - (push ccs follow-to)))))) - (widen)) + (setq follow-to (message-get-reply-headers wide to-address)))) - (message-pop-to-buffer (message-buffer-name - (if wide "wide reply" "reply") from - (if wide to-address nil))) + (message-pop-to-buffer + (message-buffer-name + (if wide "wide reply" "reply") from + (if wide to-address nil))) (setq message-reply-headers (make-full-mail-header-from-decoded-header @@ -4043,9 +4128,10 @@ responses here are directed to other newsgroups.")) ;;;###autoload -(defun message-cancel-news () - "Cancel an article you posted." - (interactive) +(defun message-cancel-news (&optional arg) + "Cancel an article you posted. +If ARG, allow editing of the cancellation message." + (interactive "P") (unless (message-news-p) (error "This is not a news article; canceling is impossible")) (when (yes-or-no-p "Do you really want to cancel this article? ") @@ -4070,8 +4156,9 @@ responses here are directed to other newsgroups.")) (message-make-from)))))) (error "This article is not yours")) ;; Make control message. - (setq buf (set-buffer (get-buffer-create " *message cancel*"))) - (buffer-disable-undo (current-buffer)) + (if arg + (message-news) + (setq buf (set-buffer (get-buffer-create " *message cancel*")))) (erase-buffer) (insert "Newsgroups: " newsgroups "\n" "From: " (message-make-from) "\n" @@ -4082,14 +4169,14 @@ responses here are directed to other newsgroups.")) "") mail-header-separator "\n" message-cancel-message) - (message "Canceling your article...") - (if (let ((message-syntax-checks - 'dont-check-for-anything-just-trust-me) - (message-encoding-buffer (current-buffer)) - (message-edit-buffer (current-buffer))) - (message-send-news)) - (message "Canceling your article...done")) - (kill-buffer buf))))) + (run-hooks 'message-cancel-hook) + (unless arg + (message "Canceling your article...") + (if (let ((message-syntax-checks + 'dont-check-for-anything-just-trust-me)) + (funcall message-send-news-function)) + (message "Canceling your article...done")) + (kill-buffer buf)))))) (defun message-supersede-setup-for-mime-edit () (set (make-local-variable 'message-setup-hook) nil) @@ -4142,6 +4229,8 @@ header line with the old Message-ID." (cond ((save-window-excursion (if (not (eq system-type 'vax-vms)) (with-output-to-temp-buffer "*Directory*" + (with-current-buffer standard-output + (fundamental-mode)) ; for Emacs 20.4+ (buffer-disable-undo standard-output) (let ((default-directory "/")) (call-process @@ -4534,6 +4623,7 @@ The following arguments may contain lists of values." (save-excursion (with-output-to-temp-buffer " *MESSAGE information message*" (set-buffer " *MESSAGE information message*") + (fundamental-mode) ; for Emacs 20.4+ (mapcar 'princ text) (goto-char (point-min)))) (funcall ask question)) diff --git a/lisp/mm-bodies.el b/lisp/mm-bodies.el index 348371e..e417c85 100644 --- a/lisp/mm-bodies.el +++ b/lisp/mm-bodies.el @@ -1,5 +1,5 @@ ;;; mm-bodies.el --- Functions for decoding MIME things -;; Copyright (C) 1998,99 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko @@ -39,9 +39,18 @@ ;; BS, vertical TAB, form feed, and ^_ (defvar mm-7bit-chars "\x20-\x7f\r\n\t\x7\x8\xb\xc\x1f") -(defvar mm-body-charset-encoding-alist nil +(defcustom mm-body-charset-encoding-alist + '((iso-2022-jp . 7bit) + (iso-2022-jp-2 . 7bit)) "Alist of MIME charsets to encodings. -Valid encodings are `7bit', `8bit', `quoted-printable' and `base64'.") +Valid encodings are `7bit', `8bit', `quoted-printable' and `base64'." + :type '(repeat (cons (symbol :tag "charset") + (choice :tag "encoding" + (const 7bit) + (const 8bit) + (const quoted-printable) + (const base64)))) + :group 'mime) (defun mm-encode-body () "Encode a body. @@ -151,15 +160,21 @@ If no encoding was done, nil is returned." ((eq encoding 'quoted-printable) (quoted-printable-decode-region (point-min) (point-max))) ((eq encoding 'base64) - (base64-decode-region (point-min) - ;; Some mailers insert whitespace - ;; junk at the end which - ;; base64-decode-region dislikes. - (save-excursion - (goto-char (point-max)) - (skip-chars-backward "\n\t ") - (delete-region (point) (point-max)) - (point)))) + (base64-decode-region + (point-min) + ;; Some mailers insert whitespace + ;; junk at the end which + ;; base64-decode-region dislikes. + ;; Also remove possible junk which could + ;; have been added by mailing list software. + (save-excursion + (goto-char (point-min)) + (if (re-search-forward "^[\t ]*$" nil t) + (delete-region (point) (point-max)) + (goto-char (point-max))) + (skip-chars-backward "\n\t ") + (delete-region (point) (point-max)) + (point)))) ((memq encoding '(7bit 8bit binary)) ;; Do nothing. ) diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el index 996b514..e04d235 100644 --- a/lisp/mm-decode.el +++ b/lisp/mm-decode.el @@ -1,5 +1,5 @@ ;;; mm-decode.el --- Functions for decoding MIME things -;; Copyright (C) 1998,99 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko @@ -29,6 +29,8 @@ (require 'mm-bodies) (require 'mmgnus) +(defvar mm-xemacs-p (string-match "XEmacs" (emacs-version))) + (defgroup mime-display () "Display of MIME in mail and news articles." :link '(custom-manual "(emacs-mime)Customization") @@ -490,14 +492,18 @@ external if displayed external." (defun mm-mailcap-command (method file type-list) (let ((ctl (cdr type-list)) (beg 0) + (uses-stdin t) out sub total) - (while (string-match "%{\\([^}]+\\)}\\|%s\\|%t" method beg) + (while (string-match "%{\\([^}]+\\)}\\|%s\\|%t\\|%%" method beg) (push (substring method beg (match-beginning 0)) out) (setq beg (match-end 0) total (match-string 0 method) sub (match-string 1 method)) (cond + ((string= total "%%") + (push "%" out)) ((string= total "%s") + (setq uses-stdin nil) (push (mm-quote-arg file) out)) ((string= total "%t") (push (mm-quote-arg (car type-list)) out)) @@ -505,6 +511,10 @@ external if displayed external." (push (mm-quote-arg (or (mime-content-type-parameter sub ctl) "")) out)))) (push (substring method beg (length method)) out) + (if uses-stdin + (progn + (push "<" out) + (push (mm-quote-arg file) out))) (mapconcat 'identity (nreverse out) ""))) (defun mm-remove-parts (handles) @@ -769,7 +779,37 @@ external if displayed external." "Return the handle(s) referred to by ID." (cdr (assoc id mm-content-id-alist))) -(defun mm-get-image (handle) +(defun mm-get-image-emacs (handle) + "Return an image instance based on HANDLE." + (let ((type (mm-handle-media-subtype handle)) + spec) + ;; Allow some common translations. + (setq type + (cond + ((equal type "x-pixmap") + "xpm") + ((equal type "x-xbitmap") + "xbm") + (t type))) + (or (mm-handle-cache handle) + (mm-with-unibyte-buffer + (mm-insert-part handle) + (prog1 + (setq spec + (ignore-errors + (cond + ((equal type "xbm") + ;; xbm images require special handling, since + ;; the only way to create glyphs from these + ;; (without a ton of work) is to write them + ;; out to a file, and then create a file + ;; specifier. + (error "Don't know what to do for XBMs right now.")) + (t + (list 'image :type (intern type) :data (buffer-string)))))) + (mm-handle-set-cache handle spec)))))) + +(defun mm-get-image-xemacs (handle) "Return an image instance based on HANDLE." (let ((type (mm-handle-media-subtype handle)) spec) @@ -808,17 +848,37 @@ external if displayed external." (vector (intern type) :data (buffer-string))))))) (mm-handle-set-cache handle spec)))))) +(defun mm-get-image (handle) + (if mm-xemacs-p + (mm-get-image-xemacs handle) + (mm-get-image-emacs handle))) + (defun mm-image-fit-p (handle) "Say whether the image in HANDLE will fit the current window." (let ((image (mm-get-image handle))) - (or mm-inline-large-images - (and (< (glyph-width image) (window-pixel-width)) - (< (glyph-height image) (window-pixel-height)))))) + (if (fboundp 'glyph-width) + ;; XEmacs' glyphs can actually tell us about their width, so + ;; lets be nice and smart about them. + (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))) (defun mm-valid-image-format-p (format) "Say whether FORMAT can be displayed natively by Emacs." - (and (fboundp 'valid-image-instantiator-format-p) - (valid-image-instantiator-format-p format))) + (cond + ;; Handle XEmacs + ((fboundp 'valid-image-instantiator-format-p) + (valid-image-instantiator-format-p format)) + ;; Handle Emacs 21 + ((fboundp 'image-type-available-p) + (image-type-available-p format)) + ;; Nobody else can do images yet. + (t + nil))) (defun mm-valid-and-fit-image-p (format handle) "Say whether FORMAT can be displayed natively and HANDLE fits the window." diff --git a/lisp/mm-encode.el b/lisp/mm-encode.el index a882641..fab3513 100644 --- a/lisp/mm-encode.el +++ b/lisp/mm-encode.el @@ -1,5 +1,5 @@ ;;; mm-encode.el --- Functions for encoding MIME things -;; Copyright (C) 1998,99 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko diff --git a/lisp/mm-util.el b/lisp/mm-util.el index bf94df4..e945a2f 100644 --- a/lisp/mm-util.el +++ b/lisp/mm-util.el @@ -1,5 +1,5 @@ ;;; mm-util.el --- Utility functions for MIME things -;; Copyright (C) 1998,99 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko @@ -64,7 +64,8 @@ chinese-cns11643-1 chinese-cns11643-2 chinese-cns11643-3 chinese-cns11643-4 chinese-cns11643-5 chinese-cns11643-6 - chinese-cns11643-7)) + chinese-cns11643-7) + (utf-8 unicode-a unicode-b unicode-c unicode-d unicode-e)) "Alist of MIME-charset/MULE-charsets.") (eval-and-compile @@ -94,6 +95,13 @@ prompt (mapcar (lambda (s) (list (symbol-name (car s)))) mm-mime-mule-charset-alist))))))) +(eval-and-compile + (defalias 'mm-char-or-char-int-p + (cond + ((fboundp 'char-or-char-int-p) 'char-or-char-int-p) + ((fboundp 'char-valid-p) 'char-valid-p) + (t 'identity)))) + (defvar mm-coding-system-list nil) (defun mm-get-coding-system-list () "Get the coding system list." @@ -241,7 +249,7 @@ If the charset is `composition', return the actual one." (defun mm-mime-charset (charset) "Return the MIME charset corresponding to the MULE CHARSET." - (if (fboundp 'coding-system-get) + (if (and (fboundp 'coding-system-get) (fboundp 'get-charset-property)) ;; This exists in Emacs 20. (or (and (mm-preferred-coding-system charset) diff --git a/lisp/mm-uu.el b/lisp/mm-uu.el index ef78335..47e777c 100644 --- a/lisp/mm-uu.el +++ b/lisp/mm-uu.el @@ -1,5 +1,5 @@ ;;; mm-uu.el -- Return uu stuffs as mm handles -;; Copyright (c) 1998,99 Free Software Foundation, Inc. +;; Copyright (c) 1998, 1999, 2000 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu ;; Keywords: postscript uudecode binhex shar forward news @@ -165,10 +165,16 @@ To disable dissecting shar codes, for instance, add (setq end-char-1 (match-beginning 0)) (forward-line) (setq end-char (point)) - (when (or (not (eq type 'binhex)) - (setq file-name - (ignore-errors - (binhex-decode-region start-char end-char t)))) + (when (cond + ((eq type 'binhex) + (setq file-name + (ignore-errors + (binhex-decode-region start-char end-char t)))) + ((eq type 'forward) + (save-excursion + (goto-char start-char-1) + (looking-at "[\r\n]*[a-zA-Z][a-zA-Z0-9-]*:"))) + (t t)) (if (> start-char text-start) (push (mm-make-handle (mm-uu-copy-to-buffer text-start start-char) diff --git a/lisp/mm-view.el b/lisp/mm-view.el index 73653c0..cd0fa7f 100644 --- a/lisp/mm-view.el +++ b/lisp/mm-view.el @@ -1,5 +1,5 @@ ;;; mm-view.el --- Functions for viewing MIME objects -;; Copyright (C) 1998,99 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; This file is part of GNU Emacs. @@ -33,13 +33,32 @@ (autoload 'gnus-article-prepare-display "gnus-art") (autoload 'vcard-parse-string "vcard") (autoload 'vcard-format-string "vcard") + (autoload 'fill-flowed "flow-fill") (autoload 'diff-mode "diff-mode")) ;;; ;;; Functions for displaying various formats inline ;;; +(defun mm-inline-image-emacs (handle) + (let ((b (point)) + (overlay nil) + (string (copy-sequence "[MM-INLINED-IMAGE]")) + buffer-read-only) + (insert "\n") + (buffer-name) + (setq overlay (make-overlay (point) (point) (current-buffer))) + (put-text-property 0 (length string) 'display (mm-get-image handle) string) + (overlay-put overlay 'before-string string) -(defun mm-inline-image (handle) + (mm-handle-set-undisplayer + handle + `(lambda () + (let (buffer-read-only) + (delete-overlay ,overlay) + (delete-region ,(set-marker (make-marker) b) + ,(set-marker (make-marker) (point)))))))) + +(defun mm-inline-image-xemacs (handle) (let ((b (point)) (annot (make-annotation (mm-get-image handle) nil 'text)) buffer-read-only) @@ -54,6 +73,11 @@ (set-extent-property annot 'mm t) (set-extent-property annot 'duplicable t))) +(defun mm-inline-image (handle) + (if mm-xemacs-p + (mm-inline-image-xemacs handle) + (mm-inline-image-emacs handle))) + (defvar mm-w3-setup nil) (defun mm-setup-w3 () (unless mm-w3-setup @@ -127,15 +151,25 @@ (mm-insert-inline handle (concat "\n-- \n" - (vcard-format-string - (vcard-parse-string (mm-get-part handle) - 'vcard-standard-filter))))) + (if (fboundp 'vcard-pretty-print) + (vcard-pretty-print (mm-get-part handle)) + (vcard-format-string + (vcard-parse-string (mm-get-part handle) + 'vcard-standard-filter)))))) (t (setq text (mm-get-part handle)) (let ((b (point)) (charset (mail-content-type-get (mm-handle-type handle) 'charset))) (insert (mm-decode-string text charset)) + (when (and (equal type "plain") + (equal (cdr (assoc 'format (mm-handle-type handle))) + "flowed")) + (save-restriction + (narrow-to-region b (point)) + (goto-char b) + (fill-flowed) + (goto-char (point-max)))) (save-restriction (narrow-to-region b (point)) (set-text-properties (point-min) (point-max) nil) @@ -199,6 +233,8 @@ (narrow-to-region b b) (mm-insert-part handle) (let (gnus-article-mime-handles + ;; disable prepare hook + gnus-article-prepare-hook (gnus-newsgroup-charset (or charset gnus-newsgroup-charset))) (run-hooks 'gnus-article-decode-hook) diff --git a/lisp/nnagent.el b/lisp/nnagent.el index d551c9e..b445395 100644 --- a/lisp/nnagent.el +++ b/lisp/nnagent.el @@ -1,5 +1,5 @@ ;;; nnagent.el --- offline backend for Gnus -;; Copyright (C) 1997,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1997, 1998, 1999, 2000 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news, mail diff --git a/lisp/nndoc.el b/lisp/nndoc.el index 0a246e4..3ab4729 100644 --- a/lisp/nndoc.el +++ b/lisp/nndoc.el @@ -1,5 +1,6 @@ ;;; nndoc.el --- single file access for Gnus -;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Masanobu UMEDA diff --git a/lisp/nndraft.el b/lisp/nndraft.el index c201dc8..5b61f10 100644 --- a/lisp/nndraft.el +++ b/lisp/nndraft.el @@ -1,5 +1,6 @@ ;;; nndraft.el --- draft article access for Gnus -;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news diff --git a/lisp/nnfolder.el b/lisp/nnfolder.el index 1d1f2a8..2c77996 100644 --- a/lisp/nnfolder.el +++ b/lisp/nnfolder.el @@ -1,5 +1,6 @@ ;;; nnfolder.el --- mail folder access for Gnus -;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Scott Byer ;; Lars Magne Ingebrigtsen @@ -746,7 +747,7 @@ deleted. Point is left where the deleted region was." buffer (push (list group buffer) nnfolder-buffer-alist) (set-buffer-modified-p t) - (save-buffer)) + (nnfolder-save-buffer)) ;; Parse the damn thing. (save-excursion (goto-char (point-min)) diff --git a/lisp/nnheader.el b/lisp/nnheader.el index a5ae95b..c848c13 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -1,5 +1,8 @@ ;;; nnheader.el --- header access macros for Gnus and its backends -;; Copyright (C) 1987-1990,1993-1999 Free Software Foundation, Inc. + +;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996, +;; 1997, 1998, 2000 +;; Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen @@ -48,7 +51,6 @@ on your system, you could say something like: (autoload 'nnmail-message-id "nnmail") (autoload 'mail-position-on-field "sendmail") (autoload 'message-remove-header "message") - (autoload 'cancel-function-timers "timers") (autoload 'gnus-point-at-eol "gnus-util") (autoload 'gnus-delete-line "gnus-util") (autoload 'gnus-buffer-live-p "gnus-util")) @@ -734,14 +736,14 @@ without formatting." (concat (let ((dir (file-name-as-directory (expand-file-name dir)))) ;; If this directory exists, we use it directly. - (if (file-directory-p (concat dir group)) - (concat dir group "/") - ;; If not, we translate dots into slashes. - (concat dir - (mm-encode-coding-string - (nnheader-replace-chars-in-string group ?. ?/) - nnheader-pathname-coding-system) - "/"))) + (file-name-as-directory + (if (file-directory-p (concat dir group)) + (expand-file-name group dir) + ;; If not, we translate dots into slashes. + (expand-file-name (mm-encode-coding-string + (nnheader-replace-chars-in-string group ?. ?/) + nnheader-pathname-coding-system) + dir)))) (cond ((null file) "") ((numberp file) (int-to-string file)) (t file)))) diff --git a/lisp/nnimap.el b/lisp/nnimap.el index 7581479..af1de33 100644 --- a/lisp/nnimap.el +++ b/lisp/nnimap.el @@ -1,5 +1,5 @@ ;;; nnimap.el --- imap backend for Gnus -;; Copyright (C) 1998,1999 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. ;; Author: Simon Josefsson ;; Jim Radford @@ -126,6 +126,13 @@ 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.") +(defvar nnimap-split-predicate "UNSEEN UNDELETED" + "The predicate used to find articles to split. +If you use another IMAP client to peek on articles but always would +like nnimap to split them once it's started, you could change this to +\"UNDELETED\". Other available predicates are available in +RFC2060 section 6.4.4.") + (defvar nnimap-split-fancy nil "Like `nnmail-split-fancy', which see.") @@ -361,9 +368,10 @@ If EXAMINE is non-nil the group is selected read-only." nnimap-progress-how-often) nnimap-progress-chars))) (with-current-buffer nntp-server-buffer - (let (headers lines chars uid) + (let (headers lines chars uid mbx) (with-current-buffer nnimap-server-buffer (setq uid imap-current-message + mbx imap-current-mailbox headers (if (imap-capability 'IMAP4rev1) ;; xxx don't just use car? alist doesn't contain ;; anything else now, but it might... @@ -376,10 +384,14 @@ If EXAMINE is non-nil the group is selected read-only." (buffer-disable-undo) (insert headers) (nnheader-ms-strip-cr) + (nnheader-fold-continuation-lines) + (subst-char-in-region (point-min) (point-max) ?\t ? ) (let ((head (nnheader-parse-head 'naked))) (mail-header-set-number head uid) (mail-header-set-chars head chars) (mail-header-set-lines head lines) + (mail-header-set-xref + head (format "%s %s:%d" (system-name) mbx uid)) head)))))) (defun nnimap-retrieve-which-headers (articles fetch-old) @@ -492,8 +504,8 @@ If EXAMINE is non-nil the group is selected read-only." ;; remove nov's for articles which has expired on server (goto-char (point-min)) (dolist (uid (gnus-set-difference articles uids)) - (when (re-search-forward (format "^%d\t" uid) nil t) - (gnus-delete-line))))) + (when (re-search-forward (format "^%d\t" uid) nil t) + (gnus-delete-line))))) ;; nothing cached, fetch whole range from server (nnimap-retrieve-headers-from-server (cons low high) group server)) @@ -602,8 +614,8 @@ function is generally only called when Gnus is shutting down." (nnheader-ms-strip-cr) (funcall nnimap-callback-callback-function t))) -(defun nnimap-request-article-part (article part prop - &optional group server to-buffer) +(defun nnimap-request-article-part (article part prop &optional + group server to-buffer detail) (when (nnimap-possibly-change-group group server) (let ((article (if (stringp article) (car-safe (imap-search @@ -615,9 +627,12 @@ function is generally only called when Gnus is shutting down." (if (not nnheader-callback-function) (with-current-buffer (or to-buffer nntp-server-buffer) (erase-buffer) - (insert (nnimap-demule (imap-fetch article part prop nil - nnimap-server-buffer))) - (nnheader-ms-strip-cr) + (let ((data (imap-fetch article part prop nil + nnimap-server-buffer))) + (insert (nnimap-demule (if detail + (nth 2 (car data)) + data)))) + (nnheader-ms-strip-cr) (gnus-message 9 "nnimap: Fetching (part of) article %d...done" article) (if (bobp) @@ -634,16 +649,25 @@ function is generally only called when Gnus is shutting down." t) (deffoo nnimap-request-article (article &optional group server to-buffer) - (nnimap-request-article-part - article "RFC822.PEEK" 'RFC822 group server to-buffer)) + (if (imap-capability 'IMAP4rev1 nnimap-server-buffer) + (nnimap-request-article-part + article "BODY.PEEK[]" 'BODYDETAIL group server to-buffer 'detail) + (nnimap-request-article-part + article "RFC822.PEEK" 'RFC822 group server to-buffer))) (deffoo nnimap-request-head (article &optional group server to-buffer) - (nnimap-request-article-part - article "RFC822.HEADER" 'RFC822.HEADER group server to-buffer)) + (if (imap-capability 'IMAP4rev1 nnimap-server-buffer) + (nnimap-request-article-part + article "BODY.PEEK[HEADER]" 'BODYDETAIL group server to-buffer 'detail) + (nnimap-request-article-part + article "RFC822.HEADER" 'RFC822.HEADER group server to-buffer))) (deffoo nnimap-request-body (article &optional group server to-buffer) - (nnimap-request-article-part - article "RFC822.TEXT.PEEK" 'RFC822.TEXT group server to-buffer)) + (if (imap-capability 'IMAP4rev1 nnimap-server-buffer) + (nnimap-request-article-part + article "BODY.PEEK[TEXT]" 'BODYDETAIL group server to-buffer 'detail) + (nnimap-request-article-part + article "RFC822.TEXT.PEEK" 'RFC822.TEXT group server to-buffer))) (deffoo nnimap-request-group (group &optional server fast) (nnimap-request-update-info-internal @@ -889,7 +913,7 @@ function is generally only called when Gnus is shutting down." ;; find split rule for this server / inbox (when (setq rule (nnimap-split-find-rule server inbox)) ;; iterate over articles - (dolist (article (imap-search "UNSEEN UNDELETED")) + (dolist (article (imap-search nnimap-split-predicate)) (when (nnimap-request-head article) ;; copy article to right group(s) (setq removeorig nil) diff --git a/lisp/nnmail.el b/lisp/nnmail.el index 7496822..d4ead4f 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -1,5 +1,6 @@ ;;; nnmail.el --- mail support functions for the Gnus mail backends -;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news, mail @@ -166,6 +167,13 @@ Eg.: :type '(choice (const :tag "nnmail-expiry-wait" nil) (function :format "%v" nnmail-))) +(defcustom nnmail-expiry-target 'delete + "*Variable that says where expired messages should end up." + :group 'nnmail-expire + :type '(choice (const delete) + (function :format "%v" nnmail-) + string)) + (defcustom nnmail-cache-accepted-message-ids nil "If non-nil, put Message-IDs of Gcc'd articles into the duplicate cache." :group 'nnmail @@ -469,32 +477,50 @@ Symbols must be catitalized." ?. ?_)) (setq group (nnheader-translate-file-chars group)) ;; If this directory exists, we use it directly. - (if (or nnmail-use-long-file-names - (file-directory-p (concat dir group))) - (concat dir group "/") - ;; If not, we translate dots into slashes. - (concat dir - (mm-encode-coding-string - (nnheader-replace-chars-in-string group ?. ?/) - nnmail-pathname-coding-system) - "/"))) + (file-name-as-directory + (if (or nnmail-use-long-file-names + (file-directory-p (concat dir group))) + (expand-file-name group dir) + ;; If not, we translate dots into slashes. + (expand-file-name + (mm-encode-coding-string + (nnheader-replace-chars-in-string group ?. ?/) + nnmail-pathname-coding-system) + dir)))) (or file ""))) (defun nnmail-get-active () "Returns an assoc of group names and active ranges. nn*-request-list should have been called before calling this function." - (let (group-assoc) - ;; Go through all groups from the active list. - (save-excursion - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (while (re-search-forward - "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)" nil t) - ;; We create an alist with `(GROUP (LOW . HIGH))' elements. - (push (list (match-string 1) - (cons (string-to-int (match-string 3)) - (string-to-int (match-string 2)))) - group-assoc))) + ;; Go through all groups from the active list. + (save-excursion + (set-buffer nntp-server-buffer) + (nnmail-parse-active))) + +(defun nnmail-parse-active () + "Parse the active file in the current buffer and return an alist." + (goto-char (point-min)) + (unless (re-search-forward "[\\\"]" nil t) + (goto-char (point-max)) + (while (re-search-backward "[][';?()#]" nil t) + (insert ?\\))) + (goto-char (point-min)) + (let ((buffer (current-buffer)) + group-assoc group max min) + (while (not (eobp)) + (condition-case err + (progn + (narrow-to-region (point) (gnus-point-at-eol)) + (setq group (read buffer)) + (unless (stringp group) + (setq group (symbol-name group))) + (if (and (numberp (setq max (read nntp-server-buffer))) + (numberp (setq min (read nntp-server-buffer)))) + (push (list group (cons min max)) + group-assoc))) + (error nil)) + (widen) + (forward-line 1)) group-assoc)) (defvar nnmail-active-file-coding-system 'raw-text @@ -512,8 +538,11 @@ nn*-request-list should have been called before calling this function." (erase-buffer) (let (group) (while (setq group (pop alist)) - (insert (format "%s %d %d y\n" (car group) (cdadr group) - (caadr group)))))) + (insert (format "%S %d %d y\n" (intern (car group)) (cdadr group) + (caadr group)))) + (goto-char (point-max)) + (while (search-backward "\\." nil t) + (delete-char 1)))) (defun nnmail-get-split-group (file source) "Find out whether this FILE is to be split into GROUP only. @@ -1067,7 +1096,10 @@ Return the number of characters in the body." (goto-char (point-min)) (when (re-search-forward "^References:" nil t) (beginning-of-line) - (insert "X-Gnus-Broken-Eudora-")))) + (insert "X-Gnus-Broken-Eudora-")) + (goto-char (point-min)) + (when (re-search-forward "^In-Reply-To:[^\n]+\\(\n[ \t]+\\)" nil t) + (replace-match "" t t nil 1)))) (custom-add-option 'nnmail-prepare-incoming-header-hook 'nnmail-fix-eudora-headers) @@ -1310,14 +1342,84 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (setq nnmail-cache-buffer nil) (kill-buffer (current-buffer))))) +;; Compiler directives. +(defvar group) +(defvar group-art-list) +(defvar group-art) (defun nnmail-cache-insert (id) (when nnmail-treat-duplicates - (unless (gnus-buffer-live-p nnmail-cache-buffer) - (nnmail-cache-open)) + ;; Store some information about the group this message is written + ;; to. This function might have been called from various places. + ;; Sometimes, a function up in the calling sequence has an + ;; argument GROUP which is bound to a string, the group name. At + ;; other times, there is a function up in the calling sequence + ;; which has an argument GROUP-ART which is a list of pairs, and + ;; the car of a pair is a group name. Should we check that the + ;; length of the list is equal to 1? -- kai + (let ((g nil)) + (cond ((and (boundp 'group) group) + (setq g group)) + ((and (boundp 'group-art-list) group-art-list + (listp group-art-list)) + (setq g (caar group-art-list))) + ((and (boundp 'group-art) group-art (listp group-art)) + (setq g (caar group-art))) + (t (setq g ""))) + (unless (gnus-buffer-live-p nnmail-cache-buffer) + (nnmail-cache-open)) + (save-excursion + (set-buffer nnmail-cache-buffer) + (goto-char (point-max)) + (if (and g (not (string= "" g)) + (gnus-methods-equal-p gnus-command-method + (nnmail-cache-primary-mail-backend))) + (insert id "\t" g "\n") + (insert id "\n")))))) + +(defun nnmail-cache-primary-mail-backend () + (let ((be-list (cons gnus-select-method gnus-secondary-select-methods)) + (be nil) + (res nil)) + (while (and (null res) be-list) + (setq be (car be-list)) + (setq be-list (cdr be-list)) + (when (and (gnus-method-option-p be 'respool) + (eval (intern (format "%s-get-new-mail" (car be))))) + (setq res be))) + res)) + +;; Fetch the group name corresponding to the message id stored in the +;; cache. +(defun nnmail-cache-fetch-group (id) + (when (and nnmail-treat-duplicates nnmail-cache-buffer) (save-excursion (set-buffer nnmail-cache-buffer) (goto-char (point-max)) - (insert id "\n")))) + (when (search-backward id nil t) + (beginning-of-line) + (skip-chars-forward "^\n\r\t") + (unless (eolp) + (forward-char 1) + (buffer-substring (point) + (progn (end-of-line) (point)))))))) + +;; Function for nnmail-split-fancy: look up all references in the +;; cache and if a match is found, return that group. +(defun nnmail-split-fancy-with-parent () + (let* ((refstr (or (message-fetch-field "references") + (message-fetch-field "in-reply-to"))) + (references nil) + (res nil)) + (when refstr + (setq references (nreverse (gnus-split-references refstr))) + (unless (gnus-buffer-live-p nnmail-cache-buffer) + (nnmail-cache-open)) + (mapcar (lambda (x) + (setq res (or (nnmail-cache-fetch-group x) res)) + (when (string= "drafts" res) + (setq res nil))) + references) + res))) (defun nnmail-cache-id-exists-p (id) (when nnmail-treat-duplicates @@ -1498,6 +1600,12 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." ;; Compare the time with the current time. (ignore-errors (time-less-p days (time-since time)))))))) +(defun nnmail-expiry-target-group (target group) + (when (nnheader-functionp target) + (setq target (funcall target group))) + (unless (eq target 'delete) + (gnus-request-accept-article target))) + (defun nnmail-check-syntax () "Check (and modify) the syntax of the message in the current buffer." (save-restriction @@ -1578,6 +1686,8 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (unless nnmail-split-history (error "No current split history")) (with-output-to-temp-buffer "*nnmail split history*" + (with-current-buffer standard-output + (fundamental-mode)) ; for Emacs 20.4+ (let ((history nnmail-split-history) elem) (while (setq elem (pop history)) diff --git a/lisp/nnml.el b/lisp/nnml.el index fd7d216..07fdbc6 100644 --- a/lisp/nnml.el +++ b/lisp/nnml.el @@ -1,5 +1,6 @@ ;;; nnml.el --- mail spool access for Gnus -;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Masanobu UMEDA @@ -41,11 +42,11 @@ "Spool directory for the nnml mail backend.") (defvoo nnml-active-file - (concat (file-name-as-directory nnml-directory) "active") + (expand-file-name "active" nnml-directory) "Mail active file.") (defvoo nnml-newsgroups-file - (concat (file-name-as-directory nnml-directory) "newsgroups") + (expand-file-name "newsgroups" nnml-directory) "Mail newsgroups description file.") (defvoo nnml-get-new-mail t @@ -285,6 +286,13 @@ all. This may very well take some time.") (nnmail-expired-article-p group mod-time force nnml-inhibit-expiry))) (progn + ;; Allow a special target group. + (unless (eq nnmail-expiry-target 'delete) + (with-temp-buffer + (nnml-request-article article group server + (current-buffer)) + (nnmail-expiry-target-group + nnmail-expiry-target group))) (nnheader-message 5 "Deleting article %s in %s" article group) (condition-case () @@ -372,8 +380,8 @@ all. This may very well take some time.") (nnmail-write-region (point-min) (point-max) (or (nnml-article-to-file article) - (concat nnml-current-directory - (int-to-string article))) + (expand-file-name (int-to-string article) + nnml-current-directory)) nil (if (nnheader-be-verbose 5) nil 'nomesg)) t) (setq headers (nnml-parse-head chars article)) @@ -477,7 +485,7 @@ all. This may very well take some time.") (nnml-update-file-alist) (let (file) (if (setq file (cdr (assq article nnml-article-file-alist))) - (concat nnml-current-directory file) + (expand-file-name file nnml-current-directory) ;; Just to make sure nothing went wrong when reading over NFS -- ;; check once more. (when (file-exists-p @@ -518,8 +526,8 @@ all. This may very well take some time.") (defun nnml-find-id (group id) (erase-buffer) - (let ((nov (concat (nnmail-group-pathname group nnml-directory) - nnml-nov-file-name)) + (let ((nov (expand-file-name nnml-nov-file-name + (nnmail-group-pathname group nnml-directory))) number found) (when (file-exists-p nov) (nnheader-insert-file-contents nov) @@ -539,7 +547,7 @@ all. This may very well take some time.") (defun nnml-retrieve-headers-with-nov (articles &optional fetch-old) (if (or gnus-nov-is-evil nnml-nov-is-evil) nil - (let ((nov (concat nnml-current-directory nnml-nov-file-name))) + (let ((nov (expand-file-name nnml-nov-file-name nnml-current-directory))) (when (file-exists-p nov) (save-excursion (set-buffer nntp-server-buffer) @@ -635,8 +643,8 @@ all. This may very well take some time.") (push (list group active) nnml-group-alist)) (setcdr active (1+ (cdr active))) (while (file-exists-p - (concat (nnmail-group-pathname group nnml-directory) - (int-to-string (cdr active)))) + (expand-file-name (int-to-string (cdr active)) + (nnmail-group-pathname group nnml-directory))) (setcdr active (1+ (cdr active)))) (cdr active))) @@ -676,8 +684,9 @@ all. This may very well take some time.") (save-excursion (set-buffer buffer) (set (make-local-variable 'nnml-nov-buffer-file-name) - (concat (nnmail-group-pathname group nnml-directory) - nnml-nov-file-name)) + (expand-file-name + nnml-nov-file-name + (nnmail-group-pathname group nnml-directory))) (erase-buffer) (when (file-exists-p nnml-nov-buffer-file-name) (nnheader-insert-file-contents nnml-nov-buffer-file-name))) diff --git a/lisp/nnslashdot.el b/lisp/nnslashdot.el index 23dae0d..7d7ebf4 100644 --- a/lisp/nnslashdot.el +++ b/lisp/nnslashdot.el @@ -1,5 +1,5 @@ ;;; nnslashdot.el --- interfacing with Slashdot -;; Copyright (C) 1999 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -377,11 +377,12 @@ (narrow-to-region (point) (search-forward "")) (goto-char (point-min)) (re-search-forward "\\([^<]+\\)") - (setq description (nnweb-decode-entities-string (match-string 1))) + (setq description + (nnweb-decode-entities-string (match-string 1))) (re-search-forward "\\([^<]+\\)") (setq sid (match-string 1)) - (string-match "/\\([0-9/]+\\).shtml" sid) - (setq sid (match-string 1 sid)) + (string-match "/\\([0-9/]+\\)\\(.shtml\\|$\\)" sid) + (setq sid (concat "00/" (match-string 1 sid))) (re-search-forward "\\([^<]+\\)") (setq articles (string-to-number (match-string 1))) (setq gname (concat description " (" sid ")")) @@ -397,9 +398,11 @@ (nnweb-insert (format nnslashdot-active-url number) t) (goto-char (point-min)) (while (re-search-forward - "article.pl\\?sid=\\([^&]+\\).*\\([^<]+\\)" nil t) + "article.pl\\?sid=\\([^&]+\\).*\\([^<]+\\)" + nil t) (setq sid (match-string 1) - description (nnweb-decode-entities-string (match-string 2))) + description + (nnweb-decode-entities-string (match-string 2))) (forward-line 1) (when (re-search-forward "\\([0-9]+\\)" nil t) (setq articles (string-to-number (match-string 1)))) diff --git a/lisp/nnspool.el b/lisp/nnspool.el index 9e9e711..5cbfed7 100644 --- a/lisp/nnspool.el +++ b/lisp/nnspool.el @@ -1,5 +1,5 @@ ;;; nnspool.el --- spool access for GNU Emacs -;; Copyright (C) 198,998,89,90,93,94,95,96,97,98 Free Software Foundation, Inc. +;; Copyright (C) 1988,89,90,93,94,95,96,97,98 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen diff --git a/lisp/nntp.el b/lisp/nntp.el index 98ad46a..5ced1d7 100644 --- a/lisp/nntp.el +++ b/lisp/nntp.el @@ -1,5 +1,7 @@ ;;; nntp.el --- nntp access for Gnus -;;; Copyright (C) 1987-90,92-99 Free Software Foundation, Inc. +;; Copyright (C) 1987, 1988, 1989, 1990, 1992, 1993, 1994, 1995, 1996, +;; 1997, 1998, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -334,17 +336,23 @@ noticing asynchronous data.") (save-excursion (set-buffer (process-buffer process)) (erase-buffer))) - (when command - (nntp-send-string process command)) - (cond - ((eq callback 'ignore) - t) - ((and callback wait-for) - (nntp-async-wait process wait-for buffer decode callback) - t) - (wait-for - (nntp-wait-for process wait-for buffer decode)) - (t t))))) + (condition-case err + (progn + (when command + (nntp-send-string process command)) + (cond + ((eq callback 'ignore) + t) + ((and callback wait-for) + (nntp-async-wait process wait-for buffer decode callback) + t) + (wait-for + (nntp-wait-for process wait-for buffer decode)) + (t t))) + (error + (nnheader-report 'nntp "Couldn't open connection to %s: %s" + address err)) + (quit nil))))) (defsubst nntp-send-command (wait-for &rest strings) "Send STRINGS to server and wait until WAIT-FOR returns." @@ -775,7 +783,7 @@ and a password. If SEND-IF-FORCE, only send authinfo to the server if the .authinfo file has the FORCE token." (let* ((list (gnus-parse-netrc nntp-authinfo-file)) - (alist (gnus-netrc-machine list nntp-address)) + (alist (gnus-netrc-machine list nntp-address "nntp")) (force (gnus-netrc-get alist "force")) (user (or (gnus-netrc-get alist "login") nntp-authinfo-user)) (passwd (gnus-netrc-get alist "password"))) diff --git a/lisp/nnultimate.el b/lisp/nnultimate.el index d30c1a8..bf8fcb9 100644 --- a/lisp/nnultimate.el +++ b/lisp/nnultimate.el @@ -1,5 +1,5 @@ ;;; nnultimate.el --- interfacing with the Ultimate Bulletin Board system -;; Copyright (C) 1999 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -82,7 +82,8 @@ (while (and (setq article (car articles)) map) (while (and map - (> article (caar map))) + (or (> article (caar map)) + (< (cadar map) (caar map)))) (pop map)) (when (setq mmap (car map)) (setq farticle -1) @@ -124,7 +125,8 @@ "-" (number-to-string current-page) (match-string 0 href)))) (goto-char (point-min)) - (setq contents (w3-parse-buffer (current-buffer))) + (setq contents + (ignore-errors (w3-parse-buffer (current-buffer)))) (setq table (nnultimate-find-forum-table contents)) (setq string (mapconcat 'identity (nnweb-text table) "")) (when (string-match "topic is \\([0-9]\\) pages" string) @@ -337,25 +339,26 @@ (setq art (1+ (string-to-number (car artlist))))) (pop artlist)) (setq garticles art)) - (string-match "/\\([0-9]+\\).html" href) - (setq topic (string-to-number (match-string 1 href))) - (if (setq tinfo (assq topic topics)) - (progn - (setq old-max (cadr tinfo)) - (setcar (cdr tinfo) garticles)) - (setq old-max 0) - (push (list topic garticles subject href) topics) - (setcar (nthcdr 4 entry) topics)) - (when (not (= old-max garticles)) - (setq inc (- garticles old-max)) - (setq mapping (nconc mapping - (list - (list - old-total (1- (incf old-total inc)) - topic (1+ old-max))))) - (incf old-max inc) - (setcar (nthcdr 5 entry) mapping) - (setcar (nthcdr 6 entry) old-total))))) + (when garticles + (string-match "/\\([0-9]+\\).html" href) + (setq topic (string-to-number (match-string 1 href))) + (if (setq tinfo (assq topic topics)) + (progn + (setq old-max (cadr tinfo)) + (setcar (cdr tinfo) garticles)) + (setq old-max 0) + (push (list topic garticles subject href) topics) + (setcar (nthcdr 4 entry) topics)) + (when (not (= old-max garticles)) + (setq inc (- garticles old-max)) + (setq mapping (nconc mapping + (list + (list + old-total (1- (incf old-total inc)) + topic (1+ old-max))))) + (incf old-max inc) + (setcar (nthcdr 5 entry) mapping) + (setcar (nthcdr 6 entry) old-total)))))) (setcar (nthcdr 7 entry) current-time) (setcar (nthcdr 1 entry) (1- old-total)) (nnultimate-write-groups) diff --git a/lisp/nnvirtual.el b/lisp/nnvirtual.el index 11eb1b6..b1d0093 100644 --- a/lisp/nnvirtual.el +++ b/lisp/nnvirtual.el @@ -1,5 +1,6 @@ ;;; nnvirtual.el --- virtual newsgroups access for Gnus -;; Copyright (C) 1994,95,96,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: David Moore ;; Lars Magne Ingebrigtsen diff --git a/lisp/nnwarchive.el b/lisp/nnwarchive.el index 4057db5..f888a62 100644 --- a/lisp/nnwarchive.el +++ b/lisp/nnwarchive.el @@ -1,5 +1,5 @@ ;;; nnwarchive.el --- interfacing with web archives -;; Copyright (C) 1999 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu ;; Keywords: news egroups mail-archive @@ -61,20 +61,20 @@ '((egroups (address . "www.egroups.com") (open-url - "http://www.egroups.com/register?method=loginAction&email=%s&password=%s" + "http://www.egroups.com/login.cgi?&login_email=%s&login_password=%s" nnwarchive-login nnwarchive-passwd) (list-url - "http://www.egroups.com/UserGroupsPage?") + "http://www.egroups.com/mygroups") (list-dissect . nnwarchive-egroups-list) (list-groups . nnwarchive-egroups-list-groups) (xover-url - "http://www.egroups.com/group/%s/?fetchForward=1&start=%d" group aux) + "http://www.egroups.com/message/%s/%d" group aux) (xover-last-url - "http://www.egroups.com/group/%s/?fetchForward=1" group) + "http://www.egroups.com/message/%s/" group) (xover-page-size . 13) (xover-dissect . nnwarchive-egroups-xover) (article-url - "http://www.egroups.com/group/%s/%d.html?raw=1" group article) + "http://www.egroups.com/message/%s/%d?source=1" group article) (article-dissect . nnwarchive-egroups-article) (authentication . t) (article-offset . 0) @@ -287,31 +287,29 @@ t) (deffoo nnwarchive-open-server (server &optional defs connectionless) + (nnoo-change-server 'nnwarchive server defs) (nnwarchive-init server) - (if (nnwarchive-server-opened server) - t - (nnoo-change-server 'nnwarchive server defs) - (when nnwarchive-authentication - (setq nnwarchive-login - (or nnwarchive-login - (read-string + (when nnwarchive-authentication + (setq nnwarchive-login + (or nnwarchive-login + (read-string (format "Login at %s: " server) user-mail-address))) - (setq nnwarchive-passwd - (or nnwarchive-passwd - (mail-source-read-passwd - (format "Password for %s at %s: " - nnwarchive-login server))))) - (unless nnwarchive-groups - (nnwarchive-read-groups)) - (save-excursion - (set-buffer nnwarchive-buffer) - (erase-buffer) - (if nnwarchive-open-url - (nnwarchive-url nnwarchive-open-url)) - (if nnwarchive-open-dissect - (funcall nnwarchive-open-dissect))) - t)) + (setq nnwarchive-passwd + (or nnwarchive-passwd + (mail-source-read-passwd + (format "Password for %s at %s: " + nnwarchive-login server))))) + (unless nnwarchive-groups + (nnwarchive-read-groups)) + (save-excursion + (set-buffer nnwarchive-buffer) + (erase-buffer) + (if nnwarchive-open-url + (nnwarchive-url nnwarchive-open-url)) + (if nnwarchive-open-dissect + (funcall nnwarchive-open-dissect))) + t) (nnoo-define-skeleton nnwarchive) @@ -389,14 +387,16 @@ expr))) (defun nnwarchive-url (xurl) - (let ((url-confirmation-func 'identity)) - (cond - ((eq (car xurl) 'post) - (pop xurl) - (nnwarchive-fetch-form (car xurl) (nnwarchive-eval (cdr xurl)))) - (t - (nnweb-insert (apply 'format (nnwarchive-eval xurl))))))) - + (mm-with-unibyte-current-buffer + (let ((url-confirmation-func 'identity) + (url-cookie-multiple-line nil)) + (cond + ((eq (car xurl) 'post) + (pop xurl) + (nnwarchive-fetch-form (car xurl) (nnwarchive-eval (cdr xurl)))) + (t + (nnweb-insert (apply 'format (nnwarchive-eval xurl)))))))) + (defun nnwarchive-generate-active () (save-excursion (set-buffer nntp-server-buffer) @@ -424,7 +424,7 @@ (erase-buffer) (nnwarchive-url nnwarchive-xover-last-url) (goto-char (point-min)) - (when (re-search-forward "of \\([0-9]+\\)" nil t) + (when (re-search-forward "of \\([0-9]+\\)[ \t\n\r]*" nil t) (setq articles (string-to-number (match-string 1)))) (let ((elem (assoc group nnwarchive-groups))) (if elem @@ -442,16 +442,11 @@ group description elem articles) (goto-char (point-min)) (while - (re-search-forward - "/group/\\([^/]+\\)/info\\.html[^>]+>[^>]+>[\040\t]*-[\040\t]*\\([^<]+\\)<" - nil t) + (re-search-forward "href=\"/group/\\([^/\"\> ]+\\)" nil t) (setq group (match-string 1) description (match-string 2)) - (forward-line 1) - (when (re-search-forward ">\\([0-9]+\\)<" nil t) - (setq articles (string-to-number (match-string 1)))) (if (setq elem (assoc group nnwarchive-groups)) - (setcar (cdr elem) articles) + (setcar (cdr elem) 0) (push (list group articles description) nnwarchive-groups)))) t) @@ -459,7 +454,7 @@ (let (article subject from date) (goto-char (point-min)) (while (re-search-forward - "]+>\\([^<]+\\)<" + "]+>\\([^<]+\\)<" nil t) (setq group (match-string 1) article (string-to-number (match-string 2)) @@ -494,7 +489,7 @@ (delete-region (point) (point-max))) (goto-char (point-min)) (while (re-search-forward "]+>\\([^<]+\\)" nil t) - (replace-match "<\\1>")) + (replace-match "\\1")) (nnweb-decode-entities) (buffer-string)) diff --git a/lisp/nnweb.el b/lisp/nnweb.el index 5a56941..bb4cac9 100644 --- a/lisp/nnweb.el +++ b/lisp/nnweb.el @@ -1,5 +1,6 @@ ;;; nnweb.el --- retrieving articles via web search engines -;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -121,7 +122,6 @@ and `altavista'.") (deffoo nnweb-request-scan (&optional group server) (nnweb-possibly-change-server group server) - (setq nnweb-hashtb (gnus-make-hashtable 4095)) (funcall (nnweb-definition 'map)) (unless nnweb-ephemeral-p (nnweb-write-active) @@ -139,8 +139,6 @@ and `altavista'.") (setq nnweb-search (nth 3 info)) (unless dont-check (nnweb-read-overview group))))) - (unless dont-check - (nnweb-request-scan group)) (cond ((not nnweb-articles) (nnheader-report 'nnweb "No matching articles")) @@ -293,6 +291,7 @@ and `altavista'.") (when group (when (and (not nnweb-ephemeral-p) (not (equal group nnweb-group))) + (setq nnweb-hashtb (gnus-make-hashtable 4095)) (nnweb-request-group group nil t)))) (defun nnweb-init (server) @@ -393,6 +392,8 @@ and `altavista'.") (setq date "Jan 1 00:00:00 0000")) (incf i) (setq url (concat url "&fmt=text")) + (when (string-match "&context=[^&]+" url) + (setq url (replace-match "" t t url))) (unless (nnweb-get-hashtb url) (push (list @@ -722,7 +723,10 @@ and `altavista'.") (while (re-search-forward "&\\(#[0-9]+\\|[a-z]+\\);" nil t) (replace-match (char-to-string (if (eq (aref (match-string 1) 0) ?\#) - (string-to-number (substring (match-string 1) 1)) + (let ((c + (string-to-number (substring + (match-string 1) 1)))) + (if (mm-char-or-char-int-p c) c 32)) (or (cdr (assq (intern (match-string 1)) w3-html-entities)) ?#))) @@ -754,14 +758,11 @@ If FOLLOW-REFRESH is non-nil, redirect refresh url in META." (narrow-to-region (point) (point)) (url-insert-file-contents url) (goto-char (point-min)) - (while (re-search-forward - "HTTP-EQUIV=\"Refresh\"[^>]*URL=\\([^\"]+\\)\"" - nil t) + (when (re-search-forward + "HTTP-EQUIV=\"Refresh\"[^>]*URL=\\([^\"]+\\)\"" nil t) (let ((url (match-string 1))) (delete-region (point-min) (point-max)) - (nnweb-insert url)) - (goto-char (point-min))) - (goto-char (point-max))) + (nnweb-insert url t)))) (url-insert-file-contents url)) (setq buffer-file-name name))) diff --git a/lisp/parse-time.el b/lisp/parse-time.el index 11e4682..06e35d3 100644 --- a/lisp/parse-time.el +++ b/lisp/parse-time.el @@ -1,6 +1,6 @@ ;;; parse-time.el --- Parsing time strings -;; Copyright (C) 1996 by Free Software Foundation, Inc. +;; Copyright (C) 1996,2000 by Free Software Foundation, Inc. ;; Author: Erik Naggum ;; Keywords: util @@ -167,7 +167,7 @@ (= (length elt) 7) (= (aref elt 1) ?:))) [0 1] [2 4] [5 7]) - ((5) (50 99) ,#'(lambda () (+ 1900 elt))) + ((5) (50 110) ,#'(lambda () (+ 1900 elt))) ((5) (0 49) ,#'(lambda () (+ 2000 elt)))) "(slots predicate extractor...)") diff --git a/lisp/pop3.el b/lisp/pop3.el index 3acd1a7..d3f0ffb 100644 --- a/lisp/pop3.el +++ b/lisp/pop3.el @@ -1,10 +1,12 @@ ;;; pop3.el --- Post Office Protocol (RFC 1460) interface -;; Copyright (C) 1996-1999 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Richard L. Pieri -;; Daiki Ueno -;; Keywords: mail, pop3 +;; Daiki Ueno +;; Maintainer: FSF +;; Keywords: mail ;; Version: 1.3s ;; This file is part of GNU Emacs. @@ -150,8 +152,7 @@ Nil means no, t means yes, not-nil-or-t means yet to be determined.") (dolist (n retrieved-messages) (message "Deleting message %d of %d from %s..." n message-count pop3-mailhost) - (pop3-dele process n))) - ) + (pop3-dele process n)))) (pop3-quit process)) (kill-buffer crashbuf) message-count)) @@ -263,15 +264,15 @@ Args are NAME BUFFER HOST SERVICE." (insert output))) (defun pop3-send-command (process command) - (set-buffer (process-buffer process)) - (goto-char (point-max)) - ;; (if (= (aref command 0) ?P) - ;; (insert "PASS \r\n") - ;; (insert command "\r\n")) - (setq pop3-read-point (point)) - (goto-char (point-max)) - (process-send-string process (concat command "\r\n")) - ) + (set-buffer (process-buffer process)) + (goto-char (point-max)) +;; (if (= (aref command 0) ?P) +;; (insert "PASS \r\n") +;; (insert command "\r\n")) + (setq pop3-read-point (point)) + (goto-char (point-max)) + (process-send-string process (concat command "\r\n")) + ) (defun pop3-read-response (process &optional return) "Read the response from the server PROCESS. @@ -287,7 +288,7 @@ Return the response string if optional second argument RETURN is non-nil." (setq match-end (point)) (goto-char pop3-read-point) (if (looking-at "-ERR") - (signal 'error (list (buffer-substring (point) (- match-end 2)))) + (error (buffer-substring (point) (- match-end 2))) (if (not (looking-at "+OK")) (progn (setq pop3-read-point match-end) nil) (setq pop3-read-point match-end) @@ -301,8 +302,10 @@ Return the response string if optional second argument RETURN is non-nil." (if (not pop3-read-passwd) (if (or (fboundp 'read-passwd) (load "passwd" t)) (setq pop3-read-passwd 'read-passwd) - (autoload 'ange-ftp-read-passwd "ange-ftp") - (setq pop3-read-passwd 'ange-ftp-read-passwd))) + (if (load "passwd" t) + (setq pop3-read-passwd 'read-passwd) + (autoload 'ange-ftp-read-passwd "ange-ftp") + (setq pop3-read-passwd 'ange-ftp-read-passwd)))) (funcall pop3-read-passwd prompt)) (defun pop3-clean-region (start end) @@ -333,7 +336,9 @@ Return the response string if optional second argument RETURN is non-nil." (looking-at "BABYL OPTIONS:") ; Babyl )) (let ((from (mail-strip-quoted-names (mail-fetch-field "From"))) - (date (mail-fetch-field "Date")) + (date (split-string (or (mail-fetch-field "Date") + (message-make-date)) + " ")) (From_)) ;; sample date formats I have seen ;; Date: Tue, 9 Jul 1996 09:04:21 -0400 (EDT) @@ -460,11 +465,16 @@ Return the response string if optional second argument RETURN is non-nil." (defun pop3-apop (process user) "Send alternate authentication information to the server." - (let ((hash (md5 (concat pop3-timestamp pop3-password)))) - (pop3-send-command process (format "APOP %s %s" user hash)) - (let ((response (pop3-read-response process t))) - (if (not (and response (string-match "+OK" response))) - (pop3-quit process))))) + (let ((pass pop3-password)) + (if (and pop3-password-required (not pass)) + (setq pass + (pop3-read-passwd (format "Password for %s: " pop3-maildrop)))) + (if pass + (let ((hash (pop3-md5 (concat pop3-timestamp pass)))) + (pop3-send-command process (format "APOP %s %s" user hash)) + (let ((response (pop3-read-response process t))) + (if (not (and response (string-match "+OK" response))) + (pop3-quit process))))))) (defun pop3-stls (process) "Query whether TLS extension is supported" @@ -475,23 +485,66 @@ Return the response string if optional second argument RETURN is non-nil." ;; TRANSACTION STATE +(defvar pop3-md5-program "md5" + "*Program to encode its input in MD5.") + +(defun pop3-md5 (string) + (with-temp-buffer + (insert string) + (call-process-region (point-min) (point-max) + (or shell-file-name "/bin/sh") + t (current-buffer) nil + "-c" pop3-md5-program) + ;; The meaningful output is the first 32 characters. + ;; Don't return the newline that follows them! + (buffer-substring (point-min) (+ (point-min) 32)))) + (defun pop3-stat (process) "Return the number of messages in the maildrop and the maildrop's size." (pop3-send-command process "STAT") (let ((response (pop3-read-response process t))) - (list (string-to-int (nth 1 (split-string response))) - (string-to-int (nth 2 (split-string response)))) - )) + (list (string-to-int (nth 1 (split-string response " "))) + (string-to-int (nth 2 (split-string response " ")))))) (defun pop3-retr (process msg crashbuf) "Retrieve message-id MSG to buffer CRASHBUF." (pop3-send-command process (format "RETR %s" msg)) (pop3-read-response process) - (save-excursion - (let ((region (pop3-get-extended-response process))) - (pop3-munge-message-separator (car region) (cadr region)) - (append-to-buffer crashbuf (car region) (cadr region)) - (delete-region (car region) (cadr region)) + (let ((start pop3-read-point) end) + (save-excursion + (set-buffer (process-buffer process)) + (while (not (re-search-forward "^\\.\r\n" nil t)) + (accept-process-output process 3) + ;; bill@att.com ... to save wear and tear on the heap + ;; uncommented because the condensed version below is a problem for + ;; some. + (if (> (buffer-size) 20000) (sleep-for 1)) + (if (> (buffer-size) 50000) (sleep-for 1)) + (if (> (buffer-size) 100000) (sleep-for 1)) + (if (> (buffer-size) 200000) (sleep-for 1)) + (if (> (buffer-size) 500000) (sleep-for 1)) + ;; bill@att.com + ;; condensed into: + ;; (sometimes causes problems for really large messages.) +; (if (> (buffer-size) 20000) (sleep-for (/ (buffer-size) 20000))) + (goto-char start)) + (setq pop3-read-point (point-marker)) +;; this code does not seem to work for some POP servers... +;; and I cannot figure out why not. +; (goto-char (match-beginning 0)) +; (backward-char 2) +; (if (not (looking-at "\r\n")) +; (insert "\r\n")) +; (re-search-forward "\\.\r\n") + (goto-char (match-beginning 0)) + (setq end (point-marker)) + (pop3-clean-region start end) + (pop3-munge-message-separator start end) + (save-excursion + (set-buffer crashbuf) + (erase-buffer)) + (copy-to-buffer crashbuf start end) + (delete-region start end) ))) (defun pop3-dele (process msg) @@ -508,7 +561,7 @@ Return the response string if optional second argument RETURN is non-nil." "Return highest accessed message-id number for the session." (pop3-send-command process "LAST") (let ((response (pop3-read-response process t))) - (string-to-int (nth 1 (split-string response))) + (string-to-int (nth 1 (split-string response " "))) )) (defun pop3-rset (process) diff --git a/lisp/qp.el b/lisp/qp.el index 8643104..93c3f7e 100644 --- a/lisp/qp.el +++ b/lisp/qp.el @@ -1,5 +1,5 @@ ;;; qp.el --- Quoted-Printable functions -;; Copyright (C) 1998,99 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; This file is part of GNU Emacs. @@ -23,46 +23,63 @@ ;;; Code: +(require 'mm-util) + (defvar quoted-printable-encoding-characters (mapcar 'identity "0123456789ABCDEFabcdef")) -(defun quoted-printable-decode-region (from to) - "Decode quoted-printable in the region between FROM and TO." +(defun quoted-printable-decode-region (from to &optional charset) + "Decode quoted-printable in the region between FROM and TO. +If CHARSET is non-nil, decode the region with charset." (interactive "r") (save-excursion - (goto-char from) - (while (search-forward "=" to t) - (cond - ;; End of the line. - ((eq (char-after) ?\n) - (delete-char -1) - (delete-char 1)) - ;; Encoded character. - ((and - (memq (char-after) quoted-printable-encoding-characters) - (memq (char-after (1+ (point))) - quoted-printable-encoding-characters)) - (subst-char-in-region - (1- (point)) (point) ?= - (string-to-number - (buffer-substring (point) (+ 2 (point))) - 16)) - (delete-char 2)) - ;; Quoted equal sign. - ((eq (char-after) ?=) - (delete-char 1)) - ;; End of buffer. - ((eobp) - (delete-char -1)) - ;; Invalid. - (t - (message "Malformed MIME quoted-printable message")))))) - -(defun quoted-printable-decode-string (string) - "Decode the quoted-printable-encoded STRING and return the results." + (save-restriction + (let (start) + (narrow-to-region from to) + (goto-char from) + (while (not (eobp)) + (cond + ((eq (char-after) ?=) + (delete-char 1) + (unless start + (setq start (point))) + (cond + ;; End of the line. + ((eq (char-after) ?\n) + (delete-char 1)) + ;; Encoded character. + ((and + (memq (char-after) quoted-printable-encoding-characters) + (memq (char-after (1+ (point))) + quoted-printable-encoding-characters)) + (insert + (string-to-number + (buffer-substring (point) (+ 2 (point))) + 16)) + (delete-char 2)) + ;; Quoted equal sign. + ((eq (char-after) ?=) + (forward-char 1)) + ;; End of buffer. + ((eobp)) + ;; Invalid. + (t + (message "Malformed MIME quoted-printable message")))) + ((and charset start (not (eq (mm-charset-after) 'ascii))) + (mm-decode-coding-region start (point) charset) + (setq start nil) + (forward-char 1)) + (t + (forward-char 1)))) + (if (and charset start) + (mm-decode-coding-region start (point) charset)))))) + +(defun quoted-printable-decode-string (string &optional charset) + "Decode the quoted-printable-encoded STRING and return the results. +If CHARSET is non-nil, decode the region with charset." (with-temp-buffer (insert string) - (quoted-printable-decode-region (point-min) (point-max)) + (quoted-printable-decode-region (point-min) (point-max) charset) (buffer-string))) (defun quoted-printable-encode-region (from to &optional fold class) diff --git a/lisp/rfc1843.el b/lisp/rfc1843.el index 8ccd601..d9eba67 100644 --- a/lisp/rfc1843.el +++ b/lisp/rfc1843.el @@ -1,5 +1,5 @@ ;;; rfc1843.el --- HZ (rfc1843) decoding -;; Copyright (c) 1998,99 Free Software Foundation, Inc. +;; Copyright (c) 1998, 1999, 2000 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu ;; Keywords: news HZ HZ+ diff --git a/lisp/rfc2047.el b/lisp/rfc2047.el index 74705da..8875891 100644 --- a/lisp/rfc2047.el +++ b/lisp/rfc2047.el @@ -1,5 +1,5 @@ ;;; rfc2047.el --- Functions for encoding and decoding rfc2047 messages -;; Copyright (C) 1998,99 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko @@ -46,7 +46,7 @@ The values can be: 1) nil, in which case no encoding is done; 2) `mime', in which case the header will be encoded according to RFC2047; -3) a charset, in which case it will be encoded as that charse; +3) a charset, in which case it will be encoded as that charset; 4) `default', in which case the field will be encoded as the rest of the article.") @@ -105,33 +105,31 @@ Valid encodings are nil, `Q' and `B'.") "Encode the message header according to `rfc2047-header-encoding-alist'. Should be called narrowed to the head of the message." (interactive "*") - (when (featurep 'mule) - (save-excursion - (goto-char (point-min)) - (let ((alist rfc2047-header-encoding-alist) - elem method) - (while (not (eobp)) - (save-restriction - (rfc2047-narrow-to-field) - (when (rfc2047-encodable-p) - ;; We found something that may perhaps be encoded. - (while (setq elem (pop alist)) - (when (or (and (stringp (car elem)) - (looking-at (car elem))) - (eq (car elem) t)) - (setq alist nil - method (cdr elem)))) - (when method - (cond - ((eq method 'mime) - (rfc2047-encode-region (point-min) (point-max)) - (rfc2047-fold-region (point-min) (point-max))) - ;; Hm. - (t)))) - (goto-char (point-max))))) - (when mail-parse-charset - (encode-coding-region (point-min) (point-max) - mail-parse-charset))))) + (save-excursion + (goto-char (point-min)) + (let ((alist rfc2047-header-encoding-alist) + elem method) + (while (not (eobp)) + (save-restriction + (rfc2047-narrow-to-field) + (when (rfc2047-encodable-p) + ;; We found something that may perhaps be encoded. + (while (setq elem (pop alist)) + (when (or (and (stringp (car elem)) + (looking-at (car elem))) + (eq (car elem) t)) + (setq alist nil + method (cdr elem)))) + (cond + ((eq method 'mime) + (rfc2047-encode-region (point-min) (point-max)) + (rfc2047-fold-region (point-min) (point-max))) + ;; Hm. + (t))) + (goto-char (point-max))))) + (when mail-parse-charset + (encode-coding-region + (point-min) (point-max) mail-parse-charset)))) (defun rfc2047-encodable-p (&optional header) "Say whether the current (narrowed) buffer contains characters that need encoding in headers." @@ -268,7 +266,8 @@ Should be called narrowed to the head of the message." ((and (not break) (looking-at "=\\?")) (setq break (point))) - ((and (looking-at "\\?=") + ((and break + (looking-at "\\?=") (> (- (point) (save-excursion (beginning-of-line) (point))) 76)) (goto-char break) (setq break nil) diff --git a/lisp/smiley.el b/lisp/smiley.el index 9caaa22..7ea99a5 100644 --- a/lisp/smiley.el +++ b/lisp/smiley.el @@ -1,5 +1,6 @@ ;;; smiley.el --- displaying smiley faces -;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Wes Hardaker ;; Keywords: fun diff --git a/lisp/time-date.el b/lisp/time-date.el index c40ddbe..ba7f81a 100644 --- a/lisp/time-date.el +++ b/lisp/time-date.el @@ -1,8 +1,10 @@ ;;; time-date.el --- Date and time handling functions -;; Copyright (C) 1998,99 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Masanobu Umeda +;; Keywords: mail news util + ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify @@ -26,6 +28,7 @@ (require 'parse-time) +;;;###autoload (defun date-to-time (date) "Convert DATE into time." (condition-case () @@ -36,7 +39,7 @@ "Convert TIME to a floating point number." (+ (* (car time) 65536.0) (cadr time) - (/ (or (caddr time) 0) 1000000.0))) + (/ (or (nth 2 time) 0) 1000000.0))) (defun seconds-to-time (seconds) "Convert SECONDS (a floating point number) to an Emacs time structure." @@ -116,6 +119,7 @@ The Gregorian date Sunday, December 31, 1bce is imaginary." (- (/ (1- year) 100)) ; - century years (/ (1- year) 400)))) ; + Gregorian leap years +;;;###autoload (defun safe-date-to-time (date) "Parse DATE and return a time structure. If DATE is malformed, a zero time will be returned." diff --git a/lisp/webmail.el b/lisp/webmail.el index 1b9b9c4..78b518c 100644 --- a/lisp/webmail.el +++ b/lisp/webmail.el @@ -1,8 +1,8 @@ ;;; webmail.el --- interfacing with web mail -;; Copyright (C) 1999 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu -;; Keywords: hotmail yahoo netaddress my-deja +;; Keywords: hotmail netaddress my-deja netscape ;; This file is part of GNU Emacs. @@ -74,10 +74,12 @@ (login-url "http://%s/cgi-bin/dologin?login=%s&passwd=%s&enter=Sign+in&sec=no&curmbox=ACTIVE&_lang=&js=yes&id=2&tw=-10000&beta=" webmail-aux user password) + (login-snarf . webmail-hotmail-login) + (list-url "%s" webmail-aux) (list-snarf . webmail-hotmail-list) (article-snarf . webmail-hotmail-article) (trash-url - "%s&login=%s&f=33792&curmbox=ACTIVE&_lang=&js=&foo=inbox&page=&%s=on&Move+To.x=Move+To&tobox=trAsH" + "%s&login=%s&f=33792&curmbox=ACTIVE&_lang=&foo=inbox&js=&page=&%s=on&_HMaction=MoveTo&tobox=trAsH&nullbox=" webmail-aux user id)) (yahoo (paranoid cookie post) @@ -111,10 +113,31 @@ "http://www.netaddress.com/tpl/Mail/%s/List?FolderID=-4&SortUseCase=True" webmail-session) (list-snarf . webmail-netaddress-list) + (article-url "http://www.netaddress.com/") (article-snarf . webmail-netaddress-article) (trash-url "http://www.netaddress.com/tpl/Message/%s/Move?FolderID=-4&Q=%s&N=&Sort=Date&F=-1" webmail-session id)) + (netscape + (paranoid cookie post agent) + (address . "webmail.netscape.com") + (open-url "http://ureg.netscape.com/iiop/UReg2/login/login?U2_LA=en&U2_BACK_FROM_CJ=true&U2_CS=iso-8859-1&U2_ENDURL=http://webmail.netscape.com/tpl/Subscribe/Step1&U2_NEW_ENDURL=http://webmail.netscape.com/tpl/Subscribe/Step1&U2_EXITURL=http://home.netscape.com/&U2_SOURCE=Webmail") + (open-snarf . webmail-netscape-open) + (login-url + content + ("http://ureg.netscape.com/iiop/UReg2/login/loginform") + "%s&U2_USERNAME=%s&U2_PASSWORD=%s" + webmail-aux user password) + (login-snarf . webmail-netaddress-login) + (list-url + "http://webmail.netscape.com/tpl/Mail/%s/List?FolderID=-4&SortUseCase=True" + webmail-session) + (list-snarf . webmail-netaddress-list) + (article-url "http://webmail.netscape.com/") + (article-snarf . webmail-netscape-article) + (trash-url + "http://webmail.netscape.com/tpl/Message/%s/Move?FolderID=-4&Q=%s&N=&Sort=Date&F=-1" + webmail-session id)) (my-deja (paranoid cookie post) (address . "www.my-deja.com") @@ -123,7 +146,7 @@ (login-url content ("%s" webmail-aux) - "user=%s&pw=%s&autologout=60&go=" + "member_name=%s&pw=%s&go=&priv_opt_MyDeja99=" user password) (list-url "http://www.deja.com/rg_gotomail.xp") (list-snarf . webmail-my-deja-list) @@ -168,9 +191,27 @@ (defvar webmail-type nil) +(defvar webmail-error-function nil) + +(defvar webmail-debug-file "~/.emacs-webmail-debug") + ;;; Interface functions +(defun webmail-debug (str) + (with-temp-buffer + (insert "\n---------------- A bug at " str " ------------------\n") + (mapcar #'(lambda (sym) + (if (boundp sym) + (pp `(setq ,sym ',(eval sym)) (current-buffer)))) + '(webmail-type user)) + (insert "---------------- webmail buffer ------------------\n\n") + (insert-buffer-substring webmail-buffer) + (insert "\n---------------- end of buffer ------------------\n\n") + (append-to-file (point-min) (point-max) webmail-debug-file))) + (defun webmail-error (str) + (if webmail-error-function + (funcall webmail-error-function str)) (message "%s HTML has changed; please get a new version of webmail (%s)" webmail-type str) (error "%s HTML has changed; please get a new version of webmail (%s)" @@ -353,15 +394,28 @@ (setq webmail-aux (match-string 1)) (webmail-error "open@1"))) +(defun webmail-hotmail-login () + (let (site) + (goto-char (point-min)) + (if (re-search-forward + "https?://\\([^/]+hotmail\\.msn\\.com\\)/cgi-bin/" nil t) + (setq site (match-string 1)) + (webmail-error "login@1")) + (goto-char (point-min)) + (if (re-search-forward + "\\(/cgi-bin/HoTMaiL\\?[^\"]*curmbox=ACTIVE[^\"]*\\)" nil t) + (setq webmail-aux (concat "http://" site (match-string 1))) + (webmail-error "login@2")))) + (defun webmail-hotmail-list () (let (site url newp) (goto-char (point-min)) - (if (re-search-forward "[0-9]+ messages, [0-9]+ new" nil t) + (if (re-search-forward "[0-9]+ new" nil t) (message "Found %s" (match-string 0)) (webmail-error "maybe your w3 version is too old")) (goto-char (point-min)) (if (re-search-forward - "action=\"https?://\\([^/]+\\)/cgi-bin/HoTMaiL" nil t) + "https?://\\([^/]+hotmail\\.msn\\.com\\)/cgi-bin/" nil t) (setq site (match-string 1)) (webmail-error "list@1")) (goto-char (point-min)) @@ -644,6 +698,12 @@ ;;; netaddress +(defun webmail-netscape-open () + (goto-char (point-min)) + (if (re-search-forward "login/hint\\?\\([^\"]+\\)\"" nil t) + (setq webmail-aux (match-string 1)) + (webmail-error "open@1"))) + (defun webmail-netaddress-open () (goto-char (point-min)) (if (re-search-forward "action=\"\\([^\"]+\\)\"" nil t) @@ -671,7 +731,7 @@ (setq item (cons id (format "%s/tpl/Message/%s/Read?Q=%s&FolderID=-4&SortUseCase=True&Sort=Date&Headers=True" - (car webmail-open-url) + (car webmail-article-url) webmail-session id))) (if (or (not webmail-newmail-only) (equal (match-string 1) "True")) @@ -788,7 +848,132 @@ ;; Some blank line to seperate mails. (insert "\n\nFrom nobody " (current-time-string) "\n") (if id - (insert (format "Message-ID: <%s@usa.net>\n" id))) + (insert (format "Message-ID: <%s@%s>\n" id webmail-address))) + (unless (looking-at "$") + (if (search-forward "\n\n" nil t) + (forward-line -1) + (webmail-error "article@2"))) + (when mime + (narrow-to-region (point-min) (point)) + (goto-char (point-min)) + (while (not (eobp)) + (if (looking-at "MIME-Version\\|Content-Type") + (delete-region (point) + (progn + (forward-line 1) + (if (re-search-forward "^[^ \t]" nil t) + (goto-char (match-beginning 0)) + (point-max)))) + (forward-line 1))) + (goto-char (point-max)) + (widen) + (narrow-to-region (point) (point-max)) + (insert "MIME-Version: 1.0\n" + (prog1 + (mml-generate-mime) + (delete-region (point-min) (point-max)))) + (goto-char (point-min)) + (widen)) + (let (case-fold-search) + (while (re-search-forward "^From " nil t) + (beginning-of-line) + (insert ">")))) + (mm-append-to-file (point-min) (point-max) file))) + +(defun webmail-netscape-article (file id) + (let (p p1 attachment count mime type) + (save-restriction + (webmail-encode-8bit) + (goto-char (point-min)) + (if (not (search-forward "Trash" nil t)) + (webmail-error "article@1")) + (if (not (search-forward "
" nil t)) + (webmail-error "article@2")) + (delete-region (point-min) (match-beginning 0)) + (if (not (search-forward "
" nil t)) + (webmail-error "article@3")) + (narrow-to-region (point-min) (match-end 0)) + (goto-char (point-min)) + (while (re-search-forward "[\040\t\r\n]+" nil t) + (replace-match " ")) + (goto-char (point-min)) + (while (re-search-forward "]*>[^<]*" nil t) + (replace-match "")) + (goto-char (point-min)) + (while (search-forward "" nil t) + (replace-match "\n")) + (nnweb-remove-markup) + (nnweb-decode-entities) + (goto-char (point-min)) + (delete-blank-lines) + (goto-char (point-min)) + (while (re-search-forward "^\040+\\|\040+$" nil t) + (replace-match "")) + (goto-char (point-min)) + (while (re-search-forward "\040+" nil t) + (replace-match " ")) + (goto-char (point-max)) + (widen) + (insert "\n\n") + (setq p (point)) + (unless (search-forward "" nil t) + (webmail-error "article@4")) + (forward-line 14) + (delete-region p (point)) + (goto-char (point-max)) + (unless (re-search-backward + "
" + nil t 2) + (setq mime t) + (unless (search-forward "" nil t) + (webmail-error "article@6")) + (setq p1 (point)) + (if (search-backward "" nil t) + (webmail-error "article@8")) + (delete-region p (point)) + (let (bufname);; Attachment + (save-excursion + (set-buffer (generate-new-buffer " *webmail-att*")) + (nnweb-insert (concat (car webmail-open-url) attachment)) + (push (current-buffer) webmail-buffer-list) + (setq bufname (buffer-name))) + (insert "<#part type=" type) + (insert " buffer=\"" bufname "\"") + (insert " disposition=\"inline\"") + (insert "><#/part>\n") + (setq p (point)))) + (delete-region p p1) + (narrow-to-region + p + (if (search-forward + "" + nil t) + (match-beginning 0) + (point-max))) + (webmail-netaddress-single-part) + (goto-char (point-max)) + (setq p (point)) + (widen))) + (unless mime + (narrow-to-region p (point-max)) + (setq mime (webmail-netaddress-single-part)) + (widen)) + (goto-char (point-min)) + ;; Some blank line to seperate mails. + (insert "\n\nFrom nobody " (current-time-string) "\n") + (if id + (insert (format "Message-ID: <%s@%s>\n" id webmail-address))) (unless (looking-at "$") (if (search-forward "\n\n" nil t) (forward-line -1) @@ -825,7 +1010,7 @@ (defun webmail-my-deja-open () (webmail-refresh-redirect) (goto-char (point-min)) - (if (re-search-forward "action=\"\\([^\"]+login_confirm\\.xp[^\"]+\\)\"" + (if (re-search-forward "action=\"\\([^\"]+login_confirm\\.xp[^\"]*\\)\"" nil t) (setq webmail-aux (match-string 1)) (webmail-error "open@1"))) diff --git a/make.bat b/make.bat index b203277..9e9936c 100755 --- a/make.bat +++ b/make.bat @@ -1,14 +1,14 @@ @echo off -rem Written by David Charlap - -rem There are two catches, however. The emacs.bat batch file may not exist -rem in all distributions. It is part of the Voelker build of Emacs 19.34 -rem (http://www.cs.washington.edu/homes/voelker/ntemacs.html). If the user -rem installs Gnus with some other build, he may have to replace calls to +rem Written by David Charlap (shamino@writeme.com) +rem +rem There are two possible problems with this batch file. The emacs.bat batch +rem file may not exist in all distributions. It is part of the GNU build of +rem Emacs 20.4 (http://www.gnu.org/softare/emacs/windows.ntemacs.html) If you +rem install Gnus with some other build, you may have to replace calls to rem %1\emacs.bat with something else. rem -rem Also, the emacs.bat file that Voelker ships does not accept more than 9 +rem Also, the emacs.bat file that comes with Emacs does not accept more than 9 rem parameters, so the attempts to compile the .texi files will fail. To rem fix that (at least on NT. I don't know about Win95), the following rem change should be made to emacs.bat: @@ -31,16 +31,19 @@ if "%1" == "" goto usage cd lisp call %1\bin\emacs.bat -batch -q -no-site-file -l ./dgnushack.el -f dgnushack-compile if not "%2" == "copy" goto info -copy *.el* %1\lisp +attrib -r %1\lisp\gnus\* +copy *.el* %1\lisp\gnus :info cd ..\texi -call %1\bin\emacs.bat -batch -q -no-site-file gnus.texi -l texinfmt -f texinfo-every-node-update -f texinfo-format-buffer -f save-buffer -call %1\bin\emacs.bat -batch -q -no-site-file message.texi -l texinfmt -f texinfo-every-node-update -f texinfo-format-buffer -f save-buffer +call %1\bin\emacs.bat -batch -q -no-site-file message.texi -f texinfo-every-node-update -f texinfo-format-buffer -f save-buffer +call %1\bin\emacs.bat -batch -q -no-site-file emacs-mime.texi -f texinfo-every-node-update -f texinfo-format-buffer -f save-buffer +call %1\bin\emacs.bat -batch -q -no-site-file gnus.texi -f texinfo-every-node-update -f texinfo-format-buffer -f save-buffer if not "%2" == "copy" goto done copy gnus %1\info copy gnus-?? %1\info copy message %1\info +copy emacs-mime %1\info :etc cd ..\etc @@ -54,7 +57,7 @@ goto end echo Usage: make ^ [copy] echo. echo where: ^ is the directory you installed emacs in -echo eg. d:\emacs\19.34 +echo eg. d:\emacs\20.4 echo copy indicates that the compiled files should be copied to your echo emacs lisp, info, and etc directories diff --git a/texi/ChangeLog b/texi/ChangeLog index 73d708c..cd81980 100644 --- a/texi/ChangeLog +++ b/texi/ChangeLog @@ -1,6 +1,75 @@ +2000-04-24 17:09:17 Felix Natter + + * gnusref.tex: New version. + + * refcard.tex: New version. + +2000-04-23 00:32:23 Lars Magne Ingebrigtsen + + * gnus.texi (Thread Commands): Add keystrokes. + (Various Summary Stuff): Addition. + +2000-04-22 21:12:25 Alan Shutko + + * Makefile.in: Add pdf support. + +2000-04-21 12:07:20 Shenghuo ZHU + + * gnus.texi (Listing Groups): Addition. + +2000-04-21 13:45:52 Pavel Janik + + * gnus.texi (Mail Source Specifiers): Example for :plugged. + +2000-04-20 20:37:48 Pavel Janik + + * gnus.texi (Limiting): Fix. + +2000-04-20 20:32:40 Dmitry Yaitskov + + * gnus.texi (Charsets): Typo fix. + +2000-03-19 Simon Josefsson + + * gnus.texi (IMAP): Addition. + +2000-03-13 17:44:59 Lars Magne Ingebrigtsen + + * gnus.texi (Process/Prefix): Addition. + +2000-02-04 Simon Josefsson + + * gnus.texi (IMAP): Fix. + +2000-01-27 18:06:35 Lars Magne Ingebrigtsen + + * gnus.texi (Remember): Addition. + +2000-01-21 Simon Josefsson + + * gnus.texi (Splitting in IMAP): Addition. + (Mail Source Specifiers): Add fetchflag setting in example. + +2000-01-08 08:10:04 Martin Bialasinski + + * gnus.texi (Mail and Post): Example. + +2000-01-08 07:46:13 Lars Magne Ingebrigtsen + + * gnus.texi (Customizing w3): New. + +2000-01-08 07:46:06 Hamish Macdonald + + * gnus.texi (Customizing w3): Example. + +2000-01-06 17:55:28 Lars Magne Ingebrigtsen + + * gnus.texi (Charsets): Addition. + 2000-01-05 15:58:48 Lars Magne Ingebrigtsen * gnus.texi (Mail Group Commands): Addition. + (Top): Added detailmenu. 2000-01-03 01:31:02 Lars Magne Ingebrigtsen diff --git a/texi/Makefile.in b/texi/Makefile.in index abb518e..5a99614 100644 --- a/texi/Makefile.in +++ b/texi/Makefile.in @@ -6,11 +6,12 @@ top_srcdir = @top_srcdir@ VPATH=$(srcdir) TEXI2DVI=texi2dvi -EMACS=emacs +TEXI2PDF=texi2pdf MAKEINFO=@MAKEINFO@ EMACSINFO=$(EMACS) -batch -q -no-site-file INFOSWI=-l texinfmt -f texinfo-every-node-update -f texinfo-format-buffer -f save-buffer XINFOSWI=-l texinfmt -f texinfo-every-node-update -f texinfo-format-buffer -f save-buffer +PDFLATEX=pdflatex LATEX=latex DVIPS=dvips PERL=perl @@ -23,7 +24,7 @@ all: gnus message emacs-mime most: texi2latex.elc latex latexps -.SUFFIXES: .texi .dvi .ps +.SUFFIXES: .texi .dvi .ps .pdf .texi: if test -x $(MAKEINFO); then \ @@ -34,15 +35,28 @@ most: texi2latex.elc latex latexps dvi: gnus.dvi message.dvi refcard.dvi emacs-mime.dvi +pdf: gnus.pdf message.pdf refcard.pdf emacs-mime.pdf + .texi.dvi : $(PERL) -n -e 'print unless (/\@iflatex/ .. /\@end iflatex/)' $< > gnustmp.texi $(TEXI2DVI) gnustmp.texi cp gnustmp.dvi $*.dvi rm gnustmp.* +.texi.pdf : + $(PERL) -n -e 'print unless (/\@iflatex/ .. /\@end iflatex/)' $< > gnustmp.texi + $(TEXI2PDF) gnustmp.texi + cp gnustmp.pdf $*.pdf + rm gnustmp.* + refcard.dvi: refcard.tex gnuslogo.refcard gnusref.tex $(LATEX) refcard.tex + +refcard.pdf: refcard.tex gnuslogo.refcard gnusref.tex + epstopdf gnuslogo.refcard --outfile=gnuslogo.refcard.pdf + $(PDFLATEX) refcard.tex + clean: rm -f gnus.*.bak *.ky *.cp *.fn *.cps *.kys *.log *.aux *.dvi *.vr \ *.tp *.toc *.pg gnus.latexi *.aux *.[cgk]idx \ diff --git a/texi/gnus.texi b/texi/gnus.texi index 5c0ac9f..366d522 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.3. +This manual corresponds to Gnus 5.8.5. @end ifinfo @@ -386,7 +386,6 @@ the program. @end iftex - @menu * Starting Up:: Finding news can be a pain. * The Group Buffer:: Selecting, subscribing and killing groups. @@ -400,6 +399,465 @@ the program. * Appendices:: Terminology, Emacs intro, FAQ, History, Internals. * Index:: Variable, function and concept index. * Key Index:: Key Index. + +@detailmenu + --- The Detailed Node Listing --- + +Starting Gnus + +* Finding the News:: Choosing a method for getting news. +* The First Time:: What does Gnus do the first time you start it? +* The Server is Down:: How can I read my mail then? +* Slave Gnusae:: You can have more than one Gnus active at a time. +* Fetching a Group:: Starting Gnus just to read a group. +* New Groups:: What is Gnus supposed to do with new groups? +* Startup Files:: Those pesky startup files---@file{.newsrc}. +* Auto Save:: Recovering from a crash. +* The Active File:: Reading the active file over a slow line Takes Time. +* Changing Servers:: You may want to move from one server to another. +* Startup Variables:: Other variables you might change. + +New Groups + +* Checking New Groups:: Determining what groups are new. +* Subscription Methods:: What Gnus should do with new groups. +* Filtering New Groups:: Making Gnus ignore certain new groups. + +The Group Buffer + +* Group Buffer Format:: Information listed and how you can change it. +* Group Maneuvering:: Commands for moving in the group buffer. +* Selecting a Group:: Actually reading news. +* Group Data:: Changing the info for a group. +* Subscription Commands:: Unsubscribing, killing, subscribing. +* Group Levels:: Levels? What are those, then? +* Group Score:: A mechanism for finding out what groups you like. +* Marking Groups:: You can mark groups for later processing. +* Foreign Groups:: Creating and editing groups. +* Group Parameters:: Each group may have different parameters set. +* Listing Groups:: Gnus can list various subsets of the groups. +* Sorting Groups:: Re-arrange the group order. +* Group Maintenance:: Maintaining a tidy @file{.newsrc} file. +* Browse Foreign Server:: You can browse a server. See what it has to offer. +* Exiting Gnus:: Stop reading news and get some work done. +* Group Topics:: A folding group mode divided into topics. +* Misc Group Stuff:: Other stuff that you can to do. + +Group Buffer Format + +* Group Line Specification:: Deciding how the group buffer is to look. +* Group Modeline Specification:: The group buffer modeline. +* Group Highlighting:: Having nice colors in the group buffer. + +Group Topics + +* Topic Variables:: How to customize the topics the Lisp Way. +* Topic Commands:: Interactive E-Z commands. +* Topic Sorting:: Sorting each topic individually. +* Topic Topology:: A map of the world. +* Topic Parameters:: Parameters that apply to all groups in a topic. + +Misc Group Stuff + +* Scanning New Messages:: Asking Gnus to see whether new messages have arrived. +* Group Information:: Information and help on groups and Gnus. +* Group Timestamp:: Making Gnus keep track of when you last read a group. +* File Commands:: Reading and writing the Gnus files. + +The Summary Buffer + +* Summary Buffer Format:: Deciding how the summary buffer is to look. +* Summary Maneuvering:: Moving around the summary buffer. +* Choosing Articles:: Reading articles. +* Paging the Article:: Scrolling the current article. +* Reply Followup and Post:: Posting articles. +* Marking Articles:: Marking articles as read, expirable, etc. +* Limiting:: You can limit the summary buffer. +* Threading:: How threads are made. +* Sorting:: How articles and threads are sorted. +* Asynchronous Fetching:: Gnus might be able to pre-fetch articles. +* Article Caching:: You may store articles in a cache. +* Persistent Articles:: Making articles expiry-resistant. +* Article Backlog:: Having already read articles hang around. +* Saving Articles:: Ways of customizing article saving. +* Decoding Articles:: Gnus can treat series of (uu)encoded articles. +* Article Treatment:: The article buffer can be mangled at will. +* MIME Commands:: Doing MIMEy things with the articles. +* Charsets:: Character set issues. +* Article Commands:: Doing various things with the article buffer. +* Summary Sorting:: Sorting the summary buffer in various ways. +* Finding the Parent:: No child support? Get the parent. +* Alternative Approaches:: Reading using non-default summaries. +* Tree Display:: A more visual display of threads. +* Mail Group Commands:: Some commands can only be used in mail groups. +* Various Summary Stuff:: What didn't fit anywhere else. +* Exiting the Summary Buffer:: Returning to the Group buffer. +* Crosspost Handling:: How crossposted articles are dealt with. +* Duplicate Suppression:: An alternative when crosspost handling fails. + +Summary Buffer Format + +* Summary Buffer Lines:: You can specify how summary lines should look. +* To From Newsgroups:: How to not display your own name. +* Summary Buffer Mode Line:: You can say how the mode line should look. +* Summary Highlighting:: Making the summary buffer all pretty and nice. + +Choosing Articles + +* Choosing Commands:: Commands for choosing articles. +* Choosing Variables:: Variables that influence these commands. + +Reply, Followup and Post + +* Summary Mail Commands:: Sending mail. +* Summary Post Commands:: Sending news. +* Summary Message Commands:: Other Message-related commands. +* Canceling and Superseding:: ``Whoops, I shouldn't have called him that.'' + +Marking Articles + +* Unread Articles:: Marks for unread articles. +* Read Articles:: Marks for read articles. +* Other Marks:: Marks that do not affect readedness. + +Marking Articles + +* Setting Marks:: How to set and remove marks. +* Generic Marking Commands:: How to customize the marking. +* Setting Process Marks:: How to mark articles for later processing. + +Threading + +* Customizing Threading:: Variables you can change to affect the threading. +* Thread Commands:: Thread based commands in the summary buffer. + +Customizing Threading + +* Loose Threads:: How Gnus gathers loose threads into bigger threads. +* Filling In Threads:: Making the threads displayed look fuller. +* More Threading:: Even more variables for fiddling with threads. +* Low-Level Threading:: You thought it was over... but you were wrong! + +Decoding Articles + +* Uuencoded Articles:: Uudecode articles. +* Shell Archives:: Unshar articles. +* PostScript Files:: Split PostScript. +* Other Files:: Plain save and binhex. +* Decoding Variables:: Variables for a happy decoding. +* Viewing Files:: You want to look at the result of the decoding? + +Decoding Variables + +* Rule Variables:: Variables that say how a file is to be viewed. +* Other Decode Variables:: Other decode variables. +* Uuencoding and Posting:: Variables for customizing uuencoding. + +Article Treatment + +* Article Highlighting:: You want to make the article look like fruit salad. +* Article Fontisizing:: Making emphasized text look nice. +* Article Hiding:: You also want to make certain info go away. +* Article Washing:: Lots of way-neat functions to make life better. +* Article Buttons:: Click on URLs, Message-IDs, addresses and the like. +* Article Date:: Grumble, UT! +* Article Signature:: What is a signature? +* Article Miscellania:: Various other stuff. + +Alternative Approaches + +* Pick and Read:: First mark articles and then read them. +* Binary Groups:: Auto-decode all articles. + +Various Summary Stuff + +* Summary Group Information:: Information oriented commands. +* Searching for Articles:: Multiple article commands. +* Summary Generation Commands:: (Re)generating the summary buffer. +* Really Various Summary Commands:: Those pesky non-conformant commands. + +The Article Buffer + +* Hiding Headers:: Deciding what headers should be displayed. +* Using MIME:: Pushing articles through @sc{mime} before reading them. +* Customizing Articles:: Tailoring the look of the articles. +* Article Keymap:: Keystrokes available in the article buffer. +* Misc Article:: Other stuff. + +Composing Messages + +* Mail:: Mailing and replying. +* Post:: Posting and following up. +* Posting Server:: What server should you post via? +* Mail and Post:: Mailing and posting at the same time. +* Archived Messages:: Where Gnus stores the messages you've sent. +* Posting Styles:: An easier way to specify who you are. +* Drafts:: Postponing messages and rejected messages. +* Rejected Articles:: What happens if the server doesn't like your article? + +Select Methods + +* The Server Buffer:: Making and editing virtual servers. +* Getting News:: Reading USENET news with Gnus. +* Getting Mail:: Reading your personal mail with Gnus. +* Browsing the Web:: Getting messages from a plethora of Web sources. +* Other Sources:: Reading directories, files, SOUP packets. +* Combined Groups:: Combining groups into one group. +* Gnus Unplugged:: Reading news and mail offline. + +The Server Buffer + +* Server Buffer Format:: You can customize the look of this buffer. +* Server Commands:: Commands to manipulate servers. +* Example Methods:: Examples server specifications. +* Creating a Virtual Server:: An example session. +* Server Variables:: Which variables to set. +* Servers and Methods:: You can use server names as select methods. +* Unavailable Servers:: Some servers you try to contact may be down. + +Getting News + +* NNTP:: Reading news from an @sc{nntp} server. +* News Spool:: Reading news from the local spool. + +Getting Mail + +* Mail in a Newsreader:: Important introductory notes. +* Getting Started Reading Mail:: A simple cookbook example. +* Splitting Mail:: How to create mail groups. +* Mail Sources:: How to tell Gnus where to get mail from. +* Mail Backend Variables:: Variables for customizing mail handling. +* Fancy Mail Splitting:: Gnus can do hairy splitting of incoming mail. +* Group Mail Splitting:: Use group customize to drive mail splitting. +* Incorporating Old Mail:: What about the old mail you have? +* Expiring Mail:: Getting rid of unwanted mail. +* Washing Mail:: Removing gruft from the mail you get. +* Duplicates:: Dealing with duplicated mail. +* Not Reading Mail:: Using mail backends for reading other files. +* Choosing a Mail Backend:: Gnus can read a variety of mail formats. + +Mail Sources + +* Mail Source Specifiers:: How to specify what a mail source is. +* Mail Source Customization:: Some variables that influence things. +* Fetching Mail:: Using the mail source specifiers. + +Choosing a Mail Backend + +* Unix Mail Box:: Using the (quite) standard Un*x mbox. +* Rmail Babyl:: Emacs programs use the rmail babyl format. +* Mail Spool:: Store your mail in a private spool? +* MH Spool:: An mhspool-like backend. +* Mail Folders:: Having one file for each group. +* Comparing Mail Backends:: An in-depth looks at pros and cons. + +Browsing the Web + +* Web Searches:: Creating groups from articles that match a string. +* Slashdot:: Reading the Slashdot comments. +* Ultimate:: The Ultimate Bulletin Board systems. +* Web Archive:: Reading mailing list archived on web. + +Other Sources + +* Directory Groups:: You can read a directory as if it was a newsgroup. +* Anything Groups:: Dired? Who needs dired? +* Document Groups:: Single files can be the basis of a group. +* SOUP:: Reading @sc{soup} packets ``offline''. +* Mail-To-News Gateways:: Posting articles via mail-to-news gateways. +* IMAP:: Using Gnus as a @sc{imap} client. + +Document Groups + +* Document Server Internals:: How to add your own document types. + +SOUP + +* SOUP Commands:: Commands for creating and sending @sc{soup} packets +* SOUP Groups:: A backend for reading @sc{soup} packets. +* SOUP Replies:: How to enable @code{nnsoup} to take over mail and news. + +@sc{imap} + +* Splitting in IMAP:: Splitting mail with nnimap. +* Editing IMAP ACLs:: Limiting/enabling other users access to a mailbox. +* Expunging mailboxes:: Equivalent of a "compress mailbox" button. + +Combined Groups + +* Virtual Groups:: Combining articles from many groups. +* Kibozed Groups:: Looking through parts of the newsfeed for articles. + +Gnus Unplugged + +* Agent Basics:: How it all is supposed to work. +* Agent Categories:: How to tell the Gnus Agent what to download. +* Agent Commands:: New commands for all the buffers. +* Agent Expiry:: How to make old articles go away. +* Outgoing Messages:: What happens when you post/mail something? +* Agent Variables:: Customizing is fun. +* Example Setup:: An example @file{.gnus.el} file for offline people. +* Batching Agents:: How to fetch news from a @code{cron} job. +* Agent Caveats:: What you think it'll do and what it does. + +Agent Categories + +* Category Syntax:: What a category looks like. +* The Category Buffer:: A buffer for maintaining categories. +* Category Variables:: Customize'r'Us. + +Agent Commands + +* Group Agent Commands:: +* Summary Agent Commands:: +* Server Agent Commands:: + +Scoring + +* Summary Score Commands:: Adding score entries for the current group. +* Group Score Commands:: General score commands. +* Score Variables:: Customize your scoring. (My, what terminology). +* Score File Format:: What a score file may contain. +* Score File Editing:: You can edit score files by hand as well. +* Adaptive Scoring:: Big Sister Gnus knows what you read. +* Home Score File:: How to say where new score entries are to go. +* Followups To Yourself:: Having Gnus notice when people answer you. +* Scoring Tips:: How to score effectively. +* Reverse Scoring:: That problem child of old is not problem. +* Global Score Files:: Earth-spanning, ear-splitting score files. +* Kill Files:: They are still here, but they can be ignored. +* Converting Kill Files:: Translating kill files to score files. +* GroupLens:: Getting predictions on what you like to read. +* Advanced Scoring:: Using logical expressions to build score rules. +* Score Decays:: It can be useful to let scores wither away. + +GroupLens + +* Using GroupLens:: How to make Gnus use GroupLens. +* Rating Articles:: Letting GroupLens know how you rate articles. +* Displaying Predictions:: Displaying predictions given by GroupLens. +* GroupLens Variables:: Customizing GroupLens. + +Advanced Scoring + +* Advanced Scoring Syntax:: A definition. +* Advanced Scoring Examples:: What they look like. +* Advanced Scoring Tips:: Getting the most out of it. + +Various + +* Process/Prefix:: A convention used by many treatment commands. +* Interactive:: Making Gnus ask you many questions. +* Symbolic Prefixes:: How to supply some Gnus functions with options. +* Formatting Variables:: You can specify what buffers should look like. +* Windows Configuration:: Configuring the Gnus buffer windows. +* Faces and Fonts:: How to change how faces look. +* Compilation:: How to speed Gnus up. +* Mode Lines:: Displaying information in the mode lines. +* Highlighting and Menus:: Making buffers look all nice and cozy. +* Buttons:: Get tendonitis in ten easy steps! +* Daemons:: Gnus can do things behind your back. +* NoCeM:: How to avoid spam and other fatty foods. +* Undo:: Some actions can be undone. +* Moderation:: What to do if you're a moderator. +* XEmacs Enhancements:: There are more pictures and stuff under XEmacs. +* Fuzzy Matching:: What's the big fuzz? +* Thwarting Email Spam:: A how-to on avoiding unsolicited commercial email. +* Various Various:: Things that are really various. + +Formatting Variables + +* Formatting Basics:: A formatting variable is basically a format string. +* Mode Line Formatting:: Some rules about mode line formatting variables. +* Advanced Formatting:: Modifying output in various ways. +* User-Defined Specs:: Having Gnus call your own functions. +* Formatting Fonts:: Making the formatting look colorful and nice. + +XEmacs Enhancements + +* Picons:: How to display pictures of what your reading. +* Smileys:: Show all those happy faces the way they were meant to be shown. +* Toolbar:: Click'n'drool. +* XVarious:: Other XEmacsy Gnusey variables. + +Picons + +* Picon Basics:: What are picons and How do I get them. +* Picon Requirements:: Don't go further if you aren't using XEmacs. +* Easy Picons:: Displaying Picons---the easy way. +* Hard Picons:: The way you should do it. You'll learn something. +* Picon Useless Configuration:: Other variables you can trash/tweak/munge/play with. + +Appendices + +* History:: How Gnus got where it is today. +* On Writing Manuals:: Why this is not a beginner's guide. +* Terminology:: We use really difficult, like, words here. +* Customization:: Tailoring Gnus to your needs. +* Troubleshooting:: What you might try if things do not work. +* Gnus Reference Guide:: Rilly, rilly technical stuff. +* Emacs for Heathens:: A short introduction to Emacsian terms. +* Frequently Asked Questions:: A question-and-answer session. + +History + +* Gnus Versions:: What Gnus versions have been released. +* Other Gnus Versions:: Other Gnus versions that also have been released. +* Why?:: What's the point of Gnus? +* Compatibility:: Just how compatible is Gnus with @sc{gnus}? +* Conformity:: Gnus tries to conform to all standards. +* Emacsen:: Gnus can be run on a few modern Emacsen. +* Gnus Development:: How Gnus is developed. +* Contributors:: Oodles of people. +* New Features:: Pointers to some of the new stuff in Gnus. +* Newest Features:: Features so new that they haven't been written yet. + +New Features + +* ding Gnus:: New things in Gnus 5.0/5.1, the first new Gnus. +* September Gnus:: The Thing Formally Known As Gnus 5.3/5.3. +* Red Gnus:: Third time best---Gnus 5.4/5.5. +* Quassia Gnus:: Two times two is four, or Gnus 5.6/5.7. + +Customization + +* Slow/Expensive Connection:: You run a local Emacs and get the news elsewhere. +* Slow Terminal Connection:: You run a remote Emacs. +* Little Disk Space:: You feel that having large setup files is icky. +* Slow Machine:: You feel like buying a faster machine. + +Gnus Reference Guide + +* Gnus Utility Functions:: Common functions and variable to use. +* Backend Interface:: How Gnus communicates with the servers. +* Score File Syntax:: A BNF definition of the score file standard. +* Headers:: How Gnus stores headers internally. +* Ranges:: A handy format for storing mucho numbers. +* Group Info:: The group info format. +* Extended Interactive:: Symbolic prefixes and stuff. +* Emacs/XEmacs Code:: Gnus can be run under all modern Emacsen. +* Various File Formats:: Formats of files that Gnus use. + +Backend Interface + +* Required Backend Functions:: Functions that must be implemented. +* Optional Backend Functions:: Functions that need not be implemented. +* Error Messaging:: How to get messages and report errors. +* Writing New Backends:: Extending old backends. +* Hooking New Backends Into Gnus:: What has to be done on the Gnus end. +* Mail-like Backends:: Some tips on mail backends. + +Various File Formats + +* Active File Format:: Information on articles and groups available. +* Newsgroups File Format:: Group descriptions. + +Emacs for Heathens + +* Keystrokes:: Entering text and executing commands. +* Emacs Lisp:: The built-in Emacs programming language. + +@end detailmenu @end menu @node Starting Up @@ -1733,6 +2191,9 @@ will go to the next group of the same level (or lower). This might be handy if you want to read the most important groups before you read the rest. +If this variable is @code{best}, Gnus will make the next newsgroup the +one with the best level. + @vindex gnus-group-default-list-level All groups with a level less than or equal to @code{gnus-group-default-list-level} will be listed in the group buffer @@ -2305,6 +2766,11 @@ List all groups that have names that match a regexp List all groups that have names or descriptions that match a regexp (@code{gnus-group-description-apropos}). +@item A c +@kindex A c (Group) +@findex gnus-group-list-cached +List all groups with cached articles (@code{gnus-group-list-cached}). + @end table @vindex gnus-permanently-visible-groups @@ -3397,7 +3863,8 @@ the @code{a} spec. @item L Number of lines in the article. @item c -Number of characters in the article. +Number of characters in the article. This specifier is not supported in some +methods (like nnfolder). @item I Indentation based on thread level (@pxref{Customizing Threading}). @item T @@ -4770,7 +5237,7 @@ Limit the summary buffer to articles that match some author @findex gnus-summary-limit-to-extra Limit the summary buffer to articles that match one of the ``extra'' headers (@pxref{To From Newsgroups}) -(@code{gnus-summary-limit-to-author}). +(@code{gnus-summary-limit-to-extra}). @item / u @itemx x @@ -4792,7 +5259,7 @@ with that mark (@code{gnus-summary-limit-to-marks}). @kindex / t (Summary) @findex gnus-summary-limit-to-age Ask for a number and then limit the summary buffer to articles older than (or equal to) that number of days -(@code{gnus-summary-limit-to-marks}). If given a prefix, limit to +(@code{gnus-summary-limit-to-age}). If given a prefix, limit to articles younger than that number of days. @item / n @@ -5332,11 +5799,19 @@ understand the numeric prefix. @item T n @kindex T n (Summary) +@itemx M-C-n +@kindex M-C-n (Summary) +@itemx M-down +@kindex M-down (Summary) @findex gnus-summary-next-thread Go to the next thread (@code{gnus-summary-next-thread}). @item T p @kindex T p (Summary) +@itemx M-C-p +@kindex M-C-p (Summary) +@itemx M-up +@kindex M-up (Summary) @findex gnus-summary-prev-thread Go to the previous thread (@code{gnus-summary-prev-thread}). @@ -6282,7 +6757,7 @@ content type based on the file name. The result will be fed to Non-@code{nil} means that @code{gnus-uu}, when asked to save without decoding, will save in digests. If this variable is @code{nil}, @code{gnus-uu} will just save everything in a file without any -embellishments. The digesting almost conforms to RFC1153---no easy way +embellishments. The digesting almost conforms to RFC 1153---no easy way to specify any meaningful volume and issue numbers were found, so I simply dropped them. @@ -6599,9 +7074,10 @@ Signature}. @kindex W W l (Summary) @findex gnus-article-hide-list-identifiers @vindex gnus-list-identifiers -Hide list identifiers specified in @code{gnus-list-identifiers}. These -are strings some list servers add to the beginning of all @code{Subject} -headers---for example, @samp{[zebra 4711]}. +Strip list identifiers specified in @code{gnus-list-identifiers}. +These are strings some mailing list servers add to the beginning of +all @code{Subject} headers---for example, @samp{[zebra 4711]}. Any +leading @samp{Re: } is skipped before stripping. @table @code @@ -7215,7 +7691,9 @@ the same manner: @table @kbd @item K b @kindex K b (Summary) -Make all the @sc{mime} parts have buttons in from of them. +Make all the @sc{mime} parts have buttons in from of them. This is +mostly useful if you wish to save (or perform other actions) on inlined +parts. @item K m @kindex K m (Summary) @@ -7240,7 +7718,7 @@ Toggle the buttonized display of the article buffer @item W M w @kindex W M w (Summary) -Decode RFC2047-encoded words in the article headers +Decode RFC 2047-encoded words in the article headers (@code{gnus-article-decode-mime-words}). @item W M c @@ -7338,7 +7816,30 @@ on a group-by-group basis using the group parameters (@pxref{Group Parameters}). The default value is @code{(unknown-8bit)}, which is something some agents insist on having in there. -@cindex Russina +@vindex gnus-group-posting-charset-alist +When posting, @code{gnus-group-posting-charset-alist} is used to +determine which charsets should not be encoded using the @sc{mime} +encodings. For instance, some hierarchies discourage using +quoted-printable header encoding. + +This variable is an alist of regexps and permitted unencoded charsets +for posting. Each element of the alist has the form @code{(}@var{test +header body-list}@code{)}, where: + +@table @var +@item test +is either a regular expression matching the newsgroup header or a +variable to query, +@item header +is the charset which may be left unencoded in the header (@code{nil} +means encode all charsets), +@item 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 @code{nil} (always +encode using quoted-printable) or @code{t} (always use 8bit). +@end table + +@cindex Russian @cindex koi8-r @cindex koi8-u @cindex iso-8859-5 @@ -7978,6 +8479,22 @@ If it is @code{nil} (which is the default), Gnus will rename the any other article. If this variable is @code{t}, it won't display the article---it'll be as if it never existed. +@vindex gnus-alter-articles-to-read-function +@item gnus-alter-articles-to-read-function +This function, which takes two parameters (the group name and the list +of articles to be selected), is called to allow the user to alter the +list of articles to be selected. + +For instance, the following function adds the list of cached articles to +the list in one particular group: + +@lisp +(defun my-add-cached-articles (group articles) + (if (string= group "some.group") + (append gnus-newsgroup-cached articles) + articles)) +@end lisp + @end table @@ -8222,8 +8739,9 @@ command will make exit without updating (the @kbd{Q} command) worthless. @end table @vindex gnus-exit-group-hook -@code{gnus-exit-group-hook} is called when you exit the current -group. +@code{gnus-exit-group-hook} is called when you exit the current group +with an ``updating'' exit. For instance @kbd{Q} +(@code{gnus-summary-exit-no-update}) does not call this hook. @findex gnus-summary-wake-up-the-dead @findex gnus-dead-summary-mode @@ -8982,6 +9500,21 @@ spell-checking via the @code{ispell} package: (add-hook 'message-send-hook 'ispell-message) @end lisp +If you want to change the @code{ispell} dictionary based on what group +you're in, you could say something like the following: + +@lisp +(add-hook 'gnus-select-group-hook + (lambda () + (cond + ((string-match "^de\\." gnus-newsgroup-name) + (ispell-change-dictionary "deutsch")) + (t + (ispell-change-dictionary "english"))))) +@end lisp + +Modify to suit your needs. + @node Archived Messages @section Archived Messages @@ -9199,7 +9732,7 @@ So here's a new example: (signature my-quote-randomizer)) ((message-news-p) (signature my-news-signature)) - ((header "From.*To" "larsi.*org") + (header "From.*To" "larsi.*org" (Organization "Somewhere, Inc.")) ((posting-from-work-p) (signature-file "~/.work-signature") @@ -9784,8 +10317,8 @@ The file contains one or more line, each of which define one server. @item Each line may contain an arbitrary number of token/value pairs. The valid tokens include @samp{machine}, @samp{login}, @samp{password}, -@samp{default} and @samp{force}. (The latter is not a valid -@file{.netrc}/@code{ftp} token, which is the only way the +@samp{default}, @samp{port} and @samp{force}. (The latter is not a +valid @file{.netrc}/@code{ftp} token, which is almost the only way the @file{.authinfo} file format deviates from the @file{.netrc} file format.) @@ -10639,13 +11172,13 @@ UNDELETED}, is probably the best choice for most people, but if you sometimes peek in your mailbox with a @sc{imap} client and mark some articles as read (or; SEEN) you might want to set this to @samp{nil}. Then all articles in the mailbox is fetched, no matter what. For a -complete list of predicates, see RFC2060 §6.4.4. +complete list of predicates, see RFC 2060 §6.4.4. @item :fetchflag How to flag fetched articles on the server, the default @samp{Deleted} will mark them as deleted, an alternative would be @samp{Seen} which would simply mark them as read. These are the two most likely choices, -but more flags are defined in RFC2060 §2.3.2. +but more flags are defined in RFC 2060 §2.3.2. @item :dontexpunge If non-nil, don't remove all articles marked as deleted in the mailbox @@ -10656,7 +11189,7 @@ after finishing the fetch. An example @sc{imap} mail source: @lisp -(imap :server "mail.mycorp.com" :stream kerberos4) +(imap :server "mail.mycorp.com" :stream kerberos4 :fetchflag "\\Seen") @end lisp @item webmail @@ -10704,7 +11237,18 @@ Keywords: @table @code @item :plugged -If non-nil, fetch the mail even when Gnus is unplugged. +If non-nil, fetch the mail even when Gnus is unplugged. If you use +directory source to get mail, you can specify it as in this example: + +@lisp +(setq mail-sources + '((directory :path "/home/pavel/.Spool/" + :suffix "" + :plugged t))) +@end lisp + +Gnus will then fetch your mail even when you are unplugged. This is +useful when you use local mail and news. @end table @end table @@ -10799,8 +11343,8 @@ use this hook to notify any mail watch programs, if you want to. @vindex nnmail-split-hook @item nnmail-split-hook @findex article-decode-encoded-words -@findex RFC1522 decoding -@findex RFC2047 decoding +@findex RFC 1522 decoding +@findex RFC 2047 decoding Hook run in the buffer where the mail headers of each message is kept just before the splitting based on these headers is done. The hook is free to modify the buffer contents in any way it sees fit---the buffer @@ -11253,6 +11797,18 @@ necessarily an integer) or one of the symbols @code{immediate} or You can also use the @code{expiry-wait} group parameter to selectively change the expiry period (@pxref{Group Parameters}). +@vindex nnmail-expiry-target +The normal action taken when expiring articles is to delete them. +However, in some circumstances it might make more sense to move them to +other groups instead of deleting them. The @code{nnmail-expiry-target} +(and the @code{expiry-target} group parameter) controls this. The +default value is @code{delete}, but this can also be a string (which +should be the name of the group the message should be moved to), or a +function (which will be called in a buffer narrowed to the message in +question, and with the name of the group being moved from as its +parameter) which should return a target -- either a group name or +@code{delete}. + @vindex nnmail-keep-last-article If @code{nnmail-keep-last-article} is non-@code{nil}, Gnus will never expire the final article in a mail newsgroup. This is to make life @@ -11288,10 +11844,10 @@ auto-expire turned on. @cindex incoming mail treatment Mailers and list servers are notorious for doing all sorts of really, -really stupid things with mail. ``Hey, RFC822 doesn't explicitly +really stupid things with mail. ``Hey, RFC 822 doesn't explicitly prohibit us from adding the string @code{wE aRe ElItE!!!!!1!!} to the end of all lines passing through our server, so let's do that!!!!1!'' -Yes, but RFC822 wasn't designed to be read by morons. Things that were +Yes, but RFC 822 wasn't designed to be read by morons. Things that were considered to be self-evident were not discussed. So. Here we are. Case in point: The German version of Microsoft Exchange adds @samp{AW: @@ -11863,8 +12419,11 @@ interfaces to these sources. * Slashdot:: Reading the Slashdot comments. * Ultimate:: The Ultimate Bulletin Board systems. * Web Archive:: Reading mailing list archived on web. +* Customizing w3:: Doing stuff to Emacs/w3 from Gnus. @end menu +All the web sources require Emacs/w3 and the url library to work. + The main caveat with all these web sources is that they probably won't work for a very long time. Gleaning information from the @sc{html} data is guesswork at best, and when the layout is altered, the Gnus backend @@ -12084,6 +12643,7 @@ The directory where @code{nnultimate} stores its files. The default is @samp{~/News/ultimate/}. @end table + @node Web Archive @subsection Web Archive @cindex nnwarchive @@ -12097,7 +12657,7 @@ groups updated. The easiest way to get started with @code{nnwarchive} is to say something like the following in the group buffer: @kbd{M-x -gnus-group-make-nnwarchive-group RET an_egroup RET egroups RET +gnus-group-make-warchive-group RET an_egroup RET egroups RET www.egroups.com RET your@@email.address RET}. (Substitute the @sc{an_egroup} with the mailing list you subscribed, the @sc{your@@email.address} with your email address.), or to browse the @@ -12120,6 +12680,38 @@ The account name on the web server. The password for your account on the web server. @end table + +@node Customizing w3 +@subsection Customizing w3 +@cindex w3 +@cindex html +@cindex url +@cindex Netscape + +Gnus uses the url library to fetch web pages and Emacs/w3 to display web +pages. Emacs/w3 is documented in its own manual, but there are some +things that may be more relevant for Gnus users. + +For instance, a common question is how to make Emacs/w3 follow links +using the @code{browse-url} functions (which will call some external web +browser like Netscape). Here's one way: + +@lisp +(eval-after-load "w3" + '(progn + (fset 'w3-fetch-orig (symbol-function 'w3-fetch)) + (defun w3-fetch (&optional url target) + (interactive (list (w3-read-url-with-default))) + (if (eq major-mode 'gnus-article-mode) + (browse-url url) + (w3-fetch-orig url target))))) +@end lisp + +Put that in your @file{.emacs} file, and hitting links in w3-rendered +@sc{html} in the Gnus article buffers will use @code{browse-url} to +follow the link. + + @node Other Sources @section Other Sources @@ -12851,17 +13443,36 @@ Example: @item nnimap-stream @vindex nnimap-stream The type of stream used to connect to your server. By default, nnimap -will use the most secure stream your server is capable of. +will detect and automatically use all of the below, with the exception +of SSL. (SSL is being replaced by STARTTLS, which can be automatically +detected, but it's not widely deployed yet). @itemize @bullet @item -@dfn{kerberos4:} Uses the `imtest' program. +@dfn{gssapi:} Connect with GSSAPI (usually kerberos 5). Require the +@samp{imtest} program. @item -@dfn{ssl:} Uses OpenSSL or SSLeay. +@dfn{kerberos4:} Connect with kerberos 4. Require the @samp{imtest} program. +@item +@dfn{starttls:} Connect via the STARTTLS extension (similar to +SSL). Require the external library @samp{starttls.el} and program +@samp{starttls}. +@item +@dfn{ssl:} Connect through SSL. Require OpenSSL (the +program @samp{openssl}) or SSLeay (@samp{s_client}). @item @dfn{network:} Plain, TCP/IP network connection. @end itemize +The @samp{imtest} program is shipped with Cyrus IMAPD, nnimap support +both @samp{imtest} version 1.5.x and version 1.6.x. + +For SSL connections, the OpenSSL program is available from +@file{http://www.openssl.org/}. OpenSSL was formerly known as SSLeay, +and nnimap support it too - altough the most recent versions of SSLeay, +0.9.x, are known to have serious bugs making it useless. Earlier +versions, especially 0.8.x, of SSLeay are known to work. + @item nnimap-authenticator @vindex nnimap-authenticator @@ -12870,7 +13481,14 @@ will use the most secure authenticator your server is capable of. @itemize @bullet @item -@dfn{kerberos4:} Kerberos authentication. +@dfn{gssapi:} GSSAPI (usually kerberos 5) authentication. Require +external program @code{imtest}. +@item +@dfn{kerberos4:} Kerberos authentication. Require external program +@code{imtest}. +@item +@dfn{digest-md5:} Encrypted username/password via DIGEST-MD5. Require +external library @code{digest-md5.el}. @item @dfn{cram-md5:} Encrypted username/password via CRAM-MD5. @item @@ -13020,6 +13638,18 @@ The splitting code tries to create mailboxes if it need too. Nnmail equivalent: @code{nnmail-split-methods}. +@item nnimap-split-predicate +@cindex splitting +@vindex nnimap-split-predicate + +Mail matching this predicate in @code{nnimap-split-inbox} will be +splitted, it is a string and the default is @samp{UNSEEN UNDELETED}. + +This might be useful if you use another @sc{imap} client to read mail in +your inbox but would like Gnus to split all articles in the inbox +regardless of readedness. Then you might change this to +@samp{UNDELETED}. + @item nnimap-split-fancy @cindex splitting, fancy @findex nnimap-split-fancy @@ -15856,6 +16486,12 @@ will mark the next three unread articles as read, no matter what the summary buffer looks like. Set @code{gnus-summary-goto-unread} to @code{nil} for a more straightforward action. +Many commands do not use the process/prefix convention. All commands +that do explicitly say so in this manual. To apply the process/prefix +convention to commands that do not use it, you can use the @kbd{M-&} +command. For instance, to mark all the articles in the group as +expirable, you could say `M P b M-& E'. + @node Interactive @section Interactive @@ -20160,6 +20796,15 @@ into [-] buttons. (If I click on one of the [+] buttons, it does turn into a [-] button.) @item +Perhaps there should be a command to "attach" a buffer of comments to +a message? That is, `B WHATEVER', you're popped into a buffer, write +something, end with `C-c C-c', and then the thing you've written gets +to be the child of the message you're commenting. + +@item +Handle external-body parts. + +@item Solve the halting problem. @c TODO @@ -20435,7 +21080,7 @@ An article that responds to a different article---its parent. @item digest @cindex digest A collection of messages in one file. The most common digest format is -specified by RFC1153. +specified by RFC 1153. @end table @@ -21687,7 +22332,7 @@ almost suspect that the author looked at the @sc{nov} specification and just shamelessly @emph{stole} the entire thing, and one would be right. @dfn{Header} is a severely overloaded term. ``Header'' is used in -RFC1036 to talk about lines in the head of an article (e.g., +RFC 1036 to talk about lines in the head of an article (e.g., @code{From}). It is used by many people as a synonym for ``head''---``the header and the body''. (That should be avoided, in my opinion.) And Gnus uses a format internally that it calls ``header'', diff --git a/texi/message.texi b/texi/message.texi index ac6e009..26b7693 100644 --- a/texi/message.texi +++ b/texi/message.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename message -@settitle Pterodactyl Message 5.8.3 Manual +@settitle Message 5.8.5 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 Pterodactyl Message 5.8.3 Manual +@title Message 5.8.5 Manual @author by Lars Magne Ingebrigtsen @page @@ -83,9 +83,8 @@ Message mode buffers. * Key Index:: List of Message mode keys. @end menu -This manual corresponds to Pterodactyl Message 5.8.3. Message is -distributed with the Gnus distribution bearing the same version number -as this manual. +This manual corresponds to Message 5.8.5. Message is distributed with +the Gnus distribution bearing the same version number as this manual. @node Interface diff --git a/texi/refcard.tex b/texi/refcard.tex index a701cd4..f5ce217 100644 --- a/texi/refcard.tex +++ b/texi/refcard.tex @@ -1,65 +1,167 @@ -% Reference Card for (ding) Gnus, 3 twocolumn pages. -% To be processed with latex 2.09 +% -*- latex -*- +% Reference Card for (ding) Gnus: to be processed with LaTeX2e +\documentclass{article} \def\Guide{Card}\def\guide{card} \def\logoscale{0.25} -\def\sec{\section*} -\def\subsec{\subsection*} -\def\subsubsec{\subsubsection*} -\documentstyle{article} \textwidth 7.26in \textheight 10in \topmargin -1.0in % the same settings work for A4, although there is a bit of space at the % top and bottom of the page. \oddsidemargin -0.5in \evensidemargin -0.5in + +% TODO: +% - how can you get 'tabular' to wrap around pages ? +% - some things might not be updated: scoring and server modes, maybe more + \begin{document} -\twocolumn\scriptsize\pagestyle{empty} +\newlength{\logowidth} +\setlength{\logowidth}{6.861in} +\newlength{\logoheight} +\setlength{\logoheight}{7.013in} + +\def\progver{5.8}\def\refver{5.8} % program and refcard versions +\def\date{26th of March 2000} +\def\author{Vladimir Alexiev $<$vladimir@cs.ualberta.ca$>$} +\raggedbottom\raggedright +% +% 2000-03-26 Felix Natter : +% refcard updated for Gnus 5.8.3: please send corrections or suggestions +% to the above email-address + +% changes since 2000-03-26: +% - Create/Edit Foreign Groups: remove S b and S B (not there in 5.8.3) +% - Send/Reply etc.: remove w and W (the only bindings are S w and S W) +% Mon Apr 3 18:41:09 2000: +% - added C-c C-n and C-c C-t (Article) +% - C-c C-a as alias for M-m f (Article) + some other M-m *-bindings +% - added section for ``jumping'' in article-mode +% - now there's a difference between ``reading'' and ``composition'' +% article-modes + +\twocolumn +%\tiny +\scriptsize +\pagestyle{plain} + +% this contains a set of commands containing the actual key-sequences +% (and some explanations). \input{gnusref} -% page 1, left column \Title \par -\vspace{0.5\baselineskip} \Logo{refcard} -\vspace*{\fill} -\GroupLevels -\GroupMode -\pagebreak - -% page 1, right column \Notes -\vspace*{\fill} -\GroupCommands -\pagebreak - -% page 2, left column -\SummaryMode -\Asubmap -\Bsubmap -\Gsubmap -\Hsubmap -\Tsubmap -\pagebreak - -% page 2, right column -\Msubmap -\Marks -\pagebreak - -% page 3 -\Osubmap -\Ssubmap -\Xsubmap -\Vsubmap -\SortSummary -\Wsubmap -\Zsubmap -\ArticleMode +% +% +\section*{Group-Mode} +\GroupModeGeneral + \subsection*{Group Subscribedness-Levels} + \GroupLevels + \subsection*{List Groups} + \ListGroups + \subsection*{Create/Edit Foreign Groups} + \CreateEditGroups + \subsection*{Unsubscribe, Kill and Yank Groups} + \SubscribeKillYankGroups + \subsection*{Mark Groups} + \MarkGroups +% topics in group-mode + \subsection*{Group Topics} + \GroupTopicsGeneral + \subsubsection*{Topic Sorting} + \TopicSorting +% summary-mode +\section*{Summary-Mode} +\SummaryModeGeneral + \subsection*{Select Articles} + \SelectArticles +% + \subsection*{Threading} + \Threading +% + \subsection*{Limiting} + \Limiting + \subsection*{Sort the Summary-Buffer} + \SortSummary + \subsection*{Score (Value) Commands} + \Scoring +% + \subsection*{MIME operations from the Summary-Buffer} + \MIMESummary + \subsection*{Extract Series (Uudecode etc)} + \ExtractSeries + \subsection*{Output Articles} + \OutputArticles +% + \subsection*{Post, Followup, Reply, Forward, Cancel} + \PostReplyetc + \subsection*{Message-Composition} + \MsgCompositionGeneral + \subsubsection*{Jumping in message-buffer} + \MsgCompositionMovementArticle + \subsubsection*{Attachments/MML} + \MsgCompositionMML +% marking articles + \subsection*{Mark Articles} + \MarkArticlesGeneral + \subsubsection*{Mark Based on Score} + \MarkByScore + \subsubsection*{The Process Mark} + \ProcessMark + \subsubsection*{Mark Indication-Characters} + \MarkCharacters +% + \subsection*{Mail-Group Commands} + \MailGroups + \subsection*{Draft-Group Commands} + \DraftGroup +% exiting + \subsection*{Exit the Summary-Buffer} + \ExitSummary +% +% +\section*{Article Mode (reading)} +\ArticleModeGeneral + \subsection*{Wash the Article-Buffer} + \WashArticle + \subsection*{Hide/Highlight Parts of the Article} + \HideHighlightArticle + \subsection*{MIME operations from the Article-Buffer (reading)} + \MIMEArticleMode +% +% +\section*{Server Mode} \ServerMode - -% page 4 +% +% +\section*{Browse Server Mode} \BrowseServer -\pagebreak -\onecolumn + +%\pagebreak \vspace*{\fill} -\CopyRight +\Copyright \end{document} + +% \SummaryMode +% \Gsubmap +% \Bsubmap +% \Dsubmap +% \Tsubmap +% %\pagebreak +% % page 2, right column +% \Msubmap +% \Marks +% %\pagebreak +% \Limiting +% % page 3 +% \Osubmap +% \Ssubmap +% \Xsubmap +% \Vsubmap +% \SortSummary +% \Zsubmap +% \ArticleMode +% \ServerMode +% % page 4 +% \BrowseServer +