/[cmucl]/src/hemlock/dired.lisp
ViewVC logotype

Diff of /src/hemlock/dired.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1.1.1 by wlott, Fri Aug 3 10:13:27 1990 UTC revision 1.1.1.2 by wlott, Fri Nov 9 23:33:30 1990 UTC
# Line 108  Line 108 
108     user will be asked whether it should be overwritten or not."     user will be asked whether it should be overwritten or not."
109    (cond    (cond
110     ((not directoryp)     ((not directoryp)
111      (multiple-value-bind (ses-name1 exists1p)      (let* ((ses-name1 (ext:unix-namestring spec1 t))
112                           (lisp::predict-name spec1 t)             (exists1p (mach:unix-file-kind ses-name1))
113        (let* ((ses-name2 (lisp::predict-name spec2 nil))             (ses-name2 (ext:unix-namestring spec2 nil))
114               (pname1 (pathname ses-name1))             (pname1 (pathname ses-name1))
115               (pname2 (pathname ses-name2))             (pname2 (pathname ses-name2))
116               (dirp1 (directoryp pname1))             (dirp1 (directoryp pname1))
117               (dirp2 (directoryp pname2))             (dirp2 (directoryp pname2))
118               (wildp1 (wildcardp (file-namestring pname1)))             (wildp1 (wildcardp (file-namestring pname1)))
119               (wildp2 (wildcardp (file-namestring pname2))))             (wildp2 (wildcardp (file-namestring pname2))))
120          (when (and dirp1 wildp1)        (when (and dirp1 wildp1)
121            (funcall *error-function*          (funcall *error-function*
122                     "Cannot have wildcards in directory names -- ~S." pname1))                   "Cannot have wildcards in directory names -- ~S." pname1))
123          (when (and dirp2 wildp2)        (when (and dirp2 wildp2)
124            (funcall *error-function*          (funcall *error-function*
125                     "Cannot have wildcards in directory names -- ~S." pname2))                   "Cannot have wildcards in directory names -- ~S." pname2))
126          (when (and dirp1 (not dirp2))        (when (and dirp1 (not dirp2))
127            (funcall *error-function*          (funcall *error-function*
128                     "Cannot handle spec1 being a directory and spec2 a file."))                   "Cannot handle spec1 being a directory and spec2 a file."))
129          (when (and wildp2 (not wildp1))        (when (and wildp2 (not wildp1))
130            (funcall *error-function*          (funcall *error-function*
131                     "Cannot handle destination having wildcards without ~                   "Cannot handle destination having wildcards without ~
132                     source having wildcards."))                   source having wildcards."))
133          (when (and wildp1 (not wildp2) (not dirp2))        (when (and wildp1 (not wildp2) (not dirp2))
134            (funcall *error-function*          (funcall *error-function*
135                     "Cannot handle source with wildcards and destination ~                   "Cannot handle source with wildcards and destination ~
136                     without, unless destination is a directory."))                   without, unless destination is a directory."))
137          (cond ((and dirp1 dirp2)        (cond ((and dirp1 dirp2)
138                 (unless (directory-existsp ses-name1)               (unless (directory-existsp ses-name1)
139                   (funcall *error-function*                 (funcall *error-function*
140                            "Directory does not exist -- ~S." pname1))                          "Directory does not exist -- ~S." pname1))
141                 (unless (directory-existsp ses-name2)               (unless (directory-existsp ses-name2)
142                   (enter-directory ses-name2))                 (enter-directory ses-name2))
143                 (recursive-copy pname1 pname2 update clobber pname2               (recursive-copy pname1 pname2 update clobber pname2
144                                 ses-name1 ses-name2))                               ses-name1 ses-name2))
145                (dirp2              (dirp2
146                 ;; merge pname2 with pname1 to pick up a similar file-namestring.               ;; merge pname2 with pname1 to pick up a similar file-namestring.
147                 (copy-file-1 pname1 wildp1 exists1p               (copy-file-1 pname1 wildp1 exists1p
148                              (merge-pathnames pname2 pname1)                            (merge-pathnames pname2 pname1)
149                              wildp1 update clobber))                            wildp1 update clobber))
150                (t (copy-file-1 pname1 wildp1 exists1p              (t (copy-file-1 pname1 wildp1 exists1p
151                                pname2 wildp2 update clobber))))))                              pname2 wildp2 update clobber)))))
152      (directory      (directory
153       (when (pathname-directory spec1)       (when (pathname-directory spec1)
154         (funcall *error-function*         (funcall *error-function*
155                  "Spec1 is just a pattern when supplying directory -- ~S."                  "Spec1 is just a pattern when supplying directory -- ~S."
156                  spec1))                  spec1))
157       (let* ((pname2 (pathname (lisp::predict-name spec2 nil)))       (let* ((pname2 (pathname (ext:unix-namestring spec2 nil)))
158              (dirp2 (directoryp pname2))              (dirp2 (directoryp pname2))
159              (wildp1 (wildcardp spec1))              (wildp1 (wildcardp spec1))
160              (wildp2 (wildcardp (file-namestring pname2))))              (wildp2 (wildcardp (file-namestring pname2))))
# Line 295  Line 295 
295     specify the trailing slash."     specify the trailing slash."
296    (cond    (cond
297     ((not directoryp)     ((not directoryp)
298      (multiple-value-bind (ses-name1 exists1p)      (let* ((ses-name1 (ext:unix-namestring spec1 t))
299                           (lisp::predict-name spec1 t)             (exists1p (mach:unix-file-kind ses-name1))
300        (let* ((ses-name2 (lisp::predict-name spec2 nil))             (ses-name2 (ext:unix-namestring spec2 nil))
301               (pname1 (pathname ses-name1))             (pname1 (pathname ses-name1))
302               (pname2 (pathname ses-name2))             (pname2 (pathname ses-name2))
303               (dirp2 (directoryp pname2))             (dirp2 (directoryp pname2))
304               (wildp1 (wildcardp (file-namestring pname1)))             (wildp1 (wildcardp (file-namestring pname1)))
305               (wildp2 (wildcardp (file-namestring pname2))))             (wildp2 (wildcardp (file-namestring pname2))))
306          (if (and dirp2 wildp2)        (if (and dirp2 wildp2)
307              (funcall *error-function*            (funcall *error-function*
308                       "Cannot have wildcards in directory names -- ~S." pname2))                     "Cannot have wildcards in directory names -- ~S." pname2))
309          (if (and wildp2 (not wildp1))        (if (and wildp2 (not wildp1))
310              (funcall *error-function*            (funcall *error-function*
311                       "Cannot handle destination having wildcards without ~                     "Cannot handle destination having wildcards without ~
312                        source having wildcards."))                     source having wildcards."))
313          (if (and wildp1 (not wildp2) (not dirp2))        (if (and wildp1 (not wildp2) (not dirp2))
314              (funcall *error-function*            (funcall *error-function*
315                       "Cannot handle source with wildcards and destination ~                     "Cannot handle source with wildcards and destination ~
316                       without, unless destination is a directory."))                     without, unless destination is a directory."))
317          (if dirp2        (if dirp2
318              (rename-file-1 pname1 wildp1 exists1p (merge-pathnames pname2            (rename-file-1 pname1 wildp1 exists1p (merge-pathnames pname2
319                                                                     pname1)                                                                   pname1)
320                             wildp1 clobber)                           wildp1 clobber)
321              (rename-file-1 pname1 wildp1 exists1p pname2 wildp2 clobber)))))            (rename-file-1 pname1 wildp1 exists1p pname2 wildp2 clobber))))
322      (directory      (directory
323       (when (pathname-directory spec1)       (when (pathname-directory spec1)
324         (funcall *error-function*         (funcall *error-function*
325                  "Spec1 is just a pattern when supplying directory -- ~S."                  "Spec1 is just a pattern when supplying directory -- ~S."
326                  spec1))                  spec1))
327    
328       (let* ((pname2 (pathname (lisp::predict-name spec2 nil)))       (let* ((pname2 (pathname (ext:unix-namestring spec2 nil)))
329              (dirp2 (directoryp pname2))              (dirp2 (directoryp pname2))
330              (wildp1 (wildcardp spec1))              (wildp1 (wildcardp spec1))
331              (wildp2 (wildcardp (file-namestring pname2))))              (wildp2 (wildcardp (file-namestring pname2))))
# Line 434  Line 434 
434     subdirectory structure.  An empty directory may be specified without     subdirectory structure.  An empty directory may be specified without
435     recursive being non-nil.  When specifying a directory, the trailing slash     recursive being non-nil.  When specifying a directory, the trailing slash
436     must be included."     must be included."
437    (let* ((ses-name (lisp::predict-name spec t))    (let* ((ses-name (ext:unix-namestring spec t))
438           (pname (pathname ses-name))           (pname (pathname ses-name))
439           (wildp (wildcardp (file-namestring pname)))           (wildp (wildcardp (file-namestring pname)))
440           (dirp (directoryp pname)))           (dirp (directoryp pname)))
# Line 549  Line 549 
549    
550  (defun make-directory (name)  (defun make-directory (name)
551    "Creates directory name.  If name exists, then an error is signaled."    "Creates directory name.  If name exists, then an error is signaled."
552    (multiple-value-bind (ses-name existsp)    (let ((ses-name (ext:unix-namestring name nil)))
553                         (lisp::predict-name name nil)      (when (mach:unix-file-kind ses-name)
554      (when existsp (funcall *error-function*        (funcall *error-function* "Name already exists -- ~S" ses-name))
                            "Name already exists -- ~S" ses-name))  
555      (enter-directory ses-name))      (enter-directory ses-name))
556    t)    t)
557    
# Line 637  Line 636 
636                 ses-name1 ses-name2 (mach:get-unix-error-msg err)))))                 ses-name1 ses-name2 (mach:get-unix-error-msg err)))))
637    
638  (defun directory-existsp (ses-name)  (defun directory-existsp (ses-name)
639    (multiple-value-bind (winp type)    (eq (mach:unix-file-kind ses-name) :directory))
                        (mach:unix-subtestname ses-name)  
     (and winp (eq type :entry_directory))))  
640    
641  (defun enter-directory (ses-name)  (defun enter-directory (ses-name)
642    (declare (simple-string ses-name))    (declare (simple-string ses-name))

Legend:
Removed from v.1.1.1.1  
changed lines
  Added in v.1.1.1.2

  ViewVC Help
Powered by ViewVC 1.1.5