From e3e955fed38da9263f3904f15233ccfd0dbbbe43 Mon Sep 17 00:00:00 2001 From: Miles Bader Date: Fri, 9 Jan 2009 03:01:50 +0000 Subject: [PATCH] Merge from gnus--devo--0 Revision: emacs@sv.gnu.org/emacs--devo--0--patch-1513 --- doc/misc/ChangeLog | 15 +++ doc/misc/gnus.texi | 27 +++-- lisp/ChangeLog | 44 ++++++++ lisp/calendar/time-date.el | 7 ++ lisp/gnus/ChangeLog | 107 +++++++++++++++++++- lisp/gnus/ChangeLog.2 | 39 +++----- lisp/gnus/gnus-msg.el | 5 + lisp/gnus/gnus-start.el | 2 +- lisp/gnus/gnus-sum.el | 17 ++-- lisp/gnus/legacy-gnus-agent.el | 2 +- lisp/gnus/message.el | 40 +++++--- lisp/gnus/mm-url.el | 11 +- lisp/gnus/mm-util.el | 90 ++++++++++++++++- lisp/gnus/mml1991.el | 2 +- lisp/gnus/nnheader.el | 9 ++ lisp/gnus/nnimap.el | 21 ++-- lisp/gnus/pop3.el | 49 ++++----- lisp/gnus/sieve-manage.el | 5 +- lisp/gnus/spam-report.el | 44 ++++++-- lisp/net/dns.el | 41 +++++--- lisp/net/imap.el | 178 ++++++++++++++++++++++----------- 21 files changed, 563 insertions(+), 192 deletions(-) diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog index 6e99fd5789..3218a788be 100644 --- a/doc/misc/ChangeLog +++ b/doc/misc/ChangeLog @@ -1,3 +1,18 @@ +2009-01-09 Katsumi Yamaoka + + * gnus.texi (Group Parameters): Add note for local variables. + +2009-01-09 Reiner Steib + + * gnus.texi (Converting Kill Files): Fix URL. Include + gnus-kill-to-score.el in contrib directory. + +2009-01-09 Reiner Steib + + * gnus.texi (Startup Variables): Fix gnus-before-startup-hook. + Reported by Leo . (Bug#1660) + (Paging the Article): Add index entry. + 2009-01-03 Stephen Leake * ada-mode.texi (Examples): Delete redundant text. diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 6db07ee85c..6227831cf1 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -9,8 +9,8 @@ @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 @@ -1623,7 +1623,7 @@ times you start Gnus. @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 @@ -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. -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 @@ -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 -@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 @@ -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. +@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 @@ -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 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 diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 7ed2af86b1..24c7c6f721 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,47 @@ +2009-01-09 Dave Love + + * calendar/time-date.el: Require cl for `declare'. + +2009-01-09 Reiner Steib + + * calendar/time-date.el (format-seconds): Explain `assoc-string'. + Suggested by Dave Love. + +2009-01-09 Dave Love + + * 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 + + * net/dns.el (dns-set-servers): Check "Address". Fix typo. + +2009-01-09 Reiner Steib + + * 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 + + * net/imap.el (imap-enable-exchange-bug-workaround): Explain + auto-detection in the doc string. + 2009-01-09 Juanma Barranquero * 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 d33b99f913..3478f9646e 100644 --- a/lisp/calendar/time-date.el +++ b/lisp/calendar/time-date.el @@ -39,6 +39,9 @@ ;;; 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. @@ -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 "%") + ;; `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) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 9e964d4203..f3404816ad 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,8 +1,39 @@ +2009-01-08 Reiner Steib + + * message.el (message-fix-before-sending): Amend comment. + +2009-01-07 David Engster + + * 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 + + * gnus-sum.el (gnus-summary-set-local-parameters): Always evaluate + parameter's operands. + +2009-01-06 David Engster + + * 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 * gnus-art.el (gnus-treat-display-face): Fix docstring link to point to `(gnus)Face', not `(gnus)X-Face'. +2009-01-05 Katsumi Yamaoka + + * mm-util.el (mm-ucs-to-char): New function. + + * mm-url.el (mm-url-decode-entities): Use it. + +2009-01-03 Reiner Steib + + * message.el (message-fix-before-sending): Add `eight-bit' to + illegible-text check. + 2009-01-03 Michael Olson * 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. +2009-01-01 Dave Love + + * 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 + + * 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 + + * mm-util.el (mm-line-number-at-pos): New function. + + * spam-report.el (spam-report-process-queue): Use it. + +2008-12-24 David Engster + + * 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 + + * 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 + + * 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 + + * mm-util.el: Add comments to the mm- emulating functions. + +2008-12-21 Reiner Steib + + * gnus-start.el (gnus-before-startup-hook): Fix doc string. Reported + by Stephen Berman . + 2008-12-18 Katsumi Yamaoka * mm-util.el (mm-substring-no-properties): New function. @@ -23,6 +116,11 @@ 2008-12-18 Reiner Steib * mml.el (mml-attach-file): Strip text properties from file name. + (Bug#1574) + +2008-12-16 Glenn Morris + + * mm-util.el (mm-charset-override-alist): Declare for compiler. 2008-12-16 Glenn Morris @@ -13136,11 +13234,10 @@ 2004-01-04 Mario Lang - * 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 diff --git a/lisp/gnus/ChangeLog.2 b/lisp/gnus/ChangeLog.2 index 2c25799892..140cbd7c69 100644 --- 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). -2002-05-20 Jason Baker - Trivial patch. +2002-05-20 Jason Baker (tiny change) * 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. -2002-03-31 Andrew Cohen - Trivial patch. +2002-03-31 Andrew Cohen (tiny change) * dns.el: open-network-stream under XEmacs does udp. @@ -10451,8 +10449,7 @@ * nnweb.el (nnweb-type-definition): Clean up. -2002-01-21 Alastair Burt - Trivial patch. +2002-01-21 Alastair Burt (tiny change) * 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. -2002-01-05 Keiichi Suzuki - Trivial patch. +2002-01-05 Keiichi Suzuki (tiny change) * 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. -2001-09-16 Katsuhiro Hermit Endo - Trivial patch. +2001-09-16 Katsuhiro Hermit Endo (tiny change) * gnus-spec.el (gnus-parse-complex-format): Don't fold search case. (Thanks to Daiki Ueno .) @@ -14156,8 +14151,7 @@ * message.el (message-indent-citation): Quote only lines starting with ">" using `message-yank-cited-prefix'. -2001-08-05 Nuutti Kotivuori - Trivial patch. +2001-08-05 Nuutti Kotivuori (tiny change) * 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. -2001-06-30 YAGI Tatsuya - Trivial patch. +2001-06-30 YAGI Tatsuya (tiny change) * 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. -2001-03-10 Matthias Wiehl - Trivial patch. +2001-03-10 Matthias Wiehl (tiny change) * gnus.el (gnus-summary-line-format): Typo. @@ -16021,8 +16013,7 @@ * message.el (message-cancel-news): Allow to shoot foot. (message-supersede): Ditto. -2001-02-08 Tommi Vainikainen - Trivial patch. +2001-02-08 Tommi Vainikainen (tiny change) * 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. -2001-01-04 11:06:14 Gregory Chernov - Trivial patch. +2001-01-04 11:06:14 Gregory Chernov (tiny change) * 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. -2000-12-28 19:21:57 Inge Frick - Trivial patch. +2000-12-28 19:21:57 Inge Frick (tiny change) * gnus-sum.el (gnus-no-mark): New variable. @@ -16665,8 +16654,7 @@ * qp.el (quoted-printable-encode-region): Don't check multibyte in XEmacs. -2000-12-25 Lloyd Zusman - Trivial patch. +2000-12-25 Lloyd Zusman (tiny change) * mml.el (mml-read-tag): Save tag location. @@ -18370,8 +18358,7 @@ (nnultimate-table-regexp): New variable. (nnultimate-forum-table-p): Use it. -2000-10-30 Ed L Cashin - Trivial patch. +2000-10-30 Ed L Cashin (tiny change) * gnus-sum.el (gnus-summary-expire-articles): Save point. diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index a3698a1352..62f23cb169 100644 --- 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))) + (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? diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index bc6b7e0c50..33e7d3894b 100644 --- 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 - "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) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index a04f4aa5bb..ed636e0322 100644 --- 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." - (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) @@ -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)) - (ignore-errors ; So we set it. + (ignore-errors (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 diff --git a/lisp/gnus/legacy-gnus-agent.el b/lisp/gnus/legacy-gnus-agent.el index 28dfa25ee1..3680bc5e41 100644 --- 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)) - (throw 'found (cadar days))) + (throw 'found (cadr (car days)))) (setq days (cdr days))) nil))) (when day diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 93f7b70383..ee71162808 100644 --- 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))) +;; 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." @@ -4140,6 +4142,8 @@ conformance." (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)))) @@ -4166,10 +4170,13 @@ conformance." (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 + ;; Emacs 23, Bug#1770: + eight-bit 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 - (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)) diff --git a/lisp/gnus/mm-url.el b/lisp/gnus/mm-url.el index b41c40f8f5..46ca1741fb 100644 --- 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 -;; 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 @@ -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) ?\#) - (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)) ?#)))) diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el index 4a48083280..3d8538d4a6 100644 --- a/lisp/gnus/mm-util.el +++ b/lisp/gnus/mm-util.el @@ -40,6 +40,10 @@ (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) @@ -47,11 +51,19 @@ (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) + ;; `coding-system-equal' is an Emacs function, not available in XEmacs. (coding-system-equal . equal) + ;; `annotationp' is an XEmacs function, not available in Emacs. (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) + ;; `read-charset' is an Emacs function, not available in XEmacs. (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)))) + ;; `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 @@ -75,11 +88,14 @@ (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))) + ;; `string-as-unibyte' is an Emacs function, not available in XEmacs. (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: @@ -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' is an Emacs function, not available in XEmacs. (string-as-multibyte . identity) + ;; `multibyte-string-p' is an Emacs function, not available in XEmacs. (multibyte-string-p . ignore) + ;; `insert-byte' is available only in Emacs 23.1 or greater. (insert-byte . insert-char) + ;; `multibyte-char-to-unibyte' is an Emacs function, not available + ;; in XEmacs. (multibyte-char-to-unibyte . identity) + ;; `set-buffer-multibyte' is an Emacs function, not available in XEmacs. (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." @@ -119,6 +142,7 @@ (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. @@ -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) - 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) - ;; Don't modify string if CODING-SYSTEM is nil. (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))) +;; `string-to-multibyte' is available only in Emacs 22.1 or greater. (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 ""))))) +;; `char-or-char-int-p' is an XEmacs function, not available in Emacs. (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)))) +;; `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 diff --git a/lisp/gnus/mml1991.el b/lisp/gnus/mml1991.el index 60d6e3cb4f..4536f4183d 100644 --- 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. -;; Author: Sascha Ldecke , +;; Author: Sascha Lüdecke , ;; Simon Josefsson (Mailcrypt interface, Gnus glue) ;; Keywords PGP diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el index a40624cba2..572f80bea9 100644 --- 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 + ;; 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) + ;; 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.") @@ -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) +;; When changing this function, consider changing `pop3-accept-process-output' +;; as well. (defun nnheader-accept-process-output (process) (accept-process-output process diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index de5a67eab7..87edde6a77 100644 --- 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. -;; Author: Simon Josefsson +;; Author: Simon Josefsson ;; Jim Radford ;; 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 + ;; 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" @@ -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 - "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 -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) @@ -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-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))) diff --git a/lisp/gnus/pop3.el b/lisp/gnus/pop3.el index a99cff7443..2ca09d8827 100644 --- 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) -;; 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.") - -;; 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." @@ -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)) - (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' diff --git a/lisp/gnus/sieve-manage.el b/lisp/gnus/sieve-manage.el index 793c4f9a91..c40c6fc2cd 100644 --- 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)))) -(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))) -(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) diff --git a/lisp/gnus/spam-report.el b/lisp/gnus/spam-report.el index 94c7622b20..816f973ccb 100644 --- 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)) +(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)) - (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)) - (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. @@ -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)) - ;; 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) @@ -278,7 +298,13 @@ symbol `ask', query before flushing the queue file." (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) diff --git a/lisp/net/dns.el b/lisp/net/dns.el index e4dc9aa08a..e0aba3c32e 100644 --- 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 - "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: @@ -298,14 +298,24 @@ If TCP-P, the first two bytes of the package with be the length field." (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) @@ -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)) -(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 ((result (query-dns name type fullp reversep))) + (let ((result (dns-query name type fullp reversep))) (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 - (dns-parse-resolv-conf)) + (dns-set-servers)) (when reversep (setq name (concat diff --git a/lisp/net/imap.el b/lisp/net/imap.el index dc295d5b36..6f2b2d11f9 100644 --- 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. -;; Author: Simon Josefsson +;; Author: Simon Josefsson ;; Keywords: mail ;; This file is part of GNU Emacs. @@ -23,7 +23,7 @@ ;;; 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 @@ -72,25 +72,25 @@ ;; 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 -;; 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. ;; -;; 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 -;; `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. ;; @@ -121,6 +121,7 @@ ;; 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. @@ -131,7 +132,7 @@ ;; - 19991218 added starttls/digest-md5 patch, ;; by Daiki Ueno ;; NB! you need SLIM for starttls.el and digest-md5.el -;; - 19991023 commited to pgnus +;; - 19991023 committed to pgnus ;; ;;; 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 -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. -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 -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) @@ -230,20 +231,28 @@ encoded mailboxes which doesn't translate into ISO-8859-1." :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 -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 - "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 -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) @@ -268,7 +277,7 @@ Shorter values mean quicker response, but is more CPU intensive." :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) @@ -393,7 +402,7 @@ and `examine'.") "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.") @@ -402,7 +411,7 @@ and `examine'.") "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.") @@ -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 *. -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.") ;; 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 @@ -650,7 +665,7 @@ sure of changing the value of `foo'." 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) @@ -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)) + ;; 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) @@ -1081,7 +1103,7 @@ Returns t if login was successful, nil otherwise." imap-process)))) (defun imap-open (server &optional port stream auth buffer) - "Open a IMAP connection to host SERVER at PORT returning a buffer. + "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 @@ -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. -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))) @@ -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. -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 @@ -1510,7 +1532,7 @@ passed to list command." (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 \"" @@ -1518,7 +1540,7 @@ Returns non-nil if successful." "\""))))) (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 " @@ -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 -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 @@ -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 -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 \"" @@ -1563,7 +1585,7 @@ or 'unseen. The IMAP command tag is returned." (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 @@ -1585,7 +1607,7 @@ or 'unseen. The IMAP command tag is returned." rights)))))) (defun imap-mailbox-acl-delete (identifier &optional mailbox buffer) - "Removes any pair for IDENTIFIER in MAILBOX from server in BUFFER." + "Remove any 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 @@ -1720,6 +1742,7 @@ is non-nil return these properties." `(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) @@ -1766,9 +1789,38 @@ is non-nil return these properties." (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))) +(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)) @@ -1778,8 +1830,7 @@ is non-nil return these properties." (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)))) @@ -1793,11 +1844,11 @@ is non-nil return these properties." (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 -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))) @@ -1815,6 +1866,8 @@ first element, rest of list contain the saved articles' UIDs." (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) @@ -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 - (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)))) @@ -2201,7 +2253,7 @@ Return nil if no complete line has arrived." ;; 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 ") @@ -2623,7 +2675,7 @@ Return nil if no complete line has arrived." (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) @@ -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)) - (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))) @@ -2828,7 +2880,7 @@ Return nil if no complete line has arrived." (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))) ?\()) @@ -2861,22 +2913,28 @@ Return nil if no complete line has arrived." (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. + ;; Exchange (2007, at least) does this as well. (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) ;; - ;; 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) -- 2.20.1