From 3ab423f0f6c35efedcc008fa623ab238b599e893 Mon Sep 17 00:00:00 2001
From: Vitaly Mayatskikh <vitaly@gravicappa.englab.brq.redhat.com>
Date: Fri, 24 Oct 2008 15:44:18 +0200
Subject: [PATCH] Added support for RFC4731

---
 elmo/elmo-imap4.el | 107 ++++++++++++++++++++++++++++++++++++++++++++++++++---
 1 file changed, 101 insertions(+), 6 deletions(-)

diff --git a/elmo/elmo-imap4.el b/elmo/elmo-imap4.el
index 94e0fd6..aa11971 100644
--- a/elmo/elmo-imap4.el
+++ b/elmo/elmo-imap4.el
@@ -746,17 +746,109 @@ Returns response value if selecting folder succeed. "
   ;; Not used.
   )
 
+;; sequence-compress and -uncompress were taken from Gnus
+(defun sequence-compress (numbers &optional always-list)
+  "Convert sorted list of numbers to a list of ranges or a single range.
+If ALWAYS-LIST is non-nil, this function will always release a list of
+ranges."
+  (let* ((first (car numbers))
+	 (last (car numbers))
+	 result)
+    (if (null numbers)
+	nil
+      (if (not (listp (cdr numbers)))
+	  numbers
+	(while numbers
+	  (cond ((= last (car numbers)) nil) ;Omit duplicated number
+		((= (1+ last) (car numbers)) ;Still in sequence
+		 (setq last (car numbers)))
+		(t                      ;End of one sequence
+		 (setq result
+		       (cons (if (= first last) first
+			       (cons first last))
+			     result))
+		 (setq first (car numbers))
+		 (setq last  (car numbers))))
+	  (setq numbers (cdr numbers)))
+	(if (and (not always-list) (null result))
+	    (if (= first last) (list first) (cons first last))
+	  (nreverse (cons (if (= first last) first (cons first last))
+			  result)))))))
+
+(defun sequence-uncompress (ranges)
+  "Expand a list of ranges into a list of numbers.
+RANGES is either a single range on the form `(num . num)' or a list of
+these ranges."
+  (let (first last result)
+    (cond
+     ((null ranges)
+      nil)
+     ((not (listp (cdr ranges)))
+      (setq first (car ranges))
+      (setq last (cdr ranges))
+      (while (<= first last)
+	(setq result (cons first result))
+	(setq first (1+ first)))
+      (nreverse result))
+     (t
+      (while ranges
+	(if (atom (car ranges))
+	    (when (numberp (car ranges))
+	      (setq result (cons (car ranges) result)))
+	  (setq first (caar ranges))
+	  (setq last  (cdar ranges))
+	  (while (<= first last)
+	    (setq result (cons first result))
+	    (setq first (1+ first))))
+	(setq ranges (cdr ranges)))
+      (nreverse result)))))
+
+(defun elmo-imap4-elist (folder query tags)
+  (let ((session (elmo-imap4-get-session folder)))
+    (elmo-imap4-session-select-mailbox
+     session
+     (elmo-imap4-folder-mailbox-internal folder))
+    (let ((answer (elmo-imap4-response-value
+		   (elmo-imap4-send-command-wait
+		    session query) 'esearch))
+	  tag result)
+      (while answer
+	(setq tag (intern (downcase (car answer))))
+	(cond ((eq tag 'uid)
+	       nil)
+	      ((memq tag tags)
+	       (setq result
+		     (append result
+			     (if (eq tag 'all)
+				 (sort
+				  (sequence-uncompress
+				   (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 elmo-imap4-list (folder flag)
   (let ((session (elmo-imap4-get-session folder)))
     (elmo-imap4-session-select-mailbox
      session
      (elmo-imap4-folder-mailbox-internal folder))
-    (elmo-imap4-response-value
-     (elmo-imap4-send-command-wait
-      session
-      (format (if elmo-imap4-use-uid "uid search %s"
-		"search %s") flag))
-     'search)))
+    (if (elmo-imap4-session-capable-p session 'esearch)
+	(elmo-imap4-elist folder
+			  (concat (if elmo-imap4-use-uid "uid " "")
+				  "search return (all) " flag) '(all))
+      (elmo-imap4-response-value
+       (elmo-imap4-send-command-wait
+	session
+	(format (if elmo-imap4-use-uid "uid search %s"
+		  "search %s") flag))
+       'search))))
 
 (defun elmo-imap4-session-flag-available-p (session flag)
   (case flag
@@ -1410,6 +1502,9 @@ Return nil if no complete line has arrived."
 			(read (concat "("
 				      (buffer-substring (point) (point-max))
 				      ")"))))
+	   (ESEARCH     (list
+			 'esearch
+			 (cddr (split-string (buffer-substring (point) (point-max)) " " "\,"))))
 	   (STATUS     (elmo-imap4-parse-status))
 	   ;; Added
 	   (NAMESPACE  (elmo-imap4-parse-namespace))
-- 
2.11.4.GIT