Skip to content
Snippets Groups Projects
Commit 2b7e7809 authored by wlott's avatar wlott
Browse files

This commit was generated by cvs2svn to compensate for changes in r2375,

which included commits to RCS files with non-trunk default branches.
parents 143d3b36 a14bdf88
No related branches found
No related tags found
No related merge requests found
...@@ -108,53 +108,53 @@ ...@@ -108,53 +108,53 @@
user will be asked whether it should be overwritten or not." user will be asked whether it should be overwritten or not."
(cond (cond
((not directoryp) ((not directoryp)
(multiple-value-bind (ses-name1 exists1p) (let* ((ses-name1 (ext:unix-namestring spec1 t))
(lisp::predict-name spec1 t) (exists1p (mach:unix-file-kind ses-name1))
(let* ((ses-name2 (lisp::predict-name spec2 nil)) (ses-name2 (ext:unix-namestring spec2 nil))
(pname1 (pathname ses-name1)) (pname1 (pathname ses-name1))
(pname2 (pathname ses-name2)) (pname2 (pathname ses-name2))
(dirp1 (directoryp pname1)) (dirp1 (directoryp pname1))
(dirp2 (directoryp pname2)) (dirp2 (directoryp pname2))
(wildp1 (wildcardp (file-namestring pname1))) (wildp1 (wildcardp (file-namestring pname1)))
(wildp2 (wildcardp (file-namestring pname2)))) (wildp2 (wildcardp (file-namestring pname2))))
(when (and dirp1 wildp1) (when (and dirp1 wildp1)
(funcall *error-function* (funcall *error-function*
"Cannot have wildcards in directory names -- ~S." pname1)) "Cannot have wildcards in directory names -- ~S." pname1))
(when (and dirp2 wildp2) (when (and dirp2 wildp2)
(funcall *error-function* (funcall *error-function*
"Cannot have wildcards in directory names -- ~S." pname2)) "Cannot have wildcards in directory names -- ~S." pname2))
(when (and dirp1 (not dirp2)) (when (and dirp1 (not dirp2))
(funcall *error-function* (funcall *error-function*
"Cannot handle spec1 being a directory and spec2 a file.")) "Cannot handle spec1 being a directory and spec2 a file."))
(when (and wildp2 (not wildp1)) (when (and wildp2 (not wildp1))
(funcall *error-function* (funcall *error-function*
"Cannot handle destination having wildcards without ~ "Cannot handle destination having wildcards without ~
source having wildcards.")) source having wildcards."))
(when (and wildp1 (not wildp2) (not dirp2)) (when (and wildp1 (not wildp2) (not dirp2))
(funcall *error-function* (funcall *error-function*
"Cannot handle source with wildcards and destination ~ "Cannot handle source with wildcards and destination ~
without, unless destination is a directory.")) without, unless destination is a directory."))
(cond ((and dirp1 dirp2) (cond ((and dirp1 dirp2)
(unless (directory-existsp ses-name1) (unless (directory-existsp ses-name1)
(funcall *error-function* (funcall *error-function*
"Directory does not exist -- ~S." pname1)) "Directory does not exist -- ~S." pname1))
(unless (directory-existsp ses-name2) (unless (directory-existsp ses-name2)
(enter-directory ses-name2)) (enter-directory ses-name2))
(recursive-copy pname1 pname2 update clobber pname2 (recursive-copy pname1 pname2 update clobber pname2
ses-name1 ses-name2)) ses-name1 ses-name2))
(dirp2 (dirp2
;; merge pname2 with pname1 to pick up a similar file-namestring. ;; merge pname2 with pname1 to pick up a similar file-namestring.
(copy-file-1 pname1 wildp1 exists1p (copy-file-1 pname1 wildp1 exists1p
(merge-pathnames pname2 pname1) (merge-pathnames pname2 pname1)
wildp1 update clobber)) wildp1 update clobber))
(t (copy-file-1 pname1 wildp1 exists1p (t (copy-file-1 pname1 wildp1 exists1p
pname2 wildp2 update clobber)))))) pname2 wildp2 update clobber)))))
(directory (directory
(when (pathname-directory spec1) (when (pathname-directory spec1)
(funcall *error-function* (funcall *error-function*
"Spec1 is just a pattern when supplying directory -- ~S." "Spec1 is just a pattern when supplying directory -- ~S."
spec1)) spec1))
(let* ((pname2 (pathname (lisp::predict-name spec2 nil))) (let* ((pname2 (pathname (ext:unix-namestring spec2 nil)))
(dirp2 (directoryp pname2)) (dirp2 (directoryp pname2))
(wildp1 (wildcardp spec1)) (wildp1 (wildcardp spec1))
(wildp2 (wildcardp (file-namestring pname2)))) (wildp2 (wildcardp (file-namestring pname2))))
...@@ -295,37 +295,37 @@ ...@@ -295,37 +295,37 @@
specify the trailing slash." specify the trailing slash."
(cond (cond
((not directoryp) ((not directoryp)
(multiple-value-bind (ses-name1 exists1p) (let* ((ses-name1 (ext:unix-namestring spec1 t))
(lisp::predict-name spec1 t) (exists1p (mach:unix-file-kind ses-name1))
(let* ((ses-name2 (lisp::predict-name spec2 nil)) (ses-name2 (ext:unix-namestring spec2 nil))
(pname1 (pathname ses-name1)) (pname1 (pathname ses-name1))
(pname2 (pathname ses-name2)) (pname2 (pathname ses-name2))
(dirp2 (directoryp pname2)) (dirp2 (directoryp pname2))
(wildp1 (wildcardp (file-namestring pname1))) (wildp1 (wildcardp (file-namestring pname1)))
(wildp2 (wildcardp (file-namestring pname2)))) (wildp2 (wildcardp (file-namestring pname2))))
(if (and dirp2 wildp2) (if (and dirp2 wildp2)
(funcall *error-function* (funcall *error-function*
"Cannot have wildcards in directory names -- ~S." pname2)) "Cannot have wildcards in directory names -- ~S." pname2))
(if (and wildp2 (not wildp1)) (if (and wildp2 (not wildp1))
(funcall *error-function* (funcall *error-function*
"Cannot handle destination having wildcards without ~ "Cannot handle destination having wildcards without ~
source having wildcards.")) source having wildcards."))
(if (and wildp1 (not wildp2) (not dirp2)) (if (and wildp1 (not wildp2) (not dirp2))
(funcall *error-function* (funcall *error-function*
"Cannot handle source with wildcards and destination ~ "Cannot handle source with wildcards and destination ~
without, unless destination is a directory.")) without, unless destination is a directory."))
(if dirp2 (if dirp2
(rename-file-1 pname1 wildp1 exists1p (merge-pathnames pname2 (rename-file-1 pname1 wildp1 exists1p (merge-pathnames pname2
pname1) pname1)
wildp1 clobber) wildp1 clobber)
(rename-file-1 pname1 wildp1 exists1p pname2 wildp2 clobber))))) (rename-file-1 pname1 wildp1 exists1p pname2 wildp2 clobber))))
(directory (directory
(when (pathname-directory spec1) (when (pathname-directory spec1)
(funcall *error-function* (funcall *error-function*
"Spec1 is just a pattern when supplying directory -- ~S." "Spec1 is just a pattern when supplying directory -- ~S."
spec1)) spec1))
(let* ((pname2 (pathname (lisp::predict-name spec2 nil))) (let* ((pname2 (pathname (ext:unix-namestring spec2 nil)))
(dirp2 (directoryp pname2)) (dirp2 (directoryp pname2))
(wildp1 (wildcardp spec1)) (wildp1 (wildcardp spec1))
(wildp2 (wildcardp (file-namestring pname2)))) (wildp2 (wildcardp (file-namestring pname2))))
...@@ -434,7 +434,7 @@ ...@@ -434,7 +434,7 @@
subdirectory structure. An empty directory may be specified without subdirectory structure. An empty directory may be specified without
recursive being non-nil. When specifying a directory, the trailing slash recursive being non-nil. When specifying a directory, the trailing slash
must be included." must be included."
(let* ((ses-name (lisp::predict-name spec t)) (let* ((ses-name (ext:unix-namestring spec t))
(pname (pathname ses-name)) (pname (pathname ses-name))
(wildp (wildcardp (file-namestring pname))) (wildp (wildcardp (file-namestring pname)))
(dirp (directoryp pname))) (dirp (directoryp pname)))
...@@ -549,10 +549,9 @@ ...@@ -549,10 +549,9 @@
(defun make-directory (name) (defun make-directory (name)
"Creates directory name. If name exists, then an error is signaled." "Creates directory name. If name exists, then an error is signaled."
(multiple-value-bind (ses-name existsp) (let ((ses-name (ext:unix-namestring name nil)))
(lisp::predict-name name nil) (when (mach:unix-file-kind ses-name)
(when existsp (funcall *error-function* (funcall *error-function* "Name already exists -- ~S" ses-name))
"Name already exists -- ~S" ses-name))
(enter-directory ses-name)) (enter-directory ses-name))
t) t)
...@@ -637,9 +636,7 @@ ...@@ -637,9 +636,7 @@
ses-name1 ses-name2 (mach:get-unix-error-msg err))))) ses-name1 ses-name2 (mach:get-unix-error-msg err)))))
(defun directory-existsp (ses-name) (defun directory-existsp (ses-name)
(multiple-value-bind (winp type) (eq (mach:unix-file-kind ses-name) :directory))
(mach:unix-subtestname ses-name)
(and winp (eq type :entry_directory))))
(defun enter-directory (ses-name) (defun enter-directory (ses-name)
(declare (simple-string ses-name)) (declare (simple-string ses-name))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment