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