From: hmurata <hmurata>
Date: Tue, 24 Apr 2001 08:31:32 +0000 (+0000)
Subject: * elmo-util.el (elmo-list-subdirectories-1): New function.
X-Git-Tag: wl-2_6-root^3~33
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=ecddb8da25e68fd2bbdcb0529676d32bc5f974e9;p=elisp%2Fwanderlust.git

* elmo-util.el (elmo-list-subdirectories-1): New function.
(elmo-list-subdirectories): Use `elmo-list-subdirectories-1'.
(elmo-mapcar-list-of-list): New function.

* elmo-archive.el (elmo-archive-folder-list-subfolders): Use
`elmo-mapcar-list-of-list' instead of `mapcar'.

* elmo-localdir.el (elmo-folder-list-subfolders): Ditto.

* elmo-maildir.el (elmo-folder-list-subfolders): Ditto. Bind
`elmo-have-link-count'. Return the fully qualified folder name.
---

diff --git a/elmo/ChangeLog b/elmo/ChangeLog
index a034169..5ffcf35 100644
--- a/elmo/ChangeLog
+++ b/elmo/ChangeLog
@@ -1,3 +1,17 @@
+2001-04-24  Hiroya Murata  <hiroya@use-ebisu.co.jp>
+
+	* elmo-util.el (elmo-list-subdirectories-1): New function.
+	(elmo-list-subdirectories): Use `elmo-list-subdirectories-1'.
+	(elmo-mapcar-list-of-list): New function.
+
+	* elmo-archive.el (elmo-archive-folder-list-subfolders): Use
+	`elmo-mapcar-list-of-list' instead of `mapcar'.
+
+	* elmo-localdir.el (elmo-folder-list-subfolders): Ditto.
+
+	* elmo-maildir.el (elmo-folder-list-subfolders): Ditto. Bind
+	`elmo-have-link-count'. Return the fully qualified folder name.
+
 2001-04-23  Yuuichi Teranishi  <teranisi@gohome.org>
 
 	* elmo-shimbun.el (elmo-shimbun-check-interval): New user option.
diff --git a/elmo/elmo-archive.el b/elmo/elmo-archive.el
index ab3fa90..6d3f891 100644
--- a/elmo/elmo-archive.el
+++ b/elmo/elmo-archive.el
@@ -511,8 +511,8 @@ TYPE specifies the archiver's symbol."
 		       (elmo-concat-path base-folder (elmo-match-string 1 x))
 		       suffix prefix)))
 	  flist)))
-    (mapcar
-     (lambda (x) (concat (elmo-folder-prefix-internal folder) x))
+    (elmo-mapcar-list-of-list
+     (function (lambda (x) (concat (elmo-folder-prefix-internal folder) x)))
      (elmo-list-subdirectories
       (elmo-archive-get-archive-directory folder)
       ""
diff --git a/elmo/elmo-localdir.el b/elmo/elmo-localdir.el
index d44e8fa..3d6adab 100644
--- a/elmo/elmo-localdir.el
+++ b/elmo/elmo-localdir.el
@@ -192,7 +192,7 @@
 
 (luna-define-method elmo-folder-list-subfolders ((folder elmo-localdir-folder)
 						 &optional one-level)
-  (mapcar
+  (elmo-mapcar-list-of-list
    (lambda (x) (concat (elmo-folder-prefix-internal folder) x))
    (elmo-list-subdirectories
     (elmo-localdir-folder-path folder)
diff --git a/elmo/elmo-maildir.el b/elmo/elmo-maildir.el
index 1efc523..0c8b315 100644
--- a/elmo/elmo-maildir.el
+++ b/elmo/elmo-maildir.el
@@ -272,12 +272,17 @@ LOCATION."
 
 (luna-define-method elmo-folder-list-subfolders
   ((folder elmo-maildir-folder) &optional one-level)
-  (let ((elmo-list-subdirectories-ignore-regexp
-	 "^\\(\\.\\.?\\|cur\\|tmp\\|new\\)$"))
+  (let ((prefix (concat (elmo-folder-name-internal folder)
+			(unless (string= (elmo-folder-prefix-internal folder)
+					 (elmo-folder-name-internal folder))
+			  elmo-path-sep)))
+	(elmo-list-subdirectories-ignore-regexp
+	 "^\\(\\.\\.?\\|cur\\|tmp\\|new\\)$")
+	elmo-have-link-count)
     (append
      (list (elmo-folder-name-internal folder))
-     (mapcar
-      (lambda (x) (concat (elmo-folder-prefix-internal folder) x))
+     (elmo-mapcar-list-of-list
+      (function (lambda (x) (concat prefix x)))
       (elmo-list-subdirectories
        (elmo-maildir-folder-directory-internal folder)
        ""
diff --git a/elmo/elmo-util.el b/elmo/elmo-util.el
index fb32333..e034f79 100644
--- a/elmo/elmo-util.el
+++ b/elmo/elmo-util.el
@@ -1328,33 +1328,51 @@ NUMBER-SET is altered."
   :type 'regexp
   :group 'elmo)
 
-(defun elmo-list-subdirectories (directory file one-level)
-  (let ((root (zerop (length file)))
+(defun elmo-list-subdirectories-1 (basedir curdir one-level)
+  (let ((root (zerop (length curdir)))
 	(w32-get-true-file-link-count t) ; for Meadow
-	files attr dirs dir)
-    (setq files (directory-files (setq dir (expand-file-name file directory))))
-    (while files
-      (if (and (not (string-match elmo-list-subdirectories-ignore-regexp
-				  (car files)))
-	       (car (setq attr (file-attributes (expand-file-name 
-						 (car files) dir)))))
-	  (if (and (not one-level)
-		   (and elmo-have-link-count (< 2 (nth 1 attr))))
-	      (setq dirs
-		    (nconc dirs
-			   (elmo-list-subdirectories
-			    directory
-			    (concat file
-				    (and (not root) elmo-path-sep)
-				    (car files))
-			    one-level)))
+	attr dirs dir)
+    (catch 'done
+      (dolist (file (directory-files (setq dir (expand-file-name curdir basedir))))
+	(when (and (not (string-match
+			 elmo-list-subdirectories-ignore-regexp
+			 file))
+		   (car (setq attr (file-attributes
+				    (expand-file-name file dir)))))
+	  (when (eq one-level 'check) (throw 'done t))
+	  (let ((relpath
+		 (concat curdir (and (not root) elmo-path-sep) file))
+		subdirs)
 	    (setq dirs (nconc dirs
-			      (list
-			       (concat file
-				       (and (not root) elmo-path-sep)
-				       (car files)))))))
-      (setq files (cdr files)))
-    (nconc (and (not root) (list file)) dirs)))
+			      (if (if elmo-have-link-count (< 2 (nth 1 attr))
+				    (setq subdirs
+					  (elmo-list-subdirectories-1
+					   basedir
+					   relpath
+					   (if one-level 'check))))
+				  (if one-level
+				      (list (list relpath))
+				    (cons relpath
+					  (or subdirs
+					      (elmo-list-subdirectories-1
+					       basedir
+					       relpath
+					       nil))))
+				(list relpath)))))))
+      dirs)))
+
+(defun elmo-list-subdirectories (directory file one-level)
+  (let ((subdirs (elmo-list-subdirectories-1 directory file one-level)))
+    (if (zerop (length file))
+	subdirs
+      (cons file subdirs))))
+
+(defun elmo-mapcar-list-of-list (func list-of-list)
+  (mapcar
+   (lambda (x)
+     (cond ((listp x) (elmo-mapcar-list-of-list func x))
+	   (t (funcall func x))))
+   list-of-list))
 
 (defun elmo-parse (string regexp &optional matchn)
   (or matchn (setq matchn 1))