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