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

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

Save. Mvd params into locale.scm

File size: 2.0 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    current-locale-dictionary
17    locale-category-ref
18    set-locale-category!) )
19
20(require-extension srfi-9 miscmacros lookup-table locale-components locale-errors)
21
22;;
23
24(define (check-symbol loc obj)
25  (unless (symbol? obj)
26    (type-error loc "symbol" obj) ) )
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(define (check-locale-dictionary loc obj)
39  (unless (locale-dictionary? obj)
40    (type-error loc "locale-dictionary" obj) ) )
41;;
42
43(define (set-locale-dictionary-category! rec key val)
44  (check-locale-dictionary 'set-locale-dictionary-category! rec)
45  (check-symbol 'set-locale-dictionary-category! key)
46  (let ((tbl (locale-dictionary-table rec)))
47    (if (not val) (dict-delete! tbl key)
48        (begin
49          (check-locale-components 'set-locale-dictionary-category! val)
50          (dict-set! tbl key val) ) ) ) )
51
52;; A locale-component or #f
53
54(define (locale-dictionary-category rec key)
55  (check-locale-dictionary 'locale-dictionary-category rec)
56  (check-symbol 'locale-dictionary-category key)
57        (dict-ref (locale-dictionary-table rec) key) )
58
59;;;
60
61;;
62
63(define-parameter current-locale-dictionary (make-locale-dictionary)
64  (lambda (obj)
65    (cond ((locale-dictionary? obj)
66            obj)
67          (else
68            (warning 'current-locale-dictionary (make-type-error-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)
79        (locale-dictionary-category (current-locale-dictionary) what) )
Note: See TracBrowser for help on using the repository browser.