newLISP 删除目录

newLISP实现删除目录这是个很简单的需求，可是API只提供了一个几乎没什么用的函数，remove-dir 要求目录必须为空， 99%的情况是目录不为空。因此我写了一个函数来递归删除目录树：（define （make-sure-folder-path-end-of-slash dir-path）
（if （！= （last dir-path） "/"）
（push "/" dir-path -1）
）
dir-path
）（define （no-sub-files dir-path）
（not （directory dir-path {[^（.$）]}）））（define （delete-dir dir-path）
;; check dir-path
（unless （directory？ dir-path）
（throw-error （string dir-path " folder does not exist"））） ;; append slash to dir-path
（set "dir-path （make-sure-folder-path-end-of-slash dir-path）） ;; process sub files
（let （sub-files （directory dir-path {[^（.$）]}））
（if sub-files
（begin
;; iterate all sub files
（dolist （nde sub-files）
（if （directory？（append dir-path nde））
（delete-dir （append dir-path nde） file-op ext-context）
（let （file-path （append dir-path nde））
（println （string "delete file " file-path ": " （file-info file-path）））
（delete-file file-path ext-context））））
（if （no-sub-files dir-path）
（begin
（println （string "delete folder " dir-path ": " （file-info dir-path）））
（remove-dir dir-path））
）
）
（begin
（println "no sub files in " dir-path " folder, delete this folder"）
（remove-dir dir-path））
）
）
）测试方法：dean@dean-Latitude-3330:~/Downloads$ mkdir -p x/x2/x3; touch x/x2/x3/z;touch x/x2/m;touch x/.sss; touch x/a.x;
dean@dean-Latitude-3330:~/Downloads$ tree x -a
x
├── a.x
├── .sss
└── x2
├── m
└── x3
└── z2 directories, 4 files然后执行newlisp函数：> （delete-dir "/home/dean/Downloads/x"）
delete file /home/dean/Downloads/x/a.x: （0 33204 0 1000 1000 1409987071 1409987071 1409987071）
delete file /home/dean/Downloads/x/x2/x3/z: （0 33204 0 1000 1000 1409987071 1409987071 1409987071）
delete folder /home/dean/Downloads/x/x2/x3/: （4096 16893 0 1000 1000 1409987075 1409987075 1409987075）
delete file /home/dean/Downloads/x/x2/m: （0 33204 0 1000 1000 1409987071 1409987071 1409987071）
delete folder /home/dean/Downloads/x/x2/: （4096 16893 0 1000 1000 1409987075 1409987075 1409987075）
delete file /home/dean/Downloads/x/.sss: （0 33204 0 1000 1000 1409987071 1409987071 1409987071）
delete folder /home/dean/Downloads/x/: （4096 16893 0 1000 1000 1409987075 1409987075 1409987075）
true为Emacs配置newLISP开发环境 http://www.linuxidc.com/Linux/2013-01/78463.htmnewLISP做GitLab系统备份 http://www.linuxidc.com/Linux/2013-01/78464.htmnewLISP 遍历目录树，清理编译目录 http://www.linuxidc.com/Linux/2013-08/88954.htmnewLISP 的详细介绍：请点这里
newLISP 的下载地址：请点这里本文永久更新链接地址：http://www.linuxidc.com/Linux/2014-09/106263.htm