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
Package registry
Model registry
Operate
Environments
Terraform modules
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
GitLab community forum
Contribute to GitLab
Provide feedback
Terms and privacy
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
Christian Schafmeister
asdf
Commits
4e53ae5e
Commit
4e53ae5e
authored
15 years ago
by
Gary King
Browse files
Options
Downloads
Plain Diff
Merge with Daniel Herring's Windows link patches
parents
d9902d26
1d334a23
Branches
Branches containing commit
Tags
1.361
Tags containing commit
No related merge requests found
Changes
1
Show whitespace changes
Inline
Side-by-side
Showing
1 changed file
asdf.lisp
+92
-5
92 additions, 5 deletions
asdf.lisp
with
92 additions
and
5 deletions
asdf.lisp
+
92
−
5
View file @
4e53ae5e
...
...
@@ -597,9 +597,18 @@ actually-existing directory."
(
let
((
file
(
and
defaults
(
make-pathname
:defaults
defaults
:version
:newest
:name
name
:type
"asd"
:case
:local
))))
:name
name
:type
"asd"
:case
:local
)))
#+
(
or
win32
windows
)
(
shortcut
(
make-pathname
:defaults
defaults
:version
:newest
:name
name
:type
"asd.lnk"
:case
:local
)))
(
if
(
and
file
(
probe-file
file
))
(
return
file
))))
(
return
file
))
#+
(
or
win32
windows
)
(
when
(
probe-file
shortcut
)
(
let
((
target
(
parse-windows-shortcut
shortcut
)))
(
when
target
(
return
(
pathname
target
)))))))
(
t
(
restart-case
(
let*
((
*print-circle*
nil
)
...
...
@@ -1396,9 +1405,9 @@ Returns the new tree (which probably shares structure with the old one)"
(
loop
for
name
in
+asdf-methods+
do
(
let
((
keyword
(
intern
(
symbol-name
name
)
:keyword
)))
(
loop
for
data
=
rest
then
(
cddr
data
)
for
key
=
(
and
data
(
first
data
))
for
value
=
(
and
data
(
second
data
))
while
data
for
key
=
(
first
data
)
for
value
=
(
second
data
)
when
(
eq
key
keyword
)
do
(
destructuring-bind
(
op
qual
(
o
c
)
&body
body
)
value
(
pushnew
...
...
@@ -1569,6 +1578,84 @@ output to `*verbose-out*`. Returns the shell's exit code."
:directory
directory
)
(
system-source-directory
system
))))
;;;; Windows shortcut support. Based on:
;;; Jesse Hager: The Windows Shortcut File Format.
;;; http://www.wotsit.org/list.asp?fc=13
(
defparameter
*link-initial-dword*
76
)
(
defparameter
*link-guid*
#(
1
20
2
0
0
0
0
0
192
0
0
0
0
0
0
70
))
(
defun
read-null-terminated-string
(
s
)
(
with-output-to-string
(
out
)
(
loop
for
code
=
(
read-byte
s
)
until
(
zerop
code
)
do
(
write-char
(
code-char
code
)
out
))))
(
defun
read-little-endian
(
s
&optional
(
bytes
4
))
(
let
((
result
0
))
(
loop
for
i
from
0
below
bytes
do
(
setf
result
(
logior
result
(
ash
(
read-byte
s
)
(
*
8
i
)))))
result
))
(
defun
parse-windows-shortcut
(
pathname
)
(
with-open-file
(
s
pathname
:element-type
'
(
unsigned-byte
8
))
(
handler-case
(
when
(
and
(
=
(
read-little-endian
s
)
*link-initial-dword*
)
(
let
((
header
(
make-array
(
length
*link-guid*
))))
(
read-sequence
header
s
)
(
equalp
header
*link-guid*
)))
(
let
((
flags
(
read-little-endian
s
)))
(
file-position
s
76
)
;skip rest of header
(
when
(
logbitp
0
flags
)
;; skip shell item id list
(
let
((
length
(
read-little-endian
s
2
)))
(
file-position
s
(
+
length
(
file-position
s
)))))
(
cond
((
logbitp
1
flags
)
(
parse-file-location-info
s
))
(
t
(
when
(
logbitp
2
flags
)
;; skip description string
(
let
((
length
(
read-little-endian
s
2
)))
(
file-position
s
(
+
length
(
file-position
s
)))))
(
when
(
logbitp
3
flags
)
;; finally, our pathname
(
let*
((
length
(
read-little-endian
s
2
))
(
buffer
(
make-array
length
)))
(
read-sequence
buffer
s
)
(
map
'string
#'
code-char
buffer
)))))))
(
end-of-file
()
nil
))))
(
defun
parse-file-location-info
(
s
)
(
let
((
start
(
file-position
s
))
(
total-length
(
read-little-endian
s
))
(
end-of-header
(
read-little-endian
s
))
(
fli-flags
(
read-little-endian
s
))
(
local-volume-offset
(
read-little-endian
s
))
(
local-offset
(
read-little-endian
s
))
(
network-volume-offset
(
read-little-endian
s
))
(
remaining-offset
(
read-little-endian
s
)))
(
declare
(
ignore
total-length
end-of-header
local-volume-offset
))
(
unless
(
zerop
fli-flags
)
(
cond
((
logbitp
0
fli-flags
)
(
file-position
s
(
+
start
local-offset
)))
((
logbitp
1
fli-flags
)
(
file-position
s
(
+
start
network-volume-offset
#x14
))))
(
concatenate
'string
(
read-null-terminated-string
s
)
(
progn
(
file-position
s
(
+
start
remaining-offset
))
(
read-null-terminated-string
s
))))))
(
pushnew
:asdf
*features*
)
#+
sbcl
...
...
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