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
...@@ -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))
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment