elmo/elmo-msgdb.el

   1 ;;; elmo-msgdb.el -- Message Database for Elmo.
   2
   3 ;; Copyright 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
   4
   5 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
   6 ;; Keywords: mail, net news
   7
   8 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
   9
  10 ;; This program is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14 ;;
  15 ;; This program is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19 ;;
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24 ;;
  25
  26 ;;; Commentary:
  27 ;;
  28
  29 ;;; Code:
  30 ;;
  31
  32 (eval-when-compile (require 'cl))
  33 (require 'elmo-vars)
  34 (require 'elmo-util)
  35 (require 'emu)
  36 (require 'std11)
  37 (require 'elmo-cache)
  38
  39 (defun elmo-msgdb-expand-path (folder)
  40   "Expand msgdb path for FOLDER.
  41 FOLDER should be a sring of folder name or folder spec."
  42   (convert-standard-filename
  43    (let* ((spec (if (stringp folder)
  44                     (elmo-folder-get-spec folder)
  45                   folder))
  46           (type (car spec))
  47           fld)
  48      (cond
  49       ((eq type 'imap4)
  50        (setq fld (elmo-imap4-spec-mailbox spec))
  51        (if (string= "inbox" (downcase fld))
  52            (setq fld "inbox"))
  53        (if (eq (string-to-char fld) ?/)
  54            (setq fld (substring fld 1 (length fld))))
  55        (expand-file-name
  56         fld
  57         (expand-file-name (or (elmo-imap4-spec-username spec) "nobody")
  58                           (expand-file-name (or
  59                                              (elmo-imap4-spec-hostname spec)
  60                                              "nowhere")
  61                                             (expand-file-name
  62                                              "imap"
  63                                              elmo-msgdb-dir)))))
  64       ((eq type 'nntp)
  65        (expand-file-name
  66         (elmo-nntp-spec-group spec)
  67         (expand-file-name (or (elmo-nntp-spec-hostname spec) "nowhere")
  68                           (expand-file-name "nntp"
  69                                             elmo-msgdb-dir))))
  70       ((eq type 'maildir)
  71        (expand-file-name (elmo-safe-filename (nth 1 spec))
  72                          (expand-file-name "maildir"
  73                                            elmo-msgdb-dir)))
  74       ((eq type 'folder)
  75        (expand-file-name (elmo-safe-filename (nth 1 spec))
  76                          (expand-file-name "folder"
  77                                            elmo-msgdb-dir)))
  78       ((eq type 'multi)
  79        (setq fld (concat "*" (mapconcat 'identity (cdr spec) ",")))
  80        (expand-file-name (elmo-safe-filename fld)
  81                          (expand-file-name "multi"
  82                                            elmo-msgdb-dir)))
  83       ((eq type 'filter)
  84        (expand-file-name
  85         (elmo-replace-msgid-as-filename folder)
  86         (expand-file-name "filter"
  87                           elmo-msgdb-dir)))
  88       ((eq type 'archive)
  89        (expand-file-name
  90         (directory-file-name
  91          (concat
  92           (elmo-replace-in-string
  93            (elmo-replace-in-string
  94             (elmo-replace-in-string
  95              (nth 1 spec)
  96              "/" "_")
  97             ":" "__")
  98            "~" "___")
  99           "/" (nth 3 spec)))
 100         (expand-file-name (concat (symbol-name type) "/"
 101                                   (symbol-name (nth 2 spec)))
 102                           elmo-msgdb-dir)))
 103       ((eq type 'pop3)
 104        (expand-file-name
 105         (elmo-safe-filename (elmo-pop3-spec-username spec))
 106         (expand-file-name (elmo-pop3-spec-hostname spec)
 107                           (expand-file-name
 108                            "pop"
 109                            elmo-msgdb-dir))))
 110       ((eq type 'localnews)
 111        (expand-file-name
 112         (elmo-replace-in-string (nth 1 spec) "/" ".")
 113         (expand-file-name "localnews"
 114                           elmo-msgdb-dir)))
 115       ((eq type 'internal)
 116        (expand-file-name (elmo-safe-filename (concat (symbol-name (nth 1 spec))
 117                                                      (nth 2 spec)))
 118                          (expand-file-name "internal"
 119                                            elmo-msgdb-dir)))
 120       ((eq type 'cache)
 121        (expand-file-name (elmo-safe-filename (nth 1 spec))
 122                          (expand-file-name "internal/cache"
 123                                            elmo-msgdb-dir)))
 124       (t ; local dir or undefined type
 125        ;; absolute path
 126        (setq fld (nth 1 spec))
 127        (if (file-name-absolute-p fld)
 128            (setq fld (elmo-safe-filename fld)))
 129        (expand-file-name fld
 130                          (expand-file-name (symbol-name type)
 131                                            elmo-msgdb-dir)))))))
 132
 133 (defsubst elmo-msgdb-append-element (list element)
 134   (if list
 135       ;(append list (list element))
 136       (nconc list (list element))
 137     ;; list is nil
 138     (list element)))
 139
 140 (defsubst elmo-msgdb-get-overview (msgdb)
 141   (car msgdb))
 142 (defsubst elmo-msgdb-get-number-alist (msgdb)
 143   (cadr msgdb))
 144 (defsubst elmo-msgdb-get-mark-alist (msgdb)
 145   (caddr msgdb))
 146 (defsubst elmo-msgdb-get-location (msgdb)
 147   (cadddr msgdb))
 148 (defsubst elmo-msgdb-get-overviewht (msgdb)
 149   (nth 4 msgdb))
 150
 151 ;;
 152 ;; number <-> Message-ID handling
 153 ;;
 154 (defsubst elmo-msgdb-number-add (alist number id)
 155   (let ((ret-val alist))
 156     (setq ret-val
 157           (elmo-msgdb-append-element ret-val (cons number id)))
 158     ret-val))
 159
 160 ;;;
 161 ;; parsistent mark handling
 162 ;; (for global!)
 163
 164 (defvar elmo-msgdb-global-mark-alist nil)
 165
 166 (defun elmo-msgdb-global-mark-delete (msgid)
 167   (let* ((path (expand-file-name
 168                 elmo-msgdb-global-mark-filename
 169                 elmo-msgdb-dir))
 170          (malist (or elmo-msgdb-global-mark-alist
 171                      (setq elmo-msgdb-global-mark-alist
 172                            (elmo-object-load path))))
 173          match)
 174     (when (setq match (assoc msgid malist))
 175       (setq elmo-msgdb-global-mark-alist
 176             (delete match elmo-msgdb-global-mark-alist))
 177       (elmo-object-save path elmo-msgdb-global-mark-alist))))
 178
 179 (defun elmo-msgdb-global-mark-set (msgid mark)
 180   (let* ((path (expand-file-name
 181                 elmo-msgdb-global-mark-filename
 182                 elmo-msgdb-dir))
 183          (malist (or elmo-msgdb-global-mark-alist
 184                      (setq elmo-msgdb-global-mark-alist
 185                            (elmo-object-load path))))
 186          match)
 187     (if (setq match (assoc msgid malist))
 188         (setcdr match mark)
 189       (setq elmo-msgdb-global-mark-alist
 190             (nconc elmo-msgdb-global-mark-alist
 191                    (list (cons msgid mark)))))
 192     (elmo-object-save path elmo-msgdb-global-mark-alist)))
 193
 194 (defun elmo-msgdb-global-mark-get (msgid)
 195   (cdr (assoc msgid (or elmo-msgdb-global-mark-alist
 196                         (setq elmo-msgdb-global-mark-alist
 197                               (elmo-object-load
 198                                (expand-file-name
 199                                 elmo-msgdb-global-mark-filename
 200                                 elmo-msgdb-dir)))))))
 201
 202 ;;
 203 ;; number <-> location handling
 204 ;;
 205 (defsubst elmo-msgdb-location-load (dir)
 206   (elmo-object-load
 207    (expand-file-name
 208     elmo-msgdb-location-filename
 209     dir)))
 210
 211 (defsubst elmo-msgdb-location-add (alist number location)
 212   (let ((ret-val alist))
 213     (setq ret-val
 214           (elmo-msgdb-append-element ret-val (cons number location)))
 215     ret-val))
 216
 217 (defsubst elmo-msgdb-location-save (dir alist)
 218   (elmo-object-save
 219    (expand-file-name
 220     elmo-msgdb-location-filename
 221     dir) alist))
 222
 223 (defun elmo-list-folder-by-location (spec locations &optional msgdb)
 224   (let* ((path (elmo-msgdb-expand-path spec))
 225          (location-alist (if msgdb
 226                              (elmo-msgdb-get-location msgdb)
 227                            (elmo-msgdb-location-load path)))
 228          (locations-in-db (mapcar 'cdr location-alist))
 229          result new-locs new-alist deleted-locs i
 230          modified)
 231     (setq new-locs
 232           (elmo-delete-if (function
 233                            (lambda (x) (member x locations-in-db)))
 234                           locations))
 235     (setq deleted-locs
 236           (elmo-delete-if (function
 237                            (lambda (x) (member x locations)))
 238                           locations-in-db))
 239     (setq modified new-locs)
 240     (setq i (or (elmo-max-of-list (mapcar 'car location-alist)) 0))
 241     (mapcar
 242      (function
 243       (lambda (x)
 244         (setq location-alist
 245               (delq (rassoc x location-alist) location-alist))))
 246      deleted-locs)
 247     (while new-locs
 248       (setq i (1+ i))
 249       (setq new-alist (cons (cons i (car new-locs)) new-alist))
 250       (setq new-locs (cdr new-locs)))
 251     (setq result (nconc location-alist new-alist))
 252     (setq result (sort result (lambda (x y) (< (car x)(car y)))))
 253     (if modified (elmo-msgdb-location-save path result))
 254     (mapcar 'car result)))
 255
 256 ;;;
 257 ;; persistent mark handling
 258 ;; (for each folder)
 259 (defun elmo-msgdb-mark-set (alist id mark)
 260   (let ((ret-val alist)
 261         entity)
 262     (setq entity (assq id alist))
 263     (if entity
 264         (if (eq mark nil)
 265             ;; delete this entity
 266             (setq ret-val (delq entity alist))
 267           ;; set mark
 268           (setcar (cdr entity) mark))
 269       (if mark
 270           (setq ret-val (elmo-msgdb-append-element ret-val
 271                                                    (list id mark)))))
 272     ret-val))
 273
 274 (defun elmo-msgdb-mark-append (alist id mark)
 275   "Append mark"
 276   (setq alist (elmo-msgdb-append-element alist
 277                                          (list id mark))))
 278
 279 (defun elmo-msgdb-mark-alist-to-seen-list (number-alist mark-alist seen-marks)
 280   "Make seen-list from mark-alist"
 281   (let ((seen-mark-list (string-to-char-list seen-marks))
 282         ret-val ent)
 283     (while number-alist
 284       (if (setq ent (assq (car (car number-alist)) mark-alist))
 285           (if (and (cadr ent)
 286                    (memq (string-to-char (cadr ent)) seen-mark-list))
 287               (setq ret-val (cons (cdr (car number-alist)) ret-val)))
 288         (setq ret-val (cons (cdr (car number-alist)) ret-val)))
 289       (setq number-alist (cdr number-alist)))
 290     ret-val))
 291
 292 ;;
 293 ;; mime decode cache
 294
 295 (defvar elmo-msgdb-decoded-cache-hashtb nil)
 296 (make-variable-buffer-local 'elmo-msgdb-decoded-cache-hashtb)
 297
 298 (defsubst elmo-msgdb-get-decoded-cache (string)
 299   (if elmo-use-decoded-cache
 300       (let ((hashtb (or elmo-msgdb-decoded-cache-hashtb
 301                         (setq elmo-msgdb-decoded-cache-hashtb
 302                               (elmo-make-hash 2048))))
 303             decoded)
 304         (or (elmo-get-hash-val string hashtb)
 305             (progn
 306               (elmo-set-hash-val
 307                string
 308                (setq decoded
 309                      (decode-mime-charset-string string elmo-mime-charset))
 310                hashtb)
 311               decoded)))
 312     (decode-mime-charset-string string elmo-mime-charset)))
 313
 314 ;;
 315 ;; overview handling
 316 ;;
 317
 318 (defsubst elmo-msgdb-get-field-value (field-name beg end buffer)
 319   (save-excursion
 320     (save-restriction
 321       (set-buffer buffer)
 322       (narrow-to-region beg end)
 323       (elmo-field-body field-name))))
 324
 325 (defun elmo-multiple-field-body (name &optional boundary)
 326   (save-excursion
 327     (save-restriction
 328       (std11-narrow-to-header boundary)
 329       (goto-char (point-min))
 330       (let ((case-fold-search t)
 331             (field-body nil))
 332         (while (re-search-forward (concat "^" name ":[ \t]*") nil t)
 333           (setq field-body
 334                 (nconc field-body
 335                        (list (buffer-substring-no-properties
 336                               (match-end 0) (std11-field-end))))))
 337         field-body))))
 338
 339 (defun elmo-multiple-fields-body-list (field-names &optional boundary)
 340   "Return list of each field-bodies of FIELD-NAMES of the message header
 341 in current buffer. If BOUNDARY is not nil, it is used as message
 342 header separator."
 343   (save-excursion
 344     (save-restriction
 345       (std11-narrow-to-header boundary)
 346       (let* ((case-fold-search t)
 347              (s-rest field-names)
 348              field-name field-body)
 349         (while (setq field-name (car s-rest))
 350           (goto-char (point-min))
 351           (while (re-search-forward (concat "^" field-name ":[ \t]*") nil t)
 352             (setq field-body
 353                   (nconc field-body
 354                          (list (buffer-substring-no-properties
 355                                 (match-end 0) (std11-field-end))))))
 356           (setq s-rest (cdr s-rest)))
 357         field-body))))
 358
 359 (defsubst elmo-msgdb-remove-field-string (string)
 360   (if (string-match (concat std11-field-head-regexp "[ \t]*") string)
 361       (substring string (match-end 0))
 362     string))
 363
 364 (defsubst elmo-msgdb-get-last-message-id (string)
 365   (if string
 366       (save-match-data
 367         (let (beg)
 368           (elmo-set-work-buf
 369            (insert string)
 370            (goto-char (point-max))
 371            (when (search-backward "<" nil t)
 372              (setq beg (point))
 373              (if (search-forward ">" nil t)
 374                  (elmo-replace-in-string
 375                   (buffer-substring beg (point)) "\n[ \t]*" ""))))))))
 376
 377 (defun elmo-msgdb-number-load (dir)
 378   (elmo-object-load
 379    (expand-file-name elmo-msgdb-number-filename dir)))
 380
 381 (defun elmo-msgdb-overview-load (dir)
 382   (elmo-object-load
 383    (expand-file-name elmo-msgdb-overview-filename dir)))
 384
 385 (defun elmo-msgdb-mark-load (dir)
 386   (elmo-object-load
 387    (expand-file-name elmo-msgdb-mark-filename dir)))
 388
 389 (defsubst elmo-msgdb-seen-load (dir)
 390   (elmo-object-load (expand-file-name
 391                      elmo-msgdb-seen-filename
 392                      dir)))
 393
 394 (defun elmo-msgdb-number-save (dir obj)
 395   (elmo-object-save
 396    (expand-file-name elmo-msgdb-number-filename dir)
 397    obj))
 398
 399 (defun elmo-msgdb-mark-save (dir obj)
 400   (elmo-object-save
 401    (expand-file-name elmo-msgdb-mark-filename dir)
 402    obj))
 403
 404 (defsubst elmo-msgdb-seen-save (dir obj)
 405   (elmo-object-save
 406    (expand-file-name elmo-msgdb-seen-filename dir)
 407    obj))
 408
 409 (defsubst elmo-msgdb-overview-save (dir overview)
 410   (elmo-object-save
 411    (expand-file-name elmo-msgdb-overview-filename dir)
 412    overview))
 413
 414 (defun elmo-msgdb-search-internal-primitive (condition entity number-list)
 415   (let ((key (elmo-filter-key condition))
 416         result)
 417     (cond
 418      ((string= key "last")
 419       (setq result (<= (length (memq
 420                                 (elmo-msgdb-overview-entity-get-number entity)
 421                                 number-list))
 422                        (string-to-int (elmo-filter-value condition)))))
 423      ((string= key "first")
 424       (setq result (< (-
 425                        (length number-list)
 426                        (length (memq
 427                                 (elmo-msgdb-overview-entity-get-number entity)
 428                                 number-list)))
 429                       (string-to-int (elmo-filter-value condition)))))
 430      ((string= key "from")
 431       (setq result (string-match
 432                     (elmo-filter-value condition)
 433                     (elmo-msgdb-overview-entity-get-from entity))))
 434      ((string= key "subject")
 435       (setq result (string-match
 436                     (elmo-filter-value condition)
 437                     (elmo-msgdb-overview-entity-get-subject entity))))
 438      ((string= key "to")
 439       (setq result (string-match
 440                     (elmo-filter-value condition)
 441                     (elmo-msgdb-overview-entity-get-to entity))))
 442      ((string= key "cc")
 443       (setq result (string-match
 444                     (elmo-filter-value condition)
 445                     (elmo-msgdb-overview-entity-get-cc entity))))
 446      ((or (string= key "since")
 447           (string= key "before"))
 448       (let ((res (string< (timezone-make-date-sortable
 449                            (elmo-msgdb-overview-entity-get-date entity))
 450                           (elmo-date-make-sortable-string
 451                            (elmo-date-get-datevec
 452                             (elmo-filter-value condition))))))
 453         (setq result (if (string= key "before") res (not res))))))
 454     (if (eq (elmo-filter-type condition) 'unmatch)
 455         (setq result (not result)))
 456     result))
 457
 458 (defun elmo-msgdb-search-internal (condition entity number-list)
 459   (cond
 460    ((vectorp condition)
 461     (elmo-msgdb-search-internal-primitive condition entity number-list))
 462    ((eq (car condition) 'and)
 463     (and (elmo-msgdb-search-internal-primitive
 464           (nth 1 condition) entity number-list)
 465          (elmo-msgdb-search-internal-primitive
 466           (nth 2 condition) entity number-list)))
 467    ((eq (car condition) 'or)
 468     (or (elmo-msgdb-search-internal-primitive
 469          (nth 1 condition) entity number-list)
 470         (elmo-msgdb-search-internal-primitive
 471          (nth 2 condition) entity number-list)))))
 472
 473 (defun elmo-msgdb-delete-msgs (folder msgs msgdb &optional reserve-cache)
 474   "Delete MSGS from FOLDER in MSGDB.
 475 content of MSGDB is changed."
 476   (save-excursion
 477     (let* ((msg-list msgs)
 478            (dir (elmo-msgdb-expand-path folder))
 479            (overview (or (car msgdb)
 480                          (elmo-msgdb-overview-load dir)))
 481            (number-alist (or (cadr msgdb)
 482                              (elmo-msgdb-number-load dir)))
 483            (mark-alist (or (caddr msgdb)
 484                            (elmo-msgdb-mark-load dir)))
 485            (loc-alist (or (elmo-msgdb-get-location msgdb)
 486                           (elmo-msgdb-location-load dir)))
 487            (hashtb (or (elmo-msgdb-get-overviewht msgdb)
 488                        (elmo-msgdb-make-overview-hashtb overview)))
 489            (newmsgdb (list overview number-alist mark-alist (nth 3 msgdb) hashtb))
 490            ov-entity message-id)
 491       ;; remove from current database.
 492       (while msg-list
 493         (setq message-id (cdr (assq (car msg-list) number-alist)))
 494         (if (and (not reserve-cache) message-id)
 495             (elmo-cache-delete message-id
 496                                folder (car msg-list)))
 497         ;; This is no good!!!!
 498         ;(setq overview (delete (assoc message-id overview) overview))
 499         (setq overview
 500               (delq
 501                (setq ov-entity
 502                      (elmo-msgdb-overview-get-entity (car msg-list) newmsgdb))
 503                overview))
 504         (when (and elmo-use-overview-hashtb hashtb)
 505           (elmo-msgdb-clear-overview-hashtb ov-entity hashtb))
 506         (setq number-alist
 507               (delq (assq (car msg-list) number-alist) number-alist))
 508         (setq mark-alist (delq (assq (car msg-list) mark-alist) mark-alist))
 509         (setq loc-alist (delq (assq (car msg-list) loc-alist) loc-alist))
 510         ;; XXX Should consider when folder is not persistent.
 511         ;; (elmo-msgdb-location-save dir loc-alist)
 512         (setq msg-list (cdr msg-list)))
 513       (setcar msgdb overview)
 514       (setcar (cdr msgdb) number-alist)
 515       (setcar (cddr msgdb) mark-alist)
 516       (setcar (nthcdr 4 msgdb) hashtb))
 517     t)) ;return value
 518
 519 (defsubst elmo-msgdb-set-overview (msgdb overview)
 520   (setcar msgdb overview))
 521
 522 (defsubst elmo-msgdb-set-number-alist (msgdb number-alist)
 523   (setcar (cdr msgdb) number-alist))
 524
 525 (defsubst elmo-msgdb-set-mark-alist (msgdb mark-alist)
 526   (setcar (cddr msgdb) mark-alist))
 527
 528 (defsubst elmo-msgdb-overview-entity-get-references (entity)
 529   (and entity (aref (cdr entity) 1)))
 530
 531 ;; entity -> parent-entity
 532 (defsubst elmo-msgdb-overview-get-parent-entity (entity database)
 533   (setq entity (elmo-msgdb-overview-entity-get-references entity))
 534   ;; entity is parent-id.
 535   (and entity (assoc entity database)))
 536
 537 (defsubst elmo-msgdb-overview-entity-get-number (entity)
 538   (and entity (aref (cdr entity) 0)))
 539
 540 (defsubst elmo-msgdb-overview-entity-get-from-no-decode (entity)
 541   (and entity (aref (cdr entity) 2)))
 542
 543 (defsubst elmo-msgdb-overview-entity-get-from (entity)
 544   (and entity
 545        (aref (cdr entity) 2)
 546        (elmo-msgdb-get-decoded-cache (aref (cdr entity) 2))))
 547
 548 (defsubst elmo-msgdb-overview-entity-set-number (entity number)
 549   (and entity (aset (cdr entity) 0 number))
 550   entity)
 551   ;(setcar (cadr entity) number) entity)
 552
 553 (defsubst elmo-msgdb-overview-entity-set-from (entity from)
 554   (and entity (aset (cdr entity) 2 from))
 555   entity)
 556
 557 (defsubst elmo-msgdb-overview-entity-get-subject (entity)
 558   (and entity
 559        (aref (cdr entity) 3)
 560        (elmo-msgdb-get-decoded-cache (aref (cdr entity) 3))))
 561
 562 (defsubst elmo-msgdb-overview-entity-get-subject-no-decode (entity)
 563   (and entity (aref (cdr entity) 3)))
 564
 565 (defsubst elmo-msgdb-overview-entity-set-subject (entity subject)
 566   (and entity (aset (cdr entity) 3 subject))
 567   entity)
 568
 569 (defsubst elmo-msgdb-overview-entity-get-date (entity)
 570   (and entity (aref (cdr entity) 4)))
 571
 572 (defsubst elmo-msgdb-overview-entity-get-to (entity)
 573   (and entity (aref (cdr entity) 5)))
 574
 575 (defsubst elmo-msgdb-overview-entity-get-cc (entity)
 576   (and entity (aref (cdr entity) 6)))
 577
 578 (defsubst elmo-msgdb-overview-entity-get-size (entity)
 579   (and entity (aref (cdr entity) 7)))
 580
 581 (defsubst elmo-msgdb-overview-entity-set-size (entity size)
 582   (and entity (aset (cdr entity) 7 size))
 583   entity)
 584
 585 (defsubst elmo-msgdb-overview-entity-get-id (entity)
 586   (and entity (car entity)))
 587
 588 (defsubst elmo-msgdb-overview-entity-get-extra-field (entity field-name)
 589   (let ((extra (and entity (aref (cdr entity) 8))))
 590     (and extra
 591          (cdr (assoc field-name extra)))))
 592
 593 (defun elmo-msgdb-overview-get-entity-by-number (database number)
 594   (when number
 595     (let ((db database)
 596           entity)
 597       (while db
 598         (if (eq (elmo-msgdb-overview-entity-get-number (car db)) number)
 599             (setq entity (car db)
 600                   db nil) ; exit loop
 601           (setq db (cdr db))))
 602       entity)))
 603
 604 (defun elmo-msgdb-overview-get-entity (id msgdb)
 605   (when id
 606     (let ((ovht (elmo-msgdb-get-overviewht msgdb)))
 607       (if ovht ;; use overview hash
 608           (if (stringp id) ;; ID is message-id
 609               (elmo-get-hash-val id ovht)
 610             (elmo-get-hash-val (format "#%d" id) ovht))
 611         (let* ((overview (elmo-msgdb-get-overview msgdb))
 612                (number-alist (elmo-msgdb-get-number-alist msgdb))
 613                (message-id (if (stringp id)
 614                                id ;; ID is message-id
 615                              (cdr (assq id number-alist))))
 616                entity)
 617           (if message-id
 618               (assoc message-id overview)
 619             ;; ID is number. message-id is nil or no exists in number-alist.
 620             (elmo-msgdb-overview-get-entity-by-number overview id)))))))
 621
 622 ;;
 623 ;; deleted message handling
 624 ;;
 625 (defun elmo-msgdb-killed-list-load (dir)
 626   (elmo-object-load
 627    (expand-file-name elmo-msgdb-killed-filename dir)
 628    nil t))
 629
 630 (defun elmo-msgdb-killed-list-save (dir killed-list)
 631   (elmo-object-save
 632    (expand-file-name elmo-msgdb-killed-filename dir)
 633    killed-list))
 634
 635 (defun elmo-msgdb-killed-message-p (killed-list msg)
 636   (elmo-number-set-member msg killed-list))
 637
 638 (defun elmo-msgdb-set-as-killed (killed-list msg)
 639   (elmo-number-set-append killed-list msg))
 640
 641 (defun elmo-msgdb-append-to-killed-list (folder msgs)
 642   (let ((dir (elmo-msgdb-expand-path folder)))
 643     (elmo-msgdb-killed-list-save
 644      dir
 645      (elmo-number-set-append-list
 646       (elmo-msgdb-killed-list-load dir)
 647       msgs))))
 648
 649 (defun elmo-living-messages (messages killed-list)
 650   (if killed-list
 651       (delq nil
 652             (mapcar (lambda (number)
 653                       (unless (elmo-number-set-member number killed-list)
 654                         number))
 655                     messages))
 656     messages))
 657
 658 (defun elmo-msgdb-finfo-load ()
 659   (elmo-object-load (expand-file-name
 660                      elmo-msgdb-finfo-filename
 661                      elmo-msgdb-dir)
 662                     elmo-mime-charset t))
 663
 664 (defun elmo-msgdb-finfo-save (finfo)
 665   (elmo-object-save (expand-file-name
 666                      elmo-msgdb-finfo-filename
 667                      elmo-msgdb-dir)
 668                     finfo elmo-mime-charset))
 669
 670 (defun elmo-msgdb-flist-load (folder)
 671   (let ((flist-file (expand-file-name
 672                      elmo-msgdb-flist-filename
 673                      (elmo-msgdb-expand-path (list 'folder folder)))))
 674     (elmo-object-load flist-file nil t)))
 675
 676 (defun elmo-msgdb-flist-save (folder flist)
 677   (let ((flist-file (expand-file-name
 678                      elmo-msgdb-flist-filename
 679                      (elmo-msgdb-expand-path (list 'folder folder)))))
 680     (elmo-object-save flist-file flist)))
 681
 682 (defun elmo-crosspost-alist-load ()
 683   (elmo-object-load (expand-file-name
 684                      elmo-crosspost-alist-filename
 685                      elmo-msgdb-dir)
 686                     nil t))
 687
 688 (defun elmo-crosspost-alist-save (alist)
 689   (elmo-object-save (expand-file-name
 690                      elmo-crosspost-alist-filename
 691                      elmo-msgdb-dir)
 692                     alist))
 693
 694 (defsubst elmo-msgdb-create-overview-from-buffer (number &optional size time)
 695   "Create overview entity from current buffer.
 696 Header region is supposed to be narrowed."
 697   (save-excursion
 698     (let ((extras elmo-msgdb-extra-fields)
 699           message-id references from subject to cc date
 700           extra field-body)
 701       (elmo-set-buffer-multibyte default-enable-multibyte-characters)
 702       (setq message-id (elmo-field-body "message-id"))
 703       (setq references
 704             (or (elmo-msgdb-get-last-message-id
 705                  (elmo-field-body "in-reply-to"))
 706                 (elmo-msgdb-get-last-message-id
 707                  (elmo-field-body "references"))))
 708       (setq from (elmo-mime-string (elmo-delete-char
 709                                     ?\"
 710                                     (or
 711                                      (elmo-field-body "from")
 712                                      elmo-no-from))))
 713       (setq subject (elmo-mime-string (or (elmo-field-body "subject")
 714                                           elmo-no-subject)))
 715       (setq date (or (elmo-field-body "date") time))
 716       (setq to   (mapconcat 'identity (elmo-multiple-field-body "to") ","))
 717       (setq cc   (mapconcat 'identity (elmo-multiple-field-body "cc") ","))
 718       (or size
 719           (if (setq size (elmo-field-body "content-length"))
 720               (setq size (string-to-int size))
 721             (setq size 0)));; No mean...
 722       (while extras
 723         (if (setq field-body (elmo-field-body (car extras)))
 724             (setq extra (cons (cons (downcase (car extras))
 725                                     field-body) extra)))
 726         (setq extras (cdr extras)))
 727       (cons message-id (vector number references
 728                                from subject date to cc
 729                                size extra))
 730       )))
 731
 732 (defun elmo-msgdb-overview-sort-by-date (overview)
 733   (sort overview
 734         (function
 735          (lambda (x y)
 736            (condition-case nil
 737                (string<
 738                 (timezone-make-date-sortable
 739                  (elmo-msgdb-overview-entity-get-date x))
 740                 (timezone-make-date-sortable
 741                  (elmo-msgdb-overview-entity-get-date y)))
 742              (error))))))
 743
 744 (defun elmo-msgdb-sort-by-date (msgdb)
 745   (message "Sorting...")
 746   (let ((overview (elmo-msgdb-get-overview msgdb)))
 747     (setq overview (elmo-msgdb-overview-sort-by-date overview))
 748     (message "Sorting...done.")
 749     (list overview (nth 1 msgdb)(nth 2 msgdb)(nth 3 msgdb)(nth 4 msgdb))))
 750
 751 (defun elmo-msgdb-clear-overview-hashtb (entity hashtb)
 752   (let (number)
 753     (when (and entity
 754                elmo-use-overview-hashtb
 755                hashtb)
 756       (and (setq number (elmo-msgdb-overview-entity-get-number entity))
 757            (elmo-clear-hash-val (format "#%d" number) hashtb))
 758       (and (car entity) ;; message-id
 759            (elmo-clear-hash-val (car entity) hashtb)))))
 760
 761 (defun elmo-msgdb-make-overview-hashtb (overview &optional hashtb)
 762   (if elmo-use-overview-hashtb
 763       (let ((hashtb (or hashtb ;; append
 764                         (elmo-make-hash (length overview)))))
 765         (while overview
 766           ;; key is message-id
 767           (if (caar overview)
 768               (elmo-set-hash-val (caar overview) (car overview) hashtb))
 769           ;; key is number
 770           (elmo-set-hash-val
 771            (format "#%d" (elmo-msgdb-overview-entity-get-number (car overview)))
 772            (car overview) hashtb)
 773           (setq overview (cdr overview)))
 774         hashtb)
 775     nil))
 776
 777 (defsubst elmo-msgdb-append (msgdb msgdb-append &optional set-hash)
 778   (list
 779    (nconc (car msgdb) (car msgdb-append))
 780    (nconc (cadr msgdb) (cadr msgdb-append))
 781    (nconc (caddr msgdb) (caddr msgdb-append))
 782    (nconc (cadddr msgdb) (cadddr msgdb-append))
 783    (and set-hash
 784         (elmo-msgdb-make-overview-hashtb (car msgdb-append) (nth 4 msgdb)))))
 785
 786 (defsubst elmo-msgdb-clear (&optional msgdb)
 787   (if msgdb
 788       (list
 789        (setcar msgdb nil)
 790        (setcar (cdr msgdb) nil)
 791        (setcar (cddr msgdb) nil)
 792        (setcar (cdddr msgdb) nil)
 793        (setcar (nthcdr 4 msgdb) (elmo-msgdb-make-overview-hashtb nil)))
 794     (list nil nil nil nil (elmo-msgdb-make-overview-hashtb nil))))
 795
 796 (defun elmo-msgdb-delete-path (folder &optional spec)
 797   (let ((path (elmo-msgdb-expand-path (or spec folder))))
 798     (if (file-directory-p path)
 799         (elmo-delete-directory path t))))
 800
 801 (defun elmo-msgdb-rename-path (old-folder new-folder &optional old-spec new-spec)
 802   (let* ((old (directory-file-name (elmo-msgdb-expand-path old-spec)))
 803          (new (directory-file-name (elmo-msgdb-expand-path new-spec)))
 804          (new-dir (directory-file-name (file-name-directory new))))
 805     (if (not (file-directory-p old))
 806         ()
 807       (if (file-exists-p new)
 808           (error "already exists directory: %s" new)
 809         (if (not (file-exists-p new-dir))
 810             (elmo-make-directory new-dir))
 811         (rename-file old new)))))
 812
 813 (require 'product)
 814 (product-provide (provide 'elmo-msgdb) (require 'elmo-version))
 815
 816 ;;; elmo-msgdb.el ends here