From: Stefan Bernemann
Subject: creating a new directory (in Lucid lisp)
Date:
Message-ID: <318dne$ejg@iml.iml.fhg.de>
Hi everyone,
I know there is no portable way of creating a
directory from lisp, but I thought there might
be non-portable ways...
However, I cant find out how to do it in Lucid.
Currently, I have a Unix-Command (mkdir) run from
Lisp, but I want to get the error status and the
diagnostics back to lisp. So I let the error-output go
to a temp-file and read that back in when the
error-status is not equal 0. (Lucid does
not allow me to communicate via pipes if I call
the other Unix process synchronously, if I call it
asynchronously I cant get the error-status, as far
as my simple mind understood...
Is there any easier way of doing this????
(In fact, this experiece was like an earth quake
to my strong beliefs of Lisp being a good choice for
writing real world applications...)
--------------------------------------------------------------
Stefan Bernemann Tel.: +49-231-9743-139
FhG IML Fax: +49-213-9743-234
Joseph-von-Fraunhofer-Str. 2-4 email: ·····@iml.fhg.de
D44227 Dortmund
Stefan Bernemann <·····@iml.fhg.de> wrote:
>
>I know there is no portable way of creating a
>directory from lisp, but I thought there might
>be non-portable ways...
>However, I cant find out how to do it in Lucid.
The almost-accepted ANS CL spec has a function
ENSURE-DIRECTORIES-EXIST that does what you want. Most implementation
do not support it yet, though. I have included my versions of it for
Lucid and Genera; perhaps other folks can add ones for other CLs.
--David Gadbois
#+(and Lucid UNIX)
(defun my-lisp:ensure-directories-exist (pathspec &key verbose)
(let ((pathname (pathname pathspec)))
(when (eq (car (pathname-directory pathname)) :relative)
(setf pathname (merge-pathnames pathname)))
#+LPATHS
(when (typep pathname 'logical-pathname)
(setf pathname (translate-logical-pathname pathname)))
(setf pathname (make-pathname :defaults pathname
:name nil
:type nil
:version nil))
(let* ((directories (pathname-directory pathname))
(length (length directories))
(created-p nil))
(loop for i from (- length 2) downto 0
as parents = (butlast directories i)
as directory = (make-pathname :defaults pathname
:directory parents)
do
(unless (probe-file directory)
(multiple-value-bind (stdio stderr status pid)
(lcl:run-program "/bin/mkdir"
:input #P"/dev/null"
:output #P"/dev/null"
:if-output-exists :overwrite
:error-output #P"/dev/null"
:if-error-output-exists :overwrite
:arguments (list (format nil "/~{~A~^/~}" (cdr parents))))
(declare (ignore stdio stderr pid))
(if (zerop status)
(progn
(setf created-p t)
(when verbose
(format t "~&~A created.~%" directory)))
(error 'file-error :pathname directory)))))
(values pathspec created-p))))
#+Genera
(defun my-lisp:ensure-directories-exist (pathspec &key verbose)
(let ((pathname (pathname pathspec)))
(when (eq (car (pathname-directory pathname)) :relative)
(setf pathname (merge-pathnames pathname)))
(when (typep pathname 'logical-pathname)
(setf pathname (translate-logical-pathname pathname)))
(let* ((directories (pathname-directory pathname))
(length (length directories))
(created-p nil))
(loop for i from (- length 2) downto 0
as parent = (make-pathname :defaults pathname
:directory (butlast directories i))
as directory = (scl:send parent :directory-pathname-as-file) do
(unless (probe-file directory)
(scl:send parent :create-directory)
(setf created-p t)
(when verbose
(format t "~&~A created.~%" directory))))
(values pathspec created-p))))