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 ((field-name (downcase field-name))
 573         (extra (and entity (aref (cdr entity) 8))))
 574     (and extra
 575          (cdr (assoc field-name extra)))))
 576
 577 (defsubst elmo-msgdb-overview-entity-set-extra-field (entity field-name value)
 578   (let ((field-name (downcase field-name))
 579         (extras (and entity (aref (cdr entity) 8)))
 580         extra)
 581     (if (setq extra (assoc field-name extras))
 582         (setcdr extra value)
 583       (elmo-msgdb-overview-entity-set-extra
 584        entity
 585        (cons (cons field-name value) extras)))))
 586
 587 (defsubst elmo-msgdb-overview-entity-get-extra (entity)
 588   (and entity (aref (cdr entity) 8)))
 589
 590 (defsubst elmo-msgdb-overview-entity-set-extra (entity extra)
 591   (and entity (aset (cdr entity) 8 extra))
 592   entity)
 593
 594 (defun elmo-msgdb-overview-get-entity-by-number (database number)
 595   (when number
 596     (let ((db database)
 597           entity)
 598       (while db
 599         (if (eq (elmo-msgdb-overview-entity-get-number (car db)) number)
 600             (setq entity (car db)
 601                   db nil) ; exit loop
 602           (setq db (cdr db))))
 603       entity)))
 604
 605 (defun elmo-msgdb-overview-get-entity (id msgdb)
 606   (when id
 607     (let ((ht (elmo-msgdb-get-entity-hashtb msgdb)))
 608       (if ht
 609           (if (stringp id) ;; ID is message-id
 610               (elmo-get-hash-val id ht)
 611             (elmo-get-hash-val (format "#%d" id) ht))))))
 612
 613 ;;
 614 ;; deleted message handling
 615 ;;
 616 (defun elmo-msgdb-killed-list-load (dir)
 617   (elmo-object-load
 618    (expand-file-name elmo-msgdb-killed-filename dir)
 619    nil t))
 620
 621 (defun elmo-msgdb-killed-list-save (dir killed-list)
 622   (elmo-object-save
 623    (expand-file-name elmo-msgdb-killed-filename dir)
 624    killed-list))
 625
 626 (defun elmo-msgdb-killed-message-p (killed-list msg)
 627   (elmo-number-set-member msg killed-list))
 628
 629 (defun elmo-msgdb-set-as-killed (killed-list msg)
 630   (elmo-number-set-append killed-list msg))
 631
 632 (defun elmo-msgdb-append-to-killed-list (folder msgs)
 633   (elmo-folder-set-killed-list-internal
 634    folder
 635    (elmo-number-set-append-list
 636     (elmo-folder-killed-list-internal folder)
 637     msgs)))
 638
 639 (defun elmo-msgdb-killed-list-length (killed-list)
 640   (let ((killed killed-list)
 641         (ret-val 0))
 642     (while (car killed)
 643       (if (consp (car killed))
 644           (setq ret-val (+ ret-val 1 (- (cdar killed) (caar killed))))
 645         (setq ret-val (+ ret-val 1)))
 646       (setq killed (cdr killed)))
 647     ret-val))
 648
 649 (defun elmo-msgdb-max-of-killed (killed-list)
 650   (let ((klist killed-list)
 651         (max 0)
 652         k)
 653     (while (car klist)
 654       (if (< max
 655              (setq k
 656                    (if (consp (car klist))
 657                        (cdar klist)
 658                      (car klist))))
 659           (setq max k))
 660       (setq klist (cdr klist)))
 661     max))
 662
 663 (defun elmo-living-messages (messages killed-list)
 664   (if killed-list
 665       (delq nil
 666             (mapcar (lambda (number)
 667                       (unless (elmo-number-set-member number killed-list)
 668                         number))
 669                     messages))
 670     messages))
 671
 672 (defun elmo-msgdb-finfo-load ()
 673   (elmo-object-load (expand-file-name
 674                      elmo-msgdb-finfo-filename
 675                      elmo-msgdb-directory)
 676                     elmo-mime-charset t))
 677
 678 (defun elmo-msgdb-finfo-save (finfo)
 679   (elmo-object-save (expand-file-name
 680                      elmo-msgdb-finfo-filename
 681                      elmo-msgdb-directory)
 682                     finfo elmo-mime-charset))
 683
 684 (defun elmo-msgdb-flist-load (fname)
 685   (let ((flist-file (expand-file-name
 686                      elmo-msgdb-flist-filename
 687                      (expand-file-name
 688                       (elmo-safe-filename fname)
 689                       (expand-file-name "folder" elmo-msgdb-directory)))))
 690     (elmo-object-load flist-file elmo-mime-charset t)))
 691
 692 (defun elmo-msgdb-flist-save (fname flist)
 693   (let ((flist-file (expand-file-name
 694                      elmo-msgdb-flist-filename
 695                      (expand-file-name
 696                       (elmo-safe-filename fname)
 697                       (expand-file-name "folder" elmo-msgdb-directory)))))
 698     (elmo-object-save flist-file flist elmo-mime-charset)))
 699
 700 (defun elmo-crosspost-alist-load ()
 701   (elmo-object-load (expand-file-name
 702                      elmo-crosspost-alist-filename
 703                      elmo-msgdb-directory)
 704                     nil t))
 705
 706 (defun elmo-crosspost-alist-save (alist)
 707   (elmo-object-save (expand-file-name
 708                      elmo-crosspost-alist-filename
 709                      elmo-msgdb-directory)
 710                     alist))
 711
 712 (defun elmo-msgdb-add-msgs-to-seen-list (msgs msgdb unread-marks seen-list)
 713   ;; Add to seen list.
 714   (let (mark)
 715     (while msgs
 716       (if (setq mark (elmo-msgdb-get-mark msgdb (car msgs)))
 717           (unless (member mark unread-marks) ;; not unread mark
 718             (setq seen-list
 719                   (cons
 720                    (elmo-msgdb-get-field msgdb (car msgs) 'message-id)
 721                    seen-list)))
 722         ;; no mark ... seen...
 723         (setq seen-list
 724               (cons
 725                (elmo-msgdb-get-field msgdb (car msgs) 'message-id)
 726                seen-list)))
 727       (setq msgs (cdr msgs)))
 728     seen-list))
 729
 730 (defun elmo-msgdb-get-message-id-from-buffer ()
 731   (let ((msgid (elmo-field-body "message-id")))
 732     (if msgid
 733         (if (string-match "<\\(.+\\)>$" msgid)
 734             msgid
 735           (concat "<" msgid ">")) ; Invaild message-id.
 736       ;; no message-id, so put dummy msgid.
 737       (concat "<" (timezone-make-date-sortable
 738                    (elmo-field-body "date"))
 739               (nth 1 (eword-extract-address-components
 740                       (or (elmo-field-body "from") "nobody"))) ">"))))
 741
 742 (defsubst elmo-msgdb-create-overview-from-buffer (number &optional size time)
 743   "Create overview entity from current buffer.
 744 Header region is supposed to be narrowed."
 745   (save-excursion
 746     (let ((extras elmo-msgdb-extra-fields)
 747           (default-mime-charset default-mime-charset)
 748           message-id references from subject to cc date
 749           extra field-body charset)
 750       (elmo-set-buffer-multibyte default-enable-multibyte-characters)
 751       (setq message-id (elmo-msgdb-get-message-id-from-buffer))
 752       (and (setq charset (cdr (assoc "charset" (mime-read-Content-Type))))
 753            (setq charset (intern-soft charset))
 754            (setq default-mime-charset charset))
 755       (setq references
 756             (or (elmo-msgdb-get-last-message-id
 757                  (elmo-field-body "in-reply-to"))
 758                 (elmo-msgdb-get-last-message-id
 759                  (elmo-field-body "references"))))
 760       (setq from (elmo-replace-in-string
 761                   (elmo-mime-string (or (elmo-field-body "from")
 762                                         elmo-no-from))
 763                   "\t" " ")
 764             subject (elmo-replace-in-string
 765                      (elmo-mime-string (or (elmo-field-body "subject")
 766                                            elmo-no-subject))
 767                      "\t" " "))
 768       (setq date (or (elmo-field-body "date") time))
 769       (setq to   (mapconcat 'identity (elmo-multiple-field-body "to") ","))
 770       (setq cc   (mapconcat 'identity (elmo-multiple-field-body "cc") ","))
 771       (or size
 772           (if (setq size (elmo-field-body "content-length"))
 773               (setq size (string-to-int size))
 774             (setq size 0)));; No mean...
 775       (while extras
 776         (if (setq field-body (elmo-field-body (car extras)))
 777             (setq extra (cons (cons (downcase (car extras))
 778                                     field-body) extra)))
 779         (setq extras (cdr extras)))
 780       (cons message-id (vector number references
 781                                from subject date to cc
 782                                size extra))
 783       )))
 784
 785 (defun elmo-msgdb-copy-overview-entity (entity)
 786   (cons (car entity)
 787         (copy-sequence (cdr entity))))
 788
 789 (defsubst elmo-msgdb-insert-file-header (file)
 790   "Insert the header of the article."
 791   (let ((beg 0)
 792         insert-file-contents-pre-hook   ; To avoid autoconv-xmas...
 793         insert-file-contents-post-hook
 794         format-alist)
 795     (when (file-exists-p file)
 796       ;; Read until header separator is found.
 797       (while (and (eq elmo-msgdb-file-header-chop-length
 798                       (nth 1
 799                            (insert-file-contents-as-binary
 800                             file nil beg
 801                             (incf beg elmo-msgdb-file-header-chop-length))))
 802                   (prog1 (not (search-forward "\n\n" nil t))
 803                     (goto-char (point-max))))))))
 804
 805 (defsubst elmo-msgdb-create-overview-entity-from-file (number file)
 806   (let (insert-file-contents-pre-hook   ; To avoid autoconv-xmas...
 807         insert-file-contents-post-hook header-end
 808         (attrib (file-attributes file))
 809         ret-val size mtime)
 810     (with-temp-buffer
 811       (if (not (file-exists-p file))
 812           ()
 813         (setq size (nth 7 attrib))
 814         (setq mtime (timezone-make-date-arpa-standard
 815                      (current-time-string (nth 5 attrib)) (current-time-zone)))
 816         ;; insert header from file.
 817         (catch 'done
 818           (condition-case nil
 819               (elmo-msgdb-insert-file-header file)
 820             (error (throw 'done nil)))
 821           (goto-char (point-min))
 822           (setq header-end
 823                 (if (re-search-forward "\\(^--.*$\\)\\|\\(\n\n\\)" nil t)
 824                     (point)
 825                   (point-max)))
 826           (narrow-to-region (point-min) header-end)
 827           (elmo-msgdb-create-overview-from-buffer number size mtime))))))
 828
 829 (defun elmo-msgdb-overview-sort-by-date (overview)
 830   (sort overview
 831         (function
 832          (lambda (x y)
 833            (condition-case nil
 834                (string<
 835                 (timezone-make-date-sortable
 836                  (elmo-msgdb-overview-entity-get-date x))
 837                 (timezone-make-date-sortable
 838                  (elmo-msgdb-overview-entity-get-date y)))
 839              (error))))))
 840
 841 (defun elmo-msgdb-clear-index (msgdb entity)
 842   (let ((ehash (elmo-msgdb-get-entity-hashtb msgdb))
 843         (mhash (elmo-msgdb-get-mark-hashtb msgdb))
 844         number)
 845     (when (and entity ehash)
 846       (and (setq number (elmo-msgdb-overview-entity-get-number entity))
 847            (elmo-clear-hash-val (format "#%d" number) ehash))
 848       (and (car entity) ;; message-id
 849            (elmo-clear-hash-val (car entity) ehash)))
 850     (when (and entity mhash)
 851       (and (setq number (elmo-msgdb-overview-entity-get-number entity))
 852            (elmo-clear-hash-val (format "#%d" number) mhash)))))
 853
 854 (defun elmo-msgdb-make-index (msgdb &optional overview mark-alist)
 855   "Append OVERVIEW and MARK-ALIST to the index of MSGDB.
 856 If OVERVIEW and MARK-ALIST are nil, make index for current MSGDB.
 857 Return the updated INDEX."
 858   (when msgdb
 859     (let* ((overview (or overview (elmo-msgdb-get-overview msgdb)))
 860            (mark-alist (or mark-alist (elmo-msgdb-get-mark-alist msgdb)))
 861            (index (elmo-msgdb-get-index msgdb))
 862            (ehash (or (car index) ;; append
 863                       (elmo-make-hash (length overview))))
 864            (mhash (or (cdr index) ;; append
 865                       (elmo-make-hash (length overview)))))
 866       (while overview
 867         ;; key is message-id
 868         (if (caar overview)
 869             (elmo-set-hash-val (caar overview) (car overview) ehash))
 870         ;; key is number
 871         (elmo-set-hash-val
 872          (format "#%d"
 873                  (elmo-msgdb-overview-entity-get-number (car overview)))
 874          (car overview) ehash)
 875         (setq overview (cdr overview)))
 876       (while mark-alist
 877         ;; key is number
 878         (elmo-set-hash-val
 879          (format "#%d" (car (car mark-alist)))
 880          (car mark-alist) mhash)
 881         (setq mark-alist (cdr mark-alist)))
 882       (setq index (or index (cons ehash mhash)))
 883       (elmo-msgdb-set-index msgdb index)
 884       index)))
 885
 886 (defsubst elmo-folder-get-info (folder &optional hashtb)
 887   (elmo-get-hash-val folder
 888                      (or hashtb elmo-folder-info-hashtb)))
 889
 890 (defun elmo-folder-get-info-max (folder)
 891   "Get folder info from cache."
 892   (nth 3 (elmo-folder-get-info folder)))
 893
 894 (defun elmo-folder-get-info-length (folder)
 895   (nth 2 (elmo-folder-get-info folder)))
 896
 897 (defun elmo-folder-get-info-unread (folder)
 898   (nth 1 (elmo-folder-get-info folder)))
 899
 900 (defsubst elmo-msgdb-location-load (dir)
 901   (elmo-object-load
 902    (expand-file-name
 903     elmo-msgdb-location-filename
 904     dir)))
 905
 906 (defsubst elmo-msgdb-location-add (alist number location)
 907   (let ((ret-val alist))
 908     (setq ret-val
 909           (elmo-msgdb-append-element ret-val (cons number location)))
 910     ret-val))
 911
 912 (defsubst elmo-msgdb-location-save (dir alist)
 913   (elmo-object-save
 914    (expand-file-name
 915     elmo-msgdb-location-filename
 916     dir) alist))
 917
 918 (put 'elmo-msgdb-do-each-entity 'lisp-indent-function '1)
 919 (def-edebug-spec elmo-msgdb-do-each-entity
 920   ((symbolp form &rest form) &rest form))
 921 (defmacro elmo-msgdb-do-each-entity (spec &rest form)
 922   `(dolist (,(car spec) (elmo-msgdb-get-overview ,(car (cdr spec))))
 923      ,@form))
 924
 925 (require 'product)
 926 (product-provide (provide 'elmo-msgdb) (require 'elmo-version))
 927
 928 ;;; elmo-msgdb.el ends here