scsh-0.5/scsh/scsh-read.scm

126 lines
3.4 KiB
Scheme
Raw Normal View History

1995-10-13 23:34:21 -04:00
;;; Copyright (c) 1993, 1994 by Olin Shivers.
;;; #! comment read-macro
;;; no case-folding
;;; -flag is a symbol
;;; #! means: skip chars until newline-bang-splat-newline.
;;; For Unix script headers.
(define script-skip
(lambda (c port)
(read-char port)
(let lp ((state 0))
(let ((advance-if (lambda (look-for)
(let ((c (read-char port)))
(if (eof-object? c)
(error
"EOF inside block comment -- #! missing a closing !#")
(lp (cond ((char=? c look-for) (+ state 1))
((char=? c #\newline) 1)
(else 0))))))))
(case state
((0) (advance-if #\newline))
((1) (advance-if #\!)) ; Found \n
((2) (advance-if #\#)) ; Found \n!
((3) (advance-if #\newline)) ; Found \n!#
((4) (read port))))))) ; Found \n!#\n -- done.
; was sub-read ^
(define-sharp-macro #\! script-skip)
;;; Readme and readme are distinct symbols.
(define preferred-case (lambda (x) x))
;;; These are now OK symbols: .. -geometry -O2 9x15 80x5+5+5 +Wn
(define (parse-token string port)
(if (let ((c (string-ref string 0)))
(or (char-numeric? c) (char=? c #\+) (char=? c #\-) (char=? c #\.)))
(cond ((string->number string))
((string=? string ".") dot)
(else (string->symbol string)))
(string->symbol string)))
;;; | is now an OK symbol (for pipes).
(set-standard-syntax! #\| #f
(lambda (c port)
(parse-token (sub-read-token c port) port)))
(define bel (ascii->char 7))
(define bs (ascii->char 8))
(define ff (ascii->char 12))
(define cr (ascii->char 13))
(define ht (ascii->char 9))
(define vt (ascii->char 11))
;;; Full ANSI C strings:
;;; - read as themselves: \\ \? \" \'
;;; - control chars:
;;; \a alert (bell -- ^g)
;;; \b backspace (^h)
;;; \f form feed (^l)
;;; \n newline (^j)
;;; \r carriage return (^m)
;;; \t tab (^i)
;;; \v vertical tab (^k)
;;; - octal escapes \nnn
;;; - hex escapes \xnn
;;; Is this the elegant thing to do? Too much might make it hard to shift
;;; to Unicode implementations. How about \^g for embedding control chars?
;;; And I haven't done anything about chars (as opposed to strings).
(set-standard-read-macro! #\" #t
(lambda (c port)
c ;ignored
(let* ((readc (lambda ()
(let ((c (read-char port)))
(if (eof-object? c)
(reading-error port "end of file within a string")
c))))
(read-digit (lambda (base base-name)
(let* ((c (readc))
(d (- (char->ascii c) (char->ascii #\0))))
(if (and (<= 0 d) (< d base)) d
(reading-error port
(string-append "invalid "
base-name
" code in string.")
d))))))
(let loop ((l '()) (i 0))
(let ((c (readc)))
(cond ((char=? c #\\)
(let* ((c (readc))
(rc (case c
((#\\ #\" #\? #\') c)
((#\a) bel)
((#\b) bs)
((#\f) ff)
((#\n) #\newline)
((#\r) cr)
((#\t) ht)
((#\v) vt)
((#\0 #\1 #\2 #\3)
(let* ((d1 (- (char->ascii c) (char->ascii #\0)))
(d2 (read-digit 8 "octal"))
(d3 (read-digit 8 "octal")))
(ascii->char (+ (* 64 d1) (+ (* 8 d2) d3)))))
((#\x)
(let ((d1 (read-digit 16 "hex"))
(d2 (read-digit 16 "hex")))
(ascii->char (+ (* 16 d1) d2))))
(else
(reading-error port
"invalid escaped character in string"
c)))))
(loop (cons rc l) (+ i 1))))
((char=? c #\")
(reverse-list->string l i))
(else
(loop (cons c l) (+ i 1)))))))))