Mercurial > hg > xemacs-beta
annotate lib-src/make-docfile.c @ 4589:03ec57ae1d1e
YAFMT
| author | Stephen J. Turnbull <stephen@xemacs.org> |
|---|---|
| date | Sat, 31 Jan 2009 22:47:43 +0900 |
| parents | 061e030e3270 |
| children | f3a65dff1912 |
| rev | line source |
|---|---|
| 428 | 1 /* Generate doc-string file for XEmacs from source files. |
| 930 | 2 Copyright (C) 1985, 86, 92, 93, 94, 97, 1999, 2000, 2001 |
| 3 Free Software Foundation, Inc. | |
| 428 | 4 Copyright (C) 1995 Board of Trustees, University of Illinois. |
| 5 Copyright (C) 1998, 1999 J. Kean Johnston. | |
| 814 | 6 Copyright (C) 2001, 2002 Ben Wing. |
| 930 | 7 |
| 8 This file is part of XEmacs. | |
| 9 | |
| 10 XEmacs is free software; you can redistribute it and/or modify | |
| 11 it under the terms of the GNU General Public License as published by | |
| 12 the Free Software Foundation; either version 2, or (at your option) | |
| 13 any later version. | |
| 428 | 14 |
| 930 | 15 XEmacs is distributed in the hope that it will be useful, |
| 16 but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 17 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| 18 GNU General Public License for more details. | |
| 19 | |
| 20 You should have received a copy of the GNU General Public License | |
| 21 along with XEmacs; see the file COPYING. If not, write to | |
| 22 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 23 Boston, MA 02111-1307, USA. */ | |
| 24 | |
| 1618 | 25 /* Synched up with: FSF 21.3. */ |
| 428 | 26 |
| 27 /* The arguments given to this program are all the C and Lisp source files | |
| 930 | 28 of XEmacs. .elc and .el and .c files are allowed. |
| 29 A .o or .obj file can also be specified; the .c file it was made from is used. | |
| 30 This helps the makefile pass the correct list of files. | |
| 31 | |
| 32 The results, which go to standard output or to a file | |
| 33 specified with -a or -o (-a to append, -o to start from nothing), | |
| 34 are entries containing function or variable names and their documentation. | |
| 35 Each entry starts with a ^_ character. | |
| 36 Then comes F for a function or V for a variable. | |
| 37 Then comes the function or variable name, terminated with a newline. | |
| 38 Then comes the documentation for that function or variable. | |
| 39 | |
| 40 Added 19.15/20.1: `-i site-packages' allow installer to dump extra packages | |
| 41 without modifying Makefiles, etc. | |
| 428 | 42 */ |
| 43 | |
| 438 | 44 #include <config.h> |
| 930 | 45 #include <sysfile.h> |
| 428 | 46 |
| 3368 | 47 #include <assert.h> |
| 428 | 48 #include <stdio.h> |
| 49 #include <stdlib.h> | |
| 50 #include <string.h> | |
| 51 #include <ctype.h> | |
| 52 | |
| 2286 | 53 #include "compiler.h" |
| 54 | |
| 930 | 55 /* XEmacs addition */ |
| 56 #define C_IDENTIFIER_CHAR_P(c) \ | |
| 57 (('A' <= c && c <= 'Z') || \ | |
| 58 ('a' <= c && c <= 'z') || \ | |
| 59 ('0' <= c && c <= '9') || \ | |
| 60 (c == '_')) | |
| 428 | 61 |
| 3368 | 62 static void put_filename (const char *filename); |
| 442 | 63 static int scan_file (const char *filename); |
| 428 | 64 static int read_c_string (FILE *, int, int); |
| 442 | 65 static void write_c_args (FILE *out, const char *func, char *buf, int minargs, |
| 428 | 66 int maxargs); |
| 442 | 67 static int scan_c_file (const char *filename, const char *mode); |
| 428 | 68 static void skip_white (FILE *); |
| 69 static void read_lisp_symbol (FILE *, char *); | |
| 442 | 70 static int scan_lisp_file (const char *filename, const char *mode); |
| 428 | 71 |
| 930 | 72 /* Stdio stream for output to the DOC file. */ |
| 73 static FILE *outfile; | |
| 74 | |
| 75 /* XEmacs addition */ | |
| 76 enum | |
| 77 { | |
| 78 el_file, | |
| 79 elc_file, | |
| 80 c_file | |
| 81 } Current_file_type; | |
| 428 | 82 |
| 83 /* Name this program was invoked with. */ | |
| 84 char *progname; | |
| 85 | |
| 930 | 86 /* XEmacs addition: set to 1 if this was invoked by ellcc */ |
| 428 | 87 int ellcc = 0; |
| 88 | |
| 89 /* Print error message. `s1' is printf control string, `s2' is arg for it. */ | |
| 90 | |
| 91 static void | |
| 442 | 92 error (const char *s1, const char *s2) |
| 428 | 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 static void | |
| 442 | 102 fatal (const char *s1, const char *s2) |
| 428 | 103 { |
| 104 error (s1, s2); | |
| 105 exit (1); | |
| 106 } | |
| 107 | |
| 108 /* Like malloc but get fatal error if memory is exhausted. */ | |
| 109 | |
| 110 static long * | |
| 111 xmalloc (unsigned int size) | |
| 112 { | |
| 113 long *result = (long *) malloc (size); | |
| 114 if (result == NULL) | |
| 115 fatal ("virtual memory exhausted", 0); | |
| 116 return result; | |
| 117 } | |
| 118 | |
| 930 | 119 /* XEmacs addition */ |
| 428 | 120 static char * |
| 814 | 121 next_extra_elc (char *extra_elcs) |
| 428 | 122 { |
| 123 static FILE *fp = NULL; | |
| 124 static char line_buf[BUFSIZ]; | |
| 125 char *p = line_buf+1; | |
| 126 | |
| 814 | 127 if (!fp) |
| 128 { | |
| 129 if (!extra_elcs) | |
| 130 return NULL; | |
| 131 else if (!(fp = fopen (extra_elcs, READ_BINARY))) | |
| 132 { | |
| 133 /* It is not an error if this file doesn't exist. */ | |
| 134 /*fatal ("error opening site package file list", 0);*/ | |
| 135 return NULL; | |
| 136 } | |
| 137 fgets (line_buf, BUFSIZ, fp); | |
| 138 } | |
| 139 | |
| 930 | 140 do |
| 814 | 141 { |
| 930 | 142 if (!fgets (line_buf, BUFSIZ, fp)) |
| 143 { | |
| 144 fclose (fp); | |
| 145 fp = NULL; | |
| 146 return NULL; | |
| 147 } | |
| 148 line_buf[0] = '\0'; | |
| 814 | 149 /* reject too short or too long lines */ |
| 930 | 150 } while (strlen (p) <= 2 || strlen (p) >= (BUFSIZ - 5)); |
| 151 | |
| 814 | 152 p[strlen (p) - 2] = '\0'; |
| 153 strcat (p, ".elc"); | |
| 428 | 154 |
| 155 return p; | |
| 156 } | |
| 157 | |
| 158 | |
| 159 int | |
| 160 main (int argc, char **argv) | |
| 161 { | |
| 162 int i; | |
| 163 int err_count = 0; | |
| 164 int first_infile; | |
| 930 | 165 char *extra_elcs = NULL; /* XEmacs addition */ |
| 428 | 166 |
| 167 progname = argv[0]; | |
| 168 | |
| 169 outfile = stdout; | |
| 170 | |
| 171 /* Don't put CRs in the DOC file. */ | |
| 442 | 172 #ifdef WIN32_NATIVE |
| 428 | 173 _fmode = O_BINARY; |
| 174 _setmode (fileno (stdout), O_BINARY); | |
| 442 | 175 #endif /* WIN32_NATIVE */ |
| 428 | 176 |
| 177 /* If first two args are -o FILE, output to FILE. */ | |
| 178 i = 1; | |
| 179 if (argc > i + 1 && !strcmp (argv[i], "-o")) | |
| 180 { | |
| 181 outfile = fopen (argv[i + 1], WRITE_BINARY); | |
| 182 i += 2; | |
| 183 } | |
| 184 if (argc > i + 1 && !strcmp (argv[i], "-a")) | |
| 185 { | |
| 186 outfile = fopen (argv[i + 1], APPEND_BINARY); | |
| 187 i += 2; | |
| 188 } | |
| 930 | 189 if (argc > i + 1 && !strcmp (argv[i], "-d")) |
| 190 { | |
| 191 chdir (argv[i + 1]); | |
| 192 i += 2; | |
| 193 } | |
| 194 | |
| 195 /* Additional command line arguments for XEmacs */ | |
| 428 | 196 if (argc > i + 1 && !strcmp (argv[i], "-E")) |
| 197 { | |
| 198 outfile = fopen (argv[i + 1], APPEND_BINARY); | |
| 199 i += 2; | |
| 200 ellcc = 1; | |
| 201 } | |
| 814 | 202 if (argc > (i + 1) && !strcmp (argv[i], "-i")) |
| 203 { | |
| 204 extra_elcs = argv[i + 1]; | |
| 205 i += 2; | |
| 206 } | |
| 428 | 207 |
| 208 if (outfile == 0) | |
| 209 fatal ("No output file specified", ""); | |
| 210 | |
| 930 | 211 /* XEmacs addition */ |
| 428 | 212 if (ellcc) |
| 213 fprintf (outfile, "{\n"); | |
| 214 | |
| 215 first_infile = i; | |
| 216 for (; i < argc; i++) | |
| 217 { | |
| 930 | 218 /* XEmacs addition: the "if" clause is new; the "else" clause is the |
| 219 original FSF Emacs code */ | |
| 771 | 220 if (argv[i][0] == '@') |
| 221 { | |
| 222 /* Allow a file containing files to process, for use w/MS Windows | |
| 223 (where command-line length limits are more problematic) */ | |
| 224 FILE *argfile = fopen (argv[i] + 1, READ_TEXT); | |
| 2421 | 225 char arg[QXE_PATH_MAX]; |
| 771 | 226 |
| 227 if (!argfile) | |
| 228 fatal ("Unable to open argument file %s", argv[i] + 1); | |
| 2421 | 229 while (fgets (arg, QXE_PATH_MAX, argfile)) |
| 771 | 230 { |
| 231 if (arg[strlen (arg) - 1] == '\n') | |
| 232 arg[strlen (arg) - 1] = '\0'; /* chop \n */ | |
| 233 err_count += scan_file (arg); | |
| 234 } | |
| 235 } | |
|
4539
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4456
diff
changeset
|
236 else if (argc > i + 1 && !strcmp (argv[i], "-d")) |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4456
diff
changeset
|
237 { |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4456
diff
changeset
|
238 /* XEmacs change; allow more than one chdir. |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4456
diff
changeset
|
239 The idea is that the second chdir is to source-lisp, and that |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4456
diff
changeset
|
240 any Lisp files not under there have the full path specified. */ |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4456
diff
changeset
|
241 i += 1; |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4456
diff
changeset
|
242 chdir (argv[i]); |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4456
diff
changeset
|
243 continue; |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4456
diff
changeset
|
244 } |
| 771 | 245 else |
| 246 { | |
| 247 int j; | |
| 248 /* Don't process one file twice. */ | |
| 249 for (j = first_infile; j < i; j++) | |
| 250 if (! strcmp (argv[i], argv[j])) | |
| 251 break; | |
| 252 if (j == i) | |
| 253 err_count += scan_file (argv[i]); | |
| 254 } | |
| 428 | 255 } |
| 256 | |
| 930 | 257 /* XEmacs addition */ |
| 814 | 258 if (extra_elcs) |
| 259 { | |
| 260 char *p; | |
| 428 | 261 |
| 814 | 262 while ((p = next_extra_elc (extra_elcs)) != NULL) |
| 263 err_count += scan_file (p); | |
| 428 | 264 } |
| 265 | |
| 266 putc ('\n', outfile); | |
| 267 if (ellcc) | |
| 268 fprintf (outfile, "}\n\n"); | |
| 930 | 269 /* End XEmacs addition */ |
| 270 | |
| 428 | 271 #ifndef VMS |
| 272 exit (err_count > 0); | |
| 273 #endif /* VMS */ | |
| 274 return err_count > 0; | |
| 275 } | |
| 276 | |
| 3368 | 277 /* Add a source file name boundary in the output file. */ |
| 278 static void | |
| 279 put_filename (const char *filename) | |
| 280 { | |
|
4539
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4456
diff
changeset
|
281 /* XEmacs change; don't strip directory information. */ |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4456
diff
changeset
|
282 #if 0 |
| 3368 | 283 const char *tmp; |
| 284 | |
| 285 for (tmp = filename; *tmp; tmp++) | |
| 286 { | |
| 287 if (IS_DIRECTORY_SEP(*tmp)) | |
| 288 filename = tmp + 1; | |
| 289 } | |
|
4539
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4456
diff
changeset
|
290 #endif |
| 3368 | 291 |
| 292 /* <= because sizeof includes the nul byte at the end. Not quite right, | |
| 293 because it should include the length of the symbol + "\037[VF]" instead | |
| 294 of simply 10. */ | |
| 295 assert(sizeof("\037S\n") + strlen(filename) + 10 | |
| 296 <= DOC_MAX_FILENAME_LENGTH); | |
| 297 | |
| 298 putc (037, outfile); | |
| 299 putc ('S', outfile); | |
| 300 fprintf (outfile, "%s\n", filename); | |
| 301 } | |
| 302 | |
| 428 | 303 /* Read file FILENAME and output its doc strings to outfile. */ |
| 304 /* Return 1 if file is not found, 0 if it is found. */ | |
| 305 | |
| 306 static int | |
| 442 | 307 scan_file (const char *filename) |
| 428 | 308 { |
| 309 int len = strlen (filename); | |
| 930 | 310 |
| 311 /* XEmacs change: test ellcc and set Current_file_type in each case */ | |
| 428 | 312 if (ellcc == 0 && len > 4 && !strcmp (filename + len - 4, ".elc")) |
| 313 { | |
| 314 Current_file_type = elc_file; | |
| 315 return scan_lisp_file (filename, READ_BINARY); | |
| 316 } | |
| 317 else if (ellcc == 0 && len > 3 && !strcmp (filename + len - 3, ".el")) | |
| 318 { | |
| 319 Current_file_type = el_file; | |
|
4456
c785f98c6737
Pass READ_BINARY to scan_lisp_file, scan_c_file in make-docfile.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
3368
diff
changeset
|
320 return scan_lisp_file (filename, READ_BINARY); |
| 428 | 321 } |
| 322 else | |
| 323 { | |
| 324 Current_file_type = c_file; | |
|
4456
c785f98c6737
Pass READ_BINARY to scan_lisp_file, scan_c_file in make-docfile.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
3368
diff
changeset
|
325 return scan_c_file (filename, READ_BINARY); |
| 428 | 326 } |
| 327 } | |
| 930 | 328 |
| 329 /* XEmacs addition: ISO 2022 handling */ | |
| 814 | 330 static int |
| 331 getc_skipping_iso2022 (FILE *file) | |
| 332 { | |
| 333 register int c; | |
| 334 /* #### Kludge -- Ignore any ISO2022 sequences */ | |
| 335 c = getc (file); | |
| 336 while (c == 27) | |
| 337 { | |
| 338 c = getc (file); | |
| 339 if (c == '$') | |
| 340 c = getc (file); | |
| 341 if (c >= '(' && c <= '/') | |
| 342 c = getc (file); | |
| 343 c = getc (file); | |
| 344 } | |
| 345 return c; | |
| 346 } | |
| 347 | |
| 348 enum iso2022_state | |
| 349 { | |
| 350 ISO_NOTHING, | |
| 351 ISO_ESC, | |
| 352 ISO_DOLLAR, | |
| 353 ISO_FINAL_IS_NEXT, | |
| 354 ISO_DOLLAR_AND_FINAL_IS_NEXT | |
| 355 }; | |
| 356 | |
| 357 static int non_ascii_p; | |
| 358 | |
| 359 static int | |
| 360 getc_iso2022 (FILE *file) | |
| 361 { | |
| 362 /* #### Kludge -- Parse ISO2022 sequences (more or less) */ | |
| 363 static enum iso2022_state state; | |
| 364 static int prevc; | |
| 365 register int c; | |
| 366 c = getc (file); | |
| 367 switch (state) | |
| 368 { | |
| 369 case ISO_NOTHING: | |
| 370 if (c == 27) | |
| 371 state = ISO_ESC; | |
| 372 break; | |
| 373 | |
| 374 case ISO_ESC: | |
| 375 if (c == '$') | |
| 376 state = ISO_DOLLAR; | |
| 377 else if (c >= '(' && c <= '/') | |
| 378 state = ISO_FINAL_IS_NEXT; | |
| 379 else | |
| 380 state = ISO_NOTHING; | |
| 381 break; | |
| 382 | |
| 383 case ISO_DOLLAR: | |
| 384 if (c >= '(' && c <= '/') | |
| 385 state = ISO_DOLLAR_AND_FINAL_IS_NEXT; | |
| 386 else if (c >= '@' && c <= 'B') /* ESC $ @ etc */ | |
| 387 { | |
| 388 non_ascii_p = 1; | |
| 389 state = ISO_NOTHING; | |
| 390 } | |
| 391 else | |
| 392 state = ISO_NOTHING; | |
| 393 break; | |
| 394 | |
| 395 case ISO_FINAL_IS_NEXT: | |
| 396 if (prevc == '(' && c == 'B') /* ESC ( B, invoke ASCII */ | |
| 397 non_ascii_p = 0; | |
| 398 else if (prevc == '(' || prevc == ',') /* ESC ( x or ESC , x */ | |
| 399 non_ascii_p = 1; | |
| 400 state = ISO_NOTHING; | |
| 401 break; | |
| 402 | |
| 403 case ISO_DOLLAR_AND_FINAL_IS_NEXT: | |
| 404 if (prevc == '(' || prevc == ',') /* ESC $ ( x or ESC $ , x */ | |
| 405 non_ascii_p = 1; | |
| 406 state = ISO_NOTHING; | |
| 407 break; | |
| 408 } | |
| 409 | |
| 410 prevc = c; | |
| 411 return c; | |
| 412 } | |
| 413 | |
| 428 | 414 |
| 1111 | 415 char globalbuf[128]; |
| 428 | 416 |
| 417 /* Skip a C string from INFILE, | |
| 930 | 418 and return the character that follows the closing ". |
| 428 | 419 If printflag is positive, output string contents to outfile. |
| 420 If it is negative, store contents in buf. | |
| 421 Convert escape sequences \n and \t to newline and tab; | |
| 422 discard \ followed by newline. */ | |
| 423 | |
| 814 | 424 #define MDGET do { prevc = c; c = getc_iso2022 (infile); } while (0) |
| 428 | 425 static int |
| 426 read_c_string (FILE *infile, int printflag, int c_docstring) | |
| 427 { | |
| 442 | 428 register int prevc = 0, c = 0; |
| 1111 | 429 char *p = globalbuf; |
| 930 | 430 int start = -1; /* XEmacs addition */ |
| 428 | 431 |
| 442 | 432 MDGET; |
| 428 | 433 while (c != EOF) |
| 434 { | |
| 814 | 435 while ((c_docstring || c != '"' || non_ascii_p) && c != EOF) |
| 428 | 436 { |
| 930 | 437 /* XEmacs addition: the first two "if" clauses are new */ |
| 814 | 438 if (c == '*' && !non_ascii_p) |
| 428 | 439 { |
| 442 | 440 int cc = getc (infile); |
| 441 if (cc == '/') | |
| 428 | 442 { |
| 442 | 443 if (prevc != '\n') |
| 444 { | |
| 445 if (printflag > 0) | |
| 446 { | |
| 447 if (ellcc) | |
| 448 fprintf (outfile, "\\n\\"); | |
| 449 putc ('\n', outfile); | |
| 450 } | |
| 451 else if (printflag < 0) | |
| 452 *p++ = '\n'; | |
| 453 } | |
| 454 break; | |
| 428 | 455 } |
| 442 | 456 else |
| 457 ungetc (cc, infile); | |
| 458 } | |
| 428 | 459 |
| 442 | 460 if (start == 1) |
| 461 { | |
| 462 if (printflag > 0) | |
| 428 | 463 { |
| 442 | 464 if (ellcc) |
| 465 fprintf (outfile, "\\n\\"); | |
| 466 putc ('\n', outfile); | |
| 428 | 467 } |
| 442 | 468 else if (printflag < 0) |
| 469 *p++ = '\n'; | |
| 428 | 470 } |
| 930 | 471 /* End XEmacs addition */ |
| 428 | 472 |
| 814 | 473 if (c == '\\' && !non_ascii_p) |
| 428 | 474 { |
| 442 | 475 MDGET; |
| 428 | 476 if (c == '\n') |
| 477 { | |
| 442 | 478 MDGET; |
| 428 | 479 start = 1; |
| 480 continue; | |
| 481 } | |
| 482 if (!c_docstring && c == 'n') | |
| 483 c = '\n'; | |
| 484 if (c == 't') | |
| 485 c = '\t'; | |
| 486 } | |
| 930 | 487 |
| 488 /* XEmacs change: the "if" clause is new; the "else" clause is | |
| 489 mostly the original FSF Emacs code */ | |
| 428 | 490 if (c == '\n') |
| 491 start = 1; | |
| 492 else | |
| 493 { | |
| 494 start = 0; | |
| 442 | 495 if (printflag > 0) |
| 496 { | |
| 814 | 497 if (ellcc && c == '"' && !non_ascii_p) |
| 442 | 498 putc ('\\', outfile); |
| 499 putc (c, outfile); | |
| 500 } | |
| 428 | 501 else if (printflag < 0) |
| 502 *p++ = c; | |
| 503 } | |
| 442 | 504 MDGET; |
| 428 | 505 } |
| 930 | 506 /* XEmacs change: look for continuation of string */ |
| 428 | 507 if (Current_file_type == c_file) |
| 508 { | |
| 442 | 509 do |
| 510 { | |
| 511 MDGET; | |
| 512 } | |
| 513 while (isspace (c)); | |
| 814 | 514 if (c != '"' || non_ascii_p) |
| 428 | 515 break; |
| 516 } | |
| 517 else | |
| 518 { | |
| 442 | 519 MDGET; |
| 814 | 520 if (c != '"' || non_ascii_p) |
| 428 | 521 break; |
| 522 /* If we had a "", concatenate the two strings. */ | |
| 523 } | |
| 442 | 524 MDGET; |
| 428 | 525 } |
| 930 | 526 |
| 428 | 527 if (printflag < 0) |
| 528 *p = 0; | |
| 930 | 529 |
| 428 | 530 return c; |
| 531 } | |
| 532 | |
| 533 /* Write to file OUT the argument names of function FUNC, whose text is in BUF. | |
| 534 MINARGS and MAXARGS are the minimum and maximum number of arguments. */ | |
| 535 | |
| 536 static void | |
| 2286 | 537 write_c_args (FILE *out, const char *UNUSED (func), char *buf, |
| 538 int minargs, int maxargs) | |
| 428 | 539 { |
| 540 register char *p; | |
| 541 int in_ident = 0; | |
| 542 int just_spaced = 0; | |
| 543 #if 0 | |
| 544 int need_space = 1; | |
| 545 | |
| 546 fprintf (out, "(%s", func); | |
| 547 #else | |
| 548 /* XEmacs - "arguments:" is for parsing the docstring. FSF's help system | |
| 549 doesn't parse the docstring for arguments like we do, so we're also | |
| 550 going to omit the function name to preserve compatibility with elisp | |
| 551 that parses the docstring. Finally, not prefixing the arglist with | |
| 552 anything is asking for trouble because it's not uncommon to have an | |
| 553 unescaped parenthesis at the beginning of a line. --Stig */ | |
| 554 fprintf (out, "arguments: ("); | |
| 555 #endif | |
| 556 | |
| 930 | 557 if (*buf == '(') |
| 558 ++buf; | |
| 428 | 559 |
| 930 | 560 for (p = buf; *p; p++) |
| 428 | 561 { |
| 562 char c = *p; | |
| 563 int ident_start = 0; | |
| 564 | |
| 2603 | 565 /* XEmacs addition: add support for ANSI prototypes and the UNUSED |
| 566 macros. Hop over them. "Lisp_Object" is the only C type allowed | |
| 567 in DEFUNs. For the UNUSED macros we need to eat parens, too. */ | |
| 568 static char uu [] = "UNUSED"; | |
| 569 static char ui [] = "USED_IF_"; | |
| 428 | 570 static char lo[] = "Lisp_Object"; |
| 2603 | 571 |
| 572 /* aren't these all vulnerable to buffer overrun? I guess that | |
| 573 means that the .c is busted, so we may as well just die ... */ | |
| 574 /* skip over "Lisp_Object" */ | |
| 428 | 575 if ((C_IDENTIFIER_CHAR_P (c) != in_ident) && !in_ident && |
| 576 (strncmp (p, lo, sizeof (lo) - 1) == 0) && | |
| 930 | 577 isspace ((unsigned char) p[sizeof (lo) - 1])) |
| 428 | 578 { |
| 579 p += (sizeof (lo) - 1); | |
| 438 | 580 while (isspace ((unsigned char) (*p))) |
| 428 | 581 p++; |
| 582 c = *p; | |
| 583 } | |
| 584 | |
| 2603 | 585 /* skip over "UNUSED" invocation */ |
| 586 if ((C_IDENTIFIER_CHAR_P (c) != in_ident) && !in_ident && | |
| 587 (strncmp (p, uu, sizeof (uu) - 1) == 0)) | |
| 588 { | |
| 589 char *here = p; | |
| 590 p += (sizeof (uu) - 1); | |
| 591 while (isspace ((unsigned char) (*p))) | |
| 592 p++; | |
| 593 if (*p == '(') | |
| 594 { | |
| 595 while (isspace ((unsigned char) (*++p))) | |
| 596 ; | |
| 597 c = *p; | |
| 598 } | |
| 599 else | |
| 600 p = here; | |
| 601 } | |
| 602 | |
| 603 /* skip over "USED_IF_*" invocation (only if USED failed) */ | |
| 604 else if ((C_IDENTIFIER_CHAR_P (c) != in_ident) && !in_ident && | |
| 605 (strncmp (p, ui, sizeof (ui) - 1) == 0)) | |
| 606 { | |
| 607 char *here = p; | |
| 608 p += (sizeof (ui) - 1); | |
| 609 /* There should be a law against parsing in C: | |
| 610 this allows a broken USED_IF call, skipping to next macro's | |
| 611 parens. *You* can fix that, I don't see how offhand. ;-) */ | |
| 612 while (*p && *p++ != '(') | |
| 613 ; | |
| 614 if (*p) | |
| 615 { | |
| 616 while (isspace ((unsigned char) (*p))) | |
| 617 p++; | |
| 618 c = *p; | |
| 619 } | |
| 620 else | |
| 621 p = here; | |
| 622 } | |
| 623 | |
| 428 | 624 /* Notice when we start printing a new identifier. */ |
| 625 if (C_IDENTIFIER_CHAR_P (c) != in_ident) | |
| 626 { | |
| 627 if (!in_ident) | |
| 628 { | |
| 629 in_ident = 1; | |
| 630 ident_start = 1; | |
| 631 #if 0 | |
| 632 /* XEmacs - This goes along with the change above. */ | |
| 633 if (need_space) | |
| 634 putc (' ', out); | |
| 635 #endif | |
| 636 if (minargs == 0 && maxargs > 0) | |
| 637 fprintf (out, "&optional "); | |
| 638 just_spaced = 1; | |
| 639 | |
| 640 minargs--; | |
| 641 maxargs--; | |
| 642 } | |
| 643 else | |
| 644 in_ident = 0; | |
| 645 } | |
| 646 | |
| 647 /* Print the C argument list as it would appear in lisp: | |
| 930 | 648 print underscores as hyphens, and print commas and newlines |
| 649 as spaces. Collapse adjacent spaces into one. */ | |
| 650 if (c == '_') | |
| 651 c = '-'; | |
| 1618 | 652 else if (c == ',' /* || c == '\n' */) |
| 930 | 653 c = ' '; |
| 1618 | 654 /* XEmacs change: handle \n below for readability */ |
| 428 | 655 |
| 930 | 656 #if 0 |
| 657 /* In C code, `default' is a reserved word, so we spell it | |
| 658 `defalt'; unmangle that here. */ | |
| 659 if (ident_start | |
| 660 && strncmp (p, "defalt", 6) == 0 | |
| 661 && ! (('A' <= p[6] && p[6] <= 'Z') | |
| 662 || ('a' <= p[6] && p[6] <= 'z') | |
| 663 || ('0' <= p[6] && p[6] <= '9') | |
| 664 || p[6] == '_')) | |
| 665 { | |
| 666 fprintf (out, "DEFAULT"); | |
| 667 p += 5; | |
| 668 in_ident = 0; | |
| 669 just_spaced = 0; | |
| 670 } | |
| 671 #endif | |
| 428 | 672 /* If the C argument name ends with `_', change it to ' ', |
| 673 to allow use of C reserved words or global symbols as Lisp args. */ | |
| 674 if (c == '-' && ! C_IDENTIFIER_CHAR_P (p[1])) | |
| 675 { | |
| 676 in_ident = 0; | |
| 677 just_spaced = 0; | |
| 678 } | |
| 1618 | 679 /* XEmacs change: if the character is carriage return or linefeed, |
| 680 escape it for the compiler */ | |
| 681 else if (c == '\n') | |
| 682 { | |
| 683 putc('\\', out); | |
| 684 putc('\n', out); | |
| 685 } | |
| 686 else if (c == '\r') | |
| 687 { | |
| 688 putc('\\', out); | |
| 689 putc('\r', out); | |
| 690 } | |
| 930 | 691 else if (c != ' ' || !just_spaced) |
| 428 | 692 { |
| 693 if (c >= 'a' && c <= 'z') | |
| 694 /* Upcase the letter. */ | |
| 695 c += 'A' - 'a'; | |
| 696 putc (c, out); | |
| 697 } | |
| 698 | |
| 699 just_spaced = (c == ' '); | |
| 700 #if 0 | |
| 701 need_space = 0; | |
| 702 #endif | |
| 703 } | |
| 930 | 704 /* XEmacs addition */ |
| 428 | 705 if (!ellcc) |
| 930 | 706 putc ('\n', out); |
| 428 | 707 } |
| 708 | |
| 771 | 709 /* Read through a c file. If a .o or .obj file is named, |
| 428 | 710 the corresponding .c file is read instead. |
| 711 Looks for DEFUN constructs such as are defined in ../src/lisp.h. | |
| 930 | 712 Accepts any word starting DEF... so it finds DEFSIMPLE and DEFPRED ... |
| 713 which don't exist anymore! */ | |
| 428 | 714 |
| 715 static int | |
| 442 | 716 scan_c_file (const char *filename, const char *mode) |
| 428 | 717 { |
| 718 FILE *infile; | |
| 719 register int c; | |
| 720 register int commas; | |
| 721 register int defunflag; | |
| 722 register int defvarperbufferflag = 0; | |
| 723 register int defvarflag; | |
| 724 int minargs, maxargs; | |
| 725 int l = strlen (filename); | |
| 2421 | 726 char f[QXE_PATH_MAX]; |
| 428 | 727 |
| 930 | 728 /* XEmacs change: different method for checking filename extension */ |
| 2421 | 729 if (l > QXE_PATH_MAX - 1) |
| 647 | 730 { |
| 428 | 731 #ifdef ENAMETOOLONG |
| 647 | 732 errno = ENAMETOOLONG; |
| 428 | 733 #else |
| 647 | 734 errno = EINVAL; |
| 428 | 735 #endif |
| 930 | 736 return 0; |
| 647 | 737 } |
| 428 | 738 |
| 739 strcpy (f, filename); | |
| 771 | 740 if (l > 4 && !strcmp (f + l - 4, ".obj")) /* MS Windows */ |
| 741 strcpy (f + l - 4, ".c"); | |
| 428 | 742 if (f[l - 1] == 'o') |
| 743 f[l - 1] = 'c'; | |
| 744 infile = fopen (f, mode); | |
| 745 | |
| 746 /* No error if non-ex input file */ | |
| 747 if (infile == NULL) | |
| 748 { | |
| 749 perror (f); | |
| 750 return 0; | |
| 751 } | |
| 752 | |
| 930 | 753 #if 0 |
| 754 /* Reset extension to be able to detect duplicate files. */ | |
| 755 filename[strlen (filename) - 1] = extension; | |
| 756 #endif | |
| 757 | |
| 428 | 758 c = '\n'; |
| 759 while (!feof (infile)) | |
| 760 { | |
| 761 if (c != '\n') | |
| 762 { | |
| 763 c = getc (infile); | |
| 764 continue; | |
| 765 } | |
| 766 c = getc (infile); | |
| 767 if (c == ' ') | |
| 768 { | |
| 769 while (c == ' ') | |
| 770 c = getc (infile); | |
| 771 if (c != 'D') | |
| 772 continue; | |
| 773 c = getc (infile); | |
| 774 if (c != 'E') | |
| 775 continue; | |
| 776 c = getc (infile); | |
| 777 if (c != 'F') | |
| 778 continue; | |
| 779 c = getc (infile); | |
| 780 if (c != 'V') | |
| 781 continue; | |
| 782 c = getc (infile); | |
| 783 if (c != 'A') | |
| 784 continue; | |
| 785 c = getc (infile); | |
| 786 if (c != 'R') | |
| 787 continue; | |
| 788 c = getc (infile); | |
| 789 if (c != '_') | |
| 790 continue; | |
| 791 | |
| 792 defvarflag = 1; | |
| 793 defunflag = 0; | |
| 794 | |
| 795 c = getc (infile); | |
| 796 /* Note that this business doesn't apply under XEmacs. | |
| 797 DEFVAR_BUFFER_LOCAL in XEmacs behaves normally. */ | |
| 798 defvarperbufferflag = (c == 'P'); | |
| 799 | |
| 800 c = getc (infile); | |
| 801 } | |
| 802 else if (c == 'D') | |
| 803 { | |
| 804 c = getc (infile); | |
| 805 if (c != 'E') | |
| 806 continue; | |
| 807 c = getc (infile); | |
| 808 if (c != 'F') | |
| 809 continue; | |
| 810 c = getc (infile); | |
| 811 defunflag = (c == 'U'); | |
| 812 defvarflag = 0; | |
| 930 | 813 c = getc (infile); /* XEmacs addition */ |
| 428 | 814 } |
| 815 else continue; | |
| 816 | |
| 817 while (c != '(') | |
| 818 { | |
| 819 if (c < 0) | |
| 820 goto eof; | |
| 821 c = getc (infile); | |
| 822 } | |
| 823 | |
| 824 c = getc (infile); | |
| 825 if (c != '"') | |
| 826 continue; | |
| 827 c = read_c_string (infile, -1, 0); | |
| 828 | |
| 829 if (defunflag) | |
| 830 commas = 4; | |
| 831 else if (defvarperbufferflag) | |
| 832 commas = 2; | |
| 833 else if (defvarflag) | |
| 834 commas = 1; | |
| 930 | 835 else /* For DEFSIMPLE and DEFPRED ... which now don't exist! */ |
| 428 | 836 commas = 2; |
| 837 | |
| 838 while (commas) | |
| 839 { | |
| 840 if (c == ',') | |
| 841 { | |
| 842 commas--; | |
| 843 if (defunflag && (commas == 1 || commas == 2)) | |
| 844 { | |
| 845 do | |
| 846 c = getc (infile); | |
| 930 | 847 while (c == ' ' || c == '\n' || c == '\t'); |
| 428 | 848 if (c < 0) |
| 849 goto eof; | |
| 850 ungetc (c, infile); | |
| 851 if (commas == 2) /* pick up minargs */ | |
| 852 fscanf (infile, "%d", &minargs); | |
| 930 | 853 else /* pick up maxargs */ |
| 428 | 854 if (c == 'M' || c == 'U') /* MANY || UNEVALLED */ |
| 855 maxargs = -1; | |
| 856 else | |
| 857 fscanf (infile, "%d", &maxargs); | |
| 858 } | |
| 859 } | |
| 860 if (c < 0) | |
| 861 goto eof; | |
| 862 c = getc (infile); | |
| 863 } | |
| 864 while (c == ' ' || c == '\n' || c == '\t') | |
| 865 c = getc (infile); | |
| 866 if (c == '"') | |
| 867 c = read_c_string (infile, 0, 0); | |
| 930 | 868 /* XEmacs change */ |
| 428 | 869 if (defunflag | defvarflag) |
| 870 { | |
| 871 while (c != '/') | |
| 853 | 872 { |
| 873 if (c < 0) | |
| 874 goto eof; | |
| 930 | 875 if (defunflag && c == '(') |
| 1111 | 876 fatal ("Missing doc string for DEFUN %s\n", globalbuf); |
| 853 | 877 c = getc (infile); |
| 878 } | |
| 428 | 879 c = getc (infile); |
| 880 while (c == '*') | |
| 881 c = getc (infile); | |
| 882 } | |
| 883 else | |
| 884 { | |
| 885 while (c != ',') | |
| 853 | 886 { |
| 887 if (c < 0) | |
| 888 goto eof; | |
| 889 c = getc (infile); | |
| 890 } | |
| 428 | 891 c = getc (infile); |
| 892 } | |
| 930 | 893 /* End XEmacs change */ |
| 428 | 894 while (c == ' ' || c == '\n' || c == '\t') |
| 895 c = getc (infile); | |
| 930 | 896 /* XEmacs addition */ |
| 428 | 897 if (defunflag | defvarflag) |
| 898 ungetc (c, infile); | |
| 930 | 899 /* End XEmacs addition */ |
| 428 | 900 |
| 901 if (defunflag || defvarflag || c == '"') | |
| 902 { | |
| 930 | 903 /* XEmacs change: the original code is in the "else" clause */ |
| 3368 | 904 /* XXX Must modify the documentation file name code to handle |
| 905 ELLCCs */ | |
| 814 | 906 if (ellcc) |
| 907 fprintf (outfile, " CDOC%s(\"%s\", \"\\\n", | |
| 1111 | 908 defvarflag ? "SYM" : "SUBR", globalbuf); |
| 814 | 909 else |
| 910 { | |
| 3368 | 911 put_filename (filename); /* XEmacs addition */ |
| 814 | 912 putc (037, outfile); |
| 913 putc (defvarflag ? 'V' : 'F', outfile); | |
| 1111 | 914 fprintf (outfile, "%s\n", globalbuf); |
| 814 | 915 } |
| 930 | 916 c = read_c_string (infile, 1, defunflag || defvarflag); |
| 428 | 917 |
| 918 /* If this is a defun, find the arguments and print them. If | |
| 919 this function takes MANY or UNEVALLED args, then the C source | |
| 920 won't give the names of the arguments, so we shouldn't bother | |
| 921 trying to find them. */ | |
| 922 if (defunflag && maxargs != -1) | |
| 923 { | |
| 924 char argbuf[1024], *p = argbuf; | |
| 2603 | 925 int paren_level = 1; |
| 814 | 926 #if 0 /* For old DEFUN's only */ |
| 428 | 927 while (c != ')') |
| 928 { | |
| 929 if (c < 0) | |
| 930 goto eof; | |
| 931 c = getc (infile); | |
| 932 } | |
| 933 #endif | |
| 934 /* Skip into arguments. */ | |
| 935 while (c != '(') | |
| 936 { | |
| 937 if (c < 0) | |
| 938 goto eof; | |
| 939 c = getc (infile); | |
| 940 } | |
| 941 /* Copy arguments into ARGBUF. */ | |
| 942 *p++ = c; | |
| 943 do | |
| 853 | 944 { |
| 945 *p++ = c = getc (infile); | |
| 946 if (c < 0) | |
| 947 goto eof; | |
| 2603 | 948 /* XEmacs change: handle macros with args (eg, UNUSED) */ |
| 949 if (c == ')') | |
| 950 paren_level--; | |
| 951 if (c == '(') | |
| 952 paren_level++; | |
| 853 | 953 } |
| 2603 | 954 while (paren_level > 0); |
| 428 | 955 *p = '\0'; |
| 956 /* Output them. */ | |
| 814 | 957 if (ellcc) |
| 958 fprintf (outfile, "\\n\\\n\\n\\\n"); | |
| 959 else | |
| 960 fprintf (outfile, "\n\n"); | |
| 1111 | 961 write_c_args (outfile, globalbuf, argbuf, minargs, maxargs); |
| 428 | 962 } |
| 814 | 963 if (ellcc) |
| 964 fprintf (outfile, "\\n\");\n\n"); | |
| 428 | 965 } |
| 966 } | |
| 967 eof: | |
| 968 fclose (infile); | |
| 969 return 0; | |
| 970 } | |
| 971 | |
| 972 /* Read a file of Lisp code, compiled or interpreted. | |
| 930 | 973 Looks for |
| 974 (defun NAME ARGS DOCSTRING ...) | |
| 975 (defmacro NAME ARGS DOCSTRING ...) | |
| 976 (defsubst NAME ARGS DOCSTRING ...) | |
| 977 (autoload (quote NAME) FILE DOCSTRING ...) | |
| 978 (defvar NAME VALUE DOCSTRING) | |
| 979 (defconst NAME VALUE DOCSTRING) | |
| 980 (fset (quote NAME) (make-byte-code ... DOCSTRING ...)) | |
| 981 (fset (quote NAME) #[... DOCSTRING ...]) | |
| 982 (defalias (quote NAME) #[... DOCSTRING ...]) | |
| 983 (custom-declare-variable (quote NAME) VALUE DOCSTRING ...) | |
| 984 starting in column zero. | |
| 985 (quote NAME) may appear as 'NAME as well. | |
| 428 | 986 |
| 987 We also look for #@LENGTH CONTENTS^_ at the beginning of the line. | |
| 988 When we find that, we save it for the following defining-form, | |
| 989 and we use that instead of reading a doc string within that defining-form. | |
| 990 | |
| 930 | 991 For defvar, defconst, and fset we skip to the docstring with a kludgy |
| 428 | 992 formatting convention: all docstrings must appear on the same line as the |
| 930 | 993 initial open-paren (the one in column zero) and must contain a backslash |
| 994 and a newline immediately after the initial double-quote. No newlines | |
| 428 | 995 must appear between the beginning of the form and the first double-quote. |
| 930 | 996 For defun, defmacro, and autoload, we know how to skip over the |
| 997 arglist, but the doc string must still have a backslash and newline | |
| 998 immediately after the double quote. | |
| 999 The only source files that must follow this convention are preloaded | |
| 1000 uncompiled ones like loaddefs.el and bindings.el; aside | |
| 428 | 1001 from that, it is always the .elc file that we look at, and they are no |
| 1002 problem because byte-compiler output follows this convention. | |
| 1003 The NAME and DOCSTRING are output. | |
| 1004 NAME is preceded by `F' for a function or `V' for a variable. | |
| 1005 An entry is output only if DOCSTRING has \ newline just after the opening " | |
| 3368 | 1006 |
| 1007 Adds the filename a symbol or function was found in before its docstring; | |
| 1008 there's no need for this with the load-history available, but we do it for | |
| 1009 consistency with the C parsing code. | |
| 428 | 1010 */ |
| 1011 | |
| 1012 static void | |
| 1013 skip_white (FILE *infile) | |
| 1014 { | |
| 1015 char c = ' '; | |
| 1016 while (c == ' ' || c == '\t' || c == '\n') | |
| 1017 c = getc (infile); | |
| 1018 ungetc (c, infile); | |
| 1019 } | |
| 1020 | |
| 1021 static void | |
| 1022 read_lisp_symbol (FILE *infile, char *buffer) | |
| 1023 { | |
| 1024 char c; | |
| 1025 char *fillp = buffer; | |
| 1026 | |
| 1027 skip_white (infile); | |
| 1028 while (1) | |
| 1029 { | |
| 1030 c = getc (infile); | |
| 1031 if (c == '\\') | |
| 1032 /* FSF has *(++fillp), which is wrong. */ | |
| 1033 *fillp++ = getc (infile); | |
| 1034 else if (c == ' ' || c == '\t' || c == '\n' || c == '(' || c == ')') | |
| 1035 { | |
| 1036 ungetc (c, infile); | |
| 1037 *fillp = 0; | |
| 1038 break; | |
| 1039 } | |
| 1040 else | |
| 1041 *fillp++ = c; | |
| 1042 } | |
| 1043 | |
| 1044 if (! buffer[0]) | |
| 1045 fprintf (stderr, "## expected a symbol, got '%c'\n", c); | |
| 814 | 1046 |
| 428 | 1047 skip_white (infile); |
| 1048 } | |
| 1049 | |
| 1050 static int | |
| 442 | 1051 scan_lisp_file (const char *filename, const char *mode) |
| 428 | 1052 { |
| 1053 FILE *infile; | |
| 1054 register int c; | |
| 1055 char *saved_string = 0; | |
| 1056 | |
| 1057 infile = fopen (filename, mode); | |
| 1058 if (infile == NULL) | |
| 1059 { | |
| 1060 perror (filename); | |
| 930 | 1061 return 0; /* No error */ |
| 428 | 1062 } |
| 1063 | |
| 1064 c = '\n'; | |
| 1065 while (!feof (infile)) | |
| 1066 { | |
| 1067 char buffer[BUFSIZ]; | |
| 1068 char type; | |
| 1069 | |
| 930 | 1070 /* If not at end of line, skip till we get to one. */ |
| 428 | 1071 if (c != '\n') |
| 1072 { | |
| 814 | 1073 c = getc_skipping_iso2022 (infile); |
| 428 | 1074 continue; |
| 1075 } | |
| 930 | 1076 /* Skip the line break. */ |
| 1077 while (c == '\n') | |
| 1078 c = getc_skipping_iso2022 (infile); | |
| 428 | 1079 /* Detect a dynamic doc string and save it for the next expression. */ |
| 1080 if (c == '#') | |
| 1081 { | |
| 814 | 1082 c = getc_skipping_iso2022 (infile); |
| 428 | 1083 if (c == '@') |
| 1084 { | |
| 1085 int length = 0; | |
| 1086 int i; | |
| 1087 | |
| 1088 /* Read the length. */ | |
| 814 | 1089 while ((c = getc_skipping_iso2022 (infile), |
| 428 | 1090 c >= '0' && c <= '9')) |
| 1091 { | |
| 1092 length *= 10; | |
| 1093 length += c - '0'; | |
| 1094 } | |
| 1095 | |
| 1096 /* The next character is a space that is counted in the length | |
| 1097 but not part of the doc string. | |
| 1098 We already read it, so just ignore it. */ | |
| 1099 length--; | |
| 1100 | |
| 1101 /* Read in the contents. */ | |
| 1102 if (saved_string != 0) | |
| 1103 free (saved_string); | |
| 1104 saved_string = (char *) xmalloc (length); | |
| 1105 for (i = 0; i < length; i++) | |
| 1106 saved_string[i] = getc (infile); | |
| 1107 /* The last character is a ^_. | |
| 1108 That is needed in the .elc file | |
| 1109 but it is redundant in DOC. So get rid of it here. */ | |
| 1110 saved_string[length - 1] = 0; | |
| 930 | 1111 /* Skip the line break. */ |
| 1112 while (c == '\n') | |
| 1113 c = getc_skipping_iso2022 (infile); | |
| 1114 /* Skip the following line. */ | |
| 428 | 1115 while (c != '\n') |
| 930 | 1116 c = getc_skipping_iso2022 (infile); |
| 428 | 1117 } |
| 1118 continue; | |
| 1119 } | |
| 1120 | |
| 1121 if (c != '(') | |
| 1122 continue; | |
| 1123 | |
| 1124 read_lisp_symbol (infile, buffer); | |
| 1125 | |
| 930 | 1126 if (! strcmp (buffer, "defun") |
| 1127 || ! strcmp (buffer, "defmacro") | |
| 1128 || ! strcmp (buffer, "defsubst")) | |
| 428 | 1129 { |
| 1130 type = 'F'; | |
| 1131 read_lisp_symbol (infile, buffer); | |
| 1132 | |
| 1133 /* Skip the arguments: either "nil" or a list in parens */ | |
| 1134 | |
| 814 | 1135 c = getc_skipping_iso2022 (infile); |
| 930 | 1136 if (c == 'n') /* nil */ |
| 428 | 1137 { |
| 814 | 1138 if ((c = getc_skipping_iso2022 (infile)) != 'i' || |
| 1139 (c = getc_skipping_iso2022 (infile)) != 'l') | |
| 428 | 1140 { |
| 1141 fprintf (stderr, "## unparsable arglist in %s (%s)\n", | |
| 1142 buffer, filename); | |
| 1143 continue; | |
| 1144 } | |
| 1145 } | |
| 1146 else if (c != '(') | |
| 1147 { | |
| 1148 fprintf (stderr, "## unparsable arglist in %s (%s)\n", | |
| 1149 buffer, filename); | |
| 1150 continue; | |
| 1151 } | |
| 1152 else | |
| 1153 while (c != ')') | |
| 853 | 1154 { |
| 1155 c = getc_skipping_iso2022 (infile); | |
| 1156 if (c < 0) | |
| 1157 continue; | |
| 1158 } | |
| 428 | 1159 skip_white (infile); |
| 1160 | |
| 1161 /* If the next three characters aren't `dquote bslash newline' | |
| 1162 then we're not reading a docstring. | |
| 930 | 1163 */ |
| 814 | 1164 if ((c = getc_skipping_iso2022 (infile)) != '"' || |
| 1165 (c = getc_skipping_iso2022 (infile)) != '\\' || | |
| 1166 (c = getc_skipping_iso2022 (infile)) != '\n') | |
| 428 | 1167 { |
| 1168 #ifdef DEBUG | |
| 1169 fprintf (stderr, "## non-docstring in %s (%s)\n", | |
| 1170 buffer, filename); | |
| 1171 #endif | |
| 1172 continue; | |
| 1173 } | |
| 1174 } | |
| 1175 | |
| 930 | 1176 else if (! strcmp (buffer, "defvar") |
| 1177 || ! strcmp (buffer, "defconst")) | |
| 428 | 1178 { |
| 1179 char c1 = 0, c2 = 0; | |
| 1180 type = 'V'; | |
| 1181 read_lisp_symbol (infile, buffer); | |
| 1182 | |
| 1183 if (saved_string == 0) | |
| 1184 { | |
| 1185 | |
| 930 | 1186 /* Skip until the end of line; remember two previous chars. */ |
| 428 | 1187 while (c != '\n' && c >= 0) |
| 1188 { | |
| 1189 c2 = c1; | |
| 1190 c1 = c; | |
| 814 | 1191 c = getc_skipping_iso2022 (infile); |
| 428 | 1192 } |
| 930 | 1193 |
| 1194 /* If two previous characters were " and \, | |
| 1195 this is a doc string. Otherwise, there is none. */ | |
| 1196 if (c2 != '"' || c1 != '\\') | |
| 1197 { | |
| 1198 #ifdef DEBUG | |
| 1199 fprintf (stderr, "## non-docstring in %s (%s)\n", | |
| 1200 buffer, filename); | |
| 1201 #endif | |
| 1202 continue; | |
| 1203 } | |
| 1204 } | |
| 1205 } | |
| 428 | 1206 |
| 930 | 1207 else if (! strcmp (buffer, "custom-declare-variable")) |
| 1208 { | |
| 1209 char c1 = 0, c2 = 0; | |
| 1210 type = 'V'; | |
| 1211 | |
| 1212 c = getc (infile); | |
| 1213 if (c == '\'') | |
| 1214 read_lisp_symbol (infile, buffer); | |
| 1215 else | |
| 1216 { | |
| 1217 if (c != '(') | |
| 1218 { | |
| 1219 fprintf (stderr, | |
| 1220 "## unparsable name in custom-declare-variable in %s\n", | |
| 1221 filename); | |
| 1222 continue; | |
| 1223 } | |
| 1224 read_lisp_symbol (infile, buffer); | |
| 1225 if (strcmp (buffer, "quote")) | |
| 1226 { | |
| 1227 fprintf (stderr, | |
| 1228 "## unparsable name in custom-declare-variable in %s\n", | |
| 1229 filename); | |
| 1230 continue; | |
| 1231 } | |
| 1232 read_lisp_symbol (infile, buffer); | |
| 1233 c = getc (infile); | |
| 1234 if (c != ')') | |
| 1235 { | |
| 1236 fprintf (stderr, | |
| 1237 "## unparsable quoted name in custom-declare-variable in %s\n", | |
| 1238 filename); | |
| 1239 continue; | |
| 1240 } | |
| 1241 } | |
| 1242 | |
| 1243 if (saved_string == 0) | |
| 1244 { | |
| 1245 /* Skip to end of line; remember the two previous chars. */ | |
| 1246 while (c != '\n' && c >= 0) | |
| 1247 { | |
| 1248 c2 = c1; | |
| 1249 c1 = c; | |
| 1250 c = getc_skipping_iso2022 (infile); | |
| 1251 } | |
| 1252 | |
| 428 | 1253 /* If two previous characters were " and \, |
| 1254 this is a doc string. Otherwise, there is none. */ | |
| 1255 if (c2 != '"' || c1 != '\\') | |
| 1256 { | |
| 1257 #ifdef DEBUG | |
| 1258 fprintf (stderr, "## non-docstring in %s (%s)\n", | |
| 1259 buffer, filename); | |
| 1260 #endif | |
| 1261 continue; | |
| 1262 } | |
| 1263 } | |
| 1264 } | |
| 1265 | |
| 1266 else if (! strcmp (buffer, "fset") || ! strcmp (buffer, "defalias")) | |
| 1267 { | |
| 1268 char c1 = 0, c2 = 0; | |
| 1269 type = 'F'; | |
| 1270 | |
| 814 | 1271 c = getc_skipping_iso2022 (infile); |
| 428 | 1272 if (c == '\'') |
| 1273 read_lisp_symbol (infile, buffer); | |
| 1274 else | |
| 1275 { | |
| 1276 if (c != '(') | |
| 1277 { | |
| 1278 fprintf (stderr, "## unparsable name in fset in %s\n", | |
| 1279 filename); | |
| 1280 continue; | |
| 1281 } | |
| 1282 read_lisp_symbol (infile, buffer); | |
| 1283 if (strcmp (buffer, "quote")) | |
| 1284 { | |
| 1285 fprintf (stderr, "## unparsable name in fset in %s\n", | |
| 1286 filename); | |
| 1287 continue; | |
| 1288 } | |
| 1289 read_lisp_symbol (infile, buffer); | |
| 814 | 1290 c = getc_skipping_iso2022 (infile); |
| 428 | 1291 if (c != ')') |
| 1292 { | |
| 1293 fprintf (stderr, | |
| 1294 "## unparsable quoted name in fset in %s\n", | |
| 1295 filename); | |
| 1296 continue; | |
| 1297 } | |
| 1298 } | |
| 1299 | |
| 1300 if (saved_string == 0) | |
| 1301 { | |
| 930 | 1302 /* Skip to end of line; remember the two previous chars. */ |
| 428 | 1303 while (c != '\n' && c >= 0) |
| 1304 { | |
| 1305 c2 = c1; | |
| 1306 c1 = c; | |
| 814 | 1307 c = getc_skipping_iso2022 (infile); |
| 428 | 1308 } |
| 930 | 1309 |
| 428 | 1310 /* If two previous characters were " and \, |
| 1311 this is a doc string. Otherwise, there is none. */ | |
| 1312 if (c2 != '"' || c1 != '\\') | |
| 1313 { | |
| 1314 #ifdef DEBUG | |
| 1315 fprintf (stderr, "## non-docstring in %s (%s)\n", | |
| 1316 buffer, filename); | |
| 1317 #endif | |
| 1318 continue; | |
| 1319 } | |
| 1320 } | |
| 1321 } | |
| 1322 | |
| 1323 else if (! strcmp (buffer, "autoload")) | |
| 1324 { | |
| 1325 type = 'F'; | |
| 814 | 1326 c = getc_skipping_iso2022 (infile); |
| 428 | 1327 if (c == '\'') |
| 1328 read_lisp_symbol (infile, buffer); | |
| 1329 else | |
| 1330 { | |
| 1331 if (c != '(') | |
| 1332 { | |
| 1333 fprintf (stderr, "## unparsable name in autoload in %s\n", | |
| 1334 filename); | |
| 1335 continue; | |
| 1336 } | |
| 1337 read_lisp_symbol (infile, buffer); | |
| 1338 if (strcmp (buffer, "quote")) | |
| 1339 { | |
| 1340 fprintf (stderr, "## unparsable name in autoload in %s\n", | |
| 1341 filename); | |
| 1342 continue; | |
| 1343 } | |
| 1344 read_lisp_symbol (infile, buffer); | |
| 814 | 1345 c = getc_skipping_iso2022 (infile); |
| 428 | 1346 if (c != ')') |
| 1347 { | |
| 1348 fprintf (stderr, | |
| 1349 "## unparsable quoted name in autoload in %s\n", | |
| 1350 filename); | |
| 1351 continue; | |
| 1352 } | |
| 1353 } | |
| 1354 skip_white (infile); | |
| 814 | 1355 if ((c = getc_skipping_iso2022 (infile)) != '\"') |
| 428 | 1356 { |
| 1357 fprintf (stderr, "## autoload of %s unparsable (%s)\n", | |
| 1358 buffer, filename); | |
| 1359 continue; | |
| 1360 } | |
| 1361 read_c_string (infile, 0, 0); | |
| 1362 skip_white (infile); | |
| 1363 | |
| 1364 if (saved_string == 0) | |
| 1365 { | |
| 1366 /* If the next three characters aren't `dquote bslash newline' | |
| 1367 then we're not reading a docstring. */ | |
| 814 | 1368 if ((c = getc_skipping_iso2022 (infile)) != '"' || |
| 1369 (c = getc_skipping_iso2022 (infile)) != '\\' || | |
| 1370 (c = getc_skipping_iso2022 (infile)) != '\n') | |
| 428 | 1371 { |
| 1372 #ifdef DEBUG | |
| 1373 fprintf (stderr, "## non-docstring in %s (%s)\n", | |
| 1374 buffer, filename); | |
| 1375 #endif | |
| 1376 continue; | |
| 1377 } | |
| 1378 } | |
| 1379 } | |
| 1380 | |
| 814 | 1381 #if 0 /* causes crash */ |
| 930 | 1382 else if (! strcmp (buffer, "if") |
| 1383 || ! strcmp (buffer, "byte-code")) | |
| 428 | 1384 ; |
| 1385 #endif | |
| 1386 | |
| 1387 else | |
| 1388 { | |
| 1389 #ifdef DEBUG | |
| 1390 fprintf (stderr, "## unrecognized top-level form, %s (%s)\n", | |
| 1391 buffer, filename); | |
| 1392 #endif | |
| 1393 continue; | |
| 1394 } | |
| 1395 | |
| 1396 /* At this point, we should either use the previous | |
| 1397 dynamic doc string in saved_string | |
| 1398 or gobble a doc string from the input file. | |
| 930 | 1399 |
| 428 | 1400 In the latter case, the opening quote (and leading |
| 1401 backslash-newline) have already been read. */ | |
| 930 | 1402 |
| 3368 | 1403 put_filename (filename); /* XEmacs addition */ |
| 428 | 1404 putc (037, outfile); |
| 1405 putc (type, outfile); | |
| 1406 fprintf (outfile, "%s\n", buffer); | |
| 1407 if (saved_string) | |
| 1408 { | |
| 1409 fputs (saved_string, outfile); | |
| 1410 /* Don't use one dynamic doc string twice. */ | |
| 1411 free (saved_string); | |
| 1412 saved_string = 0; | |
| 1413 } | |
| 1414 else | |
| 1415 read_c_string (infile, 1, 0); | |
| 1416 } | |
| 1417 fclose (infile); | |
| 1418 return 0; | |
| 1419 } |