Changeset 9401 in project


Ignore:
Timestamp:
03/10/08 17:56:32 (12 years ago)
Author:
Kon Lovett
Message:

Save.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/3/format-modular/trunk/format-modular.scm

    r9384 r9401  
    137137(define (complex-strict? num)
    138138  (and (complex? num)
    139        (not (or (real? num) (rational? num) (integer? num)))) )
     139       (not (or (real? num) (rational? num) (integer? num))) ) )
    140140
    141141;;; Configuration
     
    385385(define (formatter-unknown-control-error state . rest)
    386386  (formatter-error "Unknown control character"
    387     (string-ref (state-fmt state) (fx- (state-fmtpos state) 1))) )
     387                   (string-ref (state-fmt state) (fx- (state-fmtpos state) 1))) )
    388388
    389389; Are we in a valid position in the format string, where we are
     
    429429
    430430(define (state-nest-push! state char)
    431   (state-nest-set! state (cons char (state-nest state))))
     431  (state-nest-set! state (cons char (state-nest state))) )
    432432
    433433(define (state-nest-pop! state char)
    434434  (assert (not (null? (state-nest state))))
    435435  (unless (eqv? (car (state-nest state)) char)
    436     (formatter-error "Improper nesting for character" char))
     436    (formatter-error "Improper nesting for character" char) )
    437437  (state-nest-set! state (cdr (state-nest state))) )
    438438
     
    444444(define (*formatter-out-char state char)
    445445  (state-colpos-set! state
    446     (if (char=? char #\newline) 0 (fx+ 1 (state-colpos state))))
     446                     (if (char=? char #\newline)
     447                         0
     448                         (fx+ 1 (state-colpos state))))
    447449  (write-char ((state-caseconv state) char) (state-out state)) )
    448450
     
    500502               (fixnum+char-hash
    501503                (lambda (fixnum+char #!optional (bound 536870912))
    502                   (fxmod (fxior (fxshl (char->integer (second fixnum+char)) 10) (first fixnum+char)) bound) ) )
     504                  (fxmod (fxior (fxshl (char->integer (second fixnum+char)) 10)
     505                                (first fixnum+char))
     506                         bound) ) )
    503507               (ht (make-hash-table fixnum+char-eq? fixnum+char-hash))
    504508               (times+char-memeoize
     
    510514        (lambda (state times char)
    511515          (cond ((not state)
    512                   (set! ht (make-hash-table fixnum+char-eq? fixnum+char-hash)))
     516                 (set! ht (make-hash-table fixnum+char-eq? fixnum+char-hash)))
    513517                ((fx= 1 times)
    514                   (*formatter-out-char state char))
     518                 (*formatter-out-char state char))
    515519                ((fx< 0 times)
    516                   (*formatter-out-string state (times+char-memeoize times char))) ) ) ) ) )
     520                 (*formatter-out-string state (times+char-memeoize times char))) ) ) ) ) )
    517521
    518522  (else
     
    536540
    537541(define (tabulate state colnum colinc atsign tabchar)
    538   (*formatter-out-char-times state
    539     (fx+ (if atsign colnum 0)
    540        (cond ((and (not atsign) (fx< (state-colpos state) colnum))
    541                (fx- colnum (state-colpos state)))
    542              ((fx= 0 colinc)
    543                0)
    544              (else
    545                (let ((mod (fxmod (fx+ (if atsign colnum 0) (state-colpos state)) colinc)))
    546                  (if (fx= 0 mod) 0 (fx- colinc mod))))))
    547      tabchar) )
     542  (*formatter-out-char-times
     543   state
     544   (fx+ (if atsign colnum 0)
     545        (cond ((and (not atsign) (fx< (state-colpos state) colnum))
     546               (fx- colnum (state-colpos state)) )
     547              ((fx= 0 colinc)
     548               0 )
     549              (else
     550               (let ((mod (fxmod (fx+ (if atsign colnum 0) (state-colpos state))
     551                                 colinc)))
     552                 (if (fx= 0 mod)
     553                     0
     554                     (fx- colinc mod) ) ) ) ) )
     555   tabchar) )
    548556
    549557;;; Parsing of format strings
     
    561569           (state-fmtpos-set! state (fx+ 1 (state-fmtpos state)))
    562570           ((vector-ref (state-table state) (char->integer (string-ref fmt pos)))
    563              state start params colon atsign) )
     571            state start params colon atsign) )
    564572          (else
    565             (*formatter-out-char state #\~) ) ) ) )
     573           (*formatter-out-char state #\~) ) ) ) )
    566574
    567575; Process the entire format string; when done, call the first
     
    618626                     (apply formatter #f out args) )
    619627                    ((output-port? out)
    620                       (unless (pair? args)
    621                         (formatter-error "bad argument count - received 1 but expected 2" formatter) )
    622                       (format-parse
    623                         (make-default-state table escape out (car args) (cdr args))) )
     628                     (unless (pair? args)
     629                       (formatter-error "bad argument count - received 1 but expected 2" formatter) )
     630                     (format-parse
     631                       (make-default-state table escape out (car args) (cdr args))) )
    624632                    (else
    625                       (formatter-error "invalid destination" out) ) ) ) ) )
     633                     (formatter-error "invalid destination" out) ) ) ) ) )
    626634    formatter ) )
    627635
     
    634642  (lambda (state start params colon atsign)
    635643    (when (cond-valid? state)
    636       (func state start (reverse params) colon atsign))))
     644      (func state start (reverse params) colon atsign) ) ) )
    637645
    638646;;; Formatter supporting basic arguments
     
    658666          (fx+ newpos 1)
    659667          newpos)) )
    660   (format-escape state start (cons new params) colon atsign))
     668  (format-escape state start (cons new params) colon atsign) )
    661669
    662670; Given a string FMT and a position I, return the smallest
     
    668676    (if (or (char-numeric? c) (char=? c #\+) (char=? c #\-))
    669677        (skip-number fmt (fx+ i 1))
    670         i)))
     678        i ) ) )
    671679
    672680; Formatter function to call when the escape character is
     
    677685  (let ((newpos (skip-number (state-fmt state) (state-fmtpos state))))
    678686    (apply add-param state start
    679       (fx- newpos (state-fmtpos state))
    680       (string->number (substring (state-fmt state) (fx- (state-fmtpos state) 1) newpos))
    681       rest)))
     687                     (fx- newpos (state-fmtpos state))
     688                     (string->number (substring (state-fmt state)
     689                                                (fx- (state-fmtpos state) 1)
     690                                                newpos))
     691                     rest) ) )
    682692
    683693; Now define a list that can be used to create format functions
     
    708718    (#\7 ,numeric-arg)
    709719    (#\8 ,numeric-arg)
    710     (#\9 ,numeric-arg)))
     720    (#\9 ,numeric-arg) ) )
    711721
    712722;;; Iteration
     
    879889               (iterator-maxruns-set! (car (state-iterate state)) 0)
    880890               (state-condskip-pop! state)
    881                (state-condskip-push! state -1)))))))
     891               (state-condskip-push! state -1) ) ) ) ) ) )
    882892
    883893;`~{STR~}'
     
    909919  `((#\{ ,formatter-iteration-start)
    910920    (#\} ,formatter-iteration-end)
    911     (#\^ ,(formatter-iteration-up-and-out))))
     921    (#\^ ,(formatter-iteration-up-and-out))) )
    912922
    913923;;; Case conversion
     
    930940               (set! current inner))
    931941              (else
    932                 (set! current start-rest)
    933                 (set! inner inner-rest)))
    934         (func c)))))
     942               (set! current start-rest)
     943               (set! inner inner-rest)))
     944        (func c) ) ) ) )
    935945
    936946(define (formatter-caseconv-start state start params colon atsign)
     
    944954          (and atsign colon)      ; Uppercase subsequent letters of 1st word?
    945955          (and atsign colon))))   ; Uppercase subsequent letters of subsequent words?
    946     (state-caseconv-depth-set! state (fx+ 1 (state-caseconv-depth state)))))
     956    (state-caseconv-depth-set! state (fx+ 1 (state-caseconv-depth state))) ) )
    947957
    948958(define (formatter-caseconv-end state start params colon atsign)
     
    951961    (state-caseconv-depth-set! state (fx- 1 (state-caseconv-depth state)))
    952962    (when (fx= 0 (state-caseconv-depth state))
    953       (state-caseconv-set! state identity))))
     963      (state-caseconv-set! state identity) ) ) )
    954964
    955965; `~(str~)'
     
    966976(define *formatter-caseconv*
    967977  `((#\( ,formatter-caseconv-start)
    968     (#\) ,formatter-caseconv-end)))
     978    (#\) ,formatter-caseconv-end)) )
    969979
    970980;;; Printing control characters
     
    974984    (lambda (state start params colon atsign)
    975985      (let-optionals params ((times 1))
    976         (*formatter-out-char-times state times output)))))
     986        (*formatter-out-char-times state times output) ) ) ) )
    977987
    978988(define (formatter-chars-newline-if)
     
    983993                   (fx< 0 (state-colpos state)))
    984994          (*formatter-out-char state #\newline))
    985         (*formatter-out-char-times state (fx- times 1) #\newline)))))
     995        (*formatter-out-char-times state (fx- times 1) #\newline) ) ) ) )
    986996
    987997(define (formatter-chars-skip-whitespace)
     
    10051015                          (*formatter-out-char state char))
    10061016                        (loop (fx+ fmtpos 1)))
    1007                       fmtpos)))))))))
     1017                      fmtpos ) ) ) ) ) ) ) ) )
    10081018
    10091019; `~%'
     
    10561066    (#\~ ,(formatter-chars #\~))
    10571067    (#\_ ,(formatter-chars #\space))
    1058     (#\newline ,(formatter-chars-skip-whitespace))))
     1068    (#\newline ,(formatter-chars-skip-whitespace))) )
    10591069
    10601070;;; Printing numbers
     
    10631073
    10641074(define *roman-numerals*
    1065   '((1000 #\M) (500 #\D) (100 #\C) (50 #\L) (10 #\X) (5 #\V) (1 #\I)))
     1075  '((1000 #\M) (500 #\D) (100 #\C) (50 #\L) (10 #\X) (5 #\V) (1 #\I)) )
    10661076
    10671077;;
     
    10911101                  (else
    10921102                    result) ) ) ) )
    1093       result) )
     1103      result ) )
    10941104
    10951105;; Pull numbers from the argument list
     
    11251135    (if (and always-sign (not (negative? number)))
    11261136        (cons #\+ tail)
    1127         tail)))
     1137        tail ) ) )
    11281138
    11291139(define (format-roman-old state num)
     
    11311141    (let ((sub (find (lambda (x) (>= num (car x))) *roman-numerals*)))
    11321142      (*formatter-out-char state (cadr sub))
    1133       (format-roman-old state (- num (car sub))))))
     1143      (format-roman-old state (- num (car sub))) ) ) )
    11341144
    11351145(define (format-roman state num)
     
    11461156                    (*formatter-out-char state (cadr big))
    11471157                    (format-roman state (- num (- big-n (car c))))))
    1148               (else (loop (cdr ls))))))))
     1158              (else
     1159               (loop (cdr ls)) ) ) ) ) ) )
    11491160
    11501161(define (format-number-english func zero)
    11511162  (lambda (state num)
    1152     (cond ((not (integer? num)) (formatter-error "invalid integer" num))
    1153           ((zero? num) (*formatter-out-string state zero))
     1163    (cond ((not (integer? num))
     1164           (formatter-error "invalid integer" num))
     1165          ((zero? num)
     1166           (*formatter-out-string state zero))
    11541167          ((negative? num)
    11551168           (*formatter-out-string state "minus ")
    11561169           (func state (- num)))
    1157           (else (func state num)))))
     1170          (else
     1171           (func state num) ) ) ) )
    11581172
    11591173;; Cardinal formatting
     
    11631177      '()
    11641178      (cons (cons (remainder num 1000) pow)
    1165             (initial-pows (quotient num 1000) (+ pow 1)))))
     1179            (initial-pows (quotient num 1000) (+ pow 1))) ) )
    11661180
    11671181; Show a number between 0 and 20
    11681182
    11691183(define (format-cardinal-20 state num)
    1170   (*formatter-out-string state (vector-ref *cardinal-ones* num)))
     1184  (*formatter-out-string state (vector-ref *cardinal-ones* num)) )
    11711185
    11721186; Show a number between 0 and 100
     
    11741188(define (format-cardinal-100 state num)
    11751189  (cond ((< num 20)
    1176           (format-cardinal-20 state num))
     1190         (format-cardinal-20 state num))
    11771191        (else
    1178           (*formatter-out-string state (vector-ref *cardinal-tens* (quotient num 10)))
    1179           (let ((ones (remainder num 10)))
    1180             (unless (zero? ones)
    1181               (unless (zero? (quotient num 10))
    1182                 (*formatter-out-char state #\-))
    1183               (format-cardinal-20 state ones))))))
     1192         (*formatter-out-string state (vector-ref *cardinal-tens* (quotient num 10)))
     1193         (let ((ones (remainder num 10)))
     1194           (unless (zero? ones)
     1195             (unless (zero? (quotient num 10))
     1196               (*formatter-out-char state #\-) )
     1197             (format-cardinal-20 state ones) ) ) ) ) )
    11841198
    11851199; Show a number between 0 and 1000
     
    11891203    (unless (zero? hundreds)
    11901204      (format-cardinal-20 state hundreds)
    1191       (*formatter-out-string state *cardinal-hundred*))
     1205      (*formatter-out-string state *cardinal-hundred*) )
    11921206    (unless (zero? rest)
    11931207      (unless (zero? hundreds)
    1194         (*formatter-out-char state #\space))
    1195       (format-cardinal-100 state rest))))
     1208        (*formatter-out-char state #\space) )
     1209      (format-cardinal-100 state rest) ) ) )
    11961210
    11971211(define (format-cardinal-positive state num)
     
    12001214      (unless (zero? (caar pows))
    12011215        (unless start
    1202           (*formatter-out-string state ", "))
     1216          (*formatter-out-string state ", ") )
    12031217        (format-cardinal-1000 state (caar pows))
    12041218        (*formatter-out-string state (vector-ref *thousand-factor-names* (cdar pows))))
    1205       (loop (cdr pows) #f))))
     1219      (loop (cdr pows) #f) ) ) )
    12061220
    12071221(define format-cardinal
    1208   (format-number-english format-cardinal-positive "zero"))
     1222  (format-number-english format-cardinal-positive "zero") )
    12091223
    12101224;; Ordinal formatting
     
    12131227
    12141228(define (format-ordinal-20 state num)
    1215   (*formatter-out-string state (vector-ref *ordinal-ones* num)))
     1229  (*formatter-out-string state (vector-ref *ordinal-ones* num)) )
    12161230
    12171231(define (format-ordinal-positive state num)
    12181232  (cond ((>= num 100)
    1219           (format-cardinal-positive state (* (quotient num 100) 100))
    1220           (let ((rest (remainder num 100)))
    1221             (unless (zero? rest)
    1222               (*formatter-out-char state #\space)
    1223               (format-ordinal-positive state rest))))
     1233         (format-cardinal-positive state (* (quotient num 100) 100))
     1234         (let ((rest (remainder num 100)))
     1235           (unless (zero? rest)
     1236             (*formatter-out-char state #\space)
     1237             (format-ordinal-positive state rest) ) ) )
    12241238        ((< num 20)
    1225           (format-ordinal-20 state num))
     1239          (format-ordinal-20 state num) )
    12261240        (else
    12271241          (let ((tens (quotient num 10))
    12281242                (ones (remainder num 10)))
    12291243            (cond ((zero? ones)
    1230                     (*formatter-out-string state (vector-ref *ordinal-tens* tens)))
     1244                   (*formatter-out-string state (vector-ref *ordinal-tens* tens)))
    12311245                  (else
    1232                     (*formatter-out-string state (vector-ref *cardinal-tens* tens))
    1233                     (*formatter-out-char state #\-)
    1234                     (*formatter-out-string state (vector-ref *ordinal-ones* ones))))))))
     1246                   (*formatter-out-string state (vector-ref *cardinal-tens* tens))
     1247                   (*formatter-out-char state #\-)
     1248                   (*formatter-out-string state (vector-ref *ordinal-ones* ones)) ) ) ) ) ) )
    12351249
    12361250(define format-ordinal
    1237   (format-number-english format-ordinal-positive "zeroth"))
     1251  (format-number-english format-ordinal-positive "zeroth") )
    12381252
    12391253;; Integer formatting
     
    12431257    (let ((num (get-number state 1)))
    12441258      (if (integer? num)
    1245           (let ((result (add-comma (and colon (or commachar #\,)) (or commawidth 3) (number-list num atsign base))))
    1246             (*formatter-out-char-times state (fxmax 0 (fx- (or mincol 0) (length result))) (or pad-char #\space))
     1259          (let ((result (add-comma (and colon (or commachar #\,))
     1260                                   (or commawidth 3)
     1261                                   (number-list num atsign base))))
     1262            (*formatter-out-char-times state
     1263                                       (fxmax 0 (fx- (or mincol 0) (length result)))
     1264                                       (or pad-char #\space))
    12471265            (*formatter-out-char-list state result) )
    12481266          ; This ignores the radix but the CL spec isn't clear on this except for ~D
    1249           (format-string/padding (with-output-to-string (lambda () (display num))) state colon atsign mincol #f #f pad-char) ) ) ) )
     1267          (format-string/padding (with-output-to-string (lambda () (display num)))
     1268                                 state colon atsign mincol #f #f pad-char) ) ) ) )
    12501269
    12511270(define (make-formatter-integer/radix base)
     
    12801299                                  (if (zero? number) number (ceiling (log10 number)))
    12811300                                  1)))))
    1282         (/ (round (* number mult)) mult))
    1283       number))
     1301        (/ (round (* number mult)) mult) )
     1302      number ) )
    12841303
    12851304; Given a positive fixed float number, return a list with the digits of its
     
    13071326            result))
    13081327      middle
    1309       tail)))
     1328      tail) ) )
    13101329
    13111330; Given a fixed float number, return a list with the digits of its
     
    13431362              (make-list (fxmax 0 (fx- exp-digits (length expo-list))) #\0)
    13441363              '())
    1345           expo-list))))
     1364          expo-list) ) ) )
    13461365
    13471366; Given a positive fixed float number, return a list with the digits of its
     
    13791398                   (*formatter-out-char-times state width overflow-ch) )
    13801399                  (else
    1381                     (when width
    1382                       (*formatter-out-char-times state (fxmax 0 (fx- width len)) (or pad-char #\space)))
    1383                     (*formatter-out-char-list state result) ) ) ) ) ) ) )
     1400                   (when width
     1401                     (*formatter-out-char-times state (fxmax 0 (fx- width len)) (or pad-char #\space)))
     1402                   (*formatter-out-char-list state result) ) ) ) ) ) ) )
    13841403
    13851404(define (formatter-fixed-float state start params colon atsign)
     
    14051424                   (tabulate state ee 1 #t (or pad-char #\space)) )
    14061425                  (else
    1407                     (formatter-exponential state start params colon atsign) ) ) ) ) ) ) )
     1426                   (formatter-exponential state start params colon atsign) ) ) ) ) ) ) )
    14081427
    14091428(define (formatter-dollar state start params colon atsign)
     
    15631582    (#\E ,(formatter-function formatter-exponential))
    15641583    (#\$ ,(formatter-function formatter-dollar))
    1565     (#\I ,(formatter-function formatter-complex))))
     1584    (#\I ,(formatter-function formatter-complex))) )
    15661585
    15671586;;; Conditional Expressions
     
    15701589  (state-nest-push! state #\[)
    15711590  (state-condskip-push! state
    1572     (cond ((not (cond-valid? state)) -1) ; If not on a valid state, use -1 so it will never become valid.
    1573           (colon  (if (state-obj-ref state 1) 1 0))
    1574           (atsign (if (%state-obj-ref state) 0 (begin (state-objpos-inc! state 1) -1)))
    1575           ((null? params) (state-obj-ref state 1))
    1576           (else (car params)))))
     1591    (cond ((not (cond-valid? state))
     1592           ; If not on a valid state, use -1 so it will never become valid.
     1593           -1 )
     1594          (colon
     1595           (if (state-obj-ref state 1)
     1596               1
     1597               0 ) )
     1598          (atsign
     1599           (if (%state-obj-ref state)
     1600               0
     1601               (begin
     1602                 (state-objpos-inc! state 1)
     1603                 -1 ) ) )
     1604          ((null? params)
     1605           (state-obj-ref state 1) )
     1606          (else
     1607           (car params) ) ) ) )
    15771608
    15781609(define (formatter-cond-next state start params colon atsign)
    15791610  (set-car! (state-condskip state)
    15801611    (let ((newval (fx- (car (state-condskip state)) 1)))
    1581       (if colon (fxmin 0 newval) newval))))
     1612      (if colon (fxmin 0 newval) newval ) ) ) )
    15821613
    15831614(define (formatter-cond-end state start params colon atsign)
    15841615  (state-nest-pop! state #\[)
    1585   (state-condskip-pop! state))
     1616  (state-condskip-pop! state) )
    15861617
    15871618;`~[str0~;str1~;...~;strn~]'
     
    16051636  `((#\[ ,formatter-cond-start)
    16061637    (#\; ,formatter-cond-next)
    1607     (#\] ,formatter-cond-end)))
     1638    (#\] ,formatter-cond-end)) )
    16081639
    16091640;;; Indirection
     
    16201651    (unless atsign
    16211652      (state-obj-set! state obj)
    1622       (state-objpos-set! state (fx+ objpos 2)))))
     1653      (state-objpos-set! state (fx+ objpos 2)) ) ) )
    16231654
    16241655(define (formatter-indirection state start params colon atsign)
     
    16301661    (unless atsign
    16311662      (state-obj-set! state (list->vector (state-obj-ref state 1)))
    1632       (state-objpos-set! state 0))))
     1663      (state-objpos-set! state 0) ) ) )
    16331664
    16341665;`~?'
     
    16411672(define *formatter-indirection*
    16421673  `((#\? ,formatter-indirection)
    1643     (#\K ,formatter-indirection)))
     1674    (#\K ,formatter-indirection)) )
    16441675
    16451676;;; Argument jumping
     
    16711702
    16721703(define *formatter-jump*
    1673   `((#\* ,formatter-jump)))
     1704  `((#\* ,formatter-jump)) )
    16741705
    16751706;;; Object output
     
    16821713      (let ((sym (char-name char)))
    16831714        (cond (sym
    1684                 (*formatter-out-string state (symbol->string sym)))
     1715               (*formatter-out-string state (symbol->string sym)))
    16851716              ((char-set-contains? char-set:graphic char)
    1686                 (*formatter-out-char state char))
     1717               (*formatter-out-char state char))
    16871718              (else
    1688                 (let* ((str (number->string (char->integer char) 16))
    1689                        (strlen (string-length str)))
    1690                   (let ((out-hex-char
    1691                         (lambda (prf wid)
    1692                           (*formatter-out-char state prf)
    1693                           (*formatter-out-char-times state (fx- wid strlen) #\0)
    1694                           (*formatter-out-string state str))))
    1695                     (cond ((fx<= strlen 2)  (out-hex-char #\x 2))
    1696                           ((fx<= strlen 4)  (out-hex-char #\u 4))
    1697                           (else             (out-hex-char #\U 8))) ) ) ) ) ) ) )
     1719               (let* ((str (number->string (char->integer char) 16))
     1720                      (strlen (string-length str)))
     1721                 (let ((out-hex-char
     1722                       (lambda (prf wid)
     1723                         (*formatter-out-char state prf)
     1724                         (*formatter-out-char-times state (fx- wid strlen) #\0)
     1725                         (*formatter-out-string state str))))
     1726                   (cond ((fx<= strlen 2)  (out-hex-char #\x 2))
     1727                         ((fx<= strlen 4)  (out-hex-char #\u 4))
     1728                         (else             (out-hex-char #\U 8))) ) ) ) ) ) ) )
    16981729
    16991730  (else
     
    17051736        ((#\space) (*formatter-out-string state "space"))
    17061737        ((#\tab) (*formatter-out-string state "tab"))
    1707         (else (*formatter-out-char state char)))) ) )
     1738        (else (*formatter-out-char state char) ) ) ) ) )
    17081739
    17091740(define (out-char-emacs state char)
     
    17151746           (*formatter-out-string state "#\\")
    17161747           (*formatter-out-string state (number->string c 8)))
    1717           (else (*formatter-out-char state char)))))
     1748          (else
     1749           (*formatter-out-char state char) ) ) ) )
    17181750
    17191751(define (formatter-char state start params colon atsign)
     
    17211753    (let ((char (state-obj-ref state 1)))
    17221754      (assert (char? char))
    1723       ((cond (colon out-char-emacs)
    1724              (atsign out-char-lisp)
    1725              (else *formatter-out-char))
     1755      ((cond (colon   out-char-emacs)
     1756             (atsign  out-char-lisp)
     1757             (else    *formatter-out-char))
    17261758       state
    1727        char))))
     1759       char) ) ) )
    17281760
    17291761; Calculate how many instances of pad-char should be produced.
     
    17321764  (if (fx< (fx+ len n) mincol)
    17331765      (calc-padding (fx+ n colinc) mincol colinc len)
    1734       n))
     1766      n ) )
    17351767
    17361768; Bind control character char to function show-func, used for displaying
     
    17451777  (unless atsign (*formatter-out-string state objstr))
    17461778  (*formatter-out-char-times state (calc-padding (or minpad 0) (or mincol 0) (or colinc 1) (string-length objstr)) (or pad-char #\space))
    1747   (when atsign (*formatter-out-string state objstr)) )
     1779  (when atsign (*formatter-out-string state objstr) ) )
    17481780
    17491781(define (formatter-padded show-func)
     
    17511783    (lambda (state start params colon atsign)
    17521784      (let-optionals params ((mincol 0) (colinc 1) (minpad 0) (pad-char #\space))
    1753         (format-string/padding (with-output-to-string (lambda () (show-func (state-obj-ref state 1)))) state colon atsign mincol colinc minpad pad-char) ) ) ) )
     1785        (format-string/padding (with-output-to-string (lambda () (show-func (state-obj-ref state 1))))
     1786                               state colon atsign mincol colinc minpad pad-char) ) ) ) )
    17541787
    17551788(define (formatter-pretty-print)
    17561789  (formatter-function
    17571790    (lambda (state start params colon atsign)
    1758       (let ((objstr (with-output-to-string (lambda () (pretty-print (state-obj-ref state 1))))))
    1759         (*formatter-out-string state objstr)))))
     1791      (*formatter-out-string state (with-output-to-string (lambda () (pretty-print (state-obj-ref state 1))))) ) ) )
    17601792
    17611793; `~C'
     
    17911823    (#\A ,(formatter-padded display))
    17921824    (#\S ,(formatter-padded write))
    1793     (#\Y ,(formatter-pretty-print))))
     1825    (#\Y ,(formatter-pretty-print))) )
    17941826
    17951827;;; Version info
     
    17991831    (if colon
    18001832        "$Version: 1.8 $"
    1801         "Flexible Format Framework\n$Id: format-modular.scm 1.8 2008-03-07 12:00:00Z klovett $\n  Alejandro Forero Cuervo <azul@freaks-unidos.net>\n  Alex Shinn <foof@synthcode.com>\n  Kon Lovett <klovett@pacbell.net>\n")))
     1833        "Flexible Format Framework\n$Id: format-modular.scm 1.8 2008-03-07 12:00:00Z klovett $\n  Alejandro Forero Cuervo <azul@freaks-unidos.net>\n  Alex Shinn <foof@synthcode.com>\n  Kon Lovett <klovett@pacbell.net>\n") ) )
    18021834
    18031835; `~Q'
     
    18081840
    18091841(define *formatter-version*
    1810   `((#\Q ,formatter-version)))
     1842  `((#\Q ,formatter-version)) )
    18111843
    18121844;;; Flushing output
     
    18141846(define (formatter-flush state . rest)
    18151847  (when (cond-valid? state)
    1816     (flush-output (state-out state))))
     1848    (flush-output (state-out state)) ) )
    18171849
    18181850; `~!'
     
    18201852
    18211853(define *formatter-flush*
    1822   `((#\! ,formatter-flush)))
     1854  `((#\! ,formatter-flush)) )
    18231855
    18241856;;; Plural print
     
    18311863      ((if (eqv? 1 (state-obj-ref state)) car cadr)
    18321864       (if atsign '("y" "ies") '("" "s"))))
    1833     (state-objpos-inc! state)))
     1865    (state-objpos-inc! state) ) )
    18341866
    18351867;`~P'
     
    18451877
    18461878(define *formatter-plural*
    1847   `((#\P ,formatter-plural)))
     1879  `((#\P ,formatter-plural)) )
    18481880
    18491881;;; Tabulation
     
    18531885    (lambda (state start params colon atsign)
    18541886      (let-optionals params ((colnum #f) (colinc #f) (tabchar #\space))
    1855         (tabulate state (or colnum 1) (or colinc 1) atsign (or tabchar #\space))))))
     1887        (tabulate state (or colnum 1) (or colinc 1) atsign (or tabchar #\space)) ) ) ) )
    18561888
    18571889; `~T'
     
    18641896
    18651897(define *formatter-tabulate*
    1866   `((#\T ,formatter-tabulate)))
     1898  `((#\T ,formatter-tabulate)) )
    18671899
    18681900;;; Formatter implementing Common Lisp's format function
     
    19011933    ,*formatter-jump*
    19021934    ,*formatter-objs*
    1903     ,*formatter-version*))
     1935    ,*formatter-version*) )
    19041936
    19051937(define format (make-format-function #f #\~ *formatter-cl*))
Note: See TracChangeset for help on using the changeset viewer.