elmo/elmo-msgdb.el

   1 ;;; elmo-msgdb.el --- Message Database for ELMO.
   2
   3 ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
   4 ;; Copyright (C) 2000           Masahiro MURATA <muse@ba2.so-net.ne.jp>
   5
   6 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
   7 ;;      Masahiro MURATA <muse@ba2.so-net.ne.jp>
   8 ;; Keywords: mail, net news
   9
  10 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
  11
  12 ;; This program is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16 ;;
  17 ;; This program is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21 ;;
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25 ;; Boston, MA 02111-1307, USA.
  26 ;;
  27
  28 ;;; Commentary:
  29 ;;
  30
  31 ;;; Code:
  32 ;;
  33
  34 (eval-when-compile (require 'cl))
  35 (require 'elmo-vars)
  36 (require 'elmo-util)
  37 (require 'emu)
  38 (require 'std11)
  39 (require 'mime)
  40
  41 (defconst elmo-msgdb-new-mark "N"
  42   "Mark for new message.")
  43
  44 (defconst elmo-msgdb-unread-uncached-mark "U"
  45   "Mark for unread and uncached message.")
  46
  47 (defconst elmo-msgdb-unread-cached-mark "!"
  48   "Mark for unread but already cached message.")
  49
  50 (defconst elmo-msgdb-read-uncached-mark "u"
  51   "Mark for read but uncached message.")
  52
  53 (defconst elmo-msgdb-answered-cached-mark "&"
  54   "Mark for answered and cached message.")
  55
  56 (defconst elmo-msgdb-answered-uncached-mark "A"
  57   "Mark for answered but cached message.")
  58
  59 (defconst elmo-msgdb-important-mark "$"
  60   "Mark for important message.")
  61
  62 ;;; MSGDB interface.
  63 ;;
  64 ;; MSGDB elmo-load-msgdb PATH
  65 ;; MARK elmo-msgdb-get-mark MSGDB NUMBER
  66
  67 ;; CACHED elmo-msgdb-get-cached MSGDB NUMBER
  68 ;; VOID elmo-msgdb-set-cached MSGDB NUMBER CACHED USE-CACHE
  69 ;; VOID elmo-msgdb-set-flag MSGDB FOLDER NUMBER FLAG
  70 ;; VOID elmo-msgdb-unset-flag MSGDB FOLDER NUMBER FLAG
  71
  72 ;; LIST-OF-NUMBERS elmo-msgdb-count-marks MSGDB
  73 ;; NUMBER elmo-msgdb-get-number MSGDB MESSAGE-ID
  74 ;; FIELD-VALUE elmo-msgdb-get-field MSGDB NUMBER FIELD
  75 ;; MSGDB elmo-msgdb-append MSGDB MSGDB-APPEND
  76 ;; MSGDB elmo-msgdb-clear MSGDB
  77 ;; elmo-msgdb-delete-messages MSGDB NUMBERS
  78 ;; elmo-msgdb-sort-by-date MSGDB
  79
  80 ;;;
  81 ;; LIST-OF-NUMBERS elmo-msgdb-list-messages MSGDB
  82
  83 ;; elmo-flag-table-load
  84 ;; elmo-flag-table-set
  85 ;; elmo-flag-table-get
  86 ;; elmo-flag-table-save
  87
  88 ;; elmo-msgdb-append-entity MSGDB ENTITY MARK-OR-FLAGS
  89
  90 ;; ENTITY elmo-msgdb-make-entity ARGS
  91 ;; VALUE elmo-msgdb-entity-field ENTITY
  92 ;;
  93
  94 ;; OVERVIEW elmo-msgdb-get-overview MSGDB
  95 ;; NUMBER-ALIST elmo-msgdb-get-number-alist MSGDB
  96 ;; MARK-ALIST elmo-msgdb-get-mark-alist MSGDB
  97 ;; elmo-msgdb-change-mark MSGDB BEFORE AFTER
  98
  99 ;; (for internal use?)
 100 ;; LIST-OF-MARKS elmo-msgdb-unread-marks
 101 ;; LIST-OF-MARKS elmo-msgdb-answered-marks
 102 ;; LIST-OF-MARKS elmo-msgdb-uncached-marks
 103 ;; elmo-msgdb-overview-save DIR OBJ
 104
 105 ;; elmo-msgdb-message-entity MSGDB KEY
 106
 107 ;;; Abolish
 108 ;; elmo-msgdb-overview-entity-get-references ENTITY
 109 ;; elmo-msgdb-overview-entity-set-references ENTITY
 110 ;; elmo-msgdb-get-parent-entity ENTITY MSGDB
 111 ;; elmo-msgdb-overview-enitty-get-number ENTITY
 112 ;; elmo-msgdb-overview-enitty-get-from-no-decode ENTITY
 113 ;; elmo-msgdb-overview-enitty-get-from ENTITY
 114 ;; elmo-msgdb-overview-enitty-get-subject-no-decode ENTITY
 115 ;; elmo-msgdb-overview-enitty-get-subject ENTITY
 116 ;; elmo-msgdb-overview-enitty-get-date ENTITY
 117 ;; elmo-msgdb-overview-enitty-get-to ENTITY
 118 ;; elmo-msgdb-overview-enitty-get-cc ENTITY
 119 ;; elmo-msgdb-overview-enitty-get-size ENTITY
 120 ;; elmo-msgdb-overview-enitty-get-id ENTITY
 121 ;; elmo-msgdb-overview-enitty-get-extra-field ENTITY
 122 ;; elmo-msgdb-overview-enitty-get-extra ENTITY
 123 ;; elmo-msgdb-overview-get-entity ID MSGDB
 124
 125 ;; elmo-msgdb-killed-list-load DIR
 126 ;; elmo-msgdb-killed-list-save DIR
 127 ;; elmo-msgdb-append-to-killed-list FOLDER MSG
 128 ;; elmo-msgdb-killed-list-length KILLED-LIST
 129 ;; elmo-msgdb-max-of-killed KILLED-LIST
 130 ;; elmo-msgdb-killed-message-p KILLED-LIST MSG
 131 ;; elmo-living-messages MESSAGES KILLED-LIST
 132 ;; elmo-msgdb-finfo-load
 133 ;; elmo-msgdb-finfo-save
 134 ;; elmo-msgdb-flist-load
 135 ;; elmo-msgdb-flist-save
 136
 137 ;; elmo-crosspost-alist-load
 138 ;; elmo-crosspost-alist-save
 139
 140 ;; elmo-msgdb-create-overview-from-buffer NUMBER SIZE TIME
 141 ;; elmo-msgdb-copy-overview-entity ENTITY
 142 ;; elmo-msgdb-create-overview-entity-from-file NUMBER FILE
 143 ;; elmo-msgdb-clear-index
 144
 145 ;; elmo-folder-get-info
 146 ;; elmo-folder-get-info-max
 147 ;; elmo-folder-get-info-length
 148 ;; elmo-folder-get-info-unread
 149
 150 ;; elmo-msgdb-list-flagged MSGDB FLAG
 151 ;; (MACRO) elmo-msgdb-do-each-entity
 152
 153 ;;; MSGDB interface
 154 ;;
 155 (eval-and-compile
 156   (luna-define-class elmo-msgdb () (location            ; location for save.
 157                                     message-modified    ; message is modified.
 158                                     flag-modified       ; flag is modified.
 159                                     ))
 160   (luna-define-internal-accessors 'elmo-msgdb))
 161
 162 (luna-define-generic elmo-msgdb-load (msgdb)
 163   "Load the MSGDB.")
 164
 165 (luna-define-generic elmo-msgdb-save (msgdb)
 166   "Save the MSGDB.")
 167
 168 (luna-define-generic elmo-msgdb-location (msgdb)
 169   "Return the location of MSGDB.")
 170
 171 (luna-define-generic elmo-msgdb-message-modified-p (msgdb)
 172   "Return non-nil if message is modified.")
 173
 174 (luna-define-generic elmo-msgdb-flag-modified-p (msgdb)
 175   "Return non-nil if flag is modified.")
 176
 177 (luna-define-generic elmo-msgdb-append (msgdb msgdb-append)
 178   "Append the MSGDB-APPEND to the MSGDB.
 179 Return a list of messages which have duplicated message-id.")
 180
 181 (luna-define-generic elmo-msgdb-clear (msgdb)
 182   "Clear the MSGDB structure.")
 183
 184 (luna-define-generic elmo-msgdb-flags (msgdb number)
 185   "Return a list of flag which corresponds to the message with NUMBER.")
 186
 187 (luna-define-generic elmo-msgdb-set-flag (msgdb number flag)
 188   "Set message flag.
 189 MSGDB is the ELMO msgdb.
 190 NUMBER is a message number to set flag.
 191 FLAG is a symbol which is one of the following:
 192 `new'       ... Message which is new.
 193 `read'      ... Message which is already read.
 194 `important' ... Message which is marked as important.
 195 `answered'  ... Message which is marked as answered.
 196 `cached'    ... Message which is cached.")
 197
 198 (luna-define-generic elmo-msgdb-unset-flag (msgdb number flag)
 199   "Unset message flag.
 200 MSGDB is the ELMO msgdb.
 201 NUMBER is a message number to set flag.
 202 FLAG is a symbol which is one of the following:
 203 `new'       ... Message which is new.
 204 `read'      ... Message which is already read.
 205 `important' ... Message which is marked as important.
 206 `answered'  ... Message which is marked as answered.
 207 `cached'    ... Message which is cached.")
 208
 209 (luna-define-generic elmo-msgdb-list-messages (msgdb)
 210   "Return a list of message numbers in the MSGDB.")
 211
 212 (luna-define-generic elmo-msgdb-list-flagged (msgdb flag)
 213   "Return a list of message numbers which is set FLAG in the MSGDB.")
 214
 215 ;;; (luna-define-generic elmo-msgdb-search (msgdb condition &optional numbers)
 216 ;;;   "Search and return list of message numbers.
 217 ;;; MSGDB is the ELMO msgdb structure.
 218 ;;; CONDITION is a condition structure for searching.
 219 ;;; If optional argument NUMBERS is specified and is a list of message numbers,
 220 ;;; messages are searched from the list.")
 221
 222 (luna-define-generic elmo-msgdb-append-entity (msgdb entity &optional flags)
 223   "Append a ENTITY with FLAGS into the MSGDB.
 224 Return non-nil if message-id of entity is duplicated.")
 225
 226 (luna-define-generic elmo-msgdb-delete-messages (msgdb numbers)
 227   "Delete messages which are contained NUMBERS from MSGDB.")
 228
 229 (luna-define-generic elmo-msgdb-sort-entities (msgdb predicate &optional app-data)
 230   "Sort entities of MSGDB, comparing with PREDICATE.
 231 PREDICATE is called with two entities and APP-DATA.
 232 Should return non-nil if the first entity is \"less\" than the second.")
 233
 234 (luna-define-generic elmo-msgdb-message-entity (msgdb key)
 235   "Return the message-entity structure which matches to the KEY.
 236 KEY is a number or a string.
 237 A number is for message number in the MSGDB.
 238 A string is for message-id of the message.")
 239
 240 ;;; generic implement
 241 ;;
 242 (luna-define-method elmo-msgdb-location ((msgdb elmo-msgdb))
 243   (elmo-msgdb-location-internal msgdb))
 244
 245 (luna-define-method elmo-msgdb-message-modified-p ((msgdb elmo-msgdb))
 246   (elmo-msgdb-message-modified-internal msgdb))
 247
 248 (luna-define-method elmo-msgdb-flag-modified-p ((msgdb elmo-msgdb))
 249   (elmo-msgdb-flag-modified-internal msgdb))
 250
 251 (luna-define-method elmo-msgdb-clear ((msgdb elmo-msgdb))
 252   (elmo-msgdb-set-message-modified-internal msgdb nil)
 253   (elmo-msgdb-set-flag-modified-internal msgdb nil))
 254
 255 (luna-define-method elmo-msgdb-append ((msgdb elmo-msgdb) msgdb-append)
 256   (let (duplicates)
 257     (dolist (number (elmo-msgdb-list-messages msgdb-append))
 258       (when (elmo-msgdb-append-entity
 259              msgdb
 260              (elmo-msgdb-message-entity msgdb-append number)
 261              (elmo-msgdb-flags msgdb-append number))
 262         (setq duplicates (cons number duplicates))))
 263     duplicates))
 264
 265
 266 ;;; legacy implement
 267 ;;
 268 (eval-and-compile
 269   (luna-define-class elmo-msgdb-legacy (elmo-msgdb)
 270                      (overview number-alist mark-alist index))
 271   (luna-define-internal-accessors 'elmo-msgdb-legacy))
 272
 273 ;; for internal use only
 274 (defsubst elmo-msgdb-get-overview (msgdb)
 275   (elmo-msgdb-legacy-overview-internal msgdb))
 276
 277 (defsubst elmo-msgdb-get-number-alist (msgdb)
 278   (elmo-msgdb-legacy-number-alist-internal msgdb))
 279
 280 (defsubst elmo-msgdb-get-mark-alist (msgdb)
 281   (elmo-msgdb-legacy-mark-alist-internal msgdb))
 282
 283 (defsubst elmo-msgdb-get-index (msgdb)
 284   (elmo-msgdb-legacy-index-internal msgdb))
 285
 286 (defsubst elmo-msgdb-get-entity-hashtb (msgdb)
 287   (car (elmo-msgdb-legacy-index-internal msgdb)))
 288
 289 (defsubst elmo-msgdb-get-mark-hashtb (msgdb)
 290   (cdr (elmo-msgdb-legacy-index-internal msgdb)))
 291
 292 (defsubst elmo-msgdb-get-path (msgdb)
 293   (elmo-msgdb-location msgdb))
 294
 295 (defsubst elmo-msgdb-set-overview (msgdb overview)
 296   (elmo-msgdb-legacy-set-overview-internal msgdb overview))
 297
 298 (defsubst elmo-msgdb-set-number-alist (msgdb number-alist)
 299   (elmo-msgdb-legacy-set-number-alist-internal msgdb number-alist))
 300
 301 (defsubst elmo-msgdb-set-mark-alist (msgdb mark-alist)
 302   (elmo-msgdb-legacy-set-mark-alist-internal msgdb mark-alist))
 303
 304 (defsubst elmo-msgdb-set-index (msgdb index)
 305   (elmo-msgdb-legacy-set-index-internal msgdb index))
 306
 307 (defsubst elmo-msgdb-set-path (msgdb path)
 308   (elmo-msgdb-set-location-internal msgdb path))
 309
 310
 311 ;;
 312 (luna-define-method elmo-msgdb-load ((msgdb elmo-msgdb-legacy))
 313   (let ((inhibit-quit t)
 314         (path (elmo-msgdb-location msgdb)))
 315     (when (file-exists-p (expand-file-name elmo-msgdb-mark-filename path))
 316       (elmo-msgdb-legacy-set-overview-internal
 317        msgdb
 318        (elmo-msgdb-overview-load path))
 319       (elmo-msgdb-legacy-set-number-alist-internal
 320        msgdb
 321        (elmo-msgdb-number-load path))
 322       (elmo-msgdb-legacy-set-mark-alist-internal
 323        msgdb
 324        (elmo-msgdb-mark-load path))
 325       (elmo-msgdb-make-index msgdb)
 326       t)))
 327
 328 (luna-define-method elmo-msgdb-save ((msgdb elmo-msgdb-legacy))
 329   (let ((path (elmo-msgdb-location msgdb)))
 330     (when (elmo-msgdb-message-modified-p msgdb)
 331       (elmo-msgdb-overview-save
 332        path
 333        (elmo-msgdb-legacy-overview-internal msgdb))
 334       (elmo-msgdb-number-save
 335        path
 336        (elmo-msgdb-legacy-number-alist-internal msgdb))
 337       (elmo-msgdb-set-message-modified-internal msgdb nil))
 338     (when (elmo-msgdb-flag-modified-p msgdb)
 339       (elmo-msgdb-mark-save
 340        path
 341        (elmo-msgdb-legacy-mark-alist-internal msgdb))
 342       (elmo-msgdb-set-flag-modified-internal msgdb nil))))
 343
 344 (defun elmo-load-msgdb (location)
 345   "Load the MSGDB from PATH."
 346   (let ((msgdb (elmo-make-msgdb location)))
 347     (elmo-msgdb-load msgdb)
 348     msgdb))
 349
 350 (defun elmo-make-msgdb (&optional location)
 351   "Make a MSGDB."
 352   (luna-make-entity 'elmo-msgdb-legacy :location location))
 353
 354 (luna-define-method elmo-msgdb-list-messages ((msgdb elmo-msgdb-legacy))
 355   (mapcar 'elmo-msgdb-overview-entity-get-number
 356           (elmo-msgdb-get-overview msgdb)))
 357
 358 (defsubst elmo-msgdb-mark-to-flags (mark)
 359   (append
 360    (and (string= mark elmo-msgdb-new-mark)
 361         '(new))
 362    (and (string= mark elmo-msgdb-important-mark)
 363         '(important))
 364    (and (member mark (elmo-msgdb-unread-marks))
 365         '(unread))
 366    (and (member mark (elmo-msgdb-answered-marks))
 367         '(answered))
 368    (and (not (member mark (elmo-msgdb-uncached-marks)))
 369         '(cached))))
 370
 371 (defsubst elmo-msgdb-flags-to-mark (flags)
 372   (cond ((memq 'new flags)
 373          elmo-msgdb-new-mark)
 374         ((memq 'important flags)
 375          elmo-msgdb-important-mark)
 376         ((memq 'answered flags)
 377          (if (memq 'cached flags)
 378              elmo-msgdb-answered-cached-mark
 379            elmo-msgdb-answered-uncached-mark))
 380         ((memq 'unread flags)
 381          (if (memq 'cached flags)
 382              elmo-msgdb-unread-cached-mark
 383            elmo-msgdb-unread-uncached-mark))
 384         (t
 385          (if (memq 'cached flags)
 386              nil
 387            elmo-msgdb-read-uncached-mark))))
 388
 389 (defsubst elmo-msgdb-get-mark (msgdb number)
 390   "Get mark string from MSGDB which corresponds to the message with NUMBER."
 391   (cadr (elmo-get-hash-val (format "#%d" number)
 392                            (elmo-msgdb-get-mark-hashtb msgdb))))
 393
 394 (defsubst elmo-msgdb-set-mark (msgdb number mark)
 395   "Set MARK of the message with NUMBER in the MSGDB.
 396 if MARK is nil, mark is removed."
 397   (let ((elem (elmo-get-hash-val (format "#%d" number)
 398                                  (elmo-msgdb-get-mark-hashtb msgdb))))
 399     (if elem
 400         (if mark
 401             ;; Set mark of the elem
 402             (setcar (cdr elem) mark)
 403           ;; Delete elem from mark-alist
 404           (elmo-msgdb-set-mark-alist
 405            msgdb
 406            (delq elem (elmo-msgdb-get-mark-alist msgdb)))
 407           (elmo-clear-hash-val (format "#%d" number)
 408                                (elmo-msgdb-get-mark-hashtb msgdb)))
 409       (when mark
 410         ;; Append new element.
 411         (elmo-msgdb-set-mark-alist
 412          msgdb
 413          (nconc
 414           (elmo-msgdb-get-mark-alist msgdb)
 415           (list (setq elem (list number mark)))))
 416         (elmo-set-hash-val (format "#%d" number) elem
 417                            (elmo-msgdb-get-mark-hashtb msgdb))))
 418     (elmo-msgdb-set-flag-modified-internal msgdb t)
 419     ;; return value.
 420     t))
 421
 422 (luna-define-method elmo-msgdb-flags ((msgdb elmo-msgdb-legacy) number)
 423   (elmo-msgdb-mark-to-flags (elmo-msgdb-get-mark msgdb number)))
 424
 425 (luna-define-method elmo-msgdb-set-flag ((msgdb elmo-msgdb-legacy)
 426                                          number flag)
 427   (case flag
 428     (read
 429      (elmo-msgdb-unset-flag msgdb number 'unread))
 430     (uncached
 431      (elmo-msgdb-unset-flag msgdb number 'cached))
 432     (t
 433      (let* ((cur-mark (elmo-msgdb-get-mark msgdb number))
 434             (flags (elmo-msgdb-mark-to-flags cur-mark))
 435             new-mark)
 436        (and (memq 'new flags)
 437             (setq flags (delq 'new flags)))
 438        (or (memq flag flags)
 439            (setq flags (cons flag flags)))
 440        (when (and (eq flag 'unread)
 441                   (memq 'answered flags))
 442          (setq flags (delq 'answered flags)))
 443        (setq new-mark (elmo-msgdb-flags-to-mark flags))
 444        (unless (string= new-mark cur-mark)
 445          (elmo-msgdb-set-mark msgdb number new-mark))))))
 446
 447 (luna-define-method elmo-msgdb-unset-flag ((msgdb elmo-msgdb-legacy)
 448                                            number flag)
 449   (case flag
 450     (read
 451      (elmo-msgdb-set-flag msgdb number 'unread))
 452     (uncached
 453      (elmo-msgdb-set-flag msgdb number 'cached))
 454     (t
 455      (let* ((cur-mark (elmo-msgdb-get-mark msgdb number))
 456             (flags (elmo-msgdb-mark-to-flags cur-mark))
 457             new-mark)
 458        (and (memq 'new flags)
 459             (setq flags (delq 'new flags)))
 460        (and (memq flag flags)
 461             (setq flags (delq flag flags)))
 462        (when (and (eq flag 'unread)
 463                   (memq 'answered flags))
 464          (setq flags (delq 'answered flags)))
 465        (setq new-mark (elmo-msgdb-flags-to-mark flags))
 466        (unless (string= new-mark cur-mark)
 467          (elmo-msgdb-set-mark msgdb number new-mark))))))
 468
 469 (defvar elmo-msgdb-unread-marks-internal nil)
 470 (defsubst elmo-msgdb-unread-marks ()
 471   "Return an unread mark list"
 472   (or elmo-msgdb-unread-marks-internal
 473       (setq elmo-msgdb-unread-marks-internal
 474             (list elmo-msgdb-new-mark
 475                   elmo-msgdb-unread-uncached-mark
 476                   elmo-msgdb-unread-cached-mark))))
 477
 478 (defvar elmo-msgdb-answered-marks-internal nil)
 479 (defsubst elmo-msgdb-answered-marks ()
 480   "Return an answered mark list"
 481   (or elmo-msgdb-answered-marks-internal
 482       (setq elmo-msgdb-answered-marks-internal
 483             (list elmo-msgdb-answered-cached-mark
 484                   elmo-msgdb-answered-uncached-mark))))
 485
 486 (defvar elmo-msgdb-uncached-marks-internal nil)
 487 (defsubst elmo-msgdb-uncached-marks ()
 488   (or elmo-msgdb-uncached-marks-internal
 489       (setq elmo-msgdb-uncached-marks-internal
 490             (list elmo-msgdb-new-mark
 491                   elmo-msgdb-answered-uncached-mark
 492                   elmo-msgdb-unread-uncached-mark
 493                   elmo-msgdb-read-uncached-mark))))
 494
 495 (luna-define-method elmo-msgdb-append-entity ((msgdb elmo-msgdb-legacy)
 496                                               entity &optional flags)
 497   (when entity
 498     (let ((number (elmo-msgdb-overview-entity-get-number entity))
 499           (message-id (elmo-msgdb-overview-entity-get-id entity))
 500           mark)
 501       (elmo-msgdb-set-overview
 502        msgdb
 503        (nconc (elmo-msgdb-get-overview msgdb)
 504               (list entity)))
 505       (elmo-msgdb-set-number-alist
 506        msgdb
 507        (nconc (elmo-msgdb-get-number-alist msgdb)
 508               (list (cons number message-id))))
 509       (elmo-msgdb-set-message-modified-internal msgdb t)
 510       (when (setq mark (elmo-msgdb-flags-to-mark flags))
 511         (elmo-msgdb-set-mark-alist
 512          msgdb
 513          (nconc (elmo-msgdb-get-mark-alist msgdb)
 514                 (list (list number mark))))
 515         (elmo-msgdb-set-flag-modified-internal msgdb t))
 516       (elmo-msgdb-make-index
 517        msgdb
 518        (list entity)
 519        (list (list number mark))))))
 520
 521 (defsubst elmo-msgdb-get-number (msgdb message-id)
 522   "Get number of the message which corrensponds to MESSAGE-ID from MSGDB."
 523   (elmo-msgdb-overview-entity-get-number
 524    (elmo-msgdb-overview-get-entity message-id msgdb)))
 525
 526 (defsubst elmo-msgdb-get-field (msgdb number field)
 527   "Get FIELD value of the message with NUMBER from MSGDB."
 528   (case field
 529     (message-id (elmo-msgdb-overview-entity-get-id
 530                  (elmo-msgdb-overview-get-entity
 531                   number msgdb)))
 532     (subject (elmo-msgdb-overview-entity-get-subject
 533               (elmo-msgdb-overview-get-entity
 534                number msgdb)))
 535     (size (elmo-msgdb-overview-entity-get-size
 536            (elmo-msgdb-overview-get-entity
 537             number msgdb)))
 538     (date (elmo-msgdb-overview-entity-get-date
 539            (elmo-msgdb-overview-get-entity
 540             number msgdb)))
 541     (to (elmo-msgdb-overview-entity-get-to
 542          (elmo-msgdb-overview-get-entity
 543           number msgdb)))
 544     (cc (elmo-msgdb-overview-entity-get-cc
 545          (elmo-msgdb-overview-get-entity
 546           number msgdb)))))
 547
 548 (luna-define-method elmo-msgdb-append :around ((msgdb elmo-msgdb-legacy)
 549                                                msgdb-append)
 550   (if (eq (luna-class-name msgdb-append)
 551           'elmo-msgdb-legacy)
 552       (let (duplicates)
 553         (elmo-msgdb-set-overview
 554          msgdb
 555          (nconc (elmo-msgdb-get-overview msgdb)
 556                 (elmo-msgdb-get-overview msgdb-append)))
 557         (elmo-msgdb-set-number-alist
 558          msgdb
 559          (nconc (elmo-msgdb-get-number-alist msgdb)
 560                 (elmo-msgdb-get-number-alist msgdb-append)))
 561         (elmo-msgdb-set-mark-alist
 562          msgdb
 563          (nconc (elmo-msgdb-get-mark-alist msgdb)
 564                 (elmo-msgdb-get-mark-alist msgdb-append)))
 565         (setq duplicates (elmo-msgdb-make-index
 566                           msgdb
 567                           (elmo-msgdb-get-overview msgdb-append)
 568                           (elmo-msgdb-get-mark-alist msgdb-append)))
 569         (elmo-msgdb-set-path
 570          msgdb
 571          (or (elmo-msgdb-get-path msgdb)
 572              (elmo-msgdb-get-path msgdb-append)))
 573         (elmo-msgdb-set-message-modified-internal msgdb t)
 574         (elmo-msgdb-set-flag-modified-internal msgdb t)
 575         duplicates)
 576     (luna-call-next-method)))
 577
 578 (defun elmo-msgdb-merge (folder msgdb-merge)
 579   "Return a list of messages which have duplicated message-id."
 580   (let (msgdb duplicates)
 581     (setq msgdb (or (elmo-folder-msgdb-internal folder)
 582                     (elmo-make-msgdb (elmo-folder-msgdb-path folder))))
 583     (setq duplicates (elmo-msgdb-append msgdb msgdb-merge))
 584     (elmo-folder-set-msgdb-internal folder msgdb)
 585     duplicates))
 586
 587 (luna-define-method elmo-msgdb-clear :after ((msgdb elmo-msgdb-legacy))
 588   (elmo-msgdb-set-overview msgdb nil)
 589   (elmo-msgdb-set-number-alist msgdb nil)
 590   (elmo-msgdb-set-mark-alist msgdb nil)
 591   (elmo-msgdb-set-index msgdb nil))
 592
 593 (luna-define-method elmo-msgdb-delete-messages ((msgdb elmo-msgdb-legacy)
 594                                                 numbers)
 595   (let* ((overview (elmo-msgdb-get-overview msgdb))
 596          (number-alist (elmo-msgdb-get-number-alist msgdb))
 597          (mark-alist (elmo-msgdb-get-mark-alist msgdb))
 598          (index (elmo-msgdb-get-index msgdb))
 599          ov-entity)
 600     ;; remove from current database.
 601     (dolist (number numbers)
 602       (setq overview
 603             (delq
 604              (setq ov-entity
 605                    (elmo-msgdb-overview-get-entity number msgdb))
 606              overview))
 607       (setq number-alist (delq (assq number number-alist) number-alist))
 608       (setq mark-alist (delq (assq number mark-alist) mark-alist))
 609       ;;
 610       (when index (elmo-msgdb-clear-index msgdb ov-entity)))
 611     (elmo-msgdb-set-overview msgdb overview)
 612     (elmo-msgdb-set-number-alist msgdb number-alist)
 613     (elmo-msgdb-set-mark-alist msgdb mark-alist)
 614     (elmo-msgdb-set-index msgdb index)
 615     (elmo-msgdb-set-message-modified-internal msgdb t)
 616     (elmo-msgdb-set-flag-modified-internal msgdb t)
 617     t)) ;return value
 618
 619 (luna-define-method elmo-msgdb-sort-entities ((msgdb elmo-msgdb-legacy)
 620                                               predicate &optional app-data)
 621   (message "Sorting...")
 622   (let ((overview (elmo-msgdb-get-overview msgdb)))
 623     (elmo-msgdb-set-overview
 624      msgdb
 625      (sort overview (lambda (a b) (funcall predicate a b app-data))))
 626     (message "Sorting...done")
 627     msgdb))
 628
 629 (defun elmo-msgdb-sort-by-date (msgdb)
 630   (elmo-msgdb-sort-entities
 631    msgdb
 632    (lambda (x y app-data)
 633      (condition-case nil
 634          (string<
 635           (timezone-make-date-sortable
 636            (elmo-msgdb-overview-entity-get-date x))
 637           (timezone-make-date-sortable
 638            (elmo-msgdb-overview-entity-get-date y)))
 639        (error)))))
 640
 641 ;;;
 642 (defsubst elmo-msgdb-append-element (list element)
 643   (if list
 644 ;;;   (append list (list element))
 645       (nconc list (list element))
 646     ;; list is nil
 647     (list element)))
 648
 649 ;;
 650 ;; number <-> Message-ID handling
 651 ;;
 652 (defsubst elmo-msgdb-number-add (alist number id)
 653   (let ((ret-val alist))
 654     (setq ret-val
 655           (elmo-msgdb-append-element ret-val (cons number id)))
 656     ret-val))
 657
 658 ;;; flag table
 659 ;;
 660 (defvar elmo-flag-table-filename "flag-table")
 661 (defun elmo-flag-table-load (dir)
 662   "Load flag hashtable for MSGDB."
 663   (let ((table (elmo-make-hash))
 664         ;; For backward compatibility
 665         (seen-file (expand-file-name elmo-msgdb-seen-filename dir))
 666         value)
 667     (when (file-exists-p seen-file)
 668       (dolist (msgid (elmo-object-load seen-file))
 669         (elmo-set-hash-val msgid '(read) table))
 670       (delete-file seen-file))
 671     (dolist (pair (elmo-object-load
 672                    (expand-file-name elmo-flag-table-filename dir)))
 673       (setq value (cdr pair))
 674       (elmo-set-hash-val (car pair)
 675                          (cond ((consp value)
 676                                 value)
 677                                ;; Following cases for backward compatibility.
 678                                (value
 679                                 (list value))
 680                                (t
 681                                 '(unread)))
 682                          table))
 683     table))
 684
 685 (defun elmo-flag-table-set (flag-table msg-id flags)
 686   (elmo-set-hash-val msg-id (or flags '(read)) flag-table))
 687
 688 (defun elmo-flag-table-get (flag-table msg-id)
 689   (let ((flags (elmo-get-hash-val msg-id flag-table)))
 690     (if flags
 691         (append
 692          (and (elmo-msgdb-global-mark-get msg-id)
 693               '(important))
 694          (and (elmo-file-cache-exists-p msg-id)
 695               '(cached))
 696          (elmo-list-delete '(important cached read)
 697                            (copy-sequence flags)
 698                            #'delq))
 699       '(new unread))))
 700
 701 (defun elmo-flag-table-save (dir flag-table)
 702   (elmo-object-save
 703    (expand-file-name elmo-flag-table-filename dir)
 704    (if flag-table
 705        (let (list)
 706          (mapatoms (lambda (atom)
 707                      (setq list (cons (cons (symbol-name atom)
 708                                             (symbol-value atom))
 709                                       list)))
 710                    flag-table)
 711          list))))
 712 ;;;
 713 ;; persistent mark handling
 714 ;; (for each folder)
 715
 716 (defun elmo-msgdb-mark-append (alist id mark)
 717   "Append mark."
 718   (setq alist (elmo-msgdb-append-element alist
 719                                          (list id mark))))
 720
 721 (defsubst elmo-msgdb-length (msgdb)
 722   (length (elmo-msgdb-get-overview msgdb)))
 723
 724 (defun elmo-msgdb-flag-table (msgdb &optional flag-table)
 725   ;; Make a table of msgid flag (read, answered)
 726   (let ((flag-table (or flag-table
 727                         (elmo-make-hash (elmo-msgdb-length msgdb))))
 728         entity)
 729     (dolist (number (elmo-msgdb-list-messages msgdb))
 730       (setq entity (elmo-msgdb-message-entity msgdb number))
 731       (elmo-flag-table-set
 732        flag-table
 733        (elmo-msgdb-overview-entity-get-id entity)
 734        (elmo-msgdb-flags msgdb number)))
 735     flag-table))
 736
 737 ;;
 738 ;; mime decode cache
 739
 740 (defvar elmo-msgdb-decoded-cache-hashtb nil)
 741 (make-variable-buffer-local 'elmo-msgdb-decoded-cache-hashtb)
 742
 743 (defsubst elmo-msgdb-get-decoded-cache (string)
 744   (if elmo-use-decoded-cache
 745       (let ((hashtb (or elmo-msgdb-decoded-cache-hashtb
 746                         (setq elmo-msgdb-decoded-cache-hashtb
 747                               (elmo-make-hash 2048))))
 748             decoded)
 749         (or (elmo-get-hash-val string hashtb)
 750             (progn
 751               (elmo-set-hash-val
 752                string
 753                (setq decoded
 754                      (decode-mime-charset-string string elmo-mime-charset))
 755                hashtb)
 756               decoded)))
 757     (decode-mime-charset-string string elmo-mime-charset)))
 758
 759 ;;
 760 ;; overview handling
 761 ;;
 762 (defun elmo-multiple-field-body (name &optional boundary)
 763   (save-excursion
 764     (save-restriction
 765       (std11-narrow-to-header boundary)
 766       (goto-char (point-min))
 767       (let ((case-fold-search t)
 768             (field-body nil))
 769         (while (re-search-forward (concat "^" name ":[ \t]*") nil t)
 770           (setq field-body
 771                 (nconc field-body
 772                        (list (buffer-substring-no-properties
 773                               (match-end 0) (std11-field-end))))))
 774         field-body))))
 775
 776 (defun elmo-multiple-fields-body-list (field-names &optional boundary)
 777   "Return list of each field-bodies of FIELD-NAMES of the message header
 778 in current buffer. If BOUNDARY is not nil, it is used as message
 779 header separator."
 780   (save-excursion
 781     (save-restriction
 782       (std11-narrow-to-header boundary)
 783       (let* ((case-fold-search t)
 784              (s-rest field-names)
 785              field-name field-body)
 786         (while (setq field-name (car s-rest))
 787           (goto-char (point-min))
 788           (while (re-search-forward (concat "^" field-name ":[ \t]*") nil t)
 789             (setq field-body
 790                   (nconc field-body
 791                          (list (buffer-substring-no-properties
 792                                 (match-end 0) (std11-field-end))))))
 793           (setq s-rest (cdr s-rest)))
 794         field-body))))
 795
 796 (defsubst elmo-msgdb-remove-field-string (string)
 797   (if (string-match (concat std11-field-head-regexp "[ \t]*") string)
 798       (substring string (match-end 0))
 799     string))
 800
 801 (defsubst elmo-msgdb-get-last-message-id (string)
 802   (if string
 803       (save-match-data
 804         (let (beg)
 805           (elmo-set-work-buf
 806            (insert string)
 807            (goto-char (point-max))
 808            (when (search-backward "<" nil t)
 809              (setq beg (point))
 810              (if (search-forward ">" nil t)
 811                  (elmo-replace-in-string
 812                   (buffer-substring beg (point)) "\n[ \t]*" ""))))))))
 813
 814 (defun elmo-msgdb-number-load (dir)
 815   (elmo-object-load
 816    (expand-file-name elmo-msgdb-number-filename dir)))
 817
 818 (defun elmo-msgdb-overview-load (dir)
 819   (elmo-object-load
 820    (expand-file-name elmo-msgdb-overview-filename dir)))
 821
 822 (defun elmo-msgdb-mark-load (dir)
 823   (elmo-object-load
 824    (expand-file-name elmo-msgdb-mark-filename dir)))
 825
 826 (defsubst elmo-msgdb-seen-load (dir)
 827   (elmo-object-load (expand-file-name
 828                      elmo-msgdb-seen-filename
 829                      dir)))
 830
 831 (defun elmo-msgdb-number-save (dir obj)
 832   (elmo-object-save
 833    (expand-file-name elmo-msgdb-number-filename dir)
 834    obj))
 835
 836 (defun elmo-msgdb-mark-save (dir obj)
 837   (elmo-object-save
 838    (expand-file-name elmo-msgdb-mark-filename dir)
 839    obj))
 840
 841 (defun elmo-msgdb-change-mark (msgdb before after)
 842   "Set the BEFORE marks to AFTER."
 843   (let ((mark-alist (elmo-msgdb-get-mark-alist msgdb))
 844         entity)
 845     (while mark-alist
 846       (setq entity (car mark-alist))
 847       (when (string= (cadr entity) before)
 848         (setcar (cdr entity) after))
 849       (setq mark-alist (cdr mark-alist)))))
 850
 851 (defsubst elmo-msgdb-out-of-date-messages (msgdb)
 852   (elmo-msgdb-change-mark msgdb
 853                           elmo-msgdb-new-mark
 854                           elmo-msgdb-unread-uncached-mark))
 855
 856 (defsubst elmo-msgdb-overview-save (dir overview)
 857   (elmo-object-save
 858    (expand-file-name elmo-msgdb-overview-filename dir)
 859    overview))
 860
 861 (defun elmo-msgdb-match-condition-primitive (condition mark entity numbers)
 862   (catch 'unresolved
 863     (let ((key (elmo-filter-key condition))
 864           (case-fold-search t)
 865           result)
 866       (cond
 867        ((string= key "last")
 868         (setq result (<= (length (memq
 869                                   (elmo-msgdb-overview-entity-get-number
 870                                    entity)
 871                                   numbers))
 872                          (string-to-int (elmo-filter-value condition)))))
 873        ((string= key "first")
 874         (setq result (< (-
 875                          (length numbers)
 876                          (length (memq
 877                                   (elmo-msgdb-overview-entity-get-number
 878                                    entity)
 879                                   numbers)))
 880                         (string-to-int (elmo-filter-value condition)))))
 881        ((string= key "flag")
 882         (setq result
 883               (cond
 884                ((string= (elmo-filter-value condition) "any")
 885                 (not (or (null mark)
 886                          (string= mark elmo-msgdb-read-uncached-mark))))
 887                ((string= (elmo-filter-value condition) "digest")
 888                 (not (or (null mark)
 889                          (string= mark elmo-msgdb-read-uncached-mark)
 890                          (string= mark elmo-msgdb-answered-cached-mark)
 891                          (string= mark elmo-msgdb-answered-uncached-mark))))
 892 ;;        (member mark (append (elmo-msgdb-answered-marks)
 893 ;;                             (list elmo-msgdb-important-mark)
 894 ;;                             (elmo-msgdb-unread-marks))))
 895                ((string= (elmo-filter-value condition) "unread")
 896                 (member mark (elmo-msgdb-unread-marks)))
 897                ((string= (elmo-filter-value condition) "important")
 898                 (string= mark elmo-msgdb-important-mark))
 899                ((string= (elmo-filter-value condition) "answered")
 900                 (member mark (elmo-msgdb-answered-marks))))))
 901        ((string= key "from")
 902         (setq result (string-match
 903                       (elmo-filter-value condition)
 904                       (elmo-msgdb-overview-entity-get-from entity))))
 905        ((string= key "subject")
 906         (setq result (string-match
 907                       (elmo-filter-value condition)
 908                       (elmo-msgdb-overview-entity-get-subject entity))))
 909        ((string= key "to")
 910         (setq result (string-match
 911                       (elmo-filter-value condition)
 912                       (elmo-msgdb-overview-entity-get-to entity))))
 913        ((string= key "cc")
 914         (setq result (string-match
 915                       (elmo-filter-value condition)
 916                       (elmo-msgdb-overview-entity-get-cc entity))))
 917        ((or (string= key "since")
 918             (string= key "before"))
 919         (let ((field-date (elmo-date-make-sortable-string
 920                            (timezone-fix-time
 921                             (elmo-msgdb-overview-entity-get-date entity)
 922                             (current-time-zone) nil)))
 923               (specified-date
 924                (elmo-date-make-sortable-string
 925                 (elmo-date-get-datevec
 926                  (elmo-filter-value condition)))))
 927           (setq result (if (string= key "since")
 928                            (or (string= specified-date field-date)
 929                                (string< specified-date field-date))
 930                          (string< field-date specified-date)))))
 931        ((member key elmo-msgdb-extra-fields)
 932         (let ((extval (elmo-msgdb-overview-entity-get-extra-field entity key)))
 933           (when (stringp extval)
 934             (setq result (string-match
 935                           (elmo-filter-value condition)
 936                           extval)))))
 937        (t
 938         (throw 'unresolved condition)))
 939       (if (eq (elmo-filter-type condition) 'unmatch)
 940           (not result)
 941         result))))
 942
 943 (defun elmo-msgdb-match-condition-internal (condition mark entity numbers)
 944   (cond
 945    ((vectorp condition)
 946     (elmo-msgdb-match-condition-primitive condition mark entity numbers))
 947    ((eq (car condition) 'and)
 948     (let ((lhs (elmo-msgdb-match-condition-internal (nth 1 condition)
 949                                                     mark entity numbers)))
 950       (cond
 951        ((elmo-filter-condition-p lhs)
 952         (let ((rhs (elmo-msgdb-match-condition-internal
 953                     (nth 2 condition) mark entity numbers)))
 954           (cond ((elmo-filter-condition-p rhs)
 955                  (list 'and lhs rhs))
 956                 (rhs
 957                  lhs))))
 958        (lhs
 959         (elmo-msgdb-match-condition-internal (nth 2 condition)
 960                                              mark entity numbers)))))
 961    ((eq (car condition) 'or)
 962     (let ((lhs (elmo-msgdb-match-condition-internal (nth 1 condition)
 963                                                     mark entity numbers)))
 964       (cond
 965        ((elmo-filter-condition-p lhs)
 966         (let ((rhs (elmo-msgdb-match-condition-internal (nth 2 condition)
 967                                                         mark entity numbers)))
 968           (cond ((elmo-filter-condition-p rhs)
 969                  (list 'or lhs rhs))
 970                 (rhs
 971                  t)
 972                 (t
 973                  lhs))))
 974        (lhs
 975         t)
 976        (t
 977         (elmo-msgdb-match-condition-internal (nth 2 condition)
 978                                              mark entity numbers)))))))
 979
 980 (defun elmo-msgdb-match-condition (msgdb condition number numbers)
 981   "Check whether the condition of the message is satisfied or not.
 982 MSGDB is the msgdb to search from.
 983 CONDITION is the search condition.
 984 NUMBER is the message number to check.
 985 NUMBERS is the target message number list.
 986 Return CONDITION itself if no entity exists in msgdb."
 987   (let ((entity (elmo-msgdb-overview-get-entity number msgdb)))
 988     (if entity
 989         (elmo-msgdb-match-condition-internal condition
 990                                              (elmo-msgdb-get-mark msgdb number)
 991                                              entity numbers)
 992       condition)))
 993
 994 (defsubst elmo-msgdb-overview-entity-get-references (entity)
 995   (and entity (aref (cdr entity) 1)))
 996
 997 (defsubst elmo-msgdb-overview-entity-set-references (entity references)
 998   (and entity (aset (cdr entity) 1 references))
 999   entity)
1000
1001 ;; entity -> parent-entity
1002 (defsubst elmo-msgdb-overview-get-parent-entity (entity database)
1003   (setq entity (elmo-msgdb-overview-entity-get-references entity))
1004   ;; entity is parent-id.
1005   (and entity (assoc entity database)))
1006
1007 (defsubst elmo-msgdb-get-parent-entity (entity msgdb)
1008   (setq entity (elmo-msgdb-overview-entity-get-references entity))
1009   ;; entity is parent-id.
1010   (and entity (elmo-msgdb-overview-get-entity entity msgdb)))
1011
1012 (defsubst elmo-msgdb-overview-entity-get-number (entity)
1013   (and entity (aref (cdr entity) 0)))
1014
1015 (defsubst elmo-msgdb-overview-entity-get-from-no-decode (entity)
1016   (and entity (aref (cdr entity) 2)))
1017
1018 (defsubst elmo-msgdb-overview-entity-get-from (entity)
1019   (and entity
1020        (aref (cdr entity) 2)
1021        (elmo-msgdb-get-decoded-cache (aref (cdr entity) 2))))
1022
1023 (defsubst elmo-msgdb-overview-entity-set-number (entity number)
1024   (and entity (aset (cdr entity) 0 number))
1025   entity)
1026 ;;;(setcar (cadr entity) number) entity)
1027
1028 (defsubst elmo-msgdb-overview-entity-set-from (entity from)
1029   (and entity (aset (cdr entity) 2 from))
1030   entity)
1031
1032 (defsubst elmo-msgdb-overview-entity-get-subject (entity)
1033   (and entity
1034        (aref (cdr entity) 3)
1035        (elmo-msgdb-get-decoded-cache (aref (cdr entity) 3))))
1036
1037 (defsubst elmo-msgdb-overview-entity-get-subject-no-decode (entity)
1038   (and entity (aref (cdr entity) 3)))
1039
1040 (defsubst elmo-msgdb-overview-entity-set-subject (entity subject)
1041   (and entity (aset (cdr entity) 3 subject))
1042   entity)
1043
1044 (defsubst elmo-msgdb-overview-entity-get-date (entity)
1045   (and entity (aref (cdr entity) 4)))
1046
1047 (defsubst elmo-msgdb-overview-entity-set-date (entity date)
1048   (and entity (aset (cdr entity) 4 date))
1049   entity)
1050
1051 (defsubst elmo-msgdb-overview-entity-get-to (entity)
1052   (and entity (aref (cdr entity) 5)))
1053
1054 (defsubst elmo-msgdb-overview-entity-get-cc (entity)
1055   (and entity (aref (cdr entity) 6)))
1056
1057 (defsubst elmo-msgdb-overview-entity-get-size (entity)
1058   (and entity (aref (cdr entity) 7)))
1059
1060 (defsubst elmo-msgdb-overview-entity-set-size (entity size)
1061   (and entity (aset (cdr entity) 7 size))
1062   entity)
1063
1064 (defsubst elmo-msgdb-overview-entity-get-id (entity)
1065   (and entity (car entity)))
1066
1067 (defsubst elmo-msgdb-overview-entity-get-extra-field (entity field-name)
1068   (let ((field-name (downcase field-name))
1069         (extra (and entity (aref (cdr entity) 8))))
1070     (and extra
1071          (cdr (assoc field-name extra)))))
1072
1073 (defsubst elmo-msgdb-overview-entity-set-extra-field (entity field-name value)
1074   (let ((field-name (downcase field-name))
1075         (extras (and entity (aref (cdr entity) 8)))
1076         extra)
1077     (if (setq extra (assoc field-name extras))
1078         (setcdr extra value)
1079       (elmo-msgdb-overview-entity-set-extra
1080        entity
1081        (cons (cons field-name value) extras)))))
1082
1083 (defsubst elmo-msgdb-overview-entity-get-extra (entity)
1084   (and entity (aref (cdr entity) 8)))
1085
1086 (defsubst elmo-msgdb-overview-entity-set-extra (entity extra)
1087   (and entity (aset (cdr entity) 8 extra))
1088   entity)
1089
1090 ;;; New APIs
1091 (luna-define-method elmo-msgdb-message-entity ((msgdb elmo-msgdb-legacy) key)
1092   (elmo-get-hash-val
1093    (cond ((stringp key) key)
1094          ((numberp key) (format "#%d" key)))
1095    (elmo-msgdb-get-entity-hashtb msgdb)))
1096
1097 (defun elmo-msgdb-make-message-entity (&rest args)
1098   "Make an message entity."
1099   (cons (plist-get args :message-id)
1100         (vector (plist-get args :number)
1101                 (plist-get args :references)
1102                 (plist-get args :from)
1103                 (plist-get args :subject)
1104                 (plist-get args :date)
1105                 (plist-get args :to)
1106                 (plist-get args :cc)
1107                 (plist-get args :size)
1108                 (plist-get args :extra))))
1109
1110 (defsubst elmo-msgdb-message-entity-field (entity field &optional decode)
1111   (and entity
1112        (let ((field-value
1113               (case field
1114                 (to (aref (cdr entity) 5))
1115                 (cc (aref (cdr entity) 6))
1116                 (date (aref (cdr entity) 4))
1117                 (subject (aref (cdr entity) 3))
1118                 (from (aref (cdr entity) 2))
1119                 (message-id (car entity))
1120                 (references (aref (cdr entity) 1))
1121                 (size (aref (cdr entity) 7))
1122                 (t (cdr (assoc (symbol-name field) (aref (cdr entity) 8)))))))
1123          (if (and decode (memq field '(from subject)))
1124              (elmo-msgdb-get-decoded-cache field-value)
1125            field-value))))
1126
1127 (defsubst elmo-msgdb-message-entity-set-field (entity field value)
1128   (and entity
1129        (case field
1130          (to (aset (cdr entity) 5 value))
1131          (cc (aset (cdr entity) 6 value))
1132          (date (aset (cdr entity) 4 value))
1133          (subject (aset (cdr entity) 3 value))
1134          (from (aset (cdr entity) 2 value))
1135          (message-id (setcar entity value))
1136          (references (aset (cdr entity) 1 value))
1137          (size (aset (cdr entity) 7 value))
1138          (t
1139           (let ((extras (and entity (aref (cdr entity) 8)))
1140                 extra)
1141             (if (setq extra (assoc field extras))
1142                 (setcdr extra value)
1143               (aset (cdr entity) 8 (cons (cons (symbol-name field)
1144                                                value) extras))))))))
1145
1146 ;;;
1147 (defun elmo-msgdb-overview-get-entity (id msgdb)
1148   (elmo-msgdb-message-entity msgdb id))
1149
1150 ;;
1151 ;; deleted message handling
1152 ;;
1153 (defun elmo-msgdb-killed-list-load (dir)
1154   (elmo-object-load
1155    (expand-file-name elmo-msgdb-killed-filename dir)
1156    nil t))
1157
1158 (defun elmo-msgdb-killed-list-save (dir killed-list)
1159   (elmo-object-save
1160    (expand-file-name elmo-msgdb-killed-filename dir)
1161    killed-list))
1162
1163 (defun elmo-msgdb-killed-message-p (killed-list msg)
1164   (elmo-number-set-member msg killed-list))
1165
1166 (defun elmo-msgdb-set-as-killed (killed-list msg)
1167   (elmo-number-set-append killed-list msg))
1168
1169 (defun elmo-msgdb-killed-list-length (killed-list)
1170   (let ((killed killed-list)
1171         (ret-val 0))
1172     (while (car killed)
1173       (if (consp (car killed))
1174           (setq ret-val (+ ret-val 1 (- (cdar killed) (caar killed))))
1175         (setq ret-val (+ ret-val 1)))
1176       (setq killed (cdr killed)))
1177     ret-val))
1178
1179 (defun elmo-msgdb-max-of-killed (killed-list)
1180   (let ((klist killed-list)
1181         (max 0)
1182         k)
1183     (while (car klist)
1184       (if (< max
1185              (setq k
1186                    (if (consp (car klist))
1187                        (cdar klist)
1188                      (car klist))))
1189           (setq max k))
1190       (setq klist (cdr klist)))
1191     max))
1192
1193 (defun elmo-living-messages (messages killed-list)
1194   (if killed-list
1195       (delq nil
1196             (mapcar (lambda (number)
1197                       (unless (elmo-number-set-member number killed-list)
1198                         number))
1199                     messages))
1200     messages))
1201
1202 (defun elmo-msgdb-finfo-load ()
1203   (elmo-object-load (expand-file-name
1204                      elmo-msgdb-finfo-filename
1205                      elmo-msgdb-directory)
1206                     elmo-mime-charset t))
1207
1208 (defun elmo-msgdb-finfo-save (finfo)
1209   (elmo-object-save (expand-file-name
1210                      elmo-msgdb-finfo-filename
1211                      elmo-msgdb-directory)
1212                     finfo elmo-mime-charset))
1213
1214 (defun elmo-msgdb-flist-load (fname)
1215   (let ((flist-file (expand-file-name
1216                      elmo-msgdb-flist-filename
1217                      (expand-file-name
1218                       (elmo-safe-filename fname)
1219                       (expand-file-name "folder" elmo-msgdb-directory)))))
1220     (elmo-object-load flist-file elmo-mime-charset t)))
1221
1222 (defun elmo-msgdb-flist-save (fname flist)
1223   (let ((flist-file (expand-file-name
1224                      elmo-msgdb-flist-filename
1225                      (expand-file-name
1226                       (elmo-safe-filename fname)
1227                       (expand-file-name "folder" elmo-msgdb-directory)))))
1228     (elmo-object-save flist-file flist elmo-mime-charset)))
1229
1230 (defun elmo-crosspost-alist-load ()
1231   (elmo-object-load (expand-file-name
1232                      elmo-crosspost-alist-filename
1233                      elmo-msgdb-directory)
1234                     nil t))
1235
1236 (defun elmo-crosspost-alist-save (alist)
1237   (elmo-object-save (expand-file-name
1238                      elmo-crosspost-alist-filename
1239                      elmo-msgdb-directory)
1240                     alist))
1241
1242 (defun elmo-msgdb-get-message-id-from-buffer ()
1243   (let ((msgid (elmo-field-body "message-id")))
1244     (if msgid
1245         (if (string-match "<\\(.+\\)>$" msgid)
1246             msgid
1247           (concat "<" msgid ">")) ; Invaild message-id.
1248       ;; no message-id, so put dummy msgid.
1249       (concat "<" (timezone-make-date-sortable
1250                    (elmo-field-body "date"))
1251               (nth 1 (eword-extract-address-components
1252                       (or (elmo-field-body "from") "nobody"))) ">"))))
1253
1254 (defsubst elmo-msgdb-create-overview-from-buffer (number &optional size time)
1255   "Create overview entity from current buffer.
1256 Header region is supposed to be narrowed."
1257   (save-excursion
1258     (let ((extras elmo-msgdb-extra-fields)
1259           (default-mime-charset default-mime-charset)
1260           message-id references from subject to cc date
1261           extra field-body charset)
1262       (elmo-set-buffer-multibyte default-enable-multibyte-characters)
1263       (setq message-id (elmo-msgdb-get-message-id-from-buffer))
1264       (and (setq charset (cdr (assoc "charset" (mime-read-Content-Type))))
1265            (setq charset (intern-soft charset))
1266            (setq default-mime-charset charset))
1267       (setq references
1268             (or (elmo-msgdb-get-last-message-id
1269                  (elmo-field-body "in-reply-to"))
1270                 (elmo-msgdb-get-last-message-id
1271                  (elmo-field-body "references"))))
1272       (setq from (elmo-replace-in-string
1273                   (elmo-mime-string (or (elmo-field-body "from")
1274                                         elmo-no-from))
1275                   "\t" " ")
1276             subject (elmo-replace-in-string
1277                      (elmo-mime-string (or (elmo-field-body "subject")
1278                                            elmo-no-subject))
1279                      "\t" " "))
1280       (setq date (or (elmo-field-body "date") time))
1281       (setq to   (mapconcat 'identity (elmo-multiple-field-body "to") ","))
1282       (setq cc   (mapconcat 'identity (elmo-multiple-field-body "cc") ","))
1283       (or size
1284           (if (setq size (elmo-field-body "content-length"))
1285               (setq size (string-to-int size))
1286             (setq size 0)));; No mean...
1287       (while extras
1288         (if (setq field-body (elmo-field-body (car extras)))
1289             (setq extra (cons (cons (downcase (car extras))
1290                                     field-body) extra)))
1291         (setq extras (cdr extras)))
1292       (cons message-id (vector number references
1293                                from subject date to cc
1294                                size extra))
1295       )))
1296
1297 (defun elmo-msgdb-copy-overview-entity (entity)
1298   (cons (car entity)
1299         (copy-sequence (cdr entity))))
1300
1301 (defsubst elmo-msgdb-insert-file-header (file)
1302   "Insert the header of the article."
1303   (let ((beg 0)
1304         insert-file-contents-pre-hook   ; To avoid autoconv-xmas...
1305         insert-file-contents-post-hook
1306         format-alist)
1307     (when (file-exists-p file)
1308       ;; Read until header separator is found.
1309       (while (and (eq elmo-msgdb-file-header-chop-length
1310                       (nth 1
1311                            (insert-file-contents-as-binary
1312                             file nil beg
1313                             (incf beg elmo-msgdb-file-header-chop-length))))
1314                   (prog1 (not (search-forward "\n\n" nil t))
1315                     (goto-char (point-max))))))))
1316
1317 (defsubst elmo-msgdb-create-overview-entity-from-file (number file)
1318   (let (insert-file-contents-pre-hook   ; To avoid autoconv-xmas...
1319         insert-file-contents-post-hook header-end
1320         (attrib (file-attributes file))
1321         ret-val size mtime)
1322     (with-temp-buffer
1323       (if (not (file-exists-p file))
1324           ()
1325         (setq size (nth 7 attrib))
1326         (setq mtime (timezone-make-date-arpa-standard
1327                      (current-time-string (nth 5 attrib)) (current-time-zone)))
1328         ;; insert header from file.
1329         (catch 'done
1330           (condition-case nil
1331               (elmo-msgdb-insert-file-header file)
1332             (error (throw 'done nil)))
1333           (goto-char (point-min))
1334           (setq header-end
1335                 (if (re-search-forward "\\(^--.*$\\)\\|\\(\n\n\\)" nil t)
1336                     (point)
1337                   (point-max)))
1338           (narrow-to-region (point-min) header-end)
1339           (elmo-msgdb-create-overview-from-buffer number size mtime))))))
1340
1341 (defun elmo-msgdb-clear-index (msgdb entity)
1342   (let ((ehash (elmo-msgdb-get-entity-hashtb msgdb))
1343         (mhash (elmo-msgdb-get-mark-hashtb msgdb))
1344         number)
1345     (when (and entity ehash)
1346       (and (setq number (elmo-msgdb-overview-entity-get-number entity))
1347            (elmo-clear-hash-val (format "#%d" number) ehash))
1348       (and (car entity) ;; message-id
1349            (elmo-clear-hash-val (car entity) ehash)))
1350     (when (and entity mhash)
1351       (and (setq number (elmo-msgdb-overview-entity-get-number entity))
1352            (elmo-clear-hash-val (format "#%d" number) mhash)))))
1353
1354 (defun elmo-msgdb-make-index (msgdb &optional overview mark-alist)
1355   "Append OVERVIEW and MARK-ALIST to the index of MSGDB.
1356 If OVERVIEW and MARK-ALIST are nil, make index for current MSGDB.
1357 Return a list of message numbers which have duplicated message-ids."
1358   (when msgdb
1359     (let* ((overview (or overview (elmo-msgdb-get-overview msgdb)))
1360            (mark-alist (or mark-alist (elmo-msgdb-get-mark-alist msgdb)))
1361            (index (elmo-msgdb-get-index msgdb))
1362            (ehash (or (car index) ;; append
1363                       (elmo-make-hash (length overview))))
1364            (mhash (or (cdr index) ;; append
1365                       (elmo-make-hash (length overview))))
1366            duplicates)
1367       (while overview
1368         ;; key is message-id
1369         (if (elmo-get-hash-val (caar overview) ehash) ; duplicated.
1370             (setq duplicates (cons
1371                               (elmo-msgdb-overview-entity-get-number
1372                                (car overview))
1373                               duplicates)))
1374         (if (caar overview)
1375             (elmo-set-hash-val (caar overview) (car overview) ehash))
1376         ;; key is number
1377         (elmo-set-hash-val
1378          (format "#%d"
1379                  (elmo-msgdb-overview-entity-get-number (car overview)))
1380          (car overview) ehash)
1381         (setq overview (cdr overview)))
1382       (while mark-alist
1383         ;; key is number
1384         (elmo-set-hash-val
1385          (format "#%d" (car (car mark-alist)))
1386          (car mark-alist) mhash)
1387         (setq mark-alist (cdr mark-alist)))
1388       (setq index (or index (cons ehash mhash)))
1389       (elmo-msgdb-set-index msgdb index)
1390       duplicates)))
1391
1392 (defsubst elmo-folder-get-info (folder &optional hashtb)
1393   (elmo-get-hash-val folder
1394                      (or hashtb elmo-folder-info-hashtb)))
1395
1396 (defun elmo-folder-get-info-max (folder)
1397   "Get folder info from cache."
1398   (nth 3 (elmo-folder-get-info folder)))
1399
1400 (defun elmo-folder-get-info-length (folder)
1401   (nth 2 (elmo-folder-get-info folder)))
1402
1403 (defun elmo-folder-get-info-unread (folder)
1404   (nth 1 (elmo-folder-get-info folder)))
1405
1406 (defsubst elmo-msgdb-location-load (dir)
1407   (elmo-object-load
1408    (expand-file-name
1409     elmo-msgdb-location-filename
1410     dir)))
1411
1412 (defsubst elmo-msgdb-location-add (alist number location)
1413   (let ((ret-val alist))
1414     (setq ret-val
1415           (elmo-msgdb-append-element ret-val (cons number location)))
1416     ret-val))
1417
1418 (defsubst elmo-msgdb-location-save (dir alist)
1419   (elmo-object-save
1420    (expand-file-name
1421     elmo-msgdb-location-filename
1422     dir) alist))
1423
1424 (luna-define-method elmo-msgdb-list-flagged ((msgdb elmo-msgdb-legacy) flag)
1425   (let ((case-fold-search nil)
1426         mark-regexp matched)
1427     (case flag
1428       (new
1429        (setq mark-regexp (regexp-quote elmo-msgdb-new-mark)))
1430       (unread
1431        (setq mark-regexp (elmo-regexp-opt (elmo-msgdb-unread-marks))))
1432       (answered
1433        (setq mark-regexp (elmo-regexp-opt (elmo-msgdb-answered-marks))))
1434       (important
1435        (setq mark-regexp (regexp-quote elmo-msgdb-important-mark)))
1436       (read
1437        (setq mark-regexp (elmo-regexp-opt (elmo-msgdb-unread-marks))))
1438       (digest
1439        (setq mark-regexp (elmo-regexp-opt
1440                           (append (elmo-msgdb-unread-marks)
1441                                   (list elmo-msgdb-important-mark)))))
1442       (any
1443        (setq mark-regexp (elmo-regexp-opt
1444                           (append
1445                            (elmo-msgdb-unread-marks)
1446                            (elmo-msgdb-answered-marks)
1447                            (list elmo-msgdb-important-mark))))))
1448     (when mark-regexp
1449       (if (eq flag 'read)
1450           (dolist (number (elmo-msgdb-list-messages msgdb))
1451             (let ((mark (elmo-msgdb-get-mark msgdb number)))
1452               (unless (and mark (string-match mark-regexp mark))
1453                 (setq matched (cons number matched)))))
1454         (dolist (elem (elmo-msgdb-get-mark-alist msgdb))
1455           (if (string-match mark-regexp (cadr elem))
1456               (setq matched (cons (car elem) matched))))))
1457     matched))
1458
1459 (require 'product)
1460 (product-provide (provide 'elmo-msgdb) (require 'elmo-version))
1461
1462 ;;; elmo-msgdb.el ends here