(module internat mzscheme
  (require (lib "28.ss"   "srfi"))
  (require (lib "list.ss" "mzlib"))
  (provide internat-init
           _
           internat-language!
           internat-language
           internat-clear-cache!
           internat-get
           internat-translate
           internat-set!
           internat-remove!
           internat-keys)

;=pod
;
;=head1 Internat
;
;Internat is an internationalization module. It exports a simple interface to help implementing
;internationalization in applications. It works a little like i8n.
;
;=head1 Synopsis
;
;=syn scm,8
;
; >(require (planet "internat.scm" ("oesterholt" "internat.plt" 1 0)))
; >(define LANG-HASH (make-hash-table 'equal))
; > (internat-init (lambda (lang key default-translation)
;                  (hash-table-get LANG-HASH (format "~a/~a" lang key) (lambda () default-translation)))
;                (lambda (lang key translation)
;                  (hash-table-put! LANG-HASH (format "~a/~a" lang key) translation))
;                (lambda ()
;                  (hash-table-map LANG-HASH (lambda (key val)
;                                               (let ((kv (regexp-match "([^/]*)[/](.*)" key)))
;                                                  (cdr kv)))))
;                "en"
;                (lambda (lang key)
;                  (hash-table-remove! LANG-HASH (format "~a/~a" lang key))))
; > (internat-language! "nl")
; > (internat-language)
; "nl"
; > (internat-get "Hi?" )
; "Hi?"
; > (internat-set! "Hello?" "Hallo?")
; > (_ "Hello?")
; "Hallo?"
; > (internat-get "Hello?")
; "Hallo?"
; > (internat-translate "A book" "Een boek")
; > (internat-get "A book")
; "Een boek"
; > (internat-keys)
; ("A book" "Hello?")
;
;
;=head1 API
;
;=head3 C<(internat-init getter setter key-mapper language:string . deleter) : undefined>
;
;Initializes the internationalization module with the given mutation functions.
;A deleter function is optional, but if not given, it will result in an error
;if a key is removed.
;
;=head3 C<(internat-language! language:string) : undefined>
;
;Sets the language to translate the input sentences to. Usually, one wants to
;use the mz-language-tags module to get IANA language tags for languages in
;combination with this function.
;
;=head3 C<(internat-language) : string>
;
;Returns the current language.
;
;=head3 C<(internat-get sentence) : string>
;
;Returns the translation for this sentence for the current language, or, if no translation is there,
;'sentence' itself.
;
;=head3 C<(_ sentence) : string>
;
;Same as 'internat-get'.
;
;=head3 C<(internat-set! sentence translation) : undefined>
;
;Sets the translation for 'sentence' to 'translation' for the current language.
;
;=head3 C<(internat-translate sentence translation) : undefined>
;
;Same as 'internat-set!'.
;
;=head3 C<(internat-remove! sentence) : undefined>
;
;Removes the translation for 'sentence' for the current language.
;
;=head3 C<(internat-keys) : (list of list of (language:string sentence:string)>
;
;Returns all language, sentence pairs in the current translation store.
;Can be used in translation applications (e.g. like internat-editor provided with this package).
;
;=head1 Info
;
;(p) 2005-2007 Hans Oesterholt-Dijkema, LGPL.
;
;=cut

  (define (displayp . args)
    (define (prt args)
      (if (null? args)
          (newline)
          (begin
            (display (car args))
            (prt (cdr args)))))
    (prt args))

  (define-syntax lang
    (syntax-rules ()
      ((_ s l)
       (list l s))))

  ; Interfacing with getter and setters
  
  (define _handle (lambda (cmd key . val) (if (null? val) val (car val))))
  (define _used #f)

  ; Language settings
  
  (define _language "default")
  (define _cache (make-hash-table 'equal))

  ; initialization, etc.
  
  (define (internat-init getter setter key-mapper language . _deleter)
    (let ((deleter (if (null? _deleter)
		       (lambda args (error "internat: No remover initialized"))
		       (car _deleter))))
      (set! _handle   (lambda (cmd . args) ; language key . val)
			(cond
			 ((eq? cmd 'get) 
			  (apply (lambda (language key) (getter language key key)) args))
			 ((eq? cmd 'set)
			  (apply (lambda (language key val) (setter language key val)) args))
			 ((eq? cmd 'map)
			  (apply (lambda () (key-mapper)) args))
			 ((eq? cmd 'delete)
			  (apply (lambda (language key) (deleter language key)) args))
			 (else
			  (error "Cannot handle command " cmd)))))
      (set! _language language)))


  (define (internat-language! language)
    (set! _language language))

  (define (internat-language)
    _language)

  (define (internat-clear-cache!)
    (set! _cache (make-hash-table 'equal)))
    
  ; Getting sentences

  (define (internat-get sentence)
    (let ((s (hash-table-get _cache (lang sentence _language) (lambda () #f))))
      (if (eq? s #f)
          (let ((s (_handle 'get _language sentence)))
            (if (eq? s #f)
                (begin
                  (_handle 'set _language sentence 'no-translation)
                  (hash-table-put! _cache (list sentence _language) sentence)
                  sentence)
                (if (eq? s 'no-translation)
                    (begin
                      (hash-table-put! _cache (lang sentence _language) sentence)
                      sentence)
                    (begin
                      (hash-table-put! _cache (lang sentence _language) s)
		      s))))
          s)))

  (define (internat-set! s1 s2)
    (_handle 'set _language s1  s2)
    (hash-table-put! _cache (lang s1 _language) s2))

  (define (internat-translate s1 s2)
    (internat-set! s1 s2))

  (define (internat-remove! sentence)
    (hash-table-remove! _cache (lang sentence _language))
    (_handle 'delete _language sentence))

  (define (internat-keys)
    (let ((sentences (make-hash-table 'equal)))
      (for-each (lambda (key)
                  (apply (lambda (language sentence)
                           (if (not (eq? language '%scfg))
                               (hash-table-put! sentences sentence 0))) key))
                (_handle 'map))
      (quicksort (hash-table-map sentences (lambda (key value) key))
                 string-ci<?)))

  (define (_ sentence . args)
    (if (null? args)
	(internat-get sentence)
	(apply format (cons (internat-get sentence) args))))
  
)