Re: gettext bindings?

[Rob Browning]

Ariel Rios <address@hidden> writes:

> Are there any gettext bidings available?

FWIW in gnucash we just do some simple bits partialty via g-wrap and
partially by-hand.

In our g-wrap spec file:

  (gw:wrap-function
   mod
   'gnc:gettext-helper
   '(<gw:m-chars-caller-owned> gw:const)
   "gnc_gettext_helper"
   '(((<gw:m-chars-caller-owned> gw:const) string))
   "Returns the translated version of string")

and in our c-interface.scm file:

  ;; gettext functions
  (define gnc:gettext gnc:gettext-helper)
  (define gnc:_ gnc:gettext)
  (define _ gnc:gettext)
  (define-syntax N_
    (syntax-rules ()
      ((_ x) x)))

and Dave (I believe) has written an xgettext.scm file that can
traverse all our scheme code, extracting the relevant gettext strings:

;; Find translatable strings in guile files

(define (expand-newlines string out-port)
  (define (output-prefix-newlines chars)
    (if (and (pair? chars) (char=? (car chars) #\newline))
        (begin
          (display "\\n" out-port)
          (output-prefix-newlines (cdr chars)))
        chars))

  (let loop ((chars (string->list string))
             (accum '()))
    (cond
     ((null? chars)
      (if (not (null? accum))
          (write (list->string (reverse accum)) out-port)))
     ((char=? (car chars) #\newline)
      (write (list->string (reverse accum)) out-port)
      (display "\"" out-port)
      (set! chars (output-prefix-newlines chars))
      (display "\"" out-port)
      (if (not (null? chars))
          (display "\n  " out-port))
      (loop chars '()))
     (else
      (loop (cdr chars) (cons (car chars) accum))))))

(define (write-string string out-port)
  (display "_(" out-port)
  (expand-newlines string out-port)
  (display ")\n" out-port))

(define (find-strings-in-item item out-port in-port)
  (define (find-internal rest)
    (cond
     ((and (list? rest)                    ; if it's a list
           (= (length rest) 2)             ; of length 2
           (symbol? (car rest))            ; starting with a symbol
           (string? (cadr rest))           ; and ending with a string
           (or (eqv? '_ (car rest))        ; and the symbol is _
               (eqv? 'N_ (car rest))       ; or N_
               (eqv? 'gnc:_ (car rest))))  ; or gnc:_
      (write-string (cadr rest) out-port)) ; then write it out

     ((pair? rest)                         ; otherwise, recurse
      (find-internal (car rest))
      (find-internal (cdr rest)))))

  (find-internal item))

(define (find-strings in-port out-port)
  (do ((item (read in-port) (read in-port)))
      ((eof-object? item) #t)
    (find-strings-in-item item out-port in-port)))

(let ((out-port (open "guile-strings.c" (logior O_WRONLY O_CREAT O_TRUNC)))
      (in-files (cdr (command-line))))
  (for-each (lambda (file)
              (call-with-input-file file (lambda (port)
                                           (find-strings port out-port))))
            in-files))

-- 
Rob Browning <address@hidden> PGP=E80E0D04F521A094 532B97F5D64E3930