* wl-score.el (wl-score-save): Bind print-length and print-level.

[elisp/wanderlust.git] / elmo / elmo-archive.el

diff --git a/elmo/elmo-archive.el b/elmo/elmo-archive.el
index 6625a7f..62dc48a 100644 (file)
--- a/elmo/elmo-archive.el
+++ b/elmo/elmo-archive.el
@@ -1,4 +1,4 @@
-;;; elmo-archive.el --- Archive folder of ELMO.
+;;; elmo-archive.el --- Archive folder of ELMO. -*- coding: euc-japan -*-
 
 ;; Copyright (C) 1998,1999,2000 OKUNISHI Fujikazu <fuji0924@mbox.kyoto-inet.or.jp>
 ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
@@ -81,12 +81,19 @@
 ;;; ELMO Local directory folder
 (eval-and-compile
   (luna-define-class elmo-archive-folder (elmo-folder)
-                    (archive-name archive-type archive-prefix))
+                    (archive-name archive-type archive-prefix dir-name))
   (luna-define-internal-accessors 'elmo-archive-folder))
 
+(luna-define-generic elmo-archive-folder-path (folder)
+  "Return local directory path of the FOLDER.")
+
+(luna-define-method elmo-archive-folder-path ((folder elmo-archive-folder))
+  elmo-archive-folder-path)
+
 (luna-define-method elmo-folder-initialize ((folder
                                             elmo-archive-folder)
                                            name)
+  (elmo-archive-folder-set-dir-name-internal folder name)
   (when (string-match
         "^\\([^;]*\\);?\\([^;]*\\);?\\([^;]*\\)$"
         name)
@@ -302,7 +309,7 @@ TYPE specifies the archiver's symbol."
                      (not (eobp)))  ; for GNU tar 981010
            (setq file-list (nconc file-list (list (string-to-int
                                                    (match-string 1)))))))
-      (error "%s does not exist." file))
+      (error "%s does not exist" file))
     (if nonsort
        (cons (or (elmo-max-of-list file-list) 0)
              (if killed
@@ -440,7 +447,7 @@ TYPE specifies the archiver's symbol."
             (delete-file dummy)))
        ))))
 
-(luna-define-method elmo-folder-delete ((folder elmo-archive-folder))
+(luna-define-method elmo-folder-delete :before ((folder elmo-archive-folder))
   (let ((arc (elmo-archive-get-archive-name folder)))
     (if (not (file-exists-p arc))
        (error "No such file: %s" arc)
@@ -450,7 +457,11 @@ TYPE specifies the archiver's symbol."
 (luna-define-method elmo-folder-rename-internal ((folder elmo-archive-folder)
                                                 new-folder)
   (let* ((old-arc (elmo-archive-get-archive-name folder))
-        (new-arc (elmo-archive-get-archive-name new-folder)))
+        (new-arc (elmo-archive-get-archive-name new-folder))
+        (new-dir (directory-file-name
+                  (elmo-archive-get-archive-directory new-folder))))
+    (if elmo-archive-treat-file
+       (setq new-dir (directory-file-name (file-name-directory new-dir))))
     (unless (and (eq (elmo-archive-folder-archive-type-internal folder)
                     (elmo-archive-folder-archive-type-internal new-folder))
                 (equal (elmo-archive-folder-archive-prefix-internal
@@ -458,12 +469,14 @@ TYPE specifies the archiver's symbol."
                        (elmo-archive-folder-archive-prefix-internal
                         new-folder)))
       (error "Not same archive type and prefix"))
-    (if (not (file-exists-p old-arc))
-       (error "No such file: %s" old-arc)
-      (if (file-exists-p new-arc)
-         (error "Already exists: %s" new-arc)
-       (rename-file old-arc new-arc)
-       t))))
+    (unless (file-exists-p old-arc)
+      (error "No such file: %s" old-arc))
+    (when (file-exists-p new-arc)
+      (error "Already exists: %s" new-arc))
+    (unless (file-directory-p new-dir)
+      (elmo-make-directory new-dir))
+    (rename-file old-arc new-arc)
+    t))
 
 (defun elmo-archive-folder-list-subfolders (folder one-level)
   (if elmo-archive-treat-file
@@ -485,7 +498,9 @@ TYPE specifies the archiver's symbol."
                       "" (file-name-nondirectory path)))
             (flist (and (file-directory-p dir)
                         (directory-files dir nil
-                                         (concat "^" name "[^A-z][^A-z]")
+                                         (if (> (length name) 0)
+                                             (concat "^" name "[^A-z][^A-z]")
+                                           name)
                                          nil)))
             (regexp (format "^\\(.*\\)\\(%s\\)$"
                             (mapconcat
@@ -511,10 +526,20 @@ TYPE specifies the archiver's symbol."
                       suffix prefix)))
          flist)))
     (elmo-mapcar-list-of-list
-     (function (lambda (x) (concat (elmo-folder-prefix-internal folder) x)))
+     (function (lambda (x)
+                (if (file-exists-p
+                     (expand-file-name
+                      (concat elmo-archive-basename
+                              (elmo-archive-get-suffix
+                               (elmo-archive-folder-archive-type-internal
+                                folder)))
+                      (expand-file-name
+                       x
+                       (elmo-archive-folder-path folder))))
+                    (concat (elmo-folder-prefix-internal folder) x))))
      (elmo-list-subdirectories
-      (elmo-archive-get-archive-directory folder)
-      ""
+      (elmo-archive-folder-path folder)
+      (or (elmo-archive-folder-dir-name-internal folder) "")
       one-level))))
 
 (luna-define-method elmo-folder-list-subfolders ((folder elmo-archive-folder)
@@ -532,11 +557,12 @@ TYPE specifies the archiver's symbol."
         (method (elmo-archive-get-method type 'cat))
         (args (list arc (elmo-concat-path
                          prefix (int-to-string number)))))
-    (when (file-exists-p arc)
-      (and
-       (as-binary-process
-       (elmo-archive-call-method method args t))
-       (elmo-delete-cr-buffer)))))
+    (and (file-exists-p arc)
+        (as-binary-process
+         (elmo-archive-call-method method args t))
+        (progn
+          (elmo-delete-cr-buffer)
+          t))))
 
 (luna-define-method elmo-message-fetch-internal ((folder elmo-archive-folder)
                                                 number strategy
@@ -839,7 +865,7 @@ TYPE specifies the archiver's symbol."
      (setq ret-val
           (elmo-archive-call-process
            (car compress) (append (cdr compress) (list arc-tar)))))
-    ;; delete tmporary messages
+    ;; delete temporary messages
     (if (and (not copy)
             (eq exec-type 'append))
        (while tmp-msgs