comparison lib-src/make-docfile.c @ 814:a634e3b7acc8

[xemacs-hg @ 2002-04-14 12:41:59 by ben] latest changes TODO.ben-mule-21-5: Update. make-docfile.c: Add basic support for handling ISO 2022 doc strings -- we parse the basic charset designation sequences so we know whether we're in ASCII and have to pay attention to end quotes and such. Reformat code according to coding standards. abbrev.el: Add `global-abbrev-mode', which turns on or off abbrev-mode in all buffers. Added `defining-abbrev-turns-on-abbrev-mode' -- if non-nil, defining an abbrev through an interactive function will automatically turn on abbrev-mode, either globally or locally depending on the command. This is the "what you'd expect" behavior. indent.el: general function for indenting a balanced expression in a mode-correct way. Works similar to indent-region in that a mode can specify a specific command to do the whole operation; if not, figure out the region using forward-sexp and indent each line using indent-according-to-mode. keydefs.el: Removed. Modify M-C-backslash to do indent-region-or-balanced-expression. Make S-Tab just insert a TAB char, like it's meant to do. make-docfile.el: Now that we're using the call-process-in-lisp, we need to load an extra file win32-native.el because we're running a bare temacs. menubar-items.el: Totally redo the Cmds menu so that most used commands appear directly on the menu and less used commands appear in submenus. The old way may have been very pretty, but rather impractical. process.el: Under Windows, don't ever use old-call-process-internal, even in batch mode. We can do processes in batch mode. subr.el: Someone recoded truncate-string-to-width, saying "the FSF version is too complicated and does lots of hard-to-understand stuff" but the resulting recoded version was *totally* wrong! it misunderstood the basic point of this function, which is work in *columns* not chars. i dumped ours and copied the version from FSF 21.1. Also added truncate-string-with-continuation-dots, since this idiom is used often. config.inc.samp, xemacs.mak: Separate out debug and optimize flags. Remove all vestiges of USE_MINIMAL_TAGBITS, USE_INDEXED_LRECORD_IMPLEMENTATION, and GUNG_HO, since those ifdefs have long been removed. Make error-checking support actually work. Some rearrangement of config.inc.samp to make it more logical. Remove callproc.c and ntproc.c from xemacs.mak, no longer used. Make pdump the default. lisp.h: Add support for strong type-checking of Bytecount, Bytebpos, Charcount, Charbpos, and others, by making them classes, overloading the operators to provide integer-like operation and carefully controlling what operations are allowed. Not currently enabled in C++ builds because there are still a number of compile errors, and it won't really work till we merge in my "8-bit-Mule" workspace, in which I make use of the new types Charxpos, Bytexpos, Memxpos, representing a "position" either in a buffer or a string. (This is especially important in the extent code.) abbrev.c, alloc.c, eval.c, buffer.c, buffer.h, editfns.c, fns.c, text.h: Warning fixes, some of them related to new C++ strict type checking of Bytecount, Charbpos, etc. dired.c: Caught an actual error due to strong type checking -- char len being passed when should be byte len. alloc.c, backtrace.h, bytecode.c, bytecode.h, eval.c, sysdep.c: Further optimize Ffuncall: -- process arg list at compiled-function creation time, converting into an array for extra-quick access at funcall time. -- rewrite funcall_compiled_function to use it, and inline this function. -- change the order of check for magic stuff in SPECBIND_FAST_UNSAFE to be faster. -- move the check for need to garbage collect into the allocation code, so only a single flag needs to be checked in funcall. buffer.c, symbols.c: add debug funs to check on mule optimization info in buffers and strings. eval.c, emacs.c, text.c, regex.c, scrollbar-msw.c, search.c: Fix evil crashes due to eistrings not properly reinitialized under pdump. Redo a bit some of the init routines; convert some complex_vars_of() into simple vars_of(), because they didn't need complex processing. callproc.c, emacs.c, event-stream.c, nt.c, process.c, process.h, sysdep.c, sysdep.h, syssignal.h, syswindows.h, ntproc.c: Delete. Hallelujah, praise the Lord, there is no god but Allah!!! fix so that processes can be invoked in bare temacs -- thereby eliminating any need for callproc.c. (currently only eliminated under NT.) remove all crufty and unnecessary old process code in ntproc.c and elsewhere. move non-callproc-specific stuff (mostly environment) into process.c, so callproc.c can be left out under NT. console-tty.c, doc.c, file-coding.c, file-coding.h, lstream.c, lstream.h: fix doc string handling so it works with Japanese, etc docs. change handling of "character mode" so callers don't have to manually set it (quite error-prone). event-msw.c: spacing fixes. lread.c: eliminate unused crufty vintage-19 "FSF defun hack" code. lrecord.h: improve pdump description docs. buffer.c, ntheap.c, unexnt.c, win32.c, emacs.c: Mule-ize some unexec and startup code. It was pseudo-Mule-ized before by simply always calling the ...A versions of functions, but that won't cut it -- eventually we want to be able to run properly even if XEmacs has been installed in a Japanese directory. (The current problem is the timing of the loading of the Unicode tables; this will eventually be fixed.) Go through and fix various other places where the code was not Mule-clean. Provide a function mswindows_get_module_file_name() to get our own name without resort to PATH_MAX and such. Add a big comment in main() about the problem with Unicode table load timing that I just alluded to. emacs.c: When error-checking is enabled (interpreted as "user is developing XEmacs"), don't ask user to "pause to read messages" when a fatal error has occurred, because it will wedge if we are in an inner modal loop (typically when a menu is popped up) and make us unable to get a useful stack trace in the debugger. text.c: Correct update_entirely_ascii_p_flag to actually work. lisp.h, symsinit.h: declarations for above changes.
author ben
date Sun, 14 Apr 2002 12:43:31 +0000
parents 943eaba38521
children 2b6fa2618f76
comparison
equal deleted inserted replaced
813:9541922fb765 814:a634e3b7acc8
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, 1986, 1992, 1993, 1994 Free Software Foundation, Inc.
3 Copyright (C) 1995 Board of Trustees, University of Illinois. 3 Copyright (C) 1995 Board of Trustees, University of Illinois.
4 Copyright (C) 1998, 1999 J. Kean Johnston. 4 Copyright (C) 1998, 1999 J. Kean Johnston.
5 Copyright (C) 2001 Ben Wing. 5 Copyright (C) 2001, 2002 Ben Wing.
6 6
7 This file is part of XEmacs. 7 This file is part of XEmacs.
8 8
9 XEmacs is free software; you can redistribute it and/or modify it 9 XEmacs is free software; you can redistribute it and/or modify it
10 under the terms of the GNU General Public License as published by the 10 under the terms of the GNU General Public License as published by the
11 Free Software Foundation; either version 2, or (at your option) any 11 Free Software Foundation; either version 2, or (at your option) any
12 later version. 12 later version.
13 13
14 XEmacs is distributed in the hope that it will be useful, but WITHOUT 14 XEmacs is distributed in the hope that it will be useful, but WITHOUT
15 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 15 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
16 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License 16 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
17 for more details. 17 for more details.
18 18
19 You should have received a copy of the GNU General Public License 19 You should have received a copy of the GNU General Public License
20 along with XEmacs; see the file COPYING. If not, write to 20 along with XEmacs; see the file COPYING. If not, write to
21 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, 21 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 Boston, MA 02111-1307, USA. */ 22 Boston, MA 02111-1307, USA. */
23 23
24 /* Synched up with: FSF 19.30. */ 24 /* Synched up with: FSF 19.30. */
25 25
26 /* The arguments given to this program are all the C and Lisp source files 26 /* 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. 27 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 used. 28 A .o or .obj file can also be specified; the .c file it was made from is
29 This helps the makefile pass the correct list of files. 29 used. This helps the makefile pass the correct list of files.
30 30
31 The results, which go to standard output or to a file 31 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), 32 specified with -a or -o (-a to append, -o to start from nothing),
33 are entries containing function or variable names and their documentation. 33 are entries containing function or variable names and their documentation.
34 Each entry starts with a ^_ character. 34 Each entry starts with a ^_ character.
35 Then comes F for a function or V for a variable. 35 Then comes F for a function or V for a variable.
36 Then comes the function or variable name, terminated with a newline. 36 Then comes the function or variable name, terminated with a newline.
37 Then comes the documentation for that function or variable. 37 Then comes the documentation for that function or variable.
38 38
39 Added 19.15/20.1: `-i site-packages' allow installer to dump extra packages 39 Added 19.15/20.1: `-i site-packages' allow installer to dump extra packages
40 without modifying Makefiles, etc. 40 without modifying Makefiles, etc.
41 */ 41 */
42 42
43 #include <config.h> 43 #include <config.h>
44 44
45 #include <stdio.h> 45 #include <stdio.h>
122 fatal ("virtual memory exhausted", 0); 122 fatal ("virtual memory exhausted", 0);
123 return result; 123 return result;
124 } 124 }
125 125
126 static char * 126 static char *
127 next_extra_elc(char *extra_elcs) 127 next_extra_elc (char *extra_elcs)
128 { 128 {
129 static FILE *fp = NULL; 129 static FILE *fp = NULL;
130 static char line_buf[BUFSIZ]; 130 static char line_buf[BUFSIZ];
131 char *p = line_buf+1; 131 char *p = line_buf+1;
132 132
133 if (!fp) { 133 if (!fp)
134 if (!extra_elcs) { 134 {
135 if (!extra_elcs)
136 return NULL;
137 else if (!(fp = fopen (extra_elcs, READ_BINARY)))
138 {
139 /* It is not an error if this file doesn't exist. */
140 /*fatal ("error opening site package file list", 0);*/
141 return NULL;
142 }
143 fgets (line_buf, BUFSIZ, fp);
144 }
145
146 again:
147 if (!fgets (line_buf, BUFSIZ, fp))
148 {
149 fclose (fp);
150 fp = NULL;
135 return NULL; 151 return NULL;
136 } else if (!(fp = fopen(extra_elcs, READ_BINARY))) { 152 }
137 /* It is not an error if this file doesn't exist. */
138 /*fatal("error opening site package file list", 0);*/
139 return NULL;
140 }
141 fgets(line_buf, BUFSIZ, fp);
142 }
143
144 again:
145 if (!fgets(line_buf, BUFSIZ, fp)) {
146 fclose(fp);
147 fp = NULL;
148 return NULL;
149 }
150 line_buf[0] = '\0'; 153 line_buf[0] = '\0';
151 if (strlen(p) <= 2 || strlen(p) >= (BUFSIZ - 5)) { 154 if (strlen (p) <= 2 || strlen (p) >= (BUFSIZ - 5))
152 /* reject too short or too long lines */ 155 {
153 goto again; 156 /* reject too short or too long lines */
154 } 157 goto again;
155 p[strlen(p) - 2] = '\0'; 158 }
156 strcat(p, ".elc"); 159 p[strlen (p) - 2] = '\0';
160 strcat (p, ".elc");
157 161
158 return p; 162 return p;
159 } 163 }
160 164
161 165
199 { 203 {
200 chdir (argv[i + 1]); 204 chdir (argv[i + 1]);
201 i += 2; 205 i += 2;
202 } 206 }
203 207
204 if (argc > (i + 1) && !strcmp(argv[i], "-i")) { 208 if (argc > (i + 1) && !strcmp (argv[i], "-i"))
205 extra_elcs = argv[i + 1]; 209 {
206 i += 2; 210 extra_elcs = argv[i + 1];
207 } 211 i += 2;
212 }
208 213
209 if (outfile == 0) 214 if (outfile == 0)
210 fatal ("No output file specified", ""); 215 fatal ("No output file specified", "");
211 216
212 if (ellcc) 217 if (ellcc)
244 /* err_count seems to be {mis,un}used */ 249 /* err_count seems to be {mis,un}used */
245 err_count += scan_file (argv[i]); 250 err_count += scan_file (argv[i]);
246 } 251 }
247 } 252 }
248 253
249 if (extra_elcs) { 254 if (extra_elcs)
250 char *p; 255 {
251 256 char *p;
252 while ((p = next_extra_elc(extra_elcs)) != NULL) { 257
253 err_count += scan_file(p); 258 while ((p = next_extra_elc (extra_elcs)) != NULL)
254 } 259 err_count += scan_file (p);
255 } 260 }
256 261
257 putc ('\n', outfile); 262 putc ('\n', outfile);
258 if (ellcc) 263 if (ellcc)
259 fprintf (outfile, "}\n\n"); 264 fprintf (outfile, "}\n\n");
260 #ifndef VMS 265 #ifndef VMS
284 { 289 {
285 Current_file_type = c_file; 290 Current_file_type = c_file;
286 return scan_c_file (filename, READ_TEXT); 291 return scan_c_file (filename, READ_TEXT);
287 } 292 }
288 } 293 }
294
295 static int
296 getc_skipping_iso2022 (FILE *file)
297 {
298 register int c;
299 /* #### Kludge -- Ignore any ISO2022 sequences */
300 c = getc (file);
301 while (c == 27)
302 {
303 c = getc (file);
304 if (c == '$')
305 c = getc (file);
306 if (c >= '(' && c <= '/')
307 c = getc (file);
308 c = getc (file);
309 }
310 return c;
311 }
312
313 enum iso2022_state
314 {
315 ISO_NOTHING,
316 ISO_ESC,
317 ISO_DOLLAR,
318 ISO_FINAL_IS_NEXT,
319 ISO_DOLLAR_AND_FINAL_IS_NEXT
320 };
321
322 static int non_ascii_p;
323
324 static int
325 getc_iso2022 (FILE *file)
326 {
327 /* #### Kludge -- Parse ISO2022 sequences (more or less) */
328 static enum iso2022_state state;
329 static int prevc;
330 register int c;
331 c = getc (file);
332 switch (state)
333 {
334 case ISO_NOTHING:
335 if (c == 27)
336 state = ISO_ESC;
337 break;
338
339 case ISO_ESC:
340 if (c == '$')
341 state = ISO_DOLLAR;
342 else if (c >= '(' && c <= '/')
343 state = ISO_FINAL_IS_NEXT;
344 else
345 state = ISO_NOTHING;
346 break;
347
348 case ISO_DOLLAR:
349 if (c >= '(' && c <= '/')
350 state = ISO_DOLLAR_AND_FINAL_IS_NEXT;
351 else if (c >= '@' && c <= 'B') /* ESC $ @ etc */
352 {
353 non_ascii_p = 1;
354 state = ISO_NOTHING;
355 }
356 else
357 state = ISO_NOTHING;
358 break;
359
360 case ISO_FINAL_IS_NEXT:
361 if (prevc == '(' && c == 'B') /* ESC ( B, invoke ASCII */
362 non_ascii_p = 0;
363 else if (prevc == '(' || prevc == ',') /* ESC ( x or ESC , x */
364 non_ascii_p = 1;
365 state = ISO_NOTHING;
366 break;
367
368 case ISO_DOLLAR_AND_FINAL_IS_NEXT:
369 if (prevc == '(' || prevc == ',') /* ESC $ ( x or ESC $ , x */
370 non_ascii_p = 1;
371 state = ISO_NOTHING;
372 break;
373 }
374
375 prevc = c;
376 return c;
377 }
378
289 379
290 char buf[128]; 380 char buf[128];
291 381
292 /* Skip a C string from INFILE, 382 /* Skip a C string from INFILE,
293 and return the character that follows the closing ". 383 and return the character that follows the closing ".
294 If printflag is positive, output string contents to outfile. 384 If printflag is positive, output string contents to outfile.
295 If it is negative, store contents in buf. 385 If it is negative, store contents in buf.
296 Convert escape sequences \n and \t to newline and tab; 386 Convert escape sequences \n and \t to newline and tab;
297 discard \ followed by newline. */ 387 discard \ followed by newline. */
298 388
299 #define MDGET do { prevc = c; c = getc (infile); } while (0) 389 #define MDGET do { prevc = c; c = getc_iso2022 (infile); } while (0)
300 static int 390 static int
301 read_c_string (FILE *infile, int printflag, int c_docstring) 391 read_c_string (FILE *infile, int printflag, int c_docstring)
302 { 392 {
303 register int prevc = 0, c = 0; 393 register int prevc = 0, c = 0;
304 char *p = buf; 394 char *p = buf;
305 int start = -1; 395 int start = -1;
306 396
307 MDGET; 397 MDGET;
308 while (c != EOF) 398 while (c != EOF)
309 { 399 {
310 while ((c_docstring || c != '"') && c != EOF) 400 while ((c_docstring || c != '"' || non_ascii_p) && c != EOF)
311 { 401 {
312 if (c == '*') 402 if (c == '*' && !non_ascii_p)
313 { 403 {
314 int cc = getc (infile); 404 int cc = getc (infile);
315 if (cc == '/') 405 if (cc == '/')
316 { 406 {
317 if (prevc != '\n') 407 if (prevc != '\n')
341 } 431 }
342 else if (printflag < 0) 432 else if (printflag < 0)
343 *p++ = '\n'; 433 *p++ = '\n';
344 } 434 }
345 435
346 if (c == '\\') 436 if (c == '\\' && !non_ascii_p)
347 { 437 {
348 MDGET; 438 MDGET;
349 if (c == '\n') 439 if (c == '\n')
350 { 440 {
351 MDGET; 441 MDGET;
362 else 452 else
363 { 453 {
364 start = 0; 454 start = 0;
365 if (printflag > 0) 455 if (printflag > 0)
366 { 456 {
367 if (ellcc && c == '"') 457 if (ellcc && c == '"' && !non_ascii_p)
368 putc ('\\', outfile); 458 putc ('\\', outfile);
369 putc (c, outfile); 459 putc (c, outfile);
370 } 460 }
371 else if (printflag < 0) 461 else if (printflag < 0)
372 *p++ = c; 462 *p++ = c;
379 do 469 do
380 { 470 {
381 MDGET; 471 MDGET;
382 } 472 }
383 while (isspace (c)); 473 while (isspace (c));
384 if (c != '"') 474 if (c != '"' || non_ascii_p)
385 break; 475 break;
386 } 476 }
387 else 477 else
388 { 478 {
389 MDGET; 479 MDGET;
390 if (c != '"') 480 if (c != '"' || non_ascii_p)
391 break; 481 break;
392 /* If we had a "", concatenate the two strings. */ 482 /* If we had a "", concatenate the two strings. */
393 } 483 }
394 MDGET; 484 MDGET;
395 } 485 }
396 486
397 if (printflag < 0) 487 if (printflag < 0)
398 *p = 0; 488 *p = 0;
399 489
400 return c; 490 return c;
401 } 491 }
402 492
403 /* Write to file OUT the argument names of function FUNC, whose text is in BUF. 493 /* Write to file OUT the argument names of function FUNC, whose text is in BUF.
404 MINARGS and MAXARGS are the minimum and maximum number of arguments. */ 494 MINARGS and MAXARGS are the minimum and maximum number of arguments. */
435 /* Add support for ANSI prototypes. Hop over 525 /* Add support for ANSI prototypes. Hop over
436 "Lisp_Object" string (the only C type allowed in DEFUNs) */ 526 "Lisp_Object" string (the only C type allowed in DEFUNs) */
437 static char lo[] = "Lisp_Object"; 527 static char lo[] = "Lisp_Object";
438 if ((C_IDENTIFIER_CHAR_P (c) != in_ident) && !in_ident && 528 if ((C_IDENTIFIER_CHAR_P (c) != in_ident) && !in_ident &&
439 (strncmp (p, lo, sizeof (lo) - 1) == 0) && 529 (strncmp (p, lo, sizeof (lo) - 1) == 0) &&
440 isspace((unsigned char) (* (p + sizeof (lo) - 1)))) 530 isspace ((unsigned char) (* (p + sizeof (lo) - 1))))
441 { 531 {
442 p += (sizeof (lo) - 1); 532 p += (sizeof (lo) - 1);
443 while (isspace ((unsigned char) (*p))) 533 while (isspace ((unsigned char) (*p)))
444 p++; 534 p++;
445 c = *p; 535 c = *p;
493 #if 0 583 #if 0
494 need_space = 0; 584 need_space = 0;
495 #endif 585 #endif
496 } 586 }
497 if (!ellcc) 587 if (!ellcc)
498 putc ('\n', out); /* XEmacs addition */ 588 putc ('\n', out); /* XEmacs addition */
499 } 589 }
500 590
501 /* Read through a c file. If a .o or .obj file is named, 591 /* Read through a c file. If a .o or .obj file is named,
502 the corresponding .c file is read instead. 592 the corresponding .c file is read instead.
503 Looks for DEFUN constructs such as are defined in ../src/lisp.h. 593 Looks for DEFUN constructs such as are defined in ../src/lisp.h.
615 commas = 4; 705 commas = 4;
616 else if (defvarperbufferflag) 706 else if (defvarperbufferflag)
617 commas = 2; 707 commas = 2;
618 else if (defvarflag) 708 else if (defvarflag)
619 commas = 1; 709 commas = 1;
620 else /* For DEFSIMPLE and DEFPRED */ 710 else /* For DEFSIMPLE and DEFPRED */
621 commas = 2; 711 commas = 2;
622 712
623 while (commas) 713 while (commas)
624 { 714 {
625 if (c == ',') 715 if (c == ',')
634 if (c < 0) 724 if (c < 0)
635 goto eof; 725 goto eof;
636 ungetc (c, infile); 726 ungetc (c, infile);
637 if (commas == 2) /* pick up minargs */ 727 if (commas == 2) /* pick up minargs */
638 fscanf (infile, "%d", &minargs); 728 fscanf (infile, "%d", &minargs);
639 else /* pick up maxargs */ 729 else /* pick up maxargs */
640 if (c == 'M' || c == 'U') /* MANY || UNEVALLED */ 730 if (c == 'M' || c == 'U') /* MANY || UNEVALLED */
641 maxargs = -1; 731 maxargs = -1;
642 else 732 else
643 fscanf (infile, "%d", &maxargs); 733 fscanf (infile, "%d", &maxargs);
644 } 734 }
670 if (defunflag | defvarflag) 760 if (defunflag | defvarflag)
671 ungetc (c, infile); 761 ungetc (c, infile);
672 762
673 if (defunflag || defvarflag || c == '"') 763 if (defunflag || defvarflag || c == '"')
674 { 764 {
675 if (ellcc) 765 if (ellcc)
676 fprintf (outfile, " CDOC%s(\"%s\", \"\\\n", 766 fprintf (outfile, " CDOC%s(\"%s\", \"\\\n",
677 defvarflag ? "SYM" : "SUBR", buf); 767 defvarflag ? "SYM" : "SUBR", buf);
678 else 768 else
679 { 769 {
680 putc (037, outfile); 770 putc (037, outfile);
681 putc (defvarflag ? 'V' : 'F', outfile); 771 putc (defvarflag ? 'V' : 'F', outfile);
682 fprintf (outfile, "%s\n", buf); 772 fprintf (outfile, "%s\n", buf);
683 } 773 }
684 c = read_c_string (infile, 1, (defunflag || defvarflag)); 774 c = read_c_string (infile, 1, (defunflag || defvarflag));
685 775
686 /* If this is a defun, find the arguments and print them. If 776 /* If this is a defun, find the arguments and print them. If
687 this function takes MANY or UNEVALLED args, then the C source 777 this function takes MANY or UNEVALLED args, then the C source
688 won't give the names of the arguments, so we shouldn't bother 778 won't give the names of the arguments, so we shouldn't bother
689 trying to find them. */ 779 trying to find them. */
690 if (defunflag && maxargs != -1) 780 if (defunflag && maxargs != -1)
691 { 781 {
692 char argbuf[1024], *p = argbuf; 782 char argbuf[1024], *p = argbuf;
693 #if 0 /* For old DEFUN's only */ 783 #if 0 /* For old DEFUN's only */
694 while (c != ')') 784 while (c != ')')
695 { 785 {
696 if (c < 0) 786 if (c < 0)
697 goto eof; 787 goto eof;
698 c = getc (infile); 788 c = getc (infile);
710 do 800 do
711 *p++ = c = getc (infile); 801 *p++ = c = getc (infile);
712 while (c != ')'); 802 while (c != ')');
713 *p = '\0'; 803 *p = '\0';
714 /* Output them. */ 804 /* Output them. */
715 if (ellcc) 805 if (ellcc)
716 fprintf (outfile, "\\n\\\n\\n\\\n"); 806 fprintf (outfile, "\\n\\\n\\n\\\n");
717 else 807 else
718 fprintf (outfile, "\n\n"); 808 fprintf (outfile, "\n\n");
719 write_c_args (outfile, buf, argbuf, minargs, maxargs); 809 write_c_args (outfile, buf, argbuf, minargs, maxargs);
720 } 810 }
721 if (ellcc) 811 if (ellcc)
722 fprintf (outfile, "\\n\");\n\n"); 812 fprintf (outfile, "\\n\");\n\n");
723 } 813 }
724 } 814 }
725 eof: 815 eof:
726 fclose (infile); 816 fclose (infile);
727 return 0; 817 return 0;
728 } 818 }
729 819
730 /* Read a file of Lisp code, compiled or interpreted. 820 /* Read a file of Lisp code, compiled or interpreted.
731 Looks for 821 Looks for
732 (defun NAME ARGS DOCSTRING ...) 822 (defun NAME ARGS DOCSTRING ...)
733 (defmacro NAME ARGS DOCSTRING ...) 823 (defmacro NAME ARGS DOCSTRING ...)
734 (autoload (quote NAME) FILE DOCSTRING ...) 824 (autoload (quote NAME) FILE DOCSTRING ...)
735 (defvar NAME VALUE DOCSTRING) 825 (defvar NAME VALUE DOCSTRING)
736 (defconst NAME VALUE DOCSTRING) 826 (defconst NAME VALUE DOCSTRING)
737 (fset (quote NAME) (make-byte-code ... DOCSTRING ...)) 827 (fset (quote NAME) (make-byte-code ... DOCSTRING ...))
738 (fset (quote NAME) #[... DOCSTRING ...]) 828 (fset (quote NAME) #[... DOCSTRING ...])
739 (defalias (quote NAME) #[... DOCSTRING ...]) 829 (defalias (quote NAME) #[... DOCSTRING ...])
740 starting in column zero. 830 starting in column zero.
741 (quote NAME) may appear as 'NAME as well. 831 (quote NAME) may appear as 'NAME as well.
742 832
743 We also look for #@LENGTH CONTENTS^_ at the beginning of the line. 833 We also look for #@LENGTH CONTENTS^_ at the beginning of the line.
744 When we find that, we save it for the following defining-form, 834 When we find that, we save it for the following defining-form,
745 and we use that instead of reading a doc string within that defining-form. 835 and we use that instead of reading a doc string within that defining-form.
746 836
790 *fillp++ = c; 880 *fillp++ = c;
791 } 881 }
792 882
793 if (! buffer[0]) 883 if (! buffer[0])
794 fprintf (stderr, "## expected a symbol, got '%c'\n", c); 884 fprintf (stderr, "## expected a symbol, got '%c'\n", c);
795 885
796 skip_white (infile); 886 skip_white (infile);
797 } 887 }
798 888
799 static int 889 static int
800 scan_lisp_file (const char *filename, const char *mode) 890 scan_lisp_file (const char *filename, const char *mode)
805 895
806 infile = fopen (filename, mode); 896 infile = fopen (filename, mode);
807 if (infile == NULL) 897 if (infile == NULL)
808 { 898 {
809 perror (filename); 899 perror (filename);
810 return 0; /* No error */ 900 return 0; /* No error */
811 } 901 }
812 902
813 c = '\n'; 903 c = '\n';
814 while (!feof (infile)) 904 while (!feof (infile))
815 { 905 {
816 char buffer[BUFSIZ]; 906 char buffer[BUFSIZ];
817 char type; 907 char type;
818 908
819 if (c != '\n') 909 if (c != '\n')
820 { 910 {
821 c = getc (infile); 911 c = getc_skipping_iso2022 (infile);
822 continue; 912 continue;
823 } 913 }
824 c = getc (infile); 914 c = getc_skipping_iso2022 (infile);
825 /* Detect a dynamic doc string and save it for the next expression. */ 915 /* Detect a dynamic doc string and save it for the next expression. */
826 if (c == '#') 916 if (c == '#')
827 { 917 {
828 c = getc (infile); 918 c = getc_skipping_iso2022 (infile);
829 if (c == '@') 919 if (c == '@')
830 { 920 {
831 int length = 0; 921 int length = 0;
832 int i; 922 int i;
833 923
834 /* Read the length. */ 924 /* Read the length. */
835 while ((c = getc (infile), 925 while ((c = getc_skipping_iso2022 (infile),
836 c >= '0' && c <= '9')) 926 c >= '0' && c <= '9'))
837 { 927 {
838 length *= 10; 928 length *= 10;
839 length += c - '0'; 929 length += c - '0';
840 } 930 }
853 /* The last character is a ^_. 943 /* The last character is a ^_.
854 That is needed in the .elc file 944 That is needed in the .elc file
855 but it is redundant in DOC. So get rid of it here. */ 945 but it is redundant in DOC. So get rid of it here. */
856 saved_string[length - 1] = 0; 946 saved_string[length - 1] = 0;
857 /* Skip the newline. */ 947 /* Skip the newline. */
858 c = getc (infile); 948 c = getc_skipping_iso2022 (infile);
859 while (c != '\n') 949 while (c != '\n')
860 c = getc (infile); 950 c = getc_skipping_iso2022 (infile);
861 } 951 }
862 continue; 952 continue;
863 } 953 }
864 954
865 if (c != '(') 955 if (c != '(')
873 type = 'F'; 963 type = 'F';
874 read_lisp_symbol (infile, buffer); 964 read_lisp_symbol (infile, buffer);
875 965
876 /* Skip the arguments: either "nil" or a list in parens */ 966 /* Skip the arguments: either "nil" or a list in parens */
877 967
878 c = getc (infile); 968 c = getc_skipping_iso2022 (infile);
879 if (c == 'n') /* nil */ 969 if (c == 'n') /* nil */
880 { 970 {
881 if ((c = getc (infile)) != 'i' || 971 if ((c = getc_skipping_iso2022 (infile)) != 'i' ||
882 (c = getc (infile)) != 'l') 972 (c = getc_skipping_iso2022 (infile)) != 'l')
883 { 973 {
884 fprintf (stderr, "## unparsable arglist in %s (%s)\n", 974 fprintf (stderr, "## unparsable arglist in %s (%s)\n",
885 buffer, filename); 975 buffer, filename);
886 continue; 976 continue;
887 } 977 }
892 buffer, filename); 982 buffer, filename);
893 continue; 983 continue;
894 } 984 }
895 else 985 else
896 while (c != ')') 986 while (c != ')')
897 c = getc (infile); 987 c = getc_skipping_iso2022 (infile);
898 skip_white (infile); 988 skip_white (infile);
899 989
900 /* If the next three characters aren't `dquote bslash newline' 990 /* If the next three characters aren't `dquote bslash newline'
901 then we're not reading a docstring. 991 then we're not reading a docstring.
902 */ 992 */
903 if ((c = getc (infile)) != '"' || 993 if ((c = getc_skipping_iso2022 (infile)) != '"' ||
904 (c = getc (infile)) != '\\' || 994 (c = getc_skipping_iso2022 (infile)) != '\\' ||
905 (c = getc (infile)) != '\n') 995 (c = getc_skipping_iso2022 (infile)) != '\n')
906 { 996 {
907 #ifdef DEBUG 997 #ifdef DEBUG
908 fprintf (stderr, "## non-docstring in %s (%s)\n", 998 fprintf (stderr, "## non-docstring in %s (%s)\n",
909 buffer, filename); 999 buffer, filename);
910 #endif 1000 #endif
920 read_lisp_symbol (infile, buffer); 1010 read_lisp_symbol (infile, buffer);
921 1011
922 if (saved_string == 0) 1012 if (saved_string == 0)
923 { 1013 {
924 1014
925 /* Skip until the first newline; remember the two previous chars. */ 1015 /* Skip until the first newline; remember the two previous
1016 chars. */
926 while (c != '\n' && c >= 0) 1017 while (c != '\n' && c >= 0)
927 { 1018 {
928 /* #### Kludge -- Ignore any ESC x x ISO2022 sequences */
929 if (c == 27)
930 {
931 getc (infile);
932 getc (infile);
933 goto nextchar;
934 }
935
936 c2 = c1; 1019 c2 = c1;
937 c1 = c; 1020 c1 = c;
938 nextchar: 1021 c = getc_skipping_iso2022 (infile);
939 c = getc (infile);
940 } 1022 }
941 1023
942 /* If two previous characters were " and \, 1024 /* If two previous characters were " and \,
943 this is a doc string. Otherwise, there is none. */ 1025 this is a doc string. Otherwise, there is none. */
944 if (c2 != '"' || c1 != '\\') 1026 if (c2 != '"' || c1 != '\\')
955 else if (! strcmp (buffer, "fset") || ! strcmp (buffer, "defalias")) 1037 else if (! strcmp (buffer, "fset") || ! strcmp (buffer, "defalias"))
956 { 1038 {
957 char c1 = 0, c2 = 0; 1039 char c1 = 0, c2 = 0;
958 type = 'F'; 1040 type = 'F';
959 1041
960 c = getc (infile); 1042 c = getc_skipping_iso2022 (infile);
961 if (c == '\'') 1043 if (c == '\'')
962 read_lisp_symbol (infile, buffer); 1044 read_lisp_symbol (infile, buffer);
963 else 1045 else
964 { 1046 {
965 if (c != '(') 1047 if (c != '(')
974 fprintf (stderr, "## unparsable name in fset in %s\n", 1056 fprintf (stderr, "## unparsable name in fset in %s\n",
975 filename); 1057 filename);
976 continue; 1058 continue;
977 } 1059 }
978 read_lisp_symbol (infile, buffer); 1060 read_lisp_symbol (infile, buffer);
979 c = getc (infile); 1061 c = getc_skipping_iso2022 (infile);
980 if (c != ')') 1062 if (c != ')')
981 { 1063 {
982 fprintf (stderr, 1064 fprintf (stderr,
983 "## unparsable quoted name in fset in %s\n", 1065 "## unparsable quoted name in fset in %s\n",
984 filename); 1066 filename);
986 } 1068 }
987 } 1069 }
988 1070
989 if (saved_string == 0) 1071 if (saved_string == 0)
990 { 1072 {
991 /* Skip until the first newline; remember the two previous chars. */ 1073 /* Skip until the first newline; remember the two previous
1074 chars. */
992 while (c != '\n' && c >= 0) 1075 while (c != '\n' && c >= 0)
993 { 1076 {
994 c2 = c1; 1077 c2 = c1;
995 c1 = c; 1078 c1 = c;
996 c = getc (infile); 1079 c = getc_skipping_iso2022 (infile);
997 } 1080 }
998 1081
999 /* If two previous characters were " and \, 1082 /* If two previous characters were " and \,
1000 this is a doc string. Otherwise, there is none. */ 1083 this is a doc string. Otherwise, there is none. */
1001 if (c2 != '"' || c1 != '\\') 1084 if (c2 != '"' || c1 != '\\')
1010 } 1093 }
1011 1094
1012 else if (! strcmp (buffer, "autoload")) 1095 else if (! strcmp (buffer, "autoload"))
1013 { 1096 {
1014 type = 'F'; 1097 type = 'F';
1015 c = getc (infile); 1098 c = getc_skipping_iso2022 (infile);
1016 if (c == '\'') 1099 if (c == '\'')
1017 read_lisp_symbol (infile, buffer); 1100 read_lisp_symbol (infile, buffer);
1018 else 1101 else
1019 { 1102 {
1020 if (c != '(') 1103 if (c != '(')
1029 fprintf (stderr, "## unparsable name in autoload in %s\n", 1112 fprintf (stderr, "## unparsable name in autoload in %s\n",
1030 filename); 1113 filename);
1031 continue; 1114 continue;
1032 } 1115 }
1033 read_lisp_symbol (infile, buffer); 1116 read_lisp_symbol (infile, buffer);
1034 c = getc (infile); 1117 c = getc_skipping_iso2022 (infile);
1035 if (c != ')') 1118 if (c != ')')
1036 { 1119 {
1037 fprintf (stderr, 1120 fprintf (stderr,
1038 "## unparsable quoted name in autoload in %s\n", 1121 "## unparsable quoted name in autoload in %s\n",
1039 filename); 1122 filename);
1040 continue; 1123 continue;
1041 } 1124 }
1042 } 1125 }
1043 skip_white (infile); 1126 skip_white (infile);
1044 if ((c = getc (infile)) != '\"') 1127 if ((c = getc_skipping_iso2022 (infile)) != '\"')
1045 { 1128 {
1046 fprintf (stderr, "## autoload of %s unparsable (%s)\n", 1129 fprintf (stderr, "## autoload of %s unparsable (%s)\n",
1047 buffer, filename); 1130 buffer, filename);
1048 continue; 1131 continue;
1049 } 1132 }
1052 1135
1053 if (saved_string == 0) 1136 if (saved_string == 0)
1054 { 1137 {
1055 /* If the next three characters aren't `dquote bslash newline' 1138 /* If the next three characters aren't `dquote bslash newline'
1056 then we're not reading a docstring. */ 1139 then we're not reading a docstring. */
1057 if ((c = getc (infile)) != '"' || 1140 if ((c = getc_skipping_iso2022 (infile)) != '"' ||
1058 (c = getc (infile)) != '\\' || 1141 (c = getc_skipping_iso2022 (infile)) != '\\' ||
1059 (c = getc (infile)) != '\n') 1142 (c = getc_skipping_iso2022 (infile)) != '\n')
1060 { 1143 {
1061 #ifdef DEBUG 1144 #ifdef DEBUG
1062 fprintf (stderr, "## non-docstring in %s (%s)\n", 1145 fprintf (stderr, "## non-docstring in %s (%s)\n",
1063 buffer, filename); 1146 buffer, filename);
1064 #endif 1147 #endif
1065 continue; 1148 continue;
1066 } 1149 }
1067 } 1150 }
1068 } 1151 }
1069 1152
1070 #if 0 /* causes crash */ 1153 #if 0 /* causes crash */
1071 else if (! strcmp (buffer, "if") || 1154 else if (! strcmp (buffer, "if") ||
1072 ! strcmp (buffer, "byte-code")) 1155 ! strcmp (buffer, "byte-code"))
1073 ; 1156 ;
1074 #endif 1157 #endif
1075 1158
1083 } 1166 }
1084 1167
1085 /* At this point, we should either use the previous 1168 /* At this point, we should either use the previous
1086 dynamic doc string in saved_string 1169 dynamic doc string in saved_string
1087 or gobble a doc string from the input file. 1170 or gobble a doc string from the input file.
1088 1171
1089 In the latter case, the opening quote (and leading 1172 In the latter case, the opening quote (and leading
1090 backslash-newline) have already been read. */ 1173 backslash-newline) have already been read. */
1091 putc ('\n', outfile); /* XEmacs addition */ 1174 putc ('\n', outfile); /* XEmacs addition */
1092 putc (037, outfile); 1175 putc (037, outfile);
1093 putc (type, outfile); 1176 putc (type, outfile);
1094 fprintf (outfile, "%s\n", buffer); 1177 fprintf (outfile, "%s\n", buffer);
1095 if (saved_string) 1178 if (saved_string)
1096 { 1179 {