From fa705d928f20733f8c30afd8300272fc1fb95ab5 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Thu, 29 Feb 1996 22:16:23 +0000 Subject: [PATCH] In OS/TRIM-PATHNAME-STRING, allow the user to delete part of an inserted directory and then follow it with an absolute pathname. --- v7/src/edwin/dosfile.scm | 7 +++++-- v7/src/edwin/unix.scm | 6 ++++-- 2 files changed, 9 insertions(+), 4 deletions(-) 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))) -- 2.25.1