-;;; elmo-localdir.el -- Localdir Interface for ELMO.
+;;; elmo-localdir.el --- Localdir Interface for ELMO.
-;; Copyright 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
+;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
+;; Copyright (C) 1998,1999,2000 Masahiro MURATA <muse@ba2.so-net.ne.jp>
+;; Copyright (C) 1999,2000 Kenichi OKADA <okada@opaopa.org>
;; Author: Yuuichi Teranishi <teranisi@gohome.org>
+;; Masahiro MURATA <muse@ba2.so-net.ne.jp>
+;; Kenichi OKADA <okada@opaopa.org>
;; Keywords: mail, net news
;; This file is part of ELMO (Elisp Library for Message Orchestration).
;;
;;; Commentary:
-;;
+;;
;;; Code:
-;;
-
-(require 'emu)
-(require 'std11)
+;;
+(eval-when-compile (require 'cl))
-(eval-when-compile
- (require 'elmo-cache))
(require 'elmo-msgdb)
+(require 'elmo)
+
+(defcustom elmo-localdir-folder-path "~/Mail"
+ "*Local mail directory (MH format) path."
+ :type 'directory
+ :group 'elmo)
+
+(defvar elmo-localdir-lockfile-list nil)
+
+;;; ELMO Local directory folder
+(eval-and-compile
+ (luna-define-class elmo-localdir-folder (elmo-folder elmo-file-tag)
+ (dir-name directory))
+ (luna-define-internal-accessors 'elmo-localdir-folder))
+
+;;; elmo-localdir specific methods.
+(luna-define-generic elmo-localdir-folder-path (folder)
+ "Return local directory path of the FOLDER.")
+
+(luna-define-generic elmo-localdir-folder-name (folder name)
+ "Return directory NAME for FOLDER.")
+
+(luna-define-method elmo-localdir-folder-path ((folder elmo-localdir-folder))
+ elmo-localdir-folder-path)
+
+(luna-define-method elmo-localdir-folder-name ((folder elmo-localdir-folder)
+ name)
+ name)
+
+(luna-define-method elmo-folder-initialize ((folder
+ elmo-localdir-folder)
+ name)
+ (elmo-localdir-folder-set-dir-name-internal folder name)
+ (if (file-name-absolute-p name)
+ (elmo-localdir-folder-set-directory-internal
+ folder
+ (expand-file-name name))
+ (elmo-localdir-folder-set-directory-internal
+ folder
+ (expand-file-name
+ (elmo-localdir-folder-name folder name)
+ (elmo-localdir-folder-path folder))))
+ folder)
+
+;; open, check, commit, and close are generic.
+
+(luna-define-method elmo-folder-exists-p ((folder elmo-localdir-folder))
+ (file-directory-p (elmo-localdir-folder-directory-internal folder)))
+
+(luna-define-method elmo-folder-expand-msgdb-path ((folder
+ elmo-localdir-folder))
+ (let* ((dir-name (elmo-localdir-folder-dir-name-internal folder))
+ (path (mapconcat
+ 'identity
+ (delete ""
+ (mapcar
+ 'elmo-replace-string-as-filename
+ (split-string
+ (if (file-name-absolute-p dir-name)
+ (expand-file-name dir-name)
+ dir-name)
+ "/")))
+ "/")))
+ (expand-file-name
+ path
+ (expand-file-name ;;"localdir" or "localdir-abs"
+ (concat
+ (symbol-name (elmo-folder-type-internal folder))
+ (when (file-name-absolute-p dir-name) "-abs"))
+ elmo-msgdb-directory))))
+
+(luna-define-method elmo-message-file-name ((folder
+ elmo-localdir-folder)
+ number)
+ (expand-file-name (number-to-string number)
+ (elmo-localdir-folder-directory-internal folder)))
+
+(luna-define-method elmo-folder-message-file-number-p ((folder
+ elmo-localdir-folder))
+ t)
-(defsubst elmo-localdir-get-folder-directory (spec)
- (if (file-name-absolute-p (nth 1 spec))
- (nth 1 spec) ; already full path.
- (expand-file-name (nth 1 spec)
- (cond ((eq (car spec) 'localnews)
- elmo-localnews-folder-path)
- (t
- elmo-localdir-folder-path)))))
-
-(defun elmo-localdir-msgdb-expand-path (spec)
- (let ((fld-name (nth 1 spec)))
- (expand-file-name fld-name
- (expand-file-name "localdir"
- elmo-msgdb-dir))))
-
-(defun elmo-localdir-number-to-filename (spec dir number &optional loc-alist)
- (expand-file-name (int-to-string number) dir))
-
-(if (boundp 'nemacs-version)
- (defsubst elmo-localdir-insert-header (file)
- "Insert the header of the article (Does not work on nemacs)."
- (as-binary-input-file
- (insert-file-contents file)))
- (defsubst elmo-localdir-insert-header (file)
- "Insert the header of the article."
- (let ((beg 0)
- insert-file-contents-pre-hook ; To avoid autoconv-xmas...
- insert-file-contents-post-hook
- format-alist)
- (when (file-exists-p file)
- ;; Read until header separator is found.
- (while (and (eq elmo-localdir-header-chop-length
- (nth 1
- (as-binary-input-file
- (insert-file-contents
- file nil beg
- (incf beg elmo-localdir-header-chop-length)))))
- (prog1 (not (search-forward "\n\n" nil t))
- (goto-char (point-max)))))))))
-
-
-(defsubst elmo-localdir-msgdb-create-overview-entity-from-file (number file)
- (save-excursion
- (let ((tmp-buffer (get-buffer-create " *ELMO LocalDir Temp*"))
- insert-file-contents-pre-hook ; To avoid autoconv-xmas...
- insert-file-contents-post-hook header-end
- (attrib (file-attributes file))
- ret-val size mtime)
- (set-buffer tmp-buffer)
- (erase-buffer)
- (if (not (file-exists-p file))
- ()
- (setq size (nth 7 attrib))
- (setq mtime (timezone-make-date-arpa-standard
- (current-time-string (nth 5 attrib)) (current-time-zone)))
- ;; insert header from file.
- (catch 'done
- (condition-case nil
- (elmo-localdir-insert-header file)
- (error (throw 'done nil)))
- (goto-char (point-min))
- (setq header-end
- (if (re-search-forward "\\(^--.*$\\)\\|\\(\n\n\\)" nil t)
- (point)
- (point-max)))
- (narrow-to-region (point-min) header-end)
- (setq ret-val (elmo-msgdb-create-overview-from-buffer number size mtime))
- (kill-buffer tmp-buffer))
- ret-val
- ))))
-
-(defun elmo-localdir-msgdb-create-entity (dir number)
- (elmo-localdir-msgdb-create-overview-entity-from-file
- number (expand-file-name (int-to-string number) dir)))
-
-(defun elmo-localdir-msgdb-create-as-numlist (spec numlist new-mark
- already-mark seen-mark
- important-mark seen-list)
- (when numlist
- (let ((dir (elmo-localdir-get-folder-directory spec))
- overview number-alist mark-alist entity message-id
- i percent len num seen gmark)
- (setq len (length numlist))
- (setq i 0)
- (message "Creating msgdb...")
- (while numlist
- (setq entity
- (elmo-localdir-msgdb-create-entity
- dir (car numlist)))
- (if (null entity)
- ()
- (setq num (elmo-msgdb-overview-entity-get-number entity))
- (setq overview
- (elmo-msgdb-append-element
- overview entity))
- (setq number-alist
- (elmo-msgdb-number-add number-alist
- num
- (elmo-msgdb-overview-entity-get-id
- entity)))
- (setq message-id (elmo-msgdb-overview-entity-get-id entity))
- (setq seen (member message-id seen-list))
- (if (setq gmark (or (elmo-msgdb-global-mark-get message-id)
- (if (elmo-cache-exists-p message-id) ; XXX
- (if seen
- nil
- already-mark)
- (if seen
- nil ;;seen-mark
- new-mark))))
- (setq mark-alist
- (elmo-msgdb-mark-append
- mark-alist
- num
- gmark))))
- (setq i (1+ i))
- (setq percent (/ (* i 100) len))
- (elmo-display-progress
- 'elmo-localdir-msgdb-create-as-numlist "Creating msgdb..."
- percent)
- (setq numlist (cdr numlist)))
- (message "Creating msgdb...done.")
- (list overview number-alist mark-alist))))
-
-(defalias 'elmo-localdir-msgdb-create 'elmo-localdir-msgdb-create-as-numlist)
-
-(defvar elmo-localdir-list-folders-spec-string "+")
-(defvar elmo-localdir-list-folders-filter-regexp "^\\(\\.\\.?\\|[0-9]+\\)$")
-
-(defun elmo-localdir-list-folders (spec &optional hierarchy)
- (let ((folder (concat elmo-localdir-list-folders-spec-string (nth 1 spec))))
- (elmo-localdir-list-folders-subr folder hierarchy)))
-
-(defun elmo-localdir-list-folders-subr (folder &optional hierarchy)
- (let ((case-fold-search t)
- folders curdir dirent relpath abspath attr
- subprefix subfolder)
- (condition-case ()
- (progn
- (setq curdir
- (expand-file-name (nth 1 (elmo-folder-get-spec folder))
- elmo-localdir-folder-path))
- (if (string-match "^[+=$.]$" folder) ; localdir, archive, localnews
- (setq subprefix folder)
- (setq subprefix (concat folder elmo-path-sep))
- ;; include parent
- (setq folders (list folder)))
- (setq dirent (directory-files curdir))
- (catch 'done
- (while dirent
- (setq relpath (car dirent))
- (setq dirent (cdr dirent))
- (setq abspath (expand-file-name relpath curdir))
- (and
- (not (string-match
- elmo-localdir-list-folders-filter-regexp
- relpath))
- (eq (nth 0 (setq attr (file-attributes abspath))) t)
- (if (eq hierarchy 'check)
- (throw 'done (nconc folders t))
- t)
- (setq subfolder (concat subprefix relpath))
- (setq folders (nconc folders
- (if (and hierarchy
- (if elmo-have-link-count
- (< 2 (nth 1 attr))
- (cdr
- (elmo-localdir-list-folders-subr
- subfolder 'check))))
- (list (list subfolder))
- (list subfolder))))
- (or
- hierarchy
- (and elmo-have-link-count (>= 2 (nth 1 attr)))
- (setq folders
- (nconc folders (cdr (elmo-localdir-list-folders-subr
- subfolder hierarchy))))))))
- folders)
- (file-error folders))))
-
-(defsubst elmo-localdir-list-folder-subr (spec &optional nonsort)
- (let* ((dir (elmo-localdir-get-folder-directory spec))
- (flist (mapcar 'string-to-int
- (directory-files dir nil "^[0-9]+$" t))))
- (if nonsort
- (cons (or (elmo-max-of-list flist) 0) (length flist))
- (sort flist '<))))
+(luna-define-method elmo-folder-message-file-directory ((folder
+ elmo-localdir-folder))
+ (elmo-localdir-folder-directory-internal folder))
-(defun elmo-localdir-append-msg (spec string &optional msg no-see)
- (let ((dir (elmo-localdir-get-folder-directory spec))
- (tmp-buffer (get-buffer-create " *ELMO Temp buffer*"))
- (next-num (or msg
- (1+ (car (elmo-localdir-list-folder-subr spec t)))))
- filename)
- (save-excursion
- (set-buffer tmp-buffer)
- (erase-buffer)
- (setq filename (expand-file-name (int-to-string
- next-num)
- dir))
- (unwind-protect
- (if (file-writable-p filename)
- (progn
- (insert string)
- (as-binary-output-file
- (write-region (point-min) (point-max) filename nil 'no-msg))
- t)
- nil
- )
- (kill-buffer tmp-buffer)))))
-
-(defun elmo-localdir-delete-msg (spec number)
- (let (file
- (dir (elmo-localdir-get-folder-directory spec))
- (number (int-to-string number)))
- (setq file (expand-file-name number dir))
- (if (and (string-match "[0-9]+" number) ; for safety.
- (file-exists-p file)
- (file-writable-p file)
- (not (file-directory-p file)))
- (progn (delete-file file)
- t))))
-
-(defun elmo-localdir-read-msg (spec number outbuf &optional set-mark)
- (save-excursion
- (let* ((number (int-to-string number))
- (dir (elmo-localdir-get-folder-directory spec))
- (file (expand-file-name number dir)))
- (set-buffer outbuf)
- (erase-buffer)
- (when (file-exists-p file)
- (as-binary-input-file (insert-file-contents file))
- (elmo-delete-cr-get-content-type)))))
-
-(defun elmo-localdir-delete-msgs (spec msgs)
- (mapcar '(lambda (msg) (elmo-localdir-delete-msg spec msg))
- msgs))
-
-(defun elmo-localdir-list-folder (spec); called by elmo-localdir-search()
- (elmo-localdir-list-folder-subr spec))
-
-(defun elmo-localdir-max-of-folder (spec)
- (elmo-localdir-list-folder-subr spec t))
-
-(defun elmo-localdir-check-validity (spec validity-file)
- (let* ((dir (elmo-localdir-get-folder-directory spec))
- (cur-val (nth 5 (file-attributes dir)))
- (file-val (read
- (or (elmo-get-file-string validity-file)
- "nil"))))
- (cond
- ((or (null cur-val) (null file-val)) nil)
- ((> (car cur-val) (car file-val)) nil)
- ((= (car cur-val) (car file-val))
- (if (> (cadr cur-val) (cadr file-val)) nil t)) ; t if same
- (t t))))
-
-(defun elmo-localdir-sync-validity (spec validity-file)
- (save-excursion
- (let* ((dir (elmo-localdir-get-folder-directory spec))
- (tmp-buffer (get-buffer-create " *ELMO TMP*"))
- (number-file (expand-file-name elmo-msgdb-number-filename dir)))
- (set-buffer tmp-buffer)
- (erase-buffer)
- (prin1 (nth 5 (file-attributes dir)) tmp-buffer)
- (princ "\n" tmp-buffer)
- (if (file-writable-p validity-file)
- (write-region (point-min) (point-max)
- validity-file nil 'no-msg)
- (message (format "%s is not writable." number-file)))
- (kill-buffer tmp-buffer))))
-
-(defun elmo-localdir-folder-exists-p (spec)
- (file-directory-p (elmo-localdir-get-folder-directory spec)))
-
-(defun elmo-localdir-folder-creatable-p (spec)
+(luna-define-method elmo-folder-message-make-temp-file-p
+ ((folder elmo-localdir-folder))
t)
-(defun elmo-localdir-create-folder (spec)
- (save-excursion
- (let ((dir (elmo-localdir-get-folder-directory spec)))
- (if (file-directory-p dir)
- ()
- (if (file-exists-p dir)
- (error "Create folder failed")
- (elmo-make-directory dir))
- t
- ))))
-
-(defun elmo-localdir-delete-folder (spec)
- (let* ((dir (elmo-localdir-get-folder-directory spec)))
- (if (not (file-directory-p dir))
- (error "no such directory: %s" dir)
- (elmo-delete-directory dir t)
+(luna-define-method elmo-folder-message-make-temp-files ((folder
+ elmo-localdir-folder)
+ numbers
+ &optional
+ start-number)
+ (let ((temp-dir (elmo-folder-make-temporary-directory folder))
+ (cur-number (or start-number 0)))
+ (dolist (number numbers)
+ (elmo-copy-file
+ (expand-file-name
+ (number-to-string number)
+ (elmo-localdir-folder-directory-internal folder))
+ (expand-file-name
+ (number-to-string (if start-number cur-number number))
+ temp-dir))
+ (incf cur-number))
+ temp-dir))
+
+(defun elmo-localdir-msgdb-create-entity (msgdb dir number)
+ (elmo-msgdb-create-message-entity-from-file
+ (elmo-msgdb-message-entity-handler msgdb)
+ number (expand-file-name (number-to-string number) dir)))
+
+(luna-define-method elmo-folder-msgdb-create ((folder elmo-localdir-folder)
+ numbers
+ flag-table)
+ (when numbers
+ (let ((dir (elmo-localdir-folder-directory-internal folder))
+ (new-msgdb (elmo-make-msgdb))
+ entity message-id flags)
+ (elmo-with-progress-display (elmo-folder-msgdb-create (length numbers))
+ "Creating msgdb"
+ (dolist (number numbers)
+ (setq entity (elmo-localdir-msgdb-create-entity
+ new-msgdb dir number))
+ (when entity
+ (setq message-id (elmo-message-entity-field entity 'message-id)
+ flags (elmo-flag-table-get flag-table message-id))
+ (elmo-global-flags-set flags folder number message-id)
+ (elmo-msgdb-append-entity new-msgdb entity flags))
+ (elmo-progress-notify 'elmo-folder-msgdb-create)))
+ new-msgdb)))
+
+(luna-define-method elmo-folder-list-subfolders ((folder elmo-localdir-folder)
+ &optional one-level)
+ (elmo-mapcar-list-of-list
+ (lambda (x) (concat (elmo-folder-prefix-internal folder) x))
+ (elmo-list-subdirectories
+ (elmo-localdir-folder-path folder)
+ (or (elmo-localdir-folder-dir-name-internal folder) "")
+ one-level)))
+
+(defsubst elmo-localdir-list-subr (folder &optional nonsort)
+ (let ((flist (mapcar 'string-to-number
+ (directory-files
+ (elmo-localdir-folder-directory-internal folder)
+ nil "^[0-9]+$" t)))
+ (killed (elmo-msgdb-killed-list-load (elmo-folder-msgdb-path folder))))
+ (if nonsort
+ (cons (or (elmo-max-of-list flist) 0)
+ (if killed
+ (- (length flist)
+ (elmo-msgdb-killed-list-length killed))
+ (length flist)))
+ (sort flist '<))))
+
+(luna-define-method elmo-folder-append-buffer ((folder elmo-localdir-folder)
+ &optional flags number)
+ (let ((filename (elmo-message-file-name
+ folder
+ (or number
+ (1+ (car (elmo-folder-status folder)))))))
+ (when (and (file-writable-p filename)
+ (not (file-exists-p filename)))
+ (write-region-as-binary
+ (point-min) (point-max) filename nil 'no-msg)
+ (elmo-folder-preserve-flags
+ folder (elmo-msgdb-get-message-id-from-buffer) flags)
t)))
-(defun elmo-localdir-rename-folder (old-spec new-spec)
- (let* ((old (elmo-localdir-get-folder-directory old-spec))
- (new (elmo-localdir-get-folder-directory new-spec))
- (new-dir (directory-file-name (file-name-directory new))))
- (if (not (file-directory-p old))
- (error "no such directory: %s" old)
- (if (file-exists-p new)
- (error "already exists directory: %s" new)
- (if (not (file-exists-p new-dir))
- (elmo-make-directory new-dir))
- (rename-file old new)
- t))))
-
-(defsubst elmo-localdir-field-condition-match (spec number condition)
- (elmo-file-field-condition-match
- (expand-file-name (int-to-string number)
- (elmo-localdir-get-folder-directory spec))
- condition))
-
-(defun elmo-localdir-search (spec condition &optional from-msgs)
- (let* ((msgs (or from-msgs (elmo-localdir-list-folder spec)))
- (num (length msgs))
- (i 0) case-fold-search ret-val)
- (while msgs
- (if (elmo-localdir-field-condition-match spec (car msgs)
- condition)
- (setq ret-val (cons (car msgs) ret-val)))
- (setq i (1+ i))
- (elmo-display-progress
- 'elmo-localdir-search "Searching..."
- (/ (* i 100) num))
- (setq msgs (cdr msgs)))
- (nreverse ret-val)))
-
-;;; (localdir, maildir, localnews) -> localdir
-(defun elmo-localdir-copy-msgs (dst-spec msgs src-spec
- &optional loc-alist same-number)
- (let ((dst-dir
- (elmo-localdir-get-folder-directory dst-spec))
- (next-num (1+ (car (elmo-localdir-list-folder-subr dst-spec t)))))
- (while msgs
+(defun elmo-folder-append-messages-*-localdir (folder
+ src-folder
+ numbers
+ same-number)
+ (let ((src-msgdb-exists (not (zerop (elmo-folder-length src-folder))))
+ (dir (elmo-localdir-folder-directory-internal folder))
+ (table (elmo-folder-flag-table folder))
+ (succeeds numbers)
+ (next-num (1+ (car (elmo-folder-status folder))))
+ flags id)
+ (while numbers
+ (setq flags (elmo-message-flags src-folder (car numbers)))
(elmo-copy-file
- ;; src file
- (elmo-call-func src-spec "get-msg-filename" (car msgs) loc-alist)
- ;; dst file
- (expand-file-name (int-to-string
- (if same-number (car msgs) next-num))
- dst-dir))
- (if (and (setq msgs (cdr msgs))
+ (elmo-message-file-name src-folder (car numbers))
+ (expand-file-name
+ (number-to-string
+ (if same-number (car numbers) next-num))
+ dir))
+ ;; save flag-table only when src folder's msgdb is loaded.
+ (when (setq id (and src-msgdb-exists
+ (elmo-message-field src-folder (car numbers)
+ 'message-id)))
+ (elmo-flag-table-set table id flags))
+ (elmo-progress-notify 'elmo-folder-move-messages)
+ (if (and (setq numbers (cdr numbers))
(not same-number))
(setq next-num
- (if (and (eq (car dst-spec) 'localdir)
- (elmo-localdir-locked-p))
+ (if (elmo-localdir-locked-p)
;; MDA is running.
- (1+ (car (elmo-localdir-list-folder-subr dst-spec t)))
+ (1+ (car (elmo-folder-status folder)))
(1+ next-num)))))
- t))
+ (when (elmo-folder-persistent-p folder)
+ (elmo-folder-close-flag-table folder))
+ succeeds))
+
+(luna-define-method elmo-folder-delete-messages-internal
+ ((folder elmo-localdir-folder) numbers)
+ (dolist (number numbers)
+ (elmo-localdir-delete-message folder number))
+ t)
+
+(defun elmo-localdir-delete-message (folder number)
+ "Delete message in the FOLDER with NUMBER."
+ (let ((filename (elmo-message-file-name folder number)))
+ (when (and (string-match "[0-9]+" filename) ; for safety.
+ (file-exists-p filename)
+ (file-writable-p filename)
+ (not (file-directory-p filename)))
+ (delete-file filename)
+ t)))
+
+(luna-define-method elmo-message-fetch-internal ((folder elmo-localdir-folder)
+ number strategy
+ &optional section unread)
+ (let ((filename (elmo-message-file-name folder number)))
+ (when (file-exists-p filename)
+ (insert-file-contents-as-raw-text filename))))
+
+(luna-define-method elmo-folder-list-messages-internal
+ ((folder elmo-localdir-folder) &optional nohide)
+ (elmo-localdir-list-subr folder))
+
+(luna-define-method elmo-folder-status ((folder elmo-localdir-folder))
+ (elmo-localdir-list-subr folder t))
-(defun elmo-localdir-pack-number (spec msgdb arg)
- (let ((dir (elmo-localdir-get-folder-directory spec))
- (onum-alist (elmo-msgdb-get-number-alist msgdb))
- (omark-alist (elmo-msgdb-get-mark-alist msgdb))
- (oov (elmo-msgdb-get-overview msgdb))
- (new-number 1) ; first ordinal position in localdir
- flist onum mark new-mark-alist total)
- (setq flist
- (if elmo-pack-number-check-strict
- (elmo-call-func spec "list-folder") ; allow localnews
- (mapcar 'car onum-alist)))
- (setq total (length flist))
- (while flist
- (elmo-display-progress
- 'elmo-localdir-pack-number "Packing..."
- (/ (* new-number 100) total))
- (setq onum (car flist))
- (when (not (eq onum new-number)) ; why \=() is wrong..
- (elmo-bind-directory
- dir
- ;; xxx nfs,hardlink
- (rename-file (int-to-string onum) (int-to-string new-number) t))
- ;; update overview
- (elmo-msgdb-overview-entity-set-number
- (elmo-msgdb-overview-get-entity-by-number
- oov onum) new-number)
- ;; update number-alist
- (setcar (assq onum onum-alist) new-number))
- ;; update mark-alist
- (when (setq mark (cadr (assq onum omark-alist)))
- (setq new-mark-alist
- (elmo-msgdb-mark-append
- new-mark-alist
- new-number mark)))
- (setq new-number (1+ new-number))
- (setq flist (cdr flist)))
- (message "Packing...done.")
- (list (elmo-msgdb-get-overview msgdb)
- onum-alist
- new-mark-alist
- (elmo-msgdb-get-location msgdb))))
-
-(defun elmo-localdir-use-cache-p (spec number)
- nil)
-
-(defun elmo-localdir-local-file-p (spec number)
+(luna-define-method elmo-folder-creatable-p ((folder elmo-localdir-folder))
t)
-(defun elmo-localdir-get-msg-filename (spec number &optional loc-alist)
- (expand-file-name
- (int-to-string number)
- (elmo-localdir-get-folder-directory spec)))
+(luna-define-method elmo-folder-writable-p ((folder elmo-localdir-folder))
+ t)
+
+(luna-define-method elmo-folder-create ((folder elmo-localdir-folder))
+ (let ((dir (elmo-localdir-folder-directory-internal folder)))
+ (if (file-directory-p dir)
+ ()
+ (if (file-exists-p dir)
+ (error "Create folder failed")
+ (elmo-make-directory dir))
+ t)))
+
+(luna-define-method elmo-folder-delete ((folder elmo-localdir-folder))
+ (let ((msgs (and (elmo-folder-exists-p folder)
+ (elmo-folder-list-messages folder))))
+ (when (yes-or-no-p (format "%sDelete msgdb and substance of \"%s\"? "
+ (if (> (length msgs) 0)
+ (format "%d msg(s) exists. " (length msgs))
+ "")
+ (elmo-folder-name-internal folder)))
+ (let ((dir (elmo-localdir-folder-directory-internal folder)))
+ (if (not (file-directory-p dir))
+ (error "No such directory: %s" dir)
+ (elmo-delete-match-files dir "[0-9]+" t)))
+ (elmo-msgdb-delete-path folder)
+ t)))
+
+(luna-define-method elmo-folder-rename-internal ((folder elmo-localdir-folder)
+ new-folder)
+ (let* ((old (elmo-localdir-folder-directory-internal folder))
+ (new (elmo-localdir-folder-directory-internal new-folder))
+ (new-dir (directory-file-name (file-name-directory new))))
+ (unless (file-directory-p old)
+ (error "No such directory: %s" old))
+ (when (file-exists-p new)
+ (error "Already exists directory: %s" new))
+ (unless (file-directory-p new-dir)
+ (elmo-make-directory new-dir))
+ (rename-file old new)
+ t))
+
+(luna-define-method elmo-folder-pack-numbers ((folder elmo-localdir-folder))
+ (let* ((dir (elmo-localdir-folder-directory-internal folder))
+ (msgdb (elmo-folder-msgdb folder))
+ (new-msgdb (elmo-make-msgdb (elmo-folder-msgdb-path folder)))
+ (numbers (sort (elmo-folder-list-messages
+ folder
+ nil
+ (not elmo-pack-number-check-strict))
+ '<))
+ (new-number 1) ; first ordinal position in localdir
+ entity)
+ (elmo-with-progress-display (elmo-folder-pack-numbers (length numbers))
+ "Packing"
+ (dolist (old-number numbers)
+ (setq entity (elmo-msgdb-message-entity msgdb old-number))
+ (when (not (eq old-number new-number)) ; why \=() is wrong..
+ (elmo-bind-directory dir
+ ;; xxx nfs,hardlink
+ (rename-file (number-to-string old-number)
+ (number-to-string new-number) t))
+ (elmo-message-entity-set-number entity new-number))
+ (elmo-msgdb-append-entity new-msgdb entity
+ (elmo-msgdb-flags msgdb old-number))
+ (elmo-emit-signal 'message-number-changed folder old-number new-number)
+ (setq new-number (1+ new-number))))
+ (message "Packing...done")
+ (elmo-folder-set-msgdb-internal folder new-msgdb)))
+
+(luna-define-method elmo-folder-message-file-p ((folder elmo-localdir-folder))
+ t)
(defun elmo-localdir-locked-p ()
(if elmo-localdir-lockfile-list
(throw 'found t))
(setq lock (cdr lock)))))))
-(defalias 'elmo-localdir-sync-number-alist
- 'elmo-generic-sync-number-alist)
-(defalias 'elmo-localdir-list-folder-unread
- 'elmo-generic-list-folder-unread)
-(defalias 'elmo-localdir-list-folder-important
- 'elmo-generic-list-folder-important)
-(defalias 'elmo-localdir-commit 'elmo-generic-commit)
+(autoload 'elmo-global-flags-set "elmo-flag")
-(provide 'elmo-localdir)
+(require 'product)
+(product-provide (provide 'elmo-localdir) (require 'elmo-version))
;;; elmo-localdir.el ends here
projects / elisp / wanderlust.git / blobdiff