current-directory not needed, use uiop instead

Add setf expansion for getcwd
This commit is contained in:
Javier Olaechea 2014-08-15 14:09:09 -05:00
parent 81fe5a72d3
commit c2e83dd729
2 changed files with 10 additions and 21 deletions

View file

@ -7,6 +7,8 @@
(:import-from :cl-fad #:file-exists-p)
(:import-from :closure-template #:compile-template)
(:import-from :local-time #:format-rfc1123-timestring)
(:import-from :uiop #:getcwd
#:chdir)
(:export #:main
#:preview
#:*config*

View file

@ -30,33 +30,20 @@ BODY on files that match the given extension."
#',extension-p
(constantly t))))))
(defun (setf getcwd) (path)
"Change the operating system's current directory to PATH."
(chdir path)
path)
(defmacro with-current-directory (path &body body)
"Change the current directory to PATH and execute BODY in
an UNWIND-PROTECT, then change back to the current directory."
(alexandria:with-gensyms (old)
`(let ((,old (current-directory)))
`(let ((,old (getcwd)))
(unwind-protect (progn
(setf (current-directory) ,path)
(setf (getcwd) ,path)
,@body)
(setf (current-directory) ,old)))))
(defun current-directory ()
"Return the operating system's current directory."
#+sbcl (sb-posix:getcwd)
#+ccl (ccl:current-directory)
#+ecl (si:getcwd)
#+cmucl (unix:unix-current-directory)
#+clisp (ext:cd)
#-(or sbcl ccl ecl cmucl clisp) (error "Not implemented yet."))
(defun (setf current-directory) (path)
"Change the operating system's current directory to PATH."
#+sbcl (sb-posix:chdir path)
#+ccl (setf (ccl:current-directory) path)
#+ecl (si:chdir path)
#+cmucl (unix:unix-chdir (namestring path))
#+clisp (ext:cd path)
#-(or sbcl ccl ecl cmucl clisp) (error "Not implemented yet."))
(setf (getcwd) ,old)))))
(defun exit ()
"Exit the lisp system returning a 0 status code."