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