From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 4 Nov 1991 20:52:22 +0000 (+0000)
Subject: Changes to match runtime version 14.141.
X-Git-Tag: 20090517-FFI~10077
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=136a76fe667f463c1a135c15bbde36e1bb018a2f;p=mit-scheme.git

Changes to match runtime version 14.141.
---

diff --git a/v7/src/edwin/basic.scm b/v7/src/edwin/basic.scm
index 5bb8cbf44..5c302c834 100644
--- a/v7/src/edwin/basic.scm
+++ b/v7/src/edwin/basic.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/basic.scm,v 1.115 1991/08/28 13:52:20 jinx Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/basic.scm,v 1.116 1991/11/04 20:50:20 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -237,7 +237,7 @@ For more information type the HELP key while entering the name."
 	   (prompt-for-confirmation?
 	    "File has changed on disk; really want to edit the buffer"))))
       (editor-error "File changed on disk: "
-		    (pathname->string (buffer-pathname buffer))))
+		    (->namestring (buffer-pathname buffer))))
   (message
    "File on disk now will become a backup file if you save these changes.")
   (set-buffer-backed-up?! buffer false))
diff --git a/v7/src/edwin/buffer.scm b/v7/src/edwin/buffer.scm
index c77024915..70c318763 100644
--- a/v7/src/edwin/buffer.scm
+++ b/v7/src/edwin/buffer.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/buffer.scm,v 1.147 1991/10/29 13:39:59 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/buffer.scm,v 1.148 1991/11/04 20:50:26 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -151,8 +151,7 @@ The buffer is guaranteed to be deselected at that time."
 (define (set-buffer-pathname! buffer pathname)
   (vector-set! buffer buffer-index:pathname pathname)
   (if pathname
-      (set-buffer-default-directory! buffer
-				     (pathname-directory-path pathname)))
+      (set-buffer-default-directory! buffer (directory-pathname pathname)))
   (buffer-modeline-event! buffer 'BUFFER-PATHNAME))
 
 (define (set-buffer-truename! buffer truename)
diff --git a/v7/src/edwin/bufmnu.scm b/v7/src/edwin/bufmnu.scm
index 61b67f28d..d8a53961e 100644
--- a/v7/src/edwin/bufmnu.scm
+++ b/v7/src/edwin/bufmnu.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/bufmnu.scm,v 1.116 1991/05/10 22:19:16 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/bufmnu.scm,v 1.117 1991/11/04 20:50:32 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -106,7 +106,7 @@ Type q immediately to make the buffer menu go away."
 			    (group-length (buffer-group buffer)))
 			   (mode-display-name (buffer-major-mode buffer))
 			   (let ((truename (buffer-truename buffer)))
-			     (if truename (pathname->string truename) ""))))
+			     (if truename (->namestring truename) ""))))
 			 (newline))))
 		  (buffer-list)))))
   (set-buffer-point! buffer (line-start (buffer-start buffer) 2))
diff --git a/v7/src/edwin/comint.scm b/v7/src/edwin/comint.scm
index 9be480eb8..9f9b19df9 100644
--- a/v7/src/edwin/comint.scm
+++ b/v7/src/edwin/comint.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/comint.scm,v 1.10 1991/10/25 00:02:54 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/comint.scm,v 1.11 1991/11/04 20:50:38 cph Exp $
 
 Copyright (c) 1991 Massachusetts Institute of Technology
 
@@ -443,8 +443,7 @@ See also \\[comint-dynamic-complete]."
       (let ((filename (region->string region)))
 	(set-current-point! (region-end region))
 	(comint-filename-complete
-	 (merge-pathnames (->pathname filename)
-			  (buffer-default-directory (current-buffer)))
+	 (merge-pathnames filename (buffer-default-directory (current-buffer)))
 	 filename
 	 (lambda (filename*)
 	   (region-delete! region)
@@ -459,9 +458,9 @@ it just adds completion characters to the end of the filename."
   (lambda ()
     (let ((region (comint-current-filename-region)))
       (let ((pathname
-	     (merge-pathnames (->pathname (region->string region))
+	     (merge-pathnames (region->string region)
 			      (buffer-default-directory (current-buffer)))))
-	(let ((filename (pathname->string pathname)))
+	(let ((filename (->namestring pathname)))
 	  (set-current-point! (region-end region))
 	  (comint-filename-complete
 	   pathname
@@ -479,9 +478,8 @@ it just adds completion characters to the end of the filename."
     (pop-up-generated-completions
      (lambda ()
        (filename-completions-list
-	(merge-pathnames
-	 (->pathname (region->string (comint-current-filename-region)))
-	 (buffer-default-directory (current-buffer))))))))
+	(merge-pathnames (region->string (comint-current-filename-region))
+			 (buffer-default-directory (current-buffer))))))))
 
 (define (comint-current-filename-region)
   (let ((point (current-point))
diff --git a/v7/src/edwin/comred.scm b/v7/src/edwin/comred.scm
index 0596dec41..b2be6af1a 100644
--- a/v7/src/edwin/comred.scm
+++ b/v7/src/edwin/comred.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/comred.scm,v 1.88 1991/10/21 23:40:40 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/comred.scm,v 1.89 1991/11/04 20:50:44 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -390,12 +390,11 @@
       ((#\d)
        (varies (current-point) '(CURRENT-POINT)))
       ((#\D)
-       (prompting
-	(pathname->string (prompt-for-directory prompt false false))))
+       (prompting (prompt-for-directory prompt false)))
       ((#\f)
-       (prompting (pathname->string (prompt-for-input-truename prompt false))))
+       (prompting (prompt-for-existing-file prompt false)))
       ((#\F)
-       (prompting (pathname->string (prompt-for-pathname prompt false false))))
+       (prompting (prompt-for-file prompt false)))
       ((#\k)
        (prompting (prompt-for-key prompt (current-comtabs))))
       ((#\m)
diff --git a/v7/src/edwin/debuge.scm b/v7/src/edwin/debuge.scm
index da8b1c763..86827dd4f 100644
--- a/v7/src/edwin/debuge.scm
+++ b/v7/src/edwin/debuge.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/debuge.scm,v 1.42 1991/05/10 04:52:20 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/debuge.scm,v 1.43 1991/11/04 20:50:48 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -54,33 +54,33 @@
   (if (and (buffer-modified? buffer)
 	   (buffer-writeable? buffer))
       (let ((pathname
-	     (let ((pathname (buffer-pathname buffer)))
-	       (cond ((not pathname)
-		      (and (y-or-n? "Save buffer "
-				    (buffer-name buffer)
-				    " (Y or N)? ")
-			   (->pathname (prompt-for-expression "Filename"))))
-		     ((integer? (pathname-version pathname))
-		      (pathname-new-version pathname 'NEWEST))
-		     (else
-		      pathname)))))
+	     (merge-pathnames
+	      (let ((pathname (buffer-pathname buffer)))
+		(cond ((not pathname)
+		       (and (y-or-n? "Save buffer "
+				     (buffer-name buffer)
+				     " (Y or N)? ")
+			    (prompt-for-expression "Filename")))
+		      ((integer? (pathname-version pathname))
+		       (pathname-new-version pathname 'NEWEST))
+		      (else
+		       pathname))))))
 	(if pathname
-	    (let ((truename (pathname->output-truename pathname)))
-	      (let ((filename (pathname->string truename)))
-		(if (or (not (file-exists? filename))
-			(y-or-n? "File '"
-				 (pathname->string pathname)
-				 "' exists.  Write anyway (Y or N)? "))
-		    (begin
-		      (newline)
-		      (write-string "Writing file '")
-		      (write-string filename)
-		      (write-string "'")
-		      (write-region (buffer-region buffer) filename false)
-		      (write-string " -- done")
-		      (set-buffer-pathname! buffer pathname)
-		      (set-buffer-truename! buffer truename)
-		      (buffer-not-modified! buffer)))))))))
+	    (let ((filename (->namestring pathname)))
+	      (if (or (not (file-exists? pathname))
+		      (y-or-n? "File '"
+			       filename
+			       "' exists.  Write anyway (Y or N)? "))
+		  (begin
+		    (newline)
+		    (write-string "Writing file '")
+		    (write-string filename)
+		    (write-string "'")
+		    (write-region (buffer-region buffer) filename false)
+		    (write-string " -- done")
+		    (set-buffer-pathname! buffer pathname)
+		    (set-buffer-truename! buffer (->truename pathname))
+		    (buffer-not-modified! buffer))))))))
 
 (define-command debug-count-marks
   "Show the number of in-use and GC'ed marks for the current buffer."
diff --git a/v7/src/edwin/dired.scm b/v7/src/edwin/dired.scm
index c1aa09e21..8bb4571fa 100644
--- a/v7/src/edwin/dired.scm
+++ b/v7/src/edwin/dired.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/dired.scm,v 1.119 1991/10/26 21:07:59 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/dired.scm,v 1.120 1991/11/04 20:50:53 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -134,8 +134,7 @@ Type `h' after entering dired for more info."
   (let ((directory (->pathname directory)))
     (let ((buffer (get-dired-buffer directory)))
       (set-buffer-major-mode! buffer (ref-mode-object dired))
-      (set-buffer-default-directory! buffer
-				     (pathname-directory-path directory))
+      (set-buffer-default-directory! buffer (directory-pathname directory))
       (buffer-put! buffer 'REVERT-BUFFER-METHOD revert-dired-buffer)
       (buffer-put! buffer 'DIRED-DIRECTORY directory)
       (fill-dired-buffer! buffer directory)
@@ -144,9 +143,7 @@ Type `h' after entering dired for more info."
 (define (get-dired-buffer directory)
   (or (list-search-positive (buffer-list)
 	(lambda (buffer)
-	  (let ((directory* (buffer-get buffer 'DIRED-DIRECTORY)))
-	    (and directory*
-		 (pathname=? directory* directory)))))
+	  (equal? directory (buffer-get buffer 'DIRED-DIRECTORY))))
       (new-buffer (pathname->buffer-name directory))))
 
 (define (dired-buffer-directory buffer)
@@ -191,9 +188,7 @@ CANNOT contain the 'F' option."
   (set-buffer-writeable! buffer)
   (region-delete! (buffer-region buffer))
   (temporary-message
-   (string-append "Reading directory "
-		  (pathname->string pathname)
-		  "..."))
+   (string-append "Reading directory " (->namestring pathname) "..."))
   (read-directory pathname
 		  (ref-variable dired-listing-switches)
 		  (buffer-point buffer))
@@ -213,34 +208,33 @@ CANNOT contain the 'F' option."
   (set-buffer-read-only! buffer))
 
 (define (read-directory pathname switches mark)
-  (let ((directory (pathname-directory-path pathname)))
+  (let ((directory (directory-pathname pathname)))
     (if (file-directory? pathname)
 	(run-synchronous-process false mark directory false
 				 (find-program "ls" false)
 				 switches
-				 (pathname->string pathname))
+				 (->namestring pathname))
 	(shell-command false mark directory false
 		       (string-append "ls "
 				      switches
 				      " "
-				      (pathname-name-string pathname))))))
+				      (file-namestring pathname))))))
 
 (define (add-dired-entry pathname)
   (let ((lstart (line-start (current-point) 0))
-	(directory (pathname-directory-path pathname)))
+	(directory (directory-pathname pathname)))
     (if (pathname=? (buffer-default-directory (mark-buffer lstart)) directory)
 	(let ((start (mark-right-inserting lstart)))
 	  (run-synchronous-process false lstart directory false
 				   (find-program "ls" directory)
 				   "-d"
 				   (ref-variable dired-listing-switches)
-				   (pathname->string pathname))
+				   (->namestring pathname))
 	  (insert-string "  " start)
 	  (let ((start (mark-right-inserting (dired-filename-start start))))
 	    (insert-string
-	     (pathname-name-string
-	      (string->pathname
-	       (extract-and-delete-string start (line-end start 0))))
+	     (file-namestring
+	      (extract-and-delete-string start (line-end start 0)))
 	     start))))))
 
 (define-command dired-find-file
@@ -322,10 +316,10 @@ CANNOT contain the 'F' option."
   "Rename this file to TO-FILE."
   (lambda ()
     (list
-     (pathname->string
+     (->namestring
       (let ((pathname (dired-current-pathname)))
 	(prompt-for-pathname (string-append "Rename "
-					    (pathname-name-string pathname)
+					    (file-namestring pathname)
 					    " to")
 			     pathname
 			     false)))))
@@ -344,10 +338,10 @@ CANNOT contain the 'F' option."
   "Copy this file to TO-FILE."
   (lambda ()
     (list
-     (pathname->string
+     (->namestring
       (let ((pathname (dired-current-pathname)))
 	(prompt-for-pathname (string-append "Copy "
-					    (pathname-name-string pathname)
+					    (file-namestring pathname)
 					    " to")
 			     pathname
 			     false)))))
@@ -382,11 +376,11 @@ CANNOT contain the 'F' option."
 
 (define (dired-change-line program argument)
   (let ((pathname (dired-current-pathname)))
-    (let ((directory (pathname-directory-path pathname)))
+    (let ((directory (directory-pathname pathname)))
       (run-synchronous-process false false directory false
 			       (find-program program directory)
 			       argument
-			       (pathname->string pathname)))
+			       (->namestring pathname)))
     (dired-redisplay pathname)))
 
 (define (dired-redisplay pathname)
@@ -430,8 +424,8 @@ CANNOT contain the 'F' option."
 
 (define (dired-pathname lstart)
   (merge-pathnames
-   (pathname-directory-path (dired-buffer-directory (current-buffer)))
-   (string->pathname (region->string (dired-filename-region lstart)))))
+   (directory-pathname (dired-buffer-directory (current-buffer)))
+   (region->string (dired-filename-region lstart))))
 
 (define (dired-mark char n)
   (with-read-only-defeated (current-point)
@@ -490,7 +484,7 @@ CANNOT contain the 'F' option."
 	(let ((buffer (temporary-buffer " *Deletions*")))
 	  (write-strings-densely
 	   (map (lambda (filename)
-		  (pathname-name-string (car filename)))
+		  (file-namestring (car filename)))
 		filenames)
 	   (mark->output-port (buffer-point buffer))
 	   (window-x-size (current-window)))
@@ -509,7 +503,7 @@ CANNOT contain the 'F' option."
 		       (loop (cdr filenames)
 			     (if (dired-kill-file! (car filenames))
 				 failures
-				 (cons (pathname-name-string (caar filenames))
+				 (cons (file-namestring (caar filenames))
 				       failures))))
 		      ((not (null? failures))
 		       (message "Deletions failed: " failures)))))
@@ -528,7 +522,7 @@ CANNOT contain the 'F' option."
 (define (dired-kill-file! filename)
   (let ((deleted?
 	 (catch-file-errors (lambda () false)
-			    (lambda () (delete-file (car filename))))))
+			    (lambda () (delete-file (car filename)) true))))
     (if deleted?
 	(with-read-only-defeated (cdr filename)
 	  (lambda ()
@@ -554,7 +548,7 @@ CANNOT contain the 'F' option."
 	(let ((buffer (temporary-buffer " *Copies*")))
 	  (write-strings-densely
 	   (map (lambda (filename)
-		  (pathname-name-string (car filename)))
+		  (file-namestring (car filename)))
 		filenames)
 	   (mark->output-port (buffer-point buffer))
 	   (window-x-size (current-window)))
@@ -563,19 +557,19 @@ CANNOT contain the 'F' option."
 	  (set-buffer-read-only! buffer)
 	  (let ((destination
 		 (pathname-directory
-		  (with-selected-buffer
-		   buffer
-		   (lambda ()
-		     (local-set-variable! truncate-partial-width-windows false)
-		     (prompt-for-directory "Copy these files to directory"
-					   false
-					   true))))))
+		  (with-selected-buffer buffer
+		    (lambda ()
+		      (local-set-variable! truncate-partial-width-windows
+					   false)
+		      (prompt-for-existing-directory
+		       "Copy these files to directory"
+		       false))))))
 	    (let loop ((filenames filenames) (failures '()))
 	      (cond ((not (null? filenames))
 		     (loop (cdr filenames)
 			   (if (dired-copy-file! (car filenames) destination)
 			       failures
-			       (cons (pathname-name-string (caar filenames))
+			       (cons (file-namestring (caar filenames))
 				     failures))))
 		    ((not (null? failures))
 		     (message "Copies failed: " (reverse! failures))))))
@@ -615,11 +609,10 @@ Actions controlled by variables list-directory-brief-switches
  and list-directory-verbose-switches."
   (lambda ()
     (let ((argument (command-argument)))
-      (list (pathname->string
-	     (prompt-for-directory (if argument
-				       "List directory (verbose)"
-				       "List directory (brief)")
-				   false false))
+      (list (prompt-for-directory (if argument
+				      "List directory (verbose)"
+				      "List directory (brief)")
+				  false)
 	    argument)))
   (lambda (directory argument)
     (let ((directory (->pathname directory))
@@ -627,7 +620,7 @@ Actions controlled by variables list-directory-brief-switches
       (disable-group-undo! (buffer-group buffer))
       (let ((point (buffer-end buffer)))
 	(insert-string "Directory " point)
-	(insert-string (pathname->string directory) point)
+	(insert-string (->namestring directory) point)
 	(insert-newline point)
 	(read-directory directory
 			(if argument
diff --git a/v7/src/edwin/filcom.scm b/v7/src/edwin/filcom.scm
index ec3532c3d..105537da9 100644
--- a/v7/src/edwin/filcom.scm
+++ b/v7/src/edwin/filcom.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/filcom.scm,v 1.160 1991/10/11 03:31:24 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/filcom.scm,v 1.161 1991/11/04 20:50:58 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -56,11 +56,11 @@
   (select-buffer-other-screen (find-file-noselect filename true)))
 
 (define (find-file-noselect filename warn?)
-  (let ((pathname (pathname->absolute-pathname (->pathname filename))))
+  (let ((pathname (merge-pathnames filename)))
     (if (file-directory? pathname)
 	(if (ref-variable find-file-run-dired)
 	    (make-dired-buffer (pathname-as-directory pathname))
-	    (editor-error (pathname->string pathname) " is a directory."))
+	    (editor-error (->namestring pathname) " is a directory."))
 	(let ((buffer (pathname->buffer pathname)))
 	  (if buffer
 	      (begin
@@ -80,7 +80,7 @@
       (let ((pathname (buffer-pathname buffer)))
 	(cond ((not (file-exists? pathname))
 	       (editor-error "File "
-			     (pathname->string pathname)
+			     (->namestring pathname)
 			     " no longer exists!"))
 	      ((prompt-for-yes-or-no?
 		(string-append
@@ -157,14 +157,14 @@ Argument means don't offer to use auto-save file."
 	      "Buffer does not seem to be associated with any file"))
 	    ((not (file-readable? pathname))
 	     (editor-error "File "
-			   (pathname->string pathname)
+			   (->namestring pathname)
 			   " no longer "
 			   (if (file-exists? pathname) "exists" "readable")
 			   "!"))
 	    ((or dont-confirm?
 		 (prompt-for-yes-or-no?
 		  (string-append "Revert buffer from file "
-				 (pathname->string pathname))))
+				 (->namestring pathname))))
 	     ;; If file was backed up but has changed since, we
 	     ;; should make another backup.
 	     (if (and (not auto-save?)
@@ -215,7 +215,7 @@ Argument means don't offer to use auto-save file."
 		    "File is write protected")
 		   ((file-attributes pathname)
 		    "File exists, but is read-protected.")
-		   ((file-attributes (pathname-directory-path pathname))
+		   ((file-attributes (directory-pathname pathname))
 		    "File not found and directory write-protected")
 		   (else
 		    "File not found and directory doesn't exist"))))
@@ -333,7 +333,7 @@ If `trim-versions-without-asking' is false, system will query user
 	(if (and (ref-variable enable-emacs-write-file-message)
 		 (> (buffer-length buffer) 50000))
 	    (message "Saving file "
-		     (pathname->string (buffer-pathname buffer))
+		     (->namestring (buffer-pathname buffer))
 		     "..."))
 	(write-buffer-interactive buffer backup-mode))
       (message "(No changes need to be written)")))
@@ -366,7 +366,7 @@ With argument, saves all with no questions."
 			     (let ((pathname (buffer-pathname buffer)))
 			       (if pathname
 				   (string-append "Save file "
-						  (pathname->string pathname))
+						  (->namestring pathname))
 				   (string-append "Save buffer "
 						  (buffer-name buffer)))))
 			    (write-buffer-interactive buffer false))))
@@ -388,8 +388,8 @@ if you wish to make buffer not be visiting any file."
   (lambda (filename)
     (set-visited-pathname
      (current-buffer)
-     (let ((pathname (string->pathname filename)))
-       (and (not (string-null? (pathname-name-string pathname)))
+     (let ((pathname (->pathname filename)))
+       (and (not (string-null? (file-namestring pathname)))
 	    pathname)))))
 
 (define (set-visited-pathname buffer pathname)
@@ -444,68 +444,52 @@ Leaves point at the beginning, mark at the end."
 	(insert-file point filename)
 	(set-current-point! point)
 	(push-current-mark! mark)))))
-
+
 (define (pathname->buffer-name pathname)
-  (if (pathname-name pathname)
-      (pathname-name-string pathname)
-      (let ((name
-	     (let ((directory (pathname-directory pathname)))
-	       (and (pair? directory)
-		    (car (last-pair directory))))))
-	(if (string? name)
-	    name
-	    (pathname->string pathname)))))
+  (file-namestring
+   (let ((pathname (->pathname pathname)))
+     (if (pathname-name pathname)
+	 pathname
+	 (directory-pathname-as-file pathname)))))
 
 (define (pathname->buffer pathname)
-  (or (list-search-positive (buffer-list)
-	(lambda (buffer)
-	  (let ((pathname* (buffer-pathname buffer)))
-	    (and pathname*
-		 (pathname=? pathname pathname*)))))
-      (let ((truename (pathname->input-truename pathname)))
-	(and truename
-	     (list-search-positive (buffer-list)
-	       (lambda (buffer)
-		 (let ((pathname* (buffer-pathname buffer)))
-		   (and pathname*
-			(or (pathname=? pathname pathname*)
-			    (pathname=? truename pathname*)
-			    (let ((truename* (buffer-truename buffer)))
-			      (and truename*
-				   (pathname=? truename truename*))))))))))))
+  (let ((pathname (->pathname pathname)))
+    (list-search-positive (buffer-list)
+      (lambda (buffer)
+	(equal? pathname (buffer-pathname buffer))))))
 
 (define-command copy-file
   "Copy a file; the old and new names are read in the typein window.
 If a file with the new name already exists, confirmation is requested first."
   (lambda ()
-    (let ((old (prompt-for-input-truename "Copy file" false)))
-      (list old (prompt-for-output-truename "Copy to" old))))
+    (let ((old (prompt-for-existing-file "Copy file" false)))
+      (list old (prompt-for-file "Copy to" old))))
   (lambda (old new)
     (if (or (not (file-exists? new))
 	    (prompt-for-yes-or-no?
 	     (string-append "File "
-			    (pathname->string new)
+			    (->namestring new)
 			    " already exists; copy anyway")))
 	(begin (copy-file old new)
-	       (message "Copied " (pathname->string old)
-			" => " (pathname->string new))))))
+	       (message "Copied " (->namestring old)
+			" => " (->namestring new))))))
 
 (define-command rename-file
   "Rename a file; the old and new names are read in the typein window.
 If a file with the new name already exists, confirmation is requested first."
   (lambda ()
-    (let ((old (prompt-for-input-truename "Rename file" false)))
-      (list old (prompt-for-output-truename "Rename to" old))))
+    (let ((old (prompt-for-existing-file "Rename file" false)))
+      (list old (prompt-for-file "Rename to" old))))
   (lambda (old new)
     (let ((do-it
 	   (lambda ()
 	     (rename-file old new)
-	     (message "Renamed " (pathname->string old)
-		      " => " (pathname->string new)))))
+	     (message "Renamed " (->namestring old)
+		      " => " (->namestring new)))))
       (if (file-exists? new)
 	  (if (prompt-for-yes-or-no?
 	       (string-append "File "
-			      (pathname->string new)
+			      (->namestring new)
 			      " already exists; rename anyway"))
 	      (begin (delete-file new) (do-it)))
 	  (do-it)))))
@@ -520,7 +504,7 @@ If a file with the new name already exists, confirmation is requested first."
   ()
   (lambda ()
     (message "Directory "
-	     (pathname->string (buffer-default-directory (current-buffer))))))
+	     (->namestring (buffer-default-directory (current-buffer))))))
 
 (define-command cd
   "Make DIR become the current buffer's default directory."
@@ -533,49 +517,50 @@ If a file with the new name already exists, confirmation is requested first."
   (let ((buffer (current-buffer)))
     (let ((directory
 	   (pathname-as-directory
-	    (merge-pathnames (->pathname directory)
-			     (buffer-default-directory buffer)))))
+	    (merge-pathnames directory (buffer-default-directory buffer)))))
       (if (not (file-directory? directory))
-	  (editor-error (pathname->string directory) " is not a directory"))
-      (if (not (unix/file-access directory 1))
+	  (editor-error (->namestring directory) " is not a directory"))
+      (if (not (file-access directory 1))
 	  (editor-error "Cannot cd to "
-			(pathname->string directory)
+			(->namestring directory)
 			": Permission denied"))
       (set-buffer-default-directory! buffer directory))))
 
 ;;;; Prompting
 
-(define (prompt-for-input-truename prompt default)
-  (pathname->input-truename
-   (prompt-for-pathname-non-directory prompt default true)))
+(define (prompt-for-file prompt default)
+  (->namestring
+   (prompt-for-pathname* prompt default file-non-directory? false)))
 
-(define (prompt-for-output-truename prompt default)
-  (pathname->output-truename (prompt-for-pathname prompt default false)))
+(define (prompt-for-existing-file prompt default)
+  (->namestring
+   (prompt-for-pathname* prompt default file-non-directory? true)))
 
-(define (prompt-for-directory prompt default require-match?)
-  (let ((directory
-	 (prompt-for-pathname* prompt default file-directory? require-match?)))
-    (if (file-directory? directory)
-	(pathname-as-directory directory)
-	directory)))
+(define (file-non-directory? file)
+  (and (file-exists? file)
+       (not (file-directory? file))))
+
+(define (prompt-for-directory prompt default)
+  (->namestring
+   (let ((directory
+	  (prompt-for-pathname* prompt default file-directory? false)))
+     (if (file-directory? directory)
+	 (pathname-as-directory directory)
+	 directory))))
+
+(define (prompt-for-existing-directory prompt default)
+  (->namestring
+   (pathname-as-directory
+    (prompt-for-pathname* prompt default file-directory? true))))
 
 (define-integrable (prompt-for-pathname prompt default require-match?)
   (prompt-for-pathname* prompt default file-exists? require-match?))
 
-(define-integrable (prompt-for-pathname-non-directory
-		    prompt default require-match?)
-  (prompt-for-pathname* prompt
-			default
-			(lambda (file)
-			  (and (file-exists? file)
-			       (not (file-directory? file))))
-			require-match?))
-
 (define (prompt-for-pathname* prompt directory
 			      verify-final-value? require-match?)
   (let ((directory
 	 (if directory
-	     (pathname-directory-path (->pathname directory))
+	     (directory-pathname directory)
 	     (buffer-default-directory (current-buffer)))))
     (prompt-string->pathname
      (prompt-for-completed-string
@@ -640,8 +625,8 @@ If a file with the new name already exists, confirmation is requested first."
 		   (unique-case (car filtered-filenames)))
 		  (else
 		   (non-unique-case filtered-filenames)))))))
-  (let ((directory (pathname-directory-string pathname))
-	(prefix (pathname-name-string pathname)))
+  (let ((directory (directory-namestring pathname))
+	(prefix (file-namestring pathname)))
     (cond ((not (os/file-directory? directory))
 	   (if-not-found))
 	  ((string-null? prefix)
@@ -659,15 +644,14 @@ If a file with the new name already exists, confirmation is requested first."
 		 (loop directory filenames)))))))
 
 (define (filename-completions-list pathname)
-  (let ((directory (pathname-directory-string pathname)))
+  (let ((directory (directory-namestring pathname)))
     (canonicalize-filename-completions
      directory
      (os/directory-list-completions directory
-				    (pathname-name-string pathname)))))
+				    (file-namestring pathname)))))
 
 (define-integrable (prompt-string->pathname string directory)
-  (merge-pathnames (string->pathname (os/trim-pathname-string string))
-		   directory))
+  (merge-pathnames (os/trim-pathname-string string) directory))
 
 (define (canonicalize-filename-completions directory filenames)
   (do ((filenames filenames (cdr filenames)))
diff --git a/v7/src/edwin/fileio.scm b/v7/src/edwin/fileio.scm
index c076f4fce..a221ba33a 100644
--- a/v7/src/edwin/fileio.scm
+++ b/v7/src/edwin/fileio.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/fileio.scm,v 1.102 1991/09/17 14:05:09 arthur Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/fileio.scm,v 1.103 1991/11/04 20:51:04 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -55,7 +55,9 @@
 
 (define (read-buffer buffer pathname visit?)
   (set-buffer-writeable! buffer)
-  (let ((truename (pathname->input-truename pathname)))
+  (let ((truename
+	 (catch-file-errors (lambda () false)
+			    (lambda () (->truename pathname)))))
     (if truename
 	(begin
 	  ;; Set modified so that file supercession check isn't done.
@@ -79,17 +81,17 @@
 (define (insert-file mark filename)
   (%insert-file
    mark
-   (let ((pathname (->pathname filename)))
-     (let ((truename (pathname->input-truename pathname)))
-       (if (not truename)
-	   (editor-error "File " (pathname->string pathname) " not found"))
-       truename))))
+   (bind-condition-handler (list condition-type:file-error)
+       (lambda (condition)
+	 condition
+	 (editor-error "File " (->namestring filename) " not found"))
+     (lambda () (->truename filename)))))
 
 (define (%insert-file mark truename)
   (if (ref-variable read-file-message)
       (let ((msg
 	     (string-append "Reading file \""
-			    (pathname->string truename)
+			    (->namestring truename)
 			    "\"...")))
 	(temporary-message msg)
 	(group-insert-file! (mark-group mark) (mark-index mark) truename)
@@ -97,7 +99,7 @@
       (group-insert-file! (mark-group mark) (mark-index mark) truename)))
 
 (define (group-insert-file! group index truename)
-  (let ((channel (file-open-input-channel (pathname->string truename))))
+  (let ((channel (file-open-input-channel (->namestring truename))))
     (let ((length (file-length channel)))
       (without-interrupts
        (lambda ()
@@ -215,7 +217,7 @@ after you find a file.  If you explicitly request such a scan with
 			(prompt-for-confirmation?
 			 (string-append
 			  "Set local variables as specified at end of "
-			  (pathname-name-string (buffer-pathname buffer)))))
+			  (file-namestring (buffer-pathname buffer)))))
 		    (parse-local-variables buffer start end)))))))))
 
 (define edwin-environment (->environment '(edwin)))
@@ -348,22 +350,22 @@ and the rest are not called."
   list?)
 
 (define (write-buffer-interactive buffer backup-mode)
-  (let ((truename (pathname->output-truename (buffer-pathname buffer))))
-    (let ((writable? (file-writable? truename)))
+  (let ((pathname (buffer-pathname buffer)))
+    (let ((writable? (file-writable? pathname)))
       (if (or writable?
 	      (prompt-for-yes-or-no?
 	       (string-append "File "
-			      (pathname-name-string truename)
+			      (file-namestring pathname)
 			      " is write-protected; try to save anyway"))
 	      (editor-error
 	       "Attempt to save to a file which you aren't allowed to write"))
 	  (begin
 	    (if (not (or (verify-visited-file-modification-time? buffer)
-			 (not (file-exists? truename))
+			 (not (file-exists? pathname))
 			 (prompt-for-yes-or-no?
 			  "Disk file has changed since visited or saved.  Save anyway")))
 		(editor-error "Save not confirmed"))
-	    (let ((modes (backup-buffer! buffer truename backup-mode)))
+	    (let ((modes (backup-buffer! buffer pathname backup-mode)))
 	      (require-newline buffer)
 	      (cond ((let loop ((hooks (ref-variable write-file-hooks buffer)))
 		       (and (not (null? hooks))
@@ -371,11 +373,11 @@ and the rest are not called."
 				(loop (cdr hooks)))))
 		     unspecific)
 		    ((ref-variable file-precious-flag buffer)
-		     (let ((old (os/precious-backup-pathname truename)))
+		     (let ((old (os/precious-backup-pathname pathname)))
 		       (let ((rename-back?
 			      (catch-file-errors (lambda () false)
 				(lambda ()
-				  (rename-file truename old)
+				  (rename-file pathname old)
 				  (set! modes (file-modes old))
 				  true))))
 			 (dynamic-wind
@@ -392,29 +394,29 @@ and the rest are not called."
 			  (lambda ()
 			    (if rename-back?
 				(begin
-				  (rename-file old truename)
+				  (rename-file old pathname)
 				  (clear-visited-file-modification-time!
 				   buffer))))))))
 		    (else
 		     (if (and (not writable?)
 			      (not modes)
-			      (file-exists? truename))
+			      (file-exists? pathname))
 			 (bind-condition-handler
 			     (list condition-type:file-error)
 			     (lambda (condition)
 			       condition
 			       (editor-error
 				"Can't get write permission for file: "
-				(pathname->string truename)))
+				(->namestring pathname)))
 			   (lambda ()
-			     (let ((m (file-modes truename)))
-			       (set-file-modes! truename #o777)
+			     (let ((m (file-modes pathname)))
+			       (set-file-modes! pathname #o777)
 			       (set! modes m)))))
 		     (write-buffer buffer)))
 	      (if modes
 		  (catch-file-errors
 		   (lambda () unspecific)
-		   (lambda () (set-file-modes! truename modes))))))))))
+		   (lambda () (set-file-modes! pathname modes))))))))))
 
 (define (verify-visited-file-modification-time? buffer)
   (let ((truename (buffer-truename buffer))
@@ -430,18 +432,15 @@ and the rest are not called."
 
 (define (write-buffer buffer)
   (let ((truename
-	 (string->pathname
+	 (->pathname
 	  (write-region (buffer-unclipped-region buffer)
 			(buffer-pathname buffer)
 			true))))
-    (if truename
-	(begin
-	  (set-buffer-truename! buffer truename)
-	  (delete-auto-save-file! buffer)
-	  (set-buffer-save-length! buffer)
-	  (buffer-not-modified! buffer)
-	  (set-buffer-modification-time! buffer
-					 (file-modification-time truename))))))
+    (set-buffer-truename! buffer truename)
+    (delete-auto-save-file! buffer)
+    (set-buffer-save-length! buffer)
+    (buffer-not-modified! buffer)
+    (set-buffer-modification-time! buffer (file-modification-time truename))))
 
 (define-variable enable-emacs-write-file-message
   "If true, generate Emacs-style message when writing files.
@@ -450,36 +449,22 @@ Otherwise, a message is written both before and after long file writes."
   boolean?)
 
 (define (write-region region filename message?)
-  (let ((filename (canonicalize-output-filename filename))
-	(start (region-start-index region))
-	(end (region-end-index region)))
-    (let ((do-it
-	   (lambda ()
-	     (group-write-to-file (region-group region) start end filename))))
-      (cond ((not message?)
-	     (do-it))
-	    ((or (ref-variable enable-emacs-write-file-message)
-		 (<= (- end start) 50000))
-	     (do-it)
-	     (message "Wrote " filename))
-	    (else
-	     (let ((msg (string-append "Writing file " filename "...")))
-	       (message msg)
-	       (do-it)
-	       (message msg "done")))))
-    filename))
+  (write-region* region filename message? group-write-to-file))
 
 (define (append-to-file region filename message?)
-  (let ((filename (canonicalize-overwrite-filename filename))
+  (write-region* region filename message? group-append-to-file))
+
+(define (write-region* region filename message? group-write-to-file)
+  (let ((filename (->namestring filename))
 	(start (region-start-index region))
 	(end (region-end-index region)))
     (let ((do-it
 	   (lambda ()
-	     (group-append-to-file (region-group region) start end filename))))
+	     (group-write-to-file (region-group region) start end filename))))
       (cond ((not message?)
 	     (do-it))
 	    ((or (ref-variable enable-emacs-write-file-message)
-		 (< (- end start) 50000))
+		 (<= (- end start) 50000))
 	     (do-it)
 	     (message "Wrote " filename))
 	    (else
@@ -487,6 +472,9 @@ Otherwise, a message is written both before and after long file writes."
 	       (message msg)
 	       (do-it)
 	       (message msg "done")))))
+    ;; This isn't the correct truename on systems that support version
+    ;; numbers.  For those systems, the truename must be supplied by
+    ;; the operating system after the channel is closed.
     filename))
 
 (define (group-write-to-file group start end filename)
@@ -554,7 +542,7 @@ Otherwise, a message is written both before and after long file writes."
 			  (temporary-message
 			   "Cannot write backup file; backing up in "
 			   filename)
-			  (copy-file truename (string->pathname filename))
+			  (copy-file truename filename)
 			  false))
 		      (lambda ()
 			(if (or (ref-variable file-precious-flag buffer)
@@ -578,7 +566,7 @@ Otherwise, a message is written both before and after long file writes."
 			     (prompt-for-confirmation?
 			      (string-append
 			       "Delete excess backup versions of "
-			       (pathname->string (buffer-pathname buffer))))))
+			       (->namestring (buffer-pathname buffer))))))
 		    (for-each (lambda (target)
 				(catch-file-errors
 				 (lambda () unspecific)
diff --git a/v7/src/edwin/hlpcom.scm b/v7/src/edwin/hlpcom.scm
index 90e07c7c7..614e2849e 100644
--- a/v7/src/edwin/hlpcom.scm
+++ b/v7/src/edwin/hlpcom.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/hlpcom.scm,v 1.100 1991/08/06 15:39:10 arthur Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/hlpcom.scm,v 1.101 1991/11/04 20:51:09 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -266,9 +266,7 @@ If you want VALUE to be a string, you must surround it with doublequotes."
   ()
   (lambda ()
     (delete-other-windows (current-window))
-    (let ((pathname
-	   (merge-pathnames (string->pathname "TUTORIAL")
-			    (home-directory-pathname))))
+    (let ((pathname (merge-pathnames "TUTORIAL" (user-homedir-pathname))))
       (let ((buffer (pathname->buffer pathname)))
 	(if buffer
 	    (select-buffer buffer)
diff --git a/v7/src/edwin/info.scm b/v7/src/edwin/info.scm
index 6949d88fb..627de6996 100644
--- a/v7/src/edwin/info.scm
+++ b/v7/src/edwin/info.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/info.scm,v 1.107 1991/10/18 16:02:39 arthur Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/info.scm,v 1.108 1991/11/04 20:51:14 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -173,7 +173,7 @@ s	Search through this Info file for specified regexp,
 			"Info:  ("
 			(let ((pathname (ref-variable info-current-file)))
 			  (if pathname
-			      (pathname-name-string pathname)
+			      (file-namestring pathname)
 			      ""))
 			")"
 			(or (ref-variable info-current-node) ""))))
@@ -364,7 +364,7 @@ except for \\[info-cease-edit] to return to Info."
 			(begin
 			  (let ((pathname (subfile-pathname (car subfiles))))
 			    (message "Searching subfile "
-				     (pathname-name-string pathname)
+				     (file-namestring pathname)
 				     "...")
 			    (set-current-subfile! pathname))
 			  (let ((mark (perform-search (buffer-start buffer))))
@@ -648,13 +648,12 @@ The name may be an abbreviation of the reference name."
 			;; unless filename is explicitly self-relative.
 			(if (let ((directory (pathname-directory pathname)))
 			      (and (pair? directory)
-				   (eq? (car directory) 'SELF)))
+				   (eq? (car directory) 'RELATIVE)
+				   (pair? (cdr directory))
+				   (equal? (cadr directory) ".")))
 			    (buffer-default-directory (current-buffer))
-			    (let ((info-directory
-				   (ref-variable info-directory)))
-			      (if info-directory
-				  (->pathname info-directory)
-				  (edwin-info-directory))))))))
+			    (or (ref-variable info-directory)
+				(edwin-info-directory)))))))
 		(if (file-exists? pathname)
 		    pathname
 		    (let ((pathname*
@@ -672,9 +671,7 @@ The name may be an abbreviation of the reference name."
 		       (ref-variable info-current-node)
 		       (mark-index (current-point))))
       ;; Switch files if necessary.
-      (if (and pathname
-	       (let ((pathname* (ref-variable info-current-file)))
-		 (not (and pathname* (pathname=? pathname pathname*)))))
+      (if (and pathname (equal? pathname (ref-variable info-current-file)))
 	  (begin
 	    (read-buffer buffer pathname true)
 	    (if (not (eq? (buffer-major-mode buffer) (ref-mode-object info)))
@@ -909,18 +906,16 @@ The name may be an abbreviation of the reference name."
 	(loop (cdr subfiles)))))
 
 (define (set-current-subfile! pathname)
-  (let ((subfile (ref-variable info-current-subfile)))
-    (if (or (not subfile)
-	    (not (pathname=? subfile pathname)))
-	(begin
-	  (read-buffer (current-buffer) pathname true)
-	  (set-variable! info-current-subfile pathname)))))
+  (if (not (equal? pathname (ref-variable info-current-subfile)))
+      (begin
+	(read-buffer (current-buffer) pathname true)
+	(set-variable! info-current-subfile pathname))))
 
 (define-integrable subfile-filename car)
 (define-integrable subfile-index cdr)
 
 (define (subfile-pathname subfile)
-  (merge-pathnames (->pathname (subfile-filename subfile))
+  (merge-pathnames (subfile-filename subfile)
 		   (ref-variable info-current-file)))
 
 (define (subfile-list)
diff --git a/v7/src/edwin/make.scm b/v7/src/edwin/make.scm
index ce3ec801d..4f087c12c 100644
--- a/v7/src/edwin/make.scm
+++ b/v7/src/edwin/make.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/make.scm,v 3.61 1991/10/25 00:16:18 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/make.scm,v 3.62 1991/11/04 20:51:20 cph Exp $
 
 Copyright (c) 1989-91 Massachusetts Institute of Technology
 
@@ -37,4 +37,4 @@ MIT in each case. |#
 (declare (usual-integrations))
 
 (package/system-loader "edwin" '() 'QUERY)
-(add-system! (make-system "Edwin" 3 61 '()))
\ No newline at end of file
+(add-system! (make-system "Edwin" 3 62 '()))
\ No newline at end of file
diff --git a/v7/src/edwin/modlin.scm b/v7/src/edwin/modlin.scm
index b2d97153c..f9df551a9 100644
--- a/v7/src/edwin/modlin.scm
+++ b/v7/src/edwin/modlin.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/modlin.scm,v 1.11 1991/08/28 22:28:33 arthur Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/modlin.scm,v 1.12 1991/11/04 20:51:24 cph Exp $
 ;;;
 ;;;	Copyright (c) 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -246,7 +246,7 @@ If #F, the normal method is used."
 	 (cond ((not pathname)
 		"[none]")
 	       ((pathname? pathname)
-		(os/truncate-filename-for-modeline (pathname->string pathname)
+		(os/truncate-filename-for-modeline (->namestring pathname)
 						   max-width))
 	       (else
 		""))))
diff --git a/v7/src/edwin/paths.scm b/v7/src/edwin/paths.scm
index fbc1e8553..7b13d8533 100644
--- a/v7/src/edwin/paths.scm
+++ b/v7/src/edwin/paths.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/paths.scm,v 1.10 1991/07/16 21:00:02 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/paths.scm,v 1.11 1991/11/04 20:51:29 cph Exp $
 
 Copyright (c) 1989-91 Massachusetts Institute of Technology
 
@@ -37,20 +37,19 @@ MIT in each case. |#
 (declare (usual-integrations))
 
 (define edwin-library-directory-pathname
-  (let ((directory (pathname-as-directory (string->pathname "edwin"))))
+  (let ((directory (pathname-as-directory "edwin")))
     (lambda (name)
       (let ((pathname
 	     (system-library-directory-pathname
-	      (merge-pathnames (->pathname name) directory))))
+	      (merge-pathnames name directory))))
 	(if (not pathname)
 	    (error "Can't find edwin library directory:" name))
 	pathname))))
 
 (define (edwin-etc-pathname filename)
-  (let ((pathname
-	 (merge-pathnames (->pathname filename) (edwin-etc-directory))))
+  (let ((pathname (merge-pathnames filename (edwin-etc-directory))))
     (if (not (file-exists? pathname))
-	(error "Unable to find file:" (pathname->string pathname)))
+	(error "Unable to find file:" (->namestring pathname)))
     pathname))
 
 (define (edwin-binary-directory)
diff --git a/v7/src/edwin/process.scm b/v7/src/edwin/process.scm
index 310b96188..70d8fdf00 100644
--- a/v7/src/edwin/process.scm
+++ b/v7/src/edwin/process.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/process.scm,v 1.12 1991/10/29 13:48:22 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/process.scm,v 1.13 1991/11/04 20:51:36 cph Exp $
 ;;;
 ;;;	Copyright (c) 1991 Massachusetts Institute of Technology
 ;;;
@@ -656,11 +656,11 @@ Prefix arg means replace the region with it."
 ;;; These procedures are not specific to the process abstraction.
 
 (define (find-program program default-directory)
-  (pathname->string
-   (let ((program (->pathname program))
-	 (lose (lambda () (error "Can't find program:" program))))
+  (->namestring
+   (let ((lose
+	  (lambda () (error "Can't find program:" (->namestring program)))))
      (cond ((pathname-absolute? program)
-	    (if (not (unix/file-access program 1)) (lose))
+	    (if (not (file-access program 1)) (lose))
 	    program)
 	   ((not default-directory)
 	    (let loop ((path (ref-variable exec-path)))
@@ -668,12 +668,11 @@ Prefix arg means replace the region with it."
 	      (or (and (car path)
 		       (pathname-absolute? (car path))
 		       (let ((pathname (merge-pathnames program (car path))))
-			 (and (unix/file-access pathname 1)
+			 (and (file-access pathname 1)
 			      pathname)))
 		  (loop (cdr path)))))
 	   (else
-	    (let ((default-directory
-		   (pathname->absolute-pathname default-directory)))
+	    (let ((default-directory (merge-pathnames default-directory)))
 	      (let loop ((path (ref-variable exec-path)))
 		(if (null? path) (lose))
 		(let ((pathname
@@ -683,7 +682,7 @@ Prefix arg means replace the region with it."
 			      ((pathname-absolute? (car path)) (car path))
 			      (else (merge-pathnames (car path)
 						     default-directory))))))
-		  (if (unix/file-access pathname 1)
+		  (if (file-access pathname 1)
 		      pathname
 		      (loop (cdr path)))))))))))
 
@@ -691,8 +690,7 @@ Prefix arg means replace the region with it."
   (let ((end (string-length string))
 	(substring
 	 (lambda (string start end)
-	   (pathname-as-directory
-	    (string->pathname (substring string start end))))))
+	   (pathname-as-directory (substring string start end)))))
     (let loop ((start 0))
       (if (< start end)
 	  (let ((index (substring-find-next-char string start end #\:)))
diff --git a/v7/src/edwin/rmail.scm b/v7/src/edwin/rmail.scm
index e1c2c103e..fe3fc0f3a 100644
--- a/v7/src/edwin/rmail.scm
+++ b/v7/src/edwin/rmail.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/rmail.scm,v 1.10 1991/10/26 21:08:26 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/rmail.scm,v 1.11 1991/11/04 20:51:47 cph Exp $
 ;;;
 ;;;	Copyright (c) 1991 Massachusetts Institute of Technology
 ;;;
@@ -171,7 +171,7 @@ w	Edit the current message.  C-c C-c to return to Rmail."
      (let ((inboxes (parse-file-inboxes buffer)))
        (if (and (null? inboxes)
 		(pathname=? (buffer-pathname buffer)
-			    (->pathname (ref-variable rmail-file-name))))
+			    (ref-variable rmail-file-name)))
 	   (ref-variable rmail-primary-inbox-list)
 	   inboxes)))
     (buffer-put! buffer 'REVERT-BUFFER-METHOD rmail-revert-buffer)
@@ -287,9 +287,7 @@ then performs rmail editing on that file,
 but does not copy any new mail into the file."
   (lambda ()
     (list (and (command-argument)
-	       (pathname->string
-		(prompt-for-input-truename "Run rmail on RMAIL file"
-					   false)))))
+	       (prompt-for-existing-file "Run rmail on RMAIL file" false))))
   (lambda (filename)
     (rmail-find-file (or filename (ref-variable rmail-file-name)))
     (let ((mode (current-major-mode)))
@@ -363,9 +361,7 @@ Interactively, a prefix argument causes us to read a file name
 and use that file as the inbox."
   (lambda ()
     (list (and (command-argument)
-	       (pathname->string
-		(prompt-for-input-truename "Get new mail from file"
-					   false)))))
+	       (prompt-for-existing-file "Get new mail from file" false))))
   (lambda (filename)
     (let ((buffer (current-buffer)))
       (rmail-find-file-revert buffer)
@@ -452,8 +448,7 @@ and use that file as the inbox."
     (let ((source (->pathname filename)))
       (cond ((not rename?)
 	     (insert source))
-	    ((string=? rmail-spool-directory
-		       (pathname-directory-string source))
+	    ((string=? rmail-spool-directory (directory-namestring source))
 	     (rename-inbox-using-movemail source
 					  insert
 					  (buffer-default-directory buffer)))
@@ -461,11 +456,10 @@ and use that file as the inbox."
 	     (rename-inbox-using-rename source insert))))))
 
 (define (rename-inbox-using-rename source insert)
-  (let ((target
-	 (string->pathname (string-append (pathname->string source) "~"))))
+  (let ((target (string-append (->namestring source) "~")))
     (let ((msg
 	   (string-append "Getting mail from "
-			  (pathname->string source)
+			  (->namestring source)
 			  "...")))
       (message msg)
       (if (and (file-exists? source) (not (file-exists? target)))
@@ -479,16 +473,12 @@ and use that file as the inbox."
 	 ;; On some systems, /usr/spool/mail/foo is a directory and
 	 ;; the actual inbox is /usr/spool/mail/foo/foo.
 	 (if (file-directory? source)
-	     (merge-pathnames (string->pathname (pathname-name source))
+	     (merge-pathnames (pathname-name source)
 			      (pathname-as-directory source))
 	     source))
-	(target
-	 (merge-pathnames (string->pathname ".newmail")
-			  (->pathname directory))))
+	(target (merge-pathnames ".newmail" directory)))
     (let ((msg
-	   (string-append "Getting mail from "
-			  (pathname->string source)
-			  "...")))
+	   (string-append "Getting mail from " (->namestring source) "...")))
       (message msg)
       (if (and (file-exists? source)
 	       (not (file-exists? target)))
@@ -496,10 +486,10 @@ and use that file as the inbox."
 	    (let ((start (buffer-start error-buffer))
 		  (end (buffer-end error-buffer)))
 	      (run-synchronous-process false start false false
-				       (pathname->string
+				       (->namestring
 					(edwin-etc-pathname "movemail"))
-				       (pathname->string source)
-				       (pathname->string target))
+				       (->namestring source)
+				       (->namestring target))
 	      (if (mark< start end)
 		  (error
 		   (let ((m
@@ -1270,12 +1260,12 @@ If file is being visited, the message is appended to the
 buffer visiting that file."
   (lambda ()
     (list
-     (pathname->string
+     (->namestring
       (get-rmail-output-pathname "Output message to Rmail file"
 				 (ref-variable rmail-last-rmail-file)))))
   (lambda (filename)
     (let* ((pathname (->pathname filename))
-	   (filename (pathname->string pathname)))
+	   (filename (->namestring pathname)))
       (set-variable! rmail-last-rmail-file filename)
       (let* ((memo (current-msg-memo))
 	     (message
@@ -1325,12 +1315,12 @@ buffer visiting that file."
   "Append this message to Unix mail file named FILE-NAME."
   (lambda ()
     (list
-     (pathname->string
+     (->namestring
       (get-rmail-output-pathname "Output message to Unix mail file"
 				 (ref-variable rmail-last-file)))))
   (lambda (filename)
     (let* ((pathname (->pathname filename)))
-      (set-variable! rmail-last-file (pathname->string pathname))
+      (set-variable! rmail-last-file (->namestring pathname))
       (let ((memo (current-msg-memo)))
 	(let ((buffer (temporary-buffer " rmail output")))
 	  (let ((end (mark-left-inserting-copy (buffer-end buffer))))
@@ -1360,11 +1350,11 @@ buffer visiting that file."
 
 (define (get-rmail-output-pathname prompt default)
   (let ((default (->pathname default)))
-    (let ((name (pathname-name-path default)))
+    (let ((name (file-pathname default)))
       (let ((pathname
 	     (prompt-for-pathname
-	      (string-append prompt " (default " (pathname->string name) ")")
-	      (pathname-directory-path default)
+	      (string-append prompt " (default " (->namestring name) ")")
+	      (directory-pathname default)
 	      false)))
 	(if (file-directory? pathname)
 	    (merge-pathnames name (pathname-as-directory pathname))
diff --git a/v7/src/edwin/sendmail.scm b/v7/src/edwin/sendmail.scm
index 2ab3d465b..aa86501cf 100644
--- a/v7/src/edwin/sendmail.scm
+++ b/v7/src/edwin/sendmail.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/sendmail.scm,v 1.11 1991/10/26 21:08:33 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/sendmail.scm,v 1.12 1991/11/04 20:51:55 cph Exp $
 ;;;
 ;;;	Copyright (c) 1991 Massachusetts Institute of Technology
 ;;;
@@ -101,7 +101,9 @@ False means let mailer mail back a message to report errors."
 
 (define-variable sendmail-program
   "Filename of sendmail program."
-  "/usr/lib/sendmail"
+  (if (file-exists? "/usr/lib/sendmail")
+      "/usr/lib/sendmail"
+      "fakemail")
   string?)
 
 (define-variable mail-yank-ignored-headers
@@ -538,7 +540,7 @@ Numeric argument means justify as well."
 		 (extract-string (re-match-start 1) (re-match-end 1))))
 	    (move-mark-to! m (line-start (re-match-start 0) 0))
 	    (delete-string m (line-start m 1))
-	    (loop (cons (string->pathname filename) pathnames)))
+	    (loop (cons (->pathname filename) pathnames)))
 	  (begin
 	    (mark-temporary! m)
 	    pathnames)))))
\ No newline at end of file
diff --git a/v7/src/edwin/shell.scm b/v7/src/edwin/shell.scm
index a4378f1ee..f36aa6140 100644
--- a/v7/src/edwin/shell.scm
+++ b/v7/src/edwin/shell.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/shell.scm,v 1.7 1991/10/25 00:03:10 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/shell.scm,v 1.8 1991/11/04 20:52:03 cph Exp $
 
 Copyright (c) 1991 Massachusetts Institute of Technology
 
@@ -125,8 +125,7 @@ Otherwise, one argument `-i' is passed to the shell."
 	      (let ((variable
 		     (string-table-get editor-variables
 				       (string-append "explicit-"
-						      (pathname-name-string
-						       (->pathname program))
+						      (file-namestring program)
 						      "-args"))))
 		(if variable
 		    (variable-value variable)
@@ -190,7 +189,7 @@ Otherwise, one argument `-i' is passed to the shell."
 
 (define (shell-process-pushd arg)
   (let ((default-directory
-	  (pathname->string (buffer-default-directory (current-buffer))))
+	  (->namestring (buffer-default-directory (current-buffer))))
 	(dirstack (ref-variable shell-dirstack)))
     (if (string-null? arg)
 	;; no arg -- swap pwd and car of shell stack
@@ -251,7 +250,7 @@ Otherwise, one argument `-i' is passed to the shell."
        (lambda ()
 	 (set-default-directory
 	  (if (string-null? filename)
-	      (home-directory-pathname)
+	      (user-homedir-pathname)
 	      filename))))))
   (shell-dirstack-message))
 
@@ -261,7 +260,7 @@ Otherwise, one argument `-i' is passed to the shell."
 	     ((dirs
 	       (cons (buffer-default-directory (current-buffer))
 		     (ref-variable shell-dirstack))))
-	   (cons (os/pathname->display-string (->pathname (car dirs)))
+	   (cons (os/pathname->display-string (car dirs))
 		 (if (null? (cdr dirs))
 		     '()
 		     (cons " " (loop (cdr dirs))))))))
diff --git a/v7/src/edwin/tagutl.scm b/v7/src/edwin/tagutl.scm
index b9b1b2719..0d9b42c96 100644
--- a/v7/src/edwin/tagutl.scm
+++ b/v7/src/edwin/tagutl.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/tagutl.scm,v 1.43 1991/10/11 03:32:51 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/tagutl.scm,v 1.44 1991/11/04 20:52:09 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -155,7 +155,7 @@ See documentation of variable tags-file-name."
 	  (let ((pathname
 		 (merge-pathnames
 		  (tag->pathname tag)
-		  (pathname-directory-path (buffer-pathname buffer))))
+		  (directory-pathname (buffer-pathname buffer))))
 		(regexp
 		 (string-append
 		  "^"
@@ -189,7 +189,7 @@ See documentation of variable tags-file-name."
 		(if (not mark)
 		    (editor-failure regexp
 				    " not found in "
-				    (pathname-name-string pathname))
+				    (file-namestring pathname))
 		    (set-current-point! (line-start mark 0))))))))))
 
 (define find-tag-match-regexp
@@ -252,7 +252,7 @@ See documentation of variable tags-file-name."
 	  (set! tags-loop-pathnames (cdr pathnames))
 	  (find-file (car pathnames))
 	  (message "Scanning file "
-		   (pathname->string (buffer-truename (current-buffer)))
+		   (->namestring (buffer-truename (current-buffer)))
 		   "...")
 	  (set-current-point! (buffer-start (current-buffer)))
 	  (tags-loop-continuation)))))
@@ -276,7 +276,7 @@ See documentation of variable tags-file-name."
 	  (revert-buffer buffer true true))
       (if (not (eqv? (extract-right-char (buffer-start buffer)) #\Page))
 	  (editor-error "File "
-			(pathname->string pathname)
+			(->namestring pathname)
 			" not a valid tag table"))
       buffer)))
 
@@ -286,8 +286,8 @@ See documentation of variable tags-file-name."
       (let ((mark (mark+ (line-start file-mark 1)
 			 (with-input-from-mark file-mark read))))
 	(if (mark> mark tag)
-	    (string->pathname (extract-string (line-start file-mark 0)
-					      (mark-1+ file-mark)))
+	    (->pathname (extract-string (line-start file-mark 0)
+					(mark-1+ file-mark)))
 	    (loop mark)))))
   (loop (group-start tag)))
 
@@ -296,7 +296,7 @@ See documentation of variable tags-file-name."
     (or (buffer-get buffer tags-table-pathnames)
 	(let ((pathnames
 	       (let ((directory
-		      (pathname-directory-path (buffer-truename buffer))))
+		      (directory-pathname (buffer-truename buffer))))
 		 (let loop ((mark (buffer-start buffer)))
 		   (let ((file-mark
 			  (skip-chars-backward "^,\n" (line-end mark 1))))
@@ -304,9 +304,8 @@ See documentation of variable tags-file-name."
 			    (mark+ (line-start file-mark 1)
 				   (with-input-from-mark file-mark read))))
 		       (cons (merge-pathnames
-			      (string->pathname
-			       (extract-string (line-start file-mark 0)
-					       (mark-1+ file-mark)))
+			      (extract-string (line-start file-mark 0)
+					      (mark-1+ file-mark))
 			      directory)
 			     (if (group-end? mark)
 				 '()
diff --git a/v7/src/edwin/unix.scm b/v7/src/edwin/unix.scm
index 9bcc2034b..d75f40ee7 100644
--- a/v7/src/edwin/unix.scm
+++ b/v7/src/edwin/unix.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/unix.scm,v 1.18 1991/10/23 06:14:21 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/unix.scm,v 1.19 1991/11/04 20:52:15 cph Exp $
 ;;;
 ;;;	Copyright (c) 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -98,10 +98,10 @@ Includes the new backup.  Must be > 0."
 	       (loop (-1+ slash))))))))
 
 (define (os/pathname->display-string pathname)
-  (let ((relative (pathname-relative? pathname (home-directory-pathname))))
-    (if relative
-	(string-append "~/" (pathname->string relative))
-	(pathname->string pathname))))
+  (let ((pathname (enough-pathname pathname (user-homedir-pathname))))
+    (if (pathname-absolute? pathname)
+	(->namestring pathname)
+	(string-append "~/" (->namestring pathname)))))
 
 (define (os/filename->display-string filename)
   (let ((home (unix/current-home-directory)))
@@ -117,16 +117,15 @@ Includes the new backup.  Must be > 0."
 (define (os/auto-save-pathname pathname buffer)
   (let ((wrap
 	 (lambda (name directory)
-	   (merge-pathnames (string->pathname (string-append "#" name "#"))
-			    directory))))
+	   (merge-pathnames (string-append "#" name "#") directory))))
     (if (not pathname)
 	(wrap (string-append "%" (buffer-name buffer))
 	      (buffer-default-directory buffer))
-	(wrap (pathname-name-string pathname)
-	      (pathname-directory-path pathname)))))
+	(wrap (file-namestring pathname)
+	      (directory-pathname pathname)))))
 
 (define (os/precious-backup-pathname pathname)
-  (string->pathname (string-append (pathname->string pathname) "#")))
+  (->pathname (string-append (->namestring pathname) "#")))
 
 (define (os/backup-buffer? truename)
   (and (memv (string-ref (vector-ref (file-attributes truename) 8) 0)
@@ -134,12 +133,28 @@ Includes the new backup.  Must be > 0."
        (not
 	(let ((directory (pathname-directory truename)))
 	  (and (pair? directory)
-	       (eq? 'ROOT (car directory))
+	       (eq? 'ABSOLUTE (car directory))
 	       (pair? (cdr directory))
 	       (eqv? "tmp" (cadr directory)))))))
 
 (define (os/default-backup-filename)
   "~/%backup%~")
+
+(define (os/truncate-filename-for-modeline filename width)
+  (let ((length (string-length filename)))
+    (if (< 0 width length)
+	(let ((result
+	       (substring
+		filename
+		(let ((index (- length width)))
+		  (or (and (not (char=? #\/ (string-ref filename index)))
+			   (substring-find-next-char filename index length
+						     #\/))
+		      (1+ index)))
+		length)))
+	  (string-set! result 0 #\$)
+	  result)
+	filename)))
 
 (define (os/backup-by-copying? truename)
   (let ((attributes (file-attributes truename)))
@@ -153,14 +168,14 @@ Includes the new backup.  Must be > 0."
   (let ((no-versions
 	 (lambda ()
 	   (values
-	    (string->pathname (string-append (pathname->string truename) "~"))
+	    (->pathname (string-append (->namestring truename) "~"))
 	    '()))))
     (if (eq? 'NEVER (ref-variable version-control))
 	(no-versions)
-	(let ((prefix (string-append (pathname-name-string truename) ".~")))
+	(let ((prefix (string-append (file-namestring truename) ".~")))
 	  (let ((filenames
 		 (os/directory-list-completions
-		  (pathname-directory-string truename)
+		  (directory-namestring truename)
 		  prefix))
 		(prefix-length (string-length prefix)))
 	    (let ((possibilities
@@ -188,14 +203,12 @@ Includes the new backup.  Must be > 0."
 		  (if (or (ref-variable version-control)
 			  (positive? high-water-mark))
 		      (let ((version->pathname
-			     (let ((directory
-				    (pathname-directory-path truename)))
+			     (let ((directory (directory-pathname truename)))
 			       (lambda (version)
 				 (merge-pathnames
-				  (string->pathname
-				   (string-append prefix
-						  (number->string version)
-						  "~"))
+				  (string-append prefix
+						 (number->string version)
+						 "~")
 				  directory)))))
 			(values
 			 (version->pathname (1+ high-water-mark))
@@ -209,68 +222,6 @@ Includes the new backup.  Must be > 0."
 			       '()))))
 		      (no-versions))))))))))
 
-(define (os/make-dired-line pathname)
-  (let ((attributes (file-attributes pathname)))
-    (and attributes
-	 (string-append
-	  "  "
-	  (file-attributes/mode-string attributes)
-	  " "
-	  (pad-on-left-to
-	   (number->string (file-attributes/n-links attributes) 10)
-	   3)
-	  " "
-	  (pad-on-right-to (unix/uid->string (file-attributes/uid attributes))
-			   8)
-	  " "
-	  (pad-on-right-to (unix/gid->string (file-attributes/gid attributes))
-			   8)
-	  " "
-	  (pad-on-left-to
-	   (number->string (file-attributes/length attributes) 10)
-	   7)
-	  " "
-	  (substring (unix/file-time->string
-		      (file-attributes/modification-time attributes))
-		     4
-		     16)
-	  " "
-	  (pathname-name-string pathname)
-	  (let ((type (file-attributes/type attributes)))
-	    (if (string? type)
-		(string-append " -> " type)
-		""))))))
-
-(define (os/dired-filename-region lstart)
-  (let ((lend (line-end lstart 0)))
-    (if (not (re-search-forward
-	      "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\) +[0-9]+ +[0-9:]+ "
-	      lstart
-	      lend))
-	(editor-error "No filename on this line"))
-    (make-region (re-match-end 0) lend)))
-
-(define (os/dired-sort-pathnames pathnames)
-  (sort pathnames
-    (lambda (x y)
-      (string<? (pathname-name-string x) (pathname-name-string y)))))
-
-(define (os/truncate-filename-for-modeline filename width)
-  (let ((length (string-length filename)))
-    (if (< 0 width length)
-	(let ((result
-	       (substring
-		filename
-		(let ((index (- length width)))
-		  (or (and (not (char=? #\/ (string-ref filename index)))
-			   (substring-find-next-char filename index length
-						     #\/))
-		      (1+ index)))
-		length)))
-	  (string-set! result 0 #\$)
-	  result)
-	filename)))
-
 (define (os/directory-list directory)
   ((ucode-primitive directory-close 0))
   ((ucode-primitive directory-open-noread 1) directory)
@@ -339,19 +290,13 @@ Includes the new backup.  Must be > 0."
 
 (define (os/init-file-name)
   "~/.edwin")
-
-(define os/find-file-initialization-filename
-  (let ((name-path (string->pathname ".edwin-ffi")))
-    (lambda (pathname)
-      (or (and (equal? "scm" (pathname-type pathname))
-	       (let ((pathname (pathname-new-version pathname "ffi")))
-		 (and (file-exists? pathname)
-		      pathname)))
-	  (let ((pathname
-		 (merge-pathnames name-path
-				  (pathname-directory-path pathname))))
-	    (and (file-exists? pathname)
-		 pathname))))))
 
-(define-integrable (file-readable? filename)
-  (unix/file-access filename 4))
\ No newline at end of file
+(define (os/find-file-initialization-filename pathname)
+  (or (and (equal? "scm" (pathname-type pathname))
+	   (let ((pathname (pathname-new-type pathname "ffi")))
+	     (and (file-exists? pathname)
+		  pathname)))
+      (let ((pathname
+	     (merge-pathnames ".edwin-ffi" (directory-pathname pathname))))
+	(and (file-exists? pathname)
+	     pathname))))
\ No newline at end of file
diff --git a/v7/src/edwin/utils.scm b/v7/src/edwin/utils.scm
index fd9c7fb9b..38d1989b3 100644
--- a/v7/src/edwin/utils.scm
+++ b/v7/src/edwin/utils.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/utils.scm,v 1.25 1991/05/16 23:06:00 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/utils.scm,v 1.26 1991/11/04 20:52:22 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -168,10 +168,6 @@
 	   (continuation (if-error)))
        thunk))))
 
-(define (pathname=? x y)
-  (string=? (pathname->string x)
-	    (pathname->string y)))
-
 (define (string-or-false? object)
   ;; Useful as a type for option variables.
   (or (false? object)