Changeset 13852 in project
- Timestamp:
- 03/21/09 02:31:41 (12 years ago)
- Location:
- release/3/locale/trunk
- Files:
-
- 1 added
- 7 edited
Legend:
- Unmodified
- Added
- Removed
-
release/3/locale/trunk/locale-categories.scm
r12818 r13852 2 2 ;;;; Kon Lovett, May '06 3 3 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!) ) 20 18 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 25 27 26 28 ;;; … … 39 41 (check-locale-dictionary 'set-locale-dictionary-category! rec) 40 42 (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) 43 44 (begin 44 45 (check-locale-components 'set-locale-dictionary-category! val) -
release/3/locale/trunk/locale-components.scm
r12818 r13852 9 9 ;; platform specific code. May switch to records later & deprecate the existing interface. 10 10 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) 48 45 49 46 ;;; … … 51 48 ;; 52 49 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)) 76 51 77 52 ;;; Association List Operations … … 80 55 81 56 (define (%locale-component-exists? al what) 82 ( ->boolean (assq what al)) )57 (%->boolean (assq what al)) ) 83 58 84 59 (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) 88 62 (optional def #f) ) ) ) 89 63 … … 91 65 92 66 (define (%set-locale-component! al what value) 93 (let ( [p (assq what al)])67 (let ((p (assq what al))) 94 68 (cond (p 95 69 (set-cdr! p value)) … … 103 77 104 78 (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 108 81 (begin 109 82 (set-locale-component! lc (car key-val-lst) (cadr key-val-lst)) … … 115 88 116 89 (define (timezone-dst-rule-julian-noleap? r) 117 (let ( [d (car r)])90 (let ((d (car r))) 118 91 (and (= 2 (length d)) (= 1 (car d))) ) ) 119 92 … … 121 94 122 95 (define (timezone-dst-rule-julian-leap? r) 123 (let ( [d (car r)])96 (let ((d (car r))) 124 97 (and (= 2 (length d)) (= 0 (car d))) ) ) 125 98 … … 127 100 128 101 (define (timezone-dst-rule-mwd? r) 129 (let ( [d (car r)])102 (let ((d (car r))) 130 103 (= 3 (length d)) ) ) 131 104 … … 180 153 181 154 (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))) 184 157 (%set-locale-component! lc 'tag tag) 185 158 (%set-locale-component! lc 'name nam) -
release/3/locale/trunk/locale-parameters.scm
r12818 r13852 6 6 ;; - Only Posix for now. 7 7 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) ) 21 19 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) ) ) 27 27 28 28 ;; … … 34 34 (else 35 35 (warning 'current-locale-dictionary (make-type-error-message "a locale-dictionary") obj) 36 (current-locale-dictionary) ))))36 (current-locale-dictionary) ) ) ) ) 37 37 38 38 ;; 39 39 40 40 (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) ) ) ) ) ) 51 49 52 50 ;; A'la MzScheme … … 54 52 55 53 (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) ) ) ) ) ) 66 62 67 63 ;;; 68 64 65 (define (current-timezone-components) (locale-category-ref 'timezone)) 69 66 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)) 75 68 76 69 ;; … … 78 71 #; 79 72 (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))) 82 75 (lambda args 83 (cond [(null? args)84 (let ( [timezone (current-timezone)])76 (cond ((null? args) 77 (let ((timezone (current-timezone))) 85 78 (unless (equal? cached-timezone timezone) 86 79 (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))) 89 82 (current-timezone-components timezone tzc) 90 83 #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)) 93 86 (set! cached-timezone (car args)) 94 (set! cached-components (cadr args)) ]95 [else96 (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) ) ) 97 90 cached-components ) ) ) 98 91 … … 101 94 #; 102 95 (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))) 105 98 (lambda args 106 (cond [(null? args)107 (let ( [locale (current-locale)])99 (cond ((null? args) 100 (let ((locale (current-locale))) 108 101 (unless (equal? cached-locale locale) 109 102 (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))) 112 105 (current-locale-components locale lc) 113 106 #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)) 116 109 (set! cached-locale (car args)) 117 (set! cached-components (cadr args)) ]118 [else119 (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) ) ) 120 113 cached-components ) ) ) -
release/3/locale/trunk/locale-posix.scm
r12818 r13852 9 9 ;; will still be #f, while some locale-categories will be valued 10 10 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) 32 26 33 27 ;;; … … 36 30 37 31 (define (nonnull-getenv varnam) 38 (let ( [str (getenv "TZ")])32 (let ((str (getenv "TZ"))) 39 33 (and (string? str) 40 34 (not (string-null? str)) … … 47 41 48 42 (define make-posix-timezone 49 (let ( [hms43 (let ((hms 50 44 (lambda (secs) 51 (let* ( [asecs (abs secs)]52 [rsecs (remainder asecs SEC/HR)])45 (let* ((asecs (abs secs)) 46 (rsecs (remainder asecs SEC/HR))) 53 47 (string-append 54 48 (if (negative? secs) "-" "+") 55 49 (number->string (quotient asecs SEC/HR)) 56 50 ":" (number->string (quotient rsecs SEC/MIN)) 57 ":" (number->string (remainder rsecs SEC/MIN))))) ])51 ":" (number->string (remainder rsecs SEC/MIN))))))) 58 52 (lambda (dst-tzn dst-off std-tzn std-off) 59 53 (string-append dst-tzn (hms dst-off) std-tzn (hms std-off)) ) ) ) … … 69 63 70 64 (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)) 76 70 (lambda (tz str) 77 (let ( [strpos 0]78 [strend (string-length str)])71 (let ((strpos 0) 72 (strend (string-length str))) 79 73 (letrec ( 80 [next-match74 (next-match 81 75 (lambda (re) 82 (and-let* ( [ml (string-match re str strpos)])76 (and-let* ((ml (string-match re str strpos))) 83 77 (set! strpos (+ strpos (string-length (car ml)))) 84 ml ) ) ]85 [all-parsed86 (lambda () (>= strpos strend)) ]87 [fake-dst-rule78 ml ) )) 79 (all-parsed 80 (lambda () (>= strpos strend))) 81 (fake-dst-rule 88 82 (lambda () 89 83 (set-timezone-component! tz 'dst-start (make-timezone-dst-rule-mwd 4 1 0 +defoff+)) 90 84 (set-timezone-component! tz 'dst-end (make-timezone-dst-rule-mwd 10 5 0 +defoff+)) 91 #t) ]92 [to-num85 #t)) 86 (to-num 93 87 (lambda (numstr) 94 88 (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-offset89 (cond ((not numstr) "0") 90 ((string-prefix? ":" numstr) (string-trim numstr #\:)) 91 ((string-prefix? "." numstr) (string-trim numstr #\.)) 92 (else numstr))))) 93 (to-offset 100 94 (lambda (sgnstr hms-lst) 101 (let ( [secs (+ (* (string->number (car hms-lst)) 3600)95 (let ((secs (+ (* (string->number (car hms-lst)) 3600) 102 96 (* (to-num (cadr hms-lst)) 60) 103 (to-num (caddr hms-lst))) ])104 (if (equal? sgnstr "-") (- secs) secs))) ]105 [parse-nam+off97 (to-num (caddr hms-lst))))) 98 (if (equal? sgnstr "-") (- secs) secs)))) 99 (parse-nam+off 106 100 (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))) 109 103 (set-timezone-component! tz namkey (cadr n-m)) 110 104 (set-timezone-component! tz offkey (to-offset (cadr o-m) (cddr o-m))) 111 #t ) ) ]112 [decode-dst-rule105 #t ) )) 106 (decode-dst-rule 113 107 (lambda (rulstr dat-lst off) 114 (let ( [n1 (string->number (car dat-lst))])108 (let ((n1 (string->number (car dat-lst)))) 115 109 (if (not rulstr) 116 110 ; Then assume Julian style rule 117 111 (make-timezone-dst-rule-julian-leap n1 off) 118 112 ; Else select rule 119 (let ( [rch (string-ref rulstr 0)])113 (let ((rch (string-ref rulstr 0))) 120 114 (case rch 121 [(#\J) ; Julian122 (make-timezone-dst-rule-julian-noleap n1 off) ]123 [(#\M) ; Date115 ((#\J) ; Julian 116 (make-timezone-dst-rule-julian-noleap n1 off)) 117 ((#\M) ; Date 124 118 (make-timezone-dst-rule-mwd n1 (to-num (cadr dat-lst)) 125 (to-num (caddr dat-lst)) off) ]126 [else119 (to-num (caddr dat-lst)) off)) 120 (else 127 121 (warning "unknown DST rule type; assuming julian-leap" rch) 128 (make-timezone-dst-rule-julian-leap n1 off) ] ) ) ) ) ) ]129 [parse-dst-rule122 (make-timezone-dst-rule-julian-leap n1 off) ) ) ) ) ) ) ) 123 (parse-dst-rule 130 124 (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+))) 134 128 (set-timezone-component! tz key (decode-dst-rule (cadr d-m) (cddr d-m) off)) 135 #t))) ])129 #t)))) ) 136 130 ; Walk the match set 137 131 (and ; At least standard timezone info … … 158 152 159 153 (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 [else166 (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) ) ) ) ) 167 161 168 162 ;; Splits an IEEEÊStdÊ1003.1-2001 locale specifier string into … … 172 166 ;; Returns a locale-components object or #f, indicating a parse error. 173 167 ;; 174 ;; name: language [-script][_territory][.codeset][@modifier]168 ;; name: language(-script)(_territory)(.codeset)(@modifier) 175 169 ;; language: ISO 639-1 or ISO 639-2 176 170 ;; script: RFC 3066bis … … 180 174 181 175 (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)+)?(\\.(^@)+)?(@.+)?"))) 183 177 (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-len178 (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 192 186 (lambda (v) 193 (set! matched-len (+ matched-len (string-length v)))) ])187 (set! matched-len (+ matched-len (string-length v)))))) 194 188 (when l 195 189 (inc-matched-len l) … … 215 209 216 210 (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 [else224 (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) ) ) ) ) ) 225 219 226 220 ;; The POSIX/GNU locale categories … … 252 246 253 247 (define (gnu-language-string->locale-components str . args) 254 (let-optionals args ( [src "GNU"] [tag 'language])255 (let ( [lst248 (let-optionals args ((src "GNU") (tag 'language)) 249 (let ((lst 256 250 (map 257 251 (lambda (lclstr) 258 (let ( [lc (posix-locale-string->locale-components lclstr src)])252 (let ((lc (posix-locale-string->locale-components lclstr src))) 259 253 (unless (locale-component-ref lc 'region) 260 254 (set-locale-component! lc 261 255 'region (string-upcase (locale-component-ref lc 'language))) ) 262 256 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))) 265 259 (set-locale-components! lc 'locales lst) 266 260 lc ) ) ) ) … … 272 266 (define (posix-load-timezone) 273 267 (unless (locale-category-ref 'timezone) 274 (and-let* ( [str (nonnull-getenv "TZ")])268 (and-let* ((str (nonnull-getenv "TZ"))) 275 269 (let ((lc (posix-timezone-string->timezone-components str "POSIX"))) 276 270 (set-locale-category! 'timezone lc)) ) ) ) … … 280 274 (define (posix-load-locale) 281 275 ; POSIX standard 282 (let ( [str (nonnull-getenv "LC_ALL")])276 (let ((str (nonnull-getenv "LC_ALL"))) 283 277 (if str 284 278 ; Then LC_ALL overrides 285 (let ( [lc (posix-locale-string->locale-components str)])279 (let ((lc (posix-locale-string->locale-components str))) 286 280 (set-posix-locale-categories (lambda (e c) lc)) ) 287 281 ; Else set individually, w/ LANG as default 288 (let* ( [str (nonnull-getenv "LANG")]289 [lc (and str290 (posix-locale-string->locale-components str)) ])282 (let* ((str (nonnull-getenv "LANG")) 283 (lc (and str 284 (posix-locale-string->locale-components str)))) 291 285 (set-posix-locale-categories 292 286 (lambda (e c) … … 300 294 (define (gnu-load-locale) 301 295 (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))) 304 298 (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 Keys172 <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 Values179 <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 "name" 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 "name" 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 "PST". A Daylight Saving Time start rule and end rule are optional properties.</p><table class="symbol-table">Timezone Component Properties204 <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->timezone-components STRING [SOURCE "POSIX"])</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 Properties280 <tr>281 <td class="symbol">language</td>282 <td>ISO 639-1 or ISO 639-2 name string. Default "en".</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 "US".</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->locale-components STRING [SOURCE "POSIX"])</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 Keys320 <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 "default" timezone & 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 & 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 a384 copy of this software and associated documentation files (the Software),385 to deal in the Software without restriction, including without limitation386 the rights to use, copy, modify, merge, publish, distribute, sublicense,387 and/or sell copies of the Software, and to permit persons to whom the388 Software is furnished to do so, subject to the following conditions:389 390 The above copyright notice and this permission notice shall be included391 in all copies or substantial portions of the Software.392 393 THE SOFTWARE IS PROVIDED ASIS, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR394 IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,395 FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL396 THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR397 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 OR399 OTHER DEALINGS IN THE SOFTWARE.</pre></div></div>400 <div id="footer">401 <hr /><a href="index.html">< Egg index</a>402 <div id="revision-history">$Revision$ $Date$</div> </div></body></html> -
release/3/locale/trunk/locale.meta
r12812 r13852 16 16 "locale-components.scm" 17 17 "locale-posix.scm" 18 "locale-errors.scm" 18 19 "locale.html" 19 20 "locale.setup")) -
release/3/locale/trunk/locale.scm
r12818 r13852 6 6 ;; - Only Posix for now. 7 7 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) ) 18 16 19 (require-extension 20 posix 21 locale-posix 22 locale-components 23 locale-parameters) 17 (require-extension posix locale-posix locale-components locale-parameters) 24 18 25 19 ;;; When no environment info use Plan B 26 20 27 21 (define BUILTIN-SOURCE "BUILTIN") 22 (define UNKNOWN-LOCAL-TZ-NAME "XXXX") 28 23 29 24 ;; Builtin Timezone … … 34 29 (define-constant DEFAULT-DST-OFFSET 3600) 35 30 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)) 41 32 42 33 (define (make-builtin-timezone) 43 34 ; 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)) ) 47 38 (cond-expand 48 [macosx39 (macosx 49 40 ; 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))) 51 42 (if dstf 52 43 (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 [else44 (make-posix-timezone tzn tzo UNKNOWN-LOCAL-TZ-NAME (- tzo DEFAULT-DST-OFFSET)) ) ) ) 45 (else 55 46 ; Since only the standard tzn & tzo are available need to 56 47 ; 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)) ) ) ) ) ) 59 50 60 51 (define (use-builtin-timezone) … … 75 66 76 67 (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))) 79 70 (set-locale-components! lc 'locales (list msglc)) 80 71 (set-locale-category! 'language lc) ) ) ) … … 94 85 ;; time info. 95 86 96 (unless (current-timezone) 97 (use-builtin-timezone) ) 87 (unless (current-timezone) (use-builtin-timezone)) 98 88 99 (unless (current-locale) 100 (use-builtin-locale) ) 89 (unless (current-locale) (use-builtin-locale)) 101 90 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.