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 ;;
 230 ;; overview handling
 231 ;;
 232 (defun elmo-multiple-field-body (name &optional boundary)
 233   (save-excursion
 234     (save-restriction
 235       (std11-narrow-to-header boundary)
 236       (goto-char (point-min))
 237       (let ((case-fold-search t)
 238             (field-body nil))
 239         (while (re-search-forward (concat "^" name ":[ \t]*") nil t)
 240           (setq field-body
 241                 (nconc field-body
 242                        (list (buffer-substring-no-properties
 243                               (match-end 0) (std11-field-end))))))
 244         field-body))))
 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 (defun elmo-msgdb-match-condition (msgdb condition number numbers)
 281   "Check whether the condition of the message is satisfied or not.
 282 MSGDB is the msgdb to search from.
 283 CONDITION is the search condition.
 284 NUMBER is the message number to check.
 285 NUMBERS is the target message number list.
 286 Return CONDITION itself if no entity exists in msgdb."
 287   (let ((entity (elmo-msgdb-message-entity msgdb number)))
 288     (if entity
 289         (elmo-msgdb-match-condition-internal msgdb
 290                                              condition
 291                                              entity
 292                                              (elmo-msgdb-flags msgdb number)
 293                                              numbers)
 294       condition)))
 295
 296 ;;
 297 ;; deleted message handling
 298 ;;
 299 (defun elmo-msgdb-killed-list-load (dir)
 300   (elmo-object-load
 301    (expand-file-name elmo-msgdb-killed-filename dir)
 302    nil t))
 303
 304 (defun elmo-msgdb-killed-list-save (dir killed-list)
 305   (elmo-object-save
 306    (expand-file-name elmo-msgdb-killed-filename dir)
 307    killed-list))
 308
 309 (defun elmo-msgdb-killed-message-p (killed-list msg)
 310   (elmo-number-set-member msg killed-list))
 311
 312 (defun elmo-msgdb-set-as-killed (killed-list msg)
 313   (elmo-number-set-append killed-list msg))
 314
 315 (defun elmo-msgdb-killed-list-length (killed-list)
 316   (let ((killed killed-list)
 317         (ret-val 0))
 318     (while (car killed)
 319       (if (consp (car killed))
 320           (setq ret-val (+ ret-val 1 (- (cdar killed) (caar killed))))
 321         (setq ret-val (+ ret-val 1)))
 322       (setq killed (cdr killed)))
 323     ret-val))
 324
 325 (defun elmo-msgdb-max-of-killed (killed-list)
 326   (let ((klist killed-list)
 327         (max 0)
 328         k)
 329     (while (car klist)
 330       (if (< max
 331              (setq k
 332                    (if (consp (car klist))
 333                        (cdar klist)
 334                      (car klist))))
 335           (setq max k))
 336       (setq klist (cdr klist)))
 337     max))
 338
 339 (defun elmo-living-messages (messages killed-list)
 340   (if killed-list
 341       (delq nil
 342             (mapcar (lambda (number)
 343                       (unless (elmo-number-set-member number killed-list)
 344                         number))
 345                     messages))
 346     messages))
 347
 348 (defun elmo-msgdb-finfo-load ()
 349   (elmo-object-load (expand-file-name
 350                      elmo-msgdb-finfo-filename
 351                      elmo-msgdb-directory)
 352                     elmo-mime-charset t))
 353
 354 (defun elmo-msgdb-finfo-save (finfo)
 355   (elmo-object-save (expand-file-name
 356                      elmo-msgdb-finfo-filename
 357                      elmo-msgdb-directory)
 358                     finfo elmo-mime-charset))
 359
 360 (defun elmo-msgdb-flist-load (fname)
 361   (let ((flist-file (expand-file-name
 362                      elmo-msgdb-flist-filename
 363                      (expand-file-name
 364                       (elmo-safe-filename fname)
 365                       (expand-file-name "folder" elmo-msgdb-directory)))))
 366     (elmo-object-load flist-file elmo-mime-charset t)))
 367
 368 (defun elmo-msgdb-flist-save (fname flist)
 369   (let ((flist-file (expand-file-name
 370                      elmo-msgdb-flist-filename
 371                      (expand-file-name
 372                       (elmo-safe-filename fname)
 373                       (expand-file-name "folder" elmo-msgdb-directory)))))
 374     (elmo-object-save flist-file flist elmo-mime-charset)))
 375
 376 (defun elmo-crosspost-alist-load ()
 377   (elmo-object-load (expand-file-name
 378                      elmo-crosspost-alist-filename
 379                      elmo-msgdb-directory)
 380                     nil t))
 381
 382 (defun elmo-crosspost-alist-save (alist)
 383   (elmo-object-save (expand-file-name
 384                      elmo-crosspost-alist-filename
 385                      elmo-msgdb-directory)
 386                     alist))
 387
 388 (defun elmo-msgdb-get-message-id-from-buffer ()
 389   (let ((msgid (elmo-field-body "message-id")))
 390     (if msgid
 391         (if (string-match "<\\(.+\\)>$" msgid)
 392             msgid
 393           (concat "<" msgid ">")) ; Invaild message-id.
 394       ;; no message-id, so put dummy msgid.
 395       (concat "<" (timezone-make-date-sortable
 396                    (elmo-field-body "date"))
 397               (nth 1 (eword-extract-address-components
 398                       (or (elmo-field-body "from") "nobody"))) ">"))))
 399
 400 (defsubst elmo-folder-get-info (folder &optional hashtb)
 401   (elmo-get-hash-val folder
 402                      (or hashtb elmo-folder-info-hashtb)))
 403
 404 (defun elmo-folder-get-info-max (folder)
 405   "Get folder info from cache."
 406   (nth 3 (elmo-folder-get-info folder)))
 407
 408 (defun elmo-folder-get-info-length (folder)
 409   (nth 2 (elmo-folder-get-info folder)))
 410
 411 (defun elmo-folder-get-info-unread (folder)
 412   (nth 1 (elmo-folder-get-info folder)))
 413
 414 (defsubst elmo-msgdb-location-load (dir)
 415   (elmo-object-load
 416    (expand-file-name
 417     elmo-msgdb-location-filename
 418     dir)))
 419
 420 (defsubst elmo-msgdb-location-add (alist number location)
 421   (let ((ret-val alist))
 422     (setq ret-val
 423           (elmo-msgdb-append-element ret-val (cons number location)))
 424     ret-val))
 425
 426 (defsubst elmo-msgdb-location-save (dir alist)
 427   (elmo-object-save
 428    (expand-file-name
 429     elmo-msgdb-location-filename
 430     dir) alist))
 431
 432 (require 'product)
 433 (product-provide (provide 'elmo-msgdb) (require 'elmo-version))
 434
 435 ;;; elmo-msgdb.el ends here