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
46 ;; NUMBER elmo-msgdb-get-number MSGDB MESSAGE-ID
47 ;; elmo-msgdb-sort-by-date MSGDB
49 ;; elmo-flag-table-load
50 ;; elmo-flag-table-set
51 ;; elmo-flag-table-get
52 ;; elmo-flag-table-save
54 ;; elmo-msgdb-overview-save DIR OBJ
57 ;; elmo-msgdb-get-parent-entity ENTITY MSGDB
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
67 ;; elmo-msgdb-finfo-load
68 ;; elmo-msgdb-finfo-save
69 ;; elmo-msgdb-flist-load
70 ;; elmo-msgdb-flist-save
72 ;; elmo-crosspost-alist-load
73 ;; elmo-crosspost-alist-save
75 ;; elmo-msgdb-create-overview-from-buffer NUMBER SIZE TIME
76 ;; elmo-msgdb-create-overview-entity-from-file NUMBER FILE
78 ;; elmo-folder-get-info
79 ;; elmo-folder-get-info-max
80 ;; elmo-folder-get-info-length
81 ;; elmo-folder-get-info-unread
83 (defconst elmo-msgdb-load-priorities '(legacy standard)
84 "Priority list of modb type for load.")
86 ;;; Helper functions for MSGDB
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)
94 (delq elmo-msgdb-default-type
95 (copy-sequence elmo-msgdb-load-priorities)))
96 (while (and priorities
98 (setq temp-modb (elmo-make-msgdb location (car priorities))
99 loaded (elmo-msgdb-load temp-modb)
100 priorities (cdr priorities)))
102 (if (eq elmo-msgdb-convert-type 'auto)
103 (elmo-msgdb-append msgdb temp-modb)
104 (setq msgdb temp-modb))))
107 (defun elmo-make-msgdb (&optional location type)
109 (let* ((type (or type elmo-msgdb-default-type))
110 (class (intern (format "modb-%s" type))))
112 (luna-make-entity class
113 :location location)))
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)))
120 (defun elmo-msgdb-sort-by-date (msgdb)
121 (elmo-msgdb-sort-entities
123 (lambda (x y app-data)
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)))
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)))
139 (defsubst elmo-msgdb-append-element (list element)
141 ;;; (append list (list element))
142 (nconc list (list element))
147 ;; number <-> Message-ID handling
149 (defsubst elmo-msgdb-number-add (alist number id)
150 (let ((ret-val alist))
152 (elmo-msgdb-append-element ret-val (cons number id)))
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))
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)
174 ;; Following cases for backward compatibility.
182 (defun elmo-flag-table-set (flag-table msg-id flags)
183 (elmo-set-hash-val msg-id (or flags '(read)) flag-table))
185 (defun elmo-flag-table-get (flag-table msg-id)
186 (let ((flags (elmo-get-hash-val msg-id flag-table)))
189 (and (elmo-file-cache-exists-p msg-id)
191 (elmo-list-delete '(cached read)
192 (copy-sequence flags)
196 (defun elmo-flag-table-save (dir flag-table)
198 (expand-file-name elmo-flag-table-filename dir)
201 (mapatoms (lambda (atom)
202 (setq list (cons (cons (symbol-name atom)
208 ;; persistent mark handling
211 (defun elmo-msgdb-mark-append (alist id mark)
213 (setq alist (elmo-msgdb-append-element alist
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))))
221 (dolist (number (elmo-msgdb-list-messages msgdb))
222 (setq entity (elmo-msgdb-message-entity msgdb number))
225 (elmo-msgdb-message-entity-field msgdb entity 'message-id)
226 (elmo-msgdb-flags msgdb number)))
232 (defun elmo-multiple-field-body (name &optional boundary)
235 (std11-narrow-to-header boundary)
236 (goto-char (point-min))
237 (let ((case-fold-search t)
239 (while (re-search-forward (concat "^" name ":[ \t]*") nil t)
242 (list (buffer-substring-no-properties
243 (match-end 0) (std11-field-end))))))
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)))
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)))
289 (elmo-msgdb-match-condition-internal msgdb
292 (elmo-msgdb-flags msgdb number)
297 ;; deleted message handling
299 (defun elmo-msgdb-killed-list-load (dir)
301 (expand-file-name elmo-msgdb-killed-filename dir)
304 (defun elmo-msgdb-killed-list-save (dir killed-list)
306 (expand-file-name elmo-msgdb-killed-filename dir)
309 (defun elmo-msgdb-killed-message-p (killed-list msg)
310 (elmo-number-set-member msg killed-list))
312 (defun elmo-msgdb-set-as-killed (killed-list msg)
313 (elmo-number-set-append killed-list msg))
315 (defun elmo-msgdb-killed-list-length (killed-list)
316 (let ((killed killed-list)
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)))
325 (defun elmo-msgdb-max-of-killed (killed-list)
326 (let ((klist killed-list)
332 (if (consp (car klist))
336 (setq klist (cdr klist)))
339 (defun elmo-living-messages (messages killed-list)
342 (mapcar (lambda (number)
343 (unless (elmo-number-set-member number killed-list)
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))
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))
360 (defun elmo-msgdb-flist-load (fname)
361 (let ((flist-file (expand-file-name
362 elmo-msgdb-flist-filename
364 (elmo-safe-filename fname)
365 (expand-file-name "folder" elmo-msgdb-directory)))))
366 (elmo-object-load flist-file elmo-mime-charset t)))
368 (defun elmo-msgdb-flist-save (fname flist)
369 (let ((flist-file (expand-file-name
370 elmo-msgdb-flist-filename
372 (elmo-safe-filename fname)
373 (expand-file-name "folder" elmo-msgdb-directory)))))
374 (elmo-object-save flist-file flist elmo-mime-charset)))
376 (defun elmo-crosspost-alist-load ()
377 (elmo-object-load (expand-file-name
378 elmo-crosspost-alist-filename
379 elmo-msgdb-directory)
382 (defun elmo-crosspost-alist-save (alist)
383 (elmo-object-save (expand-file-name
384 elmo-crosspost-alist-filename
385 elmo-msgdb-directory)
388 (defun elmo-msgdb-get-message-id-from-buffer ()
389 (let ((msgid (elmo-field-body "message-id")))
391 (if (string-match "<\\(.+\\)>$" 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"))) ">"))))
400 (defsubst elmo-folder-get-info (folder &optional hashtb)
401 (elmo-get-hash-val folder
402 (or hashtb elmo-folder-info-hashtb)))
404 (defun elmo-folder-get-info-max (folder)
405 "Get folder info from cache."
406 (nth 3 (elmo-folder-get-info folder)))
408 (defun elmo-folder-get-info-length (folder)
409 (nth 2 (elmo-folder-get-info folder)))
411 (defun elmo-folder-get-info-unread (folder)
412 (nth 1 (elmo-folder-get-info folder)))
414 (defsubst elmo-msgdb-location-load (dir)
417 elmo-msgdb-location-filename
420 (defsubst elmo-msgdb-location-add (alist number location)
421 (let ((ret-val alist))
423 (elmo-msgdb-append-element ret-val (cons number location)))
426 (defsubst elmo-msgdb-location-save (dir alist)
429 elmo-msgdb-location-filename
433 (product-provide (provide 'elmo-msgdb) (require 'elmo-version))
435 ;;; elmo-msgdb.el ends here