;;;; 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 scheme chicken)
(use
  #;srfi-9
  (only miscmacros define-parameter)
  (only lookup-table make-dict dict-delete! dict-set! dict-ref)
  type-checks type-errors
  locale-components)

;;;

(define-record-type locale-dictionary
  (%make-locale-dictionary dict)
  locale-dictionary?
  (dict locale-dictionary-dict) )

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

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

;;

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

;; A locale-component or #f

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

;;;

;;

(define-parameter current-locale-dictionary (make-locale-dictionary)
  (lambda (x)
    (cond
      ((locale-dictionary? x)
        x )
      (else
        (warning 'current-locale-dictionary (make-error-type-message "locale-dictionary") x)
        (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