+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.
@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
@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
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
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
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
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
+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)
;;; 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.
(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)
+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-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
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 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>
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>
* 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.
* 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.
* 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.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.
* 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>.)
* 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.
* 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'.
* 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.
* 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.
* 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.
(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.
* 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.
(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.
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?
: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)
(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)
(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
(when (eq 0 (string-match
(caar days)
group))
- (throw 'found (cadar days)))
+ (throw 'found (cadr (car days))))
(setq days (cdr days)))
nil)))
(when day
(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."
(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))))
(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)))))
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))
;;; 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>
(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))
?#))))
(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)
(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."
(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
(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:
;; (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."
(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.
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
(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)
(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
((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
;; 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
;; 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.")
(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
;; 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
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"
(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)
(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)))
(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."
(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 (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)
"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.
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)
(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)
"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:
(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)
(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
;; 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.
;;; 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
;; 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.
;;
;; 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.
;; - 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:
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)
: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)
: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)
"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.")
"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-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)
- "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
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)
(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)
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
(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)))
(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
(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 \""
"\"")))))
(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 "
(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
(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 \""
(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
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
`(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)
(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))
(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))))
(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)))
(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)
(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))))
;; 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 ")
(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)
(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)))
(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))) ?\())
(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)
projects / emacs.git / commitdiff