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

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

Save

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