Skip to content
GitLab
Explore
Sign in
Register
Primary navigation
Search or go to…
Project
A
asdf
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Wiki
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Snippets
Build
Pipelines
Jobs
Pipeline schedules
Artifacts
Deploy
Releases
Container Registry
Model registry
Operate
Environments
Monitor
Incidents
Service Desk
Analyze
Value stream analytics
Contributor analytics
CI/CD analytics
Repository analytics
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Terms and privacy
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
Pascal J. Bourguignon
asdf
Commits
08267f16
Commit
08267f16
authored
15 years ago
by
Francois-Rene Rideau
Browse files
Options
Downloads
Patches
Plain Diff
1.669: fix and document the apply-output-translations function.
parent
054bf9dc
No related branches found
No related tags found
No related merge requests found
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
asdf.lisp
+40
-34
40 additions, 34 deletions
asdf.lisp
doc/asdf.texinfo
+21
-6
21 additions, 6 deletions
doc/asdf.texinfo
with
61 additions
and
40 deletions
asdf.lisp
+
40
−
34
View file @
08267f16
...
@@ -60,7 +60,7 @@
...
@@ -60,7 +60,7 @@
(
eval-when
(
:load-toplevel
:compile-toplevel
:execute
)
(
eval-when
(
:load-toplevel
:compile-toplevel
:execute
)
(
let*
((
asdf-version
(
let*
((
asdf-version
;; the 1+ hair is to ensure that we don't do an inadvertent find and replace
;; 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
)
#+
allegro
(
excl::*autoload-package-name-alist*
nil
)
(
existing-asdf
(
find-package
:asdf
))
(
existing-asdf
(
find-package
:asdf
))
(
versym
'
#:*asdf-version*
)
(
versym
'
#:*asdf-version*
)
...
@@ -669,9 +669,13 @@ actually-existing directory."
...
@@ -669,9 +669,13 @@ actually-existing directory."
"Resolve as much of a pathname as possible"
"Resolve as much of a pathname as possible"
(
block
nil
(
block
nil
(
when
(
typep
p
'logical-pathname
)
(
return
p
))
(
when
(
typep
p
'logical-pathname
)
(
return
p
))
(
ignore-errors
(
return
(
truename
p
)))
(
let*
((
p
(
merge-pathnames
p
))
(
let
((
directory
(
pathname-directory
p
)))
(
directory
(
pathname-directory
p
)))
(
when
(
or
(
atom
directory
)
(
not
(
eq
:absolute
(
car
directory
))))
(
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
))
(
return
p
))
(
let
((
sofar
(
ignore-errors
(
truename
(
pathname-root
p
)))))
(
let
((
sofar
(
ignore-errors
(
truename
(
pathname-root
p
)))))
(
unless
sofar
(
return
p
))
(
unless
sofar
(
return
p
))
...
@@ -2596,51 +2600,53 @@ effectively disabling the output translation facility."
...
@@ -2596,51 +2600,53 @@ effectively disabling the output translation facility."
(
ensure-output-translations
)
(
ensure-output-translations
)
(
loop
:with
p
=
(
truenamize
path
)
(
loop
:with
p
=
(
truenamize
path
)
:for
(
source
destination
)
:in
(
car
*output-translations*
)
:for
(
source
destination
)
:in
(
car
*output-translations*
)
:when
(
or
(
eq
source
t
)
:for
root
=
(
when
(
or
(
eq
source
t
)
(
and
(
absolute-pathname-p
source
)
(
pathname-match-p
p
source
))
(
and
(
pathnamep
source
)
(
and
(
pathnamep
source
)
(
not
(
absolute-pathname-p
source
))))
(
pathname-match-p
p
(
merge-pathnames*
source
(
pathname-root
p
)))))
(
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
:return
(
cond
(
cond
((
functionp
destination
)
((
functionp
destination
)
(
funcall
destination
p
source
))
(
funcall
destination
p
absolute-
source
))
((
eq
destination
t
)
((
eq
destination
t
)
p
)
p
)
((
and
(
eq
source
t
)
(
pathnamep
destination
))
((
not
(
pathnamep
destination
))
(
translate-full-pathname
p
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
(
t
(
translate-pathname
p
source
destination
)))
(
translate-pathname
p
absolute-
source
destination
)))
:finally
(
return
p
)))))
:finally
(
return
p
)))))
(
defun
last-char
(
s
)
(
defun
last-char
(
s
)
(
and
(
stringp
s
)
(
plusp
(
length
s
))
(
char
s
(
1-
(
length
s
)))))
(
and
(
stringp
s
)
(
plusp
(
length
s
))
(
char
s
(
1-
(
length
s
)))))
(
defun
translate-full-pathname
(
source
destination
)
(
defun
directorize-pathname-host-device
(
pathname
)
(
let*
((
source-root
(
pathname-root
source
))
(
let*
((
root
(
pathname-root
pathname
))
(
wild-source
(
wilden
source-root
))
(
wild-root
(
wilden
root
))
(
absolute-source
(
merge-pathnames*
source
source-root
))
(
absolute-pathname
(
merge-pathnames*
pathname
root
))
(
absolute-destination
(
merge-pathnames*
destination
source-root
))
(
foo
(
make-pathname
:directory
'
(
:absolute
"FOO"
)
:defaults
root
))
(
wild-destination
(
separator
(
last-char
(
namestring
foo
)))
(
if
(
wild-pathname-p
absolute-destination
)
(
root-namestring
(
namestring
root
))
absolute-destination
(
root-string
(
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
(
substitute-if
#\/
(
substitute-if
#\/
(
lambda
(
x
)
(
or
(
eql
x
#\:
)
(
lambda
(
x
)
(
or
(
eql
x
#\:
)
(
eql
x
source-
separator
)))
(
eql
x
separator
)))
source-
root-namestring
)))
root-namestring
)))
(
multiple-value-bind
(
relative
path
filename
)
(
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
))
(
declare
(
ignore
relative
filename
))
(
let*
((
new-base
(
let
((
new-base
(
make-pathname
:defaults
source-root
(
make-pathname
:defaults
root
:directory
`
(
:absolute
,@
path
)))
:directory
`
(
:absolute
,@
path
))))
(
rebased-source
(
translate-pathname
absolute-source
wild-source
(
wilden
new-base
))))
(
translate-pathname
absolute-pathname
wild-root
(
wilden
new-base
))))))
(
translate-pathname
rebased-source
wild-source
wild-destination
)))))
(
defmethod
output-files
:around
(
operation
component
)
(
defmethod
output-files
:around
(
operation
component
)
"Translate output files, unless asked not to"
"Translate output files, unless asked not to"
...
...
This diff is collapsed.
Click to expand it.
doc/asdf.texinfo
+
21
−
6
View file @
08267f16
...
@@ -2172,19 +2172,34 @@ You may use @code{#+features} to customize the configuration file.
...
@@ -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
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
)
.
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
@code
{
:include
}
statements cause the search to recurse with the path specifications
from the file specified.
from the file specified.
If the @code
{
translate
-
pathname
}
mechanism cannot achieve a desired
If the @code
{
translate
-
pathname
}
mechanism cannot achieve a desired
translation, the user may provide a function which provides the
translation, the user may provide a function which provides the
required algorithim. Such a translation function is specified by
required algorithim. Such a translation function is specified by
supplying a list as the second @code
{
directory
-
designator
}
whose first
supplying a list as the second @code
{
directory
-
designator
}
element is the keyword @code
{
:function
}
, and whose second element is
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.
either a symbol which designates a function or a lambda expression.
The function designated by the second argument must take two
The function designated by the second argument must take two
arguments,
arguments,
the first being the pathname of the source file,
the second
the first being the pathname of the source file,
being the wildcard that was matched.
The result of the function
the second
being the wildcard that was matched.
invocation should be the translated pathname.
The result of the function
invocation should be the translated pathname.
An @code
{
:inherit
-
configuration
}
statement cause the search to recurse with the path
An @code
{
:inherit
-
configuration
}
statement cause the search to recurse with the path
specifications from the next configuration.
specifications from the next configuration.
...
...
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment