Merge from gnus--devo--0

Revision: emacs@sv.gnu.org/emacs--devo--0--patch-1513

diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog
index 6e99fd5789c5f2405d943b3bcae952e980797f33..3218a788be7c93d983f59e747d90e86168ff45d2 100644 (file)
--- a/doc/misc/ChangeLog
+++ b/doc/misc/ChangeLog
@@ -1,3 +1,18 @@
+2009-01-09  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+       * gnus.texi (Group Parameters): Add note for local variables.
+
+2009-01-09  Reiner Steib  <Reiner.Steib@gmx.de>
+
+       * gnus.texi (Converting Kill Files): Fix URL.  Include
+       gnus-kill-to-score.el in contrib directory.
+
+2009-01-09  Reiner Steib  <Reiner.Steib@gmx.de>
+
+       * gnus.texi (Startup Variables): Fix gnus-before-startup-hook.
+       Reported by Leo <sdl.web@gmail.com>.  (Bug#1660)
+       (Paging the Article): Add index entry.
+

 2009-01-03  Stephen Leake  <stephen_leake@member.fsf.org>
 
        * ada-mode.texi (Examples): Delete redundant text.
 2009-01-03  Stephen Leake  <stephen_leake@member.fsf.org>
 
        * ada-mode.texi (Examples): Delete redundant text.

diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 6db07ee85c93b91119b6ffdc2b4e3729af870b73..6227831cf151e1448b58a70c8b2ffb038f0f7acb 100644 (file)
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -9,8 +9,8 @@
 @documentencoding ISO-8859-1
 
 @copying
 @documentencoding ISO-8859-1
 
 @copying

-Copyright @copyright{} 1995, 1996, 1997, 1998, 1999, 2000, 2001,
-2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
+Copyright @copyright{} 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
+2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.

 
 @quotation
 Permission is granted to copy, distribute and/or modify this document
 
 @quotation
 Permission is granted to copy, distribute and/or modify this document


@@ -1623,7 +1623,7 @@ times you start Gnus.
 
 @item gnus-before-startup-hook
 @vindex gnus-before-startup-hook
 
 @item gnus-before-startup-hook
 @vindex gnus-before-startup-hook

-A hook run after starting up Gnus successfully.
+A hook called as the first thing when Gnus is started.

 
 @item gnus-startup-hook
 @vindex gnus-startup-hook
 
 @item gnus-startup-hook
 @vindex gnus-startup-hook


@@ -3156,7 +3156,12 @@ that group.  @code{gnus-show-threads} will be made into a local variable
 in the summary buffer you enter, and the form @code{nil} will be
 @code{eval}ed there.
 
 in the summary buffer you enter, and the form @code{nil} will be
 @code{eval}ed there.
 

-Note that this feature sets the variable locally to the summary buffer.
+Note that this feature sets the variable locally to the summary buffer
+if and only if @var{variable} has been bound as a variable.  Otherwise,
+only evaluating the form will take place.  So, you may want to bind the
+variable in advance using @code{defvar} or other if the result of the
+form needs to be set to it.
+

 But some variables are evaluated in the article buffer, or in the
 message buffer (of a reply or followup or otherwise newly created
 message).  As a workaround, it might help to add the variable in
 But some variables are evaluated in the article buffer, or in the
 message buffer (of a reply or followup or otherwise newly created
 message).  As a workaround, it might help to add the variable in


@@ -3184,9 +3189,9 @@ into the group parameters for the group.
 
 This can also be used as a group-specific hook function.  If you want to
 hear a beep when you enter a group, you could put something like
 
 This can also be used as a group-specific hook function.  If you want to
 hear a beep when you enter a group, you could put something like

-@code{(dummy-variable (ding))} in the parameters of that group.
-@code{dummy-variable} will be set to the (meaningless) result of the
-@code{(ding)} form.
+@code{(dummy-variable (ding))} in the parameters of that group.  If
+@code{dummy-variable} has been bound (see above), it will be set to the
+(meaningless) result of the @code{(ding)} form.

 
 Alternatively, since the VARIABLE becomes local to the group, this
 pattern can be used to temporarily change a hook.  For example, if the
 
 Alternatively, since the VARIABLE becomes local to the group, this
 pattern can be used to temporarily change a hook.  For example, if the


@@ -6233,6 +6238,7 @@ given a prefix, fetch the current article, but don't run any of the
 article treatment functions.  This will give you a ``raw'' article, just
 the way it came from the server.
 
 article treatment functions.  This will give you a ``raw'' article, just
 the way it came from the server.
 

+@cindex charset, view article with different charset

 If given a numerical prefix, you can do semi-manual charset stuff.
 @kbd{C-u 0 g cn-gb-2312 RET} will decode the message as if it were
 encoded in the @code{cn-gb-2312} charset.  If you have
 If given a numerical prefix, you can do semi-manual charset stuff.
 @kbd{C-u 0 g cn-gb-2312 RET} will decode the message as if it were
 encoded in the @code{cn-gb-2312} charset.  If you have


@@ -22464,9 +22470,10 @@ score files.  If they are ``regular'', you can use
 the @file{gnus-kill-to-score.el} package; if not, you'll have to do it
 by hand.
 
 the @file{gnus-kill-to-score.el} package; if not, you'll have to do it
 by hand.
 

-The kill to score conversion package isn't included in Gnus by default.
-You can fetch it from
-@uref{http://www.stud.ifi.uio.no/~larsi/ding-various/gnus-kill-to-score.el}.
+The kill to score conversion package isn't included in Emacs by default.
+You can fetch it from the contrib directory of the Gnus distribution or
+from
+@uref{http://heim.ifi.uio.no/~larsi/ding-various/gnus-kill-to-score.el}.

 
 If your old kill files are very complex---if they contain more
 non-@code{gnus-kill} forms than not, you'll have to convert them by
 
 If your old kill files are very complex---if they contain more
 non-@code{gnus-kill} forms than not, you'll have to convert them by

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 7ed2af86b1e6a35c85fa64185b107b681296ab8f..24c7c6f72160899b4995fa9033c9ff59942f0d32 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,47 @@
+2009-01-09  Dave Love  <fx@gnu.org>
+
+       * calendar/time-date.el: Require cl for `declare'.
+
+2009-01-09  Reiner Steib  <Reiner.Steib@gmx.de>
+
+       * calendar/time-date.el (format-seconds): Explain `assoc-string'.
+       Suggested by Dave Love.
+
+2009-01-09  Dave Love  <fx@gnu.org>
+
+       * net/imap.el (imap-string-to-integer): Fix typo.
+       (imap-fetch-safe): New function.
+       (imap-message-copyuid-1, imap-message-appenduid-1): Use it.
+
+       * net/imap.el (imap-process-connection-type, imap-debug, imap-open):
+       (imap-parse-greeting): Fix doc strings.
+       (imap-tls-open, imap-search, imap-message-appenduid-1): Add FIXMEs.
+       (imap-parse-flag-list): Make messages unique.
+       (imap-parse-body): Fix comments.  Add comment on Exchange 2007.
+
+       * net/imap.el (imap-message-appenduid-1): Fix typo in imap-fetch-safe
+       call.
+
+       * net/imap.el: Fix author email.  Doc fixes.
+       (imap-parse-body): Work around assertion failure in bogus Exchange 2007
+       reply.
+
+2009-01-09  Reiner Steib  <Reiner.Steib@gmx.de>
+
+       * net/dns.el (dns-set-servers): Check "Address".  Fix typo.
+
+2009-01-09  Reiner Steib  <Reiner.Steib@gmx.de>
+
+       * net/dns.el (dns-set-servers): Renamed from dns-parse-resolv-conf.
+       Call nslookup if resolv.conf isn't available.
+       (dns-query): Rename from query-dns.
+       (dns-query-cached): Rename from query-dns-cached.
+
+2009-01-09  Reiner Steib  <Reiner.Steib@gmx.de>
+
+       * net/imap.el (imap-enable-exchange-bug-workaround): Explain
+       auto-detection in the doc string.
+

 2009-01-09  Juanma Barranquero  <lekktu@gmail.com>
 
        * textmodes/ispell.el (ispell-check-minver, ispell-last-program-name)
 2009-01-09  Juanma Barranquero  <lekktu@gmail.com>
 
        * textmodes/ispell.el (ispell-check-minver, ispell-last-program-name)

diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el
index d33b99f91350f878aceb75f09dde68fcf0383226..3478f9646ea0e1cf3089faa839e7729d527bc75d 100644 (file)
--- a/lisp/calendar/time-date.el
+++ b/lisp/calendar/time-date.el
@@ -39,6 +39,9 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

+;; Only necessary for `declare' when compiling Gnus with Emacs 21.
+(eval-when-compile (require 'cl))
+

 (defmacro with-decoded-time-value (varlist &rest body)
   "Decode a time value and bind it according to VARLIST, then eval BODY.
 
 (defmacro with-decoded-time-value (varlist &rest body)
   "Decode a time value and bind it according to VARLIST, then eval BODY.
 


@@ -290,6 +293,10 @@ This function does not work for SECONDS greater than `most-positive-fixnum'."
       (setq start (match-end 0)
             spec (match-string 1 string))
       (unless (string-equal spec "%")
       (setq start (match-end 0)
             spec (match-string 1 string))
       (unless (string-equal spec "%")

+       ;; `assoc-string' is not available in Emacs 21.  So when compiling
+       ;; Gnus (`time-date.el' is part of Gnus) with Emacs 21, we get a
+       ;; warning here.  But `format-seconds' is not used anywhere in Gnus so
+       ;; it's not a real problem. --rsteib

         (or (setq match (assoc-string spec units t))
             (error "Bad format specifier: `%s'" spec))
         (if (assoc-string spec usedunits t)
         (or (setq match (assoc-string spec units t))
             (error "Bad format specifier: `%s'" spec))
         (if (assoc-string spec usedunits t)

diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 9e964d4203f4857c2cc0fbbc5d7675a53c78c73a..f3404816ad6016afc9b376616b767375cbaa62f4 100644 (file)
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,8 +1,39 @@
+2009-01-08  Reiner Steib  <Reiner.Steib@gmx.de>
+
+       * message.el (message-fix-before-sending): Amend comment.
+
+2009-01-07  David Engster  <dengste@eml.cc>
+
+       * gnus-msg.el (gnus-inews-do-gcc): Fix last patch to deal with
+       simplified server definitions by converting it via
+       gnus-server-to-method.
+
+2009-01-06  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+       * gnus-sum.el (gnus-summary-set-local-parameters): Always evaluate
+       parameter's operands.
+
+2009-01-06  David Engster  <dengste@eml.cc>
+
+       * gnus-msg.el (gnus-inews-do-gcc): Reduce to short group name when on
+       primary select method (for gnus-group-mark-article-as-read).
+

 2009-01-06  Tassilo Horn  <tassilo@member.fsf.org>
 
        * gnus-art.el (gnus-treat-display-face): Fix docstring link to point to
        `(gnus)Face', not `(gnus)X-Face'.
 
 2009-01-06  Tassilo Horn  <tassilo@member.fsf.org>
 
        * gnus-art.el (gnus-treat-display-face): Fix docstring link to point to
        `(gnus)Face', not `(gnus)X-Face'.
 

+2009-01-05  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+       * mm-util.el (mm-ucs-to-char): New function.
+
+       * mm-url.el (mm-url-decode-entities): Use it.
+
+2009-01-03  Reiner Steib  <Reiner.Steib@gmx.de>
+
+       * message.el (message-fix-before-sending): Add `eight-bit' to
+       illegible-text check.
+

 2009-01-03  Michael Olson  <mwolson@gnu.org>
 
        * nnimap.el (nnimap-retrieve-headers-progress): Handle edge case where
 2009-01-03  Michael Olson  <mwolson@gnu.org>
 
        * nnimap.el (nnimap-retrieve-headers-progress): Handle edge case where


@@ -11,6 +42,68 @@
        to the folder.
        (nnimap-request-article-part): Do not insert `data' if it is nil.
 
        to the folder.
        (nnimap-request-article-part): Do not insert `data' if it is nil.
 

+2009-01-01  Dave Love  <fx@gnu.org>
+
+       * nnimap.el (nnimap-find-minmax-uid): Use imap-fetch-safe.
+
+       * nnimap.el: Fix author email.
+       (nnimap-split-rule): Add FIXME comment.
+       (nnimap-debug): Fix doc string.
+
+2008-12-25  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+       * gnus-sum.el (gnus-summary-set-article-display-arrow): Make
+       overlay-arrow-position and overlay-arrow-string buffer-local; no need
+       to check if those variables exist (first appeared in Emacs 18.50).
+
+2008-12-24  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+       * mm-util.el (mm-line-number-at-pos): New function.
+
+       * spam-report.el (spam-report-process-queue): Use it.
+
+2008-12-24  David Engster  <dengste@eml.cc>
+
+       * gnus-sum.el (gnus-summary-set-local-parameters): Don't bind
+       parameters that haven't existed as variables as buffer-local variables.
+
+2008-12-23  Dave Love  <fx@gnu.org>
+
+       * legacy-gnus-agent.el (gnus-agent-unlist-expire-days): Don't use
+       cadar.
+
+       * sieve-manage.el (sieve-manage-starttls-p): Renamed from
+       imap-starttls-p.
+       (sieve-manage-starttls-open): Renamed from imap-starttls-open.
+
+2008-12-22  Reiner Steib  <Reiner.Steib@gmx.de>
+
+       * spam-report.el (spam-report-gmane-max-requests): New constant.
+       (spam-report-gmane-wait): New variable.
+       (spam-report-gmane-ham, spam-report-gmane-spam)
+       (spam-report-url-ping-plain, spam-report-process-queue): Wait only if
+       spam-report-gmane-wait is non-nil should be sufficient to avoid DOS-ing
+       the server.
+
+       * nnheader.el (nnheader-read-timeout, nnheader-accept-process-output):
+       Add explanations.
+
+       * pop3.el (pop3-accept-process-output, pop3-read-timeout): Use
+       nnheader-accept-process-output and nnheader-read-timeout if available.
+       (pop3-movemail): Use it.
+
+       * message.el (message-check-news-body-syntax): Fix signature check if
+       there's an attachment.
+
+2008-12-21  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+       * mm-util.el: Add comments to the mm- emulating functions.
+
+2008-12-21  Reiner Steib  <Reiner.Steib@gmx.de>
+
+       * gnus-start.el (gnus-before-startup-hook): Fix doc string.  Reported
+       by Stephen Berman <stephen.berman@gmx.net>.
+

 2008-12-18  Katsumi Yamaoka  <yamaoka@jpl.org>
 
        * mm-util.el (mm-substring-no-properties): New function.
 2008-12-18  Katsumi Yamaoka  <yamaoka@jpl.org>
 
        * mm-util.el (mm-substring-no-properties): New function.


@@ -23,6 +116,11 @@
 2008-12-18  Reiner Steib  <Reiner.Steib@gmx.de>
 
        * mml.el (mml-attach-file): Strip text properties from file name.
 2008-12-18  Reiner Steib  <Reiner.Steib@gmx.de>
 
        * mml.el (mml-attach-file): Strip text properties from file name.

+       (Bug#1574)
+
+2008-12-16  Glenn Morris  <rgm@gnu.org>
+
+       * mm-util.el (mm-charset-override-alist): Declare for compiler.

 
 2008-12-16  Glenn Morris  <rgm@gnu.org>
 
 
 2008-12-16  Glenn Morris  <rgm@gnu.org>
 


@@ -13136,11 +13234,10 @@
 
 2004-01-04  Mario Lang  <lang@zid.tugraz.at>
 
 
 2004-01-04  Mario Lang  <lang@zid.tugraz.at>
 

-       * dns.el: Add support for AAAA records (see RFC 3596)
-
-       * Fix typo PRT -> PTR
-
-       * Parse MX, PTR and SOA replies (see RFC 1035)
+       * dns.el (dns-query-types): Fix typo.
+       (dns-query-types): New function
+       (dns-read-type): Add support for AAAA records, see RFC 3596.  Parse MX,
+       PTR and SOA replies, see RFC 1035.

 
 2004-01-04  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
 
 2004-01-04  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 

diff --git a/lisp/gnus/ChangeLog.2 b/lisp/gnus/ChangeLog.2
index 2c25799892f7134548386da633d1e6cba58db7eb..140cbd7c6981e1aa05bc4bd455b292a54c48dee2 100644 (file)
--- a/lisp/gnus/ChangeLog.2
+++ b/lisp/gnus/ChangeLog.2
@@ -8763,8 +8763,7 @@
        * sieve-manage.el (sieve-manage-cram-md5-auth): Just send the SASL
        name (makes it work with recent Cyrus timsieved).
 
        * sieve-manage.el (sieve-manage-cram-md5-auth): Just send the SASL
        name (makes it work with recent Cyrus timsieved).
 

-2002-05-20  Jason Baker  <jbaker@cs.utah.edu>
-       Trivial patch.
+2002-05-20  Jason Baker  <jbaker@cs.utah.edu>  (tiny change)

 
        * gnus-art.el (gnus-request-article-this-buffer): Try
        reconnecting if you don't get the message.
 
        * gnus-art.el (gnus-request-article-this-buffer): Try
        reconnecting if you don't get the message.


@@ -9189,8 +9188,7 @@
 
        * nnmaildir.el: Fixed some buggy invocations of nnmaildir--pgname.
 
 
        * nnmaildir.el: Fixed some buggy invocations of nnmaildir--pgname.
 

-2002-03-31  Andrew Cohen  <cohen@andy.bu.edu>
-       Trivial patch.
+2002-03-31  Andrew Cohen  <cohen@andy.bu.edu>  (tiny change)

 
        * dns.el: open-network-stream under XEmacs does udp.
 
 
        * dns.el: open-network-stream under XEmacs does udp.
 


@@ -10451,8 +10449,7 @@
 
        * nnweb.el (nnweb-type-definition): Clean up.
 
 
        * nnweb.el (nnweb-type-definition): Clean up.
 

-2002-01-21  Alastair Burt  <burt@dfki.de>
-       Trivial patch.
+2002-01-21  Alastair Burt  <burt@dfki.de>  (tiny change)

 
        * gnus-art.el (gnus-mm-display-part): Make sure that the summary
        buffer exists before jumping to it.
 
        * gnus-art.el (gnus-mm-display-part): Make sure that the summary
        buffer exists before jumping to it.


@@ -11088,8 +11085,7 @@
 
        * gnus.el (gnus-logo-color-alist): Added more colors from Luis.
 
 
        * gnus.el (gnus-logo-color-alist): Added more colors from Luis.
 

-2002-01-05  Keiichi Suzuki  <keiichi@nanap.org>
-       Trivial patch.
+2002-01-05  Keiichi Suzuki  <keiichi@nanap.org>  (tiny change)

 
        * nntp.el (nntp-possibly-change-group): Erase contents of nntp
        buffer to get rid of junk line.
 
        * nntp.el (nntp-possibly-change-group): Erase contents of nntp
        buffer to get rid of junk line.


@@ -13307,8 +13303,7 @@
        * gnus-spec.el (gnus-correct-pad-form): Re-revert.
        (gnus-parse-simple-format): Re-revert.
 
        * gnus-spec.el (gnus-correct-pad-form): Re-revert.
        (gnus-parse-simple-format): Re-revert.
 

-2001-09-16  Katsuhiro Hermit Endo  <hermit@koka-in.org>
-       Trivial patch.
+2001-09-16  Katsuhiro Hermit Endo  <hermit@koka-in.org>  (tiny change)

 
        * gnus-spec.el (gnus-parse-complex-format): Don't fold search
        case.  (Thanks to Daiki Ueno <ueno@unixuser.org>.)
 
        * gnus-spec.el (gnus-parse-complex-format): Don't fold search
        case.  (Thanks to Daiki Ueno <ueno@unixuser.org>.)


@@ -14156,8 +14151,7 @@
        * message.el (message-indent-citation): Quote only lines starting
        with ">" using `message-yank-cited-prefix'.
 
        * message.el (message-indent-citation): Quote only lines starting
        with ">" using `message-yank-cited-prefix'.
 

-2001-08-05  Nuutti Kotivuori  <nuutti.kotivuori@smarttrust.com>
-       Trivial patch.
+2001-08-05  Nuutti Kotivuori  <nuutti.kotivuori@smarttrust.com>  (tiny change)

 
        * gnus-cache.el (gnus-cache-possibly-enter-article): Use
        gnus-cache-fully-p.
 
        * gnus-cache.el (gnus-cache-possibly-enter-article): Use
        gnus-cache-fully-p.


@@ -14926,8 +14920,7 @@
        * nntp.el (nntp-send-command-nodelete): Ditto.
        * nntp.el (nntp-send-command-and-decode): Ditto.
 
        * nntp.el (nntp-send-command-nodelete): Ditto.
        * nntp.el (nntp-send-command-and-decode): Ditto.
 

-2001-06-30  YAGI Tatsuya  <yagi@is.titech.ac.jp>
-       Trivial patch.
+2001-06-30  YAGI Tatsuya  <yagi@is.titech.ac.jp>  (tiny change)

 
        * gnus-start.el (gnus-check-first-time-used): Use `if' instead of
        `when'.
 
        * gnus-start.el (gnus-check-first-time-used): Use `if' instead of
        `when'.


@@ -15646,8 +15639,7 @@
 
        * message.el (message-generate-headers-first): Update doc.
 
 
        * message.el (message-generate-headers-first): Update doc.
 

-2001-03-10  Matthias Wiehl  <mwiehl@gmx.de>
-       Trivial patch.
+2001-03-10  Matthias Wiehl  <mwiehl@gmx.de>  (tiny change)

 
        * gnus.el (gnus-summary-line-format): Typo.
 
 
        * gnus.el (gnus-summary-line-format): Typo.
 


@@ -16021,8 +16013,7 @@
        * message.el (message-cancel-news): Allow to shoot foot.
        (message-supersede): Ditto.
 
        * message.el (message-cancel-news): Allow to shoot foot.
        (message-supersede): Ditto.
 

-2001-02-08  Tommi Vainikainen  <thv@iki.fi>
-       Trivial patch.
+2001-02-08  Tommi Vainikainen  <thv@iki.fi>  (tiny change)

 
        * gnus-sum.el (gnus-simplify-subject-re): Use
        message-subject-re-regexp.
 
        * gnus-sum.el (gnus-simplify-subject-re): Use
        message-subject-re-regexp.


@@ -16487,8 +16478,7 @@
 
        * time-date.el (time-to-number-of-days): New function.
 
 
        * time-date.el (time-to-number-of-days): New function.
 

-2001-01-04 11:06:14  Gregory Chernov  <greg@visiontech-dml.com>
-       Trivial patch.
+2001-01-04 11:06:14  Gregory Chernov  <greg@visiontech-dml.com>  (tiny change)

 
        * nnslashdot.el (nnslashdot-request-list): Always get the right
        sid.
 
        * nnslashdot.el (nnslashdot-request-list): Always get the right
        sid.


@@ -16645,8 +16635,7 @@
        (gnus-uu-mark-by-regexp): Use it.
        (gnus-new-processable): New function.
 
        (gnus-uu-mark-by-regexp): Use it.
        (gnus-new-processable): New function.
 

-2000-12-28 19:21:57  Inge Frick  <inge@nada.kth.se>
-        Trivial patch.
+2000-12-28 19:21:57  Inge Frick  <inge@nada.kth.se>  (tiny change)

 
        * gnus-sum.el (gnus-no-mark): New variable.
 
 
        * gnus-sum.el (gnus-no-mark): New variable.
 


@@ -16665,8 +16654,7 @@
        * qp.el (quoted-printable-encode-region): Don't check multibyte in
        XEmacs.
 
        * qp.el (quoted-printable-encode-region): Don't check multibyte in
        XEmacs.
 

-2000-12-25  Lloyd Zusman  <ljz@asfast.com>
-       Trivial patch.
+2000-12-25  Lloyd Zusman  <ljz@asfast.com>  (tiny change)

 
        * mml.el (mml-read-tag): Save tag location.
 
 
        * mml.el (mml-read-tag): Save tag location.
 


@@ -18370,8 +18358,7 @@
        (nnultimate-table-regexp): New variable.
        (nnultimate-forum-table-p): Use it.
 
        (nnultimate-table-regexp): New variable.
        (nnultimate-forum-table-p): Use it.
 

-2000-10-30  Ed L Cashin  <ecashin@coe.uga.edu>
-       Trivial patch.
+2000-10-30  Ed L Cashin  <ecashin@coe.uga.edu>  (tiny change)

 
        * gnus-sum.el (gnus-summary-expire-articles): Save point.
 
 
        * gnus-sum.el (gnus-summary-expire-articles): Save point.
 

diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el
index a3698a135273a6f0fe0a82312728bb2685385194..62f23cb169d712a7cdad5cd38bc831915e255401 100644 (file)
--- a/lisp/gnus/gnus-msg.el
+++ b/lisp/gnus/gnus-msg.el
@@ -1677,6 +1677,11 @@ this is a reply."
                                    group method t t))))
                (gnus-message 1 "Couldn't store article in group %s: %s"
                              group (gnus-status-message method)))
                                    group method t t))))
                (gnus-message 1 "Couldn't store article in group %s: %s"
                              group (gnus-status-message method)))

+             (when (stringp method)
+               (setq method (gnus-server-to-method method)))
+             (when (and (listp method)
+                        (gnus-native-method-p method))
+               (setq group (gnus-group-short-name group)))

              (when (and group-art
                         ;; FIXME: Should gcc-mark-as-read work when
                         ;; Gnus is not running?
              (when (and group-art
                         ;; FIXME: Should gcc-mark-as-read work when
                         ;; Gnus is not running?

diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index bc6b7e0c50835f238512dcb01f74588c73441d82..33e7d3894b5fc714447851055aff8b40d80e9b20 100644 (file)
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -392,7 +392,7 @@ This hook is called after Gnus is connected to the NNTP server."
   :type 'hook)
 
 (defcustom gnus-before-startup-hook nil
   :type 'hook)
 
 (defcustom gnus-before-startup-hook nil

-  "A hook called at before startup.
+  "A hook called before startup.

 This hook is called as the first thing when Gnus is started."
   :group 'gnus-start
   :type 'hook)
 This hook is called as the first thing when Gnus is started."
   :group 'gnus-start
   :type 'hook)

diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index a04f4aa5bb4c3561159fcbcfe6d19055fae490a3..ed636e032293427e55e530f542cdccefa066a9d3 100644 (file)
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -3455,9 +3455,9 @@ display only a single character."
 
 (defun gnus-summary-set-article-display-arrow (pos)
   "Update the overlay arrow to point to line at position POS."
 
 (defun gnus-summary-set-article-display-arrow (pos)
   "Update the overlay arrow to point to line at position POS."

-  (when (and gnus-summary-display-arrow
-            (boundp 'overlay-arrow-position)
-            (boundp 'overlay-arrow-string))
+  (when gnus-summary-display-arrow
+    (make-local-variable 'overlay-arrow-position)
+    (make-local-variable 'overlay-arrow-string)

     (save-excursion
       (goto-char pos)
       (beginning-of-line)
     (save-excursion
       (goto-char pos)
       (beginning-of-line)


@@ -3832,10 +3832,15 @@ This function is intended to be used in
           (consp (cdr elem))           ; The cdr has to be a list.
           (symbolp (car elem))         ; Has to be a symbol in there.
           (not (memq (car elem) vars))
           (consp (cdr elem))           ; The cdr has to be a list.
           (symbolp (car elem))         ; Has to be a symbol in there.
           (not (memq (car elem) vars))

-          (ignore-errors               ; So we set it.
+          (ignore-errors

             (push (car elem) vars)
             (push (car elem) vars)

-            (make-local-variable (car elem))
-            (set (car elem) (eval (nth 1 elem))))))))
+            ;; Variables like `gnus-show-threads' that are globally
+            ;; bound, if used as group parameters, need to get to be
+            ;; buffer-local, whereas just parameters like `gcc-self',
+            ;; `timestamp', etc. should not be bound as variables.
+            (if (boundp (car elem))
+                (set (make-local-variable (car elem)) (eval (nth 1 elem)))
+              (eval (nth 1 elem))))))))

 
 (defun gnus-summary-read-group (group &optional show-all no-article
                                      kill-buffer no-display backward
 
 (defun gnus-summary-read-group (group &optional show-all no-article
                                      kill-buffer no-display backward

diff --git a/lisp/gnus/legacy-gnus-agent.el b/lisp/gnus/legacy-gnus-agent.el
index 28dfa25ee1f1dc20b05b5d549a128cd30b0662e3..3680bc5e4101df1a36c310781a5f12911d6c5c6b 100644 (file)
--- a/lisp/gnus/legacy-gnus-agent.el
+++ b/lisp/gnus/legacy-gnus-agent.el
@@ -186,7 +186,7 @@ converted to the compressed format."
                                                                (when (eq 0 (string-match
                                                                             (caar days)
                                                                             group))
                                                                (when (eq 0 (string-match
                                                                             (caar days)
                                                                             group))

-                                                                 (throw 'found (cadar days)))
+                                                                 (throw 'found (cadr (car days))))

                                                                (setq days (cdr days)))
                                                              nil)))
                                                  (when day
                                                                (setq days (cdr days)))
                                                              nil)))
                                                  (when day

diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 93f7b703832de04f97ed99a2731a52ec596f68fe..ee711628080c85ba29e8226377941955ced443cd 100644 (file)
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -2395,6 +2395,8 @@ Return the number of headers removed."
      (point-max)))
   (goto-char (point-min)))
 
      (point-max)))
   (goto-char (point-min)))
 

+;; FIXME: clarify diffference: message-narrow-to-head,
+;; message-narrow-to-headers-or-head, message-narrow-to-headers

 (defun message-narrow-to-head ()
   "Narrow the buffer to the head of the message.
 Point is left at the beginning of the narrowed-to region."
 (defun message-narrow-to-head ()
   "Narrow the buffer to the head of the message.
 Point is left at the beginning of the narrowed-to region."


@@ -4140,6 +4142,8 @@ conformance."
                  (and (mm-multibyte-p)
                       (memq (char-charset char)
                             '(eight-bit-control eight-bit-graphic
                  (and (mm-multibyte-p)
                       (memq (char-charset char)
                             '(eight-bit-control eight-bit-graphic

+                                                ;; Emacs 23, Bug#1770:
+                                                eight-bit

                                                 control-1))
                       (not (get-text-property
                             (point) 'untranslated-utf-8))))
                                                 control-1))
                       (not (get-text-property
                             (point) 'untranslated-utf-8))))


@@ -4166,10 +4170,13 @@ conformance."
                  (or (< (mm-char-int char) 128)
                      (and (mm-multibyte-p)
                           ;; FIXME: Wrong for Emacs 23 (unicode) and for
                  (or (< (mm-char-int char) 128)
                      (and (mm-multibyte-p)
                           ;; FIXME: Wrong for Emacs 23 (unicode) and for

-                          ;; things like undecable utf-8.  Should at least
-                          ;; use find-coding-systems-region.
+                          ;; things like undecodable utf-8 (in Emacs 21?).
+                          ;; Should at least use find-coding-systems-region.
+                          ;; -- fx

                           (memq (char-charset char)
                                 '(eight-bit-control eight-bit-graphic
                           (memq (char-charset char)
                                 '(eight-bit-control eight-bit-graphic

+                                                    ;; Emacs 23, Bug#1770:
+                                                    eight-bit

                                                     control-1))
                           (not (get-text-property
                                 (point) 'untranslated-utf-8)))))
                                                     control-1))
                           (not (get-text-property
                                 (point) 'untranslated-utf-8)))))


@@ -5119,17 +5126,24 @@ Otherwise, generate and save a value for `canlock-password' first."
        nil)))
    ;; Check the length of the signature.
    (message-check 'signature
        nil)))
    ;; Check the length of the signature.
    (message-check 'signature

-     (goto-char (point-max))
-     (if (not (re-search-backward message-signature-separator nil t))
-        t
-       (if (>= (count-lines (1+ (point-at-eol)) (point-max)) 5)
-          (if (message-gnksa-enable-p 'signature)
-              (y-or-n-p
-               (format "Signature is excessively long (%d lines).  Really post? "
-                       (count-lines (1+ (point-at-eol)) (point-max))))
-            (message "Denied posting -- Excessive signature.")
-            nil)
-        t)))
+     (let (sig-start sig-end)
+       (goto-char (point-max))
+       (if (not (re-search-backward message-signature-separator nil t))
+          t
+        (setq sig-start (1+ (point-at-eol)))
+        (setq sig-end
+              (if (re-search-forward
+                   "<#/?\\(multipart\\|part\\|external\\|mml\\)" nil t)
+                  (- (point-at-bol) 1)
+                (point-max)))
+        (if (>= (count-lines sig-start sig-end) 5)
+            (if (message-gnksa-enable-p 'signature)
+                (y-or-n-p
+                 (format "Signature is excessively long (%d lines).  Really post? "
+                         (count-lines sig-start sig-end)))
+              (message "Denied posting -- Excessive signature.")
+              nil)
+          t))))

    ;; Ensure that text follows last quoted portion.
    (message-check 'quoting-style
      (goto-char (point-max))
    ;; Ensure that text follows last quoted portion.
    (message-check 'quoting-style
      (goto-char (point-max))

diff --git a/lisp/gnus/mm-url.el b/lisp/gnus/mm-url.el
index b41c40f8f5064271c59a3d03da4b09e697bdd893..46ca1741fb7ab07644e9f9fa11473cbcd5e1c296 100644 (file)
--- a/lisp/gnus/mm-url.el
+++ b/lisp/gnus/mm-url.el
@@ -1,6 +1,7 @@
 ;;; mm-url.el --- a wrapper of url functions/commands for Gnus
 
 ;;; mm-url.el --- a wrapper of url functions/commands for Gnus
 

-;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
+;;   Free Software Foundation, Inc.

 
 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
 
 
 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
 


@@ -366,10 +367,10 @@ If FOLLOW-REFRESH is non-nil, redirect refresh url in META."
   (goto-char (point-min))
   (while (re-search-forward "&\\(#[0-9]+\\|[a-z]+[0-9]*\\);" nil t)
     (let ((elem (if (eq (aref (match-string 1) 0) ?\#)
   (goto-char (point-min))
   (while (re-search-forward "&\\(#[0-9]+\\|[a-z]+[0-9]*\\);" nil t)
     (let ((elem (if (eq (aref (match-string 1) 0) ?\#)

-                       (let ((c
-                              (string-to-number (substring
-                                                 (match-string 1) 1))))
-                         (if (mm-char-or-char-int-p c) c 32))
+                       (let ((c (mm-ucs-to-char
+                                 (string-to-number
+                                  (substring (match-string 1) 1)))))
+                         (if (mm-char-or-char-int-p c) c ?#))

                      (or (cdr (assq (intern (match-string 1))
                                     mm-url-html-entities))
                          ?#))))
                      (or (cdr (assq (intern (match-string 1))
                                     mm-url-html-entities))
                          ?#))))

diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el
index 4a480832809b51e364b6c318e34b38f4fff24612..3d8538d4a61dd6213aab4c02e3d6000eca0367e0 100644 (file)
--- a/lisp/gnus/mm-util.el
+++ b/lisp/gnus/mm-util.el
@@ -40,6 +40,10 @@
 
 (defvar mm-mime-mule-charset-alist )
 
 
 (defvar mm-mime-mule-charset-alist )
 

+;; Emulate functions that are not available in every (X)Emacs version.
+;; The name of a function is prefixed with mm-, like `mm-char-int' for
+;; `char-int' that is a native XEmacs function, not available in Emacs.
+;; Gnus programs all should use mm- functions, not the original ones.

 (eval-and-compile
   (mapc
    (lambda (elem)
 (eval-and-compile
   (mapc
    (lambda (elem)


@@ -47,11 +51,19 @@
        (if (fboundp (car elem))
           (defalias nfunc (car elem))
         (defalias nfunc (cdr elem)))))
        (if (fboundp (car elem))
           (defalias nfunc (car elem))
         (defalias nfunc (cdr elem)))))

-   `((coding-system-list . ignore)
+   `(;; `coding-system-list' is not available in XEmacs 21.4 built
+     ;; without the `file-coding' feature.
+     (coding-system-list . ignore)
+     ;; `char-int' is an XEmacs function, not available in Emacs.

      (char-int . identity)
      (char-int . identity)

+     ;; `coding-system-equal' is an Emacs function, not available in XEmacs.

      (coding-system-equal . equal)
      (coding-system-equal . equal)

+     ;; `annotationp' is an XEmacs function, not available in Emacs.

      (annotationp . ignore)
      (annotationp . ignore)

+     ;; `set-buffer-file-coding-system' is not available in XEmacs 21.4
+     ;; built without the `file-coding' feature.

      (set-buffer-file-coding-system . ignore)
      (set-buffer-file-coding-system . ignore)

+     ;; `read-charset' is an Emacs function, not available in XEmacs.

      (read-charset
       . ,(lambda (prompt)
           "Return a charset."
      (read-charset
       . ,(lambda (prompt)
           "Return a charset."


@@ -61,6 +73,7 @@
             (mapcar (lambda (e) (list (symbol-name (car e))))
                     mm-mime-mule-charset-alist)
             nil t))))
             (mapcar (lambda (e) (list (symbol-name (car e))))
                     mm-mime-mule-charset-alist)
             nil t))))

+     ;; `subst-char-in-string' is not available in XEmacs 21.4.

      (subst-char-in-string
       . ,(lambda (from to string &optional inplace)
           ;; stolen (and renamed) from nnheader.el
      (subst-char-in-string
       . ,(lambda (from to string &optional inplace)
           ;; stolen (and renamed) from nnheader.el


@@ -75,11 +88,14 @@
                 (aset string idx to))
               (setq idx (1+ idx)))
             string)))
                 (aset string idx to))
               (setq idx (1+ idx)))
             string)))

+     ;; `replace-in-string' is an XEmacs function, not available in Emacs.

      (replace-in-string
       . ,(lambda (string regexp rep &optional literal)
           "See `replace-regexp-in-string', only the order of args differs."
           (replace-regexp-in-string regexp rep string nil literal)))
      (replace-in-string
       . ,(lambda (string regexp rep &optional literal)
           "See `replace-regexp-in-string', only the order of args differs."
           (replace-regexp-in-string regexp rep string nil literal)))

+     ;; `string-as-unibyte' is an Emacs function, not available in XEmacs.

      (string-as-unibyte . identity)
      (string-as-unibyte . identity)

+     ;; `string-make-unibyte' is an Emacs function, not available in XEmacs.

      (string-make-unibyte . identity)
      ;; string-as-multibyte often doesn't really do what you think it does.
      ;; Example:
      (string-make-unibyte . identity)
      ;; string-as-multibyte often doesn't really do what you think it does.
      ;; Example:


@@ -99,11 +115,18 @@
      ;; (string-as-multibyte s)   ~= (decode-coding-string s 'emacs-mule)
      ;; (string-to-multibyte s)   ~= (decode-coding-string s 'binary)
      ;; (string-make-multibyte s) ~= (decode-coding-string s locale-coding-system)
      ;; (string-as-multibyte s)   ~= (decode-coding-string s 'emacs-mule)
      ;; (string-to-multibyte s)   ~= (decode-coding-string s 'binary)
      ;; (string-make-multibyte s) ~= (decode-coding-string s locale-coding-system)

+     ;; `string-as-multibyte' is an Emacs function, not available in XEmacs.

      (string-as-multibyte . identity)
      (string-as-multibyte . identity)

+     ;; `multibyte-string-p' is an Emacs function, not available in XEmacs.

      (multibyte-string-p . ignore)
      (multibyte-string-p . ignore)

+     ;; `insert-byte' is available only in Emacs 23.1 or greater.

      (insert-byte . insert-char)
      (insert-byte . insert-char)

+     ;; `multibyte-char-to-unibyte' is an Emacs function, not available
+     ;; in XEmacs.

      (multibyte-char-to-unibyte . identity)
      (multibyte-char-to-unibyte . identity)

+     ;; `set-buffer-multibyte' is an Emacs function, not available in XEmacs.

      (set-buffer-multibyte . ignore)
      (set-buffer-multibyte . ignore)

+     ;; `special-display-p' is an Emacs function, not available in XEmacs.

      (special-display-p
       . ,(lambda (buffer-name)
           "Returns non-nil if a buffer named BUFFER-NAME gets a special frame."
      (special-display-p
       . ,(lambda (buffer-name)
           "Returns non-nil if a buffer named BUFFER-NAME gets a special frame."


@@ -119,6 +142,7 @@
                             (stringp (car elem))
                             (string-match (car elem) buffer-name)
                             (throw 'return (cdr elem)))))))))
                             (stringp (car elem))
                             (string-match (car elem) buffer-name)
                             (throw 'return (cdr elem)))))))))

+     ;; `substring-no-properties' is available only in Emacs 22.1 or greater.

      (substring-no-properties
       . ,(lambda (string &optional from to)
           "Return a substring of STRING, without text properties.
      (substring-no-properties
       . ,(lambda (string &optional from to)
           "Return a substring of STRING, without text properties.


@@ -130,12 +154,30 @@ If FROM or TO is negative, it counts from the end.
 With one argument, just copy STRING without its properties."
           (setq string (substring string (or from 0) to))
           (set-text-properties 0 (length string) nil string)
 With one argument, just copy STRING without its properties."
           (setq string (substring string (or from 0) to))
           (set-text-properties 0 (length string) nil string)

-          string)))))
-
+          string))
+     ;; `line-number-at-pos' is available only in Emacs 22.1 or greater
+     ;; and XEmacs 21.5.
+     (line-number-at-pos
+      . ,(lambda (&optional pos)
+          "Return (narrowed) buffer line number at position POS.
+If POS is nil, use current buffer location.
+Counting starts at (point-min), so the value refers
+to the contents of the accessible portion of the buffer."
+          (let ((opoint (or pos (point))) start)
+            (save-excursion
+              (goto-char (point-min))
+              (setq start (point))
+              (goto-char opoint)
+              (forward-line 0)
+              (1+ (count-lines start (point))))))))))
+
+;; `decode-coding-string', `encode-coding-string', `decode-coding-region'
+;; and `encode-coding-region' are available in Emacs and XEmacs built with
+;; the `file-coding' feature, but the XEmacs versions treat nil, that is
+;; given as the `coding-system' argument, as the `binary' coding system.

 (eval-and-compile
   (if (featurep 'xemacs)
       (if (featurep 'file-coding)
 (eval-and-compile
   (if (featurep 'xemacs)
       (if (featurep 'file-coding)

-         ;; Don't modify string if CODING-SYSTEM is nil.

          (progn
            (defun mm-decode-coding-string (str coding-system)
              (if coding-system
          (progn
            (defun mm-decode-coding-string (str coding-system)
              (if coding-system


@@ -160,6 +202,7 @@ With one argument, just copy STRING without its properties."
     (defalias 'mm-decode-coding-region 'decode-coding-region)
     (defalias 'mm-encode-coding-region 'encode-coding-region)))
 
     (defalias 'mm-decode-coding-region 'decode-coding-region)
     (defalias 'mm-encode-coding-region 'encode-coding-region)))
 

+;; `string-to-multibyte' is available only in Emacs 22.1 or greater.

 (defalias 'mm-string-to-multibyte
   (cond
    ((featurep 'xemacs)
 (defalias 'mm-string-to-multibyte
   (cond
    ((featurep 'xemacs)


@@ -173,6 +216,7 @@ With one argument, just copy STRING without its properties."
        (lambda (ch) (mm-string-as-multibyte (char-to-string ch)))
        string "")))))
 
        (lambda (ch) (mm-string-as-multibyte (char-to-string ch)))
        string "")))))
 

+;; `char-or-char-int-p' is an XEmacs function, not available in Emacs.

 (eval-and-compile
   (defalias 'mm-char-or-char-int-p
     (cond
 (eval-and-compile
   (defalias 'mm-char-or-char-int-p
     (cond


@@ -180,6 +224,44 @@ With one argument, just copy STRING without its properties."
      ((fboundp 'char-valid-p) 'char-valid-p)
      (t 'identity))))
 
      ((fboundp 'char-valid-p) 'char-valid-p)
      (t 'identity))))
 

+;; `ucs-to-char' is a function that Mule-UCS provides.
+(if (featurep 'xemacs)
+    (cond ((and (fboundp 'unicode-to-char) ;; XEmacs 21.5.
+               (subrp (symbol-function 'unicode-to-char)))
+          (if (featurep 'mule)
+              (defalias 'mm-ucs-to-char 'unicode-to-char)
+            (defun mm-ucs-to-char (codepoint)
+              "Convert Unicode codepoint to character."
+              (or (unicode-to-char codepoint) ?#))))
+         ((featurep 'mule)
+          (defun mm-ucs-to-char (codepoint)
+            "Convert Unicode codepoint to character."
+            (if (fboundp 'ucs-to-char) ;; Mule-UCS is loaded.
+                (progn
+                  (defalias 'mm-ucs-to-char
+                    (lambda (codepoint)
+                      "Convert Unicode codepoint to character."
+                      (condition-case nil
+                          (or (ucs-to-char codepoint) ?#)
+                        (error ?#))))
+                  (mm-ucs-to-char codepoint))
+              (condition-case nil
+                  (or (int-to-char codepoint) ?#)
+                (error ?#)))))
+         (t
+          (defun mm-ucs-to-char (codepoint)
+            "Convert Unicode codepoint to character."
+            (condition-case nil
+                (or (int-to-char codepoint) ?#)
+              (error ?#)))))
+  (if (let ((char (make-char 'japanese-jisx0208 36 34)))
+       (eq char (decode-char 'ucs char)))
+      ;; Emacs 23.
+      (defalias 'mm-ucs-to-char 'identity)
+    (defun mm-ucs-to-char (codepoint)
+      "Convert Unicode codepoint to character."
+      (or (decode-char 'ucs codepoint) ?#))))
+

 ;; Fixme:  This seems always to be used to read a MIME charset, so it
 ;; should be re-named and fixed (in Emacs) to offer completion only on
 ;; proper charset names (base coding systems which have a
 ;; Fixme:  This seems always to be used to read a MIME charset, so it
 ;; should be re-named and fixed (in Emacs) to offer completion only on
 ;; proper charset names (base coding systems which have a

diff --git a/lisp/gnus/mml1991.el b/lisp/gnus/mml1991.el
index 60d6e3cb4fd605d845a3f76c93d066145d708ca8..4536f4183d97fc52589283decf6ac24b6b3028f3 100644 (file)
--- a/lisp/gnus/mml1991.el
+++ b/lisp/gnus/mml1991.el
@@ -3,7 +3,7 @@
 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
 ;;   2007, 2008, 2009  Free Software Foundation, Inc.
 
 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
 ;;   2007, 2008, 2009  Free Software Foundation, Inc.
 

-;; Author: Sascha Ldecke <sascha@meta-x.de>,
+;; Author: Sascha Lüdecke <sascha@meta-x.de>,

 ;;     Simon Josefsson <simon@josefsson.org> (Mailcrypt interface, Gnus glue)
 ;; Keywords PGP
 
 ;;     Simon Josefsson <simon@josefsson.org> (Mailcrypt interface, Gnus glue)
 ;; Keywords PGP
 

diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el
index a40624cba29f3b7b65161b10426492546b7ab3d1..572f80bea9d9ad006f74e13e74be35d3e5e4daf5 100644 (file)
--- a/lisp/gnus/nnheader.el
+++ b/lisp/gnus/nnheader.el
@@ -86,7 +86,14 @@ Integer values will in effect be rounded up to the nearest multiple of
       ;; what's possible.  Perhaps better, maybe the Windows/DOS primitive
       ;; could round up non-zero timeouts to a minimum of 1.0?
       1.0
       ;; what's possible.  Perhaps better, maybe the Windows/DOS primitive
       ;; could round up non-zero timeouts to a minimum of 1.0?
       1.0

+    ;; 2008-05-19 change by Larsi:
+    ;; Change the default timeout from 0.1 seconds to 0.01 seconds.  This will
+    ;; make nntp and pop3 article retrieval faster in some cases, but might
+    ;; make CPU usage larger.  If this has any bad side effects, we might
+    ;; revert this change.

     0.01)
     0.01)

+  ;; When changing this variable, consider changing `pop3-read-timeout' as
+  ;; well.

   "How long nntp should wait between checking for the end of output.
 Shorter values mean quicker response, but are more CPU intensive.")
 
   "How long nntp should wait between checking for the end of output.
 Shorter values mean quicker response, but are more CPU intensive.")
 


@@ -1057,6 +1064,8 @@ See `find-file-noselect' for the arguments."
 (defalias 'nnheader-cancel-timer 'cancel-timer)
 (defalias 'nnheader-cancel-function-timers 'cancel-function-timers)
 
 (defalias 'nnheader-cancel-timer 'cancel-timer)
 (defalias 'nnheader-cancel-function-timers 'cancel-function-timers)
 

+;; When changing this function, consider changing `pop3-accept-process-output'
+;; as well.

 (defun nnheader-accept-process-output (process)
   (accept-process-output
    process
 (defun nnheader-accept-process-output (process)
   (accept-process-output
    process

diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index de5a67eab7d696e8b1592d640fed9dc8dbe765ad..87edde6a77b0fbe6b2f6316581fe488d31fcf8f8 100644 (file)
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -3,7 +3,7 @@
 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
 ;;   2007, 2008, 2009  Free Software Foundation, Inc.
 
 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
 ;;   2007, 2008, 2009  Free Software Foundation, Inc.
 

-;; Author: Simon Josefsson <jas@pdc.kth.se>
+;; Author: Simon Josefsson <simon@josefsson.org>

 ;;         Jim Radford <radford@robby.caltech.edu>
 ;; Keywords: mail
 
 ;;         Jim Radford <radford@robby.caltech.edu>
 ;; Keywords: mail
 


@@ -163,6 +163,8 @@ the inbox string is also a regexp.  The actual splitting rules are as
 before, either a function, or a list with group/regexp or
 group/function elements."
   :group 'nnimap
 before, either a function, or a list with group/regexp or
 group/function elements."
   :group 'nnimap

+  ;; FIXME: Doesn't allow `("my2server" ("INBOX" nnimap-split-fancy))'
+  ;; per example above.  -- fx

   :type '(choice :tag "Rule type"
                 (repeat :menu-tag "Single-server"
                         :tag "Single-server list"
   :type '(choice :tag "Rule type"
                 (repeat :menu-tag "Single-server"
                         :tag "Single-server list"


@@ -460,11 +462,17 @@ An example plist would be '(\"name\" \"Gnus\" \"version\" gnus-version-number
                 (plist :key-type string :value-type string)))
 
 (defcustom nnimap-debug nil
                 (plist :key-type string :value-type string)))
 
 (defcustom nnimap-debug nil

-  "If non-nil, random debug spews are placed in *nnimap-debug* buffer.
+  "If non-nil, trace nnimap- functions into `nnimap-debug-buffer'.
+Uses `trace-function-background', so you can turn it off with,
+say, `untrace-all'.
+

 Note that username, passwords and other privacy sensitive
 Note that username, passwords and other privacy sensitive

-information (such as e-mail) may be stored in the *nnimap-debug*
-buffer.  It is not written to disk, however.  Do not enable this
-variable unless you are comfortable with that."
+information (such as e-mail) may be stored in the buffer.
+It is not written to disk, however.  Do not enable this
+variable unless you are comfortable with that.
+
+This variable only takes effect when loading the `nnimap' library.
+See also `nnimap-log'."

   :group 'nnimap
   :type 'boolean)
 
   :group 'nnimap
   :type 'boolean)
 


@@ -555,8 +563,7 @@ If EXAMINE is non-nil the group is selected read-only."
              (imap-mailbox-select group examine))
       (let (minuid maxuid)
        (when (> (imap-mailbox-get 'exists) 0)
              (imap-mailbox-select group examine))
       (let (minuid maxuid)
        (when (> (imap-mailbox-get 'exists) 0)

-         (imap-fetch (if imap-enable-exchange-bug-workaround "1,*:*" "1,*")
-                     "UID" nil 'nouidfetch)
+         (imap-fetch-safe '("1,*" . "1,*:*") "UID" nil 'nouidfetch)

          (imap-message-map (lambda (uid Uid)
                              (setq minuid (if minuid (min minuid uid) uid)
                                    maxuid (if maxuid (max maxuid uid) uid)))
          (imap-message-map (lambda (uid Uid)
                              (setq minuid (if minuid (min minuid uid) uid)
                                    maxuid (if maxuid (max maxuid uid) uid)))

diff --git a/lisp/gnus/pop3.el b/lisp/gnus/pop3.el
index a99cff74433a0d92256196c9d989a80a99dcfcc9..2ca09d882774050717250daf0f48f054fb729bf4 100644 (file)
--- a/lisp/gnus/pop3.el
+++ b/lisp/gnus/pop3.el
@@ -105,33 +105,28 @@ Used for APOP authentication.")
 (defvar pop3-read-point nil)
 (defvar pop3-debug nil)
 
 (defvar pop3-read-point nil)
 (defvar pop3-debug nil)
 

-;; Borrowed from nnheader-accept-process-output in nnheader.el.
-(defvar pop3-read-timeout
-  (if (string-match "windows-nt\\|os/2\\|emx\\|cygwin"
-                   (symbol-name system-type))
-      ;; http://thread.gmane.org/v9655t3pjo.fsf@marauder.physik.uni-ulm.de
-      ;;
-      ;; IIRC, values lower than 1.0 didn't/don't work on Windows/DOS.
-      ;;
-      ;; There should probably be a runtime test to determine the timing
-      ;; resolution, or a primitive to report it.  I don't know off-hand
-      ;; what's possible.  Perhaps better, maybe the Windows/DOS primitive
-      ;; could round up non-zero timeouts to a minimum of 1.0?
-      1.0
-    0.1)
-  "How long pop3 should wait between checking for the end of output.
+;; Borrowed from nnheader-accept-process-output in nnheader.el.  See the
+;; comments there for explanations about the values.
+
+(eval-and-compile
+  (if (and (fboundp 'nnheader-accept-process-output)
+          (boundp 'nnheader-read-timeout))
+      (defalias 'pop3-accept-process-output 'nnheader-accept-process-output)
+    ;; Borrowed from `nnheader.el':
+    (defvar pop3-read-timeout
+      (if (string-match "windows-nt\\|os/2\\|emx\\|cygwin"
+                       (symbol-name system-type))
+         1.0
+       0.01)
+      "How long pop3 should wait between checking for the end of output.

 Shorter values mean quicker response, but are more CPU intensive.")
 Shorter values mean quicker response, but are more CPU intensive.")

-
-;; Borrowed from nnheader-accept-process-output in nnheader.el.
-(defun pop3-accept-process-output (process)
-  (accept-process-output
-   process
-   (truncate pop3-read-timeout)
-   (truncate (* (- pop3-read-timeout
-                  (truncate pop3-read-timeout))
-               1000))))
-
-(autoload 'nnheader-accept-process-output "nnheader")
+    (defun pop3-accept-process-output (process)
+      (accept-process-output
+       process
+       (truncate pop3-read-timeout)
+       (truncate (* (- pop3-read-timeout
+                      (truncate pop3-read-timeout))
+                   1000))))))

 
 (defun pop3-movemail (&optional crashbox)
   "Transfer contents of a maildrop to the specified CRASHBOX."
 
 (defun pop3-movemail (&optional crashbox)
   "Transfer contents of a maildrop to the specified CRASHBOX."


@@ -171,7 +166,7 @@ Shorter values mean quicker response, but are more CPU intensive.")
           (unless pop3-leave-mail-on-server
             (pop3-dele process n))
          (setq n (+ 1 n))
           (unless pop3-leave-mail-on-server
             (pop3-dele process n))
          (setq n (+ 1 n))

-         (nnheader-accept-process-output process))
+         (pop3-accept-process-output process))

       (when (and pop3-leave-mail-on-server
                 (> n 1))
        (message "pop3.el doesn't support UIDL.  Setting `pop3-leave-mail-on-server'
       (when (and pop3-leave-mail-on-server
                 (> n 1))
        (message "pop3.el doesn't support UIDL.  Setting `pop3-leave-mail-on-server'

diff --git a/lisp/gnus/sieve-manage.el b/lisp/gnus/sieve-manage.el
index 793c4f9a914d0b2f85855d09286dc46608ba16c3..c40c6fc2cd9c8a0af3370ff37240de74acd0ca01 100644 (file)
--- a/lisp/gnus/sieve-manage.el
+++ b/lisp/gnus/sieve-manage.el
@@ -304,15 +304,14 @@ Returns t if login was successful, nil otherwise."
       (when (memq (process-status process) '(open run))
        process))))
 
       (when (memq (process-status process) '(open run))
        process))))
 

-(defun imap-starttls-p (buffer)
-  ;;  (and (imap-capability 'STARTTLS buffer)
+(defun sieve-manage-starttls-p (buffer)

   (condition-case ()
       (progn
        (require 'starttls)
        (call-process "starttls"))
     (error nil)))
 
   (condition-case ()
       (progn
        (require 'starttls)
        (call-process "starttls"))
     (error nil)))
 

-(defun imap-starttls-open (name buffer server port)
+(defun sieve-manage-starttls-open (name buffer server port)

   (let* ((port (or port sieve-manage-default-port))
         (coding-system-for-read sieve-manage-coding-system-for-read)
         (coding-system-for-write sieve-manage-coding-system-for-write)
   (let* ((port (or port sieve-manage-default-port))
         (coding-system-for-read sieve-manage-coding-system-for-read)
         (coding-system-for-write sieve-manage-coding-system-for-write)

diff --git a/lisp/gnus/spam-report.el b/lisp/gnus/spam-report.el
index 94c7622b20053a35daa11ff60e8b5577bc1742b8..816f973ccb15a9bbe6ee8c1ad603b9fba1577034 100644 (file)
--- a/lisp/gnus/spam-report.el
+++ b/lisp/gnus/spam-report.el
@@ -117,17 +117,33 @@ Reports is as ham when HAM is set."
   "Report an article as ham by resending via email."
   (spam-report-resend articles t))
 
   "Report an article as ham by resending via email."
   (spam-report-resend articles t))
 

+(defconst spam-report-gmane-max-requests 4
+  "Number of reports to send before waiting for a response.")
+
+(defvar spam-report-gmane-wait nil
+  "When non-nil, wait until we get a server response.
+This makes sure we don't DOS the host, if many reports are
+submitted at once.  Internal variable.")
+

 (defun spam-report-gmane-ham (&rest articles)
   "Report ARTICLES as ham (unregister) through Gmane."
   (interactive (gnus-summary-work-articles current-prefix-arg))
 (defun spam-report-gmane-ham (&rest articles)
   "Report ARTICLES as ham (unregister) through Gmane."
   (interactive (gnus-summary-work-articles current-prefix-arg))

-  (dolist (article articles)
-    (spam-report-gmane-internal t article)))
+  (let ((count 0))
+    (dolist (article articles)
+      (setq count (1+ count))
+      (let ((spam-report-gmane-wait
+            (zerop (% count spam-report-gmane-max-requests))))
+       (spam-report-gmane-internal t article)))))

 
 (defun spam-report-gmane-spam (&rest articles)
   "Report ARTICLES as spam through Gmane."
   (interactive (gnus-summary-work-articles current-prefix-arg))
 
 (defun spam-report-gmane-spam (&rest articles)
   "Report ARTICLES as spam through Gmane."
   (interactive (gnus-summary-work-articles current-prefix-arg))

-  (dolist (article articles)
-    (spam-report-gmane-internal nil article)))
+  (let ((count 0))
+    (dolist (article articles)
+      (setq count (1+ count))
+      (let ((spam-report-gmane-wait
+            (zerop (% count spam-report-gmane-max-requests))))
+       (spam-report-gmane-internal nil article)))))

 
 ;; `spam-report-gmane' was an interactive entry point, so we should provide an
 ;; alias.
 
 ;; `spam-report-gmane' was an interactive entry point, so we should provide an
 ;; alias.


@@ -245,10 +261,14 @@ This is initialized based on `user-mail-address'."
        tcp-connection
        (format "GET %s HTTP/1.1\nUser-Agent: %s\nHost: %s\n\n"
               report spam-report-user-agent host))
        tcp-connection
        (format "GET %s HTTP/1.1\nUser-Agent: %s\nHost: %s\n\n"
               report spam-report-user-agent host))

-      ;; Wait until we get something so we don't DOS the host. 
-      (while (and (memq (process-status tcp-connection) '(open run))
-                 (zerop (buffer-size)))
-       (accept-process-output tcp-connection)))))
+      ;; Wait until we get something so we don't DOS the host, if
+      ;; `spam-report-gmane-wait' is let-bound to t.
+      (when spam-report-gmane-wait
+       (gnus-message 7 "Waiting for response from %s..." host)
+       (while (and (memq (process-status tcp-connection) '(open run))
+                   (zerop (buffer-size)))
+         (accept-process-output tcp-connection))
+       (gnus-message 7 "Waiting for response from %s... done" host)))))

 
 ;;;###autoload
 (defun spam-report-process-queue (&optional file keep)
 
 ;;;###autoload
 (defun spam-report-process-queue (&optional file keep)


@@ -278,7 +298,13 @@ symbol `ask', query before flushing the queue file."
     (while (and (not (eobp))
                (re-search-forward
                 "http://\\([^/]+\\)\\(/.*\\) *$" (point-at-eol) t))
     (while (and (not (eobp))
                (re-search-forward
                 "http://\\([^/]+\\)\\(/.*\\) *$" (point-at-eol) t))

-      (funcall spam-report-url-ping-function (match-string 1) (match-string 2))
+      (let ((spam-report-gmane-wait
+            (zerop (% (mm-line-number-at-pos)
+                      spam-report-gmane-max-requests))))
+       (gnus-message 6 "Reporting %s%s..."
+                     (match-string 1) (match-string 2))
+       (funcall spam-report-url-ping-function
+                (match-string 1) (match-string 2)))

       (forward-line 1))
     (if (or (eq keep nil)
            (and (eq keep 'ask)
       (forward-line 1))
     (if (or (eq keep nil)
            (and (eq keep 'ask)

diff --git a/lisp/net/dns.el b/lisp/net/dns.el
index e4dc9aa08ab2050c0aab32bae8317e019c3fe4a5..e0aba3c32ead69720712e7c4850c8a9c8f7d36e4 100644 (file)
--- a/lisp/net/dns.el
+++ b/lisp/net/dns.el
@@ -29,8 +29,8 @@
   "How many seconds to wait when doing DNS queries.")
 
 (defvar dns-servers nil
   "How many seconds to wait when doing DNS queries.")
 
 (defvar dns-servers nil

-  "Which DNS servers to query.
-If nil, /etc/resolv.conf will be consulted.")
+  "List of DNS servers to query.
+If nil, /etc/resolv.conf and nslookup will be consulted.")

 
 ;;; Internal code:
 
 
 ;;; Internal code:
 


@@ -298,14 +298,24 @@ If TCP-P, the first two bytes of the package with be the length field."
            (t string)))
       (goto-char point))))
 
            (t string)))
       (goto-char point))))
 

-(defun dns-parse-resolv-conf ()
-  (when (file-exists-p "/etc/resolv.conf")
-    (with-temp-buffer
-      (insert-file-contents "/etc/resolv.conf")
-      (goto-char (point-min))
-      (while (re-search-forward "^nameserver[\t ]+\\([^ \t\n]+\\)" nil t)
-       (push (match-string 1) dns-servers))
-      (setq dns-servers (nreverse dns-servers)))))
+(defun dns-set-servers ()
+  "Set `dns-servers' to a list of DNS servers or nil if none are found.
+Parses \"/etc/resolv.conf\" or calls \"nslookup\"."
+  (or (when (file-exists-p "/etc/resolv.conf")
+       (setq dns-servers nil)
+       (with-temp-buffer
+         (insert-file-contents "/etc/resolv.conf")
+         (goto-char (point-min))
+         (while (re-search-forward "^nameserver[\t ]+\\([^ \t\n]+\\)" nil t)
+           (push (match-string 1) dns-servers))
+         (setq dns-servers (nreverse dns-servers))))
+      (when (executable-find "nslookup")
+       (with-temp-buffer
+         (call-process "nslookup" nil t nil "localhost")
+         (goto-char (point-min))
+         (re-search-forward
+          "^Address:[ \t]*\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)" nil t)
+         (setq dns-servers (list (match-string 1)))))))

 
 (defun dns-read-txt (string)
   (if (> (length string) 1)
 
 (defun dns-read-txt (string)
   (if (> (length string) 1)


@@ -351,23 +361,26 @@ If TCP-P, the first two bytes of the package with be the length field."
 
 (defvar dns-cache (make-vector 4096 0))
 
 
 (defvar dns-cache (make-vector 4096 0))
 

-(defun query-dns-cached (name &optional type fullp reversep)
+(defun dns-query-cached (name &optional type fullp reversep)

   (let* ((key (format "%s:%s:%s:%s" name type fullp reversep))
         (sym (intern-soft key dns-cache)))
     (if (and sym
             (boundp sym))
        (symbol-value sym)
   (let* ((key (format "%s:%s:%s:%s" name type fullp reversep))
         (sym (intern-soft key dns-cache)))
     (if (and sym
             (boundp sym))
        (symbol-value sym)

-      (let ((result (query-dns name type fullp reversep)))
+      (let ((result (dns-query name type fullp reversep)))

        (set (intern key dns-cache) result)
        result))))
 
        (set (intern key dns-cache) result)
        result))))
 

-(defun query-dns (name &optional type fullp reversep)
+;; The old names `query-dns' and `query-dns-cached' weren't used in Emacs 23
+;; yet, so no alias are provided.  --rsteib
+
+(defun dns-query (name &optional type fullp reversep)

   "Query a DNS server for NAME of TYPE.
 If FULLP, return the entire record returned.
 If REVERSEP, look up an IP address."
   (setq type (or type 'A))
   (unless dns-servers
   "Query a DNS server for NAME of TYPE.
 If FULLP, return the entire record returned.
 If REVERSEP, look up an IP address."
   (setq type (or type 'A))
   (unless dns-servers

-    (dns-parse-resolv-conf))
+    (dns-set-servers))

 
   (when reversep
     (setq name (concat
 
   (when reversep
     (setq name (concat

diff --git a/lisp/net/imap.el b/lisp/net/imap.el
index dc295d5b367d2c7b3e2d80f6011e4f644f696539..6f2b2d11f97eb51b7b9102332aeb8bffd5766f6b 100644 (file)
--- a/lisp/net/imap.el
+++ b/lisp/net/imap.el
@@ -3,7 +3,7 @@
 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
 ;;   2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
 
 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
 ;;   2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
 

-;; Author: Simon Josefsson <jas@pdc.kth.se>
+;; Author: Simon Josefsson <simon@josefsson.org>

 ;; Keywords: mail
 
 ;; This file is part of GNU Emacs.
 ;; Keywords: mail
 
 ;; This file is part of GNU Emacs.


@@ -23,7 +23,7 @@
 
 ;;; Commentary:
 
 
 ;;; Commentary:
 

-;; imap.el is a elisp library providing an interface for talking to
+;; imap.el is an elisp library providing an interface for talking to

 ;; IMAP servers.
 ;;
 ;; imap.el is roughly divided in two parts, one that parses IMAP
 ;; IMAP servers.
 ;;
 ;; imap.el is roughly divided in two parts, one that parses IMAP


@@ -72,25 +72,25 @@
 ;; explanatory for someone that know IMAP.  All functions have
 ;; additional documentation on how to invoke them.
 ;;
 ;; explanatory for someone that know IMAP.  All functions have
 ;; additional documentation on how to invoke them.
 ;;

-;; imap.el support RFC1730/2060/RFC3501 (IMAP4/IMAP4rev1), implemented
+;; imap.el supports RFC1730/2060/RFC3501 (IMAP4/IMAP4rev1).  The implemented

 ;; IMAP extensions are RFC2195 (CRAM-MD5), RFC2086 (ACL), RFC2342
 ;; (NAMESPACE), RFC2359 (UIDPLUS), the IMAP-part of RFC2595 (STARTTLS,
 ;; LOGINDISABLED) (with use of external library starttls.el and
 ;; IMAP extensions are RFC2195 (CRAM-MD5), RFC2086 (ACL), RFC2342
 ;; (NAMESPACE), RFC2359 (UIDPLUS), the IMAP-part of RFC2595 (STARTTLS,
 ;; LOGINDISABLED) (with use of external library starttls.el and

-;; program starttls), and the GSSAPI / kerberos V4 sections of RFC1731
-;; (with use of external program `imtest'), RFC2971 (ID).  It also
+;; program starttls), and the GSSAPI / Kerberos V4 sections of RFC1731
+;; (with use of external program `imtest'), and RFC2971 (ID).  It also

 ;; takes advantage of 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.
 ;;
 ;; takes advantage of 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.
 ;;

-;; This is a transcript of short interactive session for demonstration
+;; This is a transcript of a short interactive session for demonstration

 ;; purposes.
 ;;
 ;; (imap-open "my.mail.server")
 ;; => " *imap* my.mail.server:0"
 ;;
 ;; The rest are invoked with current buffer as the buffer returned by
 ;; purposes.
 ;;
 ;; (imap-open "my.mail.server")
 ;; => " *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 it all without this, but it would

 ;; look ugly here since `buffer' is always the last argument for all
 ;; imap.el API functions.
 ;;
 ;; look ugly here since `buffer' is always the last argument for all
 ;; imap.el API functions.
 ;;


@@ -121,6 +121,7 @@
 ;; Todo:
 ;;
 ;; o Parse UIDs as strings? We need to overcome the 28 bit limit somehow.
 ;; Todo:
 ;;
 ;; o Parse UIDs as strings? We need to overcome the 28 bit limit somehow.

+;;   Use IEEE floats (which are effectively exact)?  -- fx

 ;; o Don't use `read' at all (important places already fixed)
 ;; o Accept list of articles instead of message set string in most
 ;;   imap-message-* functions.
 ;; o Don't use `read' at all (important places already fixed)
 ;; o Accept list of articles instead of message set string in most
 ;;   imap-message-* functions.


@@ -131,7 +132,7 @@
 ;;  - 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
 ;;  - 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
+;;  - 19991023 committed to pgnus

 ;;
 
 ;;; Code:
 ;;
 
 ;;; Code:


@@ -204,19 +205,19 @@ until a successful connection is made."
 Within a string, %s is replaced with the server address, %p with port
 number on server, %g with `imap-shell-host', and %l with
 `imap-default-user'.  The program should read IMAP commands from stdin
 Within a string, %s is replaced with the server address, %p with port
 number on server, %g with `imap-shell-host', and %l with
 `imap-default-user'.  The program should read IMAP commands from stdin

-and write IMAP response to stdout. Each entry in the list is tried
+and write IMAP response to stdout.  Each entry in the list is tried

 until a successful connection is made."
   :group 'imap
   :type '(repeat string))
 
 (defcustom imap-process-connection-type nil
   "*Value for `process-connection-type' to use for Kerberos4, GSSAPI and SSL.
 until a successful connection is made."
   :group 'imap
   :type '(repeat string))
 
 (defcustom imap-process-connection-type nil
   "*Value for `process-connection-type' to use for Kerberos4, GSSAPI and SSL.

-The `process-connection-type' variable control type of device
+The `process-connection-type' variable controls the type of device

 used to communicate with subprocesses.  Values are nil to use a
 pipe, or t or `pty' to use a pty.  The value has no effect if the
 system has no ptys or if all ptys are busy: then a pipe is used
 used to communicate with subprocesses.  Values are nil to use a
 pipe, or t or `pty' to use a pty.  The value has no effect if the
 system has no ptys or if all ptys are busy: then a pipe is used

-in any case.  The value takes effect when a IMAP server is
-opened, changing it after that has no effect."
+in any case.  The value takes effect when an IMAP server is
+opened; changing it after that has no effect."

   :version "22.1"
   :group 'imap
   :type 'boolean)
   :version "22.1"
   :group 'imap
   :type 'boolean)


@@ -230,20 +231,28 @@ encoded mailboxes which doesn't translate into ISO-8859-1."
   :type 'boolean)
 
 (defcustom imap-log nil
   :type 'boolean)
 
 (defcustom imap-log nil

-  "If non-nil, a imap session trace is placed in *imap-log* buffer.
+  "If non-nil, an imap session trace is placed in `imap-log-buffer'.

 Note that username, passwords and other privacy sensitive
 Note that username, passwords and other privacy sensitive

-information (such as e-mail) may be stored in the *imap-log*
-buffer.  It is not written to disk, however.  Do not enable this
-variable unless you are comfortable with that."
+information (such as e-mail) may be stored in the buffer.
+It is not written to disk, however.  Do not enable this
+variable unless you are comfortable with that.
+
+See also `imap-debug'."

   :group 'imap
   :type 'boolean)
 
 (defcustom imap-debug nil
   :group 'imap
   :type 'boolean)
 
 (defcustom imap-debug nil

-  "If non-nil, random debug spews are placed in *imap-debug* buffer.
+  "If non-nil, trace imap- functions into `imap-debug-buffer'.
+Uses `trace-function-background', so you can turn it off with,
+say, `untrace-all'.
+

 Note that username, passwords and other privacy sensitive
 Note that username, passwords and other privacy sensitive

-information (such as e-mail) may be stored in the *imap-debug*
-buffer.  It is not written to disk, however.  Do not enable this
-variable unless you are comfortable with that."
+information (such as e-mail) may be stored in the buffer.
+It is not written to disk, however.  Do not enable this
+variable unless you are comfortable with that.
+
+This variable only takes effect when loading the `imap' library.
+See also `imap-log'."

   :group 'imap
   :type 'boolean)
 
   :group 'imap
   :type 'boolean)
 


@@ -268,7 +277,7 @@ Shorter values mean quicker response, but is more CPU intensive."
   :group 'imap)
 
 (defcustom imap-store-password nil
   :group 'imap)
 
 (defcustom imap-store-password nil

-  "If non-nil, store session password without promting."
+  "If non-nil, store session password without prompting."

   :group 'imap
   :type 'boolean)
 
   :group 'imap
   :type 'boolean)
 


@@ -393,7 +402,7 @@ and `examine'.")
   "Obarray with mailbox data.")
 
 (defvar imap-mailbox-prime 997
   "Obarray with mailbox data.")
 
 (defvar imap-mailbox-prime 997

-  "Length of imap-mailbox-data.")
+  "Length of `imap-mailbox-data'.")

 
 (defvar imap-current-message nil
   "Current message number.")
 
 (defvar imap-current-message nil
   "Current message number.")


@@ -402,7 +411,7 @@ and `examine'.")
   "Obarray with message data.")
 
 (defvar imap-message-prime 997
   "Obarray with message data.")
 
 (defvar imap-message-prime 997

-  "Length of imap-message-data.")
+  "Length of `imap-message-data'.")

 
 (defvar imap-capability nil
   "Capability for server.")
 
 (defvar imap-capability nil
   "Capability for server.")


@@ -440,17 +449,23 @@ second the status (OK, NO, BAD etc) of the command.")
 
 (defvar imap-enable-exchange-bug-workaround nil
   "Send FETCH UID commands as *:* instead of *.
 
 (defvar imap-enable-exchange-bug-workaround nil
   "Send FETCH UID commands as *:* instead of *.

-Enabling this appears to be required for some servers (e.g.,
-Microsoft Exchange) which otherwise would trigger a response 'BAD
-The specified message set is invalid.'.")
+
+When non-nil, use an alternative UIDS form.  Enabling appears to
+be required for some servers (e.g., Microsoft Exchange 2007)
+which otherwise would trigger a response 'BAD The specified
+message set is invalid.'.  We don't unconditionally use this
+form, since this is said to be significantly inefficient.
+
+This variable is set to t automatically per server if the
+canonical form fails.")

 
 \f
 ;; Utility functions:
 
 (defun imap-remassoc (key alist)
 
 \f
 ;; Utility functions:
 
 (defun imap-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
-of LIST has a car that is `equal' to KEY, there is no way to remove it
+  "Delete by side effect any elements of ALIST whose car is `equal' to KEY.
+The modified ALIST is returned.  If the first member
+of ALIST 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'."
   (when alist
 by side effect; therefore, write `(setq foo (remassoc key foo))' to be
 sure of changing the value of `foo'."
   (when alist


@@ -650,7 +665,7 @@ sure of changing the value of `foo'."
   nil)
 
 (defun imap-ssl-open (name buffer server port)
   nil)
 
 (defun imap-ssl-open (name buffer server port)

-  "Open a SSL connection to server."
+  "Open an SSL connection to SERVER."

   (let ((cmds (if (listp imap-ssl-program) imap-ssl-program
                (list imap-ssl-program)))
        cmd done)
   (let ((cmds (if (listp imap-ssl-program) imap-ssl-program
                (list imap-ssl-program)))
        cmd done)


@@ -711,6 +726,13 @@ sure of changing the value of `foo'."
         (process (open-tls-stream name buffer server port)))
     (when process
       (while (and (memq (process-status process) '(open run))
         (process (open-tls-stream name buffer server port)))
     (when process
       (while (and (memq (process-status process) '(open run))

+                 ;; FIXME: Per the "blue moon" comment, the process/buffer
+                 ;; handling here, and elsewhere in functions which open
+                 ;; streams, looks confused.  Obviously we can change buffers
+                 ;; if a different process handler kicks in from
+                 ;; `accept-process-output' or `sit-for' below, and TRT seems
+                 ;; to be to `save-buffer' around those calls.  (I wonder why
+                 ;; `sit-for' is used with a non-zero wait.)  -- fx

                  (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
                  (goto-char (point-max))
                  (forward-line -1)
                  (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
                  (goto-char (point-max))
                  (forward-line -1)


@@ -1081,7 +1103,7 @@ Returns t if login was successful, nil otherwise."
           imap-process))))
 
 (defun imap-open (server &optional port stream auth buffer)
           imap-process))))
 
 (defun imap-open (server &optional port stream auth buffer)

-  "Open a IMAP connection to host SERVER at PORT returning a buffer.
+  "Open an 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
 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


@@ -1402,7 +1424,7 @@ If EXAMINE is non-nil, do a read-only select."
 
 (defun imap-mailbox-expunge (&optional asynch buffer)
   "Expunge articles in current folder in BUFFER.
 
 (defun imap-mailbox-expunge (&optional asynch buffer)
   "Expunge articles in current folder in BUFFER.

-If ASYNCH, do not wait for succesful completion of the command.
+If ASYNCH, do not wait for successful completion of the command.

 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)))
 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)))


@@ -1412,7 +1434,7 @@ If BUFFER is nil the current buffer is assumed."
 
 (defun imap-mailbox-close (&optional asynch buffer)
   "Expunge articles and close current folder in BUFFER.
 
 (defun imap-mailbox-close (&optional asynch buffer)
   "Expunge articles and close current folder in BUFFER.

-If ASYNCH, do not wait for succesful completion of the command.
+If ASYNCH, do not wait for successful completion of the command.

 If BUFFER is nil the current buffer is assumed."
   (with-current-buffer (or buffer (current-buffer))
     (when imap-current-mailbox
 If BUFFER is nil the current buffer is assumed."
   (with-current-buffer (or buffer (current-buffer))
     (when imap-current-mailbox


@@ -1510,7 +1532,7 @@ passed to list command."
        (nreverse out)))))
 
 (defun imap-mailbox-subscribe (mailbox &optional buffer)
        (nreverse out)))))
 
 (defun imap-mailbox-subscribe (mailbox &optional buffer)

-  "Send the SUBSCRIBE command on the mailbox to server in BUFFER.
+  "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 \""
 Returns non-nil if successful."
   (with-current-buffer (or buffer (current-buffer))
     (imap-ok-p (imap-send-command-wait (concat "SUBSCRIBE \""


@@ -1518,7 +1540,7 @@ Returns non-nil if successful."
                                               "\"")))))
 
 (defun imap-mailbox-unsubscribe (mailbox &optional buffer)
                                               "\"")))))
 
 (defun imap-mailbox-unsubscribe (mailbox &optional buffer)

-  "Send the SUBSCRIBE command on the mailbox to server in BUFFER.
+  "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 "
 Returns non-nil if successful."
   (with-current-buffer (or buffer (current-buffer))
     (imap-ok-p (imap-send-command-wait (concat "UNSUBSCRIBE "


@@ -1528,8 +1550,8 @@ Returns non-nil if successful."
 (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
 (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
+the STATUS data items -- i.e. `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 its value is returned."
   (with-current-buffer (or buffer (current-buffer))
     (when (imap-ok-p
 returned, if ITEMS is a symbol only its value is returned."
   (with-current-buffer (or buffer (current-buffer))
     (when (imap-ok-p


@@ -1550,7 +1572,7 @@ returned, if ITEMS is a symbol only its value is returned."
 (defun imap-mailbox-status-asynch (mailbox items &optional buffer)
   "Send status item request ITEM on MAILBOX to server in BUFFER.
 ITEMS can be a symbol or a list of symbols, valid symbols are one of
 (defun imap-mailbox-status-asynch (mailbox items &optional buffer)
   "Send status item request ITEM on MAILBOX to 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
+the STATUS data items -- i.e. 'messages, 'recent, 'uidnext, 'uidvalidity

 or 'unseen.  The IMAP command tag is returned."
   (with-current-buffer (or buffer (current-buffer))
     (imap-send-command (list "STATUS \""
 or 'unseen.  The IMAP command tag is returned."
   (with-current-buffer (or buffer (current-buffer))
     (imap-send-command (list "STATUS \""


@@ -1563,7 +1585,7 @@ or 'unseen.  The IMAP command tag is returned."
                                        (list items))))))))
 
 (defun imap-mailbox-acl-get (&optional mailbox buffer)
                                        (list items))))))))
 
 (defun imap-mailbox-acl-get (&optional mailbox buffer)

-  "Get ACL on mailbox from server in BUFFER."
+  "Get ACL on MAILBOX from server in BUFFER."

   (let ((mailbox (imap-utf7-encode mailbox)))
     (with-current-buffer (or buffer (current-buffer))
       (when (imap-ok-p
   (let ((mailbox (imap-utf7-encode mailbox)))
     (with-current-buffer (or buffer (current-buffer))
       (when (imap-ok-p


@@ -1585,7 +1607,7 @@ or 'unseen.  The IMAP command tag is returned."
                                     rights))))))
 
 (defun imap-mailbox-acl-delete (identifier &optional mailbox buffer)
                                     rights))))))
 
 (defun imap-mailbox-acl-delete (identifier &optional mailbox buffer)

-  "Removes any <identifier,rights> pair for IDENTIFIER in MAILBOX from server in BUFFER."
+  "Remove 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
   (let ((mailbox (imap-utf7-encode mailbox)))
     (with-current-buffer (or buffer (current-buffer))
       (imap-ok-p


@@ -1720,6 +1742,7 @@ is non-nil return these properties."
   `(with-current-buffer (or ,buffer (current-buffer))
      (imap-message-get ,uid 'BODY)))
 
   `(with-current-buffer (or ,buffer (current-buffer))
      (imap-message-get ,uid 'BODY)))
 

+;; FIXME: Should this try to use CHARSET?  -- fx

 (defun imap-search (predicate &optional buffer)
   (with-current-buffer (or buffer (current-buffer))
     (imap-mailbox-put 'search 'dummy)
 (defun imap-search (predicate &optional buffer)
   (with-current-buffer (or buffer (current-buffer))
     (imap-mailbox-put 'search 'dummy)


@@ -1766,9 +1789,38 @@ is non-nil return these properties."
   (let ((number (string-to-number string base)))
     (if (> number most-positive-fixnum)
        (error
   (let ((number (string-to-number string base)))
     (if (> number most-positive-fixnum)
        (error

-        (format "String %s cannot be converted to a lisp integer" number))
+        (format "String %s cannot be converted to a Lisp integer" number))

       number)))
 
       number)))
 

+(defun imap-fetch-safe (uids props &optional receive nouidfetch buffer)
+  "Like `imap-fetch', but DTRT with Exchange 2007 bug.
+However, UIDS here is a cons, where the car is the canonical form
+of the UIDS specification, and the cdr is the one which works with
+Exchange 2007 or, potentially, other buggy servers.
+See `imap-enable-exchange-bug-workaround'."
+  ;; We don't unconditionally use the alternative (valid) form, since
+  ;; this is said to be significantly inefficient.  The first time we
+  ;; get here for a given, we'll try the canonical form.  If we get
+  ;; the known error from the buggy server, set the flag
+  ;; buffer-locally (to account for connections to multiple servers),
+  ;; then re-try with the alternative UIDS spec.
+  (condition-case data
+      (imap-fetch (if imap-enable-exchange-bug-workaround
+                     (cdr uids)
+                   (car uids))
+                 props receive nouidfetch buffer)
+    (error
+     (if (and (not imap-enable-exchange-bug-workaround)
+             (string-match
+              "The specified message set is invalid"
+              (cadr data)))
+        (with-current-buffer (or buffer (current-buffer))
+          (set (make-local-variable
+                'imap-enable-exchange-bug-workaround)
+               t)
+          (imap-fetch (cdr uids) props receive nouidfetch))
+       (signal (car data) (cdr data))))))
+

 (defun imap-message-copyuid-1 (mailbox)
   (if (imap-capability 'UIDPLUS)
       (list (nth 0 (imap-mailbox-get-1 'copyuid mailbox))
 (defun imap-message-copyuid-1 (mailbox)
   (if (imap-capability 'UIDPLUS)
       (list (nth 0 (imap-mailbox-get-1 'copyuid mailbox))


@@ -1778,8 +1830,7 @@ is non-nil return these properties."
          (imap-message-data (make-vector 2 0)))
       (when (imap-mailbox-examine-1 mailbox)
        (prog1
          (imap-message-data (make-vector 2 0)))
       (when (imap-mailbox-examine-1 mailbox)
        (prog1

-           (and (imap-fetch
-                 (if imap-enable-exchange-bug-workaround "*:*" "*") "UID")
+           (and (imap-fetch-safe '("*" . "*:*") "UID")

                 (list (imap-mailbox-get-1 'uidvalidity mailbox)
                       (apply 'max (imap-message-map
                                    (lambda (uid prop) uid) 'UID))))
                 (list (imap-mailbox-get-1 'uidvalidity mailbox)
                       (apply 'max (imap-message-map
                                    (lambda (uid prop) uid) 'UID))))


@@ -1793,11 +1844,11 @@ is non-nil return these properties."
 
 (defun imap-message-copy (articles mailbox
                                   &optional dont-create no-copyuid buffer)
 
 (defun imap-message-copy (articles mailbox
                                   &optional dont-create no-copyuid buffer)

-  "Copy ARTICLES (a string message set) to MAILBOX on server in
-BUFFER, creating mailbox if it doesn't exist.  If dont-create is
-non-nil, it will not create a mailbox.  On success, return a list with
+  "Copy ARTICLES to MAILBOX on server in BUFFER.
+ARTICLES is a string message set.  Create mailbox if it doesn't exist,
+unless DONT-CREATE is non-nil.  On success, return a list with

 the UIDVALIDITY of the mailbox the article(s) was copied to as the
 the UIDVALIDITY of the mailbox the article(s) was copied to as the

-first element, rest of list contain the saved articles' UIDs."
+first element.  The rest of list contains the saved articles' UIDs."

   (when articles
     (with-current-buffer (or buffer (current-buffer))
       (let ((mailbox (imap-utf7-encode mailbox)))
   (when articles
     (with-current-buffer (or buffer (current-buffer))
       (let ((mailbox (imap-utf7-encode mailbox)))


@@ -1815,6 +1866,8 @@ first element, rest of list contain the saved articles' UIDs."
            (or no-copyuid
                (imap-message-copyuid-1 mailbox)))))))
 
            (or no-copyuid
                (imap-message-copyuid-1 mailbox)))))))
 

+;; FIXME: Amalgamate with imap-message-copyuid-1, using an extra arg, since it
+;; shares most of the code?  -- fx

 (defun imap-message-appenduid-1 (mailbox)
   (if (imap-capability 'UIDPLUS)
       (imap-mailbox-get-1 'appenduid mailbox)
 (defun imap-message-appenduid-1 (mailbox)
   (if (imap-capability 'UIDPLUS)
       (imap-mailbox-get-1 'appenduid mailbox)


@@ -1823,8 +1876,7 @@ first element, rest of list contain the saved articles' UIDs."
          (imap-message-data (make-vector 2 0)))
       (when (imap-mailbox-examine-1 mailbox)
        (prog1
          (imap-message-data (make-vector 2 0)))
       (when (imap-mailbox-examine-1 mailbox)
        (prog1

-           (and (imap-fetch
-                 (if imap-enable-exchange-bug-workaround "*:*" "*") "UID")
+           (and (imap-fetch-safe '("*" . "*:*") "UID")

                 (list (imap-mailbox-get-1 'uidvalidity mailbox)
                       (apply 'max (imap-message-map
                                    (lambda (uid prop) uid) 'UID))))
                 (list (imap-mailbox-get-1 'uidvalidity mailbox)
                       (apply 'max (imap-message-map
                                    (lambda (uid prop) uid) 'UID))))


@@ -2201,7 +2253,7 @@ Return nil if no complete line has arrived."
 ;;   resp-cond-bye   = "BYE" SP resp-text
 
 (defun imap-parse-greeting ()
 ;;   resp-cond-bye   = "BYE" SP resp-text
 
 (defun imap-parse-greeting ()

-  "Parse a IMAP greeting."
+  "Parse an IMAP greeting."

   (cond ((looking-at "\\* OK ")
         (setq imap-state 'nonauth))
        ((looking-at "\\* PREAUTH ")
   (cond ((looking-at "\\* OK ")
         (setq imap-state 'nonauth))
        ((looking-at "\\* PREAUTH ")


@@ -2623,7 +2675,7 @@ Return nil if no complete line has arrived."
 
 (defun imap-parse-flag-list ()
   (let (flag-list start)
 
 (defun imap-parse-flag-list ()
   (let (flag-list start)

-    (assert (eq (char-after) ?\() nil "In imap-parse-flag-list")
+    (assert (eq (char-after) ?\() nil "In imap-parse-flag-list 1")

     (while (and (not (eq (char-after) ?\)))
                (setq start (progn
                              (imap-forward)
     (while (and (not (eq (char-after) ?\)))
                (setq start (progn
                              (imap-forward)


@@ -2632,7 +2684,7 @@ Return nil if no complete line has arrived."
                              (point)))
                (> (skip-chars-forward "^ )" (point-at-eol)) 0))
       (push (buffer-substring start (point)) flag-list))
                              (point)))
                (> (skip-chars-forward "^ )" (point-at-eol)) 0))
       (push (buffer-substring start (point)) flag-list))

-    (assert (eq (char-after) ?\)) nil "In imap-parse-flag-list")
+    (assert (eq (char-after) ?\)) nil "In imap-parse-flag-list 2")

     (imap-forward)
     (nreverse flag-list)))
 
     (imap-forward)
     (nreverse flag-list)))
 


@@ -2828,7 +2880,7 @@ Return nil if no complete line has arrived."
          (let (subbody)
            (while (and (eq (char-after) ?\()
                        (setq subbody (imap-parse-body)))
          (let (subbody)
            (while (and (eq (char-after) ?\()
                        (setq subbody (imap-parse-body)))

-            ;; buggy stalker communigate pro 3.0 insert a SPC between
+             ;; buggy stalker communigate pro 3.0 inserts a SPC between

              ;; parts in multiparts
              (when (and (eq (char-after) ?\ )
                         (eq (char-after (1+ (point))) ?\())
              ;; parts in multiparts
              (when (and (eq (char-after) ?\ )
                         (eq (char-after (1+ (point))) ?\())


@@ -2861,22 +2913,28 @@ Return nil if no complete line has arrived."
        (imap-forward)
        (push (imap-parse-nstring) body) ;; body-fld-desc
        (imap-forward)
        (imap-forward)
        (push (imap-parse-nstring) body) ;; body-fld-desc
        (imap-forward)

-       ;; next `or' for Sun SIMS bug, it regard body-fld-enc as a
-       ;; nstring and return nil instead of defaulting back to 7BIT
+       ;; Next `or' for Sun SIMS bug.  It regards body-fld-enc as a
+       ;; nstring and returns nil instead of defaulting back to 7BIT

        ;; as the standard says.
        ;; as the standard says.

+       ;; Exchange (2007, at least) does this as well.

        (push (or (imap-parse-nstring) "7BIT") body) ;; body-fld-enc
        (imap-forward)
        (push (or (imap-parse-nstring) "7BIT") body) ;; body-fld-enc
        (imap-forward)

-       (push (imap-parse-number) body) ;; body-fld-octets
+       ;; Exchange 2007 can return -1, contrary to the spec...
+       (if (eq (char-after) ?-)
+           (progn
+             (skip-chars-forward "-0-9")
+             (push nil body))
+         (push (imap-parse-number) body)) ;; body-fld-octets

 
 

-   ;; ok, we're done parsing the required parts, what comes now is one
-       ;; of three things:
+       ;; Ok, we're done parsing the required parts, what comes now is one of
+       ;; three things:

        ;;
        ;; envelope       (then we're parsing body-type-msg)
        ;; body-fld-lines (then we're parsing body-type-text)
        ;; body-ext-1part (then we're parsing body-type-basic)
        ;;
        ;;
        ;; envelope       (then we're parsing body-type-msg)
        ;; body-fld-lines (then we're parsing body-type-text)
        ;; 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)...
+       ;; 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)...

 
        (when (eq (char-after) ?\ )
          (imap-forward)
 
        (when (eq (char-after) ?\ )
          (imap-forward)