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