Mercurial > hg > xemacs-beta
annotate lib-src/make-docfile.c @ 4539:061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
lib-src/ChangeLog addition:
2008-12-27 Aidan Kehoe <kehoea@parhasard.net>
* make-docfile.c (main): Allow more than one -d argument, followed
by a directory to change to.
(put_filename): Don't strip directory information; with previous
change, allows retrieval of Lisp function and variable origin
files from #'built-in-symbol-file relative to lisp-directory.
(scan_lisp_file): Don't add an extraneous newline after the file
name, put_filename has added the newline already.
lisp/ChangeLog addition:
2008-12-27 Aidan Kehoe <kehoea@parhasard.net>
* loadup.el (load-history):
Add the contents of current-load-list to load-history before
clearing it. Move the variable declarations earlier in the file to
a format understood by make-docfile.c.
* custom.el (custom-declare-variable): Add the variable's symbol
to the current file's load history entry correctly, don't use a
cons. Eliminate a comment that we don't need to worry about, we
don't need to check the `initialized' C variable in Lisp.
* bytecomp.el (byte-compile-output-file-form):
Merge Andreas Schwab's pre-GPLv3 GNU change of 19970831 here;
treat #'custom-declare-variable correctly, generating the
docstrings in a format understood by make-docfile.c.
* loadhist.el (symbol-file): Correct behaviour for checking
autoloaded macros and functions when supplied with a TYPE
argument. Accept fully-qualified paths from
#'built-in-symbol-file; if a path is not fully-qualified, return
it relative to lisp-directory if the filename corresponds to a
Lisp file, and relative to (concat source-directory "/src/")
otherwise.
* make-docfile.el (preloaded-file-list):
Rationalise some let bindings a little. Use the "-d" argument to
make-docfile.c to supply Lisp paths relative to lisp-directory,
not absolutely. Add in loadup.el explicitly to the list of files
to be processed by make-docfile.c--it doesn't make sense to add it
to preloaded-file-list, since that is used for purposes of
byte-compilation too.
src/ChangeLog addition:
2008-12-27 Aidan Kehoe <kehoea@parhasard.net>
* doc.c (Fbuilt_in_symbol_file):
Return a subr's filename immediately if we've found it. Check for
compiled function and compiled macro docstrings in DOC too, and
return them if they exist.
The branch of the if statement focused on functions may have
executed, but we may still want to check variable bindings; an
else clause isn't appropriate.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Sat, 27 Dec 2008 14:05:50 +0000 |
| parents | c785f98c6737 |
| 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 } |