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