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

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

Save

File size: 2.2 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  UNKNOWN-LOCAL-TZ-NAME
11  BUILTIN-SOURCE
12  ;
13  use-builtin-timezone
14  use-builtin-locale
15  use-builtin-language)
16
17  (import chicken scheme)
18  (require-extension posix
19                     locale-posix locale-components locale-categories locale-timezone)
20
21  (declare
22    (fixnum)
23    (inline)
24    (no-procedure-checks) )
25
26;;; When no environment info use Plan B
27
28(define BUILTIN-SOURCE "BUILTIN")
29(define UNKNOWN-LOCAL-TZ-NAME "XXXX")
30
31;; Builtin Timezone
32
33;; Daylight saving time offset from standard offset.
34;; ("spring forward" add it, "fall back" subtract it)
35
36(define-constant DEFAULT-DST-OFFSET 3600)
37
38(define (current-local-time) (seconds->local-time (current-seconds)))
39
40(define (local-timezone-name tv)
41  (local-timezone (+ (vector-ref tv 5) 1900) (vector-ref tv 4) (vector-ref tv 2)) )
42
43(define (make-builtin-timezone)
44  ; Need local timezone info
45  (let ((tv (current-local-time)))
46    (let ((tzn (local-timezone-name tv))
47          (tzo (vector-ref tv 9))
48          (dst? (vector-ref tv 8)) )
49      ; Since the tzo reflects the dst status need to fake the one not in effect.
50      (if dst?
51          (make-posix-timezone UNKNOWN-LOCAL-TZ-NAME (+ tzo DEFAULT-DST-OFFSET) tzn tzo)
52          (make-posix-timezone tzn tzo UNKNOWN-LOCAL-TZ-NAME (- tzo DEFAULT-DST-OFFSET)) ) ) ) )
53
54(define (use-builtin-timezone)
55  (set-locale-category!
56   'timezone
57   (posix-timezone-string->timezone-components (make-builtin-timezone) BUILTIN-SOURCE)) )
58
59;; Builtin Locale
60
61(define-constant DEFAULT-LANGUAGE "en")
62(define-constant DEFAULT-REGION "US")
63
64(define (make-builtin-locale-string)
65  (string-append DEFAULT-LANGUAGE "_" DEFAULT-REGION) )
66
67(define (use-builtin-locale)
68  (set-locale-category!
69   'messages 
70   (posix-locale-string->locale-components (make-builtin-locale-string) BUILTIN-SOURCE)) )
71
72;; Builtin Language List
73
74(define (use-builtin-language)
75  (and-let* ((msglc (locale-category-ref 'messages)))
76    (let ((lc (make-locale-components (locale-component-ref msglc 'name) BUILTIN-SOURCE 'language)))
77      (update-locale-components! lc 'locales (list msglc))
78      (set-locale-category! 'language lc) ) ) )
79
80) ;module locale-builtin
Note: See TracBrowser for help on using the repository browser.