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-extra-fields (&optional non-virtual
)
147 (let ((spec (assq (intern extra
) modb-entity-field-extractor-alist
)))
149 (let ((real-fields (nth 2 spec
)))
150 (cond ((functionp real-fields
)
151 (funcall real-fields extra
))
153 (copy-sequence real-fields
))))
155 elmo-msgdb-extra-fields
))
156 elmo-msgdb-extra-fields
))
158 (defun elmo-msgdb-sort-by-date (msgdb)
159 (elmo-msgdb-sort-entities
161 (lambda (x y app-data
)
164 (elmo-message-entity-field x
'date
)
165 (elmo-message-entity-field y
'date
))
168 (defsubst elmo-msgdb-get-parent-entity
(entity msgdb
)
169 (setq entity
(elmo-message-entity-field entity
'references
))
170 ;; entity is parent-id.
171 (and entity
(elmo-msgdb-message-entity msgdb entity
)))
174 (defsubst elmo-msgdb-append-element
(list element
)
176 ;;; (append list (list element))
177 (nconc list
(list element
))
182 ;; number <-> Message-ID handling
184 (defsubst elmo-msgdb-number-add
(alist number id
)
185 (let ((ret-val alist
))
187 (elmo-msgdb-append-element ret-val
(cons number id
)))
192 (defvar elmo-flag-table-filename
"flag-table")
193 (defun elmo-flag-table-load (dir)
194 "Load flag hashtable for MSGDB."
195 (let ((table (elmo-make-hash))
196 ;; For backward compatibility
197 (seen-file (expand-file-name elmo-msgdb-seen-filename dir
))
199 (when (file-exists-p seen-file
)
200 (dolist (msgid (elmo-object-load seen-file
))
201 (elmo-set-hash-val msgid
'(read) table
))
202 (delete-file seen-file
))
203 (dolist (pair (elmo-object-load
204 (expand-file-name elmo-flag-table-filename dir
)))
205 (setq value
(cdr pair
))
206 (elmo-set-hash-val (car pair
)
209 ;; Following cases for backward compatibility.
217 (defun elmo-flag-table-set (flag-table msg-id flags
)
218 (elmo-set-hash-val msg-id
(or flags
'(read)) flag-table
))
220 (defun elmo-flag-table-get (flag-table msg-id
)
221 (let ((flags (elmo-get-hash-val msg-id flag-table
)))
223 (and (elmo-file-cache-exists-p msg-id
)
226 (elmo-list-delete '(cached read
)
227 (copy-sequence flags
)
231 (defun elmo-flag-table-save (dir flag-table
)
233 (expand-file-name elmo-flag-table-filename dir
)
236 (mapatoms (lambda (atom)
237 (setq list
(cons (cons (symbol-name atom
)
243 ;; persistent mark handling
246 (defun elmo-msgdb-mark-append (alist id mark
)
248 (setq alist
(elmo-msgdb-append-element alist
251 (defun elmo-msgdb-flag-table (msgdb &optional flag-table
)
252 ;; Make a table of msgid flag (read, answered)
253 (let ((flag-table (or flag-table
254 (elmo-make-hash (elmo-msgdb-length msgdb
))))
256 (dolist (number (elmo-msgdb-list-messages msgdb
))
257 (when (setq msg-id
(elmo-msgdb-message-field msgdb number
'message-id
))
258 (elmo-flag-table-set flag-table
260 (elmo-msgdb-flags msgdb number
))))
263 (defun elmo-multiple-fields-body-list (field-names &optional boundary
)
264 "Return list of each field-bodies of FIELD-NAMES of the message header
265 in current buffer. If BOUNDARY is not nil, it is used as message
269 (std11-narrow-to-header boundary
)
270 (let* ((case-fold-search t
)
272 field-name field-body
)
273 (while (setq field-name
(car s-rest
))
274 (goto-char (point-min))
275 (while (re-search-forward (concat "^" field-name
":[ \t]*") nil t
)
278 (list (buffer-substring-no-properties
279 (match-end 0) (std11-field-end))))))
280 (setq s-rest
(cdr s-rest
)))
283 (defsubst elmo-msgdb-remove-field-string
(string)
284 (if (string-match (concat std11-field-head-regexp
"[ \t]*") string
)
285 (substring string
(match-end 0))
288 (defsubst elmo-msgdb-seen-load
(dir)
289 (elmo-object-load (expand-file-name
290 elmo-msgdb-seen-filename
293 (defsubst elmo-msgdb-out-of-date-messages
(msgdb)
294 (dolist (number (elmo-msgdb-list-flagged msgdb
'new
))
295 (elmo-msgdb-unset-flag msgdb number
'new
)))
298 ;; deleted message handling
300 (defun elmo-msgdb-killed-list-load (dir)
302 (expand-file-name elmo-msgdb-killed-filename dir
)
305 (defun elmo-msgdb-killed-list-save (dir killed-list
)
307 (expand-file-name elmo-msgdb-killed-filename dir
)
310 (defun elmo-msgdb-killed-message-p (killed-list msg
)
311 (elmo-number-set-member msg killed-list
))
313 (defun elmo-msgdb-set-as-killed (killed-list msg
)
314 (elmo-number-set-append killed-list msg
))
316 (defun elmo-msgdb-killed-list-length (killed-list)
317 (let ((killed killed-list
)
320 (if (consp (car killed
))
321 (setq ret-val
(+ ret-val
1 (- (cdar killed
) (caar killed
))))
322 (setq ret-val
(+ ret-val
1)))
323 (setq killed
(cdr killed
)))
326 (defun elmo-msgdb-max-of-killed (killed-list)
327 (let ((klist killed-list
)
333 (if (consp (car klist
))
337 (setq klist
(cdr klist
)))
340 (defun elmo-living-messages (messages killed-list
)
343 (mapcar (lambda (number)
344 (unless (elmo-number-set-member number killed-list
)
349 (defun elmo-msgdb-finfo-load ()
350 (elmo-object-load (expand-file-name
351 elmo-msgdb-finfo-filename
352 elmo-msgdb-directory
)
353 elmo-mime-charset t
))
355 (defun elmo-msgdb-finfo-save (finfo)
356 (elmo-object-save (expand-file-name
357 elmo-msgdb-finfo-filename
358 elmo-msgdb-directory
)
359 finfo elmo-mime-charset
))
361 (defun elmo-msgdb-flist-load (fname)
362 (let ((flist-file (expand-file-name
363 elmo-msgdb-flist-filename
365 (elmo-safe-filename fname
)
366 (expand-file-name "folder" elmo-msgdb-directory
)))))
367 (elmo-object-load flist-file elmo-mime-charset t
)))
369 (defun elmo-msgdb-flist-save (fname flist
)
370 (let ((flist-file (expand-file-name
371 elmo-msgdb-flist-filename
373 (elmo-safe-filename fname
)
374 (expand-file-name "folder" elmo-msgdb-directory
)))))
375 (elmo-object-save flist-file flist elmo-mime-charset
)))
377 (defun elmo-crosspost-alist-load ()
378 (elmo-object-load (expand-file-name
379 elmo-crosspost-alist-filename
380 elmo-msgdb-directory
)
383 (defun elmo-crosspost-alist-save (alist)
384 (elmo-object-save (expand-file-name
385 elmo-crosspost-alist-filename
386 elmo-msgdb-directory
)
389 (defsubst elmo-folder-get-info
(folder &optional hashtb
)
390 (elmo-get-hash-val folder
391 (or hashtb elmo-folder-info-hashtb
)))
393 (defun elmo-folder-get-info-max (folder)
394 "Get folder info from cache."
395 (nth 3 (elmo-folder-get-info folder
)))
397 (defun elmo-folder-get-info-length (folder)
398 (nth 2 (elmo-folder-get-info folder
)))
400 (defun elmo-folder-get-info-unread (folder)
401 (nth 1 (elmo-folder-get-info folder
)))
403 (defsubst elmo-msgdb-location-load
(dir)
406 elmo-msgdb-location-filename
409 (defsubst elmo-msgdb-location-add
(alist number location
)
410 (let ((ret-val alist
))
412 (elmo-msgdb-append-element ret-val
(cons number location
)))
415 (defsubst elmo-msgdb-location-save
(dir alist
)
418 elmo-msgdb-location-filename
421 ;;; For backward compatibility.
422 (defsubst elmo-msgdb-overview-entity-get-number
(entity)
423 (elmo-message-entity-number entity
))
425 (defsubst elmo-msgdb-overview-entity-set-number
(entity number
)
426 (elmo-message-entity-set-number entity number
))
428 (defsubst elmo-msgdb-overview-entity-get-references
(entity)
429 (elmo-message-entity-field entity
'references
))
431 (defsubst elmo-msgdb-overview-entity-set-references
(entity references
)
432 (elmo-message-entity-set-field entity
'references references
))
434 (defsubst elmo-msgdb-overview-entity-get-from-no-decode
(entity)
435 (elmo-with-enable-multibyte
436 (encode-mime-charset-string
437 (elmo-message-entity-field entity
'from
) elmo-mime-charset
)))
439 (defsubst elmo-msgdb-overview-entity-get-from
(entity)
440 (elmo-message-entity-field entity
'from
))
442 (defsubst elmo-msgdb-overview-entity-set-from
(entity from
)
443 (elmo-message-entity-set-field entity
'from from
))
445 (defsubst elmo-msgdb-overview-entity-get-subject
(entity)
446 (elmo-message-entity-field entity
'subject
))
448 (defsubst elmo-msgdb-overview-entity-get-subject-no-decode
(entity)
449 (elmo-with-enable-multibyte
450 (encode-mime-charset-string
451 (elmo-message-entity-field entity
'subject
) elmo-mime-charset
)))
453 (defsubst elmo-msgdb-overview-entity-set-subject
(entity subject
)
454 (elmo-message-entity-set-field entity
'subject subject
))
456 (defsubst elmo-msgdb-overview-entity-get-date
(entity)
457 (elmo-message-entity-field entity
'date
'string
))
459 (defsubst elmo-msgdb-overview-entity-set-date
(entity date
)
460 (elmo-message-entity-set-field entity
'date date
))
462 (defsubst elmo-msgdb-overview-entity-get-to
(entity)
463 (elmo-message-entity-field entity
'to
'string
))
465 (defsubst elmo-msgdb-overview-entity-get-cc
(entity)
466 (elmo-message-entity-field entity
'cc
'string
))
468 (defsubst elmo-msgdb-overview-entity-get-size
(entity)
469 (elmo-message-entity-field entity
'size
))
471 (defsubst elmo-msgdb-overview-entity-set-size
(entity size
)
472 (elmo-message-entity-set-field entity
'size size
))
474 (defsubst elmo-msgdb-overview-entity-get-extra
(entity)
478 (defsubst elmo-msgdb-overview-entity-set-extra
(entity extra
)
482 (defsubst elmo-msgdb-overview-entity-get-extra-field
(entity
484 (elmo-message-entity-field entity
(intern field-name
)))
486 (defsubst elmo-msgdb-overview-entity-set-extra-field
(entity
489 (elmo-message-entity-set-field entity
(intern field-name
) value
))
492 (product-provide (provide 'elmo-msgdb
) (require 'elmo-version
))
494 ;;; elmo-msgdb.el ends here