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