From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 11 Jul 1995 23:09:20 +0000 (+0000)
Subject: Change interface with OS/TRIM-PATHNAME-STRING to pass that procedure a
X-Git-Tag: 20090517-FFI~6186
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=f14485f4e9fba08cc0b423f3dca5635dc6a2ccc8;p=mit-scheme.git

Change interface with OS/TRIM-PATHNAME-STRING to pass that procedure a
second argument, which is the prefix string that is to be trimmed off.
---

diff --git a/v7/src/edwin/filcom.scm b/v7/src/edwin/filcom.scm
index de005b671..513cd8984 100644
--- a/v7/src/edwin/filcom.scm
+++ b/v7/src/edwin/filcom.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Id: filcom.scm,v 1.184 1995/02/24 00:30:27 cph Exp $
+;;;	$Id: filcom.scm,v 1.185 1995/07/11 23:09:20 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-95 Massachusetts Institute of Technology
 ;;;
@@ -634,15 +634,16 @@ If a file with the new name already exists, confirmation is requested first."
   (let ((directory
 	 (if directory
 	     (directory-pathname directory)
-	     (buffer-default-directory (current-buffer)))))
+	     (buffer-default-directory (current-buffer))))
+	(insertion (os/pathname->display-string directory)))
     (prompt-string->pathname
      (prompt-for-completed-string
       prompt
-      (os/pathname->display-string directory)
+      insertion
       'INSERTED-DEFAULT
       (lambda (string if-unique if-not-unique if-not-found)
 	(filename-complete-string
-	 (prompt-string->pathname string directory)
+	 (prompt-string->pathname string insertion directory)
 	 (lambda (filename)
 	   (if-unique (os/pathname->display-string filename)))
 	 (lambda (prefix get-completions)
@@ -650,10 +651,13 @@ 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)))
+	(filename-completions-list
+	 (prompt-string->pathname string insertion directory)))
       (lambda (string)
-	(verify-final-value? (prompt-string->pathname string directory)))
+	(verify-final-value?
+	 (prompt-string->pathname string insertion directory)))
       require-match?)
+     insertion
      directory)))
 
 ;;;; Filename Completion
@@ -723,8 +727,8 @@ If a file with the new name already exists, confirmation is requested first."
      (os/directory-list-completions directory
 				    (file-namestring pathname)))))
 
-(define (prompt-string->pathname string directory)
-  (merge-pathnames (let ((pathname (os/trim-pathname-string string)))
+(define (prompt-string->pathname string insertion directory)
+  (merge-pathnames (let ((pathname (os/trim-pathname-string string insertion)))
 		     (if (memq (pathname-device pathname) '(#F UNSPECIFIC))
 			 pathname
 			 (pathname-default-directory pathname '(ABSOLUTE))))