说明：非原创，抄来的，放在这里的目的是，给大家一个范例，写一个可以发布的lisp 程序基本就是这个格式了

http://blog.sina.com.cn/s/blog_510ac74901011fww.html

这应该还是算实用的一段代码，虽然，用python，perl 实现要远远的简单的多。

这个程序的思想是通过系统调用ls -al，然后用正则解析其输出结果，再依照这个原理遍历每一个子目录

;;-------------wy_file_fun.asd------------

;; 定义自己的package

(defpackage :wy.file
(:use     :common-lisp
            :cl-ppcre)
(:export :walk
            :dir-detail) )

;;--------------wy_file_fun.lisp--------------

(in-package :wy.file)

;;walk是接口函数，遍历每一个子目录，输出形式是((*(filename filepath&name size flag)) size)链表，*代表多个，

;;以这种形式将当前目录以及子目录中所有的文件和目录都返回出来

(defun walk (path-name) (let ((file-list nil)
                               (tmp-res nil)
                               (value-after-total 0)
                               (dir-info nil))
                           (setf dir-info (dir-detail path-name))
                           (setf file-list (elt dir-info 0))
                           (setf value-after-total (elt dir-info 1))
                           (loop for x in file-list
                                do (if (eq (elt (elt x 3) 0) #\d)
                                  (progn (setf tmp-res (walk (elt x 1)))
                                    (setf file-list (append file-list (elt tmp-res 0)))
                                    (setf value-after-total (+ value-after-total (elt tmp-res 1)))))
                                finally (return (list file-list value-after-total)))))

;;dir-detail也是接口函数，当然他也被walk调用

;;通过正则将当前目录ls命令的输出转换成((*(filename filepath&name size flag)) size)的链表形式，*代表多个

(defun dir-detail (path-name)
(let ((res-ls-al (inner-os-ls-al path-name))
        (ret-table (make-hash-table))
        (res nil)
        (value-after-total nil)
        (file-list nil))
    ;strip the / at the tail of path-name
    (if (not (string= path-name ""))
         (if (eq (elt path-name (- (length path-name) 1)) #\/)
             (if (string= path-name "/") (setf path-name "") (setf path-name (subseq path-name 0 (length path-name) 2)))))
    (loop for x in res-ls-al
       do (multiple-value-bind
                 (tmp-string ppcre-res)
               (scan-to-strings "total\\s+(\\d+)" x)
             (if (not (eq nil ppcre-res))
                                        ;this line is 'total XXX', convert XXX to value-after-total
                 (setf value-after-total (parse-integer (elt ppcre-res 0)))
                                        ;the below is the files
                                        ;drwxr-xr-x 4 root root 4096 Jul 9 2011 .
                                        ;drwxr-xr-x 18 root root 4096 Jul 9 2011 ..
                                        ;drwxr-xr-x 2 root ftp 4096 May 28 2011 ftp
                                        ;-rw-r--r-- 1 root root    0 May 3 2011 .keep
                                        ;drwxr-xr-x 18 wyao root 4096 Feb 19 17:32 wyao
                 (multiple-value-bind
                       (tmp-string ppcre-res)
                     (scan-to-strings "(\\S+)\\s+(\\d+)\\s+(\\S+)\\s+(\\S+)\\s+(\\d+)\\s+(\\S+)\\s+(\\d+)\\s+(\\S+)\\s+(\\S+)" x)
                   (if (not (eq nil ppcre-res))
                       (if (or (string= "." (elt ppcre-res 8)) (string= ".." (elt ppcre-res 8)))
                           nil
                           (setf file-list (cons (list
                                                  (elt ppcre-res 8)    ;name
                                                  (concatenate 'string path-name "/" (elt ppcre-res 8) ) ;path + name
                                                  (parse-integer (elt ppcre-res 4)) ; size
                                                  (elt ppcre-res 0)) ;flag
                                                 file-list)))))
            ))
         finally (return (list file-list value-after-total))
    )))

;;inner-os-ls-al 是内部函数

;;用于执行/bin/ls -al这个系统调用，以获得某个目录的文件情况

(defun inner-os-ls-al (path-name)
(let ((p (sb-ext:process-output (sb-ext:run-program "/bin/ls" (list "-al" (eval_r(string path-name))) :output :stream)))
        (file-list nil))
    (loop for line = (read-line p nil)
       while (> (length line) 0) do (setf file-list (cons line file-list))
         finally (return file-list))))

cl 的完整程序