1 ;;; elmo-localdir.el -- Localdir Interface for ELMO.
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>
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
12 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
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)
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.
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.
40 (require 'elmo-cache))
43 (defsubst elmo-localdir-get-folder-directory (spec)
44 (if (file-name-absolute-p (nth 1 spec))
45 (nth 1 spec) ; already full path.
46 (expand-file-name (nth 1 spec)
47 (cond ((eq (car spec) 'localnews)
48 elmo-localnews-folder-path)
50 elmo-localdir-folder-path)))))
52 (defun elmo-localdir-msgdb-expand-path (spec)
53 (let ((fld-name (nth 1 spec)))
54 (expand-file-name fld-name
55 (expand-file-name "localdir"
58 (defun elmo-localdir-number-to-filename (spec dir number &optional loc-alist)
59 (expand-file-name (int-to-string number) dir))
61 (if (boundp 'nemacs-version)
62 (defsubst elmo-localdir-insert-header (file)
63 "Insert the header of the article (Does not work on nemacs)."
65 (insert-file-contents file)))
66 (defsubst elmo-localdir-insert-header (file)
67 "Insert the header of the article."
69 insert-file-contents-pre-hook ; To avoid autoconv-xmas...
70 insert-file-contents-post-hook
72 (when (file-exists-p file)
73 ;; Read until header separator is found.
74 (while (and (eq elmo-localdir-header-chop-length
79 (incf beg elmo-localdir-header-chop-length)))))
80 (prog1 (not (search-forward "\n\n" nil t))
81 (goto-char (point-max)))))))))
84 (defsubst elmo-localdir-msgdb-create-overview-entity-from-file (number file)
86 (let ((tmp-buffer (get-buffer-create " *ELMO LocalDir Temp*"))
87 insert-file-contents-pre-hook ; To avoid autoconv-xmas...
88 insert-file-contents-post-hook header-end
89 (attrib (file-attributes file))
91 (set-buffer tmp-buffer)
93 (if (not (file-exists-p file))
95 (setq size (nth 7 attrib))
96 (setq mtime (timezone-make-date-arpa-standard
97 (current-time-string (nth 5 attrib)) (current-time-zone)))
98 ;; insert header from file.
101 (elmo-localdir-insert-header file)
102 (error (throw 'done nil)))
103 (goto-char (point-min))
105 (if (re-search-forward "\\(^--.*$\\)\\|\\(\n\n\\)" nil t)
108 (narrow-to-region (point-min) header-end)
109 (setq ret-val (elmo-msgdb-create-overview-from-buffer number size mtime))
110 (kill-buffer tmp-buffer))
114 (defun elmo-localdir-msgdb-create-entity (dir number)
115 (elmo-localdir-msgdb-create-overview-entity-from-file
116 number (expand-file-name (int-to-string number) dir)))
118 (defun elmo-localdir-msgdb-create-as-numlist (spec numlist new-mark
119 already-mark seen-mark
120 important-mark seen-list)
122 (let ((dir (elmo-localdir-get-folder-directory spec))
123 overview number-alist mark-alist entity message-id
126 (len (length numlist)))
127 (message "Creating msgdb...")
130 (elmo-localdir-msgdb-create-entity
134 (setq num (elmo-msgdb-overview-entity-get-number entity))
136 (elmo-msgdb-append-element
138 (setq message-id (elmo-msgdb-overview-entity-get-id entity))
140 (elmo-msgdb-number-add number-alist
143 (setq seen (member message-id seen-list))
144 (if (setq gmark (or (elmo-msgdb-global-mark-get message-id)
145 (if (elmo-cache-exists-p message-id) ; XXX
153 (elmo-msgdb-mark-append
157 (when (> len elmo-display-progress-threshold)
159 (elmo-display-progress
160 'elmo-localdir-msgdb-create-as-numlist "Creating msgdb..."
162 (setq numlist (cdr numlist)))
163 (message "Creating msgdb...done")
164 (list overview number-alist mark-alist))))
166 (defalias 'elmo-localdir-msgdb-create 'elmo-localdir-msgdb-create-as-numlist)
168 (defvar elmo-localdir-list-folders-spec-string "+")
169 (defvar elmo-localdir-list-folders-filter-regexp "^\\(\\.\\.?\\|[0-9]+\\)$")
171 (defun elmo-localdir-list-folders (spec &optional hierarchy)
172 (let ((folder (concat elmo-localdir-list-folders-spec-string (nth 1 spec))))
173 (elmo-localdir-list-folders-subr folder hierarchy)))
175 (defun elmo-localdir-list-folders-subr (folder &optional hierarchy)
176 (let ((case-fold-search t)
177 (w32-get-true-file-link-count t) ; for Meadow
178 folders curdir dirent relpath abspath attr
183 (expand-file-name (nth 1 (elmo-folder-get-spec folder))
184 elmo-localdir-folder-path))
185 (if (string-match "^[+=$.]$" folder) ; localdir, archive, localnews
186 (setq subprefix folder)
187 (setq subprefix (concat folder elmo-path-sep))
189 (setq folders (list folder)))
190 (setq dirent (directory-files curdir))
193 (setq relpath (car dirent))
194 (setq dirent (cdr dirent))
195 (setq abspath (expand-file-name relpath curdir))
198 elmo-localdir-list-folders-filter-regexp
200 (eq (nth 0 (setq attr (file-attributes abspath))) t)
201 (if (eq hierarchy 'check)
202 (throw 'done (nconc folders t))
204 (setq subfolder (concat subprefix relpath))
205 (setq folders (nconc folders
207 (if elmo-have-link-count
210 (elmo-localdir-list-folders-subr
212 (list (list subfolder))
216 (and elmo-have-link-count (>= 2 (nth 1 attr)))
218 (nconc folders (cdr (elmo-localdir-list-folders-subr
219 subfolder hierarchy))))))))
221 (file-error folders))))
223 (defsubst elmo-localdir-list-folder-subr (spec &optional nonsort)
224 (let* ((dir (elmo-localdir-get-folder-directory spec))
225 (flist (mapcar 'string-to-int
226 (directory-files dir nil "^[0-9]+$" t)))
227 (killed (and elmo-use-killed-list
228 (elmo-msgdb-killed-list-load
229 (elmo-msgdb-expand-path spec))))
232 (cons (or (elmo-max-of-list flist) 0)
235 (elmo-msgdb-killed-list-length killed))
237 (setq numbers (sort flist '<))
238 (elmo-living-messages numbers killed))))
240 (defun elmo-localdir-append-msg (spec string &optional msg no-see)
241 (let ((dir (elmo-localdir-get-folder-directory spec))
242 (tmp-buffer (get-buffer-create " *ELMO Temp buffer*"))
244 (1+ (car (elmo-localdir-max-of-folder spec)))))
247 (set-buffer tmp-buffer)
249 (setq filename (expand-file-name (int-to-string
253 (if (file-writable-p filename)
256 (as-binary-output-file
257 (write-region (point-min) (point-max) filename nil 'no-msg))
261 (kill-buffer tmp-buffer)))))
263 (defun elmo-localdir-delete-msg (spec number)
265 (dir (elmo-localdir-get-folder-directory spec))
266 (number (int-to-string number)))
267 (setq file (expand-file-name number dir))
268 (if (and (string-match "[0-9]+" number) ; for safety.
270 (file-writable-p file)
271 (not (file-directory-p file)))
272 (progn (delete-file file)
275 (defun elmo-localdir-read-msg (spec number outbuf &optional msgdb unread)
277 (let* ((number (int-to-string number))
278 (dir (elmo-localdir-get-folder-directory spec))
279 (file (expand-file-name number dir)))
282 (when (file-exists-p file)
283 (as-binary-input-file (insert-file-contents file))
284 (elmo-delete-cr-get-content-type)))))
286 (defun elmo-localdir-delete-msgs (spec msgs)
287 (mapcar '(lambda (msg) (elmo-localdir-delete-msg spec msg))
290 (defun elmo-localdir-list-folder (spec &optional nohide); called by elmo-localdir-search()
291 (elmo-localdir-list-folder-subr spec))
293 (defun elmo-localdir-max-of-folder (spec)
294 (elmo-localdir-list-folder-subr spec t))
296 (defun elmo-localdir-check-validity (spec validity-file)
297 (let* ((dir (elmo-localdir-get-folder-directory spec))
298 (cur-val (nth 5 (file-attributes dir)))
300 (or (elmo-get-file-string validity-file)
303 ((or (null cur-val) (null file-val)) nil)
304 ((> (car cur-val) (car file-val)) nil)
305 ((= (car cur-val) (car file-val))
306 (if (> (cadr cur-val) (cadr file-val)) nil t)) ; t if same
309 (defun elmo-localdir-sync-validity (spec validity-file)
311 (let* ((dir (elmo-localdir-get-folder-directory spec))
312 (tmp-buffer (get-buffer-create " *ELMO TMP*"))
313 (number-file (expand-file-name elmo-msgdb-number-filename dir)))
314 (set-buffer tmp-buffer)
316 (prin1 (nth 5 (file-attributes dir)) tmp-buffer)
317 (princ "\n" tmp-buffer)
318 (if (file-writable-p validity-file)
319 (write-region (point-min) (point-max)
320 validity-file nil 'no-msg)
321 (message (format "%s is not writable." number-file)))
322 (kill-buffer tmp-buffer))))
324 (defun elmo-localdir-folder-exists-p (spec)
325 (file-directory-p (elmo-localdir-get-folder-directory spec)))
327 (defun elmo-localdir-folder-creatable-p (spec)
330 (defun elmo-localdir-create-folder (spec)
332 (let ((dir (elmo-localdir-get-folder-directory spec)))
333 (if (file-directory-p dir)
335 (if (file-exists-p dir)
336 (error "Create folder failed")
337 (elmo-make-directory dir))
341 (defun elmo-localdir-delete-folder (spec)
342 (let* ((dir (elmo-localdir-get-folder-directory spec)))
343 (if (not (file-directory-p dir))
344 (error "No such directory: %s" dir)
345 (elmo-delete-directory dir t)
348 (defun elmo-localdir-rename-folder (old-spec new-spec)
349 (let* ((old (elmo-localdir-get-folder-directory old-spec))
350 (new (elmo-localdir-get-folder-directory new-spec))
351 (new-dir (directory-file-name (file-name-directory new))))
352 (if (not (file-directory-p old))
353 (error "No such directory: %s" old)
354 (if (file-exists-p new)
355 (error "Already exists directory: %s" new)
356 (if (not (file-exists-p new-dir))
357 (elmo-make-directory new-dir))
358 (rename-file old new)
361 (defsubst elmo-localdir-field-primitive-condition-match (spec
366 (goto-char (point-min))
368 ((string= (elmo-filter-key condition) "last")
369 (setq result (<= (length (memq number number-list))
370 (string-to-int (elmo-filter-value condition)))))
371 ((string= (elmo-filter-key condition) "first")
372 (setq result (< (- (length number-list)
373 (length (memq number number-list)))
374 (string-to-int (elmo-filter-value condition)))))
377 (as-binary-input-file (insert-file-contents
379 (int-to-string number)
380 (elmo-localdir-get-folder-directory spec))))
381 (elmo-set-buffer-multibyte default-enable-multibyte-characters)
382 ;; Should consider charset?
383 (decode-mime-charset-region (point-min)(point-max) elmo-mime-charset)
385 (elmo-buffer-field-primitive-condition-match
386 condition number number-list)))))
387 (if (eq (elmo-filter-type condition) 'unmatch)
388 (setq result (not result)))
391 (defun elmo-localdir-field-condition-match (spec condition number number-list)
394 (elmo-localdir-field-primitive-condition-match
395 spec condition number number-list))
396 ((eq (car condition) 'and)
397 (and (elmo-localdir-field-condition-match
398 spec (nth 1 condition) number number-list)
399 (elmo-localdir-field-condition-match
400 spec (nth 2 condition) number number-list)))
401 ((eq (car condition) 'or)
402 (or (elmo-localdir-field-condition-match
403 spec (nth 1 condition) number number-list)
404 (elmo-localdir-field-condition-match
405 spec (nth 2 condition) number number-list)))))
407 (defun elmo-localdir-search (spec condition &optional from-msgs)
408 (let* ((msgs (or from-msgs (elmo-localdir-list-folder spec)))
411 last cur number-list case-fold-search ret-val)
414 ((and (vectorp condition)
415 (string= (elmo-filter-key condition) "last"))
416 (nthcdr (max (- (length msgs)
417 (string-to-int (elmo-filter-value condition)))
420 ((and (vectorp condition)
421 (string= (elmo-filter-key condition) "first"))
422 (let ((rest (nthcdr (string-to-int (elmo-filter-value condition) )
425 (delete x msgs)) rest))
428 (setq number-list msgs)
430 (if (elmo-localdir-field-condition-match spec condition
431 (car msgs) number-list)
432 (setq ret-val (cons (car msgs) ret-val)))
433 (when (> num elmo-display-progress-threshold)
435 (setq cur (/ (* i 100) num))
436 (unless (eq cur last)
437 (elmo-display-progress
438 'elmo-localdir-search "Searching..."
441 (setq msgs (cdr msgs)))
442 (nreverse ret-val)))))
444 ;;; (localdir, maildir, localnews) -> localdir
445 (defun elmo-localdir-copy-msgs (dst-spec msgs src-spec
446 &optional loc-alist same-number)
448 (elmo-localdir-get-folder-directory dst-spec))
449 (next-num (1+ (car (elmo-localdir-max-of-folder dst-spec)))))
453 (elmo-call-func src-spec "get-msg-filename" (car msgs) loc-alist)
455 (expand-file-name (int-to-string
456 (if same-number (car msgs) next-num))
458 (if (and (setq msgs (cdr msgs))
461 (if (and (eq (car dst-spec) 'localdir)
462 (elmo-localdir-locked-p))
464 (1+ (car (elmo-localdir-max-of-folder dst-spec)))
468 (defun elmo-localdir-pack-number (spec msgdb arg)
469 (let ((dir (elmo-localdir-get-folder-directory spec))
470 (onum-alist (elmo-msgdb-get-number-alist msgdb))
471 (omark-alist (elmo-msgdb-get-mark-alist msgdb))
472 (new-number 1) ; first ordinal position in localdir
473 flist onum mark new-mark-alist total)
475 (if elmo-pack-number-check-strict
476 (elmo-call-func spec "list-folder") ; allow localnews
477 (mapcar 'car onum-alist)))
478 (setq total (length flist))
480 (when (> total elmo-display-progress-threshold)
481 (elmo-display-progress
482 'elmo-localdir-pack-number "Packing..."
483 (/ (* new-number 100) total)))
484 (setq onum (car flist))
485 (when (not (eq onum new-number)) ; why \=() is wrong..
489 (rename-file (int-to-string onum) (int-to-string new-number) t))
491 (elmo-msgdb-overview-entity-set-number
492 (elmo-msgdb-overview-get-entity onum msgdb)
494 ;; update number-alist
495 (setcar (assq onum onum-alist) new-number))
497 (when (setq mark (cadr (assq onum omark-alist)))
499 (elmo-msgdb-mark-append
502 (setq new-number (1+ new-number))
503 (setq flist (cdr flist)))
504 (message "Packing...done")
505 (list (elmo-msgdb-get-overview msgdb)
508 (elmo-msgdb-get-location msgdb)
510 (elmo-msgdb-make-overview-hashtb (elmo-msgdb-get-overview msgdb)))))
512 (defun elmo-localdir-use-cache-p (spec number)
515 (defun elmo-localdir-local-file-p (spec number)
518 (defun elmo-localdir-get-msg-filename (spec number &optional loc-alist)
520 (int-to-string number)
521 (elmo-localdir-get-folder-directory spec)))
523 (defun elmo-localdir-locked-p ()
524 (if elmo-localdir-lockfile-list
525 (let ((lock elmo-localdir-lockfile-list))
528 (if (file-exists-p (car lock))
530 (setq lock (cdr lock)))))))
532 (defalias 'elmo-localdir-sync-number-alist
533 'elmo-generic-sync-number-alist)
534 (defalias 'elmo-localdir-list-folder-unread
535 'elmo-generic-list-folder-unread)
536 (defalias 'elmo-localdir-list-folder-important
537 'elmo-generic-list-folder-important)
538 (defalias 'elmo-localdir-commit 'elmo-generic-commit)
539 (defalias 'elmo-localdir-folder-diff 'elmo-generic-folder-diff)
542 (product-provide (provide 'elmo-localdir) (require 'elmo-version))
544 ;;; elmo-localdir.el ends here