Mercurial > hg > xemacs-beta
annotate src/doc.c @ 4899:aa8197436fdb
Make #'find-function behave better with dumped functions, installed XEmacs
2010-01-30 Aidan Kehoe <kehoea@parhasard.net>
* loadup.el:
If any filename in load-history starts with the value of
source-lisp, delete that part of the string, so that
#'find-function works better with dumped functions in an installed
XEmacs (it will look in lisp-directory instead, where it will
probably succeed).
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Sat, 30 Jan 2010 15:47:37 +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 } |