2f7a27f4f004fd31372a0fa0ffa6e5839f4e6b1c
[elisp/wanderlust.git] / elmo / elmo-internal.el
1 ;;; elmo-internal.el -- Internal Interface for ELMO.
2
3 ;; Copyright 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
4
5 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
6 ;; Keywords: mail, net news
7
8 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
9
10 ;; This program is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
13 ;; any later version.
14 ;;
15 ;; This program is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18 ;; GNU General Public License for more details.
19 ;;
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
24 ;;
25
26 ;;; Commentary:
27 ;; 
28
29 ;;; Code:
30 ;; 
31 (require 'elmo-localdir)
32
33 (defsubst elmo-internal-list-folder-subr (spec &optional nonsort)
34   (let* ((directive (nth 1 spec))
35          (arg (nth 2 spec))
36          (flist (elmo-list-folder-by-location
37                  spec
38                  (elmo-internal-list-location directive arg))))
39     (if nonsort
40         (cons (or (elmo-max-of-list flist) 0)
41               (length flist))
42       (sort flist '<))))
43
44 (defun elmo-internal-list-folder (spec)
45   (elmo-internal-list-folder-subr spec))
46
47 (defun elmo-internal-list-folder-by-location (spec location &optional msgdb)
48   (let* ((path (elmo-msgdb-expand-path nil spec))
49          (location-alist 
50           (if msgdb
51               (elmo-msgdb-get-location msgdb)
52             (elmo-msgdb-location-load path)))
53          (i 0)
54          result pair
55          location-max modified)
56     (setq location-max
57           (or (elmo-max-of-list (mapcar 'car location-alist)) 0))
58     (when location-max
59       (while location
60         (if (setq pair (rassoc (car location) location-alist))
61             (setq result
62                   (append result
63                           (list (cons (car pair) (car location)))))
64           (setq i (1+ i))
65           (setq result (append result
66                                (list 
67                                 (cons (+ location-max i) (car location))))))
68         (setq location (cdr location))))
69     (setq result (sort result '(lambda (x y)
70                                  (< (car x)(car y)))))
71     (if (not (equal result location-alist))
72         (setq modified t))
73     (if modified
74         (elmo-msgdb-location-save path result))
75     (mapcar 'car result)))
76
77 (defun elmo-internal-list-location (directive arg)
78   (let ((mark-alist 
79          (or elmo-msgdb-global-mark-alist
80              (setq elmo-msgdb-global-mark-alist
81                    (elmo-object-load (expand-file-name 
82                                       elmo-msgdb-global-mark-filename
83                                       elmo-msgdb-dir)))))
84         result)
85     (mapcar (function (lambda (x)
86                         (setq result (cons (car x) result))))
87             mark-alist)
88     (nreverse result)))
89
90 (defun elmo-internal-msgdb-create-entity (number loc-alist)
91   (elmo-localdir-msgdb-create-overview-entity-from-file
92    number
93    (elmo-cache-get-path (cdr (assq number loc-alist)))))
94
95 (defun elmo-internal-msgdb-create (spec numlist new-mark 
96                                        already-mark seen-mark 
97                                        important-mark 
98                                        seen-list
99                                        &optional msgdb)
100   (when numlist
101     (let* ((directive (nth 1 spec))
102            (arg       (nth 2 spec))
103            (loc-alist (if msgdb (elmo-msgdb-get-location msgdb)
104                         (elmo-msgdb-location-load (elmo-msgdb-expand-path 
105                                                    nil spec))))
106            (loc-list (elmo-internal-list-location directive arg))
107            overview number-alist mark-alist entity
108            i percent num location pair)
109       (setq num (length numlist))
110       (setq i 0)
111       (message "Creating msgdb...")
112       (while numlist
113         (setq entity
114               (elmo-internal-msgdb-create-entity
115                (car numlist) loc-alist))
116         (if (null entity)
117             ()
118           (setq overview 
119                 (elmo-msgdb-append-element
120                  overview entity))
121           (setq number-alist
122                 (elmo-msgdb-number-add number-alist
123                                        (elmo-msgdb-overview-entity-get-number
124                                         entity)
125                                        (elmo-msgdb-overview-entity-get-id
126                                         entity)))
127           (setq location (cdr (assq (car numlist) loc-alist)))
128           (unless (memq location seen-list)
129             (setq mark-alist
130                   (elmo-msgdb-mark-append
131                    mark-alist 
132                    (elmo-msgdb-overview-entity-get-number
133                     entity)
134                                         ;(nth 0 entity)
135                    (or (elmo-msgdb-global-mark-get 
136                         (elmo-msgdb-overview-entity-get-id
137                          entity))
138                        (if (elmo-cache-exists-p 
139                             (elmo-msgdb-overview-entity-get-id
140                              entity))
141                            already-mark
142                          new-mark))))))
143         (setq i (1+ i))
144         (setq percent (/ (* i 100) num))
145         (elmo-display-progress
146          'elmo-internal-msgdb-create "Creating msgdb..."
147          percent)
148         (setq numlist (cdr numlist)))
149       (message "Creating msgdb...done.")
150       (list overview number-alist mark-alist loc-alist))))
151
152 (defalias 'elmo-internal-msgdb-create-as-numlist 'elmo-internal-msgdb-create)
153
154 (defun elmo-internal-list-folders (spec &optional hierarchy)
155   ;; XXX hard cording.
156   (unless (nth 1 spec) ; toplevel.
157     (list (list "'cache") "'mark")))
158
159 (defvar elmo-internal-mark "$")
160
161 (defun elmo-internal-append-msg (spec string &optional msg no-see)
162   (elmo-set-work-buf
163    (insert string)
164    (let* ((msgid (elmo-field-body "message-id"))
165           (path (elmo-cache-get-path msgid))
166           dir)
167      (when path 
168        (setq dir (directory-file-name (file-name-directory path)))
169        (if (not (file-exists-p dir))
170            (elmo-make-directory dir))
171        (as-binary-output-file (write-region (point-min) (point-max)
172                                             path nil 'no-msg)))
173      (elmo-msgdb-global-mark-set msgid elmo-internal-mark))))
174
175 (defun elmo-internal-delete-msgs (spec msgs &optional msgdb)
176   (let ((loc-alist (if msgdb (elmo-msgdb-get-location msgdb)
177                      (elmo-msgdb-location-load (elmo-msgdb-expand-path 
178                                                 nil spec)))))
179     (mapcar '(lambda (msg) (elmo-internal-delete-msg spec msg
180                                                      loc-alist))
181             msgs)))
182
183 (defun elmo-internal-delete-msg (spec number loc-alist)
184   (let ((pair (assq number loc-alist)))
185     (elmo-msgdb-global-mark-delete (cdr pair))))
186
187 (defun elmo-internal-read-msg (spec number outbuf &optional msgdb)
188   (save-excursion
189     (let* ((loc-alist (if msgdb (elmo-msgdb-get-location msgdb)
190                         (elmo-msgdb-location-load (elmo-msgdb-expand-path 
191                                                    nil spec))))
192            (file (elmo-cache-get-path (cdr (assq number loc-alist)))))
193       (set-buffer outbuf)
194       (erase-buffer)
195       (when (file-exists-p file)
196         (as-binary-input-file (insert-file-contents file))
197         (elmo-delete-cr-get-content-type)))))
198
199 (defun elmo-internal-max-of-folder (spec)
200   (elmo-internal-list-folder-subr spec t))
201
202 (defun elmo-internal-check-validity (spec)
203   nil)
204
205 (defun elmo-internal-sync-validity (spec)
206   nil)
207
208 (defun elmo-internal-folder-exists-p (spec)
209   t)
210
211 (defun elmo-internal-folder-creatable-p (spec)
212   nil)
213
214 (defun elmo-internal-create-folder (spec)
215   nil)
216
217 (defun elmo-internal-search (spec condition &optional from-msgs msgdb)
218   (let* ((mark-alist 
219          (or elmo-msgdb-global-mark-alist
220              (setq elmo-msgdb-global-mark-alist
221                    (elmo-object-load (expand-file-name 
222                                       elmo-msgdb-global-mark-filename
223                                       elmo-msgdb-dir)))))
224          (loc-alist (if msgdb (elmo-msgdb-get-location msgdb)
225                       (elmo-msgdb-location-load (elmo-msgdb-expand-path 
226                                                  nil spec))))    
227          cache-file
228          ret-val
229          case-fold-search msg
230          percent i num)
231     (setq num (length loc-alist))
232     (setq i 0)
233     (while loc-alist
234       (if (and (setq cache-file (elmo-cache-exists-p (cdr (car loc-alist))))
235                (elmo-file-field-condition-match cache-file
236                                                 condition))
237           (setq ret-val (append ret-val (list (car (car loc-alist))))))
238       (setq i (1+ i))
239       (setq percent (/ (* i 100) num))
240       (elmo-display-progress
241        'elmo-internal-search "Searching..."
242        percent)
243       (setq loc-alist (cdr loc-alist)))
244     ret-val))
245
246 (defun elmo-internal-use-cache-p (spec number)
247   nil)
248
249 (defun elmo-internal-local-file-p (spec number)
250   nil ;; XXXX
251   )
252
253 (defalias 'elmo-internal-sync-number-alist 'elmo-generic-sync-number-alist)
254 (defalias 'elmo-internal-list-folder-unread 
255   'elmo-generic-list-folder-unread)
256 (defalias 'elmo-internal-list-folder-important
257   'elmo-generic-list-folder-important)
258 (defalias 'elmo-internal-commit 'elmo-generic-commit)
259
260 (provide 'elmo-internal)
261
262 ;;; elmo-internal.el ends here