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      ((member key elmo-msgdb-extra-fields)
 455       (let ((extval (elmo-msgdb-overview-entity-get-extra-field entity key)))
 456         (if (stringp extval)
 457             (setq result (string-match
 458                           (elmo-filter-value condition)
 459                           extval))))))
 460     (if (eq (elmo-filter-type condition) 'unmatch)
 461         (setq result (not result)))
 462     result))
 463
 464 (defun elmo-msgdb-search-internal (condition entity number-list)
 465   (cond
 466    ((vectorp condition)
 467     (elmo-msgdb-search-internal-primitive condition entity number-list))
 468    ((eq (car condition) 'and)
 469     (and (elmo-msgdb-search-internal-primitive
 470           (nth 1 condition) entity number-list)
 471          (elmo-msgdb-search-internal-primitive
 472           (nth 2 condition) entity number-list)))
 473    ((eq (car condition) 'or)
 474     (or (elmo-msgdb-search-internal-primitive
 475          (nth 1 condition) entity number-list)
 476         (elmo-msgdb-search-internal-primitive
 477          (nth 2 condition) entity number-list)))))
 478
 479 (defun elmo-msgdb-delete-msgs (folder msgs msgdb &optional reserve-cache)
 480   "Delete MSGS from FOLDER in MSGDB.
 481 content of MSGDB is changed."
 482   (save-excursion
 483     (let* ((msg-list msgs)
 484            (dir (elmo-msgdb-expand-path folder))
 485            (overview (or (car msgdb)
 486                          (elmo-msgdb-overview-load dir)))
 487            (number-alist (or (cadr msgdb)
 488                              (elmo-msgdb-number-load dir)))
 489            (mark-alist (or (caddr msgdb)
 490                            (elmo-msgdb-mark-load dir)))
 491            (loc-alist (or (elmo-msgdb-get-location msgdb)
 492                           (elmo-msgdb-location-load dir)))
 493            (hashtb (or (elmo-msgdb-get-overviewht msgdb)
 494                        (elmo-msgdb-make-overview-hashtb overview)))
 495            (newmsgdb (list overview number-alist mark-alist (nth 3 msgdb) hashtb))
 496            ov-entity message-id)
 497       ;; remove from current database.
 498       (while msg-list
 499         (setq message-id (cdr (assq (car msg-list) number-alist)))
 500         (if (and (not reserve-cache) message-id)
 501             (elmo-cache-delete message-id
 502                                folder (car msg-list)))
 503 ;;;     This is no good!!!!
 504 ;;;     (setq overview (delete (assoc message-id overview) overview))
 505         (setq overview
 506               (delq
 507                (setq ov-entity
 508                      (elmo-msgdb-overview-get-entity (car msg-list) newmsgdb))
 509                overview))
 510         (when (and elmo-use-overview-hashtb hashtb)
 511           (elmo-msgdb-clear-overview-hashtb ov-entity hashtb))
 512         (setq number-alist
 513               (delq (assq (car msg-list) number-alist) number-alist))
 514         (setq mark-alist (delq (assq (car msg-list) mark-alist) mark-alist))
 515         (setq loc-alist (delq (assq (car msg-list) loc-alist) loc-alist))
 516         ;; XXX Should consider when folder is not persistent.
 517         ;; (elmo-msgdb-location-save dir loc-alist)
 518         (setq msg-list (cdr msg-list)))
 519       (setcar msgdb overview)
 520       (setcar (cdr msgdb) number-alist)
 521       (setcar (cddr msgdb) mark-alist)
 522       (setcar (nthcdr 4 msgdb) hashtb))
 523     t)) ;return value
 524
 525 (defsubst elmo-msgdb-set-overview (msgdb overview)
 526   (setcar msgdb overview))
 527
 528 (defsubst elmo-msgdb-set-number-alist (msgdb number-alist)
 529   (setcar (cdr msgdb) number-alist))
 530
 531 (defsubst elmo-msgdb-set-mark-alist (msgdb mark-alist)
 532   (setcar (cddr msgdb) mark-alist))
 533
 534 (defsubst elmo-msgdb-overview-entity-get-references (entity)
 535   (and entity (aref (cdr entity) 1)))
 536
 537 ;; entity -> parent-entity
 538 (defsubst elmo-msgdb-overview-get-parent-entity (entity database)
 539   (setq entity (elmo-msgdb-overview-entity-get-references entity))
 540   ;; entity is parent-id.
 541   (and entity (assoc entity database)))
 542
 543 (defsubst elmo-msgdb-overview-entity-get-number (entity)
 544   (and entity (aref (cdr entity) 0)))
 545
 546 (defsubst elmo-msgdb-overview-entity-get-from-no-decode (entity)
 547   (and entity (aref (cdr entity) 2)))
 548
 549 (defsubst elmo-msgdb-overview-entity-get-from (entity)
 550   (and entity
 551        (aref (cdr entity) 2)
 552        (elmo-msgdb-get-decoded-cache (aref (cdr entity) 2))))
 553
 554 (defsubst elmo-msgdb-overview-entity-set-number (entity number)
 555   (and entity (aset (cdr entity) 0 number))
 556   entity)
 557 ;;;(setcar (cadr entity) number) entity)
 558
 559 (defsubst elmo-msgdb-overview-entity-set-from (entity from)
 560   (and entity (aset (cdr entity) 2 from))
 561   entity)
 562
 563 (defsubst elmo-msgdb-overview-entity-get-subject (entity)
 564   (and entity
 565        (aref (cdr entity) 3)
 566        (elmo-msgdb-get-decoded-cache (aref (cdr entity) 3))))
 567
 568 (defsubst elmo-msgdb-overview-entity-get-subject-no-decode (entity)
 569   (and entity (aref (cdr entity) 3)))
 570
 571 (defsubst elmo-msgdb-overview-entity-set-subject (entity subject)
 572   (and entity (aset (cdr entity) 3 subject))
 573   entity)
 574
 575 (defsubst elmo-msgdb-overview-entity-get-date (entity)
 576   (and entity (aref (cdr entity) 4)))
 577
 578 (defsubst elmo-msgdb-overview-entity-get-to (entity)
 579   (and entity (aref (cdr entity) 5)))
 580
 581 (defsubst elmo-msgdb-overview-entity-get-cc (entity)
 582   (and entity (aref (cdr entity) 6)))
 583
 584 (defsubst elmo-msgdb-overview-entity-get-size (entity)
 585   (and entity (aref (cdr entity) 7)))
 586
 587 (defsubst elmo-msgdb-overview-entity-set-size (entity size)
 588   (and entity (aset (cdr entity) 7 size))
 589   entity)
 590
 591 (defsubst elmo-msgdb-overview-entity-get-id (entity)
 592   (and entity (car entity)))
 593
 594 (defsubst elmo-msgdb-overview-entity-get-extra-field (entity field-name)
 595   (let ((extra (and entity (aref (cdr entity) 8))))
 596     (and extra
 597          (cdr (assoc field-name extra)))))
 598
 599 (defun elmo-msgdb-overview-get-entity-by-number (database number)
 600   (when number
 601     (let ((db database)
 602           entity)
 603       (while db
 604         (if (eq (elmo-msgdb-overview-entity-get-number (car db)) number)
 605             (setq entity (car db)
 606                   db nil) ; exit loop
 607           (setq db (cdr db))))
 608       entity)))
 609
 610 (defun elmo-msgdb-overview-get-entity (id msgdb)
 611   (when id
 612     (let ((ovht (elmo-msgdb-get-overviewht msgdb)))
 613       (if ovht ;; use overview hash
 614           (if (stringp id) ;; ID is message-id
 615               (elmo-get-hash-val id ovht)
 616             (elmo-get-hash-val (format "#%d" id) ovht))
 617         (let* ((overview (elmo-msgdb-get-overview msgdb))
 618                (number-alist (elmo-msgdb-get-number-alist msgdb))
 619                (message-id (if (stringp id)
 620                                id ;; ID is message-id
 621                              (cdr (assq id number-alist))))
 622                entity)
 623           (if message-id
 624               (assoc message-id overview)
 625             ;; ID is number. message-id is nil or no exists in number-alist.
 626             (elmo-msgdb-overview-get-entity-by-number overview id)))))))
 627
 628 ;;
 629 ;; deleted message handling
 630 ;;
 631 (defun elmo-msgdb-killed-list-load (dir)
 632   (elmo-object-load
 633    (expand-file-name elmo-msgdb-killed-filename dir)
 634    nil t))
 635
 636 (defun elmo-msgdb-killed-list-save (dir killed-list)
 637   (elmo-object-save
 638    (expand-file-name elmo-msgdb-killed-filename dir)
 639    killed-list))
 640
 641 (defun elmo-msgdb-killed-message-p (killed-list msg)
 642   (elmo-number-set-member msg killed-list))
 643
 644 (defun elmo-msgdb-set-as-killed (killed-list msg)
 645   (elmo-number-set-append killed-list msg))
 646
 647 (defun elmo-msgdb-append-to-killed-list (folder msgs)
 648   (let ((dir (elmo-msgdb-expand-path folder)))
 649     (elmo-msgdb-killed-list-save
 650      dir
 651      (elmo-number-set-append-list
 652       (elmo-msgdb-killed-list-load dir)
 653       msgs))))
 654
 655 (defun elmo-msgdb-killed-list-length (killed-list)
 656   (let ((killed killed-list)
 657         (ret-val 0))
 658     (while (car killed)
 659       (if (consp (car killed))
 660           (setq ret-val (+ ret-val 1 (- (cdar killed) (caar killed))))
 661         (setq ret-val (+ ret-val 1)))
 662       (setq killed (cdr killed)))
 663     ret-val))
 664
 665 (defun elmo-living-messages (messages killed-list)
 666   (if killed-list
 667       (delq nil
 668             (mapcar (lambda (number)
 669                       (unless (elmo-number-set-member number killed-list)
 670                         number))
 671                     messages))
 672     messages))
 673
 674 (defun elmo-msgdb-finfo-load ()
 675   (elmo-object-load (expand-file-name
 676                      elmo-msgdb-finfo-filename
 677                      elmo-msgdb-dir)
 678                     elmo-mime-charset t))
 679
 680 (defun elmo-msgdb-finfo-save (finfo)
 681   (elmo-object-save (expand-file-name
 682                      elmo-msgdb-finfo-filename
 683                      elmo-msgdb-dir)
 684                     finfo elmo-mime-charset))
 685
 686 (defun elmo-msgdb-flist-load (folder)
 687   (let ((flist-file (expand-file-name
 688                      elmo-msgdb-flist-filename
 689                      (elmo-msgdb-expand-path (list 'folder folder)))))
 690     (elmo-object-load flist-file nil t)))
 691
 692 (defun elmo-msgdb-flist-save (folder flist)
 693   (let ((flist-file (expand-file-name
 694                      elmo-msgdb-flist-filename
 695                      (elmo-msgdb-expand-path (list 'folder folder)))))
 696     (elmo-object-save flist-file flist)))
 697
 698 (defun elmo-crosspost-alist-load ()
 699   (elmo-object-load (expand-file-name
 700                      elmo-crosspost-alist-filename
 701                      elmo-msgdb-dir)
 702                     nil t))
 703
 704 (defun elmo-crosspost-alist-save (alist)
 705   (elmo-object-save (expand-file-name
 706                      elmo-crosspost-alist-filename
 707                      elmo-msgdb-dir)
 708                     alist))
 709
 710 (defsubst elmo-msgdb-create-overview-from-buffer (number &optional size time)
 711   "Create overview entity from current buffer.
 712 Header region is supposed to be narrowed."
 713   (save-excursion
 714     (let ((extras elmo-msgdb-extra-fields)
 715           message-id references from subject to cc date
 716           extra field-body)
 717       (elmo-set-buffer-multibyte default-enable-multibyte-characters)
 718       (setq message-id (elmo-field-body "message-id"))
 719       (setq references
 720             (or (elmo-msgdb-get-last-message-id
 721                  (elmo-field-body "in-reply-to"))
 722                 (elmo-msgdb-get-last-message-id
 723                  (elmo-field-body "references"))))
 724       (setq from (elmo-mime-string (elmo-delete-char
 725                                     ?\"
 726                                     (or
 727                                      (elmo-field-body "from")
 728                                      elmo-no-from))))
 729       (setq subject (elmo-mime-string (or (elmo-field-body "subject")
 730                                           elmo-no-subject)))
 731       (setq date (or (elmo-field-body "date") time))
 732       (setq to   (mapconcat 'identity (elmo-multiple-field-body "to") ","))
 733       (setq cc   (mapconcat 'identity (elmo-multiple-field-body "cc") ","))
 734       (or size
 735           (if (setq size (elmo-field-body "content-length"))
 736               (setq size (string-to-int size))
 737             (setq size 0)));; No mean...
 738       (while extras
 739         (if (setq field-body (elmo-field-body (car extras)))
 740             (setq extra (cons (cons (downcase (car extras))
 741                                     field-body) extra)))
 742         (setq extras (cdr extras)))
 743       (cons message-id (vector number references
 744                                from subject date to cc
 745                                size extra))
 746       )))
 747
 748 (defun elmo-msgdb-overview-sort-by-date (overview)
 749   (sort overview
 750         (function
 751          (lambda (x y)
 752            (condition-case nil
 753                (string<
 754                 (timezone-make-date-sortable
 755                  (elmo-msgdb-overview-entity-get-date x))
 756                 (timezone-make-date-sortable
 757                  (elmo-msgdb-overview-entity-get-date y)))
 758              (error))))))
 759
 760 (defun elmo-msgdb-sort-by-date (msgdb)
 761   (message "Sorting...")
 762   (let ((overview (elmo-msgdb-get-overview msgdb)))
 763     (setq overview (elmo-msgdb-overview-sort-by-date overview))
 764     (message "Sorting...done")
 765     (list overview (nth 1 msgdb)(nth 2 msgdb)(nth 3 msgdb)(nth 4 msgdb))))
 766
 767 (defun elmo-msgdb-clear-overview-hashtb (entity hashtb)
 768   (let (number)
 769     (when (and entity
 770                elmo-use-overview-hashtb
 771                hashtb)
 772       (and (setq number (elmo-msgdb-overview-entity-get-number entity))
 773            (elmo-clear-hash-val (format "#%d" number) hashtb))
 774       (and (car entity) ;; message-id
 775            (elmo-clear-hash-val (car entity) hashtb)))))
 776
 777 (defun elmo-msgdb-make-overview-hashtb (overview &optional hashtb)
 778   (if elmo-use-overview-hashtb
 779       (let ((hashtb (or hashtb ;; append
 780                         (elmo-make-hash (length overview)))))
 781         (while overview
 782           ;; key is message-id
 783           (if (caar overview)
 784               (elmo-set-hash-val (caar overview) (car overview) hashtb))
 785           ;; key is number
 786           (elmo-set-hash-val
 787            (format "#%d" (elmo-msgdb-overview-entity-get-number (car overview)))
 788            (car overview) hashtb)
 789           (setq overview (cdr overview)))
 790         hashtb)
 791     nil))
 792
 793 (defsubst elmo-msgdb-append (msgdb msgdb-append &optional set-hash)
 794   (list
 795    (nconc (car msgdb) (car msgdb-append))
 796    (nconc (cadr msgdb) (cadr msgdb-append))
 797    (nconc (caddr msgdb) (caddr msgdb-append))
 798    (nconc (cadddr msgdb) (cadddr msgdb-append))
 799    (and set-hash
 800         (elmo-msgdb-make-overview-hashtb (car msgdb-append) (nth 4 msgdb)))))
 801
 802 (defsubst elmo-msgdb-clear (&optional msgdb)
 803   (if msgdb
 804       (list
 805        (setcar msgdb nil)
 806        (setcar (cdr msgdb) nil)
 807        (setcar (cddr msgdb) nil)
 808        (setcar (cdddr msgdb) nil)
 809        (setcar (nthcdr 4 msgdb) (elmo-msgdb-make-overview-hashtb nil)))
 810     (list nil nil nil nil (elmo-msgdb-make-overview-hashtb nil))))
 811
 812 (defun elmo-msgdb-delete-path (folder &optional spec)
 813   (let ((path (elmo-msgdb-expand-path (or spec folder))))
 814     (if (file-directory-p path)
 815         (elmo-delete-directory path t))))
 816
 817 (defun elmo-msgdb-rename-path (old-folder new-folder &optional old-spec new-spec)
 818   (let* ((old (directory-file-name (elmo-msgdb-expand-path old-spec)))
 819          (new (directory-file-name (elmo-msgdb-expand-path new-spec)))
 820          (new-dir (directory-file-name (file-name-directory new))))
 821     (if (not (file-directory-p old))
 822         ()
 823       (if (file-exists-p new)
 824           (error "Already exists directory: %s" new)
 825         (if (not (file-exists-p new-dir))
 826             (elmo-make-directory new-dir))
 827         (rename-file old new)))))
 828
 829 (require 'product)
 830 (product-provide (provide 'elmo-msgdb) (require 'elmo-version))
 831
 832 ;;; elmo-msgdb.el ends here