elmo/elmo-msgdb.el

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