From 5ed6442dec6bd1ba0429596e8728e40f09c82333 Mon Sep 17 00:00:00 2001 From: phg <phg> Date: Fri, 5 Jun 1992 19:28:07 +0000 Subject: [PATCH] Updated function merge-dirs to reflect updated pathname-directory returns a list rather than a simple vector and amended its use of make-pathname to set :device argument to :unspecific rather than :absolute. In set-write-date spliced in the *utimes-buffer* list into the unix:unix-utimes unix:unix-utimes function call. --- hemlock/dired.lisp | 17 +++++++++++++++-- 1 file changed, 15 insertions(+), 2 deletions(-) diff --git a/hemlock/dired.lisp b/hemlock/dired.lisp index f449780da..17155e212 100644 --- a/hemlock/dired.lisp +++ b/hemlock/dired.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/dired.lisp,v 1.1.1.4 1992/02/14 23:50:55 wlott Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/dired.lisp,v 1.1.1.5 1992/06/05 19:28:07 phg Exp $") ;;; ;;; ********************************************************************** ;;; @@ -207,6 +207,7 @@ ;;; adds it to the end of the sequence of directory names from pname2, returning ;;; a pathname. ;;; +#| (defun merge-dirs (pname1 pname2) (let* ((dirs1 (pathname-directory pname1)) (dirs2 (pathname-directory pname2)) @@ -217,6 +218,17 @@ (setf (svref new-dirs2 dirs2-len) (svref dirs1 (1- (length dirs1)))) (make-pathname :directory new-dirs2 :device :absolute))) +|# + +(defun merge-dirs (pname1 pname2) + (let* ((dirs1 (pathname-directory pname1)) + (dirs2 (pathname-directory pname2)) + (dirs2-len (length dirs2)) + (new-dirs2 (make-list (1+ dirs2-len)))) + (replace new-dirs2 dirs2) + (setf (nth dirs2-len new-dirs2) + (nth (1- (length dirs1)) dirs1)) + (make-pathname :directory new-dirs2 :device :unspecific))) ;;; COPY-FILE-1 takes pathnames which either both contain a single wildcard ;;; or none. Wildp1 and Wildp2 are either nil or indexes into the @@ -612,7 +624,8 @@ dev-or-err)) (setf (car *utimes-buffer*) atime) (setf (caddr *utimes-buffer*) secs)) - (multiple-value-bind (winp err) (unix:unix-utimes ses-name *utimes-buffer*) + (multiple-value-bind (winp err) + `(unix:unix-utimes ses-name ,@*utimes-buffer*) (unless winp (funcall *error-function* "Couldn't set write date of file ~S: ~A" ses-name -- GitLab