Change interface with OS/TRIM-PATHNAME-STRING to pass that procedure a
authorChris Hanson <org/chris-hanson/cph>
Tue, 11 Jul 1995 23:09:20 +0000 (23:09 +0000)
committerChris Hanson <org/chris-hanson/cph>
Tue, 11 Jul 1995 23:09:20 +0000 (23:09 +0000)
second argument, which is the prefix string that is to be trimmed off.

v7/src/edwin/filcom.scm

index de005b6719ac48e0f66078cd46efe05c6571e8a6..513cd8984d0daf4e57f045f6ac9bca71eb9eba04 100644 (file)
@@ -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)))
 \f
 ;;;; 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))))