Changeset 14152
- Timestamp:
- 09/14/12 22:09:14 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/abcl/src/org/armedbear/lisp/ensure-directories-exist.lisp
r13289 r14152 34 34 (in-package "SYSTEM") 35 35 36 (defun ensure-directories-exist (pathspec &key verbose)36 (defun ensure-directories-exist (pathspec &key (verbose t)) ;; DEBUG 37 37 (let ((pathname (pathname pathspec)) 38 38 (created-p nil)) … … 47 47 :pathname pathname)) 48 48 (let ((dir (pathname-directory pathname))) 49 (loop for i from 1 upto (length dir) 50 do (let ((newpath (make-pathname 51 :host (pathname-host pathname) 52 :device (pathname-device pathname) 53 :directory (subseq dir 0 i)))) 54 (unless (probe-file newpath) 55 (let ((namestring (namestring newpath))) 56 (when verbose 57 (fresh-line) 58 (format *standard-output* 59 "Creating directory: ~A~%" 60 namestring)) 61 (mkdir namestring) 62 (unless (probe-file namestring) 63 (error 'file-error 64 :pathname pathspec 65 :format-control "Can't create directory ~A." 66 :format-arguments (list namestring))) 49 (loop :for i :from 1 :upto (length dir) 50 :doing (let ((newpath (make-pathname 51 :host (pathname-host pathname) 52 :device (if (pathname-device pathname) 53 (pathname-device pathname) 54 :unspecific) 55 :directory (subseq dir 0 i)))) 56 (unless (probe-directory newpath) 57 (when verbose 58 (fresh-line) 59 (format *standard-output* 60 "Creating directory of pathname ~A.~&" 61 newpath)) 62 (mkdir newpath) 63 (unless (probe-directory newpath) 64 (error 'file-error 65 :pathname newpath 66 :format-control "Can't ensure directory~& ~S ~&ancestor of~& ~S." 67 :format-arguments (list newpath pathname))) 67 68 (setq created-p t))))) 68 (values pathname created-p))) )69 (values pathname created-p)))
Note: See TracChangeset
for help on using the changeset viewer.