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