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
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 decode)
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 DECODE is non-nil, returned value is decoded."
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 (raw)."
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)
112 "Load the MSGDB from PATH."
113 (let ((msgdb (elmo-make-msgdb location elmo-msgdb-default-type))
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 (car priorities))
122 loaded (elmo-msgdb-load temp-modb)
123 priorities (cdr priorities)))
125 (if (eq elmo-msgdb-convert-type 'auto)
126 (elmo-msgdb-append msgdb temp-modb)
127 (setq msgdb temp-modb))))
130 (defun elmo-make-msgdb (&optional location type)
132 (let* ((type (or type elmo-msgdb-default-type))
133 (class (intern (format "modb-%s" type))))
135 (luna-make-entity class
136 :location location)))
138 (defun elmo-msgdb-sort-by-date (msgdb)
139 (elmo-msgdb-sort-entities
141 (lambda (x y app-data)
144 (timezone-make-date-sortable
145 (elmo-message-entity-field x 'date))
146 (timezone-make-date-sortable
147 (elmo-message-entity-field y 'date)))
150 (defsubst elmo-msgdb-get-parent-entity (entity msgdb)
151 (setq entity (elmo-message-entity-field entity 'references))
152 ;; entity is parent-id.
153 (and entity (elmo-msgdb-message-entity msgdb entity)))
156 (defsubst elmo-msgdb-append-element (list element)
158 ;;; (append list (list element))
159 (nconc list (list element))
164 ;; number <-> Message-ID handling
166 (defsubst elmo-msgdb-number-add (alist number id)
167 (let ((ret-val alist))
169 (elmo-msgdb-append-element ret-val (cons number id)))
174 (defvar elmo-flag-table-filename "flag-table")
175 (defun elmo-flag-table-load (dir)
176 "Load flag hashtable for MSGDB."
177 (let ((table (elmo-make-hash))
178 ;; For backward compatibility
179 (seen-file (expand-file-name elmo-msgdb-seen-filename dir))
181 (when (file-exists-p seen-file)
182 (dolist (msgid (elmo-object-load seen-file))
183 (elmo-set-hash-val msgid '(read) table))
184 (delete-file seen-file))
185 (dolist (pair (elmo-object-load
186 (expand-file-name elmo-flag-table-filename dir)))
187 (setq value (cdr pair))
188 (elmo-set-hash-val (car pair)
191 ;; Following cases for backward compatibility.
199 (defun elmo-flag-table-set (flag-table msg-id flags)
200 (elmo-set-hash-val msg-id (or flags '(read)) flag-table))
202 (defun elmo-flag-table-get (flag-table msg-id)
203 (let ((flags (elmo-get-hash-val msg-id flag-table)))
205 (and (elmo-file-cache-exists-p msg-id)
208 (elmo-list-delete '(cached read)
209 (copy-sequence flags)
213 (defun elmo-flag-table-save (dir flag-table)
215 (expand-file-name elmo-flag-table-filename dir)
218 (mapatoms (lambda (atom)
219 (setq list (cons (cons (symbol-name atom)
225 ;; persistent mark handling
228 (defun elmo-msgdb-mark-append (alist id mark)
230 (setq alist (elmo-msgdb-append-element alist
233 (defun elmo-msgdb-flag-table (msgdb &optional flag-table)
234 ;; Make a table of msgid flag (read, answered)
235 (let ((flag-table (or flag-table
236 (elmo-make-hash (elmo-msgdb-length msgdb))))
238 (dolist (number (elmo-msgdb-list-messages msgdb))
239 (when (setq msg-id (elmo-message-entity-field
240 (elmo-msgdb-message-entity msgdb number)
242 (elmo-flag-table-set flag-table
244 (elmo-msgdb-flags msgdb number))))
247 (defun elmo-multiple-fields-body-list (field-names &optional boundary)
248 "Return list of each field-bodies of FIELD-NAMES of the message header
249 in current buffer. If BOUNDARY is not nil, it is used as message
253 (std11-narrow-to-header boundary)
254 (let* ((case-fold-search t)
256 field-name field-body)
257 (while (setq field-name (car s-rest))
258 (goto-char (point-min))
259 (while (re-search-forward (concat "^" field-name ":[ \t]*") nil t)
262 (list (buffer-substring-no-properties
263 (match-end 0) (std11-field-end))))))
264 (setq s-rest (cdr s-rest)))
267 (defsubst elmo-msgdb-remove-field-string (string)
268 (if (string-match (concat std11-field-head-regexp "[ \t]*") string)
269 (substring string (match-end 0))
272 (defsubst elmo-msgdb-seen-load (dir)
273 (elmo-object-load (expand-file-name
274 elmo-msgdb-seen-filename
277 (defsubst elmo-msgdb-out-of-date-messages (msgdb)
278 (dolist (number (elmo-msgdb-list-flagged msgdb 'new))
279 (elmo-msgdb-unset-flag msgdb number 'new)))
282 ;; deleted message handling
284 (defun elmo-msgdb-killed-list-load (dir)
286 (expand-file-name elmo-msgdb-killed-filename dir)
289 (defun elmo-msgdb-killed-list-save (dir killed-list)
291 (expand-file-name elmo-msgdb-killed-filename dir)
294 (defun elmo-msgdb-killed-message-p (killed-list msg)
295 (elmo-number-set-member msg killed-list))
297 (defun elmo-msgdb-set-as-killed (killed-list msg)
298 (elmo-number-set-append killed-list msg))
300 (defun elmo-msgdb-killed-list-length (killed-list)
301 (let ((killed killed-list)
304 (if (consp (car killed))
305 (setq ret-val (+ ret-val 1 (- (cdar killed) (caar killed))))
306 (setq ret-val (+ ret-val 1)))
307 (setq killed (cdr killed)))
310 (defun elmo-msgdb-max-of-killed (killed-list)
311 (let ((klist killed-list)
317 (if (consp (car klist))
321 (setq klist (cdr klist)))
324 (defun elmo-living-messages (messages killed-list)
327 (mapcar (lambda (number)
328 (unless (elmo-number-set-member number killed-list)
333 (defun elmo-msgdb-finfo-load ()
334 (elmo-object-load (expand-file-name
335 elmo-msgdb-finfo-filename
336 elmo-msgdb-directory)
337 elmo-mime-charset t))
339 (defun elmo-msgdb-finfo-save (finfo)
340 (elmo-object-save (expand-file-name
341 elmo-msgdb-finfo-filename
342 elmo-msgdb-directory)
343 finfo elmo-mime-charset))
345 (defun elmo-msgdb-flist-load (fname)
346 (let ((flist-file (expand-file-name
347 elmo-msgdb-flist-filename
349 (elmo-safe-filename fname)
350 (expand-file-name "folder" elmo-msgdb-directory)))))
351 (elmo-object-load flist-file elmo-mime-charset t)))
353 (defun elmo-msgdb-flist-save (fname flist)
354 (let ((flist-file (expand-file-name
355 elmo-msgdb-flist-filename
357 (elmo-safe-filename fname)
358 (expand-file-name "folder" elmo-msgdb-directory)))))
359 (elmo-object-save flist-file flist elmo-mime-charset)))
361 (defun elmo-crosspost-alist-load ()
362 (elmo-object-load (expand-file-name
363 elmo-crosspost-alist-filename
364 elmo-msgdb-directory)
367 (defun elmo-crosspost-alist-save (alist)
368 (elmo-object-save (expand-file-name
369 elmo-crosspost-alist-filename
370 elmo-msgdb-directory)
373 (defsubst elmo-folder-get-info (folder &optional hashtb)
374 (elmo-get-hash-val folder
375 (or hashtb elmo-folder-info-hashtb)))
377 (defun elmo-folder-get-info-max (folder)
378 "Get folder info from cache."
379 (nth 3 (elmo-folder-get-info folder)))
381 (defun elmo-folder-get-info-length (folder)
382 (nth 2 (elmo-folder-get-info folder)))
384 (defun elmo-folder-get-info-unread (folder)
385 (nth 1 (elmo-folder-get-info folder)))
387 (defsubst elmo-msgdb-location-load (dir)
390 elmo-msgdb-location-filename
393 (defsubst elmo-msgdb-location-add (alist number location)
394 (let ((ret-val alist))
396 (elmo-msgdb-append-element ret-val (cons number location)))
399 (defsubst elmo-msgdb-location-save (dir alist)
402 elmo-msgdb-location-filename
405 ;;; For backward compatibility.
406 (defsubst elmo-msgdb-overview-entity-get-number (entity)
407 (elmo-message-entity-number entity))
409 (defsubst elmo-msgdb-overview-entity-set-number (entity number)
410 (elmo-message-entity-set-number entity number))
412 (defsubst elmo-msgdb-overview-entity-get-references (entity)
413 (elmo-message-entity-field entity 'references))
415 (defsubst elmo-msgdb-overview-entity-set-references (entity references)
416 (elmo-message-entity-set-field entity 'references references))
418 (defsubst elmo-msgdb-overview-entity-get-from-no-decode (entity)
419 (elmo-message-entity-field entity 'from))
421 (defsubst elmo-msgdb-overview-entity-get-from (entity)
422 (elmo-message-entity-field entity 'from t))
424 (defsubst elmo-msgdb-overview-entity-set-from (entity from)
425 (elmo-message-entity-set-field entity 'from from))
427 (defsubst elmo-msgdb-overview-entity-get-subject (entity)
428 (elmo-message-entity-field entity 'subject t))
430 (defsubst elmo-msgdb-overview-entity-get-subject-no-decode (entity)
431 (elmo-message-entity-field entity 'subject))
433 (defsubst elmo-msgdb-overview-entity-set-subject (entity subject)
434 (elmo-message-entity-set-field entity 'subject subject))
436 (defsubst elmo-msgdb-overview-entity-get-date (entity)
437 (elmo-message-entity-field entity 'date))
439 (defsubst elmo-msgdb-overview-entity-set-date (entity date)
440 (elmo-message-entity-set-field entity 'date date))
442 (defsubst elmo-msgdb-overview-entity-get-to (entity)
443 (elmo-message-entity-field entity 'to))
445 (defsubst elmo-msgdb-overview-entity-get-cc (entity)
446 (elmo-message-entity-field entity 'cc))
448 (defsubst elmo-msgdb-overview-entity-get-size (entity)
449 (elmo-message-entity-field entity 'size))
451 (defsubst elmo-msgdb-overview-entity-set-size (entity size)
452 (elmo-message-entity-set-field entity 'size size))
454 (defsubst elmo-msgdb-overview-entity-get-extra (entity)
458 (defsubst elmo-msgdb-overview-entity-set-extra (entity extra)
462 (defsubst elmo-msgdb-overview-entity-get-extra-field (entity
464 (elmo-message-entity-field entity (intern field-name)))
466 (defsubst elmo-msgdb-overview-entity-set-extra-field (entity
469 (elmo-message-entity-set-field entity (intern field-name) value))
472 (product-provide (provide 'elmo-msgdb) (require 'elmo-version))
474 ;;; elmo-msgdb.el ends here