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 ;;; MSGDB interface.
  42 (defun elmo-load-msgdb (path)
  43   "Load the MSGDB from PATH."
  44   (let ((inhibit-quit t))
  45     (elmo-make-msgdb (elmo-msgdb-overview-load path)
  46                      (elmo-msgdb-number-load path)
  47                      (elmo-msgdb-mark-load path))))
  48
  49 (defun elmo-make-msgdb (&optional overview number-alist mark-alist)
  50   "Make a MSGDB."
  51   (let ((msgdb (list overview number-alist mark-alist nil)))
  52     (elmo-msgdb-make-index msgdb)
  53     msgdb))
  54
  55 (defsubst elmo-msgdb-get-mark (msgdb number)
  56   "Get mark string from MSGDB which corresponds to the message with NUMBER."
  57   (cadr (elmo-get-hash-val (format "#%d" number)
  58                            (elmo-msgdb-get-mark-hashtb msgdb))))
  59
  60 (defsubst elmo-msgdb-set-mark (msgdb number mark)
  61   "Set MARK of the message with NUMBER in the MSGDB.
  62 if MARK is nil, mark is removed."
  63   (elmo-msgdb-set-mark-alist
  64    msgdb
  65    (elmo-msgdb-mark-alist-set (elmo-msgdb-get-mark-alist msgdb)
  66                               number
  67                               mark msgdb))
  68   (unless mark
  69     (elmo-clear-hash-val (format "#%d" number)
  70                          (elmo-msgdb-get-mark-hashtb msgdb))))
  71
  72 (defsubst elmo-msgdb-count-marks (msgdb new-mark unread-marks)
  73   (let ((new 0)
  74         (unreads 0))
  75     (dolist (elem (elmo-msgdb-get-mark-alist msgdb))
  76       (cond
  77        ((string= (cadr elem) new-mark)
  78         (incf new))
  79        ((member (cadr elem) unread-marks)
  80         (incf unreads))))
  81     (cons new unreads)))
  82
  83 (defsubst elmo-msgdb-get-number (msgdb message-id)
  84   "Get number of the message which corrensponds to MESSAGE-ID from MSGDB."
  85   (elmo-msgdb-overview-entity-get-number
  86    (elmo-msgdb-overview-get-entity message-id msgdb)))
  87
  88 (defsubst elmo-msgdb-get-field (msgdb number field)
  89   "Get FIELD value of the message with NUMBER from MSGDB."
  90   (case field
  91     (message-id (elmo-msgdb-overview-entity-get-id
  92                  (elmo-msgdb-overview-get-entity
  93                   number msgdb)))
  94     (subject (elmo-msgdb-overview-entity-get-subject
  95               (elmo-msgdb-overview-get-entity
  96                number msgdb)))
  97     (size (elmo-msgdb-overview-entity-get-size
  98            (elmo-msgdb-overview-get-entity
  99             number msgdb)))
 100     (date (elmo-msgdb-overview-entity-get-date
 101            (elmo-msgdb-overview-get-entity
 102             number msgdb)))
 103     (to (elmo-msgdb-overview-entity-get-to
 104          (elmo-msgdb-overview-get-entity
 105           number msgdb)))
 106     (cc (elmo-msgdb-overview-entity-get-cc
 107          (elmo-msgdb-overview-get-entity
 108           number msgdb)))))
 109
 110 (defsubst elmo-msgdb-append (msgdb msgdb-append)
 111   (list
 112    (nconc (car msgdb) (car msgdb-append))
 113    (nconc (cadr msgdb) (cadr msgdb-append))
 114    (nconc (caddr msgdb) (caddr msgdb-append))
 115    (elmo-msgdb-make-index
 116     msgdb
 117     (elmo-msgdb-get-overview msgdb-append)
 118     (elmo-msgdb-get-mark-alist msgdb-append))))
 119
 120 (defsubst elmo-msgdb-clear (&optional msgdb)
 121   (if msgdb
 122       (list
 123        (setcar msgdb nil)
 124        (setcar (cdr msgdb) nil)
 125        (setcar (cddr msgdb) nil)
 126        (setcar (nthcdr 3 msgdb) nil))
 127     (list nil nil nil nil)))
 128
 129 (defun elmo-msgdb-delete-msgs (msgdb msgs)
 130   "Delete MSGS from MSGDB
 131 content of MSGDB is changed."
 132   (let* ((overview (car msgdb))
 133          (number-alist (cadr msgdb))
 134          (mark-alist (caddr msgdb))
 135          (index (elmo-msgdb-get-index msgdb))
 136          (newmsgdb (list overview number-alist mark-alist index))
 137          ov-entity)
 138     ;; remove from current database.
 139     (while msgs
 140       (setq overview
 141             (delq
 142              (setq ov-entity
 143                    (elmo-msgdb-overview-get-entity (car msgs) newmsgdb))
 144              overview))
 145       (setq number-alist (delq (assq (car msgs) number-alist) number-alist))
 146       (setq mark-alist (delq (assq (car msgs) mark-alist) mark-alist))
 147       ;;
 148       (when index (elmo-msgdb-clear-index msgdb ov-entity))
 149       (setq msgs (cdr msgs)))
 150     (setcar msgdb overview)
 151     (setcar (cdr msgdb) number-alist)
 152     (setcar (cddr msgdb) mark-alist)
 153     (setcar (nthcdr 3 msgdb) index)
 154     t)) ;return value
 155
 156 (defun elmo-msgdb-sort-by-date (msgdb)
 157   (message "Sorting...")
 158   (let ((overview (elmo-msgdb-get-overview msgdb)))
 159     (setq overview (elmo-msgdb-overview-sort-by-date overview))
 160     (message "Sorting...done")
 161     (list overview (nth 1 msgdb)(nth 2 msgdb))))
 162
 163 (defun elmo-msgdb-make-entity (&rest args)
 164   "Make an msgdb entity."
 165   (cons (plist-get args :message-id)
 166         (vector (plist-get args :number)
 167                 (plist-get args :references)
 168                 (plist-get args :from)
 169                 (plist-get args :subject)
 170                 (plist-get args :date)
 171                 (plist-get args :to)
 172                 (plist-get args :cc)
 173                 (plist-get args :size)
 174                 (plist-get args :extra))))
 175
 176 ;;;
 177 (defsubst elmo-msgdb-append-element (list element)
 178   (if list
 179 ;;;   (append list (list element))
 180       (nconc list (list element))
 181     ;; list is nil
 182     (list element)))
 183
 184 (defsubst elmo-msgdb-get-overview (msgdb)
 185   (car msgdb))
 186 (defsubst elmo-msgdb-get-number-alist (msgdb)
 187   (cadr msgdb))
 188 (defsubst elmo-msgdb-get-mark-alist (msgdb)
 189   (caddr msgdb))
 190 ;(defsubst elmo-msgdb-get-location (msgdb)
 191 ;  (cadddr msgdb))
 192
 193 (defsubst elmo-msgdb-get-index (msgdb)
 194   (nth 3 msgdb))
 195
 196 (defsubst elmo-msgdb-get-entity-hashtb (msgdb)
 197   (car (nth 3 msgdb)))
 198
 199 (defsubst elmo-msgdb-get-mark-hashtb (msgdb)
 200   (cdr (nth 3 msgdb)))
 201
 202 ;;
 203 ;; number <-> Message-ID handling
 204 ;;
 205 (defsubst elmo-msgdb-number-add (alist number id)
 206   (let ((ret-val alist))
 207     (setq ret-val
 208           (elmo-msgdb-append-element ret-val (cons number id)))
 209     ret-val))
 210
 211 ;;;
 212 ;; persistent mark handling
 213 ;; (for each folder)
 214 (defun elmo-msgdb-mark-alist-set (alist id mark msgdb)
 215   (let ((ret-val alist)
 216         entity)
 217     (setq entity (assq id alist))
 218     (if entity
 219         (if (eq mark nil)
 220             ;; delete this entity
 221             (setq ret-val (delq entity alist))
 222           ;; set mark
 223           (setcar (cdr entity) mark))
 224       (when mark
 225         (setq ret-val (elmo-msgdb-append-element ret-val
 226                                                  (setq entity
 227                                                        (list id mark))))
 228         (elmo-set-hash-val (format "#%d" id) entity
 229                            (elmo-msgdb-get-mark-hashtb msgdb))))
 230     ret-val))
 231
 232 (defun elmo-msgdb-mark-append (alist id mark)
 233   "Append mark."
 234   (setq alist (elmo-msgdb-append-element alist
 235                                          (list id mark))))
 236
 237 (defun elmo-msgdb-seen-list (msgdb seen-marks)
 238   "Get SEEN-MSGID-LIST from MSGDB."
 239   (let ((ov (elmo-msgdb-get-overview msgdb))
 240         mark seen-list)
 241     (while ov
 242       (if (setq mark (elmo-msgdb-get-mark
 243                       msgdb
 244                       (elmo-msgdb-overview-entity-get-number (car ov))))
 245           (if (and mark (member mark seen-marks))
 246               (setq seen-list (cons
 247                                (elmo-msgdb-overview-entity-get-id (car ov))
 248                                seen-list)))
 249         (setq seen-list (cons
 250                          (elmo-msgdb-overview-entity-get-id (car ov))
 251                          seen-list)))
 252       (setq ov (cdr ov)))
 253     seen-list))
 254
 255 ;;
 256 ;; mime decode cache
 257
 258 (defvar elmo-msgdb-decoded-cache-hashtb nil)
 259 (make-variable-buffer-local 'elmo-msgdb-decoded-cache-hashtb)
 260
 261 (defsubst elmo-msgdb-get-decoded-cache (string)
 262   (if elmo-use-decoded-cache
 263       (let ((hashtb (or elmo-msgdb-decoded-cache-hashtb
 264                         (setq elmo-msgdb-decoded-cache-hashtb
 265                               (elmo-make-hash 2048))))
 266             decoded)
 267         (or (elmo-get-hash-val string hashtb)
 268             (progn
 269               (elmo-set-hash-val
 270                string
 271                (setq decoded
 272                      (decode-mime-charset-string string elmo-mime-charset))
 273                hashtb)
 274               decoded)))
 275     (decode-mime-charset-string string elmo-mime-charset)))
 276
 277 ;;
 278 ;; overview handling
 279 ;;
 280
 281 (defsubst elmo-msgdb-get-field-value (field-name beg end buffer)
 282   (save-excursion
 283     (save-restriction
 284       (set-buffer buffer)
 285       (narrow-to-region beg end)
 286       (elmo-field-body field-name))))
 287
 288 (defun elmo-multiple-field-body (name &optional boundary)
 289   (save-excursion
 290     (save-restriction
 291       (std11-narrow-to-header boundary)
 292       (goto-char (point-min))
 293       (let ((case-fold-search t)
 294             (field-body nil))
 295         (while (re-search-forward (concat "^" name ":[ \t]*") nil t)
 296           (setq field-body
 297                 (nconc field-body
 298                        (list (buffer-substring-no-properties
 299                               (match-end 0) (std11-field-end))))))
 300         field-body))))
 301
 302 (defun elmo-multiple-fields-body-list (field-names &optional boundary)
 303   "Return list of each field-bodies of FIELD-NAMES of the message header
 304 in current buffer. If BOUNDARY is not nil, it is used as message
 305 header separator."
 306   (save-excursion
 307     (save-restriction
 308       (std11-narrow-to-header boundary)
 309       (let* ((case-fold-search t)
 310              (s-rest field-names)
 311              field-name field-body)
 312         (while (setq field-name (car s-rest))
 313           (goto-char (point-min))
 314           (while (re-search-forward (concat "^" field-name ":[ \t]*") nil t)
 315             (setq field-body
 316                   (nconc field-body
 317                          (list (buffer-substring-no-properties
 318                                 (match-end 0) (std11-field-end))))))
 319           (setq s-rest (cdr s-rest)))
 320         field-body))))
 321
 322 (defsubst elmo-msgdb-remove-field-string (string)
 323   (if (string-match (concat std11-field-head-regexp "[ \t]*") string)
 324       (substring string (match-end 0))
 325     string))
 326
 327 (defsubst elmo-msgdb-get-last-message-id (string)
 328   (if string
 329       (save-match-data
 330         (let (beg)
 331           (elmo-set-work-buf
 332            (insert string)
 333            (goto-char (point-max))
 334            (when (search-backward "<" nil t)
 335              (setq beg (point))
 336              (if (search-forward ">" nil t)
 337                  (elmo-replace-in-string
 338                   (buffer-substring beg (point)) "\n[ \t]*" ""))))))))
 339
 340 (defun elmo-msgdb-number-load (dir)
 341   (elmo-object-load
 342    (expand-file-name elmo-msgdb-number-filename dir)))
 343
 344 (defun elmo-msgdb-overview-load (dir)
 345   (elmo-object-load
 346    (expand-file-name elmo-msgdb-overview-filename dir)))
 347
 348 (defun elmo-msgdb-mark-load (dir)
 349   (elmo-object-load
 350    (expand-file-name elmo-msgdb-mark-filename dir)))
 351
 352 (defsubst elmo-msgdb-seen-load (dir)
 353   (elmo-object-load (expand-file-name
 354                      elmo-msgdb-seen-filename
 355                      dir)))
 356
 357 (defun elmo-msgdb-number-save (dir obj)
 358   (elmo-object-save
 359    (expand-file-name elmo-msgdb-number-filename dir)
 360    obj))
 361
 362 (defun elmo-msgdb-mark-save (dir obj)
 363   (elmo-object-save
 364    (expand-file-name elmo-msgdb-mark-filename dir)
 365    obj))
 366
 367 (defun elmo-msgdb-change-mark (msgdb before after)
 368   "Set the BEFORE marks to AFTER."
 369   (let ((mark-alist (elmo-msgdb-get-mark-alist msgdb))
 370         entity)
 371     (while mark-alist
 372       (setq entity (car mark-alist))
 373       (when (string= (cadr entity) before)
 374         (setcar (cdr entity) after))
 375       (setq mark-alist (cdr mark-alist)))))
 376
 377 (defsubst elmo-msgdb-seen-save (dir obj)
 378   (elmo-object-save
 379    (expand-file-name elmo-msgdb-seen-filename dir)
 380    obj))
 381
 382 (defsubst elmo-msgdb-overview-save (dir overview)
 383   (elmo-object-save
 384    (expand-file-name elmo-msgdb-overview-filename dir)
 385    overview))
 386
 387 (defun elmo-msgdb-match-condition-primitive (condition entity numbers)
 388   (catch 'unresolved
 389     (let ((key (elmo-filter-key condition))
 390           (case-fold-search t)
 391           result)
 392       (cond
 393        ((string= key "last")
 394         (setq result (<= (length (memq
 395                                   (elmo-msgdb-overview-entity-get-number
 396                                    entity)
 397                                   numbers))
 398                          (string-to-int (elmo-filter-value condition)))))
 399        ((string= key "first")
 400         (setq result (< (-
 401                          (length numbers)
 402                          (length (memq
 403                                   (elmo-msgdb-overview-entity-get-number
 404                                    entity)
 405                                   numbers)))
 406                         (string-to-int (elmo-filter-value condition)))))
 407        ((string= key "from")
 408         (setq result (string-match
 409                       (elmo-filter-value condition)
 410                       (elmo-msgdb-overview-entity-get-from entity))))
 411        ((string= key "subject")
 412         (setq result (string-match
 413                       (elmo-filter-value condition)
 414                       (elmo-msgdb-overview-entity-get-subject entity))))
 415        ((string= key "to")
 416         (setq result (string-match
 417                       (elmo-filter-value condition)
 418                       (elmo-msgdb-overview-entity-get-to entity))))
 419        ((string= key "cc")
 420         (setq result (string-match
 421                       (elmo-filter-value condition)
 422                       (elmo-msgdb-overview-entity-get-cc entity))))
 423        ((or (string= key "since")
 424             (string= key "before"))
 425         (let ((field-date (elmo-date-make-sortable-string
 426                            (timezone-fix-time
 427                             (elmo-msgdb-overview-entity-get-date entity)
 428                             (current-time-zone) nil)))
 429               (specified-date
 430                (elmo-date-make-sortable-string
 431                 (elmo-date-get-datevec
 432                  (elmo-filter-value condition)))))
 433           (setq result (if (string= key "since")
 434                            (or (string= specified-date field-date)
 435                                (string< specified-date field-date))
 436                          (string< field-date specified-date)))))
 437        ((member key elmo-msgdb-extra-fields)
 438         (let ((extval (elmo-msgdb-overview-entity-get-extra-field entity key)))
 439           (when (stringp extval)
 440             (setq result (string-match
 441                           (elmo-filter-value condition)
 442                           extval)))))
 443        (t
 444         (throw 'unresolved condition)))
 445       (if (eq (elmo-filter-type condition) 'unmatch)
 446           (not result)
 447         result))))
 448
 449 (defun elmo-msgdb-match-condition (condition entity numbers)
 450   (cond
 451    ((vectorp condition)
 452     (elmo-msgdb-match-condition-primitive condition entity numbers))
 453    ((eq (car condition) 'and)
 454     (let ((lhs (elmo-msgdb-match-condition (nth 1 condition)
 455                                            entity numbers)))
 456       (cond
 457        ((elmo-filter-condition-p lhs)
 458         (let ((rhs (elmo-msgdb-match-condition (nth 2 condition)
 459                                                entity numbers)))
 460           (cond ((elmo-filter-condition-p rhs)
 461                  (list 'and lhs rhs))
 462                 (rhs
 463                  lhs))))
 464        (lhs
 465         (elmo-msgdb-match-condition (nth 2 condition)
 466                                     entity numbers)))))
 467    ((eq (car condition) 'or)
 468     (let ((lhs (elmo-msgdb-match-condition (nth 1 condition)
 469                                            entity numbers)))
 470       (cond
 471        ((elmo-filter-condition-p lhs)
 472         (let ((rhs (elmo-msgdb-match-condition (nth 2 condition)
 473                                                entity numbers)))
 474           (cond ((elmo-filter-condition-p rhs)
 475                  (list 'or lhs rhs))
 476                 (rhs
 477                  t)
 478                 (t
 479                  lhs))))
 480        (lhs
 481         t)
 482        (t
 483         (elmo-msgdb-match-condition (nth 2 condition)
 484                                     entity numbers)))))))
 485
 486 (defsubst elmo-msgdb-set-overview (msgdb overview)
 487   (setcar msgdb overview))
 488
 489 (defsubst elmo-msgdb-set-number-alist (msgdb number-alist)
 490   (setcar (cdr msgdb) number-alist))
 491
 492 (defsubst elmo-msgdb-set-mark-alist (msgdb mark-alist)
 493   (setcar (cddr msgdb) mark-alist))
 494
 495 (defsubst elmo-msgdb-set-index (msgdb index)
 496   (setcar (cdddr msgdb) index))
 497
 498 (defsubst elmo-msgdb-overview-entity-get-references (entity)
 499   (and entity (aref (cdr entity) 1)))
 500
 501 (defsubst elmo-msgdb-overview-entity-set-references (entity references)
 502   (and entity (aset (cdr entity) 1 references))
 503   entity)
 504
 505 ;; entity -> parent-entity
 506 (defsubst elmo-msgdb-overview-get-parent-entity (entity database)
 507   (setq entity (elmo-msgdb-overview-entity-get-references entity))
 508   ;; entity is parent-id.
 509   (and entity (assoc entity database)))
 510
 511 (defsubst elmo-msgdb-get-parent-entity (entity msgdb)
 512   (setq entity (elmo-msgdb-overview-entity-get-references entity))
 513   ;; entity is parent-id.
 514   (and entity (elmo-msgdb-overview-get-entity entity msgdb)))
 515
 516 (defsubst elmo-msgdb-overview-entity-get-number (entity)
 517   (and entity (aref (cdr entity) 0)))
 518
 519 (defsubst elmo-msgdb-overview-entity-get-from-no-decode (entity)
 520   (and entity (aref (cdr entity) 2)))
 521
 522 (defsubst elmo-msgdb-overview-entity-get-from (entity)
 523   (and entity
 524        (aref (cdr entity) 2)
 525        (elmo-msgdb-get-decoded-cache (aref (cdr entity) 2))))
 526
 527 (defsubst elmo-msgdb-overview-entity-set-number (entity number)
 528   (and entity (aset (cdr entity) 0 number))
 529   entity)
 530 ;;;(setcar (cadr entity) number) entity)
 531
 532 (defsubst elmo-msgdb-overview-entity-set-from (entity from)
 533   (and entity (aset (cdr entity) 2 from))
 534   entity)
 535
 536 (defsubst elmo-msgdb-overview-entity-get-subject (entity)
 537   (and entity
 538        (aref (cdr entity) 3)
 539        (elmo-msgdb-get-decoded-cache (aref (cdr entity) 3))))
 540
 541 (defsubst elmo-msgdb-overview-entity-get-subject-no-decode (entity)
 542   (and entity (aref (cdr entity) 3)))
 543
 544 (defsubst elmo-msgdb-overview-entity-set-subject (entity subject)
 545   (and entity (aset (cdr entity) 3 subject))
 546   entity)
 547
 548 (defsubst elmo-msgdb-overview-entity-get-date (entity)
 549   (and entity (aref (cdr entity) 4)))
 550
 551 (defsubst elmo-msgdb-overview-entity-set-date (entity date)
 552   (and entity (aset (cdr entity) 4 date))
 553   entity)
 554
 555 (defsubst elmo-msgdb-overview-entity-get-to (entity)
 556   (and entity (aref (cdr entity) 5)))
 557
 558 (defsubst elmo-msgdb-overview-entity-get-cc (entity)
 559   (and entity (aref (cdr entity) 6)))
 560
 561 (defsubst elmo-msgdb-overview-entity-get-size (entity)
 562   (and entity (aref (cdr entity) 7)))
 563
 564 (defsubst elmo-msgdb-overview-entity-set-size (entity size)
 565   (and entity (aset (cdr entity) 7 size))
 566   entity)
 567
 568 (defsubst elmo-msgdb-overview-entity-get-id (entity)
 569   (and entity (car entity)))
 570
 571 (defsubst elmo-msgdb-overview-entity-get-extra-field (entity field-name)
 572   (let ((extra (and entity (aref (cdr entity) 8))))
 573     (and extra
 574          (cdr (assoc field-name extra)))))
 575
 576 (defsubst elmo-msgdb-overview-entity-set-extra-field (entity field-name value)
 577   (let ((extras (and entity (aref (cdr entity) 8)))
 578         extra)
 579     (if (setq extra (assoc field-name extras))
 580         (setcdr extra value)
 581       (elmo-msgdb-overview-entity-set-extra
 582        entity
 583        (cons (cons field-name value) extras)))))
 584
 585 (defsubst elmo-msgdb-overview-entity-get-extra (entity)
 586   (and entity (aref (cdr entity) 8)))
 587
 588 (defsubst elmo-msgdb-overview-entity-set-extra (entity extra)
 589   (and entity (aset (cdr entity) 8 extra))
 590   entity)
 591
 592 (defun elmo-msgdb-overview-get-entity-by-number (database number)
 593   (when number
 594     (let ((db database)
 595           entity)
 596       (while db
 597         (if (eq (elmo-msgdb-overview-entity-get-number (car db)) number)
 598             (setq entity (car db)
 599                   db nil) ; exit loop
 600           (setq db (cdr db))))
 601       entity)))
 602
 603 (defun elmo-msgdb-overview-get-entity (id msgdb)
 604   (when id
 605     (let ((ht (elmo-msgdb-get-entity-hashtb msgdb)))
 606       (if ht
 607           (if (stringp id) ;; ID is message-id
 608               (elmo-get-hash-val id ht)
 609             (elmo-get-hash-val (format "#%d" id) ht))))))
 610
 611 ;;
 612 ;; deleted message handling
 613 ;;
 614 (defun elmo-msgdb-killed-list-load (dir)
 615   (elmo-object-load
 616    (expand-file-name elmo-msgdb-killed-filename dir)
 617    nil t))
 618
 619 (defun elmo-msgdb-killed-list-save (dir killed-list)
 620   (elmo-object-save
 621    (expand-file-name elmo-msgdb-killed-filename dir)
 622    killed-list))
 623
 624 (defun elmo-msgdb-killed-message-p (killed-list msg)
 625   (elmo-number-set-member msg killed-list))
 626
 627 (defun elmo-msgdb-set-as-killed (killed-list msg)
 628   (elmo-number-set-append killed-list msg))
 629
 630 (defun elmo-msgdb-append-to-killed-list (folder msgs)
 631   (elmo-folder-set-killed-list-internal
 632    folder
 633    (elmo-number-set-append-list
 634     (elmo-folder-killed-list-internal folder)
 635     msgs)))
 636
 637 (defun elmo-msgdb-killed-list-length (killed-list)
 638   (let ((killed killed-list)
 639         (ret-val 0))
 640     (while (car killed)
 641       (if (consp (car killed))
 642           (setq ret-val (+ ret-val 1 (- (cdar killed) (caar killed))))
 643         (setq ret-val (+ ret-val 1)))
 644       (setq killed (cdr killed)))
 645     ret-val))
 646
 647 (defun elmo-msgdb-max-of-killed (killed-list)
 648   (let ((klist killed-list)
 649         (max 0)
 650         k)
 651     (while (car klist)
 652       (if (< max
 653              (setq k
 654                    (if (consp (car klist))
 655                        (cdar klist)
 656                      (car klist))))
 657           (setq max k))
 658       (setq klist (cdr klist)))
 659     max))
 660
 661 (defun elmo-living-messages (messages killed-list)
 662   (if killed-list
 663       (delq nil
 664             (mapcar (lambda (number)
 665                       (unless (elmo-number-set-member number killed-list)
 666                         number))
 667                     messages))
 668     messages))
 669
 670 (defun elmo-msgdb-finfo-load ()
 671   (elmo-object-load (expand-file-name
 672                      elmo-msgdb-finfo-filename
 673                      elmo-msgdb-directory)
 674                     elmo-mime-charset t))
 675
 676 (defun elmo-msgdb-finfo-save (finfo)
 677   (elmo-object-save (expand-file-name
 678                      elmo-msgdb-finfo-filename
 679                      elmo-msgdb-directory)
 680                     finfo elmo-mime-charset))
 681
 682 (defun elmo-msgdb-flist-load (fname)
 683   (let ((flist-file (expand-file-name
 684                      elmo-msgdb-flist-filename
 685                      (expand-file-name
 686                       (elmo-safe-filename fname)
 687                       (expand-file-name "folder" elmo-msgdb-directory)))))
 688     (elmo-object-load flist-file elmo-mime-charset t)))
 689
 690 (defun elmo-msgdb-flist-save (fname flist)
 691   (let ((flist-file (expand-file-name
 692                      elmo-msgdb-flist-filename
 693                      (expand-file-name
 694                       (elmo-safe-filename fname)
 695                       (expand-file-name "folder" elmo-msgdb-directory)))))
 696     (elmo-object-save flist-file flist elmo-mime-charset)))
 697
 698 (defun elmo-crosspost-alist-load ()
 699   (elmo-object-load (expand-file-name
 700                      elmo-crosspost-alist-filename
 701                      elmo-msgdb-directory)
 702                     nil t))
 703
 704 (defun elmo-crosspost-alist-save (alist)
 705   (elmo-object-save (expand-file-name
 706                      elmo-crosspost-alist-filename
 707                      elmo-msgdb-directory)
 708                     alist))
 709
 710 (defun elmo-msgdb-add-msgs-to-seen-list (msgs msgdb unread-marks seen-list)
 711   ;; Add to seen list.
 712   (let (mark)
 713     (while msgs
 714       (if (setq mark (elmo-msgdb-get-mark msgdb (car msgs)))
 715           (unless (member mark unread-marks) ;; not unread mark
 716             (setq seen-list
 717                   (cons
 718                    (elmo-msgdb-get-field msgdb (car msgs) 'message-id)
 719                    seen-list)))
 720         ;; no mark ... seen...
 721         (setq seen-list
 722               (cons
 723                (elmo-msgdb-get-field msgdb (car msgs) 'message-id)
 724                seen-list)))
 725       (setq msgs (cdr msgs)))
 726     seen-list))
 727
 728 (defun elmo-msgdb-get-message-id-from-buffer ()
 729   (let ((msgid (elmo-field-body "message-id")))
 730     (if msgid
 731         (if (string-match "<\\(.+\\)>$" msgid)
 732             msgid
 733           (concat "<" msgid ">")) ; Invaild message-id.
 734       ;; no message-id, so put dummy msgid.
 735       (concat "<" (timezone-make-date-sortable
 736                    (elmo-field-body "date"))
 737               (nth 1 (eword-extract-address-components
 738                       (or (elmo-field-body "from") "nobody"))) ">"))))
 739
 740 (defsubst elmo-msgdb-create-overview-from-buffer (number &optional size time)
 741   "Create overview entity from current buffer.
 742 Header region is supposed to be narrowed."
 743   (save-excursion
 744     (let ((extras elmo-msgdb-extra-fields)
 745           (default-mime-charset default-mime-charset)
 746           message-id references from subject to cc date
 747           extra field-body charset)
 748       (elmo-set-buffer-multibyte default-enable-multibyte-characters)
 749       (setq message-id (elmo-msgdb-get-message-id-from-buffer))
 750       (and (setq charset (cdr (assoc "charset" (mime-read-Content-Type))))
 751            (setq charset (intern-soft charset))
 752            (setq default-mime-charset charset))
 753       (setq references
 754             (or (elmo-msgdb-get-last-message-id
 755                  (elmo-field-body "in-reply-to"))
 756                 (elmo-msgdb-get-last-message-id
 757                  (elmo-field-body "references"))))
 758       (setq from (elmo-replace-in-string
 759                   (elmo-mime-string (or (elmo-field-body "from")
 760                                         elmo-no-from))
 761                   "\t" " ")
 762             subject (elmo-replace-in-string
 763                      (elmo-mime-string (or (elmo-field-body "subject")
 764                                            elmo-no-subject))
 765                      "\t" " "))
 766       (setq date (or (elmo-field-body "date") time))
 767       (setq to   (mapconcat 'identity (elmo-multiple-field-body "to") ","))
 768       (setq cc   (mapconcat 'identity (elmo-multiple-field-body "cc") ","))
 769       (or size
 770           (if (setq size (elmo-field-body "content-length"))
 771               (setq size (string-to-int size))
 772             (setq size 0)));; No mean...
 773       (while extras
 774         (if (setq field-body (elmo-field-body (car extras)))
 775             (setq extra (cons (cons (downcase (car extras))
 776                                     field-body) extra)))
 777         (setq extras (cdr extras)))
 778       (cons message-id (vector number references
 779                                from subject date to cc
 780                                size extra))
 781       )))
 782
 783 (defun elmo-msgdb-copy-overview-entity (entity)
 784   (cons (car entity)
 785         (copy-sequence (cdr entity))))
 786
 787 (defsubst elmo-msgdb-insert-file-header (file)
 788   "Insert the header of the article."
 789   (let ((beg 0)
 790         insert-file-contents-pre-hook   ; To avoid autoconv-xmas...
 791         insert-file-contents-post-hook
 792         format-alist)
 793     (when (file-exists-p file)
 794       ;; Read until header separator is found.
 795       (while (and (eq elmo-msgdb-file-header-chop-length
 796                       (nth 1
 797                            (insert-file-contents-as-binary
 798                             file nil beg
 799                             (incf beg elmo-msgdb-file-header-chop-length))))
 800                   (prog1 (not (search-forward "\n\n" nil t))
 801                     (goto-char (point-max))))))))
 802
 803 (defsubst elmo-msgdb-create-overview-entity-from-file (number file)
 804   (let (insert-file-contents-pre-hook   ; To avoid autoconv-xmas...
 805         insert-file-contents-post-hook header-end
 806         (attrib (file-attributes file))
 807         ret-val size mtime)
 808     (with-temp-buffer
 809       (if (not (file-exists-p file))
 810           ()
 811         (setq size (nth 7 attrib))
 812         (setq mtime (timezone-make-date-arpa-standard
 813                      (current-time-string (nth 5 attrib)) (current-time-zone)))
 814         ;; insert header from file.
 815         (catch 'done
 816           (condition-case nil
 817               (elmo-msgdb-insert-file-header file)
 818             (error (throw 'done nil)))
 819           (goto-char (point-min))
 820           (setq header-end
 821                 (if (re-search-forward "\\(^--.*$\\)\\|\\(\n\n\\)" nil t)
 822                     (point)
 823                   (point-max)))
 824           (narrow-to-region (point-min) header-end)
 825           (elmo-msgdb-create-overview-from-buffer number size mtime))))))
 826
 827 (defun elmo-msgdb-overview-sort-by-date (overview)
 828   (sort overview
 829         (function
 830          (lambda (x y)
 831            (condition-case nil
 832                (string<
 833                 (timezone-make-date-sortable
 834                  (elmo-msgdb-overview-entity-get-date x))
 835                 (timezone-make-date-sortable
 836                  (elmo-msgdb-overview-entity-get-date y)))
 837              (error))))))
 838
 839 (defun elmo-msgdb-clear-index (msgdb entity)
 840   (let ((ehash (elmo-msgdb-get-entity-hashtb msgdb))
 841         (mhash (elmo-msgdb-get-mark-hashtb msgdb))
 842         number)
 843     (when (and entity ehash)
 844       (and (setq number (elmo-msgdb-overview-entity-get-number entity))
 845            (elmo-clear-hash-val (format "#%d" number) ehash))
 846       (and (car entity) ;; message-id
 847            (elmo-clear-hash-val (car entity) ehash)))
 848     (when (and entity mhash)
 849       (and (setq number (elmo-msgdb-overview-entity-get-number entity))
 850            (elmo-clear-hash-val (format "#%d" number) mhash)))))
 851
 852 (defun elmo-msgdb-make-index (msgdb &optional overview mark-alist)
 853   "Append OVERVIEW and MARK-ALIST to the index of MSGDB.
 854 If OVERVIEW and MARK-ALIST are nil, make index for current MSGDB.
 855 Return the updated INDEX."
 856   (when msgdb
 857     (let* ((overview (or overview (elmo-msgdb-get-overview msgdb)))
 858            (mark-alist (or mark-alist (elmo-msgdb-get-mark-alist msgdb)))
 859            (index (elmo-msgdb-get-index msgdb))
 860            (ehash (or (car index) ;; append
 861                       (elmo-make-hash (length overview))))
 862            (mhash (or (cdr index) ;; append
 863                       (elmo-make-hash (length overview)))))
 864       (while overview
 865         ;; key is message-id
 866         (if (caar overview)
 867             (elmo-set-hash-val (caar overview) (car overview) ehash))
 868         ;; key is number
 869         (elmo-set-hash-val
 870          (format "#%d"
 871                  (elmo-msgdb-overview-entity-get-number (car overview)))
 872          (car overview) ehash)
 873         (setq overview (cdr overview)))
 874       (while mark-alist
 875         ;; key is number
 876         (elmo-set-hash-val
 877          (format "#%d" (car (car mark-alist)))
 878          (car mark-alist) mhash)
 879         (setq mark-alist (cdr mark-alist)))
 880       (setq index (or index (cons ehash mhash)))
 881       (elmo-msgdb-set-index msgdb index)
 882       index)))
 883
 884 (defsubst elmo-folder-get-info (folder &optional hashtb)
 885   (elmo-get-hash-val folder
 886                      (or hashtb elmo-folder-info-hashtb)))
 887
 888 (defun elmo-folder-get-info-max (folder)
 889   "Get folder info from cache."
 890   (nth 3 (elmo-folder-get-info folder)))
 891
 892 (defun elmo-folder-get-info-length (folder)
 893   (nth 2 (elmo-folder-get-info folder)))
 894
 895 (defun elmo-folder-get-info-unread (folder)
 896   (nth 1 (elmo-folder-get-info folder)))
 897
 898 (defsubst elmo-msgdb-location-load (dir)
 899   (elmo-object-load
 900    (expand-file-name
 901     elmo-msgdb-location-filename
 902     dir)))
 903
 904 (defsubst elmo-msgdb-location-add (alist number location)
 905   (let ((ret-val alist))
 906     (setq ret-val
 907           (elmo-msgdb-append-element ret-val (cons number location)))
 908     ret-val))
 909
 910 (defsubst elmo-msgdb-location-save (dir alist)
 911   (elmo-object-save
 912    (expand-file-name
 913     elmo-msgdb-location-filename
 914     dir) alist))
 915
 916 (put 'elmo-msgdb-do-each-entity 'lisp-indent-function '1)
 917 (def-edebug-spec elmo-msgdb-do-each-entity
 918   ((symbolp form &rest form) &rest form))
 919 (defmacro elmo-msgdb-do-each-entity (spec &rest form)
 920   `(dolist (,(car spec) (elmo-msgdb-get-overview ,(car (cdr spec))))
 921      ,@form))
 922
 923 (require 'product)
 924 (product-provide (provide 'elmo-msgdb) (require 'elmo-version))
 925
 926 ;;; elmo-msgdb.el ends here