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