From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 16 May 2000 03:34:42 +0000 (+0000)
Subject: Implement IMAP SEARCH-FOLDER operation.
X-Git-Tag: 20090517-FFI~3865
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=d628827fb727d9561a774dced5cccb59e3bc8618;p=mit-scheme.git

Implement IMAP SEARCH-FOLDER operation.
---

diff --git a/v7/src/imail/imail-imap.scm b/v7/src/imail/imail-imap.scm
index 3d5c78ff0..62d3ef8c9 100644
--- a/v7/src/imail/imail-imap.scm
+++ b/v7/src/imail/imail-imap.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-imap.scm,v 1.40 2000/05/16 03:13:29 cph Exp $
+;;; $Id: imail-imap.scm,v 1.41 2000/05/16 03:33:38 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -602,7 +602,15 @@
 
 (define-method search-folder ((folder <imap-folder>) criteria)
   (guarantee-imap-folder-open folder)
-  ???)
+  (map (lambda (index) (get-message folder index))
+       (imap:response:search-indices
+	(let ((connection (imap-folder-connection folder)))
+	  (cond ((string? criteria)
+		 (imap:command:search connection 'TEXT criteria))
+		(else
+		 (error:wrong-type-argument criteria
+					    "search criteria"
+					    'SEARCH-FOLDER)))))))
 
 (define-method folder-sync-status ((folder <imap-folder>))
   ;; Changes are always written through.
@@ -688,6 +696,10 @@
 			    (and (pair? flags) flags)
 			    (imap:universal-time->date-time time)
 			    (cons 'LITERAL text)))
+
+(define (imap:command:search connection . key-plist)
+  (apply imap:command:single-response imap:response:search?
+	 connection 'SEARCH key-plist))
 
 (define (imap:command:no-response connection command . arguments)
   (let ((response
diff --git a/v7/src/imail/imail.pkg b/v7/src/imail/imail.pkg
index 55c590b68..368e5addc 100644
--- a/v7/src/imail/imail.pkg
+++ b/v7/src/imail/imail.pkg
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail.pkg,v 1.32 2000/05/16 03:13:41 cph Exp $
+;;; $Id: imail.pkg,v 1.33 2000/05/16 03:33:47 cph Exp $
 ;;;
 ;;; Copyright (c) 2000 Massachusetts Institute of Technology
 ;;;
@@ -183,6 +183,7 @@
 	  imap:response:recent?
 	  imap:response:response-text-code
 	  imap:response:response-text-string
+	  imap:response:search-indices
 	  imap:response:search?
 	  imap:response:status-response?
 	  imap:response:status?
diff --git a/v7/src/imail/imap-response.scm b/v7/src/imail/imap-response.scm
index 843e9f391..c8bdf31bf 100644
--- a/v7/src/imail/imap-response.scm
+++ b/v7/src/imail/imap-response.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imap-response.scm,v 1.13 2000/05/08 15:04:44 cph Exp $
+;;; $Id: imap-response.scm,v 1.14 2000/05/16 03:33:49 cph Exp $
 ;;;
 ;;; Copyright (c) 2000 Massachusetts Institute of Technology
 ;;;
@@ -474,6 +474,7 @@
 (define imap:response:fetch-index cadr)
 (define imap:response:flags cdr)
 (define imap:response:recent-count cadr)
+(define imap:response:search-indices cdr)
 
 (define (imap:response:tag response)
   (and (memq (car response) '(OK NO BAD))
diff --git a/v7/src/imail/todo.txt b/v7/src/imail/todo.txt
index 8c49a965b..e8a1b6dc3 100644
--- a/v7/src/imail/todo.txt
+++ b/v7/src/imail/todo.txt
@@ -1,5 +1,5 @@
 IMAIL To-Do List
-$Id: todo.txt,v 1.11 2000/05/15 19:17:19 cph Exp $
+$Id: todo.txt,v 1.12 2000/05/16 03:34:42 cph Exp $
 
 Bug fixes
 ---------
@@ -7,15 +7,7 @@ Bug fixes
 * Use UID FETCH instead of FETCH for IMAP?  In the case of Cyrus, it
   looks like UID FETCH does new-mail checks, while FETCH doesn't.
 
-* Implement operations for IMAP: FOLDER-VALID?, SEARCH-FOLDER, and
-  APPEND-MESSAGE.
-
-* APPEND-MESSAGE should use the IMAP COPY command if the source and
-  target folder are both on the same server and belong to the same
-  user (i.e. if the URLs are equal except for the mailbox).  If the
-  IMAP APPEND command is used, the internal date should be set from
-  the unix from line, if available, or else computed from the
-  "received:" headers, or the "date:" header as a last resort.
+* Implement operations for IMAP: FOLDER-VALID?.
 
 * Implement background thread to periodically send NOOP to IMAP server
   both to check for new mail and to keep the connection alive.