diff -puw lisp/net/imap.el.orig lisp/net/imap.el --- lisp/net/imap.el.orig 2008-05-06 09:31:46.000000000 +0200 +++ lisp/net/imap.el 2008-08-14 10:40:31.000000000 +0200 @@ -1721,6 +1721,8 @@ is non-nil return these properties." (imap-message-get ,uid 'BODY))) (defun imap-search (predicate &optional buffer) + (if (imap-capability 'ESEARCH) + (car (imap-esearch (concat "UID SEARCH RETURN (ALL) " predicate) '(ALL))) (with-current-buffer (or buffer (current-buffer)) (imap-mailbox-put 'search 'dummy) (when (imap-ok-p (imap-send-command-wait (concat "UID SEARCH " predicate))) @@ -1728,7 +1730,39 @@ is non-nil return these properties." (progn (message "Missing SEARCH response to a SEARCH command (server not RFC compliant)...") nil) - (imap-mailbox-get-1 'search imap-current-mailbox))))) + (imap-mailbox-get-1 'search imap-current-mailbox)))))) + +(defun imap-esearch (query tags &optional buffer) + (with-current-buffer (or buffer (current-buffer)) + (imap-mailbox-put 'esearch 'dummy) + (when (imap-ok-p (imap-send-command-wait query)) + (if (eq (imap-mailbox-get-1 'esearch imap-current-mailbox) 'dummy) + (progn + (message "Missing ESEARCH response to a SEARCH command (server not RFC compliant)...") + nil) + (let ((answer (imap-mailbox-get-1 'esearch imap-current-mailbox)) + tag result) + (while answer + (setq tag (intern (upcase (car answer)))) + (cond ((eq tag 'UID) + nil) + ((memq tag tags) + (setq result + (append result + (list + (if (eq tag 'ALL) + (gnus-uncompress-range + (mapcar #'(lambda (x) + (let ((y (split-string x ":"))) + (if (null (cdr y)) + (string-to-number (car y)) + (cons (string-to-number (car y)) + (string-to-number (cadr y)))))) + (split-string (cadr answer) "\,"))) + (string-to-number (cadr answer))))))) + (t nil)) + (setq answer (cdr answer))) + result))))) (defun imap-message-flag-permanent-p (flag &optional mailbox buffer) "Return t if FLAG can be permanently (between IMAP sessions) saved on articles, in MAILBOX on server in BUFFER." @@ -2265,6 +2299,9 @@ Return nil if no complete line has arriv (SEARCH (imap-mailbox-put 'search (read (concat "(" (buffer-substring (point) (point-max)) ")")))) + (ESEARCH (imap-mailbox-put + 'esearch + (cddr (split-string (buffer-substring (point) (point-max)) " " "\,")))) (STATUS (imap-parse-status)) (CAPABILITY (setq imap-capability (read (concat "(" (upcase (buffer-substring