source: project/release/4/srfi-19/trunk/srfi-19-timezone.scm @ 35407

Last change on this file since 35407 was 35407, checked in by Kon Lovett, 3 years ago

locale does delayed init

File size: 2.9 KB
Line 
1;;;;srfi-19-timezone.scm
2
3(module srfi-19-timezone
4
5(;export
6  local-timezone-locale
7  utc-timezone-locale
8  #;make-timezone-locale
9  timezone-locale-name
10  timezone-locale-offset
11  timezone-locale-dst?
12  timezone-name?
13  check-timezone-name
14  timezone-info?
15  error-timezone-name
16  check-timezone-info
17  error-timezone-info
18  checked-optional-timezone-info)
19
20(import scheme)
21
22(import chicken)
23
24(use miscmacros locale type-checks type-errors)
25
26;;;Timezone Locale Object (Public Immutable, but not enforced)
27
28(define-inline (make-utc-timezone)
29  (let ((tzc (make-timezone-components "UTC0" (builtin-source-name))))
30    (update-timezone-components! tzc 'std-name "UTC" 'std-offset 0) ) )
31
32(define-inline (timezone-components-ref/dst? tzc a b)
33  (timezone-component-ref tzc (if (timezone-component-ref tzc 'dst?) a b)) )
34
35;;
36
37(define-parameter local-timezone-locale (current-timezone-components)
38  (lambda (x)
39    (cond
40      ((timezone-components? x)
41        x )
42      (else
43        (warning-argument-type 'local-timezone-locale x 'timezone-components)
44        (local-timezone-locale) ) ) ) )
45
46(define-parameter utc-timezone-locale (make-utc-timezone)
47  (lambda (x)
48    (cond
49      ((timezone-components? x)
50        x )
51      (else
52        (warning-argument-type 'utc-timezone-locale x 'timezone-components)
53        (utc-timezone-locale) ) ) ) )
54
55;;
56
57#;;Unusued
58(define (make-timezone-locale nam off dst?)
59  (update-timezone-components! (make-timezone-components #f "SRFI 19")
60    (if dst? 'dst-name 'std-name) nam
61    (if dst? 'dst-offset 'std-offset) (- off) ;ISO 8601 -> locale
62    'dst? dst?) )
63
64(define (timezone-locale-name . tzc)
65  (let ((tzc (optional tzc (local-timezone-locale))))
66    (check-timezone-components 'timezone-locale-name tzc)
67    (let ((tzn (timezone-components-ref/dst? tzc 'dst-name 'std-name)))
68      ;TZ may not be set
69      (and
70        (not (unknown-timezone-name? tzn))
71        tzn ) ) ) )
72
73(define (timezone-locale-offset . tzc)
74  (let ((tzc (optional tzc (local-timezone-locale))))
75    (check-timezone-components 'timezone-locale-offset tzc)
76    (let ((tzo (timezone-components-ref/dst? tzc 'dst-offset 'std-offset)))
77      ;TZ may not be set but if it is then convert to ISO 8601
78      (if tzo (- tzo)
79          0 ) ) ) )
80
81(define (timezone-locale-dst? . tzc)
82  (let ((tzc (optional tzc (local-timezone-locale))))
83    (check-timezone-components 'timezone-locale-offset tzc)
84    (timezone-component-ref tzc 'dst?) ) )
85
86;;
87
88(define (timezone-name? obj) (or (not obj) (string? obj)))
89(define (timezone-info? obj) (or (timezone-components? obj) (timezone-offset? obj)))
90
91(define-check+error-type timezone-name)
92(define-check+error-type timezone-info)
93
94;;
95
96(define (checked-optional-timezone-info loc tzi)
97  (cond
98    ((not tzi)                    (utc-timezone-locale))
99    ((boolean? tzi)               (local-timezone-locale))
100    ((timezone-components? tzi)   tzi)
101    ((fixnum? tzi)                tzi)
102    (else
103      (error-timezone-info loc tzi)) ) )
104
105) ;module srfi-19-timezone
Note: See TracBrowser for help on using the repository browser.