Changeset 7518


Ignore:
Timestamp:
Oct 25, 2007, 2:21:44 PM (14 years ago)
Author:
mikel
Message:

added a definition for ccl::recursive-delete-directory

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/ccl/lib/pathnames.lisp

    r7494 r7518  
    155155              (copy-file f dest-file :if-exists :supersede :preserve-attributes t)))))))
    156156
    157 
     157;;; use with caution!
     158;;; blows away a directory and all its contents
     159(defun recursive-delete-directory (path &key (if-does-not-exist :error))
     160  (setq path (ensure-directory-pathname path))
     161  (setq if-does-not-exist (require-type if-does-not-exist '(member :error nil)))
     162  (when (eq if-does-not-exist :error)
     163    (unless (probe-file path)
     164      (if-does-not-exist if-does-not-exist path)))
     165  (when (probe-file path)
     166      (if (directoryp path)
     167          ;; it's a directory: blow it away
     168          (let* ((pattern (make-pathname :name :wild :type :wild :defaults path))
     169                 (files (directory pattern :directories nil :files t))
     170                 (subdirs (directory pattern :directories t :files nil))
     171                 (target-pathname (native-translated-namestring path)))
     172            (dolist (f files)
     173              (delete-file f))
     174            (dolist (d subdirs)
     175              (recursive-delete-directory d :if-does-not-exist if-does-not-exist))
     176            (%rmdir target-pathname))
     177          ;; it's not a directory: for safety's sake, signal an error
     178          (error "Pathname '~A' is not a directory" path))))
    158179
    159180;;; It's not clear that we can support anything stronger than
Note: See TracChangeset for help on using the changeset viewer.