1 files changed, 43 insertions(+), 26 deletions(-)

M chicken-clean.scm

@@ 32,6 32,9 @@
           (chicken string)
           (srfi 1)))
 
+(define (list-if test value)
+  (if (test value) (list value) (list)))
+
 (define (local-egg-build-artifacts)
   (let ((egg-files (glob "*.egg" "chicken/*.egg")))
     (map symbol->string (append-map egg-programs egg-files))))


@@ 56,14 59,6 @@
                  ,(glob->sre "*.types"))
             (pathname-strip-directory path)))))
 
-(define (file-removal-summary paths)
-  (conc "The following files will be removed:"
-        #\newline
-        #\newline
-        (foldl (lambda (s p) (conc s "  " p #\newline)) "" paths)
-        #\newline
-        "Continue?"))
-
 (define (disposable-directory? path)
   (and (directory-exists? path)
        ((flip every)


@@ 85,29 80,51 @@
                    (= (errno) errno/notempty))
          (signal e)))))
 
-(define (clean-working-directory)
-  (let* ((files       (find-files "." test: disposable-file?))
-         (directories (find-files "." test: disposable-directory?))
-         (sorted      (sort (append files directories) string<?)))
-    (when (and (pair? sorted) (prompt (file-removal-summary sorted)))
-      (for-each remove-file files)
-      (for-each remove-directory directories))))
+(define (file-removal-summary paths)
+  (conc "The following files will be removed:"
+        #\newline
+        #\newline
+        (foldl (lambda (s p) (conc s "  " p #\newline)) "" paths)
+        #\newline
+        "Continue?"))
+
+(define (collect-disposable-files path)
+  (cond ((disposable-file? path) (list path))
+        ((directory-exists? path)
+         (append (list-if disposable-directory? path)
+                 (find-files path test: disposable-file?)
+                 (find-files path test: disposable-directory?)))
+        (else (list))))
+
+(define (clean-paths paths)
+  (let* ((disposable (append-map collect-disposable-files paths))
+         (sorted     (sort disposable string<?)))
+    (receive (directories files) (partition directory-exists? sorted)
+      (when (and (pair? sorted) (prompt (file-removal-summary sorted)))
+        (for-each remove-file files)
+        (for-each remove-directory directories)))))
 
 (define (usage status)
-  (message 0 (conc "Usage: " (pathname-file (program-name)) " [-interactive | -quiet | -verbose]"))
+  (message 0 (conc "Usage: " (pathname-file (program-name)) " [-interactive | -quiet | -verbose] [<path> ...]"))
   (exit status))
 
 (define (main)
-  ((flip for-each)
-   (command-line-arguments)
-   (lambda (flag)
-     (case (string->symbol flag)
-       ((-quiet) (verbosity (sub1 (verbosity))))
-       ((-verbose) (verbosity (add1 (verbosity))))
-       ((-interactive) (interactive #t))
-       ((-h -help) (usage 0))
-       (else (usage 1)))))
-  (clean-working-directory))
+  (let ((paths '()))
+    ((flip for-each)
+     (command-line-arguments)
+     (lambda (flag)
+       (case (string->symbol flag)
+         ((-quiet) (verbosity (sub1 (verbosity))))
+         ((-verbose) (verbosity (add1 (verbosity))))
+         ((-interactive) (interactive #t))
+         ((-h -help) (usage 0))
+         (else (set! paths (cons flag paths))))))
+    (if (any (lambda (p) (irregex-search "^-" p)) paths)
+        (usage 1)
+        (clean-paths
+         (if (null? paths)
+             (list ".")
+             (reverse paths))))))
 
 (cond-expand
   (compiling (main))