+2002-03-03 Bruno Haible <bruno@clisp.org>
+
+ * gettext.texi (Tcl): New node.
+
2002-02-21 Bruno Haible <bruno@clisp.org>
* msggrep.texi: Document option -C.
* Pascal:: Pascal - Free Pascal Compiler
* wxWindows:: wxWindows library
* YCP:: YCP - YaST2 scripting language
+* Tcl:: Tcl - Tk's scripting language
* Perl:: Perl
* PHP:: PHP Hypertext Preprocessor
* Pike:: Pike
* Pascal:: Pascal - Free Pascal Compiler
* wxWindows:: wxWindows library
* YCP:: YCP - YaST2 scripting language
+* Tcl:: Tcl - Tk's scripting language
* Perl:: Perl
* PHP:: PHP Hypertext Preprocessor
* Pike:: Pike
yes
@end table
-@node YCP, Perl, wxWindows, List of Programming Languages
+@node YCP, Tcl, wxWindows, List of Programming Languages
@subsection YCP - YaST2 scripting language
@cindex YCP
@cindex YaST2 scripting language
---
@end table
-@node Perl, PHP, YCP, List of Programming Languages
+@node Tcl, Perl, YCP, List of Programming Languages
+@subsection Tcl - Tk's scripting language
+@cindex Tcl
+@cindex Tk's scripting language
+
+@table @asis
+@item RPMs
+tcl
+
+@item File extension
+@code{tcl}
+
+@item String syntax
+@code{"abc"}
+
+@item gettext shorthand
+@code{[_ "abc"]}
+
+@item gettext/ngettext functions
+@code{::msgcat::mc}
+
+@item textdomain
+---
+
+@item bindtextdomain
+---, use @code{::msgcat::mcload} instead
+
+@item setlocale
+automatic, uses LANG, but ignores LC_MESSAGES and LC_ALL
+
+@item Prerequisite
+@code{package require msgcat}
+@*@code{proc _ @{s@} @{return [::msgcat::mc $s]@}}
+
+@item Use or emulate GNU gettext
+---, uses a Tcl specific message catalog format
+
+@item Extractor
+@code{xgettext -k_}
+
+@item Formatting with positions
+@code{format "%2\$d %1\$d"}
+
+@item Portability
+fully portable
+
+@item po-mode marking
+---
+@end table
+
+Before marking strings as internationalizable, substitutions of variables
+into the string need to be converted to @code{format} applications. For
+example, @code{"file $filename not found"} becomes
+@code{[format "file %s not found" $filename]}.
+Only after this is done, can the strings be marked and extracted.
+After marking, this example becomes
+@code{[format [_ "file %s not found"] $filename]} or
+@code{[msgcat::mc "file %s not found" $filename]}. Note that the
+@code{msgcat::mc} function implicitly calls @code{format} when more than one
+argument is given.
+
+@node Perl, PHP, Tcl, List of Programming Languages
@subsection Perl
@cindex Perl
+2002-03-03 Bruno Haible <bruno@clisp.org>
+
+ * message.h (format_type): New enum value 'format_tcl'.
+ (NFORMATS): Increment.
+ * message.c (format_language): Add format_tcl entry.
+ (format_language_pretty): Likewise.
+ * format.h (formatstring_tcl): New declaration.
+ * format-tcl.c: New file.
+ * format.c (formatstring_parsers): Add formatstring_tcl.
+ * x-tcl.h: New file.
+ * x-tcl.c: New file.
+ * xgettext.c: Include x-tcl.h.
+ (main): Call x_tcl_extract_all, x_tcl_keyword.
+ (language_to_scanner): Add Tcl rule.
+ (extension_to_language): Add Tcl rule.
+ * write-tcl.h: New file.
+ * write-tcl.c: New file.
+ * msgfmt.c: Include write-tcl.h.
+ (tcl_mode, tcl_locale_name, tcl_base_directory): New variables.
+ (long_options): Add option "--tcl".
+ (main): Handle --tcl option. Set tcl_mode, tcl_locale_name,
+ tcl_base_directory. More checks for contradicting options. Call
+ msgdomain_write_tcl.
+ (usage): Mention Tcl mode.
+ (format_directive_domain): Ignore domain directive if in Tcl mode.
+ * read-tcl.h: New file.
+ * read-tcl.c: New file.
+ * msgunfmt.c: Include read-tcl.h.
+ (tcl_mode, tcl_locale_name, tcl_base_directory): New variables.
+ (long_options): Add option "--tcl".
+ (main): Handle --tcl and -d options. Set tcl_mode, tcl_locale_name,
+ tcl_base_directory. More checks for contradicting options. Call
+ msgdomain_read_tcl.
+ (usage): Mention Tcl mode.
+ * Makefile.am (noinst_HEADERS): Add read-tcl.h, write-tcl.h, x-tcl.h.
+ (DEFS): Add -DGETTEXTDATADIR.
+ (FORMAT_SOURCE): Add format-tcl.c.
+ (msgfmt_SOURCES): Add write-tcl.c.
+ (msgunfmt_SOURCES): Add read-tcl.c.
+ (xgettext_SOURCES): Add x-tcl.c.
+ (install-tcl, installdirs-tcl, uninstall-tcl): New targets.
+
2002-03-02 Bruno Haible <bruno@clisp.org>
* msgfmt.c (check_pair): Don't count "&&" as an accelerator designator,
| read-java.h
| read-java.c
| Reading Java ResourceBundle files.
+| read-tcl.h
+| read-tcl.c
+| Reading Tcl .msg files.
| msgunfmt.c
| Main source for the 'msgunfmt' program.
|
format-java.c Format string handling for Java.
format-pascal.c Format string handling for Object Pascal.
format-ycp.c Format string handling for YCP.
+format-tcl.c Format string handling for Tcl.
format.c Table of the language dependent format string handlers.
+-------------- The 'msgfmt' program
| write-java.h
| write-java.c
| Generating Java ResourceBundle files.
+| write-tcl.h
+| write-tcl.c
+| Generating Tcl .msg files.
| msgfmt.c
| Main source for the 'msgfmt' program.
|
| x-ycp.h
| x-ycp.c
| String extractor for YCP.
+| x-tcl.h
+| x-tcl.c
+| String extractor for Tcl.
| x-rst.h
| x-rst.c
| String extractor from .rst files, for Object Pascal.
po.h open-po.h read-po.h str-list.h write-po.h dir-list.h file-list.h \
po-gram-gen.h po-hash-gen.h msgl-charset.h msgl-equal.h msgl-iconv.h \
msgl-ascii.h msgl-cat.h msgl-english.h msgfmt.h msgunfmt.h read-mo.h \
-write-mo.h read-java.h write-java.h po-time.h plural-table.h format.h \
-xgettext.h x-c.h x-po.h x-python.h x-lisp.h x-elisp.h x-librep.h x-java.h \
-x-awk.h x-ycp.h x-rst.h x-glade.h
+write-mo.h read-java.h write-java.h read-tcl.h write-tcl.h po-time.h \
+plural-table.h format.h xgettext.h x-c.h x-po.h x-python.h x-lisp.h \
+x-elisp.h x-librep.h x-java.h x-awk.h x-ycp.h x-tcl.h x-rst.h x-glade.h
EXTRA_DIST = FILES project-id \
gnu/gettext/DumpResource.java gnu/gettext/GetURL.java
INCLUDES = -I. -I$(srcdir) -I.. -I$(top_srcdir)/libuniname \
-I../lib -I$(top_srcdir)/lib -I../intl -I$(top_srcdir)/intl
DEFS = -DLOCALEDIR=\"$(localedir)\" -DGETTEXTJAR=\"$(jardir)/gettext.jar\" \
--DLIBDIR=\"$(libdir)\" -DPROJECTSDIR=\"$(projectsdir)\" @DEFS@
+-DLIBDIR=\"$(libdir)\" -DGETTEXTDATADIR=\"$(pkgdatadir)\" \
+-DPROJECTSDIR=\"$(projectsdir)\" @DEFS@
LDADD = ../lib/libgettextlib.la @LTLIBINTL@
SED = sed
# xgettext and msgfmt deal with format strings.
FORMAT_SOURCE = format.c \
format-c.c format-python.c format-lisp.c format-elisp.c format-librep.c \
-format-java.c format-awk.c format-pascal.c format-ycp.c
+format-java.c format-awk.c format-pascal.c format-ycp.c format-tcl.c
# libgettextsrc contains all code that is needed by at least two programs.
libgettextsrc_la_SOURCES = \
gettext_SOURCES = gettext.c
ngettext_SOURCES = ngettext.c
msgcmp_SOURCES = msgcmp.c
-msgfmt_SOURCES = msgfmt.c write-mo.c write-java.c plural-eval.c
+msgfmt_SOURCES = msgfmt.c write-mo.c write-java.c write-tcl.c plural-eval.c
msgmerge_SOURCES = msgmerge.c
-msgunfmt_SOURCES = msgunfmt.c read-mo.c read-java.c
+msgunfmt_SOURCES = msgunfmt.c read-mo.c read-java.c read-tcl.c
xgettext_SOURCES = xgettext.c \
x-c.c x-po.c x-python.c x-lisp.c x-elisp.c x-librep.c x-java.l x-awk.c \
- x-ycp.c x-rst.c x-glade.c
+ x-ycp.c x-tcl.c x-rst.c x-glade.c
msgattrib_SOURCES = msgattrib.c
msgcat_SOURCES = msgcat.c
msgcomm_SOURCES = msgcomm.c
$(RM) $(DESTDIR)$(jardir)/gettext.jar
+# Special rules for Tcl auxiliary program.
+
+install-data-local: install-tcl
+install-tcl:
+ $(mkinstalldirs) $(DESTDIR)$(pkgdatadir)
+ $(INSTALL_DATA) $(srcdir)/msgunfmt.tcl $(DESTDIR)$(pkgdatadir)/msgunfmt.tcl
+
+installdirs-local: installdirs-tcl
+installdirs-tcl:
+ $(mkinstalldirs) $(DESTDIR)$(pkgdatadir)
+
+uninstall-local: uninstall-tcl
+uninstall-tcl:
+ $(RM) $(DESTDIR)$(pkgdatadir)/msgunfmt.tcl
+
+
# One more automake bug.
installdirs: installdirs-local
--- /dev/null
+/* Tcl format strings.
+ Copyright (C) 2001-2002 Free Software Foundation, Inc.
+ Written by Bruno Haible <haible@clisp.cons.org>, 2002.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software Foundation,
+ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#include <stdbool.h>
+#include <stdlib.h>
+
+#include "format.h"
+#include "xmalloc.h"
+#include "error.h"
+#include "progname.h"
+#include "gettext.h"
+
+#define _(str) gettext (str)
+
+/* Tcl format strings are described in the tcl8.3.3/doc/format.n manual
+ page and implemented in the function Tcl_FormatObjCmd in
+ tcl8.3.3/generic/tclCmdAH.c.
+ A directive
+ - starts with '%' or '%m$' where m is a positive integer,
+ - is optionally followed by any of the characters '#', '0', '-', ' ', '+',
+ each of which acts as a flag,
+ - is optionally followed by a width specification: '*' (reads an argument)
+ or a nonempty digit sequence,
+ - is optionally followed by '.' and a precision specification: '*' (reads
+ an argument) or a nonempty digit sequence,
+ - is optionally followed by a size specifier, 'h' or 'l'. 'l' is ignored.
+ - is finished by a specifier
+ - '%', that needs no argument,
+ - 'c', that needs a character argument,
+ - 's', that needs a string argument,
+ - 'i', 'd', that need a signed integer argument,
+ - 'o', 'u', 'x', 'X', that need an unsigned integer argument,
+ - 'e', 'E', 'f', 'g', 'G', that need a floating-point argument.
+ Numbered ('%m$') and unnumbered argument specifications cannot be used
+ in the same string.
+ */
+
+enum format_arg_type
+{
+ FAT_NONE,
+ FAT_CHARACTER,
+ FAT_STRING,
+ FAT_INTEGER,
+ FAT_UNSIGNED_INTEGER,
+ FAT_SHORT_INTEGER,
+ FAT_SHORT_UNSIGNED_INTEGER,
+ FAT_FLOAT
+};
+
+struct numbered_arg
+{
+ unsigned int number;
+ enum format_arg_type type;
+};
+
+struct spec
+{
+ unsigned int directives;
+ unsigned int numbered_arg_count;
+ unsigned int allocated;
+ struct numbered_arg *numbered;
+};
+
+/* Locale independent test for a decimal digit.
+ Argument can be 'char' or 'unsigned char'. (Whereas the argument of
+ <ctype.h> isdigit must be an 'unsigned char'.) */
+#undef isdigit
+#define isdigit(c) ((unsigned int) ((c) - '0') < 10)
+
+
+/* Prototypes for local functions. Needed to ensure compiler checking of
+ function argument counts despite of K&R C function definition syntax. */
+static int numbered_arg_compare PARAMS ((const void *p1, const void *p2));
+static void *format_parse PARAMS ((const char *format));
+static void format_free PARAMS ((void *descr));
+static int format_get_number_of_directives PARAMS ((void *descr));
+static bool format_check PARAMS ((const lex_pos_ty *pos,
+ void *msgid_descr, void *msgstr_descr,
+ bool equality,
+ bool noisy, const char *pretty_msgstr));
+
+
+static int
+numbered_arg_compare (p1, p2)
+ const void *p1;
+ const void *p2;
+{
+ unsigned int n1 = ((const struct numbered_arg *) p1)->number;
+ unsigned int n2 = ((const struct numbered_arg *) p2)->number;
+
+ return (n1 > n2 ? 1 : n1 < n2 ? -1 : 0);
+}
+
+static void *
+format_parse (format)
+ const char *format;
+{
+ struct spec spec;
+ struct spec *result;
+ bool seen_numbered_arg;
+ bool seen_unnumbered_arg;
+ unsigned int number;
+
+ spec.directives = 0;
+ spec.numbered_arg_count = 0;
+ spec.allocated = 0;
+ spec.numbered = NULL;
+ seen_numbered_arg = false;
+ seen_unnumbered_arg = false;
+ number = 1;
+
+ for (; *format != '\0';)
+ if (*format++ == '%')
+ {
+ /* A directive. */
+ spec.directives++;
+
+ if (*format != '%')
+ {
+ bool is_numbered_arg;
+ bool short_flag;
+ enum format_arg_type type;
+
+ is_numbered_arg = false;
+ if (isdigit (*format))
+ {
+ const char *f = format;
+ unsigned int m = 0;
+
+ do
+ {
+ m = 10 * m + (*f - '0');
+ f++;
+ }
+ while (isdigit (*f));
+
+ if (*f == '$')
+ {
+ if (m == 0)
+ goto bad_format;
+ number = m;
+ format = ++f;
+
+ /* Numbered and unnumbered specifications are exclusive. */
+ if (seen_unnumbered_arg)
+ goto bad_format;
+ is_numbered_arg = true;
+ seen_numbered_arg = true;
+ }
+ }
+
+ /* Numbered and unnumbered specifications are exclusive. */
+ if (!is_numbered_arg)
+ {
+ if (seen_numbered_arg)
+ goto bad_format;
+ seen_unnumbered_arg = true;
+ }
+
+ /* Parse flags. */
+ while (*format == ' ' || *format == '+' || *format == '-'
+ || *format == '#' || *format == '0')
+ format++;
+
+ /* Parse width. */
+ if (*format == '*')
+ {
+ format++;
+
+ if (spec.allocated == spec.numbered_arg_count)
+ {
+ spec.allocated = 2 * spec.allocated + 1;
+ spec.numbered = (struct numbered_arg *) xrealloc (spec.numbered, spec.allocated * sizeof (struct numbered_arg));
+ }
+ spec.numbered[spec.numbered_arg_count].number = number;
+ spec.numbered[spec.numbered_arg_count].type = FAT_INTEGER;
+ spec.numbered_arg_count++;
+
+ number++;
+ }
+ else if (isdigit (*format))
+ {
+ do format++; while (isdigit (*format));
+ }
+
+ /* Parse precision. */
+ if (*format == '.')
+ {
+ format++;
+
+ if (*format == '*')
+ {
+ format++;
+
+ if (spec.allocated == spec.numbered_arg_count)
+ {
+ spec.allocated = 2 * spec.allocated + 1;
+ spec.numbered = (struct numbered_arg *) xrealloc (spec.numbered, spec.allocated * sizeof (struct numbered_arg));
+ }
+ spec.numbered[spec.numbered_arg_count].number = number;
+ spec.numbered[spec.numbered_arg_count].type = FAT_INTEGER;
+ spec.numbered_arg_count++;
+
+ number++;
+ }
+ else if (isdigit (*format))
+ {
+ do format++; while (isdigit (*format));
+ }
+ }
+
+ /* Parse optional size specification. */
+ short_flag = false;
+ if (*format == 'h')
+ short_flag = true, format++;
+ else if (*format == 'l')
+ format++;
+
+ switch (*format)
+ {
+ case 'c':
+ type = FAT_CHARACTER;
+ break;
+ case 's':
+ type = FAT_STRING;
+ break;
+ case 'i': case 'd':
+ type = (short_flag ? FAT_SHORT_INTEGER : FAT_INTEGER);
+ break;
+ case 'u': case 'o': case 'x': case 'X':
+ type = (short_flag ? FAT_SHORT_UNSIGNED_INTEGER : FAT_UNSIGNED_INTEGER);
+ break;
+ case 'e': case 'E': case 'f': case 'g': case 'G':
+ type = FAT_FLOAT;
+ break;
+ default:
+ goto bad_format;
+ }
+
+ if (spec.allocated == spec.numbered_arg_count)
+ {
+ spec.allocated = 2 * spec.allocated + 1;
+ spec.numbered = (struct numbered_arg *) xrealloc (spec.numbered, spec.allocated * sizeof (struct numbered_arg));
+ }
+ spec.numbered[spec.numbered_arg_count].number = number;
+ spec.numbered[spec.numbered_arg_count].type = type;
+ spec.numbered_arg_count++;
+
+ number++;
+ }
+
+ format++;
+ }
+
+ /* Sort the numbered argument array, and eliminate duplicates. */
+ if (spec.numbered_arg_count > 1)
+ {
+ unsigned int i, j;
+ bool err;
+
+ qsort (spec.numbered, spec.numbered_arg_count,
+ sizeof (struct numbered_arg), numbered_arg_compare);
+
+ /* Remove duplicates: Copy from i to j, keeping 0 <= j <= i. */
+ err = false;
+ for (i = j = 0; i < spec.numbered_arg_count; i++)
+ if (j > 0 && spec.numbered[i].number == spec.numbered[j-1].number)
+ {
+ enum format_arg_type type1 = spec.numbered[i].type;
+ enum format_arg_type type2 = spec.numbered[j-1].type;
+ enum format_arg_type type_both;
+
+ if (type1 == type2)
+ type_both = type1;
+ else
+ /* Incompatible types. */
+ type_both = FAT_NONE, err = true;
+
+ spec.numbered[j-1].type = type_both;
+ }
+ else
+ {
+ if (j < i)
+ {
+ spec.numbered[j].number = spec.numbered[i].number;
+ spec.numbered[j].type = spec.numbered[i].type;
+ }
+ j++;
+ }
+ spec.numbered_arg_count = j;
+ if (err)
+ goto bad_format;
+ }
+
+ result = (struct spec *) xmalloc (sizeof (struct spec));
+ *result = spec;
+ return result;
+
+ bad_format:
+ if (spec.numbered != NULL)
+ free (spec.numbered);
+ return NULL;
+}
+
+static void
+format_free (descr)
+ void *descr;
+{
+ struct spec *spec = (struct spec *) descr;
+
+ if (spec->numbered != NULL)
+ free (spec->numbered);
+ free (spec);
+}
+
+static int
+format_get_number_of_directives (descr)
+ void *descr;
+{
+ struct spec *spec = (struct spec *) descr;
+
+ return spec->directives;
+}
+
+static bool
+format_check (pos, msgid_descr, msgstr_descr, equality, noisy, pretty_msgstr)
+ const lex_pos_ty *pos;
+ void *msgid_descr;
+ void *msgstr_descr;
+ bool equality;
+ bool noisy;
+ const char *pretty_msgstr;
+{
+ struct spec *spec1 = (struct spec *) msgid_descr;
+ struct spec *spec2 = (struct spec *) msgstr_descr;
+ bool err = false;
+
+ if (spec1->numbered_arg_count + spec2->numbered_arg_count > 0)
+ {
+ unsigned int i, j;
+ unsigned int n1 = spec1->numbered_arg_count;
+ unsigned int n2 = spec2->numbered_arg_count;
+
+ /* Check the argument names are the same.
+ Both arrays are sorted. We search for the first difference. */
+ for (i = 0, j = 0; i < n1 || j < n2; )
+ {
+ int cmp = (i >= n1 ? 1 :
+ j >= n2 ? -1 :
+ spec1->numbered[i].number > spec2->numbered[j].number ? 1 :
+ spec1->numbered[i].number < spec2->numbered[j].number ? -1 :
+ 0);
+
+ if (cmp > 0)
+ {
+ if (noisy)
+ {
+ error_with_progname = false;
+ error_at_line (0, 0, pos->file_name, pos->line_number,
+ _("a format specification for argument %u, as in '%s', doesn't exist in 'msgid'"),
+ spec2->numbered[j].number, pretty_msgstr);
+ error_with_progname = true;
+ }
+ err = true;
+ break;
+ }
+ else if (cmp < 0)
+ {
+ if (equality)
+ {
+ if (noisy)
+ {
+ error_with_progname = false;
+ error_at_line (0, 0, pos->file_name, pos->line_number,
+ _("a format specification for argument %u doesn't exist in '%s'"),
+ spec1->numbered[i].number, pretty_msgstr);
+ error_with_progname = true;
+ }
+ err = true;
+ break;
+ }
+ else
+ i++;
+ }
+ else
+ j++, i++;
+ }
+ /* Check the argument types are the same. */
+ if (!err)
+ for (i = 0, j = 0; j < n2; )
+ {
+ if (spec1->numbered[i].number == spec2->numbered[j].number)
+ {
+ if (spec1->numbered[i].type != spec2->numbered[j].type)
+ {
+ if (noisy)
+ {
+ error_with_progname = false;
+ error_at_line (0, 0, pos->file_name, pos->line_number,
+ _("format specifications in 'msgid' and '%s' for argument %u are not the same"),
+ pretty_msgstr,
+ spec2->numbered[j].number);
+ error_with_progname = true;
+ }
+ err = true;
+ break;
+ }
+ j++, i++;
+ }
+ else
+ i++;
+ }
+ }
+
+ return err;
+}
+
+
+struct formatstring_parser formatstring_tcl =
+{
+ format_parse,
+ format_free,
+ format_get_number_of_directives,
+ format_check
+};
+
+
+#ifdef TEST
+
+/* Test program: Print the argument list specification returned by
+ format_parse for strings read from standard input. */
+
+#include <stdio.h>
+#include "getline.h"
+
+static void
+format_print (descr)
+ void *descr;
+{
+ struct spec *spec = (struct spec *) descr;
+ unsigned int last;
+ unsigned int i;
+
+ if (spec == NULL)
+ {
+ printf ("INVALID");
+ return;
+ }
+
+ printf ("(");
+ last = 1;
+ for (i = 0; i < spec->numbered_arg_count; i++)
+ {
+ unsigned int number = spec->numbered[i].number;
+
+ if (i > 0)
+ printf (" ");
+ if (number < last)
+ abort ();
+ for (; last < number; last++)
+ printf ("_ ");
+ switch (spec->numbered[i].type)
+ {
+ case FAT_CHARACTER:
+ printf ("c");
+ break;
+ case FAT_STRING:
+ printf ("s");
+ break;
+ case FAT_INTEGER:
+ printf ("i");
+ break;
+ case FAT_UNSIGNED_INTEGER:
+ printf ("[unsigned]i");
+ break;
+ case FAT_SHORT_INTEGER:
+ printf ("hi");
+ break;
+ case FAT_UNSIGNED_SHORT_INTEGER:
+ printf ("[unsigned]hi");
+ break;
+ case FAT_FLOAT:
+ printf ("f");
+ break;
+ default:
+ abort ();
+ }
+ last = number + 1;
+ }
+ printf (")");
+}
+
+int
+main ()
+{
+ for (;;)
+ {
+ char *line = NULL;
+ size_t line_len = 0;
+ void *descr;
+
+ if (getline (&line, &line_len, stdin) < 0)
+ break;
+
+ descr = format_parse (line);
+
+ format_print (descr);
+ printf ("\n");
+
+ free (line);
+ }
+
+ return 0;
+}
+
+/*
+ * For Emacs M-x compile
+ * Local Variables:
+ * compile-command: "/bin/sh ../libtool --mode=link gcc -o a.out -static -O -g -Wall -I.. -I../lib -I../intl -DHAVE_CONFIG_H -DTEST format-tcl.c ../lib/libgettextlib.la"
+ * End:
+ */
+
+#endif /* TEST */
/* format_java */ &formatstring_java,
/* format_awk */ &formatstring_awk,
/* format_pascal */ &formatstring_pascal,
- /* format_ycp */ &formatstring_ycp
+ /* format_ycp */ &formatstring_ycp,
+ /* format_tcl */ &formatstring_tcl
};
extern struct formatstring_parser formatstring_awk;
extern struct formatstring_parser formatstring_pascal;
extern struct formatstring_parser formatstring_ycp;
+extern struct formatstring_parser formatstring_tcl;
/* Table of all format string parsers. */
extern struct formatstring_parser *formatstring_parsers[NFORMATS];
/* format_java */ "java",
/* format_awk */ "awk",
/* format_pascal */ "object-pascal",
- /* format_ycp */ "ycp"
+ /* format_ycp */ "ycp",
+ /* format_tcl */ "tcl"
};
const char *const format_language_pretty[NFORMATS] =
/* format_java */ "Java",
/* format_awk */ "awk",
/* format_pascal */ "Object Pascal",
- /* format_ycp */ "YCP"
+ /* format_ycp */ "YCP",
+ /* format_tcl */ "Tcl"
};
format_java,
format_awk,
format_pascal,
- format_ycp
+ format_ycp,
+ format_tcl
};
-#define NFORMATS 10 /* Number of format_type enum values. */
+#define NFORMATS 11 /* Number of format_type enum values. */
extern const char *const format_language[NFORMATS];
extern const char *const format_language_pretty[NFORMATS];
#include "msgfmt.h"
#include "write-mo.h"
#include "write-java.h"
+#include "write-tcl.h"
#include "gettext.h"
#include "message.h"
static const char *java_locale_name;
static const char *java_class_directory;
+/* Tcl mode output file specification. */
+static bool tcl_mode;
+static const char *tcl_locale_name;
+static const char *tcl_base_directory;
+
/* We may have more than one input file. Domains with same names in
different files have to merged. So we need a list of tables for
each output file. */
{ "resource", required_argument, NULL, 'r' },
{ "statistics", no_argument, &do_statistics, 1 },
{ "strict", no_argument, NULL, 'S' },
+ { "tcl", no_argument, NULL, CHAR_MAX + 7 },
{ "use-fuzzy", no_argument, NULL, 'f' },
{ "verbose", no_argument, NULL, 'v' },
{ "version", no_argument, NULL, 'V' },
break;
case 'd':
java_class_directory = optarg;
+ tcl_base_directory = optarg;
break;
case 'D':
dir_list_append (optarg);
break;
case 'l':
java_locale_name = optarg;
+ tcl_locale_name = optarg;
break;
case 'o':
output_file_name = optarg;
case CHAR_MAX + 6:
no_hash_table = true;
break;
+ case CHAR_MAX + 7:
+ tcl_mode = true;
+ break;
default:
usage (EXIT_FAILURE);
break;
}
/* Check for contradicting options. */
+ if (java_mode && tcl_mode)
+ error (EXIT_FAILURE, 0, _("%s and %s are mutually exclusive"),
+ "--java", "--tcl");
if (java_mode)
{
if (output_file_name != NULL)
{
error (EXIT_FAILURE, 0, _("%s and %s are mutually exclusive"),
- "--java-mode", "--output-file");
+ "--java", "--output-file");
}
if (java_class_directory == NULL)
{
error (EXIT_SUCCESS, 0,
_("%s requires a \"-d directory\" specification"),
- "--java-mode");
+ "--java");
+ usage (EXIT_FAILURE);
+ }
+ }
+ else if (tcl_mode)
+ {
+ if (output_file_name != NULL)
+ {
+ error (EXIT_FAILURE, 0, _("%s and %s are mutually exclusive"),
+ "--tcl", "--output-file");
+ }
+ if (tcl_locale_name == NULL)
+ {
+ error (EXIT_SUCCESS, 0,
+ _("%s requires a \"-l locale\" specification"),
+ "--tcl");
+ usage (EXIT_FAILURE);
+ }
+ if (tcl_base_directory == NULL)
+ {
+ error (EXIT_SUCCESS, 0,
+ _("%s requires a \"-d directory\" specification"),
+ "--tcl");
usage (EXIT_FAILURE);
}
}
if (java_resource_name != NULL)
{
error (EXIT_SUCCESS, 0, _("%s is only valid with %s"),
- "--resource", "--java-mode");
+ "--resource", "--java");
usage (EXIT_FAILURE);
}
if (java_locale_name != NULL)
{
- error (EXIT_SUCCESS, 0, _("%s is only valid with %s"),
- "--locale", "--java-mode");
+ error (EXIT_SUCCESS, 0, _("%s is only valid with %s or %s"),
+ "--locale", "--java", "--tcl");
usage (EXIT_FAILURE);
}
if (java_class_directory != NULL)
{
- error (EXIT_SUCCESS, 0, _("%s is only valid with %s"),
- "-d", "--java-mode");
+ error (EXIT_SUCCESS, 0, _("%s is only valid with %s or %s"),
+ "-d", "--java", "--tcl");
usage (EXIT_FAILURE);
}
}
assume_java2))
exit_status = EXIT_FAILURE;
}
+ else if (tcl_mode)
+ {
+ if (msgdomain_write_tcl (domain->mlp,
+ tcl_locale_name, tcl_base_directory))
+ exit_status = EXIT_FAILURE;
+ }
else
{
if (msgdomain_write_mo (domain->mlp, domain->domain_name,
Operation mode:\n\
-j, --java Java mode: generate a Java ResourceBundle class\n\
--java2 like --java, and assume Java2 (JDK 1.2 or higher)\n\
+ --tcl Tcl mode: generate a tcl/msgcat .msg file\n\
"));
printf ("\n");
/* xgettext: no-wrap */
The class name is determined by appending the locale name to the resource name,\n\
separated with an underscore. The -d option is mandatory. The class is\n\
written under the specified directory.\n\
+"));
+ printf ("\n");
+ /* xgettext: no-wrap */
+ printf (_("\
+Output file location in Tcl mode:\n\
+ -l, --locale=LOCALE locale name, either language or language_COUNTRY\n\
+ -d DIRECTORY base directory of .msg message catalogs\n\
+The -l and -d options are mandatory. The .msg file is written in the\n\
+specified directory.\n\
"));
printf ("\n");
/* xgettext: no-wrap */
{
/* If no output file was given, we change it with each `domain'
directive. */
- if (!java_mode && output_file_name == NULL)
+ if (!java_mode && !tcl_mode && output_file_name == NULL)
{
size_t correct;
#endif
#include <getopt.h>
+#include <limits.h>
#include <stdbool.h>
#include <stdio.h>
#include <stdlib.h>
#include "msgunfmt.h"
#include "read-mo.h"
#include "read-java.h"
+#include "read-tcl.h"
#include "write-po.h"
#include "gettext.h"
static const char *java_resource_name;
static const char *java_locale_name;
+/* Tcl mode input file specification. */
+static bool tcl_mode;
+static const char *tcl_locale_name;
+static const char *tcl_base_directory;
+
/* Force output of PO file even if empty. */
static int force_po;
{ "resource", required_argument, NULL, 'r' },
{ "sort-output", no_argument, NULL, 's' },
{ "strict", no_argument, NULL, 'S' },
+ { "tcl", no_argument, NULL, CHAR_MAX + 1 },
{ "verbose", no_argument, NULL, 'v' },
{ "version", no_argument, NULL, 'V' },
{ "width", required_argument, NULL, 'w', },
bindtextdomain (PACKAGE, LOCALEDIR);
textdomain (PACKAGE);
- while ((optchar = getopt_long (argc, argv, "eEhijl:o:r:svVw:", long_options,
- NULL))
+ while ((optchar = getopt_long (argc, argv, "d:eEhijl:o:r:svVw:",
+ long_options, NULL))
!= EOF)
switch (optchar)
{
/* long option */
break;
+ case 'd':
+ tcl_base_directory = optarg;
+ break;
+
case 'e':
message_print_style_escape (false);
break;
case 'l':
java_locale_name = optarg;
+ tcl_locale_name = optarg;
break;
case 'o':
}
break;
+ case CHAR_MAX + 1:
+ tcl_mode = true;
+ break;
+
default:
usage (EXIT_FAILURE);
break;
usage (EXIT_SUCCESS);
/* Check for contradicting options. */
+ if (java_mode && tcl_mode)
+ error (EXIT_FAILURE, 0, _("%s and %s are mutually exclusive"),
+ "--java", "--tcl");
if (java_mode)
{
if (optind < argc)
{
error (EXIT_FAILURE, 0,
_("%s and explicit file names are mutually exclusive"),
- "--java-mode");
+ "--java");
+ }
+ }
+ else if (tcl_mode)
+ {
+ if (optind < argc)
+ {
+ error (EXIT_FAILURE, 0,
+ _("%s and explicit file names are mutually exclusive"),
+ "--tcl");
+ }
+ if (tcl_locale_name == NULL)
+ {
+ error (EXIT_SUCCESS, 0,
+ _("%s requires a \"-l locale\" specification"),
+ "--tcl");
+ usage (EXIT_FAILURE);
+ }
+ if (tcl_base_directory == NULL)
+ {
+ error (EXIT_SUCCESS, 0,
+ _("%s requires a \"-d directory\" specification"),
+ "--tcl");
+ usage (EXIT_FAILURE);
}
}
else
if (java_resource_name != NULL)
{
error (EXIT_SUCCESS, 0, _("%s is only valid with %s"),
- "--resource", "--java-mode");
+ "--resource", "--java");
usage (EXIT_FAILURE);
}
if (java_locale_name != NULL)
{
error (EXIT_SUCCESS, 0, _("%s is only valid with %s"),
- "--locale", "--java-mode");
+ "--locale", "--java");
usage (EXIT_FAILURE);
}
}
{
result = msgdomain_read_java (java_resource_name, java_locale_name);
}
+ else if (tcl_mode)
+ {
+ result = msgdomain_read_tcl (tcl_locale_name, tcl_base_directory);
+ }
else
{
message_list_ty *mlp;
/* xgettext: no-wrap */
printf (_("\
Operation mode:\n\
- -j, --java Java mode: generate a Java ResourceBundle class\n\
+ -j, --java Java mode: input is a Java ResourceBundle class\n\
+ --tcl Tcl mode: input is a tcl/msgcat .msg file\n\
"));
printf ("\n");
/* xgettext: no-wrap */
-l, --locale=LOCALE locale name, either language or language_COUNTRY\n\
The class name is determined by appending the locale name to the resource name,\n\
separated with an underscore. The class is located using the CLASSPATH.\n\
+"));
+ printf ("\n");
+ /* xgettext: no-wrap */
+ printf (_("\
+Input file location in Tcl mode:\n\
+ -l, --locale=LOCALE locale name, either language or language_COUNTRY\n\
+ -d DIRECTORY base directory of .msg message catalogs\n\
+The -l and -d options are mandatory. The .msg file is located in the\n\
+specified directory.\n\
"));
printf ("\n");
/* xgettext: no-wrap */
--- /dev/null
+/* Reading tcl/msgcat .msg files.
+ Copyright (C) 2002 Free Software Foundation, Inc.
+ Written by Bruno Haible <bruno@clisp.org>, 2002.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software Foundation,
+ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+#include "liballoca.h"
+
+/* Specification. */
+#include "read-tcl.h"
+
+#include <errno.h>
+#include <stdio.h>
+#include <stdlib.h>
+
+#include "msgunfmt.h"
+#include "pathname.h"
+#include "sh-quote.h"
+#include "pipe.h"
+#include "wait-process.h"
+#include "read-po.h"
+#include "error.h"
+#include "exit.h"
+#include "gettext.h"
+
+#define _(str) gettext (str)
+
+
+/* A Tcl .msg file contains Tcl commands. It is best interpreted by Tcl
+ itself. But we redirect the msgcat::mcset function so that it passes
+ the msgid/msgstr pair to us, instead of storing it in the hash table. */
+
+msgdomain_list_ty *
+msgdomain_read_tcl (locale_name, directory)
+ const char *locale_name;
+ const char *directory;
+{
+ const char *gettextdatadir;
+ char *tclscript;
+ size_t len;
+ char *frobbed_locale_name;
+ char *p;
+ char *file_name;
+ char *argv[4];
+ pid_t child;
+ int fd[1];
+ FILE *fp;
+ msgdomain_list_ty *mdlp;
+ int exitstatus;
+ size_t k;
+
+ /* Make it possible to override the msgunfmt.tcl location. This is
+ necessary for running the testsuite before "make install". */
+ gettextdatadir = getenv ("GETTEXTDATADIR");
+ if (gettextdatadir == NULL || gettextdatadir[0] == '\0')
+ gettextdatadir = GETTEXTDATADIR;
+
+ tclscript = concatenated_pathname (gettextdatadir, "msgunfmt.tcl", NULL);
+
+ /* Convert the locale name to lowercase and remove any encoding. */
+ len = strlen (locale_name);
+ frobbed_locale_name = (char *) alloca (len + 1);
+ memcpy (frobbed_locale_name, locale_name, len + 1);
+ for (p = frobbed_locale_name; *p != '\0'; p++)
+ if (*p >= 'A' && *p <= 'Z')
+ *p = *p - 'A' + 'a';
+ else if (*p == '.')
+ {
+ *p = '\0';
+ break;
+ }
+
+ file_name = concatenated_pathname (directory, frobbed_locale_name, ".msg");
+
+ /* Prepare arguments. */
+ argv[0] = "tclsh";
+ argv[1] = tclscript;
+ argv[2] = file_name;
+ argv[3] = NULL;
+
+ if (verbose)
+ {
+ char *command = shell_quote_argv (argv);
+ printf ("%s\n", command);
+ free (command);
+ }
+
+ /* Open a pipe to the Tcl interpreter. */
+ child = create_pipe_in ("tclsh", "tclsh", argv, "/dev/null", false, true,
+ fd);
+
+ fp = fdopen (fd[0], "r");
+ if (fp == NULL)
+ error (EXIT_FAILURE, errno, _("fdopen() failed"));
+
+ /* Read the message list. */
+ mdlp = read_po (fp, "(pipe)", "(pipe)");
+
+ fclose (fp);
+
+ /* Remove zombie process from process list, and retrieve exit status. */
+ exitstatus = wait_subprocess (child, "tclsh", true);
+ if (exitstatus != 0)
+ {
+ if (exitstatus == 2)
+ /* Special exitcode provided by msgunfmt.tcl. */
+ error (EXIT_FAILURE, ENOENT,
+ _("error while opening \"%s\" for reading"), file_name);
+ else
+ error (EXIT_FAILURE, 0, _("%s subprocess failed with exit code %d"),
+ "tclsh", exitstatus);
+ }
+
+ free (tclscript);
+
+ /* Move the header entry to the beginning. */
+ for (k = 0; k < mdlp->nitems; k++)
+ {
+ message_list_ty *mlp = mdlp->item[k]->messages;
+ size_t j;
+
+ for (j = 0; j < mlp->nitems; j++)
+ if (mlp->item[j]->msgid[0] == '\0')
+ {
+ /* Found the header entry. */
+ if (j > 0)
+ {
+ message_ty *header = mlp->item[j];
+ size_t i;
+
+ for (i = j; i > 0; i--)
+ mlp->item[i] = mlp->item[i - 1];
+ mlp->item[0] = header;
+ }
+ break;
+ }
+ }
+
+ return mdlp;
+}
--- /dev/null
+/* Reading tcl/msgcat .msg files.
+ Copyright (C) 2002 Free Software Foundation, Inc.
+ Written by Bruno Haible <bruno@clisp.org>, 2002.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software Foundation,
+ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+
+#ifndef _READ_TCL_H
+#define _READ_TCL_H
+
+#include "message.h"
+
+/* Read the Tcl msg file given by locale_name and directory.
+ Returns a list of messages. */
+extern msgdomain_list_ty *
+ msgdomain_read_tcl PARAMS ((const char *locale_name,
+ const char *directory));
+
+#endif /* _READ_TCL_H */
--- /dev/null
+/* Writing tcl/msgcat .msg files.
+ Copyright (C) 2002 Free Software Foundation, Inc.
+ Written by Bruno Haible <bruno@clisp.org>, 2002.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software Foundation,
+ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+#include "liballoca.h"
+
+/* Specification. */
+#include "write-tcl.h"
+
+#include <errno.h>
+#include <stdbool.h>
+#include <stdio.h>
+#include <string.h>
+
+#include "error.h"
+#include "xerror.h"
+#include "message.h"
+#include "msgl-iconv.h"
+#include "po-charset.h"
+#include "xmalloc.h"
+#include "pathname.h"
+#include "exit.h"
+#include "utf8-ucs4.h"
+#include "gettext.h"
+
+#define _(str) gettext (str)
+
+
+/* Prototypes for local functions. Needed to ensure compiler checking of
+ function argument counts despite of K&R C function definition syntax. */
+static void write_tcl_string PARAMS ((FILE *stream, const char *str));
+static void write_msg PARAMS ((FILE *output_file, message_list_ty *mlp,
+ const char *locale_name));
+
+
+/* Write a string in Tcl Unicode notation to the given stream.
+ Tcl 8 uses Unicode for its internal string representation.
+ In tcl-8.3.3, the .msg files are read in using the locale dependent
+ encoding. The only way to specify strings in an encoding independent
+ form is the \unnnn notation. Newer tcl versions have this fixed:
+ they read the .msg files in UTF-8 encoding. */
+static void
+write_tcl_string (stream, str)
+ FILE *stream;
+ const char *str;
+{
+ static const char hexdigit[] = "0123456789abcdef";
+ const char *str_limit = str + strlen (str);
+
+ fprintf (stream, "\"");
+ while (str < str_limit)
+ {
+ unsigned int uc;
+ unsigned int count;
+ count = u8_mbtouc (&uc, str, str_limit - str);
+ if (uc < 0x10000)
+ {
+ /* Single UCS-2 'char'. */
+ if (uc == 0x000a)
+ fprintf (stream, "\\n");
+ else if (uc == 0x000d)
+ fprintf (stream, "\\r");
+ else if (uc == 0x0022)
+ fprintf (stream, "\\\"");
+ else if (uc == 0x0024)
+ fprintf (stream, "\\$");
+ else if (uc == 0x005b)
+ fprintf (stream, "\\[");
+ else if (uc == 0x005c)
+ fprintf (stream, "\\\\");
+ else if (uc == 0x005d)
+ fprintf (stream, "\\]");
+ /* No need to escape '{' and '}' because we don't have opening
+ braces outside the strings. */
+#if 0
+ else if (uc == 0x007b)
+ fprintf (stream, "\\{");
+ else if (uc == 0x007d)
+ fprintf (stream, "\\}");
+#endif
+ else if (uc >= 0x0020 && uc < 0x007f)
+ fprintf (stream, "%c", uc);
+ else
+ fprintf (stream, "\\u%c%c%c%c",
+ hexdigit[(uc >> 12) & 0x0f], hexdigit[(uc >> 8) & 0x0f],
+ hexdigit[(uc >> 4) & 0x0f], hexdigit[uc & 0x0f]);
+ }
+ else
+ /* The \unnnn notation doesn't support characters >= 0x10000.
+ We output them as UTF-8 byte sequences and hope that either
+ the Tcl version reading them will be new enough or that the
+ user is using an UTF-8 locale. */
+ fwrite (str, 1, count, stream);
+ str += count;
+ }
+ fprintf (stream, "\"");
+}
+
+
+static void
+write_msg (output_file, mlp, locale_name)
+ FILE *output_file;
+ message_list_ty *mlp;
+ const char *locale_name;
+{
+ size_t j;
+
+ /* We don't care about esthetic formattic of the output (like respecting
+ a maximum line width, or including the translator comments) because
+ the \unnnn notation is unesthetic anyway. Translators shall edit
+ the PO file. */
+ for (j = 0; j < mlp->nitems; j++)
+ {
+ message_ty *mp = mlp->item[j];
+
+ if (mp->msgid[0] == '\0')
+ /* Tcl's msgcat unit ignores this, but msgunfmt needs it. */
+ fprintf (output_file, "set ::msgcat::header ");
+ else
+ {
+ fprintf (output_file, "::msgcat::mcset %s ", locale_name);
+ write_tcl_string (output_file, mp->msgid);
+ fprintf (output_file, " ");
+ }
+ write_tcl_string (output_file, mp->msgstr);
+ fprintf (output_file, "\n");
+ }
+}
+
+int
+msgdomain_write_tcl (mlp, locale_name, directory)
+ message_list_ty *mlp;
+ const char *locale_name;
+ const char *directory;
+{
+ /* If no entry for this domain don't even create the file. */
+ if (mlp->nitems == 0)
+ return 0;
+
+ /* Determine whether mlp has plural entries. */
+ {
+ bool has_plural;
+ size_t j;
+
+ has_plural = false;
+ for (j = 0; j < mlp->nitems; j++)
+ if (mlp->item[j]->msgid_plural != NULL)
+ has_plural = true;
+ if (has_plural)
+ {
+ multiline_error (xstrdup (""),
+ xstrdup (_("\
+message catalog has plural form translations\n\
+but the Tcl message catalog format doesn't support plural handling\n")));
+ return 1;
+ }
+ }
+
+ /* Convert the messages to Unicode. */
+ iconv_message_list (mlp, NULL, po_charset_canonicalize ("UTF-8"));
+
+ /* Now create the file. */
+ {
+ size_t len;
+ char *frobbed_locale_name;
+ char *p;
+ char *file_name;
+ FILE *output_file;
+
+ /* Convert the locale name to lowercase and remove any encoding. */
+ len = strlen (locale_name);
+ frobbed_locale_name = (char *) alloca (len + 1);
+ memcpy (frobbed_locale_name, locale_name, len + 1);
+ for (p = frobbed_locale_name; *p != '\0'; p++)
+ if (*p >= 'A' && *p <= 'Z')
+ *p = *p - 'A' + 'a';
+ else if (*p == '.')
+ {
+ *p = '\0';
+ break;
+ }
+
+ file_name = concatenated_pathname (directory, frobbed_locale_name, ".msg");
+
+ output_file = fopen (file_name, "w");
+ if (output_file == NULL)
+ {
+ error (0, errno, _("error while opening \"%s\" for writing"),
+ file_name);
+ return 1;
+ }
+
+ write_msg (output_file, mlp, frobbed_locale_name);
+
+ /* Make sure nothing went wrong. */
+ if (fflush (output_file) || ferror (output_file))
+ error (EXIT_FAILURE, errno, _("error while writing \"%s\" file"),
+ file_name);
+
+ fclose (output_file);
+ }
+
+ return 0;
+}
--- /dev/null
+/* Writing tcl/msgcat .msg files.
+ Copyright (C) 2002 Free Software Foundation, Inc.
+ Written by Bruno Haible <bruno@clisp.org>, 2002.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software Foundation,
+ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+
+#ifndef _WRITE_TCL_H
+#define _WRITE_TCL_H
+
+#include "message.h"
+
+/* Write a Tcl msg file. mlp is a list containing the messages to be output.
+ locale_name is the locale name (with underscore separators), directory is
+ the base directory.
+ Return 0 if ok, nonzero on error. */
+extern int
+ msgdomain_write_tcl PARAMS ((message_list_ty *mlp,
+ const char *locale_name,
+ const char *directory));
+
+#endif /* _WRITE_TCL_H */
--- /dev/null
+/* xgettext Tcl backend.
+ Copyright (C)2002 Free Software Foundation, Inc.
+
+ This file was written by Bruno Haible <haible@clisp.cons.org>, 2002.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software Foundation,
+ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+
+#ifdef HAVE_CONFIG_H
+# include "config.h"
+#endif
+
+#include <assert.h>
+#include <errno.h>
+#include <limits.h>
+#include <stdbool.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include "message.h"
+#include "x-tcl.h"
+#include "xgettext.h"
+#include "error.h"
+#include "xmalloc.h"
+#include "exit.h"
+#include "hash.h"
+#include "c-ctype.h"
+#include "po-charset.h"
+#include "msgl-ascii.h"
+#include "msgl-iconv.h"
+#include "ucs4-utf8.h"
+#include "gettext.h"
+
+#define _(s) gettext(s)
+
+#if HAVE_C_BACKSLASH_A
+# define ALERT_CHAR '\a'
+#else
+# define ALERT_CHAR '\7'
+#endif
+
+
+/* The Tcl syntax is defined in the Tcl.n manual page.
+ Summary of Tcl syntax:
+ Like sh syntax, except that `...` is replaced with [...]. In detail:
+ - In a preprocessing pass, backslash-newline-anywhitespace is replaced
+ with single space.
+ - Input is broken into words, which are then subject to command
+ substitution [...] , variable substitution $var, backslash substitution
+ \escape.
+ - Strings are enclosed in "..."; command substitution, variable
+ substitution and backslash substitutions are performed here as well.
+ - {...} is a string without substitutions.
+ - The list of resulting words is split into commands by semicolon and
+ newline.
+ - '#' at the beginning of a command introduces a comment until end of line.
+ The parser is implemented in tcl8.3.3/generic/tclParse.c. */
+
+
+/* Prototypes for local functions. Needed to ensure compiler checking of
+ function argument counts despite of K&R C function definition syntax. */
+struct token;
+struct word;
+static void init_keywords PARAMS ((void));
+static int do_getc PARAMS ((void));
+static void do_ungetc PARAMS ((int c));
+static int phase1_getc PARAMS ((void));
+static void phase1_ungetc PARAMS ((int c));
+static int phase2_push PARAMS ((void));
+static void phase2_pop PARAMS ((int previous_depth));
+static int phase2_getc PARAMS ((void));
+static void phase2_ungetc PARAMS ((int c));
+static inline void init_token PARAMS ((struct token *tp));
+static inline void free_token PARAMS ((struct token *tp));
+static inline void grow_token PARAMS ((struct token *tp));
+static inline void comment_start PARAMS ((void));
+static inline void comment_add PARAMS ((int c));
+static inline void comment_line_end PARAMS ((void));
+static inline void free_word PARAMS ((struct word *wp));
+static char * string_of_word PARAMS ((const struct word *wp));
+static int do_getc_escaped PARAMS ((void));
+
+
+/* ====================== Keyword set customization. ====================== */
+
+/* If true extract all strings. */
+static bool extract_all = false;
+
+static hash_table keywords;
+static bool default_keywords = true;
+
+
+void
+x_tcl_extract_all ()
+{
+ extract_all = true;
+}
+
+
+void
+x_tcl_keyword (name)
+ const char *name;
+{
+ if (name == NULL)
+ default_keywords = false;
+ else
+ {
+ const char *end;
+ int argnum1;
+ int argnum2;
+
+ if (keywords.table == NULL)
+ init_hash (&keywords, 100);
+
+ split_keywordspec (name, &end, &argnum1, &argnum2);
+
+ /* The characters between name and end should form a valid Tcl
+ function name. A leading "::" is redundant. */
+ if (end - name >= 2 && name[0] == ':' && name[1] == ':')
+ name += 2;
+
+ if (argnum1 == 0)
+ argnum1 = 1;
+ insert_entry (&keywords, name, end - name,
+ (void *) (long) (argnum1 + (argnum2 << 10)));
+ }
+}
+
+/* Finish initializing the keywords hash table.
+ Called after argument processing, before each file is processed. */
+static void
+init_keywords ()
+{
+ if (default_keywords)
+ {
+ x_tcl_keyword ("::msgcat::mc");
+ default_keywords = false;
+ }
+}
+
+
+/* ======================== Reading of characters. ======================== */
+
+/* Real filename, used in error messages about the input file. */
+static const char *real_file_name;
+
+/* Logical filename and line number, used to label the extracted messages. */
+static char *logical_file_name;
+static int line_number;
+
+/* The input file stream. */
+static FILE *fp;
+
+
+/* Fetch the next character from the input file. */
+static int
+do_getc ()
+{
+ int c = getc (fp);
+
+ if (c == EOF)
+ {
+ if (ferror (fp))
+ error (EXIT_FAILURE, errno, _("\
+error while reading \"%s\""), real_file_name);
+ }
+ else if (c == '\n')
+ line_number++;
+
+ return c;
+}
+
+/* Put back the last fetched character, not EOF. */
+static void
+do_ungetc (c)
+ int c;
+{
+ if (c == '\n')
+ line_number--;
+ ungetc (c, fp);
+}
+
+
+/* Combine backslash followed by newline and additional whitespace to
+ a single space. Cope with potentially 2 characters of pushback. */
+
+/* An int that becomes a space when casted to 'unsigned char'. */
+#define BS_NL (UCHAR_MAX + 1 + ' ')
+
+/* Maximum used guaranteed to be < 4. */
+static int phase1_pushback[4];
+static int phase1_pushback_length;
+
+static int
+phase1_getc ()
+{
+ int c;
+
+ if (phase1_pushback_length)
+ {
+ c = phase1_pushback[--phase1_pushback_length];
+ if (c == '\n' || c == BS_NL)
+ ++line_number;
+ return c;
+ }
+ c = do_getc ();
+ if (c != '\\')
+ return c;
+ c = do_getc ();
+ if (c != '\n')
+ {
+ if (c != EOF)
+ do_ungetc (c);
+ return '\\';
+ }
+ for (;;)
+ {
+ c = do_getc ();
+ if (!(c == ' ' || c == '\t'))
+ break;
+ }
+ if (c != EOF)
+ do_ungetc (c);
+ return BS_NL;
+}
+
+static void
+phase1_ungetc (c)
+ int c;
+{
+ switch (c)
+ {
+ case EOF:
+ break;
+
+ case '\n':
+ case BS_NL:
+ --line_number;
+ /* FALLTHROUGH */
+
+ default:
+ phase1_pushback[phase1_pushback_length++] = c;
+ break;
+ }
+}
+
+
+/* Keep track of brace nesting depth.
+ When a word starts with an opening brace, a character group begins that
+ ends with the corresponding closing brace. In theory these character
+ groups are string literals, but they are used by so many Tcl primitives
+ (proc, if, ...) as representing command lists, that we treat them as
+ command lists. */
+
+/* An int that becomes a closing brace when casted to 'unsigned char'. */
+#define CL_BRACE (UCHAR_MAX + 1 + '}')
+
+/* Maximum used guaranteed to be < 4. */
+static int phase2_pushback[4];
+static int phase2_pushback_length;
+
+/* Brace nesting depth inside the current character group. */
+static int brace_depth;
+
+static int
+phase2_push ()
+{
+ int previous_depth = brace_depth;
+ brace_depth = 1;
+ return previous_depth;
+}
+
+static void
+phase2_pop (previous_depth)
+ int previous_depth;
+{
+ brace_depth = previous_depth;
+}
+
+static int
+phase2_getc ()
+{
+ int c;
+
+ if (phase2_pushback_length)
+ {
+ c = phase2_pushback[--phase2_pushback_length];
+ if (c == '\n' || c == BS_NL)
+ ++line_number;
+ else if (c == '{')
+ ++brace_depth;
+ else if (c == '}')
+ --brace_depth;
+ return c;
+ }
+ c = phase1_getc ();
+ if (c == '{')
+ ++brace_depth;
+ else if (c == '}')
+ {
+ if (--brace_depth == 0)
+ c = CL_BRACE;
+ }
+ return c;
+}
+
+static void
+phase2_ungetc (c)
+ int c;
+{
+ if (c != EOF)
+ {
+ switch (c)
+ {
+ case '\n':
+ case BS_NL:
+ --line_number;
+ break;
+
+ case '{':
+ --brace_depth;
+ break;
+
+ case '}':
+ ++brace_depth;
+ break;
+ }
+ phase2_pushback[phase2_pushback_length++] = c;
+ }
+}
+
+
+/* ========================== Reading of tokens. ========================== */
+
+
+/* A token consists of a sequence of characters. */
+struct token
+{
+ int allocated; /* number of allocated 'token_char's */
+ int charcount; /* number of used 'token_char's */
+ char *chars; /* the token's constituents */
+};
+
+/* Initialize a 'struct token'. */
+static inline void
+init_token (tp)
+ struct token *tp;
+{
+ tp->allocated = 10;
+ tp->chars = (char *) xmalloc (tp->allocated * sizeof (char));
+ tp->charcount = 0;
+}
+
+/* Free the memory pointed to by a 'struct token'. */
+static inline void
+free_token (tp)
+ struct token *tp;
+{
+ free (tp->chars);
+}
+
+/* Ensure there is enough room in the token for one more character. */
+static inline void
+grow_token (tp)
+ struct token *tp;
+{
+ if (tp->charcount == tp->allocated)
+ {
+ tp->allocated *= 2;
+ tp->chars = (char *) xrealloc (tp->chars, tp->allocated * sizeof (char));
+ }
+}
+
+
+/* ========================= Accumulating comments ========================= */
+
+
+static char *buffer;
+static size_t bufmax;
+static size_t buflen;
+
+static inline void
+comment_start ()
+{
+ buflen = 0;
+}
+
+static inline void
+comment_add (c)
+ int c;
+{
+ if (buflen >= bufmax)
+ {
+ bufmax += 100;
+ buffer = xrealloc (buffer, bufmax);
+ }
+ buffer[buflen++] = c;
+}
+
+static inline void
+comment_line_end ()
+{
+ while (buflen >= 1
+ && (buffer[buflen - 1] == ' ' || buffer[buflen - 1] == '\t'))
+ --buflen;
+ if (buflen >= bufmax)
+ {
+ bufmax += 100;
+ buffer = xrealloc (buffer, bufmax);
+ }
+ buffer[buflen] = '\0';
+ xgettext_comment_add (buffer);
+}
+
+
+/* These are for tracking whether comments count as immediately before
+ keyword. */
+static int last_comment_line;
+static int last_non_comment_line;
+
+
+/* ========================= Accumulating messages ========================= */
+
+
+static message_list_ty *mlp;
+
+
+/* ========================== Reading of commands ========================== */
+
+
+/* We are only interested in constant strings (e.g. "msgcat::mc" or other
+ string literals). Other words need not to be represented precisely. */
+enum word_type
+{
+ t_string, /* constant string */
+ t_other, /* other string */
+ t_separator, /* command separator: semicolon or newline */
+ t_bracket, /* ']' pseudo word */
+ t_brace, /* '}' pseudo word */
+ t_eof /* EOF marker */
+};
+
+struct word
+{
+ enum word_type type;
+ struct token *token; /* for t_string */
+ int line_number_at_start; /* for t_string */
+};
+
+/* Free the memory pointed to by a 'struct word'. */
+static inline void
+free_word (wp)
+ struct word *wp;
+{
+ if (wp->type == t_string)
+ {
+ free_token (wp->token);
+ free (wp->token);
+ }
+}
+
+/* Convert a t_string token to a char*. */
+static char *
+string_of_word (wp)
+ const struct word *wp;
+{
+ char *str;
+ int n;
+
+ if (!(wp->type == t_string))
+ abort ();
+ n = wp->token->charcount;
+ str = (char *) xmalloc (n + 1);
+ memcpy (str, wp->token->chars, n);
+ str[n] = '\0';
+ return str;
+}
+
+
+/* Read an escape sequence. The value is an ISO-8859-1 character (in the
+ range 0x00..0xff) or a Unicode character (in the range 0x0000..0xffff). */
+static int
+do_getc_escaped ()
+{
+ int c;
+
+ c = phase1_getc ();
+ switch (c)
+ {
+ case EOF:
+ return '\\';
+ case 'a':
+ return ALERT_CHAR;
+ case 'b':
+ return '\b';
+ case 'f':
+ return '\f';
+ case 'n':
+ return '\n';
+ case 'r':
+ return '\r';
+ case 't':
+ return '\t';
+ case 'v':
+ return '\v';
+ case 'x':
+ {
+ int n = 0;
+ unsigned int i;
+
+ for (i = 0;; i++)
+ {
+ c = phase1_getc ();
+ if (c == EOF || !c_isxdigit ((unsigned char) c))
+ break;
+
+ if (c >= '0' && c <= '9')
+ n = (n << 4) + (c - '0');
+ else if (c >= 'A' && c <= 'F')
+ n = (n << 4) + (c - 'A' + 10);
+ else if (c >= 'a' && c <= 'f')
+ n = (n << 4) + (c - 'a' + 10);
+ }
+ phase1_ungetc (c);
+ return (i > 0 ? (unsigned char) n : 'x');
+ }
+ case 'u':
+ {
+ int n = 0;
+ unsigned int i;
+
+ for (i = 0; i < 4; i++)
+ {
+ c = phase1_getc ();
+ if (c == EOF || !c_isxdigit ((unsigned char) c))
+ break;
+
+ if (c >= '0' && c <= '9')
+ n = (n << 4) + (c - '0');
+ else if (c >= 'A' && c <= 'F')
+ n = (n << 4) + (c - 'A' + 10);
+ else if (c >= 'a' && c <= 'f')
+ n = (n << 4) + (c - 'a' + 10);
+ }
+ phase1_ungetc (c);
+ return (i > 0 ? n : 'u');
+ }
+ case '0': case '1': case '2': case '3': case '4':
+ case '5': case '6': case '7':
+ {
+ int n = c - '0';
+
+ c = phase1_getc ();
+ if (c != EOF)
+ {
+ if (c >= '0' && c <= '7')
+ {
+ n = (n << 3) + (c - '0');
+ c = phase1_getc ();
+ if (c != EOF)
+ {
+ if (c >= '0' && c <= '7')
+ n = (n << 3) + (c - '0');
+ else
+ phase1_ungetc (c);
+ }
+ }
+ else
+ phase1_ungetc (c);
+ }
+ return (unsigned char) n;
+ }
+ default:
+ /* Note: If c is non-ASCII, Tcl's behaviour is undefined here. */
+ return (unsigned char) c;
+ }
+}
+
+
+enum terminator
+{
+ te_space_separator, /* looking for space semicolon newline */
+ te_space_separator_bracket, /* looking for space semicolon newline ']' */
+ te_paren, /* looking for ')' */
+ te_quote /* looking for '"' */
+};
+
+/* Prototypes for local functions. Needed to ensure compiler checking of
+ function argument counts despite of K&R C function definition syntax. */
+static int accumulate_word PARAMS ((struct word *wp,
+ enum terminator looking_for));
+static void read_word PARAMS ((struct word *wp, int looking_for));
+static enum word_type read_command PARAMS ((int looking_for));
+static enum word_type read_command_list PARAMS ((int looking_for));
+
+/* Accumulate tokens into the given word.
+ 'looking_for' denotes a parse terminator combination. */
+static int
+accumulate_word (wp, looking_for)
+ struct word *wp;
+ enum terminator looking_for;
+{
+ int c;
+
+ for (;;)
+ {
+ c = phase2_getc ();
+
+ if (c == EOF || c == CL_BRACE)
+ return c;
+ if ((looking_for == te_space_separator
+ || looking_for == te_space_separator_bracket)
+ && (c == ' ' || c == BS_NL
+ || c == '\t' || c == '\v' || c == '\f' || c == '\r'
+ || c == ';' || c == '\n'))
+ return c;
+ if (looking_for == te_space_separator_bracket && c == ']')
+ return c;
+ if (looking_for == te_paren && c == ')')
+ return c;
+ if (looking_for == te_quote && c == '"')
+ return c;
+
+ if (c == '$')
+ {
+ /* Distinguish $varname, ${varname} and lone $. */
+ c = phase2_getc ();
+ if (c == '{')
+ {
+ /* ${varname} */
+ do
+ c = phase2_getc ();
+ while (c != EOF && c != '}');
+ wp->type = t_other;
+ }
+ else
+ {
+ bool nonempty = false;
+
+ for (; c != EOF && c != CL_BRACE; c = phase2_getc ())
+ {
+ if (c_isalnum ((unsigned char) c) || (c == '_'))
+ {
+ nonempty = true;
+ continue;
+ }
+ if (c == ':')
+ {
+ c = phase2_getc ();
+ if (c == ':')
+ {
+ do
+ c = phase2_getc ();
+ while (c == ':');
+
+ phase2_ungetc (c);
+ nonempty = true;
+ continue;
+ }
+ phase2_ungetc (c);
+ c = ':';
+ }
+ break;
+ }
+ if (c == '(')
+ {
+ /* $varname(index) */
+ struct word index_word;
+
+ index_word.type = t_other;
+ c = accumulate_word (&index_word, te_paren);
+ if (c != EOF && c != ')')
+ phase2_ungetc (c);
+ wp->type = t_other;
+ }
+ else
+ {
+ phase2_ungetc (c);
+ if (nonempty)
+ {
+ /* $varname */
+ wp->type = t_other;
+ }
+ else
+ {
+ /* lone $ */
+ if (wp->type == t_string)
+ {
+ grow_token (wp->token);
+ wp->token->chars[wp->token->charcount++] = '$';
+ }
+ }
+ }
+ }
+ }
+ else if (c == '[')
+ {
+ read_command_list (']');
+ wp->type = t_other;
+ }
+ else if (c == '\\')
+ {
+ unsigned int uc;
+ unsigned char utf8buf[6];
+ int count;
+ int i;
+
+ uc = do_getc_escaped ();
+ assert (uc < 0x10000);
+ count = u8_uctomb (utf8buf, uc, 6);
+ assert (count > 0);
+ if (wp->type == t_string)
+ for (i = 0; i < count; i++)
+ {
+ grow_token (wp->token);
+ wp->token->chars[wp->token->charcount++] = utf8buf[i];
+ }
+ }
+ else
+ {
+ if (wp->type == t_string)
+ {
+ grow_token (wp->token);
+ wp->token->chars[wp->token->charcount++] = (unsigned char) c;
+ }
+ }
+ }
+}
+
+
+/* Read the next word.
+ 'looking_for' denotes a parse terminator, either ']' or '\0'. */
+static void
+read_word (wp, looking_for)
+ struct word *wp;
+ int looking_for;
+{
+ int c;
+
+ do
+ c = phase2_getc ();
+ while (c == ' ' || c == BS_NL);
+
+ if (c == EOF)
+ {
+ wp->type = t_eof;
+ return;
+ }
+
+ if (c == CL_BRACE)
+ {
+ wp->type = t_brace;
+ last_non_comment_line = line_number;
+ return;
+ }
+
+ if (c == '\n')
+ {
+ /* Comments assumed to be grouped with a message must immediately
+ precede it, with no non-whitespace token on a line between both. */
+ if (last_non_comment_line > last_comment_line)
+ xgettext_comment_reset ();
+ wp->type = t_separator;
+ return;
+ }
+
+ if (c == ';')
+ {
+ wp->type = t_separator;
+ last_non_comment_line = line_number;
+ return;
+ }
+
+ if (looking_for == ']' && c == ']')
+ {
+ wp->type = t_bracket;
+ last_non_comment_line = line_number;
+ return;
+ }
+
+ if (c == '{')
+ {
+ int previous_depth;
+ enum word_type terminator;
+
+ /* Start a new nested character group, which lasts until the next
+ balanced '}' (ignoring \} things). */
+ previous_depth = phase2_push () - 1;
+
+ /* Interpret it as a command list. */
+ terminator = read_command_list ('\0');
+
+ if (terminator == t_brace)
+ phase2_pop (previous_depth);
+
+ wp->type = t_other;
+ last_non_comment_line = line_number;
+ return;
+ }
+
+ wp->type = t_string;
+ wp->token = (struct token *) xmalloc (sizeof (struct token));
+ init_token (wp->token);
+ wp->line_number_at_start = line_number;
+
+ if (c == '"')
+ {
+ c = accumulate_word (wp, te_quote);
+ if (c != EOF && c != '"')
+ phase2_ungetc (c);
+ }
+ else
+ {
+ phase2_ungetc (c);
+ c = accumulate_word (wp,
+ looking_for == ']'
+ ? te_space_separator_bracket
+ : te_space_separator);
+ if (c != EOF)
+ phase2_ungetc (c);
+ }
+
+ if (wp->type != t_string)
+ {
+ free_token (wp->token);
+ free (wp->token);
+ }
+ last_non_comment_line = line_number;
+}
+
+
+/* Read the next command.
+ 'looking_for' denotes a parse terminator, either ']' or '\0'.
+ Returns the type of the word that terminated the command: t_separator or
+ t_bracket (only if looking_for is ']') or t_brace or t_eof. */
+static enum word_type
+read_command (looking_for)
+ int looking_for;
+{
+ int c;
+
+ /* Skip whitespace and comments. */
+ for (;;)
+ {
+ c = phase2_getc ();
+
+ if (c == ' ' || c == BS_NL
+ || c == '\t' || c == '\v' || c == '\f' || c == '\r')
+ continue;
+ if (c == '#')
+ {
+ /* Skip a comment up to end of line. */
+ last_comment_line = line_number;
+ comment_start ();
+ for (;;)
+ {
+ c = phase2_getc ();
+ if (c == EOF || c == CL_BRACE || c == '\n')
+ break;
+ comment_add (c);
+ }
+ comment_line_end ();
+ continue;
+ }
+ break;
+ }
+ phase2_ungetc (c);
+
+ /* Read the words that make up the command. */
+ {
+ int arg = 0; /* Current argument number. */
+ int argnum1 = 0; /* First string position. */
+ int argnum2 = 0; /* Plural string position. */
+ message_ty *plural_mp = NULL; /* Remember the msgid. */
+
+ for (;; arg++)
+ {
+ struct word inner;
+
+ read_word (&inner, looking_for);
+
+ /* Recognize end of command. */
+ if (inner.type == t_separator || inner.type == t_bracket
+ || inner.type == t_brace || inner.type == t_eof)
+ return inner.type;
+
+ if (extract_all)
+ {
+ if (inner.type == t_string)
+ {
+ lex_pos_ty pos;
+
+ pos.file_name = logical_file_name;
+ pos.line_number = inner.line_number_at_start;
+ remember_a_message (mlp, string_of_word (&inner), &pos);
+ }
+ }
+ else
+ {
+ if (arg == 0)
+ {
+ /* This is the function position. */
+ if (inner.type == t_string)
+ {
+ char *function_name = string_of_word (&inner);
+ char *stripped_name;
+ void *keyword_value;
+
+ /* A leading "::" is redundant. */
+ stripped_name = function_name;
+ if (function_name[0] == ':' && function_name[1] == ':')
+ stripped_name += 2;
+
+ if (find_entry (&keywords,
+ stripped_name, strlen (stripped_name),
+ &keyword_value)
+ == 0)
+ {
+ argnum1 = (int) (long) keyword_value & ((1 << 10) - 1);
+ argnum2 = (int) (long) keyword_value >> 10;
+ }
+
+ free (function_name);
+ }
+ }
+ else
+ {
+ /* These are the argument positions.
+ Extract a string if we have reached the right
+ argument position. */
+ if (arg == argnum1)
+ {
+ if (inner.type == t_string)
+ {
+ lex_pos_ty pos;
+ message_ty *mp;
+
+ pos.file_name = logical_file_name;
+ pos.line_number = inner.line_number_at_start;
+ mp = remember_a_message (mlp, string_of_word (&inner), &pos);
+ if (argnum2 > 0)
+ plural_mp = mp;
+ }
+ }
+ else if (arg == argnum2)
+ {
+ if (inner.type == t_string && plural_mp != NULL)
+ {
+ lex_pos_ty pos;
+
+ pos.file_name = logical_file_name;
+ pos.line_number = inner.line_number_at_start;
+ remember_a_message_plural (plural_mp, string_of_word (&inner), &pos);
+ }
+ }
+ }
+ }
+
+ free_word (&inner);
+ }
+ }
+}
+
+
+/* Read a list of commands.
+ 'looking_for' denotes a parse terminator, either ']' or '\0'.
+ Returns the type of the word that terminated the command list:
+ t_bracket (only if looking_for is ']') or t_brace or t_eof. */
+static enum word_type
+read_command_list (looking_for)
+ int looking_for;
+{
+ for (;;)
+ {
+ enum word_type terminator;
+
+ terminator = read_command (looking_for);
+ if (terminator != t_separator)
+ return terminator;
+ }
+}
+
+
+void
+extract_tcl (f, real_filename, logical_filename, mdlp)
+ FILE *f;
+ const char *real_filename;
+ const char *logical_filename;
+ msgdomain_list_ty *mdlp;
+{
+ mlp = mdlp->item[0]->messages;
+
+ fp = f;
+ real_file_name = real_filename;
+ logical_file_name = xstrdup (logical_filename);
+ line_number = 1;
+
+ /* Initially, no brace is open. */
+ brace_depth = 1000000;
+
+ last_comment_line = -1;
+ last_non_comment_line = -1;
+
+ init_keywords ();
+
+ /* Eat tokens until eof is seen. */
+ read_command_list ('\0');
+
+ /* We converted our strings to UTF-8 encoding. If not all the strings
+ were plain ASCII, set the charset in the header to UTF-8. */
+ if (!is_ascii_message_list (mlp))
+ {
+ const char *canon_utf_8 = po_charset_canonicalize ("UTF-8");
+ iconv_message_list (mlp, canon_utf_8, canon_utf_8);
+ }
+
+ fp = NULL;
+ real_file_name = NULL;
+ logical_file_name = NULL;
+ line_number = 0;
+}
--- /dev/null
+/* xgettext Tcl Lisp backend.
+ Copyright (C) 2002 Free Software Foundation, Inc.
+ Written by Bruno Haible <haible@clisp.cons.org>, 2002.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software Foundation,
+ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+
+
+#define EXTENSIONS_TCL \
+ { "tcl", "Tcl" }, \
+
+#define SCANNERS_TCL \
+ { "Tcl", extract_tcl, &formatstring_tcl }, \
+
+/* Scan a Tcl file and add its translatable strings to mdlp. */
+extern void extract_tcl PARAMS ((FILE *fp, const char *real_filename,
+ const char *logical_filename,
+ msgdomain_list_ty *mdlp));
+
+
+/* Handling of options specific to this language. */
+
+extern void x_tcl_extract_all PARAMS ((void));
+extern void x_tcl_keyword PARAMS ((const char *name));
#include "x-java.h"
#include "x-awk.h"
#include "x-ycp.h"
+#include "x-tcl.h"
#include "x-rst.h"
#include "x-glade.h"
x_librep_extract_all ();
x_java_extract_all ();
x_awk_extract_all ();
+ x_tcl_extract_all ();
x_glade_extract_all ();
break;
case 'c':
x_librep_keyword (optarg);
x_java_keyword (optarg);
x_awk_keyword (optarg);
+ x_tcl_keyword (optarg);
x_glade_keyword (optarg);
}
break;
SCANNERS_JAVA
SCANNERS_AWK
SCANNERS_YCP
+ SCANNERS_TCL
SCANNERS_RST
SCANNERS_GLADE
/* Here will follow more languages and their scanners: perl, etc...
EXTENSIONS_JAVA
EXTENSIONS_AWK
EXTENSIONS_YCP
+ EXTENSIONS_TCL
EXTENSIONS_RST
EXTENSIONS_GLADE
- /* Here will follow more file extensions: sh, pl, tcl ... */
+ /* Here will follow more file extensions: sh, pl ... */
};
table_ty *tp;
+2002-03-03 Bruno Haible <bruno@clisp.org>
+
+ * format-tcl-1: New file.
+ * format-tcl-2: New file.
+ * lang-tcl: New file.
+ * Makefile.am (TESTS): Add them.
+
2002-03-03 Bruno Haible <bruno@clisp.org>
* lang-clisp: Create prog.ok only after testing presence of clisp.
xgettext-1 xgettext-2 xgettext-3 xgettext-4 xgettext-5 xgettext-6 \
xgettext-7 xgettext-8 xgettext-9 xgettext-10 xgettext-11 xgettext-12 \
xgettext-13 xgettext-14 xgettext-15 xgettext-16 xgettext-17 \
- xgettext-18 xgettext-19 xgettext-20 \
+ xgettext-18 xgettext-19 xgettext-20 xgettext-21 \
format-awk-1 format-awk-2 \
format-c-1 format-c-2 \
format-elisp-1 format-elisp-2 \
format-lisp-1 format-lisp-2 \
format-python-1 format-python-2 \
format-pascal-1 format-pascal-2 \
+ format-tcl-1 format-tcl-2 \
format-ycp-1 format-ycp-2 \
plural-1 plural-2 \
- lang-c lang-c++ lang-objc lang-python lang-clisp lang-elisp lang-librep lang-java lang-gawk lang-pascal lang-ycp lang-po lang-rst \
+ lang-c lang-c++ lang-objc lang-python lang-clisp lang-elisp lang-librep lang-java lang-gawk lang-pascal lang-ycp lang-tcl lang-po lang-rst \
rpath-1a rpath-1b \
rpath-2aaa rpath-2aab rpath-2aac rpath-2aad \
rpath-2aba rpath-2abb rpath-2abc rpath-2abd \
--- /dev/null
+#! /bin/sh
+
+# Test recognition of Tcl format strings.
+
+tmpfiles=""
+trap 'rm -fr $tmpfiles' 1 2 3 15
+
+tmpfiles="$tmpfiles f-t-1.data"
+cat <<\EOF > f-t-1.data
+# Valid: no argument
+"abc%%"
+# Valid: one character argument
+"abc%c"
+# Valid: one string argument
+"abc%s"
+# Valid: one integer argument
+"abc%i"
+# Valid: one integer argument
+"abc%d"
+# Valid: one integer argument
+"abc%o"
+# Valid: one integer argument
+"abc%u"
+# Valid: one integer argument
+"abc%x"
+# Valid: one integer argument
+"abc%X"
+# Valid: one floating-point argument
+"abc%e"
+# Valid: one floating-point argument
+"abc%E"
+# Valid: one floating-point argument
+"abc%f"
+# Valid: one floating-point argument
+"abc%g"
+# Valid: one floating-point argument
+"abc%G"
+# Valid: one argument with flags
+"abc%0#g"
+# Valid: one argument with width
+"abc%2g"
+# Valid: one argument with width
+"abc%*g"
+# Valid: one argument with precision
+"abc%.4g"
+# Valid: one argument with precision
+"abc%.*g"
+# Valid: one argument with width and precision
+"abc%14.4g"
+# Valid: one argument with width and precision
+"abc%14.*g"
+# Valid: one argument with width and precision
+"abc%*.4g"
+# Valid: one argument with width and precision
+"abc%*.*g"
+# Invalid: unterminated
+"abc%"
+# Invalid: unknown format specifier
+"abc%y"
+# Invalid: unknown format specifier
+"abc%F"
+# Invalid: flags after width
+"abc%*0g"
+# Invalid: twice precision
+"abc%.4.2g"
+# Valid: three arguments
+"abc%d%u%u"
+# Valid: a numbered argument
+"abc%1$d"
+# Invalid: zero
+"abc%0$d"
+# Valid: two-digit numbered arguments
+"abc%11$def%10$dgh%9$dij%8$dkl%7$dmn%6$dop%5$dqr%4$dst%3$duv%2$dwx%1$dyz"
+# Invalid: unterminated number
+"abc%1"
+# Invalid: flags before number
+"abc%+1$d"
+# Valid: three arguments, two with same number
+"abc%1$4x,%2$c,%1$u"
+# Invalid: argument with conflicting types
+"abc%1$4x,%2$c,%1$s"
+# Valid: no conflict
+"abc%1$4x,%2$c,%1$u"
+# Invalid: mixing of numbered and unnumbered arguments
+"abc%d%2$x"
+# Valid: numbered argument with constant precision
+"abc%1$.9x"
+# Valid: * does mix with numbered arguments
+"abc%1$.*x"
+# Valid: missing non-final argument
+"abc%2$x%3$s"
+# Valid: permutation
+"abc%2$ddef%1$d"
+# Valid: multiple uses of same argument
+"abc%2$xdef%1$sghi%2$x"
+# Valid: one argument with width
+"abc%2$#*g"
+# Valid: one argument with width and precision
+"abc%3$*.*g"
+# Invalid: zero
+"abc%0$*.*g"
+EOF
+
+: ${XGETTEXT=xgettext}
+n=0
+while read comment; do
+ read string
+ n=`expr $n + 1`
+ tmpfiles="$tmpfiles f-t-1-$n.in f-t-1-$n.po"
+ escape_dollars='s/\$/\\\$/g'
+ string=`echo "$string" | sed -e "$escape_dollars"`
+ cat <<EOF > f-t-1-$n.in
+[msgcat::mc ${string}];
+EOF
+ ${XGETTEXT} -L Tcl -o f-t-1-$n.po f-t-1-$n.in || exit 1
+ test -f f-t-1-$n.po || exit 1
+ fail=
+ if echo "$comment" | grep 'Valid:' > /dev/null; then
+ if grep tcl-format f-t-1-$n.po > /dev/null; then
+ :
+ else
+ fail=yes
+ fi
+ else
+ if grep tcl-format f-t-1-$n.po > /dev/null; then
+ fail=yes
+ else
+ :
+ fi
+ fi
+ if test -n "$fail"; then
+ echo "Format string recognition error:" 1>&2
+ cat f-t-1-$n.in 1>&2
+ echo "Got:" 1>&2
+ cat f-t-1-$n.po 1>&2
+ exit 1
+ fi
+done < f-t-1.data
+
+rm -fr $tmpfiles
+
+exit 0
--- /dev/null
+#! /bin/sh
+
+# Test checking of Tcl format strings.
+
+tmpfiles=""
+trap 'rm -fr $tmpfiles' 1 2 3 15
+
+tmpfiles="$tmpfiles f-t-2.data"
+cat <<\EOF > f-t-2.data
+# Valid: %% doesn't count
+msgid "abc%%def"
+msgstr "xyz"
+# Invalid: invalid msgstr
+msgid "abc%%def"
+msgstr "xyz%"
+# Valid: same arguments
+msgid "abc%s%gdef"
+msgstr "xyz%s%g"
+# Valid: same arguments, with different widths
+msgid "abc%2sdef"
+msgstr "xyz%3s"
+# Valid: same arguments but in numbered syntax
+msgid "abc%s%gdef"
+msgstr "xyz%1$s%2$g"
+# Valid: permutation
+msgid "abc%s%g%cdef"
+msgstr "xyz%3$c%2$g%1$s"
+# Invalid: too few arguments
+msgid "abc%2$udef%1$s"
+msgstr "xyz%1$s"
+# Invalid: too few arguments
+msgid "abc%sdef%u"
+msgstr "xyz%s"
+# Invalid: too many arguments
+msgid "abc%udef"
+msgstr "xyz%uvw%c"
+# Valid: same numbered arguments, with different widths
+msgid "abc%2$5s%1$4s"
+msgstr "xyz%2$4s%1$5s"
+# Invalid: missing argument
+msgid "abc%2$sdef%1$u"
+msgstr "xyz%1$u"
+# Invalid: missing argument
+msgid "abc%1$sdef%2$u"
+msgstr "xyz%2$u"
+# Invalid: added argument
+msgid "abc%1$udef"
+msgstr "xyz%1$uvw%2$c"
+# Valid: type compatibility
+msgid "abc%i"
+msgstr "xyz%d"
+# Valid: type compatibility
+msgid "abc%o"
+msgstr "xyz%u"
+# Valid: type compatibility
+msgid "abc%u"
+msgstr "xyz%x"
+# Valid: type compatibility
+msgid "abc%u"
+msgstr "xyz%X"
+# Valid: type compatibility
+msgid "abc%e"
+msgstr "xyz%E"
+# Valid: type compatibility
+msgid "abc%e"
+msgstr "xyz%f"
+# Valid: type compatibility
+msgid "abc%e"
+msgstr "xyz%g"
+# Valid: type compatibility
+msgid "abc%e"
+msgstr "xyz%G"
+# Invalid: type incompatibility
+msgid "abc%c"
+msgstr "xyz%s"
+# Invalid: type incompatibility
+msgid "abc%c"
+msgstr "xyz%i"
+# Invalid: type incompatibility
+msgid "abc%c"
+msgstr "xyz%o"
+# Invalid: type incompatibility
+msgid "abc%c"
+msgstr "xyz%e"
+# Invalid: type incompatibility
+msgid "abc%s"
+msgstr "xyz%i"
+# Invalid: type incompatibility
+msgid "abc%s"
+msgstr "xyz%o"
+# Invalid: type incompatibility
+msgid "abc%s"
+msgstr "xyz%e"
+# Invalid: type incompatibility
+msgid "abc%i"
+msgstr "xyz%o"
+# Invalid: type incompatibility
+msgid "abc%i"
+msgstr "xyz%e"
+# Invalid: type incompatibility
+msgid "abc%u"
+msgstr "xyz%e"
+# Invalid: type incompatibility for width
+msgid "abc%g%*g"
+msgstr "xyz%*g%g"
+EOF
+
+: ${MSGFMT=msgfmt}
+n=0
+while read comment; do
+ read msgid_line
+ read msgstr_line
+ n=`expr $n + 1`
+ tmpfiles="$tmpfiles f-t-2-$n.po f-t-2-$n.mo"
+ cat <<EOF > f-t-2-$n.po
+#, tcl-format
+${msgid_line}
+${msgstr_line}
+EOF
+ fail=
+ if echo "$comment" | grep 'Valid:' > /dev/null; then
+ if ${MSGFMT} --check-format -o f-t-2-$n.mo f-t-2-$n.po; then
+ :
+ else
+ fail=yes
+ fi
+ else
+ ${MSGFMT} --check-format -o f-t-2-$n.mo f-t-2-$n.po 2> /dev/null
+ if test $? = 1; then
+ :
+ else
+ fail=yes
+ fi
+ fi
+ if test -n "$fail"; then
+ echo "Format string checking error:" 1>&2
+ cat f-t-2-$n.po 1>&2
+ exit 1
+ fi
+done < f-t-2.data
+
+rm -fr $tmpfiles
+
+exit 0
--- /dev/null
+# Test of gettext facilities in the Tcl language.
+# Assumes an fr_FR locale is installed.
+# Assumes the following packages are installed: tcl.
+
+tmpfiles=""
+trap 'rm -fr $tmpfiles' 1 2 3 15
+
+tmpfiles="$tmpfiles program.tcl"
+cat <<\EOF > program.tcl
+#!/usr/bin/env tclsh
+package require msgcat
+::msgcat::mcload [file join [file dirname [info script]] msgs]
+proc _ {s} {return [::msgcat::mc $s]}
+puts [_ "'Your command, please?', asked the waiter."]
+puts [::msgcat::mc "%s is replaced by %s." "FF" "EUR"]
+EOF
+
+tmpfiles="$tmpfiles prog.pot"
+: ${XGETTEXT=xgettext}
+${XGETTEXT} -o prog.pot --omit-header -k_ program.tcl
+
+tmpfiles="$tmpfiles prog.ok"
+cat <<EOF > prog.ok
+#: program.tcl:5
+msgid "'Your command, please?', asked the waiter."
+msgstr ""
+
+#: program.tcl:6
+#, tcl-format
+msgid "%s is replaced by %s."
+msgstr ""
+EOF
+
+: ${DIFF=diff}
+${DIFF} prog.ok prog.pot || exit 1
+
+tmpfiles="$tmpfiles fr.po"
+cat <<\EOF > fr.po
+msgid ""
+msgstr "Content-Type: text/plain; charset=ISO-8859-1\n"
+
+#: program.tcl:5
+msgid "'Your command, please?', asked the waiter."
+msgstr "«Votre commande, s'il vous plait», dit le garçon."
+
+# Reverse the arguments.
+#: program.tcl:6
+#, tcl-format
+msgid "%s is replaced by %s."
+msgstr "%2$s remplace %1$s."
+EOF
+
+tmpfiles="$tmpfiles fr.po.new"
+: ${MSGMERGE=msgmerge}
+${MSGMERGE} -q -o fr.po.new fr.po prog.pot
+
+: ${DIFF=diff}
+${DIFF} fr.po fr.po.new || exit 1
+
+tmpfiles="$tmpfiles msgs"
+test -d msgs || mkdir msgs
+
+: ${MSGFMT=msgfmt}
+${MSGFMT} --tcl -d msgs -l fr fr.po || exit 1
+
+# Test for presence of tclsh.
+tmpfiles="$tmpfiles version.tcl"
+cat <<\EOF > version.tcl
+puts $tcl_version
+EOF
+(tclsh version.tcl) >/dev/null 2>/dev/null \
+ || { echo "SKIP: lang-tcl"; rm -fr $tmpfiles; exit 77; }
+
+tmpfiles="$tmpfiles prog.ok prog.out"
+: ${DIFF=diff}
+cat <<\EOF > prog.ok
+«Votre commande, s'il vous plait», dit le garçon.
+EUR remplace FF.
+EOF
+
+LANGUAGE= LANG=fr_FR LC_MESSAGES= LC_ALL= tclsh program.tcl > prog.out || exit 1
+${DIFF} prog.ok prog.out || exit 1
+
+rm -fr $tmpfiles
+
+exit 0
projects / thirdparty / gettext.git / commitdiff
