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