source: project/release/4/locale/trunk/locale-current.scm @ 15682

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

Parse errors are now failures. Added type checking for components. Made posix tz name be almost anything.

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