Loading asdf.lisp +40 −34 Original line number Diff line number Diff line Loading @@ -60,7 +60,7 @@ (eval-when (:load-toplevel :compile-toplevel :execute) (let* ((asdf-version ;; the 1+ hair is to ensure that we don't do an inadvertent find and replace (subseq "VERSION:1.668" (1+ (length "VERSION")))) (subseq "VERSION:1.669" (1+ (length "VERSION")))) #+allegro (excl::*autoload-package-name-alist* nil) (existing-asdf (find-package :asdf)) (versym '#:*asdf-version*) Loading Loading @@ -669,9 +669,13 @@ actually-existing directory." "Resolve as much of a pathname as possible" (block nil (when (typep p 'logical-pathname) (return p)) (let* ((p (merge-pathnames p)) (directory (pathname-directory p))) (when (typep p 'logical-pathname) (return p)) (ignore-errors (return (truename p))) (let ((directory (pathname-directory p))) (when (or (atom directory) (not (eq :absolute (car directory)))) (when (stringp directory) (return p)) (when (not (eq :absolute (car directory))) (return p)) (let ((sofar (ignore-errors (truename (pathname-root p))))) (unless sofar (return p)) Loading Loading @@ -2596,51 +2600,53 @@ effectively disabling the output translation facility." (ensure-output-translations) (loop :with p = (truenamize path) :for (source destination) :in (car *output-translations*) :when (or (eq source t) (and (absolute-pathname-p source) (pathname-match-p p source)) :for root = (when (or (eq source t) (and (pathnamep source) (pathname-match-p p (merge-pathnames* source (pathname-root p))))) (not (absolute-pathname-p source)))) (pathname-root p)) :for absolute-source = (cond ((eq source t) (wilden root)) (root (merge-pathnames* source root)) (t source)) :when (or (eq source t) (pathname-match-p p absolute-source)) :return (cond ((functionp destination) (funcall destination p source)) (funcall destination p absolute-source)) ((eq destination t) p) ((and (eq source t) (pathnamep destination)) (translate-full-pathname p destination)) ((not (pathnamep destination)) (error "invalid destination")) ((not (absolute-pathname-p destination)) (translate-pathname p absolute-source (merge-pathnames* destination root))) (root (translate-pathname (directorize-pathname-host-device p) absolute-source destination)) (t (translate-pathname p source destination))) (translate-pathname p absolute-source destination))) :finally (return p))))) (defun last-char (s) (and (stringp s) (plusp (length s)) (char s (1- (length s))))) (defun translate-full-pathname (source destination) (let* ((source-root (pathname-root source)) (wild-source (wilden source-root)) (absolute-source (merge-pathnames* source source-root)) (absolute-destination (merge-pathnames* destination source-root)) (wild-destination (if (wild-pathname-p absolute-destination) absolute-destination (wilden absolute-destination))) (destination-root (pathname-root absolute-destination)) (source-foo (make-pathname :directory '(:absolute "FOO") :defaults source-root)) (source-separator (last-char (namestring source-foo))) (source-root-namestring (namestring source-root)) (source-root-string (defun directorize-pathname-host-device (pathname) (let* ((root (pathname-root pathname)) (wild-root (wilden root)) (absolute-pathname (merge-pathnames* pathname root)) (foo (make-pathname :directory '(:absolute "FOO") :defaults root)) (separator (last-char (namestring foo))) (root-namestring (namestring root)) (root-string (substitute-if #\/ (lambda (x) (or (eql x #\:) (eql x source-separator))) source-root-namestring))) (eql x separator))) root-namestring))) (multiple-value-bind (relative path filename) (component-name-to-pathname-components source-root-string t) (component-name-to-pathname-components root-string t) (declare (ignore relative filename)) (let* ((new-base (make-pathname :defaults source-root :directory `(:absolute ,@path))) (rebased-source (translate-pathname absolute-source wild-source (wilden new-base)))) (translate-pathname rebased-source wild-source wild-destination))))) (let ((new-base (make-pathname :defaults root :directory `(:absolute ,@path)))) (translate-pathname absolute-pathname wild-root (wilden new-base)))))) (defmethod output-files :around (operation component) "Translate output files, unless asked not to" Loading doc/asdf.texinfo +21 −6 Original line number Diff line number Diff line Loading @@ -2172,19 +2172,34 @@ You may use @code{#+features} to customize the configuration file. The second designator of a mapping may be @code{NIL}, indicating that files are not mapped to anything but themselves (same as if the second designator was the same as the first). When the first designator is @code{t}, the mapping always matches. When the first designator starts with @code{:root}, the mapping matches any host and device. In either of these cases, if the second designator isn't @code{t} and doesn't start with @code{:root}, then strings indicating the host and pathname are somehow copied in the beginning of the directory component of the source pathname before it is translated. When the second designator is @code{t}, the mapping is the identity. When the second designator starts with @code{root}, the mapping preserves the host and device of the original pathname. @code{:include} statements cause the search to recurse with the path specifications from the file specified. If the @code{translate-pathname} mechanism cannot achieve a desired translation, the user may provide a function which provides the required algorithim. Such a translation function is specified by supplying a list as the second @code{directory-designator} whose first element is the keyword @code{:function}, and whose second element is supplying a list as the second @code{directory-designator} the first element of which is the keyword @code{:function}, and the second element of which is either a symbol which designates a function or a lambda expression. The function designated by the second argument must take two arguments, the first being the pathname of the source file, the second being the wildcard that was matched. The result of the function invocation should be the translated pathname. The function designated by the second argument must take two arguments, the first being the pathname of the source file, the second being the wildcard that was matched. The result of the function invocation should be the translated pathname. An @code{:inherit-configuration} statement cause the search to recurse with the path specifications from the next configuration. Loading Loading
asdf.lisp +40 −34 Original line number Diff line number Diff line Loading @@ -60,7 +60,7 @@ (eval-when (:load-toplevel :compile-toplevel :execute) (let* ((asdf-version ;; the 1+ hair is to ensure that we don't do an inadvertent find and replace (subseq "VERSION:1.668" (1+ (length "VERSION")))) (subseq "VERSION:1.669" (1+ (length "VERSION")))) #+allegro (excl::*autoload-package-name-alist* nil) (existing-asdf (find-package :asdf)) (versym '#:*asdf-version*) Loading Loading @@ -669,9 +669,13 @@ actually-existing directory." "Resolve as much of a pathname as possible" (block nil (when (typep p 'logical-pathname) (return p)) (let* ((p (merge-pathnames p)) (directory (pathname-directory p))) (when (typep p 'logical-pathname) (return p)) (ignore-errors (return (truename p))) (let ((directory (pathname-directory p))) (when (or (atom directory) (not (eq :absolute (car directory)))) (when (stringp directory) (return p)) (when (not (eq :absolute (car directory))) (return p)) (let ((sofar (ignore-errors (truename (pathname-root p))))) (unless sofar (return p)) Loading Loading @@ -2596,51 +2600,53 @@ effectively disabling the output translation facility." (ensure-output-translations) (loop :with p = (truenamize path) :for (source destination) :in (car *output-translations*) :when (or (eq source t) (and (absolute-pathname-p source) (pathname-match-p p source)) :for root = (when (or (eq source t) (and (pathnamep source) (pathname-match-p p (merge-pathnames* source (pathname-root p))))) (not (absolute-pathname-p source)))) (pathname-root p)) :for absolute-source = (cond ((eq source t) (wilden root)) (root (merge-pathnames* source root)) (t source)) :when (or (eq source t) (pathname-match-p p absolute-source)) :return (cond ((functionp destination) (funcall destination p source)) (funcall destination p absolute-source)) ((eq destination t) p) ((and (eq source t) (pathnamep destination)) (translate-full-pathname p destination)) ((not (pathnamep destination)) (error "invalid destination")) ((not (absolute-pathname-p destination)) (translate-pathname p absolute-source (merge-pathnames* destination root))) (root (translate-pathname (directorize-pathname-host-device p) absolute-source destination)) (t (translate-pathname p source destination))) (translate-pathname p absolute-source destination))) :finally (return p))))) (defun last-char (s) (and (stringp s) (plusp (length s)) (char s (1- (length s))))) (defun translate-full-pathname (source destination) (let* ((source-root (pathname-root source)) (wild-source (wilden source-root)) (absolute-source (merge-pathnames* source source-root)) (absolute-destination (merge-pathnames* destination source-root)) (wild-destination (if (wild-pathname-p absolute-destination) absolute-destination (wilden absolute-destination))) (destination-root (pathname-root absolute-destination)) (source-foo (make-pathname :directory '(:absolute "FOO") :defaults source-root)) (source-separator (last-char (namestring source-foo))) (source-root-namestring (namestring source-root)) (source-root-string (defun directorize-pathname-host-device (pathname) (let* ((root (pathname-root pathname)) (wild-root (wilden root)) (absolute-pathname (merge-pathnames* pathname root)) (foo (make-pathname :directory '(:absolute "FOO") :defaults root)) (separator (last-char (namestring foo))) (root-namestring (namestring root)) (root-string (substitute-if #\/ (lambda (x) (or (eql x #\:) (eql x source-separator))) source-root-namestring))) (eql x separator))) root-namestring))) (multiple-value-bind (relative path filename) (component-name-to-pathname-components source-root-string t) (component-name-to-pathname-components root-string t) (declare (ignore relative filename)) (let* ((new-base (make-pathname :defaults source-root :directory `(:absolute ,@path))) (rebased-source (translate-pathname absolute-source wild-source (wilden new-base)))) (translate-pathname rebased-source wild-source wild-destination))))) (let ((new-base (make-pathname :defaults root :directory `(:absolute ,@path)))) (translate-pathname absolute-pathname wild-root (wilden new-base)))))) (defmethod output-files :around (operation component) "Translate output files, unless asked not to" Loading
doc/asdf.texinfo +21 −6 Original line number Diff line number Diff line Loading @@ -2172,19 +2172,34 @@ You may use @code{#+features} to customize the configuration file. The second designator of a mapping may be @code{NIL}, indicating that files are not mapped to anything but themselves (same as if the second designator was the same as the first). When the first designator is @code{t}, the mapping always matches. When the first designator starts with @code{:root}, the mapping matches any host and device. In either of these cases, if the second designator isn't @code{t} and doesn't start with @code{:root}, then strings indicating the host and pathname are somehow copied in the beginning of the directory component of the source pathname before it is translated. When the second designator is @code{t}, the mapping is the identity. When the second designator starts with @code{root}, the mapping preserves the host and device of the original pathname. @code{:include} statements cause the search to recurse with the path specifications from the file specified. If the @code{translate-pathname} mechanism cannot achieve a desired translation, the user may provide a function which provides the required algorithim. Such a translation function is specified by supplying a list as the second @code{directory-designator} whose first element is the keyword @code{:function}, and whose second element is supplying a list as the second @code{directory-designator} the first element of which is the keyword @code{:function}, and the second element of which is either a symbol which designates a function or a lambda expression. The function designated by the second argument must take two arguments, the first being the pathname of the source file, the second being the wildcard that was matched. The result of the function invocation should be the translated pathname. The function designated by the second argument must take two arguments, the first being the pathname of the source file, the second being the wildcard that was matched. The result of the function invocation should be the translated pathname. An @code{:inherit-configuration} statement cause the search to recurse with the path specifications from the next configuration. Loading