fe837187a9fe0db20ad8146d8544348af952b847
[elisp/wanderlust.git] / elmo / elmo-localdir.el
1 ;;; elmo-localdir.el --- Localdir Interface for ELMO.
2
3 ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
4 ;; Copyright (C) 1998,1999,2000 Masahiro MURATA <muse@ba2.so-net.ne.jp>
5 ;; Copyright (C) 1999,2000      Kenichi OKADA  <okada@opaopa.org>
6
7 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
8 ;;      Masahiro MURATA <muse@ba2.so-net.ne.jp>
9 ;;      Kenichi OKADA <okada@opaopa.org>
10 ;; Keywords: mail, net news
11
12 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
13
14 ;; This program is free software; you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation; either version 2, or (at your option)
17 ;; any later version.
18 ;;
19 ;; This program is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
22 ;; GNU General Public License for more details.
23 ;;
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
26 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
27 ;; Boston, MA 02111-1307, USA.
28 ;;
29
30 ;;; Commentary:
31 ;;
32
33 ;;; Code:
34 ;;
35 (eval-when-compile (require 'cl))
36
37 (require 'elmo-msgdb)
38 (require 'elmo)
39
40 (defcustom elmo-localdir-folder-path "~/Mail"
41   "*Local mail directory (MH format) path."
42   :type 'directory
43   :group 'elmo)
44
45 (defvar elmo-localdir-lockfile-list nil)
46
47 ;;; ELMO Local directory folder
48 (eval-and-compile
49   (luna-define-class elmo-localdir-folder (elmo-folder)
50                      (dir-name directory))
51   (luna-define-internal-accessors 'elmo-localdir-folder))
52
53 ;;; elmo-localdir specific methods.
54 (luna-define-generic elmo-localdir-folder-path (folder)
55   "Return local directory path of the FOLDER.")
56
57 (luna-define-generic elmo-localdir-folder-name (folder name)
58   "Return directory NAME for FOLDER.")
59
60 (luna-define-method elmo-localdir-folder-path ((folder elmo-localdir-folder))
61   elmo-localdir-folder-path)
62
63 (luna-define-method elmo-localdir-folder-name ((folder elmo-localdir-folder)
64                                                name)
65   name)
66
67 (luna-define-method elmo-folder-initialize ((folder
68                                              elmo-localdir-folder)
69                                             name)
70   (elmo-localdir-folder-set-dir-name-internal folder name)
71   (if (file-name-absolute-p name)
72       (elmo-localdir-folder-set-directory-internal
73        folder
74        (expand-file-name name))
75     (elmo-localdir-folder-set-directory-internal
76      folder
77      (expand-file-name
78       (elmo-localdir-folder-name folder name)
79       (elmo-localdir-folder-path folder))))
80   folder)
81
82 ;; open, check, commit, and close are generic.
83
84 (luna-define-method elmo-folder-exists-p ((folder elmo-localdir-folder))
85   (file-directory-p (elmo-localdir-folder-directory-internal folder)))
86
87 (luna-define-method elmo-folder-expand-msgdb-path ((folder
88                                                     elmo-localdir-folder))
89   (let* ((dir-name (elmo-localdir-folder-dir-name-internal folder))
90          (path (mapconcat
91                 'identity
92                 (delete ""
93                         (mapcar
94                          'elmo-replace-string-as-filename
95                          (split-string
96                           (if (file-name-absolute-p dir-name)
97                               (expand-file-name dir-name)
98                             dir-name)
99                           "/")))
100                 "/")))
101     (expand-file-name
102      path
103      (expand-file-name ;;"localdir" or "localdir-abs"
104       (concat
105        (symbol-name (elmo-folder-type-internal folder))
106        (when (file-name-absolute-p dir-name) "-abs"))
107       elmo-msgdb-directory))))
108
109 (luna-define-method elmo-message-file-name ((folder
110                                              elmo-localdir-folder)
111                                             number)
112   (expand-file-name (int-to-string number)
113                     (elmo-localdir-folder-directory-internal folder)))
114
115 (luna-define-method elmo-folder-message-file-number-p ((folder
116                                                         elmo-localdir-folder))
117   t)
118
119 (luna-define-method elmo-folder-message-file-directory ((folder
120                                                          elmo-localdir-folder))
121   (elmo-localdir-folder-directory-internal folder))
122
123 (luna-define-method elmo-folder-message-make-temp-file-p
124   ((folder elmo-localdir-folder))
125   t)
126
127 (luna-define-method elmo-folder-message-make-temp-files ((folder
128                                                           elmo-localdir-folder)
129                                                          numbers
130                                                          &optional
131                                                          start-number)
132   (let ((temp-dir (elmo-folder-make-temporary-directory folder))
133         (cur-number (or start-number 0)))
134     (dolist (number numbers)
135       (elmo-copy-file
136        (expand-file-name
137         (int-to-string number)
138         (elmo-localdir-folder-directory-internal folder))
139        (expand-file-name
140         (int-to-string (if start-number cur-number number))
141         temp-dir))
142       (incf cur-number))
143     temp-dir))
144
145 (defun elmo-localdir-msgdb-create-entity (msgdb dir number)
146   (elmo-msgdb-create-message-entity-from-file
147    (elmo-msgdb-message-entity-handler msgdb)
148    number (expand-file-name (int-to-string number) dir)))
149
150 (luna-define-method elmo-folder-msgdb-create ((folder elmo-localdir-folder)
151                                               numbers
152                                               flag-table)
153   (when numbers
154     (let ((dir (elmo-localdir-folder-directory-internal folder))
155           (new-msgdb (elmo-make-msgdb))
156           entity message-id
157           flags
158           (i 0)
159           (len (length numbers)))
160       (message "Creating msgdb...")
161       (while numbers
162         (setq entity
163               (elmo-localdir-msgdb-create-entity
164                new-msgdb dir (car numbers)))
165         (when entity
166           (setq message-id (elmo-message-entity-field entity 'message-id)
167                 flags (elmo-flag-table-get flag-table message-id))
168           (elmo-global-flags-set flags folder (car numbers) message-id)
169           (elmo-msgdb-append-entity new-msgdb entity flags))
170         (when (> len elmo-display-progress-threshold)
171           (setq i (1+ i))
172           (elmo-display-progress
173            'elmo-localdir-msgdb-create-as-numbers "Creating msgdb..."
174            (/ (* i 100) len)))
175         (setq numbers (cdr numbers)))
176       (message "Creating msgdb...done")
177       new-msgdb)))
178
179 (luna-define-method elmo-folder-list-subfolders ((folder elmo-localdir-folder)
180                                                  &optional one-level)
181   (elmo-mapcar-list-of-list
182    (lambda (x) (concat (elmo-folder-prefix-internal folder) x))
183    (elmo-list-subdirectories
184     (elmo-localdir-folder-path folder)
185     (or (elmo-localdir-folder-dir-name-internal folder) "")
186     one-level)))
187
188 (defsubst elmo-localdir-list-subr (folder &optional nonsort)
189   (let ((flist (mapcar 'string-to-int
190                        (directory-files
191                         (elmo-localdir-folder-directory-internal folder)
192                         nil "^[0-9]+$" t)))
193         (killed (elmo-msgdb-killed-list-load (elmo-folder-msgdb-path folder))))
194     (if nonsort
195         (cons (or (elmo-max-of-list flist) 0)
196               (if killed
197                   (- (length flist)
198                      (elmo-msgdb-killed-list-length killed))
199                 (length flist)))
200       (sort flist '<))))
201
202 (luna-define-method elmo-folder-append-buffer ((folder elmo-localdir-folder)
203                                                &optional flags number)
204   (let ((filename (elmo-message-file-name
205                    folder
206                    (or number
207                        (1+ (car (elmo-folder-status folder)))))))
208     (when (and (file-writable-p filename)
209                (not (file-exists-p filename)))
210       (write-region-as-binary
211        (point-min) (point-max) filename nil 'no-msg)
212       (elmo-folder-preserve-flags
213        folder (elmo-msgdb-get-message-id-from-buffer) flags)
214       t)))
215
216 (luna-define-method elmo-folder-append-messages :around
217   ((folder elmo-localdir-folder)
218    src-folder numbers &optional same-number)
219   (if (elmo-folder-message-file-p src-folder)
220       (let ((src-msgdb-exists (not (zerop (elmo-folder-length src-folder))))
221             (dir (elmo-localdir-folder-directory-internal folder))
222             (table (elmo-folder-flag-table folder))
223             (succeeds numbers)
224             (next-num (1+ (car (elmo-folder-status folder))))
225             flags id)
226         (while numbers
227           (setq flags (elmo-message-flags src-folder (car numbers)))
228           (elmo-copy-file
229            (elmo-message-file-name src-folder (car numbers))
230            (expand-file-name
231             (int-to-string
232              (if same-number (car numbers) next-num))
233             dir))
234           ;; save flag-table only when src folder's msgdb is loaded.
235           (when (setq id (and src-msgdb-exists
236                               (elmo-message-field src-folder (car numbers)
237                                                   'message-id)))
238             (elmo-flag-table-set table id flags))
239           (elmo-progress-notify 'elmo-folder-move-messages)
240           (if (and (setq numbers (cdr numbers))
241                    (not same-number))
242               (setq next-num
243                     (if (elmo-localdir-locked-p)
244                         ;; MDA is running.
245                         (1+ (car (elmo-folder-status folder)))
246                       (1+ next-num)))))
247         (when (elmo-folder-persistent-p folder)
248           (elmo-folder-close-flag-table folder))
249         succeeds)
250     (luna-call-next-method)))
251
252 (luna-define-method elmo-folder-delete-messages ((folder elmo-localdir-folder)
253                                                  numbers)
254   (dolist (number numbers)
255     (elmo-localdir-delete-message folder number))
256   t)
257
258 (defun elmo-localdir-delete-message (folder number)
259   "Delete message in the FOLDER with NUMBER."
260   (let ((filename (elmo-message-file-name folder number)))
261     (when (and (string-match "[0-9]+" filename) ; for safety.
262                (file-exists-p filename)
263                (file-writable-p filename)
264                (not (file-directory-p filename)))
265       (delete-file filename)
266       t)))
267
268 (luna-define-method elmo-message-fetch-internal ((folder elmo-localdir-folder)
269                                                  number strategy
270                                                  &optional section unread)
271   (when (file-exists-p (elmo-message-file-name folder number))
272     (insert-file-contents-as-binary
273      (elmo-message-file-name folder number))))
274
275 (luna-define-method elmo-folder-list-messages-internal
276   ((folder elmo-localdir-folder) &optional nohide)
277   (elmo-localdir-list-subr folder))
278
279 (luna-define-method elmo-folder-status ((folder elmo-localdir-folder))
280   (elmo-localdir-list-subr folder t))
281
282 (luna-define-method elmo-folder-creatable-p ((folder elmo-localdir-folder))
283   t)
284
285 (luna-define-method elmo-folder-writable-p ((folder elmo-localdir-folder))
286   t)
287
288 (luna-define-method elmo-folder-create ((folder elmo-localdir-folder))
289   (let ((dir (elmo-localdir-folder-directory-internal folder)))
290     (if (file-directory-p dir)
291         ()
292       (if (file-exists-p dir)
293           (error "Create folder failed")
294         (elmo-make-directory dir))
295       t)))
296
297 (luna-define-method elmo-folder-delete ((folder elmo-localdir-folder))
298   (let ((msgs (and (elmo-folder-exists-p folder)
299                    (elmo-folder-list-messages folder))))
300     (when (yes-or-no-p (format "%sDelete msgdb and substance of \"%s\"? "
301                                (if (> (length msgs) 0)
302                                    (format "%d msg(s) exists. " (length msgs))
303                                  "")
304                                (elmo-folder-name-internal folder)))
305       (let ((dir (elmo-localdir-folder-directory-internal folder)))
306         (if (not (file-directory-p dir))
307             (error "No such directory: %s" dir)
308           (elmo-delete-match-files dir "[0-9]+" t)))
309       (elmo-msgdb-delete-path folder)
310       t)))
311
312 (luna-define-method elmo-folder-rename-internal ((folder elmo-localdir-folder)
313                                                  new-folder)
314   (let* ((old (elmo-localdir-folder-directory-internal folder))
315          (new (elmo-localdir-folder-directory-internal new-folder))
316          (new-dir (directory-file-name (file-name-directory new))))
317     (unless (file-directory-p old)
318       (error "No such directory: %s" old))
319     (when (file-exists-p new)
320       (error "Already exists directory: %s" new))
321     (unless (file-directory-p new-dir)
322       (elmo-make-directory new-dir))
323     (rename-file old new)
324     t))
325
326 (defsubst elmo-localdir-field-condition-match (folder condition
327                                                       number number-list)
328   (elmo-file-field-condition-match
329    (expand-file-name (int-to-string number)
330                      (elmo-localdir-folder-directory-internal folder))
331    condition number number-list))
332
333 (luna-define-method elmo-folder-pack-numbers ((folder elmo-localdir-folder))
334   (let* ((dir (elmo-localdir-folder-directory-internal folder))
335          (msgdb (elmo-folder-msgdb folder))
336          (new-msgdb (elmo-make-msgdb (elmo-folder-msgdb-path folder)))
337          (numbers (sort (elmo-folder-list-messages
338                          folder
339                          nil
340                          (not elmo-pack-number-check-strict))
341                         '<))
342          (new-number 1)           ; first ordinal position in localdir
343          total entity)
344     (setq total (length numbers))
345     (elmo-with-progress-display (> total elmo-display-progress-threshold)
346         (elmo-folder-pack-numbers total "Packing...")
347       (dolist (old-number numbers)
348         (setq entity (elmo-msgdb-message-entity msgdb old-number))
349         (when (not (eq old-number new-number)) ; why \=() is wrong..
350           (elmo-bind-directory
351            dir
352            ;; xxx  nfs,hardlink
353            (rename-file (int-to-string old-number)
354                         (int-to-string new-number) t))
355           (elmo-message-entity-set-number entity new-number))
356         (elmo-msgdb-append-entity new-msgdb entity
357                                   (elmo-msgdb-flags msgdb old-number))
358         (setq new-number (1+ new-number))))
359     (message "Packing...done")
360     (elmo-folder-set-msgdb-internal folder new-msgdb)))
361
362 (luna-define-method elmo-folder-message-file-p ((folder elmo-localdir-folder))
363   t)
364
365 (luna-define-method elmo-message-file-name ((folder elmo-localdir-folder)
366                                             number)
367   (expand-file-name
368    (int-to-string number)
369    (elmo-localdir-folder-directory-internal folder)))
370
371 (defun elmo-localdir-locked-p ()
372   (if elmo-localdir-lockfile-list
373       (let ((lock elmo-localdir-lockfile-list))
374         (catch 'found
375           (while lock
376             (if (file-exists-p (car lock))
377                 (throw 'found t))
378             (setq lock (cdr lock)))))))
379
380 (autoload 'elmo-global-flags-set "elmo-flag")
381
382 (require 'product)
383 (product-provide (provide 'elmo-localdir) (require 'elmo-version))
384
385 ;;; elmo-localdir.el ends here