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

;; Issues
;;
;; - Only Posix for now.

(module locale-current (;export
  current-timezone
  current-locale
  current-timezone-components
  current-locale-components)

  (import chicken scheme)
  (require-extension posix
                     type-checks type-errors
                     locale-builtin locale-posix locale-components locale-categories)

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

;;;

(define-inline (%current-dstflag) (vector-ref (seconds->local-time (current-seconds)) 8))

(define-inline (%locale-category+component-ref catnam cmpnam)
  (and-let* ((lc (locale-category-ref catnam))) (locale-component-ref lc cmpnam)) )

;;; Parameters (Well, parameter-like)

;;

(define (current-timezone . args)
  (if (null? args) (%locale-category+component-ref 'timezone 'name)
      (let-optionals args ((obj #f) (src "USER"))
        (cond ((not obj)
               (set-locale-category! 'timezone #f) )
              ((string? obj)
               (set-locale-category!
                'timezone
                (posix-timezone-string->timezone-components obj src)) )
              ((timezone-components? obj)
               (set-locale-category! 'timezone obj) )
              (else
               (warning 'current-timezone (make-error-type-message "string, #f or timezone-components") obj)
               (current-timezone) ) ) ) ) )

;; A'la MzScheme
;; Treat locale as messages category

(define (current-locale . args)
  (if (null? args) (%locale-category+component-ref 'messages 'name)
      (let-optionals args ((obj #f) (src "USER"))
        (cond ((not obj)
               (set-locale-category! 'messages #f) )
              ((string? obj)
               (set-locale-category!
                'messages
                (posix-locale-string->locale-components obj src)) )
              ((and (not (timezone-components? obj)) (locale-components? obj))
               (set-locale-category! 'messages obj) )
              (else
               (warning 'current-locale (make-error-type-message "string, #f or locale-components") obj)
               (current-locale) ) ) ) ) )

;;

(define (current-timezone-components) (locale-category-ref 'timezone))
(define (current-locale-components) (locale-category-ref 'messages))

;;;
;;; Module Init
;;;

;; Use Posix locale system

(unless (current-timezone) (posix-load-timezone))
(unless (current-locale) (posix-load-locale))
(unless (locale-category-ref 'language) (gnu-load-locale))

;; Use Builtin (fake) locale system

(unless (current-timezone) (use-builtin-timezone))
(unless (current-locale) (use-builtin-locale))
(unless (locale-category-ref 'language) (use-builtin-language))

;; Chicken platform extensions

(when (current-timezone-components)
  (set-timezone-component! (current-timezone-components) 'dst? (%current-dstflag)) )

;; We really should have something by now

(unless (current-timezone-components) (warning "cannot determine a timezone") )
(unless (current-locale-components) (warning "cannot determine a locale") )

) ;module locale