;;;; locale-builtin.scm
;;;; Kon Lovett, Mar '09

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

(module locale-builtin

  (;export
    ;
    builtin-source-name builtin-source-name?
    unknown-timezone-name unknown-timezone-name?
    ;
    use-builtin-timezone
    use-builtin-locale
    use-builtin-language)

  (import
    scheme chicken
    (only posix seconds->local-time local-timezone-abbreviation)
    locale-posix
    locale-components
    locale-categories
    locale-timezone)

  (require-library
    posix locale-posix locale-components locale-categories locale-timezone)

;;; When no environment info use Plan B

;FIXME use immutable core string

(define-constant BUILTIN-SOURCE "BUILTIN")
(define (builtin-source-name) BUILTIN-SOURCE)
(define (builtin-source-name? x) (equal? BUILTIN-SOURCE x))

(define-constant UNKNOWN-LOCAL-TZ-NAME "XXXX")
(define (unknown-timezone-name) UNKNOWN-LOCAL-TZ-NAME)
(define (unknown-timezone-name? x) (equal? UNKNOWN-LOCAL-TZ-NAME x))

;; Builtin Timezone

;; Daylight saving time offset from standard offset.
;; ("spring forward" add it, "fall back" subtract it)

(define-constant DEFAULT-DST-OFFSET 3600)

(define (current-local-time) (seconds->local-time (current-seconds)))

(define (local-timezone-name tv) (local-timezone tv))

(define (make-builtin-timezone)
  ; Need local timezone info
  (let ((tv (current-local-time)))
    (let ((tzn (local-timezone-name tv)
               #; ;Not until Posix bug fixed
               (local-timezone-abbreviation))
          (tzo (vector-ref tv 9))
          (dst? (vector-ref tv 8)) )
      ; Since the tzo reflects the dst status need to fake the one not in effect.
      (if dst?
          (make-posix-timezone UNKNOWN-LOCAL-TZ-NAME (+ tzo DEFAULT-DST-OFFSET) tzn tzo)
          (make-posix-timezone tzn tzo UNKNOWN-LOCAL-TZ-NAME (- tzo DEFAULT-DST-OFFSET)) ) ) ) )

(define (use-builtin-timezone)
  (set-locale-category!
   'timezone
   (posix-timezone-string->timezone-components (make-builtin-timezone) BUILTIN-SOURCE)) )

;; Builtin Locale

(define-constant DEFAULT-LANGUAGE "en")
(define-constant DEFAULT-REGION "US")

(define (make-builtin-locale-string)
  (string-append DEFAULT-LANGUAGE "_" DEFAULT-REGION) )

(define (use-builtin-locale)
  (set-locale-category!
   'messages
   (posix-locale-string->locale-components (make-builtin-locale-string) BUILTIN-SOURCE)) )

;; Builtin Language List

(define (use-builtin-language)
  (and-let* ((msglc (locale-category-ref 'messages)))
    (let ((lc (make-locale-components (locale-component-ref msglc 'name) BUILTIN-SOURCE 'language)))
      (update-locale-components! lc 'locales (list msglc))
      (set-locale-category! 'language lc) ) ) )

) ;module locale-builtin