1/* xgettext Tcl backend.
2   Copyright (C) 2002-2003, 2005-2007 Free Software Foundation, Inc.
3
4   This file was written by Bruno Haible <haible@clisp.cons.org>, 2002.
5
6   This program is free software: you can redistribute it and/or modify
7   it under the terms of the GNU General Public License as published by
8   the Free Software Foundation; either version 3 of the License, or
9   (at your option) any later version.
10
11   This program is distributed in the hope that it will be useful,
12   but WITHOUT ANY WARRANTY; without even the implied warranty of
13   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14   GNU General Public License for more details.
15
16   You should have received a copy of the GNU General Public License
17   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
18
19#ifdef HAVE_CONFIG_H
20# include "config.h"
21#endif
22
23/* Specification.  */
24#include "x-tcl.h"
25
26#include <assert.h>
27#include <errno.h>
28#include <limits.h>
29#include <stdbool.h>
30#include <stdio.h>
31#include <stdlib.h>
32#include <string.h>
33
34#include "message.h"
35#include "xgettext.h"
36#include "x-tcl.h"
37#include "error.h"
38#include "xalloc.h"
39#include "hash.h"
40#include "c-ctype.h"
41#include "po-charset.h"
42#include "unistr.h"
43#include "gettext.h"
44
45#define _(s) gettext(s)
46
47#define SIZEOF(a) (sizeof(a) / sizeof(a[0]))
48
49
50/* The Tcl syntax is defined in the Tcl.n manual page.
51   Summary of Tcl syntax:
52   Like sh syntax, except that `...` is replaced with [...]. In detail:
53   - In a preprocessing pass, backslash-newline-anywhitespace is replaced
54     with single space.
55   - Input is broken into words, which are then subject to command
56     substitution [...] , variable substitution $var, backslash substitution
57     \escape.
58   - Strings are enclosed in "..."; command substitution, variable
59     substitution and backslash substitutions are performed here as well.
60   - {...} is a string without substitutions.
61   - The list of resulting words is split into commands by semicolon and
62     newline.
63   - '#' at the beginning of a command introduces a comment until end of line.
64   The parser is implemented in tcl8.3.3/generic/tclParse.c.  */
65
66
67/* ====================== Keyword set customization.  ====================== */
68
69/* If true extract all strings.  */
70static bool extract_all = false;
71
72static hash_table keywords;
73static bool default_keywords = true;
74
75
76void
77x_tcl_extract_all ()
78{
79  extract_all = true;
80}
81
82
83void
84x_tcl_keyword (const char *name)
85{
86  if (name == NULL)
87    default_keywords = false;
88  else
89    {
90      const char *end;
91      struct callshape shape;
92
93      if (keywords.table == NULL)
94	hash_init (&keywords, 100);
95
96      split_keywordspec (name, &end, &shape);
97
98      /* The characters between name and end should form a valid Tcl
99	 function name.  A leading "::" is redundant.  */
100      if (end - name >= 2 && name[0] == ':' && name[1] == ':')
101	name += 2;
102
103      insert_keyword_callshape (&keywords, name, end - name, &shape);
104    }
105}
106
107/* Finish initializing the keywords hash table.
108   Called after argument processing, before each file is processed.  */
109static void
110init_keywords ()
111{
112  if (default_keywords)
113    {
114      /* When adding new keywords here, also update the documentation in
115	 xgettext.texi!  */
116      x_tcl_keyword ("::msgcat::mc");
117      default_keywords = false;
118    }
119}
120
121void
122init_flag_table_tcl ()
123{
124  xgettext_record_flag ("::msgcat::mc:1:pass-tcl-format");
125  xgettext_record_flag ("format:1:tcl-format");
126}
127
128
129/* ======================== Reading of characters.  ======================== */
130
131/* Real filename, used in error messages about the input file.  */
132static const char *real_file_name;
133
134/* Logical filename and line number, used to label the extracted messages.  */
135static char *logical_file_name;
136static int line_number;
137
138/* The input file stream.  */
139static FILE *fp;
140
141
142/* Fetch the next character from the input file.  */
143static int
144do_getc ()
145{
146  int c = getc (fp);
147
148  if (c == EOF)
149    {
150      if (ferror (fp))
151	error (EXIT_FAILURE, errno, _("\
152error while reading \"%s\""), real_file_name);
153    }
154  else if (c == '\n')
155   line_number++;
156
157  return c;
158}
159
160/* Put back the last fetched character, not EOF.  */
161static void
162do_ungetc (int c)
163{
164  if (c == '\n')
165    line_number--;
166  ungetc (c, fp);
167}
168
169
170/* Combine backslash followed by newline and additional whitespace to
171   a single space.  */
172
173/* An int that becomes a space when casted to 'unsigned char'.  */
174#define BS_NL (UCHAR_MAX + 1 + ' ')
175
176static int phase1_pushback[1];
177static int phase1_pushback_length;
178
179static int
180phase1_getc ()
181{
182  int c;
183
184  if (phase1_pushback_length)
185    {
186      c = phase1_pushback[--phase1_pushback_length];
187      if (c == '\n' || c == BS_NL)
188	++line_number;
189      return c;
190    }
191  c = do_getc ();
192  if (c != '\\')
193    return c;
194  c = do_getc ();
195  if (c != '\n')
196    {
197      if (c != EOF)
198	do_ungetc (c);
199      return '\\';
200    }
201  for (;;)
202    {
203      c = do_getc ();
204      if (!(c == ' ' || c == '\t'))
205	break;
206    }
207  if (c != EOF)
208    do_ungetc (c);
209  return BS_NL;
210}
211
212/* Supports only one pushback character.  */
213static void
214phase1_ungetc (int c)
215{
216  switch (c)
217    {
218    case EOF:
219      break;
220
221    case '\n':
222    case BS_NL:
223      --line_number;
224      /* FALLTHROUGH */
225
226    default:
227      if (phase1_pushback_length == SIZEOF (phase1_pushback))
228	abort ();
229      phase1_pushback[phase1_pushback_length++] = c;
230      break;
231    }
232}
233
234
235/* Keep track of brace nesting depth.
236   When a word starts with an opening brace, a character group begins that
237   ends with the corresponding closing brace.  In theory these character
238   groups are string literals, but they are used by so many Tcl primitives
239   (proc, if, ...) as representing command lists, that we treat them as
240   command lists.  */
241
242/* An int that becomes a closing brace when casted to 'unsigned char'.  */
243#define CL_BRACE (UCHAR_MAX + 1 + '}')
244
245static int phase2_pushback[2];
246static int phase2_pushback_length;
247
248/* Brace nesting depth inside the current character group.  */
249static int brace_depth;
250
251static int
252phase2_push ()
253{
254  int previous_depth = brace_depth;
255  brace_depth = 1;
256  return previous_depth;
257}
258
259static void
260phase2_pop (int previous_depth)
261{
262  brace_depth = previous_depth;
263}
264
265static int
266phase2_getc ()
267{
268  int c;
269
270  if (phase2_pushback_length)
271    {
272      c = phase2_pushback[--phase2_pushback_length];
273      if (c == '\n' || c == BS_NL)
274	++line_number;
275      else if (c == '{')
276	++brace_depth;
277      else if (c == '}')
278	--brace_depth;
279      return c;
280    }
281  c = phase1_getc ();
282  if (c == '{')
283    ++brace_depth;
284  else if (c == '}')
285    {
286      if (--brace_depth == 0)
287	c = CL_BRACE;
288    }
289  return c;
290}
291
292/* Supports 2 characters of pushback.  */
293static void
294phase2_ungetc (int c)
295{
296  if (c != EOF)
297    {
298      switch (c)
299	{
300	case '\n':
301	case BS_NL:
302	  --line_number;
303	  break;
304
305	case '{':
306	  --brace_depth;
307	  break;
308
309	case '}':
310	  ++brace_depth;
311	  break;
312	}
313      if (phase2_pushback_length == SIZEOF (phase2_pushback))
314	abort ();
315      phase2_pushback[phase2_pushback_length++] = c;
316    }
317}
318
319
320/* ========================== Reading of tokens.  ========================== */
321
322
323/* A token consists of a sequence of characters.  */
324struct token
325{
326  int allocated;		/* number of allocated 'token_char's */
327  int charcount;		/* number of used 'token_char's */
328  char *chars;			/* the token's constituents */
329};
330
331/* Initialize a 'struct token'.  */
332static inline void
333init_token (struct token *tp)
334{
335  tp->allocated = 10;
336  tp->chars = XNMALLOC (tp->allocated, char);
337  tp->charcount = 0;
338}
339
340/* Free the memory pointed to by a 'struct token'.  */
341static inline void
342free_token (struct token *tp)
343{
344  free (tp->chars);
345}
346
347/* Ensure there is enough room in the token for one more character.  */
348static inline void
349grow_token (struct token *tp)
350{
351  if (tp->charcount == tp->allocated)
352    {
353      tp->allocated *= 2;
354      tp->chars = (char *) xrealloc (tp->chars, tp->allocated * sizeof (char));
355    }
356}
357
358
359/* ========================= Accumulating comments ========================= */
360
361
362static char *buffer;
363static size_t bufmax;
364static size_t buflen;
365
366static inline void
367comment_start ()
368{
369  buflen = 0;
370}
371
372static inline void
373comment_add (int c)
374{
375  if (buflen >= bufmax)
376    {
377      bufmax = 2 * bufmax + 10;
378      buffer = xrealloc (buffer, bufmax);
379    }
380  buffer[buflen++] = c;
381}
382
383static inline void
384comment_line_end ()
385{
386  while (buflen >= 1
387	 && (buffer[buflen - 1] == ' ' || buffer[buflen - 1] == '\t'))
388    --buflen;
389  if (buflen >= bufmax)
390    {
391      bufmax = 2 * bufmax + 10;
392      buffer = xrealloc (buffer, bufmax);
393    }
394  buffer[buflen] = '\0';
395  savable_comment_add (buffer);
396}
397
398
399/* These are for tracking whether comments count as immediately before
400   keyword.  */
401static int last_comment_line;
402static int last_non_comment_line;
403
404
405/* ========================= Accumulating messages ========================= */
406
407
408static message_list_ty *mlp;
409
410
411/* ========================== Reading of commands ========================== */
412
413
414/* We are only interested in constant strings (e.g. "msgcat::mc" or other
415   string literals).  Other words need not to be represented precisely.  */
416enum word_type
417{
418  t_string,	/* constant string */
419  t_other,	/* other string */
420  t_separator,	/* command separator: semicolon or newline */
421  t_bracket,	/* ']' pseudo word */
422  t_brace,	/* '}' pseudo word */
423  t_eof		/* EOF marker */
424};
425
426struct word
427{
428  enum word_type type;
429  struct token *token;		/* for t_string */
430  int line_number_at_start;	/* for t_string */
431};
432
433/* Free the memory pointed to by a 'struct word'.  */
434static inline void
435free_word (struct word *wp)
436{
437  if (wp->type == t_string)
438    {
439      free_token (wp->token);
440      free (wp->token);
441    }
442}
443
444/* Convert a t_string token to a char*.  */
445static char *
446string_of_word (const struct word *wp)
447{
448  char *str;
449  int n;
450
451  if (!(wp->type == t_string))
452    abort ();
453  n = wp->token->charcount;
454  str = XNMALLOC (n + 1, char);
455  memcpy (str, wp->token->chars, n);
456  str[n] = '\0';
457  return str;
458}
459
460
461/* Context lookup table.  */
462static flag_context_list_table_ty *flag_context_list_table;
463
464
465/* Read an escape sequence.  The value is an ISO-8859-1 character (in the
466   range 0x00..0xff) or a Unicode character (in the range 0x0000..0xffff).  */
467static int
468do_getc_escaped ()
469{
470  int c;
471
472  c = phase1_getc ();
473  switch (c)
474    {
475    case EOF:
476      return '\\';
477    case 'a':
478      return '\a';
479    case 'b':
480      return '\b';
481    case 'f':
482      return '\f';
483    case 'n':
484      return '\n';
485    case 'r':
486      return '\r';
487    case 't':
488      return '\t';
489    case 'v':
490      return '\v';
491    case 'x':
492      {
493	int n = 0;
494	unsigned int i;
495
496	for (i = 0;; i++)
497	  {
498	    c = phase1_getc ();
499	    if (c == EOF || !c_isxdigit ((unsigned char) c))
500	      break;
501
502	    if (c >= '0' && c <= '9')
503	      n = (n << 4) + (c - '0');
504	    else if (c >= 'A' && c <= 'F')
505	      n = (n << 4) + (c - 'A' + 10);
506	    else if (c >= 'a' && c <= 'f')
507	      n = (n << 4) + (c - 'a' + 10);
508	  }
509	phase1_ungetc (c);
510	return (i > 0 ? (unsigned char) n : 'x');
511      }
512    case 'u':
513      {
514	int n = 0;
515	unsigned int i;
516
517	for (i = 0; i < 4; i++)
518	  {
519	    c = phase1_getc ();
520	    if (c == EOF || !c_isxdigit ((unsigned char) c))
521	      break;
522
523	    if (c >= '0' && c <= '9')
524	      n = (n << 4) + (c - '0');
525	    else if (c >= 'A' && c <= 'F')
526	      n = (n << 4) + (c - 'A' + 10);
527	    else if (c >= 'a' && c <= 'f')
528	      n = (n << 4) + (c - 'a' + 10);
529	  }
530	phase1_ungetc (c);
531	return (i > 0 ? n : 'u');
532      }
533    case '0': case '1': case '2': case '3': case '4':
534    case '5': case '6': case '7':
535      {
536	int n = c - '0';
537
538	c = phase1_getc ();
539	if (c != EOF)
540	  {
541	    if (c >= '0' && c <= '7')
542	      {
543		n = (n << 3) + (c - '0');
544		c = phase1_getc ();
545		if (c != EOF)
546		  {
547		    if (c >= '0' && c <= '7')
548		      n = (n << 3) + (c - '0');
549		    else
550		      phase1_ungetc (c);
551		  }
552	      }
553	    else
554	      phase1_ungetc (c);
555	  }
556	return (unsigned char) n;
557      }
558    default:
559      /* Note: If c is non-ASCII, Tcl's behaviour is undefined here.  */
560      return (unsigned char) c;
561    }
562}
563
564
565enum terminator
566{
567  te_space_separator,		/* looking for space semicolon newline */
568  te_space_separator_bracket,	/* looking for space semicolon newline ']' */
569  te_paren,			/* looking for ')' */
570  te_quote			/* looking for '"' */
571};
572
573/* Forward declaration of local functions.  */
574static enum word_type read_command_list (int looking_for,
575					 flag_context_ty outer_context);
576
577/* Accumulate tokens into the given word.
578   'looking_for' denotes a parse terminator combination.
579   Return the first character past the token.  */
580static int
581accumulate_word (struct word *wp, enum terminator looking_for,
582		 flag_context_ty context)
583{
584  int c;
585
586  for (;;)
587    {
588      c = phase2_getc ();
589
590      if (c == EOF || c == CL_BRACE)
591	return c;
592      if ((looking_for == te_space_separator
593	   || looking_for == te_space_separator_bracket)
594	  && (c == ' ' || c == BS_NL
595	      || c == '\t' || c == '\v' || c == '\f' || c == '\r'
596	      || c == ';' || c == '\n'))
597	return c;
598      if (looking_for == te_space_separator_bracket && c == ']')
599	return c;
600      if (looking_for == te_paren && c == ')')
601	return c;
602      if (looking_for == te_quote && c == '"')
603	return c;
604
605      if (c == '$')
606	{
607	  /* Distinguish $varname, ${varname} and lone $.  */
608	  c = phase2_getc ();
609	  if (c == '{')
610	    {
611	      /* ${varname} */
612	      do
613		c = phase2_getc ();
614	      while (c != EOF && c != '}');
615	      wp->type = t_other;
616	    }
617	  else
618	    {
619	      bool nonempty = false;
620
621	      for (; c != EOF && c != CL_BRACE; c = phase2_getc ())
622		{
623		  if (c_isalnum ((unsigned char) c) || (c == '_'))
624		    {
625		      nonempty = true;
626		      continue;
627		    }
628		  if (c == ':')
629		    {
630		      c = phase2_getc ();
631		      if (c == ':')
632			{
633			  do
634			    c = phase2_getc ();
635			  while (c == ':');
636
637			  phase2_ungetc (c);
638			  nonempty = true;
639			  continue;
640			}
641		      phase2_ungetc (c);
642		      c = ':';
643		    }
644		  break;
645		}
646	      if (c == '(')
647		{
648		  /* $varname(index) */
649		  struct word index_word;
650
651		  index_word.type = t_other;
652		  c = accumulate_word (&index_word, te_paren, null_context);
653		  if (c != EOF && c != ')')
654		    phase2_ungetc (c);
655		  wp->type = t_other;
656		}
657	      else
658		{
659		  phase2_ungetc (c);
660		  if (nonempty)
661		    {
662		      /* $varname */
663		      wp->type = t_other;
664		    }
665		  else
666		    {
667		      /* lone $ */
668		      if (wp->type == t_string)
669			{
670			  grow_token (wp->token);
671			  wp->token->chars[wp->token->charcount++] = '$';
672			}
673		    }
674		}
675	    }
676	}
677      else if (c == '[')
678	{
679	  read_command_list (']', context);
680	  wp->type = t_other;
681	}
682      else if (c == '\\')
683	{
684	  unsigned int uc;
685	  unsigned char utf8buf[6];
686	  int count;
687	  int i;
688
689	  uc = do_getc_escaped ();
690	  assert (uc < 0x10000);
691	  count = u8_uctomb (utf8buf, uc, 6);
692	  assert (count > 0);
693	  if (wp->type == t_string)
694	    for (i = 0; i < count; i++)
695	      {
696		grow_token (wp->token);
697		wp->token->chars[wp->token->charcount++] = utf8buf[i];
698	      }
699	}
700      else
701	{
702	  if (wp->type == t_string)
703	    {
704	      grow_token (wp->token);
705	      wp->token->chars[wp->token->charcount++] = (unsigned char) c;
706	    }
707	}
708    }
709}
710
711
712/* Read the next word.
713   'looking_for' denotes a parse terminator, either ']' or '\0'.  */
714static void
715read_word (struct word *wp, int looking_for, flag_context_ty context)
716{
717  int c;
718
719  do
720    c = phase2_getc ();
721  while (c == ' ' || c == BS_NL
722	 || c == '\t' || c == '\v' || c == '\f' || c == '\r');
723
724  if (c == EOF)
725    {
726      wp->type = t_eof;
727      return;
728    }
729
730  if (c == CL_BRACE)
731    {
732      wp->type = t_brace;
733      last_non_comment_line = line_number;
734      return;
735    }
736
737  if (c == '\n')
738    {
739      /* Comments assumed to be grouped with a message must immediately
740	 precede it, with no non-whitespace token on a line between both.  */
741      if (last_non_comment_line > last_comment_line)
742	savable_comment_reset ();
743      wp->type = t_separator;
744      return;
745    }
746
747  if (c == ';')
748    {
749      wp->type = t_separator;
750      last_non_comment_line = line_number;
751      return;
752    }
753
754  if (looking_for == ']' && c == ']')
755    {
756      wp->type = t_bracket;
757      last_non_comment_line = line_number;
758      return;
759    }
760
761  if (c == '{')
762    {
763      int previous_depth;
764      enum word_type terminator;
765
766      /* Start a new nested character group, which lasts until the next
767	 balanced '}' (ignoring \} things).  */
768      previous_depth = phase2_push () - 1;
769
770      /* Interpret it as a command list.  */
771      terminator = read_command_list ('\0', null_context);
772
773      if (terminator == t_brace)
774	phase2_pop (previous_depth);
775
776      wp->type = t_other;
777      last_non_comment_line = line_number;
778      return;
779    }
780
781  wp->type = t_string;
782  wp->token = XMALLOC (struct token);
783  init_token (wp->token);
784  wp->line_number_at_start = line_number;
785
786  if (c == '"')
787    {
788      c = accumulate_word (wp, te_quote, context);
789      if (c != EOF && c != '"')
790	phase2_ungetc (c);
791    }
792  else
793    {
794      phase2_ungetc (c);
795      c = accumulate_word (wp,
796			   looking_for == ']'
797			   ? te_space_separator_bracket
798			   : te_space_separator,
799			   context);
800      if (c != EOF)
801	phase2_ungetc (c);
802    }
803
804  if (wp->type != t_string)
805    {
806      free_token (wp->token);
807      free (wp->token);
808    }
809  last_non_comment_line = line_number;
810}
811
812
813/* Read the next command.
814   'looking_for' denotes a parse terminator, either ']' or '\0'.
815   Returns the type of the word that terminated the command: t_separator or
816   t_bracket (only if looking_for is ']') or t_brace or t_eof.  */
817static enum word_type
818read_command (int looking_for, flag_context_ty outer_context)
819{
820  int c;
821
822  /* Skip whitespace and comments.  */
823  for (;;)
824    {
825      c = phase2_getc ();
826
827      if (c == ' ' || c == BS_NL
828	  || c == '\t' || c == '\v' || c == '\f' || c == '\r')
829	continue;
830      if (c == '#')
831	{
832	  /* Skip a comment up to end of line.  */
833	  last_comment_line = line_number;
834	  comment_start ();
835	  for (;;)
836	    {
837	      c = phase2_getc ();
838	      if (c == EOF || c == CL_BRACE || c == '\n')
839		break;
840	      /* We skip all leading white space, but not EOLs.  */
841	      if (!(buflen == 0 && (c == ' ' || c == '\t')))
842		comment_add (c);
843	    }
844	  comment_line_end ();
845	  continue;
846	}
847      break;
848    }
849  phase2_ungetc (c);
850
851  /* Read the words that make up the command.  */
852  {
853    int arg = 0;		/* Current argument number.  */
854    flag_context_list_iterator_ty context_iter;
855    const struct callshapes *shapes = NULL;
856    struct arglist_parser *argparser = NULL;
857
858    for (;; arg++)
859      {
860	struct word inner;
861	flag_context_ty inner_context;
862
863	if (arg == 0)
864	  inner_context = null_context;
865	else
866	  inner_context =
867	    inherited_context (outer_context,
868			       flag_context_list_iterator_advance (
869				 &context_iter));
870
871	read_word (&inner, looking_for, inner_context);
872
873	/* Recognize end of command.  */
874	if (inner.type == t_separator || inner.type == t_bracket
875	    || inner.type == t_brace || inner.type == t_eof)
876	  {
877	    if (argparser != NULL)
878	      arglist_parser_done (argparser, arg);
879	    return inner.type;
880	  }
881
882	if (extract_all)
883	  {
884	    if (inner.type == t_string)
885	      {
886		lex_pos_ty pos;
887
888		pos.file_name = logical_file_name;
889		pos.line_number = inner.line_number_at_start;
890		remember_a_message (mlp, NULL, string_of_word (&inner),
891				    inner_context, &pos, savable_comment);
892	      }
893	  }
894
895	if (arg == 0)
896	  {
897	    /* This is the function position.  */
898	    if (inner.type == t_string)
899	      {
900		char *function_name = string_of_word (&inner);
901		char *stripped_name;
902		void *keyword_value;
903
904		/* A leading "::" is redundant.  */
905		stripped_name = function_name;
906		if (function_name[0] == ':' && function_name[1] == ':')
907		  stripped_name += 2;
908
909		if (hash_find_entry (&keywords,
910				     stripped_name, strlen (stripped_name),
911				     &keyword_value)
912		    == 0)
913		  shapes = (const struct callshapes *) keyword_value;
914
915		argparser = arglist_parser_alloc (mlp, shapes);
916
917		context_iter =
918		  flag_context_list_iterator (
919		    flag_context_list_table_lookup (
920		      flag_context_list_table,
921		      stripped_name, strlen (stripped_name)));
922
923		free (function_name);
924	      }
925	    else
926	      context_iter = null_context_list_iterator;
927	  }
928	else
929	  {
930	    /* These are the argument positions.  */
931	    if (argparser != NULL && inner.type == t_string)
932	      arglist_parser_remember (argparser, arg,
933				       string_of_word (&inner),
934				       inner_context,
935				       logical_file_name,
936				       inner.line_number_at_start,
937				       savable_comment);
938	  }
939
940	free_word (&inner);
941      }
942  }
943}
944
945
946/* Read a list of commands.
947   'looking_for' denotes a parse terminator, either ']' or '\0'.
948   Returns the type of the word that terminated the command list:
949   t_bracket (only if looking_for is ']') or t_brace or t_eof.  */
950static enum word_type
951read_command_list (int looking_for, flag_context_ty outer_context)
952{
953  for (;;)
954    {
955      enum word_type terminator;
956
957      terminator = read_command (looking_for, outer_context);
958      if (terminator != t_separator)
959	return terminator;
960    }
961}
962
963
964void
965extract_tcl (FILE *f,
966	     const char *real_filename, const char *logical_filename,
967	     flag_context_list_table_ty *flag_table,
968	     msgdomain_list_ty *mdlp)
969{
970  mlp = mdlp->item[0]->messages;
971
972  /* We convert our strings to UTF-8 encoding.  */
973  xgettext_current_source_encoding = po_charset_utf8;
974
975  fp = f;
976  real_file_name = real_filename;
977  logical_file_name = xstrdup (logical_filename);
978  line_number = 1;
979
980  /* Initially, no brace is open.  */
981  brace_depth = 1000000;
982
983  last_comment_line = -1;
984  last_non_comment_line = -1;
985
986  flag_context_list_table = flag_table;
987
988  init_keywords ();
989
990  /* Eat tokens until eof is seen.  */
991  read_command_list ('\0', null_context);
992
993  fp = NULL;
994  real_file_name = NULL;
995  logical_file_name = NULL;
996  line_number = 0;
997}
998