Changeset 13852 in project


Ignore:
Timestamp:
03/21/09 02:31:41 (12 years ago)
Author:
Kon Lovett
Message:

Added errors file.

Location:
release/3/locale/trunk
Files:
1 added
7 edited

Legend:

Unmodified
Added
Removed

  • release/3/locale/trunk/locale-categories.scm

    r12818 r13852  
    22;;;; Kon Lovett, May '06
    33
    4 (eval-when (compile)
    5   (declare
    6         (usual-integrations)
    7         (fixnum)
    8         (inline)
    9     (no-procedure-checks)
    10     (no-bound-checks)
    11     (export
    12       ;
    13       make-locale-dictionary
    14       locale-dictionary?
    15       set-locale-dictionary-category!
    16       locale-dictionary-category
    17       ;
    18       locale-category-ref
    19       set-locale-category!) ) )
     4(declare
     5  (usual-integrations)
     6  (fixnum)
     7  (inline)
     8  (no-procedure-checks)
     9  (export
     10    ;
     11    make-locale-dictionary
     12    locale-dictionary?
     13    set-locale-dictionary-category!
     14    locale-dictionary-category
     15    ;
     16    locale-category-ref
     17    set-locale-category!) )
    2018
    21 (require-extension
    22   srfi-9
    23   lookup-table
    24   locale-components)
     19(require-extension srfi-9 lookup-table locale-components locale-errors)
     20
     21;;
     22
     23(define (check-symbol loc obj)
     24  (unless (symbol? obj)
     25    (type-error loc "symbol" obj) ) )
     26
    2527
    2628;;;
    … …  
    3941  (check-locale-dictionary 'set-locale-dictionary-category! rec)
    4042  (check-symbol 'set-locale-dictionary-category! key)
    41   (if (not val)
    42       (dict-delete! (locale-dictionary-table rec) key)
     43  (if (not val) (dict-delete! (locale-dictionary-table rec) key)
    4344      (begin
    4445        (check-locale-components 'set-locale-dictionary-category! val)

  • release/3/locale/trunk/locale-components.scm

    r12818 r13852  
    99;; platform specific code. May switch to records later & deprecate the existing interface.
    1010
    11 (eval-when (compile)
    12   (declare
    13         (usual-integrations)
    14         (fixnum)
    15         (inline)
    16     (no-procedure-checks)
    17     (no-bound-checks)
    18     (bound-to-procedure
    19       ##sys#signal-hook)
    20     (export
    21       ;
    22                 make-locale-components
    23       locale-components?
    24       locale-component-ref
    25       set-locale-component!
    26                 update-locale-components!
    27                 ;
    28                 make-timezone-components
    29       timezone-components?
    30       set-timezone-component!
    31       timezone-component-ref
    32                 update-timezone-components!
    33       ;
    34         make-timezone-dst-rule-julian-leap
    35         make-timezone-dst-rule-julian-noleap
    36         make-timezone-dst-rule-mwd
    37         timezone-dst-rule-julian-leap?
    38         timezone-dst-rule-julian-noleap?
    39         timezone-dst-rule-mwd?
    40         timezone-dst-rule-day
    41         timezone-dst-rule-julian
    42         timezone-dst-rule-month
    43         timezone-dst-rule-offset
    44         timezone-dst-rule-week) ) )
    45 
    46 (require-extension
    47   srfi-1)
     11(declare
     12  (usual-integrations)
     13  (fixnum)
     14  (inline)
     15  (no-procedure-checks)
     16  (export
     17    ;
     18    check-locale-components
     19    make-locale-components
     20    locale-components?
     21    locale-component-ref
     22    set-locale-component!
     23    update-locale-components!
     24    ;
     25    check-timezone-components
     26    make-timezone-components
     27    timezone-components?
     28    set-timezone-component!
     29    timezone-component-ref
     30    update-timezone-components!
     31    ;
     32    make-timezone-dst-rule-julian-leap
     33    make-timezone-dst-rule-julian-noleap
     34    make-timezone-dst-rule-mwd
     35    timezone-dst-rule-julian-leap?
     36    timezone-dst-rule-julian-noleap?
     37    timezone-dst-rule-mwd?
     38    timezone-dst-rule-day
     39    timezone-dst-rule-julian
     40    timezone-dst-rule-month
     41    timezone-dst-rule-offset
     42    timezone-dst-rule-week) )
     43
     44(require-extension srfi-1 local-errors)
    4845
    4946;;;
    … …  
    5148;;
    5249
    53 (define (->boolean obj)
    54   (and obj
    55        #t) )
    56 
    57 ;;
    58 
    59 (define (make-exn-condition loc msg . args)
    60   (if (null? args)
    61       (make-property-condition 'exn 'message msg 'location loc)
    62       (make-property-condition 'exn 'message msg 'location loc 'arguments args) ) )
    63 
    64 (define (make-type-error-message typmsg)
    65   (string-append "bad argument type - not " typmsg) )
    66 
    67 (define *type-condition* (make-property-condition 'type))
    68 
    69 (define (make-type-error-condition loc typmsg bad)
    70   (make-composite-condition
    71    (make-exn-condition loc (make-type-error-message typmsg) bad)
    72    *type-condition*) )
    73 
    74 (define (type-error loc typmsg bad)
    75   (abort (make-type-error-condition loc typmsg bad)) )
     50(define-inline (%->boolean obj) (and obj #t))
    7651
    7752;;; Association List Operations
    … …  
    8055
    8156(define (%locale-component-exists? al what)
    82   (->boolean (assq what al)) )
     57  (%->boolean (assq what al)) )
    8358
    8459(define (%locale-component-ref al what . def)
    85         (let ([p (assq what al)])
    86                 (if p
    87         (cdr p)
     60        (let ((p (assq what al)))
     61                (if p (cdr p)
    8862        (optional def #f) ) ) )
    8963
    … …  
    9165
    9266(define (%set-locale-component! al what value)
    93         (let ([p (assq what al)])
     67        (let ((p (assq what al)))
    9468                (cond (p
    9569                        (set-cdr! p value))
    … …  
    10377
    10478(define (%update-locale-components! lc . args)
    105         (let loop ([key-val-lst args])
    106                 (if (null? key-val-lst)
    107                     lc
     79        (let loop ((key-val-lst args))
     80                (if (null? key-val-lst) lc
    10881                    (begin
    10982          (set-locale-component! lc (car key-val-lst) (cadr key-val-lst))
    … …  
    11588
    11689(define (timezone-dst-rule-julian-noleap? r)
    117         (let ([d (car r)])
     90        (let ((d (car r)))
    11891                (and (= 2 (length d)) (= 1 (car d))) ) )
    11992
    … …  
    12194
    12295(define (timezone-dst-rule-julian-leap? r)
    123         (let ([d (car r)])
     96        (let ((d (car r)))
    12497                (and (= 2 (length d)) (= 0 (car d))) ) )
    12598
    … …  
    127100
    128101(define (timezone-dst-rule-mwd? r)
    129         (let ([d (car r)])
     102        (let ((d (car r)))
    130103                (= 3 (length d)) ) )
    131104
    … …  
    180153
    181154(define (make-locale-components nam . args)
    182   (let-optionals args ([src #f] [tag 'locale])
    183     (let ([lc (empty-locale-components)])
     155  (let-optionals args ((src #f) (tag 'locale))
     156    (let ((lc (empty-locale-components)))
    184157      (%set-locale-component! lc 'tag tag)
    185158      (%set-locale-component! lc 'name nam)

  • release/3/locale/trunk/locale-parameters.scm

    r12818 r13852  
    66;; - Only Posix for now.
    77
    8 (eval-when (compile)
    9   (declare
    10         (usual-integrations)
    11         (fixnum)
    12         (inline)
    13     (no-procedure-checks)
    14     (no-bound-checks)
    15     (export
    16       current-locale-dictionary
    17       current-timezone
    18       current-locale
    19       current-timezone-components
    20       current-locale-components) ) )
     8(declare
     9  (usual-integrations)
     10  (fixnum)
     11  (inline)
     12  (no-procedure-checks)
     13  (export
     14    current-locale-dictionary
     15    current-timezone
     16    current-locale
     17    current-timezone-components
     18    current-locale-components) )
    2119
    22 (require-extension
    23   miscmacros
    24   locale-categories
    25   locale-components
    26   locale-errors)
     20(require-extension miscmacros locale-categories locale-components locale-errors)
     21
     22;;
     23
     24(define (check-string-or-false loc obj)
     25  (unless (or (not obj) (string? obj))
     26    (type-error loc "string or #f" obj) ) )
    2727
    2828;;
    … …  
    3434          (else
    3535            (warning 'current-locale-dictionary (make-type-error-message "a locale-dictionary") obj)
    36             (current-locale-dictionary)))))
     36            (current-locale-dictionary) ) ) ) )
    3737
    3838;;
    3939
    4040(define (current-timezone . args)
    41   (cond
    42     [(null? args)
    43       (let ([lc (locale-category-ref 'timezone)])
    44         (and lc
    45              (locale-component-ref lc 'name) ) ) ]
    46     [else
    47       (let-optionals args ([str #f] [src "USER"])
    48         (check-string-or-false 'current-timezone str)
    49         (let ([lc (and str (posix-timezone-string->locale-components str src))])
    50           (set-locale-category! 'timezone lc) ) ) ] ) )
     41  (cond ((null? args)
     42          (and-let* ((lc (locale-category-ref 'timezone)))
     43            (locale-component-ref lc 'name) ) )
     44        (else
     45          (let-optionals args ((str #f) (src "USER"))
     46            (check-string-or-false 'current-timezone str)
     47            (let ((lc (and str (posix-timezone-string->locale-components str src))))
     48              (set-locale-category! 'timezone lc) ) ) ) ) )
    5149
    5250;; A'la MzScheme
    … …  
    5452
    5553(define (current-locale . args)
    56   (cond
    57     [(null? args)
    58       (let ([lc (locale-category-ref 'messages)])
    59         (and lc
    60              (locale-component-ref lc 'name) ) ) ]
    61     [else
    62       (let-optionals args ([str #f] [src "USER"])
    63         (check-string-or-false 'current-locale str)
    64         (let ([lc (and str (posix-locale-string->locale-components str src))])
    65           (set-locale-category! 'messages lc) ) ) ] ) )
     54  (cond ((null? args)
     55          (and-let* ((lc (locale-category-ref 'messages)))
     56            (locale-component-ref lc 'name) ) )
     57        (else
     58          (let-optionals args ((str #f) (src "USER"))
     59            (check-string-or-false 'current-locale str)
     60            (let ((lc (and str (posix-locale-string->locale-components str src))))
     61              (set-locale-category! 'messages lc) ) ) ) ) )
    6662
    6763;;;
    6864
     65(define (current-timezone-components) (locale-category-ref 'timezone))
    6966
    70 (define (current-timezone-components)
    71   (locale-category-ref 'timezone) )
    72 
    73 (define (current-locale-components)
    74   (locale-category-ref 'messages) )
     67(define (current-locale-components) (locale-category-ref 'messages))
    7568
    7669;;
    … …  
    7871#;
    7972(define current-timezone-components
    80         (let ([cached-timezone #f]
    81                                 [cached-components (default-timezone-components)])
     73        (let ((cached-timezone #f)
     74                                (cached-components (default-timezone-components)))
    8275                (lambda args
    83                   (cond [(null? args)
    84               (let ([timezone (current-timezone)])
     76                  (cond ((null? args)
     77              (let ((timezone (current-timezone)))
    8578                (unless (equal? cached-timezone timezone)
    8679                  (unless (and timezone
    87                                (and-let* ([(string? timezone)]
    88                                           [tzc (posix-timezone-string->timezone-components timezone)])
     80                               (and-let* (((string? timezone))
     81                                          (tzc (posix-timezone-string->timezone-components timezone)))
    8982                                 (current-timezone-components timezone tzc)
    9083                                 #t ) )
    91                     (current-timezone-components #f (default-timezone-components)) ) ) ) ]
    92             [(= 2 (length args))
     84                    (current-timezone-components #f (default-timezone-components)) ) ) ) )
     85            ((= 2 (length args))
    9386              (set! cached-timezone (car args))
    94               (set! cached-components (cadr args)) ]
    95             [else
    96               (error 'current-timezone-components "too few arguments" args) ] )
     87              (set! cached-components (cadr args)) )
     88            (else
     89              (error 'current-timezone-components "too few arguments" args) ) )
    9790      cached-components ) ) )
    9891
    … …  
    10194#;
    10295(define current-locale-components
    103         (let ([cached-locale #f]
    104                                 [cached-components (default-locale-components)])
     96        (let ((cached-locale #f)
     97                                (cached-components (default-locale-components)))
    10598                (lambda args
    106                   (cond [(null? args)
    107               (let ([locale (current-locale)])
     99                  (cond ((null? args)
     100              (let ((locale (current-locale)))
    108101                (unless (equal? cached-locale locale)
    109102                  (unless (and locale
    110                                (and-let* ([(string? locale)]
    111                                           [lc (posix-locale-string->locale-components locale)])
     103                               (and-let* (((string? locale))
     104                                          (lc (posix-locale-string->locale-components locale)))
    112105                                 (current-locale-components locale lc)
    113106                                 #t ) )
    114                     (current-locale-components #f (default-locale-components)) ) ) ) ]
    115             [(= 2 (length args))
     107                    (current-locale-components #f (default-locale-components)) ) ) ) )
     108            ((= 2 (length args))
    116109              (set! cached-locale (car args))
    117               (set! cached-components (cadr args)) ]
    118             [else
    119               (error 'current-locale-components "too few arguments" args) ] )
     110              (set! cached-components (cadr args)) )
     111            (else
     112              (error 'current-locale-components "too few arguments" args) ) )
    120113      cached-components ) ) )

  • release/3/locale/trunk/locale-posix.scm

    r12818 r13852  
    99;; will still be #f, while some locale-categories will be valued
    1010
    11 (eval-when (compile)
    12   (declare
    13         (usual-integrations)
    14         (fixnum)
    15         (inline)
    16     (no-procedure-checks)
    17     (no-bound-checks)
    18     (export
    19       make-posix-timezone
    20       posix-timezone-string->timezone-components
    21       posix-locale-string->locale-components
    22       gnu-language-string->locale-components
    23       posix-load-timezone
    24       posix-load-locale
    25       gnu-load-locale) ) )
    26 
    27 (require-extension
    28   srfi-1 srfi-13
    29   regex data-structures
    30   locale-categories
    31   locale-components)
     11(declare
     12  (usual-integrations)
     13  (fixnum)
     14  (inline)
     15  (no-procedure-checks)
     16  (export
     17    make-posix-timezone
     18    posix-timezone-string->timezone-components
     19    posix-locale-string->locale-components
     20    gnu-language-string->locale-components
     21    posix-load-timezone
     22    posix-load-locale
     23    gnu-load-locale) )
     24
     25(require-extension srfi-1 srfi-13 regex data-structures locale-categories locale-components)
    3226
    3327;;;
    … …  
    3630
    3731(define (nonnull-getenv varnam)
    38   (let ([str (getenv "TZ")])
     32  (let ((str (getenv "TZ")))
    3933                (and (string? str)
    4034                     (not (string-null? str))
    … …  
    4741
    4842(define make-posix-timezone
    49   (let ([hms
     43  (let ((hms
    5044          (lambda (secs)
    51             (let* ([asecs (abs secs)]
    52                    [rsecs (remainder asecs SEC/HR)])
     45            (let* ((asecs (abs secs))
     46                   (rsecs (remainder asecs SEC/HR)))
    5347              (string-append
    5448                (if (negative? secs) "-" "+")
    5549                (number->string (quotient asecs SEC/HR))
    5650                ":" (number->string (quotient rsecs SEC/MIN))
    57                 ":" (number->string (remainder rsecs SEC/MIN)))))])
     51                ":" (number->string (remainder rsecs SEC/MIN)))))))
    5852    (lambda (dst-tzn dst-off std-tzn std-off)
    5953      (string-append dst-tzn (hms dst-off) std-tzn (hms std-off)) ) ) )
    … …  
    6963
    7064(define parse-posix-standard-timezone-value
    71         (let ([name-re (regexp "([A-Za-z]+)|<([^>]+)>")]
    72                                 [offset-re (regexp "([+-])?([0-9]+)(:[0-9]+)?(:[0-9]+)?")]
    73                                 [date-re (regexp ",([MJ])?([0-9]+)(\\.[0-9]+)?(\\.[0-9]+)?")]
    74                                 [time-re (regexp "/([0-9]+)(:[0-9]+)?(:[0-9]+)?")]
    75                                 [+defoff+ 3600])
     65        (let ((name-re (regexp "((A-Za-z)+)|<((^>)+)>"))
     66                                (offset-re (regexp "((+-))?((0-9)+)(:(0-9)+)?(:(0-9)+)?"))
     67                                (date-re (regexp ",((MJ))?((0-9)+)(\\.(0-9)+)?(\\.(0-9)+)?"))
     68                                (time-re (regexp "/((0-9)+)(:(0-9)+)?(:(0-9)+)?"))
     69                                (+defoff+ 3600))
    7670                (lambda (tz str)
    77                         (let ([strpos 0]
    78             [strend (string-length str)])
     71                        (let ((strpos 0)
     72            (strend (string-length str)))
    7973        (letrec (
    80             [next-match
     74            (next-match
    8175              (lambda (re)
    82                 (and-let* ([ml (string-match re str strpos)])
     76                (and-let* ((ml (string-match re str strpos)))
    8377                  (set! strpos (+ strpos (string-length (car ml))))
    84                   ml ) )]
    85             [all-parsed
    86               (lambda () (>= strpos strend))]
    87             [fake-dst-rule
     78                  ml ) ))
     79            (all-parsed
     80              (lambda () (>= strpos strend)))
     81            (fake-dst-rule
    8882              (lambda ()
    8983                (set-timezone-component! tz 'dst-start (make-timezone-dst-rule-mwd 4 1 0 +defoff+))
    9084                (set-timezone-component! tz 'dst-end (make-timezone-dst-rule-mwd 10 5 0 +defoff+))
    91                 #t)]
    92             [to-num
     85                #t))
     86            (to-num
    9387              (lambda (numstr)
    9488                (string->number
    95                   (cond [(not numstr)                 "0"]
    96                         [(string-prefix? ":" numstr)  (string-trim numstr #\:)]
    97                         [(string-prefix? "." numstr)  (string-trim numstr #\.)]
    98                         [else                         numstr])))]
    99             [to-offset
     89                  (cond ((not numstr)                 "0")
     90                        ((string-prefix? ":" numstr)  (string-trim numstr #\:))
     91                        ((string-prefix? "." numstr)  (string-trim numstr #\.))
     92                        (else                         numstr)))))
     93            (to-offset
    10094              (lambda (sgnstr hms-lst)
    101                 (let ([secs (+ (* (string->number (car hms-lst)) 3600)
     95                (let ((secs (+ (* (string->number (car hms-lst)) 3600)
    10296                               (* (to-num (cadr hms-lst)) 60)
    103                                (to-num (caddr hms-lst)))])
    104                   (if (equal? sgnstr "-") (- secs) secs)))]
    105             [parse-nam+off
     97                               (to-num (caddr hms-lst)))))
     98                  (if (equal? sgnstr "-") (- secs) secs))))
     99            (parse-nam+off
    106100              (lambda (namkey offkey)
    107                 (and-let* ([n-m (next-match name-re)]
    108                            [o-m (next-match offset-re)])
     101                (and-let* ((n-m (next-match name-re))
     102                           (o-m (next-match offset-re)))
    109103                  (set-timezone-component! tz namkey (cadr n-m))
    110104                  (set-timezone-component! tz offkey (to-offset (cadr o-m) (cddr o-m)))
    111                   #t ) )]
    112             [decode-dst-rule
     105                  #t ) ))
     106            (decode-dst-rule
    113107              (lambda (rulstr dat-lst off)
    114                 (let ([n1 (string->number (car dat-lst))])
     108                (let ((n1 (string->number (car dat-lst))))
    115109                  (if (not rulstr)
    116110                      ; Then assume Julian style rule
    117111                      (make-timezone-dst-rule-julian-leap n1 off)
    118112                      ; Else select rule
    119                       (let ([rch (string-ref rulstr 0)])
     113                      (let ((rch (string-ref rulstr 0)))
    120114                        (case rch
    121                           [(#\J)  ; Julian
    122                             (make-timezone-dst-rule-julian-noleap n1 off)]
    123                           [(#\M)  ; Date
     115                          ((#\J)  ; Julian
     116                            (make-timezone-dst-rule-julian-noleap n1 off))
     117                          ((#\M)  ; Date
    124118                            (make-timezone-dst-rule-mwd n1 (to-num (cadr dat-lst))
    125                                                            (to-num (caddr dat-lst)) off)]
    126                           [else
     119                                                           (to-num (caddr dat-lst)) off))
     120                          (else
    127121                            (warning "unknown DST rule type; assuming julian-leap" rch)
    128                             (make-timezone-dst-rule-julian-leap n1 off) ] ) ) ) ) ) ]
    129             [parse-dst-rule
     122                            (make-timezone-dst-rule-julian-leap n1 off) ) ) ) ) ) ) )
     123            (parse-dst-rule
    130124              (lambda (key)
    131                 (and-let* ([d-m (next-match date-re)])
    132                   (let* ([t-m (next-match time-re)]
    133                          [off (if t-m (to-offset #f (cdr t-m)) +defoff+)])
     125                (and-let* ((d-m (next-match date-re)))
     126                  (let* ((t-m (next-match time-re))
     127                         (off (if t-m (to-offset #f (cdr t-m)) +defoff+)))
    134128                    (set-timezone-component! tz key (decode-dst-rule (cadr d-m) (cddr d-m) off))
    135                     #t)))] )
     129                    #t)))) )
    136130          ; Walk the match set
    137131          (and ; At least standard timezone info
    … …  
    158152
    159153(define (posix-timezone-string->timezone-components str . src)
    160   (let ([tz (make-timezone-components str (optional src "POSIX"))])
    161     (cond [(string-prefix? ":" str)
    162             (parse-posix-implementation-defined-timezone-value tz str) ]
    163           [(string-prefix? "/" str)
    164             (parse-posix-pathname-timezone-value tz str) ]
    165           [else
    166             (parse-posix-standard-timezone-value tz str) ] ) ) )
     154  (let ((tz (make-timezone-components str (optional src "POSIX"))))
     155    (cond ((string-prefix? ":" str)
     156            (parse-posix-implementation-defined-timezone-value tz str) )
     157          ((string-prefix? "/" str)
     158            (parse-posix-pathname-timezone-value tz str) )
     159          (else
     160            (parse-posix-standard-timezone-value tz str) ) ) ) )
    167161
    168162;; Splits an IEEEÊStdÊ1003.1-2001 locale specifier string into
    … …  
    172166;; Returns a locale-components object or #f, indicating a parse error.
    173167;;
    174 ;;     name: language[-script][_territory][.codeset][@modifier]
     168;;     name: language(-script)(_territory)(.codeset)(@modifier)
    175169;; language: ISO 639-1 or ISO 639-2
    176170;;   script: RFC 3066bis
    … …  
    180174
    181175(define parse-posix-standard-locale
    182         (let ([locale-re (regexp "([a-zA-Z]+)(-[a-zA-Z]+)?(_[a-zA-Z]+)?(\\.[^@]+)?(@.+)?")])
     176        (let ((locale-re (regexp "((a-zA-Z)+)(-(a-zA-Z)+)?(_(a-zA-Z)+)?(\\.(^@)+)?(@.+)?")))
    183177                (lambda (lc str)
    184                         (and-let* ([r (string-match locale-re str)]
    185                  [matched-len 0])
    186         (let ([l (cadr r)]
    187               [s (caddr r)]
    188               [t (cadddr r)]
    189               [c (car (cddddr r))]
    190               [m (cadr (cddddr r))]
    191               [inc-matched-len
     178                        (and-let* ((r (string-match locale-re str))
     179                 (matched-len 0))
     180        (let ((l (cadr r))
     181              (s (caddr r))
     182              (t (cadddr r))
     183              (c (car (cddddr r)))
     184              (m (cadr (cddddr r)))
     185              (inc-matched-len
    192186                (lambda (v)
    193                   (set! matched-len (+ matched-len (string-length v))))])
     187                  (set! matched-len (+ matched-len (string-length v))))))
    194188          (when l
    195189            (inc-matched-len l)
    … …  
    215209
    216210(define (posix-locale-string->locale-components str . args)
    217   (let-optionals args ([src "POSIX"] [tag 'locale])
    218     (let ([lc (make-locale-components str src tag)])
    219       (cond [(or (string=? str "C") (string=? str "POSIX"))
    220               #f ]
    221             [(string-prefix? "/" str)
    222               (parse-posix-pathname-locale lc str) ]
    223             [else
    224               (parse-posix-standard-locale lc str) ] ) ) ) )
     211  (let-optionals args ((src "POSIX") (tag 'locale))
     212    (let ((lc (make-locale-components str src tag)))
     213      (cond ((or (string=? str "C") (string=? str "POSIX"))
     214              #f )
     215            ((string-prefix? "/" str)
     216              (parse-posix-pathname-locale lc str) )
     217            (else
     218              (parse-posix-standard-locale lc str) ) ) ) ) )
    225219
    226220;; The POSIX/GNU locale categories
    … …  
    252246
    253247(define (gnu-language-string->locale-components str . args)
    254   (let-optionals args ([src "GNU"] [tag 'language])
    255     (let ([lst
     248  (let-optionals args ((src "GNU") (tag 'language))
     249    (let ((lst
    256250            (map
    257251              (lambda (lclstr)
    258                 (let ([lc (posix-locale-string->locale-components lclstr src)])
     252                (let ((lc (posix-locale-string->locale-components lclstr src)))
    259253                  (unless (locale-component-ref lc 'region)
    260254                    (set-locale-component! lc
    261255                      'region (string-upcase (locale-component-ref lc 'language))) )
    262256                  lc ) )
    263               (string-split str ":"))])
    264         (let ([lc (make-locale-components str src tag)])
     257              (string-split str ":"))))
     258        (let ((lc (make-locale-components str src tag)))
    265259          (set-locale-components! lc 'locales lst)
    266260          lc ) ) ) )
    … …  
    272266(define (posix-load-timezone)
    273267  (unless (locale-category-ref 'timezone)
    274     (and-let* ([str (nonnull-getenv "TZ")])
     268    (and-let* ((str (nonnull-getenv "TZ")))
    275269      (let ((lc (posix-timezone-string->timezone-components str "POSIX")))
    276270        (set-locale-category! 'timezone lc)) ) ) )
    … …  
    280274(define (posix-load-locale)
    281275  ; POSIX standard
    282         (let ([str (nonnull-getenv "LC_ALL")])
     276        (let ((str (nonnull-getenv "LC_ALL")))
    283277                (if str
    284278        ; Then LC_ALL overrides
    285         (let ([lc (posix-locale-string->locale-components str)])
     279        (let ((lc (posix-locale-string->locale-components str)))
    286280          (set-posix-locale-categories (lambda (e c) lc)) )
    287281        ; Else set individually, w/ LANG as default
    288         (let* ([str (nonnull-getenv "LANG")]
    289                [lc (and str
    290                         (posix-locale-string->locale-components str))])
     282        (let* ((str (nonnull-getenv "LANG"))
     283               (lc (and str
     284                        (posix-locale-string->locale-components str))))
    291285          (set-posix-locale-categories
    292286           (lambda (e c)
    … …  
    300294(define (gnu-load-locale)
    301295  (unless (locale-category-ref 'language)
    302     (and-let* ([str (nonnull-getenv "LANGUAGE")])
    303       (let ([lc (gnu-language-string->locale-components str)])
     296    (and-let* ((str (nonnull-getenv "LANGUAGE")))
     297      (let ((lc (gnu-language-string->locale-components str)))
    304298        (set-locale-category! 'language lc) ) ) ) )

  • release/3/locale/trunk/locale.html

    r12806 r13852  
    1 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
    2 <!-- Generated by eggdoc Revision: 1.20  -->
    3 <html>
    4 <head>
    5 <title>Eggs Unlimited - locale</title><style type="text/css"> <!--
    6       CODE {
    7             color: #666666;
    8           }
    9 /*   DT.definition EM { font-weight: bold; font-style: normal; } */
    10 
    11      DT.definition {
    12                    background: #eee;
    13                    color: black;
    14                    padding: 0.2em 1em 0.2em 0.7em;
    15                    margin-left: 0.2em;
    16 border: 1px solid #bbc;
    17                    font-family: "Andale Mono", monospace;
    18                    /* font-size: 1.2em; */
    19                    
    20                  }
    21      DD {
    22                    margin-top: 0.8em;
    23                    margin-bottom: 0.8em;
    24      }
    25      DIV.subsection {
    26                     border-top: 1px solid #448;
    27                     padding-left: 1em;
    28                     margin-bottom: 1.2em;
    29      }
    30      DIV.subsubsection {
    31                     border-top: 1px dotted #99c;
    32                     /* border-left: 1px solid #99c; */
    33                     padding-left: 1em;
    34                     margin-bottom: 1.2em;
    35      }
    36      DIV.subsubsubsection {
    37                     border-top: 1px solid #ddf;
    38                     padding-left: 1em;
    39                     margin-bottom: 1.2em;
    40      }
    41 
    42          DIV.section {
    43                  margin-bottom: 1.5em;
    44          }
    45          a:link {
    46                  color: #336;
    47          }
    48          a:visited { color: #666; }
    49          a:active  { color: #966; }
    50          a:hover   { color: #669; }
    51          body { margin: 0; padding: 0; background: #fff; color: #000; font: 9pt "Lucida Grande", "Verdana", sans-serif; }
    52          H2 {
    53                  background: #336;
    54                  color: #fff;
    55                  padding-top: 0.5em;
    56                  padding-bottom: 0.5em;
    57                  padding-left: 16px;
    58                  margin: 0 0 1em 0;
    59         }
    60         UL LI {
    61                 list-style: none;
    62         }
    63         TT {
    64                 font-family: "Andale Mono", monospace;
    65                 /* font-size: 1.2em; */
    66         }
    67         H3 {
    68                 color: #113;
    69                 margin-bottom: 0.5em;
    70         }
    71         H4, H5, H6 {
    72                 color: #113;
    73                 margin-bottom: 1.0em;
    74         }
    75         H5 {
    76                 font-weight: normal;
    77                 font-style: italic;
    78                 font-size: 100%;
    79                 margin-top: 1.2em;
    80         }
    81         H6 {
    82                 font-weight: bold;
    83                 font-size: 85%;
    84                 margin-top: 1.2em;
    85         }
    86      DIV#eggheader {
    87          text-align: center;
    88                  float: right;
    89                  margin-right: 2em;
    90      }
    91      DIV#header IMG {
    92             /* display: block; margin-left: auto; margin-right: auto;  */
    93             /* float: right; */
    94             border: none;  /* firefox */
    95      }
    96      DIV#footer {
    97                 background: #bbd;
    98                 padding: 0.7em ;
    99                 border-top: 1px solid #cce;
    100      }
    101      DIV#footer hr {
    102                 display: none;
    103      }
    104      DIV#footer a {
    105                 float: left;
    106      }
    107      DIV#revision-history {
    108          float: right;
    109      }
    110      
    111      DIV#body {
    112                  margin: 1em 1em 1em 16px;
    113          }
    114 
    115      DIV#examples PRE {
    116        background: #eef;
    117        padding: 0.1em;
    118        border: 1px solid #aac;
    119      }
    120      PRE#license, DIV#examples PRE {
    121        padding: 0.5em;
    122      }
    123      DIV#examples PRE {
    124        /* font-size: 85%; */
    125      }
    126      PRE { font-family: "Andale Mono", monospace; }
    127      TABLE {
    128        background: #eef;
    129        padding: 0.2em;
    130        border: 1px solid #aac;
    131        border-collapse: collapse;
    132        width: 100%;
    133      }
    134      TABLE.symbol-table TD.symbol {
    135           width: 15em;
    136           font-family: "Andale Mono", monospace;
    137           /* font-size: 1.2em; */
    138      }
    139      TH {
    140        text-align: left;
    141        border-bottom: 1px solid #aac;
    142        padding: 0.25em 0.5em 0.25em 0.5em;
    143      }
    144      TD { padding: 0.25em 0.5em 0.25em 0.5em; }
    145      --></style></head>
    146 <body>
    147 <div id="header">
    148 <h2>locale</h2>
    149 <div id="eggheader"><a href="index.html">
    150 <img src="egg.jpg" alt="[Picture of an egg]" /></a></div></div>
    151 <div id="body">
    152 <div class="section">
    153 <h3>Description</h3>
    154 <p>Provides locale operations.</p></div>
    155 <div class="section">
    156 <h3>Author</h3><a href="mailto:klovett@pacbell.net">Kon Lovett</a></div>
    157 <div class="section">
    158 <h3>Usage</h3><tt>(require-extension locale)</tt></div>
    159 <div class="section">
    160 <h3>Download</h3><a href="locale.egg">locale.egg</a></div>
    161 <div class="section">
    162 <h3>Requires</h3>
    163 <ul>
    164 <li><a href="miscmacros.html">miscmacros</a></li></ul></div>
    165 <div class="section">
    166 <h3>Documentation</h3>
    167 <p>locale is a set of routines supporting locale query operations. The environment locale information is determined upon module load and the corresponding parameters are set.</p>
    168 <div class="subsection">
    169 <h4>Locale Components</h4>
    170 <p>The major data structure is the <code>locale-components</code> type, portrayed as an extensible <tt>key+value</tt> pairing. The <tt>key</tt> is a <code>symbol</code>. The <tt>value</tt> is usually a <code>string</code>.</p>
    171 <p>A <code>locale-components</code> object will have more properties but the following are provided for every instance:</p><table class="symbol-table">Common Component Keys
    172 <tr>
    173 <td class="symbol">name</td>
    174 <td>The composite information object, source specific.</td></tr>
    175 <tr>
    176 <td class="symbol">source</td>
    177 <td>The origin for the information.</td></tr></table>
    178 <p>The <code>source</code> property is one of the following (others are possible):</p><table class="symbol-table">Source Values
    179 <tr>
    180 <td class="symbol">PLATFORM</td>
    181 <td>Information from the system.</td></tr>
    182 <tr>
    183 <td class="symbol">POSIX</td>
    184 <td>Information from POSIX environment. The &quot;name&quot; is a string.</td></tr>
    185 <tr>
    186 <td class="symbol">BUILTIN</td>
    187 <td>Information from system defaults.</td></tr></table>
    188 <p>The <code>PLATFORM</code> source is used for information first. Then the <code>POSIX</code> source is attempted. When all have failed the <code>BUILTIN</code> source is used. The point being locale information will be available, but without an accuracy guarantee.</p>
    189 <p>The <code>BUILTIN</code> source creates a POSIX-style string &quot;name&quot; constructed using constants and library procedures.</p></div>
    190 <div class="subsection">
    191 <h4>Generic Locale Components Property Access</h4>
    192 <dt class="definition"><strong>procedure:</strong> (locale-components? OBJECT)</dt>
    193 <dd>
    194 <p>Is the <tt>OBJECT</tt> a <code>locale-compenents</code> object?</p></dd>
    195 <dt class="definition"><strong>procedure:</strong> (locale-component-ref LOCALE-COMPONENTS KEY [DEFAULT #f])</dt>
    196 <dd>
    197 <p>Returns the <tt>KEY</tt> property of <tt>LOCALE-COMPONENTS</tt> or the <tt>DEFAULT</tt> when not found.</p></dd>
    198 <dt class="definition"><strong>procedure:</strong> (set-locale-component! LOCALE-COMPONENTS KEY VALUE)</dt>
    199 <dd>
    200 <p>Updates or creates the <tt>KEY</tt> property of <tt>LOCALE-COMPONENTS</tt> with the <tt>VALUE</tt>.</p></dd></div>
    201 <div class="subsection">
    202 <h4>Timezone</h4>
    203 <p>Access to timezone information. A timezone object is a <code>locale-components</code> object with properties for Standard Time Name and Offset, and an optional Summer or Daylight Saving Time Name and Offset. The offset is seconds west (positive) or east (negative) of UTC. The name is some locally accepted timezone name, such as &quot;PST&quot;. A Daylight Saving Time start rule and end rule are optional properties.</p><table class="symbol-table">Timezone Component Properties
    204 <tr>
    205 <td class="symbol">std-name</td>
    206 <td>The Standard timezone name.</td></tr>
    207 <tr>
    208 <td class="symbol">std-offset</td>
    209 <td>Seconds +/- UTC.</td></tr>
    210 <tr>
    211 <td class="symbol">dst-name</td>
    212 <td>The Daylight Saving Time timezone name.</td></tr>
    213 <tr>
    214 <td class="symbol">dst-offset</td>
    215 <td>Seconds +/- UTC.</td></tr>
    216 <tr>
    217 <td class="symbol">dst-start</td>
    218 <td>The start of Daylight Saving Time; a timezone-dst-rule.</td></tr>
    219 <tr>
    220 <td class="symbol">dst-end</td>
    221 <td>The end of Daylight Saving Time; a timezone-dst-rule.</td></tr></table>
    222 <dl>
    223 <dt class="definition"><strong>parameter:</strong> (current-timezone [VALUE])</dt>
    224 <dd>
    225 <p>The currently defined timezone. The specified <tt>VALUE</tt> is either a timezone string value, or <code>#f</code>, indicating no timezone. When no timezone value is set the default timezone is UTC.</p></dd>
    226 <dt class="definition"><strong>procedure:</strong> (current-timezone-components)</dt>
    227 <dd>
    228 <p>Returns the timezone-components object corresponding to the current-timezone.</p></dd>
    229 <dt class="definition"><strong>procedure:</strong> (timezone-components? TIMEZONE-COMPONENTS)</dt>
    230 <dd>
    231 <p>Is the specified <tt>TIMEZONE-COMPONENTS</tt> object actually a timezone-components object?</p></dd>
    232 <dt class="definition"><strong>procedure:</strong> (timezone-component-ref TIMEZONE-COMPONENTS KEY [DEFAULT #f])</dt>
    233 <dd>
    234 <p>Returns the timezone-component <tt>KEY</tt> of the <tt>TIMEZONE-COMPONENTS</tt> object, or the <tt>DEFAULT</tt> for a missing component.</p></dd>
    235 <dt class="definition"><strong>procedure:</strong> (set-timezone-component! TIMEZONE-COMPONENTS KEY VALUE)</dt>
    236 <dd>
    237 <p>Sets the timezone-component <tt>KEY</tt> of the <tt>TIMEZONE-COMPONENTS</tt> object to <tt>VALUE</tt>.</p></dd>
    238 <dt class="definition"><strong>procedure:</strong> (timezone-dst-rule-julian-noleap? TIMEZONE-DST-RULE)</dt>
    239 <dd>
    240 <p>Is the specified <tt>TIMEZONE-DST-RULE</tt> object actually a daylight saving time julian day without leap seconds object?</p></dd>
    241 <dt class="definition"><strong>procedure:</strong> (timezone-dst-rule-julian-leap? TIMEZONE-DST-RULE)</dt>
    242 <dd>
    243 <p>Is the specified <tt>TIMEZONE-DST-RULE</tt> object actually a daylight saving time julian day assuming leap seconds object?</p></dd>
    244 <dt class="definition"><strong>procedure:</strong> (timezone-dst-rule-mwd? TIMEZONE-DST-RULE)</dt>
    245 <dd>
    246 <p>Is the specified <tt>TIMEZONE-DST-RULE</tt> object actually a daylight saving time month+week+day object?</p></dd>
    247 <dt class="definition"><strong>procedure:</strong> (timezone-dst-rule-offset TIMEZONE-DST-RULE)</dt>
    248 <dd>
    249 <p>Returns the seconds within day offset component of the specified <tt>TIMEZONE-DST-RULE</tt> object.</p></dd>
    250 <dt class="definition"><strong>procedure:</strong> (timezone-dst-rule-julian TIMEZONE-DST-RULE)</dt>
    251 <dd>
    252 <p>Returns the julian day component of the specified <tt>TIMEZONE-DST-RULE</tt> object.</p></dd>
    253 <dt class="definition"><strong>procedure:</strong> (timezone-dst-rule-month TIMEZONE-DST-RULE)</dt>
    254 <dd>
    255 <p>Returns the month of year component of the specified <tt>TIMEZONE-DST-RULE</tt> object.</p></dd>
    256 <dt class="definition"><strong>procedure:</strong> (timezone-dst-rule-week TIMEZONE-DST-RULE)</dt>
    257 <dd>
    258 <p>Returns the week of month component of the specified <tt>TIMEZONE-DST-RULE</tt> object.</p></dd>
    259 <dt class="definition"><strong>procedure:</strong> (timezone-dst-rule-day TIMEZONE-DST-RULE)</dt>
    260 <dd>
    261 <p>Returns the day of week component of the specified <tt>TIMEZONE-DST-RULE</tt> object.</p></dd>
    262 <dt class="definition"><strong>procedure:</strong> (make-timezone-dst-rule-julian-leap JULIAN-DAY OFFSET)</dt>
    263 <dd>
    264 <p>Returns a daylight saving time julian day assuming leap seconds rule object.</p></dd>
    265 <dt class="definition"><strong>procedure:</strong> (make-timezone-dst-rule-julian-noleap JULIAN-DAY OFFSET)</dt>
    266 <dd>
    267 <p>Returns a daylight saving time julian day without leap seconds rule object.</p></dd>
    268 <dt class="definition"><strong>procedure:</strong> (make-timezone-dst-rule-mwd MONTH WEEK DAY OFFSET)</dt>
    269 <dd>
    270 <p>Returns a daylight saving time month.week.day rule object.</p></dd>
    271 <dt class="definition"><strong>procedure:</strong> (posix-timezone-value-&gt;timezone-components STRING [SOURCE &quot;POSIX&quot;])</dt>
    272 <dd>
    273 <p>Parses a POSIX timezone string specification, <tt>STRING</tt>, and returns the corresponding timezone-components object, or <code>#f</code> when a parse error occurs. A <code>#f</code> or empty string value is mapped to the default timezone. The optional <tt>SOURCE</tt> indicates what locale system supplied the string.</p></dd>
    274 <dt class="definition"><strong>procedure:</strong> (posix-load-timezone)</dt>
    275 <dd>
    276 <p>Initialize the current-timezone from the TZ environment variable.</p></dd></dl></div>
    277 <div class="subsection">
    278 <h4>Locale</h4>
    279 <p>Access to locale information. A locale object is composed of a Language, an optional Script, an optional Region, an optional Codeset, and an optional Modifier. The language should be an ISO 639-1 or ISO 639-2 name. The Script should be a RFC 3066bis name. The region should be an ISO 3166-1 name. The codeset and modifier forms are locale dependent.</p><table class="symbol-table">Locale Properties
    280 <tr>
    281 <td class="symbol">language</td>
    282 <td>ISO 639-1 or ISO 639-2 name string. Default &quot;en&quot;.</td></tr>
    283 <tr>
    284 <td class="symbol">script</td>
    285 <td>RFC 3066bis name string.</td></tr>
    286 <tr>
    287 <td class="symbol">region</td>
    288 <td>ISO 3166-1 name string. Default &quot;US&quot;.</td></tr>
    289 <tr>
    290 <td class="symbol">codeset</td>
    291 <td>The character code to character mapping system.</td></tr>
    292 <tr>
    293 <td class="symbol">modifier</td>
    294 <td>The codeset subsection, if any.</td></tr></table>
    295 <dl>
    296 <dt class="definition"><strong>parameter:</strong> (current-locale [VALUE])</dt>
    297 <dd>
    298 <p>The currently defined locale. The specified <tt>VALUE</tt> is either a locale string value, or <code>#f</code>, indicating locale independence. When no locale value is set the default locale is <code>#f</code>.</p></dd>
    299 <dt class="definition"><strong>procedure:</strong> (current-locale-components)</dt>
    300 <dd>
    301 <p>Returns the locale-components object corresponding to the current-locale.</p></dd>
    302 <dt class="definition"><strong>procedure:</strong> (locale-components? LOCALE-COMPONENTS)</dt>
    303 <dd>
    304 <p>Is the specified <tt>LOCALE-COMPONENTS</tt> object actually a locale-components object?</p></dd>
    305 <dt class="definition"><strong>procedure:</strong> (locale-component-ref LOCALE-COMPONENTS KEY [DEFAULT #f])</dt>
    306 <dd>
    307 <p>Returns the locale-component <tt>KEY</tt> of the <tt>LOCALE-COMPONENTS</tt> object, or the <tt>DEFAULT</tt> for a missing component.</p></dd>
    308 <dt class="definition"><strong>procedure:</strong> (set-locale-component! LOCALE-COMPONENTS KEY VALUE)</dt>
    309 <dd>
    310 <p>Sets the locale-component <tt>KEY</tt> of the <tt>LOCALE-COMPONENTS</tt> object to <tt>VALUE</tt>.</p></dd>
    311 <dt class="definition"><strong>procedure:</strong> (posix-locale-value-&gt;locale-components STRING [SOURCE &quot;POSIX&quot;])</dt>
    312 <dd>
    313 <p>Parses a POSIX locale string specification, <tt>STRING</tt>, and returns the corresponding locale-components object, or <code>#f</code> when a parse error occurs. A <code>#f</code> or empty string value is mapped to the default locale. The optional <tt>SOURCE</tt> indicates what locale system supplied the string.</p></dd>
    314 <dt class="definition"><strong>procedure:</strong> (posix-load-locale)</dt>
    315 <dd>
    316 <p>Initialize the current-locale from the LC_* or LANG environment variables. When both the LC_ALL and LANG environment variables are not set the current-locale is <code>#f</code>, even though some locale-categories may have values. LC_ALL or LANG should be set if any locale categories are set.</p></dd></dl></div>
    317 <div class="subsection">
    318 <h4>Locale Category</h4>
    319 <p>Access to the locale information by category.</p><table class="symbol-table">Locale Category Keys
    320 <tr>
    321 <td class="symbol">ADDRESS</td>
    322 <td></td></tr>
    323 <tr>
    324 <td class="symbol">COLLATE</td>
    325 <td></td></tr>
    326 <tr>
    327 <td class="symbol">CTYPE</td>
    328 <td></td></tr>
    329 <tr>
    330 <td class="symbol">IDENTIFICATION</td>
    331 <td></td></tr>
    332 <tr>
    333 <td class="symbol">LANGUAGE</td>
    334 <td></td></tr>
    335 <tr>
    336 <td class="symbol">MEASUREMENT</td>
    337 <td></td></tr>
    338 <tr>
    339 <td class="symbol">MESSAGES</td>
    340 <td></td></tr>
    341 <tr>
    342 <td class="symbol">MONETARY</td>
    343 <td></td></tr>
    344 <tr>
    345 <td class="symbol">NAME</td>
    346 <td></td></tr>
    347 <tr>
    348 <td class="symbol">NUMERIC</td>
    349 <td></td></tr>
    350 <tr>
    351 <td class="symbol">PAPER</td>
    352 <td></td></tr>
    353 <tr>
    354 <td class="symbol">TELEPHONE</td>
    355 <td></td></tr>
    356 <tr>
    357 <td class="symbol">TIME</td>
    358 <td></td></tr></table>
    359 <dl>
    360 <dt class="definition"><strong>procedure:</strong> (set-locale-category! CATEGORY LOCALE-COMPONENTS)</dt>
    361 <dd>
    362 <p>Sets the specified <tt>CATEGORY</tt> to the specified <tt>LOCALE-COMPONENTS</tt> object.</p></dd>
    363 <dt class="definition"><strong>procedure:</strong> (locale-category-ref CATEGORY)</dt>
    364 <dd>
    365 <p>Returns the specified <tt>CATEGORY</tt> locale-components object, or <code>#f</code> if the category is not valued.</p></dd></dl></div></div>
    366 <div class="section">
    367 <h3>Issues</h3>
    368 <p>NOTE: This is a work in progress. Currently only the Posix locale information is supported. Plans are to support the native MacOS X and Windows locale APIs. Changes to this API are almost certain.</p></div>
    369 <div class="section">
    370 <h3>Version</h3>
    371 <ul>
    372 <li>0.4.0 Added &quot;default&quot; timezone &amp; locale</li>
    373 <li>0.3.3 Removed use of 'critical-section'</li>
    374 <li>0.3.2 Dropped :optional</li>
    375 <li>0.3.1 Bug fix for default dst offset</li>
    376 <li>0.3 Reverts to defaults for timezone &amp; locale when parse errors</li>
    377 <li>0.2 Exports</li>
    378 <li>0.1 Initial release</li></ul></div>
    379 <div class="section">
    380 <h3>License</h3>
    381 <pre>Copyright (c) 2005, Kon Lovett.  All rights reserved.
    382 
    383 Permission is hereby granted, free of charge, to any person obtaining a
    384 copy of this software and associated documentation files (the Software),
    385 to deal in the Software without restriction, including without limitation
    386 the rights to use, copy, modify, merge, publish, distribute, sublicense,
    387 and/or sell copies of the Software, and to permit persons to whom the
    388 Software is furnished to do so, subject to the following conditions:
    389 
    390 The above copyright notice and this permission notice shall be included
    391 in all copies or substantial portions of the Software.
    392 
    393 THE SOFTWARE IS PROVIDED ASIS, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
    394 IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
    395 FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
    396 THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
    397 OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
    398 ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
    399 OTHER DEALINGS IN THE SOFTWARE.</pre></div></div>
    400 <div id="footer">
    401 <hr /><a href="index.html">&lt; Egg index</a>
    402 <div id="revision-history">$Revision$ $Date$</div>&nbsp;</div></body></html>

  • release/3/locale/trunk/locale.meta

    r12812 r13852  
    1616        "locale-components.scm"
    1717        "locale-posix.scm"
     18        "locale-errors.scm"
    1819        "locale.html"
    1920        "locale.setup"))

  • release/3/locale/trunk/locale.scm

    r12818 r13852  
    66;; - Only Posix for now.
    77
    8 (eval-when (compile)
    9   (declare
    10         (usual-integrations)
    11         (fixnum)
    12         (inline)
    13     (no-procedure-checks)
    14     (no-bound-checks)
    15     (export
    16       UNKNOWN-LOCAL-TZ-NAME
    17       BUILTIN-SOURCE) ) )
     8(declare
     9  (usual-integrations)
     10  (fixnum)
     11  (inline)
     12  (no-procedure-checks)
     13  (export
     14    UNKNOWN-LOCAL-TZ-NAME
     15    BUILTIN-SOURCE) )
    1816
    19 (require-extension
    20   posix
    21   locale-posix
    22   locale-components
    23   locale-parameters)
     17(require-extension posix locale-posix locale-components locale-parameters)
    2418
    2519;;; When no environment info use Plan B
    2620
    2721(define BUILTIN-SOURCE "BUILTIN")
     22(define UNKNOWN-LOCAL-TZ-NAME "XXXX")
    2823
    2924;; Builtin Timezone
    … …  
    3429(define-constant DEFAULT-DST-OFFSET 3600)
    3530
    36 (define UNKNOWN-LOCAL-TZ-NAME "XXXX")
    37 
    38 (define (local-timezone-name)
    39   (or (local-timezone-abbreviation)
    40       UNKNOWN-LOCAL-TZ-NAME) )
     31(define (local-timezone-name) (or (local-timezone-abbreviation) UNKNOWN-LOCAL-TZ-NAME))
    4132
    4233(define (make-builtin-timezone)
    4334  ; Need local timezone info
    44   (let* ([tv (seconds->local-time (current-seconds))]
    45          [dstf (vector-ref tv 8)]
    46          [tzn (local-timezone-name)] )
     35  (let* ((tv (seconds->local-time (current-seconds)))
     36         (dstf (vector-ref tv 8))
     37         (tzn (local-timezone-name)) )
    4738    (cond-expand
    48       [macosx
     39      (macosx
    4940        ; Since the tzo reflects the dst status need to fake the one not in effect.
    50         (let ([tzo (vector-ref tv 9)])
     41        (let ((tzo (vector-ref tv 9)))
    5142          (if dstf
    5243              (make-posix-timezone UNKNOWN-LOCAL-TZ-NAME (+ tzo DEFAULT-DST-OFFSET) tzn tzo)
    53               (make-posix-timezone tzn tzo UNKNOWN-LOCAL-TZ-NAME (- tzo DEFAULT-DST-OFFSET)) ) ) ]
    54       [else
     44              (make-posix-timezone tzn tzo UNKNOWN-LOCAL-TZ-NAME (- tzo DEFAULT-DST-OFFSET)) ) ) )
     45      (else
    5546        ; Since only the standard tzn & tzo are available need to
    5647        ; fake summer time.
    57         (let ([tzo (vector-ref tv 9)])
    58           (make-posix-timezone tzn tzo UNKNOWN-LOCAL-TZ-NAME (- tzo DEFAULT-DST-OFFSET)) ) ] ) ) )
     48        (let ((tzo (vector-ref tv 9)))
     49          (make-posix-timezone tzn tzo UNKNOWN-LOCAL-TZ-NAME (- tzo DEFAULT-DST-OFFSET)) ) ) ) ) )
    5950
    6051(define (use-builtin-timezone)
    … …  
    7566
    7667(define (use-builtin-language)
    77   (and-let* ([msglc (locale-category-ref 'messages)])
    78     (let ([lc (make-locale-components (locale-component-ref msglc 'name) BUILTIN-SOURCE 'language)])
     68  (and-let* ((msglc (locale-category-ref 'messages)))
     69    (let ((lc (make-locale-components (locale-component-ref msglc 'name) BUILTIN-SOURCE 'language)))
    7970      (set-locale-components! lc 'locales (list msglc))
    8071      (set-locale-category! 'language lc) ) ) )
    … …  
    9485;; time info.
    9586
    96 (unless (current-timezone)
    97   (use-builtin-timezone) )
     87(unless (current-timezone) (use-builtin-timezone))
    9888
    99 (unless (current-locale)
    100   (use-builtin-locale) )
     89(unless (current-locale) (use-builtin-locale))
    10190
    102 (unless (locale-category-ref 'language)
    103   (use-builtin-language) )
     91(unless (locale-category-ref 'language) (use-builtin-language))
Note: See TracChangeset for help on using the changeset viewer.