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)))
206 (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 (setq entity (elmo-msgdb-message-entity msgdb number))
242 (elmo-message-entity-field entity 'message-id)
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 (defun elmo-msgdb-get-message-id-from-buffer ()
373 (let ((msgid (elmo-field-body "message-id")))
375 (if (string-match "<\\(.+\\)>$" msgid)
377 (concat "<" msgid ">")) ; Invaild message-id.
378 ;; no message-id, so put dummy msgid.
379 (concat "<" (timezone-make-date-sortable
380 (elmo-field-body "date"))
381 (nth 1 (eword-extract-address-components
382 (or (elmo-field-body "from") "nobody"))) ">"))))
384 (defsubst elmo-folder-get-info (folder &optional hashtb)
385 (elmo-get-hash-val folder
386 (or hashtb elmo-folder-info-hashtb)))
388 (defun elmo-folder-get-info-max (folder)
389 "Get folder info from cache."
390 (nth 3 (elmo-folder-get-info folder)))
392 (defun elmo-folder-get-info-length (folder)
393 (nth 2 (elmo-folder-get-info folder)))
395 (defun elmo-folder-get-info-unread (folder)
396 (nth 1 (elmo-folder-get-info folder)))
398 (defsubst elmo-msgdb-location-load (dir)
401 elmo-msgdb-location-filename
404 (defsubst elmo-msgdb-location-add (alist number location)
405 (let ((ret-val alist))
407 (elmo-msgdb-append-element ret-val (cons number location)))
410 (defsubst elmo-msgdb-location-save (dir alist)
413 elmo-msgdb-location-filename
417 (product-provide (provide 'elmo-msgdb) (require 'elmo-version))
419 ;;; elmo-msgdb.el ends here