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