elmo/elmo-msgdb.el

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