From ecddb8da25e68fd2bbdcb0529676d32bc5f974e9 Mon Sep 17 00:00:00 2001 From: hmurata Date: Tue, 24 Apr 2001 08:31:32 +0000 Subject: [PATCH] * 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. --- elmo/ChangeLog | 14 ++++++++++ elmo/elmo-archive.el | 4 +-- elmo/elmo-localdir.el | 2 +- elmo/elmo-maildir.el | 13 +++++++--- elmo/elmo-util.el | 68 +++++++++++++++++++++++++++++++------------------ 5 files changed, 69 insertions(+), 32 deletions(-) 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 + + * 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 * 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)) -- 1.7.10.4