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.

5 files changed, 233 insertions, 57 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index b18c6c78172..28d197d92be 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,9 @@
+2010-09-14  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+        * net/imap.el: Revert back to version
+        cb950ed8ff3e0f40dac437a51b269166f9ffb60d, since some of the changes
+        seem problematic.
+
 2010-09-14  Juanma Barranquero  <lekktu@gmail.com>
 
         * obsolete/old-whitespace.el (whitespace-unload-function):
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 7bb141ccfc0..8e2309f43a8 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,15 @@
+2010-09-14  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+        * 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  <lekktu@gmail.com>
 
         * gnus-registry.el (gnus-registry-install-shortcuts):
diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el
index 8bfbaaa5279..ffa5ff1acdd 100644
--- a/lisp/gnus/gnus-html.el
+++ b/lisp/gnus/gnus-html.el
@@ -288,18 +288,19 @@ fit these criteria."
 (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 @@ This only works if the article in question is HTML."
 ;;;###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
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index 725adcf559c..c4cbce4abaf 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -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)
diff --git a/lisp/net/imap.el b/lisp/net/imap.el
index e286a14a0e4..ed72d7b9ce0 100644
--- a/lisp/net/imap.el
+++ b/lisp/net/imap.el
@@ -448,6 +448,18 @@ The actual value is really the text on the continuation line.")
 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 @@ If BUFFER is nil, the current buffer is assumed."
 
 ;; 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 @@ is non-nil return these properties."
                     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-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)
-  (get (intern-soft (number-to-string uid) imap-message-data)
-       propname))
+(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)
+(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 @@ is non-nil return these properties."
          (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 @@ is non-nil return these properties."
           (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 @@ first element.  The rest of list contains the saved articles' UIDs."
           (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 @@ Return nil if no complete line has arrived."
         (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