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
1ebfcdcc
Commit
1ebfcdcc
authored
Feb 09, 2014
by
Robert P. Goldman
Browse files
Fix for bug where DIRECTORY-FILES listed subdirectories.
parent
fad76d08
Changes
1
Hide whitespace changes
Inline
Side-by-side
uiop/filesystem.lisp
View file @
1ebfcdcc
...
@@ -142,6 +142,9 @@ or the original (parsed) pathname if it is false (the default)."
...
@@ -142,6 +142,9 @@ or the original (parsed) pathname if it is false (the default)."
(
defun
directory-exists-p
(
x
)
(
defun
directory-exists-p
(
x
)
"Is X the name of a directory that exists on the filesystem?"
"Is X the name of a directory that exists on the filesystem?"
#+
allegro
(
excl:probe-directory
x
)
#-
allegro
(
let
((
p
(
probe-file*
x
:truename
t
)))
(
let
((
p
(
probe-file*
x
:truename
t
)))
(
and
(
directory-pathname-p
p
)
p
)))
(
and
(
directory-pathname-p
p
)
p
)))
...
@@ -187,8 +190,12 @@ This function is used as a helper to DIRECTORY-FILES to avoid invalid entries wh
...
@@ -187,8 +190,12 @@ This function is used as a helper to DIRECTORY-FILES to avoid invalid entries wh
(
defun
directory-files
(
directory
&optional
(
pattern
*wild-file*
))
(
defun
directory-files
(
directory
&optional
(
pattern
*wild-file*
))
"Return a list of the files in a directory according to the PATTERN,
"Return a list of the files in a directory according to the PATTERN.
which is not very portable to override. Try not resolve symlinks if implementation allows."
Subdirectories should NOT be returned.
PATTERN defaults to a pattern carefully chosen based on the implementation;
override the default at your own risk.
DIRECTORY-FILES tries NOT to resolve symlinks if the implementation
permits this."
(
let
((
dir
(
pathname
directory
)))
(
let
((
dir
(
pathname
directory
)))
(
when
(
logical-pathname-p
dir
)
(
when
(
logical-pathname-p
dir
)
;; Because of the filtering we do below,
;; Because of the filtering we do below,
...
@@ -204,13 +211,14 @@ which is not very portable to override. Try not resolve symlinks if implementati
...
@@ -204,13 +211,14 @@ which is not very portable to override. Try not resolve symlinks if implementati
#+
clisp
#+
clisp
(
when
(
equal
:wild
(
pathname-type
pattern
))
(
when
(
equal
:wild
(
pathname-type
pattern
))
(
ignore-errors
(
directory*
(
make-pathname
:type
nil
:defaults
pat
)))))))
(
ignore-errors
(
directory*
(
make-pathname
:type
nil
:defaults
pat
)))))))
(
filter-logical-directory-results
(
remove-if
'directory-exists-p
directory
entries
(
filter-logical-directory-results
#'
(
lambda
(
f
)
directory
entries
(
make-pathname
:defaults
dir
#'
(
lambda
(
f
)
:name
(
make-pathname-component-logical
(
pathname-name
f
))
(
make-pathname
:defaults
dir
:type
(
make-pathname-component-logical
(
pathname-type
f
))
:name
(
make-pathname-component-logical
(
pathname-name
f
))
:version
(
make-pathname-component-logical
(
pathname-version
f
))))))))
:type
(
make-pathname-component-logical
(
pathname-type
f
))
:version
(
make-pathname-component-logical
(
pathname-version
f
)))))))))
(
defun
subdirectories
(
directory
)
(
defun
subdirectories
(
directory
)
"Given a DIRECTORY pathname designator, return a list of the subdirectories under it."
"Given a DIRECTORY pathname designator, return a list of the subdirectories under it."
...
...
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