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

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

Save

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