source: project/release/4/locale/trunk/locale-builtin.scm @ 15915

Last change on this file since 15915 was 15915, checked in by Kon Lovett, 11 years ago

Use of scheme only in locale-timezone. Note about posix 'local-timezone-abbreviation' bug.

File size: 2.7 KB
Line 
1;;;; locale-builtin.scm
2;;;; Kon Lovett, Mar '09
3
4;; Issues
5;;
6;; - Only Posix for now.
7
8(module locale-builtin (;export
9  ;
10  builtin-source-name builtin-source-name?
11  unknown-timezone-name unknown-timezone-name?
12  ;
13  use-builtin-timezone
14  use-builtin-locale
15  use-builtin-language)
16
17  (import scheme chicken
18          (only posix seconds->local-time local-timezone-abbreviation)
19          locale-posix
20          locale-components
21          locale-categories
22          locale-timezone)
23
24  (require-library posix locale-posix locale-components locale-categories locale-timezone)
25
26  (declare
27    (fixnum)
28    (inline)
29    (local)
30    (no-procedure-checks) )
31
32;;; When no environment info use Plan B
33
34;FIXME use immutable core string
35
36(define-constant BUILTIN-SOURCE "BUILTIN")
37(define (builtin-source-name) BUILTIN-SOURCE)
38(define (builtin-source-name? x) (equal? BUILTIN-SOURCE x))
39
40(define-constant UNKNOWN-LOCAL-TZ-NAME "XXXX")
41(define (unknown-timezone-name) UNKNOWN-LOCAL-TZ-NAME)
42(define (unknown-timezone-name? x) (equal? UNKNOWN-LOCAL-TZ-NAME x))
43
44;; Builtin Timezone
45
46;; Daylight saving time offset from standard offset.
47;; ("spring forward" add it, "fall back" subtract it)
48
49(define-constant DEFAULT-DST-OFFSET 3600)
50
51(define (current-local-time) (seconds->local-time (current-seconds)))
52
53(define (local-timezone-name tv) (local-timezone tv))
54
55(define (make-builtin-timezone)
56  ; Need local timezone info
57  (let ((tv (current-local-time)))
58    (let ((tzn (local-timezone-name tv)
59               #; ;Not until Posix bug fixed
60               (local-timezone-abbreviation))
61          (tzo (vector-ref tv 9))
62          (dst? (vector-ref tv 8)) )
63      ; Since the tzo reflects the dst status need to fake the one not in effect.
64      (if dst?
65          (make-posix-timezone UNKNOWN-LOCAL-TZ-NAME (+ tzo DEFAULT-DST-OFFSET) tzn tzo)
66          (make-posix-timezone tzn tzo UNKNOWN-LOCAL-TZ-NAME (- tzo DEFAULT-DST-OFFSET)) ) ) ) )
67
68(define (use-builtin-timezone)
69  (set-locale-category!
70   'timezone
71   (posix-timezone-string->timezone-components (make-builtin-timezone) BUILTIN-SOURCE)) )
72
73;; Builtin Locale
74
75(define-constant DEFAULT-LANGUAGE "en")
76(define-constant DEFAULT-REGION "US")
77
78(define (make-builtin-locale-string)
79  (string-append DEFAULT-LANGUAGE "_" DEFAULT-REGION) )
80
81(define (use-builtin-locale)
82  (set-locale-category!
83   'messages
84   (posix-locale-string->locale-components (make-builtin-locale-string) BUILTIN-SOURCE)) )
85
86;; Builtin Language List
87
88(define (use-builtin-language)
89  (and-let* ((msglc (locale-category-ref 'messages)))
90    (let ((lc (make-locale-components (locale-component-ref msglc 'name) BUILTIN-SOURCE 'language)))
91      (update-locale-components! lc 'locales (list msglc))
92      (set-locale-category! 'language lc) ) ) )
93
94) ;module locale-builtin
Note: See TracBrowser for help on using the repository browser.