LISP非递归深度遍历文件夹查找文件

dcl1214

见过一些递归的查找文件，我来一个非递归的，我想不到递归怎么写，代码如下：

1. (defun $lie-chu-mu-lu-xia-suo-you-wen-jian$
   
2.        (lst / a f fs fs-all kzm n ns ns-1 wj wjs)
   
3.                                         ;列出目录下所有文件，含子级目录，所有目录下的文件
   
4.   ;($lie-chu-mu-lu-xia-suo-you-wen-jian$(list(cons "目录" "C:\\uploads")(cons "扩展名" "*.dwg")))
   
5.   (or (and lst
   
6.            (= (type lst) 'list)
   
7.            (setq kzm (cdr (assoc "扩展名" lst)))
   
8.            (> (strlen kzm) 0)
   
9.            (wcmatch kzm "[,`*.*,]")
   
10.       )
    
11.       (setq kzm "*.*")
    
12.   )
    
13.   (or (and lst
    
14.            (= (type lst) 'list)
    
15.            (setq f (cdr (assoc "目录" lst)))
    
16.       )
    
17.       (and lst (= (type lst) 'str) (setq f lst))
    
18.   )
    
19.   (and
    
20.     f
    
21.     kzm
    
22.     (findfile f)
    
23.     (progn
    
24.       (while (and f (wcmatch f "*`\\*"))
    
25.         (setq f (vl-string-subst "/" "\\" f))
    
26.       )
    
27.       (setq fs-all nil)
    
28.       (setq fs-all (cons f fs-all))
    
29.       (setq fs (vl-directory-files f "*.*" -1))
    
30.       (setq fs (vl-remove ".." fs))
    
31.       (setq fs (vl-remove "." fs))
    
32.       (setq fs (mapcar (function (lambda (a) (strcat f "/" a))) fs))
    
33.       (setq fs-all (APPEND fs-all fs))
    
34.       (while (AND fs (setq f (last fs)) (< (length fs-all) 10000))
    
35.         (setq ns nil)
    
36.         (setq ns (vl-directory-files f "*.*" -1))
    
37.         (setq ns (vl-remove ".." ns))
    
38.         (setq ns (vl-remove "." ns))
    
39.         (while (setq a (car ns))
    
40.           (setq n (strcat f "/" a))
    
41.           (setq fs (cons n fs))
    
42.           (setq fs-all (cons n fs-all))
    
43.           (setq ns (cdr ns))
    
44.         )
    
45.         (setq fs (reverse (cdr (reverse fs))))
    
46.       )
    
47.       (and fs-all
    
48.            (progn
    
49.              (setq wjs nil)
    
50.              (while (setq a (car fs-all))
    
51.                (setq wj nil)
    
52.                (setq wj (vl-directory-files a kzm 1))
    
53.                (setq wj (vl-remove ".." wj))
    
54.                (setq wj (vl-remove "." wj))
    
55.                (setq
    
56.                  wj (mapcar (function (lambda (b) (strcat a "/" b))) wj)
    
57.                )
    
58.                (setq wjs (cons wj wjs))
    
59.                (setq fs-all (cdr fs-all))
    
60.              )
    
61.              (setq wjs (vl-remove nil wjs))
    
62.            )
    
63.       )
    
64.     )
    
65.   )
    
66.   wjs
    
67. )
    
68. 
    

(defun $lie-chu-mu-lu-xia-suo-you-wen-jian$<br />        (lst / a f fs fs-all kzm n ns ns-1 wj wjs)<br />                                         ;列出目录下所有文件，含子级目录，所有目录下的文件<br />   ;($lie-chu-mu-lu-xia-suo-you-wen-jian$(list(cons "目录" "C:\\uploads")(cons "扩展名" "*.dwg")))<br />   (or (and lst<br />            (= (type lst) 'list)<br />            (setq kzm (cdr (assoc "扩展名" lst)))<br />            (> (strlen kzm) 0)<br />            (wcmatch kzm "[,`*.*,]")<br />       )<br />       (setq kzm "*.*")<br />   )<br />   (or (and lst<br />            (= (type lst) 'list)<br />            (setq f (cdr (assoc "目录" lst)))<br />       )<br />       (and lst (= (type lst) 'str) (setq f lst))<br />   )<br />   (and<br />     f<br />     kzm<br />     (findfile f)<br />     (progn<br />       (while (and f (wcmatch f "*`\\*"))<br />         (setq f (vl-string-subst "/" "\\" f))<br />       )<br />       (setq fs-all nil)<br />       (setq fs-all (cons f fs-all))<br />       (setq fs (vl-directory-files f "*.*" -1))<br />       (setq fs (vl-remove ".." fs))<br />       (setq fs (vl-remove "." fs))<br />       (setq fs (mapcar (function (lambda (a) (strcat f "/" a))) fs))<br />       (setq fs-all (APPEND fs-all fs))<br />       (while (AND fs (setq f (last fs)) (< (length fs-all) 10000))<br />         (setq ns nil)<br />         (setq ns (vl-directory-files f "*.*" -1))<br />         (setq ns (vl-remove ".." ns))<br />         (setq ns (vl-remove "." ns))<br />         (while (setq a (car ns))<br />           (setq n (strcat f "/" a))<br />           (setq fs (cons n fs))<br />           (setq fs-all (cons n fs-all))<br />           (setq ns (cdr ns))<br />         )<br />         (setq fs (reverse (cdr (reverse fs))))<br />       )<br />       (and fs-all<br />            (progn<br />              (setq wjs nil)<br />              (while (setq a (car fs-all))<br />                (setq wj nil)<br />                (setq wj (vl-directory-files a kzm 1))<br />                (setq wj (vl-remove ".." wj))<br />                (setq wj (vl-remove "." wj))<br />                (setq<br />                  wj (mapcar (function (lambda (b) (strcat a "/" b))) wj)<br />                )<br />                (setq wjs (cons wj wjs))<br />                (setq fs-all (cdr fs-all))<br />              )<br />              (setq wjs (vl-remove nil wjs))<br />            )<br />       )<br />     )<br />   )<br />   wjs<br /> )<br /> <br />

flowerson

不错，不错。学习到了。要是可以选择包含“某些字符”就更好了。

sachindkini

thanks for sharing ... learning

guosheyang

感谢杜总的分享！

叁點壹肆

谢分享，受益非&#15552;