source: project/release/3/locale/trunk/locale.scm @ 13852

Last change on this file since 13852 was 13852, checked in by Kon Lovett, 12 years ago

Added errors file.

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