Loading bin/install-asdf-as-module +1 −2 Original line number Diff line number Diff line Loading @@ -57,8 +57,7 @@ It notably doesn't work on: (defun install-asdf-as-module () (let ((fasl (asdf-module-fasl))) (ensure-directories-exist (translate-logical-pathname fasl)) (handler-bind ((warning #'muffle-warning)) (compile-file* (subpathname *asdf-dir* "build/asdf.lisp") :output-file fasl)))) (compile-file (subpathname *asdf-dir* "build/asdf.lisp") :output-file fasl))) (trace compile-file*) (install-asdf-as-module) uiop/image.lisp +1 −0 Original line number Diff line number Diff line Loading @@ -242,6 +242,7 @@ depending on whether *LISP-INTERACTION* is set, enter debugger or die" "Extract user arguments from command-line invocation of current process. Assume the calling conventions of a generated script that uses -- if we are not called from a directly executable image." (declare (ignorable arguments)) #+abcl arguments ;; LispWorks command-line processing isn't transparent to the user, and ;; we need to rely on cl-launch or some other script to set it for us. Loading uiop/pathname.lisp +23 −25 Original line number Diff line number Diff line Loading @@ -544,6 +544,25 @@ then it is merged with the PATHNAME-DIRECTORY-PATHNAME of PATHNAME." ;; scheme-specific parts: port username password, not others: . #.(or #+scl '(:parameters nil :query nil :fragment nil)))) (defun ensure-absolute-pathname (path &optional defaults (on-error 'error)) "Given a pathname designator PATH, return an absolute pathname as specified by PATH considering the DEFAULTS, or, if not possible, use CALL-FUNCTION on the specified ON-ERROR behavior, with a format control-string and other arguments as arguments" (cond ((absolute-pathname-p path)) ((stringp path) (ensure-absolute-pathname (pathname path) defaults on-error)) ((not (pathnamep path)) (call-function on-error "not a valid pathname designator ~S" path)) ((let ((default-pathname (if (pathnamep defaults) defaults (call-function defaults)))) (or (if (absolute-pathname-p default-pathname) (absolute-pathname-p (merge-pathnames* path default-pathname)) (call-function on-error "Default pathname ~S is not an absolute pathname" default-pathname)) (call-function on-error "Failed to merge ~S with ~S into an absolute pathname" path default-pathname)))) (t (call-function on-error "Cannot ensure ~S is evaluated as an absolute pathname with defaults ~S" path defaults)))) (defun subpathp (maybe-subpath base-pathname) "if MAYBE-SUBPATH is a pathname that is under BASE-PATHNAME, return a pathname object that when used with MERGE-PATHNAMES* with defaults BASE-PATHNAME, returns MAYBE-SUBPATH." Loading @@ -558,11 +577,9 @@ when used with MERGE-PATHNAMES* with defaults BASE-PATHNAME, returns MAYBE-SUBPA (defun enough-pathname (maybe-subpath base-pathname) "if MAYBE-SUBPATH is a pathname that is under BASE-PATHNAME, return a pathname object that when used with MERGE-PATHNAMES* with defaults BASE-PATHNAME, returns MAYBE-SUBPATH." (check-type maybe-subpath (or null pathname)) (check-type base-pathname (or null pathname)) (when (pathnamep base-pathname) (assert (absolute-pathname-p base-pathname))) (or (and base-pathname (subpathp maybe-subpath base-pathname)) maybe-subpath)) (let ((sub (when maybe-subpath (pathname maybe-subpath))) (base (when base-pathname (ensure-absolute-pathname (pathname base-pathname))))) (or (and base (subpathp sub base)) sub))) (defun call-with-enough-pathname (maybe-subpath defaults-pathname thunk) "In a context where *DEFAULT-PATHNAME-DEFAULTS* is bound to DEFAULTS-PATHNAME (if not null, Loading @@ -576,26 +593,7 @@ given DEFAULTS-PATHNAME as a base pathname." (defaults *default-pathname-defaults*)) &body body) "Shorthand syntax for CALL-WITH-ENOUGH-PATHNAME" `(call-with-enough-pathname ,pathname ,defaults #'(lambda (,pathname-var) ,@body))) (defun ensure-absolute-pathname (path &optional defaults (on-error 'error)) "Given a pathname designator PATH, return an absolute pathname as specified by PATH considering the DEFAULTS, or, if not possible, use CALL-FUNCTION on the specified ON-ERROR behavior, with a format control-string and other arguments as arguments" (cond ((absolute-pathname-p path)) ((stringp path) (ensure-absolute-pathname (pathname path) defaults on-error)) ((not (pathnamep path)) (call-function on-error "not a valid pathname designator ~S" path)) ((let ((default-pathname (if (pathnamep defaults) defaults (call-function defaults)))) (or (if (absolute-pathname-p default-pathname) (absolute-pathname-p (merge-pathnames* path default-pathname)) (call-function on-error "Default pathname ~S is not an absolute pathname" default-pathname)) (call-function on-error "Failed to merge ~S with ~S into an absolute pathname" path default-pathname)))) (t (call-function on-error "Cannot ensure ~S is evaluated as an absolute pathname with defaults ~S" path defaults))))) `(call-with-enough-pathname ,pathname ,defaults #'(lambda (,pathname-var) ,@body)))) ;;; Wildcard pathnames Loading Loading
bin/install-asdf-as-module +1 −2 Original line number Diff line number Diff line Loading @@ -57,8 +57,7 @@ It notably doesn't work on: (defun install-asdf-as-module () (let ((fasl (asdf-module-fasl))) (ensure-directories-exist (translate-logical-pathname fasl)) (handler-bind ((warning #'muffle-warning)) (compile-file* (subpathname *asdf-dir* "build/asdf.lisp") :output-file fasl)))) (compile-file (subpathname *asdf-dir* "build/asdf.lisp") :output-file fasl))) (trace compile-file*) (install-asdf-as-module)
uiop/image.lisp +1 −0 Original line number Diff line number Diff line Loading @@ -242,6 +242,7 @@ depending on whether *LISP-INTERACTION* is set, enter debugger or die" "Extract user arguments from command-line invocation of current process. Assume the calling conventions of a generated script that uses -- if we are not called from a directly executable image." (declare (ignorable arguments)) #+abcl arguments ;; LispWorks command-line processing isn't transparent to the user, and ;; we need to rely on cl-launch or some other script to set it for us. Loading
uiop/pathname.lisp +23 −25 Original line number Diff line number Diff line Loading @@ -544,6 +544,25 @@ then it is merged with the PATHNAME-DIRECTORY-PATHNAME of PATHNAME." ;; scheme-specific parts: port username password, not others: . #.(or #+scl '(:parameters nil :query nil :fragment nil)))) (defun ensure-absolute-pathname (path &optional defaults (on-error 'error)) "Given a pathname designator PATH, return an absolute pathname as specified by PATH considering the DEFAULTS, or, if not possible, use CALL-FUNCTION on the specified ON-ERROR behavior, with a format control-string and other arguments as arguments" (cond ((absolute-pathname-p path)) ((stringp path) (ensure-absolute-pathname (pathname path) defaults on-error)) ((not (pathnamep path)) (call-function on-error "not a valid pathname designator ~S" path)) ((let ((default-pathname (if (pathnamep defaults) defaults (call-function defaults)))) (or (if (absolute-pathname-p default-pathname) (absolute-pathname-p (merge-pathnames* path default-pathname)) (call-function on-error "Default pathname ~S is not an absolute pathname" default-pathname)) (call-function on-error "Failed to merge ~S with ~S into an absolute pathname" path default-pathname)))) (t (call-function on-error "Cannot ensure ~S is evaluated as an absolute pathname with defaults ~S" path defaults)))) (defun subpathp (maybe-subpath base-pathname) "if MAYBE-SUBPATH is a pathname that is under BASE-PATHNAME, return a pathname object that when used with MERGE-PATHNAMES* with defaults BASE-PATHNAME, returns MAYBE-SUBPATH." Loading @@ -558,11 +577,9 @@ when used with MERGE-PATHNAMES* with defaults BASE-PATHNAME, returns MAYBE-SUBPA (defun enough-pathname (maybe-subpath base-pathname) "if MAYBE-SUBPATH is a pathname that is under BASE-PATHNAME, return a pathname object that when used with MERGE-PATHNAMES* with defaults BASE-PATHNAME, returns MAYBE-SUBPATH." (check-type maybe-subpath (or null pathname)) (check-type base-pathname (or null pathname)) (when (pathnamep base-pathname) (assert (absolute-pathname-p base-pathname))) (or (and base-pathname (subpathp maybe-subpath base-pathname)) maybe-subpath)) (let ((sub (when maybe-subpath (pathname maybe-subpath))) (base (when base-pathname (ensure-absolute-pathname (pathname base-pathname))))) (or (and base (subpathp sub base)) sub))) (defun call-with-enough-pathname (maybe-subpath defaults-pathname thunk) "In a context where *DEFAULT-PATHNAME-DEFAULTS* is bound to DEFAULTS-PATHNAME (if not null, Loading @@ -576,26 +593,7 @@ given DEFAULTS-PATHNAME as a base pathname." (defaults *default-pathname-defaults*)) &body body) "Shorthand syntax for CALL-WITH-ENOUGH-PATHNAME" `(call-with-enough-pathname ,pathname ,defaults #'(lambda (,pathname-var) ,@body))) (defun ensure-absolute-pathname (path &optional defaults (on-error 'error)) "Given a pathname designator PATH, return an absolute pathname as specified by PATH considering the DEFAULTS, or, if not possible, use CALL-FUNCTION on the specified ON-ERROR behavior, with a format control-string and other arguments as arguments" (cond ((absolute-pathname-p path)) ((stringp path) (ensure-absolute-pathname (pathname path) defaults on-error)) ((not (pathnamep path)) (call-function on-error "not a valid pathname designator ~S" path)) ((let ((default-pathname (if (pathnamep defaults) defaults (call-function defaults)))) (or (if (absolute-pathname-p default-pathname) (absolute-pathname-p (merge-pathnames* path default-pathname)) (call-function on-error "Default pathname ~S is not an absolute pathname" default-pathname)) (call-function on-error "Failed to merge ~S with ~S into an absolute pathname" path default-pathname)))) (t (call-function on-error "Cannot ensure ~S is evaluated as an absolute pathname with defaults ~S" path defaults))))) `(call-with-enough-pathname ,pathname ,defaults #'(lambda (,pathname-var) ,@body)))) ;;; Wildcard pathnames Loading