(put_char): New function.
[bpt/emacs.git] / lib-src / make-docfile.c
CommitLineData
f2cc4248 1/* Generate doc-string file for GNU Emacs from source files.
291c7e74
GM
2 Copyright (C) 1985, 86, 92, 93, 94, 97, 1999, 2000, 2001
3 Free Software Foundation, Inc.
f2cc4248
RS
4
5This file is part of GNU Emacs.
6
93320c23
JA
7GNU Emacs is free software; you can redistribute it and/or modify
8it under the terms of the GNU General Public License as published by
e065a56e 9the Free Software Foundation; either version 2, or (at your option)
93320c23
JA
10any later version.
11
f2cc4248 12GNU Emacs is distributed in the hope that it will be useful,
93320c23
JA
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15GNU General Public License for more details.
f2cc4248 16
93320c23
JA
17You should have received a copy of the GNU General Public License
18along with GNU Emacs; see the file COPYING. If not, write to
3b7ad313
EN
19the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20Boston, MA 02111-1307, USA. */
f2cc4248
RS
21
22/* The arguments given to this program are all the C and Lisp source files
23 of GNU Emacs. .elc and .el and .c files are allowed.
24 A .o file can also be specified; the .c file it was made from is used.
25 This helps the makefile pass the correct list of files.
26
27 The results, which go to standard output or to a file
28 specified with -a or -o (-a to append, -o to start from nothing),
29 are entries containing function or variable names and their documentation.
30 Each entry starts with a ^_ character.
31 Then comes F for a function or V for a variable.
32 Then comes the function or variable name, terminated with a newline.
33 Then comes the documentation for that function or variable.
34 */
35
34b4ece5 36#define NO_SHORTNAMES /* Tell config not to load remap.h */
433d333d
RS
37#include <config.h>
38
39/* defined to be emacs_main, sys_fopen, etc. in config.h */
40#undef main
41#undef fopen
42#undef chdir
34b4ece5 43
f2cc4248 44#include <stdio.h>
e3938952
RS
45#ifdef MSDOS
46#include <fcntl.h>
47#endif /* MSDOS */
86b0513a
RS
48#ifdef WINDOWSNT
49#include <stdlib.h>
50#include <fcntl.h>
51#include <direct.h>
52#endif /* WINDOWSNT */
e3938952 53
86b0513a 54#ifdef DOS_NT
e3938952
RS
55#define READ_TEXT "rt"
56#define READ_BINARY "rb"
86b0513a 57#else /* not DOS_NT */
e3938952
RS
58#define READ_TEXT "r"
59#define READ_BINARY "r"
86b0513a 60#endif /* not DOS_NT */
f2cc4248 61
340ff9de
DM
62int scan_file ();
63int scan_lisp_file ();
64int scan_c_file ();
65
2d1985a2
KH
66#ifdef MSDOS
67/* s/msdos.h defines this as sys_chdir, but we're not linking with the
68 file where that function is defined. */
69#undef chdir
70#endif
71
a0613c61
AS
72#ifdef HAVE_UNISTD_H
73#include <unistd.h>
74#endif
75
b5ff43cc 76/* Stdio stream for output to the DOC file. */
f2cc4248
RS
77FILE *outfile;
78
b5ff43cc
RS
79/* Name this program was invoked with. */
80char *progname;
81
82/* Print error message. `s1' is printf control string, `s2' is arg for it. */
83
84/* VARARGS1 */
85void
86error (s1, s2)
87 char *s1, *s2;
88{
89 fprintf (stderr, "%s: ", progname);
90 fprintf (stderr, s1, s2);
91 fprintf (stderr, "\n");
92}
93
94/* Print error message and exit. */
95
96/* VARARGS1 */
97void
98fatal (s1, s2)
99 char *s1, *s2;
100{
101 error (s1, s2);
102 exit (1);
103}
104
105/* Like malloc but get fatal error if memory is exhausted. */
106
34b4ece5 107long *
b5ff43cc
RS
108xmalloc (size)
109 unsigned int size;
110{
34b4ece5 111 long *result = (long *) malloc (size);
b5ff43cc
RS
112 if (result == NULL)
113 fatal ("virtual memory exhausted", 0);
114 return result;
115}
116\f
340ff9de 117int
f2cc4248
RS
118main (argc, argv)
119 int argc;
120 char **argv;
121{
122 int i;
123 int err_count = 0;
a27897c9 124 int first_infile;
f2cc4248 125
b5ff43cc
RS
126 progname = argv[0];
127
4e043ed3
RS
128 outfile = stdout;
129
86b0513a 130 /* Don't put CRs in the DOC file. */
e3938952 131#ifdef MSDOS
5281dea4 132 _fmode = O_BINARY;
4e043ed3
RS
133#if 0 /* Suspicion is that this causes hanging.
134 So instead we require people to use -o on MSDOS. */
e3938952
RS
135 (stdout)->_flag &= ~_IOTEXT;
136 _setmode (fileno (stdout), O_BINARY);
4e043ed3
RS
137#endif
138 outfile = 0;
e3938952 139#endif /* MSDOS */
86b0513a
RS
140#ifdef WINDOWSNT
141 _fmode = O_BINARY;
142 _setmode (fileno (stdout), O_BINARY);
143#endif /* WINDOWSNT */
144
f2cc4248
RS
145 /* If first two args are -o FILE, output to FILE. */
146 i = 1;
147 if (argc > i + 1 && !strcmp (argv[i], "-o"))
148 {
149 outfile = fopen (argv[i + 1], "w");
150 i += 2;
151 }
152 if (argc > i + 1 && !strcmp (argv[i], "-a"))
153 {
154 outfile = fopen (argv[i + 1], "a");
155 i += 2;
156 }
d2d92f7a
JB
157 if (argc > i + 1 && !strcmp (argv[i], "-d"))
158 {
159 chdir (argv[i + 1]);
160 i += 2;
161 }
f2cc4248 162
4e043ed3
RS
163 if (outfile == 0)
164 fatal ("No output file specified", "");
165
a27897c9 166 first_infile = i;
f2cc4248 167 for (; i < argc; i++)
a27897c9
RS
168 {
169 int j;
170 /* Don't process one file twice. */
171 for (j = first_infile; j < i; j++)
172 if (! strcmp (argv[i], argv[j]))
173 break;
174 if (j == i)
175 err_count += scan_file (argv[i]);
176 }
f2cc4248 177#ifndef VMS
a27897c9 178 exit (err_count > 0);
a706b808 179#endif /* VMS */
a27897c9 180 return err_count > 0;
f2cc4248
RS
181}
182
a8a7afbe 183/* Read file FILENAME and output its doc strings to outfile. */
f2cc4248
RS
184/* Return 1 if file is not found, 0 if it is found. */
185
340ff9de 186int
f2cc4248
RS
187scan_file (filename)
188 char *filename;
189{
190 int len = strlen (filename);
dc61cb9d 191 if (len > 4 && !strcmp (filename + len - 4, ".elc"))
e3938952 192 return scan_lisp_file (filename, READ_BINARY);
dc61cb9d 193 else if (len > 3 && !strcmp (filename + len - 3, ".el"))
e3938952 194 return scan_lisp_file (filename, READ_TEXT);
f2cc4248 195 else
e3938952 196 return scan_c_file (filename, READ_TEXT);
f2cc4248
RS
197}
198\f
199char buf[128];
200
0c82822c
MB
201/* Add CH to either outfile, if PRINTFLAG is positive, or to the buffer
202 whose end is pointed to by BUFP, if PRINTFLAG is negative.
203 If the counters pointed to by PENDING_NEWLINES and PENDING_SPACES are
204 non-zero, that many newlines and spaces are output before CH, and
205 the counters are zeroed. */
206
207static INLINE void
208put_char (ch, printflag, bufp, pending_newlines, pending_spaces)
209 int ch, printflag;
210 char **bufp;
211 unsigned *pending_newlines, *pending_spaces;
212{
213 int out_ch;
214 do
215 {
216 if (*pending_newlines > 0)
217 {
218 (*pending_newlines)--;
219 out_ch = '\n';
220 }
221 else if (*pending_spaces > 0)
222 {
223 (*pending_spaces)--;
224 out_ch = ' ';
225 }
226 else
227 out_ch = ch;
228
229 if (printflag > 0)
230 putc (out_ch, outfile);
231 else if (printflag < 0)
232 *(*bufp)++ = out_ch;
233 }
234 while (out_ch != ch);
235}
236
74c55c82
GM
237/* Skip a C string or C-style comment from INFILE, and return the
238 character that follows. COMMENT non-zero means skip a comment. If
239 PRINTFLAG is positive, output string contents to outfile. If it is
240 negative, store contents in buf. Convert escape sequences \n and
241 \t to newline and tab; discard \ followed by newline. */
f2cc4248 242
340ff9de 243int
74c55c82 244read_c_string_or_comment (infile, printflag, comment)
f2cc4248
RS
245 FILE *infile;
246 int printflag;
247{
248 register int c;
0c82822c 249 unsigned pending_spaces = 0, pending_newlines = 0;
f2cc4248
RS
250 char *p = buf;
251
74c55c82
GM
252 if (comment)
253 {
254 while ((c = getc (infile)) != EOF
255 && (c == '\n' || c == '\r' || c == '\t' || c == ' '))
256 ;
257 }
258 else
259 c = getc (infile);
260
f2cc4248
RS
261 while (c != EOF)
262 {
74c55c82 263 while (c != EOF && (comment ? c != '*' : c != '"'))
f2cc4248
RS
264 {
265 if (c == '\\')
266 {
267 c = getc (infile);
433d333d 268 if (c == '\n' || c == '\r')
f2cc4248
RS
269 {
270 c = getc (infile);
271 continue;
272 }
273 if (c == 'n')
274 c = '\n';
275 if (c == 't')
276 c = '\t';
277 }
74c55c82 278
0c82822c
MB
279 if (c == ' ')
280 pending_spaces++;
281 else if (c == '\n')
282 {
283 pending_newlines++;
284 pending_spaces = 0;
285 }
286 else
287 put_char (c, printflag, &p, &pending_newlines, &pending_spaces);
288
f2cc4248
RS
289 c = getc (infile);
290 }
74c55c82 291
7dfd439c
GM
292 if (c != EOF)
293 c = getc (infile);
f2cc4248 294
74c55c82
GM
295 if (comment)
296 {
297 if (c == '/')
298 {
299 c = getc (infile);
300 break;
301 }
7dfd439c 302
0c82822c 303 put_char ('*', printflag, &p, &pending_newlines, &pending_spaces);
74c55c82
GM
304 }
305 else
306 {
307 if (c != '"')
308 break;
309
310 /* If we had a "", concatenate the two strings. */
311 c = getc (infile);
312 }
313 }
314
f2cc4248
RS
315 if (printflag < 0)
316 *p = 0;
317
318 return c;
319}
74c55c82
GM
320
321
f2cc4248 322\f
069ad9ea 323/* Write to file OUT the argument names of function FUNC, whose text is in BUF.
f2cc4248
RS
324 MINARGS and MAXARGS are the minimum and maximum number of arguments. */
325
340ff9de 326void
069ad9ea 327write_c_args (out, func, buf, minargs, maxargs)
f2cc4248 328 FILE *out;
069ad9ea 329 char *func, *buf;
f2cc4248
RS
330 int minargs, maxargs;
331{
f125a9e8 332 register char *p;
30e4c427
JB
333 int in_ident = 0;
334 int just_spaced = 0;
069ad9ea 335 int need_space = 1;
f2cc4248 336
069ad9ea
RM
337 fprintf (out, "(%s", func);
338
339 if (*buf == '(')
340 ++buf;
f2cc4248 341
f125a9e8 342 for (p = buf; *p; p++)
f2cc4248 343 {
30e4c427 344 char c = *p;
3941a179 345 int ident_start = 0;
30e4c427
JB
346
347 /* Notice when we start printing a new identifier. */
348 if ((('A' <= c && c <= 'Z')
349 || ('a' <= c && c <= 'z')
350 || ('0' <= c && c <= '9')
351 || c == '_')
352 != in_ident)
f2cc4248 353 {
30e4c427
JB
354 if (!in_ident)
355 {
356 in_ident = 1;
3941a179 357 ident_start = 1;
f125a9e8 358
069ad9ea
RM
359 if (need_space)
360 putc (' ', out);
361
30e4c427
JB
362 if (minargs == 0 && maxargs > 0)
363 fprintf (out, "&optional ");
364 just_spaced = 1;
f125a9e8 365
30e4c427
JB
366 minargs--;
367 maxargs--;
368 }
369 else
370 in_ident = 0;
f2cc4248 371 }
30e4c427
JB
372
373 /* Print the C argument list as it would appear in lisp:
291c7e74
GM
374 print underscores as hyphens, and print commas and newlines
375 as spaces. Collapse adjacent spaces into one. */
376 if (c == '_')
377 c = '-';
378 else if (c == ',' || c == '\n')
379 c = ' ';
30e4c427 380
3941a179
JB
381 /* In C code, `default' is a reserved word, so we spell it
382 `defalt'; unmangle that here. */
383 if (ident_start
384 && strncmp (p, "defalt", 6) == 0
385 && ! (('A' <= p[6] && p[6] <= 'Z')
386 || ('a' <= p[6] && p[6] <= 'z')
387 || ('0' <= p[6] && p[6] <= '9')
388 || p[6] == '_'))
389 {
4607ea99 390 fprintf (out, "DEFAULT");
3941a179
JB
391 p += 5;
392 in_ident = 0;
393 just_spaced = 0;
394 }
291c7e74 395 else if (c != ' ' || !just_spaced)
069ad9ea
RM
396 {
397 if (c >= 'a' && c <= 'z')
398 /* Upcase the letter. */
399 c += 'A' - 'a';
400 putc (c, out);
401 }
30e4c427 402
291c7e74 403 just_spaced = c == ' ';
069ad9ea 404 need_space = 0;
f2cc4248 405 }
f2cc4248
RS
406}
407\f
408/* Read through a c file. If a .o file is named,
409 the corresponding .c file is read instead.
410 Looks for DEFUN constructs such as are defined in ../src/lisp.h.
411 Accepts any word starting DEF... so it finds DEFSIMPLE and DEFPRED. */
412
340ff9de 413int
e3938952
RS
414scan_c_file (filename, mode)
415 char *filename, *mode;
f2cc4248
RS
416{
417 FILE *infile;
418 register int c;
419 register int commas;
420 register int defunflag;
84128dee 421 register int defvarperbufferflag;
f2cc4248
RS
422 register int defvarflag;
423 int minargs, maxargs;
1feb8ae1 424 int extension = filename[strlen (filename) - 1];
f2cc4248 425
1feb8ae1 426 if (extension == 'o')
f2cc4248
RS
427 filename[strlen (filename) - 1] = 'c';
428
e3938952 429 infile = fopen (filename, mode);
f2cc4248
RS
430
431 /* No error if non-ex input file */
432 if (infile == NULL)
433 {
434 perror (filename);
435 return 0;
436 }
437
1feb8ae1
RS
438 /* Reset extension to be able to detect duplicate files. */
439 filename[strlen (filename) - 1] = extension;
440
f2cc4248
RS
441 c = '\n';
442 while (!feof (infile))
443 {
a5979c0e
MB
444 int doc_keyword = 0;
445
433d333d 446 if (c != '\n' && c != '\r')
f2cc4248
RS
447 {
448 c = getc (infile);
449 continue;
450 }
451 c = getc (infile);
452 if (c == ' ')
453 {
454 while (c == ' ')
455 c = getc (infile);
456 if (c != 'D')
457 continue;
458 c = getc (infile);
459 if (c != 'E')
460 continue;
461 c = getc (infile);
462 if (c != 'F')
463 continue;
464 c = getc (infile);
465 if (c != 'V')
466 continue;
84128dee
JB
467 c = getc (infile);
468 if (c != 'A')
469 continue;
470 c = getc (infile);
471 if (c != 'R')
472 continue;
473 c = getc (infile);
474 if (c != '_')
475 continue;
476
f2cc4248
RS
477 defvarflag = 1;
478 defunflag = 0;
84128dee
JB
479
480 c = getc (infile);
481 defvarperbufferflag = (c == 'P');
482
f2cc4248
RS
483 c = getc (infile);
484 }
485 else if (c == 'D')
486 {
487 c = getc (infile);
488 if (c != 'E')
489 continue;
490 c = getc (infile);
491 if (c != 'F')
492 continue;
493 c = getc (infile);
494 defunflag = c == 'U';
495 defvarflag = 0;
496 }
497 else continue;
498
499 while (c != '(')
500 {
501 if (c < 0)
502 goto eof;
503 c = getc (infile);
504 }
505
74c55c82 506 /* Lisp variable or function name. */
f2cc4248
RS
507 c = getc (infile);
508 if (c != '"')
509 continue;
74c55c82
GM
510 c = read_c_string_or_comment (infile, -1, 0);
511
a5979c0e
MB
512 /* DEFVAR_LISP ("name", addr, "doc")
513 DEFVAR_LISP ("name", addr /\* doc *\/)
514 DEFVAR_LISP ("name", addr, doc: /\* doc *\/) */
f2cc4248
RS
515
516 if (defunflag)
517 commas = 5;
84128dee
JB
518 else if (defvarperbufferflag)
519 commas = 2;
f2cc4248
RS
520 else if (defvarflag)
521 commas = 1;
522 else /* For DEFSIMPLE and DEFPRED */
523 commas = 2;
524
525 while (commas)
526 {
527 if (c == ',')
528 {
529 commas--;
74c55c82 530
f2cc4248
RS
531 if (defunflag && (commas == 1 || commas == 2))
532 {
533 do
534 c = getc (infile);
433d333d 535 while (c == ' ' || c == '\n' || c == '\r' || c == '\t');
f2cc4248
RS
536 if (c < 0)
537 goto eof;
538 ungetc (c, infile);
539 if (commas == 2) /* pick up minargs */
540 fscanf (infile, "%d", &minargs);
541 else /* pick up maxargs */
542 if (c == 'M' || c == 'U') /* MANY || UNEVALLED */
543 maxargs = -1;
544 else
545 fscanf (infile, "%d", &maxargs);
546 }
547 }
74c55c82
GM
548
549 if (c == EOF)
f2cc4248
RS
550 goto eof;
551 c = getc (infile);
552 }
a5979c0e 553
433d333d 554 while (c == ' ' || c == '\n' || c == '\r' || c == '\t')
f2cc4248 555 c = getc (infile);
74c55c82 556
f2cc4248 557 if (c == '"')
74c55c82
GM
558 c = read_c_string_or_comment (infile, 0, 0);
559
560 while (c != EOF && c != ',' && c != '/')
f2cc4248 561 c = getc (infile);
74c55c82
GM
562 if (c == ',')
563 {
a5979c0e
MB
564 c = getc (infile);
565 while (c == ' ' || c == '\n' || c == '\r' || c == '\t')
566 c = getc (infile);
567 while ((c >= 'a' && c <= 'z') || (c >= 'Z' && c <= 'Z'))
568 c = getc (infile);
569 if (c == ':')
570 {
571 doc_keyword = 1;
572 c = getc (infile);
573 while (c == ' ' || c == '\n' || c == '\r' || c == '\t')
574 c = getc (infile);
575 }
74c55c82 576 }
f2cc4248 577
74c55c82
GM
578 if (c == '"'
579 || (c == '/'
580 && (c = getc (infile),
581 ungetc (c, infile),
582 c == '*')))
f2cc4248 583 {
74c55c82
GM
584 int comment = c != '"';
585
f2cc4248
RS
586 putc (037, outfile);
587 putc (defvarflag ? 'V' : 'F', outfile);
588 fprintf (outfile, "%s\n", buf);
74c55c82
GM
589
590 if (comment)
591 getc (infile); /* Skip past `*' */
592 c = read_c_string_or_comment (infile, 1, comment);
772e2009
JB
593
594 /* If this is a defun, find the arguments and print them. If
595 this function takes MANY or UNEVALLED args, then the C source
596 won't give the names of the arguments, so we shouldn't bother
74c55c82
GM
597 trying to find them.
598
a5979c0e
MB
599 Various doc-string styles:
600 0: DEFUN (..., "DOC") (args) [!comment]
601 1: DEFUN (..., /\* DOC *\/ (args)) [comment && !doc_keyword]
602 2: DEFUN (..., doc: /\* DOC *\/) (args) [comment && doc_keyword]
603 */
772e2009 604 if (defunflag && maxargs != -1)
f2cc4248
RS
605 {
606 char argbuf[1024], *p = argbuf;
74c55c82 607
a5979c0e 608 if (!comment || doc_keyword)
74c55c82
GM
609 while (c != ')')
610 {
611 if (c < 0)
612 goto eof;
613 c = getc (infile);
614 }
615
f2cc4248
RS
616 /* Skip into arguments. */
617 while (c != '(')
618 {
619 if (c < 0)
620 goto eof;
621 c = getc (infile);
622 }
623 /* Copy arguments into ARGBUF. */
624 *p++ = c;
625 do
626 *p++ = c = getc (infile);
627 while (c != ')');
628 *p = '\0';
629 /* Output them. */
630 fprintf (outfile, "\n\n");
069ad9ea 631 write_c_args (outfile, buf, argbuf, minargs, maxargs);
f2cc4248
RS
632 }
633 }
634 }
635 eof:
636 fclose (infile);
637 return 0;
638}
639\f
640/* Read a file of Lisp code, compiled or interpreted.
641 Looks for
642 (defun NAME ARGS DOCSTRING ...)
23d6b5a6 643 (defmacro NAME ARGS DOCSTRING ...)
34e778a6 644 (defsubst NAME ARGS DOCSTRING ...)
23d6b5a6 645 (autoload (quote NAME) FILE DOCSTRING ...)
f2cc4248
RS
646 (defvar NAME VALUE DOCSTRING)
647 (defconst NAME VALUE DOCSTRING)
23d6b5a6
JB
648 (fset (quote NAME) (make-byte-code ... DOCSTRING ...))
649 (fset (quote NAME) #[... DOCSTRING ...])
2d6e2619 650 (defalias (quote NAME) #[... DOCSTRING ...])
3fe77f98 651 (custom-declare-variable (quote NAME) VALUE DOCSTRING ...)
f2cc4248 652 starting in column zero.
23d6b5a6 653 (quote NAME) may appear as 'NAME as well.
b5ff43cc
RS
654
655 We also look for #@LENGTH CONTENTS^_ at the beginning of the line.
656 When we find that, we save it for the following defining-form,
657 and we use that instead of reading a doc string within that defining-form.
658
eb8c3be9 659 For defvar, defconst, and fset we skip to the docstring with a kludgy
23d6b5a6
JB
660 formatting convention: all docstrings must appear on the same line as the
661 initial open-paren (the one in column zero) and must contain a backslash
b0f08a24 662 and a newline immediately after the initial double-quote. No newlines
23d6b5a6 663 must appear between the beginning of the form and the first double-quote.
b0f08a24
DL
664 For defun, defmacro, and autoload, we know how to skip over the
665 arglist, but the doc string must still have a backslash and newline
666 immediately after the double quote.
667 The only source files that must follow this convention are preloaded
668 uncompiled ones like loaddefs.el and bindings.el; aside
23d6b5a6
JB
669 from that, it is always the .elc file that we look at, and they are no
670 problem because byte-compiler output follows this convention.
f2cc4248
RS
671 The NAME and DOCSTRING are output.
672 NAME is preceded by `F' for a function or `V' for a variable.
673 An entry is output only if DOCSTRING has \ newline just after the opening "
674 */
675
23d6b5a6
JB
676void
677skip_white (infile)
678 FILE *infile;
679{
680 char c = ' ';
433d333d 681 while (c == ' ' || c == '\t' || c == '\n' || c == '\r')
23d6b5a6
JB
682 c = getc (infile);
683 ungetc (c, infile);
684}
685
686void
687read_lisp_symbol (infile, buffer)
688 FILE *infile;
689 char *buffer;
690{
691 char c;
692 char *fillp = buffer;
693
694 skip_white (infile);
695 while (1)
696 {
697 c = getc (infile);
698 if (c == '\\')
699 *(++fillp) = getc (infile);
433d333d 700 else if (c == ' ' || c == '\t' || c == '\n' || c == '\r' || c == '(' || c == ')')
23d6b5a6
JB
701 {
702 ungetc (c, infile);
703 *fillp = 0;
704 break;
705 }
706 else
707 *fillp++ = c;
708 }
709
710 if (! buffer[0])
711 fprintf (stderr, "## expected a symbol, got '%c'\n", c);
712
713 skip_white (infile);
714}
715
340ff9de 716int
e3938952
RS
717scan_lisp_file (filename, mode)
718 char *filename, *mode;
f2cc4248
RS
719{
720 FILE *infile;
721 register int c;
b5ff43cc 722 char *saved_string = 0;
f2cc4248 723
e3938952 724 infile = fopen (filename, mode);
f2cc4248
RS
725 if (infile == NULL)
726 {
727 perror (filename);
728 return 0; /* No error */
729 }
730
731 c = '\n';
732 while (!feof (infile))
733 {
b5ff43cc 734 char buffer[BUFSIZ];
23d6b5a6
JB
735 char type;
736
66f54605 737 /* If not at end of line, skip till we get to one. */
433d333d 738 if (c != '\n' && c != '\r')
f2cc4248
RS
739 {
740 c = getc (infile);
741 continue;
742 }
66f54605 743 /* Skip the line break. */
7e6972e9 744 while (c == '\n' || c == '\r')
66f54605 745 c = getc (infile);
b5ff43cc
RS
746 /* Detect a dynamic doc string and save it for the next expression. */
747 if (c == '#')
748 {
749 c = getc (infile);
750 if (c == '@')
751 {
752 int length = 0;
753 int i;
754
755 /* Read the length. */
756 while ((c = getc (infile),
757 c >= '0' && c <= '9'))
758 {
759 length *= 10;
760 length += c - '0';
761 }
762
763 /* The next character is a space that is counted in the length
764 but not part of the doc string.
765 We already read it, so just ignore it. */
766 length--;
767
768 /* Read in the contents. */
769 if (saved_string != 0)
770 free (saved_string);
771 saved_string = (char *) malloc (length);
772 for (i = 0; i < length; i++)
773 saved_string[i] = getc (infile);
774 /* The last character is a ^_.
775 That is needed in the .elc file
776 but it is redundant in DOC. So get rid of it here. */
777 saved_string[length - 1] = 0;
66f54605
PR
778 /* Skip the line break. */
779 while (c == '\n' && c == '\r')
780 c = getc (infile);
781 /* Skip the following line. */
433d333d 782 while (c != '\n' && c != '\r')
b5ff43cc
RS
783 c = getc (infile);
784 }
785 continue;
786 }
787
f2cc4248
RS
788 if (c != '(')
789 continue;
a8a7afbe 790
23d6b5a6
JB
791 read_lisp_symbol (infile, buffer);
792
66f54605 793 if (! strcmp (buffer, "defun")
34e778a6
AS
794 || ! strcmp (buffer, "defmacro")
795 || ! strcmp (buffer, "defsubst"))
f2cc4248 796 {
23d6b5a6
JB
797 type = 'F';
798 read_lisp_symbol (infile, buffer);
f2cc4248 799
23d6b5a6 800 /* Skip the arguments: either "nil" or a list in parens */
f2cc4248 801
23d6b5a6
JB
802 c = getc (infile);
803 if (c == 'n') /* nil */
f2cc4248 804 {
66f54605
PR
805 if ((c = getc (infile)) != 'i'
806 || (c = getc (infile)) != 'l')
23d6b5a6
JB
807 {
808 fprintf (stderr, "## unparsable arglist in %s (%s)\n",
809 buffer, filename);
810 continue;
811 }
f2cc4248 812 }
23d6b5a6 813 else if (c != '(')
f2cc4248 814 {
23d6b5a6
JB
815 fprintf (stderr, "## unparsable arglist in %s (%s)\n",
816 buffer, filename);
817 continue;
f2cc4248 818 }
23d6b5a6
JB
819 else
820 while (c != ')')
f2cc4248 821 c = getc (infile);
23d6b5a6
JB
822 skip_white (infile);
823
824 /* If the next three characters aren't `dquote bslash newline'
825 then we're not reading a docstring.
826 */
66f54605
PR
827 if ((c = getc (infile)) != '"'
828 || (c = getc (infile)) != '\\'
829 || ((c = getc (infile)) != '\n' && c != '\r'))
f2cc4248 830 {
23d6b5a6
JB
831#ifdef DEBUG
832 fprintf (stderr, "## non-docstring in %s (%s)\n",
833 buffer, filename);
834#endif
835 continue;
f2cc4248 836 }
f2cc4248 837 }
a8a7afbe 838
66f54605
PR
839 else if (! strcmp (buffer, "defvar")
840 || ! strcmp (buffer, "defconst"))
f2cc4248 841 {
23d6b5a6
JB
842 char c1 = 0, c2 = 0;
843 type = 'V';
844 read_lisp_symbol (infile, buffer);
a8a7afbe 845
b5ff43cc 846 if (saved_string == 0)
f2cc4248 847 {
b5ff43cc 848
66f54605 849 /* Skip until the end of line; remember two previous chars. */
433d333d 850 while (c != '\n' && c != '\r' && c >= 0)
b5ff43cc
RS
851 {
852 c2 = c1;
853 c1 = c;
854 c = getc (infile);
855 }
23d6b5a6 856
b5ff43cc
RS
857 /* If two previous characters were " and \,
858 this is a doc string. Otherwise, there is none. */
859 if (c2 != '"' || c1 != '\\')
860 {
23d6b5a6 861#ifdef DEBUG
b5ff43cc
RS
862 fprintf (stderr, "## non-docstring in %s (%s)\n",
863 buffer, filename);
23d6b5a6 864#endif
b5ff43cc
RS
865 continue;
866 }
f2cc4248 867 }
23d6b5a6
JB
868 }
869
3fe77f98
RS
870 else if (! strcmp (buffer, "custom-declare-variable"))
871 {
872 char c1 = 0, c2 = 0;
873 type = 'V';
874
875 c = getc (infile);
876 if (c == '\'')
877 read_lisp_symbol (infile, buffer);
878 else
879 {
880 if (c != '(')
881 {
882 fprintf (stderr,
883 "## unparsable name in custom-declare-variable in %s\n",
884 filename);
885 continue;
886 }
887 read_lisp_symbol (infile, buffer);
888 if (strcmp (buffer, "quote"))
889 {
890 fprintf (stderr,
891 "## unparsable name in custom-declare-variable in %s\n",
892 filename);
893 continue;
894 }
895 read_lisp_symbol (infile, buffer);
896 c = getc (infile);
897 if (c != ')')
898 {
899 fprintf (stderr,
900 "## unparsable quoted name in custom-declare-variable in %s\n",
901 filename);
902 continue;
903 }
904 }
905
906 if (saved_string == 0)
907 {
66f54605 908 /* Skip to end of line; remember the two previous chars. */
433d333d 909 while (c != '\n' && c != '\r' && c >= 0)
3fe77f98
RS
910 {
911 c2 = c1;
912 c1 = c;
913 c = getc (infile);
914 }
915
916 /* If two previous characters were " and \,
917 this is a doc string. Otherwise, there is none. */
918 if (c2 != '"' || c1 != '\\')
919 {
920#ifdef DEBUG
921 fprintf (stderr, "## non-docstring in %s (%s)\n",
922 buffer, filename);
923#endif
924 continue;
925 }
926 }
927 }
928
2d6e2619 929 else if (! strcmp (buffer, "fset") || ! strcmp (buffer, "defalias"))
23d6b5a6
JB
930 {
931 char c1 = 0, c2 = 0;
932 type = 'F';
a8a7afbe 933
23d6b5a6
JB
934 c = getc (infile);
935 if (c == '\'')
936 read_lisp_symbol (infile, buffer);
937 else
f2cc4248 938 {
23d6b5a6
JB
939 if (c != '(')
940 {
941 fprintf (stderr, "## unparsable name in fset in %s\n",
942 filename);
943 continue;
944 }
945 read_lisp_symbol (infile, buffer);
946 if (strcmp (buffer, "quote"))
947 {
948 fprintf (stderr, "## unparsable name in fset in %s\n",
949 filename);
950 continue;
951 }
952 read_lisp_symbol (infile, buffer);
f2cc4248 953 c = getc (infile);
23d6b5a6
JB
954 if (c != ')')
955 {
956 fprintf (stderr,
957 "## unparsable quoted name in fset in %s\n",
958 filename);
959 continue;
960 }
f2cc4248 961 }
f2cc4248 962
b5ff43cc 963 if (saved_string == 0)
f2cc4248 964 {
66f54605 965 /* Skip to end of line; remember the two previous chars. */
433d333d 966 while (c != '\n' && c != '\r' && c >= 0)
b5ff43cc
RS
967 {
968 c2 = c1;
969 c1 = c;
970 c = getc (infile);
971 }
23d6b5a6 972
b5ff43cc
RS
973 /* If two previous characters were " and \,
974 this is a doc string. Otherwise, there is none. */
975 if (c2 != '"' || c1 != '\\')
976 {
23d6b5a6 977#ifdef DEBUG
b5ff43cc
RS
978 fprintf (stderr, "## non-docstring in %s (%s)\n",
979 buffer, filename);
23d6b5a6 980#endif
b5ff43cc
RS
981 continue;
982 }
23d6b5a6
JB
983 }
984 }
f2cc4248 985
23d6b5a6
JB
986 else if (! strcmp (buffer, "autoload"))
987 {
988 type = 'F';
989 c = getc (infile);
990 if (c == '\'')
991 read_lisp_symbol (infile, buffer);
992 else
f2cc4248 993 {
23d6b5a6 994 if (c != '(')
f2cc4248 995 {
23d6b5a6
JB
996 fprintf (stderr, "## unparsable name in autoload in %s\n",
997 filename);
998 continue;
f2cc4248 999 }
23d6b5a6
JB
1000 read_lisp_symbol (infile, buffer);
1001 if (strcmp (buffer, "quote"))
f2cc4248 1002 {
23d6b5a6
JB
1003 fprintf (stderr, "## unparsable name in autoload in %s\n",
1004 filename);
1005 continue;
f2cc4248 1006 }
23d6b5a6 1007 read_lisp_symbol (infile, buffer);
f2cc4248 1008 c = getc (infile);
23d6b5a6 1009 if (c != ')')
f2cc4248 1010 {
23d6b5a6
JB
1011 fprintf (stderr,
1012 "## unparsable quoted name in autoload in %s\n",
1013 filename);
1014 continue;
f2cc4248 1015 }
23d6b5a6
JB
1016 }
1017 skip_white (infile);
1018 if ((c = getc (infile)) != '\"')
1019 {
1020 fprintf (stderr, "## autoload of %s unparsable (%s)\n",
1021 buffer, filename);
f2cc4248
RS
1022 continue;
1023 }
74c55c82 1024 read_c_string_or_comment (infile, 0, 0);
23d6b5a6
JB
1025 skip_white (infile);
1026
b5ff43cc 1027 if (saved_string == 0)
a8a7afbe 1028 {
b5ff43cc
RS
1029 /* If the next three characters aren't `dquote bslash newline'
1030 then we're not reading a docstring. */
66f54605
PR
1031 if ((c = getc (infile)) != '"'
1032 || (c = getc (infile)) != '\\'
1033 || ((c = getc (infile)) != '\n' && c != '\r'))
b5ff43cc 1034 {
23d6b5a6 1035#ifdef DEBUG
b5ff43cc
RS
1036 fprintf (stderr, "## non-docstring in %s (%s)\n",
1037 buffer, filename);
23d6b5a6 1038#endif
b5ff43cc
RS
1039 continue;
1040 }
a8a7afbe 1041 }
a8a7afbe 1042 }
f2cc4248 1043
23d6b5a6 1044#ifdef DEBUG
66f54605
PR
1045 else if (! strcmp (buffer, "if")
1046 || ! strcmp (buffer, "byte-code"))
23d6b5a6
JB
1047 ;
1048#endif
f2cc4248 1049
23d6b5a6
JB
1050 else
1051 {
1052#ifdef DEBUG
1053 fprintf (stderr, "## unrecognised top-level form, %s (%s)\n",
1054 buffer, filename);
1055#endif
1056 continue;
1057 }
f2cc4248 1058
b5ff43cc
RS
1059 /* At this point, we should either use the previous
1060 dynamic doc string in saved_string
1061 or gobble a doc string from the input file.
1062
1063 In the latter case, the opening quote (and leading
1064 backslash-newline) have already been read. */
1065
f2cc4248 1066 putc (037, outfile);
23d6b5a6
JB
1067 putc (type, outfile);
1068 fprintf (outfile, "%s\n", buffer);
b5ff43cc
RS
1069 if (saved_string)
1070 {
1071 fputs (saved_string, outfile);
1072 /* Don't use one dynamic doc string twice. */
1073 free (saved_string);
1074 saved_string = 0;
1075 }
1076 else
74c55c82 1077 read_c_string_or_comment (infile, 1, 0);
f2cc4248
RS
1078 }
1079 fclose (infile);
1080 return 0;
1081}