From 1b74776b824fd5e4cd820e174bcf9127bfe98a4c Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Mon, 16 Jan 1995 20:46:15 +0000 Subject: [PATCH] Fix bug in pathname merging -- if the user specifies a device, don't merge in the default pathname's directory but instead start at that device's root directory. --- v7/src/edwin/filcom.scm | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/v7/src/edwin/filcom.scm b/v7/src/edwin/filcom.scm index d9c0d76d7..3cf4345e6 100644 --- a/v7/src/edwin/filcom.scm +++ b/v7/src/edwin/filcom.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: filcom.scm,v 1.181 1995/01/06 01:06:09 cph Exp $ +;;; $Id: filcom.scm,v 1.182 1995/01/16 20:46:15 cph Exp $ ;;; ;;; Copyright (c) 1986, 1989-95 Massachusetts Institute of Technology ;;; @@ -651,9 +651,9 @@ If a file with the new name already exists, confirmation is requested first." get-completions)) if-not-found)) (lambda (string) - (filename-completions-list - (prompt-string->pathname string directory))) - verify-final-value? + (filename-completions-list (prompt-string->pathname string directory))) + (lambda (string) + (verify-final-value? (prompt-string->pathname string directory))) require-match?) directory))) @@ -724,8 +724,12 @@ If a file with the new name already exists, confirmation is requested first." (os/directory-list-completions directory (file-namestring pathname))))) -(define-integrable (prompt-string->pathname string directory) - (merge-pathnames (os/trim-pathname-string string) directory)) +(define (prompt-string->pathname string directory) + (merge-pathnames (let ((pathname (os/trim-pathname-string string))) + (if (memq (pathname-device pathname) '(#F UNSPECIFIC)) + pathname + (pathname-default-directory pathname '(ABSOLUTE)))) + directory)) (define (canonicalize-filename-completions directory filenames) (do ((filenames filenames (cdr filenames))) -- 2.25.1