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