Changeset 13881 in project


Ignore:
Timestamp:
03/23/09 18:58:53 (11 years ago)
Author:
Kon Lovett
Message:

Made builtin locale sep file.

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

Legend:

Unmodified
Added
Removed
  • release/3/locale/trunk/locale-categories.scm

    r13860 r13881  
    2222;;
    2323
    24 (define (check-symbol loc obj)
    25   (unless (symbol? obj)
    26     (type-error loc "symbol" obj) ) )
     24(define (check-symbol loc obj) (unless (symbol? obj) (type-error loc "symbol" obj)))
    2725
    2826;;;
     
    4543  (check-symbol 'set-locale-dictionary-category! key)
    4644  (let ((tbl (locale-dictionary-table rec)))
    47     (if (not val) (dict-delete! tbl key)
    48         (begin
    49           (check-locale-components 'set-locale-dictionary-category! val)
    50           (dict-set! tbl key val) ) ) ) )
     45    (cond ((not val)
     46           (dict-delete! tbl key))
     47          (else
     48           (check-locale-components 'set-locale-dictionary-category! val)
     49           (dict-set! tbl key val) ) ) ) )
    5150
    5251;; A locale-component or #f
     
    6463  (lambda (obj)
    6564    (cond ((locale-dictionary? obj)
    66             obj)
     65           obj)
    6766          (else
    68             (warning 'current-locale-dictionary (make-type-error-message "locale-dictionary") obj)
    69             (current-locale-dictionary) ) ) ) )
     67           (warning 'current-locale-dictionary (make-type-error-message "locale-dictionary") obj)
     68           (current-locale-dictionary) ) ) ) )
    7069
    7170;;
  • release/3/locale/trunk/locale-components.scm

    r13860 r13881  
    171171(define (check-locale-components loc obj)
    172172  (unless (locale-components? obj)
    173     (type-error loc "a timezone-components object" obj) ) )
     173    (type-error loc "a locale-components object" obj) ) )
    174174
    175175;;
  • release/3/locale/trunk/locale-posix.scm

    r13860 r13881  
    1515  (no-procedure-checks)
    1616  (export
     17    ;
     18    seconds->hms-string
     19    ;
    1720    make-posix-timezone
     21    ;
    1822    posix-timezone-string->timezone-components
    1923    posix-locale-string->locale-components
    2024    gnu-language-string->locale-components
     25    ;
    2126    posix-load-timezone
    2227    posix-load-locale
     
    4045(define-constant SEC/MIN  60)
    4146
    42 (define make-posix-timezone
    43   (let ((hms
    44           (lambda (secs)
    45             (let* ((asecs (abs secs))
    46                    (rsecs (remainder asecs SEC/HR)))
    47               (string-append
    48                 (if (negative? secs) "-" "+")
    49                 (number->string (quotient asecs SEC/HR))
    50                 ":" (number->string (quotient rsecs SEC/MIN))
    51                 ":" (number->string (remainder rsecs SEC/MIN)))))))
    52     (lambda (dst-tzn dst-off std-tzn std-off)
    53       (string-append dst-tzn (hms dst-off) std-tzn (hms std-off)) ) ) )
     47(define (seconds->hms-string secs)
     48  (let* ((asecs (abs secs))
     49         (rsecs (remainder asecs SEC/HR)) )
     50    (conc (if (negative? secs) #\- #\+) (quotient asecs SEC/HR)
     51          #\: (quotient rsecs SEC/MIN)
     52          #\: (remainder rsecs SEC/MIN)) ) )
     53
     54(define (make-posix-timezone dst-tzn dst-off std-tzn std-off)
     55  (string-append dst-tzn (seconds->hms-string dst-off) std-tzn (seconds->hms-string std-off)) )
    5456
    5557;; Splits an IEEEÊStdÊ1003.1-2001 TZ specifier string into components.
     
    119121                                                           (to-num (caddr dat-lst)) off))
    120122                          (else
    121                             (warning "unknown DST rule type; assuming julian-leap" rch)
     123                            (warning "unknown Posix timezone DST rule type; assuming julian-leap" rch)
    122124                            (make-timezone-dst-rule-julian-leap n1 off) ) ) ) ) ) ) )
    123125            (parse-dst-rule
     
    131133          (and ; At least standard timezone info
    132134               (parse-nam+off 'std-name 'std-offset)
    133                ; Ok, then try optional DST section
     135               ; Ok, try optional DST section
    134136               (or (not (parse-nam+off 'dst-name 'dst-offset))
    135                    ; Ok, then try optional DST start+end
    136                    (or (and (parse-dst-rule 'dst-start)
    137                             (parse-dst-rule 'dst-end))
    138                        ; Else dummy something up
     137                   ; then try optional DST start+end
     138                   (or (and (parse-dst-rule 'dst-start) (parse-dst-rule 'dst-end))
     139                       ; else dummy something up
    139140                       (fake-dst-rule)))
    140141               ; Matched at least the minimum
    141142               (all-parsed)
    142                ; Valid timezone info
     143               ; Then valid timezone info
    143144               tz ) ) ) ) ) )
    144145
    145146(define (parse-posix-implementation-defined-timezone-value tz str)
    146   (warning "cannot understand implementation-defined values" str)
     147  (warning "cannot understand Posix implementation-defined timezone values" str)
    147148  #f )
    148149
    149150(define (parse-posix-pathname-timezone-value tz str)
    150   (warning "cannot understand pathname values" str)
     151  (warning "cannot understand Posix pathname timezone values" str)
    151152  #f )
    152153
     
    205206
    206207(define (parse-posix-pathname-locale lc str)
    207   (warning "cannot understand pathname locale values" str)
     208  (warning "cannot understand Posix pathname locale values" str)
    208209  #f )
    209210
     
    235236
    236237(define (set-posix-locale-categories func)
     238  ; Will not override existing category value
    237239  (for-each
    238240   (lambda (p)
    239241     (let ((cat (cdr p)))
    240        ; Will not override existing category value
    241242       (unless (locale-category-ref cat)
    242243         (cond ((func (car p) cat) => (cute set-locale-category! cat <>))) ) ) )
     
    281282        ; Else set individually, w/ LANG as default
    282283        (let* ((str (nonnull-getenv "LANG"))
    283                (lc (and str
    284                         (posix-locale-string->locale-components str))))
     284               (lc (and str (posix-locale-string->locale-components str))))
    285285          (set-posix-locale-categories
    286286           (lambda (e c)
    287              (cond ((nonnull-getenv e)
    288                     => (cute posix-locale-string->locale-components <>))
    289                    (else
    290                     lc)))) ) ) ) )
     287             (cond ((nonnull-getenv e) => (cute posix-locale-string->locale-components <>))
     288                   (else lc)))) ) ) ) )
    291289
    292290;; GNU LANGUAGE (PATH-sytle list of LANG)
  • release/3/locale/trunk/locale.meta

    r13860 r13881  
    1616        "locale-components.scm"
    1717        "locale-posix.scm"
     18        "locale-builtin.scm"
    1819        "locale-errors.scm"
    1920        "locale.setup"))
  • release/3/locale/trunk/locale.scm

    r13878 r13881  
    1212  (no-procedure-checks)
    1313  (export
    14     UNKNOWN-LOCAL-TZ-NAME
    15     BUILTIN-SOURCE
    1614    current-timezone
    1715    current-locale
     
    1917    current-locale-components) )
    2018
    21 (require-extension posix miscmacros locale-posix locale-components locale-categories locale-errors)
     19(require-extension locale-builtin locale-posix locale-components locale-categories locale-errors)
    2220
    2321;;;
    24 
    25 (define (check-string-or-false loc obj)
    26   (unless (or (not obj) (string? obj))
    27     (type-error loc "string or #f" obj) ) )
    2822
    2923;;
    3024
    3125(define (current-timezone . args)
    32   (cond ((null? args)
    33           (and-let* ((lc (locale-category-ref 'timezone)))
    34             (locale-component-ref lc 'name) ) )
    35         (else
    36           (let-optionals args ((str #f) (src "USER"))
    37             (check-string-or-false 'current-timezone str)
    38             (let ((lc (and str (posix-timezone-string->timezone-components str src))))
    39               (set-locale-category! 'timezone lc) ) ) ) ) )
     26  (if (null? args)
     27      (and-let* ((lc (locale-category-ref 'timezone))) (locale-component-ref lc 'name) )
     28      (let-optionals args ((obj #f) (src "USER"))
     29        (cond ((not obj)
     30               (set-locale-category! 'timezone #f) )
     31              ((string? obj)
     32               (set-locale-category!
     33                'timezone
     34                (posix-timezone-string->timezone-components obj src)) )
     35              ((timezone-components? obj)
     36               (set-locale-category! 'timezone obj) )
     37              (else
     38               (warning 'current-timezone (make-type-error-message "string, #f or timezone-components") obj)
     39               (current-timezone) ) ) ) ) )
    4040
    4141;; A'la MzScheme
     
    4343
    4444(define (current-locale . args)
    45   (cond ((null? args)
    46           (and-let* ((lc (locale-category-ref 'messages)))
    47             (locale-component-ref lc 'name) ) )
    48         (else
    49           (let-optionals args ((str #f) (src "USER"))
    50             (check-string-or-false 'current-locale str)
    51             (let ((lc (and str (posix-locale-string->locale-components str src))))
    52               (set-locale-category! 'messages lc) ) ) ) ) )
     45  (if (null? args)
     46      (and-let* ((lc (locale-category-ref 'messages))) (locale-component-ref lc 'name) )
     47      (let-optionals args ((obj #f) (src "USER"))
     48        (cond ((not obj)
     49               (set-locale-category! 'messages #f) )
     50              ((string? obj)
     51               (set-locale-category!
     52                'messages
     53                (posix-locale-string->locale-components obj src)) )
     54              ((and (not (timezone-components? obj)) (locale-components? obj))
     55               (set-locale-category! 'messages obj) )
     56              (else
     57               (warning 'current-locale (make-type-error-message "string, #f or locale-components") obj)
     58               (current-locale) ) ) ) ) )
    5359
    5460;;
     
    5763
    5864(define (current-locale-components) (locale-category-ref 'messages))
    59 
    60 ;;; When no environment info use Plan B
    61 
    62 (define BUILTIN-SOURCE "BUILTIN")
    63 (define UNKNOWN-LOCAL-TZ-NAME "XXXX")
    64 
    65 ;; Builtin Timezone
    66 
    67 ;; Daylight saving time offset from standard offset.
    68 ;; ("spring forward" add it, "fall back" subtract it)
    69 
    70 (define-constant DEFAULT-DST-OFFSET 3600)
    71 
    72 (define (local-timezone-name) (or (local-timezone-abbreviation) UNKNOWN-LOCAL-TZ-NAME))
    73 
    74 (define (make-builtin-timezone)
    75   ; Need local timezone info
    76   (let* ((tv (seconds->local-time (current-seconds)))
    77          (dstf (vector-ref tv 8))
    78          (tzn (local-timezone-name)) )
    79     (cond-expand
    80       (macosx
    81         ; Since the tzo reflects the dst status need to fake the one not in effect.
    82         (let ((tzo (vector-ref tv 9)))
    83           (if dstf
    84               (make-posix-timezone UNKNOWN-LOCAL-TZ-NAME (+ tzo DEFAULT-DST-OFFSET) tzn tzo)
    85               (make-posix-timezone tzn tzo UNKNOWN-LOCAL-TZ-NAME (- tzo DEFAULT-DST-OFFSET)) ) ) )
    86       (else
    87         ; Since only the standard tzn & tzo are available need to
    88         ; fake summer time.
    89         (let ((tzo (vector-ref tv 9)))
    90           (make-posix-timezone tzn tzo UNKNOWN-LOCAL-TZ-NAME (- tzo DEFAULT-DST-OFFSET)) ) ) ) ) )
    91 
    92 (define (use-builtin-timezone)
    93   (current-timezone (make-builtin-timezone) BUILTIN-SOURCE) )
    94 
    95 ;; Builtin Locale
    96 
    97 (define-constant DEFAULT-LANGUAGE "en")
    98 (define-constant DEFAULT-REGION "US")
    99 
    100 (define (make-builtin-locale-string)
    101   (string-append DEFAULT-LANGUAGE "_" DEFAULT-REGION) )
    102 
    103 (define (use-builtin-locale)
    104   (current-locale (make-builtin-locale-string) BUILTIN-SOURCE) )
    105 
    106 ;; Builtin Language List
    107 
    108 (define (use-builtin-language)
    109   (and-let* ((msglc (locale-category-ref 'messages)))
    110     (let ((lc (make-locale-components (locale-component-ref msglc 'name) BUILTIN-SOURCE 'language)))
    111       (update-locale-components! lc 'locales (list msglc))
    112       (set-locale-category! 'language lc) ) ) )
    11365
    11466;;;
  • release/3/locale/trunk/locale.setup

    r13860 r13881  
    77(compile-dynld "locale-categories")
    88(compile-dynld "locale-posix")
     9(compile-dynld "locale-builtin")
    910(compile-dynld "locale")
    1011
     
    1415                ,(make-dynld-filename 'locale-categories)
    1516                ,(make-dynld-filename 'locale-components)
     17                ,(make-dynld-filename 'locale-builtin)
    1618                ,(make-dynld-filename 'locale-posix) )
    1719        `((version ,*version*)
     
    2224      ,(make-exports-filename 'locale-categories)
    2325      ,(make-exports-filename 'locale-components)
     26      ,(make-exports-filename 'locale-builtin)
    2427      ,(make-exports-filename 'locale-posix)) ) )
    2528
Note: See TracChangeset for help on using the changeset viewer.