66 lines
1.8 KiB
Scheme
66 lines
1.8 KiB
Scheme
|
(define read-string
|
||
|
|
(lambda (ip)
|
||
|
|
(unless (eqv? (read-char ip) #\")
|
||
|
|
(error 'read-string "no starting double-quote"))
|
||
|
|
(list->string
|
||
|
|
(let f ()
|
||
|
|
(let ([c (read-char ip)])
|
||
|
|
(cond
|
||
|
|
[(eqv? c #\") '()]
|
||
|
|
[(or (eqv? c #\newline) (eof-object? c))
|
||
|
|
(error 'read-string "no ending double-quote")]
|
||
|
|
[else (cons c (f))]))))))
|
||
|
|
|
||
|
|
(define readrol
|
||
|
|
(lambda (ip)
|
||
|
|
(let ([c (read-char ip)])
|
||
|
|
(if (eq? c #\newline)
|
||
|
|
'()
|
||
|
|
(cons c (readrol ip))))))
|
||
|
|
|
||
|
|
(define read-line
|
||
|
|
(lambda (ip)
|
||
|
|
(if (eof-object? (peek-char ip))
|
||
|
|
(peek-char ip)
|
||
|
|
(let ([x (read-string ip)])
|
||
|
|
(cons x (readrol ip))))))
|
||
|
|
|
||
|
|
(define summary-read
|
||
|
|
(lambda (ip)
|
||
|
|
(do ([ls '() (cons line ls)]
|
||
|
|
[line (read-line ip) (read-line ip)])
|
||
|
|
((eof-object? line) (reverse! ls)))))
|
||
|
|
|
||
|
|
(define summary-sort
|
||
|
|
(lambda (x)
|
||
|
|
(sort! (lambda (x y) (string<? (car x) (car y))) x)))
|
||
|
|
|
||
|
|
(define write-list
|
||
|
|
(lambda (ls op)
|
||
|
|
(unless (null? ls)
|
||
|
|
(write-char (car ls) op)
|
||
|
|
(write-list (cdr ls) op))))
|
||
|
|
|
||
|
|
(define summary-print
|
||
|
|
(lambda (x op)
|
||
|
|
(for-each
|
||
|
|
(lambda (x) (write-list (cdr x) op) (newline op))
|
||
|
|
x)))
|
||
|
|
|
||
|
|
(define summary-make
|
||
|
|
(lambda (root)
|
||
|
|
(parameterize ((reset-handler abort))
|
||
|
|
(let ([ip (open-input-file (format "~a.rfm" root))]
|
||
|
|
[op (open-output-file (format "~a.sfm" root) 'replace)])
|
||
|
|
(dynamic-wind
|
||
|
|
(lambda () #f)
|
||
|
|
(lambda ()
|
||
|
|
(fprintf op "\\begin{thesummary}~%")
|
||
|
|
(summary-print
|
||
|
|
(summary-sort (summary-read ip))
|
||
|
|
op)
|
||
|
|
(fprintf op "\\end{thesummary}~%"))
|
||
|
|
(lambda ()
|
||
|
|
(close-input-port ip)
|
||
|
|
(close-output-port op)))))))
|