1 ;;; elmo-localdir.el -- Localdir Interface for ELMO.
3 ;; Copyright 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
5 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
6 ;; Keywords: mail, net news
8 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
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)
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.
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.
36 (require 'elmo-cache))
39 (defsubst elmo-localdir-get-folder-directory (spec)
40 (if (file-name-absolute-p (nth 1 spec))
41 (nth 1 spec) ; already full path.
42 (expand-file-name (nth 1 spec)
43 (cond ((eq (car spec) 'localnews)
44 elmo-localnews-folder-path)
46 elmo-localdir-folder-path)))))
48 (defun elmo-localdir-msgdb-expand-path (spec)
49 (let ((fld-name (nth 1 spec)))
50 (expand-file-name fld-name
51 (expand-file-name "localdir"
54 (defun elmo-localdir-number-to-filename (spec dir number &optional loc-alist)
55 (expand-file-name (int-to-string number) dir))
57 (if (boundp 'nemacs-version)
58 (defsubst elmo-localdir-insert-header (file)
59 "Insert the header of the article (Does not work on nemacs)."
61 (insert-file-contents file)))
62 (defsubst elmo-localdir-insert-header (file)
63 "Insert the header of the article."
65 insert-file-contents-pre-hook ; To avoid autoconv-xmas...
66 insert-file-contents-post-hook
68 (when (file-exists-p file)
69 ;; Read until header separator is found.
70 (while (and (eq elmo-localdir-header-chop-length
75 (incf beg elmo-localdir-header-chop-length)))))
76 (prog1 (not (search-forward "\n\n" nil t))
77 (goto-char (point-max)))))))))
80 (defsubst elmo-localdir-msgdb-create-overview-entity-from-file (number file)
82 (let ((tmp-buffer (get-buffer-create " *ELMO LocalDir Temp*"))
83 insert-file-contents-pre-hook ; To avoid autoconv-xmas...
84 insert-file-contents-post-hook header-end
85 (attrib (file-attributes file))
87 (set-buffer tmp-buffer)
89 (if (not (file-exists-p file))
91 (setq size (nth 7 attrib))
92 (setq mtime (timezone-make-date-arpa-standard
93 (current-time-string (nth 5 attrib)) (current-time-zone)))
94 ;; insert header from file.
97 (elmo-localdir-insert-header file)
98 (error (throw 'done nil)))
99 (goto-char (point-min))
101 (if (re-search-forward "\\(^--.*$\\)\\|\\(\n\n\\)" nil t)
104 (narrow-to-region (point-min) header-end)
105 (setq ret-val (elmo-msgdb-create-overview-from-buffer number size mtime))
106 (kill-buffer tmp-buffer))
110 (defun elmo-localdir-msgdb-create-entity (dir number)
111 (elmo-localdir-msgdb-create-overview-entity-from-file
112 number (expand-file-name (int-to-string number) dir)))
114 (defun elmo-localdir-msgdb-create-as-numlist (spec numlist new-mark
115 already-mark seen-mark
116 important-mark seen-list)
118 (let ((dir (elmo-localdir-get-folder-directory spec))
119 overview number-alist mark-alist entity message-id
122 (len (length numlist)))
123 (message "Creating msgdb...")
126 (elmo-localdir-msgdb-create-entity
130 (setq num (elmo-msgdb-overview-entity-get-number entity))
132 (elmo-msgdb-append-element
134 (setq message-id (elmo-msgdb-overview-entity-get-id entity))
136 (elmo-msgdb-number-add number-alist
139 (setq seen (member message-id seen-list))
140 (if (setq gmark (or (elmo-msgdb-global-mark-get message-id)
141 (if (elmo-cache-exists-p message-id) ; XXX
149 (elmo-msgdb-mark-append
153 (when (> len elmo-display-progress-threshold)
155 (elmo-display-progress
156 'elmo-localdir-msgdb-create-as-numlist "Creating msgdb..."
158 (setq numlist (cdr numlist)))
159 (message "Creating msgdb...done")
160 (list overview number-alist mark-alist))))
162 (defalias 'elmo-localdir-msgdb-create 'elmo-localdir-msgdb-create-as-numlist)
164 (defvar elmo-localdir-list-folders-spec-string "+")
165 (defvar elmo-localdir-list-folders-filter-regexp "^\\(\\.\\.?\\|[0-9]+\\)$")
167 (defun elmo-localdir-list-folders (spec &optional hierarchy)
168 (let ((folder (concat elmo-localdir-list-folders-spec-string (nth 1 spec))))
169 (elmo-localdir-list-folders-subr folder hierarchy)))
171 (defun elmo-localdir-list-folders-subr (folder &optional hierarchy)
172 (let ((case-fold-search t)
173 (w32-get-true-file-link-count t) ; for Meadow
174 folders curdir dirent relpath abspath attr
179 (expand-file-name (nth 1 (elmo-folder-get-spec folder))
180 elmo-localdir-folder-path))
181 (if (string-match "^[+=$.]$" folder) ; localdir, archive, localnews
182 (setq subprefix folder)
183 (setq subprefix (concat folder elmo-path-sep))
185 (setq folders (list folder)))
186 (setq dirent (directory-files curdir))
189 (setq relpath (car dirent))
190 (setq dirent (cdr dirent))
191 (setq abspath (expand-file-name relpath curdir))
194 elmo-localdir-list-folders-filter-regexp
196 (eq (nth 0 (setq attr (file-attributes abspath))) t)
197 (if (eq hierarchy 'check)
198 (throw 'done (nconc folders t))
200 (setq subfolder (concat subprefix relpath))
201 (setq folders (nconc folders
203 (if elmo-have-link-count
206 (elmo-localdir-list-folders-subr
208 (list (list subfolder))
212 (and elmo-have-link-count (>= 2 (nth 1 attr)))
214 (nconc folders (cdr (elmo-localdir-list-folders-subr
215 subfolder hierarchy))))))))
217 (file-error folders))))
219 (defsubst elmo-localdir-list-folder-subr (spec &optional nonsort)
220 (let* ((dir (elmo-localdir-get-folder-directory spec))
221 (flist (mapcar 'string-to-int
222 (directory-files dir nil "^[0-9]+$" t)))
223 (killed (and elmo-use-killed-list
224 (elmo-msgdb-killed-list-load
225 (elmo-msgdb-expand-path spec))))
228 (cons (or (elmo-max-of-list flist) 0)
231 (elmo-msgdb-killed-list-length killed))
233 (setq numbers (sort flist '<))
234 (elmo-living-messages numbers killed))))
236 (defun elmo-localdir-append-msg (spec string &optional msg no-see)
237 (let ((dir (elmo-localdir-get-folder-directory spec))
238 (tmp-buffer (get-buffer-create " *ELMO Temp buffer*"))
240 (1+ (car (elmo-localdir-max-of-folder spec)))))
243 (set-buffer tmp-buffer)
245 (setq filename (expand-file-name (int-to-string
249 (if (file-writable-p filename)
252 (as-binary-output-file
253 (write-region (point-min) (point-max) filename nil 'no-msg))
257 (kill-buffer tmp-buffer)))))
259 (defun elmo-localdir-delete-msg (spec number)
261 (dir (elmo-localdir-get-folder-directory spec))
262 (number (int-to-string number)))
263 (setq file (expand-file-name number dir))
264 (if (and (string-match "[0-9]+" number) ; for safety.
266 (file-writable-p file)
267 (not (file-directory-p file)))
268 (progn (delete-file file)
271 (defun elmo-localdir-read-msg (spec number outbuf &optional set-mark)
273 (let* ((number (int-to-string number))
274 (dir (elmo-localdir-get-folder-directory spec))
275 (file (expand-file-name number dir)))
278 (when (file-exists-p file)
279 (as-binary-input-file (insert-file-contents file))
280 (elmo-delete-cr-get-content-type)))))
282 (defun elmo-localdir-delete-msgs (spec msgs)
283 (mapcar '(lambda (msg) (elmo-localdir-delete-msg spec msg))
286 (defun elmo-localdir-list-folder (spec); called by elmo-localdir-search()
287 (elmo-localdir-list-folder-subr spec))
289 (defun elmo-localdir-max-of-folder (spec)
290 (elmo-localdir-list-folder-subr spec t))
292 (defun elmo-localdir-check-validity (spec validity-file)
293 (let* ((dir (elmo-localdir-get-folder-directory spec))
294 (cur-val (nth 5 (file-attributes dir)))
296 (or (elmo-get-file-string validity-file)
299 ((or (null cur-val) (null file-val)) nil)
300 ((> (car cur-val) (car file-val)) nil)
301 ((= (car cur-val) (car file-val))
302 (if (> (cadr cur-val) (cadr file-val)) nil t)) ; t if same
305 (defun elmo-localdir-sync-validity (spec validity-file)
307 (let* ((dir (elmo-localdir-get-folder-directory spec))
308 (tmp-buffer (get-buffer-create " *ELMO TMP*"))
309 (number-file (expand-file-name elmo-msgdb-number-filename dir)))
310 (set-buffer tmp-buffer)
312 (prin1 (nth 5 (file-attributes dir)) tmp-buffer)
313 (princ "\n" tmp-buffer)
314 (if (file-writable-p validity-file)
315 (write-region (point-min) (point-max)
316 validity-file nil 'no-msg)
317 (message (format "%s is not writable." number-file)))
318 (kill-buffer tmp-buffer))))
320 (defun elmo-localdir-folder-exists-p (spec)
321 (file-directory-p (elmo-localdir-get-folder-directory spec)))
323 (defun elmo-localdir-folder-creatable-p (spec)
326 (defun elmo-localdir-create-folder (spec)
328 (let ((dir (elmo-localdir-get-folder-directory spec)))
329 (if (file-directory-p dir)
331 (if (file-exists-p dir)
332 (error "Create folder failed")
333 (elmo-make-directory dir))
337 (defun elmo-localdir-delete-folder (spec)
338 (let* ((dir (elmo-localdir-get-folder-directory spec)))
339 (if (not (file-directory-p dir))
340 (error "No such directory: %s" dir)
341 (elmo-delete-directory dir t)
344 (defun elmo-localdir-rename-folder (old-spec new-spec)
345 (let* ((old (elmo-localdir-get-folder-directory old-spec))
346 (new (elmo-localdir-get-folder-directory new-spec))
347 (new-dir (directory-file-name (file-name-directory new))))
348 (if (not (file-directory-p old))
349 (error "No such directory: %s" old)
350 (if (file-exists-p new)
351 (error "Already exists directory: %s" new)
352 (if (not (file-exists-p new-dir))
353 (elmo-make-directory new-dir))
354 (rename-file old new)
357 (defsubst elmo-localdir-field-condition-match (spec condition
359 (elmo-file-field-condition-match
360 (expand-file-name (int-to-string number)
361 (elmo-localdir-get-folder-directory spec))
365 (defun elmo-localdir-search (spec condition &optional from-msgs)
366 (let* ((msgs (or from-msgs (elmo-localdir-list-folder spec)))
369 number-list case-fold-search ret-val)
370 (setq number-list msgs)
372 (if (elmo-localdir-field-condition-match spec condition
373 (car msgs) number-list)
374 (setq ret-val (cons (car msgs) ret-val)))
375 (when (> num elmo-display-progress-threshold)
377 (elmo-display-progress
378 'elmo-localdir-search "Searching..."
380 (setq msgs (cdr msgs)))
383 ;;; (localdir, maildir, localnews) -> localdir
384 (defun elmo-localdir-copy-msgs (dst-spec msgs src-spec
385 &optional loc-alist same-number)
387 (elmo-localdir-get-folder-directory dst-spec))
388 (next-num (1+ (car (elmo-localdir-max-of-folder dst-spec)))))
392 (elmo-call-func src-spec "get-msg-filename" (car msgs) loc-alist)
394 (expand-file-name (int-to-string
395 (if same-number (car msgs) next-num))
397 (if (and (setq msgs (cdr msgs))
400 (if (and (eq (car dst-spec) 'localdir)
401 (elmo-localdir-locked-p))
403 (1+ (car (elmo-localdir-max-of-folder dst-spec)))
407 (defun elmo-localdir-pack-number (spec msgdb arg)
408 (let ((dir (elmo-localdir-get-folder-directory spec))
409 (onum-alist (elmo-msgdb-get-number-alist msgdb))
410 (omark-alist (elmo-msgdb-get-mark-alist msgdb))
411 (new-number 1) ; first ordinal position in localdir
412 flist onum mark new-mark-alist total)
414 (if elmo-pack-number-check-strict
415 (elmo-call-func spec "list-folder") ; allow localnews
416 (mapcar 'car onum-alist)))
417 (setq total (length flist))
419 (when (> total elmo-display-progress-threshold)
420 (elmo-display-progress
421 'elmo-localdir-pack-number "Packing..."
422 (/ (* new-number 100) total)))
423 (setq onum (car flist))
424 (when (not (eq onum new-number)) ; why \=() is wrong..
428 (rename-file (int-to-string onum) (int-to-string new-number) t))
430 (elmo-msgdb-overview-entity-set-number
431 (elmo-msgdb-overview-get-entity onum msgdb)
433 ;; update number-alist
434 (setcar (assq onum onum-alist) new-number))
436 (when (setq mark (cadr (assq onum omark-alist)))
438 (elmo-msgdb-mark-append
441 (setq new-number (1+ new-number))
442 (setq flist (cdr flist)))
443 (message "Packing...done")
444 (list (elmo-msgdb-get-overview msgdb)
447 (elmo-msgdb-get-location msgdb)
449 (elmo-msgdb-make-overview-hashtb (elmo-msgdb-get-overview msgdb)))))
451 (defun elmo-localdir-use-cache-p (spec number)
454 (defun elmo-localdir-local-file-p (spec number)
457 (defun elmo-localdir-get-msg-filename (spec number &optional loc-alist)
459 (int-to-string number)
460 (elmo-localdir-get-folder-directory spec)))
462 (defun elmo-localdir-locked-p ()
463 (if elmo-localdir-lockfile-list
464 (let ((lock elmo-localdir-lockfile-list))
467 (if (file-exists-p (car lock))
469 (setq lock (cdr lock)))))))
471 (defalias 'elmo-localdir-sync-number-alist
472 'elmo-generic-sync-number-alist)
473 (defalias 'elmo-localdir-list-folder-unread
474 'elmo-generic-list-folder-unread)
475 (defalias 'elmo-localdir-list-folder-important
476 'elmo-generic-list-folder-important)
477 (defalias 'elmo-localdir-commit 'elmo-generic-commit)
478 (defalias 'elmo-localdir-folder-diff 'elmo-generic-folder-diff)
481 (product-provide (provide 'elmo-localdir) (require 'elmo-version))
483 ;;; elmo-localdir.el ends here