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 'mime)
  40 (require 'modb)
  41
  42 ;;; MSGDB interface.
  43 ;;
  44 ;; MSGDB elmo-load-msgdb PATH MIME-CHARSET
  45 ;; MSGDB elmo-make-msgdb LOCATION TYPE
  46 ;; elmo-msgdb-sort-by-date MSGDB
  47
  48 ;; elmo-flag-table-load
  49 ;; elmo-flag-table-set
  50 ;; elmo-flag-table-get
  51 ;; elmo-flag-table-save
  52
  53 ;; elmo-msgdb-overview-save DIR OBJ
  54
  55 ;;; Abolish
  56 ;; elmo-msgdb-get-parent-entity ENTITY MSGDB
  57
  58 ;; elmo-msgdb-killed-list-load DIR
  59 ;; elmo-msgdb-killed-list-save DIR
  60 ;; elmo-msgdb-append-to-killed-list FOLDER MSG
  61 ;; elmo-msgdb-killed-list-length KILLED-LIST
  62 ;; elmo-msgdb-max-of-killed KILLED-LIST
  63 ;; elmo-msgdb-killed-message-p KILLED-LIST MSG
  64 ;; elmo-living-messages MESSAGES KILLED-LIST
  65
  66 ;; elmo-msgdb-finfo-load
  67 ;; elmo-msgdb-finfo-save
  68 ;; elmo-msgdb-flist-load
  69 ;; elmo-msgdb-flist-save
  70
  71 ;; elmo-crosspost-alist-load
  72 ;; elmo-crosspost-alist-save
  73
  74 ;; elmo-folder-get-info
  75 ;; elmo-folder-get-info-max
  76 ;; elmo-folder-get-info-length
  77 ;; elmo-folder-get-info-unread
  78
  79 ;;; message entity wrappers
  80 ;;
  81 (defsubst elmo-message-entity-number (entity)
  82   (elmo-msgdb-message-entity-number (elmo-message-entity-handler entity)
  83                                     entity))
  84
  85 (defsubst elmo-message-entity-set-number (entity number)
  86   (elmo-msgdb-message-entity-set-number (elmo-message-entity-handler entity)
  87                                         entity
  88                                         number))
  89
  90 (defsubst elmo-message-entity-field (entity field &optional type)
  91   "Get message entity field value.
  92 ENTITY is the message entity structure obtained by `elmo-message-entity'.
  93 FIELD is the symbol of the field name.
  94 If optional argument TYPE is specified, return converted value."
  95   (elmo-msgdb-message-entity-field (elmo-message-entity-handler entity)
  96                                    entity field type))
  97
  98 (defsubst elmo-message-entity-set-field (entity field value)
  99   "Set message entity field value.
 100 ENTITY is the message entity structure.
 101 FIELD is the symbol of the field name.
 102 VALUE is the field value."
 103   (elmo-msgdb-message-entity-set-field (elmo-message-entity-handler entity)
 104                                        entity field value))
 105
 106 (defconst elmo-msgdb-load-priorities '(legacy standard)
 107   "Priority list of modb type for load.")
 108
 109 ;;; Helper functions for MSGDB
 110 ;;
 111 (defun elmo-load-msgdb (location mime-charset)
 112   "Load the MSGDB from PATH."
 113   (let ((msgdb (elmo-make-msgdb location elmo-msgdb-default-type mime-charset))
 114         priorities loaded temp-modb)
 115     (unless (elmo-msgdb-load msgdb)
 116       (setq priorities
 117             (delq elmo-msgdb-default-type
 118                   (copy-sequence elmo-msgdb-load-priorities)))
 119       (while (and priorities
 120                   (not loaded))
 121         (setq temp-modb (elmo-make-msgdb location
 122                                          (car priorities)
 123                                          mime-charset)
 124               loaded (elmo-msgdb-load temp-modb)
 125               priorities (cdr priorities)))
 126       (when loaded
 127         (if (eq elmo-msgdb-convert-type 'auto)
 128             (elmo-msgdb-append msgdb temp-modb)
 129           (setq msgdb temp-modb))))
 130     msgdb))
 131
 132 (defun elmo-make-msgdb (&optional location type mime-charset)
 133   "Make a MSGDB."
 134   (let* ((type (or type elmo-msgdb-default-type))
 135          (class (intern (format "modb-%s" type))))
 136     (require class)
 137     (luna-make-entity class
 138                       :location location
 139                       :mime-charset mime-charset)))
 140
 141 (defun elmo-msgdb-sort-by-date (msgdb)
 142   (elmo-msgdb-sort-entities
 143    msgdb
 144    (lambda (x y app-data)
 145      (condition-case nil
 146          (elmo-time<
 147           (elmo-message-entity-field x 'date)
 148           (elmo-message-entity-field y 'date))
 149        (error)))))
 150
 151 (defsubst elmo-msgdb-get-parent-entity (entity msgdb)
 152   (setq entity (elmo-message-entity-field entity 'references))
 153   ;; entity is parent-id.
 154   (and entity (elmo-msgdb-message-entity msgdb entity)))
 155
 156 ;;;
 157 (defsubst elmo-msgdb-append-element (list element)
 158   (if list
 159 ;;;   (append list (list element))
 160       (nconc list (list element))
 161     ;; list is nil
 162     (list element)))
 163
 164 ;;
 165 ;; number <-> Message-ID handling
 166 ;;
 167 (defsubst elmo-msgdb-number-add (alist number id)
 168   (let ((ret-val alist))
 169     (setq ret-val
 170           (elmo-msgdb-append-element ret-val (cons number id)))
 171     ret-val))
 172
 173 ;;; flag table
 174 ;;
 175 (defvar elmo-flag-table-filename "flag-table")
 176 (defun elmo-flag-table-load (dir)
 177   "Load flag hashtable for MSGDB."
 178   (let ((table (elmo-make-hash))
 179         ;; For backward compatibility
 180         (seen-file (expand-file-name elmo-msgdb-seen-filename dir))
 181         value)
 182     (when (file-exists-p seen-file)
 183       (dolist (msgid (elmo-object-load seen-file))
 184         (elmo-set-hash-val msgid '(read) table))
 185       (delete-file seen-file))
 186     (dolist (pair (elmo-object-load
 187                    (expand-file-name elmo-flag-table-filename dir)))
 188       (setq value (cdr pair))
 189       (elmo-set-hash-val (car pair)
 190                          (cond ((consp value)
 191                                 value)
 192                                ;; Following cases for backward compatibility.
 193                                (value
 194                                 (list value))
 195                                (t
 196                                 '(unread)))
 197                          table))
 198     table))
 199
 200 (defun elmo-flag-table-set (flag-table msg-id flags)
 201   (elmo-set-hash-val msg-id (or flags '(read)) flag-table))
 202
 203 (defun elmo-flag-table-get (flag-table msg-id)
 204   (let ((flags (elmo-get-hash-val msg-id flag-table)))
 205     (append
 206      (and (elmo-file-cache-exists-p msg-id)
 207           '(cached))
 208      (if flags
 209          (elmo-list-delete '(cached read)
 210                            (copy-sequence flags)
 211                            #'delq)
 212        '(new unread)))))
 213
 214 (defun elmo-flag-table-save (dir flag-table)
 215   (elmo-object-save
 216    (expand-file-name elmo-flag-table-filename dir)
 217    (if flag-table
 218        (let (list)
 219          (mapatoms (lambda (atom)
 220                      (setq list (cons (cons (symbol-name atom)
 221                                             (symbol-value atom))
 222                                       list)))
 223                    flag-table)
 224          list))))
 225 ;;;
 226 ;; persistent mark handling
 227 ;; (for each folder)
 228
 229 (defun elmo-msgdb-mark-append (alist id mark)
 230   "Append mark."
 231   (setq alist (elmo-msgdb-append-element alist
 232                                          (list id mark))))
 233
 234 (defun elmo-msgdb-flag-table (msgdb &optional flag-table)
 235   ;; Make a table of msgid flag (read, answered)
 236   (let ((flag-table (or flag-table
 237                         (elmo-make-hash (elmo-msgdb-length msgdb))))
 238         msg-id)
 239     (dolist (number (elmo-msgdb-list-messages msgdb))
 240       (when (setq msg-id (elmo-msgdb-message-field msgdb number 'message-id))
 241         (elmo-flag-table-set flag-table
 242                              msg-id
 243                              (elmo-msgdb-flags msgdb number))))
 244     flag-table))
 245
 246 (defun elmo-multiple-fields-body-list (field-names &optional boundary)
 247   "Return list of each field-bodies of FIELD-NAMES of the message header
 248 in current buffer. If BOUNDARY is not nil, it is used as message
 249 header separator."
 250   (save-excursion
 251     (save-restriction
 252       (std11-narrow-to-header boundary)
 253       (let* ((case-fold-search t)
 254              (s-rest field-names)
 255              field-name field-body)
 256         (while (setq field-name (car s-rest))
 257           (goto-char (point-min))
 258           (while (re-search-forward (concat "^" field-name ":[ \t]*") nil t)
 259             (setq field-body
 260                   (nconc field-body
 261                          (list (buffer-substring-no-properties
 262                                 (match-end 0) (std11-field-end))))))
 263           (setq s-rest (cdr s-rest)))
 264         field-body))))
 265
 266 (defsubst elmo-msgdb-remove-field-string (string)
 267   (if (string-match (concat std11-field-head-regexp "[ \t]*") string)
 268       (substring string (match-end 0))
 269     string))
 270
 271 (defsubst elmo-msgdb-seen-load (dir)
 272   (elmo-object-load (expand-file-name
 273                      elmo-msgdb-seen-filename
 274                      dir)))
 275
 276 (defsubst elmo-msgdb-out-of-date-messages (msgdb)
 277   (dolist (number (elmo-msgdb-list-flagged msgdb 'new))
 278     (elmo-msgdb-unset-flag msgdb number 'new)))
 279
 280 ;;
 281 ;; deleted message handling
 282 ;;
 283 (defun elmo-msgdb-killed-list-load (dir)
 284   (elmo-object-load
 285    (expand-file-name elmo-msgdb-killed-filename dir)
 286    nil t))
 287
 288 (defun elmo-msgdb-killed-list-save (dir killed-list)
 289   (elmo-object-save
 290    (expand-file-name elmo-msgdb-killed-filename dir)
 291    killed-list))
 292
 293 (defun elmo-msgdb-killed-message-p (killed-list msg)
 294   (elmo-number-set-member msg killed-list))
 295
 296 (defun elmo-msgdb-set-as-killed (killed-list msg)
 297   (elmo-number-set-append killed-list msg))
 298
 299 (defun elmo-msgdb-killed-list-length (killed-list)
 300   (let ((killed killed-list)
 301         (ret-val 0))
 302     (while (car killed)
 303       (if (consp (car killed))
 304           (setq ret-val (+ ret-val 1 (- (cdar killed) (caar killed))))
 305         (setq ret-val (+ ret-val 1)))
 306       (setq killed (cdr killed)))
 307     ret-val))
 308
 309 (defun elmo-msgdb-max-of-killed (killed-list)
 310   (let ((klist killed-list)
 311         (max 0)
 312         k)
 313     (while (car klist)
 314       (if (< max
 315              (setq k
 316                    (if (consp (car klist))
 317                        (cdar klist)
 318                      (car klist))))
 319           (setq max k))
 320       (setq klist (cdr klist)))
 321     max))
 322
 323 (defun elmo-living-messages (messages killed-list)
 324   (if killed-list
 325       (delq nil
 326             (mapcar (lambda (number)
 327                       (unless (elmo-number-set-member number killed-list)
 328                         number))
 329                     messages))
 330     messages))
 331
 332 (defun elmo-msgdb-finfo-load ()
 333   (elmo-object-load (expand-file-name
 334                      elmo-msgdb-finfo-filename
 335                      elmo-msgdb-directory)
 336                     elmo-mime-charset t))
 337
 338 (defun elmo-msgdb-finfo-save (finfo)
 339   (elmo-object-save (expand-file-name
 340                      elmo-msgdb-finfo-filename
 341                      elmo-msgdb-directory)
 342                     finfo elmo-mime-charset))
 343
 344 (defun elmo-msgdb-flist-load (fname)
 345   (let ((flist-file (expand-file-name
 346                      elmo-msgdb-flist-filename
 347                      (expand-file-name
 348                       (elmo-safe-filename fname)
 349                       (expand-file-name "folder" elmo-msgdb-directory)))))
 350     (elmo-object-load flist-file elmo-mime-charset t)))
 351
 352 (defun elmo-msgdb-flist-save (fname flist)
 353   (let ((flist-file (expand-file-name
 354                      elmo-msgdb-flist-filename
 355                      (expand-file-name
 356                       (elmo-safe-filename fname)
 357                       (expand-file-name "folder" elmo-msgdb-directory)))))
 358     (elmo-object-save flist-file flist elmo-mime-charset)))
 359
 360 (defun elmo-crosspost-alist-load ()
 361   (elmo-object-load (expand-file-name
 362                      elmo-crosspost-alist-filename
 363                      elmo-msgdb-directory)
 364                     nil t))
 365
 366 (defun elmo-crosspost-alist-save (alist)
 367   (elmo-object-save (expand-file-name
 368                      elmo-crosspost-alist-filename
 369                      elmo-msgdb-directory)
 370                     alist))
 371
 372 (defsubst elmo-folder-get-info (folder &optional hashtb)
 373   (elmo-get-hash-val folder
 374                      (or hashtb elmo-folder-info-hashtb)))
 375
 376 (defun elmo-folder-get-info-max (folder)
 377   "Get folder info from cache."
 378   (nth 3 (elmo-folder-get-info folder)))
 379
 380 (defun elmo-folder-get-info-length (folder)
 381   (nth 2 (elmo-folder-get-info folder)))
 382
 383 (defun elmo-folder-get-info-unread (folder)
 384   (nth 1 (elmo-folder-get-info folder)))
 385
 386 (defsubst elmo-msgdb-location-load (dir)
 387   (elmo-object-load
 388    (expand-file-name
 389     elmo-msgdb-location-filename
 390     dir)))
 391
 392 (defsubst elmo-msgdb-location-add (alist number location)
 393   (let ((ret-val alist))
 394     (setq ret-val
 395           (elmo-msgdb-append-element ret-val (cons number location)))
 396     ret-val))
 397
 398 (defsubst elmo-msgdb-location-save (dir alist)
 399   (elmo-object-save
 400    (expand-file-name
 401     elmo-msgdb-location-filename
 402     dir) alist))
 403
 404 ;;; For backward compatibility.
 405 (defsubst elmo-msgdb-overview-entity-get-number (entity)
 406   (elmo-message-entity-number entity))
 407
 408 (defsubst elmo-msgdb-overview-entity-set-number (entity number)
 409   (elmo-message-entity-set-number entity number))
 410
 411 (defsubst elmo-msgdb-overview-entity-get-references (entity)
 412   (elmo-message-entity-field entity 'references))
 413
 414 (defsubst elmo-msgdb-overview-entity-set-references (entity references)
 415   (elmo-message-entity-set-field entity 'references references))
 416
 417 (defsubst elmo-msgdb-overview-entity-get-from-no-decode (entity)
 418   (elmo-with-enable-multibyte
 419     (encode-mime-charset-string
 420      (elmo-message-entity-field entity 'from) elmo-mime-charset)))
 421
 422 (defsubst elmo-msgdb-overview-entity-get-from (entity)
 423   (elmo-message-entity-field entity 'from))
 424
 425 (defsubst elmo-msgdb-overview-entity-set-from (entity from)
 426   (elmo-message-entity-set-field entity 'from from))
 427
 428 (defsubst elmo-msgdb-overview-entity-get-subject (entity)
 429   (elmo-message-entity-field entity 'subject))
 430
 431 (defsubst elmo-msgdb-overview-entity-get-subject-no-decode (entity)
 432   (elmo-with-enable-multibyte
 433     (encode-mime-charset-string
 434      (elmo-message-entity-field entity 'subject) elmo-mime-charset)))
 435
 436 (defsubst elmo-msgdb-overview-entity-set-subject (entity subject)
 437   (elmo-message-entity-set-field entity 'subject subject))
 438
 439 (defsubst elmo-msgdb-overview-entity-get-date (entity)
 440   (elmo-message-entity-field entity 'date 'string))
 441
 442 (defsubst elmo-msgdb-overview-entity-set-date (entity date)
 443   (elmo-message-entity-set-field entity 'date date))
 444
 445 (defsubst elmo-msgdb-overview-entity-get-to (entity)
 446   (elmo-message-entity-field entity 'to 'string))
 447
 448 (defsubst elmo-msgdb-overview-entity-get-cc (entity)
 449   (elmo-message-entity-field entity 'cc 'string))
 450
 451 (defsubst elmo-msgdb-overview-entity-get-size (entity)
 452   (elmo-message-entity-field entity 'size))
 453
 454 (defsubst elmo-msgdb-overview-entity-set-size (entity size)
 455   (elmo-message-entity-set-field entity 'size size))
 456
 457 (defsubst elmo-msgdb-overview-entity-get-extra (entity)
 458   ;; Truely obsolete.
 459   )
 460
 461 (defsubst elmo-msgdb-overview-entity-set-extra (entity extra)
 462   ;; Truely obsolete.
 463   )
 464
 465 (defsubst elmo-msgdb-overview-entity-get-extra-field (entity
 466                                                       field-name)
 467   (elmo-message-entity-field entity (intern field-name)))
 468
 469 (defsubst elmo-msgdb-overview-entity-set-extra-field (entity
 470                                                       field-name
 471                                                       value)
 472   (elmo-message-entity-set-field entity (intern field-name) value))
 473
 474 (require 'product)
 475 (product-provide (provide 'elmo-msgdb) (require 'elmo-version))
 476
 477 ;;; elmo-msgdb.el ends here