;;; -*- Mode:Common-Lisp; Package:IMAP; Base:10 -*-

;;; **********************************************************************
;;; Copyright (c) 1990 Stanford University.
;;; This code was written by James Rice.
;;; Copyright is held by Stanford University except where code has been
;;; modified from TI source code.  In these cases TI code is marked with
;;; a suitable comment.

;;; All Stanford Copyright code is in the public domain.  This code may be
;;; distributed and used without restriction as long as this copyright
;;; notice is included and no fee is charged.  This can be thought of as
;;; being equivalent to the Free Software Foundation's Copyleft policy.

;;; TI source code may only be distributed to users who hold valid TI
;;; software licenses.

;;; The development of this software was assisted by the following grants:
;;; Biomedical Research Technology Program of the National Institutes
;;; of Health under grant RR-00785
;;; Information Systems Technologies office of the Defense Advanced
;;; Research Projects Agency under contract N00039-86-C0033.

;;; **********************************************************************

;-------------------------------------------------------------------------------

;;; The SEARCH command.
(defmethod process-request ((command (eql :Search)) stream)
"Reads the set of serach criteria from the client."
  (ignore stream)
  (multiple-value-bind (criteria string) (read-criteria stream)
    (list criteria string)
  )
)

;(defmethod process-imap-server-command
;	   (stream tag (command (eql :Search)) &rest arglist)
;"Performs a search for the client given a set of criteria."
;  (declare (special *current-mailbox* *Selected-Version*))
;  (ignore stream tag arglist)
;  (destructuring-bind (criteria string) arglist
;    (ignore string)
;    (let ((selected
;	    (loop for message-number
;		  from 1
;		  to (Number-Of-Messages-In *current-mailbox*)
;		  for message = (The-Message message-number *current-mailbox*)
;		  when (loop for (key argument) on criteria by #'cddr
;			     unless
;			       (apply-search-criterion key argument message)
;			     return nil
;			     finally (return t)
;		       )
;		  collect message-number
;	    )
;	  )
;	 )
;	 (if (equal *Selected-Version* *imap2-version*)
;	     (apply #'Send-Solicited-Command stream tag :Search selected)
;	     (Send-Solicited-Command stream tag :Search selected
;				     (loop for (key argument) on criteria
;					   by #'cddr
;					   append (if argument
;						      (list key argument)
;						      (list key)
;						  )
;				     )
;             )
;	 )
;    )
;  )
;  (values :Ok "Search completed.")
;)

(defun read-criteria (stream)
"Reads a list of search criteria from Stream."
  (declare (values criterion/arg-alist criteria-string))
  (let ((key (Read-Keyword stream)))
       (let ((argument (read-search-keyword key stream)))
	    (multiple-value-bind (criteria string)
		(if (char= #\newline (peek-char nil stream))
		    (values nil "")
		    (read-criteria stream)
		)
	        (values (cons (if argument
				  (list key argument)
				  (list key)
			      )
			      criteria
			)
			(string-append (symbol-name key)
				       (if argument " " "")
				       (or argument "")
				       string
			)
		)
	    )
       )
  )
)

(defmethod read-search-keyword ((keyword (eql :All)) stream)
"Reads the ALL search criterion."
  (ignore stream)
  nil
)

(defmethod read-search-keyword ((keyword (eql :~All)) stream)
"Reads the ~ALL search criterion."
  (ignore stream)
  nil
)

(defmethod read-search-keyword ((keyword (eql :Answered)) stream)
"Reads the ANSWERED search criterion."
  (ignore stream)
  nil
)

(defmethod read-search-keyword ((keyword (eql :~Answered)) stream)
"Reads the ~ANSWERED search criterion."
  (ignore stream)
  nil
)

(defmethod read-search-keyword ((keyword (eql :Bcc)) stream)
"Reads the BCC search criterion with its search string."
  (Read-String stream)
)

(defmethod read-search-keyword ((keyword (eql :~Bcc)) stream)
"Reads the ~BCC search criterion with its search string."
  (Read-String stream)
)

(defmethod read-search-keyword ((keyword (eql :Before)) stream)
"Reads the BEFORE search criterion with its date string."
  (Read-String stream)
)

(defmethod read-search-keyword ((keyword (eql :~Before)) stream)
"Reads the ~BEFORE search criterion with its date string."
  (Read-String stream)
)

(defmethod read-search-keyword ((keyword (eql :Body)) stream)
"Reads the BODY search criterion with its search string."
  (Read-String stream)
)

(defmethod read-search-keyword ((keyword (eql :~Body)) stream)
"Reads the ~BODY search criterion with its search string."
  (Read-String stream)
)

(defmethod read-search-keyword ((keyword (eql :CC)) stream)
"Reads the CC search criterion with its search string."
  (Read-String stream)
)

(defmethod read-search-keyword ((keyword (eql :~Cc)) stream)
"Reads the ~CC search criterion with its search string."
  (Read-String stream)
)

(defmethod read-search-keyword ((keyword (eql :$CC)) stream)
"Reads the $CC search criterion with its search string."
  (Read-String stream)
)

(defmethod read-search-keyword ((keyword (eql :~$CC)) stream)
"Reads the ~$CC search criterion with its search string."
  (Read-String stream)
)

(defmethod read-search-keyword ((keyword (eql :Deleted)) stream)
"Reads the DELETED search criterion."
  (ignore stream)
  nil
)

(defmethod read-search-keyword ((keyword (eql :~Deleted)) stream)
"Reads the ~DELETED search criterion."
  (ignore stream)
  nil
)

(defmethod read-search-keyword ((keyword (eql :Flagged)) stream)
"Reads the FLAGGED search criterion."
  (ignore stream)
  nil
)

(defmethod read-search-keyword ((keyword (eql :~Flagged)) stream)
"Reads the ~FLAGGED search criterion."
  (ignore stream)
  nil
)

(defmethod read-search-keyword ((keyword (eql :From)) stream)
"Reads the FROM search criterion with its search string."
  (Read-String stream)
)

(defmethod read-search-keyword ((keyword (eql :~From)) stream)
"Reads the ~FROM search criterion with its search string."
  (Read-String stream)
)

(defmethod read-search-keyword ((keyword (eql :$From)) stream)
"Reads the $From search criterion with its search string."
  (Read-String stream)
)

(defmethod read-search-keyword ((keyword (eql :~$From)) stream)
"Reads the ~$From search criterion with its search string."
  (Read-String stream)
)

(defmethod read-search-keyword ((keyword (eql :Keyword)) stream)
"Reads the KEYWORD search criterion with its keyword string."
  (Read-keyword stream)
)

(defmethod read-search-keyword ((keyword (eql :~Keyword)) stream)
"Reads the ~KEYWORD search criterion with its keyword string."
  (Read-keyword stream)
)

(defmethod read-search-keyword ((keyword (eql :Header)) stream)
"Reads the Header search criterion with its search string."
  (Read-String stream)
)

(defmethod read-search-keyword ((keyword (eql :~Header)) stream)
"Reads the ~Header search criterion with its search string."
  (Read-String stream)
)

(defmethod read-search-keyword ((keyword (eql :New)) stream)
"Reads the NEW search criterion."
  (ignore stream)
  nil
)

(defmethod read-search-keyword ((keyword (eql :~New)) stream)
"Reads the ~NEW search criterion."
  (ignore stream)
  nil
)

(defmethod read-search-keyword ((keyword (eql :Old)) stream)
"Reads the OLD search criterion."
  (ignore stream)
  nil
)

(defmethod read-search-keyword ((keyword (eql :~Old)) stream)
"Reads the ~OLD search criterion."
  (ignore stream)
  nil
)

(defmethod read-search-keyword ((keyword (eql :On)) stream)
"Reads the ON search criterion with its date string."
  (Read-String stream)
)

(defmethod read-search-keyword ((keyword (eql :~On)) stream)
"Reads the ~ON search criterion with its date string."
  (Read-String stream)
)

(defmethod read-search-keyword ((keyword (eql :Recent)) stream)
"Reads the RECENT search criterion."
  (ignore stream)
  nil
)

(defmethod read-search-keyword ((keyword (eql :~Recent)) stream)
"Reads the ~RECENT search criterion."
  (ignore stream)
  nil
)

(defmethod read-search-keyword ((keyword (eql :Seen)) stream)
"Reads the SEEN search criterion."
  (ignore stream)
  nil
)

(defmethod read-search-keyword ((keyword (eql :~Seen)) stream)
"Reads the ~SEEN search criterion."
  (ignore stream)
  nil
)

(defmethod read-search-keyword ((keyword (eql :Since)) stream)
"Reads the SINCE search criterion with its date string."
  (Read-String stream)
)

(defmethod read-search-keyword ((keyword (eql :~Since)) stream)
"Reads the ~SINCE search criterion with its date string."
  (Read-String stream)
)

(defmethod read-search-keyword ((keyword (eql :Subject)) stream)
"Reads the Subject search criterion with its search string."
  (Read-String stream)
)

(defmethod read-search-keyword ((keyword (eql :~Subject)) stream)
"Reads the ~Subject search criterion with its search string."
  (Read-String stream)
)

(defmethod read-search-keyword ((keyword (eql :$Subject)) stream)
"Reads the $Subject search criterion with its search string."
  (Read-String stream)
)

(defmethod read-search-keyword ((keyword (eql :~$Subject)) stream)
"Reads the ~$Subject search criterion with its search string."
  (Read-String stream)
)

(defmethod read-search-keyword ((keyword (eql :Text)) stream)
"Reads the TEXT search criterion with its search string."
  (Read-String stream)
)

(defmethod read-search-keyword ((keyword (eql :~Text)) stream)
"Reads the ~TEXT search criterion with its search string."
  (Read-String stream)
)

(defmethod read-search-keyword ((keyword (eql :To)) stream)
"Reads the TO search criterion with its search string."
  (Read-String stream)
)

(defmethod read-search-keyword ((keyword (eql :~To)) stream)
"Reads the ~TO search criterion with its search string."
  (Read-String stream)
)

(defmethod read-search-keyword ((keyword (eql :$To)) stream)
"Reads the $To search criterion with its search string."
  (Read-String stream)
)

(defmethod read-search-keyword ((keyword (eql :~$To)) stream)
"Reads the ~$To search criterion with its search string."
  (Read-String stream)
)

;-------------------------------------------------------------------------------

(defmethod read-search-keyword ((keyword Symbol) stream)
"Reads a concrete key search criterion with its search string."
  (Read-String stream)
)

;-------------------------------------------------------------------------------
;;; Obsolete commands.

(defmethod read-search-keyword ((keyword (eql :UnAnswered)) stream)
"Reads the ~ANSWERED search criterion."
  (ignore stream)
  nil
)

(defmethod read-search-keyword ((keyword (eql :UnDeleted)) stream)
"Reads the ~DELETED search criterion."
  (ignore stream)
  nil
)

(defmethod read-search-keyword ((keyword (eql :UnFlagged)) stream)
"Reads the ~FLAGGED search criterion."
  (ignore stream)
  nil
)

(defmethod read-search-keyword ((keyword (eql :UnKeyword)) stream)
"Reads the ~KEYWORD search criterion with its keyword string."
  (Read-keyword stream)
)

(defmethod read-search-keyword ((keyword (eql :UnSeen)) stream)
"Reads the ~SEEN search criterion."
  (ignore stream)
  nil
)

;-------------------------------------------------------------------------------

(defun ensure-ut (time)
"Ensures that Time is a universal time."
  (etypecase time
    (number time)
    (string (time:parse-universal-time time))
  )
)

(defun date-less-p (date1 date2)
"Is true if date1 is before date2."
  (let ((time1 (Ensure-Ut date1))
	(time2 (Ensure-Ut date2))
       )
       (< time1 time2)
  )
)

(defun on-day (date1 date2)
"Is true if date1 falls on the same day as date2."
  (let ((time1 (Ensure-Ut date1))
	(time2 (Ensure-Ut date2))
       )
       (multiple-value-bind (ignore ignore ignore day1 month1 year1)
	   (time:decode-universal-time time1)
	 (multiple-value-bind (ignore ignore ignore day2 month2 year2)
	     (time:decode-universal-time time2)
	   (and (= day1 day2) (= month1 month2) (= year1 year2))
	 )
       )
  )
)

;-------------------------------------------------------------------------------

(defmethod apply-search-criterion ((keyword (eql :All)) argument message)
"The predicate for the ALL search criterion."
  (ignore argument message)
  t
)

(defmethod apply-search-criterion ((keyword (eql :~All)) argument message)
"The predicate for the ~ALL search criterion."
  (ignore argument message)
  nil
)

(defmethod apply-search-criterion ((keyword (eql :Answered)) argument message)
"The predicate for the ANSWERED search criterion."
  (ignore argument)
  (Flag-set-p (message-flags message) :\\Answered)
)

(defmethod apply-search-criterion ((keyword (eql :~Answered)) argument message)
"The predicate for the ~ANSWERED search criterion."
  (not (Apply-Search-Criterion :Answered argument message))
)

(defmethod apply-search-criterion ((keyword (eql :Bcc)) argument message)
"The predicate for the BCC search criterion."
  (search-for-string-in argument (yw:envelope-bcc (message-envelope message)))
)

(defmethod apply-search-criterion ((keyword (eql :~Bcc)) argument message)
"The predicate for the ~BCC search criterion."
  (not (Apply-Search-Criterion :Bcc argument message))
)

(defmethod apply-search-criterion ((keyword (eql :Before)) argument message)
"The predicate for the BEFORE search criterion."
  (date-less-p argument (message-internal-date message))
)

(defmethod apply-search-criterion ((keyword (eql :~Before)) argument message)
"The predicate for the ~BEFORE search criterion."
  (not (Apply-Search-Criterion :Before argument message))
)

(defmethod apply-search-criterion ((keyword (eql :Body)) argument message)
"The predicate for the BODY search criterion."
  (search-for-string-in argument (message-body message))
)

(defmethod apply-search-criterion ((keyword (eql :~Body)) argument message)
"The predicate for the ~BODY search criterion."
  (not (Apply-Search-Criterion :Body argument message))
)

(defmethod apply-search-criterion ((keyword (eql :CC)) argument message)
"The predicate for the CC search criterion."
  (search-for-string-in argument (yw:envelope-cc (message-envelope message)))
)

(defmethod apply-search-criterion ((keyword (eql :~Cc)) argument message)
"The predicate for the ~CC search criterion."
  (not (Apply-Search-Criterion :CC argument message))
)

(defmethod apply-search-criterion ((keyword (eql :$CC)) argument message)
"The predicate for the $CC search criterion."
  (search-for-string-in argument (yw:envelope-$CC (message-envelope message)))
)

(defmethod apply-search-criterion ((keyword (eql :~$CC)) argument message)
"The predicate for the ~$CC search criterion."
  (not (Apply-Search-Criterion :$CC argument message))
)

(defmethod apply-search-criterion ((keyword (eql :Deleted)) argument message)
"The predicate for the DELETED search criterion."
  (ignore argument)
  (Flag-set-p (message-flags message) :\\Deleted)
)

(defmethod apply-search-criterion ((keyword (eql :~Deleted)) argument message)
"The predicate for the ~DELETED search criterion."
  (not (Apply-Search-Criterion :Deleted argument message))
)

(defmethod apply-search-criterion ((keyword (eql :Flagged)) argument message)
"The predicate for the FLAGGED search criterion."
  (ignore argument)
  (Flag-set-p (message-flags message) :\\Flagged)
)

(defmethod apply-search-criterion ((keyword (eql :~Flagged)) argument message)
"The predicate for the ~FLAGGED search criterion."
  (not (Apply-Search-Criterion :Flagged argument message))
)

(defmethod apply-search-criterion ((keyword (eql :From)) argument message)
"The predicate for the FROM search criterion."
  (search-for-string-in argument (yw:envelope-from (message-envelope message)))
)

(defmethod apply-search-criterion ((keyword (eql :~From)) argument message)
"The predicate for the ~FROM search criterion."
  (not (Apply-Search-Criterion :From argument message))
)

(defmethod apply-search-criterion ((keyword (eql :$From)) argument message)
"The predicate for the $From search criterion."
  (search-for-string-in argument (yw:envelope-$From (message-envelope message)))
)

(defmethod apply-search-criterion ((keyword (eql :~$From)) argument message)
"The predicate for the ~$From search criterion."
  (not (Apply-Search-Criterion :$From argument message))
)

(defmethod apply-search-criterion ((keyword (eql :Header)) argument message)
"The predicate for the Header search criterion."
  (search-for-string-in argument (message-header message))
)

(defmethod apply-search-criterion ((keyword (eql :~Header)) argument message)
"The predicate for the ~Header search criterion."
  (not (Apply-Search-Criterion :Header argument message))
)

(defmethod apply-search-criterion ((keyword (eql :Keyword)) argument message)
"The predicate for the KEYWORD search criterion."
  (Flag-set-p (message-flags message) argument)
)

(defmethod apply-search-criterion ((keyword (eql :~Keyword)) argument message)
"The predicate for the ~KEYWORD search criterion."
  (not (Apply-Search-Criterion :Keyword argument message))
)

(defmethod apply-search-criterion ((keyword (eql :New)) argument message)
"The predicate for the NEW search criterion."
  (ignore argument message)
  nil
)

(defmethod apply-search-criterion ((keyword (eql :~New)) argument message)
"The predicate for the ~NEW search criterion."
  (ignore argument message)
  t
)

(defmethod apply-search-criterion ((keyword (eql :Old)) argument message)
"The predicate for the OLD search criterion."
  (ignore argument)
  (not (Recent-P message))
)

(defmethod apply-search-criterion ((keyword (eql :~Old)) argument message)
"The predicate for the ~OLD search criterion."
  (not (Apply-Search-Criterion :Old argument message))
)

(defmethod apply-search-criterion ((keyword (eql :On)) argument message)
"The predicate for the ON search criterion."
  (on-day argument (message-internal-date message))
)

(defmethod apply-search-criterion ((keyword (eql :~On)) argument message)
"The predicate for the ~ON search criterion."
  (not (Apply-Search-Criterion :On argument message))
)

(defmethod apply-search-criterion ((keyword (eql :Recent)) argument message)
"The predicate for the RECENT search criterion."
  (ignore argument)
  (Recent-P message)
)

(defmethod apply-search-criterion ((keyword (eql :~Recent)) argument message)
"The predicate for the ~RECENT search criterion."
  (ignore argument)
  (not (Apply-Search-Criterion :Recent argument message))
)

(defmethod apply-search-criterion ((keyword (eql :Seen)) argument message)
"The predicate for the SEEN search criterion."
  (ignore argument)
  (Flag-set-p (message-flags message) :\\Seen)
)

(defmethod apply-search-criterion ((keyword (eql :~Seen)) argument message)
"The predicate for the ~SEEN search criterion."
  (ignore argument)
  (not (Apply-Search-Criterion :Seen argument message))
)

(defmethod apply-search-criterion ((keyword (eql :Since)) argument message)
"The predicate for the SINCE search criterion."
  (Date-Less-P (message-internal-date message) argument)
)

(defmethod apply-search-criterion ((keyword (eql :~Since)) argument message)
"The predicate for the ~SINCE search criterion."
  (not (Apply-Search-Criterion :Since argument message))
)

(defmethod apply-search-criterion ((keyword (eql :Size)) argument message)
"The predicate for the Size search criterion."
  (let ((number (catch-error (read-from-string argument) nil)))
       (and (numberp number) (= (message-length message) number))
  )
)

(defmethod apply-search-criterion ((keyword (eql :~Size)) argument message)
"The predicate for the ~Size search criterion."
  (not (Apply-Search-Criterion :Size argument message))
)

(defmethod apply-search-criterion ((keyword (eql :Subject)) argument message)
"The predicate for the Subject search criterion."
  (Search-For-String-In
    argument (yw:envelope-subject (message-envelope message))
  )
)

(defmethod apply-search-criterion ((keyword (eql :~Subject)) argument message)
"The predicate for the ~Subject search criterion."
  (not (Apply-Search-Criterion :Subject argument message))
)

(defmethod apply-search-criterion ((keyword (eql :$Subject)) argument message)
"The predicate for the $Subject search criterion."
  (Search-For-String-In
    argument (yw:envelope-$Subject (message-envelope message))
  )
)

(defmethod apply-search-criterion ((keyword (eql :~$Subject)) argument message)
"The predicate for the ~$Subject search criterion."
  (not (Apply-Search-Criterion :$Subject argument message))
)

(defmethod apply-search-criterion ((keyword (eql :Text)) argument message)
"The predicate for the TEXT search criterion."
  (search-for-string-in argument (message-rfc822 message))
)

(defmethod apply-search-criterion ((keyword (eql :~Text)) argument message)
"The predicate for the ~TEXT search criterion."
  (not (Apply-Search-Criterion :Text argument message))
)

(defmethod apply-search-criterion ((keyword (eql :To)) argument message)
"The predicate for the TO search criterion."
  (search-for-string-in argument (yw:envelope-to (message-envelope message)))
)

(defmethod apply-search-criterion ((keyword (eql :~To)) argument message)
"The predicate for the ~TO search criterion."
  (not (Apply-Search-Criterion :To argument message))
)

(defmethod apply-search-criterion ((keyword (eql :$To)) argument message)
"The predicate for the $To search criterion."
  (search-for-string-in argument (yw:envelope-$To (message-envelope message)))
)

(defmethod apply-search-criterion ((keyword (eql :~$To)) argument message)
"The predicate for the ~$To search criterion."
  (not (Apply-Search-Criterion :$To argument message))
)

(defmethod apply-search-criterion ((keyword (eql :UnAnswered)) argument message)
"The predicate for the UNANSWERED search criterion."
  (not (Apply-Search-Criterion :Answered argument message))
)

(defmethod Apply-Search-Criterion
	   ((keyword (eql :~Unanswered)) argument message)
  (Apply-Search-Criterion :Answered argument message)
)

(defmethod apply-search-criterion ((keyword (eql :UnDeleted)) argument message)
"The predicate for the UNDELETED search criterion."
  (not (Apply-Search-Criterion :Deleted argument message))
)

(defmethod apply-search-criterion ((keyword (eql :~Undeleted)) argument message)
  (Apply-Search-Criterion :Deleted argument message)
)

(defmethod apply-search-criterion ((keyword (eql :UnFlagged)) argument message)
"The predicate for the UNFLAGGED search criterion."
  (not (Apply-Search-Criterion :Flagged argument message))
)

(defmethod apply-search-criterion ((keyword (eql :~Unflagged)) argument message)
  (Apply-Search-Criterion :Flagged argument message)
)

(defmethod apply-search-criterion ((keyword (eql :UnKeyword)) argument message)
"The predicate for the UNKEYWORD search criterion."
  (not (Apply-Search-Criterion :Keyword argument message))
)

(defmethod apply-search-criterion ((keyword (eql :~Unkeyword)) argument message)
  (Apply-Search-Criterion :Keyword argument message)
)

(defmethod apply-search-criterion ((keyword (eql :UnSeen)) argument message)
"The predicate for the UNSEEN search criterion."
  (not (Apply-Search-Criterion :Seen argument message))
)

(defmethod apply-search-criterion ((keyword (eql :~Unseen)) argument message)
  (Apply-Search-Criterion :Seen argument message)
)

;-------------------------------------------------------------------------------

;;; Search for some user-specified concrete key.

(defmethod apply-search-criterion ((keyword symbol) argument message)
"The predicate for some user-specified concrete key search criterion."
  (if (~command-p keyword)
      (not (apply-search-criterion (not-ify keyword) argument message))
      (let ((field (Get-Value-Of-Field keyword message)))
	   (and field
		(search-for-string-in argument (send field :String-For-Message))
	   )
      )
  )
)

;-------------------------------------------------------------------------------

;===============================================================================
;;;   Experimental stuff not in IMAP 3.0.
;===============================================================================

(defun search-for-string-in (search-for in)
"Searches for a string in a thing, which could be a whole bunch of different
types.
"
  (declare (optimize (speed 3) (safety 0)))
  (etypecase in
    (string (if (feature-enabled-p :Wildcard.Searches)
		(fs:Compare-String-Full search-for nil in (length in) 0)
		(yw:string-search search-for in)
	    )
    )
    (cons (or (Search-For-String-In search-for (first in))
	      (Search-For-String-In search-for (rest in))
	  )
    )
    (yw:address
     (Search-For-String-In search-for (yw:address-address-object in))
    )
    (mail:basic-address
     (Search-For-String-In search-for (send in :address-string))
    )
  )
)

(defun canonicalize-search-criterion (criterion)
"Turns a search criterion into a canonical search criterion with respect
 to wildcarding, parsing any search criteria where necessary.
"
  (destructuring-bind (key argument) criterion
    (if (and (stringp argument)
	     (feature-enabled-p :Wildcard.Searches)
	)
	(list key (fs:parse-search-string argument '(#\* #\%) 0 0))
	(list key argument)
    )
  )
)

(defmethod process-imap-server-command
	   (stream tag (command (eql :Search)) &rest arglist)
"Performs a search for the client given a set of criteria."
  (declare (special *current-mailbox* *Selected-Version*))
  (ignore stream tag arglist)
  (destructuring-bind (criteria string) arglist
    (ignore string)
    (let ((canonical-criteria (mapcar 'Canonicalize-Search-Criterion criteria)))
	 (let ((selected
		 (loop for message-number
		       from 1
		       to (Number-Of-Messages-In *current-mailbox*)
		       for message
		           = (The-Message message-number *current-mailbox*)
		       when (loop for (key argument)
				  in canonical-criteria
				  unless (Apply-Search-Criterion
					   key argument message
					 )
				  return nil
				  finally (return t)
			    )
		       collect message-number
		 )
	       )
	      )
	      (if (equal *Selected-Version* *imap2-version*)
		  (apply #'Send-Solicited-Command stream tag :Search selected)
		  (apply 'Send-Solicited-Command stream tag :Search
			 (if selected selected :Empty-List)
			 (list (loop for (key argument) in criteria
				     append (if argument
						(list key argument)
						(list key)
					    )
			       )
			 )
		  )
	      )
	 )
    )
  )
  (values :Ok "Search completed.")
)