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
Hugo Ishimaru
asdf
Commits
0484bd87
Commit
0484bd87
authored
10 years ago
by
Francois-Rene Rideau
Browse files
Options
Downloads
Patches
Plain Diff
Genera: support directory deletion, remove some compile-time warnings.
parent
2f4058cd
No related branches found
Branches containing commit
No related tags found
Tags containing commit
No related merge requests found
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
uiop/filesystem.lisp
+4
-3
4 additions, 3 deletions
uiop/filesystem.lisp
uiop/run-program.lisp
+3
-1
3 additions, 1 deletion
uiop/run-program.lisp
uiop/utility.lisp
+2
-2
2 additions, 2 deletions
uiop/utility.lisp
with
9 additions
and
6 deletions
uiop/filesystem.lisp
+
4
−
3
View file @
0484bd87
...
@@ -592,13 +592,14 @@ in an atomic way if the implementation allows."
...
@@ -592,13 +592,14 @@ in an atomic way if the implementation allows."
directory-pathname
(
unix:get-unix-error-msg
errno
))))
directory-pathname
(
unix:get-unix-error-msg
errno
))))
#+
cormanlisp
(
win32:delete-directory
directory-pathname
)
#+
cormanlisp
(
win32:delete-directory
directory-pathname
)
#+
ecl
(
si:rmdir
directory-pathname
)
#+
ecl
(
si:rmdir
directory-pathname
)
#+
genera
(
fs:delete-directory
directory-pathname
)
#+
lispworks
(
lw:delete-directory
directory-pathname
)
#+
lispworks
(
lw:delete-directory
directory-pathname
)
#+
mkcl
(
mkcl:rmdir
directory-pathname
)
#+
mkcl
(
mkcl:rmdir
directory-pathname
)
#+
sbcl
#.
(
if-let
(
dd
(
find-symbol*
:delete-directory
:sb-ext
nil
))
#+
sbcl
#.
(
if-let
(
dd
(
find-symbol*
:delete-directory
:sb-ext
nil
))
`
(
,
dd
directory-pathname
)
;; requires SBCL 1.0.44 or later
`
(
,
dd
directory-pathname
)
;; requires SBCL 1.0.44 or later
`
(
progn
(
require
:sb-posix
)
(
symbol-call
:sb-posix
:rmdir
directory-pathname
)))
`
(
progn
(
require
:sb-posix
)
(
symbol-call
:sb-posix
:rmdir
directory-pathname
)))
#+
xcl
(
symbol-call
:uiop
:run-program
`
(
"rmdir"
,
(
native-namestring
directory-pathname
)))
#+
xcl
(
symbol-call
:uiop
:run-program
`
(
"rmdir"
,
(
native-namestring
directory-pathname
)))
#-
(
or
abcl
allegro
clisp
clozure
cmu
cormanlisp
digitool
ecl
gcl
lispworks
mkcl
sbcl
scl
xcl
)
#-
(
or
abcl
allegro
clisp
clozure
cmu
cormanlisp
digitool
ecl
gcl
genera
lispworks
mkcl
sbcl
scl
xcl
)
(
error
"~S not implemented on ~S"
'delete-empty-directory
(
implementation-type
)))
; genera
(
error
"~S not implemented on ~S"
'delete-empty-directory
(
implementation-type
)))
; genera
(
defun
delete-directory-tree
(
directory-pathname
&key
(
validate
nil
validatep
)
(
if-does-not-exist
:error
))
(
defun
delete-directory-tree
(
directory-pathname
&key
(
validate
nil
validatep
)
(
if-does-not-exist
:error
))
...
@@ -632,7 +633,7 @@ If you're suicidal or extremely confident, just use :VALIDATE T."
...
@@ -632,7 +633,7 @@ If you're suicidal or extremely confident, just use :VALIDATE T."
(
error
"~S was asked to delete ~S but the directory does not exist"
(
error
"~S was asked to delete ~S but the directory does not exist"
'delete-filesystem-tree
directory-pathname
))
'delete-filesystem-tree
directory-pathname
))
(
:ignore
nil
)))
(
:ignore
nil
)))
#-
(
or
allegro
cmu
clozure
sbcl
scl
)
#-
(
or
allegro
cmu
clozure
genera
sbcl
scl
)
((
os-unix-p
)
;; On Unix, don't recursively walk the directory and delete everything in Lisp,
((
os-unix-p
)
;; On Unix, don't recursively walk the directory and delete everything in Lisp,
;; except on implementations where we can prevent DIRECTORY from following symlinks;
;; except on implementations where we can prevent DIRECTORY from following symlinks;
;; instead spawn a standard external program to do the dirty work.
;; instead spawn a standard external program to do the dirty work.
...
@@ -642,7 +643,7 @@ If you're suicidal or extremely confident, just use :VALIDATE T."
...
@@ -642,7 +643,7 @@ If you're suicidal or extremely confident, just use :VALIDATE T."
#+
allegro
(
symbol-call
:excl.osi
:delete-directory-and-files
#+
allegro
(
symbol-call
:excl.osi
:delete-directory-and-files
directory-pathname
:if-does-not-exist
if-does-not-exist
)
directory-pathname
:if-does-not-exist
if-does-not-exist
)
#+
clozure
(
ccl:delete-directory
directory-pathname
)
#+
clozure
(
ccl:delete-directory
directory-pathname
)
#+
genera
(
error
"~S not implemented on ~S"
'delete-directory-tree
(
implementation-type
)
)
#+
genera
(
fs:delete-directory
directory-pathname
:confirm
nil
)
#+
sbcl
#.
(
if-let
(
dd
(
find-symbol*
:delete-directory
:sb-ext
nil
))
#+
sbcl
#.
(
if-let
(
dd
(
find-symbol*
:delete-directory
:sb-ext
nil
))
`
(
,
dd
directory-pathname
:recursive
t
)
;; requires SBCL 1.0.44 or later
`
(
,
dd
directory-pathname
:recursive
t
)
;; requires SBCL 1.0.44 or later
'
(
error
"~S requires SBCL 1.0.44 or later"
'delete-directory-tree
))
'
(
error
"~S requires SBCL 1.0.44 or later"
'delete-directory-tree
))
...
...
This diff is collapsed.
Click to expand it.
uiop/run-program.lisp
+
3
−
1
View file @
0484bd87
...
@@ -773,7 +773,7 @@ It returns a process-info plist with possible keys:
...
@@ -773,7 +773,7 @@ It returns a process-info plist with possible keys:
#+
(
or
allegro
clozure
cmu
(
and
lispworks
os-unix
)
sbcl
scl
)
#+
(
or
allegro
clozure
cmu
(
and
lispworks
os-unix
)
sbcl
scl
)
(
%wait-process-result
(
%wait-process-result
(
apply
'%run-program
(
%normalize-system-command
command
)
:wait
t
keys
))
(
apply
'%run-program
(
%normalize-system-command
command
)
:wait
t
keys
))
#+
(
or
abcl
cormanlisp
clisp
ecl
gcl
(
and
lispworks
os-windows
)
mkcl
xcl
)
#+
(
or
abcl
cormanlisp
clisp
ecl
gcl
genera
(
and
lispworks
os-windows
)
mkcl
xcl
)
(
let
((
%command
(
%redirected-system-command
command
input
output
error-output
directory
)))
(
let
((
%command
(
%redirected-system-command
command
input
output
error-output
directory
)))
#+
(
and
lispworks
os-windows
)
#+
(
and
lispworks
os-windows
)
(
system:call-system
%command
:current-directory
directory
:wait
t
)
(
system:call-system
%command
:current-directory
directory
:wait
t
)
...
@@ -790,6 +790,8 @@ It returns a process-info plist with possible keys:
...
@@ -790,6 +790,8 @@ It returns a process-info plist with possible keys:
(
*error-output*
*stderr*
))
(
*error-output*
*stderr*
))
(
ext:system
%command
))
(
ext:system
%command
))
#+
gcl
(
system:system
%command
)
#+
gcl
(
system:system
%command
)
#+
genera
(
error
"~S not supported on Genera, cannot run ~S"
'%system
%command
)
#+
mcl
(
ccl::with-cstrs
((
%%command
%command
))
(
_system
%%command
))
#+
mcl
(
ccl::with-cstrs
((
%%command
%command
))
(
_system
%%command
))
#+
mkcl
(
mkcl:system
%command
)
#+
mkcl
(
mkcl:system
%command
)
#+
xcl
(
system:%run-shell-command
%command
))))
#+
xcl
(
system:%run-shell-command
%command
))))
...
...
This diff is collapsed.
Click to expand it.
uiop/utility.lisp
+
2
−
2
View file @
0484bd87
...
@@ -195,7 +195,7 @@ Returns two values: \(A B C\) and \(1 2 3\)."
...
@@ -195,7 +195,7 @@ Returns two values: \(A B C\) and \(1 2 3\)."
;;; Characters
;;; Characters
(
with-upgradability
()
;; base-char != character on ECL, LW, SBCL, Genera. LW also has SIMPLE-CHAR.
(
with-upgradability
()
;; base-char != character on ECL, LW, SBCL, Genera. LW also has SIMPLE-CHAR.
(
defconstant
+non-base-chars-exist-p+
(
not
(
subtypep
'character
'base-char
)))
(
defconstant
+non-base-chars-exist-p+
#.
(
not
(
subtypep
'character
'base-char
)))
#-
scl
;; In SCL, all characters seem to be 16-bit base-char, but this flag gets set somehow???
#-
scl
;; In SCL, all characters seem to be 16-bit base-char, but this flag gets set somehow???
(
when
+non-base-chars-exist-p+
(
pushnew
:non-base-chars-exist-p
*features*
)))
(
when
+non-base-chars-exist-p+
(
pushnew
:non-base-chars-exist-p
*features*
)))
...
@@ -372,7 +372,7 @@ and EVAL that in a (FUNCTION ...) context."
...
@@ -372,7 +372,7 @@ and EVAL that in a (FUNCTION ...) context."
(
etypecase
fun
(
etypecase
fun
(
function
fun
)
(
function
fun
)
((
or
boolean
keyword
character
number
pathname
)
(
constantly
fun
))
((
or
boolean
keyword
character
number
pathname
)
(
constantly
fun
))
(
hash-table
(
lambda
(
x
)
(
gethash
x
fun
)))
(
hash-table
#'
(
lambda
(
x
)
(
gethash
x
fun
)))
(
symbol
(
fdefinition
fun
))
(
symbol
(
fdefinition
fun
))
(
cons
(
if
(
eq
'lambda
(
car
fun
))
(
cons
(
if
(
eq
'lambda
(
car
fun
))
(
eval
fun
)
(
eval
fun
)
...
...
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