elmo/modb-standard.el

   1 ;;; modb-standard.el --- Standartd Implement of MODB.
   2
   3 ;; Copyright (C) 2003 Yuuichi Teranishi <teranisi@gohome.org>
   4
   5 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
   6 ;;      Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
   7 ;; Keywords: mail, net news
   8
   9 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
  10
  11 ;; This program is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15 ;;
  16 ;; This program is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20 ;;
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25 ;;
  26
  27 ;;; Commentary:
  28 ;;
  29
  30 ;;; Code:
  31 ;;
  32 (eval-when-compile (require 'cl))
  33
  34 (require 'elmo-util)
  35 (require 'modb)
  36 ;; Currently, entity structure is same as legacy.
  37 (require 'modb-legacy)
  38
  39
  40 (defcustom modb-standard-divide-number 500
  41   "*Standard modb divide entity number."
  42   :type '(choice (const :tag "Not divide" nil)
  43                  number)
  44   :group 'elmo)
  45
  46 (defvar modb-standard-entity-filename "entity"
  47   "Message entity database.")
  48
  49 (defvar modb-standard-flag-filename "flag"
  50   "Message number <=> Flag status database.")
  51
  52 (defvar modb-standard-msgid-filename "msgid"
  53   "Message number <=> Message-Id database.")
  54
  55 (eval-and-compile
  56   (luna-define-class modb-standard (modb-generic)
  57                      (number-list       ; sorted list of message numbers.
  58                       entity-map        ; number, msg-id -> entity mapping.
  59                       flag-map          ; number -> flag-list mapping
  60                       ))
  61   (luna-define-internal-accessors 'modb-standard))
  62
  63 ;; for internal use only
  64 (defsubst modb-standard-key (number)
  65   (concat "#" (number-to-string number)))
  66
  67 (defsubst modb-standard-entity-id (entity)
  68   (if (eq 'autoload (car-safe entity))
  69       (cddr entity)
  70     (elmo-msgdb-overview-entity-get-id entity)))
  71
  72 (defsubst modb-standard-entity-map (modb)
  73   (or (modb-standard-entity-map-internal modb)
  74       (modb-standard-set-entity-map-internal
  75        modb
  76        (elmo-make-hash (elmo-msgdb-length modb)))))
  77
  78 (defsubst modb-standard-flag-map (modb)
  79   (or (modb-standard-flag-map-internal modb)
  80       (modb-standard-set-flag-map-internal
  81        modb
  82        (elmo-make-hash (elmo-msgdb-length modb)))))
  83
  84 (defsubst modb-standard-set-message-modified (modb number)
  85   (if modb-standard-divide-number
  86       (let ((section (/ number modb-standard-divide-number))
  87             (modified (modb-generic-message-modified-internal modb)))
  88         (unless (memq section modified)
  89           (modb-generic-set-message-modified-internal
  90            modb (cons section modified))))
  91     (modb-generic-set-message-modified-internal modb t)))
  92
  93 (defsubst modb-standard-set-flag-modified (modb number)
  94   (modb-generic-set-flag-modified-internal modb t))
  95
  96 (defsubst modb-standard-message-flags (modb number)
  97   (cdr (elmo-get-hash-val (modb-standard-key number)
  98                           (modb-standard-flag-map-internal modb))))
  99
 100 (defsubst modb-standard-match-flags (check-flags flags)
 101   (catch 'done
 102     (while check-flags
 103       (when (memq (car check-flags) flags)
 104         (throw 'done t))
 105       (setq check-flags (cdr check-flags)))))
 106
 107
 108 ;; save and load functions
 109 (defun modb-standard-load-msgid (modb path)
 110   (let* ((alist (elmo-object-load
 111                  (expand-file-name modb-standard-msgid-filename path)))
 112          (table (or (modb-standard-entity-map-internal modb)
 113                     (elmo-make-hash (length alist))))
 114          numbers info)
 115     (dolist (pair alist)
 116       (setq info (cons 'autoload pair))
 117       (elmo-set-hash-val (modb-standard-key (car pair)) info table)
 118       (elmo-set-hash-val (cdr pair) info table)
 119       (setq numbers (cons (car pair) numbers)))
 120     (modb-standard-set-number-list-internal modb (nreverse numbers))
 121     (modb-standard-set-entity-map-internal modb table)))
 122
 123 (defun modb-standard-save-msgid (modb path)
 124   (let ((table (modb-standard-entity-map-internal modb))
 125         entity alist)
 126     (dolist (number (modb-standard-number-list-internal modb))
 127       (setq entity (elmo-get-hash-val (modb-standard-key number) table))
 128       (setq alist (cons (cons number (modb-standard-entity-id entity))
 129                         alist)))
 130     (elmo-object-save
 131      (expand-file-name modb-standard-msgid-filename path)
 132      (nreverse alist))))
 133
 134 (defun modb-standard-load-flag (modb path)
 135   (let ((table (or (modb-standard-flag-map-internal modb)
 136                    (elmo-make-hash (elmo-msgdb-length modb)))))
 137     (dolist (info (elmo-object-load
 138                    (expand-file-name modb-standard-flag-filename path)))
 139       (elmo-set-hash-val (modb-standard-key (car info)) info table))
 140     (modb-standard-set-flag-map-internal modb table)))
 141
 142 (defun modb-standard-save-flag (modb path)
 143   (let (table flist info)
 144     (when (setq table (modb-standard-flag-map-internal modb))
 145       (mapatoms
 146        (lambda (atom)
 147          (setq info (symbol-value atom))
 148          (when (cdr info)
 149            (setq flist (cons info flist))))
 150        table))
 151     (elmo-object-save
 152      (expand-file-name modb-standard-flag-filename path)
 153      flist)))
 154
 155 (defsubst modb-standard-entity-filename (section)
 156   (if section
 157       (concat modb-standard-entity-filename
 158               "-"
 159               (number-to-string section))
 160     modb-standard-entity-filename))
 161
 162 (defun modb-standard-load-entity (modb path &optional section)
 163   (let ((table (or (modb-standard-entity-map-internal modb)
 164                    (elmo-make-hash (elmo-msgdb-length modb)))))
 165     (dolist (entity (elmo-object-load
 166                      (expand-file-name
 167                       (modb-standard-entity-filename section)
 168                       path)))
 169       (elmo-set-hash-val (modb-standard-key
 170                           (elmo-msgdb-overview-entity-get-number entity))
 171                          entity
 172                          table)
 173       (elmo-set-hash-val (elmo-msgdb-overview-entity-get-id entity)
 174                          entity
 175                          table))
 176     (modb-standard-set-entity-map-internal modb table)))
 177
 178 (defsubst modb-standard-save-entity-1 (modb path &optional section)
 179   (let ((table (modb-standard-entity-map-internal modb))
 180         (filename (expand-file-name
 181                    (modb-standard-entity-filename section) path))
 182         entity entities)
 183     (dolist (number (modb-standard-number-list-internal modb))
 184       (when (and (or (null section)
 185                      (= section (/ number modb-standard-divide-number)))
 186                  (setq entity (elmo-msgdb-message-entity modb number)))
 187         (setq entities (cons entity entities))))
 188     (if entities
 189         (elmo-object-save filename entities)
 190       (ignore-errors (delete-file filename)))))
 191
 192 (defun modb-standard-save-entity (modb path)
 193   (let ((sections (modb-generic-message-modified-internal modb)))
 194     (cond ((listp sections)
 195            (dolist (section sections)
 196              (modb-standard-save-entity-1 modb path section)))
 197           (sections
 198            (modb-standard-save-entity-1 modb path)))))
 199
 200 ;;; Implement
 201 ;;
 202 (luna-define-method elmo-msgdb-load ((msgdb modb-standard))
 203   (let ((inhibit-quit t)
 204         (path (elmo-msgdb-location msgdb)))
 205     (when (file-exists-p (expand-file-name modb-standard-flag-filename path))
 206       (modb-standard-load-msgid msgdb path)
 207       (modb-standard-load-flag msgdb path)
 208       (unless modb-standard-divide-number
 209         (modb-standard-load-entity msgdb path))
 210       t)))
 211
 212 (luna-define-method elmo-msgdb-save ((msgdb modb-standard))
 213   (let ((path (elmo-msgdb-location msgdb)))
 214     (when (elmo-msgdb-message-modified-p msgdb)
 215       (modb-standard-save-msgid  msgdb path)
 216       (modb-standard-save-entity msgdb path)
 217       (modb-generic-set-message-modified-internal msgdb nil))
 218     (when (elmo-msgdb-flag-modified-p msgdb)
 219       (modb-standard-save-flag msgdb path)
 220       (modb-generic-set-flag-modified-internal msgdb nil))))
 221
 222 (luna-define-method elmo-msgdb-append :around ((msgdb modb-standard)
 223                                                msgdb-append)
 224   (when (> (elmo-msgdb-length msgdb-append) 0)
 225     (if (eq (luna-class-name msgdb-append) 'modb-standard)
 226         (let ((numbers (modb-standard-number-list-internal msgdb-append))
 227               duplicates)
 228           ;; number-list
 229           (modb-standard-set-number-list-internal
 230            msgdb
 231            (nconc (modb-standard-number-list-internal msgdb)
 232                   numbers))
 233           ;; entity-map
 234           (let ((table (modb-standard-entity-map msgdb))
 235                 entity msg-id)
 236             (dolist (number numbers)
 237               (setq entity (elmo-msgdb-message-entity msgdb-append number)
 238                     msg-id (modb-standard-entity-id entity))
 239               (if (elmo-get-hash-val msg-id table)
 240                   (setq duplicates (cons number duplicates))
 241                 (elmo-set-hash-val msg-id entity table))
 242               (elmo-set-hash-val (modb-standard-key number)
 243                                  entity
 244                                  table)))
 245           ;; flag-map
 246           (let ((table (modb-standard-flag-map msgdb)))
 247             (mapatoms
 248              (lambda (atom)
 249                (elmo-set-hash-val (symbol-name atom)
 250                                   (symbol-value atom)
 251                                   table))
 252              (modb-standard-flag-map msgdb-append)))
 253           ;; modification flags
 254           (dolist (number (modb-standard-number-list-internal msgdb-append))
 255             (modb-standard-set-message-modified msgdb number)
 256             (modb-standard-set-flag-modified msgdb number))
 257           duplicates)
 258       (luna-call-next-method))))
 259
 260 (luna-define-method elmo-msgdb-clear :after ((msgdb modb-standard))
 261   (modb-standard-set-number-list-internal msgdb nil)
 262   (modb-standard-set-entity-map-internal msgdb nil)
 263   (modb-standard-set-flag-map-internal msgdb nil))
 264
 265 (luna-define-method elmo-msgdb-length ((msgdb modb-standard))
 266   (length (modb-standard-number-list-internal msgdb)))
 267
 268 (luna-define-method elmo-msgdb-flags ((msgdb modb-standard) number)
 269   (modb-standard-message-flags msgdb number))
 270
 271 (luna-define-method elmo-msgdb-set-flag ((msgdb modb-standard)
 272                                          number flag)
 273   (case flag
 274     (read
 275      (elmo-msgdb-unset-flag msgdb number 'unread))
 276     (uncached
 277      (elmo-msgdb-unset-flag msgdb number 'cached))
 278     (t
 279      (let* ((cur-flags (modb-standard-message-flags msgdb number))
 280             (new-flags (copy-sequence cur-flags)))
 281        (and (memq 'new new-flags)
 282             (setq new-flags (delq 'new new-flags)))
 283        (or (memq flag new-flags)
 284            (setq new-flags (cons flag new-flags)))
 285        (when (and (eq flag 'unread)
 286                   (memq 'answered new-flags))
 287          (setq new-flags (delq 'answered new-flags)))
 288        (unless (equal new-flags cur-flags)
 289          (elmo-set-hash-val (modb-standard-key number)
 290                             (cons number new-flags)
 291                             (modb-standard-flag-map msgdb))
 292          (modb-standard-set-flag-modified msgdb number))))))
 293
 294 (luna-define-method elmo-msgdb-unset-flag ((msgdb modb-standard)
 295                                            number flag)
 296   (case flag
 297     (read
 298      (elmo-msgdb-set-flag msgdb number 'unread))
 299     (uncached
 300      (elmo-msgdb-set-flag msgdb number 'cached))
 301     (t
 302      (let* ((cur-flags (modb-standard-message-flags msgdb number))
 303             (new-flags (copy-sequence cur-flags)))
 304        (and (memq 'new new-flags)
 305             (setq new-flags (delq 'new new-flags)))
 306        (and (memq flag new-flags)
 307             (setq new-flags (delq flag new-flags)))
 308        (when (and (eq flag 'unread)
 309                   (memq 'answered new-flags))
 310          (setq new-flags (delq 'answered new-flags)))
 311        (unless (equal new-flags cur-flags)
 312          (elmo-set-hash-val (modb-standard-key number)
 313                             (cons number new-flags)
 314                             (modb-standard-flag-map msgdb))
 315          (modb-standard-set-flag-modified msgdb number))))))
 316
 317 (luna-define-method elmo-msgdb-list-messages ((msgdb modb-standard))
 318   (copy-sequence
 319    (modb-standard-number-list-internal msgdb)))
 320
 321 (luna-define-method elmo-msgdb-list-flagged ((msgdb modb-standard) flag)
 322   (let (entry matched)
 323     (case flag
 324       (read
 325        (dolist (number (modb-standard-number-list-internal msgdb))
 326          (unless (memq 'unread (modb-standard-message-flags msgdb number))
 327            (setq matched (cons number matched)))))
 328       (digest
 329        (mapatoms
 330         (lambda (atom)
 331           (setq entry (symbol-value atom))
 332           (when (modb-standard-match-flags '(unread important)
 333                                            (cdr entry))
 334             (setq matched (cons (car entry) matched))))
 335         (modb-standard-flag-map msgdb)))
 336       (any
 337        (mapatoms
 338         (lambda (atom)
 339           (setq entry (symbol-value atom))
 340           (when (modb-standard-match-flags '(unread important answered)
 341                                            (cdr entry))
 342             (setq matched (cons (car entry) matched))))
 343         (modb-standard-flag-map msgdb)))
 344       (t
 345        (mapatoms
 346         (lambda (atom)
 347           (setq entry (symbol-value atom))
 348           (when (memq flag (cdr entry))
 349             (setq matched (cons (car entry) matched))))
 350         (modb-standard-flag-map msgdb))))
 351     matched))
 352
 353 (luna-define-method elmo-msgdb-append-entity ((msgdb modb-standard)
 354                                               entity &optional flags)
 355   (let ((number (elmo-msgdb-overview-entity-get-number entity))
 356         (msg-id (elmo-msgdb-overview-entity-get-id entity))
 357         duplicate)
 358     ;; number-list
 359     (modb-standard-set-number-list-internal
 360      msgdb
 361      (nconc (modb-standard-number-list-internal msgdb)
 362             (list number)))
 363     ;; entity-map
 364     (let ((table (modb-standard-entity-map msgdb)))
 365       (setq duplicate (elmo-get-hash-val msg-id table))
 366       (elmo-set-hash-val (modb-standard-key number) entity table)
 367       (elmo-set-hash-val msg-id entity table))
 368     ;; modification flags
 369     (modb-standard-set-message-modified msgdb number)
 370     ;; flag-map
 371     (when flags
 372       (elmo-set-hash-val
 373        (modb-standard-key number)
 374        (cons number flags)
 375        (modb-standard-flag-map msgdb))
 376       (modb-standard-set-flag-modified msgdb number))
 377     duplicate))
 378
 379 (luna-define-method elmo-msgdb-delete-messages ((msgdb modb-standard)
 380                                                 numbers)
 381   (let ((number-list (modb-standard-number-list-internal msgdb))
 382         (entity-map (modb-standard-entity-map-internal msgdb))
 383         (flag-map (modb-standard-flag-map-internal msgdb))
 384         key entity)
 385     (dolist (number numbers)
 386       (setq key (modb-standard-key number)
 387             entity (elmo-get-hash-val key entity-map))
 388       ;; number-list
 389       (setq number-list (delq number number-list))
 390       ;; entity-map
 391       (elmo-clear-hash-val key entity-map)
 392       (elmo-clear-hash-val (modb-standard-entity-id entity) entity-map)
 393       ;; flag-map
 394       (elmo-clear-hash-val key flag-map)
 395       (modb-standard-set-message-modified msgdb number)
 396       (modb-standard-set-flag-modified msgdb number))
 397     (modb-standard-set-number-list-internal msgdb number-list)
 398     (modb-standard-set-entity-map-internal msgdb entity-map)
 399     (modb-standard-set-flag-map-internal msgdb flag-map)))
 400
 401 (luna-define-method elmo-msgdb-sort-entities ((msgdb modb-standard)
 402                                               predicate &optional app-data)
 403   (message "Sorting...")
 404   (let ((numbers (modb-standard-number-list-internal msgdb)))
 405     (modb-standard-set-number-list-internal
 406      msgdb
 407      (sort numbers (lambda (a b)
 408                      (funcall predicate
 409                               (elmo-msgdb-message-entity msgdb a)
 410                               (elmo-msgdb-message-entity msgdb b)
 411                               app-data))))
 412     (message "Sorting...done")
 413     msgdb))
 414
 415 (luna-define-method elmo-msgdb-message-entity ((msgdb modb-standard) key)
 416   (let ((ret (elmo-get-hash-val
 417               (cond ((stringp key) key)
 418                     ((numberp key) (modb-standard-key key)))
 419               (modb-standard-entity-map-internal msgdb))))
 420     (if (eq 'autoload (car-safe ret))
 421         (when modb-standard-divide-number
 422           (modb-standard-load-entity
 423            msgdb
 424            (elmo-msgdb-location msgdb)
 425            (/ (nth 1 ret) modb-standard-divide-number))
 426           (elmo-get-hash-val
 427            (cond ((stringp key) key)
 428                  ((numberp key) (modb-standard-key key)))
 429            (modb-standard-entity-map-internal msgdb)))
 430       ret)))
 431
 432 ;;; Message entity handling.
 433 (defsubst modb-standard-make-message-entity (args)
 434   "Make an message entity."
 435   (cons (plist-get args :message-id)
 436         (vector (plist-get args :number)
 437                 (plist-get args :references)
 438                 (plist-get args :from)
 439                 (plist-get args :subject)
 440                 (plist-get args :date)
 441                 (plist-get args :to)
 442                 (plist-get args :cc)
 443                 (plist-get args :size)
 444                 (plist-get args :extra))))
 445
 446 (luna-define-method elmo-msgdb-make-message-entity ((msgdb modb-standard)
 447                                                     args)
 448   (modb-standard-make-message-entity args))
 449
 450 (luna-define-method elmo-msgdb-create-message-entity-from-file
 451   ((msgdb modb-standard) number file)
 452   (let (insert-file-contents-pre-hook   ; To avoid autoconv-xmas...
 453         insert-file-contents-post-hook header-end
 454         (attrib (file-attributes file))
 455         ret-val size mtime)
 456     (with-temp-buffer
 457       (if (not (file-exists-p file))
 458           ()
 459         (setq size (nth 7 attrib))
 460         (setq mtime (timezone-make-date-arpa-standard
 461                      (current-time-string (nth 5 attrib)) (current-time-zone)))
 462         ;; insert header from file.
 463         (catch 'done
 464           (condition-case nil
 465               (elmo-msgdb-insert-file-header file)
 466             (error (throw 'done nil)))
 467           (goto-char (point-min))
 468           (setq header-end
 469                 (if (re-search-forward "\\(^--.*$\\)\\|\\(\n\n\\)" nil t)
 470                     (point)
 471                   (point-max)))
 472           (narrow-to-region (point-min) header-end)
 473           (elmo-msgdb-create-message-entity-from-buffer
 474            msgdb number :size size :date mtime))))))
 475
 476 (luna-define-method elmo-msgdb-create-message-entity-from-buffer
 477   ((msgdb modb-standard) number args)
 478   (let ((extras elmo-msgdb-extra-fields)
 479         (default-mime-charset default-mime-charset)
 480         entity message-id references from subject to cc date
 481         extra field-body charset size)
 482     (save-excursion
 483       (setq entity (modb-standard-make-message-entity args))
 484       (elmo-set-buffer-multibyte default-enable-multibyte-characters)
 485       (setq message-id (elmo-msgdb-get-message-id-from-buffer))
 486       (and (setq charset (cdr (assoc "charset" (mime-read-Content-Type))))
 487            (setq charset (intern-soft charset))
 488            (setq default-mime-charset charset))
 489       (setq references
 490             (or (elmo-msgdb-get-last-message-id
 491                  (elmo-field-body "in-reply-to"))
 492                 (elmo-msgdb-get-last-message-id
 493                  (elmo-field-body "references")))
 494             from (elmo-replace-in-string
 495                   (elmo-mime-string (or (elmo-field-body "from")
 496                                         elmo-no-from))
 497                   "\t" " ")
 498             subject (elmo-replace-in-string
 499                      (elmo-mime-string (or (elmo-field-body "subject")
 500                                            elmo-no-subject))
 501                      "\t" " ")
 502             date (elmo-field-body "date")
 503             to   (mapconcat 'identity (elmo-multiple-field-body "to") ",")
 504             cc   (mapconcat 'identity (elmo-multiple-field-body "cc") ","))
 505       (unless (elmo-msgdb-message-entity-field msgdb entity 'size)
 506         (if (setq size (elmo-field-body "content-length"))
 507             (setq size (string-to-int size))
 508           (setq size 0)))
 509       (while extras
 510         (if (setq field-body (elmo-field-body (car extras)))
 511             (setq extra (cons (cons (downcase (car extras))
 512                                     field-body) extra)))
 513         (setq extras (cdr extras)))
 514       (dolist (field '(number message-id references from subject date to cc
 515                               size extra))
 516         (when (symbol-value field)
 517           (elmo-msgdb-message-entity-set-field
 518            msgdb entity field (symbol-value field))))
 519       entity)))
 520
 521 ;;; Message entity interface
 522 ;;
 523 (luna-define-method elmo-msgdb-message-entity-field ((msgdb modb-standard)
 524                                                      entity field
 525                                                      &optional decode)
 526   (and entity
 527        (let ((field-value
 528               (case field
 529                 (to (aref (cdr entity) 5))
 530                 (cc (aref (cdr entity) 6))
 531                 (date (aref (cdr entity) 4))
 532                 (subject (aref (cdr entity) 3))
 533                 (from (aref (cdr entity) 2))
 534                 (message-id (car entity))
 535                 (references (aref (cdr entity) 1))
 536                 (size (aref (cdr entity) 7))
 537                 (t (cdr (assoc (symbol-name field) (aref (cdr entity) 8)))))))
 538          (if (and decode (memq field '(from subject)))
 539              (elmo-msgdb-get-decoded-cache field-value)
 540            field-value))))
 541
 542 (luna-define-method elmo-msgdb-message-entity-set-field ((msgdb modb-standard)
 543                                                          entity field value)
 544   (and entity
 545        (case field
 546          (number (aset (cdr entity) 0 value))
 547          (to (aset (cdr entity) 5 value))
 548          (cc (aset (cdr entity) 6 value))
 549          (date (aset (cdr entity) 4 value))
 550          (subject (aset (cdr entity) 3 value))
 551          (from (aset (cdr entity) 2 value))
 552          (message-id (setcar entity value))
 553          (references (aset (cdr entity) 1 value))
 554          (size (aset (cdr entity) 7 value))
 555          (t
 556           (let ((extras (and entity (aref (cdr entity) 8)))
 557                 extra)
 558             (if (setq extra (assoc field extras))
 559                 (setcdr extra value)
 560               (aset (cdr entity) 8 (cons (cons (symbol-name field)
 561                                                value) extras))))))))
 562
 563 (luna-define-method elmo-msgdb-copy-message-entity ((msgdb modb-standard)
 564                                                     entity)
 565   (cons (car entity)
 566         (copy-sequence (cdr entity))))
 567
 568 (luna-define-method elmo-msgdb-match-condition-internal ((msgdb modb-standard)
 569                                                          condition
 570                                                          entity flags numbers)
 571   (cond
 572    ((vectorp condition)
 573     (elmo-msgdb-match-condition-primitive condition entity flags numbers))
 574    ((eq (car condition) 'and)
 575     (let ((lhs (elmo-msgdb-match-condition-internal msgdb
 576                                                     (nth 1 condition)
 577                                                     entity flags numbers)))
 578       (cond
 579        ((elmo-filter-condition-p lhs)
 580         (let ((rhs (elmo-msgdb-match-condition-internal
 581                     msgdb (nth 2 condition) entity flags numbers)))
 582           (cond ((elmo-filter-condition-p rhs)
 583                  (list 'and lhs rhs))
 584                 (rhs
 585                  lhs))))
 586        (lhs
 587         (elmo-msgdb-match-condition-internal msgdb (nth 2 condition)
 588                                              entity flags numbers)))))
 589    ((eq (car condition) 'or)
 590     (let ((lhs (elmo-msgdb-match-condition-internal msgdb (nth 1 condition)
 591                                                     entity flags numbers)))
 592       (cond
 593        ((elmo-filter-condition-p lhs)
 594         (let ((rhs (elmo-msgdb-match-condition-internal msgdb
 595                                                         (nth 2 condition)
 596                                                         entity flags numbers)))
 597           (cond ((elmo-filter-condition-p rhs)
 598                  (list 'or lhs rhs))
 599                 (rhs
 600                  t)
 601                 (t
 602                  lhs))))
 603        (lhs
 604         t)
 605        (t
 606         (elmo-msgdb-match-condition-internal msgdb
 607                                              (nth 2 condition)
 608                                              entity flags numbers)))))))
 609
 610 (require 'product)
 611 (product-provide (provide 'modb-standard) (require 'elmo-version))
 612
 613 ;;; modb-standard.el ends here