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