From bd9733926076885e3417b74de76e4c9c7bc56254 Mon Sep 17 00:00:00 2001
From: Bryan Newbold <bnewbold@robocracy.org>
Date: Mon, 20 Feb 2017 00:05:28 -0800
Subject: Import Upstream version 2c7

---
 require.scm | 67 ++++++++++++++++++++++++++++++-------------------------------
 1 file changed, 33 insertions(+), 34 deletions(-)

(limited to 'require.scm')

diff --git a/require.scm b/require.scm
index ebaf49f..a578349 100644
--- a/require.scm
+++ b/require.scm
@@ -17,7 +17,7 @@
 ;promotional, or sales literature without prior written consent in
 ;each case.
 
-(define *SLIB-VERSION* "2c3")
+(define *SLIB-VERSION* "2c7")
 
 ;;; Standardize msdos -> ms-dos.
 (define software-type
@@ -31,44 +31,43 @@
     (else	"")))
 
 (define *load-pathname* #f)
-(define program-vicinity
-  (let ((*vicinity-suffix*
+(define vicinity:suffix?
+  (let ((suffi
 	 (case (software-type)
-	   ((AMIGA)	'(#\: #\/))
+	   ((AMIGA)				'(#\: #\/))
+	   ((MACOS THINKC)			'(#\:))
 	   ((MS-DOS WINDOWS ATARIST OS/2)	'(#\\ #\/))
-	   ((MACOS THINKC)	'(#\:))
-	   ((NOSVE)	'(#\: #\.))
-	   ((UNIX COHERENT)	'(#\/))
-	   ((VMS)	'(#\: #\])))))
-    (lambda ()
-      (if *load-pathname*
-	  (let loop ((i (- (string-length *load-pathname*) 1)))
-	    (cond ((negative? i) "")
-		  ((memv (string-ref *load-pathname* i) *vicinity-suffix*)
-		   (substring *load-pathname* 0 (+ i 1)))
-		  (else (loop (- i 1)))))
-	  (slib:error "Not loading but called" 'program-vicinity)))))
+	   ((NOSVE)				'(#\: #\.))
+	   ((UNIX COHERENT)			'(#\/))
+	   ((VMS)				'(#\: #\])))))
+    (lambda (chr) (memv chr suffi))))
+(define (program-vicinity)
+  (if *load-pathname*
+      (let loop ((i (- (string-length *load-pathname*) 1)))
+	(cond ((negative? i) "")
+	      ((vicinity:suffix? (string-ref *load-pathname* i))
+	       (substring *load-pathname* 0 (+ i 1)))
+	      (else (loop (- i 1)))))
+      (slib:error "Not loading but called" 'program-vicinity)))
 
 (define sub-vicinity
   (case (software-type)
-    ((VMS)
-     (lambda
-      (vic name)
-      (let ((l (string-length vic)))
-	(if (or (zero? (string-length vic))
-		(not (char=? #\] (string-ref vic (- l 1)))))
-	    (string-append vic "[" name "]")
-	    (string-append (substring vic 0 (- l 1))
-			   "." name "]")))))
-    (else
-     (let ((*vicinity-suffix*
-	    (case (software-type)
-	      ((NOSVE) ".")
-	      ((UNIX COHERENT AMIGA) "/")
-	      ((MACOS THINKC) ":")
-	      ((MS-DOS WINDOWS ATARIST OS/2) "\\"))))
-       (lambda (vic name)
-	 (string-append vic name *vicinity-suffix*))))))
+    ((VMS) (lambda
+	       (vic name)
+	     (let ((l (string-length vic)))
+	       (if (or (zero? (string-length vic))
+		       (not (char=? #\] (string-ref vic (- l 1)))))
+		   (string-append vic "[" name "]")
+		   (string-append (substring vic 0 (- l 1))
+				  "." name "]")))))
+    (else (let ((*vicinity-suffix*
+		 (case (software-type)
+		   ((NOSVE) ".")
+		   ((MACOS THINKC) ":")
+		   ((MS-DOS WINDOWS ATARIST OS/2) "\\")
+		   ((UNIX COHERENT AMIGA) "/"))))
+	    (lambda (vic name)
+	      (string-append vic name *vicinity-suffix*))))))
 
 (define (make-vicinity <pathname>) <pathname>)
 
-- 
cgit v1.2.3