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 (defun elmo-msgdb-get-cached (msgdb number)
 423   "Return non-nil if message is cached."
 424   (not (member (elmo-msgdb-get-mark msgdb number)
 425                (elmo-msgdb-uncached-marks))))
 426
 427 (defun elmo-msgdb-set-cached (msgdb number cached use-cache)
 428   "Set message cache status.
 429 If mark is changed, return non-nil."
 430   (let* ((cur-mark (elmo-msgdb-get-mark msgdb number))
 431          (cur-flag (cond
 432                       ((string= cur-mark elmo-msgdb-important-mark)
 433                        'important)
 434                       ((member cur-mark (elmo-msgdb-answered-marks))
 435                        'answered)
 436                       ((not (member cur-mark (elmo-msgdb-unread-marks)))
 437                        'read)))
 438          (cur-cached (elmo-file-cache-exists-p
 439                       (elmo-msgdb-get-field msgdb number 'message-id))))
 440     (unless (eq cached cur-cached)
 441       (case cur-flag
 442         (read
 443          (elmo-msgdb-set-mark msgdb number
 444                               (if (and use-cache (not cached))
 445                                   elmo-msgdb-read-uncached-mark)))
 446         (important nil)
 447         (answered
 448          (elmo-msgdb-set-mark msgdb number
 449                               (if cached
 450                                   elmo-msgdb-answered-cached-mark
 451                                 elmo-msgdb-answered-uncached-mark)))
 452         (t
 453          (elmo-msgdb-set-mark msgdb number
 454                               (if cached
 455                                   elmo-msgdb-unread-cached-mark
 456                                 elmo-msgdb-unread-uncached-mark)))))))
 457
 458 (luna-define-method elmo-msgdb-flags ((msgdb elmo-msgdb-legacy) number)
 459   (elmo-msgdb-mark-to-flags (elmo-msgdb-get-mark msgdb number)))
 460
 461 (luna-define-method elmo-msgdb-set-flag ((msgdb elmo-msgdb-legacy)
 462                                          number flag)
 463   (let* ((cur-mark (elmo-msgdb-get-mark msgdb number))
 464          (cur-flag (cond
 465                     ((string= cur-mark elmo-msgdb-important-mark)
 466                      'important)
 467                     ((member cur-mark (elmo-msgdb-answered-marks))
 468                      'answered)
 469                     ((not (member cur-mark (elmo-msgdb-unread-marks)))
 470                      'read)))
 471          (cur-cached (elmo-file-cache-exists-p
 472                       (elmo-msgdb-get-field msgdb number 'message-id))))
 473     (case flag
 474       (read
 475        (case cur-flag
 476          ((read important)) ; answered mark is overriden.
 477          (t (elmo-msgdb-set-mark msgdb number
 478                                  (if (not cur-cached)
 479                                      elmo-msgdb-read-uncached-mark)))))
 480       (important
 481        (unless (eq cur-flag 'important)
 482          (elmo-msgdb-set-mark msgdb number elmo-msgdb-important-mark)))
 483       (answered
 484        (unless (or (eq cur-flag 'answered) (eq cur-flag 'important))
 485          (elmo-msgdb-set-mark msgdb number
 486                               (if cur-cached
 487                                   elmo-msgdb-answered-cached-mark
 488                                 elmo-msgdb-answered-uncached-mark)))))))
 489
 490 (luna-define-method elmo-msgdb-unset-flag ((msgdb elmo-msgdb-legacy)
 491                                            number flag)
 492   (let* ((cur-mark (elmo-msgdb-get-mark msgdb number))
 493          (cur-flag (cond
 494                     ((string= cur-mark elmo-msgdb-important-mark)
 495                      'important)
 496                     ((member cur-mark (elmo-msgdb-answered-marks))
 497                      'answered)
 498                     ((not (member cur-mark (elmo-msgdb-unread-marks)))
 499                      'read)))
 500          (cur-cached (elmo-file-cache-exists-p
 501                       (elmo-msgdb-get-field msgdb number 'message-id))))
 502     (case flag
 503       (read
 504        (when (or (eq cur-flag 'read) (eq cur-flag 'answered))
 505          (elmo-msgdb-set-mark msgdb number
 506                               (if cur-cached
 507                                   elmo-msgdb-unread-cached-mark
 508                                 elmo-msgdb-unread-uncached-mark))))
 509       (important
 510        (when (eq cur-flag 'important)
 511          (elmo-msgdb-set-mark msgdb number nil)))
 512       (answered
 513        (when (eq cur-flag 'answered)
 514          (elmo-msgdb-set-mark msgdb number
 515                               (if (not cur-cached)
 516                                   elmo-msgdb-read-uncached-mark)))))))
 517
 518 (defvar elmo-msgdb-unread-marks-internal nil)
 519 (defsubst elmo-msgdb-unread-marks ()
 520   "Return an unread mark list"
 521   (or elmo-msgdb-unread-marks-internal
 522       (setq elmo-msgdb-unread-marks-internal
 523             (list elmo-msgdb-new-mark
 524                   elmo-msgdb-unread-uncached-mark
 525                   elmo-msgdb-unread-cached-mark))))
 526
 527 (defvar elmo-msgdb-answered-marks-internal nil)
 528 (defsubst elmo-msgdb-answered-marks ()
 529   "Return an answered mark list"
 530   (or elmo-msgdb-answered-marks-internal
 531       (setq elmo-msgdb-answered-marks-internal
 532             (list elmo-msgdb-answered-cached-mark
 533                   elmo-msgdb-answered-uncached-mark))))
 534
 535 (defvar elmo-msgdb-uncached-marks-internal nil)
 536 (defsubst elmo-msgdb-uncached-marks ()
 537   (or elmo-msgdb-uncached-marks-internal
 538       (setq elmo-msgdb-uncached-marks-internal
 539             (list elmo-msgdb-new-mark
 540                   elmo-msgdb-answered-uncached-mark
 541                   elmo-msgdb-unread-uncached-mark
 542                   elmo-msgdb-read-uncached-mark))))
 543
 544 (luna-define-method elmo-msgdb-append-entity ((msgdb elmo-msgdb-legacy)
 545                                               entity &optional flags)
 546   (when entity
 547     (let ((number (elmo-msgdb-overview-entity-get-number entity))
 548           (message-id (elmo-msgdb-overview-entity-get-id entity))
 549           mark)
 550       (elmo-msgdb-set-overview
 551        msgdb
 552        (nconc (elmo-msgdb-get-overview msgdb)
 553               (list entity)))
 554       (elmo-msgdb-set-number-alist
 555        msgdb
 556        (nconc (elmo-msgdb-get-number-alist msgdb)
 557               (list (cons number message-id))))
 558       (elmo-msgdb-set-message-modified-internal msgdb t)
 559       (when (setq mark (elmo-msgdb-flags-to-mark flags))
 560         (elmo-msgdb-set-mark-alist
 561          msgdb
 562          (nconc (elmo-msgdb-get-mark-alist msgdb)
 563                 (list (list number mark))))
 564         (elmo-msgdb-set-flag-modified-internal msgdb t))
 565       (elmo-msgdb-make-index
 566        msgdb
 567        (list entity)
 568        (list (list number mark))))))
 569
 570 (defsubst elmo-msgdb-get-number (msgdb message-id)
 571   "Get number of the message which corrensponds to MESSAGE-ID from MSGDB."
 572   (elmo-msgdb-overview-entity-get-number
 573    (elmo-msgdb-overview-get-entity message-id msgdb)))
 574
 575 (defsubst elmo-msgdb-get-field (msgdb number field)
 576   "Get FIELD value of the message with NUMBER from MSGDB."
 577   (case field
 578     (message-id (elmo-msgdb-overview-entity-get-id
 579                  (elmo-msgdb-overview-get-entity
 580                   number msgdb)))
 581     (subject (elmo-msgdb-overview-entity-get-subject
 582               (elmo-msgdb-overview-get-entity
 583                number msgdb)))
 584     (size (elmo-msgdb-overview-entity-get-size
 585            (elmo-msgdb-overview-get-entity
 586             number msgdb)))
 587     (date (elmo-msgdb-overview-entity-get-date
 588            (elmo-msgdb-overview-get-entity
 589             number msgdb)))
 590     (to (elmo-msgdb-overview-entity-get-to
 591          (elmo-msgdb-overview-get-entity
 592           number msgdb)))
 593     (cc (elmo-msgdb-overview-entity-get-cc
 594          (elmo-msgdb-overview-get-entity
 595           number msgdb)))))
 596
 597 (luna-define-method elmo-msgdb-append :around ((msgdb elmo-msgdb-legacy)
 598                                                msgdb-append)
 599   (if (eq (luna-class-name msgdb-append)
 600           'elmo-msgdb-legacy)
 601       (let (duplicates)
 602         (elmo-msgdb-set-overview
 603          msgdb
 604          (nconc (elmo-msgdb-get-overview msgdb)
 605                 (elmo-msgdb-get-overview msgdb-append)))
 606         (elmo-msgdb-set-number-alist
 607          msgdb
 608          (nconc (elmo-msgdb-get-number-alist msgdb)
 609                 (elmo-msgdb-get-number-alist msgdb-append)))
 610         (elmo-msgdb-set-mark-alist
 611          msgdb
 612          (nconc (elmo-msgdb-get-mark-alist msgdb)
 613                 (elmo-msgdb-get-mark-alist msgdb-append)))
 614         (setq duplicates (elmo-msgdb-make-index
 615                           msgdb
 616                           (elmo-msgdb-get-overview msgdb-append)
 617                           (elmo-msgdb-get-mark-alist msgdb-append)))
 618         (elmo-msgdb-set-path
 619          msgdb
 620          (or (elmo-msgdb-get-path msgdb)
 621              (elmo-msgdb-get-path msgdb-append)))
 622         (elmo-msgdb-set-message-modified-internal msgdb t)
 623         (elmo-msgdb-set-flag-modified-internal msgdb t)
 624         duplicates)
 625     (luna-call-next-method)))
 626
 627 (defun elmo-msgdb-merge (folder msgdb-merge)
 628   "Return a list of messages which have duplicated message-id."
 629   (let (msgdb duplicates)
 630     (setq msgdb (or (elmo-folder-msgdb-internal folder)
 631                     (elmo-make-msgdb (elmo-folder-msgdb-path folder))))
 632     (setq duplicates (elmo-msgdb-append msgdb msgdb-merge))
 633     (elmo-folder-set-msgdb-internal folder msgdb)
 634     duplicates))
 635
 636 (luna-define-method elmo-msgdb-clear :after ((msgdb elmo-msgdb-legacy))
 637   (elmo-msgdb-set-overview msgdb nil)
 638   (elmo-msgdb-set-number-alist msgdb nil)
 639   (elmo-msgdb-set-mark-alist msgdb nil)
 640   (elmo-msgdb-set-index msgdb nil))
 641
 642 (luna-define-method elmo-msgdb-delete-messages ((msgdb elmo-msgdb-legacy)
 643                                                 numbers)
 644   (let* ((overview (elmo-msgdb-get-overview msgdb))
 645          (number-alist (elmo-msgdb-get-number-alist msgdb))
 646          (mark-alist (elmo-msgdb-get-mark-alist msgdb))
 647          (index (elmo-msgdb-get-index msgdb))
 648          ov-entity)
 649     ;; remove from current database.
 650     (dolist (number numbers)
 651       (setq overview
 652             (delq
 653              (setq ov-entity
 654                    (elmo-msgdb-overview-get-entity number msgdb))
 655              overview))
 656       (setq number-alist (delq (assq number number-alist) number-alist))
 657       (setq mark-alist (delq (assq number mark-alist) mark-alist))
 658       ;;
 659       (when index (elmo-msgdb-clear-index msgdb ov-entity)))
 660     (elmo-msgdb-set-overview msgdb overview)
 661     (elmo-msgdb-set-number-alist msgdb number-alist)
 662     (elmo-msgdb-set-mark-alist msgdb mark-alist)
 663     (elmo-msgdb-set-index msgdb index)
 664     (elmo-msgdb-set-message-modified-internal msgdb t)
 665     (elmo-msgdb-set-flag-modified-internal msgdb t)
 666     t)) ;return value
 667
 668 (luna-define-method elmo-msgdb-sort-entities ((msgdb elmo-msgdb-legacy)
 669                                               predicate &optional app-data)
 670   (message "Sorting...")
 671   (let ((overview (elmo-msgdb-get-overview msgdb)))
 672     (elmo-msgdb-set-overview
 673      msgdb
 674      (sort overview (lambda (a b) (funcall predicate a b app-data))))
 675     (message "Sorting...done")
 676     msgdb))
 677
 678 (defun elmo-msgdb-sort-by-date (msgdb)
 679   (elmo-msgdb-sort-entities
 680    msgdb
 681    (lambda (x y app-data)
 682      (condition-case nil
 683          (string<
 684           (timezone-make-date-sortable
 685            (elmo-msgdb-overview-entity-get-date x))
 686           (timezone-make-date-sortable
 687            (elmo-msgdb-overview-entity-get-date y)))
 688        (error)))))
 689
 690 ;;;
 691 (defsubst elmo-msgdb-append-element (list element)
 692   (if list
 693 ;;;   (append list (list element))
 694       (nconc list (list element))
 695     ;; list is nil
 696     (list element)))
 697
 698 ;;
 699 ;; number <-> Message-ID handling
 700 ;;
 701 (defsubst elmo-msgdb-number-add (alist number id)
 702   (let ((ret-val alist))
 703     (setq ret-val
 704           (elmo-msgdb-append-element ret-val (cons number id)))
 705     ret-val))
 706
 707 ;;; flag table
 708 ;;
 709 (defvar elmo-flag-table-filename "flag-table")
 710 (defun elmo-flag-table-load (dir)
 711   "Load flag hashtable for MSGDB."
 712   (let ((table (elmo-make-hash))
 713         ;; For backward compatibility
 714         (seen-file (expand-file-name elmo-msgdb-seen-filename dir))
 715         value)
 716     (when (file-exists-p seen-file)
 717       (dolist (msgid (elmo-object-load seen-file))
 718         (elmo-set-hash-val msgid '(read) table))
 719       (delete-file seen-file))
 720     (dolist (pair (elmo-object-load
 721                    (expand-file-name elmo-flag-table-filename dir)))
 722       (setq value (cdr pair))
 723       (elmo-set-hash-val (car pair)
 724                          (cond ((consp value)
 725                                 value)
 726                                ;; Following cases for backward compatibility.
 727                                (value
 728                                 (list value))
 729                                (t
 730                                 '(unread)))
 731                          table))
 732     table))
 733
 734 (defun elmo-flag-table-set (flag-table msg-id flags)
 735   (elmo-set-hash-val msg-id (or flags '(read)) flag-table))
 736
 737 (defun elmo-flag-table-get (flag-table msg-id)
 738   (let ((flags (elmo-get-hash-val msg-id flag-table)))
 739     (if flags
 740         (append
 741          (and (elmo-msgdb-global-mark-get msg-id)
 742               '(important))
 743          (and (elmo-file-cache-exists-p msg-id)
 744               '(cached))
 745          (elmo-list-delete '(important cached read)
 746                            (copy-sequence flags)
 747                            #'delq))
 748       '(new unread))))
 749
 750 (defun elmo-flag-table-save (dir flag-table)
 751   (elmo-object-save
 752    (expand-file-name elmo-flag-table-filename dir)
 753    (if flag-table
 754        (let (list)
 755          (mapatoms (lambda (atom)
 756                      (setq list (cons (cons (symbol-name atom)
 757                                             (symbol-value atom))
 758                                       list)))
 759                    flag-table)
 760          list))))
 761 ;;;
 762 ;; persistent mark handling
 763 ;; (for each folder)
 764
 765 (defun elmo-msgdb-mark-append (alist id mark)
 766   "Append mark."
 767   (setq alist (elmo-msgdb-append-element alist
 768                                          (list id mark))))
 769
 770 (defsubst elmo-msgdb-length (msgdb)
 771   (length (elmo-msgdb-get-overview msgdb)))
 772
 773 (defun elmo-msgdb-flag-table (msgdb &optional flag-table)
 774   ;; Make a table of msgid flag (read, answered)
 775   (let ((flag-table (or flag-table
 776                         (elmo-make-hash (elmo-msgdb-length msgdb))))
 777         entity)
 778     (dolist (number (elmo-msgdb-list-messages msgdb))
 779       (setq entity (elmo-msgdb-message-entity msgdb number))
 780       (elmo-flag-table-set
 781        flag-table
 782        (elmo-msgdb-overview-entity-get-id entity)
 783        (elmo-msgdb-flags msgdb number)))
 784     flag-table))
 785
 786 ;;
 787 ;; mime decode cache
 788
 789 (defvar elmo-msgdb-decoded-cache-hashtb nil)
 790 (make-variable-buffer-local 'elmo-msgdb-decoded-cache-hashtb)
 791
 792 (defsubst elmo-msgdb-get-decoded-cache (string)
 793   (if elmo-use-decoded-cache
 794       (let ((hashtb (or elmo-msgdb-decoded-cache-hashtb
 795                         (setq elmo-msgdb-decoded-cache-hashtb
 796                               (elmo-make-hash 2048))))
 797             decoded)
 798         (or (elmo-get-hash-val string hashtb)
 799             (progn
 800               (elmo-set-hash-val
 801                string
 802                (setq decoded
 803                      (decode-mime-charset-string string elmo-mime-charset))
 804                hashtb)
 805               decoded)))
 806     (decode-mime-charset-string string elmo-mime-charset)))
 807
 808 ;;
 809 ;; overview handling
 810 ;;
 811 (defun elmo-multiple-field-body (name &optional boundary)
 812   (save-excursion
 813     (save-restriction
 814       (std11-narrow-to-header boundary)
 815       (goto-char (point-min))
 816       (let ((case-fold-search t)
 817             (field-body nil))
 818         (while (re-search-forward (concat "^" name ":[ \t]*") nil t)
 819           (setq field-body
 820                 (nconc field-body
 821                        (list (buffer-substring-no-properties
 822                               (match-end 0) (std11-field-end))))))
 823         field-body))))
 824
 825 (defun elmo-multiple-fields-body-list (field-names &optional boundary)
 826   "Return list of each field-bodies of FIELD-NAMES of the message header
 827 in current buffer. If BOUNDARY is not nil, it is used as message
 828 header separator."
 829   (save-excursion
 830     (save-restriction
 831       (std11-narrow-to-header boundary)
 832       (let* ((case-fold-search t)
 833              (s-rest field-names)
 834              field-name field-body)
 835         (while (setq field-name (car s-rest))
 836           (goto-char (point-min))
 837           (while (re-search-forward (concat "^" field-name ":[ \t]*") nil t)
 838             (setq field-body
 839                   (nconc field-body
 840                          (list (buffer-substring-no-properties
 841                                 (match-end 0) (std11-field-end))))))
 842           (setq s-rest (cdr s-rest)))
 843         field-body))))
 844
 845 (defsubst elmo-msgdb-remove-field-string (string)
 846   (if (string-match (concat std11-field-head-regexp "[ \t]*") string)
 847       (substring string (match-end 0))
 848     string))
 849
 850 (defsubst elmo-msgdb-get-last-message-id (string)
 851   (if string
 852       (save-match-data
 853         (let (beg)
 854           (elmo-set-work-buf
 855            (insert string)
 856            (goto-char (point-max))
 857            (when (search-backward "<" nil t)
 858              (setq beg (point))
 859              (if (search-forward ">" nil t)
 860                  (elmo-replace-in-string
 861                   (buffer-substring beg (point)) "\n[ \t]*" ""))))))))
 862
 863 (defun elmo-msgdb-number-load (dir)
 864   (elmo-object-load
 865    (expand-file-name elmo-msgdb-number-filename dir)))
 866
 867 (defun elmo-msgdb-overview-load (dir)
 868   (elmo-object-load
 869    (expand-file-name elmo-msgdb-overview-filename dir)))
 870
 871 (defun elmo-msgdb-mark-load (dir)
 872   (elmo-object-load
 873    (expand-file-name elmo-msgdb-mark-filename dir)))
 874
 875 (defsubst elmo-msgdb-seen-load (dir)
 876   (elmo-object-load (expand-file-name
 877                      elmo-msgdb-seen-filename
 878                      dir)))
 879
 880 (defun elmo-msgdb-number-save (dir obj)
 881   (elmo-object-save
 882    (expand-file-name elmo-msgdb-number-filename dir)
 883    obj))
 884
 885 (defun elmo-msgdb-mark-save (dir obj)
 886   (elmo-object-save
 887    (expand-file-name elmo-msgdb-mark-filename dir)
 888    obj))
 889
 890 (defun elmo-msgdb-change-mark (msgdb before after)
 891   "Set the BEFORE marks to AFTER."
 892   (let ((mark-alist (elmo-msgdb-get-mark-alist msgdb))
 893         entity)
 894     (while mark-alist
 895       (setq entity (car mark-alist))
 896       (when (string= (cadr entity) before)
 897         (setcar (cdr entity) after))
 898       (setq mark-alist (cdr mark-alist)))))
 899
 900 (defsubst elmo-msgdb-out-of-date-messages (msgdb)
 901   (elmo-msgdb-change-mark msgdb
 902                           elmo-msgdb-new-mark
 903                           elmo-msgdb-unread-uncached-mark))
 904
 905 (defsubst elmo-msgdb-overview-save (dir overview)
 906   (elmo-object-save
 907    (expand-file-name elmo-msgdb-overview-filename dir)
 908    overview))
 909
 910 (defun elmo-msgdb-match-condition-primitive (condition mark entity numbers)
 911   (catch 'unresolved
 912     (let ((key (elmo-filter-key condition))
 913           (case-fold-search t)
 914           result)
 915       (cond
 916        ((string= key "last")
 917         (setq result (<= (length (memq
 918                                   (elmo-msgdb-overview-entity-get-number
 919                                    entity)
 920                                   numbers))
 921                          (string-to-int (elmo-filter-value condition)))))
 922        ((string= key "first")
 923         (setq result (< (-
 924                          (length numbers)
 925                          (length (memq
 926                                   (elmo-msgdb-overview-entity-get-number
 927                                    entity)
 928                                   numbers)))
 929                         (string-to-int (elmo-filter-value condition)))))
 930        ((string= key "flag")
 931         (setq result
 932               (cond
 933                ((string= (elmo-filter-value condition) "any")
 934                 (not (or (null mark)
 935                          (string= mark elmo-msgdb-read-uncached-mark))))
 936                ((string= (elmo-filter-value condition) "digest")
 937                 (not (or (null mark)
 938                          (string= mark elmo-msgdb-read-uncached-mark)
 939                          (string= mark elmo-msgdb-answered-cached-mark)
 940                          (string= mark elmo-msgdb-answered-uncached-mark))))
 941 ;;        (member mark (append (elmo-msgdb-answered-marks)
 942 ;;                             (list elmo-msgdb-important-mark)
 943 ;;                             (elmo-msgdb-unread-marks))))
 944                ((string= (elmo-filter-value condition) "unread")
 945                 (member mark (elmo-msgdb-unread-marks)))
 946                ((string= (elmo-filter-value condition) "important")
 947                 (string= mark elmo-msgdb-important-mark))
 948                ((string= (elmo-filter-value condition) "answered")
 949                 (member mark (elmo-msgdb-answered-marks))))))
 950        ((string= key "from")
 951         (setq result (string-match
 952                       (elmo-filter-value condition)
 953                       (elmo-msgdb-overview-entity-get-from entity))))
 954        ((string= key "subject")
 955         (setq result (string-match
 956                       (elmo-filter-value condition)
 957                       (elmo-msgdb-overview-entity-get-subject entity))))
 958        ((string= key "to")
 959         (setq result (string-match
 960                       (elmo-filter-value condition)
 961                       (elmo-msgdb-overview-entity-get-to entity))))
 962        ((string= key "cc")
 963         (setq result (string-match
 964                       (elmo-filter-value condition)
 965                       (elmo-msgdb-overview-entity-get-cc entity))))
 966        ((or (string= key "since")
 967             (string= key "before"))
 968         (let ((field-date (elmo-date-make-sortable-string
 969                            (timezone-fix-time
 970                             (elmo-msgdb-overview-entity-get-date entity)
 971                             (current-time-zone) nil)))
 972               (specified-date
 973                (elmo-date-make-sortable-string
 974                 (elmo-date-get-datevec
 975                  (elmo-filter-value condition)))))
 976           (setq result (if (string= key "since")
 977                            (or (string= specified-date field-date)
 978                                (string< specified-date field-date))
 979                          (string< field-date specified-date)))))
 980        ((member key elmo-msgdb-extra-fields)
 981         (let ((extval (elmo-msgdb-overview-entity-get-extra-field entity key)))
 982           (when (stringp extval)
 983             (setq result (string-match
 984                           (elmo-filter-value condition)
 985                           extval)))))
 986        (t
 987         (throw 'unresolved condition)))
 988       (if (eq (elmo-filter-type condition) 'unmatch)
 989           (not result)
 990         result))))
 991
 992 (defun elmo-msgdb-match-condition-internal (condition mark entity numbers)
 993   (cond
 994    ((vectorp condition)
 995     (elmo-msgdb-match-condition-primitive condition mark entity numbers))
 996    ((eq (car condition) 'and)
 997     (let ((lhs (elmo-msgdb-match-condition-internal (nth 1 condition)
 998                                                     mark entity numbers)))
 999       (cond
1000        ((elmo-filter-condition-p lhs)
1001         (let ((rhs (elmo-msgdb-match-condition-internal
1002                     (nth 2 condition) mark entity numbers)))
1003           (cond ((elmo-filter-condition-p rhs)
1004                  (list 'and lhs rhs))
1005                 (rhs
1006                  lhs))))
1007        (lhs
1008         (elmo-msgdb-match-condition-internal (nth 2 condition)
1009                                              mark entity numbers)))))
1010    ((eq (car condition) 'or)
1011     (let ((lhs (elmo-msgdb-match-condition-internal (nth 1 condition)
1012                                                     mark entity numbers)))
1013       (cond
1014        ((elmo-filter-condition-p lhs)
1015         (let ((rhs (elmo-msgdb-match-condition-internal (nth 2 condition)
1016                                                         mark entity numbers)))
1017           (cond ((elmo-filter-condition-p rhs)
1018                  (list 'or lhs rhs))
1019                 (rhs
1020                  t)
1021                 (t
1022                  lhs))))
1023        (lhs
1024         t)
1025        (t
1026         (elmo-msgdb-match-condition-internal (nth 2 condition)
1027                                              mark entity numbers)))))))
1028
1029 (defun elmo-msgdb-match-condition (msgdb condition number numbers)
1030   "Check whether the condition of the message is satisfied or not.
1031 MSGDB is the msgdb to search from.
1032 CONDITION is the search condition.
1033 NUMBER is the message number to check.
1034 NUMBERS is the target message number list.
1035 Return CONDITION itself if no entity exists in msgdb."
1036   (let ((entity (elmo-msgdb-overview-get-entity number msgdb)))
1037     (if entity
1038         (elmo-msgdb-match-condition-internal condition
1039                                              (elmo-msgdb-get-mark msgdb number)
1040                                              entity numbers)
1041       condition)))
1042
1043 (defsubst elmo-msgdb-overview-entity-get-references (entity)
1044   (and entity (aref (cdr entity) 1)))
1045
1046 (defsubst elmo-msgdb-overview-entity-set-references (entity references)
1047   (and entity (aset (cdr entity) 1 references))
1048   entity)
1049
1050 ;; entity -> parent-entity
1051 (defsubst elmo-msgdb-overview-get-parent-entity (entity database)
1052   (setq entity (elmo-msgdb-overview-entity-get-references entity))
1053   ;; entity is parent-id.
1054   (and entity (assoc entity database)))
1055
1056 (defsubst elmo-msgdb-get-parent-entity (entity msgdb)
1057   (setq entity (elmo-msgdb-overview-entity-get-references entity))
1058   ;; entity is parent-id.
1059   (and entity (elmo-msgdb-overview-get-entity entity msgdb)))
1060
1061 (defsubst elmo-msgdb-overview-entity-get-number (entity)
1062   (and entity (aref (cdr entity) 0)))
1063
1064 (defsubst elmo-msgdb-overview-entity-get-from-no-decode (entity)
1065   (and entity (aref (cdr entity) 2)))
1066
1067 (defsubst elmo-msgdb-overview-entity-get-from (entity)
1068   (and entity
1069        (aref (cdr entity) 2)
1070        (elmo-msgdb-get-decoded-cache (aref (cdr entity) 2))))
1071
1072 (defsubst elmo-msgdb-overview-entity-set-number (entity number)
1073   (and entity (aset (cdr entity) 0 number))
1074   entity)
1075 ;;;(setcar (cadr entity) number) entity)
1076
1077 (defsubst elmo-msgdb-overview-entity-set-from (entity from)
1078   (and entity (aset (cdr entity) 2 from))
1079   entity)
1080
1081 (defsubst elmo-msgdb-overview-entity-get-subject (entity)
1082   (and entity
1083        (aref (cdr entity) 3)
1084        (elmo-msgdb-get-decoded-cache (aref (cdr entity) 3))))
1085
1086 (defsubst elmo-msgdb-overview-entity-get-subject-no-decode (entity)
1087   (and entity (aref (cdr entity) 3)))
1088
1089 (defsubst elmo-msgdb-overview-entity-set-subject (entity subject)
1090   (and entity (aset (cdr entity) 3 subject))
1091   entity)
1092
1093 (defsubst elmo-msgdb-overview-entity-get-date (entity)
1094   (and entity (aref (cdr entity) 4)))
1095
1096 (defsubst elmo-msgdb-overview-entity-set-date (entity date)
1097   (and entity (aset (cdr entity) 4 date))
1098   entity)
1099
1100 (defsubst elmo-msgdb-overview-entity-get-to (entity)
1101   (and entity (aref (cdr entity) 5)))
1102
1103 (defsubst elmo-msgdb-overview-entity-get-cc (entity)
1104   (and entity (aref (cdr entity) 6)))
1105
1106 (defsubst elmo-msgdb-overview-entity-get-size (entity)
1107   (and entity (aref (cdr entity) 7)))
1108
1109 (defsubst elmo-msgdb-overview-entity-set-size (entity size)
1110   (and entity (aset (cdr entity) 7 size))
1111   entity)
1112
1113 (defsubst elmo-msgdb-overview-entity-get-id (entity)
1114   (and entity (car entity)))
1115
1116 (defsubst elmo-msgdb-overview-entity-get-extra-field (entity field-name)
1117   (let ((field-name (downcase field-name))
1118         (extra (and entity (aref (cdr entity) 8))))
1119     (and extra
1120          (cdr (assoc field-name extra)))))
1121
1122 (defsubst elmo-msgdb-overview-entity-set-extra-field (entity field-name value)
1123   (let ((field-name (downcase field-name))
1124         (extras (and entity (aref (cdr entity) 8)))
1125         extra)
1126     (if (setq extra (assoc field-name extras))
1127         (setcdr extra value)
1128       (elmo-msgdb-overview-entity-set-extra
1129        entity
1130        (cons (cons field-name value) extras)))))
1131
1132 (defsubst elmo-msgdb-overview-entity-get-extra (entity)
1133   (and entity (aref (cdr entity) 8)))
1134
1135 (defsubst elmo-msgdb-overview-entity-set-extra (entity extra)
1136   (and entity (aset (cdr entity) 8 extra))
1137   entity)
1138
1139 ;;; New APIs
1140 (luna-define-method elmo-msgdb-message-entity ((msgdb elmo-msgdb-legacy) key)
1141   (elmo-get-hash-val
1142    (cond ((stringp key) key)
1143          ((numberp key) (format "#%d" key)))
1144    (elmo-msgdb-get-entity-hashtb msgdb)))
1145
1146 (defun elmo-msgdb-make-message-entity (&rest args)
1147   "Make an message entity."
1148   (cons (plist-get args :message-id)
1149         (vector (plist-get args :number)
1150                 (plist-get args :references)
1151                 (plist-get args :from)
1152                 (plist-get args :subject)
1153                 (plist-get args :date)
1154                 (plist-get args :to)
1155                 (plist-get args :cc)
1156                 (plist-get args :size)
1157                 (plist-get args :extra))))
1158
1159 (defsubst elmo-msgdb-message-entity-field (entity field &optional decode)
1160   (and entity
1161        (let ((field-value
1162               (case field
1163                 (to (aref (cdr entity) 5))
1164                 (cc (aref (cdr entity) 6))
1165                 (date (aref (cdr entity) 4))
1166                 (subject (aref (cdr entity) 3))
1167                 (from (aref (cdr entity) 2))
1168                 (message-id (car entity))
1169                 (references (aref (cdr entity) 1))
1170                 (size (aref (cdr entity) 7))
1171                 (t (cdr (assoc (symbol-name field) (aref (cdr entity) 8)))))))
1172          (if (and decode (memq field '(from subject)))
1173              (elmo-msgdb-get-decoded-cache field-value)
1174            field-value))))
1175
1176 (defsubst elmo-msgdb-message-entity-set-field (entity field value)
1177   (and entity
1178        (case field
1179          (to (aset (cdr entity) 5 value))
1180          (cc (aset (cdr entity) 6 value))
1181          (date (aset (cdr entity) 4 value))
1182          (subject (aset (cdr entity) 3 value))
1183          (from (aset (cdr entity) 2 value))
1184          (message-id (setcar entity value))
1185          (references (aset (cdr entity) 1 value))
1186          (size (aset (cdr entity) 7 value))
1187          (t
1188           (let ((extras (and entity (aref (cdr entity) 8)))
1189                 extra)
1190             (if (setq extra (assoc field extras))
1191                 (setcdr extra value)
1192               (aset (cdr entity) 8 (cons (cons (symbol-name field)
1193                                                value) extras))))))))
1194
1195 ;;;
1196 (defun elmo-msgdb-overview-get-entity (id msgdb)
1197   (elmo-msgdb-message-entity msgdb id))
1198
1199 ;;
1200 ;; deleted message handling
1201 ;;
1202 (defun elmo-msgdb-killed-list-load (dir)
1203   (elmo-object-load
1204    (expand-file-name elmo-msgdb-killed-filename dir)
1205    nil t))
1206
1207 (defun elmo-msgdb-killed-list-save (dir killed-list)
1208   (elmo-object-save
1209    (expand-file-name elmo-msgdb-killed-filename dir)
1210    killed-list))
1211
1212 (defun elmo-msgdb-killed-message-p (killed-list msg)
1213   (elmo-number-set-member msg killed-list))
1214
1215 (defun elmo-msgdb-set-as-killed (killed-list msg)
1216   (elmo-number-set-append killed-list msg))
1217
1218 (defun elmo-msgdb-killed-list-length (killed-list)
1219   (let ((killed killed-list)
1220         (ret-val 0))
1221     (while (car killed)
1222       (if (consp (car killed))
1223           (setq ret-val (+ ret-val 1 (- (cdar killed) (caar killed))))
1224         (setq ret-val (+ ret-val 1)))
1225       (setq killed (cdr killed)))
1226     ret-val))
1227
1228 (defun elmo-msgdb-max-of-killed (killed-list)
1229   (let ((klist killed-list)
1230         (max 0)
1231         k)
1232     (while (car klist)
1233       (if (< max
1234              (setq k
1235                    (if (consp (car klist))
1236                        (cdar klist)
1237                      (car klist))))
1238           (setq max k))
1239       (setq klist (cdr klist)))
1240     max))
1241
1242 (defun elmo-living-messages (messages killed-list)
1243   (if killed-list
1244       (delq nil
1245             (mapcar (lambda (number)
1246                       (unless (elmo-number-set-member number killed-list)
1247                         number))
1248                     messages))
1249     messages))
1250
1251 (defun elmo-msgdb-finfo-load ()
1252   (elmo-object-load (expand-file-name
1253                      elmo-msgdb-finfo-filename
1254                      elmo-msgdb-directory)
1255                     elmo-mime-charset t))
1256
1257 (defun elmo-msgdb-finfo-save (finfo)
1258   (elmo-object-save (expand-file-name
1259                      elmo-msgdb-finfo-filename
1260                      elmo-msgdb-directory)
1261                     finfo elmo-mime-charset))
1262
1263 (defun elmo-msgdb-flist-load (fname)
1264   (let ((flist-file (expand-file-name
1265                      elmo-msgdb-flist-filename
1266                      (expand-file-name
1267                       (elmo-safe-filename fname)
1268                       (expand-file-name "folder" elmo-msgdb-directory)))))
1269     (elmo-object-load flist-file elmo-mime-charset t)))
1270
1271 (defun elmo-msgdb-flist-save (fname flist)
1272   (let ((flist-file (expand-file-name
1273                      elmo-msgdb-flist-filename
1274                      (expand-file-name
1275                       (elmo-safe-filename fname)
1276                       (expand-file-name "folder" elmo-msgdb-directory)))))
1277     (elmo-object-save flist-file flist elmo-mime-charset)))
1278
1279 (defun elmo-crosspost-alist-load ()
1280   (elmo-object-load (expand-file-name
1281                      elmo-crosspost-alist-filename
1282                      elmo-msgdb-directory)
1283                     nil t))
1284
1285 (defun elmo-crosspost-alist-save (alist)
1286   (elmo-object-save (expand-file-name
1287                      elmo-crosspost-alist-filename
1288                      elmo-msgdb-directory)
1289                     alist))
1290
1291 (defun elmo-msgdb-get-message-id-from-buffer ()
1292   (let ((msgid (elmo-field-body "message-id")))
1293     (if msgid
1294         (if (string-match "<\\(.+\\)>$" msgid)
1295             msgid
1296           (concat "<" msgid ">")) ; Invaild message-id.
1297       ;; no message-id, so put dummy msgid.
1298       (concat "<" (timezone-make-date-sortable
1299                    (elmo-field-body "date"))
1300               (nth 1 (eword-extract-address-components
1301                       (or (elmo-field-body "from") "nobody"))) ">"))))
1302
1303 (defsubst elmo-msgdb-create-overview-from-buffer (number &optional size time)
1304   "Create overview entity from current buffer.
1305 Header region is supposed to be narrowed."
1306   (save-excursion
1307     (let ((extras elmo-msgdb-extra-fields)
1308           (default-mime-charset default-mime-charset)
1309           message-id references from subject to cc date
1310           extra field-body charset)
1311       (elmo-set-buffer-multibyte default-enable-multibyte-characters)
1312       (setq message-id (elmo-msgdb-get-message-id-from-buffer))
1313       (and (setq charset (cdr (assoc "charset" (mime-read-Content-Type))))
1314            (setq charset (intern-soft charset))
1315            (setq default-mime-charset charset))
1316       (setq references
1317             (or (elmo-msgdb-get-last-message-id
1318                  (elmo-field-body "in-reply-to"))
1319                 (elmo-msgdb-get-last-message-id
1320                  (elmo-field-body "references"))))
1321       (setq from (elmo-replace-in-string
1322                   (elmo-mime-string (or (elmo-field-body "from")
1323                                         elmo-no-from))
1324                   "\t" " ")
1325             subject (elmo-replace-in-string
1326                      (elmo-mime-string (or (elmo-field-body "subject")
1327                                            elmo-no-subject))
1328                      "\t" " "))
1329       (setq date (or (elmo-field-body "date") time))
1330       (setq to   (mapconcat 'identity (elmo-multiple-field-body "to") ","))
1331       (setq cc   (mapconcat 'identity (elmo-multiple-field-body "cc") ","))
1332       (or size
1333           (if (setq size (elmo-field-body "content-length"))
1334               (setq size (string-to-int size))
1335             (setq size 0)));; No mean...
1336       (while extras
1337         (if (setq field-body (elmo-field-body (car extras)))
1338             (setq extra (cons (cons (downcase (car extras))
1339                                     field-body) extra)))
1340         (setq extras (cdr extras)))
1341       (cons message-id (vector number references
1342                                from subject date to cc
1343                                size extra))
1344       )))
1345
1346 (defun elmo-msgdb-copy-overview-entity (entity)
1347   (cons (car entity)
1348         (copy-sequence (cdr entity))))
1349
1350 (defsubst elmo-msgdb-insert-file-header (file)
1351   "Insert the header of the article."
1352   (let ((beg 0)
1353         insert-file-contents-pre-hook   ; To avoid autoconv-xmas...
1354         insert-file-contents-post-hook
1355         format-alist)
1356     (when (file-exists-p file)
1357       ;; Read until header separator is found.
1358       (while (and (eq elmo-msgdb-file-header-chop-length
1359                       (nth 1
1360                            (insert-file-contents-as-binary
1361                             file nil beg
1362                             (incf beg elmo-msgdb-file-header-chop-length))))
1363                   (prog1 (not (search-forward "\n\n" nil t))
1364                     (goto-char (point-max))))))))
1365
1366 (defsubst elmo-msgdb-create-overview-entity-from-file (number file)
1367   (let (insert-file-contents-pre-hook   ; To avoid autoconv-xmas...
1368         insert-file-contents-post-hook header-end
1369         (attrib (file-attributes file))
1370         ret-val size mtime)
1371     (with-temp-buffer
1372       (if (not (file-exists-p file))
1373           ()
1374         (setq size (nth 7 attrib))
1375         (setq mtime (timezone-make-date-arpa-standard
1376                      (current-time-string (nth 5 attrib)) (current-time-zone)))
1377         ;; insert header from file.
1378         (catch 'done
1379           (condition-case nil
1380               (elmo-msgdb-insert-file-header file)
1381             (error (throw 'done nil)))
1382           (goto-char (point-min))
1383           (setq header-end
1384                 (if (re-search-forward "\\(^--.*$\\)\\|\\(\n\n\\)" nil t)
1385                     (point)
1386                   (point-max)))
1387           (narrow-to-region (point-min) header-end)
1388           (elmo-msgdb-create-overview-from-buffer number size mtime))))))
1389
1390 (defun elmo-msgdb-clear-index (msgdb entity)
1391   (let ((ehash (elmo-msgdb-get-entity-hashtb msgdb))
1392         (mhash (elmo-msgdb-get-mark-hashtb msgdb))
1393         number)
1394     (when (and entity ehash)
1395       (and (setq number (elmo-msgdb-overview-entity-get-number entity))
1396            (elmo-clear-hash-val (format "#%d" number) ehash))
1397       (and (car entity) ;; message-id
1398            (elmo-clear-hash-val (car entity) ehash)))
1399     (when (and entity mhash)
1400       (and (setq number (elmo-msgdb-overview-entity-get-number entity))
1401            (elmo-clear-hash-val (format "#%d" number) mhash)))))
1402
1403 (defun elmo-msgdb-make-index (msgdb &optional overview mark-alist)
1404   "Append OVERVIEW and MARK-ALIST to the index of MSGDB.
1405 If OVERVIEW and MARK-ALIST are nil, make index for current MSGDB.
1406 Return a list of message numbers which have duplicated message-ids."
1407   (when msgdb
1408     (let* ((overview (or overview (elmo-msgdb-get-overview msgdb)))
1409            (mark-alist (or mark-alist (elmo-msgdb-get-mark-alist msgdb)))
1410            (index (elmo-msgdb-get-index msgdb))
1411            (ehash (or (car index) ;; append
1412                       (elmo-make-hash (length overview))))
1413            (mhash (or (cdr index) ;; append
1414                       (elmo-make-hash (length overview))))
1415            duplicates)
1416       (while overview
1417         ;; key is message-id
1418         (if (elmo-get-hash-val (caar overview) ehash) ; duplicated.
1419             (setq duplicates (cons
1420                               (elmo-msgdb-overview-entity-get-number
1421                                (car overview))
1422                               duplicates)))
1423         (if (caar overview)
1424             (elmo-set-hash-val (caar overview) (car overview) ehash))
1425         ;; key is number
1426         (elmo-set-hash-val
1427          (format "#%d"
1428                  (elmo-msgdb-overview-entity-get-number (car overview)))
1429          (car overview) ehash)
1430         (setq overview (cdr overview)))
1431       (while mark-alist
1432         ;; key is number
1433         (elmo-set-hash-val
1434          (format "#%d" (car (car mark-alist)))
1435          (car mark-alist) mhash)
1436         (setq mark-alist (cdr mark-alist)))
1437       (setq index (or index (cons ehash mhash)))
1438       (elmo-msgdb-set-index msgdb index)
1439       duplicates)))
1440
1441 (defsubst elmo-folder-get-info (folder &optional hashtb)
1442   (elmo-get-hash-val folder
1443                      (or hashtb elmo-folder-info-hashtb)))
1444
1445 (defun elmo-folder-get-info-max (folder)
1446   "Get folder info from cache."
1447   (nth 3 (elmo-folder-get-info folder)))
1448
1449 (defun elmo-folder-get-info-length (folder)
1450   (nth 2 (elmo-folder-get-info folder)))
1451
1452 (defun elmo-folder-get-info-unread (folder)
1453   (nth 1 (elmo-folder-get-info folder)))
1454
1455 (defsubst elmo-msgdb-location-load (dir)
1456   (elmo-object-load
1457    (expand-file-name
1458     elmo-msgdb-location-filename
1459     dir)))
1460
1461 (defsubst elmo-msgdb-location-add (alist number location)
1462   (let ((ret-val alist))
1463     (setq ret-val
1464           (elmo-msgdb-append-element ret-val (cons number location)))
1465     ret-val))
1466
1467 (defsubst elmo-msgdb-location-save (dir alist)
1468   (elmo-object-save
1469    (expand-file-name
1470     elmo-msgdb-location-filename
1471     dir) alist))
1472
1473 (luna-define-method elmo-msgdb-list-flagged ((msgdb elmo-msgdb-legacy) flag)
1474   (let ((case-fold-search nil)
1475         mark-regexp matched)
1476     (case flag
1477       (new
1478        (setq mark-regexp (regexp-quote elmo-msgdb-new-mark)))
1479       (unread
1480        (setq mark-regexp (elmo-regexp-opt (elmo-msgdb-unread-marks))))
1481       (answered
1482        (setq mark-regexp (elmo-regexp-opt (elmo-msgdb-answered-marks))))
1483       (important
1484        (setq mark-regexp (regexp-quote elmo-msgdb-important-mark)))
1485       (read
1486        (setq mark-regexp (elmo-regexp-opt (elmo-msgdb-unread-marks))))
1487       (digest
1488        (setq mark-regexp (elmo-regexp-opt
1489                           (append (elmo-msgdb-unread-marks)
1490                                   (list elmo-msgdb-important-mark)))))
1491       (any
1492        (setq mark-regexp (elmo-regexp-opt
1493                           (append
1494                            (elmo-msgdb-unread-marks)
1495                            (elmo-msgdb-answered-marks)
1496                            (list elmo-msgdb-important-mark))))))
1497     (when mark-regexp
1498       (if (eq flag 'read)
1499           (dolist (number (elmo-msgdb-list-messages msgdb))
1500             (let ((mark (elmo-msgdb-get-mark msgdb number)))
1501               (unless (and mark (string-match mark-regexp mark))
1502                 (setq matched (cons number matched)))))
1503         (dolist (elem (elmo-msgdb-get-mark-alist msgdb))
1504           (if (string-match mark-regexp (cadr elem))
1505               (setq matched (cons (car elem) matched))))))
1506     matched))
1507
1508 (require 'product)
1509 (product-provide (provide 'elmo-msgdb) (require 'elmo-version))
1510
1511 ;;; elmo-msgdb.el ends here