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 &optional spec)
  40   (convert-standard-filename
  41    (let* ((spec (or spec (elmo-folder-get-spec folder)))
  42           (type (car spec))
  43           fld)
  44      (cond
  45       ((eq type 'imap4)
  46        (setq fld (elmo-imap4-spec-mailbox spec))
  47        (if (string= "inbox" (downcase fld))
  48            (setq fld "inbox"))
  49        (if (eq (string-to-char fld) ?/)
  50            (setq fld (substring fld 1 (length fld))))
  51        (expand-file-name
  52         fld
  53         (expand-file-name (or (elmo-imap4-spec-username spec) "nobody")
  54                           (expand-file-name (or
  55                                              (elmo-imap4-spec-hostname spec)
  56                                              "nowhere")
  57                                             (expand-file-name
  58                                              "imap"
  59                                              elmo-msgdb-dir)))))
  60       ((eq type 'nntp)
  61        (expand-file-name
  62         (elmo-nntp-spec-group spec)
  63         (expand-file-name (or (elmo-nntp-spec-hostname spec) "nowhere")
  64                           (expand-file-name "nntp"
  65                                             elmo-msgdb-dir))))
  66       ((eq type 'maildir)
  67        (expand-file-name (elmo-safe-filename (nth 1 spec))
  68                          (expand-file-name "maildir"
  69                                            elmo-msgdb-dir)))
  70       ((eq type 'folder)
  71        (expand-file-name (elmo-safe-filename (nth 1 spec))
  72                          (expand-file-name "folder"
  73                                            elmo-msgdb-dir)))
  74       ((eq type 'multi)
  75        (expand-file-name (elmo-safe-filename folder)
  76                          (expand-file-name "multi"
  77                                            elmo-msgdb-dir)))
  78       ((eq type 'filter)
  79        (expand-file-name
  80         (elmo-safe-filename folder)
  81         (expand-file-name "filter"
  82                           elmo-msgdb-dir)))
  83       ((eq type 'archive)
  84        (expand-file-name
  85         (directory-file-name
  86          (concat
  87           (elmo-replace-in-string
  88            (elmo-replace-in-string
  89             (elmo-replace-in-string
  90              (nth 1 spec)
  91              "/" "_")
  92             ":" "__")
  93            "~" "___")
  94           "/" (nth 3 spec)))
  95         (expand-file-name (concat (symbol-name type) "/"
  96                                   (symbol-name (nth 2 spec)))
  97                           elmo-msgdb-dir)))
  98       ((eq type 'pop3)
  99        (expand-file-name
 100         (elmo-safe-filename (elmo-pop3-spec-username spec))
 101         (expand-file-name (elmo-pop3-spec-hostname spec)
 102                           (expand-file-name
 103                            "pop"
 104                            elmo-msgdb-dir))))
 105       ((eq type 'localnews)
 106        (expand-file-name
 107         (elmo-replace-in-string (nth 1 spec) "/" ".")
 108         (expand-file-name "localnews"
 109                           elmo-msgdb-dir)))
 110       ((eq type 'internal)
 111        (expand-file-name (elmo-safe-filename (concat (symbol-name (nth 1 spec))
 112                                                      (nth 2 spec)))
 113                          (expand-file-name "internal"
 114                                            elmo-msgdb-dir)))
 115       ((eq type 'cache)
 116        (expand-file-name (elmo-safe-filename (nth 1 spec))
 117                          (expand-file-name "internal/cache"
 118                                            elmo-msgdb-dir)))
 119       (t ; local dir or undefined type
 120        ;; absolute path
 121        (setq fld (nth 1 spec))
 122        (if (file-name-absolute-p fld)
 123            (setq fld (elmo-safe-filename fld)))
 124        (expand-file-name fld
 125                          (expand-file-name (symbol-name type)
 126                                            elmo-msgdb-dir)))))))
 127
 128 (defsubst elmo-msgdb-append-element (list element)
 129   (if list
 130       ;(append list (list element))
 131       (nconc list (list element))
 132     ;; list is nil
 133     (list element)))
 134
 135 (defsubst elmo-msgdb-get-overview (msgdb)
 136   (car msgdb))
 137 (defsubst elmo-msgdb-get-number-alist (msgdb)
 138   (cadr msgdb))
 139 (defsubst elmo-msgdb-get-mark-alist (msgdb)
 140   (caddr msgdb))
 141 (defsubst elmo-msgdb-get-location (msgdb)
 142   (cadddr msgdb))
 143
 144 ;;
 145 ;; number <-> Message-ID handling
 146 ;;
 147 (defsubst elmo-msgdb-number-add (alist number id)
 148   (let ((ret-val alist))
 149     (setq ret-val
 150           (elmo-msgdb-append-element ret-val (cons number id)))
 151     ret-val))
 152
 153 ;;;
 154 ;; parsistent mark handling
 155 ;; (for global!)
 156
 157 (defvar elmo-msgdb-global-mark-alist nil)
 158
 159 (defun elmo-msgdb-global-mark-delete (msgid)
 160   (let* ((path (expand-file-name
 161                 elmo-msgdb-global-mark-filename
 162                 elmo-msgdb-dir))
 163          (malist (or elmo-msgdb-global-mark-alist
 164                      (setq elmo-msgdb-global-mark-alist
 165                            (elmo-object-load path))))
 166          match)
 167     (when (setq match (assoc msgid malist))
 168       (setq elmo-msgdb-global-mark-alist
 169             (delete match elmo-msgdb-global-mark-alist))
 170       (elmo-object-save path elmo-msgdb-global-mark-alist))))
 171
 172 (defun elmo-msgdb-global-mark-set (msgid mark)
 173   (let* ((path (expand-file-name
 174                 elmo-msgdb-global-mark-filename
 175                 elmo-msgdb-dir))
 176          (malist (or elmo-msgdb-global-mark-alist
 177                      (setq elmo-msgdb-global-mark-alist
 178                            (elmo-object-load path))))
 179          match)
 180     (if (setq match (assoc msgid malist))
 181         (setcdr match mark)
 182       (setq elmo-msgdb-global-mark-alist
 183             (nconc elmo-msgdb-global-mark-alist
 184                    (list (cons msgid mark)))))
 185     (elmo-object-save path elmo-msgdb-global-mark-alist)))
 186
 187 (defun elmo-msgdb-global-mark-get (msgid)
 188   (cdr (assoc msgid (or elmo-msgdb-global-mark-alist
 189                         (setq elmo-msgdb-global-mark-alist
 190                               (elmo-object-load
 191                                (expand-file-name
 192                                 elmo-msgdb-global-mark-filename
 193                                 elmo-msgdb-dir)))))))
 194
 195 ;;
 196 ;; number <-> location handling
 197 ;;
 198 (defsubst elmo-msgdb-location-load (dir)
 199   (elmo-object-load
 200    (expand-file-name
 201     elmo-msgdb-location-filename
 202     dir)))
 203
 204 (defsubst elmo-msgdb-location-add (alist number location)
 205   (let ((ret-val alist))
 206     (setq ret-val
 207           (elmo-msgdb-append-element ret-val (cons number location)))
 208     ret-val))
 209
 210 (defsubst elmo-msgdb-location-save (dir alist)
 211   (elmo-object-save
 212    (expand-file-name
 213     elmo-msgdb-location-filename
 214     dir) alist))
 215
 216 (defun elmo-list-folder-by-location (spec locations &optional msgdb)
 217   (let* ((path (elmo-msgdb-expand-path nil spec))
 218          (location-alist (if msgdb
 219                              (elmo-msgdb-get-location msgdb)
 220                            (elmo-msgdb-location-load path)))
 221          (locations-in-db (mapcar 'cdr location-alist))
 222          result new-locs new-alist deleted-locs i
 223          modified)
 224     (setq new-locs
 225           (elmo-delete-if (function
 226                            (lambda (x) (member x locations-in-db)))
 227                           locations))
 228     (setq deleted-locs
 229           (elmo-delete-if (function
 230                            (lambda (x) (member x locations)))
 231                           locations-in-db))
 232     (setq modified new-locs)
 233     (setq i (or (elmo-max-of-list (mapcar 'car location-alist)) 0))
 234     (mapcar
 235      (function
 236       (lambda (x)
 237         (setq location-alist
 238               (delq (rassoc x location-alist) location-alist))))
 239      deleted-locs)
 240     (while new-locs
 241       (setq i (1+ i))
 242       (setq new-alist (cons (cons i (car new-locs)) new-alist))
 243       (setq new-locs (cdr new-locs)))
 244     (setq result (nconc location-alist new-alist))
 245     (setq result (sort result (lambda (x y) (< (car x)(car y)))))
 246     (if modified (elmo-msgdb-location-save path result))
 247     (mapcar 'car result)))
 248
 249 ;;;
 250 ;; persistent mark handling
 251 ;; (for each folder)
 252 (defun elmo-msgdb-mark-set (alist id mark)
 253   (let ((ret-val alist)
 254         entity)
 255     (setq entity (assq id alist))
 256     (if entity
 257         (if (eq mark nil)
 258             ;; delete this entity
 259             (setq ret-val (delq entity alist))
 260           ;; set mark
 261           (setcar (cdr entity) mark))
 262       (if mark
 263           (setq ret-val (elmo-msgdb-append-element ret-val
 264                                                    (list id mark)))))
 265     ret-val))
 266
 267 (defun elmo-msgdb-mark-append (alist id mark)
 268   "Append mark"
 269   (setq alist (elmo-msgdb-append-element alist
 270                                          (list id mark))))
 271
 272 (defun elmo-msgdb-mark-alist-to-seen-list (number-alist mark-alist seen-marks)
 273   "Make seen-list from mark-alist"
 274   (let ((seen-mark-list (string-to-char-list seen-marks))
 275         ret-val ent)
 276     (while number-alist
 277       (if (setq ent (assq (car (car number-alist)) mark-alist))
 278           (if (and (cadr ent)
 279                    (memq (string-to-char (cadr ent)) seen-mark-list))
 280               (setq ret-val (cons (cdr (car number-alist)) ret-val)))
 281         (setq ret-val (cons (cdr (car number-alist)) ret-val)))
 282       (setq number-alist (cdr number-alist)))
 283     ret-val))
 284
 285 ;;
 286 ;; overview handling
 287 ;;
 288
 289 (defsubst elmo-msgdb-get-field-value (field-name beg end buffer)
 290   (save-excursion
 291     (save-restriction
 292       (set-buffer buffer)
 293       (narrow-to-region beg end)
 294       (elmo-field-body field-name))))
 295
 296 (defun elmo-multiple-field-body (name &optional boundary)
 297   (save-excursion
 298     (save-restriction
 299       (std11-narrow-to-header boundary)
 300       (goto-char (point-min))
 301       (let ((case-fold-search t)
 302             (field-body nil))
 303         (while (re-search-forward (concat "^" name ":[ \t]*") nil t)
 304           (setq field-body
 305                 (nconc field-body
 306                        (list (buffer-substring-no-properties
 307                               (match-end 0) (std11-field-end))))))
 308         field-body))))
 309
 310 (defun elmo-multiple-fields-body-list (field-names &optional boundary)
 311   "Return list of each field-bodies of FIELD-NAMES of the message header
 312 in current buffer. If BOUNDARY is not nil, it is used as message
 313 header separator."
 314   (save-excursion
 315     (save-restriction
 316       (std11-narrow-to-header boundary)
 317       (let* ((case-fold-search t)
 318              (s-rest field-names)
 319              field-name field-body)
 320         (while (setq field-name (car s-rest))
 321           (goto-char (point-min))
 322           (while (re-search-forward (concat "^" field-name ":[ \t]*") nil t)
 323             (setq field-body
 324                   (nconc field-body
 325                          (list (buffer-substring-no-properties
 326                                 (match-end 0) (std11-field-end))))))
 327           (setq s-rest (cdr s-rest)))
 328         field-body))))
 329
 330 (defsubst elmo-msgdb-remove-field-string (string)
 331   (if (string-match (concat std11-field-head-regexp "[ \t]*") string)
 332       (substring string (match-end 0))
 333     string))
 334
 335 (defsubst elmo-msgdb-get-last-message-id (string)
 336   (if string
 337       (save-match-data
 338         (let (beg)
 339           (elmo-set-work-buf
 340            (insert string)
 341            (goto-char (point-max))
 342            (when (search-backward "<" nil t)
 343              (setq beg (point))
 344              (if (search-forward ">" nil t)
 345                  (elmo-replace-in-string
 346                   (buffer-substring beg (point)) "\n[ \t]*" ""))))))))
 347
 348 (defun elmo-msgdb-number-load (dir)
 349   (elmo-object-load
 350    (expand-file-name elmo-msgdb-number-filename dir)))
 351
 352 (defun elmo-msgdb-overview-load (dir)
 353   (elmo-object-load
 354    (expand-file-name elmo-msgdb-overview-filename dir)))
 355
 356 (defun elmo-msgdb-mark-load (dir)
 357   (elmo-object-load
 358    (expand-file-name elmo-msgdb-mark-filename dir)))
 359
 360 (defsubst elmo-msgdb-seen-load (dir)
 361   (elmo-object-load (expand-file-name
 362                      elmo-msgdb-seen-filename
 363                      dir)))
 364
 365 (defun elmo-msgdb-number-save (dir obj)
 366   (elmo-object-save
 367    (expand-file-name elmo-msgdb-number-filename dir)
 368    obj))
 369
 370 (defun elmo-msgdb-mark-save (dir obj)
 371   (elmo-object-save
 372    (expand-file-name elmo-msgdb-mark-filename dir)
 373    obj))
 374
 375 (defsubst elmo-msgdb-seen-save (dir obj)
 376   (elmo-object-save
 377    (expand-file-name elmo-msgdb-seen-filename dir)
 378    obj))
 379
 380 (defsubst elmo-msgdb-overview-save (dir overview)
 381   (elmo-object-save
 382    (expand-file-name elmo-msgdb-overview-filename dir)
 383    overview))
 384
 385 (defun elmo-msgdb-delete-msgs (folder msgs msgdb &optional reserve-cache)
 386   "Delete MSGS from FOLDER in MSGDB.
 387 content of MSGDB is changed."
 388   (save-excursion
 389     (let* ((msg-list msgs)
 390            (dir (elmo-msgdb-expand-path folder))
 391            (overview (or (car msgdb)
 392                          (elmo-msgdb-overview-load dir)))
 393            (number-alist (or (cadr msgdb)
 394                              (elmo-msgdb-number-load dir)))
 395            (mark-alist (or (caddr msgdb)
 396                            (elmo-msgdb-mark-load dir)))
 397            message-id)
 398       ;; remove from current database.
 399       (while msg-list
 400         (setq message-id (cdr (assq (car msg-list) number-alist)))
 401         (if (and (not reserve-cache) message-id)
 402             (elmo-cache-delete message-id
 403                                folder (car msg-list)))
 404         ;; This is no good!!!!
 405         ;(setq overview (delete (assoc message-id overview) overview))
 406         (setq overview
 407               (delq
 408                (elmo-msgdb-overview-get-entity-by-number overview
 409                                                          (car msg-list))
 410                overview))
 411         (setq number-alist
 412               (delq (assq (car msg-list) number-alist) number-alist))
 413         (setq mark-alist (delq (assq (car msg-list) mark-alist) mark-alist))
 414         (setq msg-list (cdr msg-list)))
 415       (setcar msgdb overview)
 416       (setcar (cdr msgdb) number-alist)
 417       (setcar (cddr msgdb) mark-alist))
 418     t)) ;return value
 419
 420 (defsubst elmo-msgdb-set-overview (msgdb overview)
 421   (setcar msgdb overview))
 422
 423 (defsubst elmo-msgdb-set-number-alist (msgdb number-alist)
 424   (setcar (cdr msgdb) number-alist))
 425
 426 (defsubst elmo-msgdb-set-mark-alist (msgdb mark-alist)
 427   (setcar (cddr msgdb) mark-alist))
 428
 429 (defsubst elmo-msgdb-overview-entity-get-references (entity)
 430   (and entity (aref (cdr entity) 1)))
 431
 432 ;; entity -> parent-entity
 433 (defsubst elmo-msgdb-overview-get-parent-entity (entity database)
 434   (setq entity (elmo-msgdb-overview-entity-get-references entity))
 435   ;; entity is parent-id.
 436   (and entity (assoc entity database)))
 437
 438 (defsubst elmo-msgdb-overview-entity-get-number (entity)
 439   (and entity (aref (cdr entity) 0)))
 440
 441 (defsubst elmo-msgdb-overview-entity-get-from-no-decode (entity)
 442   (and entity (aref (cdr entity) 2)))
 443
 444 (defsubst elmo-msgdb-overview-entity-get-from (entity)
 445   (and entity
 446        (aref (cdr entity) 2)
 447        (decode-mime-charset-string (aref (cdr entity) 2)
 448                                    elmo-mime-charset)))
 449
 450 (defsubst elmo-msgdb-overview-entity-set-number (entity number)
 451   (and entity (aset (cdr entity) 0 number))
 452   entity)
 453   ;(setcar (cadr entity) number) entity)
 454
 455 (defsubst elmo-msgdb-overview-entity-set-from (entity from)
 456   (and entity (aset (cdr entity) 2 from))
 457   entity)
 458
 459 (defsubst elmo-msgdb-overview-entity-get-subject (entity)
 460   (and entity
 461        (aref (cdr entity) 3)
 462        (decode-mime-charset-string (aref (cdr entity) 3)
 463                                    elmo-mime-charset)))
 464
 465 (defsubst elmo-msgdb-overview-entity-get-subject-no-decode (entity)
 466   (and entity (aref (cdr entity) 3)))
 467
 468 (defsubst elmo-msgdb-overview-entity-set-subject (entity subject)
 469   (and entity (aset (cdr entity) 3 subject))
 470   entity)
 471
 472 (defsubst elmo-msgdb-overview-entity-get-date (entity)
 473   (and entity (aref (cdr entity) 4)))
 474
 475 (defsubst elmo-msgdb-overview-entity-get-to (entity)
 476   (and entity (aref (cdr entity) 5)))
 477
 478 (defsubst elmo-msgdb-overview-entity-get-cc (entity)
 479   (and entity (aref (cdr entity) 6)))
 480
 481 (defsubst elmo-msgdb-overview-entity-get-size (entity)
 482   (and entity (aref (cdr entity) 7)))
 483
 484 (defsubst elmo-msgdb-overview-entity-get-id (entity)
 485   (and entity (car entity)))
 486
 487 (defsubst elmo-msgdb-overview-entity-get-extra-field (entity field-name)
 488   (let ((extra (and entity (aref (cdr entity) 8))))
 489     (and extra
 490          (cdr (assoc field-name extra)))))
 491
 492 (defun elmo-msgdb-overview-get-entity-by-number (database number)
 493   (let ((db database)
 494         entity)
 495     (catch 'loop
 496       (while db
 497         (if (eq (elmo-msgdb-overview-entity-get-number (car db)) number)
 498             (progn
 499               (setq entity (car db))
 500               (throw 'loop nil))
 501           (setq db (cdr db)))))
 502     entity))
 503
 504 ;;
 505 ;; deleted message handling
 506 ;;
 507 (defun elmo-msgdb-killed-list-load (dir)
 508   (elmo-object-load
 509    (expand-file-name elmo-msgdb-killed-filename dir)
 510    nil t))
 511
 512 (defun elmo-msgdb-killed-list-save (dir killed-list)
 513   (elmo-object-save
 514    (expand-file-name elmo-msgdb-killed-filename dir)
 515    killed-list))
 516
 517 (defun elmo-msgdb-killed-message-p (killed-list msg)
 518   (and killed-list
 519        (not (listp
 520              (catch 'found
 521                (mapcar
 522                 (function
 523                  (lambda (entity)
 524                    (cond
 525                     ((integerp entity)
 526                      (if (eq entity msg)
 527                          (throw 'found t)))
 528                     ((consp entity)
 529                      (if (and (<= (car entity) msg)
 530                               (<= msg (cdr entity)))
 531                          (throw 'found t)))))
 532                  killed-list)))))))
 533
 534 (defun elmo-msgdb-set-as-killed (killed-list msg)
 535   "if cons cell, set car-cdr messages as killed.
 536 if integer, set number th message as killed."
 537   (let ((dlist killed-list)
 538         (ret-val killed-list)
 539         entity found)
 540     (cond
 541      ((integerp msg)
 542       (while (and dlist (not found))
 543         (setq entity (car dlist))
 544         (if (or (and (integerp entity) (eq entity msg))
 545                 (and (consp entity)
 546                      (<= (car entity) msg)
 547                      (<= msg (cdr entity))))
 548             (setq found t))
 549         (setq dlist (cdr dlist))
 550         )
 551       (if (not found)
 552           (setq ret-val (elmo-msgdb-append-element killed-list msg)))
 553       )
 554      ((consp msg)
 555       (while (and dlist (not found))
 556         (setq entity (car dlist))
 557         (if (integerp entity)
 558             (cond
 559              ((and (<= (car msg) entity)(<= entity (cdr msg)))
 560               (setcar dlist msg)
 561               (setq found t)
 562               )
 563              ((= (1- (car msg)) entity)
 564               (setcar dlist (cons entity (cdr msg)))
 565               (setq found t)
 566               )
 567              ((= (1+ (cdr msg)) entity)
 568               (setcar dlist (cons (car msg) entity))
 569               (setq found t)
 570               ))
 571           ;; entity is consp
 572           (cond  ; there are four patterns
 573            ((and (<= (car msg) (car entity))
 574                  (<= (cdr entity) (cdr msg)))
 575             (setcar dlist msg)
 576             (setq found t))
 577            ((and (< (car entity)(car msg))
 578                  (< (cdr msg) (cdr entity)))
 579             (setq found t))
 580            ((and (<= (car msg) (car entity))
 581                  (<= (cdr msg) (cdr entity)))
 582             (setcar dlist (cons (car msg) (cdr entity)))
 583             (setq found t))
 584            ((and (<= (car entity) (car msg))
 585                  (<= (cdr entity) (cdr msg)))
 586             (setcar dlist (cons (car entity) (cdr msg)))
 587             (setq found t))))
 588         (setq dlist (cdr dlist)))
 589       (if (not found)
 590           (setq ret-val (elmo-msgdb-append-element killed-list msg)))))
 591     ret-val))
 592
 593 (defun elmo-msgdb-finfo-load ()
 594   (elmo-object-load (expand-file-name
 595                      elmo-msgdb-finfo-filename
 596                      elmo-msgdb-dir)
 597                     elmo-mime-charset t))
 598
 599 (defun elmo-msgdb-finfo-save (finfo)
 600   (elmo-object-save (expand-file-name
 601                      elmo-msgdb-finfo-filename
 602                      elmo-msgdb-dir)
 603                     finfo elmo-mime-charset))
 604
 605 (defun elmo-msgdb-flist-load (folder)
 606   (let ((flist-file (expand-file-name
 607                      elmo-msgdb-flist-filename
 608                      (elmo-msgdb-expand-path folder (list 'folder folder)))))
 609     (elmo-object-load flist-file nil t)))
 610
 611 (defun elmo-msgdb-flist-save (folder flist)
 612   (let ((flist-file (expand-file-name
 613                      elmo-msgdb-flist-filename
 614                      (elmo-msgdb-expand-path folder (list 'folder folder)))))
 615     (elmo-object-save flist-file flist)))
 616
 617 (defun elmo-crosspost-alist-load ()
 618   (elmo-object-load (expand-file-name
 619                      elmo-crosspost-alist-filename
 620                      elmo-msgdb-dir)
 621                     nil t))
 622
 623 (defun elmo-crosspost-alist-save (alist)
 624   (elmo-object-save (expand-file-name
 625                      elmo-crosspost-alist-filename
 626                      elmo-msgdb-dir)
 627                     alist))
 628
 629 (defsubst elmo-msgdb-create-overview-from-buffer (number &optional size time)
 630   "Create overview entity from current buffer.
 631 Header region is supposed to be narrowed."
 632   (save-excursion
 633     (let ((extras elmo-msgdb-extra-fields)
 634           message-id references from subject to cc date
 635           extra field-body)
 636       (elmo-set-buffer-multibyte default-enable-multibyte-characters)
 637       (setq message-id (elmo-field-body "message-id"))
 638       (setq references
 639             (or (elmo-msgdb-get-last-message-id
 640                  (elmo-field-body "in-reply-to"))
 641                 (elmo-msgdb-get-last-message-id
 642                  (elmo-field-body "references"))))
 643       (setq from (elmo-mime-string (elmo-delete-char
 644                                     ?\"
 645                                     (or
 646                                      (elmo-field-body "from")
 647                                      elmo-no-from))))
 648       (setq subject (elmo-mime-string (or (elmo-field-body "subject")
 649                                           elmo-no-subject)))
 650       (setq date (or (elmo-field-body "date") time))
 651       (setq to   (mapconcat 'identity (elmo-multiple-field-body "to") ","))
 652       (setq cc   (mapconcat 'identity (elmo-multiple-field-body "cc") ","))
 653       (or size
 654           (if (setq size (elmo-field-body "content-length"))
 655               (setq size (string-to-int size))
 656             (setq size 0)));; No mean...
 657       (while extras
 658         (if (setq field-body (elmo-field-body (car extras)))
 659             (setq extra (cons (cons (downcase (car extras))
 660                                     field-body) extra)))
 661         (setq extras (cdr extras)))
 662       (cons message-id (vector number references
 663                                from subject date to cc
 664                                size extra))
 665       )))
 666
 667 (defun elmo-msgdb-overview-sort-by-date (overview)
 668   (sort overview
 669         (function
 670          (lambda (x y)
 671            (condition-case nil
 672                (string<
 673                 (timezone-make-date-sortable
 674                  (elmo-msgdb-overview-entity-get-date x))
 675                 (timezone-make-date-sortable
 676                  (elmo-msgdb-overview-entity-get-date y)))
 677              (error))))))
 678
 679 (defun elmo-msgdb-sort-by-date (msgdb)
 680   (message "Sorting...")
 681   (let ((overview (elmo-msgdb-get-overview msgdb)))
 682     (setq overview (elmo-msgdb-overview-sort-by-date overview))
 683     (message "Sorting...done.")
 684     (list overview (nth 1 msgdb)(nth 2 msgdb)(nth 3 msgdb))))
 685
 686 (defsubst elmo-msgdb-search-overview-entity (number number-alist overview)
 687   (let ((message-id (cdr (assq number number-alist)))
 688         ovs)
 689     (if message-id
 690         (assoc message-id overview)
 691       (elmo-msgdb-overview-get-entity-by-number overview number))))
 692
 693 (defsubst elmo-msgdb-append (msgdb msgdb-append)
 694   (list
 695    (nconc (car msgdb) (car msgdb-append))
 696    (nconc (cadr msgdb) (cadr msgdb-append))
 697    (nconc (caddr msgdb) (caddr msgdb-append))
 698    (nconc (cadddr msgdb) (cadddr msgdb-append))))
 699
 700 (defun elmo-msgdb-delete-path (folder &optional spec)
 701   (let ((path (elmo-msgdb-expand-path folder spec)))
 702     (if (file-directory-p path)
 703         (elmo-delete-directory path t))))
 704
 705 (defun elmo-msgdb-rename-path (old-folder new-folder &optional old-spec new-spec)
 706   (let* ((old (directory-file-name (elmo-msgdb-expand-path old-folder old-spec)))
 707          (new (directory-file-name (elmo-msgdb-expand-path new-folder new-spec)))
 708          (new-dir (directory-file-name (file-name-directory new))))
 709     (if (not (file-directory-p old))
 710         ()
 711       (if (file-exists-p new)
 712           (error "already exists directory: %s" new)
 713         (if (not (file-exists-p new-dir))
 714             (elmo-make-directory new-dir))
 715         (rename-file old new)))))
 716
 717 (provide 'elmo-msgdb)
 718
 719 ;;; elmo-msgdb.el ends here