diff options
author | Thomas Bushnell, BSG <tb@debian.org> | 2005-11-02 14:55:21 -0800 |
---|---|---|
committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:32 -0800 |
commit | 34c54a22ff7818bb8b38ef4d9c87dbbcb221ba73 (patch) | |
tree | 1189d06a81277bcf8539b0260a69a19f6038effb /DrScheme.init | |
parent | 611b3db17894e5fdc0db3d49eaf6743d27b44233 (diff) | |
parent | 5145dd3aa0c02c9fc496d1432fc4410674206e1d (diff) | |
download | slib-debian/3a2-1.tar.gz slib-debian/3a2-1.zip |
Import Debian changes 3a2-1debian/3a2-1
slib (3a2-1) unstable; urgency=low
* New upstream release.
* Acknowledge NMU. (Closes: #281809)
* Makefile: Don't hack Makefile; use rules instead.
* debian/rules: Set on make invocations: prefix, htmldir, TEXI2HTML.
* debian/rules (clean): Clean more stuff here.
* Makefile: Comment out old rule for $(htmldir)slib_toc.html. Instead,
specify directly that the texi2html invocation produces that file.
* debian/rules (binary-indep): Find web files in slib subdir.
* debian/control (Build-Depends-Indep): Go back to using scm.
Diffstat (limited to 'DrScheme.init')
-rw-r--r-- | DrScheme.init | 85 |
1 files changed, 84 insertions, 1 deletions
diff --git a/DrScheme.init b/DrScheme.init index 9942897..8cce2e9 100644 --- a/DrScheme.init +++ b/DrScheme.init @@ -3,6 +3,85 @@ ;;; ;;; This code is in the public domain. +;;; (software-type) should be set to the generic operating system type. +;;; UNIX, VMS, MACOS, AMIGA and MS-DOS are supported. + +;@ +(define (software-type) + (case (system-type) + [(unix macosx) 'UNIX] + [(windows) 'MS-DOS] + [(macos) 'MACOS] + [else (system-type)])) +;@ +(define in-vicinity string-append) +;@ +(define (user-vicinity) + (case (software-type) + ((VMS) "[.]") + (else ""))) + +(define *load-pathname* #f) +;@ +(define vicinity:suffix? + (let ((suffi + (case (software-type) + ((AMIGA) '(#\: #\/)) + ((MACOS THINKC) '(#\:)) + ((MS-DOS WINDOWS ATARIST OS/2) '(#\\ #\/)) + ((NOSVE) '(#\: #\.)) + ((UNIX COHERENT PLAN9) '(#\/)) + ((VMS) '(#\: #\])) + (else + (slib:warn "require.scm" 'unknown 'software-type (software-type)) + "/")))) + (lambda (chr) (and (memv chr suffi) #t)))) +;@ +(define (pathname->vicinity pathname) + (let loop ((i (- (string-length pathname) 1))) + (cond ((negative? i) "") + ((vicinity:suffix? (string-ref pathname i)) + (substring pathname 0 (+ i 1))) + (else (loop (- i 1)))))) +(define (program-vicinity) + (if *load-pathname* + (pathname->vicinity *load-pathname*) + (slib:error 'program-vicinity " called; use slib:load to load"))) +;@ +(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) ".") + ((MACOS THINKC) ":") + ((MS-DOS WINDOWS ATARIST OS/2) "\\") + ((UNIX COHERENT PLAN9 AMIGA) "/")))) + (lambda (vic name) + (string-append vic name *vicinity-suffix*)))))) +;@ +(define (make-vicinity <pathname>) <pathname>) +;@ +(define with-load-pathname + (let ((exchange + (lambda (new) + (let ((old *load-pathname*)) + (set! *load-pathname* new) + old)))) + (lambda (path thunk) + (let ((old #f)) + (dynamic-wind + (lambda () (set! old (exchange path))) + thunk + (lambda () (exchange old))))))) + (define (make-exchanger obj) (lambda (rep) (let ((old obj)) (set! obj rep) old))) (define (open-file filename modes) @@ -41,6 +120,9 @@ (eval '(require (lib "defmacro.ss"))) (slib:provide 'defmacro))) +(provide 'vicinity) +(provide 'srfi-59) + ;;;The rest corrects mistakes in ;;;/usr/local/lib/plt/collects/slibinit/init.ss: @@ -51,7 +133,8 @@ (let ((cep (current-error-port))) (if (provided? 'trace) (print-call-stack cep)) (display "Warn: " cep) - (for-each (lambda (x) (display #\ cep) (write x cep)) args)))) + (for-each (lambda (x) (display #\ cep) (write x cep)) args) + (newline cep)))) (define call-with-input-string (lambda (string thunk) |