← Back to branch summary

~ubuntu-branches/ubuntu/trusty/mit-scheme/trusty

« back to all changes in this revision

Viewing changes to src/runtime/genio.scm

  • Committer: Package Import Robot
  • Author(s): Chris Hanson
  • Date: 2011-10-15 03:08:33 UTC
  • mfrom: (1.1.8) (3.1.7 sid)
  • Revision ID: package-import@ubuntu.com-20111015030833-x7qc6yxuulvxbafv
Tags: 9.1-1
* New upstream.
* debian/control, debian/copyright, debian/mit-scheme-doc.*,
  debian/mit-scheme.install, debian/rules, Upstream has removed cover
  texts from documentation licenses, so merge packages mit-scheme and
  mit-scheme-doc back together.
* debian/compat: Bump to current version.
* debian/control: Bump standards-version to current and make
  necessary changes.
* debian/rules: Fix lintian warnings.

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/runtime/genio.scm
2
2
 
3
3
Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
4
4
    1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
5
 
    2006, 2007, 2008, 2009, 2010 Massachusetts Institute of Technology
 
5
    2006, 2007, 2008, 2009, 2010, 2011 Massachusetts Institute of
 
6
    Technology
6
7
 
7
8
This file is part of MIT/GNU Scheme.
8
9
 
121
122
         `((CHAR-READY? ,generic-io/char-ready?)
122
123
           (CLOSE-INPUT ,generic-io/close-input)
123
124
           (EOF? ,generic-io/eof?)
 
125
           (INPUT-LINE ,generic-io/input-line)
124
126
           (INPUT-OPEN? ,generic-io/input-open?)
125
127
           (PEEK-CHAR ,generic-io/peek-char)
126
128
           (READ-CHAR ,generic-io/read-char)
194
196
  (buffer-has-input? (port-input-buffer port)))
195
197
 
196
198
(define (generic-io/peek-char port)
197
 
  (let ((char (generic-io/read-char port)))
 
199
  (let* ((ib (port-input-buffer port))
 
200
         (line (input-buffer-line ib))
 
201
         (char (generic-io/read-char port)))
198
202
    (if (char? char)
199
 
        (let ((ib (port-input-buffer port)))
 
203
        ;; Undo effect of read-char.
 
204
        (begin
 
205
          (set-input-buffer-line! ib line)
200
206
          (set-input-buffer-start! ib (input-buffer-prev ib))))
201
207
    char))
202
208
 
213
219
              (else (error "Unknown result:" r))))))))
214
220
 
215
221
(define (generic-io/unread-char port char)
216
 
  char                                  ;ignored
217
222
  (let ((ib (port-input-buffer port)))
218
223
    (let ((bp (input-buffer-prev ib)))
219
224
      (if (not (fix:< bp (input-buffer-start ib)))
220
225
          (error "No char to unread:" port))
 
226
      ;; If unreading a newline, decrement the line count.
 
227
      (if (char=? char #\newline)
 
228
          (set-input-buffer-line! ib (fix:- (input-buffer-line ib) 1)))
221
229
      (set-input-buffer-start! ib bp))))
222
230
 
223
231
(define (generic-io/read-substring port string start end)
224
232
  (read-substring (port-input-buffer port) string start end))
225
233
 
 
234
(define (generic-io/input-line port)
 
235
  (input-buffer-line (port-input-buffer port)))
 
236
 
226
237
(define (generic-io/eof? port)
227
238
  (input-buffer-at-eof? (port-input-buffer port)))
228
239
 
714
725
  end
715
726
  decode
716
727
  normalize
 
728
  line
717
729
  compute-encoded-character-size)
718
730
 
719
731
(define (make-input-buffer source coder-name normalizer-name)
727
739
                       (line-ending ((source/get-channel source))
728
740
                                    normalizer-name
729
741
                                    #f))
 
742
                      0
730
743
                      (name->sizer coder-name)))
731
744
 
732
745
(define (input-buffer-open? ib)
742
755
  (set-input-buffer-end! ib byte-buffer-length))
743
756
 
744
757
(define (close-input-buffer ib)
 
758
  (set-input-buffer-line! ib -1)
745
759
  (set-input-buffer-prev! ib -1)
746
760
  (set-input-buffer-start! ib -1)
747
761
  (set-input-buffer-end! ib -1))
761
775
  ((input-buffer-compute-encoded-character-size ib) ib char))
762
776
 
763
777
(define (read-next-char ib)
764
 
  ((input-buffer-normalize ib) ib))
 
778
  (let ((char ((input-buffer-normalize ib) ib)))
 
779
    (if (and (char? char)
 
780
             (char=? char #\newline))
 
781
        (let ((line (input-buffer-line ib)))
 
782
          (if line
 
783
              (set-input-buffer-line! ib (fix:+ line 1)))))
 
784
    char))
765
785
 
766
786
(define (decode-char ib)
767
787
  (and (fix:< (input-buffer-start ib) (input-buffer-end ib))
818
838
             (next-char-ready? ib)))))
819
839
 
820
840
(define (next-char-ready? ib)
821
 
  (let ((bs (input-buffer-start ib)))
 
841
  (let ((bl (input-buffer-line ib))
 
842
        (bs (input-buffer-start ib)))
822
843
    (and (read-next-char ib)
823
844
         (begin
 
845
           (set-input-buffer-line! ib bl)
824
846
           (set-input-buffer-start! ib bs)
825
847
           #t))))
826
848
 
1222
1244
  #x0127 #x00B2 #x00B3 #x00B4 #x00B5 #x0125 #x00B7 #x00B8
1223
1245
  #x0131 #x015F #x011F #x0135 #x00BD #f     #x017C #x00C0
1224
1246
  #x00C1 #x00C2 #f     #x00C4 #x010A #x0108 #x00C7 #x00C8
1225
 
  #x00C9 #x00CA #x00CB #x00CC #x00CD #x00CE #x00CF #f    
 
1247
  #x00C9 #x00CA #x00CB #x00CC #x00CD #x00CE #x00CF #f
1226
1248
  #x00D1 #x00D2 #x00D3 #x00D4 #x0120 #x00D6 #x00D7 #x011C
1227
1249
  #x00D9 #x00DA #x00DB #x00DC #x016C #x015C #x00DF #x00E0
1228
1250
  #x00E1 #x00E2 #f     #x00E4 #x010B #x0109 #x00E7 #x00E8
1229
 
  #x00E9 #x00EA #x00EB #x00EC #x00ED #x00EE #x00EF #f    
 
1251
  #x00E9 #x00EA #x00EB #x00EC #x00ED #x00EE #x00EF #f
1230
1252
  #x00F1 #x00F2 #x00F3 #x00F4 #x0121 #x00F6 #x00F7 #x011D
1231
1253
  #x00F9 #x00FA #x00FB #x00FC #x016D #x015D #x02D9)
1232
1254
 
1268
1290
  '(ISO_8859-5:1988 ISO-IR-144 ISO_8859-5 CYRILLIC CSISOLATINCYRILLIC))
1269
1291
 
1270
1292
(define-8-bit-codecs iso-8859-6 #xA1
1271
 
  #f     #f     #f     #x00A4 #f     #f     #f     #f    
1272
 
  #f     #f     #f     #x060C #x00AD #f     #f     #f    
1273
 
  #f     #f     #f     #f     #f     #f     #f     #f    
1274
 
  #f     #f     #x061B #f     #f     #f     #x061F #f    
 
1293
  #f     #f     #f     #x00A4 #f     #f     #f     #f
 
1294
  #f     #f     #f     #x060C #x00AD #f     #f     #f
 
1295
  #f     #f     #f     #f     #f     #f     #f     #f
 
1296
  #f     #f     #x061B #f     #f     #f     #x061F #f
1275
1297
  #x0621 #x0622 #x0623 #x0624 #x0625 #x0626 #x0627 #x0628
1276
1298
  #x0629 #x062A #x062B #x062C #x062D #x062E #x062F #x0630
1277
1299
  #x0631 #x0632 #x0633 #x0634 #x0635 #x0636 #x0637 #x0638
1278
1300
  #x0639 #x063A #f     #f     #f     #f     #f     #x0640
1279
1301
  #x0641 #x0642 #x0643 #x0644 #x0645 #x0646 #x0647 #x0648
1280
1302
  #x0649 #x064A #x064B #x064C #x064D #x064E #x064F #x0650
1281
 
  #x0651 #x0652 #f     #f     #f     #f     #f     #f    
 
1303
  #x0651 #x0652 #f     #f     #f     #f     #f     #f
1282
1304
  #f     #f     #f     #f     #f     #f     #f)
1283
1305
 
1284
1306
(define-coding-aliases 'ISO-8859-6
1307
1329
  #f     #x00A2 #x00A3 #x00A4 #x00A5 #x00A6 #x00A7 #x00A8
1308
1330
  #x00A9 #x00D7 #x00AB #x00AC #x00AD #x00AE #x00AF #x00B0
1309
1331
  #x00B1 #x00B2 #x00B3 #x00B4 #x00B5 #x00B6 #x00B7 #x00B8
1310
 
  #x00B9 #x00F7 #x00BB #x00BC #x00BD #x00BE #f     #f    
1311
 
  #f     #f     #f     #f     #f     #f     #f     #f    
1312
 
  #f     #f     #f     #f     #f     #f     #f     #f    
1313
 
  #f     #f     #f     #f     #f     #f     #f     #f    
 
1332
  #x00B9 #x00F7 #x00BB #x00BC #x00BD #x00BE #f     #f
 
1333
  #f     #f     #f     #f     #f     #f     #f     #f
 
1334
  #f     #f     #f     #f     #f     #f     #f     #f
 
1335
  #f     #f     #f     #f     #f     #f     #f     #f
1314
1336
  #f     #f     #f     #f     #f     #f     #x2017 #x05D0
1315
1337
  #x05D1 #x05D2 #x05D3 #x05D4 #x05D5 #x05D6 #x05D7 #x05D8
1316
1338
  #x05D9 #x05DA #x05DB #x05DC #x05DD #x05DE #x05DF #x05E0