Changeset 9261 in project


Ignore:
Timestamp:
03/07/08 20:33:23 (12 years ago)
Author:
Kon Lovett
Message:

Save.

File:
1 edited

Legend:

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

    r4845 r9261  
    2626;
    2727; - W control support. Will subsume Y control. (See SRFI-38.)
     28;
     29; - :^ control support.
    2830
    2931(require-extension (srfi 1) (srfi 9))
     
    3133(cond-expand
    3234  (chicken
     35    (eval-when (compile)
     36      (declare
     37        (generic)
     38        (inline)
     39        (not usual-integrations
     40          ; So utf8 & full-numeric-tower extensions can override.
     41          ; Many of these are not 'integrated', but are for exposition.
     42          ;
     43          ; Numbers
     44          number->string string->number
     45          inexact->exact exact->inexact
     46          quotient remainder
     47          log
     48          abs floor ceiling
     49          negative? zero? positive?
     50          number?
     51          complex? real? integer?
     52          rational?
     53          + - * /
     54          = < <= > >=
     55          make-rectangular real-part imag-part
     56          ; Characters
     57          char-numeric? char-whitespace? char-alphabetic?
     58          char-upcase char-downcase
     59          ; Character-Sets
     60          char-set-contains? char-set:graphic
     61          ;; I/O
     62          write-char
     63          write-string
     64          ; Strings
     65          substring substring-index
     66          string->list
     67          string-ref string-length
     68          string-map! string-copy string-index)
     69        (no-procedure-checks-for-usual-bindings)
     70        (import
     71          make-rectangular)
     72        (bound-to-procedure
     73          make-rectangular
     74          ; Forward declaration
     75          formatter-error start-iteration)
     76        (unused
     77          state?
     78          iterator?)
     79        (export
     80          ; Configuration Variables
     81          ; SLIB compatibility
     82          format:floats
     83          format:complex
     84          format:expch
     85          format:iteration-bounded
     86          format:max-iterations
     87          ; Pre-defined formatters
     88          ;   By category
     89          *formatter-params*
     90          *formatter-iteration*
     91          *formatter-caseconv*
     92          *formatter-chars*
     93          *formatter-numbers*
     94          *formatter-cond*
     95          *formatter-indirection*
     96          *formatter-jump*
     97          *formatter-objs*
     98          *formatter-flush*
     99          *formatter-plural*
     100          *formatter-tabulate*
     101          ;   All
     102          *formatter-cl*
     103          ; Procedures
     104          ;   Buffered output
     105          *formatter-out-char
     106          *formatter-out-char-times
     107          *formatter-out-char-list
     108          *formatter-out-string
     109          ;   Maker
     110          make-format-function
     111          ;   Standard replacement
     112          format
     113          ; Convenience functions to simplify the creation of new
     114          ; format-functions.
     115          formatter-padded
     116          formatter-function) ) )
    33117    (use srfi-13 srfi-14 lolevel)
    34     (use srfi-29)
    35   ) (else
    36   ) )
    37 
    38 #+chicken
    39 (eval-when (compile)
    40   (declare
    41     (generic)
    42     (inline)
    43     (not usual-integrations
    44       ; So utf8 & full-numeric-tower extensions can override.
    45       ; Many of these are not 'integrated', but are for exposition.
    46       ;
    47       ; Numbers
    48       number->string string->number
    49       inexact->exact exact->inexact
    50       quotient remainder
    51       log
    52       abs floor ceiling
    53       negative? zero? positive?
    54       number?
    55       complex? real? integer?
    56       rational?
    57       + - * /
    58       = < <= > >=
    59       make-rectangular real-part imag-part
    60       ; Characters
    61       char-numeric? char-whitespace? char-alphabetic?
    62       char-upcase char-downcase
    63       ; Character-Sets
    64       char-set-contains? char-set:graphic
    65       ;; I/O
    66       write-char
    67       write-string
    68       ; Strings
    69       substring substring-index
    70       string->list
    71       string-ref string-length
    72       string-map! string-copy string-index)
    73     (no-procedure-checks-for-usual-bindings)
    74     (import
    75       make-rectangular)
    76     (bound-to-procedure
    77       make-rectangular
    78       ; Forward declaration
    79       formatter-error start-iteration)
    80     (unused
    81       fm$state?
    82       fm$iterator?)
    83     (export
    84       ; Configuration Variables
    85       ; SLIB compatibility
    86       format:floats
    87       format:complex
    88       format:expch
    89       format:iteration-bounded
    90       format:max-iterations
    91       ; Pre-defined formatters
    92       ;   By category
    93       *formatter-params*
    94       *formatter-iteration*
    95       *formatter-caseconv*
    96       *formatter-chars*
    97       *formatter-numbers*
    98       *formatter-cond*
    99       *formatter-indirection*
    100       *formatter-jump*
    101       *formatter-objs*
    102       *formatter-flush*
    103       *formatter-plural*
    104       *formatter-tabulate*
    105       ;   All
    106       *formatter-cl*
    107       ; Procedures
    108       *formatter-out-char
    109       *formatter-out-char-times
    110       *formatter-out-char-list
    111       *formatter-out-string
    112       make-format-function
    113       format
    114       ; Convenience functions to simplify the creation of new
    115       ; format-functions.
    116       formatter-padded
    117       formatter-function) ) )
    118 
    119 #+chicken
    120 #; ; already registered by extras unit
     118    (use srfi-29) )
     119  (else) )
     120
     121;;;
     122
    121123(register-feature! 'srfi-28)
    122124
     
    200202    (set! *cardinal-hundred* (item@ *cardinal-hundred*))
    201203    (set! *ordinal-ones* (localized-vector *ordinal-ones*))
    202     (set! *ordinal-tens* (localized-vector *ordinal-tens*))
    203 
    204   ) (else
     204    (set! *ordinal-tens* (localized-vector *ordinal-tens*)) )
     205
     206  (else
    205207
    206208    (define *cardinal-ones*
     
    230232    (define *ordinal-tens*
    231233      '#("" "tenth" "twentieth" "thirtieth" "fortieth" "fiftieth" "sixtieth"
    232             "seventieth" "eightieth" "ninetieth"))
    233 
    234   ) )
     234            "seventieth" "eightieth" "ninetieth")) ) )
    235235
    236236;;; State record
     
    342342; function of the C programming language--, #\%).
    343343
    344 (define-record-type fm$state
     344(define-record-type state
    345345  (make-state out obj objpos caseconv caseconv-depth colpos condskip fmt fmtpos fmtend iterate nest table escape)
    346   fm$state?
     346  state?
    347347  (out state-out #;state-out-set!)
    348348  (obj state-obj state-obj-set!)
     
    503503              (*formatter-out-char state char))
    504504            ((fx< 0 times)
    505               (*formatter-out-string state (times+char-memeoize times char))) ) ) ) )
    506 
    507   ) (else
     505              (*formatter-out-string state (times+char-memeoize times char))) ) ) ) ) )
     506
     507  (else
    508508
    509509    ; Output n repetitions of a char.
     
    520520        (do ((i 0 (fx+ i 1)))
    521521            ((fx= i strlen))
    522           (*formatter-out-char state (string-ref str i)) ) ) )
    523   ) )
     522          (*formatter-out-char state (string-ref str i)) ) ) ) ) )
    524523
    525524; Tabbing
     
    731730; present in the escape sequence that started the iteration.
    732731
    733 (define-record-type fm$iterator
     732(define-record-type iterator
    734733  (make-iterator fmt fmtpos-start fmtpos-end fmtend itobj itobjpos runs maxruns obj objpos atsign colon)
    735   fm$iterator?
     734  iterator?
    736735  (fmt iterator-fmt #;iterator-fmt-set!)
    737736  (fmtpos-start iterator-fmtpos-start iterator-fmtpos-start-set!)
     
    16371636        (formatter-error "cannot specify both : and @ for ~*")
    16381637        ((if atsign state-objpos-set! state-objpos-inc!)
    1639          state ((if colon - +) n))))))
     1638         state (if colon (- n) n)) ) ) ) )
    16401639
    16411640;`~*'
     
    16831682                  ((fx<= strlen 2)  (out-hex-char #\x 2))
    16841683                  ((fx<= strlen 4)  (out-hex-char #\u 4))
    1685                   (else             (out-hex-char #\U 8))) ) ) ) ) ) )
    1686 
    1687   ) (else
     1684                  (else             (out-hex-char #\U 8))) ) ) ) ) ) ) )
     1685
     1686  (else
    16881687
    16891688    (define (out-char-lisp state char)
     
    16931692        ((#\space) (*formatter-out-string state "space"))
    16941693        ((#\tab) (*formatter-out-string state "tab"))
    1695         (else (*formatter-out-char state char))))
    1696 
    1697   ) )
     1694        (else (*formatter-out-char state char)))) ) )
    16981695
    16991696(define (out-char-emacs state char)
     
    18691866; The following are known to be missing:
    18701867; <>
     1868;
     1869; The following are known to be incompatible:
     1870; /I
    18711871;
    18721872; If you know of another unsupported standard escape sequence, please contact
Note: See TracChangeset for help on using the changeset viewer.