From d628827fb727d9561a774dced5cccb59e3bc8618 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Tue, 16 May 2000 03:34:42 +0000 Subject: [PATCH] Implement IMAP SEARCH-FOLDER operation. --- v7/src/imail/imail-imap.scm | 16 ++++++++++++++-- v7/src/imail/imail.pkg | 3 ++- v7/src/imail/imap-response.scm | 3 ++- v7/src/imail/todo.txt | 12 ++---------- 4 files changed, 20 insertions(+), 14 deletions(-) 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 ) 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 )) ;; 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. -- 2.25.1