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     (append
 205      (and (elmo-file-cache-exists-p msg-id)
 206           '(cached))
 207      (if flags
 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         msg-id)
 238     (dolist (number (elmo-msgdb-list-messages msgdb))
 239       (when (setq msg-id (elmo-message-entity-field
 240                           (elmo-msgdb-message-entity msgdb number)
 241                           'message-id))
 242         (elmo-flag-table-set flag-table
 243                              msg-id
 244                              (elmo-msgdb-flags msgdb number))))
 245     flag-table))
 246
 247 (defun elmo-multiple-fields-body-list (field-names &optional boundary)
 248   "Return list of each field-bodies of FIELD-NAMES of the message header
 249 in current buffer. If BOUNDARY is not nil, it is used as message
 250 header separator."
 251   (save-excursion
 252     (save-restriction
 253       (std11-narrow-to-header boundary)
 254       (let* ((case-fold-search t)
 255              (s-rest field-names)
 256              field-name field-body)
 257         (while (setq field-name (car s-rest))
 258           (goto-char (point-min))
 259           (while (re-search-forward (concat "^" field-name ":[ \t]*") nil t)
 260             (setq field-body
 261                   (nconc field-body
 262                          (list (buffer-substring-no-properties
 263                                 (match-end 0) (std11-field-end))))))
 264           (setq s-rest (cdr s-rest)))
 265         field-body))))
 266
 267 (defsubst elmo-msgdb-remove-field-string (string)
 268   (if (string-match (concat std11-field-head-regexp "[ \t]*") string)
 269       (substring string (match-end 0))
 270     string))
 271
 272 (defsubst elmo-msgdb-seen-load (dir)
 273   (elmo-object-load (expand-file-name
 274                      elmo-msgdb-seen-filename
 275                      dir)))
 276
 277 (defsubst elmo-msgdb-out-of-date-messages (msgdb)
 278   (dolist (number (elmo-msgdb-list-flagged msgdb 'new))
 279     (elmo-msgdb-unset-flag msgdb number 'new)))
 280
 281 ;;
 282 ;; deleted message handling
 283 ;;
 284 (defun elmo-msgdb-killed-list-load (dir)
 285   (elmo-object-load
 286    (expand-file-name elmo-msgdb-killed-filename dir)
 287    nil t))
 288
 289 (defun elmo-msgdb-killed-list-save (dir killed-list)
 290   (elmo-object-save
 291    (expand-file-name elmo-msgdb-killed-filename dir)
 292    killed-list))
 293
 294 (defun elmo-msgdb-killed-message-p (killed-list msg)
 295   (elmo-number-set-member msg killed-list))
 296
 297 (defun elmo-msgdb-set-as-killed (killed-list msg)
 298   (elmo-number-set-append killed-list msg))
 299
 300 (defun elmo-msgdb-killed-list-length (killed-list)
 301   (let ((killed killed-list)
 302         (ret-val 0))
 303     (while (car killed)
 304       (if (consp (car killed))
 305           (setq ret-val (+ ret-val 1 (- (cdar killed) (caar killed))))
 306         (setq ret-val (+ ret-val 1)))
 307       (setq killed (cdr killed)))
 308     ret-val))
 309
 310 (defun elmo-msgdb-max-of-killed (killed-list)
 311   (let ((klist killed-list)
 312         (max 0)
 313         k)
 314     (while (car klist)
 315       (if (< max
 316              (setq k
 317                    (if (consp (car klist))
 318                        (cdar klist)
 319                      (car klist))))
 320           (setq max k))
 321       (setq klist (cdr klist)))
 322     max))
 323
 324 (defun elmo-living-messages (messages killed-list)
 325   (if killed-list
 326       (delq nil
 327             (mapcar (lambda (number)
 328                       (unless (elmo-number-set-member number killed-list)
 329                         number))
 330                     messages))
 331     messages))
 332
 333 (defun elmo-msgdb-finfo-load ()
 334   (elmo-object-load (expand-file-name
 335                      elmo-msgdb-finfo-filename
 336                      elmo-msgdb-directory)
 337                     elmo-mime-charset t))
 338
 339 (defun elmo-msgdb-finfo-save (finfo)
 340   (elmo-object-save (expand-file-name
 341                      elmo-msgdb-finfo-filename
 342                      elmo-msgdb-directory)
 343                     finfo elmo-mime-charset))
 344
 345 (defun elmo-msgdb-flist-load (fname)
 346   (let ((flist-file (expand-file-name
 347                      elmo-msgdb-flist-filename
 348                      (expand-file-name
 349                       (elmo-safe-filename fname)
 350                       (expand-file-name "folder" elmo-msgdb-directory)))))
 351     (elmo-object-load flist-file elmo-mime-charset t)))
 352
 353 (defun elmo-msgdb-flist-save (fname flist)
 354   (let ((flist-file (expand-file-name
 355                      elmo-msgdb-flist-filename
 356                      (expand-file-name
 357                       (elmo-safe-filename fname)
 358                       (expand-file-name "folder" elmo-msgdb-directory)))))
 359     (elmo-object-save flist-file flist elmo-mime-charset)))
 360
 361 (defun elmo-crosspost-alist-load ()
 362   (elmo-object-load (expand-file-name
 363                      elmo-crosspost-alist-filename
 364                      elmo-msgdb-directory)
 365                     nil t))
 366
 367 (defun elmo-crosspost-alist-save (alist)
 368   (elmo-object-save (expand-file-name
 369                      elmo-crosspost-alist-filename
 370                      elmo-msgdb-directory)
 371                     alist))
 372
 373 (defsubst elmo-folder-get-info (folder &optional hashtb)
 374   (elmo-get-hash-val folder
 375                      (or hashtb elmo-folder-info-hashtb)))
 376
 377 (defun elmo-folder-get-info-max (folder)
 378   "Get folder info from cache."
 379   (nth 3 (elmo-folder-get-info folder)))
 380
 381 (defun elmo-folder-get-info-length (folder)
 382   (nth 2 (elmo-folder-get-info folder)))
 383
 384 (defun elmo-folder-get-info-unread (folder)
 385   (nth 1 (elmo-folder-get-info folder)))
 386
 387 (defsubst elmo-msgdb-location-load (dir)
 388   (elmo-object-load
 389    (expand-file-name
 390     elmo-msgdb-location-filename
 391     dir)))
 392
 393 (defsubst elmo-msgdb-location-add (alist number location)
 394   (let ((ret-val alist))
 395     (setq ret-val
 396           (elmo-msgdb-append-element ret-val (cons number location)))
 397     ret-val))
 398
 399 (defsubst elmo-msgdb-location-save (dir alist)
 400   (elmo-object-save
 401    (expand-file-name
 402     elmo-msgdb-location-filename
 403     dir) alist))
 404
 405 ;;; For backward compatibility.
 406 (defsubst elmo-msgdb-overview-entity-get-number (entity)
 407   (elmo-message-entity-number entity))
 408
 409 (defsubst elmo-msgdb-overview-entity-set-number (entity number)
 410   (elmo-message-entity-set-number entity number))
 411
 412 (defsubst elmo-msgdb-overview-entity-get-references (entity)
 413   (elmo-message-entity-field entity 'references))
 414
 415 (defsubst elmo-msgdb-overview-entity-set-references (entity references)
 416   (elmo-message-entity-set-field entity 'references references))
 417
 418 (defsubst elmo-msgdb-overview-entity-get-from-no-decode (entity)
 419   (elmo-message-entity-field entity 'from))
 420
 421 (defsubst elmo-msgdb-overview-entity-get-from (entity)
 422   (elmo-message-entity-field entity 'from t))
 423
 424 (defsubst elmo-msgdb-overview-entity-set-from (entity from)
 425   (elmo-message-entity-set-field entity 'from from))
 426
 427 (defsubst elmo-msgdb-overview-entity-get-subject (entity)
 428   (elmo-message-entity-field entity 'subject t))
 429
 430 (defsubst elmo-msgdb-overview-entity-get-subject-no-decode (entity)
 431   (elmo-message-entity-field entity 'subject))
 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))
 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))
 444
 445 (defsubst elmo-msgdb-overview-entity-get-cc (entity)
 446   (elmo-message-entity-field entity 'cc))
 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