272 |
;;; ensure-directories-exist |
;;; ensure-directories-exist |
273 |
|
|
274 |
(defun ensure-directories-exist (pathspec &key verbose) |
(defun ensure-directories-exist (pathspec &key verbose) |
275 |
(let* ((path (pathname pathspec)) |
(flet ((pop-path |
276 |
(dir (make-pathname :host (pathname-host path) |
(p) |
277 |
:device (pathname-device path) |
(if (pathname-name p) p |
278 |
:directory (pathname-directory path))) |
(let* ((pd (pathname-directory p)) |
279 |
(created nil) |
(kl (if (keywordp (car (last pd))) 0 1))) |
280 |
trans walk newdir) |
(merge-pathnames |
281 |
(when (and (pathname-directory path) |
(make-pathname :directory (butlast pd kl) |
282 |
(not (probe-file dir))) |
:name (last pd kl)) |
283 |
(setq trans (pathname-directory (translate-logical-pathname dir))) |
p))))) |
284 |
(setq walk (list (car trans))) |
(let* ((path (pathname pathspec)) |
285 |
(dolist (step (cdr trans)) |
(dir (make-pathname :host (pathname-host path) |
286 |
(nconc walk (list step)) |
:device (pathname-device path) |
287 |
(setq newdir (make-pathname :directory walk)) |
:directory (pathname-directory path))) |
288 |
(when (not (probe-file newdir)) |
(created nil) |
289 |
(si:mkdir newdir) |
trans walk newdir) |
290 |
(when verbose (format t "~&Directory ~A created.~%" newdir)))) |
(when (and (pathname-directory path) |
291 |
(setq created t)) |
(not (directory (pop-path dir)))) |
292 |
(values pathspec created))) |
(setq trans (pathname-directory (translate-logical-pathname dir))) |
293 |
|
(setq walk (list (car trans))) |
294 |
|
(dolist (step (cdr trans)) |
295 |
|
(nconc walk (list step)) |
296 |
|
(setq newdir (make-pathname :directory walk)) |
297 |
|
(when (not (directory (pop-path newdir))) |
298 |
|
(si:mkdir newdir) |
299 |
|
(when verbose (format t "~&Directory ~A created.~%" newdir)))) |
300 |
|
(setq created t)) |
301 |
|
(values pathspec created)))) |
302 |
|
|
303 |
;;; new logical pathname translation |
;;; new logical pathname translation |
304 |
; |
; |
513 |
|
|
514 |
; i know this should be in cmpnew - but its easier here. |
; i know this should be in cmpnew - but its easier here. |
515 |
|
|
516 |
(defmacro with-compilation-unit (opt &rest body) `(progn ,@body)) |
(defmacro with-compilation-unit (opt &rest body) (declare (ignore opt)) `(progn ,@body)) |
517 |
|
|