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