diff options
Diffstat (limited to 'pscheme.init')
| -rw-r--r-- | pscheme.init | 194 |
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) |