From: hmurata Date: Sun, 27 Mar 2005 14:00:19 +0000 (+0000) Subject: * modb.el (elmo-msgdb-match-condition): Rewrite with X-Git-Tag: wl-2_15_3~103 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=d18080c5c6d2cb318ce0d8cbbb9d9d1de343105c;p=elisp%2Fwanderlust.git * modb.el (elmo-msgdb-match-condition): Rewrite with `elmo-condition-match'. (elmo-msgdb-match-condition-primitive): New function. * modb-entity.el (elmo-msgdb-message-match-condition): Removed arguments `flags' and `numbers'. (elmo-msgdb-match-condition-primitive): Abolished (merged to `elmo-msgdb-message-match-condition'). (modb-buffer-entity-handler): New class. * elmo.el (elmo-folder-search): Optimize condition to use `elmo-condition-optimize'. (elmo-message-buffer-match-condition): New function. (elmo-message-match-condition): Use `elmo-message-buffer-match-condition' instead of `elmo-buffer-field-condition-match'. * elmo-util.el (elmo-condition-match): New function. (elmo-condition-optimize): Ditto. (elmo-buffer-field-primitive-condition-match): Abolish. (elmo-buffer-field-condition-match): Ditto. * elmo-archive.el (elmo-archive-field-condition-match): Use `elmo-message-buffer-match-condition' instead of `elmo-buffer-field-condition-match'. --- diff --git a/elmo/ChangeLog b/elmo/ChangeLog index d6b453d..0982a00 100644 --- a/elmo/ChangeLog +++ b/elmo/ChangeLog @@ -1,3 +1,31 @@ +2005-03-27 Hiroya Murata + + * modb.el (elmo-msgdb-match-condition): Rewrite with + `elmo-condition-match'. + (elmo-msgdb-match-condition-primitive): New function. + + * modb-entity.el (elmo-msgdb-message-match-condition): Removed + arguments `flags' and `numbers'. + (elmo-msgdb-match-condition-primitive): Abolished (merged to + `elmo-msgdb-message-match-condition'). + (modb-buffer-entity-handler): New class. + + * elmo.el (elmo-folder-search): Optimize condition to use + `elmo-condition-optimize'. + (elmo-message-buffer-match-condition): New function. + (elmo-message-match-condition): Use + `elmo-message-buffer-match-condition' instead of + `elmo-buffer-field-condition-match'. + + * elmo-util.el (elmo-condition-match): New function. + (elmo-condition-optimize): Ditto. + (elmo-buffer-field-primitive-condition-match): Abolish. + (elmo-buffer-field-condition-match): Ditto. + + * elmo-archive.el (elmo-archive-field-condition-match): Use + `elmo-message-buffer-match-condition' instead of + `elmo-buffer-field-condition-match'. + 2005-03-25 Hiroya Murata * elmo-flag.el (elmo-global-flags-initialize): Check the diff --git a/elmo/elmo-archive.el b/elmo/elmo-archive.el index 8437532..50ce004 100644 --- a/elmo/elmo-archive.el +++ b/elmo/elmo-archive.el @@ -1069,7 +1069,7 @@ TYPE specifies the archiver's symbol." (elmo-archive-call-method method args t)) (set-buffer-multibyte default-enable-multibyte-characters) (decode-mime-charset-region (point-min)(point-max) elmo-mime-charset) - (elmo-buffer-field-condition-match condition number number-list)))))) + (elmo-message-buffer-match-condition condition number)))))) (luna-define-method elmo-folder-search ((folder elmo-archive-folder) condition &optional from-msgs) diff --git a/elmo/elmo-util.el b/elmo/elmo-util.el index e2c232c..49b67a9 100644 --- a/elmo/elmo-util.el +++ b/elmo/elmo-util.el @@ -255,6 +255,72 @@ Return value is a cons cell of (STRUCTURE . REST)" (goto-char (match-end 0)))) (t (error "Syntax error '%s'" (buffer-string))))) +(defmacro elmo-filter-condition-p (filter) + `(or (vectorp ,filter) (consp ,filter))) + +(defmacro elmo-filter-type (filter) + `(aref ,filter 0)) + +(defmacro elmo-filter-key (filter) + `(aref ,filter 1)) + +(defmacro elmo-filter-value (filter) + `(aref ,filter 2)) + +(defun elmo-condition-match (condition match-primitive args) + (cond + ((vectorp condition) + (if (eq (elmo-filter-type condition) 'unmatch) + (not (apply match-primitive condition args)) + (apply match-primitive condition args))) + ((eq (car condition) 'and) + (let ((lhs (elmo-condition-match (nth 1 condition) match-primitive args))) + (cond + ((elmo-filter-condition-p lhs) + (let ((rhs (elmo-condition-match (nth 2 condition) + match-primitive args))) + (cond ((elmo-filter-condition-p rhs) + (list 'and lhs rhs)) + (rhs + lhs)))) + (lhs + (elmo-condition-match (nth 2 condition) match-primitive args))))) + ((eq (car condition) 'or) + (let ((lhs (elmo-condition-match (nth 1 condition) match-primitive args))) + (cond + ((elmo-filter-condition-p lhs) + (let ((rhs (elmo-condition-match (nth 2 condition) + match-primitive args))) + (cond ((elmo-filter-condition-p rhs) + (list 'or lhs rhs)) + (rhs + t) + (t + lhs)))) + (lhs + t) + (t + (elmo-condition-match (nth 2 condition) match-primitive args))))))) + +(defun elmo-condition-optimize (condition) + (cond + ((vectorp condition) + (or (cdr (assoc (elmo-filter-key condition) + '(("first" . 0) + ("last" . 0) + ("flag" . 1) + ("body" . 3)))) + 2)) + (t + (let ((weight-l (elmo-condition-optimize (nth 1 condition))) + (weight-r (elmo-condition-optimize (nth 2 condition)))) + (if (> weight-l weight-r) + (let ((lhs (nth 1 condition))) + (setcar (nthcdr 1 condition) (nth 2 condition)) + (setcar (nthcdr 2 condition) lhs) + weight-l) + weight-r))))) + ;;; (defsubst elmo-buffer-replace (regexp &optional newtext) (goto-char (point-min)) @@ -814,83 +880,6 @@ the directory becomes empty after deletion." (setq l1 (cdr l1))) (cons diff1 (list l2))))) -(defmacro elmo-filter-condition-p (filter) - `(or (vectorp ,filter) (consp ,filter))) - -(defmacro elmo-filter-type (filter) - `(aref ,filter 0)) - -(defmacro elmo-filter-key (filter) - `(aref ,filter 1)) - -(defmacro elmo-filter-value (filter) - `(aref ,filter 2)) - -(defsubst elmo-buffer-field-primitive-condition-match (condition - number - number-list) - (let (result) - (goto-char (point-min)) - (cond - ((string= (elmo-filter-key condition) "last") - (setq result (<= (length (memq number number-list)) - (string-to-int (elmo-filter-value condition))))) - ((string= (elmo-filter-key condition) "first") - (setq result (< (- (length number-list) - (length (memq number number-list))) - (string-to-int (elmo-filter-value condition))))) - ((string= (elmo-filter-key condition) "since") - (let ((field-date (elmo-date-make-sortable-string - (timezone-fix-time - (std11-field-body "date") - (current-time-zone) nil))) - (specified-date (elmo-date-make-sortable-string - (elmo-date-get-datevec - (elmo-filter-value condition))))) - (setq result - (or (string= field-date specified-date) - (string< specified-date field-date))))) - ((string= (elmo-filter-key condition) "before") - (setq result - (string< - (elmo-date-make-sortable-string - (timezone-fix-time - (std11-field-body "date") - (current-time-zone) nil)) - (elmo-date-make-sortable-string - (elmo-date-get-datevec - (elmo-filter-value condition)))))) - ((string= (elmo-filter-key condition) "body") - (and (re-search-forward "^$" nil t) ; goto body - (setq result (search-forward (elmo-filter-value condition) - nil t)))) - (t - (dolist (fval (elmo-multiple-field-body (elmo-filter-key condition))) - (if (eq (length fval) 0) (setq fval nil)) - (if fval (setq fval (eword-decode-string fval))) - (setq result (or result - (and fval (string-match - (elmo-filter-value condition) fval))))))) - (if (eq (elmo-filter-type condition) 'unmatch) - (setq result (not result))) - result)) - -(defun elmo-buffer-field-condition-match (condition number number-list) - (cond - ((vectorp condition) - (elmo-buffer-field-primitive-condition-match - condition number number-list)) - ((eq (car condition) 'and) - (and (elmo-buffer-field-condition-match - (nth 1 condition) number number-list) - (elmo-buffer-field-condition-match - (nth 2 condition) number number-list))) - ((eq (car condition) 'or) - (or (elmo-buffer-field-condition-match - (nth 1 condition) number number-list) - (elmo-buffer-field-condition-match - (nth 2 condition) number number-list))))) - (defmacro elmo-get-hash-val (string hashtable) (static-if (fboundp 'unintern) `(symbol-value (intern-soft ,string ,hashtable)) diff --git a/elmo/elmo.el b/elmo/elmo.el index 31b9e14..d1a2b2b 100644 --- a/elmo/elmo.el +++ b/elmo/elmo.el @@ -801,6 +801,14 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-FLAG-ALIST).") (setq results (elmo-msgdb-search msgdb condition numbers)) (if (listp results) results + (elmo-condition-optimize condition) + (when (and (consp condition) + (eq (car condition) 'and) + (listp (setq results (elmo-msgdb-search msgdb + (nth 1 condition) + numbers)))) + (setq numbers results + condition (nth 2 condition))) (let ((len (length numbers)) matched) (elmo-with-progress-display (> len elmo-display-progress-threshold) @@ -822,6 +830,22 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-FLAG-ALIST).") (message "Searching...done") (nreverse matched))))) +(defun elmo-message-buffer-match-condition (condition number) + (let* ((handler (luna-make-entity 'modb-buffer-entity-handler)) + (result (elmo-condition-match + condition + (lambda (condition handler entity) + (elmo-msgdb-message-match-condition handler + condition + entity)) + (list + handler + (elmo-msgdb-make-message-entity + handler + :number number + :buffer (current-buffer)))))) + (and result (not (elmo-filter-condition-p result))))) + (luna-define-method elmo-message-match-condition ((folder elmo-folder) number condition numbers) @@ -849,7 +873,7 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-FLAG-ALIST).") (set-buffer-multibyte default-enable-multibyte-characters) (decode-coding-region (point-min) (point-max) elmo-mime-display-as-is-coding-system) - (elmo-buffer-field-condition-match condition number numbers))))) + (elmo-message-buffer-match-condition condition number))))) (luna-define-method elmo-folder-pack-numbers ((folder elmo-folder)) nil) ; default is noop. diff --git a/elmo/modb-entity.el b/elmo/modb-entity.el index 1a08083..a6a445b 100644 --- a/elmo/modb-entity.el +++ b/elmo/modb-entity.el @@ -129,9 +129,7 @@ Header region is supposed to be narrowed.") ;; Transitional interface. (luna-define-generic elmo-msgdb-message-match-condition (handler condition - entity - flags - numbers) + entity) "Return non-nil when the entity matches the condition.") ;; Generic implementation. @@ -534,133 +532,30 @@ If each field is t, function is set as default converter." (copy-sequence (cdr entity))))) (luna-define-method elmo-msgdb-message-match-condition - ((handler modb-entity-handler) condition entity flags numbers) - (cond - ((vectorp condition) - (elmo-msgdb-match-condition-primitive handler condition - entity flags numbers)) - ((eq (car condition) 'and) - (let ((lhs (elmo-msgdb-message-match-condition handler - (nth 1 condition) - entity flags numbers))) - (cond - ((elmo-filter-condition-p lhs) - (let ((rhs (elmo-msgdb-message-match-condition - handler (nth 2 condition) entity flags numbers))) - (cond ((elmo-filter-condition-p rhs) - (list 'and lhs rhs)) - (rhs - lhs)))) - (lhs - (elmo-msgdb-message-match-condition handler (nth 2 condition) - entity flags numbers))))) - ((eq (car condition) 'or) - (let ((lhs (elmo-msgdb-message-match-condition handler (nth 1 condition) - entity flags numbers))) - (cond - ((elmo-filter-condition-p lhs) - (let ((rhs (elmo-msgdb-message-match-condition handler - (nth 2 condition) - entity flags numbers))) - (cond ((elmo-filter-condition-p rhs) - (list 'or lhs rhs)) - (rhs - t) - (t - lhs)))) - (lhs - t) - (t - (elmo-msgdb-message-match-condition handler - (nth 2 condition) - entity flags numbers))))))) - -;; -(defun elmo-msgdb-match-condition-primitive (handler - condition - entity - flags - numbers) - (catch 'unresolved - (let ((key (elmo-filter-key condition)) - (case-fold-search t) - result) - (cond - ((string= key "last") - (setq result (<= (length (memq - (elmo-msgdb-message-entity-number - handler entity) - numbers)) - (string-to-int (elmo-filter-value condition))))) - ((string= key "first") - (setq result (< (- - (length numbers) - (length (memq - (elmo-msgdb-message-entity-number - handler entity) - numbers))) - (string-to-int (elmo-filter-value condition))))) - ((string= key "flag") - (setq result - (cond - ((string= (elmo-filter-value condition) "any") - (or (memq 'important flags) - (memq 'answered flags) - (memq 'unread flags))) - ((string= (elmo-filter-value condition) "digest") - (or (memq 'important flags) - (memq 'unread flags))) - ((string= (elmo-filter-value condition) "unread") - (memq 'unread flags)) - ((string= (elmo-filter-value condition) "important") - (memq 'important flags)) - ((string= (elmo-filter-value condition) "answered") - (memq 'answered flags))))) - ((string= key "from") - (setq result (string-match - (elmo-filter-value condition) - (elmo-msgdb-message-entity-field - handler entity 'from)))) - ((string= key "subject") - (setq result (string-match - (elmo-filter-value condition) - (elmo-msgdb-message-entity-field - handler entity 'subject)))) - ((string= key "to") - (setq result (string-match - (elmo-filter-value condition) - (elmo-msgdb-message-entity-field - handler entity 'to 'string)))) - ((string= key "cc") - (setq result (string-match - (elmo-filter-value condition) - (elmo-msgdb-message-entity-field - handler entity 'cc 'string)))) - ((or (string= key "since") - (string= key "before")) - (let ((field-date (elmo-msgdb-message-entity-field - handler entity 'date)) - (specified-date - (elmo-datevec-to-time - (elmo-date-get-datevec - (elmo-filter-value condition))))) - (setq result (if (string= key "since") - (not (elmo-time< field-date specified-date)) - (elmo-time< field-date specified-date))))) - ((member key elmo-msgdb-extra-fields) - (let ((extval (elmo-msgdb-message-entity-field handler - entity - (intern key) - 'string))) - (when (stringp extval) - (setq result (string-match - (elmo-filter-value condition) - extval))))) - (t - (throw 'unresolved condition))) - (if (eq (elmo-filter-type condition) 'unmatch) - (not result) - result)))) + ((handler modb-entity-handler) condition entity) + (let ((key (elmo-filter-key condition)) + (case-fold-search t) + field-value) + (cond + ((or (string= key "since") + (string= key "before")) + (let ((field-date (elmo-msgdb-message-entity-field + handler entity 'date)) + (specified-date + (elmo-datevec-to-time + (elmo-date-get-datevec + (elmo-filter-value condition))))) + (if (string= key "since") + (not (elmo-time< field-date specified-date)) + (elmo-time< field-date specified-date)))) + ((setq field-value (elmo-msgdb-message-entity-field handler + entity + (intern key) + 'string)) + (and (stringp field-value) + (string-match (elmo-filter-value condition) field-value))) + (t + condition)))) ;; Standard implementation. @@ -946,6 +841,67 @@ If each field is t, function is set as default converter." (elmo-msgdb-get-decoded-cache (car value)) (cdr value)))) +;; message buffer handler +(eval-and-compile + (luna-define-class modb-buffer-entity-handler (modb-entity-handler))) + +(defvar modb-buffer-entity-specializer nil) +(modb-set-field-converter 'modb-buffer-entity-specializer nil + 'date #'elmo-time-parse-date-string) + +(luna-define-method elmo-msgdb-make-message-entity + ((handler modb-buffer-entity-handler) args) + (cons handler (cons (or (plist-get args :number) + (plist-get args 'number)) + (or (plist-get args :buffer) + (plist-get args 'buffer) + (current-buffer))))) + +(luna-define-method elmo-msgdb-message-entity-number + ((handler modb-buffer-entity-handler) entity) + (car (cdr entity))) + +(luna-define-method elmo-msgdb-message-entity-set-number + ((handler modb-buffer-entity-handler) entity number) + (and entity (setcar (cdr entity) number))) + +(luna-define-method elmo-msgdb-message-entity-field + ((handler modb-buffer-entity-handler) entity field &optional type) + (and entity + (let ((elmo-mime-charset + (or (modb-entity-handler-mime-charset-internal handler) + elmo-mime-charset))) + (modb-convert-field-value + modb-buffer-entity-specializer + field + (if (memq field '(number :number)) + (car (cdr entity)) + (with-current-buffer (cdr (cdr entity)) + (let ((extractor (cdr (assq field + modb-entity-field-extractor-alist)))) + (if extractor + (funcall extractor field) + (mapconcat + (lambda (field-body) + (mime-decode-field-body field-body (symbol-name field) + 'summary)) + (elmo-multiple-field-body (symbol-name field)) + "\n"))))) + type)))) + +(luna-define-method elmo-msgdb-message-match-condition :around + ((handler modb-buffer-entity-handler) condition entity) + (let ((key (elmo-filter-key condition)) + (case-fold-search t)) + (cond + ((string= (elmo-filter-key condition) "body") + (with-current-buffer (cdr (cdr entity)) + (goto-char (point-min)) + (and (re-search-forward "^$" nil t) ; goto body + (search-forward (elmo-filter-value condition) nil t)))) + (t + (luna-call-next-method))))) + (require 'product) (product-provide (provide 'modb-entity) (require 'elmo-version)) diff --git a/elmo/modb.el b/elmo/modb.el index 8db8aed..762113f 100644 --- a/elmo/modb.el +++ b/elmo/modb.el @@ -219,14 +219,43 @@ If optional argument TYPE is specified, return converted value.") &optional numbers) (let ((entity (elmo-msgdb-message-entity msgdb number))) (if entity - (elmo-msgdb-message-match-condition - (elmo-message-entity-handler entity) + (elmo-condition-match condition - entity - (elmo-msgdb-flags msgdb number) - (or numbers (elmo-msgdb-list-messages msgdb))) + #'elmo-msgdb-match-condition-primitive + (list msgdb number entity + (or numbers (elmo-msgdb-list-messages msgdb)))) condition))) +(defun elmo-msgdb-match-condition-primitive (condition msgdb number entity + population) + (let ((key (elmo-filter-key condition)) + (case-fold-search t)) + (cond + ((string= key "last") + (<= (length (memq number population)) + (string-to-int (elmo-filter-value condition)))) + ((string= key "first") + (< (- (length population) + (length (memq number population))) + (string-to-int (elmo-filter-value condition)))) + ((string= key "flag") + (let ((flags (elmo-msgdb-flags msgdb number))) + (cond ((string= (elmo-filter-value condition) "any") + (and flags (not (equal flags '(cached))))) + ((string= (elmo-filter-value condition) "digest") + (catch 'found + (dolist (flag flags) + (when (or (memq flag elmo-digest-flags) + (elmo-global-flag-p flag)) + (throw 'found t))))) + ((string= (elmo-filter-value condition) "read") + (not (memq 'read flags))) + (t + (memq (intern (elmo-filter-value condition)) flags))))) + (t + (elmo-msgdb-message-match-condition (elmo-message-entity-handler entity) + condition entity))))) + (luna-define-method elmo-msgdb-update-entity ((msgdb modb-generic) entity values) (when (elmo-msgdb-message-entity-update-fields