pathnames.lisp 666 Bytes
Newer Older
1 2 3 4 5 6 7
(in-package :asdf-tools)

;;; ASDF directory
(defvar *asdf-dir*
  (ensure-pathname (system-relative-pathname :asdf/defsystem ())
                   :want-physical t :want-absolute t
                   :want-existing t :truename t))
8

9 10 11 12 13
(defun pn (&rest x)
  (subpathname *asdf-dir* (and x (uiop:resolve-relative-location x))))
(defun nn (&rest x)
  (native-namestring (apply 'pn x)))

14 15 16
(defvar *uiop-dir* (pn "uiop/"))
(defvar *build-dir* (pn "build/"))

17 18 19 20 21 22 23
(defun call-with-asdf-dir (thunk &rest subs)
  (with-current-directory ((apply 'pn subs))
    (funcall thunk)))

(defmacro with-asdf-dir ((&rest subs) &body body)
  `(call-with-asdf-dir (lambda () ,@body) ,@subs))