- (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))))))
+ (let ((physical (directorize-pathname
+ (physicalize-pathname
+ (merge-pathnames
+ pathspec (sane-default-pathname-defaults))))))
+ (labels ((recurse-merged (dir)
+ (lambda (sub)
+ (recurse (merge-pathnames sub dir))))
+ (delete-merged (dir)
+ (lambda (file)
+ (delete-file (merge-pathnames file dir))))
+ (recurse (dir)
+ (map-directory (recurse-merged dir) dir
+ :files nil
+ :directories t
+ :classify-symlinks nil)
+ (map-directory (delete-merged dir) 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 "Couldn't delete directory ~A"
+ namestring (get-errno))
+ dir))))
+ (if recursive
+ (recurse physical)
+ (delete-dir physical)))))