diff options
Diffstat (limited to 'scheme48.init')
| -rw-r--r-- | scheme48.init | 83 |
1 files changed, 63 insertions, 20 deletions
diff --git a/scheme48.init b/scheme48.init index 6e6b423..e65ae8e 100644 --- a/scheme48.init +++ b/scheme48.init @@ -1,5 +1,5 @@ ;;;"scheme48.init" Initialisation for SLIB for Scheme48 -*-scheme-*- -;;; Copyright (C) 1992, 1993, 1994, 1995 Aubrey Jaffer. +;;; Copyright (C) 1992, 1993, 1994, 1995, 1997 Aubrey Jaffer. ; ;Permission to copy this software, to redistribute it, and to use it ;for any purpose is granted, subject to the following restrictions and @@ -33,24 +33,40 @@ (define (scheme-implementation-type) 'Scheme48) ;;; (scheme-implementation-version) should return a string describing -;;; the version the scheme implementation loading this file. - -(define (scheme-implementation-version) "0.36") +;;; the version of the scheme implementation loading this file. + +(define scheme-implementation-version + (cond ((= -86400 (modulo -2177452800 -86400)) + (display "scheme48-0.36 has been superseded by") + (newline) + (display "ftp@ftp-swiss.ai.mit.edu:pub/s48/scheme48-0.46.tgz") + (newline) + (display "ftp://ftp-swiss.ai.mit.edu/pub/s48/scheme48-0.46.tgz") + (newline) + (lambda () "0.36")) + (else (lambda () "0.46")))) ;;; (implementation-vicinity) should be defined to be the pathname of ;;; the directory where any auxiliary files to your Scheme ;;; implementation reside. -; For scheme48, perhaps something like /usr/local/src/scheme48/misc/ ? -(define (implementation-vicinity) - (case (software-type) - ((UNIX) "=scheme48/") ; Translated - (else (slib:error "unrecognized software-type" software-type)))) +;;; [ defined from the Makefile ] ;;; (library-vicinity) should be defined to be the pathname of the ;;; directory where files of Scheme library functions reside. -(define (library-vicinity) "/usr/local/lib/slib/") +;;; [ defined from the Makefile ] + +(define getenv s48-getenv) +(define system s48-system) + +;;; (home-vicinity) should return the vicinity of the user's HOME +;;; directory, the directory which typically contains files which +;;; customize a computer environment for a user. + +(define home-vicinity + (let ((home-path (getenv "HOME"))) + (lambda () home-path))) ;;; *FEATURES* should be set to a list of symbols describing features ;;; of this implementation. See Template.scm for the list of feature @@ -76,6 +92,8 @@ dynamic-wind ;proposed dynamic-wind full-continuation ;can return multiple times macro ;R4RS appendix's DEFINE-SYNTAX + system ;posix (system <string>) + getenv ;posix (getenv <string>) )) ;;; (OUTPUT-PORT-WIDTH <port>) @@ -85,8 +103,7 @@ (define (output-port-height . arg) 24) ;;; (CURRENT-ERROR-PORT) -(define current-error-port - (access-scheme-48 'error-output-port)) +(define current-error-port s48-current-error-port) ;;; (TMPNAM) makes a temporary file name. (define tmpnam @@ -96,20 +113,29 @@ (if (file-exists? tmp) (tmpnam) tmp))))) ;;; (FILE-EXISTS? <string>) -(define (file-exists? f) #f) +(define (file-exists? f) + (call-with-current-continuation + (lambda (k) + (s48-with-handler + (lambda (condition decline) + (k #f)) + (lambda () + (close-input-port (open-input-file f)) + #t))))) ;;; (DELETE-FILE <string>) -(define (delete-file f) #f) +(define (delete-file file-name) + (s48-system (string-append "rm " file-name))) ;;; FORCE-OUTPUT flushes any pending output on optional arg output port ;;; use this definition if your system doesn't have such a procedure. (define (force-output . arg) - ((access-scheme-48 'force-output) + (s48-force-output (if (null? arg) (current-output-port) (car arg)))) ;;; CHAR-CODE-LIMIT is one greater than the largest integer which can ;;; be returned by CHAR->INTEGER. -(define integer->char (access-scheme-48 'ascii->char)) +(define integer->char s48-ascii->char) (define char->integer (let ((char->integer char->integer) (code0 (char->integer (integer->char 0)))) @@ -139,7 +165,10 @@ ;;; If your implementation provides R4RS macros: (define macro:eval slib:eval) -(define macro:load load) +(define (macro:load <pathname>) + (if (not (file-exists? <pathname>)) + (set! <pathname> (string-append <pathname> (scheme-file-suffix)))) + (load <pathname>)) (define *defmacros* (list (cons 'defmacro @@ -190,12 +219,18 @@ (evl o)) (set! *load-pathname* old-load-pathname))))) +(define slib:warn + (lambda args + (let ((port (current-error-port))) + (display "Warn: " port) + (for-each (lambda (x) (display x port)) args)))) + ;;; define an error procedure for the library -(define slib:error (access-scheme-48 'error)) +(define slib:error s48-error) ;;; define these as appropriate for your system. -(define slib:tab (integer->char 9)) -(define slib:form-feed (integer->char 12)) +(define slib:tab (s48-ascii->char 9)) +(define slib:form-feed (s48-ascii->char 12)) ;;; Support for older versions of Scheme. Not enough code for its own file. (define (last-pair l) (if (pair? (cdr l)) (last-pair (cdr l)) l)) @@ -236,4 +271,12 @@ (define slib:load slib:load-source) +;;; Scheme48 complains that these are not defined (even though they +;;; won't be called until they are). +(define synclo:load #f) +(define syncase:load #f) +(define macwork:load #f) +(define transcript-on #f) +(define transcript-off #f) + (slib:load (in-vicinity (library-vicinity) "require")) |