elmo/elmo-msgdb.el

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