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