/usr/share/gauche-0.9/0.9.1/lib/srfi-29/format.scm is in gauche 0.9.1-5.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 | ;; srfi-29.format - srfi-29 compatible 'format'.
;; Taken from srfi-29 reference implementation.
;;
;; Copyright (C) Scott G. Miller (2002). All Rights Reserved.
;;
;; This document and translations of it may be copied and furnished to
;; others, and derivative works that comment on or otherwise explain it
;; or assist in its implementation may be prepared, copied, published and
;; distributed, in whole or in part, without restriction of any kind,
; provided that the above copyright notice and this paragraph are
;; included on all such copies and derivative works. However, this
;; document itself may not be modified in any way, such as by removing
;; the copyright notice or references to the Scheme Request For
;; Implementation process or editors, except as needed for the purpose
;; of developing SRFIs in which case the procedures for copyrights
;; defined in the SRFI process must be followed, or as required to
;; translate it into languages other than English.
;;
;; The limited permissions granted above are perpetual and will not be
;; revoked by the authors or their successors or assigns.
;;
;; This document and the information contained herein is provided on an
;; "AS IS" basis and THE AUTHOR AND THE SRFI EDITORS DISCLAIM ALL
;; WARRANTIES, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO ANY
;; WARRANTY THAT THE USE OF THE INFORMATION HEREIN WILL NOT INFRINGE
;; ANY RIGHTS OR ANY IMPLIED WARRANTIES OF MERCHANTABILITY OR FITNESS
;; FOR A PARTICULAR PURPOSE
(define-module srfi-29.format
(export format))
(select-module srfi-29.format)
(define (format format-string . objects)
(let ((buffer (open-output-string)))
(let loop ((format-list (string->list format-string))
(objects objects)
(object-override #f))
(cond ((null? format-list) (get-output-string buffer))
((char=? (car format-list) #\~)
(cond ((null? (cdr format-list))
(error 'format "Incomplete escape sequence"))
((char-numeric? (cadr format-list))
(let posloop ((fl (cddr format-list))
(pos (string->number
(string (cadr format-list)))))
(cond ((null? fl)
(error 'format "Incomplete escape sequence"))
((and (eq? (car fl) '#\@)
(null? (cdr fl)))
(error 'format "Incomplete escape sequence"))
((and (eq? (car fl) '#\@)
(eq? (cadr fl) '#\*))
(loop (cddr fl) objects (list-ref objects pos)))
(else
(posloop (cdr fl)
(+ (* 10 pos)
(string->number
(string (car fl)))))))))
(else
(case (cadr format-list)
((#\a)
(cond (object-override
(begin
(display object-override buffer)
(loop (cddr format-list) objects #f)))
((null? objects)
(error 'format "No value for escape sequence"))
(else
(begin
(display (car objects) buffer)
(loop (cddr format-list)
(cdr objects) #f)))))
((#\s)
(cond (object-override
(begin
(display object-override buffer)
(loop (cddr format-list) objects #f)))
((null? objects)
(error 'format "No value for escape sequence"))
(else
(begin
(write (car objects) buffer)
(loop (cddr format-list)
(cdr objects) #f)))))
((#\%)
(if object-override
(error 'format "Escape sequence following positional override does not require a value"))
(display #\newline buffer)
(loop (cddr format-list) objects #f))
((#\~)
(if object-override
(error 'format "Escape sequence following positional override does not require a value"))
(display #\~ buffer)
(loop (cddr format-list) objects #f))
(else
(error 'format "Unrecognized escape sequence"))))))
(else (display (car format-list) buffer)
(loop (cdr format-list) objects #f))))))
|