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