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.
793
+ − 4 Copyright (C) 2001, 2002 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
+ − 40 Lisp_Object QSsubstitute;
+ − 41
814
+ − 42 /* Read and return doc string or instructions from open file descriptor FD
+ − 43 at position POSITION. Does not close the file. Returns string; or if
+ − 44 error, returns a cons holding the error data to pass to Fsignal.
+ − 45 NAME_NONRELOC and NAME_RELOC are only used for the error messages. */
428
+ − 46
+ − 47 Lisp_Object
+ − 48 unparesseuxify_doc_string (int fd, EMACS_INT position,
867
+ − 49 Ibyte *name_nonreloc, Lisp_Object name_reloc,
814
+ − 50 int standard_doc_file)
428
+ − 51 {
867
+ − 52 Ibyte buf[512 * 32 + 1];
+ − 53 Ibyte *buffer = buf;
428
+ − 54 int buffer_size = sizeof (buf);
867
+ − 55 Ibyte *from, *to;
+ − 56 REGISTER Ibyte *p = buffer;
428
+ − 57 Lisp_Object return_me;
814
+ − 58 Lisp_Object fdstream = Qnil, instream = Qnil;
+ − 59 struct gcpro gcpro1, gcpro2;
+ − 60
+ − 61 GCPRO2 (fdstream, instream);
428
+ − 62
+ − 63 if (0 > lseek (fd, position, 0))
+ − 64 {
+ − 65 if (name_nonreloc)
771
+ − 66 name_reloc = build_intstring (name_nonreloc);
+ − 67 return_me = list3 (build_msg_string
428
+ − 68 ("Position out of range in doc string file"),
+ − 69 name_reloc, make_int (position));
+ − 70 goto done;
+ − 71 }
+ − 72
814
+ − 73 fdstream = make_filedesc_input_stream (fd, 0, -1, 0);
+ − 74 Lstream_set_buffering (XLSTREAM (fdstream), LSTREAM_UNBUFFERED, 0);
+ − 75 instream =
+ − 76 make_coding_input_stream
+ − 77 /* Major trouble if we are too clever when reading byte-code
+ − 78 instructions!
+ − 79
+ − 80 #### We should have a way of handling escape-quoted elc files
+ − 81 (i.e. files with non-ASCII/Latin-1 chars in them). Currently this
+ − 82 is "solved" in bytecomp.el by never inserting lazy references in
+ − 83 such files. */
826
+ − 84 (XLSTREAM (fdstream), standard_doc_file ? Qescape_quoted : Qbinary,
814
+ − 85 CODING_DECODE, 0);
+ − 86 Lstream_set_buffering (XLSTREAM (instream), LSTREAM_UNBUFFERED, 0);
+ − 87
428
+ − 88 /* Read the doc string into a buffer.
+ − 89 Use the fixed buffer BUF if it is big enough; otherwise allocate one.
+ − 90 We store the buffer in use in BUFFER and its size in BUFFER_SIZE. */
+ − 91
+ − 92 while (1)
+ − 93 {
+ − 94 int space_left = buffer_size - (p - buffer);
+ − 95 int nread;
+ − 96
+ − 97 /* Switch to a bigger buffer if we need one. */
+ − 98 if (space_left == 0)
+ − 99 {
867
+ − 100 Ibyte *old_buffer = buffer;
771
+ − 101 if (buffer == buf)
+ − 102 {
867
+ − 103 buffer = (Ibyte *) xmalloc (buffer_size *= 2);
771
+ − 104 memcpy (buffer, old_buffer, p - old_buffer);
+ − 105 }
+ − 106 else
867
+ − 107 buffer = (Ibyte *) xrealloc (buffer, buffer_size *= 2);
428
+ − 108 p += buffer - old_buffer;
+ − 109 space_left = buffer_size - (p - buffer);
+ − 110 }
+ − 111
+ − 112 /* Don't read too much at one go. */
+ − 113 if (space_left > 1024 * 8)
+ − 114 space_left = 1024 * 8;
814
+ − 115 nread = Lstream_read (XLSTREAM (instream), p, space_left);
428
+ − 116 if (nread < 0)
+ − 117 {
771
+ − 118 return_me = list1 (build_msg_string
428
+ − 119 ("Read error on documentation file"));
+ − 120 goto done;
+ − 121 }
+ − 122 p[nread] = 0;
+ − 123 if (!nread)
+ − 124 break;
+ − 125 {
867
+ − 126 Ibyte *p1 = qxestrchr (p, '\037'); /* End of doc string marker */
814
+ − 127 if (p1)
+ − 128 {
+ − 129 *p1 = 0;
+ − 130 p = p1;
+ − 131 break;
+ − 132 }
428
+ − 133 }
+ − 134 p += nread;
+ − 135 }
+ − 136
+ − 137 /* Scan the text and remove quoting with ^A (char code 1).
+ − 138 ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_. */
+ − 139 from = to = buffer;
+ − 140 while (from < p)
+ − 141 {
+ − 142 if (*from != 1 /*^A*/)
+ − 143 *to++ = *from++;
+ − 144 else
+ − 145 {
+ − 146 int c = *(++from);
+ − 147
+ − 148 from++;
+ − 149 switch (c)
+ − 150 {
+ − 151 case 1: *to++ = c; break;
+ − 152 case '0': *to++ = '\0'; break;
+ − 153 case '_': *to++ = '\037'; break;
+ − 154 default:
771
+ − 155 return_me = list2 (build_msg_string
428
+ − 156 ("Invalid data in documentation file -- ^A followed by weird code"),
+ − 157 make_int (c));
+ − 158 goto done;
+ − 159 }
+ − 160 }
+ − 161 }
+ − 162
814
+ − 163 return_me = make_string (buffer, to - buffer);
428
+ − 164
+ − 165 done:
814
+ − 166 if (!NILP (instream))
+ − 167 {
+ − 168 Lstream_delete (XLSTREAM (instream));
+ − 169 Lstream_delete (XLSTREAM (fdstream));
+ − 170 }
+ − 171 UNGCPRO;
428
+ − 172 if (buffer != buf) /* We must have allocated buffer above */
+ − 173 xfree (buffer);
+ − 174 return return_me;
+ − 175 }
+ − 176
771
+ − 177 #define string_join(dest, s1, s2) \
+ − 178 memcpy (dest, XSTRING_DATA (s1), XSTRING_LENGTH (s1)); \
+ − 179 memcpy (dest + XSTRING_LENGTH (s1), XSTRING_DATA (s2), \
+ − 180 XSTRING_LENGTH (s2)); \
428
+ − 181 dest[XSTRING_LENGTH (s1) + XSTRING_LENGTH (s2)] = '\0'
+ − 182
+ − 183 /* Extract a doc string from a file. FILEPOS says where to get it.
+ − 184 (This could actually be byte code instructions/constants instead
+ − 185 of a doc string.)
+ − 186 If it is an integer, use that position in the standard DOC file.
+ − 187 If it is (FILE . INTEGER), use FILE as the file name
+ − 188 and INTEGER as the position in that file.
+ − 189 But if INTEGER is negative, make it positive.
+ − 190 (A negative integer is used for user variables, so we can distinguish
+ − 191 them without actually fetching the doc string.) */
+ − 192
+ − 193 static Lisp_Object
+ − 194 get_doc_string (Lisp_Object filepos)
+ − 195 {
+ − 196 REGISTER int fd;
867
+ − 197 REGISTER Ibyte *name_nonreloc = 0;
428
+ − 198 EMACS_INT position;
+ − 199 Lisp_Object file, tem;
+ − 200 Lisp_Object name_reloc = Qnil;
814
+ − 201 int standard_doc_file = 0;
428
+ − 202
+ − 203 if (INTP (filepos))
+ − 204 {
+ − 205 file = Vinternal_doc_file_name;
814
+ − 206 standard_doc_file = 1;
428
+ − 207 position = XINT (filepos);
+ − 208 }
+ − 209 else if (CONSP (filepos) && INTP (XCDR (filepos)))
+ − 210 {
+ − 211 file = XCAR (filepos);
+ − 212 position = XINT (XCDR (filepos));
+ − 213 if (position < 0)
+ − 214 position = - position;
+ − 215 }
+ − 216 else
+ − 217 return Qnil;
+ − 218
+ − 219 if (!STRINGP (file))
+ − 220 return Qnil;
+ − 221
+ − 222 /* Put the file name in NAME as a C string.
+ − 223 If it is relative, combine it with Vdoc_directory. */
+ − 224
+ − 225 tem = Ffile_name_absolute_p (file);
+ − 226 if (NILP (tem))
+ − 227 {
647
+ − 228 Bytecount minsize;
428
+ − 229 /* XEmacs: Move this check here. OK if called during loadup to
+ − 230 load byte code instructions. */
+ − 231 if (!STRINGP (Vdoc_directory))
+ − 232 return Qnil;
+ − 233
+ − 234 minsize = XSTRING_LENGTH (Vdoc_directory);
+ − 235 /* sizeof ("../lib-src/") == 12 */
+ − 236 if (minsize < 12)
+ − 237 minsize = 12;
867
+ − 238 name_nonreloc = alloca_ibytes (minsize + XSTRING_LENGTH (file) + 8);
428
+ − 239 string_join (name_nonreloc, Vdoc_directory, file);
+ − 240 }
+ − 241 else
+ − 242 name_reloc = file;
+ − 243
771
+ − 244 fd = qxe_open (name_nonreloc ? name_nonreloc :
+ − 245 XSTRING_DATA (name_reloc), O_RDONLY | OPEN_BINARY, 0);
428
+ − 246 if (fd < 0)
+ − 247 {
+ − 248 #ifndef CANNOT_DUMP
+ − 249 if (purify_flag)
+ − 250 {
+ − 251 /* sizeof ("../lib-src/") == 12 */
867
+ − 252 name_nonreloc = (Ibyte *) ALLOCA (12 + XSTRING_LENGTH (file) + 8);
428
+ − 253 /* Preparing to dump; DOC file is probably not installed.
+ − 254 So check in ../lib-src. */
867
+ − 255 qxestrcpy (name_nonreloc, (Ibyte *) "../lib-src/");
771
+ − 256 qxestrcat (name_nonreloc, XSTRING_DATA (file));
428
+ − 257
771
+ − 258 fd = qxe_open (name_nonreloc, O_RDONLY | OPEN_BINARY, 0);
428
+ − 259 }
+ − 260 #endif /* CANNOT_DUMP */
+ − 261
+ − 262 if (fd < 0)
814
+ − 263 report_file_error ("Cannot open doc string file",
+ − 264 name_nonreloc ? build_intstring (name_nonreloc) :
+ − 265 name_reloc);
428
+ − 266 }
+ − 267
814
+ − 268 tem = unparesseuxify_doc_string (fd, position, name_nonreloc, name_reloc,
+ − 269 standard_doc_file);
771
+ − 270 retry_close (fd);
428
+ − 271
+ − 272 if (!STRINGP (tem))
563
+ − 273 signal_error_1 (Qinvalid_byte_code, tem);
428
+ − 274
+ − 275 return tem;
+ − 276 }
+ − 277
+ − 278 /* Get a string from position FILEPOS and pass it through the Lisp reader.
+ − 279 We use this for fetching the bytecode string and constants vector
+ − 280 of a compiled function from the .elc file. */
+ − 281
+ − 282 Lisp_Object
+ − 283 read_doc_string (Lisp_Object filepos)
+ − 284 {
+ − 285 Lisp_Object string = get_doc_string (filepos);
+ − 286
+ − 287 if (!STRINGP (string))
563
+ − 288 invalid_state ("loading bytecode failed to return string", string);
428
+ − 289 return Fread (string);
+ − 290 }
+ − 291
+ − 292 DEFUN ("documentation", Fdocumentation, 1, 2, 0, /*
+ − 293 Return the documentation string of FUNCTION.
444
+ − 294 Unless a non-nil second argument RAW is given, the
428
+ − 295 string is passed through `substitute-command-keys'.
+ − 296 */
+ − 297 (function, raw))
+ − 298 {
+ − 299 /* This function can GC */
+ − 300 Lisp_Object fun;
+ − 301 Lisp_Object doc;
+ − 302
+ − 303 fun = Findirect_function (function);
+ − 304
+ − 305 if (SUBRP (fun))
+ − 306 {
+ − 307 if (XSUBR (fun)->doc == 0)
+ − 308 return Qnil;
+ − 309 if ((EMACS_INT) XSUBR (fun)->doc >= 0)
+ − 310 doc = build_string (XSUBR (fun)->doc);
+ − 311 else
+ − 312 doc = get_doc_string (make_int (- (EMACS_INT) XSUBR (fun)->doc));
+ − 313 }
+ − 314 else if (COMPILED_FUNCTIONP (fun))
+ − 315 {
+ − 316 Lisp_Object tem;
440
+ − 317 Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun);
428
+ − 318 if (! (f->flags.documentationp))
+ − 319 return Qnil;
+ − 320 tem = compiled_function_documentation (f);
+ − 321 if (STRINGP (tem))
+ − 322 doc = tem;
+ − 323 else if (NATNUMP (tem) || CONSP (tem))
+ − 324 doc = get_doc_string (tem);
+ − 325 else
+ − 326 return Qnil;
+ − 327 }
+ − 328 else if (KEYMAPP (fun))
771
+ − 329 return build_msg_string ("Prefix command (definition is a keymap of subcommands).");
428
+ − 330 else if (STRINGP (fun) || VECTORP (fun))
771
+ − 331 return build_msg_string ("Keyboard macro.");
428
+ − 332 else if (CONSP (fun))
+ − 333 {
+ − 334 Lisp_Object funcar = Fcar (fun);
+ − 335
+ − 336 if (!SYMBOLP (funcar))
+ − 337 return Fsignal (Qinvalid_function, list1 (fun));
+ − 338 else if (EQ (funcar, Qlambda)
+ − 339 || EQ (funcar, Qautoload))
+ − 340 {
+ − 341 Lisp_Object tem, tem1;
+ − 342 tem1 = Fcdr (Fcdr (fun));
+ − 343 tem = Fcar (tem1);
+ − 344 if (STRINGP (tem))
+ − 345 doc = tem;
+ − 346 /* Handle a doc reference--but these never come last
+ − 347 in the function body, so reject them if they are last. */
+ − 348 else if ((NATNUMP (tem) || CONSP (tem))
+ − 349 && ! NILP (XCDR (tem1)))
+ − 350 doc = get_doc_string (tem);
+ − 351 else
+ − 352 return Qnil;
+ − 353 }
+ − 354 else if (EQ (funcar, Qmacro))
+ − 355 return Fdocumentation (Fcdr (fun), raw);
+ − 356 else
+ − 357 goto oops;
+ − 358 }
+ − 359 else
+ − 360 {
+ − 361 oops:
+ − 362 return Fsignal (Qinvalid_function, list1 (fun));
+ − 363 }
+ − 364
+ − 365 if (NILP (raw))
+ − 366 {
+ − 367 struct gcpro gcpro1;
+ − 368 #ifdef I18N3
+ − 369 Lisp_Object domain = Qnil;
+ − 370 if (COMPILED_FUNCTIONP (fun))
+ − 371 domain = compiled_function_domain (XCOMPILED_FUNCTION (fun));
+ − 372 if (NILP (domain))
+ − 373 doc = Fgettext (doc);
+ − 374 else
+ − 375 doc = Fdgettext (domain, doc);
+ − 376 #endif
+ − 377
+ − 378 GCPRO1 (doc);
+ − 379 doc = Fsubstitute_command_keys (doc);
+ − 380 UNGCPRO;
+ − 381 }
+ − 382 return doc;
+ − 383 }
+ − 384
+ − 385 DEFUN ("documentation-property", Fdocumentation_property, 2, 3, 0, /*
+ − 386 Return the documentation string that is SYMBOL's PROP property.
+ − 387 This is like `get', but it can refer to strings stored in the
+ − 388 `doc-directory/DOC' file; and if the value is a string, it is passed
+ − 389 through `substitute-command-keys'. A non-nil third argument avoids this
+ − 390 translation.
+ − 391 */
444
+ − 392 (symbol, prop, raw))
428
+ − 393 {
+ − 394 /* This function can GC */
+ − 395 REGISTER Lisp_Object doc = Qnil;
+ − 396 #ifdef I18N3
+ − 397 REGISTER Lisp_Object domain;
+ − 398 #endif
+ − 399 struct gcpro gcpro1;
+ − 400
+ − 401 GCPRO1 (doc);
+ − 402
444
+ − 403 doc = Fget (symbol, prop, Qnil);
428
+ − 404 if (INTP (doc))
+ − 405 doc = get_doc_string (XINT (doc) > 0 ? doc : make_int (- XINT (doc)));
+ − 406 else if (CONSP (doc))
+ − 407 doc = get_doc_string (doc);
+ − 408 #ifdef I18N3
+ − 409 if (!NILP (doc))
+ − 410 {
444
+ − 411 domain = Fget (symbol, Qvariable_domain, Qnil);
428
+ − 412 if (NILP (domain))
+ − 413 doc = Fgettext (doc);
+ − 414 else
+ − 415 doc = Fdgettext (domain, doc);
+ − 416 }
+ − 417 #endif
+ − 418 if (NILP (raw) && STRINGP (doc))
+ − 419 doc = Fsubstitute_command_keys (doc);
+ − 420 UNGCPRO;
+ − 421 return doc;
+ − 422 }
+ − 423
+ − 424 static void
867
+ − 425 weird_doc (Lisp_Object sym, const CIbyte *weirdness, const CIbyte *type,
771
+ − 426 int pos)
428
+ − 427 {
+ − 428 if (!strcmp (weirdness, GETTEXT ("duplicate"))) return;
+ − 429 message ("Note: Strange doc (%s) for %s %s @ %d",
793
+ − 430 weirdness, type, XSTRING_DATA (XSYMBOL (sym)->name), pos);
428
+ − 431 }
+ − 432
+ − 433 DEFUN ("Snarf-documentation", Fsnarf_documentation, 1, 1, 0, /*
+ − 434 Used during Emacs initialization, before dumping runnable Emacs,
+ − 435 to find pointers to doc strings stored in `.../lib-src/DOC' and
+ − 436 record them in function definitions.
+ − 437 One arg, FILENAME, a string which does not include a directory.
+ − 438 The file is written to `../lib-src', and later found in `exec-directory'
+ − 439 when doc strings are referred to in the dumped Emacs.
+ − 440 */
+ − 441 (filename))
+ − 442 {
+ − 443 int fd;
867
+ − 444 Ibyte buf[1024 + 1];
428
+ − 445 REGISTER int filled;
+ − 446 REGISTER int pos;
867
+ − 447 REGISTER Ibyte *p, *end;
428
+ − 448 Lisp_Object sym, fun, tem;
867
+ − 449 Ibyte *name;
428
+ − 450
814
+ − 451 /* This function should not pass the data it's reading through a coding
+ − 452 stream. The reason is that the only purpose of this function is to
+ − 453 find the file offsets for the documentation of the various functions,
+ − 454 not do anything with the documentation itself. If we pass through a
+ − 455 coding stream, the pointers will get messed up when we start reading
+ − 456 ISO 2022 data because our pointers will reflect internal format, not
+ − 457 external format. */
+ − 458
428
+ − 459 #ifndef CANNOT_DUMP
+ − 460 if (!purify_flag)
563
+ − 461 invalid_operation ("Snarf-documentation can only be called in an undumped Emacs", Qunbound);
428
+ − 462 #endif
+ − 463
+ − 464 CHECK_STRING (filename);
+ − 465
+ − 466 #ifdef CANNOT_DUMP
771
+ − 467 if (!NILP (Vdoc_directory))
428
+ − 468 {
+ − 469 CHECK_STRING (Vdoc_directory);
867
+ − 470 name = alloca_ibytes (XSTRING_LENGTH (filename)
428
+ − 471 + XSTRING_LENGTH (Vdoc_directory)
+ − 472 + 1);
771
+ − 473 qxestrcpy (name, XSTRING_DATA (Vdoc_directory));
428
+ − 474 }
+ − 475 else
+ − 476 #endif /* CANNOT_DUMP */
+ − 477 {
867
+ − 478 name = alloca_ibytes (XSTRING_LENGTH (filename) + 14);
+ − 479 qxestrcpy (name, (Ibyte *) "../lib-src/");
428
+ − 480 }
+ − 481
771
+ − 482 qxestrcat (name, XSTRING_DATA (filename));
428
+ − 483
771
+ − 484 fd = qxe_open (name, O_RDONLY | OPEN_BINARY, 0);
428
+ − 485 if (fd < 0)
771
+ − 486 report_file_error ("Opening doc string file", build_intstring (name));
428
+ − 487 Vinternal_doc_file_name = filename;
+ − 488 filled = 0;
+ − 489 pos = 0;
+ − 490 while (1)
+ − 491 {
+ − 492 if (filled < 512)
771
+ − 493 filled += retry_read (fd, &buf[filled], sizeof (buf) - 1 - filled);
428
+ − 494 if (!filled)
+ − 495 break;
+ − 496
+ − 497 buf[filled] = 0;
+ − 498 p = buf;
+ − 499 end = buf + (filled < 512 ? filled : filled - 128);
+ − 500 while (p != end && *p != '\037') p++;
+ − 501 /* p points to ^_Ffunctionname\n or ^_Vvarname\n. */
+ − 502 if (p != end)
+ − 503 {
771
+ − 504 end = qxestrchr (p, '\n');
+ − 505 sym = oblookup (Vobarray, p + 2, end - p - 2);
428
+ − 506 if (SYMBOLP (sym))
+ − 507 {
+ − 508 Lisp_Object offset = make_int (pos + end + 1 - buf);
+ − 509 /* Attach a docstring to a variable */
+ − 510 if (p[1] == 'V')
+ − 511 {
+ − 512 /* Install file-position as variable-documentation property
+ − 513 and make it negative for a user-variable
+ − 514 (doc starts with a `*'). */
+ − 515 Lisp_Object old = Fget (sym, Qvariable_documentation, Qzero);
+ − 516 if (!ZEROP (old))
+ − 517 {
+ − 518 weird_doc (sym, GETTEXT ("duplicate"),
+ − 519 GETTEXT ("variable"), pos);
+ − 520 /* In the case of duplicate doc file entries, always
+ − 521 take the later one. But if the doc is not an int
+ − 522 (a string, say) leave it alone. */
+ − 523 if (!INTP (old))
+ − 524 goto weird;
+ − 525 }
+ − 526 Fput (sym, Qvariable_documentation,
+ − 527 ((end[1] == '*')
+ − 528 ? make_int (- XINT (offset))
+ − 529 : offset));
+ − 530 }
+ − 531 /* Attach a docstring to a function.
+ − 532 The type determines where the docstring is stored. */
+ − 533 else if (p[1] == 'F')
+ − 534 {
+ − 535 fun = indirect_function (sym,0);
+ − 536
+ − 537 if (CONSP (fun) && EQ (XCAR (fun), Qmacro))
+ − 538 fun = XCDR (fun);
+ − 539
+ − 540 if (UNBOUNDP (fun))
+ − 541 {
771
+ − 542 #if 0 /* There are lots of legitimate cases where this message will appear
+ − 543 (e.g. any function that's only defined when MULE is defined,
+ − 544 provided that the function is used somewhere in a dumped Lisp
+ − 545 file, so that the symbol is interned in the dumped XEmacs), and
+ − 546 there's not a lot that can be done to eliminate the warning other
+ − 547 than kludges like moving the function to a Mule-only source file,
+ − 548 which often results in ugly code. Furthermore, the only point of
+ − 549 this warning is to warn you when you have a DEFUN that you forget
+ − 550 to DEFSUBR, but the compiler will also warn you, because the DEFUN
+ − 551 declares a static object, and the object will be unused -- you'll
+ − 552 get something like
+ − 553
+ − 554 /src/xemacs/mule/src/abbrev.c:269: warning: `SFexpand_abbrev' defined but not used
+ − 555
+ − 556 So I'm disabling this. --ben */
+ − 557
428
+ − 558 /* May have been #if'ed out or something */
+ − 559 weird_doc (sym, GETTEXT ("not fboundp"),
+ − 560 GETTEXT ("function"), pos);
771
+ − 561 #endif
428
+ − 562 goto weird;
+ − 563 }
+ − 564 else if (SUBRP (fun))
+ − 565 {
+ − 566 /* Lisp_Subrs have a slot for it. */
+ − 567 if (XSUBR (fun)->doc)
+ − 568 {
+ − 569 weird_doc (sym, GETTEXT ("duplicate"),
+ − 570 GETTEXT ("subr"), pos);
+ − 571 goto weird;
+ − 572 }
+ − 573 XSUBR (fun)->doc = (char *) (- XINT (offset));
+ − 574 }
+ − 575 else if (CONSP (fun))
+ − 576 {
+ − 577 /* If it's a lisp form, stick it in the form. */
+ − 578 tem = XCAR (fun);
+ − 579 if (EQ (tem, Qlambda) || EQ (tem, Qautoload))
+ − 580 {
+ − 581 tem = Fcdr (Fcdr (fun));
+ − 582 if (CONSP (tem) &&
+ − 583 INTP (XCAR (tem)))
+ − 584 {
+ − 585 Lisp_Object old = XCAR (tem);
+ − 586 if (!ZEROP (old))
+ − 587 {
+ − 588 weird_doc (sym, GETTEXT ("duplicate"),
+ − 589 (EQ (tem, Qlambda)
+ − 590 ? GETTEXT ("lambda")
+ − 591 : GETTEXT ("autoload")),
+ − 592 pos);
+ − 593 /* In the case of duplicate doc file entries,
+ − 594 always take the later one. But if the doc
+ − 595 is not an int (a string, say) leave it
+ − 596 alone. */
+ − 597 if (!INTP (old))
+ − 598 goto weird;
+ − 599 }
+ − 600 XCAR (tem) = offset;
+ − 601 }
+ − 602 else if (!CONSP (tem))
+ − 603 {
+ − 604 weird_doc (sym, GETTEXT ("!CONSP(tem)"),
+ − 605 GETTEXT ("function"), pos);
+ − 606 goto cont;
+ − 607 }
+ − 608 else
+ − 609 {
+ − 610 /* DOC string is a string not integer 0 */
+ − 611 #if 0
+ − 612 weird_doc (sym, GETTEXT ("!INTP(XCAR(tem))"),
+ − 613 GETTEXT ("function"), pos);
+ − 614 #endif
+ − 615 goto cont;
+ − 616 }
+ − 617 }
+ − 618 else
+ − 619 {
+ − 620 weird_doc (sym, GETTEXT ("not lambda or autoload"),
+ − 621 GETTEXT ("function"), pos);
+ − 622 goto cont;
+ − 623 }
+ − 624 }
+ − 625 else if (COMPILED_FUNCTIONP (fun))
+ − 626 {
+ − 627 /* Compiled-Function objects sometimes have
+ − 628 slots for it. */
440
+ − 629 Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun);
428
+ − 630
+ − 631 /* This compiled-function object must have a
+ − 632 slot for the docstring, since we've found a
+ − 633 docstring for it. Unless there were multiple
+ − 634 definitions of it, and the latter one didn't
+ − 635 have any doc, which is a legal if slightly
+ − 636 bogus situation, so don't blow up. */
+ − 637
+ − 638 if (! (f->flags.documentationp))
+ − 639 {
+ − 640 weird_doc (sym, GETTEXT ("no doc slot"),
+ − 641 GETTEXT ("bytecode"), pos);
+ − 642 goto weird;
+ − 643 }
+ − 644 else
+ − 645 {
+ − 646 Lisp_Object old =
+ − 647 compiled_function_documentation (f);
+ − 648 if (!ZEROP (old))
+ − 649 {
+ − 650 weird_doc (sym, GETTEXT ("duplicate"),
+ − 651 GETTEXT ("bytecode"), pos);
+ − 652 /* In the case of duplicate doc file entries,
+ − 653 always take the later one. But if the doc is
+ − 654 not an int (a string, say) leave it alone. */
+ − 655 if (!INTP (old))
+ − 656 goto weird;
+ − 657 }
+ − 658 set_compiled_function_documentation (f, offset);
+ − 659 }
+ − 660 }
+ − 661 else
+ − 662 {
+ − 663 /* Otherwise the function is undefined or
+ − 664 otherwise weird. Ignore it. */
+ − 665 weird_doc (sym, GETTEXT ("weird function"),
+ − 666 GETTEXT ("function"), pos);
+ − 667 goto weird;
+ − 668 }
+ − 669 }
+ − 670 else
+ − 671 {
+ − 672 /* lose: */
771
+ − 673 signal_error (Qfile_error, "DOC file invalid at position",
+ − 674 make_int (pos));
428
+ − 675 weird:
+ − 676 /* goto lose */;
+ − 677 }
+ − 678 }
+ − 679 }
+ − 680 cont:
+ − 681 pos += end - buf;
+ − 682 filled -= end - buf;
+ − 683 memmove (buf, end, filled);
+ − 684 }
771
+ − 685 retry_close (fd);
428
+ − 686 return Qnil;
+ − 687 }
+ − 688
+ − 689 #if 1 /* Don't warn about functions whose doc was lost because they were
+ − 690 wrapped by advice-freeze.el... */
+ − 691 static int
+ − 692 kludgily_ignore_lost_doc_p (Lisp_Object sym)
+ − 693 {
+ − 694 # define kludge_prefix "ad-Orig-"
793
+ − 695 Lisp_Object name = XSYMBOL (sym)->name;
+ − 696 return (XSTRING_LENGTH (name) > (Bytecount) (sizeof (kludge_prefix)) &&
+ − 697 !qxestrncmp_c (XSTRING_DATA (name), kludge_prefix,
+ − 698 sizeof (kludge_prefix) - 1));
428
+ − 699 # undef kludge_prefix
+ − 700 }
+ − 701 #else
+ − 702 # define kludgily_ignore_lost_doc_p(sym) 0
+ − 703 #endif
+ − 704
+ − 705
+ − 706 static int
+ − 707 verify_doc_mapper (Lisp_Object sym, void *arg)
+ − 708 {
793
+ − 709 Lisp_Object closure = * (Lisp_Object *) arg;
428
+ − 710
+ − 711 if (!NILP (Ffboundp (sym)))
+ − 712 {
+ − 713 int doc = 0;
+ − 714 Lisp_Object fun = XSYMBOL (sym)->function;
+ − 715 if (CONSP (fun) &&
+ − 716 EQ (XCAR (fun), Qmacro))
+ − 717 fun = XCDR (fun);
+ − 718
+ − 719 if (SUBRP (fun))
+ − 720 doc = (EMACS_INT) XSUBR (fun)->doc;
+ − 721 else if (SYMBOLP (fun))
+ − 722 doc = -1;
+ − 723 else if (KEYMAPP (fun))
+ − 724 doc = -1;
+ − 725 else if (CONSP (fun))
+ − 726 {
+ − 727 Lisp_Object tem = XCAR (fun);
+ − 728 if (EQ (tem, Qlambda) || EQ (tem, Qautoload))
+ − 729 {
+ − 730 doc = -1;
+ − 731 tem = Fcdr (Fcdr (fun));
+ − 732 if (CONSP (tem) &&
+ − 733 INTP (XCAR (tem)))
+ − 734 doc = XINT (XCAR (tem));
+ − 735 }
+ − 736 }
+ − 737 else if (COMPILED_FUNCTIONP (fun))
+ − 738 {
440
+ − 739 Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun);
428
+ − 740 if (! (f->flags.documentationp))
+ − 741 doc = -1;
+ − 742 else
+ − 743 {
+ − 744 Lisp_Object tem = compiled_function_documentation (f);
+ − 745 if (INTP (tem))
+ − 746 doc = XINT (tem);
+ − 747 }
+ − 748 }
+ − 749
+ − 750 if (doc == 0 && !kludgily_ignore_lost_doc_p (sym))
+ − 751 {
+ − 752 message ("Warning: doc lost for function %s.",
793
+ − 753 XSTRING_DATA (XSYMBOL (sym)->name));
428
+ − 754 XCDR (closure) = Qt;
+ − 755 }
+ − 756 }
+ − 757 if (!NILP (Fboundp (sym)))
+ − 758 {
+ − 759 Lisp_Object doc = Fget (sym, Qvariable_documentation, Qnil);
+ − 760 if (ZEROP (doc))
+ − 761 {
+ − 762 message ("Warning: doc lost for variable %s.",
793
+ − 763 XSTRING_DATA (XSYMBOL (sym)->name));
428
+ − 764 XCDR (closure) = Qt;
+ − 765 }
+ − 766 }
+ − 767 return 0; /* Never stop */
+ − 768 }
+ − 769
+ − 770 DEFUN ("Verify-documentation", Fverify_documentation, 0, 0, 0, /*
+ − 771 Used to make sure everything went well with Snarf-documentation.
+ − 772 Writes to stderr if not.
+ − 773 */
+ − 774 ())
+ − 775 {
+ − 776 Lisp_Object closure = Fcons (Qnil, Qnil);
+ − 777 struct gcpro gcpro1;
+ − 778 GCPRO1 (closure);
+ − 779 map_obarray (Vobarray, verify_doc_mapper, &closure);
+ − 780 if (!NILP (Fcdr (closure)))
+ − 781 message ("\n"
+ − 782 "This is usually because some files were preloaded by loaddefs.el or\n"
+ − 783 "site-load.el, but were not passed to make-docfile by Makefile.\n");
+ − 784 UNGCPRO;
+ − 785 return NILP (Fcdr (closure)) ? Qt : Qnil;
+ − 786 }
+ − 787
+ − 788
+ − 789 DEFUN ("substitute-command-keys", Fsubstitute_command_keys, 1, 1, 0, /*
+ − 790 Substitute key descriptions for command names in STRING.
+ − 791 Return a new string which is STRING with substrings of the form \\=\\[COMMAND]
+ − 792 replaced by either: a keystroke sequence that will invoke COMMAND,
+ − 793 or "M-x COMMAND" if COMMAND is not on any keys.
+ − 794 Substrings of the form \\=\\{MAPVAR} are replaced by summaries
444
+ − 795 \(made by `describe-bindings') of the value of MAPVAR, taken as a keymap.
428
+ − 796 Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR
+ − 797 as the keymap for future \\=\\[COMMAND] substrings.
+ − 798 \\=\\= quotes the following character and is discarded;
+ − 799 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.
+ − 800 */
444
+ − 801 (string))
428
+ − 802 {
+ − 803 /* This function can GC */
867
+ − 804 Ibyte *buf;
428
+ − 805 int changed = 0;
867
+ − 806 REGISTER Ibyte *strdata;
+ − 807 REGISTER Ibyte *bufp;
428
+ − 808 Bytecount strlength;
+ − 809 Bytecount idx;
+ − 810 Bytecount bsize;
867
+ − 811 Ibyte *new;
444
+ − 812 Lisp_Object tem = Qnil;
+ − 813 Lisp_Object keymap = Qnil;
+ − 814 Lisp_Object name = Qnil;
867
+ − 815 Ibyte *start;
428
+ − 816 Bytecount length;
+ − 817 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+ − 818
444
+ − 819 if (NILP (string))
428
+ − 820 return Qnil;
+ − 821
444
+ − 822 CHECK_STRING (string);
+ − 823 GCPRO4 (string, tem, keymap, name);
428
+ − 824
+ − 825 /* There is the possibility that the string is not destined for a
+ − 826 translating stream, and it could be argued that we should do the
+ − 827 same thing here as in Fformat(), but there are very few times
+ − 828 when this will be the case and many calls to this function
+ − 829 would have to have `gettext' calls added. (I18N3) */
444
+ − 830 string = LISP_GETTEXT (string);
428
+ − 831
+ − 832 /* KEYMAP is either nil (which means search all the active keymaps)
+ − 833 or a specified local map (which means search just that and the
+ − 834 global map). If non-nil, it might come from Voverriding_local_map,
444
+ − 835 or from a \\<mapname> construct in STRING itself.. */
428
+ − 836 #if 0 /* FSFmacs */
+ − 837 /* This is really weird and garbagey. If keymap is nil and there's
+ − 838 an overriding-local-map, `where-is-internal' will correctly note
+ − 839 this, so there's no reason to do it here. Maybe FSFmacs
+ − 840 `where-is-internal' is broken. */
+ − 841 /*
+ − 842 keymap = current_kboard->Voverriding_terminal_local_map;
+ − 843 if (NILP (keymap))
+ − 844 keymap = Voverriding_local_map;
+ − 845 */
+ − 846 #endif
+ − 847
444
+ − 848 strlength = XSTRING_LENGTH (string);
428
+ − 849 bsize = 1 + strlength;
867
+ − 850 buf = (Ibyte *) xmalloc (bsize);
428
+ − 851 bufp = buf;
+ − 852
+ − 853 /* Have to reset strdata every time GC might be called */
444
+ − 854 strdata = XSTRING_DATA (string);
428
+ − 855 for (idx = 0; idx < strlength; )
+ − 856 {
867
+ − 857 Ibyte *strp = strdata + idx;
428
+ − 858
+ − 859 if (strp[0] != '\\')
+ − 860 {
+ − 861 /* just copy other chars */
+ − 862 /* As it happens, this will work with Mule even if the
+ − 863 character quoted is multi-byte; the remaining multi-byte
+ − 864 characters will just be copied by this loop. */
+ − 865 *bufp++ = *strp;
+ − 866 idx++;
+ − 867 }
+ − 868 else switch (strp[1])
+ − 869 {
+ − 870 default:
+ − 871 {
+ − 872 /* just copy unknown escape sequences */
+ − 873 *bufp++ = *strp;
+ − 874 idx++;
+ − 875 break;
+ − 876 }
+ − 877 case '=':
+ − 878 {
+ − 879 /* \= quotes the next character;
+ − 880 thus, to put in \[ without its special meaning, use \=\[. */
+ − 881 /* As it happens, this will work with Mule even if the
+ − 882 character quoted is multi-byte; the remaining multi-byte
+ − 883 characters will just be copied by this loop. */
+ − 884 changed = 1;
+ − 885 *bufp++ = strp[2];
+ − 886 idx += 3;
+ − 887 break;
+ − 888 }
+ − 889 case '[':
+ − 890 {
+ − 891 changed = 1;
+ − 892 idx += 2; /* skip \[ */
+ − 893 strp += 2;
+ − 894 start = strp;
+ − 895
+ − 896 while ((idx < strlength)
+ − 897 && *strp != ']')
+ − 898 {
+ − 899 strp++;
+ − 900 idx++;
+ − 901 }
+ − 902 length = strp - start;
+ − 903 idx++; /* skip ] */
+ − 904
+ − 905 tem = Fintern (make_string (start, length), Qnil);
+ − 906 tem = Fwhere_is_internal (tem, keymap, Qt, Qnil, Qnil);
+ − 907
+ − 908 #if 0 /* FSFmacs */
444
+ − 909 /* Disregard menu bar bindings; it is positively annoying to
+ − 910 mention them when there's no menu bar, and it isn't terribly
+ − 911 useful even when there is a menu bar. */
+ − 912 if (!NILP (tem))
+ − 913 {
+ − 914 firstkey = Faref (tem, Qzero);
+ − 915 if (EQ (firstkey, Qmenu_bar))
+ − 916 tem = Qnil;
+ − 917 }
428
+ − 918 #endif
+ − 919
+ − 920 if (NILP (tem)) /* but not on any keys */
+ − 921 {
867
+ − 922 new = (Ibyte *) xrealloc (buf, bsize += 4);
428
+ − 923 bufp += new - buf;
+ − 924 buf = new;
+ − 925 memcpy (bufp, "M-x ", 4);
+ − 926 bufp += 4;
+ − 927 goto subst;
+ − 928 }
+ − 929 else
+ − 930 { /* function is on a key */
+ − 931 tem = Fkey_description (tem);
+ − 932 goto subst_string;
+ − 933 }
+ − 934 }
+ − 935 case '{':
+ − 936 case '<':
+ − 937 {
444
+ − 938 Lisp_Object buffer = Fget_buffer_create (QSsubstitute);
+ − 939 struct buffer *buf_ = XBUFFER (buffer);
428
+ − 940
+ − 941 Fbuffer_disable_undo (buffer);
+ − 942 Ferase_buffer (buffer);
+ − 943
+ − 944 /* \{foo} is replaced with a summary of keymap (symbol-value foo).
+ − 945 \<foo> just sets the keymap used for \[cmd]. */
+ − 946 changed = 1;
+ − 947 idx += 2; /* skip \{ or \< */
+ − 948 strp += 2;
+ − 949 start = strp;
+ − 950
+ − 951 while ((idx < strlength)
+ − 952 && *strp != '}' && *strp != '>')
+ − 953 {
+ − 954 strp++;
+ − 955 idx++;
+ − 956 }
+ − 957 length = strp - start;
+ − 958 idx++; /* skip } or > */
+ − 959
+ − 960 /* Get the value of the keymap in TEM, or nil if undefined.
+ − 961 Do this while still in the user's current buffer
+ − 962 in case it is a local variable. */
+ − 963 name = Fintern (make_string (start, length), Qnil);
+ − 964 tem = Fboundp (name);
+ − 965 if (! NILP (tem))
+ − 966 {
+ − 967 tem = Fsymbol_value (name);
+ − 968 if (! NILP (tem))
+ − 969 tem = get_keymap (tem, 0, 1);
+ − 970 }
+ − 971
+ − 972 if (NILP (tem))
+ − 973 {
444
+ − 974 buffer_insert_c_string (buf_, "(uses keymap \"");
+ − 975 buffer_insert_lisp_string (buf_, Fsymbol_name (name));
+ − 976 buffer_insert_c_string (buf_, "\", which is not currently defined) ");
428
+ − 977
+ − 978 if (start[-1] == '<') keymap = Qnil;
+ − 979 }
+ − 980 else if (start[-1] == '<')
+ − 981 keymap = tem;
+ − 982 else
+ − 983 describe_map_tree (tem, 1, Qnil, Qnil, 0, buffer);
+ − 984
+ − 985 tem = make_string_from_buffer (buf_, BUF_BEG (buf_),
+ − 986 BUF_Z (buf_) - BUF_BEG (buf_));
+ − 987 Ferase_buffer (buffer);
444
+ − 988 }
+ − 989 goto subst_string;
428
+ − 990
444
+ − 991 subst_string:
+ − 992 start = XSTRING_DATA (tem);
+ − 993 length = XSTRING_LENGTH (tem);
+ − 994 subst:
+ − 995 bsize += length;
867
+ − 996 new = (Ibyte *) xrealloc (buf, bsize);
444
+ − 997 bufp += new - buf;
+ − 998 buf = new;
+ − 999 memcpy (bufp, start, length);
+ − 1000 bufp += length;
428
+ − 1001
444
+ − 1002 /* Reset STRDATA in case gc relocated it. */
+ − 1003 strdata = XSTRING_DATA (string);
428
+ − 1004
444
+ − 1005 break;
428
+ − 1006 }
+ − 1007 }
+ − 1008
+ − 1009 if (changed) /* don't bother if nothing substituted */
+ − 1010 tem = make_string (buf, bufp - buf);
+ − 1011 else
444
+ − 1012 tem = string;
428
+ − 1013 xfree (buf);
+ − 1014 UNGCPRO;
+ − 1015 return tem;
+ − 1016 }
+ − 1017
+ − 1018
+ − 1019 /************************************************************************/
+ − 1020 /* initialization */
+ − 1021 /************************************************************************/
+ − 1022
+ − 1023 void
+ − 1024 syms_of_doc (void)
+ − 1025 {
+ − 1026 DEFSUBR (Fdocumentation);
+ − 1027 DEFSUBR (Fdocumentation_property);
+ − 1028 DEFSUBR (Fsnarf_documentation);
+ − 1029 DEFSUBR (Fverify_documentation);
+ − 1030 DEFSUBR (Fsubstitute_command_keys);
+ − 1031 }
+ − 1032
+ − 1033 void
+ − 1034 vars_of_doc (void)
+ − 1035 {
+ − 1036 DEFVAR_LISP ("internal-doc-file-name", &Vinternal_doc_file_name /*
+ − 1037 Name of file containing documentation strings of built-in symbols.
+ − 1038 */ );
+ − 1039 Vinternal_doc_file_name = Qnil;
+ − 1040
+ − 1041 QSsubstitute = build_string (" *substitute*");
+ − 1042 staticpro (&QSsubstitute);
+ − 1043 }
