From 49f6557473b894b9c1d6bcdcf9f2bc65403ab5c1 Mon Sep 17 00:00:00 2001 From: dmaus Date: Sun, 17 Jul 2011 17:17:13 +0000 Subject: [PATCH] Implement new IMAP search feature, proposed by egh@e6h.org 2011-07-17 David Maus * elmo-util.el (elmo-list-difference): New function. Return difference of two lists. * elmo-imap4.el (elmo-imap4-search-generate-vector): Use function. 2011-07-03 Erik Hetzner * elmo-imap4.el (elmo-imap4-search-internal-primitive): Removed. (elmo-imap4-search-build-full-command): New function. Build full IMAP search command. (elmo-imap4-search-perform): New function. Perform IMAP search. (elmo-imap4-search-generate-vector): New function. Generate search vector. (elmo-imap4-search-mergeable-p): New function. Return non-nil if two search conditions are mergeable. (elmo-imap4-search-mergeable-charset): New function. Return charset of two searches for merging. (elmo-imap4-search-generate-uid): New function. Return search for a set of messages. (elmo-imap4-search-generate-and): New function. Return search that returns intersection of two search commands. (elmo-imap4-search-generate-or): New function. Return search that returns union of two search commands. (elmo-imap4-search-generate): New function. Return search in folder. (elmo-imap4-search-internal): Use new search functions. --- elmo/ChangeLog | 30 +++++- elmo/elmo-imap4.el | 273 +++++++++++++++++++++++++++++++--------------------- elmo/elmo-util.el | 8 ++ 3 files changed, 198 insertions(+), 113 deletions(-) diff --git a/elmo/ChangeLog b/elmo/ChangeLog index 4c9e946..5e0c0a6 100644 --- a/elmo/ChangeLog +++ b/elmo/ChangeLog @@ -1,4 +1,32 @@ -2011-07-03 David Maus +2011-07-17 David Maus + + * elmo-util.el (elmo-list-difference): New function. Return + difference of two lists. + * elmo-imap4.el (elmo-imap4-search-generate-vector): Use function. + +2011-07-03 Erik Hetzner + + * elmo-imap4.el (elmo-imap4-search-internal-primitive): Removed. + (elmo-imap4-search-build-full-command): New function. Build full + IMAP search command. + (elmo-imap4-search-perform): New function. Perform IMAP search. + (elmo-imap4-search-generate-vector): New function. Generate search + vector. + (elmo-imap4-search-mergeable-p): New function. Return non-nil if + two search conditions are mergeable. + (elmo-imap4-search-mergeable-charset): New function. Return + charset of two searches for merging. + (elmo-imap4-search-generate-uid): New function. Return search for + a set of messages. + (elmo-imap4-search-generate-and): New function. Return search that + returns intersection of two search commands. + (elmo-imap4-search-generate-or): New function. Return search that + returns union of two search commands. + (elmo-imap4-search-generate): New function. Return search in + folder. + (elmo-imap4-search-internal): Use new search functions. + +2011-07-02 David Maus * elmo-imap4.el (elmo-imap4-session-unselect-mailbox): New function. Leave selected state without silent EXPUNGE. diff --git a/elmo/elmo-imap4.el b/elmo/elmo-imap4.el index 58c0546..45a758f 100644 --- a/elmo/elmo-imap4.el +++ b/elmo/elmo-imap4.el @@ -4,11 +4,13 @@ ;; Copyright (C) 1999,2000 Kenichi OKADA ;; Copyright (C) 2000 OKAZAKI Tetsurou ;; Copyright (C) 2000 Daiki Ueno +;; Copyright (C) 2010 Erik Hetzner ;; Author: Yuuichi Teranishi ;; Kenichi OKADA ;; OKAZAKI Tetsurou ;; Daiki Ueno +;; Erik Hetzner ;; Keywords: mail, net news ;; This file is part of ELMO (Elisp Library for Message Orchestration). @@ -2280,133 +2282,180 @@ If optional argument REMOVE is non-nil, remove FLAG." (insert string) (detect-mime-charset-region (point-min) (point-max)))) -(defun elmo-imap4-search-internal-primitive (folder session filter from-msgs) +(defun elmo-imap4-search-build-full-command (search) + "Process charset at beginning of SEARCH and build a full IMAP +search command." + (let ((charset (car search))) + (append '("uid search") + (if (not (null charset)) + (list " CHARSET " charset)) + '(" ") + (cdr search)))) + +(defun elmo-imap4-search-perform (session search-or-uids) + "Perform an IMAP search. + +SESSION is an imap session. + +SEARCH-OR-UIDS is either a list of UIDs or a list of the +form (CHARSET IMAP-SEARCH-COMMAND ...) which is to be evaluated. + +Returns a list of UIDs." + (if (numberp (car search-or-uids)) + search-or-uids + (elmo-imap4-response-value + (elmo-imap4-send-command-wait + session + (elmo-imap4-search-build-full-command search-or-uids)) + 'search))) + +(defun elmo-imap4-search-generate-vector (folder filter from-msgs) (let ((search-key (elmo-filter-key filter)) (imap-search-keys '("bcc" "body" "cc" "from" "subject" "to" - "larger" "smaller" "flag")) - (total 0) - (length (length from-msgs)) - charset set-list end results) + "larger" "smaller" "flag"))) (cond ((string= "last" search-key) - (let ((numbers (or from-msgs (elmo-folder-list-messages folder)))) + (let ((numbers (or from-msgs (elmo-folder-list-messages folder))) + (length (length from-msgs))) (nthcdr (max (- (length numbers) (string-to-number (elmo-filter-value filter))) 0) numbers))) ((string= "first" search-key) - (let* ((numbers (or from-msgs (elmo-folder-list-messages folder))) - (rest (nthcdr (string-to-number (elmo-filter-value filter) ) - numbers))) - (mapc (lambda (x) (delete x numbers)) rest) - numbers)) + (let ((numbers (or from-msgs (elmo-folder-list-messages folder)))) + (elmo-list-difference + (nthcdr (string-to-number (elmo-filter-value filter)) numbers) numbers))) ((string= "flag" search-key) - (elmo-imap4-folder-list-flagged - folder (intern (elmo-filter-value filter)) (elmo-filter-type filter))) + (list nil + (if (eq (elmo-filter-type filter) 'unmatch) "not " "") + (elmo-imap4-flag-to-imap-search-key + (intern (elmo-filter-value filter))))) ((or (string= "since" search-key) (string= "before" search-key)) - (setq search-key (concat "sent" search-key) - set-list (elmo-imap4-make-number-set-list - from-msgs - elmo-imap4-number-set-chop-length) - end nil) - (while (not end) - (setq results - (append - results - (elmo-imap4-response-value - (elmo-imap4-send-command-wait - session - (format - (if elmo-imap4-use-uid - "uid search %s%s%s %s" - "search %s%s%s %s") - (if from-msgs - (concat - (if elmo-imap4-use-uid "uid ") - (cdr (car set-list)) - " ") - "") - (if (eq (elmo-filter-type filter) - 'unmatch) - "not " "") - search-key - (elmo-date-get-description - (elmo-date-get-datevec - (elmo-filter-value filter))))) - 'search))) - (setq set-list (cdr set-list) - end (null set-list))) - results) + (list + nil + (if (eq (elmo-filter-type filter) + 'unmatch) + "not " "") + (concat "sent" search-key) + " " + (elmo-date-get-description + (elmo-date-get-datevec + (elmo-filter-value filter))))) (t - (setq charset - (if (eq (length (elmo-filter-value filter)) 0) - (setq charset 'us-ascii) - (elmo-imap4-detect-search-charset - (elmo-filter-value filter))) - set-list (elmo-imap4-make-number-set-list - from-msgs - elmo-imap4-number-set-chop-length) - end nil) - (while (not end) - (setq results - (append - results - (elmo-imap4-response-value - (elmo-imap4-send-command-wait - session - (list - (if elmo-imap4-use-uid "uid ") - "search " - "CHARSET " - (elmo-imap4-astring - (symbol-name charset)) - " " - (if from-msgs - (concat - (if elmo-imap4-use-uid "uid ") - (cdr (car set-list)) - " ") - "") - (if (eq (elmo-filter-type filter) - 'unmatch) - "not " "") - (format "%s%s " - (if (member - (elmo-filter-key filter) - imap-search-keys) - "" - "header ") - (elmo-filter-key filter)) - (elmo-imap4-astring - (encode-mime-charset-string - (elmo-filter-value filter) charset)))) - 'search))) - (setq set-list (cdr set-list) - end (null set-list))) - results)))) + (let ((charset (elmo-imap4-detect-search-charset + (elmo-filter-value filter)))) + (list + (elmo-imap4-astring + (symbol-name charset)) + (if (eq (elmo-filter-type filter) + 'unmatch) + "not " "") + (format "%s%s " + (if (member (elmo-filter-key filter) imap-search-keys) + "" + "header ") + (elmo-filter-key filter)) + (elmo-imap4-astring + (encode-mime-charset-string + (elmo-filter-value filter) charset)))))))) + +(defun elmo-imap4-search-mergeable-p (a b) + "Return t if A and B are two mergeable IMAP searches. + +A is the result of a call to elmo-imap4-search-generate. +B is the result of a call to elmo-imap4-search-generate." + (let ((cara (car a)) + (carb (car b))) + (and (not (numberp cara)) + (not (numberp carb)) + (or (null cara) + (null carb) + (equal cara carb))))) + +(defun elmo-imap4-search-mergeable-charset (a b) + "Return the charset of two searches for merging. + +A is the result of a call to elmo-imap4-search-generate. +B is the result of a call to elmo-imap4-search-generate." + (or (car a) + (car b))) + +(defun elmo-imap4-search-generate-uid (msgs) + "Return a search for a set of msgs. + +A search is a list of the form (CHARSET IMAP-SEARCH-COMMAND ...) +which is to be evaluated at a future time." + (list nil + (concat "uid " + (cdr (car + (elmo-imap4-make-number-set-list msgs)))))) + +(defun elmo-imap4-search-generate-and (session a b) + "Return a search that returns the intersection of A and B in SESSION. + +SESSION is an imap session. +A is the result of a call to elmo-imap4-search-generate. +B is the result of a call to elmo-imap4-search-generate. + +A search is either a list of UIDs or a list of the form (CHARSET +IMAP-SEARCH-COMMAND ...) which is to be evaluated at a future +time." + (if (elmo-imap4-search-mergeable-p a b) + (append (list (elmo-imap4-search-mergeable-charset a b)) + (cdr a) '(" ") (cdr b)) + (elmo-list-filter (elmo-imap4-search-perform session a) + (elmo-imap4-search-perform session b)))) + +(defun elmo-imap4-search-generate-or (session a b) + "Return a search that returns the union of A and B in SESSION. + +SESSION is an imap session. +A is the result of a call to elmo-imap4-search-generate. +B is the result of a call to elmo-imap4-search-generate. + +A search is either a list of UIDs or a list of the form (CHARSET +IMAP-SEARCH-COMMAND ...) which is to be evaluated at a future +time." + (if (elmo-imap4-search-mergeable-p a b) + (append (list (elmo-imap4-search-mergeable-charset a b)) + '("OR " "(") (cdr a) '(")" " " "(") (cdr b) '(")")) + (elmo-uniq-list (append (elmo-imap4-search-perform session a) + (elmo-imap4-search-perform session b))))) + +(defun elmo-imap4-search-generate (folder session condition from-msgs) + "Return search in FOLDER for CONDITON and FROM-MSGS. + +FOLDER is a elmo folder structure. +CONDITION is a search condition. +FROM-MSGS is a set of messages. When nil, generate vector for all +messages in FOLDER. + +A search is either a list of UIDs or a list of the form (CHARSET +IMAP-SEARCH-COMMAND ...) which is to be evaluated at a future +time." + (if (vectorp condition) + (elmo-imap4-search-generate-vector folder condition from-msgs) + (let ((a (elmo-imap4-search-generate folder session (nth 1 condition) + from-msgs)) + (b (elmo-imap4-search-generate folder session (nth 2 condition) + from-msgs))) + (cond + ((eq (car condition) 'and) + (elmo-imap4-search-generate-and session a b)) + ((eq (car condition) 'or) + (elmo-imap4-search-generate-or session a b)))))) (defun elmo-imap4-search-internal (folder session condition from-msgs) - (let (result) - (cond - ((vectorp condition) - (setq result (elmo-imap4-search-internal-primitive - folder session condition from-msgs))) - ((eq (car condition) 'and) - (setq result (elmo-imap4-search-internal folder session (nth 1 condition) - from-msgs) - result (elmo-list-filter result - (elmo-imap4-search-internal - folder session (nth 2 condition) - from-msgs)))) - ((eq (car condition) 'or) - (setq result (elmo-imap4-search-internal - folder session (nth 1 condition) from-msgs) - result (elmo-uniq-list - (nconc result - (elmo-imap4-search-internal - folder session (nth 2 condition) from-msgs))) - result (sort result '<)))))) + (let* ((imap-search + (if from-msgs + (elmo-imap4-search-generate-and + session + (elmo-imap4-search-generate-uid from-msgs) + (elmo-imap4-search-generate folder session condition from-msgs)) + (elmo-imap4-search-generate folder session condition from-msgs)))) + (when imap-search + (elmo-imap4-search-perform session imap-search)))) (luna-define-method elmo-folder-search :around ((folder elmo-imap4-folder) condition &optional numbers) diff --git a/elmo/elmo-util.el b/elmo/elmo-util.el index aff84f3..7a6b019 100644 --- a/elmo/elmo-util.el +++ b/elmo/elmo-util.el @@ -892,6 +892,14 @@ the directory becomes empty after deletion." (delete-directory path) ; should be removed if empty. )))) +(defun elmo-list-difference (l1 l2) + "Return a list from L2 in which each element is not a member of L1." + (let (result) + (dolist (element l2) + (if (not (memq element l1)) + (setq result (cons element result)))) + (nreverse result))) + (defun elmo-list-filter (l1 l2) "Return a list from L2 in which each element is a member of L1." (let (result) -- 1.7.10.4