mirror of
https://github.com/justinethier/cyclone.git
synced 2025-05-18 21:29:18 +02:00
46 lines
2.3 KiB
Scheme
46 lines
2.3 KiB
Scheme
#|
|
|
| Copyright (C) 2002 Scott Miller
|
|
| Copyright (C) 2017 Koz Ross
|
|
|
|
|
| Permission is hereby granted, free of charge, to any person obtaining a copy of
|
|
| this software and associated documentation files (the "Software"), to deal in
|
|
| the Software without restriction, including without limitation the rights to
|
|
| use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
|
|
| the Software, and to permit persons to whom the Software is furnished to do so,
|
|
| subject to the following conditions:
|
|
|
|
|
| The above copyright notice and this permission notice shall be included in all
|
|
| copies or substantial portions of the Software.
|
|
|
|
|
| THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
|
| IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
|
|
| FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
|
|
| COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
|
|
| IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
|
|
| CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
|
|
|#
|
|
|
|
(define (format format-string . objects)
|
|
(define buffer (open-output-string))
|
|
(define (fmt-rec format-list objs)
|
|
(define (escape-write how)
|
|
(if (null? objs)
|
|
(error "No value for escape sequence")
|
|
(begin
|
|
(how (car objs) buffer)
|
|
(fmt-rec (cddr format-list) (cdr objs)))))
|
|
(define (raw-write what next)
|
|
(write-char what buffer)
|
|
(fmt-rec (next format-list) objs))
|
|
(cond
|
|
((null? format-list) (get-output-string buffer))
|
|
((char=? (car format-list) #\~) (if (null? (cdr format-list))
|
|
(error "Incomplete escape sequence")
|
|
(case (cadr format-list)
|
|
((#\a) (escape-write display))
|
|
((#\s) (escape-write write))
|
|
((#\%) (raw-write #\newline cddr))
|
|
((#\~) (raw-write #\~ cddr))
|
|
(else (error "Unrecognized escape sequence")))))
|
|
(else (raw-write (car format-list) cdr))))
|
|
(fmt-rec (string->list format-string) objects))
|