Mercurial > emacs
annotate lib-src/make-docfile.c @ 2809:8d00a436bfcc
original log message lost to overeager RCS user -JimB
| author | Jim Blandy <jimb@redhat.com> |
|---|---|
| date | Sat, 15 May 1993 21:38:29 +0000 |
| parents | b4145a12422d |
| children | 0da5b58e98ed |
| rev | line source |
|---|---|
| 24 | 1 /* Generate doc-string file for GNU Emacs from source files. |
| 638 | 2 Copyright (C) 1985, 1986, 1992 Free Software Foundation, Inc. |
| 24 | 3 |
| 4 This file is part of GNU Emacs. | |
| 5 | |
| 38 | 6 GNU Emacs is free software; you can redistribute it and/or modify |
| 7 it under the terms of the GNU General Public License as published by | |
| 638 | 8 the Free Software Foundation; either version 2, or (at your option) |
| 38 | 9 any later version. |
| 24 | 10 |
| 38 | 11 GNU Emacs is distributed in the hope that it will be useful, |
| 12 but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| 14 GNU General Public License for more details. | |
| 15 | |
| 16 You should have received a copy of the GNU General Public License | |
| 17 along with GNU Emacs; see the file COPYING. If not, write to | |
| 18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ | |
| 24 | 19 |
| 20 /* The arguments given to this program are all the C and Lisp source files | |
| 21 of GNU Emacs. .elc and .el and .c files are allowed. | |
| 22 A .o file can also be specified; the .c file it was made from is used. | |
| 23 This helps the makefile pass the correct list of files. | |
| 24 | |
| 25 The results, which go to standard output or to a file | |
| 26 specified with -a or -o (-a to append, -o to start from nothing), | |
| 27 are entries containing function or variable names and their documentation. | |
| 28 Each entry starts with a ^_ character. | |
| 29 Then comes F for a function or V for a variable. | |
| 30 Then comes the function or variable name, terminated with a newline. | |
| 31 Then comes the documentation for that function or variable. | |
| 32 */ | |
| 33 | |
| 34 #include <stdio.h> | |
| 35 | |
| 36 FILE *outfile; | |
| 37 | |
| 38 main (argc, argv) | |
| 39 int argc; | |
| 40 char **argv; | |
| 41 { | |
| 42 int i; | |
| 43 int err_count = 0; | |
| 44 | |
| 45 outfile = stdout; | |
| 46 | |
| 47 /* If first two args are -o FILE, output to FILE. */ | |
| 48 i = 1; | |
| 49 if (argc > i + 1 && !strcmp (argv[i], "-o")) | |
| 50 { | |
| 51 outfile = fopen (argv[i + 1], "w"); | |
| 52 i += 2; | |
| 53 } | |
| 54 if (argc > i + 1 && !strcmp (argv[i], "-a")) | |
| 55 { | |
| 56 outfile = fopen (argv[i + 1], "a"); | |
| 57 i += 2; | |
| 58 } | |
| 59 | |
| 60 for (; i < argc; i++) | |
| 61 err_count += scan_file (argv[i]); /* err_count seems to be {mis,un}used */ | |
| 62 #ifndef VMS | |
| 63 exit (err_count); /* see below - shane */ | |
| 64 #endif VMS | |
| 65 } | |
| 66 | |
| 164 | 67 /* Read file FILENAME and output its doc strings to outfile. */ |
| 24 | 68 /* Return 1 if file is not found, 0 if it is found. */ |
| 69 | |
| 70 scan_file (filename) | |
| 71 char *filename; | |
| 72 { | |
| 73 int len = strlen (filename); | |
| 74 if (!strcmp (filename + len - 4, ".elc")) | |
| 75 return scan_lisp_file (filename); | |
| 76 else if (!strcmp (filename + len - 3, ".el")) | |
| 77 return scan_lisp_file (filename); | |
| 78 else | |
| 79 return scan_c_file (filename); | |
| 80 } | |
| 81 | |
| 82 char buf[128]; | |
| 83 | |
| 84 /* Skip a C string from INFILE, | |
| 85 and return the character that follows the closing ". | |
| 164 | 86 If printflag is positive, output string contents to outfile. |
| 24 | 87 If it is negative, store contents in buf. |
| 88 Convert escape sequences \n and \t to newline and tab; | |
| 89 discard \ followed by newline. */ | |
| 90 | |
| 91 read_c_string (infile, printflag) | |
| 92 FILE *infile; | |
| 93 int printflag; | |
| 94 { | |
| 95 register int c; | |
| 96 char *p = buf; | |
| 97 | |
| 98 c = getc (infile); | |
| 99 while (c != EOF) | |
| 100 { | |
| 101 while (c != '"' && c != EOF) | |
| 102 { | |
| 103 if (c == '\\') | |
| 104 { | |
| 105 c = getc (infile); | |
| 106 if (c == '\n') | |
| 107 { | |
| 108 c = getc (infile); | |
| 109 continue; | |
| 110 } | |
| 111 if (c == 'n') | |
| 112 c = '\n'; | |
| 113 if (c == 't') | |
| 114 c = '\t'; | |
| 115 } | |
| 116 if (printflag > 0) | |
| 117 putc (c, outfile); | |
| 118 else if (printflag < 0) | |
| 119 *p++ = c; | |
| 120 c = getc (infile); | |
| 121 } | |
| 122 c = getc (infile); | |
| 123 if (c != '"') | |
| 124 break; | |
| 125 if (printflag > 0) | |
| 126 putc (c, outfile); | |
| 127 else if (printflag < 0) | |
| 128 *p++ = c; | |
| 129 c = getc (infile); | |
| 130 } | |
| 131 | |
| 132 if (printflag < 0) | |
| 133 *p = 0; | |
| 134 | |
| 135 return c; | |
| 136 } | |
| 137 | |
| 138 /* Write to file OUT the argument names of the function whose text is in BUF. | |
| 139 MINARGS and MAXARGS are the minimum and maximum number of arguments. */ | |
| 140 | |
| 141 write_c_args (out, buf, minargs, maxargs) | |
| 142 FILE *out; | |
| 143 char *buf; | |
| 144 int minargs, maxargs; | |
| 145 { | |
| 1206 | 146 register char *p; |
| 1250 | 147 int in_ident = 0; |
| 148 int just_spaced = 0; | |
| 24 | 149 |
| 168 | 150 fprintf (out, "arguments: "); |
| 24 | 151 |
| 1206 | 152 for (p = buf; *p; p++) |
| 24 | 153 { |
| 1250 | 154 char c = *p; |
|
2483
b4145a12422d
* make-docfile.c (write_c_args): Print an argument named "defalt"
Jim Blandy <jimb@redhat.com>
parents:
1676
diff
changeset
|
155 int ident_start = 0; |
| 1250 | 156 |
| 157 /* Notice when we start printing a new identifier. */ | |
| 158 if ((('A' <= c && c <= 'Z') | |
| 159 || ('a' <= c && c <= 'z') | |
| 160 || ('0' <= c && c <= '9') | |
| 161 || c == '_') | |
| 162 != in_ident) | |
| 24 | 163 { |
| 1250 | 164 if (!in_ident) |
| 165 { | |
| 166 in_ident = 1; | |
|
2483
b4145a12422d
* make-docfile.c (write_c_args): Print an argument named "defalt"
Jim Blandy <jimb@redhat.com>
parents:
1676
diff
changeset
|
167 ident_start = 1; |
| 1206 | 168 |
| 1250 | 169 if (minargs == 0 && maxargs > 0) |
| 170 fprintf (out, "&optional "); | |
| 171 just_spaced = 1; | |
| 1206 | 172 |
| 1250 | 173 minargs--; |
| 174 maxargs--; | |
| 175 } | |
| 176 else | |
| 177 in_ident = 0; | |
| 24 | 178 } |
| 638 | 179 |
| 1250 | 180 /* Print the C argument list as it would appear in lisp: |
| 181 print underscores as hyphens, and print commas as spaces. | |
| 182 Collapse adjacent spaces into one. */ | |
| 183 if (c == '_') c = '-'; | |
| 184 if (c == ',') c = ' '; | |
| 185 | |
|
2483
b4145a12422d
* make-docfile.c (write_c_args): Print an argument named "defalt"
Jim Blandy <jimb@redhat.com>
parents:
1676
diff
changeset
|
186 /* In C code, `default' is a reserved word, so we spell it |
|
b4145a12422d
* make-docfile.c (write_c_args): Print an argument named "defalt"
Jim Blandy <jimb@redhat.com>
parents:
1676
diff
changeset
|
187 `defalt'; unmangle that here. */ |
|
b4145a12422d
* make-docfile.c (write_c_args): Print an argument named "defalt"
Jim Blandy <jimb@redhat.com>
parents:
1676
diff
changeset
|
188 if (ident_start |
|
b4145a12422d
* make-docfile.c (write_c_args): Print an argument named "defalt"
Jim Blandy <jimb@redhat.com>
parents:
1676
diff
changeset
|
189 && strncmp (p, "defalt", 6) == 0 |
|
b4145a12422d
* make-docfile.c (write_c_args): Print an argument named "defalt"
Jim Blandy <jimb@redhat.com>
parents:
1676
diff
changeset
|
190 && ! (('A' <= p[6] && p[6] <= 'Z') |
|
b4145a12422d
* make-docfile.c (write_c_args): Print an argument named "defalt"
Jim Blandy <jimb@redhat.com>
parents:
1676
diff
changeset
|
191 || ('a' <= p[6] && p[6] <= 'z') |
|
b4145a12422d
* make-docfile.c (write_c_args): Print an argument named "defalt"
Jim Blandy <jimb@redhat.com>
parents:
1676
diff
changeset
|
192 || ('0' <= p[6] && p[6] <= '9') |
|
b4145a12422d
* make-docfile.c (write_c_args): Print an argument named "defalt"
Jim Blandy <jimb@redhat.com>
parents:
1676
diff
changeset
|
193 || p[6] == '_')) |
|
b4145a12422d
* make-docfile.c (write_c_args): Print an argument named "defalt"
Jim Blandy <jimb@redhat.com>
parents:
1676
diff
changeset
|
194 { |
|
b4145a12422d
* make-docfile.c (write_c_args): Print an argument named "defalt"
Jim Blandy <jimb@redhat.com>
parents:
1676
diff
changeset
|
195 fprintf (out, "default"); |
|
b4145a12422d
* make-docfile.c (write_c_args): Print an argument named "defalt"
Jim Blandy <jimb@redhat.com>
parents:
1676
diff
changeset
|
196 p += 5; |
|
b4145a12422d
* make-docfile.c (write_c_args): Print an argument named "defalt"
Jim Blandy <jimb@redhat.com>
parents:
1676
diff
changeset
|
197 in_ident = 0; |
|
b4145a12422d
* make-docfile.c (write_c_args): Print an argument named "defalt"
Jim Blandy <jimb@redhat.com>
parents:
1676
diff
changeset
|
198 just_spaced = 0; |
|
b4145a12422d
* make-docfile.c (write_c_args): Print an argument named "defalt"
Jim Blandy <jimb@redhat.com>
parents:
1676
diff
changeset
|
199 } |
|
b4145a12422d
* make-docfile.c (write_c_args): Print an argument named "defalt"
Jim Blandy <jimb@redhat.com>
parents:
1676
diff
changeset
|
200 else if (c != ' ' || ! just_spaced) |
| 1250 | 201 putc (c, out); |
| 202 | |
| 203 just_spaced = (c == ' '); | |
| 24 | 204 } |
| 205 } | |
| 206 | |
| 207 /* Read through a c file. If a .o file is named, | |
| 208 the corresponding .c file is read instead. | |
| 209 Looks for DEFUN constructs such as are defined in ../src/lisp.h. | |
| 210 Accepts any word starting DEF... so it finds DEFSIMPLE and DEFPRED. */ | |
| 211 | |
| 212 scan_c_file (filename) | |
| 213 char *filename; | |
| 214 { | |
| 215 FILE *infile; | |
| 216 register int c; | |
| 217 register int commas; | |
| 218 register int defunflag; | |
|
1676
e8b3c6b52c1e
* make-docfile.c (scan_c_file): Since DEFVAR_PER_BUFFER now takes
Jim Blandy <jimb@redhat.com>
parents:
1250
diff
changeset
|
219 register int defvarperbufferflag; |
| 24 | 220 register int defvarflag; |
| 221 int minargs, maxargs; | |
| 222 | |
| 223 if (filename[strlen (filename) - 1] == 'o') | |
| 224 filename[strlen (filename) - 1] = 'c'; | |
| 225 | |
| 226 infile = fopen (filename, "r"); | |
| 227 | |
| 228 /* No error if non-ex input file */ | |
| 229 if (infile == NULL) | |
| 230 { | |
| 231 perror (filename); | |
| 232 return 0; | |
| 233 } | |
| 234 | |
| 235 c = '\n'; | |
| 236 while (!feof (infile)) | |
| 237 { | |
| 238 if (c != '\n') | |
| 239 { | |
| 240 c = getc (infile); | |
| 241 continue; | |
| 242 } | |
| 243 c = getc (infile); | |
| 244 if (c == ' ') | |
| 245 { | |
| 246 while (c == ' ') | |
| 247 c = getc (infile); | |
| 248 if (c != 'D') | |
| 249 continue; | |
| 250 c = getc (infile); | |
| 251 if (c != 'E') | |
| 252 continue; | |
| 253 c = getc (infile); | |
| 254 if (c != 'F') | |
| 255 continue; | |
| 256 c = getc (infile); | |
| 257 if (c != 'V') | |
| 258 continue; | |
|
1676
e8b3c6b52c1e
* make-docfile.c (scan_c_file): Since DEFVAR_PER_BUFFER now takes
Jim Blandy <jimb@redhat.com>
parents:
1250
diff
changeset
|
259 c = getc (infile); |
|
e8b3c6b52c1e
* make-docfile.c (scan_c_file): Since DEFVAR_PER_BUFFER now takes
Jim Blandy <jimb@redhat.com>
parents:
1250
diff
changeset
|
260 if (c != 'A') |
|
e8b3c6b52c1e
* make-docfile.c (scan_c_file): Since DEFVAR_PER_BUFFER now takes
Jim Blandy <jimb@redhat.com>
parents:
1250
diff
changeset
|
261 continue; |
|
e8b3c6b52c1e
* make-docfile.c (scan_c_file): Since DEFVAR_PER_BUFFER now takes
Jim Blandy <jimb@redhat.com>
parents:
1250
diff
changeset
|
262 c = getc (infile); |
|
e8b3c6b52c1e
* make-docfile.c (scan_c_file): Since DEFVAR_PER_BUFFER now takes
Jim Blandy <jimb@redhat.com>
parents:
1250
diff
changeset
|
263 if (c != 'R') |
|
e8b3c6b52c1e
* make-docfile.c (scan_c_file): Since DEFVAR_PER_BUFFER now takes
Jim Blandy <jimb@redhat.com>
parents:
1250
diff
changeset
|
264 continue; |
|
e8b3c6b52c1e
* make-docfile.c (scan_c_file): Since DEFVAR_PER_BUFFER now takes
Jim Blandy <jimb@redhat.com>
parents:
1250
diff
changeset
|
265 c = getc (infile); |
|
e8b3c6b52c1e
* make-docfile.c (scan_c_file): Since DEFVAR_PER_BUFFER now takes
Jim Blandy <jimb@redhat.com>
parents:
1250
diff
changeset
|
266 if (c != '_') |
|
e8b3c6b52c1e
* make-docfile.c (scan_c_file): Since DEFVAR_PER_BUFFER now takes
Jim Blandy <jimb@redhat.com>
parents:
1250
diff
changeset
|
267 continue; |
|
e8b3c6b52c1e
* make-docfile.c (scan_c_file): Since DEFVAR_PER_BUFFER now takes
Jim Blandy <jimb@redhat.com>
parents:
1250
diff
changeset
|
268 |
| 24 | 269 defvarflag = 1; |
| 270 defunflag = 0; | |
|
1676
e8b3c6b52c1e
* make-docfile.c (scan_c_file): Since DEFVAR_PER_BUFFER now takes
Jim Blandy <jimb@redhat.com>
parents:
1250
diff
changeset
|
271 |
|
e8b3c6b52c1e
* make-docfile.c (scan_c_file): Since DEFVAR_PER_BUFFER now takes
Jim Blandy <jimb@redhat.com>
parents:
1250
diff
changeset
|
272 c = getc (infile); |
|
e8b3c6b52c1e
* make-docfile.c (scan_c_file): Since DEFVAR_PER_BUFFER now takes
Jim Blandy <jimb@redhat.com>
parents:
1250
diff
changeset
|
273 defvarperbufferflag = (c == 'P'); |
|
e8b3c6b52c1e
* make-docfile.c (scan_c_file): Since DEFVAR_PER_BUFFER now takes
Jim Blandy <jimb@redhat.com>
parents:
1250
diff
changeset
|
274 |
| 24 | 275 c = getc (infile); |
| 276 } | |
| 277 else if (c == 'D') | |
| 278 { | |
| 279 c = getc (infile); | |
| 280 if (c != 'E') | |
| 281 continue; | |
| 282 c = getc (infile); | |
| 283 if (c != 'F') | |
| 284 continue; | |
| 285 c = getc (infile); | |
| 286 defunflag = c == 'U'; | |
| 287 defvarflag = 0; | |
| 288 } | |
| 289 else continue; | |
| 290 | |
| 291 while (c != '(') | |
| 292 { | |
| 293 if (c < 0) | |
| 294 goto eof; | |
| 295 c = getc (infile); | |
| 296 } | |
| 297 | |
| 298 c = getc (infile); | |
| 299 if (c != '"') | |
| 300 continue; | |
| 301 c = read_c_string (infile, -1); | |
| 302 | |
| 303 if (defunflag) | |
| 304 commas = 5; | |
|
1676
e8b3c6b52c1e
* make-docfile.c (scan_c_file): Since DEFVAR_PER_BUFFER now takes
Jim Blandy <jimb@redhat.com>
parents:
1250
diff
changeset
|
305 else if (defvarperbufferflag) |
|
e8b3c6b52c1e
* make-docfile.c (scan_c_file): Since DEFVAR_PER_BUFFER now takes
Jim Blandy <jimb@redhat.com>
parents:
1250
diff
changeset
|
306 commas = 2; |
| 24 | 307 else if (defvarflag) |
| 308 commas = 1; | |
| 309 else /* For DEFSIMPLE and DEFPRED */ | |
| 310 commas = 2; | |
| 311 | |
| 312 while (commas) | |
| 313 { | |
| 314 if (c == ',') | |
| 315 { | |
| 316 commas--; | |
| 317 if (defunflag && (commas == 1 || commas == 2)) | |
| 318 { | |
| 319 do | |
| 320 c = getc (infile); | |
| 321 while (c == ' ' || c == '\n' || c == '\t'); | |
| 322 if (c < 0) | |
| 323 goto eof; | |
| 324 ungetc (c, infile); | |
| 325 if (commas == 2) /* pick up minargs */ | |
| 326 fscanf (infile, "%d", &minargs); | |
| 327 else /* pick up maxargs */ | |
| 328 if (c == 'M' || c == 'U') /* MANY || UNEVALLED */ | |
| 329 maxargs = -1; | |
| 330 else | |
| 331 fscanf (infile, "%d", &maxargs); | |
| 332 } | |
| 333 } | |
| 334 if (c < 0) | |
| 335 goto eof; | |
| 336 c = getc (infile); | |
| 337 } | |
| 338 while (c == ' ' || c == '\n' || c == '\t') | |
| 339 c = getc (infile); | |
| 340 if (c == '"') | |
| 341 c = read_c_string (infile, 0); | |
| 342 while (c != ',') | |
| 343 c = getc (infile); | |
| 344 c = getc (infile); | |
| 345 while (c == ' ' || c == '\n' || c == '\t') | |
| 346 c = getc (infile); | |
| 347 | |
| 348 if (c == '"') | |
| 349 { | |
| 350 putc (037, outfile); | |
| 351 putc (defvarflag ? 'V' : 'F', outfile); | |
| 352 fprintf (outfile, "%s\n", buf); | |
| 168 | 353 c = read_c_string (infile, 1); |
| 354 | |
| 355 /* If this is a defun, find the arguments and print them. If | |
| 356 this function takes MANY or UNEVALLED args, then the C source | |
| 357 won't give the names of the arguments, so we shouldn't bother | |
| 358 trying to find them. */ | |
| 359 if (defunflag && maxargs != -1) | |
| 24 | 360 { |
| 361 char argbuf[1024], *p = argbuf; | |
| 362 while (c != ')') | |
| 363 { | |
| 364 if (c < 0) | |
| 365 goto eof; | |
| 366 c = getc (infile); | |
| 367 } | |
| 368 /* Skip into arguments. */ | |
| 369 while (c != '(') | |
| 370 { | |
| 371 if (c < 0) | |
| 372 goto eof; | |
| 373 c = getc (infile); | |
| 374 } | |
| 375 /* Copy arguments into ARGBUF. */ | |
| 376 *p++ = c; | |
| 377 do | |
| 378 *p++ = c = getc (infile); | |
| 379 while (c != ')'); | |
| 380 *p = '\0'; | |
| 381 /* Output them. */ | |
| 382 fprintf (outfile, "\n\n"); | |
| 383 write_c_args (outfile, argbuf, minargs, maxargs); | |
| 384 } | |
| 385 } | |
| 386 } | |
| 387 eof: | |
| 388 fclose (infile); | |
| 389 return 0; | |
| 390 } | |
| 391 | |
| 392 /* Read a file of Lisp code, compiled or interpreted. | |
| 393 Looks for | |
| 394 (defun NAME ARGS DOCSTRING ...) | |
| 753 | 395 (defmacro NAME ARGS DOCSTRING ...) |
| 396 (autoload (quote NAME) FILE DOCSTRING ...) | |
| 24 | 397 (defvar NAME VALUE DOCSTRING) |
| 398 (defconst NAME VALUE DOCSTRING) | |
| 753 | 399 (fset (quote NAME) (make-byte-code ... DOCSTRING ...)) |
| 400 (fset (quote NAME) #[... DOCSTRING ...]) | |
| 24 | 401 starting in column zero. |
| 753 | 402 (quote NAME) may appear as 'NAME as well. |
| 403 For defun, defmacro, and autoload, we know how to skip over the arglist. | |
| 404 For defvar, defconst, and fset we skip to the docstring with a klugey | |
| 405 formatting convention: all docstrings must appear on the same line as the | |
| 406 initial open-paren (the one in column zero) and must contain a backslash | |
| 407 and a double-quote immediately after the initial double-quote. No newlines | |
| 408 must appear between the beginning of the form and the first double-quote. | |
| 409 The only source file that must follow this convention is loaddefs.el; aside | |
| 410 from that, it is always the .elc file that we look at, and they are no | |
| 411 problem because byte-compiler output follows this convention. | |
| 24 | 412 The NAME and DOCSTRING are output. |
| 413 NAME is preceded by `F' for a function or `V' for a variable. | |
| 414 An entry is output only if DOCSTRING has \ newline just after the opening " | |
| 415 */ | |
| 416 | |
| 753 | 417 void |
| 418 skip_white (infile) | |
| 419 FILE *infile; | |
| 420 { | |
| 421 char c = ' '; | |
| 422 while (c == ' ' || c == '\t' || c == '\n') | |
| 423 c = getc (infile); | |
| 424 ungetc (c, infile); | |
| 425 } | |
| 426 | |
| 427 void | |
| 428 read_lisp_symbol (infile, buffer) | |
| 429 FILE *infile; | |
| 430 char *buffer; | |
| 431 { | |
| 432 char c; | |
| 433 char *fillp = buffer; | |
| 434 | |
| 435 skip_white (infile); | |
| 436 while (1) | |
| 437 { | |
| 438 c = getc (infile); | |
| 439 if (c == '\\') | |
| 440 *(++fillp) = getc (infile); | |
| 441 else if (c == ' ' || c == '\t' || c == '\n' || c == '(' || c == ')') | |
| 442 { | |
| 443 ungetc (c, infile); | |
| 444 *fillp = 0; | |
| 445 break; | |
| 446 } | |
| 447 else | |
| 448 *fillp++ = c; | |
| 449 } | |
| 450 | |
| 451 if (! buffer[0]) | |
| 452 fprintf (stderr, "## expected a symbol, got '%c'\n", c); | |
| 453 | |
| 454 skip_white (infile); | |
| 455 } | |
| 456 | |
| 457 | |
| 24 | 458 scan_lisp_file (filename) |
| 459 char *filename; | |
| 460 { | |
| 461 FILE *infile; | |
| 462 register int c; | |
| 463 | |
| 464 infile = fopen (filename, "r"); | |
| 465 if (infile == NULL) | |
| 466 { | |
| 467 perror (filename); | |
| 468 return 0; /* No error */ | |
| 469 } | |
| 470 | |
| 471 c = '\n'; | |
| 472 while (!feof (infile)) | |
| 473 { | |
| 753 | 474 char buffer [BUFSIZ]; |
| 475 char *fillp = buffer; | |
| 476 char type; | |
| 477 | |
| 24 | 478 if (c != '\n') |
| 479 { | |
| 480 c = getc (infile); | |
| 481 continue; | |
| 482 } | |
| 483 c = getc (infile); | |
| 484 if (c != '(') | |
| 485 continue; | |
| 164 | 486 |
| 753 | 487 read_lisp_symbol (infile, buffer); |
| 488 | |
| 489 if (! strcmp (buffer, "defun") || | |
| 490 ! strcmp (buffer, "defmacro")) | |
| 24 | 491 { |
| 753 | 492 type = 'F'; |
| 493 read_lisp_symbol (infile, buffer); | |
| 494 | |
| 495 /* Skip the arguments: either "nil" or a list in parens */ | |
| 24 | 496 |
| 497 c = getc (infile); | |
| 753 | 498 if (c == 'n') /* nil */ |
| 499 { | |
| 500 if ((c = getc (infile)) != 'i' || | |
| 501 (c = getc (infile)) != 'l') | |
| 502 { | |
| 503 fprintf (stderr, "## unparsable arglist in %s (%s)\n", | |
| 504 buffer, filename); | |
| 505 continue; | |
| 506 } | |
| 507 } | |
| 508 else if (c != '(') | |
| 509 { | |
| 510 fprintf (stderr, "## unparsable arglist in %s (%s)\n", | |
| 511 buffer, filename); | |
| 512 continue; | |
| 513 } | |
| 514 else | |
| 515 while (c != ')') | |
| 516 c = getc (infile); | |
| 517 skip_white (infile); | |
| 24 | 518 |
| 753 | 519 /* If the next three characters aren't `dquote bslash newline' |
| 520 then we're not reading a docstring. | |
| 521 */ | |
| 522 if ((c = getc (infile)) != '"' || | |
| 523 (c = getc (infile)) != '\\' || | |
| 524 (c = getc (infile)) != '\n') | |
| 24 | 525 { |
| 753 | 526 #ifdef DEBUG |
| 527 fprintf (stderr, "## non-docstring in %s (%s)\n", | |
| 528 buffer, filename); | |
| 529 #endif | |
| 530 continue; | |
| 531 } | |
| 532 } | |
| 533 | |
| 534 else if (! strcmp (buffer, "defvar") || | |
| 535 ! strcmp (buffer, "defconst")) | |
| 536 { | |
| 537 char c1 = 0, c2 = 0; | |
| 538 type = 'V'; | |
| 539 read_lisp_symbol (infile, buffer); | |
| 540 | |
| 541 /* Skip until the first newline; remember the two previous chars. */ | |
| 542 while (c != '\n' && c >= 0) | |
| 543 { | |
| 544 c2 = c1; | |
| 545 c1 = c; | |
| 24 | 546 c = getc (infile); |
| 547 } | |
| 753 | 548 |
| 549 /* If two previous characters were " and \, | |
| 550 this is a doc string. Otherwise, there is none. */ | |
| 551 if (c2 != '"' || c1 != '\\') | |
| 552 { | |
| 553 #ifdef DEBUG | |
| 554 fprintf (stderr, "## non-docstring in %s (%s)\n", | |
| 555 buffer, filename); | |
| 556 #endif | |
| 557 continue; | |
| 558 } | |
| 559 } | |
| 560 | |
| 561 else if (! strcmp (buffer, "fset")) | |
| 562 { | |
| 563 char c1 = 0, c2 = 0; | |
| 564 type = 'F'; | |
| 565 | |
| 566 c = getc (infile); | |
| 567 if (c == '\'') | |
| 568 read_lisp_symbol (infile, buffer); | |
| 24 | 569 else |
| 570 { | |
| 571 if (c != '(') | |
| 753 | 572 { |
| 573 fprintf (stderr, "## unparsable name in fset in %s\n", | |
| 574 filename); | |
| 575 continue; | |
| 576 } | |
| 577 read_lisp_symbol (infile, buffer); | |
| 578 if (strcmp (buffer, "quote")) | |
| 579 { | |
| 580 fprintf (stderr, "## unparsable name in fset in %s\n", | |
| 581 filename); | |
| 582 continue; | |
| 583 } | |
| 584 read_lisp_symbol (infile, buffer); | |
| 24 | 585 c = getc (infile); |
| 753 | 586 if (c != ')') |
| 587 { | |
| 588 fprintf (stderr, | |
| 589 "## unparsable quoted name in fset in %s\n", | |
| 590 filename); | |
| 591 continue; | |
| 592 } | |
| 24 | 593 } |
| 164 | 594 |
| 753 | 595 /* Skip until the first newline; remember the two previous chars. */ |
| 596 while (c != '\n' && c >= 0) | |
| 24 | 597 { |
| 753 | 598 c2 = c1; |
| 599 c1 = c; | |
| 24 | 600 c = getc (infile); |
| 601 } | |
| 753 | 602 |
| 603 /* If two previous characters were " and \, | |
| 604 this is a doc string. Otherwise, there is none. */ | |
| 605 if (c2 != '"' || c1 != '\\') | |
| 24 | 606 { |
| 753 | 607 #ifdef DEBUG |
| 608 fprintf (stderr, "## non-docstring in %s (%s)\n", | |
| 609 buffer, filename); | |
| 610 #endif | |
| 24 | 611 continue; |
| 612 } | |
| 613 } | |
| 753 | 614 |
| 615 else if (! strcmp (buffer, "autoload")) | |
| 164 | 616 { |
| 753 | 617 type = 'F'; |
| 164 | 618 c = getc (infile); |
| 753 | 619 if (c == '\'') |
| 620 read_lisp_symbol (infile, buffer); | |
| 621 else | |
| 622 { | |
| 623 if (c != '(') | |
| 624 { | |
| 625 fprintf (stderr, "## unparsable name in autoload in %s\n", | |
| 626 filename); | |
| 627 continue; | |
| 628 } | |
| 629 read_lisp_symbol (infile, buffer); | |
| 630 if (strcmp (buffer, "quote")) | |
| 631 { | |
| 632 fprintf (stderr, "## unparsable name in autoload in %s\n", | |
| 633 filename); | |
| 634 continue; | |
| 635 } | |
| 636 read_lisp_symbol (infile, buffer); | |
| 637 c = getc (infile); | |
| 638 if (c != ')') | |
| 639 { | |
| 640 fprintf (stderr, | |
| 641 "## unparsable quoted name in autoload in %s\n", | |
| 642 filename); | |
| 643 continue; | |
| 644 } | |
| 645 } | |
| 646 skip_white (infile); | |
| 647 if ((c = getc (infile)) != '\"') | |
| 648 { | |
| 649 fprintf (stderr, "## autoload of %s unparsable (%s)\n", | |
| 650 buffer, filename); | |
| 651 continue; | |
| 652 } | |
| 653 read_c_string (infile, 0); | |
| 654 skip_white (infile); | |
| 164 | 655 |
| 753 | 656 /* If the next three characters aren't `dquote bslash newline' |
| 657 then we're not reading a docstring. | |
| 658 */ | |
| 659 if ((c = getc (infile)) != '"' || | |
| 660 (c = getc (infile)) != '\\' || | |
| 661 (c = getc (infile)) != '\n') | |
| 662 { | |
| 663 #ifdef DEBUG | |
| 664 fprintf (stderr, "## non-docstring in %s (%s)\n", | |
| 665 buffer, filename); | |
| 666 #endif | |
| 667 continue; | |
| 668 } | |
| 164 | 669 } |
| 24 | 670 |
| 753 | 671 #ifdef DEBUG |
| 672 else if (! strcmp (buffer, "if") || | |
| 673 ! strcmp (buffer, "byte-code")) | |
| 674 ; | |
| 675 #endif | |
| 24 | 676 |
| 753 | 677 else |
| 678 { | |
| 679 #ifdef DEBUG | |
| 680 fprintf (stderr, "## unrecognised top-level form, %s (%s)\n", | |
| 681 buffer, filename); | |
| 682 #endif | |
| 683 continue; | |
| 684 } | |
| 24 | 685 |
| 753 | 686 /* At this point, there is a docstring that we should gobble. |
| 687 The opening quote (and leading backslash-newline) have already | |
| 688 been read. | |
| 689 */ | |
| 690 putc ('\n', outfile); | |
| 24 | 691 putc (037, outfile); |
| 753 | 692 putc (type, outfile); |
| 693 fprintf (outfile, "%s\n", buffer); | |
| 24 | 694 read_c_string (infile, 1); |
| 695 } | |
| 696 fclose (infile); | |
| 697 return 0; | |
| 698 } |
