source: project/release/4/locale/tags/0.6.3/locale-current.scm @ 15916

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

Rel 0.6.3 - David Murray's patch for TZ envvar parsing.

File size: 3.1 KB
Line 
1;;;; locale-current.scm
2;;;; Kon Lovett, May '06
3
4;; Issues
5;;
6;; - Only Posix for now.
7
8(module locale-current (;export
9  current-timezone
10  current-locale
11  current-timezone-components
12  current-locale-components)
13
14  (import scheme chicken
15          (only posix seconds->local-time)
16          (only type-errors make-error-type-message)
17          locale-builtin locale-posix locale-components locale-categories)
18
19  (require-library posix type-errors locale-builtin locale-posix locale-components locale-categories)
20
21  (declare
22    (fixnum)
23    (inline)
24    (local)
25    (no-procedure-checks) )
26
27;;;
28
29(define-inline (%current-dstflag) (vector-ref (seconds->local-time (current-seconds)) 8))
30
31(define-inline (%locale-category+component-ref catnam cmpnam)
32  (and-let* ((lc (locale-category-ref catnam))) (locale-component-ref lc cmpnam)) )
33
34;;; Parameters (Well, parameter-like)
35
36;;
37
38(define (current-timezone . args)
39  (if (null? args) (%locale-category+component-ref 'timezone 'name)
40      (let-optionals args ((obj #f) (src "USER"))
41        (cond ((not obj)
42               (set-locale-category! 'timezone #f) )
43              ((string? obj)
44               (set-locale-category!
45                'timezone
46                (posix-timezone-string->timezone-components obj src)) )
47              ((timezone-components? obj)
48               (set-locale-category! 'timezone obj) )
49              (else
50               (warning 'current-timezone (make-error-type-message "string, #f or timezone-components") obj)
51               (current-timezone) ) ) ) ) )
52
53;; A'la MzScheme
54;; Treat locale as messages category
55
56(define (current-locale . args)
57  (if (null? args) (%locale-category+component-ref 'messages 'name)
58      (let-optionals args ((obj #f) (src "USER"))
59        (cond ((not obj)
60               (set-locale-category! 'messages #f) )
61              ((string? obj)
62               (set-locale-category!
63                'messages
64                (posix-locale-string->locale-components obj src)) )
65              ((and (not (timezone-components? obj)) (locale-components? obj))
66               (set-locale-category! 'messages obj) )
67              (else
68               (warning 'current-locale (make-error-type-message "string, #f or locale-components") obj)
69               (current-locale) ) ) ) ) )
70
71;;
72
73(define (current-timezone-components) (locale-category-ref 'timezone))
74(define (current-locale-components) (locale-category-ref 'messages))
75
76;;;
77;;; Module Init
78;;;
79
80;; Use Posix locale system
81
82(unless (current-timezone) (posix-load-timezone))
83(unless (current-locale) (posix-load-locale))
84(unless (locale-category-ref 'language) (gnu-load-locale))
85
86;; Use Builtin (fake) locale system
87
88(unless (current-timezone) (use-builtin-timezone))
89(unless (current-locale) (use-builtin-locale))
90(unless (locale-category-ref 'language) (use-builtin-language))
91
92;; Chicken platform extensions
93
94(when (current-timezone-components)
95  (set-timezone-component! (current-timezone-components) 'dst? (%current-dstflag)) )
96
97;; We really should have something by now
98
99(unless (current-timezone-components) (warning "cannot determine a timezone") )
100(unless (current-locale-components) (warning "cannot determine a locale") )
101
102) ;module locale
Note: See TracBrowser for help on using the repository browser.