Mercurial > hg > xemacs-beta
annotate src/doc.c @ 5402:308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
author | Mats Lidell <matsl@xemacs.org> |
---|---|
date | Thu, 14 Oct 2010 17:15:20 +0200 |
parents | 39d74978fd32 |
children | 56144c8593a8 |
rev | line source |
---|---|
428 | 1 /* Record indices of function doc strings stored in a file. |
2 Copyright (C) 1985, 1986, 1992, 1993, 1994, 1995 | |
3 Free Software Foundation, Inc. | |
2367 | 4 Copyright (C) 2001, 2002, 2004 Ben Wing. |
428 | 5 |
6 This file is part of XEmacs. | |
7 | |
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5206
diff
changeset
|
8 XEmacs is free software: you can redistribute it and/or modify it |
428 | 9 under the terms of the GNU General Public License as published by the |
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5206
diff
changeset
|
10 Free Software Foundation, either version 3 of the License, or (at your |
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5206
diff
changeset
|
11 option) any later version. |
428 | 12 |
13 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
16 for more details. | |
17 | |
18 You should have received a copy of the GNU General Public License | |
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5206
diff
changeset
|
19 along with XEmacs. If not, see <http://www.gnu.org/licenses/>. */ |
428 | 20 |
21 /* Synched up with: FSF 19.30. */ | |
22 | |
814 | 23 /* This file has been Mule-ized. */ |
428 | 24 |
25 #include <config.h> | |
26 #include "lisp.h" | |
27 | |
28 #include "buffer.h" | |
29 #include "bytecode.h" | |
814 | 30 #include "file-coding.h" |
428 | 31 #include "insdel.h" |
32 #include "keymap.h" | |
814 | 33 #include "lstream.h" |
428 | 34 #include "sysfile.h" |
35 | |
36 Lisp_Object Vinternal_doc_file_name; | |
37 | |
4367
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3548
diff
changeset
|
38 Lisp_Object QSsubstitute, Qdefvar; |
428 | 39 |
3368 | 40 /* Work out what source file a function or variable came from, taking the |
41 information from the documentation file. */ | |
42 | |
43 static Lisp_Object | |
44 extract_object_file_name (int fd, EMACS_INT doc_pos, | |
45 Ibyte *name_nonreloc, Lisp_Object name_reloc, | |
46 int standard_doc_file) | |
47 { | |
3383 | 48 Ibyte buf[DOC_MAX_FILENAME_LENGTH+1]; |
3368 | 49 Ibyte *buffer = buf; |
3411 | 50 int buffer_size = sizeof (buf) - 1, space_left; |
3368 | 51 Ibyte *from, *to; |
52 REGISTER Ibyte *p = buffer; | |
53 Lisp_Object return_me; | |
54 Lisp_Object fdstream = Qnil, instream = Qnil; | |
55 struct gcpro gcpro1, gcpro2; | |
56 EMACS_INT position, seenS = 0; | |
57 | |
58 GCPRO2 (fdstream, instream); | |
59 | |
3411 | 60 position = doc_pos > buffer_size ? |
61 doc_pos - buffer_size : 0; | |
3368 | 62 |
63 if (0 > lseek (fd, position, 0)) | |
64 { | |
65 if (name_nonreloc) | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
66 name_reloc = build_istring (name_nonreloc); |
3368 | 67 return_me = list3 (build_msg_string |
68 ("Position out of range in doc string file"), | |
69 name_reloc, make_int (position)); | |
70 goto done; | |
71 } | |
72 | |
73 fdstream = make_filedesc_input_stream (fd, 0, -1, 0); | |
74 Lstream_set_buffering (XLSTREAM (fdstream), LSTREAM_UNBUFFERED, 0); | |
75 instream = | |
76 make_coding_input_stream | |
77 (XLSTREAM (fdstream), standard_doc_file ? Qescape_quoted : Qbinary, | |
78 CODING_DECODE, 0); | |
79 Lstream_set_buffering (XLSTREAM (instream), LSTREAM_UNBUFFERED, 0); | |
80 | |
81 space_left = buffer_size - (p - buffer); | |
82 while (space_left > 0) | |
83 { | |
84 int nread; | |
85 | |
86 nread = Lstream_read (XLSTREAM (instream), p, space_left); | |
87 if (nread < 0) | |
88 { | |
89 return_me = list1 (build_msg_string | |
90 ("Read error on documentation file")); | |
91 goto done; | |
92 } | |
93 | |
94 p[nread] = 0; | |
95 | |
96 if (!nread) | |
97 break; | |
98 | |
99 p += nread; | |
100 space_left = buffer_size - (p - buffer); | |
101 } | |
102 | |
103 /* First, search backward for the "\037S" that marks the beginning of the | |
104 file name, then search forward from that to the newline or to the end | |
105 of the buffer. */ | |
106 from = p; | |
107 | |
108 while (from > buf) | |
109 { | |
110 --from; | |
111 if (seenS) | |
112 { | |
113 if ('\037' == *from) | |
114 { | |
115 /* Got a file name; adjust `from' to point to it, break out of | |
116 the loop. */ | |
117 from += 2; | |
118 break; | |
119 } | |
120 } | |
121 /* Is *from 'S' ? */ | |
122 seenS = ('S' == *from); | |
123 } | |
124 | |
125 if (buf == from) | |
126 { | |
127 /* We've scanned back to the beginning of the buffer without hitting | |
128 the file name. Either the file name plus the symbol name is longer | |
129 than DOC_MAX_FILENAME_LENGTH--which shouldn't happen, because it'll | |
130 trigger an assertion failure in make-docfile, the DOC file is | |
131 corrupt, or it was produced by a version of make-docfile that | |
132 doesn't store the file name with the symbol name and docstring. */ | |
133 return_me = list1 (build_msg_string | |
134 ("Object file name not stored in doc file")); | |
135 goto done; | |
136 } | |
137 | |
138 to = from; | |
139 /* Search for the end of the file name. */ | |
140 while (++to < p) | |
141 { | |
142 if ('\n' == *to || '\037' == *to) | |
143 { | |
144 break; | |
145 } | |
146 } | |
147 | |
148 /* Don't require the file name to end in a newline. */ | |
149 return_me = make_string (from, to - from); | |
150 | |
151 done: | |
152 if (!NILP (instream)) | |
153 { | |
154 Lstream_delete (XLSTREAM (instream)); | |
155 Lstream_delete (XLSTREAM (fdstream)); | |
156 } | |
157 | |
158 UNGCPRO; | |
159 return return_me; | |
160 } | |
428 | 161 |
162 Lisp_Object | |
163 unparesseuxify_doc_string (int fd, EMACS_INT position, | |
867 | 164 Ibyte *name_nonreloc, Lisp_Object name_reloc, |
814 | 165 int standard_doc_file) |
428 | 166 { |
867 | 167 Ibyte buf[512 * 32 + 1]; |
168 Ibyte *buffer = buf; | |
3411 | 169 int buffer_size = sizeof (buf) - 1; |
867 | 170 Ibyte *from, *to; |
171 REGISTER Ibyte *p = buffer; | |
428 | 172 Lisp_Object return_me; |
814 | 173 Lisp_Object fdstream = Qnil, instream = Qnil; |
174 struct gcpro gcpro1, gcpro2; | |
175 | |
176 GCPRO2 (fdstream, instream); | |
428 | 177 |
178 if (0 > lseek (fd, position, 0)) | |
179 { | |
180 if (name_nonreloc) | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
181 name_reloc = build_istring (name_nonreloc); |
771 | 182 return_me = list3 (build_msg_string |
428 | 183 ("Position out of range in doc string file"), |
184 name_reloc, make_int (position)); | |
185 goto done; | |
186 } | |
187 | |
814 | 188 fdstream = make_filedesc_input_stream (fd, 0, -1, 0); |
189 Lstream_set_buffering (XLSTREAM (fdstream), LSTREAM_UNBUFFERED, 0); | |
190 instream = | |
191 make_coding_input_stream | |
192 /* Major trouble if we are too clever when reading byte-code | |
193 instructions! | |
194 | |
195 #### We should have a way of handling escape-quoted elc files | |
196 (i.e. files with non-ASCII/Latin-1 chars in them). Currently this | |
197 is "solved" in bytecomp.el by never inserting lazy references in | |
198 such files. */ | |
826 | 199 (XLSTREAM (fdstream), standard_doc_file ? Qescape_quoted : Qbinary, |
814 | 200 CODING_DECODE, 0); |
201 Lstream_set_buffering (XLSTREAM (instream), LSTREAM_UNBUFFERED, 0); | |
202 | |
428 | 203 /* Read the doc string into a buffer. |
204 Use the fixed buffer BUF if it is big enough; otherwise allocate one. | |
205 We store the buffer in use in BUFFER and its size in BUFFER_SIZE. */ | |
206 | |
207 while (1) | |
208 { | |
209 int space_left = buffer_size - (p - buffer); | |
210 int nread; | |
211 | |
212 /* Switch to a bigger buffer if we need one. */ | |
213 if (space_left == 0) | |
214 { | |
867 | 215 Ibyte *old_buffer = buffer; |
3411 | 216 buffer_size *= 2; |
217 | |
771 | 218 if (buffer == buf) |
219 { | |
3411 | 220 buffer = xnew_ibytes (buffer_size + 1); |
771 | 221 memcpy (buffer, old_buffer, p - old_buffer); |
222 } | |
223 else | |
3411 | 224 XREALLOC_ARRAY (buffer, Ibyte, buffer_size + 1); |
428 | 225 p += buffer - old_buffer; |
226 space_left = buffer_size - (p - buffer); | |
227 } | |
228 | |
229 /* Don't read too much at one go. */ | |
230 if (space_left > 1024 * 8) | |
231 space_left = 1024 * 8; | |
814 | 232 nread = Lstream_read (XLSTREAM (instream), p, space_left); |
428 | 233 if (nread < 0) |
234 { | |
771 | 235 return_me = list1 (build_msg_string |
428 | 236 ("Read error on documentation file")); |
237 goto done; | |
238 } | |
239 p[nread] = 0; | |
240 if (!nread) | |
241 break; | |
242 { | |
867 | 243 Ibyte *p1 = qxestrchr (p, '\037'); /* End of doc string marker */ |
814 | 244 if (p1) |
245 { | |
246 *p1 = 0; | |
247 p = p1; | |
248 break; | |
249 } | |
428 | 250 } |
251 p += nread; | |
252 } | |
253 | |
254 /* Scan the text and remove quoting with ^A (char code 1). | |
255 ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_. */ | |
256 from = to = buffer; | |
257 while (from < p) | |
258 { | |
259 if (*from != 1 /*^A*/) | |
260 *to++ = *from++; | |
261 else | |
262 { | |
263 int c = *(++from); | |
264 | |
265 from++; | |
266 switch (c) | |
267 { | |
268 case 1: *to++ = c; break; | |
269 case '0': *to++ = '\0'; break; | |
270 case '_': *to++ = '\037'; break; | |
271 default: | |
771 | 272 return_me = list2 (build_msg_string |
428 | 273 ("Invalid data in documentation file -- ^A followed by weird code"), |
274 make_int (c)); | |
275 goto done; | |
276 } | |
277 } | |
278 } | |
279 | |
814 | 280 return_me = make_string (buffer, to - buffer); |
428 | 281 |
282 done: | |
814 | 283 if (!NILP (instream)) |
284 { | |
285 Lstream_delete (XLSTREAM (instream)); | |
286 Lstream_delete (XLSTREAM (fdstream)); | |
287 } | |
288 UNGCPRO; | |
428 | 289 if (buffer != buf) /* We must have allocated buffer above */ |
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
290 xfree (buffer); |
428 | 291 return return_me; |
292 } | |
293 | |
771 | 294 #define string_join(dest, s1, s2) \ |
295 memcpy (dest, XSTRING_DATA (s1), XSTRING_LENGTH (s1)); \ | |
296 memcpy (dest + XSTRING_LENGTH (s1), XSTRING_DATA (s2), \ | |
297 XSTRING_LENGTH (s2)); \ | |
428 | 298 dest[XSTRING_LENGTH (s1) + XSTRING_LENGTH (s2)] = '\0' |
299 | |
300 /* Extract a doc string from a file. FILEPOS says where to get it. | |
301 (This could actually be byte code instructions/constants instead | |
302 of a doc string.) | |
303 If it is an integer, use that position in the standard DOC file. | |
304 If it is (FILE . INTEGER), use FILE as the file name | |
305 and INTEGER as the position in that file. | |
306 But if INTEGER is negative, make it positive. | |
307 (A negative integer is used for user variables, so we can distinguish | |
308 them without actually fetching the doc string.) */ | |
309 | |
310 static Lisp_Object | |
311 get_doc_string (Lisp_Object filepos) | |
312 { | |
313 REGISTER int fd; | |
867 | 314 REGISTER Ibyte *name_nonreloc = 0; |
428 | 315 EMACS_INT position; |
316 Lisp_Object file, tem; | |
317 Lisp_Object name_reloc = Qnil; | |
814 | 318 int standard_doc_file = 0; |
428 | 319 |
320 if (INTP (filepos)) | |
321 { | |
322 file = Vinternal_doc_file_name; | |
814 | 323 standard_doc_file = 1; |
428 | 324 position = XINT (filepos); |
325 } | |
326 else if (CONSP (filepos) && INTP (XCDR (filepos))) | |
327 { | |
328 file = XCAR (filepos); | |
329 position = XINT (XCDR (filepos)); | |
330 if (position < 0) | |
331 position = - position; | |
332 } | |
333 else | |
334 return Qnil; | |
335 | |
336 if (!STRINGP (file)) | |
337 return Qnil; | |
338 | |
339 /* Put the file name in NAME as a C string. | |
340 If it is relative, combine it with Vdoc_directory. */ | |
341 | |
342 tem = Ffile_name_absolute_p (file); | |
343 if (NILP (tem)) | |
344 { | |
647 | 345 Bytecount minsize; |
428 | 346 /* XEmacs: Move this check here. OK if called during loadup to |
347 load byte code instructions. */ | |
348 if (!STRINGP (Vdoc_directory)) | |
349 return Qnil; | |
350 | |
351 minsize = XSTRING_LENGTH (Vdoc_directory); | |
352 /* sizeof ("../lib-src/") == 12 */ | |
353 if (minsize < 12) | |
354 minsize = 12; | |
867 | 355 name_nonreloc = alloca_ibytes (minsize + XSTRING_LENGTH (file) + 8); |
428 | 356 string_join (name_nonreloc, Vdoc_directory, file); |
357 } | |
358 else | |
359 name_reloc = file; | |
360 | |
771 | 361 fd = qxe_open (name_nonreloc ? name_nonreloc : |
362 XSTRING_DATA (name_reloc), O_RDONLY | OPEN_BINARY, 0); | |
428 | 363 if (fd < 0) |
364 { | |
365 if (purify_flag) | |
366 { | |
367 /* sizeof ("../lib-src/") == 12 */ | |
2367 | 368 name_nonreloc = alloca_ibytes (12 + XSTRING_LENGTH (file) + 8); |
428 | 369 /* Preparing to dump; DOC file is probably not installed. |
370 So check in ../lib-src. */ | |
2367 | 371 qxestrcpy_ascii (name_nonreloc, "../lib-src/"); |
771 | 372 qxestrcat (name_nonreloc, XSTRING_DATA (file)); |
428 | 373 |
771 | 374 fd = qxe_open (name_nonreloc, O_RDONLY | OPEN_BINARY, 0); |
428 | 375 } |
376 | |
377 if (fd < 0) | |
814 | 378 report_file_error ("Cannot open doc string file", |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
379 name_nonreloc ? build_istring (name_nonreloc) : |
814 | 380 name_reloc); |
428 | 381 } |
382 | |
814 | 383 tem = unparesseuxify_doc_string (fd, position, name_nonreloc, name_reloc, |
384 standard_doc_file); | |
771 | 385 retry_close (fd); |
428 | 386 |
387 if (!STRINGP (tem)) | |
563 | 388 signal_error_1 (Qinvalid_byte_code, tem); |
428 | 389 |
390 return tem; | |
391 } | |
392 | |
393 /* Get a string from position FILEPOS and pass it through the Lisp reader. | |
394 We use this for fetching the bytecode string and constants vector | |
395 of a compiled function from the .elc file. */ | |
396 | |
397 Lisp_Object | |
398 read_doc_string (Lisp_Object filepos) | |
399 { | |
400 Lisp_Object string = get_doc_string (filepos); | |
401 | |
402 if (!STRINGP (string)) | |
563 | 403 invalid_state ("loading bytecode failed to return string", string); |
428 | 404 return Fread (string); |
405 } | |
406 | |
3368 | 407 static Lisp_Object |
408 get_object_file_name (Lisp_Object filepos) | |
409 { | |
410 REGISTER int fd; | |
411 REGISTER Ibyte *name_nonreloc = 0; | |
412 EMACS_INT position; | |
413 Lisp_Object file, tem; | |
414 Lisp_Object name_reloc = Qnil; | |
415 int standard_doc_file = 0; | |
416 | |
417 if (INTP (filepos)) | |
418 { | |
419 file = Vinternal_doc_file_name; | |
420 standard_doc_file = 1; | |
421 position = XINT (filepos); | |
422 } | |
423 else if (CONSP (filepos) && INTP (XCDR (filepos))) | |
424 { | |
425 file = XCAR (filepos); | |
426 position = XINT (XCDR (filepos)); | |
427 if (position < 0) | |
428 position = - position; | |
429 } | |
430 else | |
431 return Qnil; | |
432 | |
433 if (!STRINGP (file)) | |
434 return Qnil; | |
435 | |
436 /* Put the file name in NAME as a C string. | |
437 If it is relative, combine it with Vdoc_directory. */ | |
438 | |
439 tem = Ffile_name_absolute_p (file); | |
440 if (NILP (tem)) | |
441 { | |
442 Bytecount minsize; | |
443 /* XEmacs: Move this check here. OK if called during loadup to | |
444 load byte code instructions. */ | |
445 if (!STRINGP (Vdoc_directory)) | |
446 return Qnil; | |
447 | |
448 minsize = XSTRING_LENGTH (Vdoc_directory); | |
449 /* sizeof ("../lib-src/") == 12 */ | |
450 if (minsize < 12) | |
451 minsize = 12; | |
452 name_nonreloc = alloca_ibytes (minsize + XSTRING_LENGTH (file) + 8); | |
453 string_join (name_nonreloc, Vdoc_directory, file); | |
454 } | |
455 else | |
456 name_reloc = file; | |
457 | |
458 fd = qxe_open (name_nonreloc ? name_nonreloc : | |
459 XSTRING_DATA (name_reloc), O_RDONLY | OPEN_BINARY, 0); | |
460 if (fd < 0) | |
461 { | |
462 if (purify_flag) | |
463 { | |
464 /* sizeof ("../lib-src/") == 12 */ | |
465 name_nonreloc = alloca_ibytes (12 + XSTRING_LENGTH (file) + 8); | |
466 /* Preparing to dump; DOC file is probably not installed. | |
467 So check in ../lib-src. */ | |
468 qxestrcpy_ascii (name_nonreloc, "../lib-src/"); | |
469 qxestrcat (name_nonreloc, XSTRING_DATA (file)); | |
470 | |
471 fd = qxe_open (name_nonreloc, O_RDONLY | OPEN_BINARY, 0); | |
472 } | |
473 | |
474 if (fd < 0) | |
475 report_file_error ("Cannot open doc string file", | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
476 name_nonreloc ? build_istring (name_nonreloc) : |
3368 | 477 name_reloc); |
478 } | |
479 | |
480 tem = extract_object_file_name (fd, position, name_nonreloc, name_reloc, | |
481 standard_doc_file); | |
482 retry_close (fd); | |
483 | |
484 if (!STRINGP (tem)) | |
485 signal_error_1 (Qinvalid_byte_code, tem); | |
486 | |
487 return tem; | |
488 } | |
489 | |
490 | |
491 static void | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
492 weird_doc (Lisp_Object sym, const Ascbyte *weirdness, const Ascbyte *type, |
3368 | 493 int pos) |
494 { | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
495 if (!strcmp (weirdness, "duplicate")) return; |
3368 | 496 message ("Note: Strange doc (%s) for %s %s @ %d", |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
497 GETTEXT (weirdness), GETTEXT (type), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
498 XSTRING_DATA (XSYMBOL (sym)->name), pos); |
3368 | 499 } |
500 | |
4367
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3548
diff
changeset
|
501 DEFUN ("built-in-symbol-file", Fbuilt_in_symbol_file, 1, 2, 0, /* |
3368 | 502 Return the C source file built-in symbol SYM comes from. |
503 Don't use this. Use the more general `symbol-file' (q.v.) instead. | |
4367
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3548
diff
changeset
|
504 |
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3548
diff
changeset
|
505 If TYPE is nil or omitted, any kind of definition is acceptable. |
4905
755ae5b97edb
Change "special form" to "special operator" in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4539
diff
changeset
|
506 If TYPE is `defun', then function, subr, special operator or macro definitions |
4367
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3548
diff
changeset
|
507 are acceptable. |
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3548
diff
changeset
|
508 If TYPE is `defvar', then variable definitions are acceptable. |
3368 | 509 */ |
4367
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3548
diff
changeset
|
510 (symbol, type)) |
3368 | 511 { |
512 /* This function can GC */ | |
513 Lisp_Object fun; | |
514 Lisp_Object filename = Qnil; | |
515 | |
4367
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3548
diff
changeset
|
516 if (EQ(Ffboundp(symbol), Qt) && (EQ(type, Qnil) || EQ(type, Qdefun))) |
3368 | 517 { |
518 fun = Findirect_function (symbol); | |
519 | |
4367
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3548
diff
changeset
|
520 if (SUBRP (fun) || (CONSP(fun) && (EQ (Qmacro, Fcar_safe (fun))) |
4381
3906442b491b
Improve style and add tests for 'built-in-symbol-file'.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4377
diff
changeset
|
521 && (fun = Fcdr_safe (fun), SUBRP (fun)))) |
3368 | 522 { |
523 if (XSUBR (fun)->doc == 0) | |
524 return Qnil; | |
525 | |
526 if ((EMACS_INT) XSUBR (fun)->doc >= 0) | |
527 { | |
528 weird_doc (symbol, "No file info available for function", | |
529 GETTEXT("function"), 0); | |
530 return Qnil; | |
531 } | |
532 else | |
4539
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
533 { |
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
534 filename = get_object_file_name |
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
535 (make_int (- (EMACS_INT) XSUBR (fun)->doc)); |
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
536 return filename; |
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
537 } |
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
538 } |
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
539 |
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
540 if (COMPILED_FUNCTIONP (fun) || (CONSP(fun) && |
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
541 (EQ (Qmacro, Fcar_safe (fun))) |
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
542 && (fun = Fcdr_safe (fun), |
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
543 COMPILED_FUNCTIONP (fun)))) |
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
544 { |
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
545 Lisp_Object tem; |
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
546 Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun); |
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
547 |
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
548 if (! (f->flags.documentationp)) |
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
549 return Qnil; |
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
550 tem = compiled_function_documentation (f); |
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
551 if (NATNUMP (tem) || CONSP (tem)) |
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
552 { |
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
553 filename = get_object_file_name (tem); |
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
554 return filename; |
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
555 } |
3368 | 556 } |
557 } | |
4539
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
558 |
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
559 if (EQ(Fboundp(symbol), Qt) && (EQ(type, Qnil) || EQ(type, Qdefvar))) |
3368 | 560 { |
561 Lisp_Object doc_offset = Fget (symbol, Qvariable_documentation, Qnil); | |
562 | |
563 if (!NILP(doc_offset)) | |
564 { | |
565 if (INTP(doc_offset)) | |
566 { | |
567 filename = get_object_file_name | |
568 (XINT (doc_offset) > 0 ? doc_offset | |
569 : make_int (- XINT (doc_offset))); | |
570 } | |
571 else if (CONSP(doc_offset)) | |
572 { | |
573 filename = get_object_file_name(doc_offset); | |
574 } | |
4539
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
575 return filename; |
3368 | 576 } |
577 } | |
4539
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
578 |
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
579 return Qnil; |
3368 | 580 } |
581 | |
428 | 582 DEFUN ("documentation", Fdocumentation, 1, 2, 0, /* |
583 Return the documentation string of FUNCTION. | |
444 | 584 Unless a non-nil second argument RAW is given, the |
428 | 585 string is passed through `substitute-command-keys'. |
586 */ | |
587 (function, raw)) | |
588 { | |
589 /* This function can GC */ | |
590 Lisp_Object fun; | |
591 Lisp_Object doc; | |
592 | |
593 fun = Findirect_function (function); | |
594 | |
595 if (SUBRP (fun)) | |
596 { | |
597 if (XSUBR (fun)->doc == 0) | |
598 return Qnil; | |
599 if ((EMACS_INT) XSUBR (fun)->doc >= 0) | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
600 doc = build_cistring (XSUBR (fun)->doc); |
428 | 601 else |
602 doc = get_doc_string (make_int (- (EMACS_INT) XSUBR (fun)->doc)); | |
603 } | |
604 else if (COMPILED_FUNCTIONP (fun)) | |
605 { | |
606 Lisp_Object tem; | |
440 | 607 Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun); |
428 | 608 if (! (f->flags.documentationp)) |
609 return Qnil; | |
610 tem = compiled_function_documentation (f); | |
611 if (STRINGP (tem)) | |
612 doc = tem; | |
613 else if (NATNUMP (tem) || CONSP (tem)) | |
5206
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
614 { |
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
615 doc = get_doc_string (tem); |
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
616 /* We may have zero length strings in the docfile for file |
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
617 information. */ |
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
618 if (STRINGP (doc) && 0 == XSTRING_LENGTH (doc)) |
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
619 { |
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
620 return Qnil; |
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
621 } |
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
622 } |
428 | 623 else |
624 return Qnil; | |
625 } | |
626 else if (KEYMAPP (fun)) | |
771 | 627 return build_msg_string ("Prefix command (definition is a keymap of subcommands)."); |
428 | 628 else if (STRINGP (fun) || VECTORP (fun)) |
771 | 629 return build_msg_string ("Keyboard macro."); |
428 | 630 else if (CONSP (fun)) |
631 { | |
632 Lisp_Object funcar = Fcar (fun); | |
633 | |
634 if (!SYMBOLP (funcar)) | |
635 return Fsignal (Qinvalid_function, list1 (fun)); | |
636 else if (EQ (funcar, Qlambda) | |
637 || EQ (funcar, Qautoload)) | |
638 { | |
639 Lisp_Object tem, tem1; | |
640 tem1 = Fcdr (Fcdr (fun)); | |
641 tem = Fcar (tem1); | |
642 if (STRINGP (tem)) | |
643 doc = tem; | |
644 /* Handle a doc reference--but these never come last | |
645 in the function body, so reject them if they are last. */ | |
646 else if ((NATNUMP (tem) || CONSP (tem)) | |
647 && ! NILP (XCDR (tem1))) | |
648 doc = get_doc_string (tem); | |
649 else | |
650 return Qnil; | |
651 } | |
652 else if (EQ (funcar, Qmacro)) | |
653 return Fdocumentation (Fcdr (fun), raw); | |
654 else | |
655 goto oops; | |
656 } | |
657 else | |
658 { | |
659 oops: | |
660 return Fsignal (Qinvalid_function, list1 (fun)); | |
661 } | |
662 | |
663 if (NILP (raw)) | |
664 { | |
665 struct gcpro gcpro1; | |
666 #ifdef I18N3 | |
667 Lisp_Object domain = Qnil; | |
668 if (COMPILED_FUNCTIONP (fun)) | |
669 domain = compiled_function_domain (XCOMPILED_FUNCTION (fun)); | |
670 if (NILP (domain)) | |
671 doc = Fgettext (doc); | |
672 else | |
673 doc = Fdgettext (domain, doc); | |
674 #endif | |
675 | |
676 GCPRO1 (doc); | |
677 doc = Fsubstitute_command_keys (doc); | |
678 UNGCPRO; | |
679 } | |
680 return doc; | |
681 } | |
682 | |
683 DEFUN ("documentation-property", Fdocumentation_property, 2, 3, 0, /* | |
684 Return the documentation string that is SYMBOL's PROP property. | |
685 This is like `get', but it can refer to strings stored in the | |
686 `doc-directory/DOC' file; and if the value is a string, it is passed | |
687 through `substitute-command-keys'. A non-nil third argument avoids this | |
688 translation. | |
689 */ | |
444 | 690 (symbol, prop, raw)) |
428 | 691 { |
692 /* This function can GC */ | |
1849 | 693 Lisp_Object doc = Qnil; |
428 | 694 #ifdef I18N3 |
695 REGISTER Lisp_Object domain; | |
696 #endif | |
697 struct gcpro gcpro1; | |
698 | |
699 GCPRO1 (doc); | |
700 | |
444 | 701 doc = Fget (symbol, prop, Qnil); |
428 | 702 if (INTP (doc)) |
703 doc = get_doc_string (XINT (doc) > 0 ? doc : make_int (- XINT (doc))); | |
704 else if (CONSP (doc)) | |
705 doc = get_doc_string (doc); | |
706 #ifdef I18N3 | |
707 if (!NILP (doc)) | |
708 { | |
444 | 709 domain = Fget (symbol, Qvariable_domain, Qnil); |
428 | 710 if (NILP (domain)) |
711 doc = Fgettext (doc); | |
712 else | |
713 doc = Fdgettext (domain, doc); | |
714 } | |
715 #endif | |
716 if (NILP (raw) && STRINGP (doc)) | |
717 doc = Fsubstitute_command_keys (doc); | |
718 UNGCPRO; | |
719 return doc; | |
720 } | |
721 | |
722 | |
723 DEFUN ("Snarf-documentation", Fsnarf_documentation, 1, 1, 0, /* | |
724 Used during Emacs initialization, before dumping runnable Emacs, | |
725 to find pointers to doc strings stored in `.../lib-src/DOC' and | |
726 record them in function definitions. | |
727 One arg, FILENAME, a string which does not include a directory. | |
728 The file is written to `../lib-src', and later found in `exec-directory' | |
729 when doc strings are referred to in the dumped Emacs. | |
730 */ | |
731 (filename)) | |
732 { | |
733 int fd; | |
867 | 734 Ibyte buf[1024 + 1]; |
428 | 735 REGISTER int filled; |
736 REGISTER int pos; | |
867 | 737 REGISTER Ibyte *p, *end; |
428 | 738 Lisp_Object sym, fun, tem; |
867 | 739 Ibyte *name; |
428 | 740 |
814 | 741 /* This function should not pass the data it's reading through a coding |
742 stream. The reason is that the only purpose of this function is to | |
743 find the file offsets for the documentation of the various functions, | |
744 not do anything with the documentation itself. If we pass through a | |
745 coding stream, the pointers will get messed up when we start reading | |
746 ISO 2022 data because our pointers will reflect internal format, not | |
747 external format. */ | |
748 | |
428 | 749 if (!purify_flag) |
563 | 750 invalid_operation ("Snarf-documentation can only be called in an undumped Emacs", Qunbound); |
428 | 751 |
752 CHECK_STRING (filename); | |
753 | |
1330 | 754 { |
755 name = alloca_ibytes (XSTRING_LENGTH (filename) + 14); | |
2367 | 756 qxestrcpy_ascii (name, "../lib-src/"); |
1330 | 757 } |
428 | 758 |
771 | 759 qxestrcat (name, XSTRING_DATA (filename)); |
428 | 760 |
771 | 761 fd = qxe_open (name, O_RDONLY | OPEN_BINARY, 0); |
428 | 762 if (fd < 0) |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
763 report_file_error ("Opening doc string file", build_istring (name)); |
428 | 764 Vinternal_doc_file_name = filename; |
765 filled = 0; | |
766 pos = 0; | |
767 while (1) | |
768 { | |
769 if (filled < 512) | |
771 | 770 filled += retry_read (fd, &buf[filled], sizeof (buf) - 1 - filled); |
428 | 771 if (!filled) |
772 break; | |
773 | |
774 buf[filled] = 0; | |
775 p = buf; | |
776 end = buf + (filled < 512 ? filled : filled - 128); | |
777 while (p != end && *p != '\037') p++; | |
778 /* p points to ^_Ffunctionname\n or ^_Vvarname\n. */ | |
779 if (p != end) | |
780 { | |
771 | 781 end = qxestrchr (p, '\n'); |
3548 | 782 /* If you trigger a failure with this assertion, you probably |
783 configured with --quick-build and need to rebuild your DOC | |
3545 | 784 file. */ |
785 assert((end - p - 2) > -1); | |
771 | 786 sym = oblookup (Vobarray, p + 2, end - p - 2); |
428 | 787 if (SYMBOLP (sym)) |
788 { | |
789 Lisp_Object offset = make_int (pos + end + 1 - buf); | |
790 /* Attach a docstring to a variable */ | |
791 if (p[1] == 'V') | |
792 { | |
793 /* Install file-position as variable-documentation property | |
794 and make it negative for a user-variable | |
795 (doc starts with a `*'). */ | |
796 Lisp_Object old = Fget (sym, Qvariable_documentation, Qzero); | |
797 if (!ZEROP (old)) | |
798 { | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
799 weird_doc (sym, "duplicate", |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
800 "variable", pos); |
428 | 801 /* In the case of duplicate doc file entries, always |
802 take the later one. But if the doc is not an int | |
803 (a string, say) leave it alone. */ | |
804 if (!INTP (old)) | |
805 goto weird; | |
806 } | |
807 Fput (sym, Qvariable_documentation, | |
808 ((end[1] == '*') | |
809 ? make_int (- XINT (offset)) | |
810 : offset)); | |
811 } | |
812 /* Attach a docstring to a function. | |
813 The type determines where the docstring is stored. */ | |
814 else if (p[1] == 'F') | |
815 { | |
816 fun = indirect_function (sym,0); | |
817 | |
818 if (CONSP (fun) && EQ (XCAR (fun), Qmacro)) | |
819 fun = XCDR (fun); | |
820 | |
821 if (UNBOUNDP (fun)) | |
822 { | |
771 | 823 #if 0 /* There are lots of legitimate cases where this message will appear |
824 (e.g. any function that's only defined when MULE is defined, | |
825 provided that the function is used somewhere in a dumped Lisp | |
826 file, so that the symbol is interned in the dumped XEmacs), and | |
827 there's not a lot that can be done to eliminate the warning other | |
828 than kludges like moving the function to a Mule-only source file, | |
829 which often results in ugly code. Furthermore, the only point of | |
830 this warning is to warn you when you have a DEFUN that you forget | |
831 to DEFSUBR, but the compiler will also warn you, because the DEFUN | |
832 declares a static object, and the object will be unused -- you'll | |
833 get something like | |
834 | |
835 /src/xemacs/mule/src/abbrev.c:269: warning: `SFexpand_abbrev' defined but not used | |
836 | |
837 So I'm disabling this. --ben */ | |
838 | |
428 | 839 /* May have been #if'ed out or something */ |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
840 weird_doc (sym, "not fboundp", |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
841 "function", pos); |
771 | 842 #endif |
428 | 843 goto weird; |
844 } | |
845 else if (SUBRP (fun)) | |
846 { | |
847 /* Lisp_Subrs have a slot for it. */ | |
848 if (XSUBR (fun)->doc) | |
849 { | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
850 weird_doc (sym, "duplicate", |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
851 "subr", pos); |
428 | 852 goto weird; |
853 } | |
854 XSUBR (fun)->doc = (char *) (- XINT (offset)); | |
855 } | |
856 else if (CONSP (fun)) | |
857 { | |
858 /* If it's a lisp form, stick it in the form. */ | |
859 tem = XCAR (fun); | |
860 if (EQ (tem, Qlambda) || EQ (tem, Qautoload)) | |
861 { | |
862 tem = Fcdr (Fcdr (fun)); | |
863 if (CONSP (tem) && | |
864 INTP (XCAR (tem))) | |
865 { | |
866 Lisp_Object old = XCAR (tem); | |
867 if (!ZEROP (old)) | |
868 { | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
869 if (EQ (tem, Qlambda)) |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
870 weird_doc (sym, "duplicate", "lambda", |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
871 pos); |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
872 else |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
873 weird_doc (sym, "duplicate", "autoload", |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
874 pos); |
428 | 875 /* In the case of duplicate doc file entries, |
876 always take the later one. But if the doc | |
877 is not an int (a string, say) leave it | |
878 alone. */ | |
879 if (!INTP (old)) | |
880 goto weird; | |
881 } | |
882 XCAR (tem) = offset; | |
883 } | |
884 else if (!CONSP (tem)) | |
885 { | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
886 weird_doc (sym, "!CONSP(tem)", "function", pos); |
428 | 887 goto cont; |
888 } | |
889 else | |
890 { | |
891 /* DOC string is a string not integer 0 */ | |
892 #if 0 | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
893 weird_doc (sym, "!INTP(XCAR(tem))", |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
894 "function", pos); |
428 | 895 #endif |
896 goto cont; | |
897 } | |
898 } | |
899 else | |
900 { | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
901 weird_doc (sym, "not lambda or autoload", |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
902 "function", pos); |
428 | 903 goto cont; |
904 } | |
905 } | |
906 else if (COMPILED_FUNCTIONP (fun)) | |
907 { | |
908 /* Compiled-Function objects sometimes have | |
909 slots for it. */ | |
440 | 910 Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun); |
428 | 911 |
5206
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
912 /* If there were multiple definitions for this function, |
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
913 and the latter one didn't |
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
914 have any doc, warn and don't blow up. */ |
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
915 Lisp_Object old = |
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
916 compiled_function_documentation (f); |
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
917 if (!ZEROP (old) && !NILP (old)) |
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
918 { |
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
919 weird_doc (sym, "duplicate", "bytecode", pos); |
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
920 /* In the case of duplicate doc file entries, |
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
921 always take the later one. But if the doc is |
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
922 not an int (a string, say) leave it alone. */ |
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
923 if (!INTP (old)) |
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
924 goto weird; |
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
925 } |
428 | 926 |
5206
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
927 /* This may be a function or variable where we want |
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
928 to make the file name available. */ |
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
929 set_compiled_function_documentation (f, offset); |
428 | 930 } |
931 else | |
932 { | |
933 /* Otherwise the function is undefined or | |
934 otherwise weird. Ignore it. */ | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
935 weird_doc (sym, "weird function", "function", pos); |
428 | 936 goto weird; |
937 } | |
938 } | |
939 else | |
940 { | |
941 /* lose: */ | |
771 | 942 signal_error (Qfile_error, "DOC file invalid at position", |
943 make_int (pos)); | |
428 | 944 weird: |
945 /* goto lose */; | |
946 } | |
947 } | |
948 } | |
949 cont: | |
950 pos += end - buf; | |
951 filled -= end - buf; | |
952 memmove (buf, end, filled); | |
953 } | |
771 | 954 retry_close (fd); |
428 | 955 return Qnil; |
956 } | |
957 | |
958 #if 1 /* Don't warn about functions whose doc was lost because they were | |
959 wrapped by advice-freeze.el... */ | |
960 static int | |
961 kludgily_ignore_lost_doc_p (Lisp_Object sym) | |
962 { | |
963 # define kludge_prefix "ad-Orig-" | |
793 | 964 Lisp_Object name = XSYMBOL (sym)->name; |
965 return (XSTRING_LENGTH (name) > (Bytecount) (sizeof (kludge_prefix)) && | |
2367 | 966 !qxestrncmp_ascii (XSTRING_DATA (name), kludge_prefix, |
793 | 967 sizeof (kludge_prefix) - 1)); |
428 | 968 # undef kludge_prefix |
969 } | |
970 #else | |
971 # define kludgily_ignore_lost_doc_p(sym) 0 | |
972 #endif | |
973 | |
974 | |
975 static int | |
976 verify_doc_mapper (Lisp_Object sym, void *arg) | |
977 { | |
793 | 978 Lisp_Object closure = * (Lisp_Object *) arg; |
428 | 979 |
980 if (!NILP (Ffboundp (sym))) | |
981 { | |
982 int doc = 0; | |
983 Lisp_Object fun = XSYMBOL (sym)->function; | |
984 if (CONSP (fun) && | |
985 EQ (XCAR (fun), Qmacro)) | |
986 fun = XCDR (fun); | |
987 | |
988 if (SUBRP (fun)) | |
989 doc = (EMACS_INT) XSUBR (fun)->doc; | |
990 else if (SYMBOLP (fun)) | |
991 doc = -1; | |
992 else if (KEYMAPP (fun)) | |
993 doc = -1; | |
994 else if (CONSP (fun)) | |
995 { | |
996 Lisp_Object tem = XCAR (fun); | |
997 if (EQ (tem, Qlambda) || EQ (tem, Qautoload)) | |
998 { | |
999 doc = -1; | |
1000 tem = Fcdr (Fcdr (fun)); | |
1001 if (CONSP (tem) && | |
1002 INTP (XCAR (tem))) | |
1003 doc = XINT (XCAR (tem)); | |
1004 } | |
1005 } | |
1006 else if (COMPILED_FUNCTIONP (fun)) | |
1007 { | |
440 | 1008 Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun); |
428 | 1009 if (! (f->flags.documentationp)) |
1010 doc = -1; | |
1011 else | |
1012 { | |
1013 Lisp_Object tem = compiled_function_documentation (f); | |
1014 if (INTP (tem)) | |
1015 doc = XINT (tem); | |
1016 } | |
1017 } | |
1018 | |
1019 if (doc == 0 && !kludgily_ignore_lost_doc_p (sym)) | |
1020 { | |
1021 message ("Warning: doc lost for function %s.", | |
793 | 1022 XSTRING_DATA (XSYMBOL (sym)->name)); |
428 | 1023 XCDR (closure) = Qt; |
1024 } | |
1025 } | |
1026 if (!NILP (Fboundp (sym))) | |
1027 { | |
1028 Lisp_Object doc = Fget (sym, Qvariable_documentation, Qnil); | |
1029 if (ZEROP (doc)) | |
1030 { | |
1031 message ("Warning: doc lost for variable %s.", | |
793 | 1032 XSTRING_DATA (XSYMBOL (sym)->name)); |
428 | 1033 XCDR (closure) = Qt; |
1034 } | |
1035 } | |
1036 return 0; /* Never stop */ | |
1037 } | |
1038 | |
1039 DEFUN ("Verify-documentation", Fverify_documentation, 0, 0, 0, /* | |
1040 Used to make sure everything went well with Snarf-documentation. | |
1041 Writes to stderr if not. | |
1042 */ | |
1043 ()) | |
1044 { | |
1045 Lisp_Object closure = Fcons (Qnil, Qnil); | |
1046 struct gcpro gcpro1; | |
1047 GCPRO1 (closure); | |
1048 map_obarray (Vobarray, verify_doc_mapper, &closure); | |
1049 if (!NILP (Fcdr (closure))) | |
1050 message ("\n" | |
1051 "This is usually because some files were preloaded by loaddefs.el or\n" | |
1052 "site-load.el, but were not passed to make-docfile by Makefile.\n"); | |
1053 UNGCPRO; | |
1054 return NILP (Fcdr (closure)) ? Qt : Qnil; | |
1055 } | |
1056 | |
1057 | |
1058 DEFUN ("substitute-command-keys", Fsubstitute_command_keys, 1, 1, 0, /* | |
1059 Substitute key descriptions for command names in STRING. | |
1060 Return a new string which is STRING with substrings of the form \\=\\[COMMAND] | |
1061 replaced by either: a keystroke sequence that will invoke COMMAND, | |
1062 or "M-x COMMAND" if COMMAND is not on any keys. | |
1063 Substrings of the form \\=\\{MAPVAR} are replaced by summaries | |
444 | 1064 \(made by `describe-bindings') of the value of MAPVAR, taken as a keymap. |
428 | 1065 Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR |
1066 as the keymap for future \\=\\[COMMAND] substrings. | |
1067 \\=\\= quotes the following character and is discarded; | |
1068 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output. | |
1069 */ | |
444 | 1070 (string)) |
428 | 1071 { |
1072 /* This function can GC */ | |
867 | 1073 Ibyte *buf; |
428 | 1074 int changed = 0; |
867 | 1075 REGISTER Ibyte *strdata; |
1076 REGISTER Ibyte *bufp; | |
428 | 1077 Bytecount strlength; |
1078 Bytecount idx; | |
1079 Bytecount bsize; | |
3025 | 1080 Ibyte *new_; |
444 | 1081 Lisp_Object tem = Qnil; |
1082 Lisp_Object keymap = Qnil; | |
1083 Lisp_Object name = Qnil; | |
867 | 1084 Ibyte *start; |
428 | 1085 Bytecount length; |
1086 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; | |
1087 | |
444 | 1088 if (NILP (string)) |
428 | 1089 return Qnil; |
1090 | |
444 | 1091 CHECK_STRING (string); |
1092 GCPRO4 (string, tem, keymap, name); | |
428 | 1093 |
1094 /* There is the possibility that the string is not destined for a | |
1095 translating stream, and it could be argued that we should do the | |
1096 same thing here as in Fformat(), but there are very few times | |
1097 when this will be the case and many calls to this function | |
1098 would have to have `gettext' calls added. (I18N3) */ | |
444 | 1099 string = LISP_GETTEXT (string); |
428 | 1100 |
1101 /* KEYMAP is either nil (which means search all the active keymaps) | |
1102 or a specified local map (which means search just that and the | |
1103 global map). If non-nil, it might come from Voverriding_local_map, | |
444 | 1104 or from a \\<mapname> construct in STRING itself.. */ |
428 | 1105 #if 0 /* FSFmacs */ |
1106 /* This is really weird and garbagey. If keymap is nil and there's | |
1107 an overriding-local-map, `where-is-internal' will correctly note | |
1108 this, so there's no reason to do it here. Maybe FSFmacs | |
1109 `where-is-internal' is broken. */ | |
1110 /* | |
1111 keymap = current_kboard->Voverriding_terminal_local_map; | |
1112 if (NILP (keymap)) | |
1113 keymap = Voverriding_local_map; | |
1114 */ | |
1115 #endif | |
1116 | |
444 | 1117 strlength = XSTRING_LENGTH (string); |
2367 | 1118 bsize = ITEXT_ZTERM_SIZE + strlength; |
1119 buf = xnew_ibytes (bsize); | |
428 | 1120 bufp = buf; |
1121 | |
1122 /* Have to reset strdata every time GC might be called */ | |
444 | 1123 strdata = XSTRING_DATA (string); |
428 | 1124 for (idx = 0; idx < strlength; ) |
1125 { | |
867 | 1126 Ibyte *strp = strdata + idx; |
428 | 1127 |
1128 if (strp[0] != '\\') | |
1129 { | |
1130 /* just copy other chars */ | |
1131 /* As it happens, this will work with Mule even if the | |
1132 character quoted is multi-byte; the remaining multi-byte | |
1133 characters will just be copied by this loop. */ | |
1134 *bufp++ = *strp; | |
1135 idx++; | |
1136 } | |
1137 else switch (strp[1]) | |
1138 { | |
1139 default: | |
1140 { | |
1141 /* just copy unknown escape sequences */ | |
1142 *bufp++ = *strp; | |
1143 idx++; | |
1144 break; | |
1145 } | |
1146 case '=': | |
1147 { | |
1148 /* \= quotes the next character; | |
1149 thus, to put in \[ without its special meaning, use \=\[. */ | |
1150 /* As it happens, this will work with Mule even if the | |
1151 character quoted is multi-byte; the remaining multi-byte | |
1152 characters will just be copied by this loop. */ | |
1153 changed = 1; | |
1154 *bufp++ = strp[2]; | |
1155 idx += 3; | |
1156 break; | |
1157 } | |
1158 case '[': | |
1159 { | |
1160 changed = 1; | |
1161 idx += 2; /* skip \[ */ | |
1162 strp += 2; | |
1163 start = strp; | |
1164 | |
1165 while ((idx < strlength) | |
1166 && *strp != ']') | |
1167 { | |
1168 strp++; | |
1169 idx++; | |
1170 } | |
1171 length = strp - start; | |
1172 idx++; /* skip ] */ | |
1173 | |
1174 tem = Fintern (make_string (start, length), Qnil); | |
1175 tem = Fwhere_is_internal (tem, keymap, Qt, Qnil, Qnil); | |
1176 | |
1177 #if 0 /* FSFmacs */ | |
444 | 1178 /* Disregard menu bar bindings; it is positively annoying to |
1179 mention them when there's no menu bar, and it isn't terribly | |
1180 useful even when there is a menu bar. */ | |
1181 if (!NILP (tem)) | |
1182 { | |
1183 firstkey = Faref (tem, Qzero); | |
1184 if (EQ (firstkey, Qmenu_bar)) | |
1185 tem = Qnil; | |
1186 } | |
428 | 1187 #endif |
1188 | |
1189 if (NILP (tem)) /* but not on any keys */ | |
1190 { | |
3025 | 1191 new_ = (Ibyte *) xrealloc (buf, bsize += 4); |
1192 bufp += new_ - buf; | |
1193 buf = new_; | |
428 | 1194 memcpy (bufp, "M-x ", 4); |
1195 bufp += 4; | |
1196 goto subst; | |
1197 } | |
1198 else | |
1199 { /* function is on a key */ | |
1200 tem = Fkey_description (tem); | |
1201 goto subst_string; | |
1202 } | |
1203 } | |
1204 case '{': | |
1205 case '<': | |
1206 { | |
444 | 1207 Lisp_Object buffer = Fget_buffer_create (QSsubstitute); |
1208 struct buffer *buf_ = XBUFFER (buffer); | |
428 | 1209 |
1210 Fbuffer_disable_undo (buffer); | |
1211 Ferase_buffer (buffer); | |
1212 | |
1213 /* \{foo} is replaced with a summary of keymap (symbol-value foo). | |
1214 \<foo> just sets the keymap used for \[cmd]. */ | |
1215 changed = 1; | |
1216 idx += 2; /* skip \{ or \< */ | |
1217 strp += 2; | |
1218 start = strp; | |
1219 | |
1220 while ((idx < strlength) | |
1221 && *strp != '}' && *strp != '>') | |
1222 { | |
1223 strp++; | |
1224 idx++; | |
1225 } | |
1226 length = strp - start; | |
1227 idx++; /* skip } or > */ | |
1228 | |
1229 /* Get the value of the keymap in TEM, or nil if undefined. | |
1230 Do this while still in the user's current buffer | |
1231 in case it is a local variable. */ | |
1232 name = Fintern (make_string (start, length), Qnil); | |
1233 tem = Fboundp (name); | |
1234 if (! NILP (tem)) | |
1235 { | |
1236 tem = Fsymbol_value (name); | |
1237 if (! NILP (tem)) | |
1238 tem = get_keymap (tem, 0, 1); | |
1239 } | |
1240 | |
1241 if (NILP (tem)) | |
1242 { | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1243 buffer_insert_ascstring (buf_, "(uses keymap \""); |
444 | 1244 buffer_insert_lisp_string (buf_, Fsymbol_name (name)); |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1245 buffer_insert_ascstring (buf_, "\", which is not currently defined) "); |
428 | 1246 |
1247 if (start[-1] == '<') keymap = Qnil; | |
1248 } | |
1249 else if (start[-1] == '<') | |
1250 keymap = tem; | |
1251 else | |
1252 describe_map_tree (tem, 1, Qnil, Qnil, 0, buffer); | |
1253 | |
1254 tem = make_string_from_buffer (buf_, BUF_BEG (buf_), | |
1255 BUF_Z (buf_) - BUF_BEG (buf_)); | |
1256 Ferase_buffer (buffer); | |
444 | 1257 } |
1258 goto subst_string; | |
428 | 1259 |
444 | 1260 subst_string: |
1261 start = XSTRING_DATA (tem); | |
1262 length = XSTRING_LENGTH (tem); | |
1263 subst: | |
1264 bsize += length; | |
3025 | 1265 new_ = (Ibyte *) xrealloc (buf, bsize); |
1266 bufp += new_ - buf; | |
1267 buf = new_; | |
444 | 1268 memcpy (bufp, start, length); |
1269 bufp += length; | |
428 | 1270 |
444 | 1271 /* Reset STRDATA in case gc relocated it. */ |
1272 strdata = XSTRING_DATA (string); | |
428 | 1273 |
444 | 1274 break; |
428 | 1275 } |
1276 } | |
1277 | |
1278 if (changed) /* don't bother if nothing substituted */ | |
1279 tem = make_string (buf, bufp - buf); | |
1280 else | |
444 | 1281 tem = string; |
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
1282 xfree (buf); |
428 | 1283 UNGCPRO; |
1284 return tem; | |
1285 } | |
1286 | |
1287 | |
1288 /************************************************************************/ | |
1289 /* initialization */ | |
1290 /************************************************************************/ | |
1291 | |
1292 void | |
1293 syms_of_doc (void) | |
1294 { | |
3368 | 1295 DEFSUBR (Fbuilt_in_symbol_file); |
428 | 1296 DEFSUBR (Fdocumentation); |
1297 DEFSUBR (Fdocumentation_property); | |
1298 DEFSUBR (Fsnarf_documentation); | |
1299 DEFSUBR (Fverify_documentation); | |
1300 DEFSUBR (Fsubstitute_command_keys); | |
4367
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3548
diff
changeset
|
1301 |
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3548
diff
changeset
|
1302 DEFSYMBOL (Qdefvar); |
428 | 1303 } |
1304 | |
1305 void | |
1306 vars_of_doc (void) | |
1307 { | |
1308 DEFVAR_LISP ("internal-doc-file-name", &Vinternal_doc_file_name /* | |
1309 Name of file containing documentation strings of built-in symbols. | |
1310 */ ); | |
1311 Vinternal_doc_file_name = Qnil; | |
1312 | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
1313 QSsubstitute = build_ascstring (" *substitute*"); |
428 | 1314 staticpro (&QSsubstitute); |
1315 } |