Skip to content
GitLab
Explore
Sign in
Register
Primary navigation
Search or go to…
Project
cmucl
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
Community forum
Contribute to GitLab
Provide feedback
Terms and privacy
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
Carl Shapiro
cmucl
Commits
a14bdf88
Commit
a14bdf88
authored
34 years ago
by
wlott
Browse files
Options
Downloads
Patches
Plain Diff
Replaced mach:unix-subtestname and lisp::predict-name with
mach:unix-file-kind and ext:unix-namestring.
parent
b722a48c
No related branches found
Branches containing commit
No related tags found
Tags containing commit
No related merge requests found
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
hemlock/dired.lisp
+72
-75
72 additions, 75 deletions
hemlock/dired.lisp
with
72 additions
and
75 deletions
hemlock/dired.lisp
+
72
−
75
View file @
a14bdf88
...
...
@@ -108,53 +108,53 @@
user will be asked whether it should be overwritten or not."
(
cond
((
not
directoryp
)
(
multiple-value-bind
(
ses-name1
ex
ists1p
)
(
lisp::predict-name
spec1
t
)
(
let*
(
(
ses-name2
(
lisp::predict-name
spec2
nil
))
(
pname1
(
pathname
ses-name1
))
(
pname2
(
pathname
ses-name2
))
(
dirp1
(
directoryp
pname1
))
(
dirp2
(
directoryp
pname2
))
(
wildp1
(
wildcardp
(
file-namestring
pname1
)))
(
wildp2
(
wildcardp
(
file-namestring
pname2
))))
(
when
(
and
dirp1
wildp1
)
(
funcall
*error-function*
"Cannot have wildcards in directory names -- ~S."
pname1
))
(
when
(
and
dirp2
wildp2
)
(
funcall
*error-function*
"Cannot have wildcards in directory names -- ~S."
pname2
))
(
when
(
and
dirp1
(
not
dirp2
))
(
funcall
*error-function*
"Cannot handle spec1 being a directory and spec2 a file."
))
(
when
(
and
wildp2
(
not
wildp1
))
(
funcall
*error-function*
"Cannot handle destination having wildcards without ~
source having wildcards."
))
(
when
(
and
wildp1
(
not
wildp2
)
(
not
dirp2
))
(
funcall
*error-function*
"Cannot handle source with wildcards and destination ~
without, unless destination is a directory."
))
(
cond
((
and
dirp1
dirp2
)
(
unless
(
directory-existsp
ses-name1
)
(
funcall
*error-function*
"Directory does not exist -- ~S."
pname1
))
(
unless
(
directory-existsp
ses-name2
)
(
enter-directory
ses-name2
))
(
recursive-copy
pname1
pname2
update
clobber
pname2
ses-name1
ses-name2
))
(
dirp2
;; merge pname2 with pname1 to pick up a similar file-namestring.
(
copy-file-1
pname1
wildp1
exists1p
(
merge-pathnames
pname2
pname1
)
wildp1
update
clobber
))
(
t
(
copy-file-1
pname1
wildp1
exists1p
pname2
wildp2
update
clobber
)))))
)
(
let*
(
(
ses-name1
(
ex
t:unix-namestring
spec1
t
)
)
(
exists1p
(
mach:unix-file-kind
ses-name1
)
)
(
ses-name2
(
ext:unix-namestring
spec2
nil
))
(
pname1
(
pathname
ses-name1
))
(
pname2
(
pathname
ses-name2
))
(
dirp1
(
directoryp
pname1
))
(
dirp2
(
directoryp
pname2
))
(
wildp1
(
wildcardp
(
file-namestring
pname1
)))
(
wildp2
(
wildcardp
(
file-namestring
pname2
))))
(
when
(
and
dirp1
wildp1
)
(
funcall
*error-function*
"Cannot have wildcards in directory names -- ~S."
pname1
))
(
when
(
and
dirp2
wildp2
)
(
funcall
*error-function*
"Cannot have wildcards in directory names -- ~S."
pname2
))
(
when
(
and
dirp1
(
not
dirp2
))
(
funcall
*error-function*
"Cannot handle spec1 being a directory and spec2 a file."
))
(
when
(
and
wildp2
(
not
wildp1
))
(
funcall
*error-function*
"Cannot handle destination having wildcards without ~
source having wildcards."
))
(
when
(
and
wildp1
(
not
wildp2
)
(
not
dirp2
))
(
funcall
*error-function*
"Cannot handle source with wildcards and destination ~
without, unless destination is a directory."
))
(
cond
((
and
dirp1
dirp2
)
(
unless
(
directory-existsp
ses-name1
)
(
funcall
*error-function*
"Directory does not exist -- ~S."
pname1
))
(
unless
(
directory-existsp
ses-name2
)
(
enter-directory
ses-name2
))
(
recursive-copy
pname1
pname2
update
clobber
pname2
ses-name1
ses-name2
))
(
dirp2
;; merge pname2 with pname1 to pick up a similar file-namestring.
(
copy-file-1
pname1
wildp1
exists1p
(
merge-pathnames
pname2
pname1
)
wildp1
update
clobber
))
(
t
(
copy-file-1
pname1
wildp1
exists1p
pname2
wildp2
update
clobber
)))))
(
directory
(
when
(
pathname-directory
spec1
)
(
funcall
*error-function*
"Spec1 is just a pattern when supplying directory -- ~S."
spec1
))
(
let*
((
pname2
(
pathname
(
lisp::predict-name
spec2
nil
)))
(
let*
((
pname2
(
pathname
(
ext:unix-namestring
spec2
nil
)))
(
dirp2
(
directoryp
pname2
))
(
wildp1
(
wildcardp
spec1
))
(
wildp2
(
wildcardp
(
file-namestring
pname2
))))
...
...
@@ -295,37 +295,37 @@
specify the trailing slash."
(
cond
((
not
directoryp
)
(
multiple-value-bind
(
ses-name1
ex
ists1p
)
(
lisp::predict-name
spec1
t
)
(
let*
(
(
ses-name2
(
lisp::predict-name
spec2
nil
))
(
pname1
(
pathname
ses-name1
))
(
pname2
(
pathname
ses-name2
))
(
dirp2
(
directoryp
pname2
))
(
wildp1
(
wildcardp
(
file-namestring
pname1
)))
(
wildp2
(
wildcardp
(
file-namestring
pname2
))))
(
if
(
and
dirp2
wildp2
)
(
funcall
*error-function*
"Cannot have wildcards in directory names -- ~S."
pname2
))
(
if
(
and
wildp2
(
not
wildp1
))
(
funcall
*error-function*
"Cannot handle destination having wildcards without ~
source having wildcards."
))
(
if
(
and
wildp1
(
not
wildp2
)
(
not
dirp2
))
(
funcall
*error-function*
"Cannot handle source with wildcards and destination ~
without, unless destination is a directory."
))
(
if
dirp2
(
rename-file-1
pname1
wildp1
exists1p
(
merge-pathnames
pname2
pname1
)
wildp1
clobber
)
(
rename-file-1
pname1
wildp1
exists1p
pname2
wildp2
clobber
))))
)
(
let*
(
(
ses-name1
(
ex
t:unix-namestring
spec1
t
)
)
(
exists1p
(
mach:unix-file-kind
ses-name1
)
)
(
ses-name2
(
ext:unix-namestring
spec2
nil
))
(
pname1
(
pathname
ses-name1
))
(
pname2
(
pathname
ses-name2
))
(
dirp2
(
directoryp
pname2
))
(
wildp1
(
wildcardp
(
file-namestring
pname1
)))
(
wildp2
(
wildcardp
(
file-namestring
pname2
))))
(
if
(
and
dirp2
wildp2
)
(
funcall
*error-function*
"Cannot have wildcards in directory names -- ~S."
pname2
))
(
if
(
and
wildp2
(
not
wildp1
))
(
funcall
*error-function*
"Cannot handle destination having wildcards without ~
source having wildcards."
))
(
if
(
and
wildp1
(
not
wildp2
)
(
not
dirp2
))
(
funcall
*error-function*
"Cannot handle source with wildcards and destination ~
without, unless destination is a directory."
))
(
if
dirp2
(
rename-file-1
pname1
wildp1
exists1p
(
merge-pathnames
pname2
pname1
)
wildp1
clobber
)
(
rename-file-1
pname1
wildp1
exists1p
pname2
wildp2
clobber
))))
(
directory
(
when
(
pathname-directory
spec1
)
(
funcall
*error-function*
"Spec1 is just a pattern when supplying directory -- ~S."
spec1
))
(
let*
((
pname2
(
pathname
(
lisp::predict-name
spec2
nil
)))
(
let*
((
pname2
(
pathname
(
ext:unix-namestring
spec2
nil
)))
(
dirp2
(
directoryp
pname2
))
(
wildp1
(
wildcardp
spec1
))
(
wildp2
(
wildcardp
(
file-namestring
pname2
))))
...
...
@@ -434,7 +434,7 @@
subdirectory structure. An empty directory may be specified without
recursive being non-nil. When specifying a directory, the trailing slash
must be included."
(
let*
((
ses-name
(
lisp::predict-name
spec
t
))
(
let*
((
ses-name
(
ext:unix-namestring
spec
t
))
(
pname
(
pathname
ses-name
))
(
wildp
(
wildcardp
(
file-namestring
pname
)))
(
dirp
(
directoryp
pname
)))
...
...
@@ -549,10 +549,9 @@
(
defun
make-directory
(
name
)
"Creates directory name. If name exists, then an error is signaled."
(
multiple-value-bind
(
ses-name
existsp
)
(
lisp::predict-name
name
nil
)
(
when
existsp
(
funcall
*error-function*
"Name already exists -- ~S"
ses-name
))
(
let
((
ses-name
(
ext:unix-namestring
name
nil
)))
(
when
(
mach:unix-file-kind
ses-name
)
(
funcall
*error-function*
"Name already exists -- ~S"
ses-name
))
(
enter-directory
ses-name
))
t
)
...
...
@@ -637,9 +636,7 @@
ses-name1
ses-name2
(
mach:get-unix-error-msg
err
)))))
(
defun
directory-existsp
(
ses-name
)
(
multiple-value-bind
(
winp
type
)
(
mach:unix-subtestname
ses-name
)
(
and
winp
(
eq
type
:entry_directory
))))
(
eq
(
mach:unix-file-kind
ses-name
)
:directory
))
(
defun
enter-directory
(
ses-name
)
(
declare
(
simple-string
ses-name
))
...
...
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