Initial git import
[sxemacs] / lib-src / make-msgfile.lex
1 %{
2
3 /* This is a Lex file. */
4
5 /* Localizable-message snarfing.
6    Copyright (C) 1994, 1995 Amdahl Corporation.
7
8 This file is part of SXEmacs.
9
10 SXEmacs is free software: you can redistribute it and/or modify
11 it under the terms of the GNU General Public License as published by
12 the Free Software Foundation, either version 3 of the License, or
13 (at your option) any later version.
14
15 SXEmacs is distributed in the hope that it will be useful,
16 but WITHOUT ANY WARRANTY; without even the implied warranty of
17 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18 GNU General Public License for more details.
19
20 You should have received a copy of the GNU General Public License
21 along with this program.  If not, see <http://www.gnu.org/licenses/>. */
22
23 /* Written by Ben Wing, November 1994.  Some code based on earlier
24    make-msgfile.c. */
25
26 /* Note: there is still much work to be done on this.
27
28    1) Definition of Arg below won't handle a generalized argument
29       as might appear in a function call.  This is fine for DEFUN
30       and friends, because only simple arguments appear there; but
31       it might run into problems if Arg is used for other sorts
32       of functions.
33    2) snarf() should be modified so that it doesn't output null
34       strings and non-textual strings (see the comment at the top
35       of make-msgfile.c).
36    3) parsing of (insert) should snarf all of the arguments.
37    4) need to add set-keymap-prompt and deal with gettext of that.
38    5) parsing of arguments should snarf all strings anywhere within
39       the arguments, rather than just looking for a string as the
40       argument.  This allows if statements as arguments to get parsed.
41    6) begin_paren_counting() et al. should handle recursive entry.
42    7) handle set-window-buffer and other such functions that take
43       a buffer as the other-than-first argument.
44    8) there is a fair amount of work to be done on the C code.
45       Look through the code for #### comments associated with
46       '#ifdef I18N3' or with an I18N3 nearby.
47    9) Deal with `get-buffer-process' et al.
48    10) Many of the changes in the Lisp code marked
49        'rewritten for I18N3 snarfing' should be undone once (5) is
50        implemented.
51    11) Go through the Lisp code in prim and make sure that all
52        strings are gettexted as necessary.  This may reveal more
53        things to implement.
54    12) Do the equivalent of (8) for the Lisp code.
55    13) Deal with parsing of menu specifications.
56
57         --ben
58    
59 */
60
61 /* Long comment from jwz:
62
63    (much of this comment is outdated, and a lot of it is actually
64    implemented)
65    
66    
67    PROPOSAL FOR HOW THIS ALL OUGHT TO WORK
68    this isn't implemented yet, but this is the plan-in-progress
69
70    
71    In general, it's accepted that the best way to internationalize is for all
72    messages to be referred to by a symbolic name (or number) and come out of a
73    table or tables, which are easy to change.
74
75    However, with Emacs, we've got the task of internationalizing a huge body
76    of existing code, which already contains messages internally.
77
78    For the C code we've got two options:
79
80     - Use a Sun-like gettext() form, which takes an "english" string which
81       appears literally in the source, and uses that as a hash key to find
82       a translated string;
83     - Rip all of the strings out and put them in a table.
84
85    In this case, it's desirable to make as few changes as possible to the C
86    code, to make it easier to merge the code with the FSF version of emacs
87    which won't ever have these changes made to it.  So we should go with the
88    former option.
89
90    The way it has been done (between 19.8 and 19.9) was to use gettext(), but
91    *also* to make massive changes to the source code.  The goal now is to use
92    gettext() at run-time and yet not require a textual change to every line
93    in the C code which contains a string constant.  A possible way to do this
94    is described below.
95
96    (gettext() can be implemented in terms of catgets() for non-Sun systems, so
97    that in itself isn't a problem.)
98
99    For the Lisp code, we've got basically the same options: put everything in
100    a table, or translate things implicitly.
101
102    Another kink that lisp code introduces is that there are thousands of third-
103    party packages, so changing the source for all of those is simply not an
104    option.
105
106    Is it a goal that if some third party package displays a message which is
107    one we know how to translate, then we translate it?  I think this is a
108    worthy goal.  It remains to be seen how well it will work in practice.
109
110    So, we should endeavor to minimize the impact on the lisp code.  Certain
111    primitive lisp routines (the stuff in lisp/prim/, and especially in
112    cmdloop.el and minibuf.el) may need to be changed to know about translation,
113    but that's an ideologically clean thing to do because those are considered
114    a part of the emacs substrate.
115
116    However, if we find ourselves wanting to make changes to, say, RMAIL, then
117    something has gone wrong.  (Except to do things like remove assumptions
118    about the order of words within a sentence, or how pluralization works.)
119
120    There are two parts to the task of displaying translated strings to the 
121    user: the first is to extract the strings which need to be translated from
122    the sources; and the second is to make some call which will translate those
123    strings before they are presented to the user.
124    
125    The old way was to use the same form to do both, that is, GETTEXT() was both
126    the tag that we searched for to build a catalog, and was the form which did
127    the translation.  The new plan is to separate these two things more: the
128    tags that we search for to build the catalog will be stuff that was in there
129    already, and the translation will get done in some more centralized, lower
130    level place.
131
132    This program (make-msgfile.c) addresses the first part, extracting the 
133    strings.
134    
135    For the emacs C code, we need to recognize the following patterns:
136    
137      message ("string" ... )
138      error ("string")
139      report_file_error ("string" ... )
140      signal_simple_error ("string" ... )
141      signal_simple_error_2 ("string" ... )
142      
143      build_translated_string ("string")
144      #### add this and use it instead of build_string() in some places.
145      
146      yes_or_no_p ("string" ... )
147      #### add this instead of funcalling Qyes_or_no_p directly.
148
149      barf_or_query_if_file_exists       #### restructure this
150      check all callers of Fsignal       #### restructure these
151      signal_error (Qerror ... )         #### change all of these to error()
152      
153      And we also parse out the `interactive' prompts from DEFUN() forms.
154      
155      #### When we've got a string which is a candidate for translation, we
156      should ignore it if it contains only format directives, that is, if
157      there are no alphabetic characters in it that are not a part of a `%'
158      directive.  (Careful not to translate either "%s%s" or "%s: ".)
159
160    For the emacs Lisp code, we need to recognize the following patterns:
161    
162      (message "string" ... )
163      (error "string" ... )
164      (format "string" ... )
165      (read-from-minibuffer "string" ... )
166      (read-shell-command "string" ... )
167      (y-or-n-p "string" ... )
168      (yes-or-no-p "string" ... )
169      (read-file-name "string" ... )
170      (temp-minibuffer-message "string")
171      (query-replace-read-args "string" ... )
172      
173    I expect there will be a lot like the above; basically, any function which
174    is a commonly used wrapper around an eventual call to `message' or
175    `read-from-minibuffer' needs to be recognized by this program.
176
177
178      (dgettext "domain-name" "string")          #### do we still need this?
179      
180      things that should probably be restructured:
181        `princ' in cmdloop.el
182        `insert' in debug.el
183        face-interactive
184        help.el, syntax.el all messed up
185      
186    BPW: (format) is a tricky case.  If I use format to create a string
187    that I then send to a file, I probably don't want the string translated.
188    On the other hand, If the string gets used as an argument to (y-or-n-p)
189    or some such function, I do want it translated, and it needs to be
190    translated before the %s and such are replaced.  The proper solution
191    here is for (format) and other functions that call gettext but don't
192    immediately output the string to the user to add the translated (and
193    formatted) string as a string property of the object, and have
194    functions that output potentially translated strings look for a
195    "translated string" property.  Of course, this will fail if someone
196    does something like
197
198       (y-or-n-p (concat (if you-p "Do you " "Does he ")
199                         (format "want to delete %s? " filename))))
200
201    But you shouldn't be doing things like this anyway.
202
203    BPW: Also, to avoid excessive translating, strings should be marked
204    as translated once they get translated, and further calls to gettext
205    don't do any more translating.  Otherwise, a call like
206
207       (y-or-n-p (format "Delete %s? " filename))
208
209    would cause translation on both the pre-formatted and post-formatted
210    strings, which could lead to weird results in some cases (y-or-n-p
211    has to translate its argument because someone could pass a string to
212    it directly).  Note that the "translating too much" solution outlined
213    below could be implemented by just marking all strings that don't
214    come from a .el or .elc file as already translated.
215
216    Menu descriptors: one way to extract the strings in menu labels would be
217    to teach this program about "^(defvar .*menu\n" forms; that's probably
218    kind of hard, though, so perhaps a better approach would be to make this
219    program recognize lines of the form
220
221      "string" ... ;###translate
222
223    where the magic token ";###translate" on a line means that the string 
224    constant on this line should go into the message catalog.  This is analogous
225    to the magic ";###autoload" comments, and to the magic comments used in the
226    EPSF structuring conventions.
227
228   -----
229   So this program manages to build up a catalog of strings to be translated.
230   To address the second part of the problem, of actually looking up the
231   translations, there are hooks in a small number of low level places in
232   emacs.
233
234   Assume the existence of a C function gettext(str) which returns the 
235   translation of `str' if there is one, otherwise returns `str'.
236
237   - message() takes a char* as its argument, and always filters it through
238     gettext() before displaying it.
239
240   - errors are printed by running the lisp function `display-error' which
241     doesn't call `message' directly (it princ's to streams), so it must be
242     carefully coded to translate its arguments.  This is only a few lines
243     of code.
244
245   - Fread_minibuffer_internal() is the lowest level interface to all minibuf
246     interactions, so it is responsible for translating the value that will go
247     into Vminibuf_prompt.
248
249   - Fpopup_menu filters the menu titles through gettext().
250
251     The above take care of 99% of all messages the user ever sees.
252
253   - The lisp function temp-minibuffer-message translates its arg.
254
255   - query-replace-read-args is funny; it does
256       (setq from (read-from-minibuffer (format "%s: " string) ... ))
257       (setq to (read-from-minibuffer (format "%s %s with: " string from) ... ))
258
259     What should we do about this?  We could hack query-replace-read-args to
260     translate its args, but might this be a more general problem?  I don't
261     think we ought to translate all calls to format.  We could just change
262     the calling sequence, since this is odd in that the first %s wants to be
263     translated but the second doesn't.
264
265
266   Solving the "translating too much" problem:
267   The concern has been raised that in this situation:
268    - "Help" is a string for which we know a translation;
269    - someone visits a file called Help, and someone does something 
270      contrived like (error buffer-file-name)
271   then we would display the translation of Help, which would not be correct.
272   We can solve this by adding a bit to Lisp_String objects which identifies
273   them as having been read as literal constants from a .el or .elc file (as
274   opposed to having been constructed at run time as it would in the above 
275   case.)  To solve this:
276
277     - Fmessage() takes a lisp string as its first argument.
278       If that string is a constant, that is, was read from a source file
279       as a literal, then it calls message() with it, which translates.
280       Otherwise, it calls message_no_translate(), which does not translate.
281
282     - Ferror() (actually, Fsignal() when condition is Qerror) works similarly.
283 */
284
285 /* Some notes:
286
287 -- {Arg} below could get confused by commas inside of quotes.
288 -- {LispToken} below can match some things that are not tokens (e.g.
289    numbers) but for all practical purposes it should be fine.
290 */
291
292 #include <stdio.h>
293
294 int snarf_return_state;
295
296 %}
297
298 %p 6000
299 %e 2000
300 %n 1000
301 %a 4000
302 %s C_QUOTE C_COMMENT LQUO LCOM
303 %s CSNARF LSNARF
304 %s DO_C DO_LISP DEFUN
305 %s DEFUN2 DEFUN3 LDEF
306
307 W       [ \t\n]
308 Any     (.|"\n")
309 Q       "\""
310 NQ      [^"]
311 NT      [^A-Za-z_0-9]
312 LP      "("
313 RP      ")"
314 BS      "\\"
315 Esc     ({BS}{Any})
316 Wh      ({W}*)
317 LCom    (";"({Esc}|.)*)
318 LWh     (({W}|{Lcom})*)
319 Open    ({Wh}{LP})
320 OpWQ    ({Open}{Wh}{Q})
321 String  ({Q}({Esc}|{NQ})*{Q})
322 Arg     ([^,]*",")
323 StringArg       ({Wh}{String}{Wh}",")
324 OpenString      ({Open}{StringArg})
325 LispToken       (({Esc}|[-A-Za-z0-9!@$%^&*_=+|{}`~,<.>/?])+)
326 %%
327
328 <DO_C>{NT}"GETTEXT"{OpWQ} { snarf (); }
329 <DO_C>{NT}"DEFER_GETTEXT"{OpWQ} { snarf (); }
330 <DO_C>{NT}"build_translated_string"{OpWQ} { snarf (); }
331 <DO_C>{NT}"insert_string"{OpWQ} { snarf (); }
332 <DO_C>{NT}"message"{OpWQ} { snarf (); }
333 <DO_C>{NT}"warn_when_safe"{OpWQ} { snarf (); }
334 <DO_C>{NT}"error"{OpWQ} { snarf (); }
335 <DO_C>{NT}"continuable_error"{OpWQ} { snarf (); }
336 <DO_C>{NT}"signal_simple_error"{OpWQ} { snarf (); }
337 <DO_C>{NT}"signal_simple_error_2"{OpWQ} { snarf (); }
338 <DO_C>{NT}"signal_simple_continuable_error"{OpWQ} { snarf (); }
339 <DO_C>{NT}"signal_simple_continuable_error_2"{OpWQ} { snarf (); }
340 <DO_C>{NT}"report_file_error"{OpWQ} { snarf (); }
341 <DO_C>{NT}"signal_file_error"{OpWQ} { snarf (); }
342 <DO_C>{NT}"signal_double_file_error"{OpWQ} { snarf (); }
343 <DO_C>{NT}"signal_double_file_error_2"{OpWQ} { snarf (); }
344 <DO_C>{NT}"syntax_error"{OpWQ} { snarf (); }
345 <DO_C>{NT}"continuable_syntax_error"{OpWQ} { snarf (); }
346 <DO_C>{NT}"CTB_ERROR"{OpWQ} { snarf (); }
347 <DO_C>{NT}"fatal"{OpWQ} { snarf (); }
348 <DO_C>{NT}"stdout_out"{OpWQ} { snarf (); }
349 <DO_C>{NT}"stderr_out"{OpWQ} { snarf (); }
350 <DO_C>{NT}"with_output_to_temp_buffer"{OpWQ} { snarf (); }
351
352 <DO_C>{NT}"DEFVAR_BOOL"{OpenString}{Arg}{Wh}{Q} { snarf (); }
353 <DO_C>{NT}"DEFVAR_LISP"{OpenString}{Arg}{Wh}{Q} { snarf (); }
354 <DO_C>{NT}"DEFVAR_SPECIFIER"{OpenString}{Arg}{Wh}{Q} { snarf (); }
355 <DO_C>{NT}"DEFVAR_INT"{OpenString}{Arg}{Wh}{Q} { snarf (); }
356 <DO_C>{NT}"DEFVAR_BUFFER_LOCAL"{OpenString}{Arg}{Wh}{Q} { snarf (); }
357 <DO_C>{NT}"DEFVAR_BUFFER_DEFAULTS"{OpenString}{Arg}{Wh}{Q} { snarf (); }
358 <DO_C>{NT}"deferror"{Open}{Arg}{StringArg}{Wh}{Q} { snarf (); }
359
360 <DO_C>{NT}"barf_or_query_if_file_exists"{Open}{Arg}{Wh}{Q} {
361   /* #### see comment above about use of Arg */
362   snarf ();
363 }
364
365 <DO_C>{NT}"DEFUN"{Open} { BEGIN DEFUN; }
366
367 <DO_C>"/*" {
368   /* This is hateful, but doc strings are sometimes put inside of comments
369      (to get around limits in cpp), so we can't ignore stuff inside of
370      comments. */
371   /* BEGIN C_COMMENT; */
372 }
373 <DO_C>{Q} { BEGIN C_QUOTE; }
374 <DO_C>{Any} { }
375
376 <DEFUN>{StringArg}{Arg}{Arg}{Arg}{Arg}{Wh} { BEGIN DEFUN2; }
377 <DEFUN>{Any} { bad_c_defun (); }
378
379 <DEFUN2>{Q} {
380   /* We found an interactive specification. */
381   snarf_return_state = DEFUN3;
382   snarf ();
383 }
384 <DEFUN2>[^,]* {
385   /* This function doesn't have an interactive specification.
386      Don't use {Arg} in the specification because DEFUN3 looks
387      for the comma. */
388   BEGIN DEFUN3;
389 }
390
391 <DEFUN3>{Wh}","{Wh}{Q} {
392   snarf_return_state = DO_C;
393   snarf ();
394 }
395 <DEFUN3>{Any} { bad_c_defun (); }
396
397 <C_QUOTE>{Esc} { }
398 <C_QUOTE>{Q} { BEGIN DO_C; }
399 <C_QUOTE>{Any} { }
400
401 <C_COMMENT>"*/" { BEGIN DO_C; }
402 <C_COMMENT>{Any} { }
403
404 <DO_LISP>{LP}{LWh}"gettext"{LWh}{Q} { inc_paren (); snarf (); }
405 <DO_LISP>{LP}{LWh}"purecopy"{LWh}{Q} { inc_paren (); snarf (); }
406 <DO_LISP>{LP}{LWh}"interactive"{LWh}{Q} { inc_paren (); snarf (); }
407 <DO_LISP>{LP}{LWh}"message"{LWh}{Q} { inc_paren (); snarf (); }
408 <DO_LISP>{LP}{LWh}"error"{LWh}{Q} { inc_paren (); snarf (); }
409 <DO_LISP>{LP}{LWh}"warn"{LWh}{Q} { inc_paren (); snarf (); }
410 <DO_LISP>{LP}{LWh}"format"{LWh}{Q} { inc_paren (); snarf (); }
411 <DO_LISP>{LP}{LWh}"substitute-command-keys"{LWh}{Q} { inc_paren (); snarf (); }
412 <DO_LISP>{LP}{LWh}"temp-minibuffer-message"{LWh}{Q} { inc_paren (); snarf (); }
413 <DO_LISP>{LP}{LWh}"momentary-string-display"{LWh}{Q} { inc_paren (); snarf (); }
414 <DO_LISP>{LP}{LWh}"princ"{LWh}{Q} { inc_paren (); snarf (); }
415 <DO_LISP>{LP}{LWh}"prin1"{LWh}{Q} { inc_paren (); snarf (); }
416 <DO_LISP>{LP}{LWh}"prin1-to-string"{LWh}{Q} { inc_paren (); snarf (); }
417 <DO_LISP>{LP}{LWh}"print"{LWh}{Q} { inc_paren (); snarf (); }
418 <DO_LISP>{LP}{LWh}"insert"{LWh}{Q} { inc_paren (); snarf (); }
419 <DO_LISP>{LP}{LWh}"insert-before-markers"{LWh}{Q} { inc_paren (); snarf (); }
420
421 <DO_LISP>{LP}{LWh}"get-buffer"{LWh}{Q} { inc_paren (); snarf (); }
422 <DO_LISP>{LP}{LWh}"get-buffer-create"{LWh}{Q} { inc_paren (); snarf (); }
423 <DO_LISP>{LP}{LWh}"generate-new-buffer-name"{LWh}{Q} { inc_paren (); snarf (); }
424 <DO_LISP>{LP}{LWh}"rename-buffer"{LWh}{Q} { inc_paren (); snarf (); }
425 <DO_LISP>{LP}{LWh}"set-buffer"{LWh}{Q} { inc_paren (); snarf (); }
426 <DO_LISP>{LP}{LWh}"switch-to-buffer"{LWh}{Q} { inc_paren (); snarf (); }
427 <DO_LISP>{LP}{LWh}"pop-to-buffer"{LWh}{Q} { inc_paren (); snarf (); }
428 <DO_LISP>{LP}{LWh}"with-output-to-temp-buffer"{LWh}{Q} { inc_paren (); snarf (); }
429 <DO_LISP>{LP}{LWh}"buffer-enable-undo"{LWh}{Q} { inc_paren (); snarf (); }
430 <DO_LISP>{LP}{LWh}"buffer-disable-undo"{LWh}{Q} { inc_paren (); snarf (); }
431 <DO_LISP>{LP}{LWh}"get-buffer-window"{LWh}{Q} { inc_paren (); snarf (); }
432 <DO_LISP>{LP}{LWh}"delete-windows-on"{LWh}{Q} { inc_paren (); snarf (); }
433 <DO_LISP>{LP}{LWh}"replace-buffer-in-windows"{LWh}{Q} { inc_paren (); snarf (); }
434 <DO_LISP>{LP}{LWh}"display-buffer"{LWh}{Q} { inc_paren (); snarf (); }
435 <DO_LISP>{LP}{LWh}"other-buffer"{LWh}{Q} { inc_paren (); snarf (); }
436
437 <DO_LISP>{LP}{LWh}"read-from-minibuffer"{LWh}{Q} { inc_paren (); snarf (); }
438 <DO_LISP>{LP}{LWh}"read-shell-command"{LWh}{Q} { inc_paren (); snarf (); }
439 <DO_LISP>{LP}{LWh}"read-file-name"{LWh}{Q} { inc_paren (); snarf (); }
440 <DO_LISP>{LP}{LWh}"read-buffer"{LWh}{Q} { inc_paren (); snarf (); }
441 <DO_LISP>{LP}{LWh}"read-variable"{LWh}{Q} { inc_paren (); snarf (); }
442 <DO_LISP>{LP}{LWh}"read-command"{LWh}{Q} { inc_paren (); snarf (); }
443 <DO_LISP>{LP}{LWh}"read-function"{LWh}{Q} { inc_paren (); snarf (); }
444 <DO_LISP>{LP}{LWh}"read-directory-name"{LWh}{Q} { inc_paren (); snarf (); }
445 <DO_LISP>{LP}{LWh}"read-string"{LWh}{Q} { inc_paren (); snarf (); }
446 <DO_LISP>{LP}{LWh}"read-number"{LWh}{Q} { inc_paren (); snarf (); }
447 <DO_LISP>{LP}{LWh}"read-minibuffer"{LWh}{Q} { inc_paren (); snarf (); }
448 <DO_LISP>{LP}{LWh}"read-quoted-char"{LWh}{Q} { inc_paren (); snarf (); }
449 <DO_LISP>{LP}{LWh}"read-face-name"{LWh}{Q} { inc_paren (); snarf (); }
450 <DO_LISP>{LP}{LWh}"read-itimer"{LWh}{Q} { inc_paren (); snarf (); }
451 <DO_LISP>{LP}{LWh}"completing-read"{LWh}{Q} { inc_paren (); snarf (); }
452 <DO_LISP>{LP}{LWh}"y-or-n-p"{LWh}{Q} { inc_paren (); snarf (); }
453 <DO_LISP>{LP}{LWh}"yes-or-no-p"{LWh}{Q} { inc_paren (); snarf (); }
454 <DO_LISP>{LP}{LWh}"query-replace-read-args"{LWh}{Q} { inc_paren (); snarf (); }
455 <DO_LISP>{LP}{LWh}"eval-minibuffer"{LWh}{Q} { inc_paren (); snarf (); }
456 <DO_LISP>{LP}{LWh}"edit-and-eval-command"{LWh}{Q} { inc_paren (); snarf (); }
457
458 <DO_LISP>{LP}{LWh}"defvar"{LWh}{LispToken}{LWh} {
459   inc_paren (); begin_paren_counting (LDEF);
460 }
461 <DO_LISP>{LP}{LWh}"defconst"{LWh}{LispToken}{LWh} {
462   inc_paren (); begin_paren_counting (LDEF);
463 }
464 <DO_LISP>{LP}{LWh}"defun"{LWh}{LispToken}{LWh} {
465   inc_paren (); begin_paren_counting (LDEF);
466 }
467 <DO_LISP>{LP}{LWh}"defmacro"{LWh}{LispToken}{LWh} {
468   inc_paren (); begin_paren_counting (LDEF);
469 }
470 <DO_LISP>{LP}{LWh}"defsubst"{LWh}{LispToken}{LWh} {
471   inc_paren (); begin_paren_counting (LDEF);
472 }
473
474 <DO_LISP>{Q} { BEGIN LQUO; }
475 <DO_LISP>";" { BEGIN LCOM; }
476 <DO_LISP>{LP} { inc_paren (); }
477 <DO_LISP>{RP} { dec_paren (); }
478 <DO_LISP>{Esc} { }
479 <DO_LISP>{W} { lisp_whitespace (); }
480 <DO_LISP>{Any} { }
481
482 <LQUO>{Esc} { }
483 <LQUO>{Q} { BEGIN DO_LISP; }
484 <LQUO>{Any} { }
485
486 <LCOM>"\n" { BEGIN DO_LISP; }
487 <LCOM>{Any} { }
488
489 <LDEF>{LWh}{Q} { snarf (); }
490 <LDEF>{Any} { BEGIN DO_LISP; }
491
492 <CSNARF>{Esc} { ECHO; }
493 <CSNARF>{Q} { ECHO; fprintf (yyout, ")\n"); BEGIN snarf_return_state; }
494 <CSNARF>{Any} { ECHO; }
495
496 <LSNARF>{Esc} { ECHO; }
497 <LSNARF>"\n" { fprintf (yyout, "\\n\\\n"); }
498 <LSNARF>{Q} { ECHO; fprintf (yyout, ")\n"); BEGIN snarf_return_state; }
499 <LSNARF>{Any} { ECHO; }
500
501 %%
502
503 enum filetype { C_FILE, LISP_FILE, INVALID_FILE };
504 /* some brain-dead headers define this ... */
505 #undef FALSE
506 #undef TRUE
507 enum boolean { FALSE, TRUE };
508
509 void scan_file (char *filename);
510 void process_C_file (void);
511 void process_Lisp_file (void);
512
513 int in_c;
514 int in_paren_counting, paren_count;
515 int paren_return_state;
516
517 snarf ()
518 {
519   fprintf (yyout, "gettext(\"");
520   if (in_c)
521     BEGIN CSNARF;
522   else
523     BEGIN LSNARF;
524 }
525
526 bad_c_defun ()
527 {
528   fprintf (stderr, "Warning: Invalid DEFUN encountered in C, line %d.\n",
529            yylineno);
530   snarf_return_state = DO_C;
531   BEGIN DO_C;
532   /* REJECT; Sun's lex is broken!  Use Flex! */
533 }
534
535 bad_lisp_def ()
536 {
537   fprintf (stderr,
538            "Warning: Invalid defmumble encountered in Lisp, line %d.\n",
539            yylineno);
540   snarf_return_state = DO_LISP;
541   BEGIN DO_LISP;
542   /* REJECT; Sun's lex is broken!  Use Flex! */
543 }
544
545 inc_paren ()
546 {
547   if (in_paren_counting)
548     paren_count++;
549 }
550
551 dec_paren ()
552 {
553   if (in_paren_counting)
554     {
555       /* If we find a right paren without a matching left paren, it usually
556          just indicates a statement like
557
558          (defvar foo-mumble nil)
559
560          where 'nil' is the sexp we are skipping over, and there's no
561          doc string. */
562       if (paren_count > 0)
563         paren_count--;
564       else
565         unput (')');    
566       if (paren_count == 0)
567         {
568           in_paren_counting = 0;
569           BEGIN paren_return_state;
570         }
571     }
572 }
573
574 /* #### begin_paren_counting () does not handle recursive entries */
575
576 begin_paren_counting (int return_state)
577 {
578   in_paren_counting = 1;
579   paren_count = 0;
580   paren_return_state = return_state;
581 }
582
583 lisp_whitespace ()
584 {
585   if (in_paren_counting && !paren_count)
586     {
587       /* We got to the end of a token and we're not in a parenthesized
588          expression, so we're at the end of an sexp. */
589       in_paren_counting = 0;
590       BEGIN paren_return_state;
591     }
592 }
593
594 yywrap ()
595 {
596   return 1;
597 }
598
599 main (int argc, char *argv[])
600 {
601   register int i;
602
603   yyout = stdout;
604
605   /* If first two args are -o FILE, output to FILE. */
606   i = 1;
607   if (argc > i + 1 && strcmp (argv[i], "-o") == 0) {
608     yyout = fopen (argv[++i], "w");
609     ++i;
610   }
611   /* ...Or if args are -a FILE, append to FILE. */
612   if (argc > i + 1 && strcmp (argv[i], "-a") == 0) {
613     yyout = fopen (argv[++i], "a");
614     ++i;
615   }
616   if (!yyout) {
617     fprintf (stderr, "Unable to open output file %s\n", argv[--i]);
618     return;
619   }
620
621   for (; i < argc; i++)
622     scan_file (argv[i]);
623
624   return 0;
625 }
626
627
628 void scan_file (char *filename)
629 {
630   enum filetype type = INVALID_FILE;
631   register char *p = filename + strlen (filename);
632
633   if (strcmp (p - 4, ".elc") == 0) {
634     *--p = '\0';                                /* Use .el file instead */
635     type = LISP_FILE;
636   } else if (strcmp (p - 3, ".el") == 0)
637     type = LISP_FILE;
638   else if (strcmp (p - 2, ".o") == 0) {
639     *--p = 'c';                                 /* Use .c file instead */
640     type = C_FILE;
641   } else if (strcmp (p - 2, ".c") == 0)
642     type = C_FILE;
643
644   if (type == INVALID_FILE) {
645     fprintf (stderr, "File %s being ignored\n", filename);
646     return;
647   }
648   yyin = fopen (filename, "r");
649   if (!yyin) {
650     fprintf (stderr, "Unable to open input file %s\n", filename);
651     return;
652   }
653
654   fprintf (yyout, "/* %s */\n", filename);
655   if (type == C_FILE)
656     process_C_file ();
657   else
658     process_Lisp_file ();
659   fputc ('\n', yyout);
660   
661   fclose (yyin);
662 }
663
664 void process_C_file ()
665 {
666   snarf_return_state = DO_C;
667   in_c = 1;
668   BEGIN DO_C;
669   yylex ();
670 }
671
672 void process_Lisp_file ()
673 {
674   snarf_return_state = DO_LISP;
675   in_c = 0;
676   BEGIN DO_LISP;
677   yylex ();
678 }
679