Sync up with Gnus v5.8.3.
authoryamaoka <yamaoka>
Thu, 6 Jan 2000 04:34:20 +0000 (04:34 +0000)
committeryamaoka <yamaoka>
Thu, 6 Jan 2000 04:34:20 +0000 (04:34 +0000)
95 files changed:
lisp/ChangeLog
lisp/base64.el
lisp/binhex.el
lisp/gnus-agent.el
lisp/gnus-art.el
lisp/gnus-async.el
lisp/gnus-audio.el
lisp/gnus-bcklg.el
lisp/gnus-cache.el
lisp/gnus-cite.el
lisp/gnus-cus.el
lisp/gnus-demon.el
lisp/gnus-draft.el
lisp/gnus-ems.el
lisp/gnus-gl.el
lisp/gnus-group.el
lisp/gnus-kill.el
lisp/gnus-load.el
lisp/gnus-logic.el
lisp/gnus-mailcap.el
lisp/gnus-mh.el
lisp/gnus-mlspl.el
lisp/gnus-msg.el
lisp/gnus-nocem.el
lisp/gnus-picon.el
lisp/gnus-range.el
lisp/gnus-salt.el
lisp/gnus-score.el
lisp/gnus-setup.el
lisp/gnus-soup.el
lisp/gnus-spec.el
lisp/gnus-srvr.el
lisp/gnus-start.el
lisp/gnus-sum.el
lisp/gnus-topic.el
lisp/gnus-undo.el
lisp/gnus-util.el
lisp/gnus-uu.el
lisp/gnus-vm.el
lisp/gnus-win.el
lisp/gnus-xmas.el
lisp/ietf-drums.el
lisp/imap.el
lisp/lpath.el
lisp/mail-prsvr.el
lisp/mail-source.el
lisp/md5.el
lisp/message.el
lisp/messcompat.el
lisp/mm-bodies.el
lisp/mm-decode.el
lisp/mm-encode.el
lisp/mm-util.el
lisp/mm-uu.el
lisp/mm-view.el
lisp/mml.el
lisp/nnagent.el
lisp/nnbabyl.el
lisp/nndb.el
lisp/nndoc.el
lisp/nndraft.el
lisp/nneething.el
lisp/nnfolder.el
lisp/nnheader.el
lisp/nnimap.el
lisp/nnkiboze.el
lisp/nnlistserv.el
lisp/nnmail.el
lisp/nnmbox.el
lisp/nnmh.el
lisp/nnml.el
lisp/nnslashdot.el
lisp/nnsoup.el
lisp/nnspool.el
lisp/nntp.el
lisp/nnultimate.el
lisp/nnvirtual.el
lisp/nnwarchive.el
lisp/nnweb.el
lisp/parse-time.el
lisp/pop3.el
lisp/qp.el
lisp/rfc1843.el
lisp/rfc2047.el
lisp/score-mode.el
lisp/smiley.el
lisp/time-date.el
lisp/uudecode.el
lisp/webmail.el
texi/ChangeLog
texi/emacs-mime.texi
texi/gnus-ja.texi
texi/gnus.texi
texi/message.texi
texi/postamble.tex

index 16f290a..4d81184 100644 (file)
@@ -1,3 +1,705 @@
+2000-01-05 17:31:52  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+       * gnus-sum.el (gnus-summary-select-article): Return whether we
+       selected something new.
+       (gnus-summary-search-article): Start searching at the window
+       point.
+
+       * gnus-group.el (gnus-fetch-group): Complete over
+       gnus-active-hashtb. 
+
+Wed Jan  5 17:06:41 2000  Lars Magne Ingebrigtsen  <larsi@menja.ifi.uio.no>
+
+       * gnus.el: Pterodactyl Gnus v5.8.3 is released.
+
+2000-01-05 15:56:02  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+       * gnus-sum.el (gnus-preserve-marks): New variable.
+       (gnus-summary-move-article): Use it.
+       (gnus-group-charset-alist): Added more entries.
+
+2000-01-03 01:18:36  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+       * mm-decode.el (mm-inline-override-types): Removed duplicate.
+
+       * gnus-uu.el (gnus-uu-mark-over): Use gnus-summary-default-score
+       as the default score.
+
+       * gnus-score.el (gnus-score-delta-default): Changed name.
+
+2000-01-04  Simon Josefsson  <jas@pdc.kth.se>
+
+       * imap.el (imap-parse-literal): 
+       (imap-parse-flag-list): Don't care about props.
+       (imap-parse-string): Handle quoted characters.
+
+2000-01-02 08:37:03  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+       * gnus-sum.el (gnus-summary-goto-unread): Doc fix.
+       (gnus-summary-mark-article): Doc fix.
+       (gnus-summary-mark-forward): Doc fix.
+       (t): Changed keystroke for gnus-summary-customize-parameters.
+
+       * gnus-art.el (gnus-article-mode-map): Use gnus-article-edit for
+       "e". 
+       (gnus-article-mode-map): No, don't.
+
+       * gnus-sum.el (gnus-summary-next-subject): Don't show the thread
+       of the final article.
+
+       * mm-decode.el (mm-interactively-view-part): Error on no method.
+
+2000-01-02 06:10:32  Stefan Monnier  <monnier+gnu/emacs@tequila.cs.yale.edu>
+
+       * gnus-score.el (gnus-score-insert-help): Something.
+
+       * gnus-art.el (gnus-button-alist): Exclude < from <URL:
+
+       * gnus-win.el (gnus-configure-frame): Ditto.
+
+       * gnus-mh.el (gnus-summary-save-in-folder): Use
+       with-current-buffer.
+
+2000-01-02 05:00:13  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+       * nnwarchive.el: Changed file perms.
+
+1999-12-19 21:42:15  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+       * gnus-group.el (gnus-group-delete-groups): New command.
+       (gnus-group-delete-group): Extra no-prompt parameters.
+
+1999-12-14 10:18:30  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+       * nnslashdot.el (nnslashdot-request-article): Translate <br> into
+       <p>. 
+
+1999-12-28 12:20:18  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * webmail.el (webmail-hotmail-article): Don't insert message id.
+
+1999-12-28  Kai.Grossjohann@CS.Uni-Dortmund.DE (Kai Großjohann)
+
+       * nnimap.el (nnimap-split-fancy): New variable.
+       (nnimap-split-fancy): New function.
+
+1999-12-28  Simon Josefsson  <jas@pdc.kth.se>
+
+       (nnimap-split-rule): Document symbol value.
+
+1999-12-28  Simon Josefsson  <jas@pdc.kth.se>
+
+       * nnimap.el (nnimap-retrieve-headers-progress): Let
+       `nnheader-parse-head' parse article.
+       (nnimap-retrieve-headers-from-server): Don't request ENVELOPE,
+       request headers needed by `nnheader-parse-head'.
+
+1999-12-23  Florian Weimer  <fw@s.netic.de>
+
+       * gnus-msg.el (gnus-group-posting-charset-alist): Correct default
+       value (crosspostings are handled), improve documentation.
+
+       * smiley.el: Declare file coding system as iso-8859-1.
+
+       * nnultimate.el: Dito.
+
+       * message.el: Dito.
+
+       * gnus-cite.el: Dito.
+
+       * gnus-spec.el: Dito.
+
+1999-12-21  Florian Weimer  <fw@s.netic.de>
+
+       * gnus-msg.el (gnus-group-posting-charset-alist): New layout.
+       (gnus-setup-message): No longer make `message-posting-charset'
+       buffer-local.
+       (gnus-setup-posting-charset): Reflect the new layout of
+       `gnus-group-posting-charset-alist' and `message-posting-charset'.
+
+       * message.el (message-send-mail): Bind `message-this-is-mail' and
+       `message-posting-charset'.
+       (message-send-news): Dito, and honour new layout of 
+       `message-posting-charset'.
+       (message-encode-message-body): Ignore `message-posting-charset'.
+       
+       * mm-bodies.el (mm-body-encoding): Consider
+       `message-posting-charset' when deciding whether to use 8bit.
+
+       * rfc2047.el (rfc2047-encode-message-header): Back out change.
+       (rfc2047-encodable-p): Now solely for headers; use
+       `message-posting-charset'.
+       
+1999-12-20 14:10:39  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * nnwarchive.el (nnwarchive-type-definition): Set default value.
+
+1999-12-19 22:49:13  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * nnagent.el (nnagent-server-opened): Optional.
+       (nnagent-status-message): Optional.
+
+1999-12-19  Simon Josefsson  <jas@pdc.kth.se>
+
+       * gnus-cite.el (gnus-article-toggle-cited-text): Restore beg and
+       end (referenced by instructions in
+       `gnus-cited-opened-text-button-line-format-alist').
+       
+1999-12-18  Simon Josefsson  <jas@pdc.kth.se>
+
+       * imap.el (imap-starttls-open): Typo.
+
+1999-12-18 16:43:37  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * mm-util.el (mm-charset-after): Non-MULE case.
+       * mail-prsvr.el (mail-parse-mule-charset): New variable.
+       * rfc2047.el (rfc2047-dissect-region): Bind it.
+
+1999-12-18  Florian Weimer  <fw@s.netic.de>
+
+       * mml.el (mml-generate-multipart-alist): Correct default value. 
+
+       * mm-encode.el (mm-use-ultra-safe-encoding): New variable.
+       (mm-safer-encoding): New function.
+       (mm-content-transfer-encoding): Use both.
+
+       * mm-bodies.el (mm-body-encoding): Use mm-use-ultra-safe-encoding.
+       * qp.el (quoted-printable-encode-region): Dito.
+
+1999-12-18 14:08:48  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * webmail.el (webmail-hotmail-article): Snarf the raw file.
+
+1999-12-18 14:08:12  Victor S. Miller  <victor@idaccr.org>
+
+       * webmail.el (webmail-hotmail-list): raw=0.
+
+1999-12-18 11:14:51  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * gnus-agent.el (gnus-agent-enter-history): Back-compatible in
+       group name.
+
+1999-12-18 11:02:00  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * gnus-agent.el (gnus-agent-expire): Convert to symbol if stringp.
+
+1999-12-18  Simon Josefsson  <jas@pdc.kth.se>
+
+       * imap.el: Don't autoload digest-md5.
+       (imap-starttls-open): Bind coding-system-for-{read,write}.
+       (imap-starttls-p): Check if we can find starttls.el.
+       (imap-digest-md5-p): Check if we can find digest-md5.el.
+
+1999-12-17   Daiki Ueno  <ueno@ueda.info.waseda.ac.jp>
+
+       * base64.el (base64-encode-string): Accept 2nd argument
+       `no-line-break'.
+
+       * imap.el: Require `digest-md5' when compiling; add autoload
+       settings for `digest-md5-parse-digest-challenge',
+       `digest-md5-digest-response', `starttls-open-stream' and
+       `starttls-negotiate'.
+       (imap-authenticators): Add `digest-md5'.
+       (imap-authenticator-alist): Setup for `digest-md5'.
+       (imap-digest-md5-p): New function.
+       (imap-digest-md5-auth): New function.
+       (imap-stream-alist): Add STARTTLS entry.
+       (imap-starttls-p): New function.
+       (imap-starttls-open): New function.
+
+1999-12-18 01:08:10  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * gnus-agent.el (gnus-agent-enter-history): Bad group name.
+
+1999-12-17 19:36:47  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * rfc2047.el (rfc2047-dissect-region): Use mapcar instead of
+       string-to-x function.
+
+1999-12-17 13:08:54  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * rfc2047.el (rfc2047-fold-region): Fold a line more than once.
+
+1999-12-17 11:54:41  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * webmail.el: Enhance hotmail-snarf.
+
+1999-12-17 10:38:10  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * rfc2047.el (rfc2047-dissect-region): Rewrite.
+
+1999-12-16 22:59:22  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * webmail.el (webmail-hotmail-list): Search no-error.
+
+1999-12-15 22:07:15  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * nnwarchive.el: Support nov-is-evil.
+       * gnus-bcklg.el (gnus-backlog-request-article): Buffer is optional.
+       Set it if non-nil.
+       * gnus-agent.el (gnus-agent-fetch-articles): Use it.
+
+1999-12-15 08:55:19  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * nnagent.el (nnagent-server-opened): Redefine.
+       (nnagent-status-message): Ditto.
+
+1999-12-14 23:37:44  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * rfc1843.el (rfc1843-decode-region): Use
+       buffer-substring-no-properties.
+       * gnus-art.el (article-decode-HZ): New function.
+
+1999-12-14 22:07:26  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * nnheader.el (nnheader-translate-file-chars): Only in full path.
+
+1999-12-14 16:21:45  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * mm-util.el (mm-find-charset-region): mail-parse-charset is a
+       MIME charset not a MULE charset.
+
+1999-12-14 15:08:03  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * gnus-ems.el: Translate more ugly characters.
+       * nnheader.el (nnheader-translate-file-chars): Don't translate
+       the second ':'.
+
+1999-12-14 10:40:33  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * gnus-art.el (gnus-request-article-this-buffer): Use all refer
+       method if cannot find the article.
+
+1999-12-14 01:13:50  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * gnus-art.el (gnus-request-article-this-buffer): Don't use refer
+       method if overrided.
+
+1999-12-13 23:38:53  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * mail-source.el (mail-source-fetch-webmail): Parameter
+       dontexpunge.
+
+1999-12-13 23:31:17  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * webmail.el: Support my-deja. Better error report.
+
+1999-12-13 18:59:33  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * nnslashdot.el (nnslashdot-date-to-date): Error proof when input
+       is bad.
+       * gnus-sum.el (gnus-list-of-unread-articles): When (car read) 
+       is not 1.
+
+1999-12-13 18:22:08  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * nnslashdot.el (nnslashdot-request-article): A space.
+
+1999-12-13 17:20:25  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * nnagent.el: Support different backend with same name.
+
+1999-12-13 13:14:42  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * nnslashdot.el (nnslashdot-threaded-retrieve-headers): Support
+       archived group.
+       (nnslashdot-sane-retrieve-headers): Ditto.
+       (nnslashdot-request-article): Ditto.
+
+1999-12-13 11:41:32  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * nnweb.el (nnweb-insert): Narrow to point.
+
+1999-12-13 10:59:42  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * nnweb.el (nnweb-insert): Follow refresh url.
+       * nnslashdot.el: Use it.
+
+1999-12-13 10:39:53  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * nnweb.el (nnweb-decode-entities): Decode numerical entities.
+       (nnweb-decode-entities-string): New function.
+       
+       * nnwarchive.el (nnwarchive-decode-entities-string): Rename to
+       nnweb-* and move to nnweb.el.
+       * nnwarchive.el: Use nnweb-decode-entities, etc.
+       * webmail.el: Ditto.
+       
+       * nnslashdot.el: Use nnweb-decode-entities-string.
+       (nnslashdot-decode-entities): Remove.
+               
+1999-12-13 10:40:56  Eric Marsden <emarsden@mail.dotcom.fr>
+
+       * nnslashdot.el: Decode entities.
+
+1999-12-12  Dave Love  <fx@gnu.org>
+
+       * gnus-agent.el (gnus-category-edit-groups)
+       (gnus-category-edit-score, gnus-category-edit-predicate): Replace
+       expansion of setf, fixed.
+       
+1999-12-12 12:50:30  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * gnus-agent.el: Revoke last Dave Love's patch, because of
+       incompatibility of XEmacs.
+
+1999-12-12 12:27:03  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * mm-uu.el: Change headers.
+       * rfc1843.el: Ditto.
+       * uudecode.el: Ditto.
+
+1999-12-07  Dave Love  <fx@gnu.org>
+
+       * gnus-agent.el (gnus-category-edit-predicate)
+       (gnus-category-edit-score, gnus-category-edit-score): Expand setf
+       inside backquote to avoid it at runtime.
+
+1999-12-07  Dave Love  <fx@gnu.org>
+
+       * binhex.el: Require cl when compiling.
+
+1999-12-04  Dave Love  <fx@gnu.org>
+
+       * gnus-cus.el (gnus-group-parameters): Allow nil for banner.
+
+1999-12-04  Dave Love  <fx@gnu.org>
+
+       * mm-util.el (mm-delete-duplicates): New function.
+       (mm-write-region): Use it.
+
+       * mml.el (mml-minibuffer-read-type): Use mm-delete-duplicates.
+
+       * mailcap.el (mailcap-mime-types): Require mm-util.  Use
+       mm-delete-duplicates.
+
+       * imap.el (imap-open, imap-debug): Avoid mapc.
+
+       * nnvirtual.el (nnvirtual-create-mapping): Likewise.
+
+       * gnus-sum.el (gnus-summary-exit-no-update): Avoid copy-list.
+       (gnus-multi-decode-encoded-word-string): Avoid mapc.
+
+       * gnus-start.el (gnus-site-init-file): Avoid ignore-errors at
+       runtime.
+
+       * gnus.el (gnus-select-method): Likewise.
+
+       * nnheader.el (nnheader-nov-read-integer): Likewise.
+
+       * mm-view.el (mm-inline-message): Require cl when compiling.
+       Avoid ignore-errors at runtime.
+       (mm-inline-text): Avoid mapc.
+       
+1999-12-12 10:36:51  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * gnus-art.el (article-decode-charset): Widen is bad.
+
+1999-12-12 10:17:42  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * mm-util.el (mm-charset-after): `charset-after' may not be defined.
+
+1999-12-12  Florian Weimer  <fw@s.netic.de>
+
+       * rfc2047.el (rfc2047-encodable-p): New parameter header used to
+       indicate that only US-ASCII is permitted.
+       (rfc2047-encode-message-header): Use it.  Now, Gnus should never
+       use unencoded 8-bit characters in message headers.
+
+1999-12-12 03:08:15  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * ietf-drums.el (ietf-drums-narrow-to-header): Make it work with
+       CRLF.
+
+1999-12-11 14:42:26  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * webmail.el: Require url-cookie.
+
+1999-12-11 14:21:23  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * nnwarchive.el (nnwarchive-make-caesar-translation-table): A
+       new function to make modified caesar table.
+       (nnwarchive-from-r13): Use it.
+       (nnwarchive-mail-archive-article): Improved.
+
+1999-12-11 12:30:20  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * webmail.el (webmail-url): Use mm-with-unibyte-current-buffer.
+
+1999-12-10 16:22:24  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * nnweb.el (nnweb-request-article): Return cons.
+
+1999-12-10 16:06:04  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * gnus-sum.el (gnus-summary-setup-default-charset): Typo.
+
+1999-12-10 12:14:04  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * mm-util.el (mm-with-unibyte): New macro.
+       * nnweb.el (nnweb-init): Use it.
+
+1999-12-09 20:39:49  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * mm-util.el (mm-charset-after): New function.
+       (mm-find-mime-charset-region): Set charsets after
+       delete-duplicates and use find-coding-systems-region.
+       (mm-find-charset-region): Remove composition.
+       
+       * mm-bodies.el (mm-encode-body): Use mm-charset-after.
+
+       * mml.el (mml-parse-singlepart-with-multiple-charsets): Ditto.
+       
+1999-12-09 17:47:56  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * mm-util.el (mm-find-mime-charset-region): Revoke last change.
+       * mml.el (mml-confirmation-set): New variable.
+       (mml-parse-1): Ask user to confirm.
+
+1999-12-09  Simon Josefsson  <jas@pdc.kth.se>
+
+       * gnus-start.el (gnus-get-unread-articles): Make sure all methods
+       are scanned when we have directory mail-sources (the mail source
+       is modified in that case, so we must scan it for all
+       groups/methods).
+
+1999-12-09 12:05:28  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * nnml.el (nnml-request-move-article): Save nnml-current-directory
+       and nnml-article-file-alist.
+
+1999-12-09 10:20:07  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * gnus-group.el (gnus-group-get-new-news-this-group): Binding
+       nnmail-fetched-sources.
+
+1999-12-09 10:19:01  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * mm-util.el (mm-find-charset-region): Use the last charset.
+
+1999-12-08  Per Abrahamsen  <abraham@dina.kvl.dk>
+
+       * gnus.el (gnus-select-method): Made the option list prettier.
+
+1999-12-08  Florian Weimer  <fw@s.netic.de>
+
+       * gnus-msg.el (gnus-group-posting-charset-alist): Use iso-8859-1
+       for the `de' newsgroups hierarchy, as it is common practice there.
+       
+
+1999-12-07 16:17:12  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * nnwarchive.el (nnwarchive-mail-archive-article): Fix
+       buffer-string arguments. Fix references.
+
+1999-12-07 15:04:18  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * gnus-agent.el (gnus-agent-confirmation-function): New variable.
+       (gnus-agent-batch-fetch): Use it.
+       (gnus-agent-fetch-session): Use it.
+
+1999-12-07 12:32:43  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * mm-util.el (mm-find-mime-charset-region): Delete nil.
+
+1999-12-07 11:45:10  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * mm-util.el (mm-find-charset-region): Don't capitalize.  Delete
+       nil.
+
+1999-12-07  Per Abrahamsen  <abraham@dina.kvl.dk>
+
+       * nnslashdot.el (nnslashdot-request-list): There were two
+       top-level body-forms.  Put a `progn' around them.
+
+       * gnus.el (gnus-select-method): Use `condition-case'
+       instead of `ignore-errors', since cl may not be loaded when the
+       form is evaluated.
+
+1999-12-06 23:57:47  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * nnwarchive.el: Support www.mail-archive.com.
+
+1999-12-06 23:55:55  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * nnmail.el (nnmail-get-new-mail): Remove fetched sources before
+       do anything.
+
+1999-12-06  Simon Josefsson  <jas@pdc.kth.se>
+
+       * utf7.el: New file, written by Jon K Hellan.
+
+       * imap.el (imap-use-utf7): Renamed from `imap-utf7-p', change
+       default to t.
+
+1999-12-06 04:40:24  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+       * nnslashdot.el (nnslashdot-request-delete-group): New function.
+
+       * gnus-sum.el (gnus-summary-refer-article): Work for lists with
+       current. 
+       (gnus-refer-article-methods): New function.
+       (gnus-summary-refer-article): Use it.
+
+1999-11-13  Simon Josefsson  <jas@pdc.kth.se>
+
+       * nnimap.el (nnimap-retrieve-groups): Return active format.
+
+       * nnimap.el (nnimap-replace-in-string): Removed.
+       (nnimap-request-list): 
+       (nnimap-retrieve-groups): 
+       (nnimap-request-newgroups): Quote group instead of escaping SPC.
+
+1999-12-05  Simon Josefsson  <jas@pdc.kth.se>
+
+       * imap.el: Use format-spec for ssl program.
+       * imap.el (imap-ssl-arguments): Removed.
+       (imap-ssl-open-{1,2}): Removed.
+
+1999-12-04  Per Abrahamsen  <abraham@dina.kvl.dk>
+
+       * gnus-start.el (gnus-site-init-file): Use `condition-case'
+       instead of `ignore-errors', since cl may not be loaded when the
+       form is evaluated.
+
+1999-12-04 11:34:22  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * mm-bodies.el (mm-8bit-char-regexps): Removed.
+       (mm-7bit-chars): New variable.
+       (mm-body-7-or-8): Use it in both cases.
+
+1999-12-04  Simon Josefsson  <jas@pdc.kth.se>
+
+       * mm-decode.el (mm-display-part): Let mm-display-external return
+       inline or external.
+       (mm-display-external): For copiousoutput methods, insert output in
+       buffer.
+
+1999-12-04 03:29:13  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * nntp.el (nntp-retrieve-headers-with-xover): Goto the end of
+       buffer.
+
+1999-12-04 08:31:10  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+       * gnus-audio.el: An M too far.
+
+       * gnus-msg.el (gnus-setup-message): One backtick too many.
+
+       * gnus-art.el (gnus-mime-view-part-as-type): mailcap-mime-types is 
+       a function, not a variable.
+
+1999-12-04 08:14:08  Max Froumentin  <masmef@maths.bath.ac.uk>
+
+       * gnus-score.el (gnus-score-body): Widen before requesting.
+
+1999-12-04 08:06:13  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+       * gnus-group.el (gnus-group-prepare-flat): Comment fix.
+
+1999-12-04 03:01:55  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * mail-source.el (mail-source-fetch-webmail): Bind
+       mail-source-string.
+
+1999-12-04 07:18:23  Matt Swift  <swift@alum.mit.edu>
+
+       * gnus-uu.el (gnus-uu-mark-by-regexp): Doc fix.
+       (gnus-uu-unmark-by-regexp): Ditto.
+
+       * gnus-group.el (gnus-group-catchup-current): Would bug out on
+       dead groups.
+
+1999-12-04 01:34:31  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+       * gnus-msg.el (gnus-setup-message): Allow the charset setting to
+       do their real thing.
+
+       * nnmh.el (nnmh-be-safe): Doc fix.
+
+       * gnus-sum.el (gnus-summary-exit): Write cache active file. 
+
+       * nntp.el (nntp-retrieve-headers-with-xover): Make sure the entire 
+       status line has arrived before we count it.
+
+       * mailcap.el (mailcap-mime-data): Removed save-file from audio/*. 
+
+       * gnus-sum.el (gnus-thread-header): Fixed after indent.
+       Whitespace problems.
+
+       * gnus-win.el (gnus-configure-windows): Error fix.
+
+       * gnus-demon.el (gnus-demon-add-nntp-close-connection): Add the
+       right function.
+
+       * gnus.el: Fixed all the doc strings to match the FSF convetions.
+       Indent all functions.  Fix all comments to match the comment
+       conventions.  Double-space after full stop.
+
+1999-12-04 01:14:55  YAMAMOTO Kouji  <kouji@pobox.com>
+
+       * nnmail.el (nnmail-split-it): I redefined nnmail-split-fancy's
+       value to divide received mails into my favorite groups and I met
+       an error.  It takes place if the length of a element "VALUE" in
+       nnmail-split-fancy is less than two.
+
+1999-10-10  Robert Bihlmeyer  <robbe@orcus.priv.at>
+
+       * mml.el (mml-insert-part): New function.
+
+1999-09-29 04:48:14  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+       * lpath.el: Add `sc-cite-regexp'.
+
+1999-12-02  Dave Love  <fx@gnu.org>
+
+       * mm-decode.el: Customize.
+
+1999-12-03  Dave Love  <fx@gnu.org>
+
+       * nnslashdot.el, nnultimate.el: Don't lose at compile time when
+       the W3 stuff isn't available.
+
+1999-12-03  Dave Love  <fx@gnu.org>
+
+       * imap.el, mailcap.el, nnvirtual.el, rfc2104.el: Don't require cl
+       at runtime.
+
+1999-12-04 00:47:35  Dan Christensen  <jdc@jhu.edu>
+
+       * gnus-score.el (gnus-score-headers): Fix orphan scoring.
+
+1999-12-01  Andrew Innes  <andrewi@gnu.org>
+
+       * nnmbox.el (nnmbox-read-mbox): Count messages correctly, and
+       don't be fooled by "From nobody" lines added by respooling.
+
+       * pop3.el (pop3-movemail): Write crashbox in binary.
+       (pop3-get-message-count): New function.
+
+       * mail-source.el (mail-source-primary-source): New variable.
+       (mail-source-report-new-mail-interval): New variable.
+       (mail-source-idle-time-delay): New variable.
+       (mail-source-new-mail-available): New internal variable.
+       (mail-source-fetch-pop): Clear new mail flag, when mail from
+       primary source has been fetched.
+       (mail-source-check-pop): New function.
+       (mail-source-new-mail-p): New function.
+       (mail-source-start-idle-timer): New function.
+       (mail-source-report-new-mail): New function.
+       (mail-source-report-new-mail): New internal variable.
+       (mail-source-report-new-mail-timer): New internal variable.
+       (mail-source-report-new-mail-idle-timer): New internal variables.
+
+1999-12-04 00:39:34  Andreas Schwab  <schwab@suse.de>
+
+       * gnus-cus.el (gnus-group-customize): Customize fix.
+
+1999-12-04 00:38:24  Andrea Arcangeli  <andrea@suse.de>
+
+       * message.el (message-send-mail-with-sendmail): Use
+       message-make-address. 
+
 Fri Dec  3 20:34:11 1999  Lars Magne Ingebrigtsen  <larsi@menja.ifi.uio.no>
 
        * gnus.el: Pterodactyl Gnus v5.8.2 is released.
@@ -1138,11 +1840,16 @@ Mon Sep 27 15:18:05 1999  Lars Magne Ingebrigtsen  <larsi@menja.ifi.uio.no>
 
        * gnus-art.el (gnus-treat-predicate): Work for (not 5).
 
-1999-08-27  Peter von der Ah\e-A\ ei\ f  <pahe@daimi.au.dk>
+1999-08-27  Peter von der Ahe <pahe@daimi.au.dk>
 
        * message.el (message-send): More helpful error message if sending
        fails
 
+1999-09-06  Robert Bihlmeyer  <robbe@orcus.priv.at>
+
+       * gnus-score.el (gnus-summary-increase-score): "Lars" was broken
+       in newer emacsen, where ?r isn't equal 114.
+
 Fri Aug 27 13:17:48 1999  Lars Magne Ingebrigtsen  <larsi@menja.ifi.uio.no>
 
        * gnus.el: Pterodactyl Gnus v0.96 is released.
@@ -1287,6 +1994,7 @@ Fri Aug 27 13:17:48 1999  Lars Magne Ingebrigtsen  <larsi@menja.ifi.uio.no>
 
        * gnus-agent.el (gnus-agent-fetch-group-1): Recreate agent
        overview buffer if it is killed.
+
 1999-08-27 14:26:03  Eric Marsden  <emarsden@mail.dotcom.fr>
 
        * gnus-art.el (article-babel): New version.
@@ -1340,7 +2048,7 @@ Fri Aug 27 13:17:48 1999  Lars Magne Ingebrigtsen  <larsi@menja.ifi.uio.no>
        * 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\ ei\ f  <peter@ahe.dk>
+Tue Jul 20 02:39:56 1999  Peter von der Ahe  <peter@ahe.dk>
 
        * gnus-sum.el (gnus-summary-exit): Allow gnus-use-adaptive-scoring
        to have buffer local values.
@@ -3892,7 +4600,7 @@ Mon Nov 30 23:38:02 1998  Shenghuo ZHU  <zsh@cs.rochester.edu>
 
        * mm-uu.el (mm-uu-dissect): Use mm-make-handle.
 
-1998-12-01 01:53:49  Fran\e-A\ eg\ fois Pinard  <pinard@iro.umontreal.ca>
+1998-12-01 01:53:49  Francois Pinard  <pinard@iro.umontreal.ca>
 
        * nndoc.el (nndoc-mime-parts-type-p): Do related.
 
@@ -5638,7 +6346,7 @@ Mon Sep 14 18:55:38 1998  Lars Magne Ingebrigtsen  <larsi@menja.ifi.uio.no>
 
        * rfc2047.el (rfc2047-q-encode-region): Would bug out.
 
-1998-09-13  Fran\e-A\ eg\ fois Pinard  <pinard@iro.umontreal.ca>
+1998-09-13  Francois 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
index 42750dd..ff4146c 100644 (file)
@@ -74,7 +74,7 @@ base64-encoder-program.")
     ( ?w . 48) ( ?x . 49) ( ?y . 50) ( ?z . 51) ( ?0 . 52) ( ?1 . 53)
     ( ?2 . 54) ( ?3 . 55) ( ?4 . 56) ( ?5 . 57) ( ?6 . 58) ( ?7 . 59)
     ( ?8 . 60) ( ?9 . 61) ( ?+ . 62) ( ?/ . 63)
-   ))
+    ))
 
 (defvar base64-alphabet-decoding-vector
   (let ((v (make-vector 123 nil))
@@ -137,9 +137,9 @@ base64-encoder-program.")
          (if base64-decoder-program
              (let* ((binary-process-output t) ; any text already has CRLFs
                     (status (apply 'base64-run-command-on-region
-                                  start end work-buffer
-                                  base64-decoder-program
-                                  base64-decoder-switches)))
+                                   start end work-buffer
+                                   base64-decoder-program
+                                   base64-decoder-switches)))
                (if (not (eq status t))
                    (error "%s" (cdr status))))
            (goto-char start)
@@ -158,7 +158,7 @@ base64-encoder-program.")
                  (cond ((= counter 4)
                         (base64-insert-char (lsh bits -16) 1 nil work-buffer)
                         (base64-insert-char (logand (lsh bits -8) 255) 1 nil
-                                        work-buffer)
+                                            work-buffer)
                         (base64-insert-char (logand bits 255) 1 nil
                                             work-buffer)
                         (setq bits 0 counter 0))
@@ -256,12 +256,12 @@ base64-encoder-program.")
       (and work-buffer (kill-buffer work-buffer))))
   (message "Encoding base64... done"))
 
-(defun base64-encode (string)
+(defun base64-encode (string &optional no-line-break)
   (save-excursion
     (set-buffer (get-buffer-create " *base64-encode*"))
     (erase-buffer)
     (insert string)
-    (base64-encode-region (point-min) (point-max))
+    (base64-encode-region (point-min) (point-max) no-line-break)
     (skip-chars-backward " \t\r\n")
     (delete-region (point-max) (point))
     (prog1
index b562051..200d571 100644 (file)
@@ -1,14 +1,11 @@
 ;;; binhex.el -- elisp native binhex decode
-;; Copyright (c) 1998 by Shenghuo Zhu <zsh@cs.rochester.edu>
+;; Copyright (c) 1998 Free Software Foundation, Inc.
 
 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
 ;; Create Date: Oct 1, 1998
-;; $Revision: 1.1.2.7.6.1 $
-;; Time-stamp: <Tue Oct  6 23:48:38 EDT 1998 zsh>
-;; Keywords: binhex
+;; Keywords: binhex news
 
-;; This file is not part of GNU Emacs, but the same permissions
-;; apply.
+;; This file is part of GNU Emacs.
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
@@ -29,6 +26,8 @@
 
 ;;; Code:
 
+(eval-when-compile (require 'cl))
+
 (if (not (fboundp 'char-int))
     (fset 'char-int 'identity))
 
@@ -251,21 +250,21 @@ If HEADER-ONLY is non-nil only decode header and return filename."
             ((= counter 2)
              (binhex-push-char (logand (lsh bits -10) 255) 1 nil
                                work-buffer))))
-      (if header-only nil
-       (binhex-verify-crc work-buffer
-                          data-fork-start
-                          (+ data-fork-start (aref header 6) 2))
-       (or (markerp end) (setq end (set-marker (make-marker) end)))
-       (goto-char start)
-       (insert-buffer-substring work-buffer
-                                data-fork-start (+ data-fork-start
-                                                   (aref header 6)))
-       (delete-region (point) end)))
+         (if header-only nil
+           (binhex-verify-crc work-buffer
+                              data-fork-start
+                              (+ data-fork-start (aref header 6) 2))
+           (or (markerp end) (setq end (set-marker (make-marker) end)))
+           (goto-char start)
+           (insert-buffer-substring work-buffer
+                                    data-fork-start (+ data-fork-start
+                                                       (aref header 6)))
+           (delete-region (point) end)))
       (and work-buffer (kill-buffer work-buffer)))
     (if header (aref header 1))))
 
 (defun binhex-decode-region-external (start end)
-  "Binhex decode region between START and END using external decoder"
+  "Binhex decode region between START and END using external decoder."
   (interactive "r")
   (let ((cbuf (current-buffer)) firstline work-buffer status
        (file-name (concat binhex-temporary-file-directory
index 2acd989..f0851c6 100644 (file)
@@ -25,6 +25,7 @@
 ;;; Code:
 
 (eval-when-compile (require 'cl))
+
 (require 'gnus)
 (require 'gnus-cache)
 (require 'nnvirtual)
@@ -77,6 +78,11 @@ If nil, only read articles will be expired."
   :group 'gnus-agent
   :type 'hook)
 
+(defcustom gnus-agent-confirmation-function 'y-or-n-p
+  "Function to confirm when error happens."
+  :group 'gnus-agent
+  :type 'function)
+
 (defcustom gnus-agent-large-newsgroup nil
   "*The number of articles which indicates a large newsgroup.
 If the number of unread articles exceeds it, The number of articles to be
@@ -704,11 +710,15 @@ the actual number of articles toggled is returned."
   (save-excursion
     (set-buffer gnus-agent-current-history)
     (goto-char (point-max))
-    (insert id "\t" (number-to-string date) "\t")
-    (while group-arts
-      (insert (caar group-arts) " " (number-to-string (cdr (pop group-arts)))
-             " "))
-    (insert "\n")))
+    (let ((p (point)))
+      (insert id "\t" (number-to-string date) "\t")
+      (while group-arts
+       (insert (format "%S" (intern (caar group-arts)))
+               " " (number-to-string (cdr (pop group-arts)))
+               " "))
+      (insert "\n")
+      (while (search-backward "\\." p t)
+       (delete-char 1)))))
 
 (defun gnus-agent-article-in-history-p (id)
   (save-excursion
@@ -737,7 +747,7 @@ the actual number of articles toggled is returned."
     ;; Prune off articles that we have already fetched.
     (while (and articles
                (cdr (assq (car articles) gnus-agent-article-alist)))
-     (pop articles))
+      (pop articles))
     (let ((arts articles))
       (while (cdr arts)
        (if (cdr (assq (cadr arts) gnus-agent-article-alist))
@@ -758,7 +768,10 @@ the actual number of articles toggled is returned."
          (with-temp-buffer
            (let (article)
              (while (setq article (pop articles))
-               (when (gnus-request-article article group)
+               (when (or 
+                      (gnus-backlog-request-article group article 
+                                                    nntp-server-buffer)
+                      (gnus-request-article article group))
                  (goto-char (point-max))
                  (push (cons article (point)) pos)
                  (insert-buffer-substring nntp-server-buffer)))
@@ -816,7 +829,7 @@ the actual number of articles toggled is returned."
       (setcdr alist (cons (cons (cdar crosses) t) (cdr alist)))
       (save-excursion
        (set-buffer (gnus-get-buffer-create (format " *Gnus agent overview %s*"
-                                              group)))
+                                                   group)))
        (when (= (point-max) (point-min))
          (push (cons group (current-buffer)) gnus-agent-buffer-alist)
          (ignore-errors
@@ -968,7 +981,8 @@ the actual number of articles toggled is returned."
   "Start Gnus and fetch session."
   (interactive)
   (gnus)
-  (gnus-agent-fetch-session)
+  (let ((gnus-agent-confirmation-function 'gnus-agent-batch-confirmation))
+    (gnus-agent-fetch-session))
   (gnus-group-exit))
 
 (defun gnus-agent-fetch-session ()
@@ -982,14 +996,20 @@ the actual number of articles toggled is returned."
        groups group gnus-command-method)
     (save-excursion
       (while methods
-       (setq gnus-command-method (car methods))
-       (when (or (gnus-server-opened gnus-command-method)
-                 (gnus-open-server gnus-command-method))
-         (setq groups (gnus-groups-from-server (car methods)))
-         (gnus-agent-with-fetch
-           (while (setq group (pop groups))
-             (when (<= (gnus-group-level group) gnus-agent-handle-level)
-               (gnus-agent-fetch-group-1 group gnus-command-method)))))
+       (condition-case err
+           (progn
+             (setq gnus-command-method (car methods))
+             (when (or (gnus-server-opened gnus-command-method)
+                       (gnus-open-server gnus-command-method))
+               (setq groups (gnus-groups-from-server (car methods)))
+               (gnus-agent-with-fetch
+                 (while (setq group (pop groups))
+                   (when (<= (gnus-group-level group) gnus-agent-handle-level)
+                     (gnus-agent-fetch-group-1 group gnus-command-method))))))
+         (error 
+          (unless (funcall gnus-agent-confirmation-function
+                           (format "Error (%s).  Continue? " err))
+            (error "Cannot fetch articles into the Gnus agent."))))
        (pop methods))
       (gnus-message 6 "Finished fetching articles into the Gnus agent"))))
 
@@ -1018,7 +1038,7 @@ the actual number of articles toggled is returned."
                         (gnus-get-newsgroup-headers-xover articles nil nil
                                                           group)))
                 ;; `gnus-agent-overview-buffer' may be killed for
-                ;; timeout reason. If so, recreate it.
+                ;; timeout reason.  If so, recreate it.
                 (gnus-agent-create-buffer)))
       (setq category (gnus-group-category group))
       (setq predicate
@@ -1450,8 +1470,9 @@ The following commands are available:
                    (forward-line 1)
                  ;; Old article.  Schedule it for possible nuking.
                  (while (not (eolp))
-                   (setq sym (let ((obarray expiry-hashtb))
-                               (read (current-buffer))))
+                   (setq sym (let ((obarray expiry-hashtb) s)
+                               (setq s (read (current-buffer)))
+                               (if (stringp s) (intern s) s)))
                    (if (boundp sym)
                        (set sym (cons (cons (read (current-buffer)) (point))
                                       (symbol-value sym)))
index a44f97d..f7b5fff 100644 (file)
@@ -194,7 +194,7 @@ the end of the buffer."
   :group 'gnus-article-signature)
 
 (defcustom gnus-signature-limit nil
-   "Provide a limit to what is considered a signature.
+  "Provide a limit to what is considered a signature.
 If it is a number, no signature may not be longer (in characters) than
 that number.  If it is a floating point number, no signature may be
 longer (in lines) than that number.  If it is a function, the function
@@ -650,9 +650,9 @@ be added below it (otherwise)."
   "Function called with a MIME handle as the argument.
 This is meant for people who want to view first matched part.
 For `undisplayed-alternative' (default), the first undisplayed 
-part or alternative part is used. For `undisplayed', the first 
-undisplayed part is used. For a function, the first part which 
-the function return `t' is used. For `nil', the first part is
+part or alternative part is used.  For `undisplayed', the first 
+undisplayed part is used.  For a function, the first part which 
+the function return `t' is used.  For `nil', the first part is
 used."
   :group 'gnus-article-mime
   :type '(choice 
@@ -1570,39 +1570,39 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")."
   "Decode charset-encoded text in the article.
 If PROMPT (the prefix), prompt for a coding system to use."
   (interactive "P")
+  (let ((inhibit-point-motion-hooks t) (case-fold-search t)
+       buffer-read-only
+       (mail-parse-charset gnus-newsgroup-charset)
+       (mail-parse-ignored-charsets 
+        (save-excursion (condition-case nil
+                            (set-buffer gnus-summary-buffer)
+                          (error))
+                        gnus-newsgroup-ignored-charsets))
+       ct cte ctl charset)
   (save-excursion
     (save-restriction
       (article-narrow-to-head)
-      (let* ((inhibit-point-motion-hooks t)
-            (case-fold-search t)
-            (ct (message-fetch-field "Content-Type" t))
-            (cte (message-fetch-field "Content-Transfer-Encoding" t))
-            (ctl (and ct (ignore-errors
-                           (mail-header-parse-content-type ct))))
-            (charset (cond
-                      (prompt
-                       (mm-read-coding-system "Charset to decode: "))
-                      (ctl
-                       (mail-content-type-get ctl 'charset))))
-            (mail-parse-charset gnus-newsgroup-charset)
-            (mail-parse-ignored-charsets 
-             (save-excursion (condition-case nil
-                                 (set-buffer gnus-summary-buffer)
-                               (error))
-                             gnus-newsgroup-ignored-charsets))
-            buffer-read-only)
-       (if (and ctl (not (string-match "/" (car ctl)))) 
-           (setq ctl nil))
-       (goto-char (point-max))
-       (widen)
-       (forward-line 1)
-       (narrow-to-region (point) (point-max))
-       (when (and (or (not ctl)
-                      (equal (car ctl) "text/plain")))
-         (mm-decode-body
-          charset (and cte (intern (downcase
-                                    (gnus-strip-whitespace cte))))
-          (car ctl)))))))
+      (setq ct (message-fetch-field "Content-Type" t)
+           cte (message-fetch-field "Content-Transfer-Encoding" t)
+           ctl (and ct (ignore-errors
+                         (mail-header-parse-content-type ct)))
+           charset (cond
+                    (prompt
+                     (mm-read-coding-system "Charset to decode: "))
+                    (ctl
+                     (mail-content-type-get ctl 'charset))))
+      (if (and ctl (not (string-match "/" (car ctl)))) 
+         (setq ctl nil))
+      (goto-char (point-max)))
+    (forward-line 1)
+    (save-restriction
+      (narrow-to-region (point) (point-max))
+      (when (and (or (not ctl)
+                    (equal (car ctl) "text/plain")))
+       (mm-decode-body
+        charset (and cte (intern (downcase
+                                  (gnus-strip-whitespace cte))))
+        (car ctl)))))))
 
 (defun article-decode-encoded-words ()
   "Remove encoded-word encoding from headers."
@@ -1631,9 +1631,20 @@ or not."
          (when charset
            (mm-decode-body charset)))))))
 
+(eval-when-compile
+  (require 'rfc1843))
+
+(defun article-decode-HZ ()
+  "Translate a HZ-encoded article."
+  (interactive)
+  (require 'rfc1843)
+  (save-excursion
+    (let ((buffer-read-only nil))
+      (rfc1843-decode-region (point-min) (point-max)))))
+
 (defun article-hide-list-identifiers ()
-  "Remove any list identifiers in `gnus-list-identifiers' from Subject
-header in the current article."
+  "Remove list identifies from the Subject header.
+The `gnus-list-identifiers' variable specifies what to do."
   (interactive)
   (save-excursion
     (save-restriction
@@ -1987,7 +1998,7 @@ If HIDE, hide the text instead."
 (defun article-date-ut (&optional type highlight header)
   "Convert DATE date to universal time in the current article.
 If TYPE is `local', convert to local time; if it is `lapsed', output
-how much time has lapsed since DATE. For `lapsed', the value of
+how much time has lapsed since DATE.  For `lapsed', the value of
 `gnus-article-date-lapsed-new-header' says whether the \"X-Sent:\" header
 should replace the \"Date:\" one, or should be added below it."
   (interactive (list 'ut t))
@@ -2082,9 +2093,9 @@ should replace the \"Date:\" one, or should be added below it."
       (concat "Date: "
              (current-time-string
               (let* ((e (parse-time-string date))
-                    (tm (apply 'encode-time e))
-                    (ms (car tm))
-                    (ls (- (cadr tm) (car (current-time-zone time)))))
+                     (tm (apply 'encode-time e))
+                     (ms (car tm))
+                     (ls (- (cadr tm) (car (current-time-zone time)))))
                 (cond ((< ls 0) (list (1- ms) (+ ls 65536)))
                       ((> ls 65535) (list (1+ ms) (- ls 65536)))
                       (t (list ms ls)))))
@@ -2607,6 +2618,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
      article-remove-cr
      article-display-x-face
      article-de-quoted-unreadable
+     article-decode-HZ
      article-hide-list-identifiers
      article-hide-pgp
      article-strip-banner
@@ -2707,7 +2719,8 @@ If variable `gnus-use-long-file-name' is non-nil, it is
        ["Hide signature" gnus-article-hide-signature t]
        ["Hide citation" gnus-article-hide-citation t]
        ["Treat overstrike" gnus-article-treat-overstrike t]
-       ["Remove carriage return" gnus-article-remove-cr t]))
+       ["Remove carriage return" gnus-article-remove-cr t]
+       ["Decode HZ" gnus-article-decode-HZ t]))
 
     ;; Note "Commands" menu is defined in gnus-sum.el for consistency
 
@@ -2917,7 +2930,7 @@ If ALL-HEADERS is non-nil, no headers are hidden."
                  (gnus-summary-mark-article article gnus-canceled-mark)
                  (unless (memq article gnus-newsgroup-sparse)
                    (gnus-error 1
-                    "No such article (may have expired or been canceled)")))))
+                               "No such article (may have expired or been canceled)")))))
          (if (or (eq result 'pseudo)
                  (eq result 'nneething))
              (progn
@@ -3210,7 +3223,8 @@ value of the variable `gnus-show-mime' is non-nil."
 (defun gnus-mime-view-part-as-type ()
   "Choose a MIME media type, and view the part as such."
   (interactive
-   (list (completing-read "View as MIME type: " mailcap-mime-types)))
+   (list (completing-read "View as MIME type: "
+                         (mapcar 'list (mailcap-mime-types)))))
   (gnus-article-check-buffer)
   (let ((handle (get-text-property (point) 'gnus-data)))
     (gnus-mm-display-part handle)))
@@ -3333,7 +3347,7 @@ In no internal viewer is available, use an external viewer."
                    ((eq condition 'undisplayed) 
                     (not (or (mm-handle-undisplayer (cdr ihandle))
                              (equal (mm-handle-media-type (cdr ihandle))
-                                "multipart/alternative"))))
+                                    "multipart/alternative"))))
                    ((eq condition 'undisplayed-alternative)
                     (not (mm-handle-undisplayer (cdr ihandle))))
                    (t t))
@@ -3484,7 +3498,7 @@ In no internal viewer is available, use an external viewer."
          ;; Top-level call; we clean up.
          (when gnus-article-mime-handles
            (mm-destroy-parts gnus-article-mime-handles)
-           (setq gnus-article-mime-handle-alist nil)) ;; A trick.
+           (setq gnus-article-mime-handle-alist nil));; A trick.
          (setq gnus-article-mime-handles handles)
          ;; We allow users to glean info from the handles.
          (when gnus-article-mime-part-function
@@ -3505,13 +3519,13 @@ In no internal viewer is available, use an external viewer."
            (narrow-to-region (point) (point-max))
            (gnus-treat-article nil 1 1)
            (widen)))
-       (if (not ihandles)
-           ;; Highlight the headers.
-           (save-excursion
-             (save-restriction
-               (article-goto-body)
-               (narrow-to-region (point-min) (point))
-               (gnus-treat-article 'head))))))))
+       (unless ihandles
+         ;; Highlight the headers.
+         (save-excursion
+           (save-restriction
+             (article-goto-body)
+             (narrow-to-region (point-min) (point))
+             (gnus-treat-article 'head))))))))
 
 (defvar gnus-mime-display-multipart-as-mixed nil)
 
@@ -3575,11 +3589,11 @@ In no internal viewer is available, use an external viewer."
          (push (cons id handle) gnus-article-mime-handle-alist)
          (when (or (not display)
                    (not (gnus-unbuttonized-mime-type-p type)))
-           (gnus-article-insert-newline)
+           ;(gnus-article-insert-newline)
            (gnus-insert-mime-button
             handle id (list (or display (and not-attachment text))))
            (gnus-article-insert-newline)
-           (gnus-article-insert-newline)
+           ;(gnus-article-insert-newline)
            (setq move t)))
        (let ((beg (point)))
          (cond
@@ -4034,8 +4048,7 @@ If given a prefix, show the hidden text instead."
          ;; We only request an article by message-id when we do not have the
          ;; headers for it, so we'll have to get those.
          (when (stringp article)
-           (let ((gnus-override-method gnus-refer-article-method))
-             (gnus-read-header article)))
+           (gnus-read-header article))
 
          ;; If the article number is negative, that means that this article
          ;; doesn't belong in this newsgroup (possibly), so we find its
@@ -4053,8 +4066,7 @@ If given a prefix, show the hidden text instead."
                    ;; This is a sparse gap article.
                    (setq do-update-line article)
                    (setq article (mail-header-id header))
-                   (let ((gnus-override-method gnus-refer-article-method))
-                     (setq sparse-header (gnus-read-header article)))
+                   (setq sparse-header (gnus-read-header article))
                    (setq gnus-newsgroup-sparse
                          (delq article gnus-newsgroup-sparse)))
                   ((vectorp header)
@@ -4106,20 +4118,35 @@ If given a prefix, show the hidden text instead."
            'article)
           ;; Get the article and put into the article buffer.
           ((or (stringp article) (numberp article))
-           (let ((gnus-override-method
-                  (and (stringp article) gnus-refer-article-method))
+           (let ((gnus-override-method gnus-override-method)
+                 (methods (and (stringp article) 
+                               gnus-refer-article-method))
+                 result
                  (buffer-read-only nil))
-             (erase-buffer)
-             (gnus-kill-all-overlays)
-             (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)
-                 (when gnus-keep-backlog
-                   (gnus-backlog-enter-article
-                    group article (current-buffer))))
-               'article)))
+             (setq methods
+                   (if (listp methods)
+                       (delq 'current methods)
+                     (list methods)))
+             (if (and (null gnus-override-method) methods)
+                 (setq gnus-override-method (pop methods)))
+             (while (not result)
+               (erase-buffer)
+               (gnus-kill-all-overlays)
+               (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)
+                   (when gnus-keep-backlog
+                     (gnus-backlog-enter-article
+                      group article (current-buffer))))
+                 (setq result 'article))
+               (if (not result)
+                   (if methods
+                       (setq gnus-override-method (pop methods))
+                     (setq result 'done))))
+             (and (eq result 'article) 'article)))
           ;; It was a pseudo.
           (t article)))
 
@@ -4426,7 +4453,7 @@ after replacing with the original article."
     ("mailto:\\([-a-zA-Z.@_+0-9%]+\\)" 0 t gnus-url-mailto 1)
     ("\\bmailto:\\([^ \n\t]+\\)" 0 t gnus-url-mailto 1)
     ;; This is how URLs _should_ be embedded in text...
-    ("<URL: *\\([^>]*\\)>" 0 t gnus-button-embedded-url 1)
+    ("<URL: *\\([^<>]*\\)>" 0 t gnus-button-embedded-url 1)
     ;; Raw URLs.
     (,gnus-button-url-regexp 0 t browse-url 0))
   "*Alist of regexps matching buttons in article bodies.
@@ -5000,8 +5027,8 @@ forbidden in URL encoding."
   '(mail-decode-encoded-word-region)
   "List of methods used to decode headers.
 
-This variable is a list of FUNCTION or (REGEXP . FUNCTION). If item is
-FUNCTION, FUNCTION will be apply to all newsgroups. If item is a
+This variable is a list of FUNCTION or (REGEXP . FUNCTION).  If item
+is FUNCTION, FUNCTION will be apply to all newsgroups.  If item is a
 (REGEXP . FUNCTION), FUNCTION will be only apply to thes newsgroups
 whose names match REGEXP.
 
@@ -5019,13 +5046,13 @@ For example:
               (eq gnus-newsgroup-name
                   (car gnus-decode-header-methods-cache)))
     (setq gnus-decode-header-methods-cache (list gnus-newsgroup-name))
-    (mapc '(lambda (x)
-            (if (symbolp x)
-                (nconc gnus-decode-header-methods-cache (list x))
-              (if (and gnus-newsgroup-name
-                       (string-match (car x) gnus-newsgroup-name))
-                  (nconc gnus-decode-header-methods-cache
-                         (list (cdr x))))))
+    (mapcar (lambda (x)
+             (if (symbolp x)
+                 (nconc gnus-decode-header-methods-cache (list x))
+               (if (and gnus-newsgroup-name
+                        (string-match (car x) gnus-newsgroup-name))
+                   (nconc gnus-decode-header-methods-cache
+                          (list (cdr x))))))
          gnus-decode-header-methods))
   (let ((xlist gnus-decode-header-methods-cache))
     (pop xlist)
index 0009e85..79063ed 100644 (file)
@@ -26,6 +26,7 @@
 ;;; Code:
 
 (eval-when-compile (require 'cl))
+
 (require 'gnus)
 (require 'gnus-sum)
 (require 'nntp)
@@ -158,42 +159,42 @@ It should return non-nil if the article is to be prefetched."
   "Possibly prefetch several articles starting with ARTICLE."
   (if (not (gnus-buffer-live-p summary))
       (gnus-async-with-semaphore
-       (setq gnus-async-fetch-list nil))
+       (setq gnus-async-fetch-list nil))
     (when (and gnus-asynchronous
               (gnus-alive-p))
       (when next
        (gnus-async-with-semaphore
-        (pop gnus-async-fetch-list)))
+         (pop gnus-async-fetch-list)))
       (let ((do-fetch next)
-           (do-message t)) ;(eq major-mode 'gnus-summary-mode)))
+           (do-message t))             ;(eq major-mode 'gnus-summary-mode)))
        (when (and (gnus-group-asynchronous-p group)
                   (gnus-buffer-live-p summary)
                   (or (not next)
                       gnus-async-fetch-list))
          (gnus-async-with-semaphore
-          (unless next
-            (setq do-fetch (not gnus-async-fetch-list))
-            ;; Nix out any outstanding requests.
-            (setq gnus-async-fetch-list nil)
-            ;; Fill in the new list.
-            (let ((n gnus-use-article-prefetch)
-                  (data (gnus-data-find-list article))
-                  d)
-              (while (and (setq d (pop data))
-                          (if (numberp n)
-                              (natnump (decf n))
-                            n))
-                (unless (or (gnus-async-prefetched-article-entry
-                             group (setq article (gnus-data-number d)))
-                            (not (natnump article))
-                            (not (funcall gnus-async-prefetch-article-p d)))
-                  ;; Not already fetched -- so we add it to the list.
-                  (push article gnus-async-fetch-list)))
-              (setq gnus-async-fetch-list
-                    (nreverse gnus-async-fetch-list))))
-
-          (when do-fetch
-            (setq article (car gnus-async-fetch-list))))
+           (unless next
+             (setq do-fetch (not gnus-async-fetch-list))
+             ;; Nix out any outstanding requests.
+             (setq gnus-async-fetch-list nil)
+             ;; Fill in the new list.
+             (let ((n gnus-use-article-prefetch)
+                   (data (gnus-data-find-list article))
+                   d)
+               (while (and (setq d (pop data))
+                           (if (numberp n)
+                               (natnump (decf n))
+                             n))
+                 (unless (or (gnus-async-prefetched-article-entry
+                              group (setq article (gnus-data-number d)))
+                             (not (natnump article))
+                             (not (funcall gnus-async-prefetch-article-p d)))
+                   ;; Not already fetched -- so we add it to the list.
+                   (push article gnus-async-fetch-list)))
+               (setq gnus-async-fetch-list
+                     (nreverse gnus-async-fetch-list))))
+
+           (when do-fetch
+             (setq article (car gnus-async-fetch-list))))
 
          (when (and do-fetch article)
            ;; We want to fetch some more articles.
@@ -227,16 +228,16 @@ It should return non-nil if the article is to be prefetched."
     (when arg
       (gnus-async-set-buffer)
       (gnus-async-with-semaphore
-       (setq
-       gnus-async-article-alist
-       (cons (list (intern (format "%s-%d" group article)
-                           gnus-async-hashtb)
-                   mark (set-marker (make-marker) (point-max))
-                   group article)
-             gnus-async-article-alist))))
+       (setq
+        gnus-async-article-alist
+        (cons (list (intern (format "%s-%d" group article)
+                            gnus-async-hashtb)
+                    mark (set-marker (make-marker) (point-max))
+                    group article)
+              gnus-async-article-alist))))
     (if (not (gnus-buffer-live-p summary))
        (gnus-async-with-semaphore
-        (setq gnus-async-fetch-list nil))
+         (setq gnus-async-fetch-list nil))
       (gnus-async-prefetch-article group next summary t))))
 
 (defun gnus-async-unread-p (data)
@@ -296,8 +297,8 @@ It should return non-nil if the article is to be prefetched."
     (set-marker (cadr entry) nil)
     (set-marker (caddr entry) nil))
   (gnus-async-with-semaphore
-   (setq gnus-async-article-alist
-        (delq entry gnus-async-article-alist))))
+    (setq gnus-async-article-alist
+         (delq entry gnus-async-article-alist))))
 
 (defun gnus-async-prefetch-remove-group (group)
   "Remove all articles belonging to GROUP from the prefetch buffer."
index f3bb686..e84c1df 100644 (file)
   "Executable program for playing WAV files.")
 
 ;;; The following isn't implemented yet.  Wait for Millennium Gnus.
-;(defvar gnus-audio-effects-enabled t
-;  "When t, Gnus will use sound effects.")
-;(defvar gnus-audio-enable-hooks nil
-;  "Functions run when enabling sound effects.")
-;(defvar gnus-audio-disable-hooks nil
-;  "Functions run when disabling sound effects.")
-;(defvar gnus-audio-theme-song nil
-;  "Theme song for Gnus.")
-;(defvar gnus-audio-enter-group nil
-;  "Sound effect played when selecting a group.")
-;(defvar gnus-audio-exit-group nil
-;  "Sound effect played when exiting a group.")
-;(defvar gnus-audio-score-group nil
-;  "Sound effect played when scoring a group.")
-;(defvar gnus-audio-busy-sound nil
-;  "Sound effect played when going into a ... sequence.")
+;;(defvar gnus-audio-effects-enabled t
+;;  "When t, Gnus will use sound effects.")
+;;(defvar gnus-audio-enable-hooks nil
+;;  "Functions run when enabling sound effects.")
+;;(defvar gnus-audio-disable-hooks nil
+;;  "Functions run when disabling sound effects.")
+;;(defvar gnus-audio-theme-song nil
+;;  "Theme song for Gnus.")
+;;(defvar gnus-audio-enter-group nil
+;;  "Sound effect played when selecting a group.")
+;;(defvar gnus-audio-exit-group nil
+;;  "Sound effect played when exiting a group.")
+;;(defvar gnus-audio-score-group nil
+;;  "Sound effect played when scoring a group.")
+;;(defvar gnus-audio-busy-sound nil
+;;  "Sound effect played when going into a ... sequence.")
 
 
 ;;;###autoload
-                                       ;(defun gnus-audio-enable-sound ()
-;  "Enable Sound Effects for Gnus."
-;  (interactive)
-;  (setq gnus-audio-effects-enabled t)
-;  (gnus-run-hooks gnus-audio-enable-hooks))
+;;(defun gnus-audio-enable-sound ()
+;;  "Enable Sound Effects for Gnus."
+;;  (interactive)
+;;  (setq gnus-audio-effects-enabled t)
+;;  (gnus-run-hooks gnus-audio-enable-hooks))
 
 ;;;###autoload
                                        ;(defun gnus-audio-disable-sound ()
-;  "Disable Sound Effects for Gnus."
-;  (interactive)
-;  (setq gnus-audio-effects-enabled nil)
-;  (gnus-run-hooks gnus-audio-disable-hooks))
+;;  "Disable Sound Effects for Gnus."
+;;  (interactive)
+;;  (setq gnus-audio-effects-enabled nil)
+;;  (gnus-run-hooks gnus-audio-disable-hooks))
 
 ;;;###autoload
 (defun gnus-audio-play (file)
 
 
 ;;; The following isn't implemented yet, wait for Red Gnus
-                                       ;(defun gnus-audio-startrek-sounds ()
-;  "Enable sounds from Star Trek the original series."
-;  (interactive)
-;  (setq gnus-audio-busy-sound "working.au")
-;  (setq gnus-audio-enter-group "bulkhead_door.au")
-;  (setq gnus-audio-exit-group "bulkhead_door.au")
-;  (setq gnus-audio-score-group "ST_laser.au")
-;  (setq gnus-audio-theme-song "startrek.au")
-;  (add-hook 'gnus-select-group-hook 'gnus-audio-startrek-select-group)
-;  (add-hook 'gnus-exit-group-hook 'gnus-audio-startrek-exit-group))
+;;(defun gnus-audio-startrek-sounds ()
+;;  "Enable sounds from Star Trek the original series."
+;;  (interactive)
+;;  (setq gnus-audio-busy-sound "working.au")
+;;  (setq gnus-audio-enter-group "bulkhead_door.au")
+;;  (setq gnus-audio-exit-group "bulkhead_door.au")
+;;  (setq gnus-audio-score-group "ST_laser.au")
+;;  (setq gnus-audio-theme-song "startrek.au")
+;;  (add-hook 'gnus-select-group-hook 'gnus-audio-startrek-select-group)
+;;  (add-hook 'gnus-exit-group-hook 'gnus-audio-startrek-exit-group))
 ;;;***
 
 (defvar gnus-startup-jingle "Tuxedomoon.Jingle4.au"
index a47a199..701cf38 100644 (file)
              t))
          (setq gnus-backlog-articles (delq ident gnus-backlog-articles)))))))
 
-(defun gnus-backlog-request-article (group number buffer)
+(defun gnus-backlog-request-article (group number &optional buffer)
   (when (numberp number)
     (gnus-backlog-setup)
     (let ((ident (intern (concat group ":" (int-to-string number))
            (setq end
                  (next-single-property-change
                   (1+ beg) 'gnus-backlog (current-buffer) (point-max)))))
-       (let ((buffer-read-only nil))
-         (erase-buffer)
-         (insert-buffer-substring gnus-backlog-buffer beg end)
-         t)))))
+       (save-excursion
+         (and buffer (set-buffer buffer))
+         (let ((buffer-read-only nil))
+           (erase-buffer)
+           (insert-buffer-substring gnus-backlog-buffer beg end)))
+       t))))
 
 (provide 'gnus-bcklg)
 
index 2f715a8..3c6ae42 100644 (file)
@@ -62,7 +62,7 @@ If a group matches both gnus-cacheable-groups and gnus-uncacheable-groups
 it's not cached."
   :group 'gnus-cache
   :type '(choice (const :tag "off" nil)
-                regexp))
+                regexp))
 
 (defcustom gnus-uncacheable-groups nil
   "*Groups that match this regexp will not be cached.
index 33ff4fd..93cb0c3 100644 (file)
@@ -21,6 +21,7 @@
 ;;; Code:
 
 (eval-when-compile (require 'cl))
+
 (require 'gnus)
 (require 'gnus-art)
 (require 'gnus-range)
@@ -43,10 +44,10 @@ article has citations."
   :type 'string)
 
 (defcustom gnus-cite-always-check nil
-  "Check article always for citations. Set it t to check all articles."
+  "Check article always for citations.  Set it t to check all articles."
   :group 'gnus-cite
   :type '(choice (const :tag "no" nil)
-                 (const :tag "yes" t)))
+                (const :tag "yes" t)))
 
 (defcustom gnus-cited-opened-text-button-line-format "%(%{[-]%}%)\n"
   "Format of opened cited text buttons."
@@ -239,8 +240,8 @@ It is merged with the face for the cited text belonging to the attribution."
 
 (defcustom gnus-cite-face-list
   '(gnus-cite-face-1 gnus-cite-face-2 gnus-cite-face-3 gnus-cite-face-4
-    gnus-cite-face-5 gnus-cite-face-6 gnus-cite-face-7 gnus-cite-face-8
-    gnus-cite-face-9 gnus-cite-face-10 gnus-cite-face-11)
+                    gnus-cite-face-5 gnus-cite-face-6 gnus-cite-face-7 gnus-cite-face-8
+                    gnus-cite-face-9 gnus-cite-face-10 gnus-cite-face-11)
   "*List of faces used for highlighting citations.
 
 When there are citations from multiple articles in the same message,
@@ -526,17 +527,19 @@ always hide."
 (defun gnus-article-toggle-cited-text (args)
   "Toggle hiding the text in REGION."
   (let* ((region (car args))
+        (beg (car region))
+        (end (cdr region))
         (start (cadr args))
         (hidden
          (text-property-any
-          (car region) (1- (cdr region))
+          beg (1- end)
           (car gnus-hidden-properties) (cadr gnus-hidden-properties)))
         (inhibit-point-motion-hooks t)
         buffer-read-only)
     (funcall
      (if hidden
         'remove-text-properties 'gnus-add-text-properties)
-     (car region) (cdr region) gnus-hidden-properties)
+     beg end gnus-hidden-properties)
     (save-excursion
       (goto-char start)
       (gnus-delete-line)
@@ -970,4 +973,8 @@ See also the documentation for `gnus-article-highlight-citation'."
 
 (provide 'gnus-cite)
 
+;; Local Variables:
+;; coding: iso-8859-1
+;; End:
+
 ;;; gnus-cite.el ends here
index 995d6b4..92baaca 100644 (file)
@@ -147,7 +147,7 @@ All posts will be send to the specified group.")
 Specify default value for GCC header.
 
 If this symbol is present in the group parameter list and set to `t',
-new composed messages will be `Gcc''d to the current group. If it is
+new composed messages will be `Gcc''d to the current group.  If it is
 present and set to `none', no `Gcc:' header will be generated, if it
 is present and a string, this string will be inserted literally as a
 `gcc' header (this symbol takes precedence over any default `Gcc'
@@ -155,7 +155,8 @@ rules as described later).")
 
     (banner (choice :tag "Banner"
                    (const signature)
-                   string ) "\
+                   string
+                   (const :tag "None" nil)) "\
 Banner to be removed from articles.")
 
     (auto-expire (const :tag "Automatic Expire" t) "\
@@ -176,7 +177,7 @@ Use with caution.")
 When to expire.
 
 Overrides any `nnmail-expiry-wait' and `nnmail-expiry-wait-function'
-when expiring expirable messages. The value can either be a number of
+when expiring expirable messages.  The value can either be a number of
 days (not necessarily an integer) or the symbols `never' or
 `immediate'.")
 
@@ -236,7 +237,7 @@ default charset will be used instead.")
                           (number :tag "Group for displayed part" 0)
                           (symbol :tag "Face" 
                                   gnus-emphasis-highlight-words))))
-  "highlight regexps.
+     "highlight regexps.
 See gnus-emphasis-alist."))
   "Alist of valid group or topic parameters.
 
@@ -342,10 +343,10 @@ like.  If you want to hear a beep when you enter a group, you could
 put something like `(dummy-variable (ding))' in the parameters of that
 group.  `dummy-variable' will be set to the result of the `(ding)'
 form, but who cares?"
-                                 (cons :format "%v" :value (nil .  nil)
-                                        (symbol :tag "Variable")
-                                        (sexp :tag
-                                              "Value")))
+                                 (list :format "%v" :value (nil nil)
+                                       (symbol :tag "Variable")
+                                       (sexp :tag
+                                             "Value")))
 
                         '(repeat :inline t
                                  :tag "Unknown entries"
@@ -490,9 +491,9 @@ documentation string for the parameter.")
         (item `(const :format "" :value ,(downcase tag)))
         (match '(string :tag "Match"))
         (score '(choice :tag "Score"
-                       (const :tag "default" nil)
-                       (integer :format "%v"
-                                :hide-front-space t)))
+                        (const :tag "default" nil)
+                        (integer :format "%v"
+                                 :hide-front-space t)))
         (expire '(choice :tag "Expire"
                          (const :tag "off" nil)
                          (integer :format "%v"
@@ -563,9 +564,9 @@ each score entry has four elements:
         (item `(const :format "" :value ,(downcase tag)))
         (match '(integer :tag "Match"))
         (score '(choice :tag "Score"
-                       (const :tag "default" nil)
-                       (integer :format "%v"
-                                :hide-front-space t)))
+                        (const :tag "default" nil)
+                        (integer :format "%v"
+                                 :hide-front-space t)))
         (expire '(choice :tag "Expire"
                          (const :tag "off" nil)
                          (integer :format "%v"
@@ -600,9 +601,9 @@ each score entry has four elements:
         (item `(const :format "" :value ,(downcase tag)))
         (match '(string :tag "Match"))
         (score '(choice :tag "Score"
-                       (const :tag "default" nil)
-                       (integer :format "%v"
-                                :hide-front-space t)))
+                        (const :tag "default" nil)
+                        (integer :format "%v"
+                                 :hide-front-space t)))
         (expire '(choice :tag "Expire"
                          (const :tag "off" nil)
                          (integer :format "%v"
@@ -652,11 +653,11 @@ eh?")))
   (interactive (list gnus-current-score-file))
   (let ((scores (gnus-score-load file))
        (types (mapcar (lambda (entry)
-                `(group :format "%v%h\n"
-                        :doc ,(nth 2 entry)
-                        (const :format "" ,(nth 0 entry))
-                        ,(nth 1 entry)))
-              gnus-score-parameters)))
+                        `(group :format "%v%h\n"
+                                :doc ,(nth 2 entry)
+                                (const :format "" ,(nth 0 entry))
+                                ,(nth 1 entry)))
+                      gnus-score-parameters)))
     ;; Ready.
     (kill-buffer (gnus-get-buffer-create "*Gnus Customize*"))
     (switch-to-buffer (gnus-get-buffer-create "*Gnus Customize*"))
index 7c1fa49..e3704d0 100644 (file)
@@ -159,7 +159,7 @@ time Emacs has been idle for IDLE `gnus-demon-timestep's."
                               thenMin
                               thenHour
                               ;; If THEN is earlier than NOW, make it
-                              ;; same time tomorrow. Doc for encode-time
+                              ;; same time tomorrow.  Doc for encode-time
                               ;; says that this is OK.
                               (+ (elt nowParts 3)
                                  (if (or (< thenHour (elt nowParts 2))
@@ -258,7 +258,7 @@ time Emacs has been idle for IDLE `gnus-demon-timestep's."
   "Add daemonic nntp server disconnection to Gnus.
 If no commands have gone out via nntp during the last five
 minutes, the connection is closed."
-  (gnus-demon-add-handler 'gnus-demon-close-connections 5 nil))
+  (gnus-demon-add-handler 'gnus-demon-nntp-close-connections 5 nil))
 
 (defun gnus-demon-nntp-close-connection ()
   (save-window-excursion
index b0df871..3e6def0 100644 (file)
@@ -69,8 +69,8 @@
   (interactive "P")
   (when (eq major-mode 'gnus-summary-mode)
     (when (set (make-local-variable 'gnus-draft-mode)
-                 (if (null arg) (not gnus-draft-mode)
-                   (> (prefix-numeric-value arg) 0)))
+              (if (null arg) (not gnus-draft-mode)
+                (> (prefix-numeric-value arg) 0)))
       ;; Set up the menu.
       (when (gnus-visual-p 'draft-menu 'menu)
        (gnus-draft-make-menu-bar))
index 84dff68..acbac35 100644 (file)
@@ -99,8 +99,9 @@
                    (symbol-name system-type))
       (setq nnheader-file-name-translation-alist
            (append nnheader-file-name-translation-alist
-                   '((?: . ?_)
-                     (?+ . ?-))))))))
+                   (mapcar (lambda (c) (cons c ?_))
+                           '(?: ?* ?\" ?< ?> ??))
+                   '((?+ . ?-))))))))
 
 (defvar gnus-tmp-unread)
 (defvar gnus-tmp-replied)
 
     ;; [Note] Now there are three kinds of mule implementations,
     ;; original MULE, XEmacs/mule and beta version of Emacs including
-    ;; some mule features. Unfortunately these API are different. In
+    ;; some mule features.  Unfortunately these API are different.  In
     ;; particular, Emacs (including original MULE) and XEmacs are
     ;; quite different.
     ;; Predicates to check are following:
     ;; (featurep 'mule) is t when every mule variants are running.
 
     ;; These implementations may be able to share between original
-    ;; MULE and beta version of new Emacs. In addition, it is able to
+    ;; MULE and beta version of new Emacs.  In addition, it is able to
     ;; detect XEmacs/mule by (featurep 'mule) and to check variable
-    ;; `emacs-version'. In this case, implementation for XEmacs/mule
+    ;; `emacs-version'.  In this case, implementation for XEmacs/mule
     ;; may be able to share between XEmacs and XEmacs/mule.
 
     (defvar gnus-summary-display-table nil
index 3263e60..68e18c7 100644 (file)
 This pseudonym is obtained during the registration process")
 
 (defvar grouplens-bbb-host "grouplens.cs.umn.edu"
-  "Host where the bbbd is running" )
+  "Host where the bbbd is running.")
 
 (defvar grouplens-bbb-port 9000
-  "Port where the bbbd is listening" )
+  "Port where the bbbd is listening.")
 
 (defvar grouplens-newsgroups
   '("comp.groupware" "comp.human-factors" "comp.lang.c++"
@@ -194,19 +194,19 @@ GroupLens scores can be combined with gnus scores in one of three ways.
 ;;;; Program global variables
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (defvar grouplens-bbb-token nil
-  "Current session token number")
+  "Current session token number.")
 
 (defvar grouplens-bbb-process nil
-  "Process Id of current bbbd network stream process")
+  "Process Id of current bbbd network stream process.")
 
 (defvar grouplens-bbb-buffer nil
-  "Buffer associated with the BBBD process")
+  "Buffer associated with the BBBD process.")
 
 (defvar grouplens-rating-alist nil
-  "Current set of  message-id rating pairs")
+  "Current set of  message-id rating pairs.")
 
 (defvar grouplens-current-hashtable nil
-  "A hashtable to hold predictions from the BBB")
+  "A hashtable to hold predictions from the BBB.")
 
 (defvar grouplens-current-group nil)
 
@@ -313,7 +313,7 @@ If this times out we give up and assume that something has died..." )
                                (concat "login " grouplens-pseudonym))
              (if (bbb-read-response bbb-process)
                  (setq grouplens-bbb-token (bbb-extract-token-number))
-             (gnus-message 3 "Error: GroupLens login failed")))))
+               (gnus-message 3 "Error: GroupLens login failed")))))
     (gnus-message 3 "Error: you must set a pseudonym"))
   grouplens-bbb-token)
 
@@ -407,7 +407,7 @@ recommend using both scores and grouplens predictions together."
                pred (bbb-get-pred))
          (push `(,mid ,pred nil s) resp)
          (gnus-sethash mid (list pred (bbb-get-confl) (bbb-get-confh))
-                     grouplens-current-hashtable)
+                       grouplens-current-hashtable)
          (forward-line 1)
          t)
         ((looking-at "\\(<.*>\\) :pred=\\([0-9]\.[0-9][0-9]\\)")
@@ -780,12 +780,12 @@ If prefix argument ALL is non-nil, all articles are marked as read."
 (unless gnus-grouplens-mode-map
   (setq gnus-grouplens-mode-map (make-keymap))
   (gnus-define-keys
-   gnus-grouplens-mode-map
-   "n" grouplens-next-unread-article
-   "r" bbb-summary-rate-article
-   "k" grouplens-score-thread
-   "c" grouplens-summary-catchup-and-exit
-   "," grouplens-best-unread-article))
+      gnus-grouplens-mode-map
+    "n" grouplens-next-unread-article
+    "r" bbb-summary-rate-article
+    "k" grouplens-score-thread
+    "c" grouplens-summary-catchup-and-exit
+    "," grouplens-best-unread-article))
 
 (defun gnus-grouplens-make-menu-bar ()
   (unless (boundp 'gnus-grouplens-menu)
index 17b58fe..9d7f92d 100644 (file)
@@ -26,6 +26,7 @@
 ;;; Code:
 
 (eval-when-compile (require 'cl))
+
 (require 'gnus)
 (require 'gnus-start)
 (require 'nnmail)
@@ -331,7 +332,7 @@ variable."
     ((= unread 0) .
      gnus-group-mail-low-empty-face)
     (t .
-     gnus-group-mail-low-face))
+       gnus-group-mail-low-face))
   "*Controls the highlighting of group buffer lines.
 
 Below is a list of `Form'/`Face' pairs.  When deciding how a a
@@ -932,7 +933,7 @@ If REGEXP, only list groups matching REGEXP."
              params (gnus-info-params info)
              newsrc (cdr newsrc)
              unread (car (gnus-gethash group gnus-newsrc-hashtb)))
-       (and unread                     ; This group might be bogus
+       (and unread                     ; This group might be unchecked
             (or (not regexp)
                 (string-match regexp group))
             (<= (setq clevel (gnus-info-level info)) level)
@@ -1579,7 +1580,7 @@ be permanent."
 (defun gnus-fetch-group (group)
   "Start Gnus if necessary and enter GROUP.
 Returns whether the fetching was successful or not."
-  (interactive "sGroup name: ")
+  (interactive (list (completing-read "Group name: " gnus-active-hashtb)))
   (unless (get-buffer gnus-group-buffer)
     (gnus-no-server))
   (gnus-group-read-group nil nil group))
@@ -1858,8 +1859,20 @@ ADDRESS."
       (gnus-request-create-group nname nil args))
     t))
 
-(defun gnus-group-delete-group (group &optional force)
-  "Delete the current group.  Only meaningful with mail groups.
+(defun gnus-group-delete-groups (&optional arg)
+  "Delete the current group.  Only meaningful with editable groups."
+  (interactive "P")
+  (let ((n (length (gnus-group-process-prefix arg))))
+    (when (gnus-yes-or-no-p
+          (if (= n 1)
+              "Delete this 1 group? "
+            (format "Delete these %d groups? " n)))
+      (gnus-group-iterate arg
+       (lambda (group)
+         (gnus-group-delete-group group nil t))))))
+
+(defun gnus-group-delete-group (group &optional force no-prompt)
+  "Delete the current group.  Only meaningful with editable groups.
 If FORCE (the prefix) is non-nil, all the articles in the group will
 be deleted.  This is \"deleted\" as in \"removed forever from the face
 of the Earth\".         There is no undo.  The user will be prompted before
@@ -1872,10 +1885,11 @@ doing the deletion."
   (unless (gnus-check-backend-function 'request-delete-group group)
     (error "This backend does not support group deletion"))
   (prog1
-      (if (not (gnus-yes-or-no-p
-               (format
-                "Do you really want to delete %s%s? "
-                group (if force " and all its contents" ""))))
+      (if (and (not no-prompt)
+              (not (gnus-yes-or-no-p
+                    (format
+                     "Do you really want to delete %s%s? "
+                     group (if force " and all its contents" "")))))
          ()                            ; Whew!
        (gnus-message 6 "Deleting group %s..." group)
        (if (not (gnus-request-delete-group group force))
@@ -2295,12 +2309,12 @@ score file entries for articles to include in the group."
 
    An access control list is a list of (identifier . rights) elements.
 
-   The identifier string specifies the corresponding user. The
+   The identifier string specifies the corresponding user.  The
    identifier \"anyone\" is reserved to refer to the universal identity.
 
    Rights is a string listing a (possibly empty) set of alphanumeric
    characters, each character listing a set of operations which is being
-   controlled. Letters are reserved for ``standard'' rights, listed
+   controlled.  Letters are reserved for ``standard'' rights, listed
    below.  Digits are reserved for implementation or site defined rights.
 
    l - lookup (mailbox is visible to LIST/LSUB commands)
@@ -2572,8 +2586,7 @@ up is returned."
          (when (eq 'nnvirtual (car method))
            (nnvirtual-catchup-group
             (gnus-group-real-name group) (nth 1 method) all)))
-       (if (>= (gnus-info-level (gnus-get-info group))
-               gnus-level-zombie)
+       (if (>= (gnus-group-level group) gnus-level-zombie)
            (gnus-message 2 "Dead groups can't be caught up")
          (if (prog1
                  (gnus-group-goto-group group)
@@ -2972,7 +2985,7 @@ entail asking the server for the groups."
   ;; First we make sure that we have really read the active file.
   (unless (gnus-read-active-file-p)
     (let ((gnus-read-active-file t)
-         (gnus-agent nil)) ; Trick the agent into ignoring the active file.
+         (gnus-agent nil))             ; Trick the agent into ignoring the active file.
       (gnus-read-active-file)))
   ;; Find all groups and sort them.
   (let ((groups
@@ -3057,7 +3070,12 @@ If N is negative, this group and the N-1 previous groups will be checked."
         (ret (if (numberp n) (- n (length groups)) 0))
         (beg (unless n
                (point)))
-        group method)
+        group method
+        (gnus-inhibit-demon t)
+        ;; Binding this variable will inhibit multiple fetchings
+        ;; of the same mail source.
+        (nnmail-fetched-sources (list t)))
+    (gnus-run-hooks 'gnus-get-new-news-hook)
     (while (setq group (pop groups))
       (gnus-group-remove-mark group)
       ;; Bypass any previous denials from the server.
@@ -3464,19 +3482,19 @@ and the second element is the address."
     (or (not info)
        (and (not (setq marked (nthcdr 3 info)))
             (or (null articles)
-                (setcdr (nthcdr 2 info)
-                        (list (list (cons type (gnus-compress-sequence
-                                                articles t)))))))
+                (setcdr (nthcdr 2 info)
+                        (list (list (cons type (gnus-compress-sequence
+                                                articles t)))))))
        (and (not (setq m (assq type (car marked))))
             (or (null articles)
-                (setcar marked
-                        (cons (cons type (gnus-compress-sequence articles t) )
-                              (car marked)))))
+                (setcar marked
+                        (cons (cons type (gnus-compress-sequence articles t) )
+                              (car marked)))))
        (if force
            (if (null articles)
-               (setcar (nthcdr 3 info)
-                       (gnus-delete-alist type (car marked)))
-             (setcdr m (gnus-compress-sequence articles t)))
+               (setcar (nthcdr 3 info)
+                       (gnus-delete-alist type (car marked)))
+             (setcdr m (gnus-compress-sequence articles t)))
          (setcdr m (gnus-compress-sequence
                     (sort (nconc (gnus-uncompress-range (cdr m))
                                  (copy-sequence articles)) '<) t))))))
@@ -3501,7 +3519,7 @@ or `gnus-group-catchup-group-hook'."
 (defun gnus-group-timestamp-delta (group)
   "Return the offset in seconds from the timestamp for GROUP to the current time, as a floating point number."
   (let* ((time (or (gnus-group-timestamp group)
-                 (list 0 0)))
+                  (list 0 0)))
          (delta (subtract-time (current-time) time)))
     (+ (* (nth 0 delta) 65536.0)
        (nth 1 delta))))
index 1d04718..c5dbd2f 100644 (file)
@@ -27,6 +27,7 @@
 ;;; Code:
 
 (eval-when-compile (require 'cl))
+
 (require 'gnus)
 (require 'gnus-art)
 (require 'gnus-range)
@@ -48,7 +49,8 @@
   :type 'boolean)
 
 (defcustom gnus-winconf-kill-file nil
-  "What does this do, Lars?"
+  "What does this do, Lars?
+I don't know, Per."
   :group 'gnus-score-kill
   :type 'sexp)
 
index f89f95e..53784fb 100644 (file)
@@ -37,7 +37,7 @@
 (put 'gnus-cite 'custom-loads '("gnus-cite"))
 (put 'gnus-demon 'custom-loads '("gnus-demon"))
 (put 'gnus-message 'custom-loads '("message"))
-(put 'gnus-score-default 'custom-loads '("gnus-sum" "gnus-score"))
+(put 'gnus-score-delta-default 'custom-loads '("gnus-sum" "gnus-score"))
 (put 'nnmail-duplicate 'custom-loads '("nnmail"))
 (put 'message-interface 'custom-loads '("message"))
 (put 'nnmail-files 'custom-loads '("nnmail"))
index c40f49e..0b14ce0 100644 (file)
@@ -26,6 +26,7 @@
 ;;; Code:
 
 (eval-when-compile (require 'cl))
+
 (require 'gnus)
 (require 'gnus-score)
 (require 'gnus-util)
index dd2b499..932fcb6 100644 (file)
@@ -28,6 +28,7 @@
 
 (eval-when-compile (require 'cl))
 (require 'mail-parse)
+(require 'mm-util)
 
 (defvar mailcap-parse-args-syntax-table
   (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table)))
       (viewer . "maplay %s")
       (type   . "audio/x-mpeg"))
      (".*"
-      (viewer . mailcap-save-binary-file)
-      (non-viewer . t)
-      (test   . (or (featurep 'nas-sound)
-                     (featurep 'native-sound)))
-      (type   . "audio/*"))
-     (".*"
       (viewer . "showaudio")
       (type   . "audio/*")))
     ("message"
       (viewer . tar-mode)
       (type . "archive/tar")
       (test . (fboundp 'tar-mode)))))
-     "The mailcap structure is an assoc list of assoc lists.
+  "The mailcap structure is an assoc list of assoc lists.
 1st assoc list is keyed on the major content-type
 2nd assoc list is keyed on the minor content-type (which can be a regexp)
 
@@ -260,7 +255,7 @@ not.")
 ;;;
 
 (defun mailcap-generate-unique-filename (&optional fmt)
-  "Generate a unique filename in mailcap-temporary-directory"
+  "Generate a unique filename in mailcap-temporary-directory."
   (if (not fmt)
       (let ((base (format "mailcap-tmp.%d" (user-real-uid)))
            (fname "")
@@ -292,7 +287,7 @@ not.")
     (kill-buffer (current-buffer))))
 
 (defun mailcap-maybe-eval ()
-  "Maybe evaluate a buffer of emacs lisp code"
+  "Maybe evaluate a buffer of emacs lisp code."
   (if (yes-or-no-p "This is emacs-lisp code, evaluate it? ")
       (eval-buffer (current-buffer))
     (emacs-lisp-mode)))
@@ -335,8 +330,8 @@ If FORCE, re-parse even if already parsed."
          fname)
       (while fnames
        (setq fname (car fnames))
-       (if (and (file-exists-p fname) (file-readable-p fname)
-                (file-regular-p fname))
+       (if (and (file-exists-p fname) (file-readable-p fname)
+                (file-regular-p fname))
            (mailcap-parse-mailcap (car fnames)))
        (setq fnames (cdr fnames))))
     (setq mailcap-parsed-p t)))
@@ -600,7 +595,7 @@ If FORCE, re-parse even if already parsed."
         ((or (null cur-minor)          ; New minor area, or
              (assq 'test info))        ; Has a test, insert at beginning
          (setcdr old-major (cons (cons minor info) (cdr old-major))))
-        ((and (not (assq 'test info)) ; No test info, replace completely
+        ((and (not (assq 'test info))  ; No test info, replace completely
               (not (assq 'test cur-minor)))
          (setcdr cur-minor info))
         (t
@@ -693,7 +688,7 @@ this type is returned."
        passed)
        (t
        ;; MUST make a copy *sigh*, else we modify mailcap-mime-data
-       (setq viewer (copy-tree viewer))
+       (setq viewer (copy-sequence viewer))
        (let ((view (assq 'viewer viewer))
              (test (assq 'test viewer)))
          (if view (setcdr view (mailcap-unescape-mime-test (cdr view) info)))
@@ -887,7 +882,7 @@ The path of COMMAND will be returned iff COMMAND is a command."
 
 (defun mailcap-mime-types ()
   "Return a list of MIME media types."
-  (delete-duplicates (mapcar 'cdr mailcap-mime-extensions)))
+  (mm-delete-duplicates (mapcar 'cdr mailcap-mime-extensions)))
 
 (provide 'gnus-mailcap)
 
index 6fabb5c..665e361 100644 (file)
@@ -67,7 +67,7 @@ Optional argument FOLDER specifies folder name."
        (errbuf (gnus-get-buffer-create " *Gnus rcvstore*"))
        ;; Find the rcvstore program.
        (exec-path (if mh-lib (cons mh-lib exec-path) exec-path)))
-    (gnus-eval-in-buffer-window gnus-original-article-buffer
+    (with-current-buffer gnus-original-article-buffer
       (save-restriction
        (widen)
        (unwind-protect
index e305b88..6c3ed8f 100644 (file)
 ;; Boston, MA 02111-1307, USA.
 
 (eval-when-compile (require 'cl))
+
 (require 'gnus)
 (require 'gnus-sum)
 (require 'gnus-group)
 (require 'nnmail)
 
 (defvar gnus-group-split-updated-hook nil
-  "Hook called just after nnmail-split-fancy is updated by
-gnus-group-split-update")
+  "Hook called just after nnmail-split-fancy is updated by gnus-group-split-update.")
 
 (defvar gnus-group-split-default-catch-all-group "mail.misc"
-  "Group used by gnus-group-split and gnus-group-split-update as
-default catch-all group")
+  "Group used by gnus-group-split and gnus-group-split-update as default catch-all group.")
 
 ;;;###autoload
 (defun gnus-group-split-setup (&optional auto-update catch-all)
-  "Sets things up so that nnmail-split-fancy is used for mail
+  "Set up the split for nnmail-split-fancy.
+Sets things up so that nnmail-split-fancy is used for mail
 splitting, and defines the variable nnmail-split-fancy according with
 group parameters.
 
@@ -53,19 +53,18 @@ nnmail-pre-get-new-mail-hook."
 
 ;;;###autoload
 (defun gnus-group-split-update (&optional catch-all)
-  "Computes nnmail-split-fancy from group params, by calling
-\(gnus-group-split-fancy nil nil DEFAULTGROUP)"
+  "Computes nnmail-split-fancy from group params.
+It does this by calling \(gnus-group-split-fancy nil nil DEFAULTGROUP)."
   (interactive)
   (setq nnmail-split-fancy
        (gnus-group-split-fancy
         nil nil (or catch-all gnus-group-split-default-catch-all-group)))
-  (run-hooks 'gnus-group-split-updated-hook)
-  )
+  (run-hooks 'gnus-group-split-updated-hook))
 
 ;;;###autoload
 (defun gnus-group-split ()
-  "Uses information from group parameters in order to split mail.  See
-gnus-group-split-fancy for more information.
+  "Uses information from group parameters in order to split mail.
+See gnus-group-split-fancy for more information.
 
 If no group is defined as catch-all, the value of
 gnus-group-split-default-catch-all-group is used.
index b16b12d..956f7c2 100644 (file)
@@ -49,8 +49,8 @@ This method will not be used in mail groups and the like, only in
 \"real\" newsgroups.
 
 If not nil nor `native', the value must be a valid method as discussed
-in the documentation of `gnus-select-method'. It can also be a list of
-methods. If that is the case, the user will be queried for what select
+in the documentation of `gnus-select-method'.  It can also be a list of
+methods.  If that is the case, the user will be queried for what select
 method to use when posting."
   :group 'gnus-group-foreign
   :type `(choice (const nil)
@@ -106,14 +106,34 @@ the second with the current group name.")
   "*Alist of styles to use when posting.")
 
 (defcustom gnus-group-posting-charset-alist
-  '(("^no\\." iso-8859-1)
-    (message-this-is-mail nil)
-    ("^de\\." nil)
-    (".*" iso-8859-1)
-    (message-this-is-news iso-8859-1))
-  "Alist of regexps (to match group names) and default charsets to be unencoded when posting."
-  :type '(repeat (list (regexp :tag "Group")
-                      (symbol :tag "Charset")))
+  '(("^\\(no\\|fr\\|dk\\)\\.[^,]*\\(,[ \t\n]*\\(no\\|fr\\|dk\\)\\.[^,]*\\)*$" iso-8859-1 (iso-8859-1))
+    (message-this-is-mail nil nil)
+    (message-this-is-news nil t))
+  "Alist of regexps and permitted unencoded charsets for posting.
+Each element of the alist has the form (TEST HEADER BODY-LIST), where
+TEST is either a regular expression matching the newsgroup header or a
+variable to query,
+HEADER is the charset which may be left unencoded in the header (nil
+means encode all charsets),
+BODY-LIST is a list of charsets which may be encoded using 8bit
+content-transfer encoding in the body, or one of the special values
+nil (always encode using quoted-printable) or t (always use 8bit).
+
+Note that any value other tha nil for HEADER infringes some RFCs, so
+use this option with care."
+  :type '(repeat (list :tag "Permitted unencoded charsets"
+                 (choice :tag "Where"
+                  (regexp :tag "Group")
+                  (const :tag "Mail message" :value message-this-is-mail)
+                  (const :tag "News article" :value message-this-is-news))
+                 (choice :tag "Header"
+                  (const :tag "None" nil)
+                  (symbol :tag "Charset"))
+                 (choice :tag "Body"
+                         (const :tag "Any" :value t)
+                         (const :tag "None" :value nil)
+                         (repeat :tag "Charsets"
+                                 (symbol :tag "Charset")))))
   :group 'gnus-charset)
 
 ;;; Internal variables.
@@ -225,8 +245,6 @@ Thank you for your help in stamping out bugs.
         (set (make-local-variable 'gnus-message-group-art)
              (cons ,group ,article))
         (set (make-local-variable 'gnus-newsgroup-name) ,group)
-        (set (make-local-variable 'message-posting-charset)
-             (gnus-setup-posting-charset ,group))
         (gnus-run-hooks 'gnus-message-setup-hook))
        (gnus-add-buffer)
        (gnus-configure-windows ,config t)
@@ -245,7 +263,7 @@ Thank you for your help in stamping out bugs.
                         (funcall (car elem) group))
                    (and (symbolp (car elem))
                         (symbol-value (car elem))))
-           (throw 'found (cadr elem))))))))
+           (throw 'found (cons (cadr elem) (caddr elem)))))))))
 
 (defun gnus-inews-add-send-actions (winconf buffer article)
   (make-local-hook 'message-sent-hook)
@@ -563,7 +581,7 @@ If SILENT, don't prompt the user."
      ;; the default method.
      ((null group-method)
       (or (and (null (eq gnus-post-method 'active)) gnus-post-method)
-              gnus-select-method message-post-method))
+         gnus-select-method message-post-method))
      ;; We want the inverse of the default
      ((and arg (not (eq arg 0)))
       (if (eq gnus-post-method 'active)
index 7e8a862..8efd1fe 100644 (file)
@@ -50,8 +50,7 @@
     "clewis@ferret.ocunix.on.ca"       ; Chris Lewis
     "jem@xpat.com"                     ; Despammer from Korea
     "snowhare@xmission.com"            ; Benjamin "Snowhare" Franz
-    "red@redpoll.mrfs.oh.us (Richard E. Depew)" ; ARMM! ARMM!
-    )
+    "red@redpoll.mrfs.oh.us (Richard E. Depew)") ; ARMM! ARMM!
   "*List of NoCeM issuers to pay attention to.
 
 This can also be a list of `(ISSUER CONDITIONS)' elements."
index 867d004..e527523 100644 (file)
@@ -26,6 +26,7 @@
 ;;; Code:
 
 (eval-when-compile (require 'cl))
+
 (require 'gnus)
 ;; (require 'xpm)
 (require 'annotations)
@@ -524,8 +525,8 @@ none, and whose CDR is the corresponding element of DOMAINS."
 (defun gnus-picons-parse-value (name)
   (goto-char (point-min))
   (if (re-search-forward (concat "<strong>"
-                            (regexp-quote name)
-                            "</strong> *= *<kbd> *\\([^ <][^<]*\\) *</kbd>")
+                                (regexp-quote name)
+                                "</strong> *= *<kbd> *\\([^ <][^<]*\\) *</kbd>")
                         nil t)
       (buffer-substring (match-beginning 1) (match-end 1))))
 
@@ -696,8 +697,8 @@ none, and whose CDR is the corresponding element of DOMAINS."
 (defun gnus-picons-network-search (user addrs dbs sym-ann right-p marker)
   (let* ((host (mapconcat 'identity addrs "."))
         (key (list (or user "unknown") host (if user
-                                                 gnus-picons-user-directories
-                                               dbs)))
+                                                gnus-picons-user-directories
+                                              dbs)))
         (cache (assoc key gnus-picons-url-alist)))
     (if (null cache)
        (gnus-picons-url-retrieve
index 1964880..5e0dc13 100644 (file)
@@ -225,19 +225,19 @@ Note: LIST has to be sorted over `<'."
       out)))
 
 (defun gnus-remove-from-range (range1 range2)
-  "Return a range that has all articles from RANGE2 removed from
-RANGE1. The returned range is always a list. RANGE2 can also be a
-unsorted list of articles. RANGE1 is modified by side effects, RANGE2
-is not modified."
+  "Return a range that has all articles from RANGE2 removed from RANGE1.
+The returned range is always a list.  RANGE2 can also be a unsorted
+list of articles.  RANGE1 is modified by side effects, RANGE2 is not
+modified."
   (if (or (null range1) (null range2))
       range1
     (let (out r1 r2 r1_min r1_max r2_min r2_max
-             (range2 (gnus-copy-sequence range2)))
+             (range2 (gnus-copy-sequence range2)))
       (setq range1 (if (listp (cdr range1)) range1 (list range1))
-           range2 (sort (if (listp (cdr range2)) range2 (list range2))
-                        (lambda (e1 e2)
-                          (< (if (consp e1) (car e1) e1)
-                             (if (consp e2) (car e2) e2))))
+           range2 (sort (if (listp (cdr range2)) range2 (list range2))
+                        (lambda (e1 e2)
+                          (< (if (consp e1) (car e1) e1)
+                             (if (consp e2) (car e2) e2))))
            r1 (car range1)
            r2 (car range2)
            r1_min (if (consp r1) (car r1) r1)
@@ -245,7 +245,7 @@ is not modified."
            r2_min (if (consp r2) (car r2) r2)
            r2_max (if (consp r2) (cdr r2) r2))
       (while (and range1 range2)
-       (cond ((< r2_max r1_min)                           ; r2 < r1
+       (cond ((< r2_max r1_min)        ; r2 < r1
               (pop range2)
               (setq r2 (car range2)
                     r2_min (if (consp r2) (car r2) r2)
@@ -266,7 +266,7 @@ is not modified."
                   (push r1_min out)
                 (push (cons r1_min (1- r2_min)) out))
               (pop range2)
-              (if (< r2_max r1_max) ; finished with r1?
+              (if (< r2_max r1_max)    ; finished with r1?
                   (setq r1_min (1+ r2_max))
                 (pop range1)
                 (setq r1 (car range1)
@@ -283,7 +283,7 @@ is not modified."
               (setq r1 (car range1)
                     r1_min (if (consp r1) (car r1) r1)
                     r1_max (if (consp r1) (cdr r1) r1)))
-             ((< r1_max r2_min)                           ; r2 > r1
+             ((< r1_max r2_min)        ; r2 > r1
               (pop range1)
               (if (eq r1_min r1_max)
                   (push r1_min out)
index 3d5e80f..181f9cf 100644 (file)
@@ -26,6 +26,7 @@
 ;;; Code:
 
 (eval-when-compile (require 'cl))
+
 (require 'gnus)
 (require 'gnus-sum)
 
@@ -161,8 +162,8 @@ If given a prefix, mark all unpicked articles as read."
       (error "No articles have been picked"))))
 
 (defun gnus-pick-goto-article (arg)
-  "Go to the article number indicated by ARG.  If ARG is an invalid
-article number, then stay on current line."
+  "Go to the article number indicated by ARG.
+If ARG is an invalid article number, then stay on current line."
   (let (pos)
     (save-excursion
       (goto-char (point-min))
@@ -173,7 +174,7 @@ article number, then stay on current line."
       (goto-char pos))))
 
 (defun gnus-pick-article (&optional arg)
-    "Pick the article on the current line.
+  "Pick the article on the current line.
 If ARG, pick the article on that line instead."
   (interactive "P")
   (when arg
@@ -243,46 +244,46 @@ This must be bound to a button-down mouse event."
     ;; (but not outside the window where the drag started).
     (let (event end end-point (end-of-range (point)))
       (track-mouse
-       (while (progn
-                (setq event (cdr (gnus-read-event-char)))
-                (or (mouse-movement-p event)
-                    (eq (car-safe event) 'switch-frame)))
-         (if (eq (car-safe event) 'switch-frame)
-             nil
-           (setq end (event-end event)
-                 end-point (posn-point end))
-
-           (cond
-            ;; Are we moving within the original window?
-            ((and (eq (posn-window end) start-window)
-                  (integer-or-marker-p end-point))
-             ;; Go to START-POINT first, so that when we move to END-POINT,
-             ;; if it's in the middle of intangible text,
-             ;; point jumps in the direction away from START-POINT.
-             (goto-char start-point)
-             (goto-char end-point)
-             (gnus-pick-article)
-             ;; In case the user moved his mouse really fast, pick
-             ;; articles on the line between this one and the last one.
-             (let* ((this-line (1+ (count-lines 1 end-point)))
-                    (min-line (min this-line start-line))
-                    (max-line (max this-line start-line)))
-               (while (< min-line max-line)
-                 (goto-line min-line)
-                 (gnus-pick-article)
-                 (setq min-line (1+ min-line)))
-               (setq start-line this-line))
-             (when (zerop (% click-count 3))
-               (setq end-of-range (point))))
-            (t
-             (let ((mouse-row (cdr (cdr (mouse-position)))))
-               (cond
-                ((null mouse-row))
-                ((< mouse-row top)
-                 (mouse-scroll-subr start-window (- mouse-row top)))
-                ((>= mouse-row bottom)
-                 (mouse-scroll-subr start-window
-                                    (1+ (- mouse-row bottom)))))))))))
+       (while (progn
+               (setq event (cdr (gnus-read-event-char)))
+               (or (mouse-movement-p event)
+                   (eq (car-safe event) 'switch-frame)))
+        (if (eq (car-safe event) 'switch-frame)
+            nil
+          (setq end (event-end event)
+                end-point (posn-point end))
+
+          (cond
+           ;; Are we moving within the original window?
+           ((and (eq (posn-window end) start-window)
+                 (integer-or-marker-p end-point))
+            ;; Go to START-POINT first, so that when we move to END-POINT,
+            ;; if it's in the middle of intangible text,
+            ;; point jumps in the direction away from START-POINT.
+            (goto-char start-point)
+            (goto-char end-point)
+            (gnus-pick-article)
+            ;; In case the user moved his mouse really fast, pick
+            ;; articles on the line between this one and the last one.
+            (let* ((this-line (1+ (count-lines 1 end-point)))
+                   (min-line (min this-line start-line))
+                   (max-line (max this-line start-line)))
+              (while (< min-line max-line)
+                (goto-line min-line)
+                (gnus-pick-article)
+                (setq min-line (1+ min-line)))
+              (setq start-line this-line))
+            (when (zerop (% click-count 3))
+              (setq end-of-range (point))))
+           (t
+            (let ((mouse-row (cdr (cdr (mouse-position)))))
+              (cond
+               ((null mouse-row))
+               ((< mouse-row top)
+                (mouse-scroll-subr start-window (- mouse-row top)))
+               ((>= mouse-row bottom)
+                (mouse-scroll-subr start-window
+                                   (1+ (- mouse-row bottom)))))))))))
       (when (consp event)
        (let ((fun (key-binding (vector (car event)))))
          ;; Run the binding of the terminating up-event, if possible.
@@ -324,8 +325,8 @@ This must be bound to a button-down mouse event."
   (setq gnus-binary-mode-map (make-sparse-keymap))
 
   (gnus-define-keys
-   gnus-binary-mode-map
-   "g" gnus-binary-show-article))
+      gnus-binary-mode-map
+    "g" gnus-binary-show-article))
 
 (defun gnus-binary-make-menu-bar ()
   (unless (boundp 'gnus-binary-menu)
@@ -442,13 +443,13 @@ Two predefined functions are available:
   (setq gnus-tree-mode-map (make-keymap))
   (suppress-keymap gnus-tree-mode-map)
   (gnus-define-keys
-   gnus-tree-mode-map
-   "\r" gnus-tree-select-article
-   gnus-mouse-2 gnus-tree-pick-article
-   "\C-?" gnus-tree-read-summary-keys
-   "h" gnus-tree-show-summary
+      gnus-tree-mode-map
+    "\r" gnus-tree-select-article
+    gnus-mouse-2 gnus-tree-pick-article
+    "\C-?" gnus-tree-read-summary-keys
+    "h" gnus-tree-show-summary
 
-   "\C-c\C-i" gnus-info-find-node)
+    "\C-c\C-i" gnus-info-find-node)
 
   (substitute-key-definition
    'undefined 'gnus-tree-read-summary-keys gnus-tree-mode-map))
index 50583bf..3fc01fb 100644 (file)
@@ -27,6 +27,7 @@
 ;;; Code:
 
 (eval-when-compile (require 'cl))
+
 (require 'gnus)
 (require 'gnus-sum)
 (require 'gnus-range)
@@ -220,14 +221,14 @@ This variable allows the same syntax as `gnus-home-score-file'."
     (gnus-catchup-mark (subject -10))
     (gnus-killed-mark (from -1) (subject -20))
     (gnus-del-mark (from -2) (subject -15)))
-"*Alist of marks and scores."
-:group 'gnus-score-adapt
-:type '(repeat (cons (symbol :tag "Mark")
-                    (repeat (list (choice :tag "Header"
-                                          (const from)
-                                          (const subject)
-                                          (symbol :tag "other"))
-                                  (integer :tag "Score"))))))
+  "*Alist of marks and scores."
+  :group 'gnus-score-adapt
+  :type '(repeat (cons (symbol :tag "Mark")
+                      (repeat (list (choice :tag "Header"
+                                            (const from)
+                                            (const subject)
+                                            (symbol :tag "other"))
+                                    (integer :tag "Score"))))))
 
 (defcustom gnus-ignored-adaptive-words nil
   "List of words to be ignored when doing adaptive word scoring."
@@ -258,10 +259,10 @@ This variable allows the same syntax as `gnus-home-score-file'."
     (,gnus-catchup-mark . -10)
     (,gnus-killed-mark . -20)
     (,gnus-del-mark . -15))
-"*Alist of marks and scores."
-:group 'gnus-score-adapt
-:type '(repeat (cons (character :tag "Mark")
-                    (integer :tag "Score"))))
+  "*Alist of marks and scores."
+  :group 'gnus-score-adapt
+  :type '(repeat (cons (character :tag "Mark")
+                      (integer :tag "Score"))))
 
 (defcustom gnus-adaptive-word-minimum nil
   "If a number, this is the minimum score value that can be assigned to a word."
@@ -513,7 +514,7 @@ The user will be prompted for header to score on, match type,
 permanence, and the string to be used.  The numerical prefix will be
 used as score."
   (interactive (gnus-interactive "P\ny"))
-  (gnus-summary-increase-score (- (gnus-score-default score)) symp))
+  (gnus-summary-increase-score (- (gnus-score-delta-default score)) symp))
 
 (defun gnus-score-kill-help-buffer ()
   (when (get-buffer "*Score Help*")
@@ -527,7 +528,7 @@ The user will be prompted for header to score on, match type,
 permanence, and the string to be used.  The numerical prefix will be
 used as score."
   (interactive (gnus-interactive "P\ny"))
-  (let* ((nscore (gnus-score-default score))
+  (let* ((nscore (gnus-score-delta-default score))
         (prefix (if (< nscore 0) ?L ?I))
         (increase (> nscore 0))
         (char-to-header
@@ -650,7 +651,7 @@ used as score."
            ;; Deal with der(r)ided superannuated paradigms.
            (when (and (eq (1+ prefix) 77)
                       (eq (+ hchar 12) 109)
-                      (eq tchar 114)
+                      (eq (1- tchar) 113)
                       (eq (- pchar 4) 111))
              (error "You rang?"))
            (if mimic
@@ -763,7 +764,7 @@ used as score."
     (pop-to-buffer "*Score Help*")
     (let ((window-min-height 1))
       (shrink-window-if-larger-than-buffer))
-    (select-window (get-buffer-window gnus-summary-buffer))))
+    (select-window (get-buffer-window gnus-summary-buffer t))))
 
 (defun gnus-summary-header (header &optional no-err extra)
   ;; Return HEADER for current articles, or error.
@@ -818,7 +819,7 @@ If optional argument `EXTRA' is non-nil, it's a non-standard overview header."
         (setq match (if match (gnus-simplify-subject-re match) "")))
        ((eq type 'f)
         (setq match (gnus-simplify-subject-fuzzy match))))
-  (let ((score (gnus-score-default score))
+  (let ((score (gnus-score-delta-default score))
        (header (format "%s" (downcase header)))
        new)
     (when prompt
@@ -1001,7 +1002,7 @@ EXTRA is the possible non-standard header."
 (defun gnus-score-followup-article (&optional score)
   "Add SCORE to all followups to the article in the current buffer."
   (interactive "P")
-  (setq score (gnus-score-default score))
+  (setq score (gnus-score-delta-default score))
   (when (gnus-buffer-live-p gnus-summary-buffer)
     (save-excursion
       (save-restriction
@@ -1016,7 +1017,7 @@ EXTRA is the possible non-standard header."
 (defun gnus-score-followup-thread (&optional score)
   "Add SCORE to all later articles in the thread the current buffer is part of."
   (interactive "P")
-  (setq score (gnus-score-default score))
+  (setq score (gnus-score-delta-default score))
   (when (gnus-buffer-live-p gnus-summary-buffer)
     (save-excursion
       (save-restriction
@@ -1061,7 +1062,7 @@ EXTRA is the possible non-standard header."
     (let ((buffer-read-only nil))
       ;; Set score.
       (gnus-summary-update-mark
-       (if (= n (or gnus-summary-default-score 0)) ? ;Whitespace
+       (if (= n (or gnus-summary-default-score 0)) ?  ;Whitespace
         (if (< n (or gnus-summary-default-score 0))
             gnus-score-below-mark gnus-score-over-mark))
        'score))
@@ -1516,79 +1517,50 @@ EXTRA is the possible non-standard header."
 
          (gnus-message 5 "Scoring...done"))))))
 
+(defun gnus-score-lower-thread (thread score-adjust)
+  "Lower the socre on THREAD with SCORE-ADJUST.
+THREAD is expected to contain a list of the form `(PARENT [CHILD1
+CHILD2 ...])' where PARENT is a header array and each CHILD is a list
+of the same form as THREAD.  The empty list `nil' is valid.  For each
+article in the tree, the score of the corresponding entry in
+GNUS-NEWSGROUP-SCORED is adjusted by SCORE-ADJUST."
+  (while thread
+    (let ((head (car thread)))
+      (if (listp head)
+         ;; handle a child and its descendants
+         (gnus-score-lower-thread head score-adjust)
+       ;; handle the parent
+       (let* ((article (mail-header-number head))
+              (score (assq article gnus-newsgroup-scored)))
+         (if score (setcdr score (+ (cdr score) score-adjust))
+           (push (cons article score-adjust) gnus-newsgroup-scored)))))
+    (setq thread (cdr thread))))
 
-(defun gnus-get-new-thread-ids (articles)
-  (let ((index (nth 1 (assoc "message-id" gnus-header-index)))
-        (refind gnus-score-index)
-        id-list art this tref)
-    (while articles
-      (setq art (car articles)
-            this (aref (car art) index)
-            tref (aref (car art) refind)
-            articles (cdr articles))
-      (when (string-equal tref "")     ;no references line
-       (push this id-list)))
-    id-list))
-
-;; Orphan functions written by plm@atcmp.nl (Peter Mutsaers).
 (defun gnus-score-orphans (score)
-  (let ((new-thread-ids (gnus-get-new-thread-ids gnus-scores-articles))
-        alike articles art arts this last this-id)
-
-    (setq gnus-scores-articles (sort gnus-scores-articles 'gnus-score-string<)
-         articles gnus-scores-articles)
-
-    ;;more or less the same as in gnus-score-string
-    (erase-buffer)
-    (while articles
-      (setq art (car articles)
-            this (aref (car art) gnus-score-index)
-            articles (cdr articles))
-      ;;completely skip if this is empty (not a child, so not an orphan)
-      (when (not (string= this ""))
-       (if (equal last this)
-           ;; O(N*H) cons-cells used here, where H is the number of
-           ;; headers.
-           (push art alike)
-         (when last
-           ;; Insert the line, with a text property on the
-           ;; terminating newline referring to the articles with
-           ;; this line.
-           (insert last ?\n)
-           (put-text-property (1- (point)) (point) 'articles alike))
-         (setq alike (list art)
-               last this))))
-    (when last                         ; Bwadr, duplicate code.
-      (insert last ?\n)
-      (put-text-property (1- (point)) (point) 'articles alike))
-
-    ;; PLM: now delete those lines that contain an entry from new-thread-ids
-    (while new-thread-ids
-      (setq this-id (car new-thread-ids)
-            new-thread-ids (cdr new-thread-ids))
-      (goto-char (point-min))
-      (while (search-forward this-id nil t)
-        ;; found a match.  remove this line
-       (beginning-of-line)
-       (kill-line 1)))
-
-    ;; now for each line: update its articles with score by moving to
-    ;; every end-of-line in the buffer and read the articles property
-    (goto-char (point-min))
-    (while (eq 0 (progn
-                   (end-of-line)
-                   (setq arts (get-text-property (point) 'articles))
-                   (while arts
-                     (setq art (car arts)
-                           arts (cdr arts))
-                     (setcdr art (+ score (cdr art))))
-                   (forward-line))))))
-
+  "Score orphans.
+A root is an article with no references.  An orphan is an article
+which has references, but is not connected via its references to a
+root article.  This function finds all the orphans, and adjusts their
+score in GNUS-NEWSGROUP-SCORED by SCORE."
+  (let ((threads (gnus-make-threads)))
+    ;; gnus-make-threads produces a list, where each entry is a "thread"
+    ;; as described in the gnus-score-lower-thread docs.  This function
+    ;; will be called again (after limiting has been done) if the display
+    ;; is threaded.  It would be nice to somehow save this info and use
+    ;; it later.
+    (while threads
+      (let* ((thread (car threads))
+            (id (aref (car thread) gnus-score-index)))
+       ;; If the parent of the thread is not a root, lower the score of
+       ;; it and its descendants.  Note that some roots seem to satisfy
+       ;; (eq id nil) and some (eq id "");  not sure why.
+       (if (and id (not (string= id "")))
+           (gnus-score-lower-thread thread score)))
+      (setq threads (cdr threads)))))
 
 (defun gnus-score-integer (scores header now expire &optional trace)
   (let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
        entries alist)
-
     ;; Find matches.
     (while scores
       (setq alist (car scores)
@@ -1637,7 +1609,6 @@ EXTRA is the possible non-standard header."
 (defun gnus-score-date (scores header now expire &optional trace)
   (let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
        entries alist match match-func article)
-
     ;; Find matches.
     (while scores
       (setq alist (car scores)
@@ -1724,8 +1695,8 @@ EXTRA is the possible non-standard header."
          (while articles
            (setq article (mail-header-number (caar articles)))
            (gnus-message 7 "Scoring article %s of %s..." article last)
+           (widen)
            (when (funcall request-func article gnus-newsgroup-name)
-             (widen)
              (goto-char (point-min))
              ;; If just parts of the article is to be searched, but the
              ;; backend didn't support partial fetching, we just narrow
@@ -1945,7 +1916,7 @@ EXTRA is the possible non-standard header."
       ;; with working on them as a group.  What a hassle.
       ;; Just wait 'til you see what horrors we commit against `match'...
       (if (= gnus-score-index 9)
-         (setq this (prin1-to-string this)))   ; ick.
+         (setq this (prin1-to-string this))) ; ick.
 
       (if simplify
          (setq this (gnus-map-function gnus-simplify-subject-functions this)))
@@ -1998,7 +1969,7 @@ EXTRA is the possible non-standard header."
          (when extra
            (setq match (concat "[ (](" extra " \\. \"[^)]*"
                                match "[^(]*\")[ )]")
-                 search-func 're-search-forward))      ; XXX danger?!?
+                 search-func 're-search-forward)) ; XXX danger?!?
 
          (cond
           ;; Fuzzy matches.  We save these for later.
@@ -2126,6 +2097,7 @@ EXTRA is the possible non-standard header."
              (cond
               ;; Permanent.
               ((null date)
+               ;; Do nothing.
                )
               ;; Match, update date.
               ((and found gnus-update-score-entry-dates)
@@ -2164,6 +2136,7 @@ EXTRA is the possible non-standard header."
                (cond
                 ;; Permanent.
                 ((null date)
+                 ;; Do nothing.
                  )
                 ;; Match, update date.
                 ((and found gnus-update-score-entry-dates)
@@ -2470,14 +2443,14 @@ EXTRA is the possible non-standard header."
       (gnus-summary-raise-score score))
     (gnus-summary-next-subject 1 t)))
 
-(defun gnus-score-default (level)
+(defun gnus-score-delta-default (level)
   (if level (prefix-numeric-value level)
     gnus-score-interactive-default-score))
 
 (defun gnus-summary-raise-thread (&optional score)
   "Raise the score of the articles in the current thread with SCORE."
   (interactive "P")
-  (setq score (gnus-score-default score))
+  (setq score (gnus-score-delta-default score))
   (let (e)
     (save-excursion
       (let ((articles (gnus-summary-articles-in-thread)))
@@ -2506,7 +2479,7 @@ EXTRA is the possible non-standard header."
 (defun gnus-summary-lower-thread (&optional score)
   "Lower score of articles in the current thread with SCORE."
   (interactive "P")
-  (gnus-summary-raise-thread (- (1- (gnus-score-default score)))))
+  (gnus-summary-raise-thread (- (1- (gnus-score-delta-default score)))))
 
 ;;; Finding score files.
 
@@ -2999,8 +2972,7 @@ See `(Gnus)Scoring Tips' for examples of good regular expressions."
        (cond
        (bad (cons 'bad bad))
        (new (cons 'new new))
-       ;; or nil
-       )))))
+       (t nil))))))
 
 (provide 'gnus-score)
 
index 29c2a31..c98ef72 100644 (file)
   "Directory where Big Brother Database is found.")
 
 (defvar gnus-use-mhe nil
-  "Set this if you want to use MH-E for mail reading")
+  "Set this if you want to use MH-E for mail reading.")
 (defvar gnus-use-rmail nil
-  "Set this if you want to use RMAIL for mail reading")
+  "Set this if you want to use RMAIL for mail reading.")
 (defvar gnus-use-sendmail t
-  "Set this if you want to use SENDMAIL for mail reading")
+  "Set this if you want to use SENDMAIL for mail reading.")
 (defvar gnus-use-vm nil
-  "Set this if you want to use the VM package for mail reading")
+  "Set this if you want to use the VM package for mail reading.")
 (defvar gnus-use-sc nil
-  "Set this if you want to use Supercite")
+  "Set this if you want to use Supercite.")
 (defvar gnus-use-mailcrypt t
-  "Set this if you want to use Mailcrypt for dealing with PGP messages")
+  "Set this if you want to use Mailcrypt for dealing with PGP messages.")
 (defvar gnus-use-bbdb nil
-  "Set this if you want to use the Big Brother DataBase")
+  "Set this if you want to use the Big Brother DataBase.")
 
 (when (and (not gnus-use-installed-gnus)
           (null (member gnus-gnus-lisp-directory load-path)))
index 8a9a206..08c96c5 100644 (file)
@@ -140,7 +140,7 @@ move those articles instead."
     (buffer-disable-undo tmp-buf)
     (save-excursion
       (while articles
-         ;; Put the article in a buffer.
+       ;; Put the article in a buffer.
        (set-buffer tmp-buf)
        (when (gnus-request-article-this-buffer
               (car articles) gnus-newsgroup-name)
index 23781b6..7f35c76 100644 (file)
@@ -27,6 +27,7 @@
 ;;; Code:
 
 (eval-when-compile (require 'cl))
+
 (require 'gnus)
 
 ;;; Internal variables.
@@ -562,7 +563,10 @@ If PROPS, insert the result."
        (symbol-value (intern (format "gnus-%s-line-format-alist" type)))
        insertable)))
 
-
 (provide 'gnus-spec)
 
+;; Local Variables:
+;; coding: iso-8859-1
+;; End:
+
 ;;; gnus-spec.el ends here
index 66c67ed..dde25b8 100644 (file)
@@ -26,6 +26,7 @@
 ;;; Code:
 
 (eval-when-compile (require 'cl))
+
 (require 'gnus)
 (require 'gnus-spec)
 (require 'gnus-group)
@@ -173,12 +174,12 @@ The following commands are available:
         (gnus-tmp-where (nth 1 method))
         (elem (assoc method gnus-opened-servers))
         (gnus-tmp-status (cond ((eq (nth 1 elem) 'denied)
-                       "(denied)")
-                      ((or (gnus-server-opened method)
-                           (eq (nth 1 elem) 'ok))
-                       "(opened)")
-                      (t
-                       "(closed)"))))
+                                "(denied)")
+                               ((or (gnus-server-opened method)
+                                    (eq (nth 1 elem) 'ok))
+                                "(opened)")
+                               (t
+                                "(closed)"))))
     (beginning-of-line)
     (gnus-add-text-properties
      (point)
@@ -508,28 +509,28 @@ The following commands are available:
   (suppress-keymap gnus-browse-mode-map)
 
   (gnus-define-keys
-   gnus-browse-mode-map
-   " " gnus-browse-read-group
-   "=" gnus-browse-select-group
-   "n" gnus-browse-next-group
-   "p" gnus-browse-prev-group
-   "\177" gnus-browse-prev-group
-   [delete] gnus-browse-prev-group
-   "N" gnus-browse-next-group
-   "P" gnus-browse-prev-group
-   "\M-n" gnus-browse-next-group
-   "\M-p" gnus-browse-prev-group
-   "\r" gnus-browse-select-group
-   "u" gnus-browse-unsubscribe-current-group
-   "l" gnus-browse-exit
-   "L" gnus-browse-exit
-   "q" gnus-browse-exit
-   "Q" gnus-browse-exit
-   "\C-c\C-c" gnus-browse-exit
-   "?" gnus-browse-describe-briefly
-
-   "\C-c\C-i" gnus-info-find-node
-   "\C-c\C-b" gnus-bug))
+      gnus-browse-mode-map
+    " " gnus-browse-read-group
+    "=" gnus-browse-select-group
+    "n" gnus-browse-next-group
+    "p" gnus-browse-prev-group
+    "\177" gnus-browse-prev-group
+    [delete] gnus-browse-prev-group
+    "N" gnus-browse-next-group
+    "P" gnus-browse-prev-group
+    "\M-n" gnus-browse-next-group
+    "\M-p" gnus-browse-prev-group
+    "\r" gnus-browse-select-group
+    "u" gnus-browse-unsubscribe-current-group
+    "l" gnus-browse-exit
+    "L" gnus-browse-exit
+    "q" gnus-browse-exit
+    "Q" gnus-browse-exit
+    "\C-c\C-c" gnus-browse-exit
+    "?" gnus-browse-describe-briefly
+
+    "\C-c\C-i" gnus-info-find-node
+    "\C-c\C-b" gnus-bug))
 
 (defun gnus-browse-make-menu-bar ()
   (gnus-turn-off-edit-menu 'browse)
index b1333c0..13f3423 100644 (file)
@@ -27,6 +27,7 @@
 
 (eval-when-compile (require 'cl))
 (eval-when-compile (require 'static))
+
 (require 'gnus)
 (require 'gnus-win)
 (require 'gnus-int)
@@ -53,7 +54,7 @@ If a file with the `.el' or `.elc' suffixes exists, it will be read instead."
               (directory-file-name installation-directory))
              "site-lisp/gnus-init")
     (error nil))
-  "*The site-wide Gnus Emacs-Lisp startup file name, or nil if none.
+  "The site-wide Gnus Emacs-Lisp startup file name, or nil if none.
 If a file with the `.el' or `.elc' suffixes exists, it will be read instead."
   :group 'gnus-start
   :type '(choice file (const nil)))
@@ -226,12 +227,12 @@ not match this regexp will be removed before saving the list."
   :type 'boolean)
 
 (defcustom gnus-ignored-newsgroups
- (mapconcat 'identity
-           '("^to\\."                  ; not "real" groups
-             "^[0-9. \t]+ "            ; all digits in name
-             "^[\"][]\"[#'()]"         ; bogus characters
-             )
-           "\\|")
+  (mapconcat 'identity
+            '("^to\\."                 ; not "real" groups
+              "^[0-9. \t]+ "           ; all digits in name
+              "^[\"][]\"[#'()]"        ; bogus characters
+              )
+            "\\|")
   "*A regexp to match uninteresting newsgroups in the active file.
 Any lines in the active file matching this regular expression are
 removed from the newsgroup list before anything else is done to it,
@@ -962,16 +963,16 @@ for new groups, and subscribe the new groups as zombies."
   (let* ((gnus-subscribe-newsgroup-method
          gnus-subscribe-newsgroup-method)
         (check (cond
-               ((or (and (= (or arg 1) 4)
-                         (not (listp gnus-check-new-newsgroups)))
-                    (null gnus-read-active-file)
-                    (eq gnus-read-active-file 'some))
-                'ask-server)
-               ((= (or arg 1) 16)
-                (setq gnus-subscribe-newsgroup-method
-                      'gnus-subscribe-zombies)
-                t)
-               (t gnus-check-new-newsgroups))))
+                ((or (and (= (or arg 1) 4)
+                          (not (listp gnus-check-new-newsgroups)))
+                     (null gnus-read-active-file)
+                     (eq gnus-read-active-file 'some))
+                 'ask-server)
+                ((= (or arg 1) 16)
+                 (setq gnus-subscribe-newsgroup-method
+                       'gnus-subscribe-zombies)
+                 t)
+                (t gnus-check-new-newsgroups))))
     (unless (gnus-check-first-time-used)
       (if (or (consp check)
              (eq check 'ask-server))
@@ -1106,10 +1107,10 @@ for new groups, and subscribe the new groups as zombies."
         hashtb))
       (when new-newsgroups
        (gnus-subscribe-hierarchical-interactive new-newsgroups)))
-     (if (> groups 0)
-        (gnus-message 5 "%d new newsgroup%s arrived"
-                      groups (if (> groups 1) "s have" " has"))
-       (gnus-message 5 "No new newsgroups"))
+    (if (> groups 0)
+       (gnus-message 5 "%d new newsgroup%s arrived"
+                     groups (if (> groups 1) "s have" " has"))
+      (gnus-message 5 "No new newsgroups"))
     (when got-new
       (setq gnus-newsrc-last-checked-date new-date))
     got-new))
@@ -1263,14 +1264,14 @@ for new groups, and subscribe the new groups as zombies."
            (setq active (gnus-active group))
            (setq num
                  (if active (- (1+ (cdr active)) (car active)) t))
-           ;; Shorten the select method if possible, if we need to
-           ;; store it at all (native groups).
-           (let ((method (gnus-method-simplify
-                          (or gnus-override-subscribe-method
-                              (gnus-group-method group)))))
-             (if method
-                 (setq info (list group level nil nil method))
-               (setq info (list group level nil)))))
+           ;; Shorten the select method if possible, if we need to
+           ;; store it at all (native groups).
+           (let ((method (gnus-method-simplify
+                          (or gnus-override-subscribe-method
+                              (gnus-group-method group)))))
+             (if method
+                 (setq info (list group level nil nil method))
+               (setq info (list group level nil)))))
          (unless previous
            (setq previous
                  (let ((p gnus-newsrc-alist))
@@ -1388,7 +1389,7 @@ newsgroup."
           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
@@ -1514,6 +1515,13 @@ newsgroup."
       ;; be reached) we just set the number of unread articles in this
       ;; newsgroup to t.  This means that Gnus thinks that there are
       ;; unread articles, but it has no idea how many.
+
+      ;; To be more explicit:
+      ;; >0 for an active group with messages
+      ;; 0 for an active group with no unread messages
+      ;; nil for non-foreign groups that the user has requested not be checked
+      ;; t for unchecked foreign groups or bogus groups, or groups that can't
+      ;;   be checked, for one reason or other.
       (if (and (setq method (gnus-info-method info))
               (not (inline
                      (gnus-server-equal
@@ -1546,7 +1554,15 @@ newsgroup."
                  (setcdr (assoc method retrievegroups)
                          (cons group (cdr (assoc method retrievegroups))))
                (push (list method group) retrievegroups))
-           (if (member method scanned-methods)
+           ;; hack: `nnmail-get-new-mail' changes the mail-source depending
+           ;; on the group, so we must perform a scan for every group
+           ;; if the users has any directory mail sources.
+           (if (and (null (assq 'directory
+                                (or mail-sources
+                                    (if (listp nnmail-spool-file) 
+                                        nnmail-spool-file
+                                      (list nnmail-spool-file)))))
+                    (member method scanned-methods))
                (setq active (gnus-activate-group group))
              (setq active (gnus-activate-group group 'scan))
              (push method scanned-methods))
@@ -2381,6 +2397,7 @@ If FORCE is non-nil, the .newsrc file is read."
   "Insert Gnus variables such as gnus-newsrc-alist in lisp format."
   (let ((print-quoted t)
        (print-escape-newlines t))
+
     (insert ";; -*- emacs-lisp -*-\n")
     (insert ";; Gnus startup file.\n")
     (insert "\
index 34aa130..ddd8192 100644 (file)
@@ -28,6 +28,7 @@
 ;;; Code:
 
 (eval-when-compile (require 'cl))
+
 (require 'gnus)
 (require 'gnus-group)
 (require 'gnus-spec)
@@ -178,10 +179,13 @@ This variable will only be used if the value of
   :type 'string)
 
 (defcustom gnus-summary-goto-unread t
-  "*If t, marking commands will go to the next unread article.
+  "*If t, many commands will go to the next unread article.
+This applies to marking commands as well as other commands that
+\"naturally\" select the next article, like, for instance, `SPC' at
+the end of an article.
+If nil, only the marking commands will go to the next (un)read article.
 If `never', commands that usually go to the next unread article, will
-go to the next article, whether it is read or not.
-If nil, only the marking commands will go to the next (un)read article."
+go to the next article, whether it is read or not."
   :group 'gnus-summary-marks
   :link '(custom-manual "(gnus)Setting Marks")
   :type '(choice (const :tag "off" nil)
@@ -370,7 +374,7 @@ It uses the same syntax as the `gnus-split-methods' variable."
                         (cons :value ("" "") regexp (repeat string))
                         (sexp :value nil))))
 
-(defcustom gnus-unread-mark ? ;Whitespace
+(defcustom gnus-unread-mark ?  ;Whitespace
   "*Mark used for unread articles."
   :group 'gnus-summary-marks
   :type 'character)
@@ -485,7 +489,7 @@ It uses the same syntax as the `gnus-split-methods' variable."
   :group 'gnus-summary-marks
   :type 'character)
 
-(defcustom gnus-empty-thread-mark ? ;Whitespace
+(defcustom gnus-empty-thread-mark ?  ;Whitespace
   "*There is no thread under the article."
   :group 'gnus-summary-marks
   :type 'character)
@@ -839,11 +843,14 @@ which it may alter in any way.")
   '(("^hk\\>\\|^tw\\>\\|\\<big5\\>" cn-big5)
     ("^cn\\>\\|\\<chinese\\>" cn-gb-2312)
     ("^fj\\>\\|^japan\\>" iso-2022-jp-2)
+    ("^tnn\\>\\|^pin\\>\\|^sci.lang.japan" iso-2022-7bit)
     ("^relcom\\>" koi8-r)
     ("^fido7\\>" koi8-r)
     ("^\\(cz\\|hun\\|pl\\|sk\\|hr\\)\\>" iso-8859-2)
     ("^israel\\>" iso-8859-1)
     ("^han\\>" euc-kr)
+    ("^alt.chinese.text.big5\\>" chinese-big5)
+    ("^soc.culture.vietnamese\\>" vietnamese-viqr)
     ("^\\(comp\\|rec\\|alt\\|sci\\|soc\\|news\\|gnu\\|bofh\\)\\>" iso-8859-1)
     (".*" iso-8859-1))
   "Alist of regexps (to match group names) and default charsets to be used when reading."
@@ -907,6 +914,10 @@ For example: ((1 . cn-gb-2312) (2 . big5))."
                       (symbol :tag "Charset")))
   :group 'gnus-charset)
 
+(defcustom gnus-preserve-marks t
+  "Whether marks are preserved when moving, copying and respooling messages."
+  :type 'boolean
+  :group 'gnus-summary-marks)
 
 ;;; Internal variables
 
@@ -921,8 +932,7 @@ For example: ((1 . cn-gb-2312) (2 . big5))."
 (defvar gnus-thread-indent-array nil)
 (defvar gnus-thread-indent-array-level gnus-thread-indent-level)
 (defvar gnus-sort-gathered-threads-function 'gnus-thread-sort-by-number
-  "Function called to sort the articles within a thread after it has 
-been gathered together.")
+  "Function called to sort the articles within a thread after it has been gathered together.")
 
 ;; Avoid highlighting in kill files.
 (defvar gnus-summary-inhibit-highlight nil)
@@ -1197,7 +1207,7 @@ If RE-ONLY is non-nil, strip leading `Re:'s only."
 (defsubst gnus-simplify-buffer-fuzzy-step (regexp &optional newtext)
   (goto-char (point-min))
   (while (re-search-forward regexp nil t)
-      (replace-match (or newtext ""))))
+    (replace-match (or newtext ""))))
 
 (defun gnus-simplify-buffer-fuzzy ()
   "Simplify string in the buffer fuzzily.
@@ -1379,7 +1389,7 @@ increase the score of each group you read."
     "\C-d" gnus-summary-enter-digest-group
     "\M-\C-d" gnus-summary-read-document
     "\M-\C-e" gnus-summary-edit-parameters
-    "\M-\C-g" gnus-summary-customize-parameters
+    "\M-\C-a" gnus-summary-customize-parameters
     "\C-c\C-b" gnus-bug
     "*" gnus-cache-enter-article
     "\M-*" gnus-cache-remove-article
@@ -1617,8 +1627,7 @@ increase the score of each group you read."
     "c" gnus-article-copy-part
     "e" gnus-article-externalize-part
     "i" gnus-article-inline-part
-    "|" gnus-article-pipe-part)
-  )
+    "|" gnus-article-pipe-part))
 
 (defun gnus-summary-make-menu-bar ()
   (gnus-turn-off-edit-menu 'summary)
@@ -1702,7 +1711,8 @@ increase the score of each group you read."
               ["Toggle MIME" gnus-summary-toggle-mime t]
               ["Verbose header" gnus-summary-verbose-headers t]
               ["Toggle header" gnus-summary-toggle-header t]
-             ["Toggle smileys" gnus-smiley-display t])
+             ["Toggle smileys" gnus-smiley-display t]
+             ["HZ" gnus-article-decode-HZ t])
              ("Output"
               ["Save in default format" gnus-summary-save-article t]
               ["Save in file" gnus-summary-save-article-file t]
@@ -1781,8 +1791,7 @@ increase the score of each group you read."
        ["Mark thread as read" gnus-summary-kill-thread t]
        ["Lower thread score" gnus-summary-lower-thread t]
        ["Raise thread score" gnus-summary-raise-thread t]
-       ["Rethread current" gnus-summary-rethread-current t]
-       ))
+       ["Rethread current" gnus-summary-rethread-current t]))
 
     (easy-menu-define
      gnus-summary-post-menu gnus-summary-mode-map ""
@@ -2005,7 +2014,8 @@ increase the score of each group you read."
                                               (list 'gnus-summary-header
                                                     (nth 1 header)))
                                             (list 'quote (nth 1 (car ts)))
-                                            (list 'gnus-score-default nil)
+                                            (list 'gnus-score-delta-default
+                                                  nil)
                                             (nth 1 (car ps))
                                             t)
                                            t)
@@ -2611,7 +2621,7 @@ marks of articles."
          (if (or (null gnus-summary-default-score)
                  (<= (abs (- gnus-tmp-score gnus-summary-default-score))
                      gnus-summary-zcore-fuzz))
-             ? ;Whitespace
+             ?  ;Whitespace
            (if (< gnus-tmp-score gnus-summary-default-score)
                gnus-score-below-mark gnus-score-over-mark)))
         (gnus-tmp-replied
@@ -2676,7 +2686,7 @@ marks of articles."
         (if (or (null gnus-summary-default-score)
                 (<= (abs (- score gnus-summary-default-score))
                     gnus-summary-zcore-fuzz))
-            ? ;Whitespace
+            ?  ;Whitespace
           (if (< score gnus-summary-default-score)
               gnus-score-below-mark gnus-score-over-mark))
         'score))
@@ -3651,7 +3661,7 @@ If LINE, insert the rebuilt thread starting on line LINE."
   ;; using some other form will lead to serious barfage.
   (or (symbolp thread) (signal 'wrong-type-argument '(symbolp thread)))
   ;; (8% speedup to gnus-summary-prepare, just for fun :-)
-  (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207" ;
+  (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207" 
        (vector thread) 2))
 
 (defsubst gnus-article-sort-by-number (h1 h2)
@@ -3979,7 +3989,7 @@ or a straight list of headers."
             (if (or (null gnus-summary-default-score)
                     (<= (abs (- gnus-tmp-score gnus-summary-default-score))
                         gnus-summary-zcore-fuzz))
-                ? ;Whitespace
+                ?  ;Whitespace
               (if (< gnus-tmp-score gnus-summary-default-score)
                   gnus-score-below-mark gnus-score-over-mark))
             gnus-tmp-replied
@@ -4243,16 +4253,14 @@ If SELECT-ARTICLES, only select those articles from GROUP."
                 ((and (or (<= scored marked) (= scored number))
                       (natnump gnus-large-newsgroup)
                       (> number gnus-large-newsgroup))
-                 (let ((input (read-from-minibuffer
-                               (format
-                                "How many articles from %s (max %d): "
-                                (gnus-limit-string gnus-newsgroup-name 35)
-                                number)
-                               (static-if (< emacs-major-version 20)
-                                   (number-to-string gnus-large-newsgroup)
-                                 (cons
-                                  (number-to-string gnus-large-newsgroup)
-                                  0)))))
+                 (let* ((cursor-in-echo-area nil)
+                        (input (read-from-minibuffer
+                                (format
+                                 "How many articles from %s (max %d): "
+                                 (gnus-limit-string gnus-newsgroup-name 35)
+                                 number)
+                                (cons (number-to-string gnus-large-newsgroup)
+                                      0))))
                    (if (string-match "^[ \t]*$" input)
                        number
                      input)))
@@ -4371,9 +4379,9 @@ If SELECT-ARTICLES, only select those articles from GROUP."
       ;; Add all marks lists to the list of marks lists.
       (while (setq type (pop types))
        (setq list (symbol-value
-                         (setq symbol
-                               (intern (format "gnus-newsgroup-%s"
-                                               (car type))))))
+                   (setq symbol
+                         (intern (format "gnus-newsgroup-%s"
+                                         (car type))))))
 
        (when list
          ;; Get rid of the entries of the articles that have the
@@ -4392,24 +4400,25 @@ If SELECT-ARTICLES, only select those articles from GROUP."
                (setq arts (cdr arts)))
              (setq list (cdr all)))))
 
-       (or (memq (cdr type) uncompressed)
-           (setq list (gnus-compress-sequence (set symbol (sort list '<)) t)))
+       (unless (memq (cdr type) uncompressed)
+         (setq list (gnus-compress-sequence (set symbol (sort list '<)) t)))
        
-       (when (gnus-check-backend-function 'request-set-mark
-                                          gnus-newsgroup-name)
-         ;; uncompressed:s are not proper flags (they are cons cells)
-         ;; cache is a internal gnus flag
-         (unless (memq (cdr type) (cons 'cache uncompressed))
-           (let* ((old (cdr (assq (cdr type) (gnus-info-marks info))))
-                  (del (gnus-remove-from-range (gnus-copy-sequence old) list))
-                  (add (gnus-remove-from-range (gnus-copy-sequence list) old)))
-             (if add
-                 (push (list add 'add (list (cdr type))) delta-marks))
-             (if del
-                 (push (list del 'del (list (cdr type))) delta-marks)))))
+       (when (gnus-check-backend-function
+              'request-set-mark gnus-newsgroup-name)
+         ;; uncompressed:s are not proper flags (they are cons cells)
+         ;; cache is a internal gnus flag
+         (unless (memq (cdr type) (cons 'cache uncompressed))
+           (let* ((old (cdr (assq (cdr type) (gnus-info-marks info))))
+                  (del (gnus-remove-from-range (gnus-copy-sequence old) list))
+                  (add (gnus-remove-from-range
+                        (gnus-copy-sequence list) old)))
+             (when add
+               (push (list add 'add (list (cdr type))) delta-marks))
+             (when del
+               (push (list del 'del (list (cdr type))) delta-marks)))))
          
        (when list
-         (push (cons (cdr type) list) newmarked)))
+         (push (cons (cdr type) list) newmarked)))
 
       (when delta-marks
        (unless (gnus-check-group gnus-newsgroup-name)
@@ -5194,7 +5203,10 @@ displayed, no centering will be performed."
       ;; If the range of read articles is a single range, then the
       ;; first unread article is the article after the last read
       ;; article.  Sounds logical, doesn't it?
-      (if (not (listp (cdr read)))
+      (if (and (not (listp (cdr read)))
+              (or (< (car read) (car active))
+                  (progn (setq read (list read))
+                         nil)))
          (setq first (max (car active) (1+ (cdr read))))
        ;; `read' is a list of ranges.
        (when (/= (setq nlast (or (and (numberp (car read)) (car read))
@@ -5251,8 +5263,7 @@ displayed, no centering will be performed."
          (key-binding
           (read-key-sequence
            (substitute-command-keys
-            "\\<gnus-summary-mode-map>\\[gnus-summary-universal-argument]"
-            ))))
+            "\\<gnus-summary-mode-map>\\[gnus-summary-universal-argument]"))))
         'undefined)
        (gnus-error 1 "Undefined key")
       (save-excursion
@@ -5350,7 +5361,7 @@ If FORCE (the prefix), also save the .newsrc file(s)."
 
 (defun gnus-summary-exit (&optional temporary)
   "Exit reading current newsgroup, and then return to group selection mode.
-gnus-exit-group-hook is called with no arguments if that value is non-nil."
+`gnus-exit-group-hook' is called with no arguments if that value is non-nil."
   (interactive)
   (gnus-set-global-variables)
   (gnus-kill-save-kill-buffer)
@@ -5379,6 +5390,8 @@ gnus-exit-group-hook is called with no arguments if that value is non-nil."
       (gnus-dup-enter-articles))
     (when gnus-use-trees
       (gnus-tree-close group))
+    (when gnus-use-cache
+      (gnus-cache-write-active))
     ;; Remove entries for this group.
     (nnmail-purge-split-history (gnus-group-real-name group))
     ;; Make all changes in this group permanent.
@@ -5727,8 +5740,8 @@ returned."
                (if backward
                    (gnus-summary-find-prev unread)
                  (gnus-summary-find-next unread)))
-      (gnus-summary-show-thread)
-      (setq n (1- n)))
+      (unless (zerop (setq n (1- n)))
+       (gnus-summary-show-thread)))
     (when (/= 0 n)
       (gnus-message 7 "No more%s articles"
                    (if unread " unread" "")))
@@ -6807,15 +6820,7 @@ of what's specified by the `gnus-refer-thread-limit' variable."
        (t
        ;; 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))
+         (dolist (gnus-override-method (gnus-refer-article-methods))
            (gnus-check-server gnus-override-method)
            ;; Fetch the header, and display the article.
            (when (setq number (gnus-summary-insert-subject message-id))
@@ -6823,6 +6828,28 @@ of what's specified by the `gnus-refer-thread-limit' variable."
              (throw 'found t)))
          (gnus-message 3 "Couldn't fetch article %s" message-id)))))))
 
+(defun gnus-refer-article-methods ()
+  "Return a list of referrable methods."
+  (cond
+   ;; No method, so we default to current and native.
+   ((null gnus-refer-article-method)
+    (list gnus-current-select-method gnus-select-method))
+   ;; Current.
+   ((eq 'current gnus-refer-article-method)
+    (list gnus-current-select-method))
+   ;; List of select methods.
+   ((not (stringp (cadr gnus-refer-article-method)))
+    (let (out)
+      (dolist (method gnus-refer-article-method)
+       (push (if (eq 'current method)
+                 gnus-current-select-method
+               method)
+             out))
+      (nreverse out)))
+   ;; One single select method.
+   (t
+    (list gnus-refer-article-method))))
+
 (defun gnus-summary-edit-parameters ()
   "Edit the group parameters of the current group."
   (interactive)
@@ -7414,7 +7441,9 @@ re-spool using this method.
 
 For this function to work, both the current newsgroup and the
 newsgroup that you want to move to have to support the `request-move'
-and `request-accept' functions."
+and `request-accept' functions.
+
+ACTION can be either `move' (the default), `crosspost' or `copy'."
   (interactive "P")
   (unless action
     (setq action 'move))
@@ -7480,7 +7509,7 @@ and `request-accept' functions."
                  gnus-newsgroup-name)) ; Server
          (list 'gnus-request-accept-article
                to-newsgroup (list 'quote select-method)
-               (not articles) t)               ; Accept form
+               (not articles) t)       ; Accept form
          (not articles)))              ; Only save nov last time
        ;; Copy the article.
        ((eq action 'copy)
@@ -7521,9 +7550,9 @@ and `request-accept' functions."
               art-group))))))
       (cond
        ((not art-group)
-       (gnus-message 1 "Couldn't %s article %s: %s"
-                     (cadr (assq action names)) article
-                     (nnheader-get-report (car to-method))))
+       (gnus-message 1 "Couldn't %s article %s: %s"
+                     (cadr (assq action names)) article
+                     (nnheader-get-report (car to-method))))
        ((and (eq art-group 'junk)
             (eq action 'move))
        (gnus-summary-mark-article article gnus-canceled-mark)
@@ -7548,13 +7577,14 @@ and `request-accept' functions."
               info (gnus-add-to-range (gnus-info-read info)
                                       (list (cdr art-group)))))
 
-           ;; Copy any marks over to the new group.
+           ;; See whether the article is to be put in the cache.
            (let ((marks (if (gnus-group-auto-expirable-p to-group)
                             default-marks
                           no-expire-marks))
                  (to-article (cdr art-group)))
 
-             ;; See whether the article is to be put in the cache.
+             ;; Enter the article into the cache in the new group,
+             ;; if that is required.
              (when gnus-use-cache
                (gnus-cache-possibly-enter-article
                 to-group to-article
@@ -7566,34 +7596,36 @@ and `request-accept' functions."
                 (memq article gnus-newsgroup-dormant)
                 (memq article gnus-newsgroup-unreads)))
 
-             (when (and (equal to-group gnus-newsgroup-name)
-                        (not (memq article gnus-newsgroup-unreads)))
-               ;; Mark this article as read in this group.
-               (push (cons to-article gnus-read-mark) gnus-newsgroup-reads)
-               (setcdr (gnus-active to-group) to-article)
-               (setcdr gnus-newsgroup-active to-article))
-
-             (while marks
-               (when (memq article (symbol-value
-                                    (intern (format "gnus-newsgroup-%s"
-                                                    (caar marks)))))
-                  (push (cdar marks) to-marks)
-                 ;; If the other group is the same as this group,
-                 ;; then we have to add the mark to the list.
-                 (when (equal to-group gnus-newsgroup-name)
-                   (set (intern (format "gnus-newsgroup-%s" (caar marks)))
-                        (cons to-article
-                              (symbol-value
-                               (intern (format "gnus-newsgroup-%s"
-                                               (caar marks)))))))
-                 ;; Copy the marks to other group.
-                 (gnus-add-marked-articles
-                  to-group (cdar marks) (list to-article) info))
-               (setq marks (cdr marks)))
-
-              (gnus-request-set-mark to-group (list (list (list to-article)
-                                                          'set
-                                                          to-marks)))
+             (when gnus-preserve-marks 
+               ;; Copy any marks over to the new group.
+               (when (and (equal to-group gnus-newsgroup-name)
+                          (not (memq article gnus-newsgroup-unreads)))
+                 ;; Mark this article as read in this group.
+                 (push (cons to-article gnus-read-mark) gnus-newsgroup-reads)
+                 (setcdr (gnus-active to-group) to-article)
+                 (setcdr gnus-newsgroup-active to-article))
+
+               (while marks
+                 (when (memq article (symbol-value
+                                      (intern (format "gnus-newsgroup-%s"
+                                                      (caar marks)))))
+                   (push (cdar marks) to-marks)
+                   ;; If the other group is the same as this group,
+                   ;; then we have to add the mark to the list.
+                   (when (equal to-group gnus-newsgroup-name)
+                     (set (intern (format "gnus-newsgroup-%s" (caar marks)))
+                          (cons to-article
+                                (symbol-value
+                                 (intern (format "gnus-newsgroup-%s"
+                                                 (caar marks)))))))
+                   ;; Copy the marks to other group.
+                   (gnus-add-marked-articles
+                    to-group (cdar marks) (list to-article) info))
+                 (setq marks (cdr marks)))
+
+               (gnus-request-set-mark to-group (list (list (list to-article)
+                                                           'set
+                                                           to-marks))))
 
              (gnus-dribble-enter
               (concat "(gnus-group-set-info '"
@@ -7724,12 +7756,11 @@ latter case, they will be copied into the relevant groups."
       (kill-buffer (current-buffer)))))
 
 (defun gnus-summary-article-posted-p ()
-  "Say whether the current (mail) article is available from `gnus-select-method' as well.
+  "Say whether the current (mail) article is available from news as well.
 This will be the case if the article has both been mailed and posted."
   (interactive)
   (let ((id (mail-header-references (gnus-summary-article-header)))
-       (gnus-override-method
-        (or gnus-refer-article-method gnus-select-method)))
+       (gnus-override-method (car (gnus-refer-article-methods))))
     (if (gnus-request-head id "")
        (gnus-message 2 "The current message was found on %s"
                      gnus-override-method)
@@ -8157,7 +8188,8 @@ the actual number of articles marked is returned."
   "Mark N articles as read forwards.
 If N is negative, mark backwards instead.  Mark with MARK, ?r by default.
 The difference between N and the actual number of articles marked is
-returned."
+returned.
+Iff NO-EXPIRE, auto-expiry will be inhibited."
   (interactive "p")
   (gnus-summary-show-thread)
   (let ((backward (< n 0))
@@ -8250,7 +8282,8 @@ Four MARK strings are reserved: `? ' (unread), `?!' (ticked),
 `??' (dormant) and `?E' (expirable).
 If MARK is nil, then the default character `?r' is used.
 If ARTICLE is nil, then the article on the current line will be
-marked."
+marked.
+Iff NO-EXPIRE, auto-expiry will be inhibited."
   ;; The mark might be a string.
   (when (stringp mark)
     (setq mark (aref mark 0)))
@@ -8780,9 +8813,7 @@ Returns nil if no threads were there to be hidden."
                (subst-char-in-region start (point) ?\n ?\^M)
                (gnus-summary-goto-subject article))
            (goto-char start)
-           nil)
-       ;;(gnus-summary-position-point)
-       ))))
+           nil)))))
 
 (defun gnus-summary-go-to-next-thread (&optional previous)
   "Go to the same level (or less) next thread.
@@ -9324,8 +9355,10 @@ If REVERSE, save parts that do not match TYPE."
   "Read the headers of article ID and enter them into the Gnus system."
   (let ((group gnus-newsgroup-name)
        (gnus-override-method
-        (and (gnus-news-group-p gnus-newsgroup-name)
-             gnus-refer-article-method))
+        (or
+         gnus-override-method
+         (and (gnus-news-group-p gnus-newsgroup-name)
+              (car (gnus-refer-article-methods)))))
        where)
     ;; First we check to see whether the header in question is already
     ;; fetched.
@@ -9502,16 +9535,16 @@ If REVERSE, save parts that do not match TYPE."
               (gnus-info-set-read ',info ',(gnus-info-read info))
               (gnus-get-unread-articles-in-group ',info (gnus-active ,group))
               (gnus-group-update-group ,group t))))
-       ;; Propagate the read marks to the backend.
-       (if (gnus-check-backend-function 'request-set-mark group)
-           (let ((del (gnus-remove-from-range (gnus-info-read info) read))
-                 (add (gnus-remove-from-range read (gnus-info-read info))))
-             (when (or add del)
-              (unless (gnus-check-group group)
-                (error "Can't open server for %s" group))
-               (gnus-request-set-mark
-                group (delq nil (list (if add (list add 'add '(read)))
-                                      (if del (list del 'del '(read)))))))))
+       ;; Propagate the read marks to the backend.
+       (if (gnus-check-backend-function 'request-set-mark group)
+           (let ((del (gnus-remove-from-range (gnus-info-read info) read))
+                 (add (gnus-remove-from-range read (gnus-info-read info))))
+             (when (or add del)
+               (unless (gnus-check-group group)
+                 (error "Can't open server for %s" group))
+               (gnus-request-set-mark
+                group (delq nil (list (if add (list add 'add '(read)))
+                                      (if del (list del 'del '(read)))))))))
        ;; Enter this list into the group info.
        (gnus-info-set-read info read)
        ;; Set the number of unread articles in gnus-newsrc-hashtb.
@@ -9676,38 +9709,38 @@ If REVERSE, save parts that do not match TYPE."
   "Setup newsgroup default charset."
   (if (equal gnus-newsgroup-name "nndraft:drafts")
       (setq gnus-newsgroup-charset nil)
-  (let* ((name (and gnus-newsgroup-name
-                  (gnus-group-real-name gnus-newsgroup-name)))
-        (ignored-charsets 
-         (or gnus-newsgroup-ephemeral-ignored-charsets
-             (append
-              (and gnus-newsgroup-name
-                   (or (gnus-group-find-parameter gnus-newsgroup-name
-                                                  'ignored-charsets t)
-                       (let ((alist gnus-group-ignored-charsets-alist)
-                          elem (charsets nil))
-                         (while (setq elem (pop alist))
-                           (when (and name
-                                      (string-match (car elem) name))
-                             (setq alist nil
-                                   charsets (cdr elem))))
-                         charsets))))
-             gnus-newsgroup-ignored-charsets)))
-    (setq gnus-newsgroup-charset
-         (or gnus-newsgroup-ephemeral-charset
-             (and gnus-newsgroup-name
-                  (or (gnus-group-find-parameter gnus-newsgroup-name 'charset)
-                      (let ((alist gnus-group-charset-alist)
-                            elem charset)
-                        (while (setq elem (pop alist))
-                          (when (and name
-                                     (string-match (car elem) name))
-                            (setq alist nil
-                                  charset (cadr elem))))
-                        charset)))
-             gnus-default-charset))
-    (set (make-local-variable 'gnus-newsgroup-ignored-charsets) 
-        ignored-charsets))))
+    (let* ((name (and gnus-newsgroup-name
+                     (gnus-group-real-name gnus-newsgroup-name)))
+          (ignored-charsets 
+           (or gnus-newsgroup-ephemeral-ignored-charsets
+               (append
+                (and gnus-newsgroup-name
+                     (or (gnus-group-find-parameter gnus-newsgroup-name
+                                                    'ignored-charsets t)
+                         (let ((alist gnus-group-ignored-charsets-alist)
+                               elem (charsets nil))
+                           (while (setq elem (pop alist))
+                             (when (and name
+                                        (string-match (car elem) name))
+                               (setq alist nil
+                                     charsets (cdr elem))))
+                           charsets)))
+                gnus-newsgroup-ignored-charsets))))
+      (setq gnus-newsgroup-charset
+           (or gnus-newsgroup-ephemeral-charset
+               (and gnus-newsgroup-name
+                    (or (gnus-group-find-parameter gnus-newsgroup-name 'charset)
+                        (let ((alist gnus-group-charset-alist)
+                              elem charset)
+                          (while (setq elem (pop alist))
+                            (when (and name
+                                       (string-match (car elem) name))
+                              (setq alist nil
+                                    charset (cadr elem))))
+                          charset)))
+               gnus-default-charset))
+      (set (make-local-variable 'gnus-newsgroup-ignored-charsets) 
+          ignored-charsets))))
 
 ;;;
 ;;; Mime Commands
index d86f573..34f5a7b 100644 (file)
@@ -27,6 +27,7 @@
 ;;; Code:
 
 (eval-when-compile (require 'cl))
+
 (require 'gnus)
 (require 'gnus-group)
 (require 'gnus-start)
@@ -221,7 +222,7 @@ If TOPIC, start with that topic."
             (> unread 0))
           (and gnus-list-groups-with-ticked-articles
                (cdr (assq 'tick (gnus-info-marks info))))
-                                       ; Has right readedness.
+          ;; Has right readedness.
           ;; Check for permanent visibility.
           (and gnus-permanently-visible-groups
                (string-match gnus-permanently-visible-groups group))
@@ -998,7 +999,7 @@ articles in the topic and its subtopics."
          (if (null arg) (not gnus-topic-mode)
            (> (prefix-numeric-value arg) 0)))
     ;; Infest Gnus with topics.
-     (if (not gnus-topic-mode)
+    (if (not gnus-topic-mode)
        (setq gnus-goto-missing-group-function nil)
       (when (gnus-visual-p 'topic-menu 'menu)
        (gnus-topic-make-menu-bar))
@@ -1065,9 +1066,9 @@ If performed over a topic line, toggle folding the topic."
     (save-excursion
       (gnus-message 5 "Expiring groups in %s..." topic)
       (let ((gnus-group-marked
-            (mapcar (lambda (entry) (car (nth 2 entry)))
-                    (gnus-topic-find-groups topic gnus-level-killed t))))
-       (gnus-group-expire-articles nil))
+            (mapcar (lambda (entry) (car (nth 2 entry)))
+                    (gnus-topic-find-groups topic gnus-level-killed t))))
+       (gnus-group-expire-articles nil))
       (gnus-message 5 "Expiring groups in %s...done" topic))))
 
 (defun gnus-topic-read-group (&optional all no-article group)
@@ -1520,7 +1521,7 @@ If REVERSE, reverse the sorting order."
       (error "Can't find topic `%s'" current))
     (unless to-top
       (error "Can't find topic `%s'" to))
-    (if (gnus-topic-find-topology to current-top 0) ;; Don't care the level
+    (if (gnus-topic-find-topology to current-top 0);; Don't care the level
        (error "Can't move `%s' to its sub-level" current))
     (gnus-topic-find-topology current nil nil 'delete)
     (while (cdr to-top)
index 6d7e4ab..8823747 100644 (file)
   (setq gnus-undo-mode-map (make-sparse-keymap))
 
   (gnus-define-keys gnus-undo-mode-map
-   "\M-\C-_"     gnus-undo
-   "\C-_"        gnus-undo
-   "\C-xu"       gnus-undo
-   ;; many people are used to type `C-/' on X terminals and get `C-_'.
-   [(control /)] gnus-undo))
+    "\M-\C-_"     gnus-undo
+    "\C-_"        gnus-undo
+    "\C-xu"       gnus-undo
+    ;; many people are used to type `C-/' on X terminals and get `C-_'.
+    [(control /)] gnus-undo))
 
 (defun gnus-undo-make-menu-bar ()
   ;; This is disabled for the time being.
index 5d6d6e2..9c665a9 100644 (file)
@@ -33,6 +33,7 @@
 
 (eval-when-compile (require 'cl))
 (eval-when-compile (require 'static))
+
 (require 'custom)
 (require 'nnheader)
 (require 'message)
@@ -536,6 +537,7 @@ If N, return the Nth ancestor instead."
              first 't2
              last 't1))
        ((gnus-functionp function)
+       ;; Do nothing.
        )
        (t
        (error "Invalid sort spec: %s" function))))
index aa2e95f..b0772e5 100644 (file)
@@ -386,17 +386,17 @@ didn't work, and overwrite existing files.  Otherwise, ask each time."
   "P" gnus-uu-decode-postscript-and-save)
 
 (gnus-define-keys
- (gnus-uu-extract-view-map "v" gnus-uu-extract-map)
- "u" gnus-uu-decode-uu-view
- "U" gnus-uu-decode-uu-and-save-view
- "s" gnus-uu-decode-unshar-view
- "S" gnus-uu-decode-unshar-and-save-view
- "o" gnus-uu-decode-save-view
- "O" gnus-uu-decode-save-view
- "b" gnus-uu-decode-binhex-view
- "B" gnus-uu-decode-binhex-view
- "p" gnus-uu-decode-postscript-view
- "P" gnus-uu-decode-postscript-and-save-view)
+    (gnus-uu-extract-view-map "v" gnus-uu-extract-map)
+  "u" gnus-uu-decode-uu-view
+  "U" gnus-uu-decode-uu-and-save-view
+  "s" gnus-uu-decode-unshar-view
+  "S" gnus-uu-decode-unshar-and-save-view
+  "o" gnus-uu-decode-save-view
+  "O" gnus-uu-decode-save-view
+  "b" gnus-uu-decode-binhex-view
+  "B" gnus-uu-decode-binhex-view
+  "p" gnus-uu-decode-postscript-view
+  "P" gnus-uu-decode-postscript-and-save-view)
 
 
 ;; Commands.
@@ -567,8 +567,10 @@ didn't work, and overwrite existing files.  Otherwise, ask each time."
 ;; Process marking.
 
 (defun gnus-uu-mark-by-regexp (regexp &optional unmark)
-  "Ask for a regular expression and set the process mark on all articles that match."
-  (interactive (list (read-from-minibuffer "Mark (regexp): ")))
+  "Set the process mark on articles whose subjects match REGEXP.
+When called interactively, prompt for REGEXP.
+Optional UNMARK non-nil means unmark instead of mark."
+  (interactive "sMark (regexp): \nP")
   (let ((articles (gnus-uu-find-articles-matching regexp)))
     (while articles
       (if unmark
@@ -577,9 +579,10 @@ didn't work, and overwrite existing files.  Otherwise, ask each time."
     (message ""))
   (gnus-summary-position-point))
 
-(defun gnus-uu-unmark-by-regexp (regexp &optional unmark)
-  "Ask for a regular expression and remove the process mark on all articles that match."
-  (interactive (list (read-from-minibuffer "Mark (regexp): ")))
+(defun gnus-uu-unmark-by-regexp (regexp)
+  "Remove the process mark from articles whose subjects match REGEXP.
+When called interactively, prompt for REGEXP."
+  (interactive "sUnmark (regexp): ")
   (gnus-uu-mark-by-regexp regexp t))
 
 (defun gnus-uu-mark-series ()
@@ -656,7 +659,7 @@ didn't work, and overwrite existing files.  Otherwise, ask each time."
 (defun gnus-uu-mark-over (&optional score)
   "Mark all articles with a score over SCORE (the prefix)."
   (interactive "P")
-  (let ((score (gnus-score-default score))
+  (let ((score (or score gnus-summary-default-score 0))
        (data gnus-newsgroup-data))
     (save-excursion
       (while data
index 74fae9f..a7f6934 100644 (file)
@@ -32,6 +32,7 @@
 ;;; Code:
 
 (eval-when-compile (require 'cl))
+
 (require 'gnus-art)
 
 (eval-when-compile
index bbaa4f9..6a335e8 100644 (file)
@@ -26,6 +26,7 @@
 ;;; Code:
 
 (eval-when-compile (require 'cl))
+
 (require 'gnus)
 
 (defgroup gnus-windows nil
@@ -84,9 +85,9 @@
                  (article 1.0)))
       (t
        '(vertical 1.0
-                (summary 0.25 point)
-                (if gnus-carpal '(summary-carpal 4))
-                (article 1.0)))))
+                 (summary 0.25 point)
+                 (if gnus-carpal '(summary-carpal 4))
+                 (article 1.0)))))
     (server
      (vertical 1.0
               (server 1.0 point)
@@ -285,7 +286,7 @@ See the Gnus manual for an explanation of the syntax used.")
 (defun gnus-configure-frame (split &optional window)
   "Split WINDOW according to SPLIT."
   (unless window
-    (setq window (get-buffer-window (current-buffer))))
+    (setq window (or (get-buffer-window (current-buffer)) (selected-window))))
   (select-window window)
   ;; This might be an old-stylee buffer config.
   (when (vectorp split)
@@ -318,8 +319,10 @@ See the Gnus manual for an explanation of the syntax used.")
                          (t (cdr (assq type gnus-window-to-buffer))))))
        (unless buffer
          (error "Invalid buffer type: %s" type))
-       (switch-to-buffer (gnus-get-buffer-create
-                          (gnus-window-to-buffer-helper buffer)))
+       (let ((buf (gnus-get-buffer-create
+                   (gnus-window-to-buffer-helper buffer))))
+         (if (eq buf (window-buffer (selected-window))) (set-buffer buf)
+           (switch-to-buffer buf)))
        (when (memq 'frame-focus split)
          (setq gnus-window-frame-focus window))
        ;; We return the window if it has the `point' spec.
@@ -420,7 +423,7 @@ See the Gnus manual for an explanation of the syntax used.")
       (setq gnus-frame-split-p nil)
 
       (unless split
-       (error "No such setting: %s" setting))
+       (error "No such setting in `gnus-buffer-configuration': %s" setting))
 
       (if (and (setq all-visible (gnus-all-windows-visible-p split))
               (not force))
@@ -443,12 +446,12 @@ See the Gnus manual for an explanation of the syntax used.")
                    (gnus-delete-windows-in-gnusey-frames))
                ;; Just remove some windows.
                (gnus-remove-some-windows)
-               (switch-to-buffer nntp-server-buffer))
+             (set-buffer nntp-server-buffer))
            (select-frame frame)))
 
-       (switch-to-buffer nntp-server-buffer)
        (let (gnus-window-frame-focus)
-         (gnus-configure-frame split (get-buffer-window (current-buffer)))
+       (set-buffer nntp-server-buffer)
+       (gnus-configure-frame split)
          (when gnus-window-frame-focus
            (select-frame (window-frame gnus-window-frame-focus))))))))
 
@@ -505,7 +508,7 @@ should have point."
        (if (and (setq buf (get-buffer (gnus-window-to-buffer-helper buffer)))
                 (setq win (get-buffer-window buf t)))
            (if (memq 'point split)
-             (setq all-visible win))
+               (setq all-visible win))
          (setq all-visible nil)))
        (t
        (when (eq type 'frame)
index 4b74674..191b38c 100644 (file)
@@ -762,8 +762,7 @@ If it is non-nil, it must be a toolbar.  The five valid values are
      gnus-summary-catchup t "Catchup"]
     [gnus-summary-catchup-and-exit
      gnus-summary-catchup-and-exit t "Catchup and exit"]
-    [gnus-summary-exit gnus-summary-exit t "Exit this summary"]
-    )
+    [gnus-summary-exit gnus-summary-exit t "Exit this summary"])
   "The summary buffer toolbar.")
 
 (defvar gnus-summary-mail-toolbar
@@ -773,14 +772,10 @@ If it is non-nil, it must be a toolbar.  The five valid values are
     [gnus-summary-next-unread
      gnus-summary-next-unread-article t "Next unread article"]
     [gnus-summary-mail-reply gnus-summary-reply t "Reply"]
-;    [gnus-summary-mail-get gnus-mail-get t "Message get"]
     [gnus-summary-mail-originate gnus-summary-post-news t "Originate"]
     [gnus-summary-mail-save gnus-summary-save-article t "Save"]
     [gnus-summary-mail-copy gnus-summary-copy-article t "Copy message"]
-;    [gnus-summary-mail-delete gnus-summary-delete-article t "Delete message"]
     [gnus-summary-mail-forward gnus-summary-mail-forward t "Forward message"]
-;    [gnus-summary-mail-spell gnus-mail-spell t "Spell"]
-;    [gnus-summary-mail-help gnus-mail-help  t "Message help"]
     [gnus-summary-caesar-message
      gnus-summary-caesar-message t "Rot 13"]
     [gnus-uu-decode-uu
@@ -793,8 +788,7 @@ If it is non-nil, it must be a toolbar.  The five valid values are
      gnus-summary-catchup t "Catchup"]
     [gnus-summary-catchup-and-exit
      gnus-summary-catchup-and-exit t "Catchup and exit"]
-    [gnus-summary-exit gnus-summary-exit t "Exit this summary"]
-    )
+    [gnus-summary-exit gnus-summary-exit t "Exit this summary"])
   "The summary buffer mail toolbar.")
 
 (defun gnus-xmas-setup-group-toolbar ()
index c28c942..6ef4fc1 100644 (file)
   "Narrow to the header section in the current buffer."
   (narrow-to-region
    (goto-char (point-min))
-   (if (re-search-forward "^\n" nil 1)
-       (1- (point))
+   (if (re-search-forward "^\r?$" nil 1)
+       (match-beginning 0)
      (point-max)))
   (goto-char (point-min)))
 
index d9e3fb1..6d8fd45 100644 (file)
@@ -29,7 +29,7 @@
 ;; imap.el is roughly divided in two parts, one that parses IMAP
 ;; responses from the server and storing data into buffer-local
 ;; variables, and one for utility functions which send commands to
-;; server, waits for an answer, and return information. The latter
+;; server, waits for an answer, and return information.  The latter
 ;; part is layered on top of the previous.
 ;;
 ;; The imap.el API consist of the following functions, other functions
@@ -69,7 +69,7 @@
 ;; imap-body-lines
 ;;
 ;; It is my hope that theese commands should be pretty self
-;; explanatory for someone that know IMAP. All functions have
+;; explanatory for someone that know IMAP.  All functions have
 ;; additional documentation on how to invoke them.
 ;;
 ;; imap.el support RFC1730/2060 (IMAP4/IMAP4rev1), implemented IMAP
@@ -79,7 +79,7 @@
 ;; the UNSELECT extension in Cyrus IMAPD.
 ;;
 ;; Without the work of John McClary Prevost and Jim Radford this library
-;; would not have seen the light of day. Many thanks.
+;; would not have seen the light of day.  Many thanks.
 ;;
 ;; This is a transcript of short interactive session for demonstration
 ;; purposes.
@@ -88,7 +88,7 @@
 ;; => " *imap* my.mail.server:0"
 ;;
 ;; The rest are invoked with current buffer as the buffer returned by
-;; `imap-open'. It is possible to do all without this, but it would
+;; `imap-open'.  It is possible to do all without this, but it would
 ;; look ugly here since `buffer' is always the last argument for all
 ;; imap.el API functions.
 ;;
 ;; o Accept list of articles instead of message set string in most
 ;;   imap-message-* functions.
 ;; o Cyrus IMAPd 1.6.x `imtest' support in the imtest wrapper
-;; o Format-spec'ify the ssl horror
 ;;
 ;; Revision history:
 ;;
-;;  - this is unreleased software
+;;  - 19991218 added starttls/digest-md5 patch,
+;;             by Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+;;             NB! you need SLIM for starttls.el and digest-md5.el
+;;  - 19991023 commited to pgnus
 ;;
 
 ;;; Code:
   (autoload 'starttls-negotiate "starttls")
   (autoload 'digest-md5-parse-digest-challenge "digest-md5")
   (autoload 'digest-md5-digest-response "digest-md5")
+  (autoload 'digest-md5-digest-uri "digest-md5")
+  (autoload 'digest-md5-challenge "digest-md5")
   (autoload 'rfc2104-hash "rfc2104")
   (autoload 'utf7-encode "utf7")
   (autoload 'utf7-decode "utf7")
 program should accept IMAP commands on stdin and return responses to
 stdout.")
 
-(defvar imap-ssl-program 'auto
-  "Program to use for SSL connections. It is called like this
-
-`imap-ssl-program' `imap-ssl-arguments' -ssl2 -connect host:port
-
-where -ssl2 can also be -ssl3 to indicate which ssl version to use. It
-should accept IMAP commands on stdin and return responses to stdout.
-
-For SSLeay set this to \"s_client\" and `imap-ssl-arguments' to nil,
-for OpenSSL set this to \"openssl\" and `imap-ssl-arguments' to
-\"s_client\".
-
-If 'auto it tries s_client first and then openssl.")
-
-(defvar imap-ssl-arguments nil
-  "Arguments to pass to `imap-ssl-program'.
-
-For SSLeay set this to nil, for OpenSSL to \"s_client\".
-
-If `imap-ssl-program' is 'auto this variable has no effect.")
+(defvar imap-ssl-program '("openssl s_client -ssl3 -connect %s:%p"
+                          "openssl s_client -ssl2 -connect %s:%p"
+                          "s_client -ssl3 -connect %s:%p"
+                          "s_client -ssl2 -connect %s:%p")
+  "A string, or list of strings, containing commands for SSL connections.
+Within a string, %s is replaced with the server address and %p with
+port number on server.  The program should accept IMAP commands on
+stdin and return responses to stdout.")
 
 (defvar imap-default-user (user-login-name)
   "Default username to use.")
@@ -194,14 +186,14 @@ If `imap-ssl-program' is 'auto this variable has no effect.")
   "Hooks called after receiving each FETCH response.")
 
 (defvar imap-streams '(kerberos4 starttls ssl network)
-  "Priority of streams to consider when opening connection to
-server.")
+  "Priority of streams to consider when opening connection to server.")
 
 (defvar imap-stream-alist
   '((kerberos4 imap-kerberos4s-p imap-kerberos4-open)
     (ssl       imap-ssl-p        imap-ssl-open)
     (network   imap-network-p    imap-network-open)
-    (starttls  imap-starttls-p   imap-starttls-open))
+    (starttls  imap-starttls-p   imap-starttls-open)
+    (tls       imap-tls-p        imap-tls-open))
   "Definition of network streams.
 
 (NAME CHECK OPEN)
@@ -211,30 +203,29 @@ server support the stream and OPEN is a function for opening the
 stream.")
 
 (defvar imap-authenticators '(kerberos4 digest-md5 cram-md5 login anonymous)
-  "Priority of authenticators to consider when authenticating to
-server.")
-
-(defvar imap-authenticator-alist 
-  '((kerberos4   imap-kerberos4a-p imap-kerberos4-auth)
-    (cram-md5    imap-cram-md5-p   imap-cram-md5-auth)
-    (login       imap-login-p      imap-login-auth)
-    (anonymous   imap-anonymous-p  imap-anonymous-auth)
-    (digest-md5  imap-digest-md5-p imap-digest-md5-auth))
+  "Priority of authenticators to consider when authenticating to server.")
+
+(defvar imap-authenticator-alist
+  '((kerberos4  imap-kerberos4a-p imap-kerberos4-auth)
+    (cram-md5   imap-cram-md5-p   imap-cram-md5-auth)
+    (login      imap-login-p      imap-login-auth)
+    (anonymous  imap-anonymous-p  imap-anonymous-auth)
+    (digest-md5 imap-digest-md5-p imap-digest-md5-auth))
   "Definition of authenticators.
 
 (NAME CHECK AUTHENTICATE)
 
-NAME names the authenticator. CHECK is a function returning non-nil if
+NAME names the authenticator.  CHECK is a function returning non-nil if
 the server support the authenticator and AUTHENTICATE is a function
 for doing the actuall authentification.")
 
-(defvar imap-utf7-p nil
+(defvar imap-use-utf7 t
   "If non-nil, do utf7 encoding/decoding of mailbox names.
 Since the UTF7 decoding currently only decodes into ISO-8859-1
 characters, you may disable this decoding if you need to access UTF7
 encoded mailboxes which doesn't translate into ISO-8859-1.")
 
-;; Internal constants. Change theese and die.
+;; Internal constants.  Change theese and die.
 
 (defconst imap-default-port 143)
 (defconst imap-default-ssl-port 993)
@@ -268,8 +259,9 @@ encoded mailboxes which doesn't translate into ISO-8859-1.")
 (defvar imap-username nil)
 (defvar imap-password nil)
 (defvar imap-state 'closed 
-  "IMAP state. Valid states are `closed', `initial', `nonauth',
-`auth', `selected' and `examine'.")
+  "IMAP state.
+Valid states are `closed', `initial', `nonauth', `auth', `selected'
+and `examine'.")
 
 (defvar imap-server-eol "\r\n"
   "The EOL string sent from the server.")
@@ -308,10 +300,10 @@ encoded mailboxes which doesn't translate into ISO-8859-1.")
   "Lower limit on command tags that have been parsed.")
 
 (defvar imap-failed-tags nil 
-  "Alist of tags that failed. Each element is a list with four
-elements; tag (a integer), response state (a symbol, `OK', `NO' or
-`BAD'), response code (a string), and human readable response text (a
-string).")
+  "Alist of tags that failed.
+Each element is a list with four elements; tag (a integer), response
+state (a symbol, `OK', `NO' or `BAD'), response code (a string), and
+human readable response text (a string).")
 
 (defvar imap-tag 0
   "Command tag number.")
@@ -320,21 +312,21 @@ string).")
   "Process.")
 
 (defvar imap-continuation nil
-  "Non-nil indicates that the server emitted a continuation request. The
-actually value is really the text on the continuation line.")
+  "Non-nil indicates that the server emitted a continuation request.
+The actually value is really the text on the continuation line.")
 
 (defvar imap-log nil
   "Imap session trace.")
 
-(defvar imap-debug nil;"*imap-debug*"
+(defvar imap-debug nil                 ;"*imap-debug*"
   "Random debug spew.")
 
 \f
 ;; Utility functions:
 
 (defun imap-read-passwd (prompt &rest args)
-  "Read a password using PROMPT. If ARGS, PROMPT is used as an
-argument to `format'."
+  "Read a password using PROMPT.
+If ARGS, PROMPT is used as an argument to `format'."
   (let ((prompt (if args
                    (apply 'format prompt args)
                  prompt)))
@@ -349,7 +341,7 @@ argument to `format'."
             prompt)))
 
 (defsubst imap-utf7-encode (string)
-  (if imap-utf7-p
+  (if imap-use-utf7
       (and string
           (condition-case ()
               (utf7-encode string t)
@@ -360,7 +352,7 @@ argument to `format'."
     string))
 
 (defsubst imap-utf7-decode (string)
-  (if imap-utf7-p
+  (if imap-use-utf7
       (and string
           (condition-case ()
               (utf7-decode string t)
@@ -411,74 +403,67 @@ argument to `format'."
               (buffer-disable-undo)
               (goto-char (point-max))
               (insert-buffer-substring buffer)))
-      (let ((response (match-string 1)))
-       (erase-buffer)
-       (message "Kerberized IMAP connection: %s" response)
-       (if (and response (let ((case-fold-search nil))
-                           (not (string-match "failed" response))))
-           process
-         (if (memq (process-status process) '(open run))
-             (imap-send-command-wait "LOGOUT"))
-         (delete-process process)
-         nil))))))
+       (let ((response (match-string 1)))
+         (erase-buffer)
+         (message "Kerberized IMAP connection: %s" response)
+         (if (and response (let ((case-fold-search nil))
+                             (not (string-match "failed" response))))
+             process
+           (if (memq (process-status process) '(open run))
+               (imap-send-command-wait "LOGOUT"))
+           (delete-process process)
+           nil))))))
   
 (defun imap-ssl-p (buffer)
   nil)
 
-(defun imap-ssl-open-2 (name buffer server port &optional extra-ssl-args)
-  (let* ((port (or port imap-default-ssl-port))
-        (ssl-program-name imap-ssl-program)
-        (ssl-program-arguments (append imap-ssl-arguments extra-ssl-args
-                                       (list "-connect" 
-                                             (format "%s:%d" server port))))
-        (process (ignore-errors
-                   (cond ((eq system-type 'windows-nt)
-                          (let (selective-display
-                                (coding-system-for-write 'binary)
-                                (coding-system-for-read 'raw-text-dos))
-                            (open-ssl-stream name buffer server port)))
-                         (t
-                          (as-binary-process 
-                           (open-ssl-stream name buffer server port)))))))
-    (when process
-      (with-current-buffer buffer
-       (goto-char (point-min))
-       (while (and (memq (process-status process) '(open run))
-                   (goto-char (point-max))
-                   (forward-line -1)
-                   (not (imap-parse-greeting)))
-         (accept-process-output process 1)
-         (sit-for 1))
-       (and imap-log
-            (with-current-buffer (get-buffer-create imap-log)
-              (buffer-disable-undo)
-              (goto-char (point-max))
-              (insert-buffer-substring buffer)))
-       (erase-buffer))
-      (when (memq (process-status process) '(open run))
-       process))))
-
-(defun imap-ssl-open-1 (name buffer server port &optional extra-ssl-args)
-  (or (and (eq imap-ssl-program 'auto)
-          (let ((imap-ssl-program "s_client")
-                (imap-ssl-arguments nil))
-            (message "imap: Opening IMAP connection with %s %s..."
-                     imap-ssl-program (car-safe extra-ssl-args))
-            (imap-ssl-open-2 name buffer server port extra-ssl-args)))
-      (and (eq imap-ssl-program 'auto)
-          (let ((imap-ssl-program "openssl")
-                (imap-ssl-arguments '("s_client")))
-            (message "imap: Opening IMAP connection with %s %s..."
-                     imap-ssl-program (car-safe extra-ssl-args))
-            (imap-ssl-open-2 name buffer server port extra-ssl-args)))
-      (and (not (eq imap-ssl-program 'auto))
-          (progn (message "imap: Opening IMAP connection with %s %s..."
-                          imap-ssl-program (car-safe extra-ssl-args))
-                 (imap-ssl-open-2 name buffer server port extra-ssl-args)))))
-          
 (defun imap-ssl-open (name buffer server port)
-  (or (imap-ssl-open-1 name buffer server port '("-ssl3"))
-      (imap-ssl-open-1 name buffer server port '("-ssl2"))))
+  "Open a SSL connection to server."
+  (let ((cmds (if (listp imap-ssl-program) imap-ssl-program
+               (list imap-ssl-program)))
+       cmd done)
+    (while (and (not done) (setq cmd (pop cmds)))
+      (message "imap: Opening SSL connection with `%s'..." cmd)
+      (let* ((port (or port imap-default-ssl-port))
+            (ssl-program-name shell-file-name)
+            (ssl-program-arguments
+             (list shell-command-switch
+                   (format-spec cmd (format-spec-make
+                                     ?s server
+                                     ?p (number-to-string port)))))
+            process)
+       (when (setq process
+                   (ignore-errors
+                     (cond ((eq system-type 'windows-nt)
+                            (let (selective-display
+                                  (coding-system-for-write 'binary)
+                                  (coding-system-for-read 'raw-text-dos))
+                              (open-ssl-stream name buffer server port)))
+                           (t
+                            (as-binary-process
+                             (open-ssl-stream name buffer server port))))))
+         (with-current-buffer buffer
+           (goto-char (point-min))
+           (while (and (memq (process-status process) '(open run))
+                       (goto-char (point-max))
+                       (forward-line -1)
+                       (not (imap-parse-greeting)))
+             (accept-process-output process 1)
+             (sit-for 1))
+           (and imap-log
+                (with-current-buffer (get-buffer-create imap-log)
+                  (buffer-disable-undo)
+                  (goto-char (point-max))
+                  (insert-buffer-substring buffer)))
+           (erase-buffer)
+           (when (memq (process-status process) '(open run))
+             (setq done process))))))
+    (if done
+       (progn
+         (message "imap: Opening SSL connection with `%s'...done" cmd)
+         done)
+      (message "imap: Failed opening SSL connection")
+      nil)))
 
 (defun imap-network-p (buffer)
   t)
@@ -531,45 +516,45 @@ argument to `format'."
          (set-process-filter imap-process nil)))
       (when (memq (process-status process) '(open run))
        process))))
-  
+
 ;; Server functions; authenticator stuff:
 
 (defun imap-interactive-login (buffer loginfunc)
-  "Login to server in BUFFER. LOGINFUNC is passed a username and a
-password, it should return t if it where sucessful authenticating
-itself to the server, nil otherwise. Returns t if login was
-successful, nil otherwise."
+  "Login to server in BUFFER.
+LOGINFUNC is passed a username and a password, it should return t if
+it where sucessful authenticating itself to the server, nil otherwise.
+Returns t if login was successful, nil otherwise."
   (with-current-buffer buffer
     (make-variable-buffer-local 'imap-username)
     (make-variable-buffer-local 'imap-password)
     (let (user passwd ret)
-;;      (condition-case ()
-         (while (or (not user) (not passwd))
-           (setq user (or imap-username
-                          (read-from-minibuffer 
-                           (concat "IMAP username for " imap-server ": ")
-                           (or user imap-default-user))))
-           (setq passwd (or imap-password
-                            (imap-read-passwd
-                             (concat "IMAP password for " user "@" 
-                                     imap-server ": "))))
-           (when (and user passwd)
-             (if (funcall loginfunc user passwd)
-                 (progn
-                   (setq ret t
-                         imap-username user)
-                   (if (and (not imap-password)
-                            (y-or-n-p "Store password for this session? "))
-                       (setq imap-password passwd)))
-               (message "Login failed...")
-               (setq passwd nil)
-               (sit-for 1))))
-;;     (quit (with-current-buffer buffer
-;;             (setq user nil
-;;                   passwd nil)))
-;;     (error (with-current-buffer buffer
-;;              (setq user nil
-;;                    passwd nil))))
+      ;;      (condition-case ()
+      (while (or (not user) (not passwd))
+       (setq user (or imap-username
+                      (read-from-minibuffer 
+                       (concat "IMAP username for " imap-server ": ")
+                       (or user imap-default-user))))
+       (setq passwd (or imap-password
+                        (imap-read-passwd
+                         (concat "IMAP password for " user "@" 
+                                 imap-server ": "))))
+       (when (and user passwd)
+         (if (funcall loginfunc user passwd)
+             (progn
+               (setq ret t
+                     imap-username user)
+               (if (and (not imap-password)
+                        (y-or-n-p "Store password for this session? "))
+                   (setq imap-password passwd)))
+           (message "Login failed...")
+           (setq passwd nil)
+           (sit-for 1))))
+      ;;       (quit (with-current-buffer buffer
+      ;;               (setq user nil
+      ;;                     passwd nil)))
+      ;;       (error (with-current-buffer buffer
+      ;;                (setq user nil
+      ;;                      passwd nil))))
       ret)))
 
 (defun imap-kerberos4a-p (buffer)
@@ -602,6 +587,26 @@ successful, nil otherwise."
                 (encoded (base64-encode-string response)))
            encoded))))))))
 
+(defun imap-login-p (buffer)
+  (not (imap-capability 'X-LOGIN-CMD-DISABLED buffer)))
+
+(defun imap-login-auth (buffer)
+  "Login to server using the LOGIN command."
+  (imap-interactive-login buffer 
+                         (lambda (user passwd)
+                           (imap-ok-p (imap-send-command-wait 
+                                       (concat "LOGIN \"" user "\" \"" 
+                                               passwd "\""))))))
+
+(defun imap-anonymous-p (buffer)
+  t)
+
+(defun imap-anonymous-auth (buffer)
+  (with-current-buffer buffer
+    (imap-ok-p (imap-send-command-wait
+               (concat "LOGIN anonymous \"" (concat (user-login-name) "@" 
+                                                    (system-name)) "\"")))))
+
 (defun imap-digest-md5-p (buffer)
   (and (condition-case ()
           (require 'digest-md5)
@@ -613,7 +618,7 @@ successful, nil otherwise."
   (imap-interactive-login
    buffer
    (lambda (user passwd)
-     (let ((tag
+     (let ((tag 
            (imap-send-command
             (list
              "AUTHENTICATE DIGEST-MD5"
@@ -621,10 +626,10 @@ successful, nil otherwise."
                (digest-md5-parse-digest-challenge
                 (base64-decode-string challenge))
                (let* ((digest-uri
-                       (digest-md5-digest-uri
+                       (digest-md5-digest-uri 
                         "imap" (digest-md5-challenge 'realm)))
                       (response
-                       (digest-md5-digest-response
+                       (digest-md5-digest-response 
                         user passwd digest-uri)))
                  (base64-encode-string response 'no-line-break))))
             )))
@@ -634,26 +639,6 @@ successful, nil otherwise."
         (imap-send-command-1 "")
         (imap-ok-p (imap-wait-for-tag tag)))))))
 
-(defun imap-login-p (buffer)
-  (not (imap-capability 'X-LOGIN-CMD-DISABLED buffer)))
-
-(defun imap-login-auth (buffer)
-  "Login to server using the LOGIN command."
-  (imap-interactive-login buffer 
-                         (lambda (user passwd)
-                           (imap-ok-p (imap-send-command-wait 
-                                       (concat "LOGIN \"" user "\" \"" 
-                                               passwd "\""))))))
-
-(defun imap-anonymous-p (buffer)
-  t)
-
-(defun imap-anonymous-auth (buffer)
-  (with-current-buffer buffer
-    (imap-ok-p (imap-send-command-wait
-               (concat "LOGIN anonymous \"" (concat (user-login-name) "@" 
-                                                    (system-name)) "\"")))))
-
 ;; Server functions:
 
 (defun imap-open-1 (buffer)
@@ -679,21 +664,21 @@ successful, nil otherwise."
           imap-process))))
 
 (defun imap-open (server &optional port stream auth buffer)
-  "Open a IMAP connection to host SERVER at PORT returning a
-buffer. If PORT is unspecified, a default value is used (143 except
+  "Open a IMAP connection to host SERVER at PORT returning a buffer.
+If PORT is unspecified, a default value is used (143 except
 for SSL which use 993).
 STREAM indicates the stream to use, see `imap-streams' for available
-streams. If nil, it choices the best stream the server is capable of.
+streams.  If nil, it choices the best stream the server is capable of.
 AUTH indicates authenticator to use, see `imap-authenticators' for
-available authenticators. If nil, it choices the best stream the
+available authenticators.  If nil, it choices the best stream the
 server is capable of.
 BUFFER can be a buffer or a name of a buffer, which is created if
-necessery. If nil, the buffer name is generated."
+necessery.  If nil, the buffer name is generated."
   (setq buffer (or buffer (format " *imap* %s:%d" server (or port 0))))
   (with-current-buffer (get-buffer-create buffer)
     (if (imap-opened buffer)
        (imap-close buffer))
-    (mapc 'make-variable-buffer-local imap-local-variables)
+    (mapcar 'make-variable-buffer-local imap-local-variables)
     (buffer-disable-undo)
     (setq imap-server (or server imap-server))
     (setq imap-port (or port imap-port))
@@ -707,7 +692,7 @@ necessery. If nil, the buffer name is generated."
          (let ((streams imap-streams))
            (while (setq stream (pop streams))
              (if (funcall (nth 1 (assq stream imap-stream-alist)) buffer)
-                 (setq stream-changed (not (eq (or imap-stream 
+                 (setq stream-changed (not (eq (or imap-stream
                                                    imap-default-stream)
                                                stream))
                        imap-stream stream
@@ -724,7 +709,7 @@ necessery. If nil, the buffer name is generated."
          (when (null imap-auth)
            (let ((auths imap-authenticators))
              (while (setq auth (pop auths))
-               (if (funcall (nth 1 (assq auth imap-authenticator-alist)) 
+               (if (funcall (nth 1 (assq auth imap-authenticator-alist))
                             buffer)
                    (setq imap-auth auth
                          auths nil)))
@@ -735,8 +720,8 @@ necessery. If nil, the buffer name is generated."
       buffer)))
 
 (defun imap-opened (&optional buffer)
-  "Return non-nil if connection to imap server in BUFFER is open. If
-BUFFER is nil then the current buffer is used."
+  "Return non-nil if connection to imap server in BUFFER is open.
+If BUFFER is nil then the current buffer is used."
   (and (setq buffer (get-buffer (or buffer (current-buffer))))
        (buffer-live-p buffer)
        (with-current-buffer buffer
@@ -744,8 +729,8 @@ BUFFER is nil then the current buffer is used."
              (memq (process-status imap-process) '(open run))))))
 
 (defun imap-authenticate (&optional user passwd buffer)
-  "Authenticate to server in BUFFER, using current buffer if nil. It
-uses the authenticator specified when opening the server. If the
+  "Authenticate to server in BUFFER, using current buffer if nil.
+It uses the authenticator specified when opening the server.  If the
 authenticator requires username/passwords, they are queried from the
 user and optionally stored in the buffer.  If USER and/or PASSWD is
 specified, the user will not be questioned and the username and/or
@@ -760,8 +745,8 @@ password is remembered in the buffer."
          (setq imap-state 'auth)))))
 
 (defun imap-close (&optional buffer)
-  "Close connection to server in BUFFER. If BUFFER is nil, the current
-buffer is used."
+  "Close connection to server in BUFFER.
+If BUFFER is nil, the current buffer is used."
   (with-current-buffer (or buffer (current-buffer))
     (and (imap-opened)
         (not (imap-ok-p (imap-send-command-wait "LOGOUT")))
@@ -776,9 +761,9 @@ buffer is used."
     t))
 
 (defun imap-capability (&optional identifier buffer)
-  "Return a list of identifiers which server in BUFFER support. If
-IDENTIFIER, return non-nil if it's among the servers capabilities. If
-BUFFER is nil, the current buffer is assumed."
+  "Return a list of identifiers which server in BUFFER support.
+If IDENTIFIER, return non-nil if it's among the servers capabilities.
+If BUFFER is nil, the current buffer is assumed."
   (with-current-buffer (or buffer (current-buffer))
     (unless imap-capability
       (unless (imap-ok-p (imap-send-command-wait "CAPABILITY"))
@@ -788,8 +773,8 @@ BUFFER is nil, the current buffer is assumed."
       imap-capability)))
 
 (defun imap-namespace (&optional buffer)
-  "Return a namespace hierarchy at server in BUFFER. If BUFFER is nil,
-the current buffer is assumed."
+  "Return a namespace hierarchy at server in BUFFER.
+If BUFFER is nil, the current buffer is assumed."
   (with-current-buffer (or buffer (current-buffer))
     (unless imap-namespace
       (when (imap-capability 'NAMESPACE)
@@ -832,8 +817,8 @@ the current buffer is assumed."
       result)))
 
 (defun imap-mailbox-map (func &optional buffer)
-  "Map a function across each mailbox in `imap-mailbox-data',
-returning a list. Function should take a mailbox name (a string) as
+  "Map a function across each mailbox in `imap-mailbox-data', returning a list.
+Function should take a mailbox name (a string) as
 the only argument."
   (imap-mailbox-map-1 func 'imap-utf7-decode buffer))
 
@@ -853,8 +838,8 @@ the only argument."
     (imap-current-mailbox-p-1 (imap-utf7-encode mailbox) examine)))
 
 (defun imap-mailbox-select-1 (mailbox &optional examine)
-  "Select MAILBOX on server in BUFFER. If EXAMINE is non-nil, do a
-read-only select."
+  "Select MAILBOX on server in BUFFER.
+If EXAMINE is non-nil, do a read-only select."
   (if (imap-current-mailbox-p-1 mailbox examine)
       imap-current-mailbox
     (setq imap-current-mailbox mailbox)
@@ -874,7 +859,7 @@ read-only select."
      (imap-mailbox-select-1 (imap-utf7-encode mailbox) examine))))
 
 (defun imap-mailbox-examine (mailbox &optional buffer)
-  "Examine MAILBOX on server in BUFFER"
+  "Examine MAILBOX on server in BUFFER."
   (imap-mailbox-select mailbox 'exmine buffer))
 
 (defun imap-mailbox-unselect (&optional buffer)
@@ -894,43 +879,43 @@ read-only select."
       t)))
 
 (defun imap-mailbox-expunge (&optional buffer)
-  "Expunge articles in current folder in BUFFER. If BUFFER is
-nil the current buffer is assumed."
+  "Expunge articles in current folder in BUFFER.
+If BUFFER is nil the current buffer is assumed."
   (with-current-buffer (or buffer (current-buffer))
     (when (and imap-current-mailbox (not (eq imap-state 'examine)))
       (imap-ok-p (imap-send-command-wait "EXPUNGE")))))
 
 (defun imap-mailbox-close (&optional buffer)
-  "Expunge articles and close current folder in BUFFER. If BUFFER is
-nil the current buffer is assumed."
+  "Expunge articles and close current folder in BUFFER.
+If BUFFER is nil the current buffer is assumed."
   (with-current-buffer (or buffer (current-buffer))
     (when (and imap-current-mailbox
               (imap-ok-p (imap-send-command-wait "CLOSE")))
-       (setq imap-current-mailbox nil
-             imap-message-data nil
-             imap-state 'auth)
-       t)))
+      (setq imap-current-mailbox nil
+           imap-message-data nil
+           imap-state 'auth)
+      t)))
 
 (defun imap-mailbox-create-1 (mailbox)
   (imap-ok-p (imap-send-command-wait (list "CREATE \"" mailbox "\""))))
 
 (defun imap-mailbox-create (mailbox &optional buffer)
-  "Create MAILBOX on server in BUFFER. If BUFFER is nil the current
-buffer is assumed."
+  "Create MAILBOX on server in BUFFER.
+If BUFFER is nil the current buffer is assumed."
   (with-current-buffer (or buffer (current-buffer))
     (imap-mailbox-create-1 (imap-utf7-encode mailbox))))
 
 (defun imap-mailbox-delete (mailbox &optional buffer)
-  "Delete MAILBOX on server in BUFFER. If BUFFER is nil the current
-buffer is assumed."
+  "Delete MAILBOX on server in BUFFER.
+If BUFFER is nil the current buffer is assumed."
   (let ((mailbox (imap-utf7-encode mailbox)))
     (with-current-buffer (or buffer (current-buffer))
       (imap-ok-p
        (imap-send-command-wait (list "DELETE \"" mailbox "\""))))))
 
 (defun imap-mailbox-rename (oldname newname &optional buffer)
-  "Rename mailbox OLDNAME to NEWNAME on server in BUFFER. If BUFFER is
-nil the current buffer is assumed."
+  "Rename mailbox OLDNAME to NEWNAME on server in BUFFER.
+If BUFFER is nil the current buffer is assumed."
   (let ((oldname (imap-utf7-encode oldname))
        (newname (imap-utf7-encode newname)))
     (with-current-buffer (or buffer (current-buffer))
@@ -941,7 +926,7 @@ nil the current buffer is assumed."
 (defun imap-mailbox-lsub (&optional root reference add-delimiter buffer) 
   "Return a list of subscribed mailboxes on server in BUFFER.
 If ROOT is non-nil, only list matching mailboxes.  If ADD-DELIMITER is
-non-nil, a hierarchy delimiter is added to root. REFERENCE is a
+non-nil, a hierarchy delimiter is added to root.  REFERENCE is a
 implementation-specific string that has to be passed to lsub command."
   (with-current-buffer (or buffer (current-buffer))
     ;; Make sure we know the hierarchy separator for root's hierarchy
@@ -965,7 +950,7 @@ implementation-specific string that has to be passed to lsub command."
 (defun imap-mailbox-list (root &optional reference add-delimiter buffer)
   "Return a list of mailboxes matching ROOT on server in BUFFER.
 If ADD-DELIMITER is non-nil, a hierarchy delimiter is added to
-root. REFERENCE is a implementation-specific string that has to be
+root.  REFERENCE is a implementation-specific string that has to be
 passed to list command."
   (with-current-buffer (or buffer (current-buffer))
     ;; Make sure we know the hierarchy separator for root's hierarchy
@@ -987,27 +972,27 @@ passed to list command."
        (nreverse out)))))
 
 (defun imap-mailbox-subscribe (mailbox &optional buffer)
-  "Send the SUBSCRIBE command on the mailbox to server in
-BUFFER. Returns non-nil if successful."
+  "Send the SUBSCRIBE command on the mailbox to server in BUFFER.
+Returns non-nil if successful."
   (with-current-buffer (or buffer (current-buffer))
     (imap-ok-p (imap-send-command-wait (concat "SUBSCRIBE \"" 
                                               (imap-utf7-encode mailbox)
                                               "\"")))))
 
 (defun imap-mailbox-unsubscribe (mailbox &optional buffer)
-  "Send the SUBSCRIBE command on the mailbox to server in
-BUFFER. Returns non-nil if successful."
+  "Send the SUBSCRIBE command on the mailbox to server in BUFFER.
+Returns non-nil if successful."
   (with-current-buffer (or buffer (current-buffer))
     (imap-ok-p (imap-send-command-wait (concat "UNSUBSCRIBE " 
                                               (imap-utf7-encode mailbox)
                                               "\"")))))
 
 (defun imap-mailbox-status (mailbox items &optional buffer)
-  "Get status items ITEM in MAILBOX from server in BUFFER. ITEMS can
-be a symbol or a list of symbols, valid symbols are one of the STATUS
-data items -- ie 'messages, 'recent, 'uidnext, 'uidvalidity or
-'unseen. If ITEMS is a list of symbols, a list of values is returned,
-if ITEMS is a symbol only it's value is returned."
+  "Get status items ITEM in MAILBOX from server in BUFFER.
+ITEMS can be a symbol or a list of symbols, valid symbols are one of
+the STATUS data items -- ie 'messages, 'recent, 'uidnext, 'uidvalidity
+or 'unseen.  If ITEMS is a list of symbols, a list of values is
+returned, if ITEMS is a symbol only it's value is returned."
   (with-current-buffer (or buffer (current-buffer))
     (when (imap-ok-p 
           (imap-send-command-wait (list "STATUS \""
@@ -1031,11 +1016,10 @@ if ITEMS is a symbol only it's value is returned."
             (imap-send-command-wait (list "GETACL \""
                                           (or mailbox imap-current-mailbox)
                                           "\"")))
-      (imap-mailbox-get-1 'acl (or mailbox imap-current-mailbox))))))
+       (imap-mailbox-get-1 'acl (or mailbox imap-current-mailbox))))))
 
 (defun imap-mailbox-acl-set (identifier rights &optional mailbox buffer)
-  "Change/set ACL for IDENTIFIER to RIGHTS in MAILBOX from server in
-BUFFER."
+  "Change/set ACL for IDENTIFIER to RIGHTS in MAILBOX from server in BUFFER."
   (let ((mailbox (imap-utf7-encode mailbox)))
     (with-current-buffer (or buffer (current-buffer))
       (imap-ok-p
@@ -1047,8 +1031,7 @@ BUFFER."
                                     rights))))))
 
 (defun imap-mailbox-acl-delete (identifier &optional mailbox buffer)
-  "Removes any <identifier,rights> pair for IDENTIFIER in MAILBOX from
-server in BUFFER."
+  "Removes any <identifier,rights> pair for IDENTIFIER in MAILBOX from server in BUFFER."
   (let ((mailbox (imap-utf7-encode mailbox)))
     (with-current-buffer (or buffer (current-buffer))
       (imap-ok-p
@@ -1081,8 +1064,8 @@ server in BUFFER."
                               props))))
 
 (defun imap-fetch (uids props &optional receive nouidfetch buffer)
-  "Fetch properties PROPS from message set UIDS from server in
-BUFFER. UIDS can be a string, number or a list of numbers. If RECEIVE
+  "Fetch properties PROPS from message set UIDS from server in BUFFER.
+UIDS can be a string, number or a list of numbers.  If RECEIVE
 is non-nil return theese properties."
   (with-current-buffer (or buffer (current-buffer))
     (when (imap-ok-p (imap-send-command-wait 
@@ -1118,8 +1101,7 @@ is non-nil return theese properties."
         propname)))
 
 (defun imap-message-map (func propname &optional buffer)
-  "Map a function across each mailbox in `imap-message-data',
-returning a list."
+  "Map a function across each mailbox in `imap-message-data', returning a list."
   (with-current-buffer (or buffer (current-buffer))
     (let (result)
       (mapatoms
@@ -1181,8 +1163,7 @@ returning a list."
        (imap-mailbox-get-1 'search imap-current-mailbox)))))
 
 (defun imap-message-flag-permanent-p (flag &optional mailbox buffer)
-  "Return t iff FLAG can be permanently (between IMAP sessions) saved
-on articles, in MAILBOX on server in BUFFER."
+  "Return t iff FLAG can be permanently (between IMAP sessions) saved on articles, in MAILBOX on server in BUFFER."
   (with-current-buffer (or buffer (current-buffer))
     (or (member "\\*" (imap-mailbox-get 'permanentflags mailbox))
        (member flag (imap-mailbox-get 'permanentflags mailbox)))))
@@ -1232,8 +1213,8 @@ on articles, in MAILBOX on server in BUFFER."
 (defun imap-message-copy (articles mailbox
                                   &optional dont-create no-copyuid buffer)
   "Copy ARTICLES (a string message set) to MAILBOX on server in
-BUFFER, creating mailbox if it doesn't exist. If dont-create is
-non-nil, it will not create a mailbox. On success, return a list with
+BUFFER, creating mailbox if it doesn't exist.  If dont-create is
+non-nil, it will not create a mailbox.  On success, return a list with
 the UIDVALIDITY of the mailbox the article(s) was copied to as the
 first element, rest of list contain the saved articles' UIDs."
   (when articles
@@ -1271,9 +1252,10 @@ first element, rest of list contain the saved articles' UIDs."
     (imap-message-appenduid-1 (imap-utf7-encode mailbox))))
 
 (defun imap-message-append (mailbox article &optional flags date-time buffer)
-  "Append ARTICLE (a buffer) to MAILBOX on server in BUFFER. FLAGS and
-DATE-TIME is currently not used. Return a cons holding uidvalidity of
-MAILBOX and UID the newly created article got, or nil on failure."
+  "Append ARTICLE (a buffer) to MAILBOX on server in BUFFER.
+FLAGS and DATE-TIME is currently not used.  Return a cons holding
+uidvalidity of MAILBOX and UID the newly created article got, or nil
+on failure."
   (let ((mailbox (imap-utf7-encode mailbox)))
     (with-current-buffer (or buffer (current-buffer))
       (and (let ((imap-current-target-mailbox mailbox))
@@ -1283,8 +1265,7 @@ MAILBOX and UID the newly created article got, or nil on failure."
           (imap-message-appenduid-1 mailbox)))))
   
 (defun imap-body-lines (body)
-  "Return number of lines in article by looking at the mime bodystructure
-BODY."
+  "Return number of lines in article by looking at the mime bodystructure BODY."
   (if (listp body)
       (if (stringp (car body))
          (cond ((and (string= (car body) "TEXT")
@@ -1337,7 +1318,7 @@ BODY."
                     (imap-send-command-1 cmdstr)
                     (setq cmdstr nil)
                     (if (not (eq (imap-wait-for-tag tag) 'INCOMPLETE))
-                        (setq command nil) ;; abort command if no cont-req
+                        (setq command nil);; abort command if no cont-req
                       (let ((process imap-process)
                             (stream imap-stream))
                         (with-current-buffer cmd
@@ -1361,7 +1342,7 @@ BODY."
               (setq cmdstr nil)
               (unwind-protect
                   (if (not (eq (imap-wait-for-tag tag) 'INCOMPLETE))
-                      (setq command nil) ;; abort command if no cont-req
+                      (setq command nil);; abort command if no cont-req
                     (setq command (cons (funcall cmd imap-continuation)
                                         command)))
                 (setq imap-continuation nil)))
@@ -1387,8 +1368,8 @@ BODY."
   (delete-process process))
 
 (defun imap-find-next-line ()
-  "Return point at end of current line, taking into account
-literals. Return nil if no complete line has arrived."
+  "Return point at end of current line, taking into account literals.
+Return nil if no complete line has arrived."
   (when (re-search-forward (concat imap-server-eol "\\|{\\([0-9]+\\)}"
                                   imap-server-eol)
                           nil t)
@@ -1455,7 +1436,7 @@ literals. Return nil if no complete line has arrived."
       (if (< (point-max) (+ pos len))
          nil
        (goto-char (+ pos len))
-       (buffer-substring-no-properties pos (+ pos len))))))
+       (buffer-substring pos (+ pos len))))))
 
 ;;   string          = quoted / literal
 ;;
@@ -1469,13 +1450,20 @@ literals. Return nil if no complete line has arrived."
 ;;   TEXT-CHAR       = <any CHAR except CR and LF>
 
 (defsubst imap-parse-string ()
-  (let (strstart strend)
-    (cond ((and (eq (char-after (point)) ?\")
-               (setq strstart (point))
-               (setq strend (search-forward "\"" nil t 2)))
-          (buffer-substring-no-properties (1+ strstart) (1- strend)))
-         ((eq (char-after) ?{)
-          (imap-parse-literal)))))
+  (cond ((eq (char-after) ?\")
+        (forward-char 1)
+        (let ((p (point)) (name ""))
+          (skip-chars-forward "^\"\\\\")
+          (setq name (buffer-substring p (point)))
+          (while (eq (char-after) ?\\)
+            (setq p (1+ (point)))
+            (forward-char 2)
+            (skip-chars-forward "^\"\\\\")
+            (setq name (concat name (buffer-substring p (point)))))
+          (forward-char 1)
+          name))
+       ((eq (char-after) ?{)
+        (imap-parse-literal))))
 
 ;;   nil             = "NIL"
 
@@ -1986,8 +1974,7 @@ literals. Return nil if no complete line has arrived."
 ;;                       ; revisions of this specification.
 
 (defun imap-parse-flag-list ()
-  (let ((str (buffer-substring-no-properties
-             (point) (search-forward ")" nil t)))
+  (let ((str (buffer-substring (point) (search-forward ")" nil t)))
        pos)
     (while (setq pos (string-match "\\\\" str (and pos (+ 2 pos))))
       (setq str (replace-match "\\\\" nil t str)))
@@ -2020,31 +2007,31 @@ literals. Return nil if no complete line has arrived."
 (defun imap-parse-envelope ()
   (when (eq (char-after) ?\()
     (imap-forward)
-    (vector (prog1 (imap-parse-nstring)      ;; date
+    (vector (prog1 (imap-parse-nstring);; date
              (imap-forward))
-           (prog1 (imap-parse-nstring)      ;; subject
+           (prog1 (imap-parse-nstring);; subject
              (imap-forward))
-           (prog1 (imap-parse-address-list) ;; from
+           (prog1 (imap-parse-address-list);; from
              (imap-forward))
-           (prog1 (imap-parse-address-list) ;; sender
+           (prog1 (imap-parse-address-list);; sender
              (imap-forward))
-           (prog1 (imap-parse-address-list) ;; reply-to
+           (prog1 (imap-parse-address-list);; reply-to
              (imap-forward))
-           (prog1 (imap-parse-address-list) ;; to
+           (prog1 (imap-parse-address-list);; to
              (imap-forward))
-           (prog1 (imap-parse-address-list) ;; cc
+           (prog1 (imap-parse-address-list);; cc
              (imap-forward))
-           (prog1 (imap-parse-address-list) ;; bcc
+           (prog1 (imap-parse-address-list);; bcc
              (imap-forward))
-           (prog1 (imap-parse-nstring)      ;; in-reply-to
+           (prog1 (imap-parse-nstring);; in-reply-to
              (imap-forward))
-           (prog1 (imap-parse-nstring)      ;; message-id
+           (prog1 (imap-parse-nstring);; message-id
              (imap-forward)))))
 
 ;;   body-fld-param  = "(" string SP string *(SP string SP string) ")" / nil
 
 (defsubst imap-parse-string-list ()
-  (cond ((eq (char-after) ?\()                      ;; body-fld-param
+  (cond ((eq (char-after) ?\();; body-fld-param
         (let (strlist str)
           (imap-forward)
           (while (setq str (imap-parse-string))
@@ -2089,7 +2076,7 @@ literals. Return nil if no complete line has arrived."
 
 (defsubst imap-parse-body-ext ()
   (let (ext)
-    (when (eq (char-after) ?\ )                   ;; body-fld-dsp
+    (when (eq (char-after) ?\ );; body-fld-dsp
       (imap-forward)
       (let (dsp)
        (if (eq (char-after) ?\()
@@ -2101,12 +2088,12 @@ literals. Return nil if no complete line has arrived."
              (imap-forward))
          (assert (imap-parse-nil)))
        (push (nreverse dsp) ext))
-      (when (eq (char-after) ?\ )                ;; body-fld-lang
+      (when (eq (char-after) ?\ );; body-fld-lang
        (imap-forward)
        (if (eq (char-after) ?\()
            (push (imap-parse-string-list) ext)
          (push (imap-parse-nstring) ext))
-       (while (eq (char-after) ?\ )             ;; body-extension
+       (while (eq (char-after) ?\ );; body-extension
          (imap-forward)
          (setq ext (append (imap-parse-body-extension) ext)))))
     ext))
@@ -2182,35 +2169,35 @@ literals. Return nil if no complete line has arrived."
                        (setq subbody (imap-parse-body)))
              (push subbody body))
            (imap-forward)
-           (push (imap-parse-string) body)               ;; media-subtype
-           (when (eq (char-after) ?\ )                   ;; body-ext-mpart:
+           (push (imap-parse-string) body);; media-subtype
+           (when (eq (char-after) ?\ );; body-ext-mpart:
              (imap-forward)
-             (if (eq (char-after) ?\()                   ;; body-fld-param
+             (if (eq (char-after) ?\();; body-fld-param
                  (push (imap-parse-string-list) body)
                (push (and (imap-parse-nil) nil) body))
              (setq body
-                   (append (imap-parse-body-ext) body))) ;; body-ext-...
+                   (append (imap-parse-body-ext) body)));; body-ext-...
            (assert (eq (char-after) ?\)))
            (imap-forward)
            (nreverse body))
 
-       (push (imap-parse-string) body)                   ;; media-type
+       (push (imap-parse-string) body);; media-type
        (imap-forward)
-       (push (imap-parse-string) body)                   ;; media-subtype
+       (push (imap-parse-string) body);; media-subtype
        (imap-forward)
        ;; next line for Sun SIMS bug
        (and (eq (char-after) ? ) (imap-forward))
-       (if (eq (char-after) ?\()                         ;; body-fld-param
+       (if (eq (char-after) ?\();; body-fld-param
            (push (imap-parse-string-list) body)
          (push (and (imap-parse-nil) nil) body))
        (imap-forward)
-       (push (imap-parse-nstring) body)                  ;; body-fld-id
+       (push (imap-parse-nstring) body);; body-fld-id
        (imap-forward)
-       (push (imap-parse-nstring) body)                  ;; body-fld-desc
+       (push (imap-parse-nstring) body);; body-fld-desc
        (imap-forward)
-       (push (imap-parse-string) body)                   ;; body-fld-enc
+       (push (imap-parse-string) body);; body-fld-enc
        (imap-forward)
-       (push (imap-parse-number) body)                   ;; body-fld-octets
+       (push (imap-parse-number) body);; body-fld-octets
 
        ;; ok, we're done parsing the required parts, what comes now is one
        ;; of three things:
@@ -2220,131 +2207,129 @@ literals. Return nil if no complete line has arrived."
        ;; body-ext-1part (then we're parsing body-type-basic)
        ;;
        ;; the problem is that the two first are in turn optionally followed
-       ;; by the third. So we parse the first two here (if there are any)...
+       ;; by the third.  So we parse the first two here (if there are any)...
 
        (when (eq (char-after) ?\ )
          (imap-forward)
          (let (lines)
-           (cond ((eq (char-after) ?\()                  ;; body-type-msg:
-                  (push (imap-parse-envelope) body)      ;; envelope
+           (cond ((eq (char-after) ?\();; body-type-msg:
+                  (push (imap-parse-envelope) body);; envelope
                   (imap-forward)
-                  (push (imap-parse-body) body)          ;; body
+                  (push (imap-parse-body) body);; body
                   (imap-forward)
-                  (push (imap-parse-number) body))       ;; body-fld-lines
-                 ((setq lines (imap-parse-number))       ;; body-type-text:
-                  (push lines body))                     ;; body-fld-lines
+                  (push (imap-parse-number) body));; body-fld-lines
+                 ((setq lines (imap-parse-number));; body-type-text:
+                  (push lines body));; body-fld-lines
                  (t
-                  (backward-char)))))                    ;; no match...
+                  (backward-char)))));; no match...
 
        ;; ...and then parse the third one here...
 
-       (when (eq (char-after) ?\ )                       ;; body-ext-1part:
+       (when (eq (char-after) ?\ );; body-ext-1part:
          (imap-forward)
-         (push (imap-parse-nstring) body)                ;; body-fld-md5
+         (push (imap-parse-nstring) body);; body-fld-md5
          (setq body (append (imap-parse-body-ext) body)));; body-ext-1part..
     
        (assert (eq (char-after) ?\)))
        (imap-forward)
        (nreverse body)))))
 
-(when imap-debug ; (untrace-all)
+(when imap-debug                       ; (untrace-all)
   (require 'trace)
   (buffer-disable-undo (get-buffer-create imap-debug))
-  (mapc (lambda (f) (trace-function-background f imap-debug)) 
-        '(
-imap-read-passwd
-imap-utf7-encode
-imap-utf7-decode
-imap-error-text
-imap-kerberos4s-p
-imap-kerberos4-open
-imap-ssl-p
-imap-ssl-open-2
-imap-ssl-open-1
-imap-ssl-open
-imap-network-p
-imap-network-open
-imap-interactive-login
-imap-kerberos4a-p
-imap-kerberos4-auth
-imap-cram-md5-p
-imap-cram-md5-auth
-imap-login-p
-imap-login-auth
-imap-anonymous-p
-imap-anonymous-auth
-imap-open-1
-imap-open
-imap-opened
-imap-authenticate
-imap-close
-imap-capability
-imap-namespace
-imap-send-command-wait
-imap-mailbox-put
-imap-mailbox-get
-imap-mailbox-map-1
-imap-mailbox-map
-imap-current-mailbox
-imap-current-mailbox-p-1
-imap-current-mailbox-p
-imap-mailbox-select-1
-imap-mailbox-select
-imap-mailbox-examine
-imap-mailbox-unselect
-imap-mailbox-expunge
-imap-mailbox-close
-imap-mailbox-create-1
-imap-mailbox-create
-imap-mailbox-delete
-imap-mailbox-rename
-imap-mailbox-lsub
-imap-mailbox-list
-imap-mailbox-subscribe
-imap-mailbox-unsubscribe
-imap-mailbox-status
-imap-mailbox-acl-get
-imap-mailbox-acl-set
-imap-mailbox-acl-delete
-imap-current-message
-imap-list-to-message-set
-imap-fetch-asynch
-imap-fetch
-imap-message-put
-imap-message-get
-imap-message-map
-imap-search
-imap-message-flag-permanent-p
-imap-message-flags-set
-imap-message-flags-del
-imap-message-flags-add
-imap-message-copyuid-1
-imap-message-copyuid
-imap-message-copy
-imap-message-appenduid-1
-imap-message-appenduid
-imap-message-append
-imap-body-lines
-imap-envelope-from
-imap-send-command-1
-imap-send-command
-imap-wait-for-tag
-imap-sentinel
-imap-find-next-line
-imap-arrival-filter
-imap-parse-greeting
-imap-parse-response
-imap-parse-resp-text
-imap-parse-resp-text-code
-imap-parse-data-list
-imap-parse-fetch
-imap-parse-status
-imap-parse-acl
-imap-parse-flag-list
-imap-parse-envelope
-imap-parse-body-extension
-imap-parse-body
-         )))
+  (mapcar (lambda (f) (trace-function-background f imap-debug)) 
+         '(
+           imap-read-passwd
+           imap-utf7-encode
+           imap-utf7-decode
+           imap-error-text
+           imap-kerberos4s-p
+           imap-kerberos4-open
+           imap-ssl-p
+           imap-ssl-open
+           imap-network-p
+           imap-network-open
+           imap-interactive-login
+           imap-kerberos4a-p
+           imap-kerberos4-auth
+           imap-cram-md5-p
+           imap-cram-md5-auth
+           imap-login-p
+           imap-login-auth
+           imap-anonymous-p
+           imap-anonymous-auth
+           imap-open-1
+           imap-open
+           imap-opened
+           imap-authenticate
+           imap-close
+           imap-capability
+           imap-namespace
+           imap-send-command-wait
+           imap-mailbox-put
+           imap-mailbox-get
+           imap-mailbox-map-1
+           imap-mailbox-map
+           imap-current-mailbox
+           imap-current-mailbox-p-1
+           imap-current-mailbox-p
+           imap-mailbox-select-1
+           imap-mailbox-select
+           imap-mailbox-examine
+           imap-mailbox-unselect
+           imap-mailbox-expunge
+           imap-mailbox-close
+           imap-mailbox-create-1
+           imap-mailbox-create
+           imap-mailbox-delete
+           imap-mailbox-rename
+           imap-mailbox-lsub
+           imap-mailbox-list
+           imap-mailbox-subscribe
+           imap-mailbox-unsubscribe
+           imap-mailbox-status
+           imap-mailbox-acl-get
+           imap-mailbox-acl-set
+           imap-mailbox-acl-delete
+           imap-current-message
+           imap-list-to-message-set
+           imap-fetch-asynch
+           imap-fetch
+           imap-message-put
+           imap-message-get
+           imap-message-map
+           imap-search
+           imap-message-flag-permanent-p
+           imap-message-flags-set
+           imap-message-flags-del
+           imap-message-flags-add
+           imap-message-copyuid-1
+           imap-message-copyuid
+           imap-message-copy
+           imap-message-appenduid-1
+           imap-message-appenduid
+           imap-message-append
+           imap-body-lines
+           imap-envelope-from
+           imap-send-command-1
+           imap-send-command
+           imap-wait-for-tag
+           imap-sentinel
+           imap-find-next-line
+           imap-arrival-filter
+           imap-parse-greeting
+           imap-parse-response
+           imap-parse-resp-text
+           imap-parse-resp-text-code
+           imap-parse-data-list
+           imap-parse-fetch
+           imap-parse-status
+           imap-parse-acl
+           imap-parse-flag-list
+           imap-parse-envelope
+           imap-parse-body-extension
+           imap-parse-body
+           )))
        
 (provide 'imap)
 
index 2e4010b..ca2d1db 100644 (file)
                    w3-meta-charset-content-type-regexp
                    url-current-callback-func url-current-callback-data
                    url-be-asynchronous temporary-file-directory
-                   babel-translations babel-history)))
+                   babel-translations babel-history
+                   display-time-mail-function)))
   (maybe-bind '(mail-mode-hook
                enable-multibyte-characters browse-url-browser-function
                adaptive-fill-first-line-regexp adaptive-fill-regexp
                url-current-mime-headers help-echo-owns-message
                w3-meta-content-type-charset-regexp
                w3-meta-charset-content-type-regexp
-               babel-translations babel-history))
+               babel-translations babel-history display-time-mail-function))
   (maybe-fbind '(color-instance-rgb-components
                 temp-directory
                 glyph-width annotation-glyph window-pixel-width glyph-height
                 url-generic-parse-url valid-image-instantiator-format-p
                 babel-fetch babel-wash sc-cite-regexp
                 coding-system-get find-coding-system
-                find-coding-systems-for-charsets font-lock-set-defaults
-                function-max-args get-charset-property toolbar-gnus
+                find-coding-systems-for-charsets find-coding-systems-region
+                font-lock-set-defaults function-max-args get-charset-property
                 make-symbolic-link map-extents smiley-encode-buffer
+                toolbar-gnus
                 )))
 
 (setq load-path (cons "." load-path))
index 82187fc..de43787 100644 (file)
@@ -29,6 +29,10 @@ This variable should never be set.  Instead, it should be bound by
 functions that wish to call mail-parse functions and let them know
 what the desired charset is to be.")
 
+(defvar mail-parse-mule-charset nil
+  "Default MULE charset used by low-level libraries.
+This variable should never be set.")
+
 (defvar mail-parse-ignored-charsets nil
   "Ignored charsets used by low-level libraries.
 This variable should never be set.  Instead, it should be bound by
index 3cf7425..4500ed4 100644 (file)
@@ -27,7 +27,8 @@
 
 (eval-when-compile (require 'cl))
 (eval-and-compile
-  (autoload 'pop3-movemail "pop3"))
+  (autoload 'pop3-movemail "pop3")
+  (autoload 'pop3-get-message-count "pop3"))
 (require 'format-spec)
 
 (defgroup mail-source nil
@@ -40,6 +41,12 @@ This variable is a list of mail source specifiers."
   :group 'mail-source
   :type 'sexp)
 
+(defcustom mail-source-primary-source nil
+  "*Primary source for incoming mail.
+If non-nil, this maildrop will be checked periodically for new mail."
+  :group 'mail-source
+  :type 'sexp)
+
 (defcustom mail-source-crash-box "~/.emacs-mail-crash-box"
   "File where mail will be stored while processing it."
   :group 'mail-source
@@ -60,11 +67,24 @@ This variable is a list of mail source specifiers."
   :group 'mail-source
   :type 'boolean)
 
+(defcustom mail-source-report-new-mail-interval 5
+  "Interval in minutes between checks for new mail."
+  :group 'mail-source
+  :type 'number)
+
+(defcustom mail-source-idle-time-delay 5
+  "Number of idle seconds to wait before checking for new mail."
+  :group 'mail-source
+  :type 'number)
+
 ;;; Internal variables.
 
 (defvar mail-source-string ""
   "A dynamically bound string that says what the current mail source is.")
 
+(defvar mail-source-new-mail-available nil
+  "Flag indicating when new mail is available.")
+
 (eval-and-compile
   (defvar mail-source-common-keyword-map
     '((:plugged))
@@ -112,6 +132,7 @@ Common keywords should be listed here.")
        (:subtype hotmail)
        (:user (or (user-login-name) (getenv "LOGNAME") (getenv "USER")))
        (:password)
+       (:dontexpunge)
        (:authentication password)))
     "Mapping from keywords to default values.
 All keywords that can be used must be listed here."))
@@ -133,8 +154,8 @@ All keywords that can be used must be listed here."))
 
 (eval-and-compile
   (defun mail-source-strip-keyword (keyword)
-  "Strip the leading colon off the KEYWORD."
-  (intern (substring (symbol-name keyword) 1))))
+    "Strip the leading colon off the KEYWORD."
+    (intern (substring (symbol-name keyword) 1))))
 
 (eval-and-compile
   (defun mail-source-bind-1 (type)
@@ -426,7 +447,7 @@ If ARGS, PROMPT is used as an argument to `format'."
     (mail-source-run-script
      prescript
      (format-spec-make ?p password ?t mail-source-crash-box
-                                     ?s server ?P port ?u user)
+                      ?s server ?P port ?u user)
      prescript-delay)
     (let ((from (format "%s:%s:%s" server user port))
          (mail-source-string (format "pop:%s@%s" user server))
@@ -466,6 +487,9 @@ If ARGS, PROMPT is used as an argument to `format'."
                (push (cons from password) mail-source-password-cache)))
            (prog1
                (mail-source-callback callback server)
+             ;; Update display-time's mail flag, if relevant.
+             (if (equal source mail-source-primary-source)
+                 (setq mail-source-new-mail-available nil))
              (mail-source-run-script
               postscript
               (format-spec-make ?p password ?t mail-source-crash-box
@@ -477,6 +501,109 @@ If ARGS, PROMPT is used as an argument to `format'."
                    mail-source-password-cache))
        0))))
 
+(defun mail-source-check-pop (source)
+  "Check whether there is new mail."
+  (mail-source-bind (pop source)
+    (let ((from (format "%s:%s:%s" server user port))
+         (mail-source-string (format "pop:%s@%s" user server))
+         result)
+      (when (eq authentication 'password)
+       (setq password
+             (or password
+                 (cdr (assoc from mail-source-password-cache))
+                 (mail-source-read-passwd
+                  (format "Password for %s at %s: " user server))))
+       (unless (assoc from mail-source-password-cache)
+         (push (cons from password) mail-source-password-cache)))
+      (when server
+       (setenv "MAILHOST" server))
+      (setq result
+           (cond
+            ;; No easy way to check whether mail is waiting for these.
+            (program)
+            (function)
+            ;; The default is to use pop3.el.
+            (t
+             (let ((pop3-password password)
+                   (pop3-maildrop user)
+                   (pop3-mailhost server)
+                   (pop3-port port)
+                   (pop3-authentication-scheme
+                    (if (eq authentication 'apop) 'apop 'pass)))
+               (save-excursion (pop3-get-message-count))))))
+      (if result
+         ;; Inform display-time that we have new mail.
+         (setq mail-source-new-mail-available (> result 0))
+       ;; We nix out the password in case the error
+       ;; was because of a wrong password being given.
+       (setq mail-source-password-cache
+             (delq (assoc from mail-source-password-cache)
+                   mail-source-password-cache)))
+      result)))
+
+(defun mail-source-new-mail-p ()
+  "Handler for `display-time' to indicate when new mail is available."
+  ;; Only report flag setting; flag is updated on a different schedule.
+  mail-source-new-mail-available)
+
+
+(defvar mail-source-report-new-mail nil)
+(defvar mail-source-report-new-mail-timer nil)
+(defvar mail-source-report-new-mail-idle-timer nil)
+
+(eval-when-compile (require 'timer))
+
+(defun mail-source-start-idle-timer ()
+  ;; Start our idle timer if necessary, so we delay the check until the
+  ;; user isn't typing.
+  (unless mail-source-report-new-mail-idle-timer
+    (setq mail-source-report-new-mail-idle-timer
+         (run-with-idle-timer
+          mail-source-idle-time-delay
+          nil
+          (lambda ()
+            (setq mail-source-report-new-mail-idle-timer nil)
+            (mail-source-check-pop mail-source-primary-source))))
+    ;; Since idle timers created when Emacs is already in the idle
+    ;; state don't get activated until Emacs _next_ becomes idle, we
+    ;; need to force our timer to be considered active now.  We do
+    ;; this by being naughty and poking the timer internals directly
+    ;; (element 0 of the vector is nil if the timer is active).
+    (aset mail-source-report-new-mail-idle-timer 0 nil)))
+
+(defun mail-source-report-new-mail (arg)
+  "Toggle whether to report when new mail is available.
+This only works when `display-time' is enabled."
+  (interactive "P")
+  (if (not mail-source-primary-source)
+      (error "Need to set `mail-source-primary-source' to check for new mail."))
+  (let ((on (if (null arg)
+               (not mail-source-report-new-mail)
+             (> (prefix-numeric-value arg) 0))))
+    (setq mail-source-report-new-mail on)
+    (and mail-source-report-new-mail-timer
+        (cancel-timer mail-source-report-new-mail-timer))
+    (and mail-source-report-new-mail-idle-timer
+        (cancel-timer mail-source-report-new-mail-idle-timer))
+    (setq mail-source-report-new-mail-timer nil)
+    (setq mail-source-report-new-mail-idle-timer nil)
+    (if on
+       (progn
+         (require 'time)
+         (setq display-time-mail-function #'mail-source-new-mail-p)
+         ;; Set up the main timer.
+         (setq mail-source-report-new-mail-timer
+               (run-at-time t (* 60 mail-source-report-new-mail-interval)
+                            #'mail-source-start-idle-timer))
+         ;; When you get new mail, clear "Mail" from the mode line.
+         (add-hook 'nnmail-post-get-new-mail-hook
+                   'display-time-event-handler)
+         (message "Mail check enabled"))
+      (setq display-time-mail-function nil)
+      (remove-hook 'nnmail-post-get-new-mail-hook
+                  'display-time-event-handler)
+      (message "Mail check disabled"))))
+
 (defun mail-source-fetch-maildir (source callback)
   "Fetcher for maildir sources."
   (mail-source-bind (maildir source)
@@ -546,13 +673,16 @@ If ARGS, PROMPT is used as an argument to `format'."
 (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))))
+    (let ((mail-source-string (format "webmail:%s:%s" subtype user))
+         (webmail-newmail-only dontexpunge)
+         (webmail-move-to-trash-can (not dontexpunge)))
+      (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)
 
index a6c19aa..a246b1a 100644 (file)
@@ -360,10 +360,10 @@ Returns a vector of 16 bytes containing the message digest."
      c (md5-II c d a b (aref in  2) 15 '(10967 . 53947))
      b (md5-II b c d a (aref in  9) 21 '(60294 . 54161)))
 
-     (aset md5-buffer 0 (md5-add (aref md5-buffer 0) a))
-     (aset md5-buffer 1 (md5-add (aref md5-buffer 1) b))
-     (aset md5-buffer 2 (md5-add (aref md5-buffer 2) c))
-     (aset md5-buffer 3 (md5-add (aref md5-buffer 3) d))))
+    (aset md5-buffer 0 (md5-add (aref md5-buffer 0) a))
+    (aset md5-buffer 1 (md5-add (aref md5-buffer 1) b))
+    (aset md5-buffer 2 (md5-add (aref md5-buffer 2) c))
+    (aset md5-buffer 3 (md5-add (aref md5-buffer 3) d))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Here begins the merger with the XEmacs API and the md5.el from the URL
@@ -378,7 +378,7 @@ hash of a portion of OBJECT.
 The optional CODING and NOERROR arguments are ignored.  They are only
 placeholders to ensure the compatibility with XEmacsen with file-coding or
 Mule support."
- (let ((buffer nil))
+  (let ((buffer nil))
     (unwind-protect
        (save-excursion
          (setq buffer (generate-new-buffer " *md5-work*"))
index e2b1599..27c419d 100644 (file)
@@ -37,6 +37,7 @@
 
 (eval-when-compile (require 'cl))
 (eval-when-compile (require 'smtp))
+
 (require 'mailheader)
 (require 'nnheader)
 (require 'easymenu)
@@ -190,7 +191,7 @@ Otherwise, most addresses look like `angles', but they look like
   :group 'message-headers)
 
 (defcustom message-syntax-checks nil
-  ; Guess this one shouldn't be easy to customize...
+  ;; Guess this one shouldn't be easy to customize...
   "*Controls what syntax checks should not be performed on outgoing posts.
 To disable checking of long signatures, for instance, add
  `(signature . disabled)' to this list.
@@ -391,7 +392,7 @@ If t, use `message-user-organization-file'."
 
 (defcustom message-make-forward-subject-function
   'message-forward-subject-author-subject
- "*A list of functions that are called to generate a subject header for forwarded messages.
+  "*A list of functions that are called to generate a subject header for forwarded messages.
 The subject generated by the previous function is passed into each
 successive function.
 
@@ -401,9 +402,9 @@ The provided functions are:
       newsgroup)), in brackets followed by the subject
 * message-forward-subject-fwd (Subject of article with 'Fwd:' prepended
       to it."
- :group 'message-forwarding
- :type '(radio (function-item message-forward-subject-author-subject)
-              (function-item message-forward-subject-fwd)))
+  :group 'message-forwarding
+  :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."
@@ -762,8 +763,7 @@ these lines."
   :type 'message-header-lines)
 
 (defcustom message-default-news-headers ""
-  "*A string of header lines to be inserted in outgoing news
-articles."
+  "*A string of header lines to be inserted in outgoing news articles."
   :group 'message-headers
   :group 'message-news
   :type 'message-header-lines)
@@ -1288,10 +1288,10 @@ The cdr of ech entry is a function for applying the face to a region.")
      "\\([^\0-\b\n-\r\^?].*\\)? "
 
      ;; The time the message was sent.
-     "\\([^\0-\r \^?]+\\) +"                           ; day of the week
-     "\\([^\0-\r \^?]+\\) +"                           ; month
-     "\\([0-3]?[0-9]\\) +"                             ; day of month
-     "\\([0-2][0-9]:[0-5][0-9]\\(:[0-6][0-9]\\)?\\) *" ; time of day
+     "\\([^\0-\r \^?]+\\) +"           ; day of the week
+     "\\([^\0-\r \^?]+\\) +"           ; month
+     "\\([0-3]?[0-9]\\) +"             ; day of month
+     "\\([0-2][0-9]:[0-5][0-9]\\(:[0-6][0-9]\\)?\\) *" ; time of day
 
      ;; Perhaps a time zone, specified by an abbreviation, or by a
      ;; numeric offset.
@@ -1461,10 +1461,10 @@ The cdr of ech entry is a function for applying the face to a region.")
       (unless (string-match "^\\([^:]+\\):[ \t]*[^ \t]" (car headers))
        (error "Invalid header `%s'" (car headers)))
       (setq hclean (match-string 1 (car headers)))
-    (save-restriction
-      (message-narrow-to-headers)
-      (unless (re-search-forward (concat "^" (regexp-quote hclean) ":") nil t)
-       (insert (car headers) ?\n))))
+      (save-restriction
+       (message-narrow-to-headers)
+       (unless (re-search-forward (concat "^" (regexp-quote hclean) ":") nil t)
+         (insert (car headers) ?\n))))
     (setq headers (cdr headers))))
 
 
@@ -2120,8 +2120,8 @@ text was killed."
     ;; We build the table, if necessary.
     (when (or (not message-caesar-translation-table)
              (/= (aref message-caesar-translation-table ?a) (+ ?a n)))
-       (setq message-caesar-translation-table
-             (message-make-caesar-translation-table n)))
+      (setq message-caesar-translation-table
+           (message-make-caesar-translation-table n)))
     ;; Then we translate the region.  Do it this way to retain
     ;; text properties.
     (while (< b e)
@@ -2168,9 +2168,9 @@ Mail and USENET news headers are not rotated."
         (narrow-to-region (point) (point-max)))
       (let ((body (buffer-substring (point-min) (point-max))))
         (unless (equal 0 (call-process-region
-                           (point-min) (point-max) program t t))
-            (insert body)
-            (message "%s failed" program))))))
+                         (point-min) (point-max) program t t))
+         (insert body)
+         (message "%s failed" program))))))
 
 (defun message-rename-buffer (&optional enter-string)
   "Rename the *message* buffer to \"*message* RECIPIENT\".
@@ -2571,10 +2571,12 @@ The text will also be indented the normal way."
 
 (defun message-send (&optional arg)
   "Send the message in the current buffer.
-If `message-interactive' is non-nil, wait for success indication
-or error messages, and inform user.
-Otherwise any failure is reported in a message back to
-the user from the mailer."
+If `message-interactive' is non-nil, wait for success indication or
+error messages, and inform user.
+Otherwise any failure is reported in a message back to the user from
+the mailer.
+The usage of ARG is defined by the instance that called Message.
+It should typically alter the sending method in some way or other."
   (interactive "P")
   ;; Disabled test.
   (when (or (buffer-modified-p)
@@ -2727,10 +2729,11 @@ This sub function is for exclusive use of `message-send-mail'."
 
 (defun message-send-mail (&optional arg)
   (require 'mail-utils)
-  (let ((tembuf (message-generate-new-buffer-clone-locals " message temp"))
-       (case-fold-search nil)
-       (news (message-news-p))
-       failure)
+  (let* ((tembuf (message-generate-new-buffer-clone-locals " message temp"))
+        (case-fold-search nil)
+        (news (message-news-p))
+        (message-this-is-mail t)
+        failure)
     (save-restriction
       (message-narrow-to-headers)
       ;; Insert some headers.
@@ -2814,10 +2817,7 @@ This sub function is for exclusive use of `message-send-mail'."
                      ;; But some systems are more broken with -f, so
                      ;; we'll let users override this.
                      (if (null message-sendmail-f-is-evil)
-                         (list "-f"
-                               (if (null user-mail-address)
-                                   (user-login-name)
-                                 user-mail-address)))
+                         (list "-f" (message-make-address)))
                      ;; These mean "report errors by mail"
                      ;; and "deliver in background".
                      (if (null message-interactive) '("-oem" "-odb"))
@@ -2963,17 +2963,18 @@ This sub function is for exclusive use of `message-send-news'."
      (not (funcall message-send-news-function method)))))
 
 (defun message-send-news (&optional arg)
-  (let ((tembuf (message-generate-new-buffer-clone-locals " *message temp*"))
-       (case-fold-search nil)
-       (method (if (message-functionp message-post-method)
-                   (funcall message-post-method arg)
-                 message-post-method))
-       (message-syntax-checks
-        (if arg
-            (cons '(existing-newsgroups . disabled)
-                  message-syntax-checks)
-          message-syntax-checks))
-       result)
+  (let* ((tembuf (message-generate-new-buffer-clone-locals " *message temp*"))
+        (case-fold-search nil)
+        (method (if (message-functionp message-post-method)
+                    (funcall message-post-method arg)
+                  message-post-method))
+        (message-syntax-checks
+         (if arg
+             (cons '(existing-newsgroups . disabled)
+                   message-syntax-checks)
+           message-syntax-checks))
+        (message-this-is-news t)
+        result)
     (save-restriction
       (message-narrow-to-headers)
       ;; Insert some headers.
@@ -3541,9 +3542,9 @@ If NOW, use that time instead."
   "Make an Organization header."
   (let* ((organization
          (when message-user-organization
-               (if (message-functionp message-user-organization)
-                   (funcall message-user-organization)
-                 message-user-organization))))
+           (if (message-functionp message-user-organization)
+               (funcall message-user-organization)
+             message-user-organization))))
     (save-excursion
       (message-set-work-buffer)
       (cond ((stringp organization)
@@ -4592,7 +4593,7 @@ that further discussion should take place only in "
   (when (yes-or-no-p "Do you really want to cancel this article? ")
     (let (from newsgroups message-id distribution buf sender)
       (save-excursion
-       ;; Get header info. from original article.
+       ;; Get header info from original article.
        (save-restriction
          (message-narrow-to-head)
          (setq from (message-fetch-field "from")
@@ -5191,8 +5192,7 @@ regexp varstr."
 (defun message-encode-message-body ()
   (unless message-inhibit-body-encoding
     (let ((mail-parse-charset (or mail-parse-charset
-                                 message-default-charset
-                                 message-posting-charset))
+                                 message-default-charset))
          (case-fold-search t)
          lines content-type-p)
       (message-goto-body)
@@ -5263,4 +5263,8 @@ regexp varstr."
 
 (run-hooks 'message-load-hook)
 
+;; Local Variables:
+;; coding: iso-8859-1
+;; End:
+
 ;;; message.el ends here
index c9f0f7d..9ffbd89 100644 (file)
@@ -72,7 +72,7 @@ If a form, the result from the form will be used instead.")
 
 ;; Deleted the autoload cookie because this crashes in loaddefs.el.
 (defvar message-signature-file mail-signature-file
-  "*File containing the text inserted at end of message. buffer.")
+  "*File containing the text inserted at end of the message buffer.")
 
 (defvar message-default-headers mail-default-headers
   "*A string containing header lines to be inserted in outgoing messages.
index 64bcac3..0901615 100644 (file)
@@ -36,7 +36,7 @@
 
 ;; 8bit treatment gets any char except: 0x32 - 0x7f, CR, LF, TAB, BEL,
 ;; BS, vertical TAB, form feed, and ^_
-(defvar mm-8bit-char-regexp "[^\x20-\x7f\r\n\t\x7\x8\xb\xc\x1f]")
+(defvar mm-7bit-chars "\x20-\x7f\r\n\t\x7\x8\xb\xc\x1f")
 
 (defvar mm-body-charset-encoding-alist nil
   "Alist of MIME charsets to encodings.
@@ -80,7 +80,7 @@ If no encoding was done, nil is returned."
                      (not (mm-coding-system-equal
                            charset buffer-file-coding-system)))
              (while (not (eobp))
-               (if (eq (char-charset (char-after)) 'ascii)
+               (if (eq (mm-charset-after) 'ascii)
                    (when start
                      (save-restriction
                        (narrow-to-region start (point))
@@ -101,12 +101,17 @@ If no encoding was done, nil is returned."
     (cond
      ((eq bits '7bit)
       bits)
-     ((eq charset mail-parse-charset)
+     ((and (not mm-use-ultra-safe-encoding)
+          (or (eq t (cdr message-posting-charset))
+              (memq charset (cdr message-posting-charset))
+              (eq charset mail-parse-charset)))
       bits)
      (t
       (let ((encoding (or encoding
                          (cdr (assq charset mm-body-charset-encoding-alist))
                          (mm-qp-or-base64))))
+       (when mm-use-ultra-safe-encoding
+         (setq encoding (mm-safer-encoding encoding)))
        (mm-encode-content-transfer-encoding encoding "text/plain")
        encoding)))))
 
@@ -116,9 +121,10 @@ If no encoding was done, nil is returned."
    ((not (featurep 'mule))
     (if (save-excursion
          (goto-char (point-min))
-         (re-search-forward mm-8bit-char-regexp nil t))
-       '8bit
-      '7bit))
+         (skip-chars-forward mm-7bit-chars)
+         (eobp))
+       '7bit
+      '8bit))
    (t
     ;; Mule version
     (if (and (null (delq 'ascii
@@ -128,7 +134,7 @@ If no encoding was done, nil is returned."
             ;;!!!Emacs 20.3.  Sometimes.
             (save-excursion
               (goto-char (point-min))
-              (skip-chars-forward "\0-\177")
+              (skip-chars-forward mm-7bit-chars)
               (eobp)))
        '7bit
       '8bit))))
@@ -154,8 +160,10 @@ If no encoding was done, nil is returned."
                                    (delete-region (point) (point-max))
                                    (point))))
           ((memq encoding '(7bit 8bit binary))
+           ;; Do nothing.
            )
           ((null encoding)
+           ;; Do nothing.
            )
           ((memq encoding '(x-uuencode x-uue))
            (funcall mm-uu-decode-function (point-min) (point-max)))
@@ -179,7 +187,7 @@ If no encoding was done, nil is returned."
   "Decode the current article that has been encoded with ENCODING.
 The characters in CHARSET should then be decoded."
   (if (stringp charset)
-    (setq charset (intern (downcase charset))))
+      (setq charset (intern (downcase charset))))
   (if (or (not charset) 
          (eq 'gnus-all mail-parse-ignored-charsets)
          (memq 'gnus-all mail-parse-ignored-charsets)
@@ -208,7 +216,7 @@ The characters in CHARSET should then be decoded."
 (defun mm-decode-string (string charset)
   "Decode STRING with CHARSET."
   (if (stringp charset)
-    (setq charset (intern (downcase charset))))
+      (setq charset (intern (downcase charset))))
   (if (or (not charset) 
          (eq 'gnus-all mail-parse-ignored-charsets)
          (memq 'gnus-all mail-parse-ignored-charsets)
@@ -216,12 +224,12 @@ The characters in CHARSET should then be decoded."
       (setq charset mail-parse-charset))
   (or
    (when (featurep 'mule)
-      (let ((mule-charset (mm-charset-to-coding-system charset)))
-       (if (and (not mule-charset)
-                (listp mail-parse-ignored-charsets)
-                (memq 'gnus-unknown mail-parse-ignored-charsets))
-           (setq mule-charset 
-                 (mm-charset-to-coding-system mail-parse-charset)))
+     (let ((mule-charset (mm-charset-to-coding-system charset)))
+       (if (and (not mule-charset)
+               (listp mail-parse-ignored-charsets)
+               (memq 'gnus-unknown mail-parse-ignored-charsets))
+          (setq mule-charset 
+                (mm-charset-to-coding-system mail-parse-charset)))
        (when (and charset mule-charset
                  (mm-multibyte-p)
                  (or (not (eq mule-charset 'ascii))
index 8fbef31..83f8ec4 100644 (file)
 (require 'gnus-mailcap)
 (require 'mm-bodies)
 
+(defgroup mime-display ()
+  "Display of MIME in mail and news articles."
+  :link '(custom-manual "(emacs-mime)Customization")
+  :group 'mail
+  :group 'news)
+
 ;;; Convenience macros.
 
 (defmacro mm-handle-buffer (handle)
@@ -64,7 +70,7 @@
   `(list ,buffer ,type ,encoding ,undisplayer
         ,disposition ,description ,cache ,id))
 
-(defvar mm-inline-media-tests
+(defcustom mm-inline-media-tests
   '(("image/jpeg"
      mm-inline-image
      (lambda (handle)
     ("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.")
+  "Alist of media types/tests saying whether types can be displayed inline."
+  :type '(repeat (list (string :tag "MIME type")
+                      (function :tag "Display function")
+                      (function :tag "Display test")))
+  :group 'mime-display)
 
-(defvar mm-inlined-types
+(defcustom mm-inlined-types
   '("image/.*" "text/.*" "message/delivery-status" "message/rfc822"
     "application/pgp-signature")
-  "List of media types that are to be displayed inline.")
+  "List of media types that are to be displayed inline."
+  :type '(repeat string)
+  :group 'mime-display)
   
-(defvar mm-automatic-display
+(defcustom mm-automatic-display
   '("text/plain" "text/enriched" "text/richtext" "text/html"
     "text/x-vcard" "image/.*" "message/delivery-status" "multipart/.*"
     "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.")
-
-(defvar mm-discouraged-alternatives nil
+  "A list of MIME types to be displayed automatically."
+  :type '(repeat string)
+  :group 'mime-display)
+
+(defcustom mm-attachment-override-types '("text/x-vcard")
+  "Types to have \"attachment\" ignored if they can be displayed inline."
+  :type '(repeat string)
+  :group 'mime-display)
+
+(defcustom mm-inline-override-types nil
+  "Types to be treated as attachments even if they can be displayed inline."
+  :type '(repeat string)
+  :group 'mime-display)
+
+(defcustom mm-automatic-external-display nil
+  "List of MIME type regexps that will be displayed externally automatically."
+  :type '(repeat string)
+  :group 'mime-display)
+
+(defcustom mm-discouraged-alternatives nil
   "List of MIME types that are discouraged when viewing multipart/alternative.
 Viewing agents are supposed to view the last possible part of a message,
 as that is supposed to be the richest.  However, users may prefer other
@@ -166,7 +183,9 @@ for instance, text/html parts are very unwanted, and text/richtech are
 somewhat unwanted, then the value of this variable should be set
 to:
 
- (\"text/html\" \"text/richtext\")")
+ (\"text/html\" \"text/richtext\")"
+  :type '(repeat string)
+  :group 'mime-display)
 
 (defvar mm-tmp-directory
   (cond ((fboundp 'temp-directory) (temp-directory))
@@ -174,8 +193,10 @@ to:
        ("/tmp/"))
   "Where mm will store its temporary files.")
 
-(defvar mm-inline-large-images nil
-  "If non-nil, then all images fit in the buffer.")
+(defcustom mm-inline-large-images nil
+  "If non-nil, then all images fit in the buffer."
+  :type 'boolean
+  :group 'mime-display)
 
 ;;; Internal variables.
 
@@ -249,13 +270,13 @@ to:
 (defun mm-dissect-multipart (ctl)
   (goto-char (point-min))
   (let* ((boundary (concat "\n--" (mail-content-type-get ctl 'boundary)))
-       (close-delimiter (concat (regexp-quote boundary) "--[ \t]*$"))
-       start parts
-       (end (save-excursion
-              (goto-char (point-max))
-              (if (re-search-backward close-delimiter nil t)
-                  (match-beginning 0)
-                (point-max)))))
+        (close-delimiter (concat (regexp-quote boundary) "--[ \t]*$"))
+        start parts
+        (end (save-excursion
+               (goto-char (point-max))
+               (if (re-search-backward close-delimiter nil t)
+                   (match-beginning 0)
+                 (point-max)))))
     (while (search-forward boundary end t)
       (goto-char (match-beginning 0))
       (when start
@@ -308,88 +329,107 @@ external if displayed external."
                  (mm-insert-inline handle (mm-get-part handle))
                  'inline)
              (mm-display-external
-              handle (or method 'mailcap-save-binary-file))
-             'external)))))))
+              handle (or method 'mailcap-save-binary-file)))))))))
 
 (defun mm-display-external (handle method)
   "Display HANDLE using METHOD."
-  (mm-with-unibyte-buffer
-    (if (functionp method)
-       (let ((cur (current-buffer)))
-         (if (eq method 'mailcap-save-binary-file)
-             (progn
-               (set-buffer (generate-new-buffer "*mm*"))
-               (setq method nil))
-           (mm-insert-part handle)
-           (let ((win (get-buffer-window cur t)))
-             (when win
-               (select-window win)))
-           (switch-to-buffer (generate-new-buffer "*mm*")))
-         (buffer-disable-undo)
-         (mm-set-buffer-file-coding-system mm-binary-coding-system)
-         (insert-buffer-substring cur)
+  (let ((outbuf (current-buffer)))
+    (mm-with-unibyte-buffer
+      (if (functionp method)
+         (let ((cur (current-buffer)))
+           (if (eq method 'mailcap-save-binary-file)
+               (progn
+                 (set-buffer (generate-new-buffer "*mm*"))
+                 (setq method nil))
+             (mm-insert-part handle)
+             (let ((win (get-buffer-window cur t)))
+               (when win
+                 (select-window win)))
+             (switch-to-buffer (generate-new-buffer "*mm*")))
+           (buffer-disable-undo)
+           (mm-set-buffer-file-coding-system mm-binary-coding-system)
+           (insert-buffer-substring cur)
+           (message "Viewing with %s" method)
+           (let ((mm (current-buffer))
+                 (non-viewer (assq 'non-viewer
+                                   (mailcap-mime-info
+                                    (mm-handle-media-type handle) t))))
+             (unwind-protect
+                 (if method
+                     (funcall method)
+                   (mm-save-part handle))
+               (when (and (not non-viewer)
+                          method)
+                 (mm-handle-set-undisplayer handle mm)))))
+       ;; The function is a string to be executed.
+       (mm-insert-part handle)
+       (let* ((dir (make-temp-name (expand-file-name "emm." mm-tmp-directory)))
+              (filename (mail-content-type-get
+                         (mm-handle-disposition handle) 'filename))
+              (mime-info (mailcap-mime-info
+                          (mm-handle-media-type handle) t))
+              (needsterm (or (assoc "needsterm" mime-info)
+                             (assoc "needsterminal" mime-info)))
+              (copiousoutput (assoc "copiousoutput" mime-info))
+              file buffer)
+         ;; We create a private sub-directory where we store our files.
+         (make-directory dir)
+         (set-file-modes dir 448)
+         (if filename
+             (setq file (expand-file-name (file-name-nondirectory filename)
+                                          dir))
+           (setq file (make-temp-name (expand-file-name "mm." dir))))
+         (let ((coding-system-for-write mm-binary-coding-system))
+           (write-region (point-min) (point-max) file nil 'nomesg))
          (message "Viewing with %s" method)
-         (let ((mm (current-buffer))
-               (non-viewer (assq 'non-viewer
-                                 (mailcap-mime-info
-                                  (mm-handle-media-type handle) t))))
-           (unwind-protect
-               (if method
-                   (funcall method)
-                 (mm-save-part handle))
-             (when (and (not non-viewer)
-                        method)
-               (mm-handle-set-undisplayer handle mm)))))
-      ;; The function is a string to be executed.
-      (mm-insert-part handle)
-      (let* ((dir (make-temp-name (expand-file-name "emm." mm-tmp-directory)))
-            (filename (mail-content-type-get
-                       (mm-handle-disposition handle) 'filename))
-            (mime-info (mailcap-mime-info
-                        (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)
-       (set-file-modes dir 448)
-       (if filename
-           (setq file (expand-file-name (file-name-nondirectory filename)
-                                        dir))
-         (setq file (make-temp-name (expand-file-name "mm." dir))))
-       (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
-                 (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*"
+         (cond (needsterm
+                (unwind-protect
+                    (start-process "*display*" nil
+                                   "xterm"
+                                   "-e" 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))
+                'external)
+               (copiousoutput
+                (with-current-buffer outbuf
+                  (forward-line 1)
+                  (mm-insert-inline
+                   handle
+                   (unwind-protect
+                       (progn
+                         (call-process shell-file-name nil
                                        (setq buffer 
                                              (generate-new-buffer "*mm*"))
-                                       shell-file-name
+                                       nil
                                        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))))))
-
+                         (if (buffer-live-p buffer)
+                             (save-excursion
+                               (set-buffer buffer)
+                               (buffer-string))))
+                     (progn
+                       (ignore-errors (delete-file file))
+                       (ignore-errors (delete-directory
+                                       (file-name-directory file)))
+                       (ignore-errors (kill-buffer buffer))))))
+                'inline)
+               (t
+                (unwind-protect
+                    (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))
+                'external)))))))
+  
 (defun mm-mailcap-command (method file type-list)
   (let ((ctl (cdr type-list))
        (beg 0)
@@ -418,6 +458,7 @@ external if displayed external."
       (while (setq handle (pop handles))
        (cond
         ((stringp handle)
+         ;; Do nothing.
          )
         ((and (listp handle)
               (stringp (car handle)))
@@ -434,6 +475,7 @@ external if displayed external."
       (while (setq handle (pop handles))
        (cond
         ((stringp handle)
+         ;; Do nothing.
          )
         ((and (listp handle)
               (stringp (car handle)))
@@ -637,6 +679,8 @@ external if displayed external."
          (mapcar (lambda (i) (list (cdr (assoc 'viewer i))))
                  (mailcap-mime-info type 'all)))
         (method (completing-read "Viewer: " methods)))
+    (when (string= method "")
+      (error "No method given"))
     (mm-display-external (copy-sequence handle) method)))
 
 (defun mm-preferred-alternative (handles &optional preferred)
index 766f1ea..5a87160 100644 (file)
 If the encoding is `qp-or-base64', then either quoted-printable
 or base64 will be used, depending on what is more efficient.")
 
+(defvar mm-use-ultra-safe-encoding nil
+  "If non-nil, use encodings aimed at Procrustean bed survival.
+
+This means that textual parts are encoded as quoted-printable if they
+contain lines longer than 76 characters or starting with \"From \" in
+the body.  Non-7bit encodings (8bit, binary) are generally disallowed.
+This is to reduce the probability that a broken MTA or MDA changes the
+message.
+
+This variable should never be set directly, but bound before a call to
+`mml-generate-mime' or similar functions.")
+
 (defun mm-insert-rfc822-headers (charset encoding)
   "Insert text/plain headers with CHARSET and ENCODING."
   (insert "MIME-Version: 1.0\n")
@@ -60,6 +72,14 @@ or base64 will be used, depending on what is more efficient.")
       "application/octet-stream"
     (mailcap-extension-to-mime (match-string 0 file))))
 
+(defun mm-safer-encoding (encoding)
+  "Return a safer but similar encoding."
+  (cond
+   ((memq encoding '(7bit 8bit quoted-printable)) 'quoted-printable)
+   ;; The remaing encodings are binary and base64 (and perhaps some
+   ;; non-standard ones), which are both turned into base64.
+   (t 'base64)))
+
 (defun mm-encode-content-transfer-encoding (encoding &optional type)
   (cond
    ((eq encoding 'quoted-printable)
@@ -75,8 +95,10 @@ or base64 will be used, depending on what is more efficient.")
        (message "Error while decoding: %s" error)
        nil)))
    ((memq encoding '(7bit 8bit binary))
+    ;; Do nothing.
     )
    ((null encoding)
+    ;; Do nothing.
     )
    ((functionp encoding)
     (ignore-errors (funcall encoding (point-min) (point-max))))
@@ -119,9 +141,13 @@ The encoding used is returned."
       (while rules
        (when (string-match (caar rules) type)
          (throw 'found
-                (if (eq (cadar rules) 'qp-or-base64)
-                    (mm-qp-or-base64)
-                  (cadar rules))))
+                (let ((encoding 
+                       (if (eq (cadar rules) 'qp-or-base64)
+                           (mm-qp-or-base64)
+                         (cadar rules))))
+                  (if mm-use-ultra-safe-encoding
+                      (mm-safer-encoding encoding)
+                    encoding))))
        (pop rules)))))
 
 (defun mm-qp-or-base64 ()
index 8006fec..bf94df4 100644 (file)
@@ -24,6 +24,8 @@
 
 ;;; Code:
 
+(require 'mail-prsvr)
+
 (defvar mm-mime-mule-charset-alist
   '((us-ascii ascii)
     (iso-8859-1 latin-iso8859-1)
@@ -65,7 +67,6 @@
                    chinese-cns11643-7))
   "Alist of MIME-charset/MULE-charsets.")
 
-
 (eval-and-compile
   (mapcar
    (lambda (elem)
@@ -208,6 +209,36 @@ used as the line break code type of the coding system."
   (or (get-charset-property charset 'prefered-coding-system)
       (get-charset-property charset 'preferred-coding-system)))
 
+(defun mm-charset-after (&optional pos)
+  "Return charset of a character in current buffer at position POS.
+If POS is nil, it defauls to the current point.
+If POS is out of range, the value is nil.
+If the charset is `composition', return the actual one."
+  (let ((charset (cond 
+                 ((fboundp 'charset-after)
+                  (charset-after pos))
+                 ((fboundp 'char-charset)
+                  (char-charset (char-after pos)))
+                 ((< (mm-char-int (char-after pos)) 128)
+                  'ascii)
+                 (mail-parse-mule-charset ;; cached mule-charset
+                  mail-parse-mule-charset)
+                 ((boundp 'current-language-environment)
+                  (let ((entry (assoc current-language-environment 
+                                      language-info-alist)))
+                    (setq mail-parse-mule-charset
+                          (or (car (last (assq 'charset entry)))
+                              'latin-iso8859-1))))
+                 (t                       ;; figure out the charset
+                  (setq mail-parse-mule-charset
+                        (or (car (last (assq mail-parse-charset
+                                             mm-mime-mule-charset-alist)))
+                            'latin-iso8859-1))))))
+    (if (eq charset 'composition)
+       (let ((p (or pos (point))))
+         (cadr (find-charset-region p (1+ p))))
+      charset)))
+
 (defun mm-mime-charset (charset)
   "Return the MIME charset corresponding to the MULE CHARSET."
   (if (fboundp 'coding-system-get)
@@ -223,18 +254,26 @@ used as the line break code type of the coding system."
     ;; This is for XEmacs.
     (mm-mule-charset-to-mime-charset charset)))
 
+(defun mm-delete-duplicates (list)
+  "Simple  substitute for CL `delete-duplicates', testing with `equal'."
+  (let (result head)
+    (while list
+      (setq head (car list))
+      (setq list (delete head list))
+      (setq result (cons head result)))
+    (nreverse result)))
+
 (defun mm-find-mime-charset-region (b e)
   "Return the MIME charsets needed to encode the region between B and E."
-  (let ((charsets
-        (mapcar 'mm-mime-charset
-                (delq 'ascii
-                      (mm-find-charset-region b e)))))
+  (let ((charsets (mapcar 'mm-mime-charset
+                         (delq 'ascii
+                               (mm-find-charset-region b e)))))
     (when (memq 'iso-2022-jp-2 charsets)
       (setq charsets (delq 'iso-2022-jp charsets)))
-    (delete-duplicates charsets)
+    (setq charsets (mm-delete-duplicates charsets))
     (if (and (> (length charsets) 1)
-            (fboundp 'find-coding-systems-for-charsets)
-            (memq 'utf-8 (find-coding-systems-for-charsets charsets)))
+            (fboundp 'find-coding-systems-region)
+            (memq 'utf-8 (find-coding-systems-region b e)))
        '(utf-8)
       charsets)))
 
@@ -289,12 +328,28 @@ See also `with-temp-file' and `with-output-to-string'."
 (put 'mm-with-unibyte-current-buffer 'lisp-indent-function 0)
 (put 'mm-with-unibyte-current-buffer 'edebug-form-spec '(body))
 
+(defmacro mm-with-unibyte (&rest forms)
+  "Set default `enable-multibyte-characters' to `nil', eval the FORMS."
+  (let ((multibyte (make-symbol "multibyte")))
+    `(if (or (string-match "XEmacs\\|Lucid" emacs-version)
+            (not (boundp 'enable-multibyte-characters)))
+        (progn ,@forms)
+       (let ((,multibyte (default-value 'enable-multibyte-characters)))
+        (unwind-protect
+            (progn
+              (setq-default enable-multibyte-characters nil)
+              ,@forms)
+          (setq-default enable-multibyte-characters ,multibyte))))))
+(put 'mm-with-unibyte 'lisp-indent-function 0)
+(put 'mm-with-unibyte 'edebug-form-spec '(body))
+
 (defun mm-find-charset-region (b e)
   "Return a list of charsets in the region."
   (cond
    ((and (mm-multibyte-p)
         (fboundp 'find-charset-region))
-    (find-charset-region b e))
+    ;; Remove composition since the base charsets have been included.
+    (delq 'composition (find-charset-region b e)))
    ((not (boundp 'current-language-environment))
     (save-excursion
       (save-restriction
@@ -303,19 +358,24 @@ See also `with-temp-file' and `with-output-to-string'."
        (skip-chars-forward "\0-\177")
        (if (eobp)
            '(ascii)
-         (delq nil (list 'ascii mail-parse-charset))))))
+         (delq nil (list 'ascii 
+                         (or (car (last (assq mail-parse-charset
+                                              mm-mime-mule-charset-alist)))
+                             'latin-iso8859-1)))))))
    (t
     ;; We are in a unibyte buffer, so we futz around a bit.
     (save-excursion
       (save-restriction
        (narrow-to-region b e)
        (goto-char (point-min))
-       (let ((entry (assoc (capitalize current-language-environment)
+       (let ((entry (assoc current-language-environment 
                            language-info-alist)))
          (skip-chars-forward "\0-\177")
          (if (eobp)
              '(ascii)
-           (list 'ascii (car (last (assq 'charset entry)))))))))))
+           (delq nil (list 'ascii 
+                           (or (car (last (assq 'charset entry)))
+                               'latin-iso8859-1))))))))))
 
 (defun mm-read-charset (prompt)
   "Return a charset."
index 4f66013..d5bbaac 100644 (file)
@@ -1,10 +1,10 @@
 ;;; mm-uu.el -- Return uu stuffs as mm handles
-;; Copyright (c) 1998,99 by Shenghuo Zhu
+;; Copyright (c) 1998,99 Free Software Foundation, Inc.
 
 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
-;; Keywords: postscript uudecode binhex shar forward
+;; Keywords: postscript uudecode binhex shar forward news
 
-;; This file is part of pgnus.
+;; This file is part of GNU Emacs.
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
@@ -155,7 +155,7 @@ To disable dissecting shar codes, for instance, add
                       (let ((nnheader-file-name-translation-alist
                              '((?/ . ?,) (? . ?_) (?* . ?_) (?$ . ?_))))
                         (nnheader-translate-file-chars (match-string 1))))))
-       (forward-line) ;; in case of failure
+       (forward-line);; in case of failure
        (setq start-char-1 (point))
        (setq end-line (symbol-value
                        (intern (concat "mm-uu-" (symbol-name type)
@@ -172,48 +172,48 @@ To disable dissecting shar codes, for instance, add
            (if (> start-char text-start)
                (push
                 (mm-make-handle (mm-uu-copy-to-buffer text-start start-char)
-                      text-plain-type)
+                                text-plain-type)
                 result))
            (push
             (cond
              ((eq type 'postscript)
               (mm-make-handle (mm-uu-copy-to-buffer start-char end-char)
-                    '("application/postscript")))
+                              '("application/postscript")))
              ((eq type 'forward)
               (mm-make-handle (mm-uu-copy-to-buffer start-char-1 end-char-1)
                               '("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
-                                   (string-match "\\.[^\\.]+$" file-name)
-                                   (mailcap-extension-to-mime
-                                    (match-string 0 file-name)))
-                              "application/octet-stream"))
-                    'x-uuencode nil
-                    (if (and file-name (not (equal file-name "")))
-                        (list mm-dissect-disposition
-                              (cons 'filename file-name)))))
+                              (list (or (and file-name
+                                             (string-match "\\.[^\\.]+$" file-name)
+                                             (mailcap-extension-to-mime
+                                              (match-string 0 file-name)))
+                                        "application/octet-stream"))
+                              'x-uuencode nil
+                              (if (and file-name (not (equal file-name "")))
+                                  (list mm-dissect-disposition
+                                        (cons 'filename file-name)))))
              ((eq type 'binhex)
               (mm-make-handle (mm-uu-copy-to-buffer start-char end-char)
-                    (list (or (and file-name
-                                   (string-match "\\.[^\\.]+$" file-name)
-                                   (mailcap-extension-to-mime
-                                    (match-string 0 file-name)))
-                              "application/octet-stream"))
-                    'x-binhex nil
-                    (if (and file-name (not (equal file-name "")))
-                        (list mm-dissect-disposition
-                              (cons 'filename file-name)))))
+                              (list (or (and file-name
+                                             (string-match "\\.[^\\.]+$" file-name)
+                                             (mailcap-extension-to-mime
+                                              (match-string 0 file-name)))
+                                        "application/octet-stream"))
+                              'x-binhex nil
+                              (if (and file-name (not (equal file-name "")))
+                                  (list mm-dissect-disposition
+                                        (cons 'filename file-name)))))
              ((eq type 'shar)
               (mm-make-handle (mm-uu-copy-to-buffer start-char end-char)
-                    '("application/x-shar"))))
+                              '("application/x-shar"))))
             result)
            (setq text-start end-char))))
       (when result
        (if (> (point-max) (1+ text-start))
            (push
             (mm-make-handle (mm-uu-copy-to-buffer text-start (point-max))
-                  text-plain-type)
+                            text-plain-type)
             result))
        (setq result (cons "multipart/mixed" (nreverse result))))
       result)))
index f076c2e..6076bb5 100644 (file)
@@ -23,6 +23,7 @@
 
 ;;; Code:
 
+(eval-when-compile (require 'cl))
 (require 'mail-parse)
 (require 'mailcap)
 (require 'mm-bodies)
             `(lambda ()
                (let (buffer-read-only)
                  (if (functionp 'remove-specifier)
-                     (mapc (lambda (prop)
-                             (remove-specifier
-                              (face-property 'default prop) (current-buffer)))
-                           '(background background-pixmap foreground)))
+                     (mapcar (lambda (prop)
+                               (remove-specifier
+                                (face-property 'default prop)
+                                (current-buffer)))
+                             '(background background-pixmap foreground)))
                  (delete-region ,(point-min-marker)
                                 ,(point-max-marker)))))))))
      ((or (equal type "enriched")
   (mm-enable-multibyte)
   (let (handles)
     (let (gnus-article-mime-handles)
-      ;; Double decode problem may happen. See mm-inline-message.
+      ;; 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))
         handle
         `(lambda ()
            (let (buffer-read-only)
-             (ignore-errors
-               ;; This is only valid on XEmacs.
-               (mapc (lambda (prop)
-                       (remove-specifier
-                        (face-property 'default prop) (current-buffer)))
-                     '(background background-pixmap foreground)))
+             (condition-case nil
+                 ;; This is only valid on XEmacs.
+                 (mapcar (lambda (prop)
+                           (remove-specifier
+                            (face-property 'default prop) (current-buffer)))
+                         '(background background-pixmap foreground))
+               (error nil))
              (delete-region ,(point-min-marker) ,(point-max-marker)))))))))
 
 (defun mm-display-patch-inline (handle)
index 9203465..320f6aa 100644 (file)
@@ -32,8 +32,7 @@
   (autoload 'message-make-message-id "message"))
 
 (defvar mml-generate-multipart-alist
-  '(("signed" . rfc2015-generate-signed-multipart)
-    ("encrypted" . rfc2015-generate-encrypted-multipart))
+  nil
   "*Alist of multipart generation functions.
 
 Each entry has the form (NAME . FUNCTION), where
@@ -64,6 +63,13 @@ 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.")
 
+(defvar mml-confirmation-set nil
+  "A list of symbols, each of which disables some warning.
+`unknown-encoding': always send messages contain characters with
+unknown encoding; `use-ascii': always use ASCII for those characters
+with unknown encoding; `multipart': always send messages with more than
+one charsets.")
+
 (defun mml-parse ()
   "Parse the current buffer as an MML document."
   (goto-char (point-min))
@@ -76,7 +82,7 @@ called for this message.")
 
 (defun mml-parse-1 ()
   "Parse the current buffer as an MML document."
-  (let (struct tag point contents charsets warn)
+  (let (struct tag point contents charsets warn use-ascii)
     (while (and (not (eobp))
                (not (looking-at "<#/multipart")))
       (cond
@@ -93,12 +99,23 @@ called for this message.")
        (setq point (point)
              contents (mml-read-part)
              charsets (mm-find-mime-charset-region point (point)))
+       (when (memq nil charsets)
+         (if (or (memq 'unknown-encoding mml-confirmation-set)
+                 (y-or-n-p
+                  "Warning: You message contains characters with unknown encoding. Really send?"))
+             (if (setq use-ascii 
+                       (or (memq 'use-ascii mml-confirmation-set)
+                           (y-or-n-p "Use ASCII as charset?")))
+                 (setq charsets (delq nil charsets))
+               (setq warn nil))
+           (error "Edit your message to remove those characters")))
        (if (< (length charsets) 2)
            (push (nconc tag (list (cons 'contents contents)))
                  struct)
          (let ((nstruct (mml-parse-singlepart-with-multiple-charsets
-                         tag point (point))))
+                         tag point (point) use-ascii)))
            (when (and warn
+                      (not (memq 'multipart mml-confirmation-set))
                       (not
                        (y-or-n-p
                         (format
@@ -110,17 +127,20 @@ called for this message.")
       (forward-line 1))
     (nreverse struct)))
 
-(defun mml-parse-singlepart-with-multiple-charsets (orig-tag beg end)
+(defun mml-parse-singlepart-with-multiple-charsets 
+  (orig-tag beg end &optional use-ascii)
   (save-excursion
     (narrow-to-region beg end)
     (goto-char (point-min))
-    (let ((current (mm-mime-charset (char-charset (following-char))))
+    (let ((current (or (mm-mime-charset (mm-charset-after))
+                      (and use-ascii 'us-ascii)))
          charset struct space newline paragraph)
       (while (not (eobp))
        (cond
         ;; The charset remains the same.
-        ((or (eq (setq charset (mm-mime-charset
-                                (char-charset (following-char)))) 'us-ascii)
+        ((or (eq (setq charset (mm-mime-charset (mm-charset-after))) 
+                 'us-ascii)
+             (and use-ascii (not charset))
              (eq charset current)))
         ;; The initial charset was ascii.
         ((eq current 'us-ascii)
@@ -596,7 +616,7 @@ called for this message.")
                  (format "Content type (default %s): " default)
                  (mapcar
                   'list
-                  (delete-duplicates
+                  (mm-delete-duplicates
                    (nconc
                     (mapcar (lambda (m) (cdr m))
                             mailcap-mime-extensions)
@@ -613,8 +633,7 @@ called for this message.")
                                        nil
                                      type)))
                                (cdr l))))
-                      mailcap-mime-data)))
-                   :test 'equal)))))
+                      mailcap-mime-data))))))))
     (if (not (equal string ""))
        string
       default)))
@@ -706,35 +725,41 @@ TYPE is the MIME type to use."
 
 (defun mml-insert-multipart (&optional type)
   (interactive (list (completing-read "Multipart type (default mixed): "
-                    '(("mixed") ("alternative") ("digest") ("parallel")
-                      ("signed") ("encrypted"))
-                    nil nil "mixed")))
+                                     '(("mixed") ("alternative") ("digest") ("parallel")
+                                       ("signed") ("encrypted"))
+                                     nil nil "mixed")))
   (or type
       (setq type "mixed"))
   (mml-insert-empty-tag "multipart" 'type type)
   (forward-line -1))
 
+(defun mml-insert-part (&optional type)
+  (interactive
+   (list (mml-minibuffer-read-type "")))
+  (mml-insert-tag 'part 'type type 'disposition "inline")
+  (forward-line -1))
+
 (defun mml-preview (&optional raw)
- "Display current buffer with Gnus, in a new buffer.
+  "Display current buffer with Gnus, in a new buffer.
 If RAW, don't highlight the article."
- (interactive "P")
- (let ((buf (current-buffer)))
-   (switch-to-buffer (get-buffer-create 
-                     (concat (if raw "*Raw MIME preview of "
-                               "*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)
-     (let ((gnus-newsgroup-name "dummy"))
-      (gnus-article-prepare-display)))
-   (fundamental-mode)
-   (setq buffer-read-only t)
-   (goto-char (point-min))))
+  (interactive "P")
+  (let ((buf (current-buffer)))
+    (switch-to-buffer (get-buffer-create 
+                      (concat (if raw "*Raw MIME preview of "
+                                "*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)
+      (let ((gnus-newsgroup-name "dummy"))
+       (gnus-article-prepare-display)))
+    (fundamental-mode)
+    (setq buffer-read-only t)
+    (goto-char (point-min))))
 
 (defun mml-validate ()
   "Validate the current MML document."
index ed62850..d551c9e 100644 (file)
 
 (nnoo-define-basics nnagent)
 
+(defun nnagent-server (server)
+  (and server (format "%s+%s" (car gnus-command-method) server)))
+
 (deffoo nnagent-open-server (server &optional defs)
   (setq defs
        `((nnagent-directory ,(gnus-agent-directory))
          (nnagent-active-file ,(gnus-agent-lib-file "active"))
          (nnagent-newsgroups-file ,(gnus-agent-lib-file "newsgroups"))
          (nnagent-get-new-mail nil)))
-  (nnoo-change-server 'nnagent server defs)
+  (nnoo-change-server 'nnagent 
+                     (nnagent-server server)
+                     defs)
   (let ((dir (gnus-agent-directory))
        err)
     (cond
     (append-to-file (point-min) (point-max) (gnus-agent-lib-file "flags")))
   nil)
 
+(deffoo nnagent-request-group (group &optional server dont-check)
+  (nnoo-parent-function 'nnagent 'nnml-request-group
+                   (list group (nnagent-server server) dont-check)))
+
+(deffoo nnagent-close-group (group &optional server)
+  (nnoo-parent-function 'nnagent 'nnml-close-group
+                   (list group (nnagent-server server))))
+
+(deffoo nnagent-request-accept-article (group &optional server last)
+  (nnoo-parent-function 'nnagent 'nnml-request-accept-article
+                   (list group (nnagent-server server) last)))
+
+(deffoo nnagent-request-article (id &optional group server buffer)
+  (nnoo-parent-function 'nnagent 'nnml-request-article
+                   (list id group (nnagent-server server) buffer)))
+
+(deffoo nnagent-request-create-group (group &optional server args)
+  (nnoo-parent-function 'nnagent 'nnml-request-create-group
+                   (list group (nnagent-server server) args)))
+
+(deffoo nnagent-request-delete-group (group &optional force server)
+  (nnoo-parent-function 'nnagent 'nnml-request-delete-group
+                   (list group force (nnagent-server server))))
+
+(deffoo nnagent-request-expire-articles (articles group &optional server force)
+  (nnoo-parent-function 'nnagent 'nnml-request-expire-articles
+                   (list articles group (nnagent-server server) force)))
+
+(deffoo nnagent-request-list (&optional server)
+  (nnoo-parent-function 'nnagent 'nnml-request-list 
+                   (list (nnagent-server server))))
+
+(deffoo nnagent-request-list-newsgroups (&optional server)
+  (nnoo-parent-function 'nnagent 'nnml-request-list-newsgroups 
+                   (list (nnagent-server server))))
+
+(deffoo nnagent-request-move-article 
+    (article group server accept-form &optional last)
+  (nnoo-parent-function 'nnagent 'nnml-request-move-article 
+                   (list article group (nnagent-server server) 
+                         accept-form last)))
+
+(deffoo nnagent-request-rename-group (group new-name &optional server)
+  (nnoo-parent-function 'nnagent 'nnml-request-rename-group 
+                   (list group new-name (nnagent-server server))))
+
+(deffoo nnagent-request-scan (&optional group server)
+  (nnoo-parent-function 'nnagent 'nnml-request-scan 
+                   (list group (nnagent-server server))))
+
+(deffoo nnagent-retrieve-headers (sequence &optional group server fetch-old)
+  (nnoo-parent-function 'nnagent 'nnml-retrieve-headers 
+                   (list sequence group (nnagent-server server) fetch-old)))
+
+(deffoo nnagent-set-status (article name value &optional group server)
+  (nnoo-parent-function 'nnagent 'nnml-set-status 
+                   (list article name value group (nnagent-server server))))
+
+(deffoo nnagent-server-opened (&optional server)
+  (nnoo-parent-function 'nnagent 'nnml-server-opened
+                       (list (nnagent-server server))))
+
+(deffoo nnagent-status-message (&optional server)
+  (nnoo-parent-function 'nnagent 'nnml-status-message
+                       (list (nnagent-server server))))
+
 ;; Use nnml functions for just about everything.
 (nnoo-import nnagent
   (nnml))
index 3d5c5b9..0b6d87b 100644 (file)
@@ -30,6 +30,7 @@
 ;;; Code:
 
 (eval-when-compile (require 'cl))
+
 (require 'nnheader)
 (condition-case nil
     (require 'rmail)
   (nnheader-report 'nnbabyl "nnbabyl: LIST NEWSGROUPS is not implemented."))
 
 (deffoo nnbabyl-request-expire-articles
-  (articles newsgroup &optional server force)
+    (articles newsgroup &optional server force)
   (nnbabyl-possibly-change-newsgroup newsgroup server)
   (let* ((is-old t)
         rest)
       (nconc rest articles))))
 
 (deffoo nnbabyl-request-move-article
-  (article group server accept-form &optional last)
+    (article group server accept-form &optional last)
   (let ((buf (get-buffer-create " *nnbabyl move*"))
        result)
     (and
       (widen)
       (narrow-to-region
        (save-excursion
-       (unless (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t)
-         (goto-char (point-min))
-         (end-of-line))
+        (unless (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t)
+          (goto-char (point-min))
+          (end-of-line))
         (if leave-delim (progn (forward-line 1) (point))
           (match-beginning 0)))
        (progn
   (nnbabyl-create-mbox)
 
   (unless (and nnbabyl-mbox-buffer
-          (buffer-name nnbabyl-mbox-buffer)
-          (save-excursion
-            (set-buffer nnbabyl-mbox-buffer)
-            (= (buffer-size) (nnheader-file-size nnbabyl-mbox-file))))
+              (buffer-name nnbabyl-mbox-buffer)
+              (save-excursion
+                (set-buffer nnbabyl-mbox-buffer)
+                (= (buffer-size) (nnheader-file-size nnbabyl-mbox-file))))
     ;; This buffer has changed since we read it last.  Possibly.
     (save-excursion
       (let ((delim (concat "^" nnbabyl-mail-delimiter))
index 8b71f5d..4868f01 100644 (file)
@@ -77,7 +77,7 @@
   "*The program used to put a message in an NNDB group.")
 
 (defvoo nndb-server-side-expiry nil
-  "If t, expiry calculation will occur on the server side")
+  "If t, expiry calculation will occur on the server side.")
 
 (defvoo nndb-set-expire-date-on-mark nil
   "If t, the expiry date for a given article will be set to the time
@@ -146,7 +146,7 @@ article was posted to nndb")
   (nntp-send-command nil "X-TOUCH" article))
 
 (deffoo nndb-request-update-mark
-  (group article mark)
+    (group article mark)
   "Sets the expiry date for ARTICLE in GROUP to now, if the mark is 'E'"
   (if (and nndb-set-expire-date-on-mark (string-equal mark "E"))
       (nndb-touch-article group article))
@@ -293,8 +293,7 @@ Optional LAST is ignored."
     (list art)))
 
 (deffoo nndb-request-replace-article (article group buffer)
-  "ARTICLE is the number of the article in GROUP to be replaced
-with the contents of the BUFFER."
+  "ARTICLE is the number of the article in GROUP to be replaced with the contents of the BUFFER."
   (set-buffer buffer)
   (when (nntp-send-command "^[23].*\r?\n" "X-REPLACE" (int-to-string article))
     (nnheader-insert "")
index 9758f61..8a1dea3 100644 (file)
@@ -27,6 +27,7 @@
 ;;; Code:
 
 (eval-when-compile (require 'cl))
+
 (require 'nnheader)
 (require 'message)
 (require 'nnmail)
@@ -292,7 +293,6 @@ from the document.")
       (setq nndoc-dissection-alist nil)
       (save-excursion
        (set-buffer nndoc-current-buffer)
-       (mm-enable-multibyte)
        (erase-buffer)
        (if (stringp nndoc-address)
            (nnheader-insert-file-contents nndoc-address)
@@ -557,10 +557,7 @@ from the document.")
 (defun nndoc-transform-lanl-gov-announce (article)
   (goto-char (point-max))
   (when (re-search-backward "^\\\\\\\\ +(\\([^ ]*\\) , *\\([^ ]*\\))" nil t)
-    (replace-match "\n\nGet it at \\1 (\\2)" t nil))
-  ;;  (when (re-search-backward "^\\\\\\\\$" nil t)
-  ;;    (replace-match "" t t))
-  )
+    (replace-match "\n\nGet it at \\1 (\\2)" t nil)))
 
 (defun nndoc-generate-lanl-gov-head (article)
   (let ((entry (cdr (assq article nndoc-dissection-alist)))
@@ -578,8 +575,7 @@ from the document.")
          (when (re-search-forward "^Title: \\([^\f]*\\)\nAuthors?: \\(.*\\)"
                                   nil t)
            (setq subject (concat (match-string 1) subject))
-           (setq from (concat (match-string 2) " <" e-mail ">"))))
-       ))
+           (setq from (concat (match-string 2) " <" e-mail ">"))))))
     (while (and from (string-match "(\[^)\]*)" from))
       (setq from (replace-match "" t t from)))
     (insert "From: "  (or from "unknown")
index 0e765fc..487ffc1 100644 (file)
@@ -26,6 +26,7 @@
 ;;; Code:
 
 (eval-when-compile (require 'cl))
+
 (require 'nnheader)
 (require 'nnmail)
 (require 'gnus-start)
    info
    (gnus-update-read-articles (gnus-group-prefixed-name group '(nndraft ""))
                              (nndraft-articles) t))
-  (let (marks)
-    (when (setq marks (nth 3 info))
+  (let ((marks (nth 3 info)))
+    (when marks
+      ;; Nix out all marks except the `unsend'-able article marks.
       (setcar (nthcdr 3 info)
              (if (assq 'unsend marks)
                  (list (assq 'unsend marks))
   (nndraft-possibly-change-group group)
   (let ((gnus-verbose-backends nil)
        (buf (current-buffer))
-        article file)
+       article file)
     (with-temp-buffer
       (insert-buffer-substring buf)
       (setq article (nndraft-request-accept-article
index 3caee7b..fdf72e3 100644 (file)
@@ -27,6 +27,7 @@
 ;;; Code:
 
 (eval-when-compile (require 'cl))
+
 (require 'nnheader)
 (require 'nnmail)
 (require 'nnoo)
@@ -106,7 +107,7 @@ included.")
          (and large
               (zerop (% count 20))
               (nnheader-message 5 "nneething: Receiving headers... %d%%"
-                       (/ (* count 100) number))))
+                                (/ (* count 100) number))))
 
        (when large
          (nnheader-message 5 "nneething: Receiving headers...done"))
@@ -294,8 +295,7 @@ included.")
           (concat "Lines: " (int-to-string
                              (count-lines (point-min) (point-max)))
                   "\n"))
-       "")
-     )))
+       ""))))
 
 (defun nneething-from-line (uid &optional file)
   "Return a From header based of UID."
index c942f6f..9c4b5b3 100644 (file)
   "The name of the nnfolder directory.")
 
 (defvoo nnfolder-active-file
-  (nnheader-concat nnfolder-directory "active")
+    (nnheader-concat nnfolder-directory "active")
   "The name of the active file.")
 
 ;; I renamed this variable to something more in keeping with the general GNU
 ;; style. -SLB
 
 (defvoo nnfolder-ignore-active-file nil
-  "If non-nil, causes nnfolder to do some extra work in order to determine
-the true active ranges of an mbox file.  Note that the active file is still
-saved, but it's values are not used.  This costs some extra time when
-scanning an mbox when opening it.")
+  "If non-nil, the active file is ignores.
+This causes nnfolder to do some extra work in order to determine the
+true active ranges of an mbox file.  Note that the active file is
+still saved, but it's values are not used.  This costs some extra time
+when scanning an mbox when opening it.")
 
 (defvoo nnfolder-distrust-mbox nil
-  "If non-nil, causes nnfolder to not trust the user with respect to
-inserting unaccounted for mail in the middle of an mbox file.  This can greatly
-slow down scans, which now must scan the entire file for unmarked messages.
-When nil, scans occur forward from the last marked message, a huge
-time saver for large mailboxes.")
+  "If non-nil, the folder will be distrusted.
+This means that nnfolder will not trust the user with respect to
+inserting unaccounted for mail in the middle of an mbox file.  This
+can greatly slow down scans, which now must scan the entire file for
+unmarked messages.  When nil, scans occur forward from the last marked
+message, a huge time saver for large mailboxes.")
 
 (defvoo nnfolder-newsgroups-file
-  (concat (file-name-as-directory nnfolder-directory) "newsgroups")
+    (concat (file-name-as-directory nnfolder-directory) "newsgroups")
   "Mail newsgroups description file.")
 
 (defvoo nnfolder-get-new-mail t
@@ -320,7 +322,7 @@ If NIL, NNFOLDER-FILE-CODING-SYSTEM is used.")
        numbers))))
 
 (deffoo nnfolder-request-expire-articles
-  (articles newsgroup &optional server force)
+    (articles newsgroup &optional server force)
   (nnfolder-possibly-change-group newsgroup server)
   (let* ((is-old t)
         ;; The articles we have deleted so far.
@@ -343,12 +345,12 @@ If NIL, NNFOLDER-FILE-CODING-SYSTEM is used.")
                                   nil t))
          (forward-sexp)
          (when (setq is-old
-                   (nnmail-expired-article-p
-                    newsgroup
-                    (buffer-substring
-                     (point) (progn (end-of-line) (point)))
-                    force nnfolder-inhibit-expiry))
-               (nnheader-message 5 "Deleting article %d..."
+                     (nnmail-expired-article-p
+                      newsgroup
+                      (buffer-substring
+                       (point) (progn (end-of-line) (point)))
+                      force nnfolder-inhibit-expiry))
+           (nnheader-message 5 "Deleting article %d..."
                              (car maybe-expirable) newsgroup)
            (nnfolder-delete-mail)
            ;; Must remember which articles were actually deleted
index 24a31ae..c75bde2 100644 (file)
@@ -29,6 +29,7 @@
 ;;; Code:
 
 (eval-when-compile (require 'cl))
+
 (require 'mail-utils)
 (require 'mime)
 
@@ -46,13 +47,13 @@ on your system, you could say something like:
 \(setq nnheader-file-name-translation-alist '((?: . ?_)))")
 
 (eval-and-compile
- (autoload 'nnmail-message-id "nnmail")
- (autoload 'mail-position-on-field "sendmail")
- (autoload 'message-remove-header "message")
- (autoload 'cancel-function-timers "timers")
- (autoload 'gnus-point-at-eol "gnus-util")
- (autoload 'gnus-delete-line "gnus-util")
- (autoload 'gnus-buffer-live-p "gnus-util"))
+  (autoload 'nnmail-message-id "nnmail")
+  (autoload 'mail-position-on-field "sendmail")
+  (autoload 'message-remove-header "message")
+  (autoload 'cancel-function-timers "timers")
+  (autoload 'gnus-point-at-eol "gnus-util")
+  (autoload 'gnus-delete-line "gnus-util")
+  (autoload 'gnus-buffer-live-p "gnus-util"))
 
 ;;; Header access macros.
 
@@ -297,7 +298,9 @@ on your system, you could say something like:
   '(prog1
        (if (eq (char-after) ?\t)
           0
-        (let ((num (ignore-errors (read (current-buffer)))))
+        (let ((num (condition-case nil
+                       (read (current-buffer))
+                     (error nil))))
           (if (numberp num) num 0)))
      (unless (eobp)
        (search-forward "\t" eol 'move))))
@@ -806,7 +809,9 @@ If FULL, translate everything."
       (if full
          ;; Do complete translation.
          (setq leaf (copy-sequence file)
-               path "")
+               path ""
+               i (if (and (< 1 (length leaf)) (eq ?: (aref leaf 1))) 
+                     2 0))
        ;; We translate -- but only the file name.  We leave the directory
        ;; alone.
        (if (string-match "/[^/]+\\'" file)
@@ -837,7 +842,7 @@ The first string in ARGS can be a format string."
   "Get the most recent report from BACKEND."
   (condition-case ()
       (nnheader-message 5 "%s" (symbol-value (intern (format "%s-status-string"
-                                                 backend))))
+                                                            backend))))
     (error (nnheader-message 5 ""))))
 
 (defun nnheader-insert (format &rest args)
index 8cd98f2..ae77d1d 100644 (file)
@@ -36,9 +36,8 @@
 ;;
 ;; Todo, minor things:
 ;;
+;;   o Don't require half of Gnus -- backends should be standalone
 ;;   o Support escape characters in `message-tokenize-header'
-;;   o Split-fancy.
-;;   o Support NOV nnmail-extra-headers.
 ;;   o Verify that we don't use IMAP4rev1 specific things (RFC2060 App B)
 ;;   o Dont uid fetch 1,* in nnimap-retrive-groups (slow)
 ;;   o Split up big fetches (1,* header especially) in smaller chunks
@@ -54,7 +53,7 @@
 ;;   o IMAP2BIS compatibility? (RFC2061)
 ;;   o ACAP stuff (perhaps a different project, would be nice to ACAPify
 ;;     .newsrc.eld)
-;;   o What about Gnus's article editing, can we support it?
+;;   o What about Gnus's article editing, can we support it?  NO!
 ;;   o Use \Draft to support the draft group??
 
 ;;; Code:
@@ -66,7 +65,6 @@
 (require 'nnmail)
 (require 'nnheader)
 (require 'gnus)
-(require 'gnus-async)
 (require 'gnus-range)
 (require 'gnus-start)
 (require 'gnus-int)
@@ -114,14 +112,21 @@ element in each \"rule\" is the name of the IMAP mailbox, and the
 second is a regexp that nnimap will try to match on the header to find
 a fit.
 
-The first element can also be a list. In that case, the first element
+The first element can also be a list.  In that case, the first element
 is the server the second element is the group on that server in which
 the matching article will be stored.
 
 The second element can also be a function.  In that case, it will be
 called narrowed to the headers with the first element of the rule as
 the argument.  It should return a non-nil value if it thinks that the
-mail belongs in that group.")
+mail belongs in that group.
+
+This variable can also have a function as its value, the function will
+be called with the headers narrowed and should return a group where it
+thinks the article should be splitted to.")
+
+(defvar nnimap-split-fancy nil
+  "Like `nnmail-split-fancy', which see.")
 
 ;; Authorization / Privacy variables
 
@@ -136,7 +141,7 @@ handle.
 
 Change this if
 
-1) you want to connect with SSL. The SSL integration with IMAP is
+1) you want to connect with SSL.  The SSL integration with IMAP is
    brain-dead so you'll have to tell it specifically.
 
 2) your server is more capable than your environment -- i.e. your
@@ -160,13 +165,14 @@ Kerberos.
 Possible choices: kerberos4, cram-md5, login, anonymous.")
 
 (defvoo nnimap-directory (nnheader-concat gnus-directory "overview/")
-  "Directory to keep NOV cache files for nnimap groups. See also
-`nnimap-nov-file-name'.")
+  "Directory to keep NOV cache files for nnimap groups.
+See also `nnimap-nov-file-name'.")
 
 (defvoo nnimap-nov-file-name "nnimap."
-  "NOV cache base filename. The group name and
-`nnimap-nov-file-name-suffix' will be appended. A typical complete
-file name would be ~/News/overview/nnimap.pdc.INBOX.ding.nov, or
+  "NOV cache base filename.
+The group name and `nnimap-nov-file-name-suffix' will be appended.  A
+typical complete file name would be
+~/News/overview/nnimap.pdc.INBOX.ding.nov, or
 ~/News/overview/nnimap/pdc/INBOX/ding/nov if
 `nnmail-use-long-file-names' is nil")
 
@@ -174,13 +180,14 @@ file name would be ~/News/overview/nnimap.pdc.INBOX.ding.nov, or
   "Suffix for NOV cache base filename.")
 
 (defvoo nnimap-nov-is-evil nil
-  "If non-nil, nnimap will never generate or use a local nov database
-for this backend.  Using nov databases will speed up header fetching
-considerably. Unlike other backends, you do not need to take special
-care if you flip this variable.")
+  "If non-nil, nnimap will never generate or use a local nov database for this backend.
+Using nov databases will speed up header fetching considerably.
+Unlike other backends, you do not need to take special care if you
+flip this variable.")
 
 (defvoo nnimap-expunge-on-close 'always ; 'ask, 'never
-  "When a IMAP group with articles marked for deletion is closed, this
+  "Whether to expunge a group when it is closed.
+When a IMAP group with articles marked for deletion is closed, this
 variable determine if nnimap should actually remove the articles or
 not.
 
@@ -192,11 +199,11 @@ When setting this variable to `never', you can only expunge articles
 by using `G x' (gnus-group-nnimap-expunge) from the Group buffer.")
 
 (defvoo nnimap-list-pattern "*"
-  "A string LIMIT or list of strings with mailbox wildcards used to
-limit available groups. Se below for available wildcards.
+  "A string LIMIT or list of strings with mailbox wildcards used to limit available groups.
+See below for available wildcards.
 
 The LIMIT string can be a cons cell (REFERENCE . LIMIT), where
-REFERENCE will be passed as the first parameter to LIST/LSUB. The
+REFERENCE will be passed as the first parameter to LIST/LSUB.  The
 semantics of this are server specific, on the University of Washington
 server you can specify a directory.
 
@@ -207,8 +214,7 @@ There are two wildcards * and %. * matches everything, % matches
 everything in the current hierarchy.")
 
 (defvoo nnimap-news-groups nil
-  "IMAP support a news-like mode, also known as bulletin board mode,
-where replies is sent via IMAP instead of SMTP.
+  "IMAP support a news-like mode, also known as bulletin board mode, where replies is sent via IMAP instead of SMTP.
 
 This variable should contain a regexp matching groups where you wish
 replies to be stored to the mailbox directly.
@@ -219,12 +225,12 @@ Example:
 This will match all groups not beginning with \"INBOX\".
 
 Note that there is nothing technically different between mail-like and
-news-like mailboxes. If you wish to have a group with todo items or
+news-like mailboxes.  If you wish to have a group with todo items or
 similar which you wouldn't want to set up a mailing list for, you can
 use this to make replies go directly to the group.")
 
 (defvoo nnimap-server-address nil
-  "Obsolete. Use `nnimap-address'.")
+  "Obsolete.  Use `nnimap-address'.")
 
 (defcustom nnimap-authinfo-file "~/.authinfo"
   "Authorization information for IMAP servers.  In .netrc format."
@@ -244,8 +250,7 @@ use this to make replies go directly to the group.")
                                          (string :format "Password: %v")))))))
 
 (defcustom nnimap-prune-cache t
-  "If non-nil, nnimap check wheter articles still exist on server
-before using data stored in NOV cache."
+  "If non-nil, nnimap check whether articles still exist on server before using data stored in NOV cache."
   :type 'boolean)
 
 (defvar nnimap-request-list-method 'imap-mailbox-list
@@ -255,7 +260,7 @@ restrict visible folders.")
 
 ;; Internal variables:
 
-(defvar nnimap-debug nil) ;; "*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)
@@ -267,28 +272,16 @@ restrict visible folders.")
   "Gnus callback the nnimap asynchronous callback should call.")
 (defvar nnimap-callback-buffer nil
   "Which buffer the asynchronous article prefetch callback should work in.")
-
-;; Various server variables.
+(defvar nnimap-server-buffer-alist nil)        ;; Map server name to buffers.
+(defvar nnimap-current-server nil)     ;; Current server
+(defvar nnimap-server-buffer nil)      ;; Current servers' buffer
 
 \f
-;; Internal variables.
-(defvar nnimap-server-buffer-alist nil) ;; Map server name to buffers.
-(defvar nnimap-current-server nil)      ;; Current server
-(defvar nnimap-server-buffer nil)       ;; Current servers' buffer
 
 (nnoo-define-basics nnimap)
 
 ;; Utility functions:
 
-(defun nnimap-replace-in-string (string regexp to)
-  "Replace substrings in STRING matching REGEXP with TO."
-  (if (string-match regexp string)
-      (concat (substring string 0 (match-beginning 0))
-             to
-             (nnimap-replace-in-string (substring string (match-end 0))
-                                regexp to))
-    string))
-
 (defsubst nnimap-get-server-buffer (server)
   "Return buffer for SERVER, if nil use current server."
   (cadr (assoc (or server nnimap-current-server) nnimap-server-buffer-alist)))
@@ -308,7 +301,7 @@ If SERVER is nil, uses the current server."
         (old-uidvalidity (gnus-group-get-parameter gnusgroup 'uidvalidity)))
     (if old-uidvalidity
        (if (not (equal old-uidvalidity new-uidvalidity))
-           nil ;; uidvalidity clash
+           nil ;; uidvalidity clash
          (gnus-group-set-parameter gnusgroup 'uidvalidity new-uidvalidity)
          t)
       (gnus-group-add-parameter gnusgroup (cons 'uidvalidity new-uidvalidity))
@@ -340,7 +333,7 @@ If EXAMINE is non-nil the group is selected read-only."
                    (zerop (imap-mailbox-get 'exists group))
                    (yes-or-no-p
                     (format
-                     "nnimap: Group %s is not uidvalid. Continue? " group)))
+                     "nnimap: Group %s is not uidvalid.  Continue? " group)))
                imap-current-mailbox
              (imap-mailbox-unselect)
              (error "nnimap: Group %s is not uid-valid." group))
@@ -367,39 +360,26 @@ If EXAMINE is non-nil the group is selected read-only."
                                 nnimap-progress-how-often)
                              nnimap-progress-chars)))
   (with-current-buffer nntp-server-buffer
-    (nnheader-insert-nov
-     (with-current-buffer nnimap-server-buffer
-       (make-full-mail-header
-       imap-current-message
-       (or (nnimap-replace-whitespace
-            (imap-message-envelope-subject imap-current-message))
-           "(none)")
-       (nnimap-replace-whitespace
-        (imap-envelope-from
-         (car-safe (imap-message-envelope-from
-                    imap-current-message))))
-       (nnimap-replace-whitespace
-        (imap-message-envelope-date imap-current-message))
-       (nnimap-replace-whitespace
-        (imap-message-envelope-message-id imap-current-message))
-       (nnimap-replace-whitespace
-        (let ((str (if (imap-capability 'IMAP4rev1)
-                       (nth 2 (assoc
-                               "HEADER.FIELDS REFERENCES"
-                               (imap-message-get
-                                imap-current-message 'BODYDETAIL)))
-                     (imap-message-get imap-current-message
-                                       'RFC822.HEADER))))
-          (if (> (length str) (length "References: "))
-              (substring str (length "References: "))
-            (if (and (setq str (imap-message-envelope-in-reply-to
-                                imap-current-message))
-                     (string-match "<[^>]+>" str))
-                (substring str (match-beginning 0) (match-end 0))))))
-       (imap-message-get imap-current-message 'RFC822.SIZE)
-       (imap-body-lines (imap-message-body imap-current-message))
-       nil ;; xref
-       nil))))) ;; extra-headers
+    (let (headers lines chars uid)
+      (with-current-buffer nnimap-server-buffer
+       (setq uid imap-current-message
+             headers (if (imap-capability 'IMAP4rev1)
+                         ;; xxx don't just use car? alist doesn't contain
+                         ;; anything else now, but it might...
+                         (nth 2 (car (imap-message-get uid 'BODYDETAIL)))
+                       (imap-message-get uid 'RFC822.HEADER))
+             lines (imap-body-lines (imap-message-body imap-current-message))
+             chars (imap-message-get imap-current-message 'RFC822.SIZE)))
+      (nnheader-insert-nov
+       (with-temp-buffer
+        (buffer-disable-undo)
+        (insert headers)
+        (nnheader-ms-strip-cr)
+        (let ((head (nnheader-parse-head 'naked)))
+          (mail-header-set-number head uid)
+          (mail-header-set-chars head chars)
+          (mail-header-set-lines head lines)
+          head))))))
 
 (defun nnimap-retrieve-which-headers (articles fetch-old)
   "Get a range of articles to fetch based on ARTICLES and FETCH-OLD."
@@ -461,10 +441,15 @@ If EXAMINE is non-nil the group is selected read-only."
          (nnimap-length (gnus-range-length articles))
          (nnimap-counter 0))
       (imap-fetch (nnimap-range-to-string articles)
-                 (concat "(UID RFC822.SIZE ENVELOPE BODY "
-                         (if (imap-capability 'IMAP4rev1)
-                             "BODY.PEEK[HEADER.FIELDS (References)])"
-                           "RFC822.HEADER.LINES (References))")))
+                 (concat "(UID RFC822.SIZE BODY "
+                         (let ((headers
+                                (append '(Subject From Date Message-Id
+                                                  References In-Reply-To Xref)
+                                        (copy-sequence
+                                         nnmail-extra-headers))))
+                           (if (imap-capability 'IMAP4rev1)
+                               (format "BODY.PEEK[HEADER.FIELDS %s])" headers)
+                             (format "RFC822.HEADER.LINES %s)" headers)))))
       (and (numberp nnmail-large-newsgroup)
           (> nnimap-length nnmail-large-newsgroup)
           (nnheader-message 6 "nnimap: Retrieving headers...done")))))
@@ -563,8 +548,9 @@ If EXAMINE is non-nil the group is selected read-only."
        (nnimap-open-connection server))))
 
 (deffoo nnimap-server-opened (&optional server)
-  "If SERVER is the current virtual server, and the connection to the
-physical server is alive, this function return a non-nil value. If
+  "Whether SERVER is opened.
+If SERVER is the current virtual server, and the connection to the
+physical server is alive, this function return a non-nil value.  If
 SERVER is nil, it is treated as the current server."
   ;; clean up autologouts??
   (and (or server nnimap-current-server)
@@ -572,8 +558,8 @@ SERVER is nil, it is treated as the current server."
        (imap-opened (nnimap-get-server-buffer server))))
 
 (deffoo nnimap-close-server (&optional server)
-  "Close connection to server and free all resources connected to
-it. Return nil if the server couldn't be closed for some reason."
+  "Close connection to server and free all resources connected to it.
+Return nil if the server couldn't be closed for some reason."
   (let ((server (or server nnimap-current-server)))
     (when (or (nnimap-server-opened server)
              (imap-opened (nnimap-get-server-buffer server)))
@@ -586,9 +572,9 @@ it. Return nil if the server couldn't be closed for some reason."
     (nnoo-close-server 'nnimap server)))
 
 (deffoo nnimap-request-close ()
-  "Close connection to all servers and free all resources that the
-backend have reserved. All buffers that have been created by that
-backend should be killed. (Not the nntp-server-buffer, though.) This
+  "Close connection to all servers and free all resources that the backend have reserved.
+All buffers that have been created by that
+backend should be killed.  (Not the nntp-server-buffer, though.) This
 function is generally only called when Gnus is shutting down."
   (mapcar (lambda (server) (nnimap-close-server (car server)))
          nnimap-server-buffer-alist)
@@ -715,12 +701,10 @@ function is generally only called when Gnus is shutting down."
          (or (member "\\NoSelect" (imap-mailbox-get 'list-flags mbx))
              (let ((info (nnimap-find-minmax-uid mbx 'examine)))
                (when info
-                 ;; Escape SPC in mailboxes xxx relies on gnus internals
                  (with-current-buffer nntp-server-buffer
-                   (insert (format "%s %d %d y\n"
-                                   (nnimap-replace-in-string mbx " " "\\ ")
-                                   (or (nth 2 info) 0)
-                                   (max 1 (or (nth 1 info) 1)))))))))))
+                   (insert (format "\"%s\" %d %d y\n"
+                                   mbx (or (nth 2 info) 0)
+                                   (max 1 (or (nth 1 info) 1)))))))))))
     (gnus-message 5 "nnimap: Generating active list%s...done"
                  (if (> (length server) 0) (concat " for " server) ""))
     t))
@@ -755,17 +739,15 @@ function is generally only called when Gnus is shutting down."
        (or (member "\\NoSelect"
                    (imap-mailbox-get 'list-flags group nnimap-server-buffer))
            (let ((info (nnimap-find-minmax-uid group 'examine)))
-             ;; Escape SPC in mailboxes xxx relies on gnus internals
-             (insert (format "211 %d %d %d %s\n" (or (nth 0 info) 0)
-                             (max 1 (or (nth 1 info) 1))
+             (insert (format "\"%s\" %d %d y\n" group
                              (or (nth 2 info) 0)
-                             (nnimap-replace-in-string group " " "\\ ")))))))
+                             (max 1 (or (nth 1 info) 1))))))))
     (gnus-message 5 "nnimap: Checking mailboxes...done")
-    'groups))
+    'active))
 
 (deffoo nnimap-request-update-info-internal (group info &optional server)
   (when (nnimap-possibly-change-group group server)
-    (when info ;; xxx what does this mean? should we create a info?
+    (when info;; xxx what does this mean? should we create a info?
       (with-current-buffer nnimap-server-buffer
        (gnus-message 5 "nnimap: Updating info for %s..."
                      (gnus-info-group info))
@@ -792,19 +774,19 @@ function is generally only called when Gnus is shutting down."
                         seen))
            (gnus-info-set-read info seen)))
 
-       (mapc (lambda (pred)
-               (when (and (nnimap-mark-permanent-p (cdr pred))
-                          (member (nnimap-mark-to-flag (cdr pred))
-                                  (imap-mailbox-get 'flags)))
-                 (gnus-info-set-marks
-                  info
-                  (nnimap-update-alist-soft
-                   (cdr pred)
-                   (gnus-compress-sequence
-                    (imap-search (nnimap-mark-to-predicate (cdr pred))))
-                   (gnus-info-marks info))
-                  t)))
-             gnus-article-mark-lists)
+       (mapcar (lambda (pred)
+                 (when (and (nnimap-mark-permanent-p (cdr pred))
+                            (member (nnimap-mark-to-flag (cdr pred))
+                                    (imap-mailbox-get 'flags)))
+                   (gnus-info-set-marks
+                    info
+                    (nnimap-update-alist-soft
+                     (cdr pred)
+                     (gnus-compress-sequence
+                      (imap-search (nnimap-mark-to-predicate (cdr pred))))
+                     (gnus-info-marks info))
+                    t)))
+               gnus-article-mark-lists)
        
        (gnus-message 5 "nnimap: Updating info for %s...done"
                      (gnus-info-group info))
@@ -853,6 +835,11 @@ function is generally only called when Gnus is shutting down."
        (gnus-message 7 "nnimap: Setting marks in %s...done" group))))
   nil)
 
+(defun nnimap-split-fancy ()
+  "Like nnmail-split-fancy, but uses nnimap-split-fancy."
+  (let ((nnmail-split-fancy nnimap-split-fancy))
+    (nnmail-split-fancy)))
+
 (defun nnimap-split-to-groups (rules)
   ;; tries to match all rules in nnimap-split-rule against content of
   ;; nntp-server-buffer, returns a list of groups that matched.
@@ -897,7 +884,7 @@ function is generally only called when Gnus is shutting down."
       (let (rule inbox removeorig (inboxes (nnimap-split-find-inbox server)))
        ;; iterate over inboxes
        (while (and (setq inbox (pop inboxes))
-                   (nnimap-possibly-change-group inbox)) ;; SELECT
+                   (nnimap-possibly-change-group inbox));; SELECT
          ;; find split rule for this server / inbox
          (when (setq rule (nnimap-split-find-rule server inbox))
            ;; iterate over articles
@@ -920,7 +907,7 @@ function is generally only called when Gnus is shutting down."
                (and removeorig
                     (imap-message-flags-add (format "%d" article)
                                             "\\Seen \\Deleted")))))
-         (when (imap-mailbox-select inbox) ;; just in case
+         (when (imap-mailbox-select inbox);; just in case
            ;; todo: UID EXPUNGE (if available) to remove splitted articles
            (imap-mailbox-expunge)
            (imap-mailbox-close)))
@@ -943,12 +930,10 @@ function is generally only called when Gnus is shutting down."
                           (string= (downcase mailbox) "\\noselect"))
                         (imap-mailbox-get 'list-flags mbx
                                           nnimap-server-buffer))
-             ;; Escape SPC in mailboxes xxx relies on gnus internals
              (let ((info (nnimap-find-minmax-uid mbx 'examine)))
                (when info
-                 (insert (format "%s %d %d y\n"
-                                 (nnimap-replace-in-string mbx " " "\\ ")
-                                 (or (nth 2 info) 0)
+                 (insert (format "\"%s\" %d %d y\n"
+                                 mbx (or (nth 2 info) 0)
                                  (max 1 (or (nth 1 info) 1)))))))))
       (gnus-message 5 "nnimap: Listing subscribed mailboxes%s%s...done"
                    (if (> (length server) 0) " on " "") server))
@@ -1087,18 +1072,18 @@ function is generally only called when Gnus is shutting down."
       ;; delete all removed identifiers
       (mapcar (lambda (old-acl)
                (unless (assoc (car old-acl) new-acls)
-                   (or (imap-mailbox-acl-delete (car old-acl) mailbox)
-                       (error "Can't delete ACL for %s" (car old-acl)))))
+                 (or (imap-mailbox-acl-delete (car old-acl) mailbox)
+                     (error "Can't delete ACL for %s" (car old-acl)))))
              old-acls)
       ;; set all changed acl's
       (mapcar (lambda (new-acl)
                (let ((new-rights (cdr new-acl))
                      (old-rights (cdr (assoc (car new-acl) old-acls))))
-               (unless (and old-rights new-rights
-                            (string= old-rights new-rights))
-                 (or (imap-mailbox-acl-set (car new-acl) new-rights mailbox)
-                     (error "Can't set ACL for %s to %s" (car new-acl)
-                            new-rights)))))
+                 (unless (and old-rights new-rights
+                              (string= old-rights new-rights))
+                   (or (imap-mailbox-acl-set (car new-acl) new-rights mailbox)
+                       (error "Can't set ACL for %s to %s" (car new-acl)
+                              new-rights)))))
              new-acls)
       t)))
 
@@ -1113,12 +1098,12 @@ function is generally only called when Gnus is shutting down."
 ;; predicate => "SEEN", "FLAGGED", "DRAFT", "KEYWORD gnus-expire" etc
 ;;
 ;; Mark should not really contain 'read since it's not a "mark" in the Gnus
-;; world, but we cheat. Mark == gnus-article-mark-lists + '(read . read).
+;; world, but we cheat.  Mark == gnus-article-mark-lists + '(read . read).
 ;;
 
 (defconst nnimap-mark-to-predicate-alist
   (mapcar
-   (lambda (pair) ; cdr is the mark
+   (lambda (pair)                      ; cdr is the mark
      (or (assoc (cdr pair)
                 '((read . "SEEN")
                   (tick . "FLAGGED")
@@ -1129,9 +1114,9 @@ function is generally only called when Gnus is shutting down."
    (cons '(read . read) gnus-article-mark-lists)))
 
 (defun nnimap-mark-to-predicate (pred)
-  "Convert a Gnus mark (a symbol such as read, tick, expire) to a IMAP
-predicate (a string such as \"SEEN\", \"FLAGGED\", \"KEYWORD
-gnus-expire\") to be used within a IMAP SEARCH query."
+  "Convert a Gnus mark (a symbol such as read, tick, expire) to a IMAP predicate.
+This is a string such as \"SEEN\", \"FLAGGED\", \"KEYWORD gnus-expire\",
+to be used within a IMAP SEARCH query."
   (cdr (assq pred nnimap-mark-to-predicate-alist)))
 
 (defconst nnimap-mark-to-flag-alist
@@ -1153,8 +1138,8 @@ gnus-expire\") to be used within a IMAP SEARCH query."
     (cdr (assoc preds nnimap-mark-to-flag-alist))))
 
 (defun nnimap-mark-to-flag (preds &optional always-list make-string)
-  "Convert a Gnus mark (a symbol such as read, tick, expire) to a IMAP
-flag (a string such as \"\\Seen\", \"\\Flagged\", \"gnus-expire\") to
+  "Convert a Gnus mark (a symbol such as read, tick, expire) to a IMAP flag.
+This is a string such as \"\\Seen\", \"\\Flagged\", \"gnus-expire\", to
 be used in a STORE FLAGS command."
   (let ((result (nnimap-mark-to-flag-1 preds)))
     (setq result (if (and (or make-string always-list)
@@ -1170,13 +1155,12 @@ be used in a STORE FLAGS command."
       result)))
 
 (defun nnimap-mark-permanent-p (mark &optional group)
-  "Return t iff MARK can be permanently (between IMAP sessions) saved
-on articles, in GROUP."
+  "Return t iff MARK can be permanently (between IMAP sessions) saved on articles, in GROUP."
   (imap-message-flag-permanent-p (nnimap-mark-to-flag mark)))
 
 (defun nnimap-remassoc (key alist)
-  "Delete by side effect any elements of LIST whose car is
-`equal' to KEY.  The modified LIST is returned.  If the first member
+  "Delete by side effect any elements of LIST whose car is `equal' to KEY.
+The modified LIST is returned.  If the first member
 of LIST has a car that is `equal' to KEY, there is no way to remove it
 by side effect; therefore, write `(setq foo (remassoc key foo))' to be
 sure of changing the value of `foo'."
@@ -1199,73 +1183,72 @@ sure of changing the value of `foo'."
                  (car item) (cdr item))
        (format "%d" item)))
    (if (and (listp range) (not (listp (cdr range))))
-       (list range) ;; make (1 . 2) into ((1 . 2))
+       (list range);; make (1 . 2) into ((1 . 2))
      range)
    ","))
 
 (when nnimap-debug
   (require 'trace)
   (buffer-disable-undo (get-buffer-create nnimap-debug))
-  (mapc (lambda (f) (trace-function-background f nnimap-debug))
+  (mapcar (lambda (f) (trace-function-background f nnimap-debug))
         '(
-nnimap-replace-in-string
-nnimap-possibly-change-server
-nnimap-verify-uidvalidity
-nnimap-find-minmax-uid
-nnimap-possibly-change-group
-;nnimap-replace-whitespace
-nnimap-retrieve-headers-progress
-nnimap-retrieve-which-headers
-nnimap-group-overview-filename
-nnimap-retrieve-headers-from-file
-nnimap-retrieve-headers-from-server
-nnimap-retrieve-headers
-nnimap-open-connection
-nnimap-open-server
-nnimap-server-opened
-nnimap-close-server
-nnimap-request-close
-nnimap-status-message
-;nnimap-demule
-nnimap-request-article-part
-nnimap-request-article
-nnimap-request-head
-nnimap-request-body
-nnimap-request-group
-nnimap-close-group
-nnimap-pattern-to-list-arguments
-nnimap-request-list
-nnimap-request-post
-nnimap-retrieve-groups
-nnimap-request-update-info-internal
-nnimap-request-type
-nnimap-request-set-mark
-nnimap-split-to-groups
-nnimap-split-find-rule
-nnimap-split-find-inbox
-nnimap-split-articles
-nnimap-request-scan
-nnimap-request-newgroups
-nnimap-request-create-group
-nnimap-time-substract
-nnimap-date-days-ago
-nnimap-request-expire-articles-progress
-nnimap-request-expire-articles
-nnimap-request-move-article
-nnimap-request-accept-article
-nnimap-request-delete-group
-nnimap-request-rename-group
-gnus-group-nnimap-expunge
-gnus-group-nnimap-edit-acl
-gnus-group-nnimap-edit-acl-done
-nnimap-group-mode-hook
-nnimap-mark-to-predicate
-nnimap-mark-to-flag-1
-nnimap-mark-to-flag
-nnimap-mark-permanent-p
-nnimap-remassoc
-nnimap-update-alist-soft
-nnimap-range-to-string
+         nnimap-possibly-change-server
+         nnimap-verify-uidvalidity
+         nnimap-find-minmax-uid
+         nnimap-possibly-change-group
+         ;;nnimap-replace-whitespace
+         nnimap-retrieve-headers-progress
+         nnimap-retrieve-which-headers
+         nnimap-group-overview-filename
+         nnimap-retrieve-headers-from-file
+         nnimap-retrieve-headers-from-server
+         nnimap-retrieve-headers
+         nnimap-open-connection
+         nnimap-open-server
+         nnimap-server-opened
+         nnimap-close-server
+         nnimap-request-close
+         nnimap-status-message
+         ;;nnimap-demule
+         nnimap-request-article-part
+         nnimap-request-article
+         nnimap-request-head
+         nnimap-request-body
+         nnimap-request-group
+         nnimap-close-group
+         nnimap-pattern-to-list-arguments
+         nnimap-request-list
+         nnimap-request-post
+         nnimap-retrieve-groups
+         nnimap-request-update-info-internal
+         nnimap-request-type
+         nnimap-request-set-mark
+         nnimap-split-to-groups
+         nnimap-split-find-rule
+         nnimap-split-find-inbox
+         nnimap-split-articles
+         nnimap-request-scan
+         nnimap-request-newgroups
+         nnimap-request-create-group
+         nnimap-time-substract
+         nnimap-date-days-ago
+         nnimap-request-expire-articles-progress
+         nnimap-request-expire-articles
+         nnimap-request-move-article
+         nnimap-request-accept-article
+         nnimap-request-delete-group
+         nnimap-request-rename-group
+         gnus-group-nnimap-expunge
+         gnus-group-nnimap-edit-acl
+         gnus-group-nnimap-edit-acl-done
+         nnimap-group-mode-hook
+         nnimap-mark-to-predicate
+         nnimap-mark-to-flag-1
+         nnimap-mark-to-flag
+         nnimap-mark-permanent-p
+         nnimap-remassoc
+         nnimap-update-alist-soft
+         nnimap-range-to-string
           )))
 
 (provide 'nnimap)
index e6d7ff0..a253608 100644 (file)
 (deffoo nnkiboze-request-delete-group (group &optional force server)
   (nnkiboze-possibly-change-group group)
   (when force
-     (let ((files (nconc
-                  (nnkiboze-score-file group)
-                  (list (nnkiboze-nov-file-name)
-                        (nnkiboze-nov-file-name ".newsrc")))))
-       (while files
-        (and (file-exists-p (car files))
-             (file-writable-p (car files))
-             (delete-file (car files)))
-        (setq files (cdr files)))))
+    (let ((files (nconc
+                 (nnkiboze-score-file group)
+                 (list (nnkiboze-nov-file-name)
+                       (nnkiboze-nov-file-name ".newsrc")))))
+      (while files
+       (and (file-exists-p (car files))
+            (file-writable-p (car files))
+            (delete-file (car files)))
+       (setq files (cdr files)))))
   (setq nnkiboze-current-group nil)
   t)
 
index a226328..79b08b8 100644 (file)
@@ -29,6 +29,7 @@
 ;;; Code:
 
 (eval-when-compile (require 'cl))
+
 (require 'nnoo)
 (require 'nnweb)
 
   nnweb-type)
 
 (defvoo nnlistserv-type-definition
-  '((kk
-     (article . nnlistserv-kk-wash-article)
-     (map . nnlistserv-kk-create-mapping)
-     (search . nnlistserv-kk-search)
-     (address . "http://www.itk.ntnu.no/ansatte/Andresen_Trond/kk-f/%s/")
-     (pages "fra160396" "fra160796" "fra061196" "fra160197"
-           "fra090997" "fra040797" "fra130397" "nye")
-     (index . "date.html")
-     (identifier . nnlistserv-kk-identity)))
+    '((kk
+       (article . nnlistserv-kk-wash-article)
+       (map . nnlistserv-kk-create-mapping)
+       (search . nnlistserv-kk-search)
+       (address . "http://www.itk.ntnu.no/ansatte/Andresen_Trond/kk-f/%s/")
+       (pages "fra160396" "fra160796" "fra061196" "fra160197"
+             "fra090997" "fra040797" "fra130397" "nye")
+       (index . "date.html")
+       (identifier . nnlistserv-kk-identity)))
   "Type-definition alist."
   nnweb-type-definition)
 
                 nil 0 0 url))
               map)
              (nnweb-set-hashtb (cadar map) (car map))
-             (nnheader-message 5 "%s %s %s" (cdr active) (point) pages)
-             ))))
+             (nnheader-message 5 "%s %s %s" (cdr active) (point) pages)))))
       ;; Return the articles in the right order.
       (setq nnweb-articles
            (sort (nconc nnweb-articles map) 'car-less-than-car)))))
index baa18b1..35ca394 100644 (file)
@@ -26,6 +26,7 @@
 ;;; Code:
 
 (eval-when-compile (require 'cl))
+
 (require 'nnheader)
 (require 'message)
 (require 'custom)
@@ -934,7 +935,7 @@ FUNC will be called with the group name to determine the article number."
                           '("bogus"))
                     (error
                      (nnheader-message 5
-                      "Error in `nnmail-split-methods'; using `bogus' mail group")
+                                       "Error in `nnmail-split-methods'; using `bogus' mail group")
                      (sit-for 1)
                      '("bogus")))))
              (setq split (gnus-remove-duplicates split))
@@ -1400,6 +1401,7 @@ See the documentation for the variable `nnmail-split-fancy' for documentation."
   (let* ((sources (or mail-sources
                      (if (listp nnmail-spool-file) nnmail-spool-file
                        (list nnmail-spool-file))))
+        fetching-sources
         (group-in group)
         (i 0)
         (new 0)
@@ -1407,14 +1409,6 @@ See the documentation for the variable `nnmail-split-fancy' for documentation."
         incoming incomings source)
     (when (and (nnmail-get-value "%s-get-new-mail" method)
               nnmail-spool-file)
-      ;; We first activate all the groups.
-      (nnmail-activate method)
-      ;; Allow the user to hook.
-      (run-hooks 'nnmail-pre-get-new-mail-hook)
-      ;; Open the message-id cache.
-      (nnmail-cache-open)
-      ;; The we go through all the existing mail source specification
-      ;; and fetch the mail from each.
       (while (setq source (pop sources))
        ;; Be compatible with old values.
        (cond
@@ -1446,21 +1440,31 @@ See the documentation for the variable `nnmail-split-fancy' for documentation."
        (when nnmail-fetched-sources
          (if (member source nnmail-fetched-sources)
              (setq source nil)
-           (push source nnmail-fetched-sources)))
-       (when source
-         (nnheader-message 4 "%s: Reading incoming mail from %s..."
-                           method (car source))
-         (when (setq new
-                     (mail-source-fetch
-                      source
-                      `(lambda (file orig-file)
-                         (nnmail-split-incoming
-                          file ',(intern (format "%s-save-mail" method))
-                          ',spool-func
-                          (nnmail-get-split-group orig-file source)
-                          ',(intern (format "%s-active-number" method))))))
-           (incf total new)
-           (incf i))))
+           (push source nnmail-fetched-sources)
+           (push source fetching-sources)))))
+    (when fetching-sources
+      ;; We first activate all the groups.
+      (nnmail-activate method)
+      ;; Allow the user to hook.
+      (run-hooks 'nnmail-pre-get-new-mail-hook)
+      ;; Open the message-id cache.
+      (nnmail-cache-open)
+      ;; The we go through all the existing mail source specification
+      ;; and fetch the mail from each.
+      (while (setq source (pop fetching-sources))
+       (nnheader-message 4 "%s: Reading incoming mail from %s..."
+                         method (car source))
+       (when (setq new
+                   (mail-source-fetch
+                    source
+                    `(lambda (file orig-file)
+                       (nnmail-split-incoming
+                        file ',(intern (format "%s-save-mail" method))
+                        ',spool-func
+                        (nnmail-get-split-group orig-file source)
+                        ',(intern (format "%s-active-number" method))))))
+         (incf total new)
+         (incf i)))
       ;; If we did indeed read any incoming spools, we save all info.
       (if (zerop total)
          (nnheader-message 4 "%s: Reading incoming mail (no new mail)...done"
index 2dd8311..4eae3b8 100644 (file)
@@ -26,6 +26,7 @@
 
 (eval-when-compile (require 'cl))
 (eval-when-compile (require 'static))
+
 (require 'nnheader)
 (require 'message)
 (require 'nnmail)
   (nnheader-report 'nnmbox "LIST NEWSGROUPS is not implemented."))
 
 (deffoo nnmbox-request-expire-articles
-  (articles newsgroup &optional server force)
+    (articles newsgroup &optional server force)
   (nnmbox-possibly-change-newsgroup newsgroup server)
   (let* ((is-old t)
         rest)
       (nconc rest articles))))
 
 (deffoo nnmbox-request-move-article
-  (article group server accept-form &optional last)
+    (article group server accept-form &optional last)
   (let ((buf (get-buffer-create " *nnmbox move*"))
        result)
     (and
          (when (and (re-search-backward
                      (format "^X-Gnus-Newsgroup: %s:\\([0-9]+\\) "
                              (caar alist)) nil t)
-                    (>= (setq number
-                              (string-to-number
-                               (buffer-substring
-                                (match-beginning 1) (match-end 1))))
-                        (cdadar alist)))
-           (setcdr (cadar alist) (1+ number)))
+                    (> (setq number
+                             (string-to-number
+                              (buffer-substring
+                               (match-beginning 1) (match-end 1))))
+                       (cdadar alist)))
+           (setcdr (cadar alist) number))
          (setq alist (cdr alist)))
 
        (goto-char (point-min))
        (while (re-search-forward delim nil t)
          (setq start (match-beginning 0))
-         (when (not (search-forward "\nX-Gnus-Newsgroup: "
-                                    (save-excursion
-                                      (setq end
-                                            (or
-                                             (and
-                                              (re-search-forward delim nil t)
-                                              (match-beginning 0))
-                                             (point-max))))
-                                    t))
+         (unless (search-forward
+                  "\nX-Gnus-Newsgroup: "
+                  (save-excursion
+                    (setq end
+                          (or
+                           (and
+                            ;; skip to end of headers first, since mail
+                            ;; which has been respooled has additional
+                            ;; "From nobody" lines.
+                            (search-forward "\n\n" nil t)
+                            (re-search-forward delim nil t)
+                            (match-beginning 0))
+                           (point-max))))
+                  t)
            (save-excursion
              (save-restriction
                (narrow-to-region start end)
index 1199d22..98e56a4 100644 (file)
@@ -32,6 +32,7 @@
 ;;; Code:
 
 (eval-when-compile (require 'cl))
+
 (require 'nnheader)
 (require 'nnmail)
 (require 'gnus-start)
   "*Hook run narrowed to an article before saving.")
 
 (defvoo nnmh-be-safe nil
-  "*If non-nil, nnmh will check all articles to make sure whether they are new or not.")
+  "*If non-nil, nnmh will check all articles to make sure whether they are new or not.
+Go through the .nnmh-articles file and compare with the actual
+articles in this folder.  The articles that are \"new\" will be marked
+as unread by Gnus.")
 
 \f
 
@@ -61,6 +65,9 @@
 
 (defvoo nnmh-status-string "")
 (defvoo nnmh-group-alist nil)
+;; Don't even think about setting this variable.  It does not exist.
+;; Forget about it.  Uh-huh.  Nope.  Nobody here.  It's only bound
+;; dynamically by certain functions in nndraft.
 (defvar nnmh-allow-delete-final nil)
 
 \f
          (and large
               (zerop (% count 20))
               (nnheader-message 5 "nnmh: Receiving headers... %d%%"
-                       (/ (* count 100) number))))
+                                (/ (* count 100) number))))
 
        (when large
          (nnheader-message 5 "nnmh: Receiving headers...done"))
               (mapcar (lambda (name) (string-to-int name))
                       (directory-files pathname nil "^[0-9]+$" t))
               '<))
-         (cond
-          (dir
-           (setq nnmh-group-alist
-                 (delq (assoc group nnmh-group-alist) nnmh-group-alist))
-           (push (list group (cons (car dir) (car (last dir))))
-                 nnmh-group-alist)
-           (nnheader-report 'nnmh "Selected group %s" group)
-           (nnheader-insert
-            "211 %d %d %d %s\n" (length dir) (car dir)
-            (car (last dir)) group))
-          (t
-           (nnheader-report 'nnmh "Empty group %s" group)
-           (nnheader-insert (format "211 0 1 0 %s\n" group))))))))))
+       (cond
+        (dir
+         (setq nnmh-group-alist
+               (delq (assoc group nnmh-group-alist) nnmh-group-alist))
+         (push (list group (cons (car dir) (car (last dir))))
+               nnmh-group-alist)
+         (nnheader-report 'nnmh "Selected group %s" group)
+         (nnheader-insert
+          "211 %d %d %d %s\n" (length dir) (car dir)
+          (car (last dir)) group))
+        (t
+         (nnheader-report 'nnmh "Empty group %s" group)
+         (nnheader-insert (format "211 0 1 0 %s\n" group))))))))))
 
 (deffoo nnmh-request-scan (&optional group server)
   (nnmail-get-new-mail 'nnmh nil nnmh-directory group))
   t)
 
 (deffoo nnmh-request-move-article
-  (article group server accept-form &optional last)
+    (article group server accept-form &optional last)
   (let ((buf (get-buffer-create " *nnmh move*"))
        result)
     (and
index 23b1401..124d870 100644 (file)
@@ -31,6 +31,7 @@
 ;;; Code:
 
 (eval-when-compile (require 'cl))
+
 (require 'nnheader)
 (require 'nnmail)
 (require 'nnoo)
   "Spool directory for the nnml mail backend.")
 
 (defvoo nnml-active-file
-  (concat (file-name-as-directory nnml-directory) "active")
+    (concat (file-name-as-directory nnml-directory) "active")
   "Mail active file.")
 
 (defvoo nnml-newsgroups-file
-  (concat (file-name-as-directory nnml-directory) "newsgroups")
+    (concat (file-name-as-directory nnml-directory) "newsgroups")
   "Mail newsgroups description file.")
 
 (defvoo nnml-get-new-mail t
@@ -304,7 +305,7 @@ all.  This may very well take some time.")
     (nconc rest articles)))
 
 (deffoo nnml-request-move-article
-  (article group server accept-form &optional last)
+    (article group server accept-form &optional last)
   (let ((buf (get-buffer-create " *nnml move*"))
        result)
     (nnml-possibly-change-directory group server)
@@ -312,12 +313,15 @@ all.  This may very well take some time.")
     (and
      (nnml-deletable-article-p group article)
      (nnml-request-article article group server)
-     (save-excursion
-       (set-buffer buf)
-       (insert-buffer-substring nntp-server-buffer)
-       (setq result (eval accept-form))
-       (kill-buffer (current-buffer))
-       result)
+     (let (nnml-current-directory 
+          nnml-current-group 
+          nnml-article-file-alist)
+       (save-excursion
+        (set-buffer buf)
+        (insert-buffer-substring nntp-server-buffer)
+        (setq result (eval accept-form))
+        (kill-buffer (current-buffer))
+        result))
      (progn
        (nnml-possibly-change-directory group server)
        (condition-case ()
index fbf1509..23dae0d 100644 (file)
 (require 'gnus)
 (require 'nnmail)
 (require 'mm-util)
-(require 'nnweb)
 (eval-when-compile
   (ignore-errors
-    (require 'w3)
-    (require 'url)
-    (require 'w3-forms)))
+    (require 'nnweb)))
 ;; Report failure to find w3 at load time if appropriate.
-(eval '(progn
-        (require 'w3)
-        (require 'url)
-        (require 'w3-forms)))
+(eval '(require 'nnweb))
 
 (nnoo-declare nnslashdot)
 
       (let ((case-fold-search t))
        (erase-buffer)
        (when (= start 1)
-         (nnweb-insert (format nnslashdot-article-url sid))
+         (nnweb-insert (format nnslashdot-article-url sid) t)
          (goto-char (point-min))
          (search-forward "Posted by ")
          (when (looking-at "<a[^>]+>\\([^<]+\\)")
-           (setq from (match-string 1)))
+           (setq from (nnweb-decode-entities-string (match-string 1))))
          (search-forward " on ")
          (setq date (nnslashdot-date-to-date
                      (buffer-substring (point) (1- (search-forward "<")))))
          (setq lines (count-lines
                       (point)
                       (search-forward
-                       "A href=http://slashdot.org/article.pl")))
+                       "A href=http://slashdot.org/article" nil t)))
          (push
           (cons
            1
                    (< start last))
          (setq point (goto-char (point-max)))
          (nnweb-insert
-          (format nnslashdot-comments-url sid nnslashdot-threshold 0 start))
+          (format nnslashdot-comments-url sid nnslashdot-threshold 0 start)
+          t)
          (when first-comments
            (setq first-comments nil)
            (goto-char (point-max))
            (setq startats (sort startats '<)))
          (goto-char point)
          (while (re-search-forward
-                 "<a name=\"\\([0-9]+\\)\"><b>\\([^<]+\\)</b>.*score:\\([^)]+\\))"
+                 "<a name=\"\\([0-9]+\\)\"><\\(b\\|H4\\)>\\([^<]+\\)</\\(b\\|H4\\)>.*score:\\([^)]+\\))"
                  nil t)
            (setq article (string-to-number (match-string 1))
-                 subject (match-string 2)
-                 score (match-string 3))
+                 subject (match-string 3)
+                 score (match-string 5))
            (when (string-match "^Re: *" subject)
              (setq subject (concat "Re: " (substring subject (match-end 0)))))
+            (setq subject (nnweb-decode-entities-string subject))
            (forward-line 1)
            (if (looking-at
                 "by <a[^>]+>\\([^<]+\\)</a>[ \t\n]*.*(\\([^)]+\\))")
-               (setq from (concat (match-string 1)
+               (setq from (concat (nnweb-decode-entities-string (match-string 1))
                                   " <" (match-string 2) ">"))
              (looking-at "by \\(.+\\) on ")
-             (setq from (match-string 1)))
+             (setq from (nnweb-decode-entities-string (match-string 1))))
            (goto-char (- (match-end 0) 5))
            (search-forward " on ")
            (setq date
       (set-buffer nnslashdot-buffer)
       (erase-buffer)
       (when (= start 1)
-       (nnweb-insert (format nnslashdot-article-url sid))
+       (nnweb-insert (format nnslashdot-article-url sid) t)
        (goto-char (point-min))
        (search-forward "Posted by ")
        (when (looking-at "<a[^>]+>\\([^<]+\\)")
-         (setq from (match-string 1)))
+         (setq from (nnweb-decode-entities-string (match-string 1))))
        (search-forward " on ")
        (setq date (nnslashdot-date-to-date
                    (buffer-substring (point) (1- (search-forward "<")))))
        (forward-line 2)
        (setq lines (count-lines (point)
                                 (search-forward
-                                 "A href=http://slashdot.org/article.pl")))
+                                 "A href=http://slashdot.org/article")))
        (push
         (cons
          1
          (setq start (1+ article)))
        (setq point (goto-char (point-max)))
        (nnweb-insert
-        (format nnslashdot-comments-url sid nnslashdot-threshold 4 start))
+        (format nnslashdot-comments-url sid nnslashdot-threshold 4 start)
+        t)
        (goto-char point)
        (while (re-search-forward
-               "<a name=\"\\([0-9]+\\)\"><b>\\([^<]+\\)</b>.*score:\\([^)]+\\))"
+                 "<a name=\"\\([0-9]+\\)\"><\\(b\\|H4\\)>\\([^<]+\\)</\\(b\\|H4\\)>.*score:\\([^)]+\\))"
                nil t)
          (setq article (string-to-number (match-string 1))
-               subject (match-string 2)
-               score (match-string 3))
+               subject (match-string 3)
+               score (match-string 5))
          (when (string-match "^Re: *" subject)
            (setq subject (concat "Re: " (substring subject (match-end 0)))))
+          (setq subject (nnweb-decode-entities-string subject))
          (forward-line 1)
          (if (looking-at
               "by <a[^>]+>\\([^<]+\\)</a>[ \t\n]*.*(\\([^)]+\\))")
-             (setq from (concat (match-string 1) " <" (match-string 2) ">"))
+             (setq from (concat (nnweb-decode-entities-string (match-string 1))
+                                 " <" (match-string 2) ">"))
            (looking-at "by \\(.+\\) on ")
-           (setq from (match-string 1)))
+           (setq from (nnweb-decode-entities-string (match-string 1))))
          (goto-char (- (match-end 0) 5))
          (search-forward " on ")
          (setq date
            (when (numberp article)
              (if (= article 1)
                  (progn
-                   (re-search-forward "Posted by .* on ")
-                   (forward-line 1)
+                   (re-search-forward "Posted by *<[^>]+>[^>]*<[^>]+> *on ")
+                   (search-forward "<BR>")
                    (setq contents
                          (buffer-substring
                           (point)
                           (progn
                             (re-search-forward
-                             "<p>.*A href=http://slashdot.org/article.pl")
+                             "<p>.*A href=http://slashdot\\.org/article")
                             (match-beginning 0)))))
                (search-forward (format "<a name=\"%d\">" (1- article)))
                (setq contents
        (erase-buffer)
        (insert contents)
        (goto-char (point-min))
-       (while (search-forward "<br><br>" nil t)
+       (while (re-search-forward "\\(<br>\r?\\)+" nil t)
          (replace-match "<p>" t t))
        (goto-char (point-min))
        (insert "Content-Type: text/html\nMIME-Version: 1.0\n")
        sid elem description articles gname)
     (condition-case why
         ;; First we do the Ultramode to get info on all the latest groups.
-        (mm-with-unibyte-buffer
-          (nnweb-insert "http://slashdot.org/slashdot.xml")
-          (goto-char (point-min))
-          (while (search-forward "<story>" nil t)
-            (narrow-to-region (point) (search-forward "</story>"))
-            (goto-char (point-min))
-            (re-search-forward "<title>\\([^<]+\\)</title>")
-            (setq description (match-string 1))
-            (re-search-forward "<url>\\([^<]+\\)</url>")
-            (setq sid (match-string 1))
-            (string-match "/\\([0-9/]+\\).shtml" sid)
-            (setq sid (match-string 1 sid))
-            (re-search-forward "<comments>\\([^<]+\\)</comments>")
-            (setq articles (string-to-number (match-string 1)))
-            (setq gname (concat description " (" sid ")"))
-            (if (setq elem (assoc gname nnslashdot-groups))
-                (setcar (cdr elem) articles)
-              (push (list gname articles sid) nnslashdot-groups))
-            (goto-char (point-max))
-            (widen)))
-      ;; Then do the older groups.
-      (while (> (- nnslashdot-group-number number) 0)
-        (mm-with-unibyte-buffer
-          (let ((case-fold-search t))
-            (nnweb-insert (format nnslashdot-active-url number))
-            (goto-char (point-min))
-            (while (re-search-forward
-                    "article.pl\\?sid=\\([^&]+\\).*<b>\\([^<]+\\)</b>" nil t)
-              (setq sid (match-string 1)
-                    description (match-string 2))
-              (forward-line 1)
-              (when (re-search-forward "<b>\\([0-9]+\\)</b>" nil t)
-                (setq articles (string-to-number (match-string 1))))
-              (setq gname (concat description " (" sid ")"))
-              (if (setq elem (assoc gname nnslashdot-groups))
-                  (setcar (cdr elem) articles)
-                (push (list gname articles sid) nnslashdot-groups)))))
-        (incf number 30))
+       (progn 
+         (mm-with-unibyte-buffer
+           (nnweb-insert "http://slashdot.org/slashdot.xml" t)
+           (goto-char (point-min))
+           (while (search-forward "<story>" nil t)
+             (narrow-to-region (point) (search-forward "</story>"))
+             (goto-char (point-min))
+             (re-search-forward "<title>\\([^<]+\\)</title>")
+             (setq description (nnweb-decode-entities-string (match-string 1)))
+             (re-search-forward "<url>\\([^<]+\\)</url>")
+             (setq sid (match-string 1))
+             (string-match "/\\([0-9/]+\\).shtml" sid)
+             (setq sid (match-string 1 sid))
+             (re-search-forward "<comments>\\([^<]+\\)</comments>")
+             (setq articles (string-to-number (match-string 1)))
+             (setq gname (concat description " (" sid ")"))
+             (if (setq elem (assoc gname nnslashdot-groups))
+                 (setcar (cdr elem) articles)
+               (push (list gname articles sid) nnslashdot-groups))
+             (goto-char (point-max))
+             (widen)))
+         ;; Then do the older groups.
+         (while (> (- nnslashdot-group-number number) 0)
+           (mm-with-unibyte-buffer
+             (let ((case-fold-search t))
+               (nnweb-insert (format nnslashdot-active-url number) t)
+               (goto-char (point-min))
+               (while (re-search-forward
+                       "article.pl\\?sid=\\([^&]+\\).*<b>\\([^<]+\\)</b>" nil t)
+                 (setq sid (match-string 1)
+                       description (nnweb-decode-entities-string (match-string 2)))
+                 (forward-line 1)
+                 (when (re-search-forward "<b>\\([0-9]+\\)</b>" nil t)
+                   (setq articles (string-to-number (match-string 1))))
+                 (setq gname (concat description " (" sid ")"))
+                 (if (setq elem (assoc gname nnslashdot-groups))
+                     (setcar (cdr elem) articles)
+                   (push (list gname articles sid) nnslashdot-groups)))))
+           (incf number 30)))
       (search-failed (nnslashdot-lose why)))
     (nnslashdot-write-groups)
     (nnslashdot-generate-active)
        ("postercomment" . ,body)
        ("posttype" . "html")))))
 
+(deffoo nnslashdot-request-delete-group (group &optional force server)
+  (nnslashdot-possibly-change-server group server)
+  (setq nnslashdot-groups (delq (assoc group nnslashdot-groups)
+                               nnslashdot-groups))
+  (nnslashdot-write-groups))
+
 (nnoo-define-skeleton nnslashdot)
 
 ;;; Internal functions
             (format " *nnslashdot %s*" server))))))
 
 (defun nnslashdot-date-to-date (sdate)
-  (let ((elem (delete "" (split-string sdate))))
-    (concat (substring (nth 0 elem) 0 3) " "
-           (substring (nth 1 elem) 0 3) " "
-           (substring (nth 2 elem) 0 2) " "
-           (substring (nth 3 elem) 1 6) " "
-           (format-time-string "%Y") " "
-           (nth 4 elem))))
+  (condition-case err
+      (let ((elem (delete "" (split-string sdate))))
+       (concat (substring (nth 0 elem) 0 3) " "
+               (substring (nth 1 elem) 0 3) " "
+               (substring (nth 2 elem) 0 2) " "
+               (substring (nth 3 elem) 1 6) " "
+               (format-time-string "%Y") " "
+               (nth 4 elem)))
+    (error "")))
 
 (defun nnslashdot-generate-active ()
   (save-excursion
index ace0c9a..c21851b 100644 (file)
@@ -27,6 +27,7 @@
 ;;; Code:
 
 (eval-when-compile (require 'cl))
+
 (require 'nnheader)
 (require 'nnmail)
 (require 'gnus-soup)
@@ -313,7 +314,7 @@ backend for the messages.")
       (setq info (pop infolist)
            range-list (gnus-uncompress-range (car info))
            prefix (gnus-soup-area-prefix (nth 1 info)))
-      (when ;; All the articles in this file are marked for expiry.
+      (when;; All the articles in this file are marked for expiry.
          (and (or (setq mod-time (nth 5 (file-attributes
                                          (nnsoup-file prefix))))
                   (setq mod-time (nth 5 (file-attributes
index 07b0b80..b22e202 100644 (file)
@@ -27,6 +27,7 @@
 ;;; Code:
 
 (eval-when-compile (require 'cl))
+
 (require 'nnheader)
 (require 'nntp)
 (require 'nnoo)
@@ -148,7 +149,7 @@ there.")
            (and do-message
                 (zerop (% (incf count) 20))
                 (nnheader-message 5 "nnspool: Receiving headers... %d%%"
-                         (/ (* count 100) number))))
+                                  (/ (* count 100) number))))
 
          (when do-message
            (nnheader-message 5 "nnspool: Receiving headers...done"))
@@ -298,8 +299,8 @@ there.")
                             (read (current-buffer)))
                           seconds))
                      (push (buffer-substring
-                                         (match-beginning 1) (match-end 1))
-                                        groups)
+                            (match-beginning 1) (match-end 1))
+                           groups)
                      (zerop (forward-line -1))))
          (erase-buffer)
          (while groups
index adac986..0415872 100644 (file)
@@ -26,6 +26,7 @@
 ;;; Code:
 
 (eval-when-compile (require 'cl))
+
 (require 'nnheader)
 (require 'nnoo)
 (require 'gnus-util)
@@ -48,10 +49,10 @@ server spawn an nnrpd server.")
 It is called with no parameters.")
 
 (defvoo nntp-server-action-alist
-  '(("nntpd 1\\.5\\.11t"
-     (remove-hook 'nntp-server-opened-hook 'nntp-send-mode-reader))
-    ("NNRP server Netscape"
-     (setq nntp-server-list-active-group nil)))
+    '(("nntpd 1\\.5\\.11t"
+       (remove-hook 'nntp-server-opened-hook 'nntp-send-mode-reader))
+      ("NNRP server Netscape"
+       (setq nntp-server-list-active-group nil)))
   "Alist of regexps to match on server types and actions to be taken.
 For instance, if you want Gnus to beep every time you connect
 to innd, you could say something like:
@@ -439,36 +440,36 @@ noticing asynchronous data.")
            (nntp-inhibit-erase t)
            article)
        ;; Send HEAD commands.
-      (while (setq article (pop articles))
-       (nntp-send-command
-        nil
-        "HEAD" (if (numberp article)
-                   (int-to-string article)
-                 ;; `articles' is either a list of article numbers
-                 ;; or a list of article IDs.
-                 article))
-       (incf count)
-       ;; Every 400 requests we have to read the stream in
-       ;; order to avoid deadlocks.
-       (when (or (null articles)       ;All requests have been sent.
-                 (zerop (% count nntp-maximum-request)))
-         (nntp-accept-response)
-         (while (progn
-                  (set-buffer buf)
-                  (goto-char last-point)
-                  ;; Count replies.
-                  (while (nntp-next-result-arrived-p)
-                    (setq last-point (point))
-                    (incf received))
-                  (< received count))
-           ;; If number of headers is greater than 100, give
-           ;;  informative messages.
-           (and (numberp nntp-large-newsgroup)
-                (> number nntp-large-newsgroup)
-                (zerop (% received 20))
-                (nnheader-message 6 "NNTP: Receiving headers... %d%%"
-                                  (/ (* received 100) number)))
-           (nntp-accept-response))))
+       (while (setq article (pop articles))
+         (nntp-send-command
+          nil
+          "HEAD" (if (numberp article)
+                     (int-to-string article)
+                   ;; `articles' is either a list of article numbers
+                   ;; or a list of article IDs.
+                   article))
+         (incf count)
+         ;; Every 400 requests we have to read the stream in
+         ;; order to avoid deadlocks.
+         (when (or (null articles)     ;All requests have been sent.
+                   (zerop (% count nntp-maximum-request)))
+           (nntp-accept-response)
+           (while (progn
+                    (set-buffer buf)
+                    (goto-char last-point)
+                    ;; Count replies.
+                    (while (nntp-next-result-arrived-p)
+                      (setq last-point (point))
+                      (incf received))
+                    (< received count))
+             ;; If number of headers is greater than 100, give
+             ;;  informative messages.
+             (and (numberp nntp-large-newsgroup)
+                  (> number nntp-large-newsgroup)
+                  (zerop (% received 20))
+                  (nnheader-message 6 "NNTP: Receiving headers... %d%%"
+                                    (/ (* received 100) number)))
+             (nntp-accept-response))))
        (and (numberp nntp-large-newsgroup)
             (> number nntp-large-newsgroup)
             (nnheader-message 6 "NNTP: Receiving headers...done"))
@@ -485,7 +486,7 @@ noticing asynchronous data.")
   (nntp-possibly-change-group nil server)
   (when (nntp-find-connection-buffer nntp-server-buffer)
     (save-excursion
-      ;; Erase nntp-sever-buffer before nntp-inhibit-erase.
+      ;; Erase nntp-server-buffer before nntp-inhibit-erase.
       (set-buffer nntp-server-buffer)
       (erase-buffer)
       (set-buffer (nntp-find-connection-buffer nntp-server-buffer))
@@ -807,13 +808,13 @@ If SEND-IF-FORCE, only send authinfo to the server if the
       (unless (member user '(nil ""))
        (nntp-send-command "^3.*\r?\n" "AUTHINFO USER" user)
        (when t                         ;???Should check if AUTHINFO succeeded
-      (nntp-send-command
-       "^2.*\r?\n" "AUTHINFO PASS"
-       (or passwd
-          nntp-authinfo-password
-          (setq nntp-authinfo-password
+         (nntp-send-command
+          "^2.*\r?\n" "AUTHINFO PASS"
+          (or passwd
+              nntp-authinfo-password
+              (setq nntp-authinfo-password
                     (mail-source-read-passwd (format "NNTP (%s@%s) password: "
-                                                user nntp-address))))))))))
+                                                     user nntp-address))))))))))
 
 (defun nntp-send-nosy-authinfo ()
   "Send the AUTHINFO to the nntp server."
@@ -823,7 +824,7 @@ If SEND-IF-FORCE, only send authinfo to the server if the
       (when t                          ;???Should check if AUTHINFO succeeded
        (nntp-send-command "^2.*\r?\n" "AUTHINFO PASS"
                           (mail-source-read-passwd "NNTP (%s@%s) password: "
-                                              user nntp-address))))))
+                                                   user nntp-address))))))
 
 (defun nntp-send-authinfo-from-file ()
   "Send the AUTHINFO to the nntp server.
@@ -1133,7 +1134,7 @@ password contained in '~/.nntp-authinfo'."
      (car (last articles)) 'wait)
 
     (goto-char (point-min))
-    (when (looking-at "[1-5][0-9][0-9] ")
+    (when (looking-at "[1-5][0-9][0-9] .*\n")
       (delete-region (point) (progn (forward-line 1) (point))))
     (while (search-forward "\r" nil t)
       (replace-match "" t t))
@@ -1180,16 +1181,16 @@ password contained in '~/.nntp-authinfo'."
                    (zerop (% count nntp-maximum-request)))
 
            (nntp-accept-response)
-           ;; On some Emacs versions the preceding function has
-           ;; a tendency to change the buffer.  Perhaps.  It's
-           ;; quite difficult to reproduce, because it only
-           ;; seems to happen once in a blue moon.
+           ;; On some Emacs versions the preceding function has a
+           ;; tendency to change the buffer.  Perhaps.  It's quite
+           ;; difficult to reproduce, because it only seems to happen
+           ;; once in a blue moon.
            (set-buffer process-buffer)
            (while (progn
                     (goto-char (or last-point (point-min)))
                     ;; Count replies.
-                    (while (re-search-forward "^[0-9][0-9][0-9] " nil t)
-                      (setq received (1+ received)))
+                    (while (re-search-forward "^[0-9][0-9][0-9] .*\n" nil t)
+                      (incf received))
                     (setq last-point (point))
                     (< received count))
              (nntp-accept-response)
@@ -1201,7 +1202,10 @@ password contained in '~/.nntp-authinfo'."
          (set-buffer process-buffer)
          ;; Wait for the reply from the final command.
          (goto-char (point-max))
-         (re-search-backward "^[0-9][0-9][0-9] " nil t)
+         (while (not (re-search-backward "^[0-9][0-9][0-9] " nil t))
+           (nntp-accept-response)
+           (set-buffer process-buffer)
+           (goto-char (point-max)))
          (when (looking-at "^[23]")
            (while (progn
                     (goto-char (point-max))
index b1962ac..d30c1a8 100644 (file)
 (require 'gnus)
 (require 'nnmail)
 (require 'mm-util)
-(require 'nnweb)
 (eval-when-compile
   (ignore-errors
-    (require 'w3)
-    (require 'url)
-    (require 'w3-forms)))
+    (require 'nnweb)))
 ;; Report failure to find w3 at load time if appropriate.
-(eval '(progn
-        (require 'w3)
-        (require 'url)
-        (require 'w3-forms)))
+(eval '(require 'nnweb))
 
 (nnoo-declare nnultimate)
 
            ;;(setq total-contents (nreverse total-contents))
            (dolist (art (cdr elem))
              (if (not (nth (1- (cdr art)) total-contents))
-                 ();(debug)
+                 ()                    ;(debug)
                (push (list (car art)
                            (nth (1- (cdr art)) total-contents)
                            subject)
     (nnultimate-open-server server))
   (unless nnultimate-groups-alist
     (nnultimate-read-groups)
-  (setq nnultimate-groups (cdr (assoc nnultimate-address
-                                     nnultimate-groups-alist)))))
+    (setq nnultimate-groups (cdr (assoc nnultimate-address
+                                       nnultimate-groups-alist)))))
 
 (deffoo nnultimate-open-server (server &optional defs connectionless)
   (nnheader-init-server-buffer)
          case-fold-search)
       (when (and href (string-match
                       "postings\\|forumdisplay\\|Forum[0-9]+/HTML\\|getbio"
-                                   href))
+                      href))
        t))))
 
 (provide 'nnultimate)
 
+;; Local Variables:
+;; coding: iso-8859-1
+;; End:
+
 ;;; nnultimate.el ends here
index 8d46ed5..fef53d7 100644 (file)
@@ -32,6 +32,7 @@
 ;;; Code:
 
 (eval-when-compile (require 'cl))
+
 (require 'nntp)
 (require 'nnheader)
 (require 'gnus)
@@ -62,8 +63,7 @@ component group will show up when you enter the virtual group.")
 (defvoo nnvirtual-current-group nil)
 
 (defvoo nnvirtual-mapping-table nil
-  "Table of rules on how to map between component group and article number
-to virtual article number.")
+  "Table of rules on how to map between component group and article number to virtual article number.")
 
 (defvoo nnvirtual-mapping-offsets nil
   "Table indexed by component group to an offset to be applied to article numbers in that group.")
@@ -121,47 +121,47 @@ to virtual article number.")
                       (let ((gnus-use-cache t))
                         (setq result (gnus-retrieve-headers
                                       articles cgroup nil))))
-           (set-buffer nntp-server-buffer)
-           ;; If we got HEAD headers, we convert them into NOV
-           ;; headers.  This is slow, inefficient and, come to think
-           ;; of it, downright evil.  So sue me.  I couldn't be
-           ;; bothered to write a header parse routine that could
-           ;; parse a mixed HEAD/NOV buffer.
-           (when (eq result 'headers)
-             (nnvirtual-convert-headers))
-           (goto-char (point-min))
-           (while (not (eobp))
-             (delete-region (point)
-                            (progn
-                              (setq carticle (read nntp-server-buffer))
-                              (point)))
-
-             ;; We remove this article from the articles list, if
-             ;; anything is left in the articles list after going through
-             ;; the entire buffer, then those articles have been
-             ;; expired or canceled, so we appropriately update the
-             ;; component group below.  They should be coming up
-             ;; generally in order, so this shouldn't be slow.
-             (setq articles (delq carticle articles))
-
-             (setq article (nnvirtual-reverse-map-article cgroup carticle))
-             (if (null article)
-                 ;; This line has no reverse mapping, that means it
-                 ;; was an extra article reference returned by nntp.
-                 (progn
-                   (beginning-of-line)
-                   (delete-region (point) (progn (forward-line 1) (point))))
-               ;; Otherwise insert the virtual article number,
-               ;; and clean up the xrefs.
-               (princ article nntp-server-buffer)
-               (nnvirtual-update-xref-header cgroup carticle
-                                             prefix system-name)
-               (forward-line 1))
-             )
-
-           (set-buffer vbuf)
-           (goto-char (point-max))
-           (insert-buffer-substring nntp-server-buffer))
+             (set-buffer nntp-server-buffer)
+             ;; If we got HEAD headers, we convert them into NOV
+             ;; headers.  This is slow, inefficient and, come to think
+             ;; of it, downright evil.  So sue me.  I couldn't be
+             ;; bothered to write a header parse routine that could
+             ;; parse a mixed HEAD/NOV buffer.
+             (when (eq result 'headers)
+               (nnvirtual-convert-headers))
+             (goto-char (point-min))
+             (while (not (eobp))
+               (delete-region (point)
+                              (progn
+                                (setq carticle (read nntp-server-buffer))
+                                (point)))
+
+               ;; We remove this article from the articles list, if
+               ;; anything is left in the articles list after going through
+               ;; the entire buffer, then those articles have been
+               ;; expired or canceled, so we appropriately update the
+               ;; component group below.  They should be coming up
+               ;; generally in order, so this shouldn't be slow.
+               (setq articles (delq carticle articles))
+
+               (setq article (nnvirtual-reverse-map-article cgroup carticle))
+               (if (null article)
+                   ;; This line has no reverse mapping, that means it
+                   ;; was an extra article reference returned by nntp.
+                   (progn
+                     (beginning-of-line)
+                     (delete-region (point) (progn (forward-line 1) (point))))
+                 ;; Otherwise insert the virtual article number,
+                 ;; and clean up the xrefs.
+                 (princ article nntp-server-buffer)
+                 (nnvirtual-update-xref-header cgroup carticle
+                                               prefix system-name)
+                 (forward-line 1))
+               )
+
+             (set-buffer vbuf)
+             (goto-char (point-max))
+             (insert-buffer-substring nntp-server-buffer))
            ;; Anything left in articles is expired or canceled.
            ;; Could be smart and not tell it about articles already known?
            (when articles
@@ -591,7 +591,7 @@ If UPDATE-P is not nil, call gnus-group-update-group on the components."
               (aref entry 1)
               (cdr (aref nnvirtual-mapping-offsets group-pos)))
            ))
-      ))
+    ))
 
 
 
@@ -649,7 +649,7 @@ then it is left out of the result."
   "Return an association list of component article numbers.
 These are indexed by elements of nnvirtual-component-groups, based on
 the sequence ARTICLES of virtual article numbers.  ARTICLES should be
-sorted, and can be a compressed sequence. If any of the article
+sorted, and can be a compressed sequence.  If any of the article
 numbers has no corresponding component article, then it is left out of
 the result."
   (when (numberp (cdr-safe articles))
@@ -691,28 +691,28 @@ based on the marks on the component groups."
     ;; Into all-unreads we put (g unreads).
     ;; Into all-marks we put (g marks).
     ;; We also increment cnt and tot here, and compute M (max of sizes).
-    (mapc (lambda (g)
-           (setq active (gnus-activate-group g)
-                 min (car active)
-                 max (cdr active))
-           (when (and active (>= max min) (not (zerop max)))
-             ;; store active information
-             (push (list g (- max min -1) max) actives)
-             ;; collect unread/mark info for later
-             (setq unreads (gnus-list-of-unread-articles g))
-             (setq marks (gnus-info-marks (gnus-get-info g)))
-             (when gnus-use-cache
-               (push (cons 'cache
-                           (gnus-cache-articles-in-group g))
-                     marks))
-             (push (cons g unreads) all-unreads)
-             (push (cons g marks) all-marks)
-             ;; count groups, total #articles, and max size
-             (setq size (- max min -1))
-             (setq cnt (1+ cnt)
-                   tot (+ tot size)
-                   M (max M size))))
-         nnvirtual-component-groups)
+    (mapcar (lambda (g)
+             (setq active (gnus-activate-group g)
+                   min (car active)
+                   max (cdr active))
+             (when (and active (>= max min) (not (zerop max)))
+               ;; store active information
+               (push (list g (- max min -1) max) actives)
+               ;; collect unread/mark info for later
+               (setq unreads (gnus-list-of-unread-articles g))
+               (setq marks (gnus-info-marks (gnus-get-info g)))
+               (when gnus-use-cache
+                 (push (cons 'cache
+                             (gnus-cache-articles-in-group g))
+                       marks))
+               (push (cons g unreads) all-unreads)
+               (push (cons g marks) all-marks)
+               ;; count groups, total #articles, and max size
+               (setq size (- max min -1))
+               (setq cnt (1+ cnt)
+                     tot (+ tot size)
+                     M (max M size))))
+           nnvirtual-component-groups)
 
     ;; Number of articles in the virtual group.
     (setq nnvirtual-mapping-len tot)
index 33bd5ea..4057db5 100644 (file)
@@ -2,7 +2,7 @@
 ;; Copyright (C) 1999 Free Software Foundation, Inc.
 
 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
-;; Keywords: news
+;; Keywords: news egroups mail-archive
 
 ;; This file is part of GNU Emacs.
 
 
 ;;; Commentary:
 
-;; Note: You need to have `url' and `w3' installed for this backend to
-;; work.
+;; Note: You need to have `url' (w3 0.46) or greater version
+;; installed for this backend to work.
 
-;; A lot of codes stolen from mail-source, nnslashdot, nnweb.
-
-;; Todo: To support more web archives.
-
-;; Known bugs: in w3 0.44, there are two copies of url-maybe-relative.
-;; If it is loaded from w3.el, (load-library "url").  w3 0.45 should
-;; work.
+;; Todo: 
+;; 1. To support more web archives.
+;; 2. Generalize webmail to other MHonArc archive.
 
 ;;; Code:
 
@@ -42,6 +38,7 @@
 (require 'message)
 (require 'gnus-util)
 (require 'gnus)
+(require 'gnus-bcklg)
 (require 'nnmail)
 (require 'mm-util)
 (require 'mail-source)
 
 (nnoo-declare nnwarchive)
 
-(eval-and-compile
-  (defvar nnwarchive-type-definition
-    '((egroups
-       (open-url 
-       "http://www.egroups.com/register?method=loginAction&email=%s&password=%s" 
-       login passwd)
-       (list-url 
-       "http://www.egroups.com/UserGroupsPage?")
-       (list-dissect . nnwarchive-egroups-list)
-       (list-groups . nnwarchive-egroups-list-groups)
-       (xover-url 
-       "http://www.egroups.com/group/%s/?fetchForward=1&start=%d" group start)
-       (xover-last-url 
-       "http://www.egroups.com/group/%s/?fetchForward=1" group)
-       (xover-page-size . 13)
-       (xover-dissect . nnwarchive-egroups-xover)
-       (article-url 
-       "http://www.egroups.com/group/%s/%d.html?raw=1" group article)
-       (article-dissect . nnwarchive-egroups-article)))))
-  
-(eval-and-compile
-  (defvar nnwarchive-short-names
-    '(login passwd)))
+(defvar nnwarchive-type-definition
+  '((egroups
+     (address . "www.egroups.com")
+     (open-url 
+      "http://www.egroups.com/register?method=loginAction&email=%s&password=%s" 
+      nnwarchive-login nnwarchive-passwd)
+     (list-url 
+      "http://www.egroups.com/UserGroupsPage?")
+     (list-dissect . nnwarchive-egroups-list)
+     (list-groups . nnwarchive-egroups-list-groups)
+     (xover-url 
+      "http://www.egroups.com/group/%s/?fetchForward=1&start=%d" group aux)
+     (xover-last-url 
+      "http://www.egroups.com/group/%s/?fetchForward=1" group)
+     (xover-page-size . 13)
+     (xover-dissect . nnwarchive-egroups-xover)
+     (article-url 
+      "http://www.egroups.com/group/%s/%d.html?raw=1" group article)
+     (article-dissect . nnwarchive-egroups-article)
+     (authentication . t)
+     (article-offset . 0)
+     (xover-files . nnwarchive-egroups-xover-files))
+    (mail-archive
+     (address . "www.mail-archive.com")
+     (open-url)
+     (list-url 
+      "http://www.mail-archive.com/lists.html")
+     (list-dissect . nnwarchive-mail-archive-list)
+     (list-groups . nnwarchive-mail-archive-list-groups)
+     (xover-url 
+      "http://www.mail-archive.com/%s/mail%d.html" group aux)
+     (xover-last-url 
+      "http://www.mail-archive.com/%s/maillist.html" group)
+     (xover-page-size)
+     (xover-dissect . nnwarchive-mail-archive-xover)
+     (article-url 
+      "http://www.mail-archive.com/%s/msg%05d.html" group article1)
+     (article-dissect . nnwarchive-mail-archive-article)
+     (xover-files . nnwarchive-mail-archive-xover-files)
+     (authentication)
+     (article-offset . 1))))
+
+(defvar nnwarchive-default-type 'egroups)
 
 (defvoo nnwarchive-directory (nnheader-concat gnus-directory "warchive/")
   "Where nnwarchive will save its files.")
 
-(eval-and-compile
-  (defvoo nnwarchive-type 'egroups
-    "The type of nnwarchive."))
+(defvoo nnwarchive-type nil
+    "The type of nnwarchive.")
 
-(defvoo nnwarchive-address "egroups.com"
+(defvoo nnwarchive-address ""
   "The address of nnwarchive.")
 
 (defvoo nnwarchive-login nil
 
 (defvoo nnwarchive-headers-cache nil)
 
-(defvoo nnwarchive-opened nil)
+(defvoo nnwarchive-authentication nil)
+
+(defvoo nnwarchive-nov-is-evil nil)
 
 (defconst nnwarchive-version "nnwarchive 1.0")
 
 ;;; Internal variables
 
-(defvar nnwarchive-open-url nil)
-(defvar nnwarchive-open-dissect nil)
+(defvoo nnwarchive-open-url nil)
+(defvoo nnwarchive-open-dissect nil)
+
+(defvoo nnwarchive-list-url nil)
+(defvoo nnwarchive-list-dissect nil)
+(defvoo nnwarchive-list-groups nil)
+
+(defvoo nnwarchive-xover-files nil)
+(defvoo nnwarchive-xover-url nil)
+(defvoo nnwarchive-xover-last-url nil)
+(defvoo nnwarchive-xover-dissect nil)
+(defvoo nnwarchive-xover-page-size nil)
 
-(defvar nnwarchive-list-url nil)
-(defvar nnwarchive-list-dissect nil)
-(defvar nnwarchive-list-groups nil)
+(defvoo nnwarchive-article-url nil)
+(defvoo nnwarchive-article-dissect nil)
+(defvoo nnwarchive-xover-files nil)
+(defvoo nnwarchive-article-offset 0)
 
-(defvar nnwarchive-xover-url nil)
-(defvar nnwarchive-xover-last-url nil)
-(defvar nnwarchive-xover-dissect nil)
-(defvar nnwarchive-xover-page-size nil)
+(defvoo nnwarchive-buffer nil)
 
-(defvar nnwarchive-article-url nil)
-(defvar nnwarchive-article-dissect nil)
+(defvoo nnwarchive-keep-backlog 300)
+(defvar nnwarchive-backlog-articles nil)
+(defvar nnwarchive-backlog-hashtb nil)
 
-(defvar nnwarchive-buffer nil)
+(defvoo nnwarchive-headers nil)
 
-(defvar nnwarchive-headers nil)
 
 ;;; Interface functions
 
 (nnoo-define-basics nnwarchive)
 
-(eval-and-compile
-  (defun nnwarchive-bind-1 ()
-    (let ((defaults (cdr (assq nnwarchive-type nnwarchive-type-definition)))
-         (short-names nnwarchive-short-names)
-         default bind)
-      (while (setq default (pop defaults))
-       (push (list (intern (concat "nnwarchive-" (symbol-name (car default))))
-                   (list 'quote (cdr default))) bind))
-      (while (setq default (pop short-names))
-       (push (list default
-                   (intern (concat "nnwarchive-" 
-                                   (symbol-name default)))) 
-             bind))
-      bind)))
-
-(defmacro nnwarchive-bind (&rest body)
-  "Return a `let' form that binds all variables in TYPE.
-Read `mail-source-bind' for details."
-  `(let ,(nnwarchive-bind-1)
-     ,@body))
-
-(put 'nnwarchive-bind 'lisp-indent-function 0)
-(put 'nnwarchive-bind 'edebug-form-spec '(form body))
+(defun nnwarchive-set-default (type)
+  (let ((defs (cdr (assq type nnwarchive-type-definition)))
+       def)
+    (dolist (def defs)
+      (set (intern (concat "nnwarchive-" (symbol-name (car def)))) 
+          (cdr def)))))
+
+(defmacro nnwarchive-backlog (&rest form)
+  `(let ((gnus-keep-backlog nnwarchive-keep-backlog)
+        (gnus-backlog-buffer 
+         (format " *nnwarchive backlog %s*" nnwarchive-address))
+        (gnus-backlog-articles nnwarchive-backlog-articles)
+        (gnus-backlog-hashtb nnwarchive-backlog-hashtb))
+     (unwind-protect
+        (progn ,@form)
+       (setq nnwarchive-backlog-articles gnus-backlog-articles
+            nnwarchive-backlog-hashtb gnus-backlog-hashtb))))
+(put 'nnwarchive-backlog 'lisp-indent-function 0)
+(put 'nnwarchive-backlog 'edebug-form-spec '(form body))
+
+(defun nnwarchive-backlog-enter-article (group number buffer)
+  (nnwarchive-backlog
+    (gnus-backlog-enter-article group number buffer)))
+
+(defun nnwarchive-get-article (article &optional group server buffer) 
+  (if (numberp article)
+      (if (nnwarchive-backlog
+           (gnus-backlog-request-article group article 
+                                         (or buffer nntp-server-buffer)))
+         (cons group article)
+       (let (contents)
+         (save-excursion
+           (set-buffer nnwarchive-buffer)
+           (goto-char (point-min))
+           (let ((article1 (- article nnwarchive-article-offset)))
+             (nnwarchive-url nnwarchive-article-url))
+           (setq contents (funcall nnwarchive-article-dissect group article)))
+         (when contents
+           (save-excursion
+             (set-buffer (or buffer nntp-server-buffer))
+             (erase-buffer)
+             (insert contents)
+             (nnwarchive-backlog-enter-article group article (current-buffer))
+             (nnheader-report 'nnwarchive "Fetched article %s" article)
+             (cons group article)))))
+    nil))
 
 (deffoo nnwarchive-retrieve-headers (articles &optional group server fetch-old)
   (nnwarchive-possibly-change-server group server)
-  (nnwarchive-bind 
+  (if (or gnus-nov-is-evil nnwarchive-nov-is-evil)
+      (with-temp-buffer
+       (with-current-buffer nntp-server-buffer
+         (erase-buffer))
+       (let ((buf (current-buffer)) b e)
+         (dolist (art articles)
+           (nnwarchive-get-article art group server buf)
+           (setq b (goto-char (point-min)))
+           (if (search-forward "\n\n" nil t)
+               (forward-char -1)
+             (goto-char (point-max)))
+           (setq e (point))
+           (with-current-buffer nntp-server-buffer
+             (insert (format "221 %d Article retrieved.\n" art))
+             (insert-buffer-substring buf b e)
+             (insert ".\n"))))
+       'headers)
     (setq nnwarchive-headers (cdr (assoc group nnwarchive-headers-cache)))
     (save-excursion
       (set-buffer nnwarchive-buffer)
       (erase-buffer)
-      (let (point start starts)
-       (setq starts (nnwarchive-paged (sort articles '<)))
-       (while (setq start (pop starts))
-         (goto-char (point-max))
-         (nnwarchive-url nnwarchive-xover-url))
-       (if nnwarchive-xover-dissect
-           (funcall nnwarchive-xover-dissect))))
+      (funcall nnwarchive-xover-files group articles))
     (save-excursion
       (set-buffer nntp-server-buffer)
       (erase-buffer)
       (let (header)
-       (dolist (art articles)
-         (if (setq header (assq art nnwarchive-headers))
-             (nnheader-insert-nov (cdr header))))))
+      (dolist (art articles)
+       (if (setq header (assq art nnwarchive-headers))
+           (nnheader-insert-nov (cdr header))))))
     (let ((elem (assoc group nnwarchive-headers-cache)))
       (if elem
          (setcdr elem nnwarchive-headers)
        (push (cons group nnwarchive-headers) nnwarchive-headers-cache)))
     'nov))
 
-(deffoo nnwarchive-retrieve-groups (groups &optional server)
-  "Retrieve group info on GROUPS."
-  (nnwarchive-possibly-change-server nil server)
-  (nnwarchive-bind 
-    (if nnwarchive-list-groups
-       (funcall nnwarchive-list-groups groups))
-    (nnwarchive-write-groups)
-    (nnwarchive-generate-active)
-    'active))
-
 (deffoo nnwarchive-request-group (group &optional server dont-check)
   (nnwarchive-possibly-change-server nil server)
-  (nnwarchive-bind 
-    (if nnwarchive-list-groups
-       (funcall nnwarchive-list-groups (list group)))
-    (nnwarchive-write-groups)
-    (let ((elem (assoc group nnwarchive-groups)))
-      (cond
-       ((not elem)
-       (nnheader-report 'nnwarchive "Group does not exist"))
-       (t
-       (nnheader-report 'nnwarchive "Opened group %s" group)
-       (nnheader-insert
-        "211 %d %d %d %s\n" (or (cadr elem) 0) 1 (or (cadr elem) 0)
-        (prin1-to-string group))
-       t)))))
-
-(deffoo nnwarchive-close-group (group &optional server)
-  (nnwarchive-possibly-change-server group server)
-  (nnwarchive-bind
-    (when (gnus-buffer-live-p nnwarchive-buffer)
-      (save-excursion
-       (set-buffer nnwarchive-buffer)
-      (kill-buffer nnwarchive-buffer)))
-    t))
+  (when (and (not dont-check) nnwarchive-list-groups)
+    (funcall nnwarchive-list-groups (list group))
+    (nnwarchive-write-groups))
+  (let ((elem (assoc group nnwarchive-groups)))
+    (cond
+     ((not elem)
+      (nnheader-report 'nnwarchive "Group does not exist"))
+     (t
+      (nnheader-report 'nnwarchive "Opened group %s" group)
+      (nnheader-insert
+       "211 %d %d %d %s\n" (or (cadr elem) 0) 1 (or (cadr elem) 0)
+       (prin1-to-string group))
+      t))))
 
 (deffoo nnwarchive-request-article (article &optional group server buffer)
   (nnwarchive-possibly-change-server group server)
-  (nnwarchive-bind 
-    (let (contents)
-      (save-excursion
-       (set-buffer nnwarchive-buffer)
-       (goto-char (point-min))
-       (nnwarchive-url nnwarchive-article-url)
-       (setq contents (funcall nnwarchive-article-dissect)))
-      (when contents
-       (save-excursion
-         (set-buffer (or buffer nntp-server-buffer))
-         (erase-buffer)
-         (insert contents)
-         (nnheader-report 'nnwarchive "Fetched article %s" article)
-         (cons group article))))))
+  (nnwarchive-get-article article group server buffer))
 
 (deffoo nnwarchive-close-server (&optional server)
   (when (and (nnwarchive-server-opened server)
@@ -243,59 +269,48 @@ Read `mail-source-bind' for details."
     (save-excursion
       (set-buffer nnwarchive-buffer)
       (kill-buffer nnwarchive-buffer)))
+  (nnwarchive-backlog
+    (gnus-backlog-shutdown))
   (nnoo-close-server 'nnwarchive server))
 
 (deffoo nnwarchive-request-list (&optional server)
   (nnwarchive-possibly-change-server nil server)
-  (nnwarchive-bind
-    (save-excursion
-      (set-buffer nnwarchive-buffer)
-      (erase-buffer)
-      (if nnwarchive-list-url
-         (nnwarchive-url nnwarchive-list-url))
-      (if nnwarchive-list-dissect
-         (funcall nnwarchive-list-dissect))
-      (nnwarchive-write-groups)
-      (nnwarchive-generate-active)))
-  'active)
-
-(deffoo nnwarchive-request-newgroups (date &optional server)
-  (nnwarchive-possibly-change-server nil server)
-  (nnwarchive-bind
+  (save-excursion
+    (set-buffer nnwarchive-buffer)
+    (erase-buffer)
+    (if nnwarchive-list-url
+       (nnwarchive-url nnwarchive-list-url))
+    (if nnwarchive-list-dissect
+       (funcall nnwarchive-list-dissect))
     (nnwarchive-write-groups)
     (nnwarchive-generate-active))
-  'active)
-
-(deffoo nnwarchive-asynchronous-p ()
-  nil)
-
-(deffoo nnwarchive-server-opened (&optional server)
-  nnwarchive-opened)
+  t)
 
 (deffoo nnwarchive-open-server (server &optional defs connectionless)
   (nnwarchive-init server)
   (if (nnwarchive-server-opened server)
       t
-    (setq nnwarchive-login
-         (or nnwarchive-login
-             (read-string
-              (format "Login at %s: " server)
-              user-mail-address)))
-    (setq nnwarchive-passwd
-         (or nnwarchive-passwd
-             (mail-source-read-passwd
-            (format "Password for %s at %s: " nnwarchive-login server))))
-    (nnwarchive-bind 
-      (unless nnwarchive-groups
-       (nnwarchive-read-groups))
-      (save-excursion
-       (set-buffer nnwarchive-buffer)
-       (erase-buffer)
-       (if nnwarchive-open-url
+    (nnoo-change-server 'nnwarchive server defs)
+    (when nnwarchive-authentication
+      (setq nnwarchive-login
+           (or nnwarchive-login
+               (read-string
+                (format "Login at %s: " server)
+                user-mail-address)))
+      (setq nnwarchive-passwd
+           (or nnwarchive-passwd
+               (mail-source-read-passwd
+                (format "Password for %s at %s: " 
+                        nnwarchive-login server)))))
+    (unless nnwarchive-groups
+      (nnwarchive-read-groups))
+    (save-excursion
+      (set-buffer nnwarchive-buffer)
+      (erase-buffer)
+      (if nnwarchive-open-url
          (nnwarchive-url nnwarchive-open-url))
-       (if nnwarchive-open-dissect
-           (funcall nnwarchive-open-dissect))
-       (setq nnwarchive-opened t)))
+      (if nnwarchive-open-dissect
+         (funcall nnwarchive-open-dissect)))
     t))
 
 (nnoo-define-skeleton nnwarchive)
@@ -324,13 +339,28 @@ Read `mail-source-bind' for details."
 
 (defun nnwarchive-init (server)
   "Initialize buffers and such."
+  (let ((type (intern server)) (defs nnwarchive-type-definition) def)
+    (cond 
+     ((equal server "")
+      (setq type nnwarchive-default-type))
+     ((assq type nnwarchive-type-definition) t)
+     (t
+      (setq type nil)
+      (while (setq def (pop defs))
+       (when (equal (cdr (assq 'address (cdr def))) server)
+         (setq defs nil)
+         (setq type (car def))))
+      (unless type
+       (error "Undefined server %s" server))))
+    (setq nnwarchive-type type))
   (unless (file-exists-p nnwarchive-directory)
     (gnus-make-directory nnwarchive-directory))
   (unless (gnus-buffer-live-p nnwarchive-buffer)
     (setq nnwarchive-buffer
          (save-excursion
            (nnheader-set-temp-buffer
-            (format " *nnwarchive %s %s*" nnwarchive-type server))))))
+            (format " *nnwarchive %s %s*" nnwarchive-type server)))))
+  (nnwarchive-set-default nnwarchive-type))
 
 (defun nnwarchive-encode-www-form-urlencoded (pairs)
   "Return PAIRS encoded for forms."
@@ -367,42 +397,6 @@ Read `mail-source-bind' for details."
      (t
       (nnweb-insert (apply 'format (nnwarchive-eval xurl)))))))
 
-(defun nnwarchive-decode-entities ()
-  (goto-char (point-min))
-  (while (re-search-forward "&\\(#[0-9]+\\|[a-z]+\\);" nil t)
-    (replace-match (char-to-string 
-                   (if (eq (aref (match-string 1) 0) ?\#)
-                       (string-to-number (substring (match-string 1) 1))
-                     (or (cdr (assq (intern (match-string 1))
-                                    w3-html-entities))
-                         ?#)))
-                  t t)))
-
-(defun nnwarchive-decode-entities-string (str)
-  (with-temp-buffer
-    (insert str)
-    (nnwarchive-decode-entities)
-    (buffer-substring (point-min) (point-max))))
-
-(defun nnwarchive-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)))
-
-(defun nnwarchive-date-to-date (sdate)
-  (let ((elem (split-string sdate)))
-    (concat (substring (nth 0 elem) 0 3) " "
-           (substring (nth 1 elem) 0 3) " "
-           (substring (nth 2 elem) 0 2) " "
-           (substring (nth 3 elem) 1 6) " "
-           (format-time-string "%Y") " "
-           (nth 4 elem))))
-
 (defun nnwarchive-generate-active ()
   (save-excursion
     (set-buffer nntp-server-buffer)
@@ -431,17 +425,17 @@ Read `mail-source-bind' for details."
        (nnwarchive-url nnwarchive-xover-last-url)
        (goto-char (point-min))
        (when (re-search-forward "of \\([0-9]+\\)</title>" nil t)
-       (setq articles (string-to-number (match-string 1)))) 
+         (setq articles (string-to-number (match-string 1)))) 
        (let ((elem (assoc group nnwarchive-groups)))
-       (if elem
-           (setcar (cdr elem) articles)
-         (push (list group articles "") nnwarchive-groups)))
+         (if elem
+             (setcar (cdr elem) articles)
+           (push (list group articles "") nnwarchive-groups)))
        (setq nnwarchive-headers (cdr (assoc group nnwarchive-headers-cache)))
-      (nnwarchive-egroups-xover)
-      (let ((elem (assoc group nnwarchive-headers-cache)))
-       (if elem
-           (setcdr elem nnwarchive-headers)
-         (push (cons group nnwarchive-headers) nnwarchive-headers-cache)))))))
+       (nnwarchive-egroups-xover group)
+       (let ((elem (assoc group nnwarchive-headers-cache)))
+         (if elem
+             (setcdr elem nnwarchive-headers)
+           (push (cons group nnwarchive-headers) nnwarchive-headers-cache)))))))
 
 (defun nnwarchive-egroups-list ()
   (let ((case-fold-search t)
@@ -458,41 +452,40 @@ Read `mail-source-bind' for details."
        (setq articles (string-to-number (match-string 1)))) 
       (if (setq elem (assoc group nnwarchive-groups))
          (setcar (cdr elem) articles)
-       (push (list group articles description) nnwarchive-groups)))
-    (nnwarchive-egroups-list-groups (mapcar 'identity nnwarchive-groups)))
+       (push (list group articles description) nnwarchive-groups))))
   t)
 
-(defun nnwarchive-egroups-xover()
-  (let (article subject from date group)
+(defun nnwarchive-egroups-xover (group)
+  (let (article subject from date)
     (goto-char (point-min))
     (while (re-search-forward
            "<a href=\"/group/\\([^/]+\\)/\\([0-9]+\\)\\.html[^>]+>\\([^<]+\\)<"
            nil t)
-         (setq group  (match-string 1)
-               article (string-to-number (match-string 2))
-               subject (match-string 3))
-         (forward-line 1)
-         (unless (assq article nnwarchive-headers)
-           (if (looking-at "<td[^>]+><font[^>]+>\\([^<]+\\)</font>")
-               (setq from (match-string 1)))
-           (forward-line 1)
-           (if (looking-at "<td[^>]+><font[^>]+>\\([^<]+\\)</font>")
-               (setq date (identity (match-string 1))))
-           (push (cons
-                  article
-                  (make-full-mail-header
-                   article 
-                   (nnwarchive-decode-entities-string subject)
-                   (nnwarchive-decode-entities-string from)
-                   date
-                   (concat "<" group "%"
-                           (number-to-string article) 
-                           "@egroup.com>")
-                   ""
-                   0 0 "")) nnwarchive-headers))))
+      (setq group  (match-string 1)
+           article (string-to-number (match-string 2))
+           subject (match-string 3))
+      (forward-line 1)
+      (unless (assq article nnwarchive-headers)
+       (if (looking-at "<td[^>]+><font[^>]+>\\([^<]+\\)</font>")
+           (setq from (match-string 1)))
+       (forward-line 1)
+       (if (looking-at "<td[^>]+><font[^>]+>\\([^<]+\\)</font>")
+           (setq date (identity (match-string 1))))
+       (push (cons
+              article
+              (make-full-mail-header
+               article 
+               (nnweb-decode-entities-string subject)
+               (nnweb-decode-entities-string from)
+               date
+               (concat "<" group "%"
+                       (number-to-string article) 
+                       "@egroup.com>")
+               ""
+               0 0 "")) nnwarchive-headers))))
   nnwarchive-headers)
 
-(defun nnwarchive-egroups-article ()
+(defun nnwarchive-egroups-article (group articles)
   (goto-char (point-min))
   (if (search-forward "<pre>" nil t)
       (delete-region (point-min) (point)))
@@ -502,8 +495,262 @@ Read `mail-source-bind' for details."
   (goto-char (point-min))
   (while (re-search-forward "<a[^>]+>\\([^<]+\\)</a>" nil t)
     (replace-match "<\\1>"))
-  (nnwarchive-decode-entities)
-  (buffer-substring (point-min) (point-max)))
+  (nnweb-decode-entities)
+  (buffer-string))
+
+(defun nnwarchive-egroups-xover-files (group articles)
+  (let (aux auxs)
+    (setq auxs (nnwarchive-paged (sort articles '<)))
+    (while (setq aux (pop auxs))
+      (goto-char (point-max))
+      (nnwarchive-url nnwarchive-xover-url))
+    (if nnwarchive-xover-dissect
+       (nnwarchive-egroups-xover group))))
+
+;; mail-archive
+
+(defun nnwarchive-mail-archive-list-groups (groups)
+  (save-excursion
+    (let (articles)
+      (set-buffer nnwarchive-buffer)
+      (dolist (group groups)
+       (erase-buffer)
+       (nnwarchive-url nnwarchive-xover-last-url)
+       (goto-char (point-min))
+       (when (re-search-forward "msg\\([0-9]+\\)\\.html" nil t)
+         (setq articles (1+ (string-to-number (match-string 1)))))
+       (let ((elem (assoc group nnwarchive-groups)))
+         (if elem
+             (setcar (cdr elem) articles)
+           (push (list group articles "") nnwarchive-groups)))
+       (setq nnwarchive-headers (cdr (assoc group nnwarchive-headers-cache)))
+       (nnwarchive-mail-archive-xover group)
+       (let ((elem (assoc group nnwarchive-headers-cache)))
+         (if elem
+             (setcdr elem nnwarchive-headers)
+           (push (cons group nnwarchive-headers) 
+                 nnwarchive-headers-cache)))))))
+
+(defun nnwarchive-mail-archive-list ()
+  (let ((case-fold-search t)
+       group description elem articles)
+    (goto-char (point-min))
+    (while (re-search-forward "<a href=\"\\([^/]+\\)/\">\\([^>]+\\)<" nil t)
+      (setq group (match-string 1)
+           description (match-string 2))
+      (forward-line 1)
+      (setq articles 0)
+      (if (setq elem (assoc group nnwarchive-groups))
+         (setcar (cdr elem) articles)
+       (push (list group articles description) nnwarchive-groups))))
+  t)
+
+(defun nnwarchive-mail-archive-xover (group)
+  (let (article subject from date)
+    (goto-char (point-min))
+    (while (re-search-forward
+           "<A[^>]*HREF=\"msg\\([0-9]+\\)\\.html[^>]+>\\([^<]+\\)<"
+           nil t)
+      (setq article (1+ (string-to-number (match-string 1)))
+           subject (match-string 2))
+      (forward-line 1)
+      (unless (assq article nnwarchive-headers)
+       (if (looking-at "<UL><LI><EM>From</EM>:\\([^&]+\\)<\\([^&]+\\)>")
+           (progn
+             (setq from (match-string 1)
+                   date (identity (match-string 2))))
+         (setq from "" date ""))
+       (push (cons
+              article
+              (make-full-mail-header
+               article 
+               (nnweb-decode-entities-string subject)
+               (nnweb-decode-entities-string from)
+               date
+               (format "<%05d%%%s>\n" (1- article) group)
+               ""
+               0 0 "")) nnwarchive-headers))))
+  nnwarchive-headers)
+
+(defun nnwarchive-mail-archive-xover-files (group articles)
+  (unless nnwarchive-headers
+    (erase-buffer)
+    (nnwarchive-url nnwarchive-xover-last-url)
+    (goto-char (point-min))
+    (nnwarchive-mail-archive-xover group))
+  (let ((minart (apply 'min articles))
+       (min (apply 'min (mapcar 'car nnwarchive-headers)))
+       (aux 2))
+    (while (> min minart)
+      (erase-buffer)
+      (nnwarchive-url nnwarchive-xover-url)
+      (nnwarchive-mail-archive-xover group)
+      (setq min (apply 'min (mapcar 'car nnwarchive-headers))))))
+
+(defvar nnwarchive-caesar-translation-table nil
+  "Modified rot13 table. tr/@A-Z[a-z/N-Z[@A-Mn-za-m/.")
+
+(defun nnwarchive-make-caesar-translation-table ()
+  "Create modified rot13 table. tr/@A-Z[a-z/N-Z[@A-Mn-za-m/."
+  (let ((i -1)
+       (table (make-string 256 0))
+       (a (mm-char-int ?a))
+       (A (mm-char-int ?A)))
+    (while (< (incf i) 256)
+      (aset table i i))
+    (concat
+     (substring table 0 (1- A))
+     (substring table (+ A 13) (+ A 27))
+     (substring table (1- A) (+ A 13))
+     (substring table (+ A 27) a)
+     (substring table (+ a 13) (+ a 26))
+     (substring table a (+ a 13))
+     (substring table (+ a 26) 255))))
+
+(defun nnwarchive-from-r13 (from-r13)
+  (when from-r13
+    (with-temp-buffer
+      (insert from-r13)
+      (let ((message-caesar-translation-table
+            (or nnwarchive-caesar-translation-table
+                (setq nnwarchive-caesar-translation-table 
+                      (nnwarchive-make-caesar-translation-table)))))
+       (message-caesar-region (point-min) (point-max))
+       (buffer-string)))))
+
+(defun nnwarchive-mail-archive-article (group article)
+  (let (p refs url mime e 
+         from subject date id 
+         done
+         (case-fold-serch t))
+    (save-restriction
+      (goto-char (point-min))
+      (when (search-forward "X-Head-End" nil t)
+       (beginning-of-line)
+       (narrow-to-region (point-min) (point))
+       (nnweb-decode-entities)
+       (goto-char (point-min))
+       (while (search-forward "<!--X-" nil t)
+         (replace-match ""))
+       (goto-char (point-min))
+       (while (search-forward " -->" nil t)
+         (replace-match ""))
+       (setq from 
+             (or (mail-fetch-field "from")
+                 (nnwarchive-from-r13 
+                  (mail-fetch-field "from-r13"))))
+       (setq date (mail-fetch-field "date"))
+       (setq id (mail-fetch-field "message-id"))
+       (setq subject (mail-fetch-field "subject"))
+       (goto-char (point-max))
+       (widen))
+      (when (search-forward "<ul>" nil t)
+       (forward-line)
+       (delete-region (point-min) (point))
+       (search-forward "</ul>" nil t)
+       (end-of-line)
+       (narrow-to-region (point-min) (point))
+       (nnweb-remove-markup)
+       (nnweb-decode-entities)
+       (goto-char (point-min))
+       (delete-blank-lines)
+       (when from
+         (message-remove-header "from")
+         (goto-char (point-max))
+         (insert "From: " from "\n"))
+       (when subject
+         (message-remove-header "subject")
+         (goto-char (point-max))
+         (insert "Subject: " subject "\n"))
+       (when id
+         (goto-char (point-max))
+         (insert "X-Message-ID: <" id ">\n"))
+       (when date
+         (message-remove-header "date")
+         (goto-char (point-max))
+         (insert "Date: " date "\n"))
+       (goto-char (point-max))
+       (widen)
+       (insert "\n"))
+      (setq p (point)) 
+      (when (search-forward "X-Body-of-Message" nil t)
+       (forward-line)
+       (delete-region p (point))
+       (search-forward "X-Body-of-Message-End" nil t)
+       (beginning-of-line)
+       (save-restriction
+         (narrow-to-region p (point))
+         (goto-char (point-min))
+         (if (> (skip-chars-forward "\040\n\r\t") 0)
+             (delete-region (point-min) (point)))
+         (while (not (eobp))
+           (cond 
+            ((looking-at "<PRE>\r?\n?") 
+             (delete-region (match-beginning 0) (match-end 0))
+             (setq p (point))
+             (when (search-forward "</PRE>" nil t)
+               (delete-region (match-beginning 0) (match-end 0))
+               (save-restriction
+                 (narrow-to-region p (point))
+                 (nnweb-remove-markup)
+                 (nnweb-decode-entities)
+                 (goto-char (point-max)))))
+            ((looking-at "<P><A HREF=\"\\([^\"]+\\)")
+             (setq url (match-string 1))
+             (delete-region (match-beginning 0) 
+                            (progn (forward-line) (point)))
+             ;; I hate to download the url encode it, then immediately 
+             ;; decode it.
+             ;; FixMe: Find a better solution to attach the URL.
+             ;; Maybe do some hack in external part of mml-generate-mim-1.
+             (insert "<#part>"
+                     "\n--\nExternal: \n"
+                     (format "<URL:http://www.mail-archive.com/%s/%s>" 
+                             group url)
+                     "\n--\n"
+                     "<#/part>")
+             (setq mime t))
+            (t
+             (setq p (point))
+             (insert "<#part type=\"text/html\" disposition=inline>")
+             (goto-char
+              (if (re-search-forward 
+                   "[\040\n\r\t]*<PRE>\\|[\040\n\r\t]*<P><A HREF=\"" 
+                   nil t)
+                  (match-beginning 0)
+                (point-max)))
+             (insert "<#/part>")
+             (setq mime t)))
+           (setq p (point))
+           (if (> (skip-chars-forward "\040\n\r\t") 0)
+               (delete-region p (point))))
+         (goto-char (point-max))))
+      (setq p (point))
+      (when (search-forward "X-References-End" nil t)
+       (setq e (point))
+       (beginning-of-line)
+       (search-backward "X-References" p t)
+       (while (re-search-forward "msg\\([0-9]+\\)\\.html" e t)
+         (push (concat "<" (match-string 1) "%" group ">") refs)))
+      (delete-region p (point-max))
+      (goto-char (point-min))
+      (insert (format "Message-ID: <%05d%%%s>\n" (1- article) group))
+      (when refs
+       (insert "References:")
+       (while refs
+         (insert " " (pop refs)))
+       (insert "\n"))
+      (when mime
+       (unless (looking-at "$") 
+         (search-forward "\n\n" nil t)
+         (forward-line -1))
+       (narrow-to-region (point) (point-max))
+       (insert "MIME-Version: 1.0\n"
+               (prog1
+                   (mml-generate-mime)
+                 (delete-region (point-min) (point-max))))
+       (widen)))
+    (buffer-string)))
 
 (provide 'nnwarchive)
 
index 1695f1e..5394105 100644 (file)
@@ -29,6 +29,7 @@
 ;;; Code:
 
 (eval-when-compile (require 'cl))
+
 (require 'nnoo)
 (require 'message)
 (require 'gnus-util)
@@ -185,7 +186,7 @@ and `altavista'.")
          (funcall (nnweb-definition 'article))
          (nnweb-decode-entities))
        (nnheader-report 'nnweb "Fetched article %s" article)
-       t))))
+       (cons group (and (numberp article) article))))))
 
 (deffoo nnweb-close-server (&optional server)
   (when (and (nnweb-server-opened server)
@@ -204,9 +205,7 @@ and `altavista'.")
     t))
 
 (deffoo nnweb-request-update-info (group info &optional server)
-  (nnweb-possibly-change-server group server)
-  ;;(setcar (cddr info) nil)
-  )
+  (nnweb-possibly-change-server group server))
 
 (deffoo nnweb-asynchronous-p ()
   t)
@@ -300,14 +299,10 @@ and `altavista'.")
   (unless (gnus-buffer-live-p nnweb-buffer)
     (setq nnweb-buffer
          (save-excursion
-           (let ((multibyte (default-value 'enable-multibyte-characters)))
-             (unwind-protect
-                 (progn
-                   (setq-default enable-multibyte-characters nil)
-                   (nnheader-set-temp-buffer
-                    (format " *nnweb %s %s %s*"
-                            nnweb-type nnweb-search server)))
-               (setq-default enable-multibyte-characters multibyte))
+           (mm-with-unibyte
+             (nnheader-set-temp-buffer
+              (format " *nnweb %s %s %s*"
+                      nnweb-type nnweb-search server))
              (current-buffer))))))
 
 (defun nnweb-fetch-url (url)
@@ -484,7 +479,6 @@ and `altavista'.")
          (goto-char (point-min))
          (search-forward "</pre><hr>" nil t)
          (delete-region (point-min) (point))
-                                       ;(nnweb-decode-entities)
          (goto-char (point-min))
          (while (re-search-forward "^ +[0-9]+\\." nil t)
            (narrow-to-region
@@ -724,12 +718,21 @@ and `altavista'.")
 (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))
-                                      ?#))
+  (while (re-search-forward "&\\(#[0-9]+\\|[a-z]+\\);" nil t)
+    (replace-match (char-to-string 
+                   (if (eq (aref (match-string 1) 0) ?\#)
+                       (string-to-number (substring (match-string 1) 1))
+                     (or (cdr (assq (intern (match-string 1))
+                                    w3-html-entities))
+                         ?#)))
                   t t)))
 
+(defun nnweb-decode-entities-string (str)
+  (with-temp-buffer
+    (insert str)
+    (nnweb-decode-entities)
+    (buffer-substring (point-min) (point-max))))
+
 (defun nnweb-remove-markup ()
   "Remove all HTML markup, leaving just plain text."
   (goto-char (point-min))
@@ -741,10 +744,24 @@ and `altavista'.")
   (while (re-search-forward "<[^>]+>" nil t)
     (replace-match "" t t)))
 
-(defun nnweb-insert (url)
-  "Insert the contents from an URL in the current buffer."
+(defun nnweb-insert (url &optional follow-refresh)
+  "Insert the contents from an URL in the current buffer.
+If FOLLOW-REFRESH is non-nil, redirect refresh url in META."
   (let ((name buffer-file-name))
-    (url-insert-file-contents url)
+    (if follow-refresh
+       (save-restriction
+         (narrow-to-region (point) (point))
+         (url-insert-file-contents url)
+         (goto-char (point-min))
+         (while (re-search-forward 
+                 "HTTP-EQUIV=\"Refresh\"[^>]*URL=\\([^\"]+\\)\""
+                 nil t)
+           (let ((url (match-string 1)))
+             (delete-region (point-min) (point-max))
+             (nnweb-insert url))
+           (goto-char (point-min)))
+         (goto-char (point-max)))
+      (url-insert-file-contents url))
     (setq buffer-file-name name)))
 
 (defun nnweb-parse-find (type parse &optional maxdepth)
index ec0d071..11e4682 100644 (file)
 
 (unless (aref parse-time-digits ?0)
   (loop for i from ?0 to ?9
-       do (aset parse-time-digits i (- i ?0))))
+    do (aset parse-time-digits i (- i ?0))))
 
 (unless (aref parse-time-syntax ?0)
   (loop for i from ?0 to ?9
-       do (aset parse-time-syntax i ?0))
+    do (aset parse-time-syntax i ?0))
   (loop for i from ?A to ?Z
-       do (aset parse-time-syntax i ?A))
+    do (aset parse-time-syntax i ?A))
   (loop for i from ?a to ?z
-       do (aset parse-time-syntax i ?a))
+    do (aset parse-time-syntax i ?a))
   (aset parse-time-syntax ?+ 1)
   (aset parse-time-syntax ?- -1)
   (aset parse-time-syntax ?: ?d)
index b544159..24ea4e5 100644 (file)
@@ -36,6 +36,7 @@
 ;;; Code:
 
 (eval-when-compile (require 'cl))
+
 (require 'mail-utils)
 
 (defconst pop3-version "1.3s")
@@ -155,6 +156,28 @@ Nil means no, t means yes, not-nil-or-t means yet to be determined.")
     (kill-buffer crashbuf)
     message-count))
 
+(defun pop3-get-message-count ()
+  "Return the number of messages in the maildrop."
+  (let* ((process (pop3-open-server pop3-mailhost pop3-port))
+        message-count
+        (pop3-password pop3-password)
+        )
+    ;; for debugging only
+    (if pop3-debug (switch-to-buffer (process-buffer process)))
+    ;; query for password
+    (if (and pop3-password-required (not pop3-password))
+       (setq pop3-password
+             (pop3-read-passwd (format "Password for %s: " pop3-maildrop))))
+    (cond ((equal 'apop pop3-authentication-scheme)
+          (pop3-apop process pop3-maildrop))
+         ((equal 'pass pop3-authentication-scheme)
+          (pop3-user process pop3-maildrop)
+          (pop3-pass process))
+         (t (error "Invalid POP3 authentication scheme.")))
+    (setq message-count (car (pop3-stat process)))
+    (pop3-quit process)
+    message-count))
+
 (defun pop3-open-server (mailhost port)
   "Open TCP connection to MAILHOST.
 Returns the process associated with the connection.
@@ -240,15 +263,15 @@ Args are NAME BUFFER HOST SERVICE."
     (insert output)))
 
 (defun pop3-send-command (process command)
-    (set-buffer (process-buffer process))
-    (goto-char (point-max))
-;;    (if (= (aref command 0) ?P)
-;;     (insert "PASS <omitted>\r\n")
-;;      (insert command "\r\n"))
-    (setq pop3-read-point (point))
-    (goto-char (point-max))
-    (process-send-string process (concat command "\r\n"))
-    )
+  (set-buffer (process-buffer process))
+  (goto-char (point-max))
+  ;;    (if (= (aref command 0) ?P)
+  ;;   (insert "PASS <omitted>\r\n")
+  ;;      (insert command "\r\n"))
+  (setq pop3-read-point (point))
+  (goto-char (point-max))
+  (process-send-string process (concat command "\r\n"))
+  )
 
 (defun pop3-read-response (process &optional return)
   "Read the response from the server PROCESS.
index 56203e9..8643104 100644 (file)
        (message "Malformed MIME quoted-printable message"))))))
 
 (defun quoted-printable-decode-string (string)
- "Decode the quoted-printable-encoded STRING and return the results."
- (with-temp-buffer
-   (insert string)
-   (quoted-printable-decode-region (point-min) (point-max))
-   (buffer-string)))
+  "Decode the quoted-printable-encoded STRING and return the results."
+  (with-temp-buffer
+    (insert string)
+    (quoted-printable-decode-region (point-min) (point-max))
+    (buffer-string)))
 
 (defun quoted-printable-encode-region (from to &optional fold class)
   "QP-encode the region between FROM and TO.
-If FOLD, fold long lines.  If CLASS, translate the characters
-matched by that regexp."
+
+If FOLD fold long lines.  If CLASS, translate the characters 
+matched by that regexp.
+
+If `mm-use-ultra-safe-encoding' is set, fold unconditionally and
+encode lines starting with \"From\"."
   (interactive "r")
   (save-excursion
     (save-restriction
       (narrow-to-region from to)
-;;      (mm-encode-body)
+      ;;      (mm-encode-body)
       ;; Encode all the non-ascii and control characters.
       (goto-char (point-min))
       (while (and (skip-chars-forward
@@ -92,14 +96,20 @@ matched by that regexp."
           (prog1
               (upcase (format "=%02x" (char-after)))
             (delete-char 1)))))
-      (when fold
+      (when (or fold mm-use-ultra-safe-encoding)
        ;; Fold long lines.
        (goto-char (point-min))
        (while (not (eobp))
+         ;; In ultra-safe mode, encode "From " at the beginning of a
+         ;; line.
+         (when mm-use-ultra-safe-encoding
+           (beginning-of-line)
+           (when (looking-at "From ")
+             (replace-match "From=20" nil t)))
          (end-of-line)
          (while (> (current-column) 72)
            (beginning-of-line)
-           (forward-char 71) ;; 71 char plus an "="
+           (forward-char 71);; 71 char plus an "="
            (search-backward "=" (- (point) 2) t)
            (insert "=\n")
            (end-of-line))
@@ -107,11 +117,11 @@ matched by that regexp."
            (forward-line)))))))
 
 (defun quoted-printable-encode-string (string)
- "QP-encode STRING and return the results."
- (mm-with-unibyte-buffer
-   (insert string)
-   (quoted-printable-encode-region (point-min) (point-max))
-   (buffer-string)))
+  "QP-encode STRING and return the results."
+  (mm-with-unibyte-buffer
+    (insert string)
+    (quoted-printable-encode-region (point-min) (point-max))
+    (buffer-string)))
 
 (provide 'qp)
 
index adf475d..b55120c 100644 (file)
@@ -1,10 +1,10 @@
 ;;; rfc1843.el --- HZ (rfc1843) decoding
-;; Copyright (c) 1998,1999 by Shenghuo Zhu <zsh@cs.rochester.edu>
+;; Copyright (c) 1998,99 Free Software Foundation, Inc.
 
 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
-;; Keywords: news HZ
+;; Keywords: news HZ HZ+
 
-;; This file is a part of GNU Emacs, but the same permissions apply.
+;; This file is a part of GNU Emacs.
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published
 (require 'mm-util)
 
 (defvar rfc1843-word-regexp
-  "~\\({\\([\041-\167][\041-\176]\\| \\)+\\(~}\\|$\\)")
+  "~\\({\\([\041-\167][\041-\176]\\| \\)+\\)\\(~}\\|$\\)")
 
 (defvar rfc1843-word-regexp-strictly
-      "~\\({\\([\041-\167][\041-\176]\\)+\\(~}\\|$\\)")
+  "~\\({\\([\041-\167][\041-\176]\\)+\\)\\(~}\\|$\\)")
 
 (defvar rfc1843-hzp-word-regexp
   "~\\({\\([\041-\167][\041-\176]\\| \\)+\\|\
 [<>]\\([\041-\175][\041-\176]\\| \\)+\\)\\(~}\\|$\\)")
 
 (defvar rfc1843-hzp-word-regexp-strictly
-      "~\\({\\([\041-\167][\041-\176]\\)+\\|\
+  "~\\({\\([\041-\167][\041-\176]\\)+\\|\
 [<>]\\([\041-\175][\041-\176]\\)+\\)\\(~}\\|$\\)")
 
 (defcustom rfc1843-decode-loosely nil
@@ -86,7 +86,10 @@ ftp://ftp.math.psu.edu/pub/simpson/chinese/hzp/hzp.doc"
            (while (re-search-forward (if rfc1843-decode-hzp
                                          rfc1843-hzp-word-regexp
                                        rfc1843-word-regexp) (point-max) t)
-             (setq str (match-string 1))
+             ;;; Text with extents may cause XEmacs crash
+             (setq str (buffer-substring-no-properties 
+                        (match-beginning 1)
+                        (match-end 1)))
              (setq firstc (aref str 0))
              (insert (mm-decode-coding-string
                       (rfc1843-decode
@@ -100,8 +103,8 @@ ftp://ftp.math.psu.edu/pub/simpson/chinese/hzp/hzp.doc"
              (cond ((eq (char-after) ?\n)
                     (delete-char -1)
                     (delete-char 1))
-                 ((eq (char-after) ?~)
-                  (delete-char 1)))))))))
+                   ((eq (char-after) ?~)
+                    (delete-char 1)))))))))
 
 (defun rfc1843-decode-string (string)
   "Decode HZ STRING and return the results."
@@ -115,7 +118,7 @@ ftp://ftp.math.psu.edu/pub/simpson/chinese/hzp/hzp.doc"
       (buffer-string))))
 
 (defun rfc1843-decode (word &optional firstc)
-  "Decode HZ WORD and return it"
+  "Decode HZ WORD and return it."
   (let ((i -1) (s (substring word 0)) v)
     (if (or (not firstc) (eq firstc ?{))
        (while (< (incf i) (length s))
@@ -130,26 +133,26 @@ ftp://ftp.math.psu.edu/pub/simpson/chinese/hzp/hzp.doc"
     s))
 
 (defun rfc1843-decode-article-body ()
-   "Decode HZ encoded text in the article body."
-   (if (string-match (concat "\\<\\(" rfc1843-newsgroups-regexp "\\)\\>")
-                    (or gnus-newsgroup-name ""))
-       (save-excursion
-        (save-restriction
-          (message-narrow-to-head)
-          (let* ((inhibit-point-motion-hooks t)
-                 (case-fold-search t)
-                 (ct (message-fetch-field "Content-Type" t))
-                 (ctl (and ct (ignore-errors
-                                (mail-header-parse-content-type ct)))))
-            (if (and ctl (not (string-match "/" (car ctl)))) 
-                (setq ctl nil))
-            (goto-char (point-max))
-            (widen)
-            (forward-line 1)
-            (narrow-to-region (point) (point-max))
-            (when (or (not ctl)
-                      (equal (car ctl) "text/plain"))
-              (rfc1843-decode-region (point) (point-max))))))))
+  "Decode HZ encoded text in the article body."
+  (if (string-match (concat "\\<\\(" rfc1843-newsgroups-regexp "\\)\\>")
+                   (or gnus-newsgroup-name ""))
+      (save-excursion
+       (save-restriction
+         (message-narrow-to-head)
+         (let* ((inhibit-point-motion-hooks t)
+                (case-fold-search t)
+                (ct (message-fetch-field "Content-Type" t))
+                (ctl (and ct (ignore-errors
+                               (mail-header-parse-content-type ct)))))
+           (if (and ctl (not (string-match "/" (car ctl)))) 
+               (setq ctl nil))
+           (goto-char (point-max))
+           (widen)
+           (forward-line 1)
+           (narrow-to-region (point) (point-max))
+           (when (or (not ctl)
+                     (equal (car ctl) "text/plain"))
+             (rfc1843-decode-region (point) (point-max))))))))
 
 (defvar rfc1843-old-gnus-decode-header-function  nil)
 (defvar gnus-decode-header-methods)
index 3344753..74705da 100644 (file)
@@ -133,13 +133,13 @@ Should be called narrowed to the head of the message."
        (encode-coding-region (point-min) (point-max)
                              mail-parse-charset)))))
 
-(defun rfc2047-encodable-p ()
-  "Say whether the current (narrowed) buffer contains characters that need encoding."
+(defun rfc2047-encodable-p (&optional header)
+  "Say whether the current (narrowed) buffer contains characters that need encoding in headers."
   (let ((charsets
         (mapcar
          'mm-mime-charset
          (mm-find-charset-region (point-min) (point-max))))
-       (cs (list 'us-ascii mail-parse-charset))
+       (cs (list 'us-ascii (car message-posting-charset)))
        found)
     (while charsets
       (unless (memq (pop charsets) cs)
@@ -148,18 +148,58 @@ Should be called narrowed to the head of the message."
 
 (defun rfc2047-dissect-region (b e)
   "Dissect the region between B and E into words."
-  (let (words)
+  (let ((all-specials (concat ietf-drums-tspecials " \t\n\r"))
+       (special-list (mapcar 'identity ietf-drums-tspecials))
+       (blank-list '(?  ?\t ?\n ?\r))
+       words current cs state mail-parse-mule-charset)
     (save-restriction
       (narrow-to-region b e)
       (goto-char (point-min))
-      (while (re-search-forward
-             (concat "[^" ietf-drums-tspecials " \t\n]+") nil t)
-       (push
-        (list (match-beginning 0) (match-end 0)
-              (car (delq 'ascii (mm-find-charset-region
-                                 (match-beginning 0) (match-end 0)))))
-        words))
-      words)))
+      (skip-chars-forward all-specials)
+      (setq b (point))
+      (while (not (eobp))
+       (cond
+        ((not state)
+         (if (memq (char-after) blank-list)
+             (setq state 'blank)
+           (setq state 'word)
+           (if (not (eq (setq cs (mm-charset-after)) 'ascii))
+               (setq current cs)))
+         (setq b (point)))
+        ((eq state 'blank)
+         (cond 
+          ((memq (char-after) special-list)
+           (setq state nil))
+          ((memq (char-after) blank-list))
+          (t
+           (setq state 'word)
+           (if (not (eq (setq cs (mm-charset-after)) 'ascii))
+               (setq current cs)))))
+        ((eq state 'word)
+         (cond 
+          ((memq (char-after) special-list)
+           (setq state nil)
+           (push (list b (point) current) words)
+           (setq current nil))
+          ((memq (char-after) blank-list)
+           (setq state 'blank)
+           (push (list b (point) current) words)
+           (setq current nil)
+           (setq b (point)))
+          ((or (eq (setq cs (mm-charset-after)) 'ascii)
+               (if current
+                   (eq current cs)
+                 (setq current cs))))
+          (t
+           (push (list b (point) current) words)
+           (setq current cs)
+           (setq b (point))))))
+       (if state
+           (forward-char)
+         (skip-chars-forward all-specials)))
+      (if (eq state 'word)
+         (push (list b (point) current) words)))
+    words))
 
 (defun rfc2047-encode-region (b e)
   "Encode all encodable words in REGION."
@@ -231,8 +271,8 @@ Should be called narrowed to the head of the message."
         ((and (looking-at "\\?=")
               (> (- (point) (save-excursion (beginning-of-line) (point))) 76))
          (goto-char break)
-         (insert "\n ")
-         (forward-line 1)))
+         (setq break nil)
+         (insert "\n ")))
        (unless (eobp)
          (forward-char 1))))))
 
@@ -337,7 +377,7 @@ Return WORD if not."
 Valid ENCODINGs are \"B\" and \"Q\".
 If your Emacs implementation can't decode CHARSET, it returns nil."
   (if (stringp charset)
-    (setq charset (intern (downcase charset))))
+      (setq charset (intern (downcase charset))))
   (if (or (not charset) 
          (eq 'gnus-all mail-parse-ignored-charsets)
          (memq 'gnus-all mail-parse-ignored-charsets)
@@ -347,7 +387,7 @@ If your Emacs implementation can't decode CHARSET, it returns nil."
     (if (and (not cs) charset 
             (listp mail-parse-ignored-charsets)
             (memq 'gnus-unknown mail-parse-ignored-charsets))
-      (setq cs (mm-charset-to-coding-system mail-parse-charset)))
+       (setq cs (mm-charset-to-coding-system mail-parse-charset)))
     (when cs
       (when (and (eq cs 'ascii)
                 mail-parse-charset)
index dd8eba3..999ee44 100644 (file)
@@ -27,6 +27,7 @@
 
 (eval-when-compile (require 'cl))
 (eval-when-compile (require 'static))
+
 (require 'easymenu)
 
 (defvar gnus-score-mode-hook nil
index 76b2884..f7cdda1 100644 (file)
@@ -36,6 +36,7 @@
 ;; The smilies were drawn by Joe Reiss <jreiss@vt.edu>.
 
 (eval-when-compile (require 'cl))
+
 (require 'annotations)
 (require 'messagexmas)
 (require 'custom)
@@ -154,7 +155,7 @@ above them."
 (defvar smiley-running-xemacs (string-match "XEmacs" emacs-version))
 
 (defvar smiley-map (make-sparse-keymap "smiley-keys")
- "Keymap to toggle smiley states.")
+  "Keymap to toggle smiley states.")
 
 (define-key smiley-map [(button2)] 'smiley-toggle-extent)
 (define-key smiley-map [(button3)] 'smiley-popup-menu)
@@ -256,13 +257,8 @@ above them."
          (while (re-search-forward regexp nd t)
            (let* ((start (match-beginning group))
                   (end (match-end group))
-                  (glyph
-                   (and (or (eq start 1)
-                            (not (string-match "\\(\\^\\|;\\|_\\);)"
-                                               (buffer-substring
-                                                (1- start) (+ start 2)))))
-                        (smiley-create-glyph (buffer-substring start end)
-                                             file))))
+                  (glyph (smiley-create-glyph (buffer-substring start end)
+                                              file)))
              (when glyph
                (mapcar 'delete-annotation (annotations-at end))
                (let ((ext (make-extent start end))
@@ -351,4 +347,8 @@ With arg, turn displaying on if and only if arg is positive."
 
 (provide 'smiley)
 
+;; Local Variables:
+;; coding: iso-8859-1
+;; End:
+
 ;;; smiley.el ends here
index 448bc54..99c4135 100644 (file)
@@ -25,6 +25,7 @@
 ;;; Code:
 
 (eval-when-compile (require 'cl))
+
 (require 'parse-time)
 
 (defun date-to-time (date)
index 299f83b..7b709e2 100644 (file)
@@ -1,12 +1,10 @@
 ;;; uudecode.el -- elisp native uudecode
-;; Copyright (c) 1998 by Shenghuo Zhu <zsh@cs.rochester.edu>
+;; Copyright (c) 1998,99 Free Software Foundation, Inc.
 
 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
-;; $Revision: 5.7 $
-;; Keywords: uudecode
+;; Keywords: uudecode news
 
-;; This file is not part of GNU Emacs, but the same permissions
-;; apply.
+;; This file is a part of GNU Emacs.
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
@@ -169,25 +167,25 @@ If FILE-NAME is non-nil, save the result to FILE-NAME."
                         (uudecode-insert-char
                          (logand (lsh bits -8) 255) 1 nil work-buffer)
                         (uudecode-insert-char (logand bits 255) 1 nil
-                                        work-buffer)
+                                              work-buffer)
                         (setq bits 0 counter 0))
                        (t (setq bits (lsh bits 6)))))))
              (cond
-                (done)
-                ((> 0 remain)
-                 (error "uucode line ends unexpectly")
-                 (setq done t))
-                ((and (= (point) end) (not done))
-                 ;(error "uucode ends unexpectly")
-                 (setq done t))
-                ((= counter 3)
-                 (uudecode-insert-char (logand (lsh bits -16) 255) 1 nil
-                                 work-buffer)
-                 (uudecode-insert-char (logand (lsh bits -8) 255) 1 nil
-                                 work-buffer))
-                ((= counter 2)
-                 (uudecode-insert-char (logand (lsh bits -10) 255) 1 nil
-                                 work-buffer)))
+              (done)
+              ((> 0 remain)
+               (error "uucode line ends unexpectly")
+               (setq done t))
+              ((and (= (point) end) (not done))
+               ;;(error "uucode ends unexpectly")
+               (setq done t))
+              ((= counter 3)
+               (uudecode-insert-char (logand (lsh bits -16) 255) 1 nil
+                                     work-buffer)
+               (uudecode-insert-char (logand (lsh bits -8) 255) 1 nil
+                                     work-buffer))
+              ((= counter 2)
+               (uudecode-insert-char (logand (lsh bits -10) 255) 1 nil
+                                     work-buffer)))
              (skip-chars-forward non-data-chars end))
            (if file-name
                (save-excursion
index 8fe0fdc..1b9b9c4 100644 (file)
@@ -2,7 +2,7 @@
 ;; Copyright (C) 1999 Free Software Foundation, Inc.
 
 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
-;; Keywords: hotmail
+;; Keywords: hotmail yahoo netaddress my-deja
 
 ;; This file is part of GNU Emacs.
 
 ;;; Commentary:
 
 ;; Note: You need to have `url' and `w3' installed for this backend to
-;; work.
+;; work. `w3' must be 4.0pre46+one-line-cookie patch or standalone
+;; `url'.
 
 ;; Todo: To support more web mail servers.
 
 ;; Known bugs: 
-;; 1. In w3, there are two copies of url-maybe-relative.
-;;    If it is loaded from w3.el, (load-library "url"). 
-;;    Fixed in w3 4.0pre46.
-;; 2. Hotmail only accept one line cookie, while w3 breaks cookies 
-;;    into lines.
-;;    Maybe fixed in w3 4.0pre47+?.
-;; 3. Net@ddress may corrupt `X-Face'.
+;; 1. Net@ddress may corrupt `X-Face'.
 
 ;; Warning:
 ;; Webmail is an experimental function, which means NO WARRANTY.
   (ignore-errors
     (require 'w3)
     (require 'url)
+    (require 'url-cookie)
     (require 'w3-forms)
     (require 'nnweb)))
 ;; Report failure to find w3 at load time if appropriate.
 (eval '(progn
         (require 'w3)
         (require 'url)
+        (require 'url-cookie)
         (require 'w3-forms)
         (require 'nnweb)))
 
      ;; Hotmail hate other HTTP user agents and use one line cookie
      (paranoid agent cookie post)
      (address . "www.hotmail.com")
-     (open-url "http://www.hotmail.com")
+     (open-url "http://www.hotmail.com/")
      (open-snarf . webmail-hotmail-open)
      ;; W3 hate redirect POST
      (login-url
       "http://%s/cgi-bin/dologin?login=%s&passwd=%s&enter=Sign+in&sec=no&curmbox=ACTIVE&_lang=&js=yes&id=2&tw=-10000&beta="
-       webmail-aux user password)
+      webmail-aux user password)
      (list-snarf . webmail-hotmail-list)
      (article-snarf . webmail-hotmail-article)
      (trash-url 
@@ -85,9 +82,9 @@
     (yahoo
      (paranoid cookie post)
      (address . "mail.yahoo.com")
-     (open-url "http://mail.yahoo.com")
+     (open-url "http://mail.yahoo.com/")
      (open-snarf . webmail-yahoo-open)
-     (login-url ;; yahoo will not accept GET
+     (login-url;; yahoo will not accept GET
       content 
       ("%s" webmail-aux)
       ".tries=1&.src=ym&.last=&promo=&lg=us&.intl=us&.bypass=&.chkP=Y&.done=http%%253a%%2F%%2Fedit.yahoo.com%%2Fconfig%%2Fmail%%253f.intl%%3D&login=%s&passwd=%s" 
     (netaddress
      (paranoid cookie post)
      (address . "www.netaddress.com")
-     (open-url "http://www.netaddress.com")
+     (open-url "http://www.netaddress.com/")
      (open-snarf . webmail-netaddress-open)
-     (login-url ;; yahoo will not accept GET
+     (login-url
       content 
       ("%s" webmail-aux)
       "LoginState=2&SuccessfulLogin=%%2Ftpl&NewServerName=www.netaddress.com&JavaScript=JavaScript1.2&DomainID=4&NA31site=classic.netaddress.com&NA31port=80&UserID=%s&passwd=%s" 
      (article-snarf . webmail-netaddress-article)
      (trash-url 
       "http://www.netaddress.com/tpl/Message/%s/Move?FolderID=-4&Q=%s&N=&Sort=Date&F=-1"
-      webmail-session id))))
+      webmail-session id))
+    (my-deja
+     (paranoid cookie post)
+     (address . "www.my-deja.com")
+     (open-url "http://www.my-deja.com/")
+     (open-snarf . webmail-my-deja-open)
+     (login-url
+      content 
+      ("%s" webmail-aux)
+      "user=%s&pw=%s&autologout=60&go="
+      user password)
+     (list-url "http://www.deja.com/rg_gotomail.xp")
+     (list-snarf . webmail-my-deja-list)
+     (article-snarf . webmail-my-deja-article)
+     (trash-url 
+      "%s/gmm_multiplex.femail?%%2Fgmm_domovemesg_top.femail=Move+to%%3A&folder_top=%s%%3Azzz%%3A%%7E6trash%%3AF%%3A0&docid=%s"
+      webmail-aux user id))))
 
 (defvar webmail-variables
   '(address article-snarf article-url list-snarf list-url 
 
 (defvar webmail-buffer nil)
 (defvar webmail-buffer-list nil)
+
+(defvar webmail-type nil)
+
 ;;; Interface functions
 
+(defun webmail-error (str)
+  (message "%s HTML has changed; please get a new version of webmail (%s)"
+          webmail-type str)
+  (error "%s HTML has changed; please get a new version of webmail (%s)"
+        webmail-type str))
+
 (defun webmail-setdefault (type)
   (let ((type-def (cdr (assq type webmail-type-definition)))
        (vars webmail-variables)
        pair)
+    (setq webmail-type type)
     (dolist (var vars)
       (if (setq pair (assq var type-def))
          (set (intern (concat "webmail-" (symbol-name var))) (cdr pair))
     expr)))
 
 (defun webmail-url (xurl)
-  (cond 
-   ((eq (car xurl) 'content)
-    (pop xurl)
-    (webmail-fetch-simple (if (stringp (car xurl))
-                             (car xurl)
-                           (apply 'format (webmail-eval (car xurl))))
-                         (apply 'format (webmail-eval (cdr xurl)))))
-   ((eq (car xurl) 'post)
-    (pop xurl)
-    (webmail-fetch-form (car xurl) (webmail-eval (cdr xurl))))
-   (t
-    (nnweb-insert (apply 'format (webmail-eval xurl))))))
-
-(defun webmail-decode-entities ()
-  (goto-char (point-min))
-  (while (re-search-forward "&\\(#[0-9]+\\|[a-z]+\\);" nil t)
-    (replace-match (char-to-string 
-                   (if (eq (aref (match-string 1) 0) ?\#)
-                       (string-to-number (substring (match-string 1) 1))
-                     (or (cdr (assq (intern (match-string 1))
-                                    w3-html-entities))
-                         ?#)))
-                  t t)))
-
-(defun webmail-decode-entities-string (str)
-  (with-temp-buffer
-    (insert str)
-    (webmail-decode-entities)
-    (buffer-substring (point-min) (point-max))))
-
-(defun webmail-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)))
-
+  (mm-with-unibyte-current-buffer
+    (cond 
+     ((eq (car xurl) 'content)
+      (pop xurl)
+      (webmail-fetch-simple (if (stringp (car xurl))
+                               (car xurl)
+                             (apply 'format (webmail-eval (car xurl))))
+                           (apply 'format (webmail-eval (cdr xurl)))))
+     ((eq (car xurl) 'post)
+      (pop xurl)
+      (webmail-fetch-form (car xurl) (webmail-eval (cdr xurl))))
+     (t
+      (nnweb-insert (apply 'format (webmail-eval xurl)))))))
+  
 (defun webmail-init ()
   "Initialize buffers and such."
   (if (gnus-buffer-live-p webmail-buffer)
       (set-buffer webmail-buffer)
     (setq webmail-buffer
-         (nnheader-set-temp-buffer " *webmail*"))))
+         (mm-with-unibyte
+           (nnheader-set-temp-buffer " *webmail*")))))
 
 (defvar url-package-name)
 (defvar url-package-version)
 (defvar url-cookie-multiple-line)
 (defvar url-confirmation-func)
 
-;; Hack W3 POST redirect. See `url-parse-mime-headers'.
+;; Hack W3 POST redirect.  See `url-parse-mime-headers'.
 ;;
 ;; Netscape uses "GET" as redirect method when orignal method is POST
 ;; and status is 302, .i.e no security risks by default without
 (defun webmail-url-confirmation-func (prompt)
   (cond 
    ((equal prompt (concat "Honor redirection with non-GET method "
-                      "(possible security risks)? "))
+                         "(possible security risks)? "))
     nil)
    ((equal prompt "Continue (with method of GET)? ")
     t)
 (defun webmail-refresh-redirect ()
   "Redirect refresh url in META."
   (goto-char (point-min))
-  (while (re-search-forward "HTTP-EQUIV=\"Refresh\"[^>]*URL=\\([^\"]+\\)\""
-                          nil t)
+  (while (re-search-forward 
+         "HTTP-EQUIV=\"Refresh\"[^>]*URL=\\([^\"]+\\)\""
+         nil t)
     (let ((url (match-string 1)))
       (erase-buffer)
-      (nnweb-insert url))
+      (mm-with-unibyte-current-buffer
+       (nnweb-insert url)))
     (goto-char (point-min))))
 
 (defun webmail-fetch (file subtype user password)
       (if webmail-list-snarf 
          (funcall webmail-list-snarf))
       (while (setq item (pop webmail-articles))
-         (message "Fetching mail #%d..." (setq n (1+ n)))
-         (erase-buffer)
-         (nnweb-insert (cdr item))
-         (setq id (car item))
-         (if webmail-article-snarf 
-             (funcall webmail-article-snarf file id))
-         (when (and webmail-trash-url webmail-move-to-trash-can)
-           (message "Move mail #%d to trash can..." n)
-           (condition-case err
-               (progn
-                 (webmail-url webmail-trash-url)
-                 (let (buf)
-                   (while (setq buf (pop webmail-buffer-list))
-                     (kill-buffer buf))))
-             (error 
-              (let (buf)
-                (while (setq buf (pop webmail-buffer-list))
-                  (kill-buffer buf)))
-              (error err))))))
+       (message "Fetching mail #%d..." (setq n (1+ n)))
+       (erase-buffer)
+       (mm-with-unibyte-current-buffer
+         (nnweb-insert (cdr item)))
+       (setq id (car item))
+       (if webmail-article-snarf 
+           (funcall webmail-article-snarf file id))
+       (when (and webmail-trash-url webmail-move-to-trash-can)
+         (message "Move mail #%d to trash can..." n)
+         (condition-case err
+             (progn
+               (webmail-url webmail-trash-url)
+               (let (buf)
+                 (while (setq buf (pop webmail-buffer-list))
+                   (kill-buffer buf))))
+           (error 
+            (let (buf)
+              (while (setq buf (pop webmail-buffer-list))
+                (kill-buffer buf)))
+            (error err))))))
     (if webmail-post-process
        (funcall webmail-post-process))))
 
+(defun webmail-encode-8bit ()
+  (goto-char (point-min))
+  (skip-chars-forward "^\200-\377")
+  (while (not (eobp))
+    (insert (format "&%d;" (mm-char-int (char-after))))
+    (delete-char 1)
+    (skip-chars-forward "^\200-\377")))
+
 ;;; hotmail
 
 (defun webmail-hotmail-open ()
   (if (re-search-forward 
        "action=\"https?://\\([^/]+\\)/cgi-bin/dologin" nil t)
       (setq webmail-aux (match-string 1))
-    (error "Can't find login url (open@1)")))
+    (webmail-error "open@1")))
 
 (defun webmail-hotmail-list ()
   (let (site url newp)
     (goto-char (point-min))
-    (if (re-search-forward "[0-9]+ messages, [0-9]+ new") 
-       (message "Found %s" (match-string 0)))
+    (if (re-search-forward "[0-9]+ messages, [0-9]+ new" nil t) 
+       (message "Found %s" (match-string 0))
+      (webmail-error "maybe your w3 version is too old"))
     (goto-char (point-min))
     (if (re-search-forward 
         "action=\"https?://\\([^/]+\\)/cgi-bin/HoTMaiL" nil t)
        (setq site (match-string 1))
-      (error "Can't find server url (list@1)"))
+      (webmail-error "list@1"))
     (goto-char (point-min))
     (if (re-search-forward "disk=\\([^&]+\\)&" nil t)
        (setq webmail-aux 
              (concat "http://" site "/cgi-bin/HoTMaiL?disk=" 
                      (match-string 1)))
-      (error "Can't find disk (list@2)"))
+      (webmail-error "list@2"))
     (goto-char (point-max))
     (while (re-search-backward 
            "newmail\\.gif\\|href=\"\\(/cgi-bin/getmsg\\?[^\"]+\\)\"" 
                (let (id)
                  (if (string-match "msg=\\([^&]+\\)" url)
                      (setq id (match-string 1 url)))
-                 (push (cons id (concat "http://" site url)) 
+                 (push (cons id (concat "http://" site url "&raw=0")) 
                        webmail-articles)))
            (setq newp nil))
        (setq newp t)))))
 
+;; Thank victor@idaccr.org (Victor S. Miller) for raw=0
+
 (defun webmail-hotmail-article (file id)
-  (let (p attachment count mime)
+  (goto-char (point-min))
+  (if (not (search-forward "<pre>" nil t))
+      (webmail-error "article@3"))
+  (skip-chars-forward "\n\r\t ")
+  (delete-region (point-min) (point))
+  (if (not (search-forward "</pre>" nil t))
+      (webmail-error "article@3.1"))
+  (delete-region (match-beginning 0) (point-max))
+  (nnweb-remove-markup)
+  (nnweb-decode-entities)
+  (goto-char (point-min))
+  (while (re-search-forward "\r\n?" nil t)
+    (replace-match "\n"))
+  (goto-char (point-min))
+  (insert "\n\n")
+  (if (not (looking-at "\n*From "))
+      (insert "From nobody " (current-time-string) "\n"))
+  (mm-append-to-file (point-min) (point-max) file))
+
+(defun webmail-hotmail-article-old (file id)
+  (let (p attachment count mime hotmail-direct)
     (save-restriction
+      (webmail-encode-8bit)
       (goto-char (point-min))
       (if (not (search-forward "<DIV>" nil t))
-         (error "Can't find start label (article@1)"))
-      (narrow-to-region (point-min) (match-beginning 0))
+         (if (not (search-forward "Reply&nbsp;All" nil t))
+             (webmail-error "article@1")
+           (setq hotmail-direct t))
+       (goto-char (match-beginning 0)))
+      (narrow-to-region (point-min) (point))
       (if (not (search-backward "<table" nil t 2))
-         (error "Can't find start label (article@1.1)"))
+         (webmail-error "article@1.1"))
       (delete-region (point-min) (match-beginning 0)) 
       (while (search-forward "<a href=" nil t)
        (setq p (match-beginning 0))
        (search-forward "</a>" nil t)
        (delete-region p (match-end 0)))
-      (webmail-remove-markup)
-      (webmail-decode-entities)
+      (nnweb-remove-markup)
+      (nnweb-decode-entities)
       (goto-char (point-min))
       (delete-blank-lines)
       (goto-char (point-min))
       (widen)
       (insert "\n")
       (setq p (point))
-      (while (re-search-forward "<div>\\|\\(http://[^/]+/cgi-bin/getmsg/\\([^\?]+\\)\?[^\"]*\\)\"" nil t)
+      (while (re-search-forward 
+             "<tt>\\|<div>\\|\\(http://[^/]+/cgi-bin/getmsg/\\([^\?]+\\)\?[^\"]*\\)\"" 
+             nil t)
        (if (setq attachment (match-string 1))
            (let ((filename (match-string 2))
-                 bufname) ;; Attachment
+                 bufname);; Attachment
              (delete-region p (match-end 0))
              (save-excursion
                (set-buffer (generate-new-buffer " *webmail-att*"))
              (insert "><#/part>\n")
              (setq p (point)))
          (delete-region p (match-end 0))
-         (setq count 1)
-         (while (and (> count 0) 
-                     (re-search-forward "</div>\\|\\(<div>\\)" nil t))
-           (if (match-string 1)
-               (setq count (1+ count))
-             (if (= (setq count (1- count)) 0)
-                 (delete-region (match-beginning 0)
-                                (match-end 0)))))
+         (if hotmail-direct
+             (if (not (search-forward "</tt>" nil t))
+                 (webmail-error "article@1.2")
+               (delete-region (match-beginning 0) (match-end 0)))
+           (setq count 1)
+           (while (and (> count 0) 
+                       (re-search-forward "</div>\\|\\(<div>\\)" nil t))
+             (if (match-string 1)
+                 (setq count (1+ count))
+               (if (= (setq count (1- count)) 0)
+                   (delete-region (match-beginning 0)
+                                  (match-end 0))))))
          (narrow-to-region p (point))
          (goto-char (point-min))
          (cond 
            (goto-char (match-end 0))
            (if (looking-at "$") (forward-char))
            (delete-region (point-min) (point))
-           (webmail-remove-markup)
-           (webmail-decode-entities)
+           (nnweb-remove-markup)
+           (nnweb-decode-entities)
            nil)
           (t
            (setq mime t)
       ;; Some blank line to seperate mails.
       (insert "\n\nFrom nobody " (current-time-string) "\n")
       (if id
-         (insert "Message-ID: <" id "@hotmail.com>\n"))
+         (insert (format "Message-ID: <%s@hotmail.com>\n" id)))
       (unless (looking-at "$") 
-       (search-forward "\n\n" nil t)
-       (forward-line -1))
+       (if (search-forward "\n\n" nil t)
+           (forward-line -1)
+         (webmail-error "article@2")))
       (narrow-to-region (point) (point-max))
       (if mime
          (insert "MIME-Version: 1.0\n"
   (goto-char (point-min))
   (if (re-search-forward "action=\"\\([^\"]+\\)\"" nil t)
       (setq webmail-aux (match-string 1))
-    (error "Can't find login url (open@1)")))
+    (webmail-error "open@1")))
 
 (defun webmail-yahoo-login ()
   (goto-char (point-min))
   (if (re-search-forward "http://[a-zA-Z][0-9]\\.mail\\.yahoo\\.com/" nil t)
       (setq webmail-aux (match-string 0))
-    (error "Can't find login url (login@1)"))
+    (webmail-error "login@1"))
   (if (re-search-forward "YY=[0-9]+" nil t)
       (setq webmail-aux (concat webmail-aux "ym/us/ShowFolder?"
                                (match-string 0)))
-    (error "Can't find login url (login@2)")))
+    (webmail-error "login@2")))
 
 (defun webmail-yahoo-list ()
   (let (url (newp t) (tofetch 0))
     (goto-char (point-min))
     (when (re-search-forward 
           "showing [0-9]+-\\([0-9]+\\) of \\([0-9]+\\)" nil t) 
-      ;(setq listed (match-string 1))
+      ;;(setq listed (match-string 1))
       (message "Found %s mail(s)" (match-string 2)))
     (if (string-match "http://[^/]+" webmail-aux)
        (setq webmail-aux (match-string 0 webmail-aux))
-      (error "Can't find server url (list@1)"))
+      (webmail-error "list@1"))
     (goto-char (point-min))
     (while (re-search-forward 
            "bgcolor=\"#eeeeee\"\\|href=\"\\(/ym/us/ShowLetter\\?MsgId=\\([^&]+\\)&[^\"]*\\)\""
              (setq tofetch (1+ tofetch)))
            (setq newp t))
        (setq newp nil)))
+    (setq webmail-articles (nreverse webmail-articles))
     (message "Fetching %d mail(s)" tofetch)))
 
 (defun webmail-yahoo-article (file id)
     (save-restriction
       (goto-char (point-min))
       (if (not (search-forward "value=\"Done\"" nil t))
-         (error "Can't find start label (article@1)"))
+         (webmail-error "article@1"))
       (if (not (search-forward "<table" nil t))
-         (error "Can't find start label (article@2)"))
+         (webmail-error "article@2"))
       (delete-region (point-min) (match-beginning 0)) 
       (if (not (search-forward "</table>" nil t))
-         (error "Can't find start label (article@3)"))
+         (webmail-error "article@3"))
       (narrow-to-region (point-min) (match-end 0))
       (while (search-forward "<a href=" nil t)
        (setq p (match-beginning 0))
        (search-forward "</a>" nil t)
        (delete-region p (match-end 0)))
-      (webmail-remove-markup)
-      (webmail-decode-entities)
+      (nnweb-remove-markup)
+      (nnweb-decode-entities)
       (goto-char (point-min))
       (delete-blank-lines)
       (goto-char (point-max))
        (setq attachment (match-string 0))
        (let (bufname ct ctl cd description)
          (if (not (search-forward "<table" nil t))
-             (error "Can't find start label (article@4)"))
+             (webmail-error "article@4"))
          (delete-region p (match-beginning 0))
          (if (not (search-forward "</table>" nil t))
-             (error "Can't find start label (article@5)"))
+             (webmail-error "article@5"))
          (narrow-to-region p (match-end 0))
-         (webmail-remove-markup)
-         (webmail-decode-entities)
+         (nnweb-remove-markup)
+         (nnweb-decode-entities)
          (goto-char (point-min))
          (delete-blank-lines)
          (setq ct (mail-fetch-field "content-type")
       ;; Some blank line to seperate mails.
       (insert "\n\nFrom nobody " (current-time-string) "\n")
       (if id
-         (insert "Message-ID: <" id "@yahoo.com>\n"))
+         (insert (format "Message-ID: <%s@yahoo.com>\n" id)))
       (unless (looking-at "$") 
-       (search-forward "\n\n" nil t)
-       (forward-line -1))
+       (if (search-forward "\n\n" nil t)
+           (forward-line -1)
+         (webmail-error "article@2")))
       (narrow-to-region (point) (point-max))
       (insert "MIME-Version: 1.0\n"
              (prog1
   (goto-char (point-min))
   (if (re-search-forward "action=\"\\([^\"]+\\)\"" nil t)
       (setq webmail-aux (concat (car webmail-open-url) (match-string 1)))
-    (error "Can't find login url (open@1)")))
+    (webmail-error "open@1")))
 
 (defun webmail-netaddress-login ()
   (webmail-refresh-redirect)
   (goto-char (point-min))
   (if (re-search-forward  "tpl/[^/]+/\\([^/]+\\)" nil t)
       (setq webmail-session (match-string 1))
-    (error "Can't find login url (login@1)")))
+    (webmail-error "login@1")))
 
 (defun webmail-netaddress-list ()
   (let (item id)
                (cons id 
                      (format "%s/tpl/Message/%s/Read?Q=%s&FolderID=-4&SortUseCase=True&Sort=Date&Headers=True"
                              (car webmail-open-url)
-                              webmail-session id)))
+                             webmail-session id)))
        (if (or (not webmail-newmail-only)
                (equal (match-string 1) "True"))
-           (push item webmail-articles))))))
+           (push item webmail-articles))))
+    (setq webmail-articles (nreverse webmail-articles))))
 
 (defun webmail-netaddress-single-part ()
   (goto-char (point-min))
       (replace-match " "))
     (goto-char (point-min))
     (while (re-search-forward "<br>" nil t)
-       (replace-match "\n"))
-    (webmail-remove-markup)
-    (webmail-decode-entities) 
+      (replace-match "\n"))
+    (nnweb-remove-markup)
+    (nnweb-decode-entities) 
     nil)
    (t
     (insert "<#part type=\"text/html\" disposition=inline>")
 (defun webmail-netaddress-article (file id)
   (let (p p1 attachment count mime type)
     (save-restriction
+      (webmail-encode-8bit)
       (goto-char (point-min))
       (if (not (search-forward "Trash" nil t))
-         (error "Can't find start label (article@1)"))
+         (webmail-error "article@1"))
       (if (not (search-forward "<form>" nil t))
-         (error "Can't find start label (article@2)"))
+         (webmail-error "article@2"))
       (delete-region (point-min) (match-beginning 0)) 
       (if (not (search-forward "</form>" nil t))
-         (error "Can't find start label (article@3)"))
+         (webmail-error "article@3"))
       (narrow-to-region (point-min) (match-end 0))
       (goto-char (point-min))
       (while (re-search-forward "[\040\t\r\n]+" nil t)
       (goto-char (point-min))
       (while (search-forward "<b>" nil t)
        (replace-match "\n"))
-      (webmail-remove-markup)
-      (webmail-decode-entities)
+      (nnweb-remove-markup)
+      (nnweb-decode-entities)
       (goto-char (point-min))
       (delete-blank-lines)
       (goto-char (point-min))
       (insert "\n\n")
       (setq p (point))
       (unless (search-forward "<!-- Data -->" nil t)
-       (error "Can't find start label (article@4)"))
+       (webmail-error "article@4"))
       (forward-line 14)
       (delete-region p (point))
       (goto-char (point-max))
       (unless (re-search-backward 
               "[\040\t]*<br>[\040\t\r\n]*<br>[\040\t\r\n]*<form" p t)
-       (error "Can't find end label (article@5)"))
+       (webmail-error "article@5"))
       (delete-region (point) (point-max))
       (goto-char p)
       (while (search-forward
              nil t 2)
        (setq mime t)
        (unless (search-forward "</TABLE>" nil t)
-         (error "Can't find end label (article@6)"))
+         (webmail-error "article@6"))
        (setq p1 (point))
        (if (search-backward "<IMG " p t)
            (progn
              (unless (re-search-forward "HREF=\"\\(/tpl/Attachment/[^/]+/\\([^/]+/[^\?]+\\)[^\"]+\\)\"" p1 t)
-               (error "Can't find tag (article@7)"))
+               (webmail-error "article@7"))
              (setq attachment (match-string 1))
              (setq type (match-string 2))
              (unless (search-forward "</TABLE>" nil t)
-               (error "Can't find end label (article@8)"))
+               (webmail-error "article@8"))
              (delete-region p (point))
-             (let (bufname) ;; Attachment
+             (let (bufname);; Attachment
                (save-excursion
                  (set-buffer (generate-new-buffer " *webmail-att*"))
                  (nnweb-insert (concat (car webmail-open-url) attachment))
          (setq p (point))
          (widen)))
       (unless mime
-         (narrow-to-region p (point-max))
-         (setq mime (webmail-netaddress-single-part))
-         (widen))
+       (narrow-to-region p (point-max))
+       (setq mime (webmail-netaddress-single-part))
+       (widen))
       (goto-char (point-min))
       ;; Some blank line to seperate mails.
       (insert "\n\nFrom nobody " (current-time-string) "\n")
       (if id
-         (insert "Message-ID: <" id "@usa.net>\n"))
+         (insert (format "Message-ID: <%s@usa.net>\n" id)))
       (unless (looking-at "$") 
-       (search-forward "\n\n" nil t)
-       (forward-line -1))
+       (if (search-forward "\n\n" nil t)
+           (forward-line -1)
+         (webmail-error "article@2")))
       (when mime
        (narrow-to-region (point-min) (point))
        (goto-char (point-min))
          (insert ">"))))
     (mm-append-to-file (point-min) (point-max) file)))
 
+;;; my-deja
+
+(defun webmail-my-deja-open ()
+  (webmail-refresh-redirect)
+  (goto-char (point-min))
+  (if (re-search-forward "action=\"\\([^\"]+login_confirm\\.xp[^\"]+\\)\"" 
+                        nil t)
+      (setq webmail-aux (match-string 1))
+    (webmail-error "open@1")))
+
+(defun webmail-my-deja-list ()
+  (let (item id newp)
+    (goto-char (point-min))
+    (when (re-search-forward 
+          "(\\([0-9]+\\) message(s), \\([0-9]+\\) new, \\([0-9]+\\)&nbsp;k )"
+          nil t) 
+      (message "Found %s mail(s), %s unread, total size %s K" 
+              (match-string 1) (match-string 2) (match-string 3)))
+    (goto-char (point-min))
+    (while (re-search-forward 
+           "&#149; &nbsp;&nbsp;\\|\\(http:[^\"]+\\)/display_seemesg\\.femail\\?docid=\\([^&\"]+\\)"
+           nil t)
+      (if (setq id (match-string 2))
+         (when (or newp (not webmail-newmail-only))
+           (push
+            (cons id (format "%s/gmm_multiplex.femail?docid=%s&femail_page_name=display_page&bool_next_on_disp_pg=true&bool_prev_on_disp_pg=false&display_all_headers=false&%%2Fgmm_save.femail=Download&femail_page_name=display_page&bool_next_on_disp_pg=true&bool_prev_on_disp_pg=false&display_all_headers=false"
+                             (match-string 1) id))
+            webmail-articles)
+           (setq webmail-aux (match-string 1))
+           (setq newp nil))
+       (setq newp t)))
+    (setq webmail-articles (nreverse webmail-articles))))
+
+(defun webmail-my-deja-article (file id)
+  (let (url)
+    (goto-char (point-min))
+    (unless (re-search-forward "\\(http:[^\"]+/attachment/entire_message.txt[^\"]+\\)" nil t)
+      (webmail-error "article@1"))
+    (setq url (match-string 1))
+    (erase-buffer)
+    (mm-with-unibyte-current-buffer
+      (nnweb-insert url))
+    (goto-char (point-min))
+    (while (search-forward "\r\n" nil t)
+      (replace-match "\n"))
+    (goto-char (point-min))
+    (insert "\n\nFrom nobody " (current-time-string) "\n")
+    (mm-append-to-file (point-min) (point-max) file)))
+
 (provide 'webmail)
 
 ;;; webmail.el ends here
index dd82a2b..73d708c 100644 (file)
@@ -1,3 +1,72 @@
+2000-01-05 15:58:48  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+       * gnus.texi (Mail Group Commands): Addition.
+
+2000-01-03 01:31:02  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+       * gnus.texi (MIME Commands): Fix.
+
+2000-01-03  Karl Kleinpaste <karl@justresearch.com>
+
+       * gnus.texi (Splitting in IMAP): Add '.' after @xref.
+
+2000-01-02 08:39:18  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+       * gnus.texi: Closing paren.
+       Doc fix.
+
+1999-12-28  Simon Josefsson  <jas@pdc.kth.se>
+
+       * gnus.texi (Article Hiding): Addition.
+       (Splitting in IMAP): Addition.
+
+1999-12-17 12:12:41  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * gnus.texi (Mail Source Specifiers): Addition.
+
+1999-12-13 23:47:50  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * gnus.texi (Mail Source Specifiers): Addition.
+
+1999-12-07 00:19:31  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * gnus.texi (Web Archive): Addition.
+
+1999-12-06 05:17:15  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+       * gnus.texi (Slashdot): Addition.
+
+1999-12-05 00:54:28  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+       * gnus.texi (Mail Source Specifiers): Removed backslashes.
+
+1999-12-04 07:35:51  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+       * gnus.texi (Setting Process Marks): Addition.
+
+1999-12-04 05:09:46  Manoj Srivastava  <srivasta@golden-gryphon.com>
+
+       * gnus.texi: Use defface instead of face-spec-set.
+
+1999-12-04 02:31:25  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+       * gnus.texi (extension): Posting server fix.
+       Url update.
+
+1999-12-04 01:16:52  Yoshiki Hayashi  <t90553@m.ecc.u-tokyo.ac.jp>
+
+       * gnus.texi (group-buffer): Fix "theese".
+
+1999-12-04 01:13:51  Thomas Gellekum  <tg@ihf.rwth-aachen.de>
+
+       * gnus.texi (Height): Typo fix.
+
+1999-11-13  Adrian Aichner  <aichner@ecf.teradyne.com>
+
+       * xemacs.mak: New NMAKE file to support build and install of info
+       documentation on Windows NT, requiring the `texinfo' XEmacs
+       package.
+
 1999-12-03 00:02:11  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
        * gnus.texi (Other Gnus Versions): New.
index 225a5f5..82afa01 100644 (file)
@@ -1216,7 +1216,7 @@ if not identical.
 The Emacs @sc{mime} library implements handling of various elements
 according to a (somewhat) large number of RFCs, drafts and standards
 documents.  This chapter lists the relevant ones.  They can all be
-fetched from @samp{http://www.stud.ifi.uio.no/~larsi/notes/}.
+fetched from @samp{http://quimby.gnus.org/notes/}.
 
 @table @dfn
 @item RFC822
index 760bd67..2cdca59 100644 (file)
@@ -1360,16 +1360,18 @@ Formatting}) \e$(B$r@_Dj$9$k$3$H$GJQ99$G$-$^$9!#$3$$$D$O;XDjJ8;z$r$"$s$^$j$?\e(B
 \e$(B$k$+$bCN$l$^$;$s!#\e(B
 
 @lisp
-(face-spec-set 'my-group-face-1
-               '((t (:foreground "Red" :bold t))))
-(face-spec-set 'my-group-face-2
-               '((t (:foreground "SeaGreen" :bold t))))
-(face-spec-set 'my-group-face-3
-               '((t (:foreground "SpringGreen" :bold t))))
-(face-spec-set 'my-group-face-4
-               '((t (:foreground "SteelBlue" :bold t))))
-(face-spec-set 'my-group-face-5
-               '((t (:foreground "SkyBlue" :bold t))))
+(cond (window-system
+       (setq custom-background-mode 'light)
+       (defface my-group-face-1
+        '((t (:foreground "Red" :bold t))) "First group face")
+       (defface my-group-face-2
+        '((t (:foreground "DarkSeaGreen4" :bold t))) "Second group face")
+       (defface my-group-face-3
+        '((t (:foreground "Green4" :bold t))) "Third group face")
+       (defface my-group-face-4
+        '((t (:foreground "SteelBlue" :bold t))) "Fourth group face")
+       (defface my-group-face-5
+        '((t (:foreground "Blue" :bold t))) "Fifth group face")))
 
 (setq gnus-group-highlight
       '(((> unread 200) . my-group-face-1)
@@ -4664,6 +4666,12 @@ Prefixes})\e$(B!#\e(B
 @findex gnus-uu-mark-by-regexp
 \e$(B@55,I=8=$K$h$C$F5-;v$K0u$rIU$1$^$9\e(B (@code{gnus-uu-mark-by-regexp})\e$(B!#\e(B
 
+@item M P G
+@kindex M P G (\e$(B35N,\e(B)
+@findex gnus-uu-unmark-by-regexp
+@code{Subject} \e$(B$,@55,I=8=$K%^%C%A$9$k5-;v$+$i0u$r:o=|$7$^$9!#\e(B
+(@code{gnus-uu-unmark-by-regexp}).
+
 @item M P r
 @kindex M P r \e$(B!J35N,!K\e(B
 @findex gnus-uu-mark-region
@@ -5748,7 +5756,7 @@ Gnus \e$(B$O$?$/$5$s$NJ}K!$G5-;v$rJ]B8$9$k;v$,$G$-$^$9!#0J2<$N$b$N$OHs>o$KN(D>\e(B
 
 @vindex gnus-default-article-saver
 Gnus \e$(B$,$"$J$?$NK>$`$H$*$j$K$J$k$h$&$K!"JQ?t\e(B
-@code{gnus-default-article-saver} \e$(B$r%+%9%?%^%$%:$9$k;v$,$G$-$^$9!#2<$N#4$D\e(B
+@code{gnus-default-article-saver} \e$(B$r%+%9%?%^%$%:$9$k;v$,$G$-$^$9!#2<$N#6$D\e(B
 \e$(B$N4{@=4X?t$r;H$&;v$,$G$-$^$9$7!"<+J,<+?H$N4X?t$r:n$k;v$b$G$-$^$9!#\e(B
 
 @table @code
@@ -7528,16 +7536,19 @@ Line Formatting})\e$(B!#%G%#%U%)%k%H$O\e(B @samp{Gnus: %%b %S %Z} \e$(B$G$9!#;HMQ2D
 @kindex B m \e$(B!J35N,!K\e(B
 @cindex move mail
 @findex gnus-summary-move-article
+@vindex gnus-preserve-marks
 \e$(B$"$k%a!<%k%0%k!<%W$+$iJL$N$H$3$m$X5-;v$r0\F0$7$^$9\e(B
-(@code{gnus-summary-move-article})\e$(B!#\e(B
+(@code{gnus-summary-move-article})\e$(B!#\e(B@var{gnus-preserve-marks} \e$(B$NCM$,\e(B nil
+\e$(B$G$O$J$$$J$i$P\e(B (\e$(B$3$l$,=i4|CM$G$9$,\e(B)\e$(B!"%^!<%/$OJ]B8$5$l$^$9!#\e(B
 
 @item B c
 @kindex B c \e$(B!J35N,!K\e(B
 @cindex copy mail
 @findex gnus-summary-copy-article
 @c @icon{gnus-summary-mail-copy}
-\e$(B$"$k%0%k!<%W!J%a!<%k%0%k!<%W$dB>$N$b$N!K$+$i%a!<%k%0%k!<%W$K5-;v$rJ#@=$7$^\e(B
-\e$(B$9\e(B (@code{gnus-summary-copy-article})\e$(B!#\e(B
+\e$(B$"$k%0%k!<%W!J%a!<%k%0%k!<%W$dB>$N$b$N!K$+$i%a!<%k%0%k!<%W$K5-;v$rJ#@=$7\e(B
+\e$(B$^$9\e(B (@code{gnus-summary-copy-article})\e$(B!#\e(B@var{gnus-preserve-marks} \e$(B$NCM\e(B
+\e$(B$,\e(B nil \e$(B$G$O$J$$$J$i$P\e(B (\e$(B$3$l$,=i4|CM$G$9$,\e(B)\e$(B!"%^!<%/$OJ]B8$5$l$^$9!#\e(B
 
 @item B B
 @kindex B B \e$(B!J35N,!K\e(B
@@ -7561,6 +7572,8 @@ Line Formatting})\e$(B!#%G%#%U%)%k%H$O\e(B @samp{Gnus: %%b %S %Z} \e$(B$G$9!#;HMQ2D
 @code{gnus-summary-respool-default-method} \e$(B$,:F%9%W!<%k$9$k$H$-$N%G%#%U%)\e(B
 \e$(B%k%H$NA*BrJ}K!$H$7$F;HMQ$5$l$^$9!#$3$NJQ?t$O%G%#%U%)%k%H$G\e(B @code{nil} \e$(B$G!"\e(B
 \e$(B$3$l$O8=:_$N%0%k!<%W$NA*BrJ}K!$,Be$o$j$K;H$o$l$k$H$$$&;v$G$9!#\e(B
+@var{gnus-preserve-marks} \e$(B$NCM$,\e(B nil \e$(B$G$O$J$$$J$i$P\e(B (\e$(B$3$l$,=i4|CM$G$9$,\e(B)\e$(B!"\e(B
+\e$(B%^!<%/$OJ]B8$5$l$^$9!#\e(B
 
 @item B w
 @itemx e
@@ -7798,8 +7811,8 @@ Gnus \e$(B$N\e(B info \e$(B$N@a\e(B (node) \e$(B$K0\F0$7$^$9\e(B (@code{gnus-info-find
 \e$(B8=:_$N%0%k!<%W$N%0%k!<%W$NG^2pJQ?t\e(B (parameter) (@pxref{Group
 Parameters}) \e$(B$rJT=8$7$^$9\e(B (@code{gnus-summary-edit-parameters})\e$(B!#\e(B
 
-@item M-C-g
-@kindex M-C-g (\e$(B35N,\e(B)
+@item M-C-a
+@kindex M-C-a (\e$(B35N,\e(B)
 @findex gnus-summary-customize-parameters
 \e$(B8=:_$N%0%k!<%W$N%0%k!<%W%Q%i%a!<%?\e(B (@pxref{Group Parameters}) \e$(B$r%+%9%?%^\e(B
 \e$(B%$%:$7$^$9\e(B (@code{gnus-summary-customize-parameters})\e$(B!#\e(B
@@ -8447,7 +8460,7 @@ GNUS \e$(B$d\e(B Gnus \e$(B$G$O!"$3$N$?$A$N0-$$LdBj$G6C$+$5$l$J$$$h$&$K$9$k$K$O!"35
 @vindex gnus-article-mode-line-format
 @item gnus-article-mode-line-format
 \e$(B$3$NJQ?t$O\e(B @code{gnus-summary-mode-line-format} \e$(B$HF1$89T$K=>$C$?MM<0J8;z\e(B
-\e$(BNs$G$9\e(B (@pxref{Mode Line Formatting})\e$(B!#$3$l$O0J2<$N0l$D$N3HD%$r=|$$$F!"\e(B
+\e$(BNs$G$9\e(B (@pxref{Mode Line Formatting})\e$(B!#$3$l$O0J2<$NFs$D$N3HD%$r=|$$$F!"\e(B
 \e$(B$=$NJQ?t$HF1$8MM<0;XDj$r<uIU$1$^$9!#\e(B
 
 @table @samp
@@ -8486,9 +8499,8 @@ GNUS \e$(B$d\e(B Gnus \e$(B$G$O!"$3$N$?$A$N0-$$LdBj$G6C$+$5$l$J$$$h$&$K$9$k$K$O!"35
 @kindex C-c C-c (\e$(BEj9F\e(B)
 \e$(BA4$F$NEj9F$H%a!<%k$NL?Na$O!"\e(B@kbd{C-c C-c} \e$(B$r2!$9;v$K$h$C$F!"5-;v$rAw?.$9$k\e(B
 \e$(BA0$K5-;v$r9%$-$J$h$&$KJT=8$9$k;v$N$G$-$k!"%a%C%;!<%8%P%C%U%!$K0\F0$7$^$9!#\e(B
-@xref{Top, , Top, message, The Message Manual}\e$(B!#$b$730It%K%e!<%9%0%k!<%W$K\e(B
-\e$(B$$$F!"5-;v$r30It%5!<%P!<$r;H$C$FEj9F$7$?$$$N$G$"$l$P!"\e(B@kbd{C-c C-c} \e$(B$K@\F,\e(B
-\e$(B0z?t$rM?$($F!"\e(Bgnus \e$(B$K30It%5!<%P!<$r;H$C$FEj9F$7$h$&$H;n$5$;$k;v$,$G$-$^$9!#\e(B
+@xref{Top, , Top, message, The Message Manual}\e$(B!#5-;v$O$"$J$?$N@_Dj$K4p$E\e(B
+\e$(B$$$FAw?.$5$l$^$9\e(B (@pxref{Posting Server})\e$(B!#\e(B
 
 @menu
 * Mail::                 \e$(B%a!<%k$HJVEz!#\e(B
@@ -10202,11 +10214,21 @@ IMAP \e$(B%5!<%P!<$KEO$9%Q%9%o!<%I$G$9!#;XDj$5$l$F$$$J$$$H$-$O!"MxMQ<T$OF~NO\e(B
 
 @item :predicate
 \e$(B<hF@$9$k5-;v$r7hDj$9$k$?$a$K;H$o$l$k=R8l!#=i4|CM$N!"\e(B@samp{UNSEEN
-UNDELETED} \e$(B$O$*$=$i$/$?$$$F$$$N?M$K$O:GNI$NA*Br$G$7$g$&$,!"$H$-$I$-\e(B IMAP
-\e$(B%/%i%$%"%s%H$G%a!<%k%\%C%/%9$r=|$-!"$$$/$D$+$N5-;v$K4{FI\e(B (\e$(B$b$7$/$O!"\e(B
-SEEN) \e$(B$N0u$rIU$1$k$J$i!"\e(B@samp{nil} \e$(B$K@_Dj$7$?$$$+$b$7$l$^$;$s!#$=$&$9$l\e(B
-\e$(B$P!"%a!<%k%\%C%/%9$NA4$F$N5-;v$O0u$NG!2?$K4X$o$i$:<hF@$5$l$^$9!#=R8l$N40\e(B
-\e$(BA4$J0lMw$O!"\e(BRFC2060 \e-A\ e'\ f6.4.4 \e$(B$rFI$s$G$/$@$5$$!#\e(B
+UNDELETED} \e$(B$O$*$=$i$/$?$$$F$$$N?M$K$O:GNI$NA*Br$G$7$g$&$,!"$H$-$I$-\e(B
+@sc{imap} \e$(B%/%i%$%"%s%H$G%a!<%k%\%C%/%9$r=|$-!"$$$/$D$+$N5-;v$K4{FI\e(B (\e$(B$b\e(B
+\e$(B$7$/$O!"\e(BSEEN) \e$(B$N0u$rIU$1$k$J$i!"\e(B@samp{nil} \e$(B$K@_Dj$7$?$$$+$b$7$l$^$;$s!#\e(B
+\e$(B$=$&$9$l$P!"%a!<%k%\%C%/%9$NA4$F$N5-;v$O0u$NG!2?$K4X$o$i$:<hF@$5$l$^$9!#\e(B
+\e$(B=R8l$N40A4$J0lMw$O!"\e(BRFC2060 \e-A\ e'\ f6.4.4 \e$(B$rFI$s$G$/$@$5$$!#\e(B
+
+@item :fetchflag
+\e$(B%5!<%P!<$G!"<hF@$7$?5-;v$K0u$rIU$1$kJ}K!!#=i4|CM$N\e(B @samp{Deleted} \e$(B$O$=$l\e(B
+\e$(B$i$K>C5n$N0u$rIU$1$^$9$,!"B>$K\e(B @samp{Seen} \e$(B$G$OC1$K4{FI$N0u$rIU$1$^$9!#\e(B
+\e$(B$3$l$i$O:G$b$"$j$=$&$JFs$D$NA*Br$G$9$,!"B>$N0u$b\e(B RFC2060 \e-A\ e'\ f2.3.2 \e$(B$GDj5A$5\e(B
+\e$(B$l$F$$$^$9!#\e(B
+
+@item :dontexpunge
+@code{nil} \e$(B$G$J$+$C$?$i!"5-;v$r<hF@$7$?8e$G!"$=$l$i$K>C5n$N0u$,IU$$$F$$\e(B
+\e$(B$F$b:o=|$7$^$;$s!#\e(B
 
 @end table
 
@@ -10217,8 +10239,8 @@ IMAP \e$(B%a!<%k%=!<%9$NNc\e(B:
 @end lisp
 
 @item webmail
-www.hotmail.com, mail.yahoo.com, www.netaddress.com \e$(B$J$I$N%&%'%V%a!<%k%5!<\e(B
-\e$(B%P!<$+$i%a!<%k$r<hF@$7$^$9!#\e(B
+www.hotmail.com, mail.yahoo.com, www.netaddress.com, www.my-deja.com
+\e$(B$J$I$N%&%'%V%a!<%k%5!<%P!<$+$i%a!<%k$r<hF@$7$^$9!#\e(B
 
 \e$(BCm\e(B: \e$(B%&%'%V%a!<%k$O\e(B w3 (url) \e$(B%Q%C%1!<%8$N%P!<%8%g%s\e(B "WWW 4.0pre.46
 1999/10/01" \e$(B$KBg$-$/0MB8$7$^$9!#$=$l0JA0$N$b$N$O$*$=$i$/F0:n$7$J$$$G$7$g\e(B
@@ -10231,7 +10253,7 @@ www.hotmail.com, mail.yahoo.com, www.netaddress.com \e$(B$J$I$N%&%'%V%a!<%k%5!<\e(
 @table @code
 @item :subtype
 \e$(B%&%'%V%a!<%k%5!<%P!<$N7?$G$9!#=i4|CM$O\e(B @code{hotmail} \e$(B$G$9!#B>$N8uJd$O\e(B
-@code{yahoo}, @code{netaddress} \e$(B$G$9!#\e(B
+@code{yahoo}, @code{netaddress}, @code{my-deja} \e$(B$G$9!#\e(B
 
 @item :user
 \e$(B%&%'%V%a!<%k%5!<%P!<$NMxMQ<TL>$G$9!#=i4|CM$O%m%0%$%sL>$G$9!#\e(B
@@ -10240,6 +10262,10 @@ www.hotmail.com, mail.yahoo.com, www.netaddress.com \e$(B$J$I$N%&%'%V%a!<%k%5!<\e(
 \e$(B%&%'%V%a!<%k%5!<%P!<$N%Q%9%o!<%I$G$9!#;XDj$7$J$$>l9g$O!"MxMQ<T$KF~NO$rB%\e(B
 \e$(B$7$^$9!#\e(B
 
+@item :dontexpunge
+@code{nil} \e$(B$G$J$+$C$?$i!"L$FI$N5-;v$@$1$r<hF@$7$F!"$=$l$i$r$4$_H"$N%U%)\e(B
+\e$(B%k%@!<$K0\F0$7$^$;$s!#\e(B
+
 @end table
 
 \e$(B%&%'%V%a!<%k$N%=!<%9$NNc$G$9\e(B:
@@ -10249,6 +10275,20 @@ www.hotmail.com, mail.yahoo.com, www.netaddress.com \e$(B$J$I$N%&%'%V%a!<%k%5!<\e(
 @end lisp
 @end table
 
+@table @dfn
+@item Common Keywords
+\e$(B6&DL%-!<%o!<%I$O$I$s$J7?$N%a!<%k%=!<%9$K$b;H$&$3$H$,$G$-$^$9!#\e(B
+
+\e$(B%-!<%o!<%I\e(B:
+
+@table @code
+@item :plugged
+
+@code{nil} \e$(B$G$J$+$C$?$i!"\e(Bgnus \e$(B$,\e(B @dfn{unplugged} \e$(B$G$"$C$F$b%a!<%k$r<hF@\e(B
+\e$(B$7$^$9!#\e(B
+
+@end table
+@end table
 
 @node Mail Source Customization
 @subsubsection \e$(B%a!<%k%=!<%9$N%+%9%?%^%$%:\e(B
@@ -10433,14 +10473,14 @@ www.hotmail.com, mail.yahoo.com, www.netaddress.com \e$(B$J$I$N%&%'%V%a!<%k%5!<\e(
 \e$(B$9!#IaDL$N@55,I=8=$N9gCW$,$J$5$l$^$9!#Nc$O2<$NJ}$r8+$F2<$5$$!#\e(B
 
 @item
-@code{(@var{field} @var{value} @code{[-} @var{restrict} @code{[-} @var{restrict} @code{[@dots{}]}@code{]]} 
-@var{split})}: \e$(B$b$7J,3d$,%j%9%H$G!":G=i$NMWAG$,J8;zNs$G$"$j!"%X%C%@!<\e(B
-@var{field} (\e$(B@55,I=8=\e(B) \e$(B$,\e(B @var{value} (\e$(B$3$l$b@55,I=8=\e(B) \e$(B$r4^$s$G$$$k>l9g!"\e(B
-\e$(B%a%C%;!<%8$r\e(B @var{split} \e$(B$G;XDj$5$l$?$H$3$m$KC_@Q$7$^$9!#\e(B@var{restrict}
- (\e$(B$^$?B>$N@55,I=8=\e(B) \e$(B$,\e(B @var{field} \e$(B$N8e$G!"9gCW$7$?\e(B @var{value} \e$(B$N:G8e$N\e(B
-\e$(BA0$N$N$$$/$D$+$NJ8;zNs$K9gCW$7$?$i!"\e(B@var{split} \e$(B$OL5;k$5$l$^$9!#\e(B
-@var{restrict} \e$(B$NJDJq$N$I$l$b$,9gCW$7$J$1$l$P\e(B @var{split} \e$(B$,<B9T$5$l$^\e(B
-\e$(B$9!#\e(B
+@code{(@var{field} @var{value} @code{[-} @var{restrict}
+@code{[@dots{}]}@code{]} @var{split})}: \e$(B$b$7J,3d$,%j%9%H$G!":G=i$NMWAG$,\e(B
+\e$(BJ8;zNs$G$"$j!"%X%C%@!<\e(B @var{field} (\e$(B@55,I=8=\e(B) \e$(B$,\e(B @var{value} (\e$(B$3$l$b@55,\e(B
+\e$(BI=8=\e(B) \e$(B$r4^$s$G$$$k>l9g!"%a%C%;!<%8$r\e(B @var{split} \e$(B$G;XDj$5$l$?$H$3$m$KC_\e(B
+\e$(B@Q$7$^$9!#\e(B@var{restrict} (\e$(B$^$?B>$N@55,I=8=\e(B) \e$(B$,\e(B @var{field} \e$(B$N8e$G!"9gCW\e(B
+\e$(B$7$?\e(B @var{value} \e$(B$N:G8e$NA0$N$N$$$/$D$+$NJ8;zNs$K9gCW$7$?$i!"\e(B@var{split}
+\e$(B$OL5;k$5$l$^$9!#\e(B@var{restrict} \e$(B$NJDJq$N$I$l$b$,9gCW$7$J$1$l$P\e(B @var{split}
+\e$(B$,<B9T$5$l$^$9!#\e(B
 
 @item
 @code{(| @var{split}@dots{})}: \e$(BJ,3d$,%j%9%H$G!":G=i$NMWAG$,\e(B @code{|}
@@ -11481,6 +11521,9 @@ gnus \e$(B$N%0%k!<%W$H$7$F9XFI$7!"$3$l$i$N%0%k!<%W$KF~$k$3$H$G%3%a%s%H$rFI$`\e(B
 \e$(BFI$9$k$3$H$KCm0U$7$F$/$@$5$$!#B>$NJ}K!$b;H$($^$9\e(B (@pxref{Subscription
 Methods})\e$(B!#\e(B
 
+\e$(B$b$7$"$J$?$,8E$$\e(B @code{nnslashdot} \e$(B%0%k!<%W$r:o=|$7$?$$$N$J$i$P!"\e(B
+@kbd{G DEL} \e$(B$,:G$b<j7Z$JF;6q$G$9\e(B (@pxref{Foreign Groups})\e$(B!#\e(B
+
 @code{nnslashdot} \e$(B%3%a%s%H$K%U%)%m!<%"%C%W\e(B (\e$(B$^$?$O?7$7$$%3%a%s%H$NEj9F\e(B)
 \e$(B$r$9$k$H$-$O!">/$7\e(B @sc{html} \e$(B$KJQ49$5$l$^$9!#FC$K!"\e(B@samp{> } \e$(B$G0zMQ$5$l\e(B
 \e$(B$?%F%-%9%H$O$=$NBe$o$j$K\e(B @code{blockquote} \e$(B$G0zMQ$5$l!"=pL>$K$O$=$l$>$l\e(B
@@ -11572,17 +11615,18 @@ Ultimate \e$(B%&%'%V%5%$%H$K$O$?$/$5$s5s$2$i$l$F$$$^$9!#\e(B) \e$(B$=$l$+$i%5!<%P!<
 @cindex nnwarchive
 @cindex Web Archive
 
-\e$(B%a!<%j%s%0%j%9%H$NCf$K$ONc$($P!"\e(B @file{http://www.egroups.com/} \e$(B$N$h$&$K\e(B
-\e$(B%&%'%V%5!<%P!<$K$7$+%"!<%+%$%V$,L5$$$b$N$b$"$j$^$9!#$H$F$b@0A3$H$7$FNI$$\e(B
-\e$(B3&LL$G!"\e(Bgnus \e$(B$,%0%k!<%W$r:G?7$N>uBV$KJ]$C$F$*$/$?$a$K>pJs$rF@$k$3$H$,2D\e(B
-\e$(BG=$G$9!#\e(B
-
+\e$(B%a!<%j%s%0%j%9%H$NCf$K$ONc$($P!"\e(B @file{http://www.egroups.com/} \e$(B$d\e(B
+@file{http://www.mail-archive.com/} \e$(B$N$h$&$K%&%'%V%5!<%P!<$K$7$+%"!<%+%$\e(B
+\e$(B%V$,L5$$$b$N$b$"$j$^$9!#$H$F$b@0A3$H$7$FNI$$3&LL$G!"\e(Bgnus \e$(B$,%0%k!<%W$r:G\e(B
+\e$(B?7$N>uBV$KJ]$C$F$*$/$?$a$K>pJs$rF@$k$3$H$,2DG=$G$9!#\e(B
 
 @code{nnwarchive} \e$(B$r;O$a$k$?$a$N0lHV4JC1$JJ}K!$O%0%k!<%W%P%C%U%!$G0J2<$N\e(B
 \e$(B$h$&$J$b$N$r$9$k$3$H$G$9\e(B: @kbd{M-x gnus-group-make-nnwarchive-group RET
 an_egroup RET egroups RET www.egroups.comRET your@@email.address RET}\e$(B!#\e(B
 (@sc{an_egroup} \e$(B$r9XFI$7$F$$$k%a!<%j%s%0%j%9%H$K!"\e(B
 @sc{your@@emailaddress} \e$(B$rEE;R%a!<%k%"%I%l%9$KCV$-49$($F$/$@$5$$!#\e(B)
+\e$(B$^$?$O\e(B @kbd{B nnwarchive RET mail-archive RET} \e$(B$G%P%C%/%(%s%I$r%V%i%&%:\e(B
+\e$(B$7$F2<$5$$!#\e(B
 
 \e$(B0J2<$N\e(B @code{nnwarchive} \e$(BJQ?t$rJQ$($k$3$H$,2DG=$G$9\e(B:
 
@@ -12496,7 +12540,7 @@ INBOX.spam \e$(B$KF~$l!"$=$NB>A4$F$N$b$N$r\e(B INBOX.private \e$(B$KF~$l$^$9!#\e(B
 \e$(B$K;HMQ$5$l$k$N$HF1$8$h$&$J!"\e(B`\\1' \e$(B7A<0$r4^$`$3$H$,$G$-$^$9!#Nc$($P\e(B:
 
 @lisp
-          ("INBOX.lists.\\1"     "^Sender: owner-\\([a-z-]+\\)@@")
+("INBOX.lists.\\1"     "^Sender: owner-\\([a-z-]+\\)@@")
 @end lisp
 
 2\e$(B$DL\$NMWAG$O4X?t$G$"$k$3$H$b$G$-$^$9!#$=$N>l9g$O!"5-;v$N%X%C%@!<$,$"$k\e(B
@@ -17524,6 +17568,9 @@ Per Abrahamsen--custom\e$(B!"%9%3%"!"%O%$%i%$%H$H\e(B @sc{soup} \e$(B%3!<%I\e(B (\e$(
 Luis Fernandes---\e$(B%G%6%$%s$H%0%i%U%#%C%/!#\e(B
 
 @item
+Justin Sheehy--FAQ \e$(B$N%a%$%s%F%$%J!<!#\e(B
+
+@item
 Erik Naggum---\e$(B1g=u!"9M$(!"%5%]!<%H!"%3!<%I$H$=$NB>!#\e(B
 
 @item
@@ -19740,6 +19787,12 @@ Be able to forward groups of messages as MIME digests.
 nnweb should include the "get whole article" article when getting articles. 
 
 @item
+When I type W W c (gnus-article-hide-citation) in the summary
+buffer, the citations are revealed, but the [+] buttons don't turn
+into [-] buttons.  (If I click on one of the [+] buttons, it does
+turn into a [-] button.)
+
+@item
 Solve the halting problem.
 
 @c TODO
index eba5cce..7c4f513 100644 (file)
@@ -381,8 +381,8 @@ being accused of plagiarism:
 
 Gnus is a message-reading laboratory.  It will let you look at just
 about anything as if it were a newsgroup.  You can read mail with it,
-you can browse directories with it, you can @code{ftp} with it---you can
-even read news with it!
+you can browse directories with it, you can @code{ftp} with it---you
+can even read news with it!
 
 Gnus tries to empower people who read news the same way Emacs empowers
 people who edit text.  Gnus sets no limits to what the user should be
@@ -1319,16 +1319,18 @@ Here's an example value for this variable that might look nice if the
 background is dark:
 
 @lisp
-(face-spec-set 'my-group-face-1
-               '((t (:foreground "Red" :bold t))))
-(face-spec-set 'my-group-face-2
-               '((t (:foreground "SeaGreen" :bold t))))
-(face-spec-set 'my-group-face-3
-               '((t (:foreground "SpringGreen" :bold t))))
-(face-spec-set 'my-group-face-4
-               '((t (:foreground "SteelBlue" :bold t))))
-(face-spec-set 'my-group-face-5
-               '((t (:foreground "SkyBlue" :bold t))))
+(cond (window-system
+       (setq custom-background-mode 'light)
+       (defface my-group-face-1
+        '((t (:foreground "Red" :bold t))) "First group face")
+       (defface my-group-face-2
+        '((t (:foreground "DarkSeaGreen4" :bold t))) "Second group face")
+       (defface my-group-face-3
+        '((t (:foreground "Green4" :bold t))) "Third group face")
+       (defface my-group-face-4
+        '((t (:foreground "SteelBlue" :bold t))) "Fourth group face")
+       (defface my-group-face-5
+        '((t (:foreground "Blue" :bold t))) "Fifth group face")))
 
 (setq gnus-group-highlight
       '(((> unread 200) . my-group-face-1)
@@ -2115,7 +2117,7 @@ news group.
 @item gcc-self
 @cindex gcc-self
 If @code{(gcc-self . t)} is present in the group parameter list, newly
-composed messages will be @code{Gcc}'d to the current group. If
+composed messages will be @code{Gcc}'d to the current group.  If
 @code{(gcc-self . none)} is present, no @code{Gcc:} header will be
 generated, if @code{(gcc-self . "string")} is present, this string will
 be inserted literally as a @code{gcc} header.  This parameter takes
@@ -2203,9 +2205,9 @@ group.  @code{dummy-variable} will be set to the result of the
 
 @item posting-style
 You can store additional posting style information for this group only
-here (@pxref{Posting Styles}). The format is that of an entry in the
+here (@pxref{Posting Styles}).  The format is that of an entry in the
 @code{gnus-posting-styles} alist, except that there's no regexp matching
-the group name (of course). Style elements in this group parameter will
+the group name (of course).  Style elements in this group parameter will
 take precedence over the ones found in @code{gnus-posting-styles}.
 
 For instance, if you want a funky name and signature in this group only,
@@ -3380,7 +3382,8 @@ The following format specification characters are understood:
 @item N
 Article number.
 @item S
-Subject string. List identifiers stripped, @code{gnus-list-identifies}. @xref{Article Hiding}.
+Subject string.  List identifiers stripped,
+@code{gnus-list-identifies}.  @xref{Article Hiding}.
 @item s
 Subject if the article is the root of the thread or the previous article
 had a different subject, @code{gnus-summary-same-subject} otherwise.
@@ -4171,7 +4174,7 @@ process/prefix convention.
 @findex gnus-uu-post-news
 @c @icon{gnus-uu-post-news}
 Uuencode a file, split it into parts, and post it as a series
-(@code{gnus-uu-post-news}). (@pxref{Uuencoding and Posting}).
+(@code{gnus-uu-post-news}).  (@pxref{Uuencoding and Posting}).
 @end table
 
 Also @pxref{(message)Header Commands} for more information.
@@ -4671,6 +4674,12 @@ Invert the list of process marked articles
 Mark articles that have a @code{Subject} header that matches a regular
 expression (@code{gnus-uu-mark-by-regexp}).
 
+@item M P G
+@kindex M P G (Summary)
+@findex gnus-uu-unmark-by-regexp
+Unmark articles that have a @code{Subject} header that matches a regular
+expression (@code{gnus-uu-unmark-by-regexp}).
+
 @item M P r
 @kindex M P r (Summary)
 @findex gnus-uu-mark-region
@@ -5197,10 +5206,10 @@ The default is 4.
 @vindex gnus-sort-gathered-threads-function
 Sometimes, particularly with mailing lists, the order in which mails
 arrive locally is not necessarily the same as the order in which they
-arrived on the mailing list. Consequently, when sorting sub-threads
+arrived on the mailing list.  Consequently, when sorting sub-threads
 using the default @code{gnus-thread-sort-by-number}, responses can end
-up appearing before the article to which they are responding to. Setting
-this variable to an alternate value
+up appearing before the article to which they are responding to.
+Setting this variable to an alternate value
 (e.g. @code{gnus-thread-sort-by-date}), in a group's parameters or in an
 appropriate hook (e.g. @code{gnus-summary-generate-hook}) can produce a
 more logical sub-thread ordering in such instances.
@@ -5617,7 +5626,7 @@ feel that it's neat to use twice as much space.
 To limit the caching, you could set @code{gnus-cacheable-groups} to a
 regexp of groups to cache, @samp{^nntp} for instance, or set the
 @code{gnus-uncacheable-groups} regexp to @samp{^nnml}, for instance.
-Both variables are @code{nil} by default. If a group matches both
+Both variables are @code{nil} by default.  If a group matches both
 variables, the group is not cached.
 
 @findex gnus-cache-generate-nov-databases
@@ -5799,7 +5808,7 @@ files.
 
 @vindex gnus-default-article-saver
 You can customize the @code{gnus-default-article-saver} variable to make
-gnus do what you want it to.  You can use any of the four ready-made
+gnus do what you want it to.  You can use any of the six ready-made
 functions below, or you can create your own.
 
 @table @code
@@ -6602,7 +6611,7 @@ Signature}.
 @kindex W W l (Summary)
 @findex gnus-article-hide-list-identifiers
 @vindex gnus-list-identifiers
-Hide list identifiers specified in @code{gnus-list-identifiers}. Theese
+Hide list identifiers specified in @code{gnus-list-identifiers}.  These
 are strings some list servers add to the beginning of all @code{Subject}
 headers---for example, @samp{[zebra 4711]}.
 
@@ -6611,7 +6620,7 @@ headers---for example, @samp{[zebra 4711]}.
 @item gnus-list-identifiers
 @vindex gnus-list-identifiers
 A regular expression that matches list identifiers to be removed from
-subject. This can also be a list of regular expressions.
+subject.  This can also be a list of regular expressions.
 
 @end table
 
@@ -6691,7 +6700,9 @@ Number of lines of hidden text.
 
 @item gnus-cited-lines-visible
 @vindex gnus-cited-lines-visible
-The number of lines at the beginning of the cited text to leave shown.
+The number of lines at the beginning of the cited text to leave
+shown. This can also be a cons cell with the number of lines at the top
+and bottom of the text, respectively, to remain visible.
 
 @end table
 
@@ -7215,9 +7226,11 @@ Make all the @sc{mime} parts have buttons in from of them.
 
 @item K m
 @kindex K m (Summary)
+@findex gnus-summary-repair-multipart
 Some multipart messages are transmitted with missing or faulty headers.
 This command will attempt to ``repair'' these messages so that they can
-be viewed in a more pleasant manner.
+be viewed in a more pleasant manner
+(@code{gnus-summary-repair-multipart}).
 
 @item X m
 @kindex X m (Summary)
@@ -7574,7 +7587,7 @@ Pick the article or thread on the current line
 (@code{gnus-pick-article-or-thread}).  If the variable
 @code{gnus-thread-hide-subtree} is true, then this key selects the
 entire thread when used at the first article of the thread.  Otherwise,
-it selects just the article. If given a numerical prefix, go to that
+it selects just the article.  If given a numerical prefix, go to that
 thread or article and pick it.  (The line number is normally displayed
 at the beginning of the summary pick lines.)
 
@@ -7831,8 +7844,10 @@ disk forever and ever, never to return again.'' Use with caution.
 @kindex B m (Summary)
 @cindex move mail
 @findex gnus-summary-move-article
+@vindex gnus-preserve-marks
 Move the article from one mail group to another
-(@code{gnus-summary-move-article}).
+(@code{gnus-summary-move-article}).  Marks will be preserved if
+@var{gnus-preserve-marks} is non-@code{nil} (which is the default). 
 
 @item B c
 @kindex B c (Summary)
@@ -7840,7 +7855,8 @@ Move the article from one mail group to another
 @findex gnus-summary-copy-article
 @c @icon{gnus-summary-mail-copy}
 Copy the article from one group (mail group or not) to a mail group
-(@code{gnus-summary-copy-article}).
+(@code{gnus-summary-copy-article}).  Marks will be preserved if
+@var{gnus-preserve-marks} is non-@code{nil} (which is the default).
 
 @item B B
 @kindex B B (Summary)
@@ -7865,6 +7881,8 @@ Respool the mail article (@code{gnus-summary-respool-article}).
 @code{gnus-summary-respool-default-method} will be used as the default
 select method when respooling.  This variable is @code{nil} by default,
 which means that the current group select method will be used instead.
+Marks will be preserved if @var{gnus-preserve-marks} is non-@code{nil}
+(which is the default).
 
 @item B w
 @itemx e
@@ -8108,8 +8126,8 @@ If given a prefix, force an @code{article} window configuration.
 Edit the group parameters (@pxref{Group Parameters}) of the current
 group (@code{gnus-summary-edit-parameters}).
 
-@item M-C-g
-@kindex M-C-g (Summary)
+@item M-C-a
+@kindex M-C-a (Summary)
 @findex gnus-summary-customize-parameters
 Customize the group parameters (@pxref{Group Parameters}) of the current
 group (@code{gnus-summary-customize-parameters}).
@@ -8136,7 +8154,7 @@ group and return you to the group buffer.
 @vindex gnus-summary-prepare-exit-hook
 @c @icon{gnus-summary-exit}
 Exit the current group and update all information on the group
-(@code{gnus-summary-exit}). @code{gnus-summary-prepare-exit-hook} is
+(@code{gnus-summary-exit}).  @code{gnus-summary-prepare-exit-hook} is
 called before doing much of the exiting, which calls
 @code{gnus-summary-expire-articles} by default.
 @code{gnus-summary-exit-hook} is called after finishing the exit
@@ -8628,8 +8646,8 @@ controlling variable is a predicate list, as described above.
 
 The following treatment options are available.  The easiest way to
 customize this is to examine the @code{gnus-article-treat} customization
-group. Values in brackets are suggested sensible values. Others are possible
-but those listed are probably sufficient for most people.
+group.  Values in parenthesis are suggested sensible values.  Others are
+possible but those listed are probably sufficient for most people.
 
 @table @code
 @item gnus-treat-highlight-signature (t, last)
@@ -8773,8 +8791,8 @@ Syntax table used in article buffers.  It is initialized from
 @item gnus-article-mode-line-format
 This variable is a format string along the same lines as
 @code{gnus-summary-mode-line-format} (@pxref{Mode Line Formatting}).  It
-accepts the same format specifications as that variable, with one
-extension:
+accepts the same format specifications as that variable, with two
+extensions:
 
 @table @samp
 @item w
@@ -8812,11 +8830,10 @@ This is the delimiter mentioned above.  By default, it is @samp{^L}
 
 @kindex C-c C-c (Post)
 All commands for posting and mailing will put you in a message buffer
-where you can edit the article all you like, before you send the article
-by pressing @kbd{C-c C-c}.  @xref{Top, , Top, message, The Message
-Manual}.  If you are in a foreign news group, and you wish to post the
-article using the foreign server, you can give a prefix to @kbd{C-c C-c}
-to make gnus try to post using the foreign server.
+where you can edit the article all you like, before you send the
+article by pressing @kbd{C-c C-c}.  @xref{Top, , Top, message, The
+Message Manual}.  Where the message will be posted/mailed to depends
+on your setup (@pxref{Posting Server}).
 
 @menu
 * Mail::                 Mailing and replying.
@@ -10154,7 +10171,7 @@ they want to treat a message.
 
 Many people subscribe to several mailing lists.  These are transported
 via SMTP, and are therefore mail.  But we might go for weeks without
-answering, or even reading these messages very carefully. We may not
+answering, or even reading these messages very carefully.  We may not
 need to save them because if we should need to read one again, they are
 archived somewhere else.
 
@@ -10528,7 +10545,7 @@ Use @samp{movemail} to move the mail:
 @end lisp
 
 @item maildir
-Get mail from a maildir. This is a type of mailbox that is supported by
+Get mail from a maildir.  This is a type of mailbox that is supported by
 at least qmail and postfix, where each file in a special directory
 contains exactly one mail.
 
@@ -10560,10 +10577,10 @@ Two example maildir mail sources:
 @end lisp
 
 @item imap
-Get mail from a @sc{imap} server. If you don't want to use @sc{imap} as intended,
-as a network mail reading protocol (ie with nnimap), for some reason or
-other, Gnus let you treat it similar to a POP server and fetches
-articles from a given @sc{imap} mailbox.
+Get mail from a @sc{imap} server.  If you don't want to use @sc{imap} as
+intended, as a network mail reading protocol (ie with nnimap), for some
+reason or other, Gnus let you treat it similar to a POP server and
+fetches articles from a given @sc{imap} mailbox.
 
 Keywords:
 
@@ -10586,31 +10603,31 @@ prompted.
 
 @item :stream
 What stream to use for connecting to the server, this is one of the
-symbols in @code{imap-stream-alist}. Right now, this means
+symbols in @code{imap-stream-alist}.  Right now, this means
 @samp{kerberos4}, @samp{ssl} or the default @samp{network}.
 
 @item :authenticator
 Which authenticator to use for authenticating to the server, this is one
-of the symbols in @code{imap-authenticator-alist}. Right now, this means
-@samp{kerberos4}, @samp{cram-md5}, @samp{anonymous} or the default
+of the symbols in @code{imap-authenticator-alist}.  Right now, this
+means @samp{kerberos4}, @samp{cram-md5}, @samp{anonymous} or the default
 @samp{login}.
 
 @item :mailbox
-The name of the mailbox to get mail from. The default is @samp{INBOX}
+The name of the mailbox to get mail from.  The default is @samp{INBOX}
 which normally is the mailbox which receive incoming mail.
 
 @item :predicate
-The predicate used to find articles to fetch. The default, 
-@samp{UNSEEN UNDELETED}, is probably the best choice for most people,
-but if you sometimes peek in your mailbox with a @sc{imap} client and mark
-some articles as read (or; SEEN) you might want to set this to
-@samp{nil}. Then all articles in the mailbox is fetched, no matter
-what. For a complete list of predicates, see RFC2060 Â§6.4.4.
+The predicate used to find articles to fetch.  The default, @samp{UNSEEN
+UNDELETED}, is probably the best choice for most people, but if you
+sometimes peek in your mailbox with a @sc{imap} client and mark some
+articles as read (or; SEEN) you might want to set this to @samp{nil}.
+Then all articles in the mailbox is fetched, no matter what.  For a
+complete list of predicates, see RFC2060 Â§6.4.4.
 
 @item :fetchflag
-How to flag fetched articles on the server, the default @samp{\Deleted}
-will mark them as deleted, an alternative would be @samp{\Seen} which
-would simply mark them as read. Theese are the two most likely choices,
+How to flag fetched articles on the server, the default @samp{Deleted}
+will mark them as deleted, an alternative would be @samp{Seen} which
+would simply mark them as read.  These are the two most likely choices,
 but more flags are defined in RFC2060 Â§2.3.2.
 
 @item :dontexpunge
@@ -10627,19 +10644,19 @@ An example @sc{imap} mail source:
 
 @item webmail
 Get mail from a webmail server, such as www.hotmail.com, 
-mail.yahoo.com, and www.netaddress.com. 
+mail.yahoo.com, www.netaddress.com and www.my-deja.com. 
 
 NOTE: Webmail largely depends on w3 (url) package, whose version of "WWW
 4.0pre.46 1999/10/01" or previous ones may not work.
 
-WARNING: Mails may lost. NO WARRANTY.
+WARNING: Mails may lost.  NO WARRANTY.
 
 Keywords:
 
 @table @code
 @item :subtype
-The type of the webmail server.  The default is @code{hotmail}. The
-alternatives are @code{yahoo}, @code{netaddress}.
+The type of the webmail server.  The default is @code{hotmail}.  The
+alternatives are @code{yahoo}, @code{netaddress}, @code{my-deja}.
 
 @item :user
 The user name to give to the webmail server.  The default is the login
@@ -10649,6 +10666,10 @@ name.
 The password to give to the webmail server.  If not specified, the user is
 prompted.
 
+@item :dontexpunge
+If non-nil, only fetch unread articles and don't move them to trash
+folder after finishing the fetch.
+
 @end table
 
 An example webmail source:
@@ -10658,6 +10679,18 @@ An example webmail source:
 @end lisp
 @end table
 
+@table @dfn
+@item Common Keywords
+Common keywords can be used in any type of mail source.
+
+Keywords:
+
+@table @code
+@item :plugged
+If non-nil, fetch the mail even when Gnus is unplugged.
+
+@end table
+@end table
 
 @node Mail Source Customization
 @subsubsection Mail Source Customization
@@ -10852,14 +10885,14 @@ name.  Normal regexp match expansion will be done.  See below for
 examples.
 
 @item
-@code{(@var{field} @var{value} @code{[-} @var{restrict} @code{[-} @var{restrict} @code{[@dots{}]}@code{]]} 
-@var{split})}: If the split is a list, the first element of which is a
-string, then store the message as specified by @var{split}, if header
-@var{field} (a regexp) contains @var{value} (also a regexp).  If
-@var{restrict} (yet another regexp) matches some string after
-@var{field} and before the end of the matched @var{value}, the
-@var{split} is ignored.  If none of the @var{restrict} clauses match,
-@var{split} is processed.
+@code{(@var{field} @var{value} @code{[-} @var{restrict}
+@code{[@dots{}]}@code{]} @var{split})}: If the split is a list, the
+first element of which is a string, then store the message as
+specified by @var{split}, if header @var{field} (a regexp) contains
+@var{value} (also a regexp).  If @var{restrict} (yet another regexp)
+matches some string after @var{field} and before the end of the
+matched @var{value}, the @var{split} is ignored.  If none of the
+@var{restrict} clauses match, @var{split} is processed.
 
 @item
 @code{(| @var{split}@dots{})}: If the split is a list, and the first
@@ -10873,7 +10906,7 @@ element is @code{&}, then process all @var{split}s in the list.
 
 @item
 @code{junk}: If the split is the symbol @code{junk}, then don't save
-this message. Use with extreme caution.
+this message.  Use with extreme caution.
 
 @item
 @code{(: @var{function} @var{arg1} @var{arg2} @dots{})}:  If the split is
@@ -10884,7 +10917,7 @@ function should return a @var{split}.
 @item
 @code{(! @var{func} @var{split})}: If the split is a list, and the first
 element is @code{!}, then SPLIT will be processed, and FUNC will be
-called as a function with the result of SPLIT as argument. FUNC should
+called as a function with the result of SPLIT as argument.  FUNC should
 return a split.
 
 @item
@@ -11340,7 +11373,7 @@ this, it keeps a cache of old @code{Message-ID}s---
 @code{nnmail-message-id-cache-file}, which is @file{~/.nnmail-cache} by
 default.  The approximate maximum number of @code{Message-ID}s stored
 there is controlled by the @code{nnmail-message-id-cache-length}
-variable, which is 1000 by default. (So 1000 @code{Message-ID}s will be
+variable, which is 1000 by default.  (So 1000 @code{Message-ID}s will be
 stored.) If all this sounds scary to you, you can set
 @code{nnmail-treat-duplicates} to @code{warn} (which is what it is by
 default), and @code{nnmail} won't delete duplicate mails.  Instead it
@@ -11471,8 +11504,8 @@ into groups.
 @vindex nnbabyl-active-file
 @vindex nnbabyl-mbox-file
 The @dfn{nnbabyl} backend will use a babyl mail box (aka. @dfn{rmail
-mbox}) to store mail. @code{nnbabyl} will add extra headers to each mail
-article to say which group it belongs in.
+mbox}) to store mail.  @code{nnbabyl} will add extra headers to each
+mail article to say which group it belongs in.
 
 Virtual server settings:
 
@@ -11941,6 +11974,9 @@ groups.  (Note that the default subscription method is to subscribe new
 groups as zombies.  Other methods are available (@pxref{Subscription
 Methods}).
 
+If you want to remove an old @code{nnslashdot} group, the @kbd{G DEL}
+command is the most handy tool (@pxref{Foreign Groups}).
+
 When following up to @code{nnslashdot} comments (or posting new
 comments), some light @sc{html}izations will be performed.  In
 particular, text quoted with @samp{> } will be quoted with
@@ -12037,7 +12073,8 @@ The directory where @code{nnultimate} stores its files.  The default is
 @cindex Web Archive
 
 Some mailing lists only have archives on Web servers, such as
-(@file{http://www.egroups.com/}). It has a quite regular and nice
+@file{http://www.egroups.com/} and
+@file{http://www.mail-archive.com/}.  It has a quite regular and nice
 interface, and it's possible to get the information Gnus needs to keep
 groups updated.
 
@@ -12046,7 +12083,8 @@ something like the following in the group buffer: @kbd{M-x
 gnus-group-make-nnwarchive-group RET an_egroup RET egroups RET
 www.egroups.com RET your@@email.address RET}.  (Substitute the
 @sc{an_egroup} with the mailing list you subscribed, the
-@sc{your@@email.address} with your email address.)
+@sc{your@@email.address} with your email address.), or to browse the
+backend by @kbd{B nnwarchive RET mail-archive RET}.
 
 The following @code{nnwarchive} variables can be altered:
 
@@ -12122,13 +12160,13 @@ true.
 When @code{nneething} is presented with a directory, it will scan this
 directory and assign article numbers to each file.  When you enter such
 a group, @code{nneething} must create ``headers'' that Gnus can use.
-After all, Gnus is a newsreader, in case you're
-forgetting. @code{nneething} does this in a two-step process.  First, it
-snoops each file in question.  If the file looks like an article (i.e.,
-the first few lines look like headers), it will use this as the head.
-If this is just some arbitrary file without a head (e.g. a C source
-file), @code{nneething} will cobble up a header out of thin air.  It
-will use file ownership, name and date and do whatever it can with these
+After all, Gnus is a newsreader, in case you're forgetting.
+@code{nneething} does this in a two-step process.  First, it snoops each
+file in question.  If the file looks like an article (i.e., the first
+few lines look like headers), it will use this as the head.  If this is
+just some arbitrary file without a head (e.g. a C source file),
+@code{nneething} will cobble up a header out of thin air.  It will use
+file ownership, name and date and do whatever it can with these
 elements.
 
 All this should happen automatically for you, and you will be presented
@@ -12754,10 +12792,10 @@ So, to use this, simply say something like:
 @cindex nnimap
 @cindex @sc{imap}
 
-@sc{imap} is a network protocol for reading mail (or news, or ...), think of
-it as a modernized @sc{nntp}. Connecting to a @sc{imap} server is much similar to
-connecting to a news server, you just specify the network address of the
-server.
+@sc{imap} is a network protocol for reading mail (or news, or ...),
+think of it as a modernized @sc{nntp}.  Connecting to a @sc{imap} server
+is much similar to connecting to a news server, you just specify the
+network address of the server.
 
 The following variables can be used to create a virtual @code{nnimap}
 server:
@@ -12767,20 +12805,20 @@ server:
 @item nnimap-address
 @vindex nnimap-address
 
-The address of the remote @sc{imap} server. Defaults to the virtual server
-name if not specified.
+The address of the remote @sc{imap} server.  Defaults to the virtual
+server name if not specified.
 
 @item nnimap-server-port
 @vindex nnimap-server-port
-Port on server to contact. Defaults to port 143, or 993 for SSL.
+Port on server to contact.  Defaults to port 143, or 993 for SSL.
 
 @item nnimap-list-pattern
 @vindex nnimap-list-pattern
-String or list of strings of mailboxes to limit available groups
-to. This is used when the server has very many mailboxes and you're only
-interested in a few -- some servers export your home directory via @sc{imap},
-you'll probably want to limit the mailboxes to those in @file{~/Mail/*}
-then.
+String or list of strings of mailboxes to limit available groups to.
+This is used when the server has very many mailboxes and you're only
+interested in a few -- some servers export your home directory via
+@sc{imap}, you'll probably want to limit the mailboxes to those in
+@file{~/Mail/*} then.
 
 The string can also be a cons of REFERENCE and the string as above, what
 REFERENCE is used for is server specific, but on the University of
@@ -12795,7 +12833,7 @@ Example:
 
 @item nnimap-stream
 @vindex nnimap-stream
-The type of stream used to connect to your server. By default, nnimap
+The type of stream used to connect to your server.  By default, nnimap
 will use the most secure stream your server is capable of.
 
 @itemize @bullet
@@ -12810,8 +12848,8 @@ will use the most secure stream your server is capable of.
 @item nnimap-authenticator
 @vindex nnimap-authenticator
 
-The authenticator used to connect to the server. By default, nnimap will
-use the most secure authenticator your server is capable of.
+The authenticator used to connect to the server.  By default, nnimap
+will use the most secure authenticator your server is capable of.
 
 @itemize @bullet
 @item
@@ -12828,13 +12866,14 @@ use the most secure authenticator your server is capable of.
 @cindex Expunging
 @vindex nnimap-expunge-on-close
 Unlike Parmenides the @sc{imap} designers has decided that things that
-doesn't exist actually does exist. More specifically, @sc{imap} has this
-concept of marking articles @code{Deleted} which doesn't actually delete
-them, and this (marking them @code{Deleted}, that is) is what nnimap
-does when you delete a article in Gnus (with @kbd{G DEL} or similair).
+doesn't exist actually does exist.  More specifically, @sc{imap} has
+this concept of marking articles @code{Deleted} which doesn't actually
+delete them, and this (marking them @code{Deleted}, that is) is what
+nnimap does when you delete a article in Gnus (with @kbd{G DEL} or
+similair).
 
 Since the articles aren't really removed when we mark them with the
-@code{Deleted} flag we'll need a way to actually delete them. Feel like
+@code{Deleted} flag we'll need a way to actually delete them.  Feel like
 running in circles yet?
 
 Traditionally, nnimap has removed all articles marked as @code{Deleted}
@@ -12849,10 +12888,10 @@ The possible options are:
 The default behaviour, delete all articles marked as "Deleted" when
 closing a mailbox.
 @item never
-Never actually delete articles. Currently there is no way of showing the
-articles marked for deletion in nnimap, but other @sc{imap} clients may allow
-you to do this. If you ever want to run the EXPUNGE command manually,
-@xref{Expunging mailboxes}.
+Never actually delete articles.  Currently there is no way of showing
+the articles marked for deletion in nnimap, but other @sc{imap} clients
+may allow you to do this.  If you ever want to run the EXPUNGE command
+manually, @xref{Expunging mailboxes}.
 @item ask
 When closing mailboxes, nnimap will ask if you wish to expunge deleted
 articles or not.
@@ -12873,14 +12912,14 @@ articles or not.
 @cindex splitting imap mail
 
 Splitting is something Gnus users has loved and used for years, and now
-the rest of the world is catching up. Yeah, dream on, not many @sc{imap}
-server has server side splitting and those that have splitting seem to
-use some non-standard protocol. This means that @sc{imap} support for Gnus
-has to do it's own splitting.
+the rest of the world is catching up.  Yeah, dream on, not many
+@sc{imap} server has server side splitting and those that have splitting
+seem to use some non-standard protocol.  This means that @sc{imap}
+support for Gnus has to do it's own splitting.
 
 And it does.
 
-There are three variables of interest:
+Here are the variables of interest:
 
 @table @code
 
@@ -12889,7 +12928,7 @@ There are three variables of interest:
 @cindex crosspost
 @vindex nnimap-split-crosspost
 
-If non-nil, do crossposting if several split methods match the mail. If
+If non-nil, do crossposting if several split methods match the mail.  If
 nil, the first match in @code{nnimap-split-rule} found will be used.
 
 Nnmail equivalent: @code{nnmail-crosspost}.
@@ -12899,8 +12938,9 @@ Nnmail equivalent: @code{nnmail-crosspost}.
 @cindex inbox
 @vindex nnimap-split-inbox
 
-A string or a list of strings that gives the name(s) of @sc{imap} mailboxes
-to split from. Defaults to nil, which means that splitting is disabled!
+A string or a list of strings that gives the name(s) of @sc{imap}
+mailboxes to split from.  Defaults to nil, which means that splitting is
+disabled!
 
 @lisp
 (setq nnimap-split-inbox '("INBOX" ("~/friend/Mail" . "lists/*") "lists.imap"))
@@ -12916,9 +12956,9 @@ New mail found in @code{nnimap-split-inbox} will be split according to
 this variable.
 
 This variable contains a list of lists, where the first element in the
-sublist gives the name of the @sc{imap} mailbox to move articles matching the
-regexp in the second element in the sublist. Got that? Neither did I, we
-need examples.
+sublist gives the name of the @sc{imap} mailbox to move articles
+matching the regexp in the second element in the sublist.  Got that?
+Neither did I, we need examples.
 
 @lisp
 (setq nnimap-split-rule
@@ -12932,33 +12972,60 @@ INBOX.nnimap, all articles containing MAKE MONEY in the Subject: line
 into INBOX.spam and everything else in INBOX.private.
 
 The first string may contain `\\1' forms, like the ones used by
-replace-match to insert sub-expressions from the matched text. For
+replace-match to insert sub-expressions from the matched text.  For
 instance:
 
 @lisp
 ("INBOX.lists.\\1"     "^Sender: owner-\\([a-z-]+\\)@@")
 @end lisp
 
-The second element can also be a function. In that case, it will be
+The second element can also be a function.  In that case, it will be
 called with the first element of the rule as the argument, in a buffer
-containing the headers of the article. It should return a non-nil value
+containing the headers of the article.  It should return a non-nil value
 if it thinks that the mail belongs in that group.
 
 Nnmail users might recollect that the last regexp had to be empty to
-match all articles (like in the example above). This is not required in
-nnimap. Articles not matching any of the regexps will not be moved out
-of your inbox. (This might might affect performance if you keep lots of
+match all articles (like in the example above).  This is not required in
+nnimap.  Articles not matching any of the regexps will not be moved out
+of your inbox.  (This might might affect performance if you keep lots of
 unread articles in your inbox, since the splitting code would go over
 them every time you fetch new mail.)
 
 These rules are processed from the beginning of the alist toward the
-end. The first rule to make a match will "win", unless you have
-crossposting enabled. In that case, all matching rules will "win".
+end.  The first rule to make a match will "win", unless you have
+crossposting enabled.  In that case, all matching rules will "win".
+
+This variable can also have a function as its value, the function will
+be called with the headers narrowed and should return a group where it
+thinks the article should be splitted to.
 
 The splitting code tries to create mailboxes if it need too.
 
 Nnmail equivalent: @code{nnmail-split-methods}.
 
+@item nnimap-split-fancy
+@cindex splitting, fancy
+@findex nnimap-split-fancy
+@vindex nnimap-split-fancy
+
+It's possible to set @code{nnimap-split-rule} to
+@code{nnmail-split-fancy} if you want to use fancy
+splitting. @xref{Fancy Mail Splitting}.
+
+However, to be able to have different fancy split rules for nnmail and
+nnimap backends you can set @code{nnimap-split-rule} to
+@code{nnimap-split-fancy} and define the nnimap specific fancy split
+rule in @code{nnimap-split-fancy}.
+
+Example:
+
+@lisp
+(setq nnimap-split-rule 'nnimap-split-fancy
+      nnimap-split-fancy ...)
+@end lisp
+
+Nnmail equivalent: @code{nnmail-split-fancy}.
+
 @end table
 
 @node Editing IMAP ACLs
@@ -12969,9 +13036,10 @@ Nnmail equivalent: @code{nnmail-split-methods}.
 @kindex G l
 @findex gnus-group-nnimap-edit-acl
 
-ACL stands for Access Control List.  ACLs are used in @sc{imap} for limiting
-(or enabling) other users access to your mail boxes. Not all @sc{imap}
-servers support this, this function will give an error if it doesn't.
+ACL stands for Access Control List.  ACLs are used in @sc{imap} for
+limiting (or enabling) other users access to your mail boxes.  Not all
+@sc{imap} servers support this, this function will give an error if it
+doesn't.
 
 To edit a ACL for a mailbox, type @kbd{G l}
 (@code{gnus-group-edit-nnimap-acl}) and you'll be presented with a ACL
@@ -13002,7 +13070,7 @@ INBOX.mailbox).
 
 If you're using the @code{never} setting of @code{nnimap-expunge-close},
 you may want the option of expunging all deleted articles in a mailbox
-manually. This is exactly what @kbd{G x} does.
+manually.  This is exactly what @kbd{G x} does.
 
 Currently there is no way of showing deleted articles, you can just
 delete them.
@@ -13291,7 +13359,7 @@ you're interested in the articles anyway.
 The main way to control what is to be downloaded is to create a
 @dfn{category} and then assign some (or all) groups to this category.
 Groups that do not belong in any other category belong to the
-@code{default} category. Gnus has its own buffer for creating and
+@code{default} category.  Gnus has its own buffer for creating and
 managing categories.
 
 @menu
@@ -13318,8 +13386,8 @@ score} is not necessarily related to normal scores.)
 @end enumerate
 
 A predicate in its simplest form can be a single predicate such as
-@code{true} or @code{false}. These two will download every available
-article or nothing respectively. In the case of these two special
+@code{true} or @code{false}.  These two will download every available
+article or nothing respectively.  In the case of these two special
 predicates an additional score rule is superfluous.
 
 Predicates of @code{high} or @code{low} download articles in respect of
@@ -13433,12 +13501,11 @@ and simply specify your predicate as:
 
 If/when using something like the above, be aware that there are many
 misconfigured systems/mailers out there and so an article's date is not
-always a reliable indication of when it was posted. Hell, some people
+always a reliable indication of when it was posted.  Hell, some people
 just don't give a damm.
 
-
 The above predicates apply to *all* the groups which belong to the
-category. However, if you wish to have a specific predicate for an
+category.  However, if you wish to have a specific predicate for an
 individual group within a category, or you're just too lazy to set up a
 new category, you can enter a group's individual predicate in it's group
 parameters like so:
@@ -13447,10 +13514,9 @@ parameters like so:
 (agent-predicate . short)
 @end lisp
 
-This is the group parameter equivalent of the agent category
-default. Note that when specifying a single word predicate like this,
-the @code{agent-predicate} specification must be in dotted pair
-notation.
+This is the group parameter equivalent of the agent category default.
+Note that when specifying a single word predicate like this, the
+@code{agent-predicate} specification must be in dotted pair notation.
 
 The equivalent of the longer example from above would be:
 
@@ -13540,8 +13606,8 @@ Group Parameter specification
 (agent-score "~/News/agent.SCORE")
 @end lisp
 
-Additional score files can be specified as above. Need I say anything
-about parenthesis.
+Additional score files can be specified as above.  Need I say anything
+about parenthesis?
 @end itemize
 
 @item
@@ -14897,7 +14963,7 @@ A string.  Then this file will be used as the home score file for all
 groups.
 
 @item
-A function. The result of this function will be used as the home score
+A function.  The result of this function will be used as the home score
 file.  The function will be called with the name of the group as the
 parameter.
 
@@ -14910,7 +14976,7 @@ A list.  The elements in this list can be:
 group name, the @var{file-name} will will be used as the home score file.
 
 @item
-A function. If the function returns non-nil, the result will be used as
+A function.  If the function returns non-nil, the result will be used as
 the home score file.
 
 @item
@@ -15403,7 +15469,7 @@ from GroupLens in one of three ways controlled by the variable
 @vindex gnus-grouplens-override-scoring
 There are three ways to display predictions in grouplens.  You may
 choose to have the GroupLens scores contribute to, or override the
-regular gnus scoring mechanism. override is the default; however, some
+regular gnus scoring mechanism.  override is the default; however, some
 people prefer to see the Gnus scores plus the grouplens scores.  To get
 the separate scoring behavior you need to set
 @code{gnus-grouplens-override-scoring} to @code{'separate}.  To have the
@@ -16027,12 +16093,12 @@ and so on.  Create as many faces as you wish.  The same goes for the
 @samp{hello} mouse-highlighted with @code{gnus-mouse-face-3}.
 
 Text inside the @samp{%<} and @samp{%>} specifiers will get the special
-@code{balloon-help} property set to @code{gnus-balloon-face-0}. If you say
-@samp{%1<}, you'll get @code{gnus-balloon-face-1} and so on. The
-@code{gnus-balloon-face-*} variables should be either strings or
-symbols naming functions that return a string. Under @code{balloon-help-mode},
+@code{balloon-help} property set to @code{gnus-balloon-face-0}.  If you
+say @samp{%1<}, you'll get @code{gnus-balloon-face-1} and so on.  The
+@code{gnus-balloon-face-*} variables should be either strings or symbols
+naming functions that return a string.  Under @code{balloon-help-mode},
 when the mouse passes over text with this property set, a balloon window
-will appear and display the string. Please refer to the doc string of
+will appear and display the string.  Please refer to the doc string of
 @code{balloon-help-mode} for more information on this.
 
 Here's an alternative recipe for the group buffer:
@@ -17143,7 +17209,7 @@ In short---to use Smiley in Gnus, put the following in your
 @file{.gnus.el} file:
 
 @lisp
-(setq gnus-treat-display-smiley t)
+(setq gnus-treat-display-smileys t)
 @end lisp
 
 Smiley maps text smiley faces---@samp{:-)}, @samp{:-=}, @samp{:-(} and
@@ -17526,11 +17592,11 @@ but at the common table.@*
 @sc{gnus} was written by Masanobu @sc{Umeda}.  When autumn crept up in
 '94, Lars Magne Ingebrigtsen grew bored and decided to rewrite Gnus.
 
-If you want to investigate the person responsible for this outrage, you
-can point your (feh!) web browser to
-@file{http://www.stud.ifi.uio.no/~larsi/}.  This is also the primary
-distribution point for the new and spiffy versions of Gnus, and is known
-as The Site That Destroys Newsrcs And Drives People Mad.
+If you want to investigate the person responsible for this outrage,
+you can point your (feh!) web browser to
+@file{http://quimby.gnus.org/~larsi/}.  This is also the primary
+distribution point for the new and spiffy versions of Gnus, and is
+known as The Site That Destroys Newsrcs And Drives People Mad.
 
 During the first extended alpha period of development, the new Gnus was
 called ``(ding) Gnus''.  @dfn{(ding)} is, of course, short for
@@ -17630,7 +17696,7 @@ and news from different sources.  I have added hooks for customizations
 everywhere I could imagine it being useful.  By doing so, I'm inviting
 every one of you to explore and invent.
 
-May Gnus never be complete. @kbd{C-u 100 M-x all-hail-emacs} and
+May Gnus never be complete.  @kbd{C-u 100 M-x all-hail-emacs} and
 @kbd{C-u 100 M-x all-hail-xemacs}.
 
 
@@ -17652,7 +17718,7 @@ Our motto is:
 All commands have kept their names.  Some internal functions have changed
 their names.
 
-The @code{gnus-uu} package has changed drastically. @xref{Decoding
+The @code{gnus-uu} package has changed drastically.  @xref{Decoding
 Articles}.
 
 One major compatibility question is the presence of several summary
@@ -17856,6 +17922,9 @@ well as numerous other things).
 Luis Fernandes---design and graphics.
 
 @item
+Justin Sheehy--the FAQ maintainer.
+
+@item
 Erik Naggum---help, ideas, support, code and stuff.
 
 @item
@@ -18088,7 +18157,6 @@ Ralph Schleicher,
 Philippe Schnoebelen,
 Andreas Schwab,
 Randal L. Schwartz,
-Justin Sheehy,
 Danny Siu,
 Matt Simmons,
 Paul D. Smith,
@@ -20069,6 +20137,12 @@ Be able to forward groups of messages as MIME digests.
 nnweb should include the "get whole article" article when getting articles. 
 
 @item
+When I type W W c (gnus-article-hide-citation) in the summary
+buffer, the citations are revealed, but the [+] buttons don't turn
+into [-] buttons.  (If I click on one of the [+] buttons, it does
+turn into a [-] button.)
+
+@item
 Solve the halting problem.
 
 @c TODO
@@ -20525,7 +20599,7 @@ If all else fails, report the problem as a bug.
 @kindex M-x gnus-bug
 @findex gnus-bug
 If you find a bug in Gnus, you can report it with the @kbd{M-x gnus-bug}
-command. @kbd{M-x set-variable RET debug-on-error RET t RET}, and send
+command.  @kbd{M-x set-variable RET debug-on-error RET t RET}, and send
 me the backtrace.  I will fix bugs, but I can only fix them if you send
 me a precise description as to how to reproduce the bug.
 
@@ -21040,11 +21114,11 @@ There should be no result data from this function.
 
 @item (nnchoke-request-set-mark GROUP ACTION &optional SERVER)
 
-Set/remove/add marks on articles. Normally Gnus handles the article
+Set/remove/add marks on articles.  Normally Gnus handles the article
 marks (such as read, ticked, expired etc) internally, and store them in
-@code{~/.newsrc.eld}. Some backends (such as @sc{imap}) however carry all
-information about the articles on the server, so Gnus need to propagate
-the mark information to the server.
+@code{~/.newsrc.eld}.  Some backends (such as @sc{imap}) however carry
+all information about the articles on the server, so Gnus need to
+propagate the mark information to the server.
 
 ACTION is a list of mark setting requests, having this format:
 
@@ -21052,18 +21126,18 @@ ACTION is a list of mark setting requests, having this format:
 (RANGE ACTION MARK)
 @end example
 
-Range is a range of articles you wish to update marks on. Action is
+Range is a range of articles you wish to update marks on.  Action is
 @code{set}, @code{add} or @code{del}, respectively used for removing all
 existing marks and setting them as specified, adding (preserving the
 marks not mentioned) mark and removing (preserving the marks not
-mentioned) marks. Mark is a list of marks; where each mark is a
-symbol. Currently used marks are @code{read}, @code{tick}, @code{reply},
+mentioned) marks.  Mark is a list of marks; where each mark is a symbol.
+Currently used marks are @code{read}, @code{tick}, @code{reply},
 @code{expire}, @code{killed}, @code{dormant}, @code{save},
 @code{download} and @code{unsend}, but your backend should, if possible,
-not limit itself to theese.
+not limit itself to these.
 
 Given contradictory actions, the last action in the list should be the
-effective one. That is, if your action contains a request to add the
+effective one.  That is, if your action contains a request to add the
 @code{tick} mark on article 1 and, later in the list, a request to
 remove the mark on the same article, the mark should in fact be removed.
 
index 24e6b45..0bbbc50 100644 (file)
@@ -275,6 +275,12 @@ the evidence of previous forwards (such as @samp{Fwd:}, @samp{Re:},
 @samp{(fwd)}) removed before the new subject is
 constructed.  The default value is @code{nil}.
 
+@item message-forward-as-mime
+@vindex message-forward-as-mime
+If this variable is @code{t} (the default), forwarded messages are
+included as inline MIME RFC822 parts.  If it's @code{nil}, forwarded
+messages will just be copied inline to the new message, like previous,
+non MIME-savvy versions of gnus would do.
 @end table
 
 
@@ -1159,7 +1165,7 @@ A function to be called if @var{predicate} returns non-@code{nil}.
 @item message-fcc-handler-function
 @vindex message-fcc-handler-function
 A function called to save outgoing articles.  This function will be
-called with the name of the file to store the article in. The default
+called with the name of the file to store the article in.  The default
 function is @code{message-output} which saves in Unix mailbox format.
 
 @item message-courtesy-message
index 3b5f803..a7d0a5c 100644 (file)
 \thispagestyle{empty}
 \vfill
 
-\begin{picture}(10,10)
-\put(90,-10){\makebox(0,0)[tr]{\epsfig{figure=tmp/larsi.ps,height=3cm}}}
-\end{picture}
-
-\hspace*{4cm}\parbox[t]{10cm}{
-This manual was written by Lars Magne Ingebrigtsen (b. 1968) who
+This manual was written by Lars Magne Ingebrigtsen (1968 --- ) who
 resides in Oslo, Norway and poses as a student, but doesn't get much
 studying done, for some strange reason or other.  When not worshipping
 at the altar of Emacs, he can often be found slouching on his couch
 reading while bopping his head gently to some obscure music.  He does
 not have a cat.
 
-Graphics by Luis Fernandes.  Set in Bembo and Futura.
-}
+\marginpar[\vspace*{-2.5cm}\epsfig{figure=tmp/larsi.ps,height=2cm}]{\vspace*{-2.2cm}\epsfig{figure=tmp/larsi.ps,height=2.5cm}}
+
+Graphics by Luis Fernandes.  Set in Adobe Bembo, Adobe Futura and
+Bitstream Courier.
 
 \clearpage
 \mbox{}