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