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