*** The Gnus posting styles have been redone again and now works in a
subtly different manner.
+*** New web-based backends have been added: nnslashdot, nnwarchive
+and nnultimate. nnweb has been revamped, again, to keep up with
+ever-changing layouts.
+
+*** Gnus can now read IMAP mail via nnimap.
+
+Wed Dec 1 16:31:31 1999 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Pterodactyl Gnus v0.99 is released.
+
+1999-12-01 14:28:49 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * dgnushack.el (dgnushack-compile): No webmail under Emacs.
+
+ * gnus-sum.el (gnus-summary-refer-article): Wrong interactive
+ spec.
+
+ * gnus-msg.el (gnus-configure-posting-styles): Eval `eval'.
+ (gnus-configure-posting-styles): No, don't.
+ (gnus-configure-posting-styles): Allow overriding files.
+
+ * gnus-art.el (gnus-header-button-alist): Use browse-url
+ directly.
+
+ * mm-decode.el (mm-inline-media-tests): Check feature vcard.
+
+ * gnus-msg.el (gnus-summary-yank-message): New command and
+ keystroke.
+
+ * message.el (message-yank-buffer): New command.
+ (message-buffers): New function.
+
+ * gnus-sum.el (gnus-summary-catchup-and-goto-next-group): Select
+ next group in a more normal fasion.
+
+ * mml.el (mml-boundary-function): New variable.
+ (mml-compute-boundary): Use it.
+
+ * nnmh.el (nnmh-active-number): Skip past files that have buffers
+ that exist for them.
+
+ * gnus-async.el (gnus-async-prefetch-next): Cancel timers.
+ (gnus-async-timer): New variable.
+
+1999-11-30 02:07:18 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnultimate.el (nnultimate-request-list): Be more lenient with
+ root addresses.
+
+1999-11-28 20:22:37 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-treatment-function-alist): Do
+ gnus-treat-capitalize-sentences.
+
+1999-11-30 09:07:53 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * webmail.el (webmail-hotmail-article): Hotmail changes the
+ format.
+
+1999-11-29 Simon Josefsson <jas@pdc.kth.se>
+
+ * mm-decode.el (mm-display-external): For `copiousoutput' methods,
+ switch to buffer after calling program.
+ (mm-display-external): Use `shell-command-switch' instead of "-c".
+
+1999-11-27 15:21:25 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnultimate.el (nnultimate-possibly-change-server): Don't always
+ read groups file.
+
+ * nnslashdot.el (nnslashdot-request-article): Convert <br><br> to
+ <p>.
+
+1999-11-24 20:18:24 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (message-mode): Doc fix.
+
+1999-11-24 09:25:00 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (article-emphasize): Check group variable.
+ * rfc1843.el (rfc1843-decode-article-body): Ditto.
+
+1999-11-24 00:11:27 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-decode.el (mm-save-part-to-file): Inhibit jka-compr for any
+ type.
+
+1999-11-23 17:21:05 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * webmail.el: Support www.netaddress.com, i.e. usa.net.
+
+1999-11-23 Hrvoje Niksic <hniksic@iskon.hr>
+
+ * mml.el (mml-quote-region): Insert ! after the hash.
+
+1999-11-23 05:08:23 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-group.el (gnus-group-warchive-address-history): Change to
+ nil.
+
+1999-11-23 02:33:13 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * webmail.el: Support mail.yahoo.com.
+
+ * mail-source.el (mail-source-fetch-webmail): Add password check.
+ (mail-source-keyword-map): Use `subtype'.
+
+1999-11-22 04:35:43 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * mail-source.el (mail-source-keyword-map): Add webmail.
+ (mail-source-fetcher-alist): Ditto.
+ (mail-source-fetch-webmail): New function.
+ * webmail.el: New file.
+
+1999-11-21 12:20:02 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * nnwarchive.el (nnwarchive-request-group): Print 0 if it is nil.
+
+1999-11-21 12:19:11 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * mailcap.el (mailcap-parse-mailcap): Don't skip double semicolon.
+
+1999-11-20 12:54:25 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnultimate.el (nnultimate-request-list): Add fetch-time slot.
+ (nnultimate-prune-days): New function.
+ (nnultimate-create-mapping): Use it.
+ (nnultimate-request-group): Only fetch the groups list if it has
+ not been done before.
+ (nnultimate-retrieve-headers): Don't write groups.
+ (nnultimate-create-mapping): Off-by-one error.
+
+1999-11-19 12:17:25 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnslashdot.el (nnslashdot-sane-retrieve-headers): Fix to match
+ threaded subjects.
+
+1999-11-20 02:22:52 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * nnwarchive.el: Lots of changes make agent happy.
+
+1999-11-19 21:37:41 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-start.el (gnus-get-unread-articles): Assert group is in
+ hashtb.
+
+1999-11-19 19:53:08 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-decode.el (mm-display-external): Write region with binary
+ mode.
+
+1999-11-18 14:52:05 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * nnweb.el (nnweb-dejanews-create-mapping): Bind `text'.
+
+1999-11-18 14:35:01 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-uu.el (mm-uu-dissect): Use fake charset `gnus-decoded'.
+ (mm-uu-test): Now it is in restricted region.
+
+ * gnus-art.el (article-decode-charset): Don't mm-uu-test.
+
+ * mm-view.el (mm-view-message): Fix buffer leak.
+ (mm-inline-message): Support 'gnus-decoded.
+
+ * mm-bodies.el (mm-decode-body): Ditto.
+
+ * rfc2047.el (rfc2047-decode-region): Ditto.
+
+1999-11-18 Matthias Andree <ma@dt.e-technik.uni-dortmund.de>
+
+ * imap.el (require): Added autoload for base64-encode-string.
+
+1999-11-17 Per Abrahamsen <abraham@dina.kvl.dk>
+
+ * gnus.el (gnus-refer-article-method): Made list value
+ customizable.
+
+1999-11-17 13:09:37 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-summary-recenter): set-window-start with
+ NOFORCE in Emacs case.
+
+1999-11-17 13:04:01 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-request-article-this-buffer): Set
+ gnus-newsgroup-name.
+
+1999-11-16 23:53:22 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-xmas.el (gnus-xmas-summary-recenter): set-window-start with
+ NOFORCE.
+
+1999-11-17 Simon Josefsson <jas@pdc.kth.se>
+
+ * gnus-start.el (gnus-get-unread-articles): Check server before
+ scanning.
+
+1999-11-16 10:01:03 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.el (gnus-valid-select-methods): nnslashdot is news.
+
+ * nnslashdot.el (nnslashdot-login-name): New variable.
+ (nnslashdot-password): Ditto.
+ (nnslashdot-request-post): New function.
+
+ * gnus-art.el (gnus-treat-buttonize): More testing.
+
+ * mm-encode.el: Another CVS test.
+
+ * gnus-art.el (gnus-treat-emphasize): Change default.
+ (gnus-treat-buttonize): Ditto.
+ (gnus-treat-buttonize): This is a test.
+
+ * gnus-sum.el (gnus-build-old-threads): Bind mail-parse-charset.
+ (gnus-build-sparse-threads): Ditto.
+ (gnus-build-all-threads): Ditto.
+
+ * nnheader.el (make-full-mail-header): Make into a subst.
+
+ * dgnushack.el (dgnushack-compile): Skip all w3-dependent files
+ unless w3 is supplied.
+
+ * gnus.el (gnus-refer-article-method): Doc fix.
+
+ * gnus-sum.el: Do not accept a prefix.
+ (gnus-summary-refer-article): Accept a list of select methods.
+
+1999-11-15 21:28:40 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * Makefile.in: Change `^ *' to `\t'.
+
+1999-11-11 Matt Pharr <mmp@graphics.stanford.edu>
+
+ * message.el (message-forward): Pay attention to prefix argument
+ again and forward all headers when it is set, regardless of the
+ value of message-forward-ignored-headers.
+
+1999-11-15 20:44:50 William M. Perry <wmperry@aventail.com>
+
+ * dgnushack.el (dgnushack-compile): Vpath file.
+
+ * Makefile.in (SHELL): VPATH support.
+
+1999-11-15 20:37:17 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-ems.el: Check for cygwin32.
+
+1999-11-14 18:15:28 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-decode.el (mm-display-external): Use 'non-viewer.
+
+1999-11-14 15:21:06 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * base64.el (base64-encode-string): An alias for base64-encode for
+ compatibility.
+
+1999-11-14 01:58:18 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * nntp.el (nntp-retrieve-groups): Erase nntp-sever-buffer before
+ nntp-inhibit-erase.
+
+1999-11-13 Simon Josefsson <jas@pdc.kth.se>
+
+ * gnus-start.el (gnus-get-unread-articles): Use
+ nnfoo-retrieve-groups to find new news, if available.
+ (gnus-read-active-file-2): New function.
+ (gnus-get-unread-articles): Use it.
+ (gnus-read-active-file-1): Ditto.
+
+1999-11-13 17:59:18 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mm-util.el (mm-find-mime-charset-region): Make sure
+ find-coding-systems-for-charsets is fbound.
+
+ * gnus-ems.el: Typo fix.
+
+1999-11-13 Florian Weimer <fw@s.netic.de>
+
+ * mm-util.el (mm-find-mime-charset-region): Use UTF-8 if
+ it's available and makes sense.
+
+1999-11-12 19:56:23 Fabrice POPINEAU <Fabrice.Popineau@supelec.fr>
+
+ * gnus-score.el (gnus-score-save): Translate score file.
+
+1999-11-13 Simon Josefsson <jas@pdc.kth.se>
+
+ * mail-source.el (mail-source-keyword-map): For IMAP mail source,
+ added fetchflag and dontexpunge keywords.
+ (mail-source-fetch-imap): Use them.
+
+1999-11-12 Per Abrahamsen <abraham@dina.kvl.dk>
+
+ * gnus-start.el (gnus-level-subscribed, gnus-level-unsubscribed,
+ gnus-level-zombie, gnus-level-killed): Changed from `defcustom' to
+ `defconst'.
+
+ * gnus-cus.el (gnus-group-parameters): Changed from `defcustom' to
+ `defconst'.
+ Mention that it is both for group and topic parameters.
+ (gnus-extra-topic-parameters): New constant, including `subscribe'
+ parameter.
+ (gnus-extra-group-parameters): New constant.
+ (gnus-group-customize): Use them.
+
+ * gnus.el (gnus-select-method): Added default value and tag.
+ (gnus-refer-article-method): Added `DejaNews' customization option.
+
+1999-11-12 05:04:43 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-int.el (gnus-server-opened): Ignore denied servers.
+
+ * gnus-ems.el (gnus-mule-max-width-function): New backquote
+ syntax.
+
+ * nndoc.el (nndoc-mime-digest-type-p): Reinstated.
+
+ * nnslashdot.el (nnslashdot-group-number): Changed default.
+
+ * nnweb.el (nnweb-dejanews-create-mapping): Work with new deja.
+ (nnweb-dejanews-wash-article): Removed.
+ (nnweb-type-definition): Fetch by id.
+
+ * gnus-msg.el (gnus-configure-posting-styles): Don't insert unless
+ we mean it.
+
+ * nnslashdot.el (nnslashdot-group-number): Doc fix.
+ (nnslashdot-request-list): Use Ultramode as well.
+ (nnslashdot-date-to-date): Be more lenient.
+ (nnslashdot-threaded): New function.
+
+1999-11-11 17:40:54 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-mime-internalize-part): Doc fix.
+
+1999-11-11 14:32:48 Steinar Bang <sb@metis.no>
+
+ * nnweb.el (nnweb-type-definition): /=dnc
+
+1999-11-11 10:58:38 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnultimate.el (nnultimate-retrieve-headers): Work with american
+ dates.
+ (nnultimate-retrieve-headers): Wrong ordering.
+
+1999-11-11 07:31:51 Matt Pharr <mmp@graphics.stanford.edu>
+
+ * message.el (message-forward-as-mime): New variable.
+
+1999-11-11 05:24:13 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-util.el (gnus-dd-mmm): Beware buggy dates.
+
+1999-11-10 16:50:01 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * mail-source.el (mail-source-movemail-and-remove): New function.
+ (mail-source-keyword-map): Add `function' for `maildir'.
+ (mail-source-fetch-maildir): Use it.
+
+1999-11-10 13:48:10 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * nnwarchive.el: New file.
+ * gnus-group.el (gnus-group-make-warchive-group): New function.
+ * gnus.el (gnus-valid-select-methods): Add `nnwarchive'.
+
+1999-11-10 12:13:30 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnultimate.el (nnultimate-retrieve-headers): Work for multi-page
+ subjects.
+
+1999-11-10 11:33:23 Rajappa Iyer <rajappa@mindspring.com>
+
+ * gnus-salt.el (gnus-pick-article-or-thread): Don't move point.
+
+1999-11-10 05:22:56 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnultimate.el (nnultimate-open-server): Do address.
+ (nnultimate-forum-table-p): New function.
+
+ * nnweb.el (nnweb-insert-html): Renamed.
+ (nnweb-insert): New function.
+
+ * nnultimate.el (nnultimate-insert-html): New function.
+
+ * nnslashdot.el (nnslashdot-retrieve-headers): Don't do anything
+ if nov is evil.
+ (nnslashdot-retrieve-headers): use the sane version instead.
+
+1999-11-09 00:13:25 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnslashdot.el (nnslashdot-request-article): Fold case.
+
+ * nnultimate.el: New file.
+
+ * nnslashdot.el (nnslashdot-retrieve-headers): Skip the article
+ unless wanted.
+
+ * gnus-start.el (gnus-active-to-gnus-format): Catch errors.
+ (gnus-read-active-file-1): Separated into own function.
+ (gnus-read-active-file): Catch quits.
+
+ * nnslashdot.el (nnslashdot-request-article): Search better on
+ first article.
+ (nnslashdot-request-list): Fold case.
+ (nnslashdot-retrieve-headers): Ditto.
+
+1999-11-08 05:33:15 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.el: Autoload gnus-subscribe-topics.
+
+1999-11-07 22:56:46 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-agent.el (gnus-agent-save-group-info): Remove backslash
+ before dot.
+ * gnus-util.el (gnus-write-active-file): Ditto.
+
+1999-11-07 22:31:10 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * nnheader.el (nnheader-replace-duplicate-chars-in-string): New
+ function.
+ * gnus-cache.el (gnus-cache-file-name): Use it.
+ * gnus-agent.el (gnus-agent-group-path): Use it.
+ * nnmail.el (nnmail-group-pathname): Use it.
+
+1999-11-07 21:07:55 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-start.el (gnus-active-to-gnus-format): Don't insert backslash
+ if cooked.
+ * gnus-util.el (gnus-write-active-file): Write cooked active file.
+ * gnus-agent.el (gnus-agent-save-group-info): Ditto.
+ * gnus.el (gnus-short-group-name): "..." proof.
+
+1999-11-07 20:03:16 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-srvr.el (gnus-browse-foreign-server): Keep using `read' to
+ support nnslashdot.
+
+1999-11-08 00:06:02 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnslashdot.el (nnslashdot-retrieve-headers): Don't fetch too
+ many articles.
+ (nnslashdot-generate-active): New function.
+ (nnslashdot-request-newgroups): Use it.
+
+ * gnus-start.el (gnus-active-to-gnus-format): Intern strings group
+ names.
+
+ * nnslashdot.el (nnslashdot-request-newgroups): New function.
+ (nnslashdot-request-list): Not moderated.
+
+1999-11-07 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap.el (nnimap-open-server): Remove error signal if
+ nnimap-server-buffer is nil (the check should've been `boundp').
+
+ * imap.el (imap-log):
+ * nnimap.el (nnimap-debug): Disable debugging by default.
+
+1999-11-07 01:17:53 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-start.el (gnus-subscribe-newsgroup-method): Doc fix.
+
+ * gnus-topic.el (gnus-subscribe-topic): New function.
+
+ * nnslashdot.el (nnslashdot-request-list): Give out extended group
+ names.
+
+ * gnus-start.el (gnus-ignored-newsgroups): Disregard bogus chars
+ if starting with a quote.
+
+1999-11-07 13:06:11 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-srvr.el (gnus-browse-foreign-server): Support backslash in
+ group name.
+
+1999-11-07 01:17:53 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnslashdot.el: New file.
+
+ * nnheader.el (nnheader-insert-header): New function.
+
+ * gnus-art.el (gnus-mime-internalize-part): Bind
+ mm-inlined-types.
+
+ * nndraft.el (nndraft-request-expire-articles): Do all the backup
+ files.
+
+1999-10-29 David S. Goldberg <dsg@mitre.org>
+
+ * emacs-mime.texi (Customization): Document mm-inline-override-types
+
+1999-10-29 David S. Goldberg <dsg@mitre.org>
+
+ * emacs-mime.texi (Customization): Document mm-inline-override-types
+
+1999-10-29 David S. Goldberg <dsg@mitre.org>
+
+ * emacs-mime.texi (Customization): Document mm-inline-override-types
+
+1999-10-26 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * smiley.el (gnus-smiley-display): Use `smiley-toggle-buffer'.
+ (smiley-toggle-buffer): New function.
+ (smiley-buffer): Don't quote the function.
+ (smiley-toggle-extents): Ditto.
+
+1999-11-07 01:00:32 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-topic.el (gnus-topic-goto-missing-topic): Work even in
+ empty buffers.
+
+1999-11-06 23:16:24 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-article-mode-map): Use the summary article
+ edit.
+
+1999-11-06 22:56:49 Jens-Ulrik Petersen <Jens-Ulrik.Petersen@nokia.com>
+
+ * gnus-group.el (gnus-group-read-ephemeral-group): Doc fix.
+
+1999-11-06 21:40:30 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-uu.el (gnus-uu-mark-thread): Don't move point around.
+
+1999-10-07 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-treat-predicate): Examine whether the argument
+ is list or not before condition.
+
+1999-10-07 Yoshiki Hayashi <t90553@mail.ecc.u-tokyo.ac.jp>
+
+ * gnus-art.el (gnus-treat-predicate): Work for (typep "something").
+
+1999-11-06 19:18:14 Kevin the Bandicoot <user42@zip.com.au>
+
+ * gnus-art.el (gnus-emphasis-alist): New value.
+
+1999-11-06 13:57:13 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-srvr.el (gnus-browse-foreign-server): Use both `read' and
+ `buffer-substring'.
+
+1999-11-06 04:24:30 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (article-date-ut): Keep the updated timer.
+ (gnus-emphasis-underline-italic): Doc fix.
+
+ * gnus-msg.el (gnus-post-method): Doc fix.
+ (gnus-post-method): Change default.
+
+1999-11-06 04:12:13 Francisco Solsona <flsc@hp.fciencias.unam.mx>
+
+ * message.el (message-newline-and-reformat): Improvements.
+
+1999-11-06 03:51:24 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (message-newline-and-reformat): Don't insert too many
+ newlines.
+ (message-newline-and-reformat): Work even if not sc.
+
+ * mm-view.el (mm-inline-message): Insert a delimiter at the end.
+
+ * mm-decode.el (mm-inline-media-tests): Only if diff mode.
+
+1999-11-06 03:48:02 Toby Speight <Toby.Speight@streapadair.freeserve.co.uk>
+
+ * mm-view.el (mm-display-patch-inline): New function.
+
+1999-11-06 03:47:54 Robert Bihlmeyer <robbe@orcus.priv.at>
+
+ * mm-view.el (mm-display-patch-inline): New function.
+
+1999-11-06 02:17:54 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-read-move-group-name): Subscribe to the
+ group.
+
+ * message.el (message-forward): Narrow to the right header.
+
+ * gnus-sum.el (gnus-summary-limit-to-age): Protect against bogus
+ dates.
+
+ * gnus-msg.el (gnus-configure-posting-styles): Use the
+ user-full-name function.
+
+ * mm-bodies.el (mm-body-encoding): Use the choosing function.
+ (mm-body-charset-encoding-alist): Default to nil.
+
+ * message.el (message-elide-ellipsis): Fix typo.
+ (message-elide-region): Ditto.
+ (message-elide-region): Don't insert a newline first.
+
+1999-11-05 20:28:27 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-cut-thread): Also cut for numberp
+ gnus-fetch-old-headers.
+ (gnus-cut-threads): Ditto.
+ (gnus-summary-initial-limit): Ditto.
+ (gnus-summary-limit-children): Ditto.
+
+ * gnus-msg.el (gnus-configure-posting-styles): Allow `header'
+ matches.
+
+1999-11-06 Simon Josefsson <jas@pdc.kth.se>
+
+ * gnus-art.el (article-decode-encoded-words):
+ (gnus-mime-display-single): Don't assume gnus-summary-buffer is
+ live.
+
+ * gnus.el (gnus-read-method): Add methods from
+ `gnus-opened-servers' to completion. Map entered method/address
+ into existing methods if possible.
+
+ * gnus-group.el (gnus-group-make-group): Simplify method.
+
+ * gnus-srvr.el (gnus-browse-unsubscribe-group): Simplify method.
+
+ * mml.el (mml-preview): Remove mail-header-separator before
+ encoding.
+
+1999-11-05 20:28:27 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (message-read-from-minibuffer): New function.
+
Fri Nov 5 19:10:02 1999 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
* gnus.el: Pterodactyl Gnus v0.98 is released.
* gnus-sum.el (gnus-newsgroup-ignored-charsets): Add x-unknown.
->>>>>>> 5.100
+1999-10-20 David S. Goldberg <dsg@mitre.org>
+
+ * mm-decode.el mm-inline-override-types: New variable
+
+ * mm-decode.el (mm-inline-override-p): New function
+
+ * mm-decode.el (mm-inlined-p): Use it
+
+1999-10-20 David S. Goldberg <dsg@mitre.org>
+
+ * mm-decode.el mm-inline-override-types: New variable
+
+ * mm-decode.el (mm-inline-override-p): New function
+
+ * mm-decode.el (mm-inlined-p): Use it
+
Mon Sep 27 15:18:05 1999 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
* gnus.el: Pterodactyl Gnus v0.97 is released.
* gnus-art.el (gnus-treat-predicate): Work for (not 5).
-1999-08-27 Peter von der Ah
\e-Aé <pahe@daimi.au.dk>
\e$)A
+1999-08-27 Peter von der Ah
\e-A
\ ei
\ f <pahe@daimi.au.dk>
* message.el (message-send): More helpful error message if sending
fails
* gnus-agent.el (gnus-agent-get-undownloaded-list): Don't
mark cached articles as `undownloaded'.
-Tue Jul 20 02:39:56 1999 Peter von der Ah
\e-Aé <peter@ahe.dk>
\e$)A
+Tue Jul 20 02:39:56 1999 Peter von der Ah
\e-A
\ ei
\ f <peter@ahe.dk>
* gnus-sum.el (gnus-summary-exit): Allow gnus-use-adaptive-scoring
to have buffer local values.
* mm-uu.el (mm-uu-dissect): Use mm-make-handle.
-1998-12-01 01:53:49 Fran
\e-Açois Pinard <pinard@iro.umontreal.ca>
\e$)A
+1998-12-01 01:53:49 Fran
\e-A
\ eg
\ fois Pinard <pinard@iro.umontreal.ca>
* nndoc.el (nndoc-mime-parts-type-p): Do related.
* rfc2047.el (rfc2047-q-encode-region): Would bug out.
-1998-09-13 Fran
\e-Açois Pinard <pinard@iro.umontreal.ca>
\e$)A
+1998-09-13 Fran
\e-A
\ eg
\ fois Pinard <pinard@iro.umontreal.ca>
* nndoc.el: Make nndoc-dissection-alist simpler for MIME, adjust all
related functions. Handle message/rfc822 parts. Display subject on
top_srcdir = @top_srcdir@
EMACS = @EMACS@
-FLAGS = -batch -q -no-site-file -l ./dgnushack.el
+FLAGS = -batch -q -no-site-file -l $(srcdir)/dgnushack.el
INSTALL = @INSTALL@
INSTALL_DATA = @INSTALL_DATA@
SHELL = /bin/sh
PACKAGEDIR = @PACKAGEDIR@
all total:
- rm -f *.elc auto-autoloads.el custom-load.el ; \
- $(EMACS) $(FLAGS) -f dgnushack-compile
+ rm -f *.elc auto-autoloads.el custom-load.el
+ srcdir=$(srcdir) $(EMACS) $(FLAGS) -f dgnushack-compile
warn:
- rm -f *.elc ; $(EMACS) $(FLAGS) --eval '(dgnushack-compile t)' 2>&1 | egrep -v "variable G|inhibit-point-motion-hooks|coding-system|temp-results|variable gnus|variable nn|scroll-in-place|deactivate-mark|filladapt-mode|byte-code-function-p|print-quoted|ps-right-header|ps-left-header|article-inhibit|print-escape|ssl-program-arguments|message-log-max"
+ rm -f *.elc
+ srcdir=$(srcdir) $(EMACS) $(FLAGS) --eval '(dgnushack-compile t)' 2>&1 | egrep -v "variable G|inhibit-point-motion-hooks|coding-system|temp-results|variable gnus|variable nn|scroll-in-place|deactivate-mark|filladapt-mode|byte-code-function-p|print-quoted|ps-right-header|ps-left-header|article-inhibit|print-escape|ssl-program-arguments|message-log-max"
# The "clever" rule is unsafe, since redefined macros are loaded from
# .elc files, and not the .el file.
clever some:
- $(EMACS) $(FLAGS) -f dgnushack-compile
+ srcdir=$(srcdir) $(EMACS) $(FLAGS) -f dgnushack-compile
install: clever
rm -f dgnushack.elc
done
package:
- $(EMACS) $(FLAGS) -f dgnushack-make-package
+ srcdir=$(srcdir) $(EMACS) $(FLAGS) -f dgnushack-make-package
install-package: clever
rm -f dgnushack.elc
- $(EMACS) $(FLAGS) -f dgnushack-make-package \
+ srcdir=$(srcdir) $(EMACS) $(FLAGS) -f dgnushack-make-package \
-f dgnushack-install-package $(PACKAGEDIR)
tags:
(kill-buffer (current-buffer)))))
(fset 'base64-decode-string 'base64-decode)
+(fset 'base64-encode-string 'base64-encode)
(provide 'base64)
(pop x))
x))))
+;; 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
+;; before loading bytecomp. Bytecomp doesn't overwrite this function.
+(defun byte-compile-dest-file (filename)
+ "Convert an Emacs Lisp source file name to a compiled file name.
+ In addition, remove directory name part from FILENAME."
+ (setq filename (byte-compiler-base-file-name filename))
+ (setq filename (file-name-sans-versions filename))
+ (setq filename (file-name-nondirectory filename))
+ (if (memq system-type '(win32 w32 mswindows windows-nt))
+ (setq filename (downcase filename)))
+ (cond ((eq system-type 'vax-vms)
+ (concat (substring filename 0 (string-match ";" filename)) "c"))
+ ((string-match emacs-lisp-file-regexp filename)
+ (concat (substring filename 0 (match-beginning 0)) ".elc"))
+ (t (concat filename ".elc"))))
+
(require 'bytecomp)
+(defvar srcdir (or (getenv "srcdir") "."))
+
+(push srcdir load-path)
+
;; Attempt to pickup the additional load-path(s).
-(load (expand-file-name "./dgnuspath.el") nil nil t)
+(load (expand-file-name "dgnuspath.el" srcdir) nil nil t)
(condition-case err
(load "~/.lpath.el" t nil t)
(error (message "Error in \"~/.lpath.el\" file: %s" err)))
-(push "." load-path)
-
(condition-case nil
(char-after)
(wrong-number-of-arguments
;; `char-after' and `char-before' must be well-behaved before lpath.el
;; is loaded. Because it requires `poe' via `path-util'.
-(load "./lpath.el" nil t)
+(load (expand-file-name "lpath.el" srcdir) nil t t)
(unless (fboundp 'byte-compile-file-form-custom-declare-variable)
;; Bind defcustom'ed variables.
Modify to suit your needs."))
(let ((files (delete "dgnuspath.el"
- (directory-files "." nil "^[^=].*\\.el$")))
+ (directory-files srcdir nil "^[^=].*\\.el$")))
(xemacs (string-match "XEmacs" emacs-version))
;;(byte-compile-generate-call-tree t)
file elc)
(condition-case ()
(require 'w3-forms)
- (error (setq files (delete "nnweb.el" (delete "nnlistserv.el" files)))))
+ (error
+ (dolist (file '("nnweb.el" "nnlistserv.el" "nnultimate.el"
+ "nnslashdot.el" "nnwarchive.el" "webmail.el"))
+ (setq files (delete file files)))))
(condition-case ()
(require 'bbdb)
(error (setq files (delete "gnus-bbdb.el" files))))
(while (setq file (pop files))
- (when (or (and (not xemacs)
- (not (member file '("gnus-xmas.el" "gnus-picon.el"
- "messagexmas.el" "nnheaderxm.el"
- "smiley.el" "x-overlay.el"))))
- (and xemacs
- (not (member file '("md5.el")))))
+ (unless (or (and (not xemacs)
+ (member file
+ '("gnus-xmas.el" "gnus-picon.el"
+ "messagexmas.el" "nnheaderxm.el"
+ "smiley.el" "x-overlay.el")))
+ (and (string-equal file "md5.el")
+ (not (and (fboundp 'md5)
+ (subrp (symbol-function 'md5))))))
+ (setq file (expand-file-name file srcdir))
(when (or (not (file-exists-p (setq elc (concat file "c"))))
(file-newer-than-file-p file elc))
(ignore-errors
(when (re-search-forward
(concat "^" (regexp-quote group) " ") nil t)
(gnus-delete-line))
- (insert group " " (number-to-string (cdr active)) " "
- (number-to-string (car active)) " y\n")))))
+ (insert (format "%S %d %d y\n" (intern group) (cdr active)
+ (car active)))
+ (goto-char (point-max))
+ (while (search-backward "\\." nil t)
+ (delete-char 1))))))
(defun gnus-agent-group-path (group)
"Translate GROUP into a path."
(if nnmail-use-long-file-names
(gnus-group-real-name group)
- (nnheader-replace-chars-in-string
- (nnheader-translate-file-chars (gnus-group-real-name group))
- ?. ?/)))
+ (nnheader-translate-file-chars
+ (nnheader-replace-chars-in-string
+ (nnheader-replace-duplicate-chars-in-string
+ (nnheader-replace-chars-in-string
+ (gnus-group-real-name group)
+ ?/ ?_)
+ ?. ?_)
+ ?. ?/))))
\f
(defcustom gnus-emphasis-alist
(let ((format
- "\\(\\s-\\|^\\|[-\"]\\|\\s(\\|\\s)\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\\(\\s-\\|[-?!.,;:\"]\\|\\s(\\|\\s)\\)")
+ "\\(\\s-\\|^\\|[-\"]\\|\\s(\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\\(\\s-\\|[-,;:\"]\\s-\\|[?!.]+\\s-\\|\\s)\\)")
(types
'(("_" "_" underline)
("/" "/" italic)
:group 'gnus-article-emphasis)
(defface gnus-emphasis-underline-italic '((t (:italic t :underline t)))
- "Face used for displaying underlined italic emphasized text (_*word*_)."
+ "Face used for displaying underlined italic emphasized text (_/word/_)."
:group 'gnus-article-emphasis)
(defface gnus-emphasis-bold-italic '((t (:bold t :italic t)))
:type gnus-article-treat-custom)
(put 'gnus-treat-highlight-signature 'highlight t)
-(defcustom gnus-treat-buttonize t
+(defcustom gnus-treat-buttonize 100000
"Add buttons.
Valid values are nil, t, `head', `last', an integer or a predicate.
See the manual for details."
(gnus-treat-overstrike gnus-article-treat-overstrike)
(gnus-treat-buttonize-head gnus-article-add-buttons-to-head)
(gnus-treat-display-smileys gnus-smiley-display)
+ (gnus-treat-capitalize-sentences gnus-article-capitalize-sentences)
(gnus-treat-display-picons gnus-article-display-picons)
(gnus-treat-play-sounds gnus-earcon-display)))
(forward-line 1)
(narrow-to-region (point) (point-max))
(when (and (or (not ctl)
- (equal (car ctl) "text/plain"))
- (not (mm-uu-test)))
+ (equal (car ctl) "text/plain")))
(mm-decode-body
charset (and cte (intern (downcase
(gnus-strip-whitespace cte))))
(interactive (gnus-article-hidden-arg))
(unless (gnus-article-check-hidden-text 'emphasis arg)
(save-excursion
- (let ((alist (or (with-current-buffer gnus-summary-buffer
- gnus-article-emphasis-alist)
- gnus-emphasis-alist))
+ (let ((alist (or
+ (condition-case nil
+ (with-current-buffer gnus-summary-buffer
+ gnus-article-emphasis-alist)
+ (error))
+ gnus-emphasis-alist))
(buffer-read-only nil)
(props (append '(article-type emphasis)
gnus-hidden-properties))
"s" gnus-article-show-summary
"\C-c\C-m" gnus-article-mail
"?" gnus-article-describe-briefly
- gnus-mouse-2 gnus-article-push-button
- "\r" gnus-article-press-button
- "\t" gnus-article-next-button
- "\M-\t" gnus-article-prev-button
- "e" gnus-article-edit
+ "e" gnus-summary-article-edit
"<" beginning-of-buffer
">" end-of-buffer
"\C-c\C-i" gnus-info-find-node
(mm-display-part handle))))
(defun gnus-mime-internalize-part (&optional handle)
- "View the MIME part under point with an internal viewer."
+ "View the MIME part under point with an internal viewer.
+In no internal viewer is available, use an external viewer."
(interactive)
(gnus-article-check-buffer)
(let* ((handle (or handle (get-text-property (point) 'gnus-data)))
- (mm-user-display-methods '((".*" . inline)))
+ (mm-inlined-types '(".*"))
(mm-inline-large-images t)
(mail-parse-charset gnus-newsgroup-charset)
(mail-parse-ignored-charsets
(when (string-match (pop ignored) type)
(throw 'ignored nil)))
(if (and (setq not-attachment
- (or (not (mm-handle-disposition handle))
- (equal (car (mm-handle-disposition handle))
- "inline")
- (mm-attachment-override-p handle)))
+ (and (not (mm-inline-override-p handle))
+ (or (not (mm-handle-disposition handle))
+ (equal (car (mm-handle-disposition handle))
+ "inline")
+ (mm-attachment-override-p handle))))
(mm-automatic-display-p handle)
(or (mm-inlined-p handle)
(mm-automatic-external-display-p type)))
(setq beg (point)))
(let ((mail-parse-charset gnus-newsgroup-charset)
(mail-parse-ignored-charsets
- (save-excursion (set-buffer gnus-summary-buffer)
+ (save-excursion (condition-case ()
+ (set-buffer gnus-summary-buffer)
+ (error))
gnus-newsgroup-ignored-charsets)))
(mm-display-part handle t))
(goto-char (point-max)))
(buffer-read-only nil))
(erase-buffer)
(gnus-kill-all-overlays)
- (gnus-check-group-server)
+ (let ((gnus-newsgroup-name group))
+ (gnus-check-group-server))
(when (gnus-request-article article group (current-buffer))
(when (numberp article)
(gnus-async-prefetch-next group article gnus-summary-buffer)
;; This is how URLs _should_ be embedded in text...
("<URL: *\\([^>]*\\)>" 0 t gnus-button-embedded-url 1)
;; Raw URLs.
- (,gnus-button-url-regexp 0 t gnus-button-url 0))
+ (,gnus-button-url-regexp 0 t browse-url 0))
"*Alist of regexps matching buttons in article bodies.
Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where
("^\\(From\\|Reply-To\\):" ": *\\(.+\\)$" 1 t gnus-button-reply 1)
("^\\(Cc\\|To\\):" "[^ \t\n<>,()\"]+@[^ \t\n<>,()\"]+"
0 t gnus-button-mailto 0)
- ("^X-[Uu][Rr][Ll]:" ,gnus-button-url-regexp 0 t gnus-button-url 0)
- ("^Subject:" ,gnus-button-url-regexp 0 t gnus-button-url 0)
- ("^[^:]+:" ,gnus-button-url-regexp 0 t gnus-button-url 0)
+ ("^X-[Uu][Rr][Ll]:" ,gnus-button-url-regexp 0 t browse-url 0)
+ ("^Subject:" ,gnus-button-url-regexp 0 t browse-url 0)
+ ("^[^:]+:" ,gnus-button-url-regexp 0 t browse-url 0)
("^[^:]+:" "\\(<\\(url: \\)?news:\\([^>\n ]*\\)>\\)" 1 t
gnus-button-message-id 3))
"*Alist of headers and regexps to match buttons in article heads.
(gnus-setup-message 'reply
(message-reply address)))
-(defun gnus-button-url (address)
- "Browse ADDRESS."
- ;; In Emacs 20, `browse-url-browser-function' may be an alist.
- (if (listp browse-url-browser-function)
- (browse-url address)
- (funcall browse-url-browser-function address)))
-
(defun gnus-button-embedded-url (address)
"Browse ADDRESS."
;; In Emacs 20, `browse-url-browser-function' may be an alist.
(defvar gnus-async-hashtb nil)
(defvar gnus-async-current-prefetch-group nil)
(defvar gnus-async-current-prefetch-article nil)
+(defvar gnus-async-timer nil)
(defvar gnus-async-prefetch-headers-buffer " *Async Prefetch Headers*")
(defvar gnus-async-header-prefetched nil)
;; do this, which leads to slightly slower article
;; buffer display.
(gnus-async-prefetch-article group next summary)
- (run-with-idle-timer
- 0.1 nil 'gnus-async-prefetch-article group next summary)))))))
+ (when gnus-async-timer
+ (ignore-errors
+ (nnheader-cancel-timer 'gnus-async-timer)))
+ (setq gnus-async-timer
+ (run-with-idle-timer
+ 0.1 nil 'gnus-async-prefetch-article
+ group next summary))))))))
(defun gnus-async-prefetch-article (group article summary &optional next)
"Possibly prefetch several articles starting with ARTICLE."
(nnheader-translate-file-chars
(if (gnus-use-long-file-name 'not-cache)
group
- (let ((group (nnheader-replace-chars-in-string group ?/ ?_)))
+ (let ((group (nnheader-replace-duplicate-chars-in-string
+ (nnheader-replace-chars-in-string group ?/ ?_)
+ ?. ?_)))
;; Translate the first colon into a slash.
(when (string-match ":" group)
(aset group (match-beginning 0) ?/))
;;; Group Customization:
-(defcustom gnus-group-parameters
+(defconst gnus-group-parameters
'((to-address (gnus-email-address :tag "To Address") "\
This will be used when doing followups and posts.
gnus-emphasis-highlight-words))))
"highlight regexps.
See gnus-emphasis-alist."))
- "Alist of valid group parameters.
+ "Alist of valid group or topic parameters.
Each entry has the form (NAME TYPE DOC), where NAME is the parameter
itself (a symbol), TYPE is the parameters type (a sexp widget), and
DOC is a documentation string for the parameter.")
+(defconst gnus-extra-topic-parameters
+ '((subscribe (regexp :tag "Subscribe") "\
+If `gnus-subscribe-newsgroup-method' is set to
+`gnus-subscribe-topics', new groups that matches this regexp will
+automatically be subscribed to this topic"))
+ "Alist of topic parameters that are not also group parameters.
+
+Each entry has the form (NAME TYPE DOC), where NAME is the parameter
+itself (a symbol), TYPE is the parameters type (a sexp widget), and
+DOC is a documentation string for the parameter.")
+
+(defconst gnus-extra-group-parameters nil
+ "Alist of group parameters that are not also topic parameters.
+
+Each entry has the form (NAME TYPE DOC), where NAME is the parameter
+itself (a symbol), TYPE is the parameters type (a sexp widget), and
+DOC is a documentation string for the parameter.")
(defvar gnus-custom-params)
(defvar gnus-custom-method)
(defvar gnus-custom-group)
:doc ,(nth 2 entry)
(const :format "" ,(nth 0 entry))
,(nth 1 entry)))
- gnus-group-parameters)))
+ (append gnus-group-parameters
+ (if group
+ gnus-extra-group-parameters
+ gnus-extra-topic-parameters)))))
(unless (or group topic)
(error "No group on current line"))
(when (and group topic)
(eval-and-compile
(let ((case-fold-search t))
(cond
- ((string-match "windows-nt\\|os/2\\|emx" (symbol-name system-type))
+ ((string-match "windows-nt\\|os/2\\|emx\\|cygwin32"
+ (symbol-name system-type))
(setq nnheader-file-name-translation-alist
(append nnheader-file-name-translation-alist
'((?: . ?_)
(eval `(nndoc-address
,(let ((file (nnheader-find-etc-directory
"gnus-tut.txt" t)))
- (or file
- (error "Couldn't find doc group"))
+ (unless file
+ (error "Couldn't find doc group"))
file))))))
"*Alist of useful group-server pairs."
:group 'gnus-group-listing
If REQUEST-ONLY, don't actually read the group; just request it.
If SELECT-ARTICLES, only select those articles.
-Return the name of the group is selection was successful."
+Return the name of the group if selection was successful."
;; Transform the select method into a unique server.
(when (stringp method)
(setq method (gnus-server-to-method method)))
(when (stringp method)
(setq method (or (gnus-server-to-method method) method)))
- (let* ((meth (when (and method
- (not (gnus-server-equal method gnus-select-method)))
- (if address (list (intern method) address)
- method)))
+ (let* ((meth (gnus-method-simplify
+ (when (and method
+ (not (gnus-server-equal method gnus-select-method)))
+ (if address (list (intern method) address)
+ method))))
(nname (if method (gnus-group-prefixed-name name meth) name))
backend info)
(when (gnus-gethash nname gnus-newsrc-hashtb)
(cons (current-buffer)
(if (eq major-mode 'gnus-summary-mode) 'summary 'group))))))
+(defvar nnwarchive-type-definition)
+(defvar gnus-group-warchive-type-history nil)
+(defvar gnus-group-warchive-login-history nil)
+(defvar gnus-group-warchive-address-history nil)
+
+(defun gnus-group-make-warchive-group ()
+ "Create a nnwarchive group."
+ (interactive)
+ (require 'nnwarchive)
+ (let* ((group (gnus-read-group "Group name: "))
+ (default-type (or (car gnus-group-warchive-type-history)
+ (symbol-name (caar nnwarchive-type-definition))))
+ (type
+ (gnus-string-or
+ (completing-read
+ (format "Warchive type (default %s): " default-type)
+ (mapcar (lambda (elem) (list (symbol-name (car elem))))
+ nnwarchive-type-definition)
+ nil t nil 'gnus-group-warchive-type-history)
+ default-type))
+ (address (read-string "Warchive address: "
+ nil 'gnus-group-warchive-address-history))
+ (default-login (or (car gnus-group-warchive-login-history)
+ user-mail-address))
+ (login
+ (gnus-string-or
+ (read-string
+ (format "Warchive login (default %s): " user-mail-address)
+ default-login 'gnus-group-warchive-login-history)
+ user-mail-address))
+ (method
+ `(nnwarchive ,address
+ (nnwarchive-type ,(intern type))
+ (nnwarchive-login ,login))))
+ (gnus-group-make-group group method)))
+
(defun gnus-group-make-archive-group (&optional all)
"Create the (ding) Gnus archive group of the most recent articles.
Given a prefix, create a full group."
(interactive)
;; First we make sure that we have really read the active file.
(unless (gnus-read-active-file-p)
- (let ((gnus-read-active-file t))
+ (let ((gnus-read-active-file t)
+ (gnus-agent nil)) ; Trick the agent into ignoring the active file.
(gnus-read-active-file)))
;; Find all groups and sort them.
(let ((groups
(defun gnus-server-opened (gnus-command-method)
"Check whether a connection to GNUS-COMMAND-METHOD has been opened."
- (when (stringp gnus-command-method)
- (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
- (funcall (inline (gnus-get-function gnus-command-method 'server-opened))
- (nth 1 gnus-command-method)))
+ (unless (eq (gnus-server-status gnus-command-method)
+ 'denied)
+ (when (stringp gnus-command-method)
+ (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
+ (funcall (inline (gnus-get-function gnus-command-method 'server-opened))
+ (nth 1 gnus-command-method))))
(defun gnus-status-message (gnus-command-method)
"Return the status message from GNUS-COMMAND-METHOD.
(skip-chars-forward " \t\n")
(setq save-pos (point)
info nil)
- (skip-chars-forward "^/;")
+ (skip-chars-forward "^/; \t\n")
(downcase-region save-pos (point))
(setq major (buffer-substring save-pos (point)))
- (skip-chars-forward "/ \t\n")
- (setq save-pos (point))
- (skip-chars-forward "^;")
- (downcase-region save-pos (point))
- (setq minor
- (cond
- ((eq ?* (or (char-after save-pos) 0)) ".*")
- ((= (point) save-pos) ".*")
- (t (regexp-quote (buffer-substring save-pos (point))))))
- (skip-chars-forward "; \t\n")
+ (skip-chars-forward " \t\n")
+ (setq minor "")
+ (when (eq (char-after) ?/)
+ (forward-char)
+ (skip-chars-forward " \t\n")
+ (setq save-pos (point))
+ (skip-chars-forward "^; \t\n")
+ (downcase-region save-pos (point))
+ (setq minor
+ (cond
+ ((eq ?* (or (char-after save-pos) 0)) ".*")
+ ((= (point) save-pos) ".*")
+ (t (regexp-quote (buffer-substring save-pos (point)))))))
+ (skip-chars-forward " \t\n")
;;; Got the major/minor chunks, now for the viewers/etc
;;; The first item _must_ be a viewer, according to the
;;; RFC for mailcap files (#1343)
- (skip-chars-forward "; \t\n")
- (setq save-pos (point))
- (skip-chars-forward "^;\n")
- ;;; skip \;
- (while (eq (char-before) ?\\)
- (backward-delete-char 1)
- (skip-chars-forward ";")
- (skip-chars-forward "^;\n"))
- (if (eq (or (char-after save-pos) 0) ?')
- (setq viewer (progn
- (narrow-to-region (1+ save-pos) (point))
- (goto-char (point-min))
- (prog1
- (read (current-buffer))
- (goto-char (point-max))
- (widen))))
- (setq viewer (buffer-substring save-pos (point))))
+ (setq viewer "")
+ (when (eq (char-after) ?\;)
+ (forward-char)
+ (skip-chars-forward " \t\n")
+ (setq save-pos (point))
+ (skip-chars-forward "^;\n")
+ ;; skip \;
+ (while (eq (char-before) ?\\)
+ (backward-delete-char 1)
+ (forward-char)
+ (skip-chars-forward "^;\n"))
+ (if (eq (or (char-after save-pos) 0) ?')
+ (setq viewer (progn
+ (narrow-to-region (1+ save-pos) (point))
+ (goto-char (point-min))
+ (prog1
+ (read (current-buffer))
+ (goto-char (point-max))
+ (widen))))
+ (setq viewer (buffer-substring save-pos (point)))))
(setq save-pos (point))
(end-of-line)
- (setq info (nconc (list (cons 'viewer viewer)
- (cons 'type (concat major "/"
- (if (string= minor ".*")
- "*" minor))))
- (mailcap-parse-mailcap-extras save-pos (point))))
- (mailcap-mailcap-entry-passes-test info)
- (mailcap-add-mailcap-entry major minor info)))))
+ (unless (equal viewer "")
+ (setq info (nconc (list (cons 'viewer viewer)
+ (cons 'type (concat major "/"
+ (if (string= minor ".*")
+ "*" minor))))
+ (mailcap-parse-mailcap-extras save-pos (point))))
+ (mailcap-mailcap-entry-passes-test info)
+ (mailcap-add-mailcap-entry major minor info))))))
(defun mailcap-parse-mailcap-extras (st nd)
;; Grab all the extra stuff from a mailcap entry
(require 'message)
(require 'gnus-art)
-(defcustom gnus-post-method nil
+(defcustom gnus-post-method 'current
"*Preferred method for posting USENET news.
If this variable is `current', Gnus will use the \"current\" select
method when posting. If it is nil (which is the default), Gnus will
-use the native posting method of the server.
+use the native select method when posting.
This method will not be used in mail groups and the like, only in
\"real\" newsgroups.
"c" gnus-summary-cancel-article
"s" gnus-summary-supersede-article
"r" gnus-summary-reply
+ "y" gnus-summary-yank-message
"R" gnus-summary-reply-with-original
"w" gnus-summary-wide-reply
"W" gnus-summary-wide-reply-with-original
(when (get-buffer "*Gnus Help Bug*")
(kill-buffer "*Gnus Help Bug*")))
+(defun gnus-summary-yank-message (buffer n)
+ "Yank the current article into a composed message."
+ (interactive
+ (list (completing-read "Buffer: " (mapcar 'list (message-buffers)) nil t)
+ current-prefix-arg))
+ (gnus-summary-iterate n
+ (let ((gnus-display-mime-function nil)
+ (gnus-inhibit-treatment t))
+ (gnus-summary-select-article))
+ (save-excursion
+ (set-buffer buffer)
+ (message-yank-buffer gnus-article-buffer))))
+
(defun gnus-debug ()
"Attempts to go through the Gnus source file and report what variables have been changed.
The source file has to be in the Emacs load path."
;; Go through all styles and look for matches.
(dolist (style styles)
(setq match (pop style))
+ (goto-char (point-min))
(when (cond
((stringp match)
;; Regexp string match on the group name.
(string-match match group))
+ ((eq match 'header)
+ (let ((header (message-fetch-field (pop style))))
+ (and header
+ (string-match (pop style) header))))
((or (symbolp match)
(gnus-functionp match))
(cond
(setq element 'signature
filep t))
;; Get the contents of file elems.
- (when filep
+ (when (and filep v)
(setq v (with-temp-buffer
(insert-file-contents v)
(buffer-string))))
`(lambda ()
(save-excursion
(let ((message-signature ,(cdr result)))
- (message-insert-signature)))))
+ (when message-signature
+ (message-insert-signature))))))
(t
(let ((header
(if (symbolp (car result))
(when (or name address)
(add-hook 'message-setup-hook
`(lambda ()
- (let ((user-full-name ,(or (cdr name) user-full-name))
+ (let ((user-full-name ,(or (cdr name) (user-full-name)))
(user-mail-address
,(or (cdr address) user-mail-address)))
(save-excursion
:group 'picons)
(defcustom gnus-picons-file-suffixes
- (if (featurep 'x)
- (let ((types (list "xbm")))
- (if (featurep 'gif)
- (setq types (cons "gif" types)))
- (if (featurep 'xpm)
- (setq types (cons "xpm" types)))
- types))
+ (when (featurep 'x)
+ (let ((types (list "xbm")))
+ (when (featurep 'gif)
+ (setq types (cons "gif" types)))
+ (when (featurep 'xpm)
+ (setq types (cons "xpm" types)))
+ types))
"*List of suffixes on picon file names to try."
:type '(repeat string)
:group 'picons)
(when arg
(gnus-pick-goto-article arg))
(if gnus-thread-hide-subtree
- (gnus-uu-mark-thread)
+ (progn
+ (save-excursion
+ (gnus-uu-mark-thread))
+ (forward-line 1))
(gnus-summary-mark-as-processable 1)))
(defun gnus-pick-unmark-article-or-thread (&optional arg)
(when arg
(gnus-pick-goto-article arg))
(if gnus-thread-hide-subtree
- (gnus-uu-unmark-thread)
+ (save-excursion
+ (gnus-uu-unmark-thread))
(gnus-summary-unmark-as-processable 1)))
(defun gnus-pick-mouse-pick (e)
(while cache
(current-buffer)
(setq entry (pop cache)
- file (car entry)
+ file (nnheader-translate-file-chars (car entry) t)
score (cdr entry))
(if (or (not (equal (gnus-score-get 'touched score) '(t)))
(gnus-score-get 'read-only score)
;; SPEC-ALIST and returns a list that can be eval'ed to return the
;; string. If the FORMAT string contains the specifiers %( and %)
;; the text between them will have the mouse-face text property.
- ;; If the FORMAT string contains the specifiers %< and %>, the text between
+ ;; If the FORMAT string contains the specifiers %[ and %], the text between
;; them will have the balloon-help text property.
(if (string-match
- "\\`\\(.*\\)%[0-9]?[{(<]\\(.*\\)%[0-9]?[})>]\\(.*\n?\\)\\'"
+ "\\`\\(.*\\)%[0-9]?[{(«]\\(.*\\)%[0-9]?[»})]\\(.*\n?\\)\\'"
format)
(gnus-parse-complex-format format spec-alist)
;; This is a simple format.
(replace-match "\\\"" nil t))
(goto-char (point-min))
(insert "(\"")
- (while (re-search-forward "%\\([0-9]+\\)?\\([{}()<>]\\)" nil t)
+ (while (re-search-forward "%\\([0-9]+\\)?\\([«»{}()]\\)" nil t)
(let ((number (if (match-beginning 1)
(match-string 1) "0"))
(delim (aref (match-string 2) 0)))
(if (or (= delim ?\()
(= delim ?\{)
- (= delim ?\<))
+ (= delim ?\«))
(replace-match (concat "\"("
(cond ((= delim ?\() "mouse")
((= delim ?\{) "face")
(delete-matching-lines gnus-ignored-newsgroups))
(while (not (eobp))
(ignore-errors
- (push (cons (let ((p (point)))
- (skip-chars-forward "^ \t")
- (buffer-substring p (point)))
- (max 0 (- (1+ (read cur)) (read cur))))
+ (push (cons
+ (if (eq (char-after) ?\")
+ (read cur)
+ (let ((p (point)) (name ""))
+ (skip-chars-forward "^ \t\\\\")
+ (setq name (buffer-substring p (point)))
+ (while (eq (char-after) ?\\)
+ (setq p (1+ (point)))
+ (forward-char 2)
+ (skip-chars-forward "^ \t\\\\")
+ (setq name (concat name (buffer-substring
+ p (point)))))
+ name))
+ (max 0 (- (1+ (read cur)) (read cur))))
groups))
(forward-line))))
(setq groups (sort groups
nil nil (if (gnus-server-equal
gnus-browse-current-method "native")
nil
- gnus-browse-current-method))
+ (gnus-method-simplify
+ gnus-browse-current-method)))
gnus-level-default-subscribed gnus-level-killed
(and (car (nth 1 gnus-newsrc-alist))
(gnus-gethash (car (nth 1 gnus-newsrc-alist))
(const some)
(const t)))
-(defcustom gnus-level-subscribed 5
- "*Groups with levels less than or equal to this variable are subscribed."
- :group 'gnus-group-levels
- :type 'integer)
+(defconst gnus-level-subscribed 5
+ "Groups with levels less than or equal to this variable are subscribed.")
-(defcustom gnus-level-unsubscribed 7
- "*Groups with levels less than or equal to this variable are unsubscribed.
+(defconst gnus-level-unsubscribed 7
+ "Groups with levels less than or equal to this variable are unsubscribed.
Groups with levels less than `gnus-level-subscribed', which should be
-less than this variable, are subscribed."
- :group 'gnus-group-levels
- :type 'integer)
+less than this variable, are subscribed.")
-(defcustom gnus-level-zombie 8
- "*Groups with this level are zombie groups."
- :group 'gnus-group-levels
- :type 'integer)
+(defconst gnus-level-zombie 8
+ "Groups with this level are zombie groups.")
-(defcustom gnus-level-killed 9
- "*Groups with this level are killed."
- :group 'gnus-group-levels
- :type 'integer)
+(defconst gnus-level-killed 9
+ "Groups with this level are killed.")
(defcustom gnus-level-default-subscribed 3
"*New subscribed groups will be subscribed at this level."
(mapconcat 'identity
'("^to\\." ; not "real" groups
"^[0-9. \t]+ " ; all digits in name
- "[][\"#'()]" ; bogus characters
+ "^[\"][]\"[#'()]" ; bogus characters
)
"\\|")
"*A regexp to match uninteresting newsgroups in the active file.
alphabetic order; `gnus-subscribe-hierarchically' inserts new groups
in hierarchical newsgroup order; `gnus-subscribe-interactively' asks
for your decision; `gnus-subscribe-killed' kills all new groups;
-`gnus-subscribe-zombies' will make all new groups into zombies."
+`gnus-subscribe-zombies' will make all new groups into zombies;
+`gnus-subscribe-topics' will enter groups into the topics that
+claim them."
:group 'gnus-group-new
:type '(radio (function-item gnus-subscribe-randomly)
(function-item gnus-subscribe-alphabetically)
(function-item gnus-subscribe-interactively)
(function-item gnus-subscribe-killed)
(function-item gnus-subscribe-zombies)
+ (function-item gnus-subscribe-topics)
function))
(defcustom gnus-subscribe-options-newsgroup-method
:type 'hook)
(defcustom gnus-after-getting-new-news-hook
- (if (gnus-boundp 'display-time-timer)
- '(display-time-event-handler))
+ (when (gnus-boundp 'display-time-timer)
+ '(display-time-event-handler))
"A hook run after Gnus checks for new news when Gnus is already running."
:group 'gnus-group-new
:type 'hook)
(when gnus-novice-user
(gnus-message 7 "`A k' to list killed groups"))))))
-(defun gnus-subscribe-group (group previous &optional method)
+
+(defun gnus-subscribe-group (group &optional previous method)
+ "Subcribe GROUP and put it after PREVIOUS."
(gnus-group-change-level
(if method
(list t group gnus-level-default-subscribed nil nil method)
group)
- gnus-level-default-subscribed gnus-level-killed previous t))
+ gnus-level-default-subscribed gnus-level-killed previous t)
+ t)
;; `gnus-group-change-level' is the fundamental function for changing
;; subscription levels of newsgroups. This might mean just changing
t)
(condition-case ()
(inline (gnus-request-group group dont-check method))
- (error nil)
+ ;(error nil)
(quit nil))
(setq active (gnus-parse-active))
;; If there are no articles in the group, the GROUP
gnus-activate-foreign-newsgroups)
(t 0))
level))
- info group active method)
+ info group active method retrievegroups)
(gnus-message 5 "Checking new news...")
(while newsrc
(setq active 'ignore))
;; Activate groups.
((not gnus-read-active-file)
+ (if (gnus-check-backend-function 'retrieve-groups group)
+ ;; if server support gnus-retrieve-groups we push
+ ;; the group onto retrievegroups for later checking
+ (if (assoc method retrievegroups)
+ (setcdr (assoc method retrievegroups)
+ (cons group (cdr (assoc method retrievegroups))))
+ (push (list method group) retrievegroups))
(setq active (gnus-activate-group group 'scan))
- (inline (gnus-close-group group)))))
+ (inline (gnus-close-group group))))))
;; Get the number of unread articles in the group.
(cond
;; The group couldn't be reached, so we nix out the number of
;; unread articles and stuff.
(gnus-set-active group nil)
- (setcar (gnus-gethash group gnus-newsrc-hashtb) t))))
+ (let ((tmp (gnus-gethash group gnus-newsrc-hashtb)))
+ (if tmp (setcar tmp t))))))
+
+ ;; iterate through groups on methods which support gnus-retrieve-groups
+ ;; and fetch a partial active file and use it to find new news.
+ (while retrievegroups
+ (let* ((mg (pop retrievegroups))
+ (method (or (car mg) gnus-select-method))
+ (groups (cdr mg)))
+ (gnus-check-server method)
+ ;; Request that the backend scan its incoming messages.
+ (when (gnus-check-backend-function 'request-scan (car method))
+ (gnus-request-scan nil method))
+ (gnus-read-active-file-2 (mapcar (lambda (group)
+ (gnus-group-real-name group))
+ groups) method)
+ (dolist (group groups)
+ (cond
+ ((setq active (gnus-active (gnus-info-group
+ (setq info (gnus-get-info group)))))
+ (inline (gnus-get-unread-articles-in-group info active t)))
+ (t
+ ;; The group couldn't be reached, so we nix out the number of
+ ;; unread articles and stuff.
+ (gnus-set-active group nil)
+ (setcar (gnus-gethash group gnus-newsrc-hashtb) t))))))
(gnus-message 5 "Checking new news...done")))
;; Also read from the archive server.
(when (gnus-archive-server-wanted-p)
(list "archive")))))
- method where mesg list-type)
+ method)
(setq gnus-have-read-active-file nil)
(save-excursion
(set-buffer nntp-server-buffer)
(while (setq method (pop methods))
+ ;; Only do each method once, in case the methods appear more
+ ;; than once in this list.
(unless (member method methods)
- (setq where (nth 1 method)
- mesg (format "Reading active file%s via %s..."
- (if (and where (not (zerop (length where))))
- (concat " from " where) "")
- (car method)))
+ (condition-case ()
+ (gnus-read-active-file-1 method force)
+ ;; We catch C-g so that we can continue past servers
+ ;; that do not respond.
+ (quit nil)))))))
+
+(defun gnus-read-active-file-1 (method force)
+ (let (where mesg)
+ (setq where (nth 1 method)
+ mesg (format "Reading active file%s via %s..."
+ (if (and where (not (zerop (length where))))
+ (concat " from " where) "")
+ (car method)))
+ (gnus-message 5 mesg)
+ (when (gnus-check-server method)
+ ;; Request that the backend scan its incoming messages.
+ (when (gnus-check-backend-function 'request-scan (car method))
+ (gnus-request-scan nil method))
+ (cond
+ ((and (eq gnus-read-active-file 'some)
+ (gnus-check-backend-function 'retrieve-groups (car method))
+ (not force))
+ (let ((newsrc (cdr gnus-newsrc-alist))
+ (gmethod (gnus-server-get-method nil method))
+ groups info)
+ (while (setq info (pop newsrc))
+ (when (inline
+ (gnus-server-equal
+ (inline
+ (gnus-find-method-for-group
+ (gnus-info-group info) info))
+ gmethod))
+ (push (gnus-group-real-name (gnus-info-group info))
+ groups)))
+ (gnus-read-active-file-2 groups method)))
+ ((null method)
+ t)
+ (t
+ (if (not (gnus-request-list method))
+ (unless (equal method gnus-message-archive-method)
+ (gnus-error 1 "Cannot read active file from %s server"
+ (car method)))
(gnus-message 5 mesg)
- (when (gnus-check-server method)
- ;; Request that the backend scan its incoming messages.
- (when (gnus-check-backend-function 'request-scan (car method))
- (gnus-request-scan nil method))
- (cond
- ((and (eq gnus-read-active-file 'some)
- (gnus-check-backend-function 'retrieve-groups (car method))
- (not force))
- (let ((newsrc (cdr gnus-newsrc-alist))
- (gmethod (gnus-server-get-method nil method))
- groups info)
- (while (setq info (pop newsrc))
- (when (inline
- (gnus-server-equal
- (inline
- (gnus-find-method-for-group
- (gnus-info-group info) info))
- gmethod))
- (push (gnus-group-real-name (gnus-info-group info))
- groups)))
- (when groups
- (gnus-check-server method)
- (setq list-type (gnus-retrieve-groups groups method))
- (cond
- ((not list-type)
- (gnus-error
- 1.2 "Cannot read partial active file from %s server."
- (car method)))
- ((eq list-type 'active)
- (gnus-active-to-gnus-format
- method gnus-active-hashtb nil t))
- (t
- (gnus-groups-to-gnus-format
- method gnus-active-hashtb t))))))
- ((null method)
- t)
- (t
- (if (not (gnus-request-list method))
- (unless (equal method gnus-message-archive-method)
- (gnus-error 1 "Cannot read active file from %s server"
- (car method)))
- (gnus-message 5 mesg)
- (gnus-active-to-gnus-format method gnus-active-hashtb nil t)
- ;; We mark this active file as read.
- (push method gnus-have-read-active-file)
- (gnus-message 5 "%sdone" mesg))))))))))
-
+ (gnus-active-to-gnus-format method gnus-active-hashtb nil t)
+ ;; We mark this active file as read.
+ (push method gnus-have-read-active-file)
+ (gnus-message 5 "%sdone" mesg)))))))
+
+(defun gnus-read-active-file-2 (groups method)
+ "Read an active file for GROUPS in METHOD using gnus-retrieve-groups."
+ (when groups
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (gnus-check-server method)
+ (let ((list-type (gnus-retrieve-groups groups method)))
+ (cond ((not list-type)
+ (gnus-error
+ 1.2 "Cannot read partial active file from %s server."
+ (car method)))
+ ((eq list-type 'active)
+ (gnus-active-to-gnus-format method gnus-active-hashtb nil t))
+ (t
+ (gnus-groups-to-gnus-format method gnus-active-hashtb t)))))))
+
;; Read an active file and place the results in `gnus-active-hashtb'.
(defun gnus-active-to-gnus-format (&optional method hashtb ignore-errors
real-active)
(t
(delete-matching-lines (concat "^to\\.\\|" gnus-ignored-newsgroups))))
- ;; Make the group names readable as a lisp expression even if they
- ;; contain special characters.
- (goto-char (point-max))
- (while (re-search-backward "[][';?()#]" nil t)
- (insert ?\\))
+ (goto-char (point-min))
+ (unless (re-search-forward "[\\\"]" nil t)
+ ;; Make the group names readable as a lisp expression even if they
+ ;; contain special characters.
+ (goto-char (point-max))
+ (while (re-search-backward "[][';?()#]" nil t)
+ (insert ?\\)))
;; Let the Gnus agent save the active file.
(when (and gnus-agent real-active gnus-plugged)
(let ((prefix (gnus-group-prefixed-name "" method)))
(goto-char (point-min))
(while (and (not (eobp))
- (progn (insert prefix)
- (zerop (forward-line 1)))))))
+ (progn
+ (when (= (following-char) ?\")
+ (forward-char 1))
+ (insert prefix)
+ (zerop (forward-line 1)))))))
;; Store the active file in a hash table.
(goto-char (point-min))
(let (group max min)
(while (not (eobp))
- (condition-case ()
+ (condition-case err
(progn
(narrow-to-region (point) (gnus-point-at-eol))
;; group gets set to a symbol interned in the hash table
;; (what a hack!!) - jwz
(setq group (let ((obarray hashtb)) (read cur)))
+ ;; ### The extended group name scheme makes
+ ;; the previous optimization strategy sort of pointless...
+ (when (stringp group)
+ (setq group (intern group hashtb)))
(if (and (numberp (setq max (read cur)))
(numberp (setq min (read cur)))
(progn
;; Call the function above at C-x C-c.
(defadvice save-buffers-kill-emacs (before save-gnus-newsrc-file-maybe activate)
"Save .newsrc and .newsrc.eld when Emacs is killed."
- (if (get-buffer gnus-group-buffer)
- (progn
- (gnus-run-hooks 'gnus-exit-gnus-hook)
- (gnus-offer-save-summaries)
- (gnus-save-newsrc-file))))
+ (when (get-buffer gnus-group-buffer)
+ (gnus-run-hooks 'gnus-exit-gnus-hook)
+ (gnus-offer-save-summaries)
+ (gnus-save-newsrc-file)))
(defun gnus-gnus-to-quick-newsrc-format ()
"Insert Gnus variables such as gnus-newsrc-alist in lisp format."
(let ((gnus-newsgroup-dormant nil))
(gnus-summary-initial-limit show-all))
(gnus-summary-initial-limit show-all))
+ ;; When untreaded, all articles are always shown.
(setq gnus-newsgroup-limit
(mapcar
(lambda (header) (mail-header-number header))
(defun gnus-build-sparse-threads ()
(let ((headers gnus-newsgroup-headers)
+ (mail-parse-charset gnus-newsgroup-charset)
(gnus-summary-ignore-duplicates t)
header references generation relations
subject child end new-child date)
;; fetch the headers for the articles that aren't there. This will
;; build complete threads - if the roots haven't been expired by the
;; server, that is.
- (let (id heads)
+ (let ((mail-parse-charset gnus-newsgroup-charset)
+ id heads)
(mapatoms
(lambda (refs)
(when (not (car (symbol-value refs)))
(defun gnus-build-all-threads ()
"Read all the headers."
(let ((gnus-summary-ignore-duplicates t)
+ (mail-parse-charset gnus-newsgroup-charset)
(dependencies gnus-newsgroup-dependencies)
header article)
(save-excursion
(while (not (eobp))
(ignore-errors
(setq article (read (current-buffer))
- header (gnus-nov-parse-line
- article dependencies)))
+ header (gnus-nov-parse-line article dependencies)))
(when header
(save-excursion
(set-buffer gnus-summary-buffer)
(memq number gnus-newsgroup-processable))))))
(defun gnus-summary-remove-list-identifiers ()
- "Remove list identifiers in `gnus-list-identifiers' from articles in
-the current group."
+ "Remove list identifiers in `gnus-list-identifiers' from articles in the current group."
(let ((regexp (if (stringp gnus-list-identifiers)
gnus-list-identifiers
(mapconcat 'identity gnus-list-identifiers " *\\|"))))
- (when regexp
- (dolist (header gnus-newsgroup-headers)
- (when (string-match (concat "\\(Re: +\\)?\\(" regexp " *\\)")
- (mail-header-subject header))
- (mail-header-set-subject
- header (concat (substring (mail-header-subject header)
- 0 (match-beginning 2))
- (substring (mail-header-subject header)
- (match-end 2)))))))))
+ (dolist (header gnus-newsgroup-headers)
+ (when (string-match (concat "\\(Re: +\\)?\\(" regexp " *\\)")
+ (mail-header-subject header))
+ (mail-header-set-subject
+ header (concat (substring (mail-header-subject header)
+ 0 (match-beginning 2))
+ (substring (mail-header-subject header)
+ (match-end 2))))))))
(defun gnus-select-newsgroup (group &optional read-all select-articles)
"Select newsgroup GROUP.
;; whichever is the least.
(set-window-start
window (min bottom (save-excursion
- (forward-line (- top)) (point)))))
+ (forward-line (- top)) (point)))
+ t))
;; Do horizontal recentering while we're at it.
(when (and (get-buffer-window (current-buffer) t)
(not (eq gnus-auto-center-summary 'vertical)))
(when (and (vectorp (gnus-data-header d))
(setq date (mail-header-date (gnus-data-header d))))
(setq is-younger (time-less-p
- (time-since (date-to-time date))
+ (time-since (condition-case ()
+ (date-to-time date)
+ (error '(0 0))))
cutoff))
(when (if younger-p
is-younger
"Go forwards in the thread until we find an article that we want to display."
(when (or (eq gnus-fetch-old-headers 'some)
(eq gnus-fetch-old-headers 'invisible)
+ (numberp gnus-fetch-old-headers)
(eq gnus-build-sparse-threads 'some)
(eq gnus-build-sparse-threads 'more))
;; Deal with old-fetched headers and sparse threads.
"Cut off all uninteresting articles from the beginning of threads."
(when (or (eq gnus-fetch-old-headers 'some)
(eq gnus-fetch-old-headers 'invisible)
+ (numberp gnus-fetch-old-headers)
(eq gnus-build-sparse-threads 'some)
(eq gnus-build-sparse-threads 'more))
(let ((th threads))
(if (or gnus-inhibit-limiting
(and (null gnus-newsgroup-dormant)
(not (eq gnus-fetch-old-headers 'some))
+ (not (numberp gnus-fetch-old-headers))
(not (eq gnus-fetch-old-headers 'invisible))
(null gnus-summary-expunge-below)
(not (eq gnus-build-sparse-threads 'some))
(zerop children))
;; If this is "fetch-old-headered" and there is no
;; visible children, then we don't want this article.
- (and (eq gnus-fetch-old-headers 'some)
+ (and (or (eq gnus-fetch-old-headers 'some)
+ (numberp gnus-fetch-old-headers))
(gnus-summary-article-ancient-p number)
(zerop children))
;; If this is "fetch-old-headered" and `invisible', then
(gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name))
(gnus-summary-limit-include-thread id)))
-(defun gnus-summary-refer-article (message-id &optional arg)
- "Fetch an article specified by MESSAGE-ID.
-If ARG (the prefix), fetch the article using `gnus-refer-article-method'
-or `gnus-select-method', no matter what backend the article comes from."
- (interactive "sMessage-ID: \nP")
+(defun gnus-summary-refer-article (message-id)
+ "Fetch an article specified by MESSAGE-ID."
+ (interactive "sMessage-ID: ")
(when (and (stringp message-id)
(not (zerop (length message-id))))
;; Construct the correct Message-ID if necessary.
(gnus-summary-article-sparse-p
(mail-header-number header))
(memq (mail-header-number header)
- gnus-newsgroup-limit))))
+ gnus-newsgroup-limit)))
+ number)
(cond
;; If the article is present in the buffer we just go to it.
((and header
(when sparse
(gnus-summary-update-article (mail-header-number header)))))
(t
- ;; We fetch the article
- (let ((gnus-override-method
- (cond ((gnus-news-group-p gnus-newsgroup-name)
- gnus-refer-article-method)
- (arg
- (or gnus-refer-article-method gnus-select-method))
- (t nil)))
- number)
- ;; Start the special refer-article method, if necessary.
- (when (and gnus-refer-article-method
- (gnus-news-group-p gnus-newsgroup-name))
- (gnus-check-server gnus-refer-article-method))
- ;; Fetch the header, and display the article.
- (if (setq number (gnus-summary-insert-subject message-id))
+ ;; We fetch the article.
+ (catch 'found
+ (dolist (gnus-override-method
+ (cond ((null gnus-refer-article-method)
+ (list 'current gnus-select-method))
+ ((consp (car gnus-refer-article-method))
+ gnus-refer-article-method)
+ (t
+ (list gnus-refer-article-method))))
+ (when (eq 'current gnus-override-method)
+ (setq gnus-override-method gnus-current-select-method))
+ (gnus-check-server gnus-override-method)
+ ;; Fetch the header, and display the article.
+ (when (setq number (gnus-summary-insert-subject message-id))
(gnus-summary-select-article nil nil nil number)
- (gnus-message 3 "Couldn't fetch article %s" message-id))))))))
+ (throw 'found t)))
+ (gnus-message 3 "Couldn't fetch article %s" message-id)))))))
(defun gnus-summary-edit-parameters ()
"Edit the group parameters of the current group."
(interactive "P")
(gnus-summary-catchup-and-exit t quietly))
-;; Suggested by "Arne Eofsson" <arne@hodgkin.mbi.ucla.edu>.
(defun gnus-summary-catchup-and-goto-next-group (&optional all)
"Mark all articles in this group as read and select the next group.
If given a prefix, mark all articles, unread as well as ticked, as
(interactive "P")
(save-excursion
(gnus-summary-catchup all))
- (gnus-summary-next-group t nil nil))
+ (gnus-summary-next-group))
;; Thread-based commands.
to-newsgroup))
(or (and (gnus-request-create-group
to-newsgroup (gnus-group-name-to-method to-newsgroup))
- (gnus-activate-group to-newsgroup nil nil
- (gnus-group-name-to-method
- to-newsgroup)))
+ (gnus-activate-group
+ to-newsgroup nil nil
+ (gnus-group-name-to-method to-newsgroup))
+ (gnus-subscribe-group to-newsgroup))
(error "Couldn't create group %s" to-newsgroup)))
(error "No such group: %s" to-newsgroup)))
to-newsgroup))
(let* ((top (gnus-topic-find-topology
(gnus-topic-parent-topic topic)))
(tp (reverse (cddr top))))
- (while (not (equal (caaar tp) topic))
- (setq tp (cdr tp)))
- (pop tp)
- (while (and tp
- (not (gnus-topic-goto-topic (caaar tp))))
- (pop tp))
- (if tp
- (gnus-topic-forward-topic 1)
- (gnus-topic-goto-missing-topic (caadr top))))
+ (if (not top)
+ (gnus-topic-insert-topic-line
+ topic t t (car (gnus-topic-find-topology topic)) nil 0)
+ (while (not (equal (caaar tp) topic))
+ (setq tp (cdr tp)))
+ (pop tp)
+ (while (and tp
+ (not (gnus-topic-goto-topic (caaar tp))))
+ (pop tp))
+ (if tp
+ (gnus-topic-forward-topic 1)
+ (gnus-topic-goto-missing-topic (caadr top)))))
nil))
(defun gnus-topic-update-topic-line (topic-name &optional reads)
(gnus-group-list-groups)
(gnus-topic-goto-topic current)))
+(defun gnus-subscribe-topics (newsgroup)
+ (catch 'end
+ (let (match gnus-group-change-level-function)
+ (dolist (topic (gnus-topic-list))
+ (when (and (setq match (cdr (assq 'subscribe
+ (gnus-topic-parameters topic))))
+ (string-match match newsgroup))
+ ;; Just subscribe the group.
+ (gnus-subscribe-alphabetically newsgroup)
+ ;; Add the group to the topic.
+ (nconc (assoc topic gnus-topic-alist) (list newsgroup))
+ (throw 'end t))))))
+
(provide 'gnus-topic)
;;; gnus-topic.el ends here
(defun gnus-dd-mmm (messy-date)
"Return a string like DD-MMM from a big messy string."
- (format-time-string "%d-%b" (safe-date-to-time messy-date)))
+ (condition-case ()
+ (format-time-string "%d-%b" (safe-date-to-time messy-date))
+ (error " - ")))
(defmacro gnus-date-get-time (date)
"Convert DATE string to Emacs time.
(when (and sym
(boundp sym)
(symbol-value sym))
- (insert (format "%s %d %d y\n"
+ (insert (format "%S %d %d y\n"
(if full-names
- (symbol-name sym)
- (gnus-group-real-name (symbol-name sym)))
+ sym
+ (intern (gnus-group-real-name (symbol-name sym))))
(or (cdr (symbol-value sym))
(car (symbol-value sym)))
(car (symbol-value sym))))))
- hashtb))))
+ hashtb)
+ (goto-char (point-max))
+ (while (search-backward "\\." nil t)
+ (delete-char 1)))))
(defun gnus-union (a b)
"Add members of list A to list B
(interactive)
(gnus-save-hidden-threads
(let ((level (gnus-summary-thread-level)))
- (while (and (gnus-summary-set-process-mark (gnus-summary-article-number))
- (zerop (gnus-summary-next-subject 1))
+ (while (and (gnus-summary-set-process-mark
+ (gnus-summary-article-number))
+ (zerop (gnus-summary-next-subject 1 nil t))
(> (gnus-summary-thread-level) level)))))
(gnus-summary-position-point))
;; Set the window start to either `bottom', which is the biggest
;; possible valid number, or the second line from the top,
;; whichever is the least.
+ ;; NOFORCE parameter suggested by Daniel Pittman <daniel@danann.net>.
(set-window-start
- window (min bottom (save-excursion (forward-line (- top)) (point)))))
+ window (min bottom (save-excursion (forward-line (- top)) (point)))
+ t))
;; Do horizontal recentering while we're at it.
(when (and (get-buffer-window (current-buffer) t)
(not (eq gnus-auto-center-summary 'vertical)))
find-charset-region
find-coding-systems-region get-charset-property
coding-system-get w3-region
- w3-coding-system-for-mime-charset
+ w3-coding-system-for-mime-charset
rmail-summary-exists rmail-select-summary
rmail-update-summary url-retrieve
- temp-directory babel-fetch babel-wash babel-as-string
- sc-cite-regexp))
+ temp-directory babel-fetch babel-wash
+ find-coding-systems-for-charsets sc-cite-regexp))
(maybe-bind '(global-face-data
mark-active transient-mark-mode mouse-selection-click-count
mouse-selection-click-count-buffer buffer-display-table
(maybe-fbind '(color-instance-rgb-components
temp-directory
glyph-width annotation-glyph window-pixel-width glyph-height
- window-pixel-height
+ window-pixel-height map-extents
make-color-instance color-instance-name specifier-instance
device-type device-class get-popup-menu-response event-object
x-defined-colors read-color add-submenu set-font-family
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
- smiley-encode-buffer function-max-args)))
+ babel-fetch babel-wash find-coding-systems-for-charsets
+ sc-cite-regexp smiley-encode-buffer function-max-args
+ map-extents)))
(setq load-path (cons "." load-path))
(require 'custom)
(:connection)
(:authentication password))
(maildir
- (:path "~/Maildir/new/"))
+ (:path "~/Maildir/new/")
+ (:function))
(imap
(:server (getenv "MAILHOST"))
(:port)
(:user (or (user-login-name) (getenv "LOGNAME") (getenv "USER")))
(:password)
(:mailbox "INBOX")
- (:predicate "UNSEEN UNDELETED")))
+ (:predicate "UNSEEN UNDELETED")
+ (:fetchflag "\Deleted")
+ (:dontexpunge))
+ (webmail
+ (:subtype hotmail)
+ (:user (or (user-login-name) (getenv "LOGNAME") (getenv "USER")))
+ (:password)
+ (:authentication password)))
"Mapping from keywords to default values.
All keywords that can be used must be listed here."))
(directory mail-source-fetch-directory)
(pop mail-source-fetch-pop)
(maildir mail-source-fetch-maildir)
- (imap mail-source-fetch-imap))
+ (imap mail-source-fetch-imap)
+ (webmail mail-source-fetch-webmail))
"A mapping from source type to fetcher function.")
(defvar mail-source-password-cache nil)
;; Return whether we moved successfully or not.
to)))
+(defun mail-source-movemail-and-remove (from to)
+ "Move FROM to TO using movemail, then remove FROM if empty."
+ (or (not (mail-source-movemail from to))
+ (not (zerop (nth 7 (file-attributes from))))
+ (delete-file from)))
+
(defvar mail-source-read-passwd nil)
(defun mail-source-read-passwd (prompt &rest args)
"Read a password using PROMPT.
(mail-source-string (format "maildir:%s" path)))
(dolist (file (directory-files path t))
(when (and (file-regular-p file)
- (not (rename-file file mail-source-crash-box)))
+ (not (if function
+ (funcall function file mail-source-crash-box)
+ (rename-file file mail-source-crash-box))))
(incf found (mail-source-callback callback file))))
found)))
(autoload 'imap-open "imap")
(autoload 'imap-authenticate "imap")
(autoload 'imap-mailbox-select "imap")
+ (autoload 'imap-mailbox-unselect "imap")
+ (autoload 'imap-mailbox-close "imap")
(autoload 'imap-search "imap")
(autoload 'imap-fetch "imap")
- (autoload 'imap-mailbox-unselect "imap")
(autoload 'imap-close "imap")
(autoload 'imap-error-text "imap")
+ (autoload 'imap-message-flags-add "imap")
+ (autoload 'imap-list-to-message-set "imap")
(autoload 'nnheader-ms-strip-cr "nnheader"))
(defun mail-source-fetch-imap (source callback)
(mail-source-bind (imap source)
(let ((found 0)
(buf (get-buffer-create (generate-new-buffer-name " *imap source*")))
- (mail-source-string (format "imap:%s:%s" server mailbox)))
+ (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-mailbox-select mailbox nil buf))
(with-temp-file mail-source-crash-box
;; if predicate is nil, use all uids
(dolist (uid (imap-search (or predicate "1:*") buf))
- (when (setq str (imap-fetch uid "RFC822" 'RFC822 nil buf))
+ (when (setq str (imap-fetch uid "RFC822.PEEK" 'RFC822 nil buf))
+ (push uid remove)
(insert "From imap " (current-time-string) "\n")
(save-excursion
(insert str "\n\n"))
(goto-char (point-max))))
(nnheader-ms-strip-cr))
(incf found (mail-source-callback callback server))
- (imap-mailbox-unselect buf)
+ (when (and remove fetchflag)
+ (imap-message-flags-add
+ (imap-list-to-message-set remove) fetchflag nil buf))
+ (if dontexpunge
+ (imap-mailbox-unselect buf)
+ (imap-mailbox-close buf))
(imap-close buf))
(imap-close buf)
(error (imap-error-text buf)))
(kill-buffer buf)
found)))
+(eval-and-compile
+ (autoload 'webmail-fetch "webmail"))
+
+(defun mail-source-fetch-webmail (source callback)
+ "Fetch for webmail source."
+ (mail-source-bind (webmail source)
+ (when (eq authentication 'password)
+ (setq password
+ (or password
+ (mail-source-read-passwd
+ (format "Password for %s at %s: " user subtype)))))
+ (webmail-fetch mail-source-crash-box subtype user password)
+ (mail-source-callback callback (symbol-name subtype))))
+
(provide 'mail-source)
;;; mail-source.el ends here
:type 'regexp
:group 'message-various)
-(defcustom message-elide-elipsis "\n[...]\n\n"
+(defcustom message-elide-ellipsis "\n[...]\n\n"
"*The string which is inserted for elided text."
:type 'string
:group 'message-various)
:type '(radio (function-item message-forward-subject-author-subject)
(function-item message-forward-subject-fwd)))
+(defcustom message-forward-as-mime t
+ "*If non-nil, forward messages as an inline/rfc822 MIME section. Otherwise, directly inline the old message in the forwarded message."
+ :group 'message-forwarding
+ :type 'boolean)
+
(defcustom message-wash-forwarded-subjects nil
"*If non-nil, try to remove as much old cruft as possible from the subject of messages before generating the new subject of a forward."
:group 'message-forwarding
:group 'message-interface
:type 'regexp)
-
(defcustom message-forward-ignored-headers nil
"*All headers that match this regexp will be deleted when forwarding a message."
:group 'message-forwarding
(when value
(while (string-match "\n[\t ]+" value)
(setq value (replace-match " " t t value)))
- ;; We remove all text props.delete-region
+ ;; We remove all text props.
(format "%s" value))))
(defun message-narrow-to-field ()
(define-key message-mode-map "\C-c\C-n" 'message-insert-newsgroups)
(define-key message-mode-map "\C-c\C-y" 'message-yank-original)
+ (define-key message-mode-map "\C-c\C-Y" 'message-yank-buffer)
(define-key message-mode-map "\C-c\C-q" 'message-fill-yanked-message)
(define-key message-mode-map "\C-c\C-w" 'message-insert-signature)
(define-key message-mode-map "\C-c\M-h" 'message-insert-headers)
C-c C-e message-elide-region (elide the text between point and mark).
C-c C-v message-delete-not-region (remove the text outside the region).
C-c C-z message-kill-to-signature (kill the text up to the signature).
-C-c C-r message-caesar-buffer-body (rot13 the message body)."
+C-c C-r message-caesar-buffer-body (rot13 the message body).
+M-RET message-newline-and-reformat (break the line and reformat)."
(interactive)
(kill-all-local-variables)
(set (make-local-variable 'message-reply-buffer) nil)
(defun message-newline-and-reformat ()
"Insert four newlines, and then reformat if inside quoted text."
(interactive)
- (let ((point (point))
- quoted)
- (save-excursion
- (beginning-of-line)
- (if (looking-at (sc-cite-regexp))
- (setq quoted (buffer-substring (match-beginning 0) (match-end 0)))))
- (insert "\n\n\n\n")
+ (let ((prefix "[]>»|:}+ \t]*")
+ (supercite-thing "[-._a-zA-Z0-9]*[>]+[ \t]*")
+ quoted point)
+ (unless (bolp)
+ (save-excursion
+ (beginning-of-line)
+ (when (looking-at (concat prefix
+ supercite-thing))
+ (setq quoted (match-string 0))))
+ (insert "\n"))
+ (setq point (point))
+ (insert "\n\n\n")
(delete-region (point) (re-search-forward "[ \t]*"))
(when quoted
(insert quoted))
(fill-paragraph nil)
(goto-char point)
- (forward-line 2)))
+ (forward-line 1)))
(defun message-insert-signature (&optional force)
"Insert a signature. See documentation for the `message-signature' variable."
(defun message-elide-region (b e)
"Elide the text between point and mark.
-An ellipsis (from `message-elide-elipsis') will be inserted where the
+An ellipsis (from `message-elide-ellipsis') will be inserted where the
text was killed."
(interactive "r")
(kill-region b e)
- (unless (bolp)
- (insert "\n"))
- (insert message-elide-elipsis))
+ (insert message-elide-ellipsis))
(defvar message-caesar-translation-table nil)
(unless (equal 0 (call-process-region
(point-min) (point-max) program t t))
(insert body)
- (message "%s failed." program))))))
+ (message "%s failed" program))))))
(defun message-rename-buffer (&optional enter-string)
"Rename the *message* buffer to \"*message* RECIPIENT\".
(unless modified
(setq message-checksum (message-checksum))))))
+(defun message-yank-buffer (buffer)
+ "Insert BUFFER into the current buffer and quote it."
+ (interactive "bYank buffer: ")
+ (let ((message-reply-buffer buffer))
+ (save-window-excursion
+ (message-yank-original))))
+
+(defun message-buffers ()
+ "Return a list of active message buffers."
+ (let (buffers)
+ (save-excursion
+ (dolist (buffer (buffer-list t))
+ (set-buffer buffer)
+ (when (and (eq major-mode 'message-mode)
+ (null message-sent-message-via))
+ (push (buffer-name buffer) buffers))))
+ (nreverse buffers)))
+
(defun message-cite-original-without-signature ()
"Cite function in the standard Message manner."
(let ((start (point))
(defun message-resend (address)
"Resend the current article to ADDRESS."
(interactive
- (list
- (let ((mail-abbrev-mode-regexp ""))
- (read-from-minibuffer
- "Resend message to: " nil message-mode-map))))
+ (list (message-read-from-minibuffer "Resend message to: ")))
(message "Resending message to %s..." address)
(save-excursion
(let ((cur (current-buffer))
(forward-line 1)
(insert "Content-Type: text/plain; charset=us-ascii\n")))))
+(defun message-read-from-minibuffer (prompt)
+ "Read from the minibuffer while providing abbrev expansion."
+ (if (fboundp 'mail-abbrevs-setup)
+ (let ((mail-abbrev-mode-regexp "")
+ (minibuffer-setup-hook 'mail-abbrevs-setup))
+ (read-from-minibuffer prompt)))
+ (let ((minibuffer-setup-hook 'mail-abbrev-minibuffer-setup-hook))
+ (read-string prompt)))
+
(defvar message-save-buffer " *encoding")
(defun message-save-drafts ()
(interactive)
;; BS, vertical TAB, form feed, and ^_
(defvar mm-8bit-char-regexp "[^\x20-\x7f\r\n\t\x7\x8\xb\xc\x1f]")
-(defvar mm-body-charset-encoding-alist
- '((us-ascii . 7bit)
- (iso-8859-1 . quoted-printable)
- (iso-8859-2 . quoted-printable)
- (iso-8859-3 . quoted-printable)
- (iso-8859-4 . quoted-printable)
- (iso-8859-5 . base64)
- (koi8-r . 8bit)
- (iso-8859-7 . quoted-printable)
- (iso-8859-8 . quoted-printable)
- (iso-8859-9 . quoted-printable)
- (iso-2022-jp . base64)
- (iso-2022-kr . base64)
- (gb2312 . base64)
- (cn-gb . base64)
- (cn-gb-2312 . base64)
- (euc-kr . 8bit)
- (iso-2022-jp-2 . base64)
- (iso-2022-int-1 . base64))
+(defvar mm-body-charset-encoding-alist nil
"Alist of MIME charsets to encodings.
Valid encodings are `7bit', `8bit', `quoted-printable' and `base64'.")
bits)
(t
(let ((encoding (or (cdr (assq charset mm-body-charset-encoding-alist))
- 'quoted-printable)))
+ (mm-qp-or-base64))))
(mm-encode-content-transfer-encoding encoding "text/plain")
encoding)))))
;;in XEmacs
(mm-multibyte-p)
(or (not (eq mule-charset 'ascii))
- (setq mule-charset mail-parse-charset)))
+ (setq mule-charset mail-parse-charset))
+ (not (eq mule-charset 'gnus-decoded)))
(mm-decode-coding-region (point-min) (point-max) mule-charset))))))
(defun mm-decode-string (string charset)
("text/plain" mm-inline-text identity)
("text/enriched" mm-inline-text identity)
("text/richtext" mm-inline-text identity)
+ ("text/x-patch" mm-display-patch-inline
+ (lambda (handle)
+ (locate-library "diff-mode")))
("text/html"
mm-inline-text
(lambda (handle)
("text/x-vcard"
mm-inline-text
(lambda (handle)
- (locate-library "vcard")))
+ (or (featurep 'vcard)
+ (locate-library "vcard"))))
("message/delivery-status" mm-inline-text identity)
("message/rfc822" mm-inline-message identity)
("text/.*" mm-inline-text identity)
(lambda (handle)
(and (or (featurep 'nas-sound) (featurep 'native-sound))
(device-sound-enabled-p))))
+ ("application/pgp-signature" ignore identity)
("multipart/alternative" ignore identity)
("multipart/mixed" ignore identity)
("multipart/related" ignore identity))
"Alist of media types/test that say whether the media types can be displayed inline.")
(defvar mm-inlined-types
- '("image/.*" "text/.*" "message/delivery-status" "message/rfc822")
+ '("image/.*" "text/.*" "message/delivery-status" "message/rfc822"
+ "application/pgp-signature")
"List of media types that are to be displayed inline.")
(defvar mm-automatic-display
'("text/plain" "text/enriched" "text/richtext" "text/html"
"text/x-vcard" "image/.*" "message/delivery-status" "multipart/.*"
- "message/rfc822")
+ "message/rfc822" "text/x-patch" "application/pgp-signature")
"A list of MIME types to be displayed automatically.")
(defvar mm-attachment-override-types '("text/x-vcard")
"Types that should have \"attachment\" ignored if they can be displayed inline.")
+(defvar mm-inline-override-types nil
+ "Types that should be treated as attachments even if they can be displayed inline.")
+
+(defvar mm-inline-override-types nil
+ "Types that should be treated as attachments even if they can be displayed inline.")
+
(defvar mm-automatic-external-display nil
"List of MIME type regexps that will be displayed externally automatically.")
(insert-buffer-substring cur)
(message "Viewing with %s" method)
(let ((mm (current-buffer))
- (non-viewer (assoc "non-viewer"
- (mailcap-mime-info
- (mm-handle-media-type handle) t))))
+ (non-viewer (assq 'non-viewer
+ (mailcap-mime-info
+ (mm-handle-media-type handle) t))))
(unwind-protect
(if method
(funcall method)
(mm-handle-media-type handle) t))
(needsterm (or (assoc "needsterm" mime-info)
(assoc "needsterminal" mime-info)))
+ (copiousoutput (assoc "copiousoutput" mime-info))
process file buffer)
;; We create a private sub-directory where we store our files.
(make-directory dir)
(setq file (expand-file-name (file-name-nondirectory filename)
dir))
(setq file (make-temp-name (expand-file-name "mm." dir))))
- (write-region (point-min) (point-max) file nil 'nomesg)
+ (let ((coding-system-for-write mm-binary-coding-system))
+ (write-region (point-min) (point-max) file nil 'nomesg))
(message "Viewing with %s" method)
(unwind-protect
(setq process
- (if needsterm
- (start-process "*display*" nil
- "xterm"
- "-e" shell-file-name "-c"
- (mm-mailcap-command
- method file (mm-handle-type handle)))
- (start-process "*display*"
- (setq buffer (generate-new-buffer "*mm*"))
- shell-file-name
- "-c"
- (mm-mailcap-command
- method file (mm-handle-type handle)))))
+ (cond (needsterm
+ (start-process "*display*" nil
+ "xterm"
+ "-e" shell-file-name
+ shell-command-switch
+ (mm-mailcap-command
+ method file (mm-handle-type handle))))
+ (copiousoutput
+ (start-process "*display*"
+ (setq buffer
+ (generate-new-buffer "*mm*"))
+ shell-file-name
+ shell-command-switch
+ (mm-mailcap-command
+ method file (mm-handle-type handle)))
+ (switch-to-buffer buffer))
+ (t
+ (start-process "*display*"
+ (setq buffer
+ (generate-new-buffer "*mm*"))
+ shell-file-name
+ shell-command-switch
+ (mm-mailcap-command
+ method file (mm-handle-type handle))))))
(mm-handle-set-undisplayer handle (cons file buffer)))
(message "Displaying %s..." (format method file))))))
(type (mm-handle-media-type handle))
method result)
(while (setq method (pop methods))
- (when (and (string-match method type)
+ (when (and (not (mm-inline-override-p handle))
+ (string-match method type)
(mm-inlinable-p handle))
(setq result t
methods nil)))
(type (mm-handle-media-type handle))
method result)
(while (setq method (pop methods))
- (when (and (string-match method type)
+ (when (and (not (mm-inline-override-p handle))
+ (string-match method type)
(mm-inlinable-p handle))
(setq result t
methods nil)))
(mm-inlinable-p handle))
(throw 'found t))))))
+(defun mm-inline-override-p (handle)
+ "Say whether HANDLE should have inline behavior overridden."
+ (let ((types mm-inline-override-types)
+ (type (mm-handle-media-type handle))
+ ty)
+ (catch 'found
+ (while (setq ty (pop types))
+ (when (string-match ty type)
+ (throw 'found t))))))
+
(defun mm-automatic-external-display-p (type)
"Return the user-defined method for TYPE."
(let ((methods mm-automatic-external-display)
;; ange-ftp, which is reasonable to use here.
(inhibit-file-name-operation 'write-region)
(inhibit-file-name-handlers
- (if (equal (mm-handle-media-type handle)
- "application/octet-stream")
- (cons 'jka-compr-handler inhibit-file-name-handlers)
- inhibit-file-name-handlers)))
+ (cons 'jka-compr-handler inhibit-file-name-handlers)))
(write-region (point-min) (point-max) file))))
(defun mm-pipe-part (handle)
-;;; mm-encode.el --- Functions for encoding MIME things
+;;; mm-encode.el --- Functions for encoding MIME things
;; Copyright (C) 1998,99 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
(mm-find-charset-region b e)))))
(when (memq 'iso-2022-jp-2 charsets)
(setq charsets (delq 'iso-2022-jp charsets)))
- (delete-duplicates charsets)))
+ (delete-duplicates charsets)
+ (if (and (> (length charsets) 1)
+ (fboundp 'find-coding-systems-for-charsets)
+ (memq 'utf-8 (find-coding-systems-for-charsets charsets)))
+ '(utf-8)
+ charsets)))
(defsubst mm-multibyte-p ()
"Say whether multibyte is enabled."
(defun mm-uu-dissect ()
"Dissect the current buffer and return a list of uu handles."
- (let (ct ctl cte charset text-start start-char end-char
- type file-name end-line result text-plain-type
- start-char-1 end-char-1
- (case-fold-search t))
+ (let (text-start start-char end-char
+ type file-name end-line result text-plain-type
+ start-char-1 end-char-1
+ (case-fold-search t))
(save-excursion
(save-restriction
(mail-narrow-to-head)
- (when (and (mail-fetch-field "mime-version")
- (setq ct (mail-fetch-field "content-type")))
- (setq cte (message-fetch-field "content-transfer-encoding" t)
- ctl (ignore-errors (mail-header-parse-content-type ct))
- charset (and ctl (mail-content-type-get ctl 'charset)))
- (if (stringp cte)
- (setq cte (intern (downcase (mail-header-remove-whitespace
- (mail-header-remove-comments
- cte))))))
- (if (memq cte '(base64 quoted-printable))
- (setq charset 'gnus-encoded ;; a fake charset
- cte nil)))
(goto-char (point-max)))
(forward-line)
+ ;;; gnus-decoded is a fake charset, which means no further
+ ;;; decoding.
(setq text-start (point)
- text-plain-type (cons "text/plain"
- (if charset
- (list (cons 'charset charset)))))
+ text-plain-type '("text/plain" (charset . gnus-decoded)))
(while (re-search-forward mm-uu-begin-line nil t)
(setq start-char (match-beginning 0))
(setq type (cdr (assq (aref (match-string 0) 0)
(intern (concat "mm-uu-" (symbol-name type)
"-end-line"))))
(when (and (re-search-forward end-line nil t)
- (not (eq (match-beginning 0) (match-end 0)))
- ;; Do not dissect base64 forward.
- (not (and (eq charset 'gnus-encoded) (eq type 'forward))))
+ (not (eq (match-beginning 0) (match-end 0))))
(setq end-char-1 (match-beginning 0))
(forward-line)
(setq end-char (point))
(if (> start-char text-start)
(push
(mm-make-handle (mm-uu-copy-to-buffer text-start start-char)
- text-plain-type cte)
+ text-plain-type)
result))
(push
(cond
'("application/postscript")))
((eq type 'forward)
(mm-make-handle (mm-uu-copy-to-buffer start-char-1 end-char-1)
- '("message/rfc822")))
+ '("message/rfc822" (charset . gnus-decoded))))
((eq type 'uu)
(mm-make-handle (mm-uu-copy-to-buffer start-char end-char)
(list (or (and file-name
(if (> (point-max) (1+ text-start))
(push
(mm-make-handle (mm-uu-copy-to-buffer text-start (point-max))
- text-plain-type cte)
+ text-plain-type)
result))
(setq result (cons "multipart/mixed" (nreverse result))))
result)))
(defun mm-uu-test ()
"Check whether the current buffer contains uu stuffs."
(save-excursion
- (save-restriction
- (mail-narrow-to-head)
- (goto-char (point-max)))
- (forward-line)
+ (goto-char (point-min))
(let (type end-line result
(case-fold-search t))
(while (and mm-uu-begin-line
(eval-and-compile
(autoload 'gnus-article-prepare-display "gnus-art")
(autoload 'vcard-parse-string "vcard")
- (autoload 'vcard-format-string "vcard"))
+ (autoload 'vcard-format-string "vcard")
+ (autoload 'diff-mode "diff-mode"))
;; Avoid byte compile warning.
(defvar gnus-article-mime-handles)
(defun mm-view-message ()
(mm-enable-multibyte)
- (gnus-article-prepare-display)
- (run-hooks 'gnus-article-decode-hook)
+ (let (handles)
+ (let (gnus-article-mime-handles)
+ ;; Double decode problem may happen. See mm-inline-message.
+ (run-hooks 'gnus-article-decode-hook)
+ (gnus-article-prepare-display)
+ (setq handles gnus-article-mime-handles))
+ (when handles
+ (setq gnus-article-mime-handles
+ (nconc gnus-article-mime-handles
+ (if (listp (car handles))
+ handles (list handles))))))
(fundamental-mode)
(goto-char (point-min)))
(defun mm-inline-message (handle)
(let ((b (point))
+ (charset (mail-content-type-get
+ (mm-handle-type handle) 'charset))
gnus-displaying-mime handles)
(save-excursion
(save-restriction
(narrow-to-region b b)
(mm-insert-part handle)
- (let (gnus-article-mime-handles)
+ (let (gnus-article-mime-handles
+ (gnus-newsgroup-charset (or charset gnus-newsgroup-charset)))
(run-hooks 'gnus-article-decode-hook)
(gnus-article-prepare-display)
(setq handles gnus-article-mime-handles))
+ (goto-char (point-max))
+ (unless (bolp)
+ (insert "\n"))
+ (insert "----------\n\n")
(when handles
(setq gnus-article-mime-handles
(nconc gnus-article-mime-handles
'(background background-pixmap foreground)))
(delete-region ,(point-min-marker) ,(point-max-marker)))))))))
+(defun mm-display-patch-inline (handle)
+ (let (text)
+ (with-temp-buffer
+ (mm-insert-part handle)
+ (diff-mode)
+ (font-lock-fontify-buffer)
+ (when (fboundp 'extent-list)
+ (map-extents (lambda (ext ignored)
+ (set-extent-property ext 'duplicable t)
+ nil)
+ nil nil nil nil nil 'text-prop))
+ (setq text (buffer-string)))
+ (mm-insert-inline handle text)))
+
(provide 'mm-view)
;; mm-view.el ends here
(modify-syntax-entry ?\' " " table)
table))
+(defvar mml-boundary-function 'mml-make-boundary
+ "A function called to suggest a boundary.
+The function may be called several times, and should try to make a new
+suggestion each time. The function is called with one parameter,
+which is a number that says how many times the function has been
+called for this message.")
+
(defun mml-parse ()
"Parse the current buffer as an MML document."
(goto-char (point-min))
(defun mml-compute-boundary (cont)
"Return a unique boundary that does not exist in CONT."
- (let ((mml-boundary (mml-make-boundary)))
+ (let ((mml-boundary (funcall mml-boundary-function
+ (incf mml-multipart-number))))
;; This function tries again and again until it has found
;; a unique boundary.
(while (not (catch 'not-unique
(goto-char (point-min))
(when (re-search-forward (concat "^--" (regexp-quote mml-boundary))
nil t)
- (setq mml-boundary (mml-make-boundary))
+ (setq mml-boundary (funcall mml-boundary-function
+ (incf mml-multipart-number)))
(throw 'not-unique nil))))
((eq (car cont) 'multipart)
(mapcar 'mml-compute-boundary-1 (cddr cont))))
t))
-(defun mml-make-boundary ()
- (concat (make-string (% (incf mml-multipart-number) 60) ?=)
- (if (> mml-multipart-number 17)
- (format "%x" mml-multipart-number)
+(defun mml-make-boundary (number)
+ (concat (make-string (% number 60) ?=)
+ (if (> number 17)
+ (format "%x" number)
"")
mml-base-boundary))
;; Quote parts.
(while (re-search-forward
"<#/?!*\\(multipart\\|part\\|external\\)" nil t)
- (goto-char (match-beginning 1))
+ ;; Insert ! after the #.
+ (goto-char (+ (match-beginning 0) 2))
(insert "!")))))
(defun mml-insert-tag (name &rest plist)
"*MIME preview of ") (buffer-name))))
(erase-buffer)
(insert-buffer buf)
+ (if (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "\n") nil t)
+ (replace-match "\n"))
(mml-to-mime)
(unless raw
(run-hooks 'gnus-article-decode-hook)
(head-end . "^\t")
(generate-head-function . nndoc-generate-clari-briefs-head)
(article-transform-function . nndoc-transform-clari-briefs))
+ (mime-digest
+ (article-begin . "")
+ (head-end . "^ ?$")
+ (body-end . "")
+ (file-end . "")
+ (subtype digest guess))
(mime-parts
(generate-head-function . nndoc-generate-mime-parts-head)
(article-transform-function . nndoc-transform-mime-parts))
(insert "From: " "clari@clari.net (" (or from "unknown") ")"
"\nSubject: " (or subject "(no subject)") "\n")))
+
+(defun nndoc-mime-digest-type-p ()
+ (let ((case-fold-search t)
+ boundary-id b-delimiter entry)
+ (when (and
+ (re-search-forward
+ (concat "^Content-Type: *multipart/digest;[ \t\n]*[ \t]"
+ "boundary=\"?\\([^\"\n]*[^\" \t\n]\\)")
+ nil t)
+ (match-beginning 1))
+ (setq boundary-id (match-string 1)
+ b-delimiter (concat "\n--" boundary-id "[\n \t]+"))
+ (setq entry (assq 'mime-digest nndoc-type-alist))
+ (setcdr entry
+ (list
+ (cons 'head-end "^ ?$")
+ (cons 'body-begin "^ ?\n")
+ (cons 'article-begin b-delimiter)
+ (cons 'body-end-function 'nndoc-digest-body-end)
+ (cons 'file-end (concat "\n--" boundary-id "--[ \t]*$"))))
+ t)))
+
(defun nndoc-standard-digest-type-p ()
(when (and (re-search-forward (concat "^" (make-string 70 ?-) "\n\n") nil t)
(re-search-forward
(dolist (backup
(let ((kept-new-versions 1)
(kept-old-versions 0))
- (cdr (find-backup-file-name
- (nndraft-article-filename article)))))
+ (find-backup-file-name
+ (nndraft-article-filename article))))
(when (file-exists-p backup)
(funcall nnmail-delete-file-function backup)))))
res))
(let* ((is-old t)
;; The articles we have deleted so far.
(deleted-articles nil)
- ;; The articles that really exist and will be expired if they are old enough.
- (maybe-expirable (gnus-intersection articles (nnfolder-existing-articles))))
+ ;; The articles that really exist and will
+ ;; be expired if they are old enough.
+ (maybe-expirable
+ (gnus-intersection articles (nnfolder-existing-articles))))
(nnmail-activate 'nnfolder)
(save-excursion
field-name)
mode max-column))
-(defun make-full-mail-header
- (&optional number subject from date id references chars lines xref extra)
+(defsubst make-full-mail-header (&optional number subject from date id
+ references chars lines xref
+ extra)
"Create a new mail header structure initialized with the parameters given."
(luna-make-entity (mm-expand-class-name 'gnus)
:location number
(cons 'From from))
:extra extra))
-(defun make-full-mail-header-from-decoded-header
+(defsubst make-full-mail-header-from-decoded-header
(&optional number subject from date id references chars lines xref extra)
"Create a new mail header structure initialized with the parameters given."
(luna-make-entity (mm-expand-class-name 'gnus)
:xref xref
:extra extra))
-(defun make-mail-header (&optional init)
+(defsubst make-mail-header (&optional init)
"Create a new mail header structure initialized with INIT."
(make-full-mail-header init init init init init
init init init init init))
(pop extra))))
(insert "\n"))
+(defun nnheader-insert-header (header)
+ (insert
+ "Subject: " (or (mail-header-subject header) "(none)") "\n"
+ "From: " (or (mail-header-from header) "(nobody)") "\n"
+ "Date: " (or (mail-header-date header) "") "\n"
+ "Message-ID: " (or (mail-header-id header) (nnmail-message-id)) "\n"
+ "References: " (or (mail-header-references header) "") "\n"
+ "Lines: ")
+ (princ (or (mail-header-lines header) 0) (current-buffer))
+ (insert "\n\n"))
+
(defun nnheader-insert-article-line (article)
(goto-char (point-min))
(insert "220 ")
(setq idx (1+ idx)))
string))
+(defun nnheader-replace-duplicate-chars-in-string (string from to)
+ "Replace characters in STRING from FROM to TO."
+ (let ((string (substring string 0)) ;Copy string.
+ (len (length string))
+ (idx 0) prev i)
+ ;; Replace all occurrences of FROM with TO.
+ (while (< idx len)
+ (setq i (aref string idx))
+ (when (and (eq prev from) (= i from))
+ (aset string (1- idx) to)
+ (aset string idx to))
+ (setq prev i)
+ (setq idx (1+ idx)))
+ string))
+
(defun nnheader-file-to-group (file &optional top)
"Return a group name based on FILE and TOP."
(nnheader-replace-chars-in-string
;; Internal variables:
-(defvar nnimap-debug "*nnimap-debug*")
+(defvar nnimap-debug nil) ;; "*nnimap-debug*")
(defvar nnimap-current-move-server nil)
(defvar nnimap-current-move-group nil)
(defvar nnimap-current-move-article nil)
(cadr (assq 'nnimap-server-address defs))) defs)
(push (list 'nnimap-address server) defs)))
(nnoo-change-server 'nnimap server defs)
- (if (null nnimap-server-buffer)
- (error "this shouldn't happen"))
- (or (imap-opened nnimap-server-buffer)
+ (or (and nnimap-server-buffer
+ (imap-opened nnimap-server-buffer))
(nnimap-open-connection server))))
(deffoo nnimap-server-opened (&optional server)
"Make pathname for GROUP."
(concat
(let ((dir (file-name-as-directory (expand-file-name dir))))
+ (setq group (nnheader-replace-duplicate-chars-in-string
+ (nnheader-replace-chars-in-string group ?/ ?_)
+ ?. ?_))
(setq group (nnheader-translate-file-chars group))
;; If this directory exists, we use it directly.
(if (or nnmail-use-long-file-names
"Compute the next article number in GROUP."
(let ((active (cadr (assoc group nnmh-group-alist)))
(dir (nnmail-group-pathname group nnmh-directory))
- (pathname-coding-system 'binary))
+ (pathname-coding-system 'binary)
+ file)
(unless active
;; The group wasn't known to nnmh, so we just create an active
;; entry for it.
(when files
(setcdr active (car files)))))
(setcdr active (1+ (cdr active)))
- (while (file-exists-p
- (concat (nnmail-group-pathname group nnmh-directory)
- (int-to-string (cdr active))))
+ (while (or
+ ;; See whether the file exists...
+ (file-exists-p
+ (setq file (concat (nnmail-group-pathname group nnmh-directory)
+ (int-to-string (cdr active)))))
+ ;; ... or there is a buffer that will make that file exist
+ ;; in the future.
+ (get-file-buffer file))
+ ;; Skip past that file.
(setcdr active (1+ (cdr active))))
(cdr active)))
(nntp-possibly-change-group nil server)
(when (nntp-find-connection-buffer nntp-server-buffer)
(save-excursion
+ ;; Erase nntp-sever-buffer before nntp-inhibit-erase.
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
(set-buffer (nntp-find-connection-buffer nntp-server-buffer))
;; The first time this is run, this variable is `try'. So we
;; try.
(defvoo nnvirtual-always-rescan t
"*If non-nil, always scan groups for unread articles when entering a group.
-If this variable is nil (which is the default) and you read articles
-in a component group after the virtual group has been activated, the
-read articles from the component group will show up when you enter the
-virtual group.")
+If this variable is nil and you read articles in a component group
+after the virtual group has been activated, the read articles from the
+component group will show up when you enter the virtual group.")
(defvoo nnvirtual-component-regexp nil
"*Regexp to match component groups.")
Valid types include `dejanews', `dejanewsold', `reference',
and `altavista'.")
-(defvoo nnweb-type-definition
+(defvar nnweb-type-definition
'((dejanews
- (article . nnweb-dejanews-wash-article)
+ (article . ignore)
+ (id . "http://search.dejanews.com/msgid.xp?MID=%s&fmt=text")
(map . nnweb-dejanews-create-mapping)
(search . nnweb-dejanews-search)
- (address . "http://x8.dejanews.com/dnquery.xp")
+ (address . "http://www.deja.com/=dnc/qs.xp")
(identifier . nnweb-dejanews-identity))
(dejanewsold
- (article . nnweb-dejanews-wash-article)
+ (article . ignore)
(map . nnweb-dejanews-create-mapping)
(search . nnweb-dejanewsold-search)
- (address . "http://x8.dejanews.com/dnquery.xp")
+ (address . "http://www.deja.com/dnquery.xp")
(identifier . nnweb-dejanews-identity))
(reference
(article . nnweb-reference-wash-article)
(not (equal group nnweb-group))
(not nnweb-ephemeral-p))
(let ((info (assoc group nnweb-group-alist)))
- (setq nnweb-group group)
- (setq nnweb-type (nth 2 info))
- (setq nnweb-search (nth 3 info))
- (unless dont-check
- (nnweb-read-overview group))))
+ (when info
+ (setq nnweb-group group)
+ (setq nnweb-type (nth 2 info))
+ (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"))
(defun nnweb-write-active ()
"Save the active file."
+ (gnus-make-directory nnweb-directory)
(with-temp-file (nnheader-concat nnweb-directory "active")
(prin1 `(setq nnweb-group-alist ',nnweb-group-alist) (current-buffer))))
(url-retrieve url))
(setq-default url-be-asynchronous old-asynch)))
-(defun nnweb-encode-www-form-urlencoded (pairs)
- "Return PAIRS encoded for forms."
- (mapconcat
- (function
- (lambda (data)
- (concat (w3-form-encode-xwfu (car data)) "="
- (w3-form-encode-xwfu (cdr data)))))
- pairs "&"))
-
-(defun nnweb-fetch-form (url pairs)
- (let ((url-request-data (nnweb-encode-www-form-urlencoded pairs))
- (url-request-method "POST")
- (url-request-extra-headers
- '(("Content-type" . "application/x-www-form-urlencoded"))))
- (url-insert-file-contents url)
- (setq buffer-file-name nil))
- t)
-
-(defun nnweb-decode-entities ()
- (goto-char (point-min))
- (while (re-search-forward "&\\([a-z]+\\);" nil t)
- (replace-match (char-to-string (or (cdr (assq (intern (match-string 1))
- w3-html-entities))
- ?#))
- t t)))
-
-(defun nnweb-remove-markup ()
- (goto-char (point-min))
- (while (search-forward "<!--" nil t)
- (delete-region (match-beginning 0)
- (or (search-forward "-->" nil t)
- (point-max))))
- (goto-char (point-min))
- (while (re-search-forward "<[^>]+>" nil t)
- (replace-match "" t t)))
-
;;;
;;; DejaNews functions.
;;;
(case-fold-search t)
(active (or (cadr (assoc nnweb-group nnweb-group-alist))
(cons 1 0)))
- Subject (Score "0") Date Newsgroup Author
- map url)
+ subject date from
+ map url parse a table group text)
(while more
;; Go through all the article hits on this page.
(goto-char (point-min))
- (nnweb-decode-entities)
- (goto-char (point-min))
- (while (re-search-forward "^ <P>\n" nil t)
- (narrow-to-region
- (point)
- (cond ((re-search-forward "^ <P>\n" nil t)
- (match-beginning 0))
- ((search-forward "\n\n" nil t)
- (point))
- (t
- (point-max))))
- (goto-char (point-min))
- (looking-at ".*HREF=\"\\([^\"]+\\)\"\\(.*\\)")
- (setq url (match-string 1))
- (let ((begin (point)))
- (nnweb-remove-markup)
- (goto-char begin)
- (while (search-forward "\t" nil t)
- (replace-match " "))
- (goto-char begin)
- (end-of-line)
- (setq Subject (buffer-substring begin (point)))
- (if (re-search-forward
- "^ Newsgroup: \\(.*\\)\n Posted on \\([0-9/]+\\) by \\(.*\\)$" nil t)
- (setq Newsgroup (match-string 1)
- Date (match-string 2)
- Author (match-string 3))))
- (widen)
- (incf i)
- (unless (nnweb-get-hashtb url)
- (push
- (list
- (incf (cdr active))
- (make-full-mail-header
- (cdr active) Subject Author Date
- (concat "<" (nnweb-identifier url) "@dejanews>")
- nil 0 (string-to-int Score) url))
- map)
- (nnweb-set-hashtb (cadar map) (car map))))
+ (setq parse (w3-parse-buffer (current-buffer))
+ table (nth 1 (nnweb-parse-find-all 'table parse)))
+ (dolist (row (nth 2 (car (nth 2 table))))
+ (setq a (nnweb-parse-find 'a row)
+ url (cdr (assq 'href (nth 1 a)))
+ text (nnweb-text row))
+ (when a
+ (setq subject (nth 2 text)
+ group (nth 4 text)
+ date (nth 5 text)
+ from (nth 6 text))
+ (string-match "\\([0-9]+\\)/\\([0-9]+\\)/\\([0-9]+\\)" date)
+ (setq date (format "%s %s %s"
+ (car (rassq (string-to-number
+ (match-string 2 date))
+ parse-time-months))
+ (match-string 3 date) (match-string 1 date)))
+ (incf i)
+ (setq url (concat url "&fmt=text"))
+ (unless (nnweb-get-hashtb url)
+ (push
+ (list
+ (incf (cdr active))
+ (make-full-mail-header
+ (cdr active) (concat subject " (" group ")") from date
+ (concat "<" (nnweb-identifier url) "@dejanews>")
+ nil 0 0 url))
+ map)
+ (nnweb-set-hashtb (cadar map) (car map)))))
;; See whether there is a "Get next 20 hits" button here.
+ (goto-char (point-min))
(if (or (not (re-search-forward
"HREF=\"\\([^\"]+\\)\"[<>b]+Next result" nil t))
(>= i nnweb-max-hits))
(setq nnweb-articles
(sort (nconc nnweb-articles map) 'car-less-than-car))))))
-(defun nnweb-dejanews-wash-article ()
- (let ((case-fold-search t))
- (goto-char (point-min))
- (re-search-forward "<PRE>" nil t)
- (delete-region (point-min) (point))
- (re-search-forward "</PRE>" nil t)
- (delete-region (point) (point-max))
- (nnweb-remove-markup)
- (goto-char (point-min))
- (while (and (looking-at " *$")
- (not (eobp)))
- (gnus-delete-line))
- (while (looking-at "\\(^[^ ]+:\\) *")
- (replace-match "\\1 " t)
- (forward-line 1))
- (when (re-search-forward "\n\n+" nil t)
- (replace-match "\n" t t))
- (goto-char (point-min))
- (when (search-forward "[More Headers]" nil t)
- (replace-match "" t t))))
-
(defun nnweb-dejanews-search (search)
- (nnweb-fetch-form
- (nnweb-definition 'address)
- `(("query" . ,search)
- ("defaultOp" . "AND")
- ("svcclass" . "dncurrent")
- ("maxhits" . "100")
- ("format" . "verbose2")
- ("threaded" . "0")
- ("showsort" . "date")
- ("agesign" . "1")
- ("ageweight" . "1")))
+ (nnweb-insert
+ (concat
+ (nnweb-definition 'address)
+ "?"
+ (nnweb-encode-www-form-urlencoded
+ `(("ST" . "PS")
+ ("svcclass" . "dnyr")
+ ("QRY" . ,search)
+ ("defaultOp" . "AND")
+ ("DBS" . "1")
+ ("OP" . "dnquery.xp")
+ ("LNG" . "ALL")
+ ("maxhits" . "100")
+ ("threaded" . "0")
+ ("format" . "verbose2")
+ ("showsort" . "date")
+ ("agesign" . "1")
+ ("ageweight" . "1")))))
t)
(defun nnweb-dejanewsold-search (search)
(defun nnweb-dejanews-identity (url)
"Return an unique identifier based on URL."
- (if (string-match "recnum=\\([0-9]+\\)" url)
+ (if (string-match "AN=\\([0-9]+\\)" url)
(match-string 1 url)
url))
(setq buffer-file-name nil)
t)
+;;;
+;;; General web/w3 interface utility functions
+;;;
+
+(defun nnweb-insert-html (parse)
+ "Insert HTML based on a w3 parse tree."
+ (if (stringp parse)
+ (insert parse)
+ (insert "<" (symbol-name (car parse)) " ")
+ (insert (mapconcat
+ (lambda (param)
+ (concat (symbol-name (car param)) "="
+ (prin1-to-string
+ (if (consp (cdr param))
+ (cadr param)
+ (cdr param)))))
+ (nth 1 parse)
+ " "))
+ (insert ">\n")
+ (mapcar 'nnweb-insert-html (nth 2 parse))
+ (insert "</" (symbol-name (car parse)) ">\n")))
+
+(defun nnweb-encode-www-form-urlencoded (pairs)
+ "Return PAIRS encoded for forms."
+ (mapconcat
+ (function
+ (lambda (data)
+ (concat (w3-form-encode-xwfu (car data)) "="
+ (w3-form-encode-xwfu (cdr data)))))
+ pairs "&"))
+
+(defun nnweb-fetch-form (url pairs)
+ "Fetch a form from URL with PAIRS as the data using the POST method."
+ (let ((url-request-data (nnweb-encode-www-form-urlencoded pairs))
+ (url-request-method "POST")
+ (url-request-extra-headers
+ '(("Content-type" . "application/x-www-form-urlencoded"))))
+ (url-insert-file-contents url)
+ (setq buffer-file-name nil))
+ t)
+
+(defun nnweb-decode-entities ()
+ "Decode all HTML entities."
+ (goto-char (point-min))
+ (while (re-search-forward "&\\([a-z]+\\);" nil t)
+ (replace-match (char-to-string (or (cdr (assq (intern (match-string 1))
+ w3-html-entities))
+ ?#))
+ t t)))
+
+(defun nnweb-remove-markup ()
+ "Remove all HTML markup, leaving just plain text."
+ (goto-char (point-min))
+ (while (search-forward "<!--" nil t)
+ (delete-region (match-beginning 0)
+ (or (search-forward "-->" nil t)
+ (point-max))))
+ (goto-char (point-min))
+ (while (re-search-forward "<[^>]+>" nil t)
+ (replace-match "" t t)))
+
+(defun nnweb-insert (url)
+ "Insert the contents from an URL in the current buffer."
+ (let ((name buffer-file-name))
+ (url-insert-file-contents url)
+ (setq buffer-file-name name)))
+
+(defun nnweb-parse-find (type parse &optional maxdepth)
+ "Find the element of TYPE in PARSE."
+ (catch 'found
+ (nnweb-parse-find-1 type parse maxdepth)))
+
+(defun nnweb-parse-find-1 (type contents maxdepth)
+ (when (or (null maxdepth)
+ (not (zerop maxdepth)))
+ (when (consp contents)
+ (when (eq (car contents) type)
+ (throw 'found contents))
+ (when (listp (cdr contents))
+ (dolist (element contents)
+ (when (consp element)
+ (nnweb-parse-find-1 type element
+ (and maxdepth (1- maxdepth)))))))))
+
+(defun nnweb-parse-find-all (type parse)
+ "Find all elements of TYPE in PARSE."
+ (catch 'found
+ (nnweb-parse-find-all-1 type parse)))
+
+(defun nnweb-parse-find-all-1 (type contents)
+ (let (result)
+ (when (consp contents)
+ (if (eq (car contents) type)
+ (push contents result)
+ (when (listp (cdr contents))
+ (dolist (element contents)
+ (when (consp element)
+ (setq result
+ (nconc result (nnweb-parse-find-all-1 type element))))))))
+ result))
+
+(defvar nnweb-text)
+(defun nnweb-text (parse)
+ "Return a list of text contents in PARSE."
+ (let ((nnweb-text nil))
+ (nnweb-text-1 parse)
+ (nreverse nnweb-text)))
+
+(defun nnweb-text-1 (contents)
+ (dolist (element contents)
+ (if (stringp element)
+ (push element nnweb-text)
+ (when (and (consp element)
+ (listp (cdr element)))
+ (nnweb-text-1 element)))))
+
(provide 'nnweb)
;;; nnweb.el ends here
(defun rfc1843-decode-article-body ()
"Decode HZ encoded text in the article body."
(if (string-match (concat "\\<\\(" rfc1843-newsgroups-regexp "\\)\\>")
- gnus-newsgroup-name)
+ (or gnus-newsgroup-name ""))
(save-excursion
(save-restriction
(message-narrow-to-head)
(match-string 0)
(delete-region (match-beginning 0) (match-end 0)))))
(when (and (mm-multibyte-p)
- mail-parse-charset)
+ mail-parse-charset
+ (not (eq mail-parse-charset 'gnus-decoded)))
(mm-decode-coding-region b e mail-parse-charset))
(setq b (point)))
(when (and (mm-multibyte-p)
mail-parse-charset
- (not (eq mail-parse-charset 'us-ascii)))
+ (not (eq mail-parse-charset 'us-ascii))
+ (not (eq mail-parse-charset 'gnus-decoded)))
(mm-decode-coding-region b (point-max) mail-parse-charset))))))
(defun rfc2047-decode-string (string)
projects / elisp / gnus.git- / commitdiff