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

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

local-timezone-locale init to (current-timezone-components) delayed till 1st use.

File size: 3.1 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 #f
38  (lambda (x)
39    (cond
40      ((or (not x) (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(define (local-timezone-locale*)
58  (or
59    (local-timezone-locale)
60    (begin
61      (local-timezone-locale (current-timezone-components))
62      (local-timezone-locale))) )
63
64;;
65
66#;;Unusued
67(define (make-timezone-locale nam off dst?)
68  (update-timezone-components! (make-timezone-components #f "SRFI 19")
69    (if dst? 'dst-name 'std-name) nam
70    (if dst? 'dst-offset 'std-offset) (- off) ;ISO 8601 -> locale
71    'dst? dst?) )
72
73(define (timezone-locale-name . tzc)
74  (let ((tzc (optional tzc (local-timezone-locale*))))
75    (check-timezone-components 'timezone-locale-name tzc)
76    (let ((tzn (timezone-components-ref/dst? tzc 'dst-name 'std-name)))
77      ;TZ may not be set
78      (and
79        (not (unknown-timezone-name? tzn))
80        tzn ) ) ) )
81
82(define (timezone-locale-offset . tzc)
83  (let ((tzc (optional tzc (local-timezone-locale*))))
84    (check-timezone-components 'timezone-locale-offset tzc)
85    (let ((tzo (timezone-components-ref/dst? tzc 'dst-offset 'std-offset)))
86      ;TZ may not be set but if it is then convert to ISO 8601
87      (if tzo (- tzo)
88          0 ) ) ) )
89
90(define (timezone-locale-dst? . tzc)
91  (let ((tzc (optional tzc (local-timezone-locale*))))
92    (check-timezone-components 'timezone-locale-offset tzc)
93    (timezone-component-ref tzc 'dst?) ) )
94
95;;
96
97(define (timezone-name? obj) (or (not obj) (string? obj)))
98(define (timezone-info? obj) (or (timezone-components? obj) (timezone-offset? obj)))
99
100(define-check+error-type timezone-name)
101(define-check+error-type timezone-info)
102
103;;
104
105(define (checked-optional-timezone-info loc tzi)
106  (cond
107    ((not tzi)                    (utc-timezone-locale))
108    ((boolean? tzi)               (local-timezone-locale*))
109    ((timezone-components? tzi)   tzi)
110    ((fixnum? tzi)                tzi)
111    (else
112      (error-timezone-info loc tzi)) ) )
113
114) ;module srfi-19-timezone
Note: See TracBrowser for help on using the repository browser.