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

Last change on this file since 35363 was 35363, checked in by kon, 16 months ago

use csi+csc test runner

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