diff --git a/src/packages.lisp b/src/packages.lisp index c6755a5..a9a3786 100644 --- a/src/packages.lisp +++ b/src/packages.lisp @@ -7,6 +7,10 @@ (: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 + #:ensure-directory-pathname + #:directory-exists-p) (:export #:main #:preview #:*config* diff --git a/src/util.lisp b/src/util.lisp index ebafe4e..1811bde 100644 --- a/src/util.lisp +++ b/src/util.lisp @@ -30,33 +30,28 @@ BODY on files that match the given extension." #',extension-p (constantly t)))))) +(define-condition directory-does-not-exist (error) + ((directory :initarg dir :reader dir)) + (:report (lambda (c stream) + (format stream "The directory '~A' does not exist" (dir c))))) + +(defun (setf getcwd) (path) + "Change the operating system's current directory to PATH." + (setf path (ensure-directory-pathname path)) + (or (and (directory-exists-p path) + (chdir path)) + (error 'directory-does-not-exist :dir 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." diff --git a/themes/hyde/post.tmpl b/themes/hyde/post.tmpl index cebe759..8400fcb 100644 --- a/themes/hyde/post.tmpl +++ b/themes/hyde/post.tmpl @@ -6,7 +6,7 @@