Implement new procedure os/filename->display-string. Change

definition of os/filename-directory, to return false when there's no
directory component.

diff --git a/v7/src/edwin/unix.scm b/v7/src/edwin/unix.scm
index 033eba49e77519e11f561769feed675dacd38269..ce8b3249c6a9cedcb36e37879a4a15a051b1ddef 100644 (file)
--- 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.16 1991/05/14 02:28:17 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/unix.scm,v 1.17 1991/05/15 18:44:44 cph Exp $
 ;;;
 ;;;    Copyright (c) 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -103,6 +103,17 @@ Includes the new backup.  Must be > 0."
        (string-append "~/" (pathname->string relative))
        (pathname->string pathname))))
 
+(define (os/filename->display-string filename)
+  (let ((home (unix/current-home-directory)))
+    (cond ((not (string-prefix? home filename))
+          filename)
+         ((string=? home filename)
+          "~")
+         ((char=? #\/ (string-ref filename (string-length home)))
+          (string-append "~" (string-tail filename (string-length home))))
+         (else
+          filename))))
+
 (define (os/auto-save-pathname pathname buffer)
   (let ((wrap
         (lambda (name directory)
@@ -294,9 +305,8 @@ Includes the new backup.  Must be > 0."
 (define (os/filename-directory filename)
   (let ((end (string-length filename)))
     (let ((index (substring-find-previous-char filename 0 end #\/)))
-      (if index
-         (substring filename 0 (+ index 1))
-         "./"))))
+      (and index
+          (substring filename 0 (+ index 1))))))
 
 (define (os/filename-non-directory filename)
   (let ((end (string-length filename)))