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