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