From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 29 Feb 1996 22:16:23 +0000 (+0000)
Subject: In OS/TRIM-PATHNAME-STRING, allow the user to delete part of an
X-Git-Tag: 20090517-FFI~5690
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=fa705d928f20733f8c30afd8300272fc1fb95ab5;p=mit-scheme.git

In OS/TRIM-PATHNAME-STRING, allow the user to delete part of an
inserted directory and then follow it with an absolute pathname.
---

diff --git a/v7/src/edwin/dosfile.scm b/v7/src/edwin/dosfile.scm
index 000280131..a39d28651 100644
--- a/v7/src/edwin/dosfile.scm
+++ b/v7/src/edwin/dosfile.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Id: dosfile.scm,v 1.5 1996/02/27 21:06:03 cph Exp $
+;;;	$Id: dosfile.scm,v 1.6 1996/02/29 22:16:23 cph Exp $
 ;;;
 ;;;	Copyright (c) 1994-96 Massachusetts Institute of Technology
 ;;;
@@ -90,7 +90,10 @@ Includes the new backup.  Must be > 0."
 (define (os/trim-pathname-string string prefix)
   (let ((index (string-match-forward prefix string)))
     (if (and index
-	     (fix:= index (string-length prefix))
+	     (or (fix:= index (string-length prefix))
+		 (and (fix:> index 0)
+		      (or (char=? (string-ref prefix (fix:- index 1)) #\/)
+			  (char=? (string-ref prefix (fix:- index 1)) #\\))))
 	     (re-match-substring-forward
 	      (re-compile-pattern "[\\/$~]\\|[a-zA-Z]:" #t)
 	      #t #f string index (string-length string)))
diff --git a/v7/src/edwin/unix.scm b/v7/src/edwin/unix.scm
index 4a9c0ff52..fd28eec55 100644
--- a/v7/src/edwin/unix.scm
+++ b/v7/src/edwin/unix.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Id: unix.scm,v 1.63 1996/02/27 21:56:57 cph Exp $
+;;;	$Id: unix.scm,v 1.64 1996/02/29 22:16:09 cph Exp $
 ;;;
 ;;;	Copyright (c) 1989-96 Massachusetts Institute of Technology
 ;;;
@@ -91,7 +91,9 @@ Includes the new backup.  Must be > 0."
 (define (os/trim-pathname-string string prefix)
   (let ((index (string-match-forward prefix string)))
     (if (and index
-	     (fix:= index (string-length prefix))
+	     (or (fix:= index (string-length prefix))
+		 (and (fix:> index 0)
+		      (char=? (string-ref prefix (fix:- index 1)) #\/)))
 	     (re-match-substring-forward (re-compile-pattern "[/$~]" #t)
 					 #t #f string index
 					 (string-length string)))