+
+(defun delete-directory (pathspec &key recursive)
+ "Deletes the directory designated by PATHSPEC (a pathname designator).
+Returns the truename of the directory deleted.
+
+If RECURSIVE is false \(the default), signals an error unless the directory is
+empty. If RECURSIVE is true, first deletes all files and subdirectories. If
+RECURSIVE is true and the directory contains symbolic links, the links are
+deleted, not the files and directories they point to.
+
+Signals an error if PATHSPEC designates a file instead of a directory, or if
+the directory could not be deleted for any reason.
+
+\(DELETE-DIRECTORY \"/tmp/foo\") and \(DELETE-DIRECTORY \"/tmp/foo/\") both
+delete the \"foo\" subdirectory of \"/tmp\", or signal an error if it does not
+exist or is a file.
+
+Experimental: interface subject to change."
+ (declare (type pathname-designator pathspec))
+ (with-pathname (pathname pathspec)
+ (let ((truename (truename (translate-logical-pathname pathname))))
+ (labels ((recurse (dir)
+ (map-directory #'recurse dir
+ :files nil
+ :directories t
+ :classify-symlinks nil)
+ (map-directory #'delete-file dir
+ :files t
+ :directories nil
+ :classify-symlinks nil)
+ (delete-dir dir))
+ (delete-dir (dir)
+ (let* ((namestring (native-namestring dir :as-file t))
+ (res (alien-funcall (extern-alien #!-win32 "rmdir"
+ #!+win32 "_rmdir"
+ (function int c-string))
+ namestring)))
+ (if (minusp res)
+ (simple-file-perror "Could not delete directory ~A:~% ~A"
+ namestring (get-errno))
+ dir))))
+ (if recursive
+ (recurse truename)
+ (delete-dir truename))))))