Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
asdf
asdf
Commits
08267f16
Commit
08267f16
authored
Apr 08, 2010
by
Francois-Rene Rideau
Browse files
1.669: fix and document the apply-output-translations function.
parent
054bf9dc
Changes
2
Hide whitespace changes
Inline
Side-by-side
asdf.lisp
View file @
08267f16
...
...
@@ -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.66
8
"
(
1+
(
length
"VERSION"
))))
(
subseq
"VERSION:1.66
9
"
(
1+
(
length
"VERSION"
))))
#+
allegro
(
excl::*autoload-package-name-alist*
nil
)
(
existing-asdf
(
find-package
:asdf
))
(
versym
'
#:*asdf-version*
)
...
...
@@ -669,9 +669,13 @@ actually-existing directory."
"Resolve as much of a pathname as possible"
(
block
nil
(
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
))))
(
let*
((
p
(
merge-pathnames
p
))
(
directory
(
pathname-directory
p
)))
(
when
(
typep
p
'logical-pathname
)
(
return
p
))
(
ignore-errors
(
return
(
truename
p
)))
(
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
))
...
...
@@ -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
))
(
and
(
pathnamep
source
)
(
pathname-match-p
p
(
merge-pathnames*
source
(
pathname-root
p
)))))
:for
root
=
(
when
(
or
(
eq
source
t
)
(
and
(
pathnamep
source
)
(
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"
...
...
doc/asdf.texinfo
View file @
08267f16
...
...
@@ -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.
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment