In OS/TRIM-PATHNAME-STRING, allow the user to delete part of an
authorChris Hanson <org/chris-hanson/cph>
Thu, 29 Feb 1996 22:16:23 +0000 (22:16 +0000)
committerChris Hanson <org/chris-hanson/cph>
Thu, 29 Feb 1996 22:16:23 +0000 (22:16 +0000)
inserted directory and then follow it with an absolute pathname.

v7/src/edwin/dosfile.scm
v7/src/edwin/unix.scm

index 0002801314ad3826f7d43ccfeecfd2d370886e88..a39d286516668952fbffc435ea0735812f660feb 100644 (file)
@@ -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)))
index 4a9c0ff520038f07f3825272c387750a95af5fcc..fd28eec559c53abfb1a970c27d9e03c2b8cf97e1 100644 (file)
@@ -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)))