summaryrefslogtreecommitdiffstats
path: root/require.scm
diff options
context:
space:
mode:
authorBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:28 -0800
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:28 -0800
commitbd9733926076885e3417b74de76e4c9c7bc56254 (patch)
tree2c99dced547d48407ad44cb0e45e31bb4d02ce43 /require.scm
parentfa3f23105ddcf07c5900de47f19af43d1db1b597 (diff)
downloadslib-bd9733926076885e3417b74de76e4c9c7bc56254.tar.gz
slib-bd9733926076885e3417b74de76e4c9c7bc56254.zip
Import Upstream version 2c7upstream/2c7
Diffstat (limited to 'require.scm')
-rw-r--r--require.scm67
1 files changed, 33 insertions, 34 deletions
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>)