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
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
|
;;;;
;;;; reader.stk -- Reader hook for the open bracket
;;;;
;;;; Copyright (C) 2001-2003 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;;
;;;;
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation; either version 2 of the License, or
;;;; (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program; if not, write to the Free Software
;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
;;;; USA.
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 6-Dec-2001 22:59 (eg)
;;;; Last file update: 28-Feb-2004 10:22 (eg)
;;;;
;; Examples of ISO-2022-JP (here for cut'n paste tests, since my japanese
;; is *very* limited ;-).
;;
;; "Japan" $BF|K\(B
;; "China and Chinese music" $BCf9q$HCf9q$N2;3Z(B
;;
;; This function is a hook for the standard reader. After defining,
;; %read-bracket, the reader calls it when it encounters an open
;; bracket
(define (%read-bracket in)
(define (read-japanese in)
;; This function reads an ISO-2022-JP sequence. Susch s sequence is coded
;; as "^[$B......^[(B" . When entering in this function the current
;; character is 'B' (the opening sequence one). Function reads until the
;; end of the sequence and return it as a string
(read-char in) ;; to skip the starting #\B
(let ((res (open-output-string)))
(let Loop ((c (peek-char in)))
(cond
((eof-object? c) ;; EOF
(error '%read-bracket "EOF encountered"))
((char=? c #\escape)
(read-char in)
(let ((next1 (peek-char in)))
(if (char=? next1 #\()
(begin
(read-char in)
(let ((next2 (peek-char in)))
(if (char=? next2 #\B)
(begin
(read-char in)
(format "\033$B~A\033(B" (get-output-string res)))
(begin
(format res "\033~A" next1)
(Loop next2)))))
(begin
(display #\escape res)
(Loop next1)))))
(else (display (read-char in) res)
(Loop (peek-char in)))))))
;;
;; Body of %read-bracket starts here
;;
(let ((out (open-output-string))
(res '())
(in-string? #f))
(read-char in) ; skip open bracket
(let Loop ((c (peek-char in)))
(cond
((eof-object? c) ;; EOF
(error '%read-bracket "EOF encountered"))
((char=? c #\escape) ;; ISO-2022-JP string?
(read-char in)
(let ((next1 (peek-char in)))
(if (char=? next1 #\$)
(begin
(read-char in)
(let ((next2 (peek-char in)))
(if (char=? next2 #\B)
(begin
(set! res
(append! res
(list (get-output-string out)
(list 'unquote
(list 'jp
(read-japanese in))))))
(set! out (open-output-string)))
(format out "\033~A" next1))))
(display #\escape out)))
(Loop (peek-char in)))
((char=? c #\\) ;; Quote char
(read-char in)
(display (read-char in) out)
(Loop (peek-char in)))
((and (not in-string?) (char=? c #\,)) ;; Comma
(read-char in)
(let ((next (peek-char in)))
(if (char=? next #\()
(begin
(set! res (append! res (list (get-output-string out)
(list 'unquote
(read in)))))
(set! out (open-output-string)))
(display #\, out))
(Loop (peek-char in))))
((and (not in-string?) (char=? c #\[)) ;; Open bracket
(display (%read-bracket in) out)
(Loop (peek-char in)))
((and (not in-string?) (char=? c #\])) ;; Close bracket
(read-char in)
(let ((str (get-output-string out)))
(list 'quasiquote
(append! res (if (string=? str "") '() (list str))))))
(else (when (char=? c #\") (set! in-string? (not in-string?)))
(display (read-char in) out)
(Loop (peek-char in)))))))
|
