Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
asdf
asdf
Commits
c43c16b3
Commit
c43c16b3
authored
Apr 27, 2015
by
Francois-Rene Rideau
Browse files
Use os-cond in more places.
parent
d32057a3
Changes
5
Hide whitespace changes
Inline
Side-by-side
find-system.lisp
View file @
c43c16b3
...
...
@@ -174,14 +174,16 @@ Going forward, we recommend new users should be using the source-registry.
:truename
truename
))
(
return
file
))
#-
(
or
clisp
genera
)
; clisp doesn't need it, plain genera doesn't have read-sequence(!)
(
when
(
and
(
os-windows-p
)
(
physical-pathname-p
defaults
))
(
let
((
shortcut
(
make-pathname
:defaults
defaults
:case
:local
:name
(
strcat
name
".asd"
)
:type
"lnk"
)))
(
when
(
probe-file*
shortcut
)
(
ensure-pathname
(
parse-windows-shortcut
shortcut
)
:namestring
:native
)))))))
(
os-cond
((
os-windows-p
)
(
when
(
physical-pathname-p
defaults
)
(
let
((
shortcut
(
make-pathname
:defaults
defaults
:case
:local
:name
(
strcat
name
".asd"
)
:type
"lnk"
)))
(
when
(
probe-file*
shortcut
)
(
ensure-pathname
(
parse-windows-shortcut
shortcut
)
:namestring
:native
)))))))))
(
defun
sysdef-central-registry-search
(
system
)
(
let
((
name
(
primary-system-name
system
))
...
...
uiop/configuration.lisp
View file @
c43c16b3
...
...
@@ -331,7 +331,8 @@ this function tries to locate the Windows FOLDER for one of
(
defun
config-system-pathnames
(
&optional
app
&rest
more
)
"Determine system user configuration directories"
(
when
(
os-unix-p
)
(
list
(
resolve-location
`
(
,
(
parse-unix-namestring
"/etc/"
)
,
app
,
more
)))))
(
os-cond
((
os-unix-p
)
(
list
(
resolve-location
`
(
,
(
parse-unix-namestring
"/etc/"
)
,
app
,
more
))))))
(
defun
clean-search-pathnames
(
dirs
)
"Parse strings as unix namestrings and remove duplicates and non absolute-pathnames in a list"
...
...
uiop/filesystem.lisp
View file @
c43c16b3
...
...
@@ -37,8 +37,9 @@
#+
(
or
cmu
scl
)
(
ext:unix-namestring
p
nil
)
#+
sbcl
(
sb-ext:native-namestring
p
)
#-
(
or
clozure
cmu
sbcl
scl
)
(
if
(
os-unix-p
)
(
unix-namestring
p
)
(
namestring
p
)))))
(
os-cond
((
os-unix-p
)
(
unix-namestring
p
))
(
t
(
namestring
p
))))))
(
defun
parse-native-namestring
(
string
&rest
constraints
&key
ensure-directory
&allow-other-keys
)
"From a native namestring suitable for use by the operating system, return
...
...
@@ -50,9 +51,9 @@ a CL pathname satisfying all the specified constraints as per ENSURE-PATHNAME"
#+
clozure
(
ccl:native-to-pathname
string
)
#+
sbcl
(
sb-ext:parse-native-namestring
string
)
#-
(
or
clozure
sbcl
)
(
if
(
os-unix-p
)
(
parse-unix-namestring
string
:ensure-directory
ensure-directory
)
(
parse-namestring
string
)))))
(
os-cond
((
os-unix-p
)
(
parse-unix-namestring
string
:ensure-directory
ensure-directory
)
)
(
t
(
parse-namestring
string
)))))
)
(
pathname
(
if
ensure-directory
(
and
pathname
(
ensure-directory-pathname
pathname
))
...
...
@@ -501,7 +502,7 @@ Note that this operation is usually NOT thread-safe."
(
with-upgradability
()
(
defun
inter-directory-separator
()
"What character does the current OS conventionally uses to separate directories?"
(
if
(
os-unix-p
)
#\:
#\;
))
(
os-cond
(
(
os-unix-p
)
#\:
)
(
t
#\;
))
)
(
defun
split-native-pathnames-string
(
string
&rest
constraints
&key
&allow-other-keys
)
"Given a string of pathnames specified in native OS syntax, separate them in a list,
...
...
uiop/pathname.lisp
View file @
c43c16b3
...
...
@@ -656,9 +656,10 @@ given DEFAULTS-PATHNAME as a base pathname."
(
defun
directorize-pathname-host-device
(
pathname
)
"Given a PATHNAME, return a pathname that has representations of its HOST and DEVICE components
added to its DIRECTORY component. This is useful for output translations."
#+
(
or
unix
abcl
)
(
when
(
and
#+
abcl
(
os-unix-p
)
(
physical-pathname-p
pathname
))
(
return-from
directorize-pathname-host-device
pathname
))
(
os-cond
((
os-unix-p
)
(
when
(
physical-pathname-p
pathname
)
(
return-from
directorize-pathname-host-device
pathname
))))
(
let*
((
root
(
pathname-root
pathname
))
(
wild-root
(
wilden
root
))
(
absolute-pathname
(
merge-pathnames*
pathname
root
))
...
...
uiop/run-program.lisp
View file @
c43c16b3
...
...
@@ -739,7 +739,9 @@ It returns a process-info plist with possible keys:
(
etypecase
command
(
string
command
)
(
list
(
escape-shell-command
(
if
(
os-unix-p
)
(
cons
"exec"
command
)
command
)))))
(
os-cond
((
os-unix-p
)
(
cons
"exec"
command
))
(
t
command
))))))
(
defun
%redirected-system-command
(
command
in
out
err
directory
)
;; helper for %USE-SYSTEM
(
flet
((
redirect
(
spec
operator
)
...
...
@@ -756,14 +758,16 @@ It returns a process-info plist with possible keys:
(
escape-shell-token
(
native-namestring
pathname
)))))))
(
multiple-value-bind
(
before
after
)
(
let
((
normalized
(
%normalize-system-command
command
)))
(
if
(
os-unix-p
)
(
values
'
(
"exec"
)
(
list
" ; "
normalized
))
(
values
(
list
normalized
)
())))
(
os-cond
((
os-unix-p
)
(
values
'
(
"exec"
)
(
list
" ; "
normalized
))
)
(
t
(
values
(
list
normalized
)
())))
)
(
reduce/strcat
(
append
before
(
redirect
in
" <"
)
(
redirect
out
" >"
)
(
redirect
err
" 2>"
)
(
when
(
and
directory
(
os-unix-p
))
;; NB: unless on Unix, %system uses with-current-directory
`
(
" ; cd "
,
(
escape-shell-token
(
native-namestring
directory
))))
(
os-cond
((
os-unix-p
)
(
when
directory
;; NB: unless on Unix, %system uses with-current-directory
`
(
" ; cd "
,
(
escape-shell-token
(
native-namestring
directory
))))))
after
)))))
(
defun
%system
(
command
&rest
keys
...
...
@@ -782,7 +786,7 @@ It returns a process-info plist with possible keys:
(
apply
'%run-program
%command
:wait
t
:input
:interactive
:output
:interactive
:error-output
:interactive
keys
))
#-
(
or
clisp
(
and
lispworks
os-windows
))
(
with-current-directory
((
unless
(
os-unix-p
)
directory
))
(
with-current-directory
((
os-cond
((
not
(
os-unix-p
)
)
directory
))
)
#+
abcl
(
ext:run-shell-command
%command
)
#+
cormanlisp
(
win32:system
%command
)
#+
(
or
clasp
ecl
)
(
let
((
*standard-input*
*stdin*
)
...
...
Write
Preview
Supports
Markdown
0%
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!
Cancel
Please
register
or
sign in
to comment