summaryrefslogtreecommitdiffstats
path: root/scheme48.init
diff options
context:
space:
mode:
authorJim Pick <jim@jimpick.com>1998-03-08 23:05:22 -0800
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:27 -0800
commitb21cac3362022718634f7086964208b2eed8e897 (patch)
tree16f4b2e70645c0e8e2202023170b5a94baa967e3 /scheme48.init
parent3796d2595035e192ed4bf1c9a6bfdb13c3c9d261 (diff)
parentf24b9140d6f74804d5599ec225717d38ca443813 (diff)
downloadslib-b21cac3362022718634f7086964208b2eed8e897.tar.gz
slib-b21cac3362022718634f7086964208b2eed8e897.zip
Import Debian changes 2c0-3debian/2c0-3
slib (2c0-3) unstable; urgency=low * New maintainer. * slibconfig script to automatically configure guile. * Fix type in description, closes: Bug#18996 slib (2c0-2) unstable; urgency=low * Minor fix for debian/rules targets slib (2c0-1) unstable; urgency=low * New upstream source * New maintainer
Diffstat (limited to 'scheme48.init')
-rw-r--r--scheme48.init83
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"))