summaryrefslogtreecommitdiffstats
path: root/pscheme.init
diff options
context:
space:
mode:
authorBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:36 -0800
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:36 -0800
commit5bea21e81ed516440e34e480f2c33ca41aa8c597 (patch)
tree653ace1b8fe0a9916d861d35ff8f611b46c80d37 /pscheme.init
parent237c6e380aebdcbc70bd1c9ecf7d3f6effca2752 (diff)
downloadslib-5bea21e81ed516440e34e480f2c33ca41aa8c597.tar.gz
slib-5bea21e81ed516440e34e480f2c33ca41aa8c597.zip
Import Upstream version 3a4upstream/3a4
Diffstat (limited to 'pscheme.init')
-rw-r--r--pscheme.init194
1 files changed, 70 insertions, 124 deletions
diff --git a/pscheme.init b/pscheme.init
index bc7a5e5..f2c35cf 100644
--- a/pscheme.init
+++ b/pscheme.init
@@ -1,6 +1,6 @@
-;;; "pscheme.init" SLIB init file for Pocket Scheme -*-scheme-*-
+;;; "pscheme.init" SLIB init file for Pocket Scheme -*-scheme-*-
;;; Author: Ben Goetter <goetter@mazama.net>
-;;; last revised for 1.1.0 on 16 October 2000
+;;; last revised for pscheme 1.3 and slib 3a3 on 5 April 2006
;;; Initial work for 0.2.3 by Robert Goldman (goldman@htc.honeywell.com)
;;; SLIB orig Author: Aubrey Jaffer (agj @ alum.mit.edu)
;;;
@@ -19,12 +19,8 @@
(define (scheme-implementation-home-page) "http://www.mazama.net/scheme/pscheme.htm")
(define (implementation-vicinity) "\\Program Files\\Pocket Scheme\\")
-(define (library-vicinity) (in-vicinity (implementation-vicinity) "slib\\"))
-(define (home-vicinity) "\\My Documents\\")
-
-;(define (implementation-vicinity) "D:\\SRC\\PSCHEME\\BUILD\\TARGET\\X86\\NT\\DBG\\")
-;(define (library-vicinity) "D:\\SRC\\SLIB\\")
-;(define (home-vicinity) "D:\\SRC\\PSCHEME\\")
+(define (library-vicinity) (in-vicinity (implementation-vicinity) "slib\\"))
+(define (home-vicinity) "\\My Documents\\")
;@
(define in-vicinity string-append)
;@
@@ -93,110 +89,56 @@
(lambda () (set! old (exchange path)))
thunk
(lambda () (exchange old)))))))
-
-;;@ *FEATURES* is a list of symbols naming the (SLIB) features
+;;@ SLIB:FEATURES is a list of symbols naming the (SLIB) features
;;; initially supported by this implementation.
-(define *features*
- '(
- source ;can load scheme source files
- ;(SLIB:LOAD-SOURCE "filename")
-;;; compiled ;can load compiled files
- ;(SLIB:LOAD-COMPILED "filename")
- vicinity
- srfi-59
-
- ;; Scheme report features
- ;; R5RS-compliant implementations should provide all 9 features.
-
-;;; r5rs ;conforms to
- eval ;R5RS two-argument eval
-;;; values ;R5RS multiple values
- dynamic-wind ;R5RS dynamic-wind
-;;; macro ;R5RS high level macros
- delay ;has DELAY and FORCE
- multiarg-apply ;APPLY can take more than 2 args.
- char-ready?
- rev4-optional-procedures ;LIST-TAIL, STRING-COPY,
- ;STRING-FILL!, and VECTOR-FILL!
-
- ;; These four features are optional in both R4RS and R5RS
-
- multiarg/and- ;/ and - can take more than 2 args.
- rationalize
-;;; transcript ;TRANSCRIPT-ON and TRANSCRIPT-OFF
- with-file ;has WITH-INPUT-FROM-FILE and
- ;WITH-OUTPUT-TO-FILE
-
- r4rs ;conforms to
-
- ieee-p1178 ;conforms to
-
-;;; r3rs ;conforms to
-
-;;; rev2-procedures ;SUBSTRING-MOVE-LEFT!,
- ;SUBSTRING-MOVE-RIGHT!,
- ;SUBSTRING-FILL!,
- ;STRING-NULL?, APPEND!, 1+,
- ;-1+, <?, <=?, =?, >?, >=?
-;;; object-hash ;has OBJECT-HASH
-
- full-continuation ;can return multiple times
-;;; ieee-floating-point ;conforms to IEEE Standard 754-1985
- ;IEEE Standard for Binary
- ;Floating-Point Arithmetic.
-
- ;; Other common features
-
-;;; srfi ;srfi-0, COND-EXPAND finds all srfi-*
-;;; sicp ;runs code from Structure and
- ;Interpretation of Computer
- ;Programs by Abelson and Sussman.
- defmacro ;has Common Lisp DEFMACRO
-;;; record ;has user defined data structures
- string-port ;has CALL-WITH-INPUT-STRING and
- ;CALL-WITH-OUTPUT-STRING
-;;; sort
-;;; pretty-print
-;;; object->string
-;;; format ;Common-lisp output formatting
-; Undef this to get the SLIB TRACE macros
-;;; trace ;has macros: TRACE and UNTRACE
-;;; compiler ;has (COMPILER)
-;;; ed ;(ED) is editor
- system ;posix (system <string>)
-;;; getenv ;posix (getenv <string>)
-;;; program-arguments ;returns list of strings (argv)
-;;; current-time ;returns time in seconds since 1/1/1970
-
- ;; Implementation Specific features
-
+(define slib:features
+ '(source
+ r4rs
+ rev4-report
+ ieee-p1178
+ rev4-optional-procedures
+ vicinity
+ srfi-59
+ multiarg/and-
+ multiarg-apply
+ with-file
+ char-ready?
+ defmacro
+ rationalize
+ delay
+; pscheme needs the R5RS arity-2 eval in order to define the following
+; eval
+ dynamic-wind
+ full-continuation
+ srfi
+; pscheme needs print-call-stack in order to define the following
+; trace
+ system
+ string-port
))
-;;; (OUTPUT-PORT-WIDTH <port>)
-;;; (OUTPUT-PORT-HEIGHT <port>)
-;; $BUGBUG completely bogus values.
-(define (output-port-width . arg) 79)
+
+;; $BUGBUG completely bogus values. Need hooks into runtime to get better ones
+;;@ (OUTPUT-PORT-WIDTH <port>)
+(define (output-port-width . arg) 30)
+;;@ (OUTPUT-PORT-HEIGHT <port>)
(define (output-port-height . arg) 12)
-;;; (TMPNAM) makes a temporary file name.
+;;@ (TMPNAM) makes a temporary file name.
(define tmpnam (let ((cntr 100))
(lambda () (set! cntr (+ 1 cntr))
(string-append "slib_" (number->string cntr)))))
-;;; (FILE-EXISTS? <string>)
-(define (file-exists? f)
- (with-handlers (((lambda (x) #t) (lambda (x) #f)))
- (close-input-port (open-input-file f))
- #t))
-
-;; pscheme: current-error-port, delete-file, force-output already defined
-
+;; pscheme: current-error-port, delete-file, force-output, file-exists? already defined
+;@
(define (make-exchanger obj)
(lambda (rep) (let ((old obj)) (set! obj rep) old)))
(define (open-file filename modes)
(case modes
- ((r rb) (open-input-file filename))
- ((w wb) (open-output-file filename))
+ ((r) (open-input-file filename))
+ ((rb) (open-input-file filename 'lf-newline 'ascii))
+ ((w) (open-output-file filename))
+ ((wb) (open-output-file filename 'lf-newline 'ascii))
(else (slib:error 'open-file 'mode? modes))))
(define (port? obj) (or (input-port? port) (output-port? port)))
(define (call-with-open-ports . ports)
@@ -215,14 +157,18 @@
((output-port? port) (close-output-port port))
(else (slib:error 'close-port 'port? port))))
+;;; $REVIEW - should pscheme make SLIB use its own binary I/O?
+
+;@
(define (browse-url url)
- (define (try cmd) (eqv? 0 (system (sprintf #f cmd url))))
- (or (try "netscape-remote -remote 'openURL(%s)'")
- (try "netscape -remote 'openURL(%s)'")
- (try "netscape '%s'&")
- (try "netscape '%s'")))
+ (with-handlers
+ ;; the pscheme SYSTEM procedure raises an exn when it can't find the image to run.
+ ;; SYSTEM uses ShellExecuteEx where available, so we give it the document name to open
+ (((lambda (x) #t) (lambda (x) #f)))
+ (system url)))
-;;; CHAR-CODE-LIMIT is one greater than the largest integer which can
+
+;;@ CHAR-CODE-LIMIT is one greater than the largest integer which can
;;; be returned by CHAR->INTEGER.
;(define char-code-limit
; (with-handlers (
@@ -238,21 +184,21 @@
;;; So we patch it to 256.
(define char-code-limit 256)
-;;; MOST-POSITIVE-FIXNUM is used in modular.scm
+;;@ MOST-POSITIVE-FIXNUM is used in modular.scm
;;; This is the most positive immediate-value fixnum in PScheme.
(define most-positive-fixnum #x07FFFFFF)
-;;; Return argument
+;;@ Return argument
(define (identity x) x)
-;;; SLIB:EVAL is single argument eval using the top-level (user) environment.
+;;@ SLIB:EVAL is single argument eval using the top-level (user) environment.
(define slib:eval eval)
;;; If your implementation provides R4RS macros:
;(define macro:eval slib:eval)
;(define macro:load load)
-; Define defmacro in terms of our define-macro
+;;@ Define defmacro in terms of our define-macro
(define-macro (defmacro name args . body)
`(define-macro (,name ,@args) ,@body))
@@ -261,82 +207,82 @@
;(define macroexpand expand-macro)
;(define macroexpand-1 expand-macro-1)
+;@
(define gentemp gensym)
(define base:eval slib:eval)
+;@
(define defmacro:eval slib:eval)
-;; slib:eval-load definition moved to "require.scm"
+;; slib:eval-load definition moved to "require.scm"
+;@
(define (defmacro:load <pathname>)
(slib:eval-load <pathname> defmacro:eval))
-
+;@
(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 an error procedure for the library
(define slib:error error)
-;;; As announced by feature string-port
+;;@ As announced by feature string-port
(define (call-with-output-string t)
(let* ((p (open-output-string))
(r (t p))
(s (get-output-string p)))
(close-output-port p)
s))
-
(define (call-with-input-string s t)
(let* ((p (open-input-string s))
(r (t p)))
(close-input-port p)
r))
-;;; define these as appropriate for your system.
+;;@ define these as appropriate for your system.
(define slib:tab (integer->char 9))
(define slib:form-feed (integer->char 12))
-;;; Support for older versions of Scheme. Not enough code for its own file.
+;;@ 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))
(define t #t)
(define nil #f)
-;;; Define these if your implementation's syntax can support it and if
+;;@ Define these if your implementation's syntax can support it and if
;;; they are not already defined.
-
(define (1+ n) (+ n 1))
(define (-1+ n) (+ n -1))
(define 1- -1+)
-;;; Define SLIB:EXIT to be the implementation procedure to exit or
+;;@ Define SLIB:EXIT to be the implementation procedure to exit or
;;; return if exiting not supported.
(define slib:exit exit)
-;;; Here for backward compatability
+;;@ Here for backward compatability
(define scheme-file-suffix
(let ((suffix (case (software-type)
((nosve) "_scm")
(else ".scm"))))
(lambda () suffix)))
-;;; (SLIB:LOAD-SOURCE "foo") should load "foo.scm" or with whatever
+;;@ (SLIB:LOAD-SOURCE "foo") should load "foo.scm" or with whatever
;;; suffix all the module files in SLIB have. See feature 'SOURCE.
(define (slib:load-source f)
(if (not (file-exists? f))
(set! f (string-append f (scheme-file-suffix))))
(load f))
-;;; (SLIB:LOAD-COMPILED "foo") should load the file that was produced
+;;@ (SLIB:LOAD-COMPILED "foo") should load the file that was produced
;;; by compiling "foo.scm" if this implementation can compile files.
;;; See feature 'COMPILED.
(define slib:load-compiled load)
-;;; At this point SLIB:LOAD must be able to load SLIB files.
+;;@ At this point SLIB:LOAD must be able to load SLIB files.
(define slib:load slib:load-source)
;;; Pscheme and SLIB both define REQUIRE, so dispatch on argument type.
-;;; The SLIB REQUIRE does accept strings, though this facility seems never to be used.
(define pscheme:require require)
(slib:load (in-vicinity (library-vicinity) "require"))
(define slib:require require)