caketext.scm Documentation


Function Documentation

Definitions
language-pack
f: new-language-pack

Setters And Accessors
f: set-language-pack-config!
f: set-language-pack-configs-from-alist!
f: get-language-pack-config
f: set-language-pack-text!
f: set-language-pack-texts-from-alist!
f: get-language-pack-text
f: language-pack-text-exists?
f: get-language-pack-func
f: set-language-pack-func!
f: set-language-pack-funcs-from-alist!
f: remove-language-pack-func

Saving And Loading
f: load-language-pack
f: dump-language-pack

Actual Translation
f: caketext-translate
f: my-format

Function Documentation

This is just the low-level function documentation; see
http://chicken.wiki.br/caketext for examples and such.

If you have any problems with this egg, or would like to suggest
changes/additions to the documentation, please e-mail
rlpowell@digitalkingdom.org

Definitions



language-pack

Language packs are a 4-list: hash of config vars (as symbols) to
values, hash of func names (as symbols) to code, hash of text key
to value, hash of text key to code.  That last is added to
automatically after 

new-language-pack

(define (new-language-pack)
... Full Code ... )
Just returns an empty language pack.



Setters And Accessors


set-language-pack-config!

(define (set-language-pack-config! pack name value)
... Full Code ... )
Sets a configuration value.  The configuration variable's name
must be a symbol.


set-language-pack-configs-from-alist!

(define (set-language-pack-configs-from-alist! pack configs-alist)
... Full Code ... )
Can be used to set all of the config variables at once from an
alist.  Don't know why you'd want to, though.


get-language-pack-config

(define (get-language-pack-config pack name)
... Full Code ... )
Gets a configuration value; #f if not found.


set-language-pack-text!

(define (set-language-pack-text! pack name value)
... Full Code ... )
Manually set a text string in a caketext language pack to a
particular translated value.  If you're using this for anything
other than a translation UI, odds are you're doing something
wrong; you almost certainly want to use auto-add and/or to edit
the language pack file by hand.


set-language-pack-texts-from-alist!

(define (set-language-pack-texts-from-alist! pack strings-alist)
... Full Code ... )
Used to set all of the strings at once from an alist.  Used
internally by the load-language-pack function.


get-language-pack-text

(define (get-language-pack-text pack name)
... Full Code ... )
Even more than with set-language-pack-text!, if you're using this you
should really think carefully about what you're doing.  The
caketext-translate function is there almost solely to get at this
data.  Returns #f if the string is not found.


language-pack-text-exists?

(define (language-pack-text-exists? pack name)
... Full Code ... )
Check for the existence of a string


get-language-pack-func

(define (get-language-pack-func pack name)
... Full Code ... )
You probably shouldn't ever need to use this, as all it's going to
return is a procedure.


set-language-pack-func!

(define (set-language-pack-func! pack name func)
... Full Code ... )
Assign a function to a symbol in this pack, for future function
substitution.  You're probably better off writing the functions
into the pack's function file, since the dumper won't write out
functions.


set-language-pack-funcs-from-alist!

(define (set-language-pack-funcs-from-alist! pack funcs-alist)
... Full Code ... )
This function is used to set all the functions on a language pack
at once using an alist.  Used internally by the load-language-pack
function.

The right way to do this is to use "include" or "-prologue" or
whatever to include, at compile time, a file that has the
functions alist in it as a simple define; say it has:

(define french-funcs
(list
(cons 'test (lambda (a b) (conc "dump-test-func: 1. " a " 2. " b)))))

then having included it, you'd run

(set-language-pack-funcs-from-alist! french-pack french-funcs)


remove-language-pack-func

(define (remove-language-pack-func pack name)
... Full Code ... )
Un-define a translation function.



Saving And Loading


load-language-pack

(define (load-language-pack pack text-file-name func-file-name)
... Full Code ... )
This function takes a pack (which should already be defined with
new-language-pack) some file names.  text-file-name should contain
an alist of strings and their translations.  func-file-name should
contain an alist of function names and function bodies.  Because
of the way read works, no quoting is required, so, examples:

Strings:

(("This is a test string for dumping." "This is a test string for dumping, eh?"))

Functions:

((test (lambda (a b) (conc "dump-test-func: 1. " a " 2. " b))))

I reccomend that you *not* use the func-file-name argument in any
application where perfomance is important.  Use of this argument
means an eval call, which may mean startup costs for a full Scheme
interpreter.  The right way to do this is to use "include" or
"-prologue" or whatever to include, at compile time, a file that
has the functions alist in it as a simple define; say it has:

(define french-funcs
(list
(cons 'test (lambda (a b) (conc "dump-test-func: 1. " a " 2. " b)))))

then having included it, you'd run

(set-language-pack-funcs-from-alist! french-pack french-funcs)


dump-language-pack

(define (dump-language-pack pack text-file-name)
... Full Code ... )



Actual Translation


caketext-translate

(define (caketext-translate lpack-list port format-string . args)
... Full Code ... )
This function does the actual translation.  It takes the same
arguments as format-modular's make-format-function's output,
except the first one, which is a list of language packs in order
of descending specificity.  They are checked in order, so place
the most-specific one first.


my-format

(define (my-format lpack-list port format-string args)
... Full Code ... )
The purpose of this function is to deal with function substitution
in the format strings.

This gets a bit complicated.  What we do is we run the string
through format-modular as per normal, and save that output.  Then,
in a seperate pass, we run the result through format-modular set
up to know about our escapes, %(, %, and %), and no others.  We
use our escapes to save the starting points of each of those.

After that, we take the output of the second run and process the
string bits in question using the positions we saved.  The first
bit is the function, and the rest are (string) arguments to it.

This function gets given the lpack-list that caketext-translate
gets. It should walk that list as necessary to find functions it
needs.

FIXME: Optimization: Skip format calls if no ~ and/or % found.
OTOH, if there *aren't* those characters, this means passing
through the string at least once more, so skip this for now,
pending need/benchmarking.


Code

set-language-pack-config!

Index
Sets a configuration value.  The configuration variable's name
must be a symbol.
(define (set-language-pack-config! pack name value)
  (cond
    [(symbol? name)
     (hash-table-set! (language-pack-configs pack) name value)]
    [else #f]))

set-language-pack-configs-from-alist!

Index
Can be used to set all of the config variables at once from an
alist.  Don't know why you'd want to, though.
(define (set-language-pack-configs-from-alist! pack configs-alist)
  (language-pack-configs-set!
    pack
    (alist->hash-table configs-alist eqv? hash-by-identity)))

get-language-pack-config

Index
Gets a configuration value; #f if not found.
(define (get-language-pack-config pack name)
  (and
    (hash-table-exists? (language-pack-configs pack) name)
    (hash-table-ref (language-pack-configs pack) name)))

set-language-pack-text!

Index
Manually set a text string in a caketext language pack to a
particular translated value.  If you're using this for anything
other than a translation UI, odds are you're doing something
wrong; you almost certainly want to use auto-add and/or to edit
the language pack file by hand.
(define (set-language-pack-text! pack name value)
  (hash-table-set! (language-pack-strings pack) name value))

set-language-pack-texts-from-alist!

Index
Used to set all of the strings at once from an alist.  Used
internally by the load-language-pack function.
(define (set-language-pack-texts-from-alist! pack strings-alist)
  (language-pack-strings-set!
    pack
    (alist->hash-table strings-alist string= string-hash)))

get-language-pack-text

Index
Even more than with set-language-pack-text!, if you're using this you
should really think carefully about what you're doing.  The
caketext-translate function is there almost solely to get at this
data.  Returns #f if the string is not found.
(define (get-language-pack-text pack name)
  (and
    (hash-table-exists? (language-pack-strings pack) name)
    (hash-table-ref (language-pack-strings pack) name)))

language-pack-text-exists?

Index
Check for the existence of a string
(define (language-pack-text-exists? pack name)
  (hash-table-exists? (language-pack-strings pack) name))

get-language-pack-func

Index
You probably shouldn't ever need to use this, as all it's going to
return is a procedure.
(define (get-language-pack-func pack name)
  (and
    (hash-table-exists? (language-pack-functions pack) name)
    (hash-table-ref (language-pack-functions pack) name)))

set-language-pack-func!

Index
Assign a function to a symbol in this pack, for future function
substitution.  You're probably better off writing the functions
into the pack's function file, since the dumper won't write out
functions.
(define (set-language-pack-func! pack name func)
  (hash-table-set! (language-pack-functions pack) name func))

set-language-pack-funcs-from-alist!

Index
This function is used to set all the functions on a language pack
at once using an alist.  Used internally by the load-language-pack
function.

The right way to do this is to use "include" or "-prologue" or
whatever to include, at compile time, a file that has the
functions alist in it as a simple define; say it has:

(define french-funcs
(list
(cons 'test (lambda (a b) (conc "dump-test-func: 1. " a " 2. " b)))))

then having included it, you'd run

(set-language-pack-funcs-from-alist! french-pack french-funcs)
(define (set-language-pack-funcs-from-alist! pack funcs-alist)
  (language-pack-functions-set!
    pack
    (alist->hash-table funcs-alist eqv? hash-by-identity)))

remove-language-pack-func

Index
Un-define a translation function.
(define (remove-language-pack-func pack name)
  (hash-table-delete! (language-pack-functions pack) name))

load-language-pack

Index
This function takes a pack (which should already be defined with
new-language-pack) some file names.  text-file-name should contain
an alist of strings and their translations.  func-file-name should
contain an alist of function names and function bodies.  Because
of the way read works, no quoting is required, so, examples:

Strings:

(("This is a test string for dumping." "This is a test string for dumping, eh?"))

Functions:

((test (lambda (a b) (conc "dump-test-func: 1. " a " 2. " b))))

I reccomend that you *not* use the func-file-name argument in any
application where perfomance is important.  Use of this argument
means an eval call, which may mean startup costs for a full Scheme
interpreter.  The right way to do this is to use "include" or
"-prologue" or whatever to include, at compile time, a file that
has the functions alist in it as a simple define; say it has:

(define french-funcs
(list
(cons 'test (lambda (a b) (conc "dump-test-func: 1. " a " 2. " b)))))

then having included it, you'd run

(set-language-pack-funcs-from-alist! french-pack french-funcs)
(define (load-language-pack pack text-file-name func-file-name)
  (set-language-pack-texts-from-alist!
    pack
    (with-input-from-file text-file-name (lambda () (read))))
  ; Try to load the functions file if appropriate
  (and
    func-file-name
    (string? func-file-name)
    (not (string= "" func-file-name))
    (set-language-pack-funcs-from-alist!
      pack
      ; If there's a way to do this without running eval on each
      ; function seperately, I haven't found it.
      (map
	(lambda (pair)
	  ;(format #t "pair: ~A.\n" pair)
	  ;(format #t "car: ~A.\n" (car pair))
	  ;(format #t "eval cdr: ~A.\n" (eval (car (cdr pair)) (null-environment 5)))
	  (cons (car pair) (eval (car (cdr pair)) (null-environment 5))))
	(with-input-from-file func-file-name (lambda () (read))))))
  #t)

dump-language-pack

Index
(define (dump-language-pack pack text-file-name)
  (with-output-to-file text-file-name (lambda () (pretty-print (hash-table->alist (language-pack-strings pack))))))


caketext-translate

Index
This function does the actual translation.  It takes the same
arguments as format-modular's make-format-function's output,
except the first one, which is a list of language packs in order
of descending specificity.  They are checked in order, so place
the most-specific one first.
(define (caketext-translate lpack-list port format-string . args)
  ;(format #t "ct: ~A, ~A.\n" lpack-list format-string)
  ;(format #t "strings: ~A.\n" (hash-table->alist (language-pack-strings (car lpack-list))))
  (letrec
    ; Get the best (i.e. first) translated string.
    ;
    ; We could grab the best pack here, but we have no use for it
    ; other than to use the string it returns, so we just grab the
    ; first matching string we find, since get-language-pack-text
    ; will return false if it needs to.
    ([get-best-string
       (lambda (l)
	 (cond
	   [(null? l) #f]
	   [else
	     (or
	       (get-language-pack-text (car l) format-string)
	       (get-best-string (cdr l)))]))]
     [best-string
       (get-best-string lpack-list)]
     ; Here we find the first pack with auto-add or onmiss set.
     [special-pack
       (find
	 (lambda (pack)
	   (or
	     (get-language-pack-config pack 'auto-add)
	     (get-language-pack-config pack 'onmiss)))
	 lpack-list)])
    ;(format #t "best string: ~A.\n" best-string)
    ;(format #t "first special: ~A.\n" special-pack)
    (cond
      ; Is it in the strings hash?
      [best-string
	(my-format lpack-list port best-string args)]
      ; Is there an auto-add/onmiss pack?
      [special-pack
	(cond
	  ; Is auto-add set?
	  [(get-language-pack-config special-pack 'auto-add)
	   ; Yes; copy the string in
	   (set-language-pack-text! special-pack format-string format-string)
	   (my-format lpack-list port format-string args)]
	  ; Is onmiss set?
	  [(get-language-pack-config special-pack 'onmiss)
	   ; Then run it
	   ((get-language-pack-config special-pack 'onmiss) lpack-list format-string)])]
      [else
	(assert #f "The string was not found in this language pack list, and neither onmiss nor auto-add was set on any of the language packs in this list." lpack-list)])))

my-format

Index
The purpose of this function is to deal with function substitution
in the format strings.

This gets a bit complicated.  What we do is we run the string
through format-modular as per normal, and save that output.  Then,
in a seperate pass, we run the result through format-modular set
up to know about our escapes, %(, %, and %), and no others.  We
use our escapes to save the starting points of each of those.

After that, we take the output of the second run and process the
string bits in question using the positions we saved.  The first
bit is the function, and the rest are (string) arguments to it.

This function gets given the lpack-list that caketext-translate
gets. It should walk that list as necessary to find functions it
needs.

FIXME: Optimization: Skip format calls if no ~ and/or % found.
OTOH, if there *aren't* those characters, this means passing
through the string at least once more, so skip this for now,
pending need/benchmarking.
(define (my-format lpack-list port format-string args)

  (define paren-bits '())
  (define all-paren-bits '())
  ; For each escape after the first one, subsequent string positions
  ; will have moved 2 by the time we see them.
  (define tosub 0)

  (define (formatter-open state start params colon atsign)
    (set! paren-bits (cons (- start tosub) paren-bits)) 
    (set! tosub (+ tosub 2)))

  (define (formatter-break state start params colon atsign)
    (set! paren-bits (cons (- start tosub) paren-bits)) 
    (set! tosub (+ tosub 2)))

  ; Save up all the bits we've found so far and push them onto
  ; all-paren-bits, then clear paren-bits
  (define (formatter-close state start params colon atsign)
    (set! paren-bits (cons (- start tosub) paren-bits)) 
    (set! tosub (+ tosub 2))
    (set! all-paren-bits (cons (reverse paren-bits) all-paren-bits))
    (set! paren-bits '()))

  (define (formatter-percent state start params colon atsign)
    (*formatter-out-char state #\%))

  (define *my-caseconv*
    `((#\( ,(formatter-function formatter-open))
      (#\, ,(formatter-function formatter-break))
      (#\) ,(formatter-function formatter-close))
      (#\% ,(formatter-function formatter-percent))))

  (define *formatter-mine* `(,*my-caseconv*))

  (define func-format (make-format-function #f #\% *formatter-mine*))

  ; Used so we don't have to replicate format's handling of the port
  ; argument.
  (define no-format (make-format-function #f #f '()))

  (define first-pass (apply format (cons #f (cons format-string args))))

  ;(format #t "First pass: ~A.\n" first-pass)

  (define second-pass (apply func-format (cons #f (cons first-pass args))))

  ;(format #t "Second pass: ~A.\n" second-pass)

  ; Did we find any %(...%) escapes?
  (cond
    ; Yes.
    [(not (null? all-paren-bits))
     (let
       ([final second-pass])
       (for-each
	 (lambda (paren-bit)
	   ;(format #t "paren-bit: ~A.\n" paren-bit)
	   (receive
	     (func . args)
	     ; Producer:
	     ;
	     ; Generate the actual string parts (that is, the func
	     ; name and arguments, as strings)
	     ;
	     ; We do this by mapping (e.g.) (1 3 5 7) with its cdr,
	     ; (3 5 7), to get pairs of start and end ranges for the
	     ; various paren sections
	     (apply
	       values
	       (map
		 (lambda (start end)
		   (string-copy final start end))
		 paren-bit
		 (cdr paren-bit)))
	     ; Consumer:
	     ;
	     ; Given the string parts, try to run the function in
	     ; question and put the result in the string
	     (letrec
	       ([find-func
		  (lambda (l)
		    (cond
		      [(null? l) #f]
		      [else
			;(format #t "find-func: ~A.\n" 
			;	(get-language-pack-func (car l) (string->symbol func)))
			(or
			  (get-language-pack-func (car l) (string->symbol func))
			  (find-func (cdr l)))]))]
		[found-func
		  (find-func lpack-list)])
	       (assert
		 found-func
		 (list "No such function found during caketext function substitution!\n" lpack-list func))

	       ;(format #t "Bits: ~A\n" paren-bit)

	       ;(format #t "String bits, func: ~A, args: ~A\n" func args)

	       ;(format #t "Func result: ~A\n" (apply found-func args))

	       (set! final (string-replace
			     final
			     (apply found-func args)
			     (first paren-bit)
			     (last paren-bit))))))
	 all-paren-bits)
       ; This is just to get the port right
       (no-format port final))]
    ; We did not find any %(...%) escapes
    [else (no-format port second-pass)]))
define-record
Index
(define-record language-pack configs functions strings)

new-language-pack

Index
Just returns an empty language pack.
(define (new-language-pack)
  (make-language-pack
    ; Configs is a hash table by symbols
    (make-hash-table eqv? hash-by-identity)
    ; So is functions
    (make-hash-table eqv? hash-by-identity)
    ; Strings, not so much
    (make-hash-table string= string-hash)))