Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 107 lines (91 sloc) 3.468 kb
35d4473 @duncanmak Port this to Scheme48.
duncanmak authored
1 ;;; -*- Mode: Scheme; scheme48-package: (config) -*-
2
3 (define-structure terminfo terminfo-interface
5110c48 Replace usages of INTEGER->CHAR and CHAR->INTEGER with their ASCII equiv...
Duncan Mak authored
4 (open ascii
35d4473 @duncanmak Port this to Scheme48.
duncanmak authored
5 let-opt
5110c48 Replace usages of INTEGER->CHAR and CHAR->INTEGER with their ASCII equiv...
Duncan Mak authored
6 scheme
35d4473 @duncanmak Port this to Scheme48.
duncanmak authored
7 support
5f1ffb8 @duncanmak Load srfi-23 and srfi-60 instead of (SUBSET SIGNALS (ERROR)) and BITWISE...
duncanmak authored
8 (subset threads (sleep))
9 srfi-1 srfi-6 srfi-9 srfi-11 srfi-13 srfi-14 srfi-23 srfi-60 srfi-69)
35d4473 @duncanmak Port this to Scheme48.
duncanmak authored
10 (files terminfo
11 terminfo-capabilities
12 utilities))
13
5f1ffb8 @duncanmak Load srfi-23 and srfi-60 instead of (SUBSET SIGNALS (ERROR)) and BITWISE...
duncanmak authored
14 (define-structure srfi-60 (export bitwise-and
15 bitwise-ior
16 bitwise-xor)
17 (open scheme bitwise))
18
a142905 @duncanmak Use the SRFI-69 hash-table API instead of the Scheme48-specific
duncanmak authored
19 (define-structure srfi-69 (export make-hash-table
20 hash-table-ref
21 hash-table-set!)
22 (open scheme
23 (modify tables (rename (make-table make-hash-table)
24 (table-ref hash-table-ref)
25 (table-set! hash-table-set!)))))
26
35d4473 @duncanmak Port this to Scheme48.
duncanmak authored
27 (define-structure support (export path-list->file-name
28 infix-splitter
29 file-readable?
30 file-not-exists?
31 getenv
0564dc5 @duncanmak (read-byte) Move definition to the package definition so that we won't
duncanmak authored
32 read-byte
35d4473 @duncanmak Port this to Scheme48.
duncanmak authored
33 tty-info tty-info:output-speed
34 uname uname:os-name
ee6d116 @duncanmak Use WHEN and UNLESS instead of one-armed IF.
duncanmak authored
35 (when :syntax)
36 (unless :syntax)
35d4473 @duncanmak Port this to Scheme48.
duncanmak authored
37 (with-current-input-port :syntax)
38 (with-current-output-port :syntax))
5110c48 Replace usages of INTEGER->CHAR and CHAR->INTEGER with their ASCII equiv...
Duncan Mak authored
39 (open ascii
8eb43de Rename CHAR->ASCII to CHAR->INTEGER, etc etc.
Duncan Mak authored
40 i/o-internal
41 let-opt
5110c48 Replace usages of INTEGER->CHAR and CHAR->INTEGER with their ASCII equiv...
Duncan Mak authored
42 scheme
8eb43de Rename CHAR->ASCII to CHAR->INTEGER, etc etc.
Duncan Mak authored
43 posix
44 (subset signals (error))
45 srfi-13
46 srfi-14
47 (subset util (unspecific)))
35d4473 @duncanmak Port this to Scheme48.
duncanmak authored
48 (for-syntax (open scheme i/o-internal))
49 (begin
ee6d116 @duncanmak Use WHEN and UNLESS instead of one-armed IF.
duncanmak authored
50
51 (define-syntax unless
52 (syntax-rules ()
53 ((unless predicate action0 . actions)
54 (if predicate
55 #f
56 (begin action0 . actions)))))
57
58 (define-syntax when
59 (syntax-rules ()
60 ((when predicate action0 . actions)
61 (if predicate
62 (begin action0 . actions)
63 #f))))
64
35d4473 @duncanmak Port this to Scheme48.
duncanmak authored
65 (define ignore (unspecific))
66 (define (tty-info port) ignore)
67 (define (uname) ignore)
68
69 ;; Modify as necessary
70 (define (uname:os-name uname) (os-name))
71 (define (tty-info:output-speed ttyinfo) 'extb)
72
73 (define (getenv variable) (lookup-environment-variable variable))
74
75 (define (path-list->file-name path-list)
76 (string-join path-list "/"))
77
78 (define (infix-splitter delimiter)
79 (lambda (input-string)
db40ce7 @duncanmak (infix-splitter): Use the complement of the charset, otherwise
duncanmak authored
80 (string-tokenize input-string
81 (char-set-complement (string->char-set delimiter)))))
35d4473 @duncanmak Port this to Scheme48.
duncanmak authored
82
83 (define (file-readable? filename)
84 (accessible? filename (access-mode read)))
85
86 (define (file-not-exists? filename)
87 (not (accessible? filename (access-mode exists))))
88
0564dc5 @duncanmak (read-byte) Move definition to the package definition so that we won't
duncanmak authored
89 (define (read-byte . args)
90 (let-optionals args ((s (current-input-port)))
91 (let ((value (read-char s)))
92 (if (eof-object? value)
93 (error "invalid data")
5110c48 Replace usages of INTEGER->CHAR and CHAR->INTEGER with their ASCII equiv...
Duncan Mak authored
94 (char->ascii value)))))
0564dc5 @duncanmak (read-byte) Move definition to the package definition so that we won't
duncanmak authored
95
35d4473 @duncanmak Port this to Scheme48.
duncanmak authored
96 (define-syntax with-current-input-port
97 (syntax-rules ()
98 ((with-current-input-port port body ...)
99 (call-with-current-input-port port
100 (lambda () body ...)))))
101
102 (define-syntax with-current-output-port
103 (syntax-rules ()
104 ((with-current-output-port port body ...)
105 (call-with-current-output-port port
106 (lambda () body ...)))))
107 ))
Something went wrong with that request. Please try again.