;;;; locale-categories.scm
;;;; Kon Lovett, May '06

(module locale-categories (;export
  ;
  make-locale-dictionary
  locale-dictionary?
  set-locale-dictionary-category!
  locale-dictionary-category
  ;
  current-locale-dictionary
  locale-category-ref
  set-locale-category!)

  (import chicken scheme)
  (require-extension #;srfi-9
                     miscmacros lookup-table type-checks type-errors
                     locale-components)

  (declare
    (fixnum)
    (inline)
    (no-procedure-checks) )

;;;

(define-record-type locale-dictionary
  (%make-locale-dictionary tbl)
  locale-dictionary?
  (tbl locale-dictionary-table) )

(define (make-locale-dictionary) (%make-locale-dictionary (make-dict)))

(define-check+error-type locale-dictionary)

;;

(define (set-locale-dictionary-category! rec key val)
  (check-locale-dictionary 'set-locale-dictionary-category! rec)
  (check-symbol 'set-locale-dictionary-category! key)
  (let ((tbl (locale-dictionary-table rec)))
    (cond ((not val) (dict-delete! tbl key))
          (else
           (check-locale-components 'set-locale-dictionary-category! val)
           (dict-set! tbl key val) ) ) ) )

;; A locale-component or #f

(define (locale-dictionary-category rec key #!optional def)
  (check-locale-dictionary 'locale-dictionary-category rec)
  (check-symbol 'locale-dictionary-category key)
	(dict-ref (locale-dictionary-table rec) key def) )

;;;

;;

(define-parameter current-locale-dictionary (make-locale-dictionary)
  (lambda (obj)
    (cond ((locale-dictionary? obj) obj)
          (else
           (warning 'current-locale-dictionary (make-error-type-message "locale-dictionary") obj)
           (current-locale-dictionary) ) ) ) )

;;

(define (set-locale-category! what value)
  (set-locale-dictionary-category! (current-locale-dictionary) what value) )

;; A locale-component or #f

(define (locale-category-ref what #!optional def)
	(locale-dictionary-category (current-locale-dictionary) what def) )

) ;module locale-categories