From 77a37e8a05f2deb8519a0d4a50540480a1825114 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Thu, 29 Feb 1996 22:14:18 +0000 Subject: [PATCH] In ENOUGH-PATHNAME, specially handle DOS network filenames, because they might partially match to non-network filenames. --- v7/src/runtime/pathnm.scm | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) diff --git a/v7/src/runtime/pathnm.scm b/v7/src/runtime/pathnm.scm index 4910e37b9..327955871 100644 --- a/v7/src/runtime/pathnm.scm +++ b/v7/src/runtime/pathnm.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: pathnm.scm,v 14.30 1995/01/31 19:34:47 cph Exp $ +$Id: pathnm.scm,v 14.31 1996/02/29 22:14:18 cph Exp $ -Copyright (c) 1988-95 Massachusetts Institute of Technology +Copyright (c) 1988-96 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -381,7 +381,7 @@ these rules: (if (default-object? default-version) 'NEWEST default-version))))) - + (define (enough-pathname pathname #!optional defaults) (let* ((defaults (if (and (not (default-object? defaults)) defaults) @@ -408,7 +408,16 @@ these rules: (default (%pathname-directory defaults))) (if (or (not directory) (symbol? directory) - (not (eq? (car directory) (car default)))) + (not (eq? (car directory) (car default))) + ;; Detect the case where directory starts with "//" + ;; and default does not, or vice versa. This is a + ;; kludge to make network devices work properly in + ;; DOS-like pathnames. + (and (eq? (car directory) 'ABSOLUTE) + (not (boolean=? (and (pair? (cdr directory)) + (equal? (cadr directory) "")) + (and (pair? (cdr default)) + (equal? (cadr default) "")))))) directory (let loop ((components (cdr directory)) (components* (cdr default))) -- 2.25.1