source: project/release/4/locale/tags/0.6.3/locale-categories.scm @ 15916

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

Rel 0.6.3 - David Murray's patch for TZ envvar parsing.

File size: 2.1 KB
Line 
1;;;; locale-categories.scm
2;;;; Kon Lovett, May '06
3
4(module locale-categories (;export
5  ;
6  make-locale-dictionary
7  locale-dictionary?
8  set-locale-dictionary-category!
9  locale-dictionary-category
10  ;
11  current-locale-dictionary
12  locale-category-ref
13  set-locale-category!)
14
15  (import scheme chicken
16          #;srfi-9
17          (only miscmacros define-parameter)
18          lookup-table
19          type-checks
20          type-errors
21          locale-components)
22
23  (require-library #;srfi-9 miscmacros lookup-table type-checks type-errors locale-components)
24
25  (declare
26    (fixnum)
27    (inline)
28    (local)
29    (no-procedure-checks) )
30
31;;;
32
33(define-record-type locale-dictionary
34  (%make-locale-dictionary tbl)
35  locale-dictionary?
36  (tbl locale-dictionary-table) )
37
38(define (make-locale-dictionary) (%make-locale-dictionary (make-dict)))
39
40(define-check+error-type locale-dictionary)
41
42;;
43
44(define (set-locale-dictionary-category! rec key val)
45  (check-locale-dictionary 'set-locale-dictionary-category! rec)
46  (check-symbol 'set-locale-dictionary-category! key)
47  (let ((tbl (locale-dictionary-table rec)))
48    (cond ((not val) (dict-delete! tbl key))
49          (else
50           (check-locale-components 'set-locale-dictionary-category! val)
51           (dict-set! tbl key val) ) ) ) )
52
53;; A locale-component or #f
54
55(define (locale-dictionary-category rec key #!optional def)
56  (check-locale-dictionary 'locale-dictionary-category rec)
57  (check-symbol 'locale-dictionary-category key)
58        (dict-ref (locale-dictionary-table rec) key def) )
59
60;;;
61
62;;
63
64(define-parameter current-locale-dictionary (make-locale-dictionary)
65  (lambda (obj)
66    (cond ((locale-dictionary? obj) obj)
67          (else
68           (warning 'current-locale-dictionary (make-error-type-message "locale-dictionary") obj)
69           (current-locale-dictionary) ) ) ) )
70
71;;
72
73(define (set-locale-category! what value)
74  (set-locale-dictionary-category! (current-locale-dictionary) what value) )
75
76;; A locale-component or #f
77
78(define (locale-category-ref what #!optional def)
79        (locale-dictionary-category (current-locale-dictionary) what def) )
80
81) ;module locale-categories
Note: See TracBrowser for help on using the repository browser.