[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] /srv/bzr/emacs/trunk r101440: Merge changes made in Gnus t
From: |
Katsumi Yamaoka |
Subject: |
[Emacs-diffs] /srv/bzr/emacs/trunk r101440: Merge changes made in Gnus trunk. |
Date: |
Tue, 14 Sep 2010 23:15:56 +0000 |
User-agent: |
Bazaar (2.0.3) |
------------------------------------------------------------
revno: 101440 [merge]
author: Lars Magne Ingebrigtsen <address@hidden>
committer: Katsumi Yamaoka <address@hidden>
branch nick: trunk
timestamp: Tue 2010-09-14 23:15:56 +0000
message:
Merge changes made in Gnus trunk.
imap.el: Revert back to version cb950ed8ff3e0f40dac437a51b269166f9ffb60d,
since some of the changes seem problematic.
Fix up the w3m/curl dependencies.
mm-decode.el (mm-text-html-renderer): Don't have gnus-article-html depend on
curl, which isn't essential.
gnus-html.el (gnus-html-schedule-image-fetching, gnus-html-prefetch-images):
Check for curl before using it.
modified:
lisp/ChangeLog
lisp/gnus/ChangeLog
lisp/gnus/gnus-html.el
lisp/gnus/mm-decode.el
lisp/net/imap.el
=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog 2010-09-14 14:59:42 +0000
+++ b/lisp/ChangeLog 2010-09-14 23:14:44 +0000
@@ -1,3 +1,9 @@
+2010-09-14 Lars Magne Ingebrigtsen <address@hidden>
+
+ * net/imap.el: Revert back to version
+ cb950ed8ff3e0f40dac437a51b269166f9ffb60d, since some of the changes
+ seem problematic.
+
2010-09-14 Juanma Barranquero <address@hidden>
* obsolete/old-whitespace.el (whitespace-unload-function):
=== modified file 'lisp/gnus/ChangeLog'
--- a/lisp/gnus/ChangeLog 2010-09-14 14:59:42 +0000
+++ b/lisp/gnus/ChangeLog 2010-09-14 23:14:44 +0000
@@ -1,3 +1,15 @@
+2010-09-14 Lars Magne Ingebrigtsen <address@hidden>
+
+ * gnus-html.el (gnus-html-schedule-image-fetching)
+ (gnus-html-prefetch-images): Check for curl before using it.
+
+ * mm-decode.el (mm-text-html-renderer): Don't have gnus-article-html
+ depend on curl, which isn't essential.
+
+ * imap.el: Revert back to version
+ cb950ed8ff3e0f40dac437a51b269166f9ffb60d, since some of the changes
+ seem problematic.
+
2010-09-14 Juanma Barranquero <address@hidden>
* gnus-registry.el (gnus-registry-install-shortcuts):
=== modified file 'lisp/gnus/gnus-html.el'
--- a/lisp/gnus/gnus-html.el 2010-09-10 00:07:33 +0000
+++ b/lisp/gnus/gnus-html.el 2010-09-14 23:14:44 +0000
@@ -288,18 +288,19 @@
(defun gnus-html-schedule-image-fetching (buffer images)
(gnus-message 8 "gnus-html-schedule-image-fetching: buffer %s, images %s"
buffer images)
- (let* ((url (caar images))
- (process (start-process
- "images" nil "curl"
- "-s" "--create-dirs"
- "--location"
- "--max-time" "60"
- "-o" (gnus-html-image-id url)
- (mm-url-decode-entities-string url))))
- (process-kill-without-query process)
- (set-process-sentinel process 'gnus-html-curl-sentinel)
- (gnus-set-process-plist process (list 'images images
- 'buffer buffer))))
+ (when (executable-find "curl")
+ (let* ((url (caar images))
+ (process (start-process
+ "images" nil "curl"
+ "-s" "--create-dirs"
+ "--location"
+ "--max-time" "60"
+ "-o" (gnus-html-image-id url)
+ (mm-url-decode-entities-string url))))
+ (process-kill-without-query process)
+ (set-process-sentinel process 'gnus-html-curl-sentinel)
+ (gnus-set-process-plist process (list 'images images
+ 'buffer buffer)))))
(defun gnus-html-image-id (url)
(expand-file-name (sha1 url) gnus-html-cache-directory))
@@ -441,7 +442,8 @@
;;;###autoload
(defun gnus-html-prefetch-images (summary)
(let (blocked-images urls)
- (when (buffer-live-p summary)
+ (when (and (buffer-live-p summary)
+ (executable-find "curl"))
(with-current-buffer summary
(setq blocked-images gnus-blocked-images))
(save-match-data
=== modified file 'lisp/gnus/mm-decode.el'
--- a/lisp/gnus/mm-decode.el 2010-09-02 00:55:51 +0000
+++ b/lisp/gnus/mm-decode.el 2010-09-14 23:14:44 +0000
@@ -105,9 +105,7 @@
,disposition ,description ,cache ,id))
(defcustom mm-text-html-renderer
- (cond ((and (executable-find "w3m")
- (executable-find "curl"))
- 'gnus-article-html)
+ (cond ((executable-find "w3m") 'gnus-article-html)
((executable-find "links") 'links)
((executable-find "lynx") 'lynx)
((locate-library "w3") 'w3)
=== modified file 'lisp/net/imap.el'
--- a/lisp/net/imap.el 2010-09-06 00:10:55 +0000
+++ b/lisp/net/imap.el 2010-09-14 23:14:44 +0000
@@ -448,6 +448,18 @@
The function should take two arguments, the first the IMAP tag and the
second the status (OK, NO, BAD etc) of the command.")
+(defvar imap-enable-exchange-bug-workaround nil
+ "Send FETCH UID commands as *:* instead of *.
+
+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:
@@ -1303,38 +1315,40 @@
;; Mailbox functions:
-(defun imap-mailbox-put (propname value &optional mailbox)
- (if imap-mailbox-data
- (put (intern (or mailbox imap-current-mailbox) imap-mailbox-data)
- propname value)
- (error "Imap-mailbox-data is nil, prop %s value %s mailbox %s buffer %s"
- propname value mailbox (current-buffer)))
- t)
+(defun imap-mailbox-put (propname value &optional mailbox buffer)
+ (with-current-buffer (or buffer (current-buffer))
+ (if imap-mailbox-data
+ (put (intern (or mailbox imap-current-mailbox) imap-mailbox-data)
+ propname value)
+ (error "Imap-mailbox-data is nil, prop %s value %s mailbox %s buffer %s"
+ propname value mailbox (current-buffer)))
+ t))
(defsubst imap-mailbox-get-1 (propname &optional mailbox)
(get (intern-soft (or mailbox imap-current-mailbox) imap-mailbox-data)
propname))
(defun imap-mailbox-get (propname &optional mailbox buffer)
+ (let ((mailbox (imap-utf7-encode mailbox)))
+ (with-current-buffer (or buffer (current-buffer))
+ (imap-mailbox-get-1 propname (or mailbox imap-current-mailbox)))))
+
+(defun imap-mailbox-map-1 (func &optional mailbox-decoder buffer)
(with-current-buffer (or buffer (current-buffer))
- (imap-mailbox-get-1 propname (or (imap-utf7-encode mailbox)
- imap-current-mailbox))))
-
-(defun imap-mailbox-map-1 (func &optional mailbox-decoder)
- (let (result)
- (mapatoms
- (lambda (s)
- (push (funcall func (if mailbox-decoder
- (funcall mailbox-decoder (symbol-name s))
- (symbol-name s))) result))
- imap-mailbox-data)
- result))
-
-(defun imap-mailbox-map (func)
+ (let (result)
+ (mapatoms
+ (lambda (s)
+ (push (funcall func (if mailbox-decoder
+ (funcall mailbox-decoder (symbol-name s))
+ (symbol-name s))) result))
+ imap-mailbox-data)
+ result)))
+
+(defun imap-mailbox-map (func &optional buffer)
"Map a function across each mailbox in `imap-mailbox-data', returning a list.
Function should take a mailbox name (a string) as
the only argument."
- (imap-mailbox-map-1 func 'imap-utf7-decode))
+ (imap-mailbox-map-1 func 'imap-utf7-decode buffer))
(defun imap-current-mailbox (&optional buffer)
(with-current-buffer (or buffer (current-buffer))
@@ -1648,26 +1662,29 @@
uids)
(imap-message-get uids receive))))))
-(defun imap-message-put (uid propname value)
- (if imap-message-data
- (put (intern (number-to-string uid) imap-message-data)
- propname value)
- (error "Imap-message-data is nil, uid %s prop %s value %s buffer %s"
- uid propname value (current-buffer)))
- t)
-
-(defun imap-message-get (uid propname)
- (get (intern-soft (number-to-string uid) imap-message-data)
- propname))
-
-(defun imap-message-map (func propname)
+(defun imap-message-put (uid propname value &optional buffer)
+ (with-current-buffer (or buffer (current-buffer))
+ (if imap-message-data
+ (put (intern (number-to-string uid) imap-message-data)
+ propname value)
+ (error "Imap-message-data is nil, uid %s prop %s value %s buffer %s"
+ uid propname value (current-buffer)))
+ t))
+
+(defun imap-message-get (uid propname &optional buffer)
+ (with-current-buffer (or buffer (current-buffer))
+ (get (intern-soft (number-to-string uid) imap-message-data)
+ propname)))
+
+(defun imap-message-map (func propname &optional buffer)
"Map a function across each message in `imap-message-data', returning a
list."
- (let (result)
- (mapatoms
- (lambda (s)
- (push (funcall func (get s 'UID) (get s propname)) result))
- imap-message-data)
- result))
+ (with-current-buffer (or buffer (current-buffer))
+ (let (result)
+ (mapatoms
+ (lambda (s)
+ (push (funcall func (get s 'UID) (get s propname)) result))
+ imap-message-data)
+ result)))
(defmacro imap-message-envelope-date (uid &optional buffer)
`(with-current-buffer (or ,buffer (current-buffer))
@@ -1763,6 +1780,48 @@
(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'."
+ ;; 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. We don't
+ ;; unconditionally use the alternative form, since the
+ ;; currently-used alternatives are seriously inefficient with some
+ ;; servers (although they are valid).
+ ;;
+ ;; FIXME: Maybe it would be cleaner to have a flag to not signal
+ ;; the error (which otherwise gives a message), and test
+ ;; `imap-failed-tags'. Also, Other IMAP clients use other forms of
+ ;; request which work with Exchange, e.g. Claws does "UID FETCH 1:*
+ ;; (UID)" rather than "FETCH UID 1,*". Is there a good reason not
+ ;; to do the same?
+ (condition-case data
+ ;; Binding `debug-on-error' allows us to get the error from
+ ;; `imap-parse-response' -- it's normally caught by Emacs around
+ ;; execution of a process filter.
+ (let ((debug-on-error t))
+ (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)
+ ;; This is the Exchange 2007 response. It may be more
+ ;; robust just to check for a BAD response to the
+ ;; attempted fetch.
+ (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))
@@ -1772,7 +1831,7 @@
(imap-message-data (make-vector 2 0)))
(when (imap-mailbox-examine-1 mailbox)
(prog1
- (and (imap-fetch "*:*" "UID")
+ (and (imap-fetch-safe '("*" . "*:*") "UID")
(list (imap-mailbox-get-1 'uidvalidity mailbox)
(apply 'max (imap-message-map
(lambda (uid prop) uid) 'UID))))
@@ -1818,7 +1877,7 @@
(imap-message-data (make-vector 2 0)))
(when (imap-mailbox-examine-1 mailbox)
(prog1
- (and (imap-fetch "*:*" "UID")
+ (and (imap-fetch-safe '("*" . "*:*") "UID")
(list (imap-mailbox-get-1 'uidvalidity mailbox)
(apply 'max (imap-message-map
(lambda (uid prop) uid) 'UID))))
@@ -2892,6 +2951,105 @@
(imap-forward)
(nreverse body)))))
+(when imap-debug ; (untrace-all)
+ (require 'trace)
+ (buffer-disable-undo (get-buffer-create imap-debug-buffer))
+ (mapc (lambda (f) (trace-function-background f imap-debug-buffer))
+ '(
+ imap-utf7-encode
+ imap-utf7-decode
+ imap-error-text
+ imap-kerberos4s-p
+ imap-kerberos4-open
+ imap-ssl-p
+ imap-ssl-open
+ imap-network-p
+ imap-network-open
+ imap-interactive-login
+ imap-kerberos4a-p
+ imap-kerberos4-auth
+ imap-cram-md5-p
+ imap-cram-md5-auth
+ imap-login-p
+ imap-login-auth
+ imap-anonymous-p
+ imap-anonymous-auth
+ imap-open-1
+ imap-open
+ imap-opened
+ imap-ping-server
+ imap-authenticate
+ imap-close
+ imap-capability
+ imap-namespace
+ imap-send-command-wait
+ imap-mailbox-put
+ imap-mailbox-get
+ imap-mailbox-map-1
+ imap-mailbox-map
+ imap-current-mailbox
+ imap-current-mailbox-p-1
+ imap-current-mailbox-p
+ imap-mailbox-select-1
+ imap-mailbox-select
+ imap-mailbox-examine-1
+ imap-mailbox-examine
+ imap-mailbox-unselect
+ imap-mailbox-expunge
+ imap-mailbox-close
+ imap-mailbox-create-1
+ imap-mailbox-create
+ imap-mailbox-delete
+ imap-mailbox-rename
+ imap-mailbox-lsub
+ imap-mailbox-list
+ imap-mailbox-subscribe
+ imap-mailbox-unsubscribe
+ imap-mailbox-status
+ imap-mailbox-acl-get
+ imap-mailbox-acl-set
+ imap-mailbox-acl-delete
+ imap-current-message
+ imap-list-to-message-set
+ imap-fetch-asynch
+ imap-fetch
+ imap-fetch-safe
+ imap-message-put
+ imap-message-get
+ imap-message-map
+ imap-search
+ imap-message-flag-permanent-p
+ imap-message-flags-set
+ imap-message-flags-del
+ imap-message-flags-add
+ imap-message-copyuid-1
+ imap-message-copyuid
+ imap-message-copy
+ imap-message-appenduid-1
+ imap-message-appenduid
+ imap-message-append
+ imap-body-lines
+ imap-envelope-from
+ imap-send-command-1
+ imap-send-command
+ imap-wait-for-tag
+ imap-sentinel
+ imap-find-next-line
+ imap-arrival-filter
+ imap-parse-greeting
+ imap-parse-response
+ imap-parse-resp-text
+ imap-parse-resp-text-code
+ imap-parse-data-list
+ imap-parse-fetch
+ imap-parse-status
+ imap-parse-acl
+ imap-parse-flag-list
+ imap-parse-envelope
+ imap-parse-body-extension
+ imap-parse-body
+ )))
+
(provide 'imap)
;;; imap.el ends here
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] /srv/bzr/emacs/trunk r101440: Merge changes made in Gnus trunk.,
Katsumi Yamaoka <=