+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.
* 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.
* 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.
* 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.
* 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.
* 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
( ?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))
(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)
(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))
(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
;;; 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.1.11 $
-;; 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
;;; Code:
+(eval-when-compile (require 'cl))
+
(if (not (fboundp 'char-int))
(fset 'char-int 'identity))
((= 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
(if (memq system-type '(win32 w32 mswindows windows-nt))
(setq filename (downcase filename)))
(cond ((eq system-type 'vax-vms)
- (concat (substring filename 0 (string-match ";" filename)) "c"))
- ((string-match emacs-lisp-file-regexp filename)
- (concat (substring filename 0 (match-beginning 0)) ".elc"))
- (t (concat filename ".elc"))))
+ (concat (substring filename 0 (string-match ";" filename)) "c"))
+ ((string-match emacs-lisp-file-regexp filename)
+ (concat (substring filename 0 (match-beginning 0)) ".elc"))
+ (t (concat filename ".elc"))))
(require 'bytecomp)
: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)
+
;;; Internal variables
(defvar gnus-agent-history-buffers nil)
(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
;; 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))
(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)))
(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
;; add article with marks to list of article headers we want to fetch
(dolist (arts (gnus-info-marks (gnus-get-info group)))
(setq articles (union (gnus-uncompress-sequence (cdr arts))
- articles)))
+ articles)))
(setq articles (sort articles '<))
;; remove known articles
(when (gnus-agent-load-alist group)
(setq articles (gnus-sorted-intersection
- articles
- (gnus-uncompress-range
- (cons (1+ (caar (last gnus-agent-article-alist)))
- (cdr (gnus-active group)))))))
+ articles
+ (gnus-uncompress-range
+ (cons (1+ (caar (last gnus-agent-article-alist)))
+ (cdr (gnus-active group)))))))
;; Fetch them.
(gnus-make-directory (nnheader-translate-file-chars
(file-name-directory file)))
(concat (gnus-agent-directory) (gnus-agent-group-path group) "/"
(if (stringp article) article (string-to-number article))))
+(defun gnus-agent-batch-confirmation (msg)
+ "Show error message and return t."
+ (gnus-message 1 msg)
+ t)
+
;;;###autoload
(defun gnus-agent-batch-fetch ()
"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 ()
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"))))
(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
(gnus-get-predicate
- (or (gnus-group-find-parameter group 'agent-predicate t)
+ (or (gnus-group-find-parameter group 'agent-predicate t)
(cadr category))))
;; Do we want to download everything, or nothing?
(if (or (eq (caaddr predicate) 'gnus-agent-true)
(gnus-edit-form
(cadr info) (format "Editing the predicate for category %s" category)
`(lambda (predicate)
- (setf (cadr (assq ',category gnus-category-alist)) predicate)
+ (setcar (cdr (assq ',category gnus-category-alist)) predicate)
(gnus-category-write)
(gnus-category-list)))))
(caddr info)
(format "Editing the score expression for category %s" category)
`(lambda (groups)
- (setf (caddr (assq ',category gnus-category-alist)) groups)
+ (setcar (cddr (assq ',category gnus-category-alist)) groups)
(gnus-category-write)
(gnus-category-list)))))
(gnus-edit-form
(cadddr info) (format "Editing the group list for category %s" category)
`(lambda (groups)
- (setf (cadddr (assq ',category gnus-category-alist)) groups)
+ (setcar (nthcdr 3 (assq ',category gnus-category-alist)) groups)
(gnus-category-write)
(gnus-category-list)))))
(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)))
(set-buffer overview)
(erase-buffer)
(when (file-exists-p nov-file)
- (nnheader-insert-file-contents nov-file))
+ (nnheader-insert-file-contents nov-file))
(goto-char (point-min))
(setq article 0)
(while (setq elem (pop articles))
: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
"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
"Decode charset-encoded text in the article.
If PROMPT (the prefix), prompt for a coding system to use."
(interactive "P")
- (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
+ (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)
+ (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))))
- (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)
- (goto-char (point-max))
- (widen)
+ (goto-char (point-max)))
(forward-line 1)
- (narrow-to-region (point) (point-max))
- (when (and (or (not ctl)
- (and (eq (mime-content-type-primary-type ctl) 'text)
- (eq (mime-content-type-subtype ctl) 'plain))))
- (mm-decode-body
- charset (and cte (intern (downcase
- (gnus-strip-whitespace cte))))
- (car ctl)))))))
+ (save-restriction
+ (narrow-to-region (point) (point-max))
+ (when (and (or (not ctl)
+ (and (eq (mime-content-type-primary-type ctl) 'text)
+ (eq (mime-content-type-subtype ctl) 'plain))))
+ (mm-decode-body
+ charset (and cte (intern (downcase
+ (gnus-strip-whitespace cte))))
+ (car ctl)))))))
(defun article-decode-encoded-words ()
"Remove encoded-word encoding from headers."
(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
(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))
(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)))))
(while (setq elem (pop alist))
(when (and name (string-match (car elem) name))
(setq alist nil
- highlight (copy-list (cdr elem)))))
+ highlight (copy-sequence (cdr elem)))))
highlight)
- (copy-list highlight-words)
+ (copy-sequence highlight-words)
(if gnus-newsgroup-name
- (copy-list (gnus-group-find-parameter
- gnus-newsgroup-name 'highlight-words t)))
+ (copy-sequence (gnus-group-find-parameter
+ gnus-newsgroup-name 'highlight-words t)))
gnus-emphasis-alist)))))
(defvar gnus-summary-article-menu)
article-remove-cr
article-display-x-face
article-de-quoted-unreadable
+ article-decode-HZ
article-mime-decode-quoted-printable
article-hide-list-identifiers
article-hide-pgp
["Hide citation" gnus-article-hide-citation t]
["Treat overstrike" gnus-article-treat-overstrike t]
["Remove carriage return" gnus-article-remove-cr t]
- ["Remove quoted-unreadable" gnus-article-de-quoted-unreadable t]))
+ ["Remove quoted-unreadable" gnus-article-de-quoted-unreadable t]
+ ["Decode HZ" gnus-article-decode-HZ t]))
;; Note "Commands" menu is defined in gnus-sum.el for consistency
(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
(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: " mm-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)))
((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))
;; 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
(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)))))))))
(eval-when-compile
(defvar mime-display-header-hook)
(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
;; 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
;; 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)
'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)))
("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.
'(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.
(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))))))
- gnus-decode-header-methods))
+ (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)
(save-restriction
"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.
(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)
(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."
"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))
+;;(defun gnus-audio-disable-sound ()
+;; "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"
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)
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.
(set-buffer cache-buf)
(erase-buffer)
(let ((coding-system-for-read
- gnus-cache-overview-coding-system))
+ gnus-cache-overview-coding-system))
(insert-file-contents
(or file (gnus-cache-file-name group ".overview"))))
(goto-char (point-min))
(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,
(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)
(provide 'gnus-cite)
+;; Local Variables:
+;; coding: iso-8859-1
+;; End:
+
;;; gnus-cite.el ends here
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'
(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) "\
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'.")
(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.
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"
(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"
(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"
(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"
(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*"))
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))
"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
(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))
;;;!!!This has been fixed in recent versions of Emacs and XEmacs,
;;;!!!but for the time being, we'll just run this tiny function uncompiled.
-(defun gnus-draft-setup-for-editing (narticle group)
- (gnus-setup-message 'forward
- (let ((article narticle))
- (message-mail)
- (erase-buffer)
- (if (not (gnus-request-restore-buffer article group))
- (error "Couldn't restore the article")
- ;; Insert the separator.
- (funcall gnus-draft-decoding-function)
- (goto-char (point-min))
- (search-forward "\n\n")
- (forward-char -1)
- (insert mail-header-separator)
- (forward-line 1)
- (message-set-auto-save-file-name)))))
+(progn
+ (defun gnus-draft-setup-for-editing (narticle group)
+ (gnus-setup-message 'forward
+ (let ((article narticle))
+ (message-mail)
+ (erase-buffer)
+ (if (not (gnus-request-restore-buffer article group))
+ (error "Couldn't restore the article")
+ ;; Insert the separator.
+ (funcall gnus-draft-decoding-function)
+ (goto-char (point-min))
+ (search-forward "\n\n")
+ (forward-char -1)
+ (insert mail-header-separator)
+ (forward-line 1)
+ (message-set-auto-save-file-name))))))
(defvar gnus-draft-send-draft-buffer " *send draft*")
(defun gnus-draft-setup-for-sending (narticle group)
(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
gnus-tmp-closing-bracket)
(point))
gnus-mouse-face-prop gnus-mouse-face)
- (insert " " gnus-tmp-subject-or-nil "\n"))
- )))
+ (insert " " gnus-tmp-subject-or-nil "\n")))))
(defun gnus-region-active-p ()
"Say whether the region is active."
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++"
;;;; 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 BBDB.")
(defvar grouplens-current-group nil)
(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)
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]\\)")
(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)
((= 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
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)
(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
(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))
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)
(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)
;; 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
(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.
(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))))))
(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))))
: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)
(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"))
(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
(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.
;;;###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.
\"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)
(defvar gnus-posting-styles nil
"*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")))
- :group 'gnus-charset)
-
;;; Internal variables.
(defvar gnus-inhibit-posting-styles nil
(set (make-local-variable 'gnus-message-group-art)
(cons ,group ,article))
(set (make-local-variable 'gnus-newsgroup-name) ,group)
- (set (make-local-variable 'default-mime-chaset)
- (gnus-setup-posting-charset ,group))
- (gnus-setup-posting-charset ,group)
(gnus-run-hooks 'gnus-message-setup-hook))
(gnus-add-buffer)
(gnus-configure-windows ,config t)
(set-buffer-modified-p nil))))
-(defun gnus-setup-posting-charset (group)
- (let ((alist gnus-group-posting-charset-alist)
- (group (or group ""))
- elem)
- (when group
- (catch 'found
- (while (setq elem (pop alist))
- (when (or (and (stringp (car elem))
- (string-match (car elem) group))
- (and (gnus-functionp (car elem))
- (funcall (car elem) group))
- (and (symbolp (car elem))
- (symbol-value (car elem))))
- (throw 'found (cadr elem))))
- default-mime-charset))))
-
(defun gnus-inews-add-send-actions (winconf buffer article)
(make-local-hook 'message-sent-hook)
(add-hook 'message-sent-hook 'gnus-inews-do-gcc nil t)
"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."
(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))))
(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
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)
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)
(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)
(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)
(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))
(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
;; (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.
(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)
(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))
(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."
(,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."
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*")
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
;; 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
(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.
(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
(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
(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
(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))
(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)
(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)
(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
;; 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)))
(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.
(cond
;; Permanent.
((null date)
+ ;; Do nothing.
)
;; Match, update date.
((and found gnus-update-score-entry-dates)
(cond
;; Permanent.
((null date)
+ ;; Do nothing.
)
;; Match, update date.
((and found gnus-update-score-entry-dates)
(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)))
(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.
(cond
(bad (cons 'bad bad))
(new (cons 'new new))
- ;; or nil
- )))))
+ (t nil))))))
(provide 'gnus-score)
"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)))
(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)
(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
(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)
(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)
:type 'file)
(defcustom gnus-site-init-file
- (ignore-errors
- (concat (file-name-directory
- (directory-file-name installation-directory))
- "site-lisp/gnus-init"))
- "*The site-wide Gnus Emacs-Lisp startup file name, or nil if none.
+ (condition-case nil
+ (concat (file-name-directory
+ (directory-file-name installation-directory))
+ "site-lisp/gnus-init")
+ (error nil))
+ "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)))
: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,
(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))
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))
(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))
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
;; 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
(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))
"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 "\
: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)
(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)
: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)
`(("^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)
(".*" ,default-mime-charset))
"Alist of regexps (to match group names) and default charsets to be used when reading."
(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
(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)
'(mail-decode-encoded-word-string)
"List of methods used to decode encoded words.
-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.
(eq gnus-newsgroup-name
(car gnus-decode-encoded-word-methods-cache)))
(setq gnus-decode-encoded-word-methods-cache (list gnus-newsgroup-name))
- (mapc '(lambda (x)
- (if (symbolp x)
- (nconc gnus-decode-encoded-word-methods-cache (list x))
- (if (and gnus-newsgroup-name
- (string-match (car x) gnus-newsgroup-name))
- (nconc gnus-decode-encoded-word-methods-cache
- (list (cdr x))))))
+ (mapcar '(lambda (x)
+ (if (symbolp x)
+ (nconc gnus-decode-encoded-word-methods-cache (list x))
+ (if (and gnus-newsgroup-name
+ (string-match (car x) gnus-newsgroup-name))
+ (nconc gnus-decode-encoded-word-methods-cache
+ (list (cdr x))))))
gnus-decode-encoded-word-methods))
(let ((xlist gnus-decode-encoded-word-methods-cache))
(pop xlist)
(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.
"\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
"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)
["Add buttons to head" gnus-article-add-buttons-to-head t]
["Stop page breaking" gnus-summary-stop-page-breaking t]
["Verbose header" gnus-summary-verbose-headers t]
- ["Toggle header" gnus-summary-toggle-header t])
+ ["Toggle header" gnus-summary-toggle-header 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]
["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 ""
(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)
(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
(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))
(setq header
(make-full-mail-header
- number ; number
- (nnheader-nov-field) ; subject
- (nnheader-nov-field) ; from
- (nnheader-nov-field) ; date
+ number ; number
+ (nnheader-nov-field) ; subject
+ (nnheader-nov-field) ; from
+ (nnheader-nov-field) ; date
(nnheader-nov-read-message-id) ; id
- (nnheader-nov-field) ; refs
- (nnheader-nov-read-integer) ; chars
- (nnheader-nov-read-integer) ; lines
+ (nnheader-nov-field) ; refs
+ (nnheader-nov-read-integer) ; chars
+ (nnheader-nov-read-integer) ; lines
(unless (eobp)
- (nnheader-nov-field)) ; misc
- (nnheader-nov-parse-extra)))) ; extra
+ (nnheader-nov-field)) ; misc
+ (nnheader-nov-parse-extra)))) ; extra
(widen))
;; 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)
(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
;; 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
(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)
headers id end ref
(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)))
+ (save-excursion (condition-case nil
+ (set-buffer gnus-summary-buffer)
+ (error))
+ gnus-newsgroup-ignored-charsets)))
(save-excursion
(set-buffer nntp-server-buffer)
;; Translate all TAB characters into SPACE characters.
;; 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))
(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
(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)
(when (gnus-buffer-live-p gnus-article-buffer)
(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.
(gnus-async-halt-prefetch)
(mapcar 'funcall
(delq 'gnus-summary-expire-articles
- (copy-list gnus-summary-prepare-exit-hook)))
+ (copy-sequence gnus-summary-prepare-exit-hook)))
(when (gnus-buffer-live-p gnus-article-buffer)
(save-excursion
(set-buffer gnus-article-buffer)
(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" "")))
(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))
(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)
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))
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)
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)
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 gnus-article-mark-lists)
(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
(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 '"
(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)
"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))
`??' (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)))
(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.
"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.
(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.
"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
(> 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))
(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))
(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)
(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)
(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.
first 't2
last 't1))
((gnus-functionp function)
+ ;; Do nothing.
)
(t
(error "Invalid sort spec: %s" function))))
"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.
;; 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
(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 ()
(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
(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)
(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)
(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.
(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))
(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))))))))
(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)
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
[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
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 ()
"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)))
;; 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
;; 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
;; 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.
;; => " *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:
+(eval-when-compile (require 'cl))
(eval-and-compile
- (require 'cl)
(autoload 'open-ssl-stream "ssl")
(autoload 'base64-decode-string "base64")
(autoload 'base64-encode-string "base64")
+ (autoload 'starttls-open-stream "starttls")
+ (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 'md5 "md5")
(autoload 'utf7-encode "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.")
(defvar imap-fetch-data-hook nil
"Hooks called after receiving each FETCH response.")
-(defvar imap-streams '(kerberos4 ssl network)
- "Priority of streams to consider when opening connection to
-server.")
+(defvar imap-streams '(kerberos4 starttls ssl network)
+ "Priority of streams to consider when opening connection to server.")
(defvar imap-stream-alist
'((kerberos4 imap-kerberos4s-p imap-kerberos4-open)
(ssl imap-ssl-p imap-ssl-open)
- (network imap-network-p imap-network-open))
+ (network imap-network-p imap-network-open)
+ (starttls imap-starttls-p imap-starttls-open))
"Definition of network streams.
(NAME CHECK OPEN)
server support the stream and OPEN is a function for opening the
stream.")
-(defvar imap-authenticators '(kerberos4 cram-md5 login anonymous)
- "Priority of authenticators to consider when authenticating to
-server.")
+(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))
+ '((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)
(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.")
"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.")
"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
(set-buffer-multibyte nil)))
(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)))
prompt)))
(defsubst imap-utf7-encode (string)
- (if imap-utf7-p
+ (if imap-use-utf7
(and string
(condition-case ()
(utf7-encode string t)
string))
(defsubst imap-utf7-decode (string)
- (if imap-utf7-p
+ (if imap-use-utf7
(and string
(condition-case ()
(utf7-decode string t)
(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))
- (coding-system-for-read imap-coding-system-for-read)
- (coding-system-for-write imap-coding-system-for-write)
- (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 (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)
- (imap-disable-multibyte)
- (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))
+ (coding-system-for-read imap-coding-system-for-read)
+ (coding-system-for-write imap-coding-system-for-write)
+ (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 (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)
+ (imap-disable-multibyte)
+ (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)
(insert-buffer-substring buffer)))
(when (memq (process-status process) '(open run))
process))))
+
+(defun imap-starttls-p (buffer)
+ (and (condition-case ()
+ (require 'starttls)
+ (error nil))
+ (imap-capability 'STARTTLS buffer)))
+
+(defun imap-starttls-open (name buffer server port)
+ (let* ((port (or port imap-default-port))
+ (coding-system-for-read imap-coding-system-for-read)
+ (coding-system-for-write imap-coding-system-for-write)
+ (process (starttls-open-stream name buffer server port)))
+ (when process
+ (while (and (memq (process-status process) '(open run))
+ (goto-char (point-min))
+ (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)))
+ (let ((imap-process process))
+ (unwind-protect
+ (progn
+ (set-process-filter imap-process 'imap-arrival-filter)
+ (when (and (eq imap-stream 'starttls)
+ (imap-ok-p (imap-send-command-wait "STARTTLS")))
+ (starttls-negotiate imap-process)))
+ (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)
(concat "LOGIN anonymous \"" (concat (user-login-name) "@"
(system-name)) "\"")))))
+(defun imap-digest-md5-p (buffer)
+ (and (condition-case ()
+ (require 'digest-md5)
+ (error nil))
+ (imap-capability 'AUTH=DIGEST-MD5 buffer)))
+
+(defun imap-digest-md5-auth (buffer)
+ "Login to server using the AUTH DIGEST-MD5 method."
+ (imap-interactive-login
+ buffer
+ (lambda (user passwd)
+ (let ((tag
+ (imap-send-command
+ (list
+ "AUTHENTICATE DIGEST-MD5"
+ (lambda (challenge)
+ (digest-md5-parse-digest-challenge
+ (base64-decode-string challenge))
+ (let* ((digest-uri
+ (digest-md5-digest-uri
+ "imap" (digest-md5-challenge 'realm)))
+ (response
+ (digest-md5-digest-response
+ user passwd digest-uri)))
+ (base64-encode-string response 'no-line-break))))
+ )))
+ (if (not (eq (imap-wait-for-tag tag) 'INCOMPLETE))
+ nil
+ (setq imap-continuation nil)
+ (imap-send-command-1 "")
+ (imap-ok-p (imap-wait-for-tag tag)))))))
+
;; Server functions:
(defun imap-open-1 (buffer)
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)
(imap-disable-multibyte)
(buffer-disable-undo)
(setq imap-server (or server imap-server))
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
(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
(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")))
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"))
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)
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))
(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)
(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)
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))
(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
(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
(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 \""
(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
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
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
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
(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)))))
(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
(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))
(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")
(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
(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)))
(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)
(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
;;
;; TEXT-CHAR = <any CHAR except CR and LF>
(defsubst imap-parse-string ()
- (let (strstart strend)
- (cond ((and (eq (char-after) ?\")
- (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"
;; ; 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)))
(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))
(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) ?\()
(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))
(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:
;; 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)
rmail-summary-exists rmail-select-summary
rmail-update-summary url-retrieve
temp-directory babel-fetch babel-wash
- find-coding-systems-for-charsets
- ))
+ find-coding-systems-for-charsets sc-cite-regexp))
(maybe-bind '(global-face-data
mark-active transient-mark-mode mouse-selection-click-count
mouse-selection-click-count-buffer buffer-display-table
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))
- (maybe-fbind '(color-instance-rgb-components temp-directory
+ 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
window-pixel-height map-extents
make-color-instance color-instance-name specifier-instance
w3-coding-system-for-mime-charset
rmail-summary-exists rmail-select-summary rmail-update-summary
url-generic-parse-url valid-image-instantiator-format-p
- babel-fetch babel-wash babel-as-string)))
+ babel-fetch babel-wash babel-as-string sc-cite-regexp)))
(setq load-path (cons "." load-path))
(require 'custom)
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
(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
: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
: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))
(: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."))
(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)
(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))
(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
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)
(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)
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
OBJECT is either a string or a buffer.
Optional arguments START and END denote buffer positions for computing the
hash of a portion of OBJECT."
- (let ((buffer nil))
+ (let ((buffer nil))
(unwind-protect
(save-excursion
(setq buffer (generate-new-buffer " *md5-work*"))
: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.
(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.
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-wash-forwarded-subjects nil
"*If non-nil, try to remove as much old cruft as possible from the subject of messages before generating the new subject of a forward."
: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)
"\\([^\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.
(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))))
(defun message-fetch-reply-field (header)
;; 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)
(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\".
(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")
(if (catch 'message-sending-cancel
;; Disabled test.
(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)
;; But some systems are more broken with -f, so
;; we'll let users override this.
(if (null message-sendmail-f-is-evil)
- (list "-f" (user-login-name)))
+ (list "-f" (message-make-address)))
;; These mean "report errors by mail"
;; and "deliver in background".
(if (null message-interactive) '("-oem" "-odb"))
(cons '(existing-newsgroups . disabled)
message-syntax-checks)
message-syntax-checks))
+ (message-this-is-news t)
result)
(save-restriction
(message-narrow-to-headers)
"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)
(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")
(provide 'message)
+;; Local Variables:
+;; coding: iso-8859-1
+;; End:
+
;;; message.el ends here
;; 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.
;; 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.
(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))
(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)))))
((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
;;!!!Emacs 20.3. Sometimes.
(save-excursion
(goto-char (point-min))
- (skip-chars-forward "\0-\177")
+ (skip-chars-forward mm-7bit-chars)
(eobp)))
'7bit
'8bit))))
(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)))
"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)
(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)
(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))
(require 'mm-bodies)
(require 'mmgnus)
+(defgroup mime-display ()
+ "Display of MIME in mail and news articles."
+ :link '(custom-manual "(emacs-mime)Customization")
+ :group 'mail
+ :group 'news)
+
;;; Convenience macros.
(defsubst mm-handle-p (handle)
:children child
:header header))
-(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
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))
("/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.
(mm-insert-inline handle (mm-get-part handle))
'inline)
(mm-display-external
- handle (or method 'mm-mailcap-save-binary-file))
- 'external)))))))
+ handle (or method 'mm-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 'mm-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 'mm-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
+ (mm-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 (mm-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
- (mm-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 (mm-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)
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")
"application/octet-stream"
(mm-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)
(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))))
(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 ()
;;; Code:
-(eval-and-compile
- (require 'cl))
+(eval-when-compile (require 'cl))
(require 'mail-parse)
+(require 'mm-util)
(defvar mm-mailcap-parse-args-syntax-table
(let ((table (copy-syntax-table emacs-lisp-mode-syntax-table)))
(viewer . "maplay %s")
(type . "audio/x-mpeg"))
(".*"
- (viewer . mm-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)
;;;
(defun mm-mailcap-generate-unique-filename (&optional fmt)
- "Generate a unique filename in mm-mailcap-temporary-directory"
+ "Generate a unique filename in mm-mailcap-temporary-directory."
(if (not fmt)
(let ((base (format "mm-mailcap-tmp.%d" (user-real-uid)))
(fname "")
(kill-buffer (current-buffer))))
(defun mm-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)))
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))
(mm-mailcap-parse-mailcap (car fnames)))
(setq fnames (cdr fnames))))
(setq mm-mailcap-parsed-p t)))
((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
passed)
(t
;; MUST make a copy *sigh*, else we modify mm-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 (mm-mailcap-unescape-mime-test (cdr view) info)))
(defun mm-mailcap-mime-types ()
"Return a list of MIME media types."
- (delete-duplicates (mapcar 'cdr mm-mailcap-mime-extensions)))
+ (mm-delete-duplicates (mapcar 'cdr mm-mailcap-mime-extensions)))
(provide 'mm-mailcap)
;;; Code:
+(require 'mail-prsvr)
+
(defvar mm-mime-mule-charset-alist
'((us-ascii ascii)
(iso-8859-1 latin-iso8859-1)
chinese-cns11643-7))
"Alist of MIME-charset/MULE-charsets.")
-
(eval-and-compile
(mapcar
(lambda (elem)
(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)
;; 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)))
(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
(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."
;;; 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
(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)
(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)
- (mm-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)
+ (mm-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)
- (mm-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)
+ (mm-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)))
;;; Code:
+(eval-when-compile (require 'cl))
(require 'mail-parse)
(require 'mm-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)
(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))
(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))
"*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
(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))
(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 "")
(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)))
(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")
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
(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"))
(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."
"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
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.
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
\(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.
'(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)))
- (or (eobp) (forward-char 1))))
+ (unless (eobp)
+ (search-forward "\t" eol 'move))))
(defmacro nnheader-nov-parse-extra ()
'(let (out string)
(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)
"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)
;;
;; 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
;; 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:
(require 'nnheader)
(require 'mm-util)
(require 'gnus)
-(require 'gnus-async)
(require 'gnus-range)
(require 'gnus-start)
(require 'gnus-int)
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
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
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")
"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.
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.
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.
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."
(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
;; 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)
"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)))
(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))
(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))
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
- (nnimap-replace-whitespace
- (imap-message-envelope-subject imap-current-message))
- (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."
(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")))))
(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)
(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)))
(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)
(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))
(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))
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))
(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.
(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
(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)))
(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)
- (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: Listing subscribed mailboxes%s%s...done"
(if (> (length server) 0) " on " "") server))
t))
;; 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)))
;; 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")
(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
(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)
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'."
(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)
(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)
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)))))
'("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))
partial regexp)
(if (symbolp value)
(setq value (cdr (assq value nnmail-split-abbrev-alist))))
- (if (string= ".*" (substring value 0 2))
+ (if (and (>= (length value) 2)
+ (string= ".*" (substring value 0 2)))
(setq value (substring value 2)
partial ""))
(setq regexp (concat "^\\(\\("
(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)
incoming incomings source)
(when (and (nnmail-get-value "%s-get-new-mail" method)
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 sources))
;; Be compatible with old values.
(cond
(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"
(let ((coding-system-for-write
(or nnmbox-file-coding-system-for-write
nnmbox-file-coding-system)))
- (save-buffer)))
+ (save-buffer)))
(defun nnmbox-save-active (group-alist active-file)
(let ((nnmail-active-file-coding-system
(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)
"*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
(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
"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
(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)
(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 ()
(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
(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
(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"))
(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
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:
(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"))
(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))
(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."
(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.
(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))
(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)
(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))
(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
(require 'gnus-start)
(require 'gnus-sum)
(require 'gnus-msg)
-(require 'cl)
+(eval-when-compile (require 'cl))
(nnoo-declare nnvirtual)
(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.")
(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
(aref entry 1)
(cdr (aref nnvirtual-mapping-offsets group-pos)))
))
- ))
+ ))
"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))
;; 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)
;; 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:
(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)
(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)
(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."
(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)
(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)
(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)))
(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)
(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)
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)
(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)
(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
(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))
(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)
(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)
(n 1)
message-count
(pop3-password pop3-password)
+ ;; use Unix line endings for crashbox
+ (coding-system-for-write 'binary)
)
;; for debugging only
(if pop3-debug (switch-to-buffer (process-buffer process)))
)
t)
+(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."
(let ((process-buffer
(get-buffer-create (format "trace of POP session to %s" mailhost)))
(process)
- (coding-system-for-read 'binary) ;; because FSF Emacs 20 and
- (coding-system-for-write 'binary) ;; XEmacs 20 & 21 are st00pid
- )
+ (coding-system-for-read 'binary);; because FSF Emacs 20 and
+ (coding-system-for-write 'binary);; XEmacs 20 & 21 are st00pid
+ )
(save-excursion
(set-buffer process-buffer)
(erase-buffer)
(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.
;; bill@att.com
;; condensed into:
;; (sometimes causes problems for really large messages.)
-; (if (> (buffer-size) 20000) (sleep-for (/ (buffer-size) 20000)))
+ ;; (if (> (buffer-size) 20000) (sleep-for (/ (buffer-size) 20000)))
(goto-char start))
(setq pop3-read-point (point-marker))
-;; this code does not seem to work for some POP servers...
-;; and I cannot figure out why not.
-; (goto-char (match-beginning 0))
-; (backward-char 2)
-; (if (not (looking-at "\r\n"))
-; (insert "\r\n"))
-; (re-search-forward "\\.\r\n")
+ ;; this code does not seem to work for some POP servers...
+ ;; and I cannot figure out why not.
+ ;; (goto-char (match-beginning 0))
+ ;; (backward-char 2)
+ ;; (if (not (looking-at "\r\n"))
+ ;; (insert "\r\n"))
+ ;; (re-search-forward "\\.\r\n")
(goto-char (match-beginning 0))
(setq end (point-marker))
(pop3-clean-region start end)
(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
(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))
(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)
;;; 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
(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
(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."
(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))
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)
(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)
(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."
((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))))))
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)
(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)
;;; 1998-09-25 renamed from hmac.el to rfc2104.el, also renamed functions
;;; 1999-10-23 included in pgnus
-(require 'cl)
+(eval-when-compile (require 'cl))
;; Magic character for inner HMAC round. 0x36 == 54 == '6'
(defconst rfc2104-ipad ?\x36)
(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)
(provide 'smiley)
+;; Local Variables:
+;; coding: iso-8859-1
+;; End:
+
;;; smiley.el ends here
;;; 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
(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
;; 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
(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 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]+\\) 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
+ "• \\|\\(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
+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.
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
spool or your mbox file. All at the same time, if you want to push your
luck.
-This manual corresponds to Gnus 5.8.2.
+This manual corresponds to Gnus 5.8.3.
@end ifinfo
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
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)
@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
@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,
@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.
@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.
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
@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.
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
@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]}.
@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
@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
@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)
(@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.)
@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)
@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)
@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
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}).
@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
@findex gnus-mime-view-part-as-type
@item t (Article)
View the @sc{mime} object as if it were a different @sc{mime} media type
-(@code{gnus-mime-view-part-as-type}.
+(@code{gnus-mime-view-part-as-type}).
@findex gnus-mime-pipe-part
@item | (Article)
Output the @sc{mime} object to a process (@code{gnus-mime-pipe-part}).
+
+@findex gnus-mime-inline-part
+@item i (Article)
+Insert the raw contents of the @sc{mime} object into the buffer
+(@code{gnus-mime-inline-part}).
+
@end table
Gnus will display some @sc{mime} objects automatically. The way Gnus
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)
@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
@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.
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.
@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.
@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:
@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
@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
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:
@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
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
@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
@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
@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
@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:
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
@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.
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:
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
@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:
@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
@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
@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
@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}
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.
@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
@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}.
@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"))
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
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
@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
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.
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
@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
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:
(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:
(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
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.
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
@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
@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:
@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
@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
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}.
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
Luis Fernandes---design and graphics.
@item
+Justin Sheehy--the FAQ maintainer.
+
+@item
Erik Naggum---help, ideas, support, code and stuff.
@item
Philippe Schnoebelen,
Andreas Schwab,
Randal L. Schwartz,
-Justin Sheehy,
Danny Siu,
Matt Simmons,
Paul D. Smith,
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
@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.
@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:
(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.
\input texinfo @c -*-texinfo-*-
@setfilename message
-@settitle Pterodactyl Message 0.99 Manual
+@settitle Pterodactyl Message 5.8.3 Manual
@synindex fn cp
@synindex vr cp
@synindex pg cp
@tex
@titlepage
-@title Pterodactyl Message 0.99 Manual
+@title Pterodactyl Message 5.8.3 Manual
@author by Lars Magne Ingebrigtsen
@page
* Key Index:: List of Message mode keys.
@end menu
-This manual corresponds to Pterodactyl Message 0.99. Message is
+This manual corresponds to Pterodactyl Message 5.8.3. Message is
distributed with the Gnus distribution bearing the same version number
as this manual.
@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
@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
projects / elisp / gnus.git- / commitdiff