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

(module locale-categories

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

(import scheme)
(import (chicken base))
(import type-checks)
(import type-errors)
(import locale-components)

;;;miscmacros define-parameter

(define-syntax define-parameter
  (syntax-rules ()
    ((define-parameter name value guard)
     (define name (make-parameter value guard)))
    ((define-parameter name value)
     (define name (make-parameter value)))
    ((define-parameter name)
     (define name (make-parameter (void))))))

;;;

#;
(define (alist-delete key al0 #!optional (test equal?))
  (let loop ((al al0) (ls '()))
    (cond
      ((null? al)            ls)
      ((test key (caar al))  (append! (reverse! ls) (cdr al)) )
      (else                  (loop (cdr al) (cons (car al) ls)) ) ) ) )

(define (alist-delete! key al0 #!optional (test equal?))
  (let loop ((al al0) (prv #f))
    (cond
      ((null? al)            al0)
      ((test key (caar al))  (if prv (begin (set-cdr! prv (cdr al)) al0) (cdr al)) )
      (else                  (loop (cdr al) al) ) ) ) )

;;;

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

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

;;

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

(define (locale-dictionary-ref rec key #!optional (def #f))
  (alist-ref key (locale-dictionary-dict rec) eq? def) )

(define (update-locale-dictionary! rec key val)
  (set-locale-dictionary-dict! rec (alist-update! key val (locale-dictionary-dict rec) eq?)) )

(define (delete-locale-dictionary! rec key)
  (set-locale-dictionary-dict! rec (alist-delete! key (locale-dictionary-dict rec) eq?)) )

;; A locale-component or #f

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

;;

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

;;;

;;

(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