source: project/release/3/locale/trunk/locale-categories.scm @ 13852

Last change on this file since 13852 was 13852, checked in by Kon Lovett, 12 years ago

Added errors file.

File size: 1.5 KB
Line 
1;;;; locale-categories.scm
2;;;; Kon Lovett, May '06
3
4(declare
5  (usual-integrations)
6  (fixnum)
7  (inline)
8  (no-procedure-checks)
9  (export
10    ;
11    make-locale-dictionary
12    locale-dictionary?
13    set-locale-dictionary-category!
14    locale-dictionary-category
15    ;
16    locale-category-ref
17    set-locale-category!) )
18
19(require-extension srfi-9 lookup-table locale-components locale-errors)
20
21;;
22
23(define (check-symbol loc obj)
24  (unless (symbol? obj)
25    (type-error loc "symbol" obj) ) )
26
27
28;;;
29
30(define-record-type locale-dictionary
31  (%make-locale-dictionary tbl)
32  locale-dictionary?
33  (tbl locale-dictionary-table) )
34
35(define (make-locale-dictionary)
36  (%make-locale-dictionary (make-dict)) )
37
38;;
39
40(define (set-locale-dictionary-category! rec key val)
41  (check-locale-dictionary 'set-locale-dictionary-category! rec)
42  (check-symbol 'set-locale-dictionary-category! key)
43  (if (not val) (dict-delete! (locale-dictionary-table rec) key)
44      (begin
45        (check-locale-components 'set-locale-dictionary-category! val)
46        (dict-set! (locale-dictionary-table rec) key val) ) ) )
47
48;; A locale-component or #f
49
50(define (locale-dictionary-category rec key)
51  (check-locale-dictionary 'locale-dictionary-category rec)
52  (check-symbol 'locale-dictionary-category key)
53        (dict-ref (locale-dictionary-table rec) key) )
54
55;;;
56
57;;
58
59(define (set-locale-category! what value)
60  (set-locale-dictionary-category! (current-locale-dictionary) what value) )
61
62;; A locale-component or #f
63
64(define (locale-category-ref what)
65        (locale-dictionary-category (current-locale-dictionary) what) )
Note: See TracBrowser for help on using the repository browser.