source: project/release/4/locale/trunk/locale-categories.scm @ 15641

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

Save

File size: 2.2 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 chicken scheme)
16  (require-extension #;srfi-9
17                     miscmacros lookup-table
18                     locale-components locale-errors)
19
20  (declare
21    (fixnum)
22    (inline)
23    (no-procedure-checks) )
24
25;;
26
27(define (check-symbol loc obj)
28  (unless (symbol? obj)
29    (locale-type-error loc "symbol" obj) ) )
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)
39  (%make-locale-dictionary (make-dict)) )
40
41(define (check-locale-dictionary loc obj)
42  (unless (locale-dictionary? obj)
43    (locale-type-error loc "locale-dictionary" obj) ) )
44;;
45
46(define (set-locale-dictionary-category! rec key val)
47  (check-locale-dictionary 'set-locale-dictionary-category! rec)
48  (check-symbol 'set-locale-dictionary-category! key)
49  (let ((tbl (locale-dictionary-table rec)))
50    (cond ((not val) (dict-delete! tbl key))
51          (else
52           (check-locale-components 'set-locale-dictionary-category! val)
53           (dict-set! tbl key val) ) ) ) )
54
55;; A locale-component or #f
56
57(define (locale-dictionary-category rec key #!optional def)
58  (check-locale-dictionary 'locale-dictionary-category rec)
59  (check-symbol 'locale-dictionary-category key)
60        (dict-ref (locale-dictionary-table rec) key def) )
61
62;;;
63
64;;
65
66(define-parameter current-locale-dictionary (make-locale-dictionary)
67  (lambda (obj)
68    (cond ((locale-dictionary? obj) obj)
69          (else
70           (warning 'current-locale-dictionary (make-locale-type-error-message "locale-dictionary") obj)
71           (current-locale-dictionary) ) ) ) )
72
73;;
74
75(define (set-locale-category! what value)
76  (set-locale-dictionary-category! (current-locale-dictionary) what value) )
77
78;; A locale-component or #f
79
80(define (locale-category-ref what #!optional def)
81        (locale-dictionary-category (current-locale-dictionary) what def) )
82
83) ;module locale-categories
Note: See TracBrowser for help on using the repository browser.