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-extra-fields (&optional non-virtual)
 142   (if non-virtual
 143       (apply
 144        #'nconc
 145        (mapcar
 146         (lambda (extra)
 147           (let ((spec (assq (intern extra) modb-entity-field-extractor-alist)))
 148             (if spec
 149                 (let ((real-fields (nth 2 spec)))
 150                   (cond ((functionp real-fields)
 151                          (funcall real-fields extra))
 152                         ((listp real-fields)
 153                          (copy-sequence real-fields))))
 154               (list extra))))
 155         elmo-msgdb-extra-fields))
 156     elmo-msgdb-extra-fields))
 157
 158 (defun elmo-msgdb-sort-by-date (msgdb)
 159   (elmo-msgdb-sort-entities
 160    msgdb
 161    (lambda (x y app-data)
 162      (condition-case nil
 163          (elmo-time<
 164           (elmo-message-entity-field x 'date)
 165           (elmo-message-entity-field y 'date))
 166        (error)))))
 167
 168 (defsubst elmo-msgdb-get-parent-entity (entity msgdb)
 169   (setq entity (elmo-message-entity-field entity 'references))
 170   ;; entity is parent-id.
 171   (and entity (elmo-msgdb-message-entity msgdb entity)))
 172
 173 ;;;
 174 (defsubst elmo-msgdb-append-element (list element)
 175   (if list
 176 ;;;      (append list (list element))
 177       (nconc list (list element))
 178     ;; list is nil
 179     (list element)))
 180
 181 ;;
 182 ;; number <-> Message-ID handling
 183 ;;
 184 (defsubst elmo-msgdb-number-add (alist number id)
 185   (let ((ret-val alist))
 186     (setq ret-val
 187           (elmo-msgdb-append-element ret-val (cons number id)))
 188     ret-val))
 189
 190 ;;; flag table
 191 ;;
 192 (defvar elmo-flag-table-filename "flag-table")
 193 (defun elmo-flag-table-load (dir)
 194   "Load flag hashtable for MSGDB."
 195   (let ((table (elmo-make-hash))
 196         ;; For backward compatibility
 197         (seen-file (expand-file-name elmo-msgdb-seen-filename dir))
 198         value)
 199     (when (file-exists-p seen-file)
 200       (dolist (msgid (elmo-object-load seen-file))
 201         (elmo-set-hash-val msgid '(read) table))
 202       (delete-file seen-file))
 203     (dolist (pair (elmo-object-load
 204                    (expand-file-name elmo-flag-table-filename dir)))
 205       (setq value (cdr pair))
 206       (elmo-set-hash-val (car pair)
 207                          (cond ((consp value)
 208                                 value)
 209                                ;; Following cases for backward compatibility.
 210                                (value
 211                                 (list value))
 212                                (t
 213                                 '(unread)))
 214                          table))
 215     table))
 216
 217 (defun elmo-flag-table-set (flag-table msg-id flags)
 218   (elmo-set-hash-val msg-id (or flags '(read)) flag-table))
 219
 220 (defun elmo-flag-table-get (flag-table msg-id)
 221   (let ((flags (elmo-get-hash-val msg-id flag-table)))
 222     (append
 223      (and (elmo-file-cache-exists-p msg-id)
 224           '(cached))
 225      (if flags
 226          (elmo-list-delete '(cached read)
 227                            (copy-sequence flags)
 228                            #'delq)
 229        '(new unread)))))
 230
 231 (defun elmo-flag-table-save (dir flag-table)
 232   (elmo-object-save
 233    (expand-file-name elmo-flag-table-filename dir)
 234    (if flag-table
 235        (let (list)
 236          (mapatoms (lambda (atom)
 237                      (setq list (cons (cons (symbol-name atom)
 238                                             (symbol-value atom))
 239                                       list)))
 240                    flag-table)
 241          list))))
 242 ;;;
 243 ;; persistent mark handling
 244 ;; (for each folder)
 245
 246 (defun elmo-msgdb-mark-append (alist id mark)
 247   "Append mark."
 248   (setq alist (elmo-msgdb-append-element alist
 249                                          (list id mark))))
 250
 251 (defun elmo-msgdb-flag-table (msgdb &optional flag-table)
 252   ;; Make a table of msgid flag (read, answered)
 253   (let ((flag-table (or flag-table
 254                         (elmo-make-hash (elmo-msgdb-length msgdb))))
 255         msg-id)
 256     (dolist (number (elmo-msgdb-list-messages msgdb))
 257       (when (setq msg-id (elmo-msgdb-message-field msgdb number 'message-id))
 258         (elmo-flag-table-set flag-table
 259                              msg-id
 260                              (elmo-msgdb-flags msgdb number))))
 261     flag-table))
 262
 263 (defun elmo-multiple-fields-body-list (field-names &optional boundary)
 264   "Return list of each field-bodies of FIELD-NAMES of the message header
 265 in current buffer. If BOUNDARY is not nil, it is used as message
 266 header separator."
 267   (save-excursion
 268     (save-restriction
 269       (std11-narrow-to-header boundary)
 270       (let* ((case-fold-search t)
 271              (s-rest field-names)
 272              field-name field-body)
 273         (while (setq field-name (car s-rest))
 274           (goto-char (point-min))
 275           (while (re-search-forward (concat "^" field-name ":[ \t]*") nil t)
 276             (setq field-body
 277                   (nconc field-body
 278                          (list (buffer-substring-no-properties
 279                                 (match-end 0) (std11-field-end))))))
 280           (setq s-rest (cdr s-rest)))
 281         field-body))))
 282
 283 (defsubst elmo-msgdb-remove-field-string (string)
 284   (if (string-match (concat std11-field-head-regexp "[ \t]*") string)
 285       (substring string (match-end 0))
 286     string))
 287
 288 (defsubst elmo-msgdb-seen-load (dir)
 289   (elmo-object-load (expand-file-name
 290                      elmo-msgdb-seen-filename
 291                      dir)))
 292
 293 (defsubst elmo-msgdb-out-of-date-messages (msgdb)
 294   (dolist (number (elmo-msgdb-list-flagged msgdb 'new))
 295     (elmo-msgdb-unset-flag msgdb number 'new)))
 296
 297 ;;
 298 ;; deleted message handling
 299 ;;
 300 (defun elmo-msgdb-killed-list-load (dir)
 301   (elmo-object-load
 302    (expand-file-name elmo-msgdb-killed-filename dir)
 303    nil t))
 304
 305 (defun elmo-msgdb-killed-list-save (dir killed-list)
 306   (elmo-object-save
 307    (expand-file-name elmo-msgdb-killed-filename dir)
 308    killed-list))
 309
 310 (defun elmo-msgdb-killed-message-p (killed-list msg)
 311   (elmo-number-set-member msg killed-list))
 312
 313 (defun elmo-msgdb-set-as-killed (killed-list msg)
 314   (elmo-number-set-append killed-list msg))
 315
 316 (defun elmo-msgdb-killed-list-length (killed-list)
 317   (let ((killed killed-list)
 318         (ret-val 0))
 319     (while (car killed)
 320       (if (consp (car killed))
 321           (setq ret-val (+ ret-val 1 (- (cdar killed) (caar killed))))
 322         (setq ret-val (+ ret-val 1)))
 323       (setq killed (cdr killed)))
 324     ret-val))
 325
 326 (defun elmo-msgdb-max-of-killed (killed-list)
 327   (let ((klist killed-list)
 328         (max 0)
 329         k)
 330     (while (car klist)
 331       (if (< max
 332              (setq k
 333                    (if (consp (car klist))
 334                        (cdar klist)
 335                      (car klist))))
 336           (setq max k))
 337       (setq klist (cdr klist)))
 338     max))
 339
 340 (defun elmo-living-messages (messages killed-list)
 341   (if killed-list
 342       (delq nil
 343             (mapcar (lambda (number)
 344                       (unless (elmo-number-set-member number killed-list)
 345                         number))
 346                     messages))
 347     messages))
 348
 349 (defun elmo-msgdb-finfo-load ()
 350   (elmo-object-load (expand-file-name
 351                      elmo-msgdb-finfo-filename
 352                      elmo-msgdb-directory)
 353                     elmo-mime-charset t))
 354
 355 (defun elmo-msgdb-finfo-save (finfo)
 356   (elmo-object-save (expand-file-name
 357                      elmo-msgdb-finfo-filename
 358                      elmo-msgdb-directory)
 359                     finfo elmo-mime-charset))
 360
 361 (defun elmo-msgdb-flist-load (fname)
 362   (let ((flist-file (expand-file-name
 363                      elmo-msgdb-flist-filename
 364                      (expand-file-name
 365                       (elmo-safe-filename fname)
 366                       (expand-file-name "folder" elmo-msgdb-directory)))))
 367     (elmo-object-load flist-file elmo-mime-charset t)))
 368
 369 (defun elmo-msgdb-flist-save (fname flist)
 370   (let ((flist-file (expand-file-name
 371                      elmo-msgdb-flist-filename
 372                      (expand-file-name
 373                       (elmo-safe-filename fname)
 374                       (expand-file-name "folder" elmo-msgdb-directory)))))
 375     (elmo-object-save flist-file flist elmo-mime-charset)))
 376
 377 (defun elmo-crosspost-alist-load ()
 378   (elmo-object-load (expand-file-name
 379                      elmo-crosspost-alist-filename
 380                      elmo-msgdb-directory)
 381                     nil t))
 382
 383 (defun elmo-crosspost-alist-save (alist)
 384   (elmo-object-save (expand-file-name
 385                      elmo-crosspost-alist-filename
 386                      elmo-msgdb-directory)
 387                     alist))
 388
 389 (defsubst elmo-folder-get-info (folder &optional hashtb)
 390   (elmo-get-hash-val folder
 391                      (or hashtb elmo-folder-info-hashtb)))
 392
 393 (defun elmo-folder-get-info-max (folder)
 394   "Get folder info from cache."
 395   (nth 3 (elmo-folder-get-info folder)))
 396
 397 (defun elmo-folder-get-info-length (folder)
 398   (nth 2 (elmo-folder-get-info folder)))
 399
 400 (defun elmo-folder-get-info-unread (folder)
 401   (nth 1 (elmo-folder-get-info folder)))
 402
 403 (defsubst elmo-msgdb-location-load (dir)
 404   (elmo-object-load
 405    (expand-file-name
 406     elmo-msgdb-location-filename
 407     dir)))
 408
 409 (defsubst elmo-msgdb-location-add (alist number location)
 410   (let ((ret-val alist))
 411     (setq ret-val
 412           (elmo-msgdb-append-element ret-val (cons number location)))
 413     ret-val))
 414
 415 (defsubst elmo-msgdb-location-save (dir alist)
 416   (elmo-object-save
 417    (expand-file-name
 418     elmo-msgdb-location-filename
 419     dir) alist))
 420
 421 ;;; For backward compatibility.
 422 (defsubst elmo-msgdb-overview-entity-get-number (entity)
 423   (elmo-message-entity-number entity))
 424
 425 (defsubst elmo-msgdb-overview-entity-set-number (entity number)
 426   (elmo-message-entity-set-number entity number))
 427
 428 (defsubst elmo-msgdb-overview-entity-get-references (entity)
 429   (elmo-message-entity-field entity 'references))
 430
 431 (defsubst elmo-msgdb-overview-entity-set-references (entity references)
 432   (elmo-message-entity-set-field entity 'references references))
 433
 434 (defsubst elmo-msgdb-overview-entity-get-from-no-decode (entity)
 435   (elmo-with-enable-multibyte
 436     (encode-mime-charset-string
 437      (elmo-message-entity-field entity 'from) elmo-mime-charset)))
 438
 439 (defsubst elmo-msgdb-overview-entity-get-from (entity)
 440   (elmo-message-entity-field entity 'from))
 441
 442 (defsubst elmo-msgdb-overview-entity-set-from (entity from)
 443   (elmo-message-entity-set-field entity 'from from))
 444
 445 (defsubst elmo-msgdb-overview-entity-get-subject (entity)
 446   (elmo-message-entity-field entity 'subject))
 447
 448 (defsubst elmo-msgdb-overview-entity-get-subject-no-decode (entity)
 449   (elmo-with-enable-multibyte
 450     (encode-mime-charset-string
 451      (elmo-message-entity-field entity 'subject) elmo-mime-charset)))
 452
 453 (defsubst elmo-msgdb-overview-entity-set-subject (entity subject)
 454   (elmo-message-entity-set-field entity 'subject subject))
 455
 456 (defsubst elmo-msgdb-overview-entity-get-date (entity)
 457   (elmo-message-entity-field entity 'date 'string))
 458
 459 (defsubst elmo-msgdb-overview-entity-set-date (entity date)
 460   (elmo-message-entity-set-field entity 'date date))
 461
 462 (defsubst elmo-msgdb-overview-entity-get-to (entity)
 463   (elmo-message-entity-field entity 'to 'string))
 464
 465 (defsubst elmo-msgdb-overview-entity-get-cc (entity)
 466   (elmo-message-entity-field entity 'cc 'string))
 467
 468 (defsubst elmo-msgdb-overview-entity-get-size (entity)
 469   (elmo-message-entity-field entity 'size))
 470
 471 (defsubst elmo-msgdb-overview-entity-set-size (entity size)
 472   (elmo-message-entity-set-field entity 'size size))
 473
 474 (defsubst elmo-msgdb-overview-entity-get-extra (entity)
 475   ;; Truely obsolete.
 476   )
 477
 478 (defsubst elmo-msgdb-overview-entity-set-extra (entity extra)
 479   ;; Truely obsolete.
 480   )
 481
 482 (defsubst elmo-msgdb-overview-entity-get-extra-field (entity
 483                                                       field-name)
 484   (elmo-message-entity-field entity (intern field-name)))
 485
 486 (defsubst elmo-msgdb-overview-entity-set-extra-field (entity
 487                                                       field-name
 488                                                       value)
 489   (elmo-message-entity-set-field entity (intern field-name) value))
 490
 491 (require 'product)
 492 (product-provide (provide 'elmo-msgdb) (require 'elmo-version))
 493
 494 ;;; elmo-msgdb.el ends here