1 ;;; elmo-msgdb.el --- Message Database for ELMO.
3 ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
4 ;; Copyright (C) 2000 Masahiro MURATA <muse@ba2.so-net.ne.jp>
6 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
7 ;; Masahiro MURATA <muse@ba2.so-net.ne.jp>
8 ;; Keywords: mail, net news
10 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
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)
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.
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.
34 (eval-when-compile (require 'cl))
44 ;; MSGDB elmo-load-msgdb PATH MIME-CHARSET
45 ;; MSGDB elmo-make-msgdb LOCATION TYPE
46 ;; elmo-msgdb-sort-by-date MSGDB
48 ;; elmo-flag-table-load
49 ;; elmo-flag-table-set
50 ;; elmo-flag-table-get
51 ;; elmo-flag-table-save
53 ;; elmo-msgdb-overview-save DIR OBJ
56 ;; elmo-msgdb-get-parent-entity ENTITY MSGDB
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
66 ;; elmo-msgdb-finfo-load
67 ;; elmo-msgdb-finfo-save
68 ;; elmo-msgdb-flist-load
69 ;; elmo-msgdb-flist-save
71 ;; elmo-crosspost-alist-load
72 ;; elmo-crosspost-alist-save
74 ;; elmo-folder-get-info
75 ;; elmo-folder-get-info-max
76 ;; elmo-folder-get-info-length
77 ;; elmo-folder-get-info-unread
79 ;;; message entity wrappers
81 (defsubst elmo-message-entity-number (entity)
82 (elmo-msgdb-message-entity-number (elmo-message-entity-handler entity)
85 (defsubst elmo-message-entity-set-number (entity number)
86 (elmo-msgdb-message-entity-set-number (elmo-message-entity-handler entity)
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)
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)
106 (defconst elmo-msgdb-load-priorities '(legacy standard)
107 "Priority list of modb type for load.")
109 ;;; Helper functions for MSGDB
111 (defun elmo-load-msgdb (location mime-charset)
112 "Load the MSGDB from PATH."
113 (let ((msgdb (elmo-make-msgdb location elmo-msgdb-default-type mime-charset))
114 priorities loaded temp-modb)
115 (unless (elmo-msgdb-load msgdb)
117 (delq elmo-msgdb-default-type
118 (copy-sequence elmo-msgdb-load-priorities)))
119 (while (and priorities
121 (setq temp-modb (elmo-make-msgdb location
124 loaded (elmo-msgdb-load temp-modb)
125 priorities (cdr priorities)))
127 (if (eq elmo-msgdb-convert-type 'auto)
128 (elmo-msgdb-append msgdb temp-modb)
129 (setq msgdb temp-modb))))
132 (defun elmo-make-msgdb (&optional location type mime-charset)
134 (let* ((type (or type elmo-msgdb-default-type))
135 (class (intern (format "modb-%s" type))))
137 (luna-make-entity class
139 :mime-charset mime-charset)))
141 (defun elmo-msgdb-sort-by-date (msgdb)
142 (elmo-msgdb-sort-entities
144 (lambda (x y app-data)
147 (elmo-message-entity-field x 'date)
148 (elmo-message-entity-field y 'date))
151 (defsubst elmo-msgdb-get-parent-entity (entity msgdb)
152 (setq entity (elmo-message-entity-field entity 'references))
153 ;; entity is parent-id.
154 (and entity (elmo-msgdb-message-entity msgdb entity)))
157 (defsubst elmo-msgdb-append-element (list element)
159 ;;; (append list (list element))
160 (nconc list (list element))
165 ;; number <-> Message-ID handling
167 (defsubst elmo-msgdb-number-add (alist number id)
168 (let ((ret-val alist))
170 (elmo-msgdb-append-element ret-val (cons number id)))
175 (defvar elmo-flag-table-filename "flag-table")
176 (defun elmo-flag-table-load (dir)
177 "Load flag hashtable for MSGDB."
178 (let ((table (elmo-make-hash))
179 ;; For backward compatibility
180 (seen-file (expand-file-name elmo-msgdb-seen-filename dir))
182 (when (file-exists-p seen-file)
183 (dolist (msgid (elmo-object-load seen-file))
184 (elmo-set-hash-val msgid '(read) table))
185 (delete-file seen-file))
186 (dolist (pair (elmo-object-load
187 (expand-file-name elmo-flag-table-filename dir)))
188 (setq value (cdr pair))
189 (elmo-set-hash-val (car pair)
192 ;; Following cases for backward compatibility.
200 (defun elmo-flag-table-set (flag-table msg-id flags)
201 (elmo-set-hash-val msg-id (or flags '(read)) flag-table))
203 (defun elmo-flag-table-get (flag-table msg-id)
204 (let ((flags (elmo-get-hash-val msg-id flag-table)))
206 (and (elmo-file-cache-exists-p msg-id)
209 (elmo-list-delete '(cached read)
210 (copy-sequence flags)
214 (defun elmo-flag-table-save (dir flag-table)
216 (expand-file-name elmo-flag-table-filename dir)
219 (mapatoms (lambda (atom)
220 (setq list (cons (cons (symbol-name atom)
226 ;; persistent mark handling
229 (defun elmo-msgdb-mark-append (alist id mark)
231 (setq alist (elmo-msgdb-append-element alist
234 (defun elmo-msgdb-flag-table (msgdb &optional flag-table)
235 ;; Make a table of msgid flag (read, answered)
236 (let ((flag-table (or flag-table
237 (elmo-make-hash (elmo-msgdb-length msgdb))))
239 (dolist (number (elmo-msgdb-list-messages msgdb))
240 (when (setq msg-id (elmo-msgdb-message-field msgdb number 'message-id))
241 (elmo-flag-table-set flag-table
243 (elmo-msgdb-flags msgdb number))))
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
252 (std11-narrow-to-header boundary)
253 (let* ((case-fold-search t)
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)
261 (list (buffer-substring-no-properties
262 (match-end 0) (std11-field-end))))))
263 (setq s-rest (cdr s-rest)))
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))
271 (defsubst elmo-msgdb-seen-load (dir)
272 (elmo-object-load (expand-file-name
273 elmo-msgdb-seen-filename
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)))
281 ;; deleted message handling
283 (defun elmo-msgdb-killed-list-load (dir)
285 (expand-file-name elmo-msgdb-killed-filename dir)
288 (defun elmo-msgdb-killed-list-save (dir killed-list)
290 (expand-file-name elmo-msgdb-killed-filename dir)
293 (defun elmo-msgdb-killed-message-p (killed-list msg)
294 (elmo-number-set-member msg killed-list))
296 (defun elmo-msgdb-set-as-killed (killed-list msg)
297 (elmo-number-set-append killed-list msg))
299 (defun elmo-msgdb-killed-list-length (killed-list)
300 (let ((killed killed-list)
303 (if (consp (car killed))
304 (setq ret-val (+ ret-val 1 (- (cdar killed) (caar killed))))
305 (setq ret-val (+ ret-val 1)))
306 (setq killed (cdr killed)))
309 (defun elmo-msgdb-max-of-killed (killed-list)
310 (let ((klist killed-list)
316 (if (consp (car klist))
320 (setq klist (cdr klist)))
323 (defun elmo-living-messages (messages killed-list)
326 (mapcar (lambda (number)
327 (unless (elmo-number-set-member number killed-list)
332 (defun elmo-msgdb-finfo-load ()
333 (elmo-object-load (expand-file-name
334 elmo-msgdb-finfo-filename
335 elmo-msgdb-directory)
336 elmo-mime-charset t))
338 (defun elmo-msgdb-finfo-save (finfo)
339 (elmo-object-save (expand-file-name
340 elmo-msgdb-finfo-filename
341 elmo-msgdb-directory)
342 finfo elmo-mime-charset))
344 (defun elmo-msgdb-flist-load (fname)
345 (let ((flist-file (expand-file-name
346 elmo-msgdb-flist-filename
348 (elmo-safe-filename fname)
349 (expand-file-name "folder" elmo-msgdb-directory)))))
350 (elmo-object-load flist-file elmo-mime-charset t)))
352 (defun elmo-msgdb-flist-save (fname flist)
353 (let ((flist-file (expand-file-name
354 elmo-msgdb-flist-filename
356 (elmo-safe-filename fname)
357 (expand-file-name "folder" elmo-msgdb-directory)))))
358 (elmo-object-save flist-file flist elmo-mime-charset)))
360 (defun elmo-crosspost-alist-load ()
361 (elmo-object-load (expand-file-name
362 elmo-crosspost-alist-filename
363 elmo-msgdb-directory)
366 (defun elmo-crosspost-alist-save (alist)
367 (elmo-object-save (expand-file-name
368 elmo-crosspost-alist-filename
369 elmo-msgdb-directory)
372 (defsubst elmo-folder-get-info (folder &optional hashtb)
373 (elmo-get-hash-val folder
374 (or hashtb elmo-folder-info-hashtb)))
376 (defun elmo-folder-get-info-max (folder)
377 "Get folder info from cache."
378 (nth 3 (elmo-folder-get-info folder)))
380 (defun elmo-folder-get-info-length (folder)
381 (nth 2 (elmo-folder-get-info folder)))
383 (defun elmo-folder-get-info-unread (folder)
384 (nth 1 (elmo-folder-get-info folder)))
386 (defsubst elmo-msgdb-location-load (dir)
389 elmo-msgdb-location-filename
392 (defsubst elmo-msgdb-location-add (alist number location)
393 (let ((ret-val alist))
395 (elmo-msgdb-append-element ret-val (cons number location)))
398 (defsubst elmo-msgdb-location-save (dir alist)
401 elmo-msgdb-location-filename
404 ;;; For backward compatibility.
405 (defsubst elmo-msgdb-overview-entity-get-number (entity)
406 (elmo-message-entity-number entity))
408 (defsubst elmo-msgdb-overview-entity-set-number (entity number)
409 (elmo-message-entity-set-number entity number))
411 (defsubst elmo-msgdb-overview-entity-get-references (entity)
412 (elmo-message-entity-field entity 'references))
414 (defsubst elmo-msgdb-overview-entity-set-references (entity references)
415 (elmo-message-entity-set-field entity 'references references))
417 (defsubst elmo-msgdb-overview-entity-get-from-no-decode (entity)
418 (elmo-with-enable-multibyte
419 (encode-mime-charset-string
420 (elmo-message-entity-field entity 'from) elmo-mime-charset)))
422 (defsubst elmo-msgdb-overview-entity-get-from (entity)
423 (elmo-message-entity-field entity 'from))
425 (defsubst elmo-msgdb-overview-entity-set-from (entity from)
426 (elmo-message-entity-set-field entity 'from from))
428 (defsubst elmo-msgdb-overview-entity-get-subject (entity)
429 (elmo-message-entity-field entity 'subject))
431 (defsubst elmo-msgdb-overview-entity-get-subject-no-decode (entity)
432 (elmo-with-enable-multibyte
433 (encode-mime-charset-string
434 (elmo-message-entity-field entity 'subject) elmo-mime-charset)))
436 (defsubst elmo-msgdb-overview-entity-set-subject (entity subject)
437 (elmo-message-entity-set-field entity 'subject subject))
439 (defsubst elmo-msgdb-overview-entity-get-date (entity)
440 (elmo-message-entity-field entity 'date 'string))
442 (defsubst elmo-msgdb-overview-entity-set-date (entity date)
443 (elmo-message-entity-set-field entity 'date date))
445 (defsubst elmo-msgdb-overview-entity-get-to (entity)
446 (elmo-message-entity-field entity 'to 'string))
448 (defsubst elmo-msgdb-overview-entity-get-cc (entity)
449 (elmo-message-entity-field entity 'cc 'string))
451 (defsubst elmo-msgdb-overview-entity-get-size (entity)
452 (elmo-message-entity-field entity 'size))
454 (defsubst elmo-msgdb-overview-entity-set-size (entity size)
455 (elmo-message-entity-set-field entity 'size size))
457 (defsubst elmo-msgdb-overview-entity-get-extra (entity)
461 (defsubst elmo-msgdb-overview-entity-set-extra (entity extra)
465 (defsubst elmo-msgdb-overview-entity-get-extra-field (entity
467 (elmo-message-entity-field entity (intern field-name)))
469 (defsubst elmo-msgdb-overview-entity-set-extra-field (entity
472 (elmo-message-entity-set-field entity (intern field-name) value))
475 (product-provide (provide 'elmo-msgdb) (require 'elmo-version))
477 ;;; elmo-msgdb.el ends here