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
  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 decode)
  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 DECODE is non-nil, returned value is decoded."
  95   (elmo-msgdb-message-entity-field (elmo-message-entity-handler entity)
  96                                    entity field decode))
  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 (raw)."
 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)
 112   "Load the MSGDB from PATH."
 113   (let ((msgdb (elmo-make-msgdb location elmo-msgdb-default-type))
 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 (car priorities))
 122               loaded (elmo-msgdb-load temp-modb)
 123               priorities (cdr priorities)))
 124       (when loaded
 125         (if (eq elmo-msgdb-convert-type 'auto)
 126             (elmo-msgdb-append msgdb temp-modb)
 127           (setq msgdb temp-modb))))
 128     msgdb))
 129
 130 (defun elmo-make-msgdb (&optional location type)
 131   "Make a MSGDB."
 132   (let* ((type (or type elmo-msgdb-default-type))
 133          (class (intern (format "modb-%s" type))))
 134     (require class)
 135     (luna-make-entity class
 136                       :location location)))
 137
 138 (defun elmo-msgdb-sort-by-date (msgdb)
 139   (elmo-msgdb-sort-entities
 140    msgdb
 141    (lambda (x y app-data)
 142      (condition-case nil
 143          (string<
 144           (timezone-make-date-sortable
 145            (elmo-message-entity-field x 'date))
 146           (timezone-make-date-sortable
 147            (elmo-message-entity-field y 'date)))
 148        (error)))))
 149
 150 (defsubst elmo-msgdb-get-parent-entity (entity msgdb)
 151   (setq entity (elmo-message-entity-field entity 'references))
 152   ;; entity is parent-id.
 153   (and entity (elmo-msgdb-message-entity msgdb entity)))
 154
 155 ;;;
 156 (defsubst elmo-msgdb-append-element (list element)
 157   (if list
 158 ;;;   (append list (list element))
 159       (nconc list (list element))
 160     ;; list is nil
 161     (list element)))
 162
 163 ;;
 164 ;; number <-> Message-ID handling
 165 ;;
 166 (defsubst elmo-msgdb-number-add (alist number id)
 167   (let ((ret-val alist))
 168     (setq ret-val
 169           (elmo-msgdb-append-element ret-val (cons number id)))
 170     ret-val))
 171
 172 ;;; flag table
 173 ;;
 174 (defvar elmo-flag-table-filename "flag-table")
 175 (defun elmo-flag-table-load (dir)
 176   "Load flag hashtable for MSGDB."
 177   (let ((table (elmo-make-hash))
 178         ;; For backward compatibility
 179         (seen-file (expand-file-name elmo-msgdb-seen-filename dir))
 180         value)
 181     (when (file-exists-p seen-file)
 182       (dolist (msgid (elmo-object-load seen-file))
 183         (elmo-set-hash-val msgid '(read) table))
 184       (delete-file seen-file))
 185     (dolist (pair (elmo-object-load
 186                    (expand-file-name elmo-flag-table-filename dir)))
 187       (setq value (cdr pair))
 188       (elmo-set-hash-val (car pair)
 189                          (cond ((consp value)
 190                                 value)
 191                                ;; Following cases for backward compatibility.
 192                                (value
 193                                 (list value))
 194                                (t
 195                                 '(unread)))
 196                          table))
 197     table))
 198
 199 (defun elmo-flag-table-set (flag-table msg-id flags)
 200   (elmo-set-hash-val msg-id (or flags '(read)) flag-table))
 201
 202 (defun elmo-flag-table-get (flag-table msg-id)
 203   (let ((flags (elmo-get-hash-val msg-id flag-table)))
 204     (if flags
 205         (append
 206          (and (elmo-file-cache-exists-p msg-id)
 207               '(cached))
 208          (elmo-list-delete '(cached read)
 209                            (copy-sequence flags)
 210                            #'delq))
 211       '(new unread))))
 212
 213 (defun elmo-flag-table-save (dir flag-table)
 214   (elmo-object-save
 215    (expand-file-name elmo-flag-table-filename dir)
 216    (if flag-table
 217        (let (list)
 218          (mapatoms (lambda (atom)
 219                      (setq list (cons (cons (symbol-name atom)
 220                                             (symbol-value atom))
 221                                       list)))
 222                    flag-table)
 223          list))))
 224 ;;;
 225 ;; persistent mark handling
 226 ;; (for each folder)
 227
 228 (defun elmo-msgdb-mark-append (alist id mark)
 229   "Append mark."
 230   (setq alist (elmo-msgdb-append-element alist
 231                                          (list id mark))))
 232
 233 (defun elmo-msgdb-flag-table (msgdb &optional flag-table)
 234   ;; Make a table of msgid flag (read, answered)
 235   (let ((flag-table (or flag-table
 236                         (elmo-make-hash (elmo-msgdb-length msgdb))))
 237         entity)
 238     (dolist (number (elmo-msgdb-list-messages msgdb))
 239       (setq entity (elmo-msgdb-message-entity msgdb number))
 240       (elmo-flag-table-set
 241        flag-table
 242        (elmo-message-entity-field entity 'message-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 (defun elmo-msgdb-get-message-id-from-buffer ()
 373   (let ((msgid (elmo-field-body "message-id")))
 374     (if msgid
 375         (if (string-match "<\\(.+\\)>$" msgid)
 376             msgid
 377           (concat "<" msgid ">")) ; Invaild message-id.
 378       ;; no message-id, so put dummy msgid.
 379       (concat "<" (timezone-make-date-sortable
 380                    (elmo-field-body "date"))
 381               (nth 1 (eword-extract-address-components
 382                       (or (elmo-field-body "from") "nobody"))) ">"))))
 383
 384 (defsubst elmo-folder-get-info (folder &optional hashtb)
 385   (elmo-get-hash-val folder
 386                      (or hashtb elmo-folder-info-hashtb)))
 387
 388 (defun elmo-folder-get-info-max (folder)
 389   "Get folder info from cache."
 390   (nth 3 (elmo-folder-get-info folder)))
 391
 392 (defun elmo-folder-get-info-length (folder)
 393   (nth 2 (elmo-folder-get-info folder)))
 394
 395 (defun elmo-folder-get-info-unread (folder)
 396   (nth 1 (elmo-folder-get-info folder)))
 397
 398 (defsubst elmo-msgdb-location-load (dir)
 399   (elmo-object-load
 400    (expand-file-name
 401     elmo-msgdb-location-filename
 402     dir)))
 403
 404 (defsubst elmo-msgdb-location-add (alist number location)
 405   (let ((ret-val alist))
 406     (setq ret-val
 407           (elmo-msgdb-append-element ret-val (cons number location)))
 408     ret-val))
 409
 410 (defsubst elmo-msgdb-location-save (dir alist)
 411   (elmo-object-save
 412    (expand-file-name
 413     elmo-msgdb-location-filename
 414     dir) alist))
 415
 416 ;;; For backward compatibility.
 417 (defsubst elmo-msgdb-overview-entity-get-number (entity)
 418   (elmo-message-entity-number entity))
 419
 420 (defsubst elmo-msgdb-overview-entity-set-number (entity number)
 421   (elmo-message-entity-set-number entity number))
 422
 423 (defsubst elmo-msgdb-overview-entity-get-references (entity)
 424   (elmo-message-entity-field entity 'references))
 425
 426 (defsubst elmo-msgdb-overview-entity-set-references (entity references)
 427   (elmo-message-entity-set-field entity 'references references))
 428
 429 (defsubst elmo-msgdb-overview-entity-get-from-no-decode (entity)
 430   (elmo-message-entity-field entity 'from))
 431
 432 (defsubst elmo-msgdb-overview-entity-get-from (entity)
 433   (elmo-message-entity-field entity 'from t))
 434
 435 (defsubst elmo-msgdb-overview-entity-set-from (entity from)
 436   (elmo-message-entity-set-field entity 'from from))
 437
 438 (defsubst elmo-msgdb-overview-entity-get-subject (entity)
 439   (elmo-message-entity-field entity 'subject t))
 440
 441 (defsubst elmo-msgdb-overview-entity-get-subject-no-decode (entity)
 442   (elmo-message-entity-field entity 'subject))
 443
 444 (defsubst elmo-msgdb-overview-entity-set-subject (entity subject)
 445   (elmo-message-entity-set-field entity 'subject subject))
 446
 447 (defsubst elmo-msgdb-overview-entity-get-date (entity)
 448   (elmo-message-entity-field entity 'date))
 449
 450 (defsubst elmo-msgdb-overview-entity-set-date (entity date)
 451   (elmo-message-entity-set-field entity 'date date))
 452
 453 (defsubst elmo-msgdb-overview-entity-get-to (entity)
 454   (elmo-message-entity-field entity 'to))
 455
 456 (defsubst elmo-msgdb-overview-entity-get-cc (entity)
 457   (elmo-message-entity-field entity 'cc))
 458
 459 (defsubst elmo-msgdb-overview-entity-get-size (entity)
 460   (elmo-message-entity-field entity 'size))
 461
 462 (defsubst elmo-msgdb-overview-entity-set-size (entity size)
 463   (elmo-message-entity-set-field entity 'size size))
 464
 465 (defsubst elmo-msgdb-overview-entity-get-extra (entity)
 466   ;; Truely obsolete.
 467   )
 468
 469 (defsubst elmo-msgdb-overview-entity-set-extra (entity extra)
 470   ;; Truely obsolete.
 471   )
 472
 473 (defsubst elmo-msgdb-overview-entity-get-extra-field (entity
 474                                                       field-name)
 475   (elmo-message-entity-field entity (intern field-name)))
 476
 477 (defsubst elmo-msgdb-overview-entity-set-extra-field (entity
 478                                                       field-name
 479                                                       value)
 480   (elmo-message-entity-set-field entity (intern field-name) value))
 481
 482 (require 'product)
 483 (product-provide (provide 'elmo-msgdb) (require 'elmo-version))
 484
 485 ;;; elmo-msgdb.el ends here