/usr/share/scsh-0.6/big/format.scm is in scsh-common-0.6 0.6.7-8.
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 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 | ; Copyright (c) 1993-1999 by Richard Kelsey and Jonathan Rees. See file COPYING.
; Quicky FORMAT
;
; (FORMAT port string . args)
;
; PORT is one of:
; an output port, in which case FORMAT prints to the port;
; #T, FORMAT prints to the current output port;
; #F, FORMAT returns a string.
;
; The following format directives have been implemented:
; ~~ -prints a single ~
; ~A -prints the next argument using DISPLAY
; ~D -prints the next argument using NUMBER->STRING (`D'ecimal)
; ~S -prints the next argument using WRITE
; ~% -prints a NEWLINE character
; ~& -prints a NEWLINE character if the previous printed character was not one
; (this is implemented using FRESH-LINE)
; ~? -performs a recursive call to FORMAT using the next two arguments as the
; string and the list of arguments
;
; FORMAT is case-insensitive with respect to letter directives (~a and ~A have
; the same effect).
; The entry point. Gets the port and writes the output.
; Get the appropriate writer for the port specification.
(define (format port string . args)
(cond ((not port)
(call-with-string-output-port
(lambda (port)
(real-format port string args))))
((eq? port #t)
(real-format (current-output-port) string args))
((output-port? port)
(real-format port string args))
(else
(error "invalid port argument to FORMAT" port))))
; Loop down the format string printing characters and dispatching on directives
; as required. Procedures for the directives are in a vector indexed by
; character codes. Each procedure takes four arguments: the format string,
; the index of the next unused character in the format string, the list of
; remaining arguments, and the writer. Each should return a list of the unused
; arguments.
(define (real-format out string all-args)
(let loop ((i 0) (args all-args))
(cond ((>= i (string-length string))
(if (null? args)
#f
(error "too many arguments to FORMAT" string all-args)))
((char=? #\~ (string-ref string i))
(if (= (+ i 1) (string-length string))
(error "invalid format string" string i)
(loop (+ i 2)
((vector-ref format-dispatch-vector
(char->ascii (string-ref string (+ i 1))))
string
(+ i 2)
args
out))))
(else
(write-char (string-ref string i) out)
(loop (+ i 1) args)))))
; One more than the highest integer that CHAR->ASCII may return.
(define number-of-char-codes ascii-limit)
; The vector of procedures implementing format directives.
(define format-dispatch-vector
(make-vector number-of-char-codes
(lambda (string i args out)
(error "illegal format command"
string
(string-ref string (- i 1))))))
; This implements FORMAT's case-insensitivity.
(define (define-format-command char proc)
(vector-set! format-dispatch-vector (char->ascii char) proc)
(if (char-alphabetic? char)
(vector-set! format-dispatch-vector
(char->ascii (if (char-lower-case? char)
(char-upcase char)
(char-downcase char)))
proc)))
; Write a single ~ character.
(define-format-command #\~
(lambda (string i args out)
(write-char #\~ out)
args))
; Newline
(define-format-command #\%
(lambda (string i args out)
(newline out)
args))
; Fresh-Line
(define-format-command #\&
(lambda (string i args out)
(fresh-line out)
args))
; Display (`A' is for ASCII)
(define-format-command #\a
(lambda (string i args out)
(check-for-format-arg args)
(display (car args) out)
(cdr args)))
; Decimals
(define-format-command #\d
(lambda (string i args out)
(check-for-format-arg args)
(if (not (number? (car args)))
(error "invalid number argument to ~D in FORMAT" string (car args)))
(display (number->string (car args) 10) out)
(cdr args)))
; Write (`S' is for S-expression)
(define-format-command #\s
(lambda (string i args out)
(check-for-format-arg args)
(write (car args) out)
(cdr args)))
; Recursion
(define-format-command #\?
(lambda (string i args out)
(check-for-format-arg args)
(check-for-format-arg (cdr args))
(real-format out (car args) (cadr args))
(cddr args)))
; Signal an error if ARGS is empty.
(define (check-for-format-arg args)
(if (null? args)
(error "insufficient number of arguments to FORMAT")))
|