blob: 99428975721a35aea744e113337444baa9187a5f (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
|
;;;"DrScheme.init" Initialization for SLIB for DrScheme -*-scheme-*-
;;; Author: Aubrey Jaffer
;;;
;;; This code is in the public domain.
(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))
(else (slib:error 'open-file 'mode? modes))))
;;(define (port? obj) (or (input-port? port) (output-port? port)))
(define (call-with-open-ports . ports)
(define proc (car ports))
(cond ((procedure? proc) (set! ports (cdr ports)))
(else (set! ports (reverse ports))
(set! proc (car ports))
(set! ports (reverse (cdr ports)))))
(let ((ans (apply proc ports)))
(for-each close-port ports)
ans))
(define (close-port port)
(cond ((input-port? port)
(close-input-port port)
(if (output-port? port) (close-output-port port)))
((output-port? port) (close-output-port port))
(else (slib:error 'close-port 'port? port))))
(define (browse-url url)
(define (try cmd end) (zero? (system (string-append cmd url end))))
(or (try "netscape-remote -remote 'openURL(" ")'")
(try "netscape -remote 'openURL(" ")'")
(try "netscape '" "'&")
(try "netscape '" "'")))
(cond ((string<? (version) "200")
(require-library "init.ss" "slibinit"))
(else
(load (build-path (collection-path "slibinit") "init.ss"))
(eval '(require (lib "defmacro.ss")))
(slib:provide 'defmacro)))
;;;The rest corrects mistakes in
;;;/usr/local/lib/plt/collects/slibinit/init.ss:
(provide 'fluid-let)
(define slib:warn
(lambda args
(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))))
(define call-with-input-string
(lambda (string thunk)
(parameterize ((current-input-port (open-input-string string)))
(thunk (current-input-port)))))
|
