comparison lib-src/make-docfile.c @ 930:eaedf30d9d76

[xemacs-hg @ 2002-07-23 08:34:59 by youngs] 2002-07-15 Jerry James <james@xemacs.org> * make-docfile.c: Change whitespace and organization to reduce the size of the diff against FSF Emacs sources and synch to Emacs 21.2. Remove unused DO_REALLOC. Mark XEmacs changes and additions more clearly. Reintroduce previously deleted Emacs code inside #if 0 ... #endif. * make-docfile.c (next_extra_elc): Replace goto with do-while. * make-docfile.c (main): Put XEmacs-only args in one place. * make-docfile.c (write_c_args): Change buff to buf to match Emacs. Replace pointer arithmetic with simpler array syntax. * make-docfile.c (scan_c_file): Note that DEFSIMPLE and DEFPRED no longer exist. Correct the "name too long" test (off by one). Die with message if a DEFUN has no docstring instead of hanging. * make-docfile.c (scan_lisp_file): Introduce while loops used in Emacs sources to skip consecutive blank lines. 2002-07-21 John Paul Wallington <jpw@xemacs.org> * process.el (substitute-env-vars): New function; sync with GNU Emacs 21.1.50. (setenv): Add optional arg SUBSTITUTE-ENV-VARS; sync with GNU Emacs 21.1.50. 2002-07-20 Mike Sperber <mike@xemacs.org> * eval.c (run_post_gc_hook): Use more correct flags when running post-gc-hook. 2002-07-20 Mike Sperber <mike@xemacs.org> * process-unix.c (child_setup): Don't try to close file descriptors for chid process once again---it's already being done in close_process_descs. (unix_create_process): Call begin_dont_check_for_quit to inhibit unwanted interaction (and thus breaking of X event synchronicity) in the child. 2002-07-15 Jerry James <james@xemacs.org> * lisp.h: Make Qdll_error visible globally. * symbols.c (check_sane_subr): Revert 2002-06-26 change. Check only if !initialized. * symbols.c (check_module_subr): Add parameter. Duplicate check_sane_subr checks, but signal an error instead of asserting. * symbols.c (defsubr): Use check_module_subr parameter. * symbols.c (defsubr_macro): Ditto.
author youngs
date Tue, 23 Jul 2002 08:35:11 +0000
parents 2b6fa2618f76
children 184461bc8de4
comparison
equal deleted inserted replaced
929:0c272be3414c 930:eaedf30d9d76
1 /* Generate doc-string file for XEmacs from source files. 1 /* Generate doc-string file for XEmacs from source files.
2 Copyright (C) 1985, 1986, 1992, 1993, 1994 Free Software Foundation, Inc. 2 Copyright (C) 1985, 86, 92, 93, 94, 97, 1999, 2000, 2001
3 Free Software Foundation, Inc.
3 Copyright (C) 1995 Board of Trustees, University of Illinois. 4 Copyright (C) 1995 Board of Trustees, University of Illinois.
4 Copyright (C) 1998, 1999 J. Kean Johnston. 5 Copyright (C) 1998, 1999 J. Kean Johnston.
5 Copyright (C) 2001, 2002 Ben Wing. 6 Copyright (C) 2001, 2002 Ben Wing.
6 7
7 This file is part of XEmacs. 8 This file is part of XEmacs.
8 9
9 XEmacs is free software; you can redistribute it and/or modify it 10 XEmacs is free software; you can redistribute it and/or modify
10 under the terms of the GNU General Public License as published by the 11 it under the terms of the GNU General Public License as published by
11 Free Software Foundation; either version 2, or (at your option) any 12 the Free Software Foundation; either version 2, or (at your option)
12 later version. 13 any later version.
13 14
14 XEmacs is distributed in the hope that it will be useful, but WITHOUT 15 XEmacs is distributed in the hope that it will be useful,
15 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 16 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License 17 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 for more details. 18 GNU General Public License for more details.
18 19
19 You should have received a copy of the GNU General Public License 20 You should have received a copy of the GNU General Public License
20 along with XEmacs; see the file COPYING. If not, write to 21 along with XEmacs; see the file COPYING. If not, write to
21 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, 22 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 Boston, MA 02111-1307, USA. */ 23 Boston, MA 02111-1307, USA. */
23 24
24 /* Synched up with: FSF 19.30. */ 25 /* Synched up with: FSF 21.2. */
25 26
26 /* The arguments given to this program are all the C and Lisp source files 27 /* The arguments given to this program are all the C and Lisp source files
27 of XEmacs. .elc and .el and .c files are allowed. 28 of XEmacs. .elc and .el and .c files are allowed.
28 A .o or .obj file can also be specified; the .c file it was made from is 29 A .o or .obj file can also be specified; the .c file it was made from is used.
29 used. This helps the makefile pass the correct list of files. 30 This helps the makefile pass the correct list of files.
30 31
31 The results, which go to standard output or to a file 32 The results, which go to standard output or to a file
32 specified with -a or -o (-a to append, -o to start from nothing), 33 specified with -a or -o (-a to append, -o to start from nothing),
33 are entries containing function or variable names and their documentation. 34 are entries containing function or variable names and their documentation.
34 Each entry starts with a ^_ character. 35 Each entry starts with a ^_ character.
35 Then comes F for a function or V for a variable. 36 Then comes F for a function or V for a variable.
36 Then comes the function or variable name, terminated with a newline. 37 Then comes the function or variable name, terminated with a newline.
37 Then comes the documentation for that function or variable. 38 Then comes the documentation for that function or variable.
38 39
39 Added 19.15/20.1: `-i site-packages' allow installer to dump extra packages 40 Added 19.15/20.1: `-i site-packages' allow installer to dump extra packages
40 without modifying Makefiles, etc. 41 without modifying Makefiles, etc.
41 */ 42 */
42 43
43 #include <config.h> 44 #include <config.h>
45 #include <sysfile.h>
44 46
45 #include <stdio.h> 47 #include <stdio.h>
46 #include <stdlib.h> 48 #include <stdlib.h>
47 #include <string.h> 49 #include <string.h>
48 #include <ctype.h> 50 #include <ctype.h>
49 51
50 #include "../src/sysfile.h" 52 /* XEmacs addition */
51 53 #define C_IDENTIFIER_CHAR_P(c) \
52 /* From src/lisp.h */ 54 (('A' <= c && c <= 'Z') || \
53 #define DO_REALLOC(basevar, sizevar, needed_size, type) do { \ 55 ('a' <= c && c <= 'z') || \
54 size_t do_realloc_needed_size = (needed_size); \ 56 ('0' <= c && c <= '9') || \
55 if ((sizevar) < do_realloc_needed_size) \ 57 (c == '_'))
56 { \
57 if ((sizevar) < 32) \
58 (sizevar) = 32; \
59 while ((sizevar) < do_realloc_needed_size) \
60 (sizevar) *= 2; \
61 XREALLOC_ARRAY (basevar, type, (sizevar)); \
62 } \
63 } while (0)
64
65 /* Stdio stream for output to the DOC file. */
66 static FILE *outfile;
67
68 enum
69 {
70 el_file,
71 elc_file,
72 c_file
73 } Current_file_type;
74 58
75 static int scan_file (const char *filename); 59 static int scan_file (const char *filename);
76 static int read_c_string (FILE *, int, int); 60 static int read_c_string (FILE *, int, int);
77 static void write_c_args (FILE *out, const char *func, char *buf, int minargs, 61 static void write_c_args (FILE *out, const char *func, char *buf, int minargs,
78 int maxargs); 62 int maxargs);
79 static int scan_c_file (const char *filename, const char *mode); 63 static int scan_c_file (const char *filename, const char *mode);
80 static void skip_white (FILE *); 64 static void skip_white (FILE *);
81 static void read_lisp_symbol (FILE *, char *); 65 static void read_lisp_symbol (FILE *, char *);
82 static int scan_lisp_file (const char *filename, const char *mode); 66 static int scan_lisp_file (const char *filename, const char *mode);
83 67
84 #define C_IDENTIFIER_CHAR_P(c) \ 68 /* Stdio stream for output to the DOC file. */
85 (('A' <= c && c <= 'Z') || \ 69 static FILE *outfile;
86 ('a' <= c && c <= 'z') || \ 70
87 ('0' <= c && c <= '9') || \ 71 /* XEmacs addition */
88 (c == '_')) 72 enum
73 {
74 el_file,
75 elc_file,
76 c_file
77 } Current_file_type;
89 78
90 /* Name this program was invoked with. */ 79 /* Name this program was invoked with. */
91 char *progname; 80 char *progname;
92 81
93 /* Set to 1 if this was invoked by ellcc */ 82 /* XEmacs addition: set to 1 if this was invoked by ellcc */
94 int ellcc = 0; 83 int ellcc = 0;
95 84
96 /* Print error message. `s1' is printf control string, `s2' is arg for it. */ 85 /* Print error message. `s1' is printf control string, `s2' is arg for it. */
97 86
98 static void 87 static void
121 if (result == NULL) 110 if (result == NULL)
122 fatal ("virtual memory exhausted", 0); 111 fatal ("virtual memory exhausted", 0);
123 return result; 112 return result;
124 } 113 }
125 114
115 /* XEmacs addition */
126 static char * 116 static char *
127 next_extra_elc (char *extra_elcs) 117 next_extra_elc (char *extra_elcs)
128 { 118 {
129 static FILE *fp = NULL; 119 static FILE *fp = NULL;
130 static char line_buf[BUFSIZ]; 120 static char line_buf[BUFSIZ];
141 return NULL; 131 return NULL;
142 } 132 }
143 fgets (line_buf, BUFSIZ, fp); 133 fgets (line_buf, BUFSIZ, fp);
144 } 134 }
145 135
146 again: 136 do
147 if (!fgets (line_buf, BUFSIZ, fp)) 137 {
148 { 138 if (!fgets (line_buf, BUFSIZ, fp))
149 fclose (fp); 139 {
150 fp = NULL; 140 fclose (fp);
151 return NULL; 141 fp = NULL;
152 } 142 return NULL;
153 line_buf[0] = '\0'; 143 }
154 if (strlen (p) <= 2 || strlen (p) >= (BUFSIZ - 5)) 144 line_buf[0] = '\0';
155 {
156 /* reject too short or too long lines */ 145 /* reject too short or too long lines */
157 goto again; 146 } while (strlen (p) <= 2 || strlen (p) >= (BUFSIZ - 5));
158 } 147
159 p[strlen (p) - 2] = '\0'; 148 p[strlen (p) - 2] = '\0';
160 strcat (p, ".elc"); 149 strcat (p, ".elc");
161 150
162 return p; 151 return p;
163 } 152 }
167 main (int argc, char **argv) 156 main (int argc, char **argv)
168 { 157 {
169 int i; 158 int i;
170 int err_count = 0; 159 int err_count = 0;
171 int first_infile; 160 int first_infile;
172 char *extra_elcs = NULL; 161 char *extra_elcs = NULL; /* XEmacs addition */
173 162
174 progname = argv[0]; 163 progname = argv[0];
175 164
176 outfile = stdout; 165 outfile = stdout;
177 166
191 if (argc > i + 1 && !strcmp (argv[i], "-a")) 180 if (argc > i + 1 && !strcmp (argv[i], "-a"))
192 { 181 {
193 outfile = fopen (argv[i + 1], APPEND_BINARY); 182 outfile = fopen (argv[i + 1], APPEND_BINARY);
194 i += 2; 183 i += 2;
195 } 184 }
185 if (argc > i + 1 && !strcmp (argv[i], "-d"))
186 {
187 chdir (argv[i + 1]);
188 i += 2;
189 }
190
191 /* Additional command line arguments for XEmacs */
196 if (argc > i + 1 && !strcmp (argv[i], "-E")) 192 if (argc > i + 1 && !strcmp (argv[i], "-E"))
197 { 193 {
198 outfile = fopen (argv[i + 1], APPEND_BINARY); 194 outfile = fopen (argv[i + 1], APPEND_BINARY);
199 i += 2; 195 i += 2;
200 ellcc = 1; 196 ellcc = 1;
201 } 197 }
202 if (argc > i + 1 && !strcmp (argv[i], "-d"))
203 {
204 chdir (argv[i + 1]);
205 i += 2;
206 }
207
208 if (argc > (i + 1) && !strcmp (argv[i], "-i")) 198 if (argc > (i + 1) && !strcmp (argv[i], "-i"))
209 { 199 {
210 extra_elcs = argv[i + 1]; 200 extra_elcs = argv[i + 1];
211 i += 2; 201 i += 2;
212 } 202 }
213 203
214 if (outfile == 0) 204 if (outfile == 0)
215 fatal ("No output file specified", ""); 205 fatal ("No output file specified", "");
216 206
207 /* XEmacs addition */
217 if (ellcc) 208 if (ellcc)
218 fprintf (outfile, "{\n"); 209 fprintf (outfile, "{\n");
219 210
220 first_infile = i; 211 first_infile = i;
221
222 for (; i < argc; i++) 212 for (; i < argc; i++)
223 { 213 {
214 /* XEmacs addition: the "if" clause is new; the "else" clause is the
215 original FSF Emacs code */
224 if (argv[i][0] == '@') 216 if (argv[i][0] == '@')
225 { 217 {
226 /* Allow a file containing files to process, for use w/MS Windows 218 /* Allow a file containing files to process, for use w/MS Windows
227 (where command-line length limits are more problematic) */ 219 (where command-line length limits are more problematic) */
228 FILE *argfile = fopen (argv[i] + 1, READ_TEXT); 220 FILE *argfile = fopen (argv[i] + 1, READ_TEXT);
238 } 230 }
239 } 231 }
240 else 232 else
241 { 233 {
242 int j; 234 int j;
243
244 /* Don't process one file twice. */ 235 /* Don't process one file twice. */
245 for (j = first_infile; j < i; j++) 236 for (j = first_infile; j < i; j++)
246 if (! strcmp (argv[i], argv[j])) 237 if (! strcmp (argv[i], argv[j]))
247 break; 238 break;
248 if (j == i) 239 if (j == i)
249 /* err_count seems to be {mis,un}used */
250 err_count += scan_file (argv[i]); 240 err_count += scan_file (argv[i]);
251 } 241 }
252 } 242 }
253 243
244 /* XEmacs addition */
254 if (extra_elcs) 245 if (extra_elcs)
255 { 246 {
256 char *p; 247 char *p;
257 248
258 while ((p = next_extra_elc (extra_elcs)) != NULL) 249 while ((p = next_extra_elc (extra_elcs)) != NULL)
260 } 251 }
261 252
262 putc ('\n', outfile); 253 putc ('\n', outfile);
263 if (ellcc) 254 if (ellcc)
264 fprintf (outfile, "}\n\n"); 255 fprintf (outfile, "}\n\n");
256 /* End XEmacs addition */
257
265 #ifndef VMS 258 #ifndef VMS
266 exit (err_count > 0); 259 exit (err_count > 0);
267 #endif /* VMS */ 260 #endif /* VMS */
268 return err_count > 0; 261 return err_count > 0;
269 } 262 }
273 266
274 static int 267 static int
275 scan_file (const char *filename) 268 scan_file (const char *filename)
276 { 269 {
277 int len = strlen (filename); 270 int len = strlen (filename);
271
272 /* XEmacs change: test ellcc and set Current_file_type in each case */
278 if (ellcc == 0 && len > 4 && !strcmp (filename + len - 4, ".elc")) 273 if (ellcc == 0 && len > 4 && !strcmp (filename + len - 4, ".elc"))
279 { 274 {
280 Current_file_type = elc_file; 275 Current_file_type = elc_file;
281 return scan_lisp_file (filename, READ_BINARY); 276 return scan_lisp_file (filename, READ_BINARY);
282 } 277 }
289 { 284 {
290 Current_file_type = c_file; 285 Current_file_type = c_file;
291 return scan_c_file (filename, READ_TEXT); 286 return scan_c_file (filename, READ_TEXT);
292 } 287 }
293 } 288 }
294 289
290 /* XEmacs addition: ISO 2022 handling */
295 static int 291 static int
296 getc_skipping_iso2022 (FILE *file) 292 getc_skipping_iso2022 (FILE *file)
297 { 293 {
298 register int c; 294 register int c;
299 /* #### Kludge -- Ignore any ISO2022 sequences */ 295 /* #### Kludge -- Ignore any ISO2022 sequences */
378 374
379 375
380 char buf[128]; 376 char buf[128];
381 377
382 /* Skip a C string from INFILE, 378 /* Skip a C string from INFILE,
383 and return the character that follows the closing ". 379 and return the character that follows the closing ".
384 If printflag is positive, output string contents to outfile. 380 If printflag is positive, output string contents to outfile.
385 If it is negative, store contents in buf. 381 If it is negative, store contents in buf.
386 Convert escape sequences \n and \t to newline and tab; 382 Convert escape sequences \n and \t to newline and tab;
387 discard \ followed by newline. */ 383 discard \ followed by newline. */
388 384
390 static int 386 static int
391 read_c_string (FILE *infile, int printflag, int c_docstring) 387 read_c_string (FILE *infile, int printflag, int c_docstring)
392 { 388 {
393 register int prevc = 0, c = 0; 389 register int prevc = 0, c = 0;
394 char *p = buf; 390 char *p = buf;
395 int start = -1; 391 int start = -1; /* XEmacs addition */
396 392
397 MDGET; 393 MDGET;
398 while (c != EOF) 394 while (c != EOF)
399 { 395 {
400 while ((c_docstring || c != '"' || non_ascii_p) && c != EOF) 396 while ((c_docstring || c != '"' || non_ascii_p) && c != EOF)
401 { 397 {
398 /* XEmacs addition: the first two "if" clauses are new */
402 if (c == '*' && !non_ascii_p) 399 if (c == '*' && !non_ascii_p)
403 { 400 {
404 int cc = getc (infile); 401 int cc = getc (infile);
405 if (cc == '/') 402 if (cc == '/')
406 { 403 {
430 putc ('\n', outfile); 427 putc ('\n', outfile);
431 } 428 }
432 else if (printflag < 0) 429 else if (printflag < 0)
433 *p++ = '\n'; 430 *p++ = '\n';
434 } 431 }
432 /* End XEmacs addition */
435 433
436 if (c == '\\' && !non_ascii_p) 434 if (c == '\\' && !non_ascii_p)
437 { 435 {
438 MDGET; 436 MDGET;
439 if (c == '\n') 437 if (c == '\n')
445 if (!c_docstring && c == 'n') 443 if (!c_docstring && c == 'n')
446 c = '\n'; 444 c = '\n';
447 if (c == 't') 445 if (c == 't')
448 c = '\t'; 446 c = '\t';
449 } 447 }
448
449 /* XEmacs change: the "if" clause is new; the "else" clause is
450 mostly the original FSF Emacs code */
450 if (c == '\n') 451 if (c == '\n')
451 start = 1; 452 start = 1;
452 else 453 else
453 { 454 {
454 start = 0; 455 start = 0;
461 else if (printflag < 0) 462 else if (printflag < 0)
462 *p++ = c; 463 *p++ = c;
463 } 464 }
464 MDGET; 465 MDGET;
465 } 466 }
466 /* look for continuation of string */ 467 /* XEmacs change: look for continuation of string */
467 if (Current_file_type == c_file) 468 if (Current_file_type == c_file)
468 { 469 {
469 do 470 do
470 { 471 {
471 MDGET; 472 MDGET;
481 break; 482 break;
482 /* If we had a "", concatenate the two strings. */ 483 /* If we had a "", concatenate the two strings. */
483 } 484 }
484 MDGET; 485 MDGET;
485 } 486 }
486 487
487 if (printflag < 0) 488 if (printflag < 0)
488 *p = 0; 489 *p = 0;
489 490
490 return c; 491 return c;
491 } 492 }
492 493
493 /* Write to file OUT the argument names of function FUNC, whose text is in BUF. 494 /* Write to file OUT the argument names of function FUNC, whose text is in BUF.
494 MINARGS and MAXARGS are the minimum and maximum number of arguments. */ 495 MINARGS and MAXARGS are the minimum and maximum number of arguments. */
495 496
496 static void 497 static void
497 write_c_args (FILE *out, const char *func, char *buff, int minargs, 498 write_c_args (FILE *out, const char *func, char *buf, int minargs, int maxargs)
498 int maxargs)
499 { 499 {
500 register char *p; 500 register char *p;
501 int in_ident = 0; 501 int in_ident = 0;
502 int just_spaced = 0; 502 int just_spaced = 0;
503 #if 0 503 #if 0
512 anything is asking for trouble because it's not uncommon to have an 512 anything is asking for trouble because it's not uncommon to have an
513 unescaped parenthesis at the beginning of a line. --Stig */ 513 unescaped parenthesis at the beginning of a line. --Stig */
514 fprintf (out, "arguments: ("); 514 fprintf (out, "arguments: (");
515 #endif 515 #endif
516 516
517 if (*buff == '(') 517 if (*buf == '(')
518 ++buff; 518 ++buf;
519 519
520 for (p = buff; *p; p++) 520 for (p = buf; *p; p++)
521 { 521 {
522 char c = *p; 522 char c = *p;
523 int ident_start = 0; 523 int ident_start = 0;
524 524
525 /* Add support for ANSI prototypes. Hop over 525 /* XEmacs addition: add support for ANSI prototypes. Hop over
526 "Lisp_Object" string (the only C type allowed in DEFUNs) */ 526 "Lisp_Object" string (the only C type allowed in DEFUNs) */
527 static char lo[] = "Lisp_Object"; 527 static char lo[] = "Lisp_Object";
528 if ((C_IDENTIFIER_CHAR_P (c) != in_ident) && !in_ident && 528 if ((C_IDENTIFIER_CHAR_P (c) != in_ident) && !in_ident &&
529 (strncmp (p, lo, sizeof (lo) - 1) == 0) && 529 (strncmp (p, lo, sizeof (lo) - 1) == 0) &&
530 isspace ((unsigned char) (* (p + sizeof (lo) - 1)))) 530 isspace ((unsigned char) p[sizeof (lo) - 1]))
531 { 531 {
532 p += (sizeof (lo) - 1); 532 p += (sizeof (lo) - 1);
533 while (isspace ((unsigned char) (*p))) 533 while (isspace ((unsigned char) (*p)))
534 p++; 534 p++;
535 c = *p; 535 c = *p;
557 else 557 else
558 in_ident = 0; 558 in_ident = 0;
559 } 559 }
560 560
561 /* Print the C argument list as it would appear in lisp: 561 /* Print the C argument list as it would appear in lisp:
562 print underscores as hyphens, and print commas as spaces. 562 print underscores as hyphens, and print commas and newlines
563 Collapse adjacent spaces into one. */ 563 as spaces. Collapse adjacent spaces into one. */
564 if (c == '_') c = '-'; 564 if (c == '_')
565 if (c == ',') c = ' '; 565 c = '-';
566 566 else if (c == ',' || c == '\n')
567 c = ' ';
568
569 #if 0
570 /* In C code, `default' is a reserved word, so we spell it
571 `defalt'; unmangle that here. */
572 if (ident_start
573 && strncmp (p, "defalt", 6) == 0
574 && ! (('A' <= p[6] && p[6] <= 'Z')
575 || ('a' <= p[6] && p[6] <= 'z')
576 || ('0' <= p[6] && p[6] <= '9')
577 || p[6] == '_'))
578 {
579 fprintf (out, "DEFAULT");
580 p += 5;
581 in_ident = 0;
582 just_spaced = 0;
583 }
584 #endif
567 /* If the C argument name ends with `_', change it to ' ', 585 /* If the C argument name ends with `_', change it to ' ',
568 to allow use of C reserved words or global symbols as Lisp args. */ 586 to allow use of C reserved words or global symbols as Lisp args. */
569 if (c == '-' && ! C_IDENTIFIER_CHAR_P (p[1])) 587 if (c == '-' && ! C_IDENTIFIER_CHAR_P (p[1]))
570 { 588 {
571 in_ident = 0; 589 in_ident = 0;
572 just_spaced = 0; 590 just_spaced = 0;
573 } 591 }
574 else if (c != ' ' || ! just_spaced) 592 else if (c != ' ' || !just_spaced)
575 { 593 {
576 if (c >= 'a' && c <= 'z') 594 if (c >= 'a' && c <= 'z')
577 /* Upcase the letter. */ 595 /* Upcase the letter. */
578 c += 'A' - 'a'; 596 c += 'A' - 'a';
579 putc (c, out); 597 putc (c, out);
582 just_spaced = (c == ' '); 600 just_spaced = (c == ' ');
583 #if 0 601 #if 0
584 need_space = 0; 602 need_space = 0;
585 #endif 603 #endif
586 } 604 }
605 /* XEmacs addition */
587 if (!ellcc) 606 if (!ellcc)
588 putc ('\n', out); /* XEmacs addition */ 607 putc ('\n', out);
589 } 608 }
590 609
591 /* Read through a c file. If a .o or .obj file is named, 610 /* Read through a c file. If a .o or .obj file is named,
592 the corresponding .c file is read instead. 611 the corresponding .c file is read instead.
593 Looks for DEFUN constructs such as are defined in ../src/lisp.h. 612 Looks for DEFUN constructs such as are defined in ../src/lisp.h.
594 Accepts any word starting DEF... so it finds DEFSIMPLE and DEFPRED. */ 613 Accepts any word starting DEF... so it finds DEFSIMPLE and DEFPRED ...
614 which don't exist anymore! */
595 615
596 static int 616 static int
597 scan_c_file (const char *filename, const char *mode) 617 scan_c_file (const char *filename, const char *mode)
598 { 618 {
599 FILE *infile; 619 FILE *infile;
604 register int defvarflag; 624 register int defvarflag;
605 int minargs, maxargs; 625 int minargs, maxargs;
606 int l = strlen (filename); 626 int l = strlen (filename);
607 char f[PATH_MAX]; 627 char f[PATH_MAX];
608 628
609 if (l > (int) sizeof (f)) 629 /* XEmacs change: different method for checking filename extension */
630 if (l > PATH_MAX - 1)
610 { 631 {
611 #ifdef ENAMETOOLONG 632 #ifdef ENAMETOOLONG
612 errno = ENAMETOOLONG; 633 errno = ENAMETOOLONG;
613 #else 634 #else
614 errno = EINVAL; 635 errno = EINVAL;
615 #endif 636 #endif
616 return (0); 637 return 0;
617 } 638 }
618 639
619 strcpy (f, filename); 640 strcpy (f, filename);
620 if (l > 4 && !strcmp (f + l - 4, ".obj")) /* MS Windows */ 641 if (l > 4 && !strcmp (f + l - 4, ".obj")) /* MS Windows */
621 strcpy (f + l - 4, ".c"); 642 strcpy (f + l - 4, ".c");
628 { 649 {
629 perror (f); 650 perror (f);
630 return 0; 651 return 0;
631 } 652 }
632 653
654 #if 0
655 /* Reset extension to be able to detect duplicate files. */
656 filename[strlen (filename) - 1] = extension;
657 #endif
658
633 c = '\n'; 659 c = '\n';
634 while (!feof (infile)) 660 while (!feof (infile))
635 { 661 {
636 if (c != '\n') 662 if (c != '\n')
637 { 663 {
683 if (c != 'F') 709 if (c != 'F')
684 continue; 710 continue;
685 c = getc (infile); 711 c = getc (infile);
686 defunflag = (c == 'U'); 712 defunflag = (c == 'U');
687 defvarflag = 0; 713 defvarflag = 0;
688 c = getc (infile); 714 c = getc (infile); /* XEmacs addition */
689 } 715 }
690 else continue; 716 else continue;
691 717
692 while (c != '(') 718 while (c != '(')
693 { 719 {
705 commas = 4; 731 commas = 4;
706 else if (defvarperbufferflag) 732 else if (defvarperbufferflag)
707 commas = 2; 733 commas = 2;
708 else if (defvarflag) 734 else if (defvarflag)
709 commas = 1; 735 commas = 1;
710 else /* For DEFSIMPLE and DEFPRED */ 736 else /* For DEFSIMPLE and DEFPRED ... which now don't exist! */
711 commas = 2; 737 commas = 2;
712 738
713 while (commas) 739 while (commas)
714 { 740 {
715 if (c == ',') 741 if (c == ',')
717 commas--; 743 commas--;
718 if (defunflag && (commas == 1 || commas == 2)) 744 if (defunflag && (commas == 1 || commas == 2))
719 { 745 {
720 do 746 do
721 c = getc (infile); 747 c = getc (infile);
722 while (c == ' ' || c == '\n' || c == '\t') 748 while (c == ' ' || c == '\n' || c == '\t');
723 ;
724 if (c < 0) 749 if (c < 0)
725 goto eof; 750 goto eof;
726 ungetc (c, infile); 751 ungetc (c, infile);
727 if (commas == 2) /* pick up minargs */ 752 if (commas == 2) /* pick up minargs */
728 fscanf (infile, "%d", &minargs); 753 fscanf (infile, "%d", &minargs);
729 else /* pick up maxargs */ 754 else /* pick up maxargs */
730 if (c == 'M' || c == 'U') /* MANY || UNEVALLED */ 755 if (c == 'M' || c == 'U') /* MANY || UNEVALLED */
731 maxargs = -1; 756 maxargs = -1;
732 else 757 else
733 fscanf (infile, "%d", &maxargs); 758 fscanf (infile, "%d", &maxargs);
734 } 759 }
739 } 764 }
740 while (c == ' ' || c == '\n' || c == '\t') 765 while (c == ' ' || c == '\n' || c == '\t')
741 c = getc (infile); 766 c = getc (infile);
742 if (c == '"') 767 if (c == '"')
743 c = read_c_string (infile, 0, 0); 768 c = read_c_string (infile, 0, 0);
769 /* XEmacs change */
744 if (defunflag | defvarflag) 770 if (defunflag | defvarflag)
745 { 771 {
746 while (c != '/') 772 while (c != '/')
773 {
774 if (c < 0)
775 goto eof;
776 if (defunflag && c == '(')
777 fatal ("Missing doc string for DEFUN %s\n", buf);
778 c = getc (infile);
779 }
780 c = getc (infile);
781 while (c == '*')
782 c = getc (infile);
783 }
784 else
785 {
786 while (c != ',')
747 { 787 {
748 if (c < 0) 788 if (c < 0)
749 goto eof; 789 goto eof;
750 c = getc (infile); 790 c = getc (infile);
751 } 791 }
752 c = getc (infile); 792 c = getc (infile);
753 while (c == '*') 793 }
754 c = getc (infile); 794 /* End XEmacs change */
755 }
756 else
757 {
758 while (c != ',')
759 {
760 if (c < 0)
761 goto eof;
762 c = getc (infile);
763 }
764 c = getc (infile);
765 }
766 while (c == ' ' || c == '\n' || c == '\t') 795 while (c == ' ' || c == '\n' || c == '\t')
767 c = getc (infile); 796 c = getc (infile);
797 /* XEmacs addition */
768 if (defunflag | defvarflag) 798 if (defunflag | defvarflag)
769 ungetc (c, infile); 799 ungetc (c, infile);
800 /* End XEmacs addition */
770 801
771 if (defunflag || defvarflag || c == '"') 802 if (defunflag || defvarflag || c == '"')
772 { 803 {
804 /* XEmacs change: the original code is in the "else" clause */
773 if (ellcc) 805 if (ellcc)
774 fprintf (outfile, " CDOC%s(\"%s\", \"\\\n", 806 fprintf (outfile, " CDOC%s(\"%s\", \"\\\n",
775 defvarflag ? "SYM" : "SUBR", buf); 807 defvarflag ? "SYM" : "SUBR", buf);
776 else 808 else
777 { 809 {
778 putc (037, outfile); 810 putc (037, outfile);
779 putc (defvarflag ? 'V' : 'F', outfile); 811 putc (defvarflag ? 'V' : 'F', outfile);
780 fprintf (outfile, "%s\n", buf); 812 fprintf (outfile, "%s\n", buf);
781 } 813 }
782 c = read_c_string (infile, 1, (defunflag || defvarflag)); 814 c = read_c_string (infile, 1, defunflag || defvarflag);
783 815
784 /* If this is a defun, find the arguments and print them. If 816 /* If this is a defun, find the arguments and print them. If
785 this function takes MANY or UNEVALLED args, then the C source 817 this function takes MANY or UNEVALLED args, then the C source
786 won't give the names of the arguments, so we shouldn't bother 818 won't give the names of the arguments, so we shouldn't bother
787 trying to find them. */ 819 trying to find them. */
828 fclose (infile); 860 fclose (infile);
829 return 0; 861 return 0;
830 } 862 }
831 863
832 /* Read a file of Lisp code, compiled or interpreted. 864 /* Read a file of Lisp code, compiled or interpreted.
833 Looks for 865 Looks for
834 (defun NAME ARGS DOCSTRING ...) 866 (defun NAME ARGS DOCSTRING ...)
835 (defmacro NAME ARGS DOCSTRING ...) 867 (defmacro NAME ARGS DOCSTRING ...)
836 (autoload (quote NAME) FILE DOCSTRING ...) 868 (defsubst NAME ARGS DOCSTRING ...)
837 (defvar NAME VALUE DOCSTRING) 869 (autoload (quote NAME) FILE DOCSTRING ...)
838 (defconst NAME VALUE DOCSTRING) 870 (defvar NAME VALUE DOCSTRING)
839 (fset (quote NAME) (make-byte-code ... DOCSTRING ...)) 871 (defconst NAME VALUE DOCSTRING)
840 (fset (quote NAME) #[... DOCSTRING ...]) 872 (fset (quote NAME) (make-byte-code ... DOCSTRING ...))
841 (defalias (quote NAME) #[... DOCSTRING ...]) 873 (fset (quote NAME) #[... DOCSTRING ...])
842 starting in column zero. 874 (defalias (quote NAME) #[... DOCSTRING ...])
843 (quote NAME) may appear as 'NAME as well. 875 (custom-declare-variable (quote NAME) VALUE DOCSTRING ...)
876 starting in column zero.
877 (quote NAME) may appear as 'NAME as well.
844 878
845 We also look for #@LENGTH CONTENTS^_ at the beginning of the line. 879 We also look for #@LENGTH CONTENTS^_ at the beginning of the line.
846 When we find that, we save it for the following defining-form, 880 When we find that, we save it for the following defining-form,
847 and we use that instead of reading a doc string within that defining-form. 881 and we use that instead of reading a doc string within that defining-form.
848 882
849 For defun, defmacro, and autoload, we know how to skip over the arglist. 883 For defvar, defconst, and fset we skip to the docstring with a kludgy
850 For defvar, defconst, and fset we skip to the docstring with a kludgy
851 formatting convention: all docstrings must appear on the same line as the 884 formatting convention: all docstrings must appear on the same line as the
852 initial open-paren (the one in column zero) and must contain a backslash 885 initial open-paren (the one in column zero) and must contain a backslash
853 and a double-quote immediately after the initial double-quote. No newlines 886 and a newline immediately after the initial double-quote. No newlines
854 must appear between the beginning of the form and the first double-quote. 887 must appear between the beginning of the form and the first double-quote.
855 The only source file that must follow this convention is loaddefs.el; aside 888 For defun, defmacro, and autoload, we know how to skip over the
889 arglist, but the doc string must still have a backslash and newline
890 immediately after the double quote.
891 The only source files that must follow this convention are preloaded
892 uncompiled ones like loaddefs.el and bindings.el; aside
856 from that, it is always the .elc file that we look at, and they are no 893 from that, it is always the .elc file that we look at, and they are no
857 problem because byte-compiler output follows this convention. 894 problem because byte-compiler output follows this convention.
858 The NAME and DOCSTRING are output. 895 The NAME and DOCSTRING are output.
859 NAME is preceded by `F' for a function or `V' for a variable. 896 NAME is preceded by `F' for a function or `V' for a variable.
860 An entry is output only if DOCSTRING has \ newline just after the opening " 897 An entry is output only if DOCSTRING has \ newline just after the opening "
907 944
908 infile = fopen (filename, mode); 945 infile = fopen (filename, mode);
909 if (infile == NULL) 946 if (infile == NULL)
910 { 947 {
911 perror (filename); 948 perror (filename);
912 return 0; /* No error */ 949 return 0; /* No error */
913 } 950 }
914 951
915 c = '\n'; 952 c = '\n';
916 while (!feof (infile)) 953 while (!feof (infile))
917 { 954 {
918 char buffer[BUFSIZ]; 955 char buffer[BUFSIZ];
919 char type; 956 char type;
920 957
958 /* If not at end of line, skip till we get to one. */
921 if (c != '\n') 959 if (c != '\n')
922 { 960 {
923 c = getc_skipping_iso2022 (infile); 961 c = getc_skipping_iso2022 (infile);
924 continue; 962 continue;
925 } 963 }
926 c = getc_skipping_iso2022 (infile); 964 /* Skip the line break. */
965 while (c == '\n')
966 c = getc_skipping_iso2022 (infile);
927 /* Detect a dynamic doc string and save it for the next expression. */ 967 /* Detect a dynamic doc string and save it for the next expression. */
928 if (c == '#') 968 if (c == '#')
929 { 969 {
930 c = getc_skipping_iso2022 (infile); 970 c = getc_skipping_iso2022 (infile);
931 if (c == '@') 971 if (c == '@')
954 saved_string[i] = getc (infile); 994 saved_string[i] = getc (infile);
955 /* The last character is a ^_. 995 /* The last character is a ^_.
956 That is needed in the .elc file 996 That is needed in the .elc file
957 but it is redundant in DOC. So get rid of it here. */ 997 but it is redundant in DOC. So get rid of it here. */
958 saved_string[length - 1] = 0; 998 saved_string[length - 1] = 0;
959 /* Skip the newline. */ 999 /* Skip the line break. */
960 c = getc_skipping_iso2022 (infile); 1000 while (c == '\n')
1001 c = getc_skipping_iso2022 (infile);
1002 /* Skip the following line. */
961 while (c != '\n') 1003 while (c != '\n')
962 { 1004 c = getc_skipping_iso2022 (infile);
963 c = getc_skipping_iso2022 (infile);
964 if (c < 0)
965 continue;
966 }
967 } 1005 }
968 continue; 1006 continue;
969 } 1007 }
970 1008
971 if (c != '(') 1009 if (c != '(')
972 continue; 1010 continue;
973 1011
974 read_lisp_symbol (infile, buffer); 1012 read_lisp_symbol (infile, buffer);
975 1013
976 if (! strcmp (buffer, "defun") || 1014 if (! strcmp (buffer, "defun")
977 ! strcmp (buffer, "defmacro")) 1015 || ! strcmp (buffer, "defmacro")
1016 || ! strcmp (buffer, "defsubst"))
978 { 1017 {
979 type = 'F'; 1018 type = 'F';
980 read_lisp_symbol (infile, buffer); 1019 read_lisp_symbol (infile, buffer);
981 1020
982 /* Skip the arguments: either "nil" or a list in parens */ 1021 /* Skip the arguments: either "nil" or a list in parens */
983 1022
984 c = getc_skipping_iso2022 (infile); 1023 c = getc_skipping_iso2022 (infile);
985 if (c == 'n') /* nil */ 1024 if (c == 'n') /* nil */
986 { 1025 {
987 if ((c = getc_skipping_iso2022 (infile)) != 'i' || 1026 if ((c = getc_skipping_iso2022 (infile)) != 'i' ||
988 (c = getc_skipping_iso2022 (infile)) != 'l') 1027 (c = getc_skipping_iso2022 (infile)) != 'l')
989 { 1028 {
990 fprintf (stderr, "## unparsable arglist in %s (%s)\n", 1029 fprintf (stderr, "## unparsable arglist in %s (%s)\n",
1007 } 1046 }
1008 skip_white (infile); 1047 skip_white (infile);
1009 1048
1010 /* If the next three characters aren't `dquote bslash newline' 1049 /* If the next three characters aren't `dquote bslash newline'
1011 then we're not reading a docstring. 1050 then we're not reading a docstring.
1012 */ 1051 */
1013 if ((c = getc_skipping_iso2022 (infile)) != '"' || 1052 if ((c = getc_skipping_iso2022 (infile)) != '"' ||
1014 (c = getc_skipping_iso2022 (infile)) != '\\' || 1053 (c = getc_skipping_iso2022 (infile)) != '\\' ||
1015 (c = getc_skipping_iso2022 (infile)) != '\n') 1054 (c = getc_skipping_iso2022 (infile)) != '\n')
1016 { 1055 {
1017 #ifdef DEBUG 1056 #ifdef DEBUG
1020 #endif 1059 #endif
1021 continue; 1060 continue;
1022 } 1061 }
1023 } 1062 }
1024 1063
1025 else if (! strcmp (buffer, "defvar") || 1064 else if (! strcmp (buffer, "defvar")
1026 ! strcmp (buffer, "defconst")) 1065 || ! strcmp (buffer, "defconst"))
1027 { 1066 {
1028 char c1 = 0, c2 = 0; 1067 char c1 = 0, c2 = 0;
1029 type = 'V'; 1068 type = 'V';
1030 read_lisp_symbol (infile, buffer); 1069 read_lisp_symbol (infile, buffer);
1031 1070
1032 if (saved_string == 0) 1071 if (saved_string == 0)
1033 { 1072 {
1034 1073
1035 /* Skip until the first newline; remember the two previous 1074 /* Skip until the end of line; remember two previous chars. */
1036 chars. */
1037 while (c != '\n' && c >= 0) 1075 while (c != '\n' && c >= 0)
1038 { 1076 {
1039 c2 = c1; 1077 c2 = c1;
1040 c1 = c; 1078 c1 = c;
1041 c = getc_skipping_iso2022 (infile); 1079 c = getc_skipping_iso2022 (infile);
1042 } 1080 }
1043 1081
1044 /* If two previous characters were " and \, 1082 /* If two previous characters were " and \,
1045 this is a doc string. Otherwise, there is none. */ 1083 this is a doc string. Otherwise, there is none. */
1046 if (c2 != '"' || c1 != '\\') 1084 if (c2 != '"' || c1 != '\\')
1047 { 1085 {
1048 #ifdef DEBUG 1086 #ifdef DEBUG
1052 continue; 1090 continue;
1053 } 1091 }
1054 } 1092 }
1055 } 1093 }
1056 1094
1095 else if (! strcmp (buffer, "custom-declare-variable"))
1096 {
1097 char c1 = 0, c2 = 0;
1098 type = 'V';
1099
1100 c = getc (infile);
1101 if (c == '\'')
1102 read_lisp_symbol (infile, buffer);
1103 else
1104 {
1105 if (c != '(')
1106 {
1107 fprintf (stderr,
1108 "## unparsable name in custom-declare-variable in %s\n",
1109 filename);
1110 continue;
1111 }
1112 read_lisp_symbol (infile, buffer);
1113 if (strcmp (buffer, "quote"))
1114 {
1115 fprintf (stderr,
1116 "## unparsable name in custom-declare-variable in %s\n",
1117 filename);
1118 continue;
1119 }
1120 read_lisp_symbol (infile, buffer);
1121 c = getc (infile);
1122 if (c != ')')
1123 {
1124 fprintf (stderr,
1125 "## unparsable quoted name in custom-declare-variable in %s\n",
1126 filename);
1127 continue;
1128 }
1129 }
1130
1131 if (saved_string == 0)
1132 {
1133 /* Skip to end of line; remember the two previous chars. */
1134 while (c != '\n' && c >= 0)
1135 {
1136 c2 = c1;
1137 c1 = c;
1138 c = getc_skipping_iso2022 (infile);
1139 }
1140
1141 /* If two previous characters were " and \,
1142 this is a doc string. Otherwise, there is none. */
1143 if (c2 != '"' || c1 != '\\')
1144 {
1145 #ifdef DEBUG
1146 fprintf (stderr, "## non-docstring in %s (%s)\n",
1147 buffer, filename);
1148 #endif
1149 continue;
1150 }
1151 }
1152 }
1153
1057 else if (! strcmp (buffer, "fset") || ! strcmp (buffer, "defalias")) 1154 else if (! strcmp (buffer, "fset") || ! strcmp (buffer, "defalias"))
1058 { 1155 {
1059 char c1 = 0, c2 = 0; 1156 char c1 = 0, c2 = 0;
1060 type = 'F'; 1157 type = 'F';
1061 1158
1088 } 1185 }
1089 } 1186 }
1090 1187
1091 if (saved_string == 0) 1188 if (saved_string == 0)
1092 { 1189 {
1093 /* Skip until the first newline; remember the two previous 1190 /* Skip to end of line; remember the two previous chars. */
1094 chars. */
1095 while (c != '\n' && c >= 0) 1191 while (c != '\n' && c >= 0)
1096 { 1192 {
1097 c2 = c1; 1193 c2 = c1;
1098 c1 = c; 1194 c1 = c;
1099 c = getc_skipping_iso2022 (infile); 1195 c = getc_skipping_iso2022 (infile);
1100 } 1196 }
1101 1197
1102 /* If two previous characters were " and \, 1198 /* If two previous characters were " and \,
1103 this is a doc string. Otherwise, there is none. */ 1199 this is a doc string. Otherwise, there is none. */
1104 if (c2 != '"' || c1 != '\\') 1200 if (c2 != '"' || c1 != '\\')
1105 { 1201 {
1106 #ifdef DEBUG 1202 #ifdef DEBUG
1169 } 1265 }
1170 } 1266 }
1171 } 1267 }
1172 1268
1173 #if 0 /* causes crash */ 1269 #if 0 /* causes crash */
1174 else if (! strcmp (buffer, "if") || 1270 else if (! strcmp (buffer, "if")
1175 ! strcmp (buffer, "byte-code")) 1271 || ! strcmp (buffer, "byte-code"))
1176 ; 1272 ;
1177 #endif 1273 #endif
1178 1274
1179 else 1275 else
1180 { 1276 {
1186 } 1282 }
1187 1283
1188 /* At this point, we should either use the previous 1284 /* At this point, we should either use the previous
1189 dynamic doc string in saved_string 1285 dynamic doc string in saved_string
1190 or gobble a doc string from the input file. 1286 or gobble a doc string from the input file.
1191 1287
1192 In the latter case, the opening quote (and leading 1288 In the latter case, the opening quote (and leading
1193 backslash-newline) have already been read. */ 1289 backslash-newline) have already been read. */
1290
1194 putc ('\n', outfile); /* XEmacs addition */ 1291 putc ('\n', outfile); /* XEmacs addition */
1195 putc (037, outfile); 1292 putc (037, outfile);
1196 putc (type, outfile); 1293 putc (type, outfile);
1197 fprintf (outfile, "%s\n", buffer); 1294 fprintf (outfile, "%s\n", buffer);
1198 if (saved_string) 1295 if (saved_string)