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 (member mark (list elmo-msgdb-important-mark
 457                                            elmo-msgdb-read-uncached-mark)))
 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-seen-save (dir obj)
 590   (elmo-object-save
 591    (expand-file-name elmo-msgdb-seen-filename dir)
 592    obj))
 593
 594 (defsubst elmo-msgdb-overview-save (dir overview)
 595   (elmo-object-save
 596    (expand-file-name elmo-msgdb-overview-filename dir)
 597    overview))
 598
 599 (defun elmo-msgdb-match-condition-primitive (condition entity numbers)
 600   (catch 'unresolved
 601     (let ((key (elmo-filter-key condition))
 602           (case-fold-search t)
 603           result)
 604       (cond
 605        ((string= key "last")
 606         (setq result (<= (length (memq
 607                                   (elmo-msgdb-overview-entity-get-number
 608                                    entity)
 609                                   numbers))
 610                          (string-to-int (elmo-filter-value condition)))))
 611        ((string= key "first")
 612         (setq result (< (-
 613                          (length numbers)
 614                          (length (memq
 615                                   (elmo-msgdb-overview-entity-get-number
 616                                    entity)
 617                                   numbers)))
 618                         (string-to-int (elmo-filter-value condition)))))
 619        ((string= key "from")
 620         (setq result (string-match
 621                       (elmo-filter-value condition)
 622                       (elmo-msgdb-overview-entity-get-from entity))))
 623        ((string= key "subject")
 624         (setq result (string-match
 625                       (elmo-filter-value condition)
 626                       (elmo-msgdb-overview-entity-get-subject entity))))
 627        ((string= key "to")
 628         (setq result (string-match
 629                       (elmo-filter-value condition)
 630                       (elmo-msgdb-overview-entity-get-to entity))))
 631        ((string= key "cc")
 632         (setq result (string-match
 633                       (elmo-filter-value condition)
 634                       (elmo-msgdb-overview-entity-get-cc entity))))
 635        ((or (string= key "since")
 636             (string= key "before"))
 637         (let ((field-date (elmo-date-make-sortable-string
 638                            (timezone-fix-time
 639                             (elmo-msgdb-overview-entity-get-date entity)
 640                             (current-time-zone) nil)))
 641               (specified-date
 642                (elmo-date-make-sortable-string
 643                 (elmo-date-get-datevec
 644                  (elmo-filter-value condition)))))
 645           (setq result (if (string= key "since")
 646                            (or (string= specified-date field-date)
 647                                (string< specified-date field-date))
 648                          (string< field-date specified-date)))))
 649        ((member key elmo-msgdb-extra-fields)
 650         (let ((extval (elmo-msgdb-overview-entity-get-extra-field entity key)))
 651           (when (stringp extval)
 652             (setq result (string-match
 653                           (elmo-filter-value condition)
 654                           extval)))))
 655        (t
 656         (throw 'unresolved condition)))
 657       (if (eq (elmo-filter-type condition) 'unmatch)
 658           (not result)
 659         result))))
 660
 661 (defun elmo-msgdb-match-condition (condition entity numbers)
 662   (cond
 663    ((vectorp condition)
 664     (elmo-msgdb-match-condition-primitive condition entity numbers))
 665    ((eq (car condition) 'and)
 666     (let ((lhs (elmo-msgdb-match-condition (nth 1 condition)
 667                                            entity numbers)))
 668       (cond
 669        ((elmo-filter-condition-p lhs)
 670         (let ((rhs (elmo-msgdb-match-condition (nth 2 condition)
 671                                                entity numbers)))
 672           (cond ((elmo-filter-condition-p rhs)
 673                  (list 'and lhs rhs))
 674                 (rhs
 675                  lhs))))
 676        (lhs
 677         (elmo-msgdb-match-condition (nth 2 condition)
 678                                     entity numbers)))))
 679    ((eq (car condition) 'or)
 680     (let ((lhs (elmo-msgdb-match-condition (nth 1 condition)
 681                                            entity numbers)))
 682       (cond
 683        ((elmo-filter-condition-p lhs)
 684         (let ((rhs (elmo-msgdb-match-condition (nth 2 condition)
 685                                                entity numbers)))
 686           (cond ((elmo-filter-condition-p rhs)
 687                  (list 'or lhs rhs))
 688                 (rhs
 689                  t)
 690                 (t
 691                  lhs))))
 692        (lhs
 693         t)
 694        (t
 695         (elmo-msgdb-match-condition (nth 2 condition)
 696                                     entity numbers)))))))
 697
 698 (defsubst elmo-msgdb-set-overview (msgdb overview)
 699   (setcar msgdb overview))
 700
 701 (defsubst elmo-msgdb-set-number-alist (msgdb number-alist)
 702   (setcar (cdr msgdb) number-alist))
 703
 704 (defsubst elmo-msgdb-set-mark-alist (msgdb mark-alist)
 705   (setcar (cddr msgdb) mark-alist))
 706
 707 (defsubst elmo-msgdb-set-index (msgdb index)
 708   (setcar (cdddr msgdb) index))
 709
 710 (defsubst elmo-msgdb-overview-entity-get-references (entity)
 711   (and entity (aref (cdr entity) 1)))
 712
 713 (defsubst elmo-msgdb-overview-entity-set-references (entity references)
 714   (and entity (aset (cdr entity) 1 references))
 715   entity)
 716
 717 ;; entity -> parent-entity
 718 (defsubst elmo-msgdb-overview-get-parent-entity (entity database)
 719   (setq entity (elmo-msgdb-overview-entity-get-references entity))
 720   ;; entity is parent-id.
 721   (and entity (assoc entity database)))
 722
 723 (defsubst elmo-msgdb-get-parent-entity (entity msgdb)
 724   (setq entity (elmo-msgdb-overview-entity-get-references entity))
 725   ;; entity is parent-id.
 726   (and entity (elmo-msgdb-overview-get-entity entity msgdb)))
 727
 728 (defsubst elmo-msgdb-overview-entity-get-number (entity)
 729   (and entity (aref (cdr entity) 0)))
 730
 731 (defsubst elmo-msgdb-overview-entity-get-from-no-decode (entity)
 732   (and entity (aref (cdr entity) 2)))
 733
 734 (defsubst elmo-msgdb-overview-entity-get-from (entity)
 735   (and entity
 736        (aref (cdr entity) 2)
 737        (elmo-msgdb-get-decoded-cache (aref (cdr entity) 2))))
 738
 739 (defsubst elmo-msgdb-overview-entity-set-number (entity number)
 740   (and entity (aset (cdr entity) 0 number))
 741   entity)
 742 ;;;(setcar (cadr entity) number) entity)
 743
 744 (defsubst elmo-msgdb-overview-entity-set-from (entity from)
 745   (and entity (aset (cdr entity) 2 from))
 746   entity)
 747
 748 (defsubst elmo-msgdb-overview-entity-get-subject (entity)
 749   (and entity
 750        (aref (cdr entity) 3)
 751        (elmo-msgdb-get-decoded-cache (aref (cdr entity) 3))))
 752
 753 (defsubst elmo-msgdb-overview-entity-get-subject-no-decode (entity)
 754   (and entity (aref (cdr entity) 3)))
 755
 756 (defsubst elmo-msgdb-overview-entity-set-subject (entity subject)
 757   (and entity (aset (cdr entity) 3 subject))
 758   entity)
 759
 760 (defsubst elmo-msgdb-overview-entity-get-date (entity)
 761   (and entity (aref (cdr entity) 4)))
 762
 763 (defsubst elmo-msgdb-overview-entity-set-date (entity date)
 764   (and entity (aset (cdr entity) 4 date))
 765   entity)
 766
 767 (defsubst elmo-msgdb-overview-entity-get-to (entity)
 768   (and entity (aref (cdr entity) 5)))
 769
 770 (defsubst elmo-msgdb-overview-entity-get-cc (entity)
 771   (and entity (aref (cdr entity) 6)))
 772
 773 (defsubst elmo-msgdb-overview-entity-get-size (entity)
 774   (and entity (aref (cdr entity) 7)))
 775
 776 (defsubst elmo-msgdb-overview-entity-set-size (entity size)
 777   (and entity (aset (cdr entity) 7 size))
 778   entity)
 779
 780 (defsubst elmo-msgdb-overview-entity-get-id (entity)
 781   (and entity (car entity)))
 782
 783 (defsubst elmo-msgdb-overview-entity-get-extra-field (entity field-name)
 784   (let ((extra (and entity (aref (cdr entity) 8))))
 785     (and extra
 786          (cdr (assoc field-name extra)))))
 787
 788 (defsubst elmo-msgdb-overview-entity-set-extra-field (entity field-name value)
 789   (let ((extras (and entity (aref (cdr entity) 8)))
 790         extra)
 791     (if (setq extra (assoc field-name extras))
 792         (setcdr extra value)
 793       (elmo-msgdb-overview-entity-set-extra
 794        entity
 795        (cons (cons field-name value) extras)))))
 796
 797 (defsubst elmo-msgdb-overview-entity-get-extra (entity)
 798   (and entity (aref (cdr entity) 8)))
 799
 800 (defsubst elmo-msgdb-overview-entity-set-extra (entity extra)
 801   (and entity (aset (cdr entity) 8 extra))
 802   entity)
 803
 804 (defun elmo-msgdb-overview-get-entity-by-number (database number)
 805   (when number
 806     (let ((db database)
 807           entity)
 808       (while db
 809         (if (eq (elmo-msgdb-overview-entity-get-number (car db)) number)
 810             (setq entity (car db)
 811                   db nil) ; exit loop
 812           (setq db (cdr db))))
 813       entity)))
 814
 815 (defun elmo-msgdb-overview-get-entity (id msgdb)
 816   (when id
 817     (let ((ht (elmo-msgdb-get-entity-hashtb msgdb)))
 818       (if ht
 819           (if (stringp id) ;; ID is message-id
 820               (elmo-get-hash-val id ht)
 821             (elmo-get-hash-val (format "#%d" id) ht))))))
 822
 823 ;;
 824 ;; deleted message handling
 825 ;;
 826 (defun elmo-msgdb-killed-list-load (dir)
 827   (elmo-object-load
 828    (expand-file-name elmo-msgdb-killed-filename dir)
 829    nil t))
 830
 831 (defun elmo-msgdb-killed-list-save (dir killed-list)
 832   (elmo-object-save
 833    (expand-file-name elmo-msgdb-killed-filename dir)
 834    killed-list))
 835
 836 (defun elmo-msgdb-killed-message-p (killed-list msg)
 837   (elmo-number-set-member msg killed-list))
 838
 839 (defun elmo-msgdb-set-as-killed (killed-list msg)
 840   (elmo-number-set-append killed-list msg))
 841
 842 (defun elmo-msgdb-append-to-killed-list (folder msgs)
 843   (elmo-folder-set-killed-list-internal
 844    folder
 845    (elmo-number-set-append-list
 846     (elmo-folder-killed-list-internal folder)
 847     msgs)))
 848
 849 (defun elmo-msgdb-killed-list-length (killed-list)
 850   (let ((killed killed-list)
 851         (ret-val 0))
 852     (while (car killed)
 853       (if (consp (car killed))
 854           (setq ret-val (+ ret-val 1 (- (cdar killed) (caar killed))))
 855         (setq ret-val (+ ret-val 1)))
 856       (setq killed (cdr killed)))
 857     ret-val))
 858
 859 (defun elmo-msgdb-max-of-killed (killed-list)
 860   (let ((klist killed-list)
 861         (max 0)
 862         k)
 863     (while (car klist)
 864       (if (< max
 865              (setq k
 866                    (if (consp (car klist))
 867                        (cdar klist)
 868                      (car klist))))
 869           (setq max k))
 870       (setq klist (cdr klist)))
 871     max))
 872
 873 (defun elmo-living-messages (messages killed-list)
 874   (if killed-list
 875       (delq nil
 876             (mapcar (lambda (number)
 877                       (unless (elmo-number-set-member number killed-list)
 878                         number))
 879                     messages))
 880     messages))
 881
 882 (defun elmo-msgdb-finfo-load ()
 883   (elmo-object-load (expand-file-name
 884                      elmo-msgdb-finfo-filename
 885                      elmo-msgdb-directory)
 886                     elmo-mime-charset t))
 887
 888 (defun elmo-msgdb-finfo-save (finfo)
 889   (elmo-object-save (expand-file-name
 890                      elmo-msgdb-finfo-filename
 891                      elmo-msgdb-directory)
 892                     finfo elmo-mime-charset))
 893
 894 (defun elmo-msgdb-flist-load (fname)
 895   (let ((flist-file (expand-file-name
 896                      elmo-msgdb-flist-filename
 897                      (expand-file-name
 898                       (elmo-safe-filename fname)
 899                       (expand-file-name "folder" elmo-msgdb-directory)))))
 900     (elmo-object-load flist-file elmo-mime-charset t)))
 901
 902 (defun elmo-msgdb-flist-save (fname flist)
 903   (let ((flist-file (expand-file-name
 904                      elmo-msgdb-flist-filename
 905                      (expand-file-name
 906                       (elmo-safe-filename fname)
 907                       (expand-file-name "folder" elmo-msgdb-directory)))))
 908     (elmo-object-save flist-file flist elmo-mime-charset)))
 909
 910 (defun elmo-crosspost-alist-load ()
 911   (elmo-object-load (expand-file-name
 912                      elmo-crosspost-alist-filename
 913                      elmo-msgdb-directory)
 914                     nil t))
 915
 916 (defun elmo-crosspost-alist-save (alist)
 917   (elmo-object-save (expand-file-name
 918                      elmo-crosspost-alist-filename
 919                      elmo-msgdb-directory)
 920                     alist))
 921
 922 (defun elmo-msgdb-add-msgs-to-seen-list (msgs msgdb seen-list)
 923   ;; Add to seen list.
 924   (let (mark)
 925     (while msgs
 926       (if (setq mark (elmo-msgdb-get-mark msgdb (car msgs)))
 927           (unless (member mark (elmo-msgdb-unread-marks)) ;; not unread mark
 928             (setq seen-list
 929                   (cons
 930                    (elmo-msgdb-get-field msgdb (car msgs) 'message-id)
 931                    seen-list)))
 932         ;; no mark ... seen...
 933         (setq seen-list
 934               (cons
 935                (elmo-msgdb-get-field msgdb (car msgs) 'message-id)
 936                seen-list)))
 937       (setq msgs (cdr msgs)))
 938     seen-list))
 939
 940 (defun elmo-msgdb-get-message-id-from-buffer ()
 941   (let ((msgid (elmo-field-body "message-id")))
 942     (if msgid
 943         (if (string-match "<\\(.+\\)>$" msgid)
 944             msgid
 945           (concat "<" msgid ">")) ; Invaild message-id.
 946       ;; no message-id, so put dummy msgid.
 947       (concat "<" (timezone-make-date-sortable
 948                    (elmo-field-body "date"))
 949               (nth 1 (eword-extract-address-components
 950                       (or (elmo-field-body "from") "nobody"))) ">"))))
 951
 952 (defsubst elmo-msgdb-create-overview-from-buffer (number &optional size time)
 953   "Create overview entity from current buffer.
 954 Header region is supposed to be narrowed."
 955   (save-excursion
 956     (let ((extras elmo-msgdb-extra-fields)
 957           (default-mime-charset default-mime-charset)
 958           message-id references from subject to cc date
 959           extra field-body charset)
 960       (elmo-set-buffer-multibyte default-enable-multibyte-characters)
 961       (setq message-id (elmo-msgdb-get-message-id-from-buffer))
 962       (and (setq charset (cdr (assoc "charset" (mime-read-Content-Type))))
 963            (setq charset (intern-soft charset))
 964            (setq default-mime-charset charset))
 965       (setq references
 966             (or (elmo-msgdb-get-last-message-id
 967                  (elmo-field-body "in-reply-to"))
 968                 (elmo-msgdb-get-last-message-id
 969                  (elmo-field-body "references"))))
 970       (setq from (elmo-replace-in-string
 971                   (elmo-mime-string (or (elmo-field-body "from")
 972                                         elmo-no-from))
 973                   "\t" " ")
 974             subject (elmo-replace-in-string
 975                      (elmo-mime-string (or (elmo-field-body "subject")
 976                                            elmo-no-subject))
 977                      "\t" " "))
 978       (setq date (or (elmo-field-body "date") time))
 979       (setq to   (mapconcat 'identity (elmo-multiple-field-body "to") ","))
 980       (setq cc   (mapconcat 'identity (elmo-multiple-field-body "cc") ","))
 981       (or size
 982           (if (setq size (elmo-field-body "content-length"))
 983               (setq size (string-to-int size))
 984             (setq size 0)));; No mean...
 985       (while extras
 986         (if (setq field-body (elmo-field-body (car extras)))
 987             (setq extra (cons (cons (downcase (car extras))
 988                                     field-body) extra)))
 989         (setq extras (cdr extras)))
 990       (cons message-id (vector number references
 991                                from subject date to cc
 992                                size extra))
 993       )))
 994
 995 (defun elmo-msgdb-copy-overview-entity (entity)
 996   (cons (car entity)
 997         (copy-sequence (cdr entity))))
 998
 999 (defsubst elmo-msgdb-insert-file-header (file)
1000   "Insert the header of the article."
1001   (let ((beg 0)
1002         insert-file-contents-pre-hook   ; To avoid autoconv-xmas...
1003         insert-file-contents-post-hook
1004         format-alist)
1005     (when (file-exists-p file)
1006       ;; Read until header separator is found.
1007       (while (and (eq elmo-msgdb-file-header-chop-length
1008                       (nth 1
1009                            (insert-file-contents-as-binary
1010                             file nil beg
1011                             (incf beg elmo-msgdb-file-header-chop-length))))
1012                   (prog1 (not (search-forward "\n\n" nil t))
1013                     (goto-char (point-max))))))))
1014
1015 (defsubst elmo-msgdb-create-overview-entity-from-file (number file)
1016   (let (insert-file-contents-pre-hook   ; To avoid autoconv-xmas...
1017         insert-file-contents-post-hook header-end
1018         (attrib (file-attributes file))
1019         ret-val size mtime)
1020     (with-temp-buffer
1021       (if (not (file-exists-p file))
1022           ()
1023         (setq size (nth 7 attrib))
1024         (setq mtime (timezone-make-date-arpa-standard
1025                      (current-time-string (nth 5 attrib)) (current-time-zone)))
1026         ;; insert header from file.
1027         (catch 'done
1028           (condition-case nil
1029               (elmo-msgdb-insert-file-header file)
1030             (error (throw 'done nil)))
1031           (goto-char (point-min))
1032           (setq header-end
1033                 (if (re-search-forward "\\(^--.*$\\)\\|\\(\n\n\\)" nil t)
1034                     (point)
1035                   (point-max)))
1036           (narrow-to-region (point-min) header-end)
1037           (elmo-msgdb-create-overview-from-buffer number size mtime))))))
1038
1039 (defun elmo-msgdb-overview-sort-by-date (overview)
1040   (sort overview
1041         (function
1042          (lambda (x y)
1043            (condition-case nil
1044                (string<
1045                 (timezone-make-date-sortable
1046                  (elmo-msgdb-overview-entity-get-date x))
1047                 (timezone-make-date-sortable
1048                  (elmo-msgdb-overview-entity-get-date y)))
1049              (error))))))
1050
1051 (defun elmo-msgdb-clear-index (msgdb entity)
1052   (let ((ehash (elmo-msgdb-get-entity-hashtb msgdb))
1053         (mhash (elmo-msgdb-get-mark-hashtb msgdb))
1054         number)
1055     (when (and entity ehash)
1056       (and (setq number (elmo-msgdb-overview-entity-get-number entity))
1057            (elmo-clear-hash-val (format "#%d" number) ehash))
1058       (and (car entity) ;; message-id
1059            (elmo-clear-hash-val (car entity) ehash)))
1060     (when (and entity mhash)
1061       (and (setq number (elmo-msgdb-overview-entity-get-number entity))
1062            (elmo-clear-hash-val (format "#%d" number) mhash)))))
1063
1064 (defun elmo-msgdb-make-index (msgdb &optional overview mark-alist)
1065   "Append OVERVIEW and MARK-ALIST to the index of MSGDB.
1066 If OVERVIEW and MARK-ALIST are nil, make index for current MSGDB.
1067 Return the updated INDEX."
1068   (when msgdb
1069     (let* ((overview (or overview (elmo-msgdb-get-overview msgdb)))
1070            (mark-alist (or mark-alist (elmo-msgdb-get-mark-alist msgdb)))
1071            (index (elmo-msgdb-get-index msgdb))
1072            (ehash (or (car index) ;; append
1073                       (elmo-make-hash (length overview))))
1074            (mhash (or (cdr index) ;; append
1075                       (elmo-make-hash (length overview)))))
1076       (while overview
1077         ;; key is message-id
1078         (if (caar overview)
1079             (elmo-set-hash-val (caar overview) (car overview) ehash))
1080         ;; key is number
1081         (elmo-set-hash-val
1082          (format "#%d"
1083                  (elmo-msgdb-overview-entity-get-number (car overview)))
1084          (car overview) ehash)
1085         (setq overview (cdr overview)))
1086       (while mark-alist
1087         ;; key is number
1088         (elmo-set-hash-val
1089          (format "#%d" (car (car mark-alist)))
1090          (car mark-alist) mhash)
1091         (setq mark-alist (cdr mark-alist)))
1092       (setq index (or index (cons ehash mhash)))
1093       (elmo-msgdb-set-index msgdb index)
1094       index)))
1095
1096 (defsubst elmo-folder-get-info (folder &optional hashtb)
1097   (elmo-get-hash-val folder
1098                      (or hashtb elmo-folder-info-hashtb)))
1099
1100 (defun elmo-folder-get-info-max (folder)
1101   "Get folder info from cache."
1102   (nth 3 (elmo-folder-get-info folder)))
1103
1104 (defun elmo-folder-get-info-length (folder)
1105   (nth 2 (elmo-folder-get-info folder)))
1106
1107 (defun elmo-folder-get-info-unread (folder)
1108   (nth 1 (elmo-folder-get-info folder)))
1109
1110 (defsubst elmo-msgdb-location-load (dir)
1111   (elmo-object-load
1112    (expand-file-name
1113     elmo-msgdb-location-filename
1114     dir)))
1115
1116 (defsubst elmo-msgdb-location-add (alist number location)
1117   (let ((ret-val alist))
1118     (setq ret-val
1119           (elmo-msgdb-append-element ret-val (cons number location)))
1120     ret-val))
1121
1122 (defsubst elmo-msgdb-location-save (dir alist)
1123   (elmo-object-save
1124    (expand-file-name
1125     elmo-msgdb-location-filename
1126     dir) alist))
1127
1128 (put 'elmo-msgdb-do-each-entity 'lisp-indent-function '1)
1129 (def-edebug-spec elmo-msgdb-do-each-entity
1130   ((symbolp form &rest form) &rest form))
1131 (defmacro elmo-msgdb-do-each-entity (spec &rest form)
1132   `(dolist (,(car spec) (elmo-msgdb-get-overview ,(car (cdr spec))))
1133      ,@form))
1134
1135 (require 'product)
1136 (product-provide (provide 'elmo-msgdb) (require 'elmo-version))
1137
1138 ;;; elmo-msgdb.el ends here