/[gcl]/gcl/lsp/gcl_iolib.lsp
ViewVC logotype

Diff of /gcl/lsp/gcl_iolib.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.4 by camm, Mon Aug 16 22:32:31 2004 UTC revision 1.5 by camm, Sat May 7 16:10:01 2005 UTC
# Line 272  Line 272 
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  ;  ;
# Line 504  the one defined in the ANSI standard. *p Line 513  the one defined in the ANSI standard. *p
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    

Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26