doc.c 22 KB
Newer Older
Jim Blandy's avatar
Jim Blandy committed
1
/* Record indices of function doc strings stored in a file.
Dave Love's avatar
Dave Love committed
2
   Copyright (C) 1985, 86,93,94,95,97,98,99, 2000 Free Software Foundation, Inc.
Jim Blandy's avatar
Jim Blandy committed
3 4 5 6 7

This file is part of GNU Emacs.

GNU Emacs is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
8
the Free Software Foundation; either version 2, or (at your option)
Jim Blandy's avatar
Jim Blandy committed
9 10 11 12 13 14 15 16 17
any later version.

GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with GNU Emacs; see the file COPYING.  If not, write to
18 19
the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.  */
Jim Blandy's avatar
Jim Blandy committed
20 21


22
#include <config.h>
Jim Blandy's avatar
Jim Blandy committed
23 24 25 26 27 28 29 30

#include <sys/types.h>
#include <sys/file.h>	/* Must be after sys/types.h for USG and BSD4_1*/

#ifdef USG5
#include <fcntl.h>
#endif

31 32 33 34
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif

Jim Blandy's avatar
Jim Blandy committed
35 36 37 38 39 40
#ifndef O_RDONLY
#define O_RDONLY 0
#endif

#include "lisp.h"
#include "buffer.h"
Jim Blandy's avatar
Jim Blandy committed
41
#include "keyboard.h"
Richard M. Stallman's avatar
Richard M. Stallman committed
42
#include "charset.h"
Stefan Monnier's avatar
Stefan Monnier committed
43
#include "keymap.h"
Jim Blandy's avatar
Jim Blandy committed
44

Gerd Moellmann's avatar
Gerd Moellmann committed
45 46
#ifdef HAVE_INDEX
extern char *index P_ ((const char *, int));
47 48
#endif

49
Lisp_Object Vdoc_file_name;
Jim Blandy's avatar
Jim Blandy committed
50

51 52
Lisp_Object Qfunction_documentation;

53 54
extern Lisp_Object Voverriding_local_map;

55 56 57 58 59
/* For VMS versions with limited file name syntax,
   convert the name to something VMS will allow. */
static void
munge_doc_file_name (name)
     char *name;
Jim Blandy's avatar
Jim Blandy committed
60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76
{
#ifdef VMS
#ifndef VMS4_4
  /* For VMS versions with limited file name syntax,
     convert the name to something VMS will allow.  */
  p = name;
  while (*p)
    {
      if (*p == '-')
	*p = '_';
      p++;
    }
#endif /* not VMS4_4 */
#ifdef VMS4_4
  strcpy (name, sys_translate_unix (name));
#endif /* VMS4_4 */
#endif /* VMS */
77 78
}

79 80 81 82
/* Buffer used for reading from documentation file.  */
static char *get_doc_string_buffer;
static int get_doc_string_buffer_size;

83
static unsigned char *read_bytecode_pointer;
84
Lisp_Object Fsnarf_documentation P_ ((Lisp_Object));
85 86 87 88 89 90

/* readchar in lread.c calls back here to fetch the next byte.
   If UNREADFLAG is 1, we unread a byte.  */

int
read_bytecode_char (unreadflag)
Dave Love's avatar
Dave Love committed
91
     int unreadflag;
92 93 94 95 96 97 98 99 100
{
  if (unreadflag)
    {
      read_bytecode_pointer--;
      return 0;
    }
  return *read_bytecode_pointer++;
}

101 102 103
/* Extract a doc string from a file.  FILEPOS says where to get it.
   If it is an integer, use that position in the standard DOC-... file.
   If it is (FILE . INTEGER), use FILE as the file name
104 105 106
   and INTEGER as the position in that file.
   But if INTEGER is negative, make it positive.
   (A negative integer is used for user variables, so we can distinguish
107 108
   them without actually fetching the doc string.)

109 110
   If UNIBYTE is nonzero, always make a unibyte string.

111 112 113 114
   If DEFINITION is nonzero, assume this is for reading
   a dynamic function definition; convert the bytestring
   and the constants vector with appropriate byte handling,
   and return a cons cell.  */
115

116
Lisp_Object
117
get_doc_string (filepos, unibyte, definition)
118
     Lisp_Object filepos;
119
     int unibyte, definition;
120
{
121
  char *from, *to;
122 123 124 125
  register int fd;
  register char *name;
  register char *p, *p1;
  int minsize;
126
  int offset, position;
127
  Lisp_Object file, tem;
128

129 130 131 132 133 134 135
  if (INTEGERP (filepos))
    {
      file = Vdoc_file_name;
      position = XINT (filepos);
    }
  else if (CONSP (filepos))
    {
136 137
      file = XCAR (filepos);
      position = XINT (XCDR (filepos));
138 139
    }
  else
140 141
    return Qnil;

142 143 144
  if (position < 0)
    position = - position;

145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167
  if (!STRINGP (Vdoc_directory))
    return Qnil;

  if (!STRINGP (file))
    return Qnil;
    
  /* Put the file name in NAME as a C string.
     If it is relative, combine it with Vdoc_directory.  */

  tem = Ffile_name_absolute_p (file);
  if (NILP (tem))
    {
      minsize = XSTRING (Vdoc_directory)->size;
      /* sizeof ("../etc/") == 8 */
      if (minsize < 8)
	minsize = 8;
      name = (char *) alloca (minsize + XSTRING (file)->size + 8);
      strcpy (name, XSTRING (Vdoc_directory)->data);
      strcat (name, XSTRING (file)->data);
      munge_doc_file_name (name);
    }
  else
    {
168
      name = (char *) XSTRING (file)->data;
169
    }
Jim Blandy's avatar
Jim Blandy committed
170

171
  fd = emacs_open (name, O_RDONLY, 0);
Jim Blandy's avatar
Jim Blandy committed
172
  if (fd < 0)
173 174 175 176 177 178 179
    {
#ifndef CANNOT_DUMP
      if (!NILP (Vpurify_flag))
	{
	  /* Preparing to dump; DOC file is probably not installed.
	     So check in ../etc. */
	  strcpy (name, "../etc/");
180
	  strcat (name, XSTRING (file)->data);
181 182
	  munge_doc_file_name (name);

183
	  fd = emacs_open (name, O_RDONLY, 0);
184 185 186 187 188 189
	}
#endif
      if (fd < 0)
	error ("Cannot open doc string file \"%s\"", name);
    }

190 191 192
  /* Seek only to beginning of disk block.  */
  offset = position % (8 * 1024);
  if (0 > lseek (fd, position - offset, 0))
Jim Blandy's avatar
Jim Blandy committed
193
    {
194
      emacs_close (fd);
Jim Blandy's avatar
Jim Blandy committed
195
      error ("Position %ld out of range in doc string file \"%s\"",
196
	     position, name);
Jim Blandy's avatar
Jim Blandy committed
197
    }
198

199 200
  /* Read the doc string into get_doc_string_buffer.
     P points beyond the data just read.  */
201

202
  p = get_doc_string_buffer;
203
  while (1)
Jim Blandy's avatar
Jim Blandy committed
204
    {
205 206
      int space_left = (get_doc_string_buffer_size
			- (p - get_doc_string_buffer));
207 208
      int nread;

209
      /* Allocate or grow the buffer if we need to.  */
210 211
      if (space_left == 0)
	{
212 213 214 215 216 217 218 219
	  int in_buffer = p - get_doc_string_buffer;
	  get_doc_string_buffer_size += 16 * 1024;
	  get_doc_string_buffer
	    = (char *) xrealloc (get_doc_string_buffer,
				 get_doc_string_buffer_size + 1);
	  p = get_doc_string_buffer + in_buffer;
	  space_left = (get_doc_string_buffer_size
			- (p - get_doc_string_buffer));
220 221
	}

222 223
      /* Read a disk block at a time.
         If we read the same block last time, maybe skip this?  */
224 225
      if (space_left > 1024 * 8)
	space_left = 1024 * 8;
226
      nread = emacs_read (fd, p, space_left);
227 228
      if (nread < 0)
	{
229
	  emacs_close (fd);
230 231 232 233
	  error ("Read error on documentation file");
	}
      p[nread] = 0;
      if (!nread)
Jim Blandy's avatar
Jim Blandy committed
234
	break;
235
      if (p == get_doc_string_buffer)
236
	p1 = (char *) index (p + offset, '\037');
237
      else
238
	p1 = (char *) index (p, '\037');
Jim Blandy's avatar
Jim Blandy committed
239 240 241 242 243 244
      if (p1)
	{
	  *p1 = 0;
	  p = p1;
	  break;
	}
245
      p += nread;
Jim Blandy's avatar
Jim Blandy committed
246
    }
247
  emacs_close (fd);
248 249 250

  /* Scan the text and perform quoting with ^A (char code 1).
     ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_.  */
251 252
  from = get_doc_string_buffer + offset;
  to = get_doc_string_buffer + offset;
253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273
  while (from != p)
    {
      if (*from == 1)
	{
	  int c;

	  from++;
	  c = *from++;
	  if (c == 1)
	    *to++ = c;
	  else if (c == '0')
	    *to++ = 0;
	  else if (c == '_')
	    *to++ = 037;
	  else
	    error ("Invalid data in documentation file -- ^A followed by code 0%o", c);
	}
      else
	*to++ = *from++;
    }

274 275
  /* If DEFINITION, read from this buffer
     the same way we would read bytes from a file.  */
276 277
  if (definition)
    {
278 279
      read_bytecode_pointer = get_doc_string_buffer + offset;
      return Fread (Qlambda);
280 281
    }

282 283 284 285
  if (unibyte)
    return make_unibyte_string (get_doc_string_buffer + offset,
				to - (get_doc_string_buffer + offset));
  else
286 287 288 289 290 291 292 293 294
    {
      /* Let the data determine whether the string is multibyte,
	 even if Emacs is running in --unibyte mode.  */
      int nchars = multibyte_chars_in_text (get_doc_string_buffer + offset,
					    to - (get_doc_string_buffer + offset));
      return make_string_from_bytes (get_doc_string_buffer + offset,
				     nchars,
				     to - (get_doc_string_buffer + offset));
    }
295 296 297 298 299 300 301 302 303 304
}

/* Get a string from position FILEPOS and pass it through the Lisp reader.
   We use this for fetching the bytecode string and constants vector
   of a compiled function from the .elc file.  */

Lisp_Object
read_doc_string (filepos)
     Lisp_Object filepos;
{
305
  return get_doc_string (filepos, 0, 1);
Jim Blandy's avatar
Jim Blandy committed
306 307
}

Roland McGrath's avatar
Roland McGrath committed
308
DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0,
309 310 311 312
       doc: /* Return the documentation string of FUNCTION.
Unless a non-nil second argument RAW is given, the
string is passed through `substitute-command-keys'.  */)
     (function, raw)
Jim Blandy's avatar
Jim Blandy committed
313
     Lisp_Object function, raw;
Jim Blandy's avatar
Jim Blandy committed
314 315 316
{
  Lisp_Object fun;
  Lisp_Object funcar;
Roland McGrath's avatar
Roland McGrath committed
317
  Lisp_Object tem, doc;
Jim Blandy's avatar
Jim Blandy committed
318

319 320
  doc = Qnil;
  
321 322 323 324 325
  if (SYMBOLP (function)
      && (tem = Fget (function, Qfunction_documentation),
	  !NILP (tem)))
    return Fdocumentation_property (function, Qfunction_documentation, raw);
  
Jim Blandy's avatar
Jim Blandy committed
326
  fun = Findirect_function (function);
327
  if (SUBRP (fun))
Jim Blandy's avatar
Jim Blandy committed
328
    {
329 330 331
      if (XSUBR (fun)->doc == 0)
	return Qnil;
      else if ((EMACS_INT) XSUBR (fun)->doc >= 0)
Roland McGrath's avatar
Roland McGrath committed
332
	doc = build_string (XSUBR (fun)->doc);
Jim Blandy's avatar
Jim Blandy committed
333
      else
334
	doc = make_number ((EMACS_INT) XSUBR (fun)->doc);
335 336 337
    }
  else if (COMPILEDP (fun))
    {
338
      if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_DOC_STRING)
Jim Blandy's avatar
Jim Blandy committed
339
	return Qnil;
340
      tem = AREF (fun, COMPILED_DOC_STRING);
341
      if (STRINGP (tem))
Roland McGrath's avatar
Roland McGrath committed
342
	doc = tem;
343
      else if (NATNUMP (tem) || CONSP (tem))
344
	doc = tem;
Roland McGrath's avatar
Roland McGrath committed
345 346
      else
	return Qnil;
347 348 349
    }
  else if (STRINGP (fun) || VECTORP (fun))
    {
Jim Blandy's avatar
Jim Blandy committed
350
      return build_string ("Keyboard macro.");
351 352 353
    }
  else if (CONSP (fun))
    {
Jim Blandy's avatar
Jim Blandy committed
354
      funcar = Fcar (fun);
355
      if (!SYMBOLP (funcar))
Jim Blandy's avatar
Jim Blandy committed
356
	return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
Jim Blandy's avatar
Jim Blandy committed
357
      else if (EQ (funcar, Qkeymap))
358
	return build_string ("Prefix command (definition is a keymap associating keystrokes with commands).");
Jim Blandy's avatar
Jim Blandy committed
359 360
      else if (EQ (funcar, Qlambda)
	       || EQ (funcar, Qautoload))
Jim Blandy's avatar
Jim Blandy committed
361
	{
362 363 364
	  Lisp_Object tem1;
	  tem1 = Fcdr (Fcdr (fun));
	  tem = Fcar (tem1);
365
	  if (STRINGP (tem))
Roland McGrath's avatar
Roland McGrath committed
366
	    doc = tem;
367 368
	  /* Handle a doc reference--but these never come last
	     in the function body, so reject them if they are last.  */
369 370 371
	  else if ((NATNUMP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
		   && !NILP (XCDR (tem1)))
	    doc = tem;
Roland McGrath's avatar
Roland McGrath committed
372 373
	  else
	    return Qnil;
Jim Blandy's avatar
Jim Blandy committed
374
	}
Jim Blandy's avatar
Jim Blandy committed
375
      else if (EQ (funcar, Qmacro))
Roland McGrath's avatar
Roland McGrath committed
376
	return Fdocumentation (Fcdr (fun), raw);
377 378 379 380 381 382 383
      else
	goto oops;
    }
  else
    {
    oops:
      Fsignal (Qinvalid_function, Fcons (fun, Qnil));
Jim Blandy's avatar
Jim Blandy committed
384
    }
Roland McGrath's avatar
Roland McGrath committed
385

386 387 388
  if (INTEGERP (doc) || CONSP (doc))
    doc = get_doc_string (doc, 0, 0);

Jim Blandy's avatar
Jim Blandy committed
389
  if (NILP (raw))
390
    doc = Fsubstitute_command_keys (doc);
Roland McGrath's avatar
Roland McGrath committed
391
  return doc;
Jim Blandy's avatar
Jim Blandy committed
392 393
}

394 395
DEFUN ("documentation-property", Fdocumentation_property,
       Sdocumentation_property, 2, 3, 0,
396 397 398 399 400 401 402
       doc: /* Return the documentation string that is SYMBOL's PROP property.
Third argument RAW omitted or nil means pass the result through
`substitute-command-keys' if it is a string.

This differs from `get' in that it can refer to strings stored in the
`etc/DOC' file; and that it evaluates documentation properties that
aren't strings.  */)
403 404
  (symbol, prop, raw)
     Lisp_Object symbol, prop, raw;
Jim Blandy's avatar
Jim Blandy committed
405
{
406
  Lisp_Object tem;
Jim Blandy's avatar
Jim Blandy committed
407

408
  tem = Fget (symbol, prop);
409
  if (INTEGERP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
410
    tem = get_doc_string (tem, 0, 0);
411 412 413 414
  else if (!STRINGP (tem))
    /* Feval protects its argument.  */
    tem = Feval (tem);
  
415
  if (NILP (raw) && STRINGP (tem))
416
    tem = Fsubstitute_command_keys (tem);
417
  return tem;
Jim Blandy's avatar
Jim Blandy committed
418 419
}

420 421 422 423 424
/* Scanning the DOC files and placing docstring offsets into functions.  */

static void
store_function_docstring (fun, offset)
     Lisp_Object fun;
425 426
     /* Use EMACS_INT because we get this from pointer subtraction.  */
     EMACS_INT offset;
427 428 429 430 431 432
{
  fun = indirect_function (fun);

  /* The type determines where the docstring is stored.  */

  /* Lisp_Subrs have a slot for it.  */
433
  if (SUBRP (fun))
434 435 436 437 438 439 440
    XSUBR (fun)->doc = (char *) - offset;

  /* If it's a lisp form, stick it in the form.  */
  else if (CONSP (fun))
    {
      Lisp_Object tem;

441
      tem = XCAR (fun);
442 443 444
      if (EQ (tem, Qlambda) || EQ (tem, Qautoload))
	{
	  tem = Fcdr (Fcdr (fun));
445
	  if (CONSP (tem) && INTEGERP (XCAR (tem)))
446
	    XSETCARFASTINT (tem, offset);
447 448
	}
      else if (EQ (tem, Qmacro))
449
	store_function_docstring (XCDR (fun), offset);
450 451 452
    }

  /* Bytecode objects sometimes have slots for it.  */
453
  else if (COMPILEDP (fun))
454 455 456
    {
      /* This bytecode object must have a slot for the
	 docstring, since we've found a docstring for it.  */
457 458
      if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
	XSETFASTINT (AREF (fun, COMPILED_DOC_STRING), offset);
459 460 461 462
    }
}


Jim Blandy's avatar
Jim Blandy committed
463
DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
464
       1, 1, 0,
465 466 467 468 469 470 471
       doc: /* Used during Emacs initialization to scan the `etc/DOC...' file.
This searches the `etc/DOC...' file for doc strings and
records them in function and variable definitions.
The function takes one argument, FILENAME, a string;
it specifies the file name (without a directory) of the DOC file.
That file is found in `../etc' now; later, when the dumped Emacs is run,
the same file name is found in the `data-directory'.  */)
472
     (filename)
Jim Blandy's avatar
Jim Blandy committed
473 474 475 476 477 478 479
     Lisp_Object filename;
{
  int fd;
  char buf[1024 + 1];
  register int filled;
  register int pos;
  register char *p, *end;
480
  Lisp_Object sym;
Jim Blandy's avatar
Jim Blandy committed
481 482
  char *name;

483 484 485 486 487
#ifndef CANNOT_DUMP
  if (NILP (Vpurify_flag))
    error ("Snarf-documentation can only be called in an undumped Emacs");
#endif

488
  CHECK_STRING (filename);
Jim Blandy's avatar
Jim Blandy committed
489 490

#ifndef CANNOT_DUMP
Jim Blandy's avatar
Jim Blandy committed
491
  name = (char *) alloca (XSTRING (filename)->size + 14);
Jim Blandy's avatar
Jim Blandy committed
492
  strcpy (name, "../etc/");
Jim Blandy's avatar
Jim Blandy committed
493
#else /* CANNOT_DUMP */
494
  CHECK_STRING (Vdoc_directory);
Richard M. Stallman's avatar
Richard M. Stallman committed
495 496
  name = (char *) alloca (XSTRING (filename)->size
			  + XSTRING (Vdoc_directory)->size + 1);
497
  strcpy (name, XSTRING (Vdoc_directory)->data);
Jim Blandy's avatar
Jim Blandy committed
498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516
#endif /* CANNOT_DUMP */
  strcat (name, XSTRING (filename)->data); 	/*** Add this line ***/
#ifdef VMS
#ifndef VMS4_4
  /* For VMS versions with limited file name syntax,
     convert the name to something VMS will allow.  */
  p = name;
  while (*p)
    {
      if (*p == '-')
	*p = '_';
      p++;
    }
#endif /* not VMS4_4 */
#ifdef VMS4_4
  strcpy (name, sys_translate_unix (name));
#endif /* VMS4_4 */
#endif /* VMS */

517
  fd = emacs_open (name, O_RDONLY, 0);
Jim Blandy's avatar
Jim Blandy committed
518 519 520 521 522 523 524 525 526
  if (fd < 0)
    report_file_error ("Opening doc string file",
		       Fcons (build_string (name), Qnil));
  Vdoc_file_name = filename;
  filled = 0;
  pos = 0;
  while (1)
    {
      if (filled < 512)
527
	filled += emacs_read (fd, &buf[filled], sizeof buf - 1 - filled);
Jim Blandy's avatar
Jim Blandy committed
528 529 530 531 532 533 534 535 536 537
      if (!filled)
	break;

      buf[filled] = 0;
      p = buf;
      end = buf + (filled < 512 ? filled : filled - 128);
      while (p != end && *p != '\037') p++;
      /* p points to ^_Ffunctionname\n or ^_Vvarname\n.  */
      if (p != end)
	{
538
	  end = (char *) index (p, '\n');
Richard M. Stallman's avatar
Richard M. Stallman committed
539 540 541
	  sym = oblookup (Vobarray, p + 2,
			  multibyte_chars_in_text (p + 2, end - p - 2),
			  end - p - 2);
542
	  if (SYMBOLP (sym))
Jim Blandy's avatar
Jim Blandy committed
543 544 545 546 547 548 549 550 551 552 553 554
	    {
	      /* Attach a docstring to a variable?  */
	      if (p[1] == 'V')
		{
		  /* Install file-position as variable-documentation property
		     and make it negative for a user-variable
		     (doc starts with a `*').  */
		  Fput (sym, Qvariable_documentation,
			make_number ((pos + end + 1 - buf)
				     * (end[1] == '*' ? -1 : 1)));
		}

555
	      /* Attach a docstring to a function?  */
Jim Blandy's avatar
Jim Blandy committed
556
	      else if (p[1] == 'F')
557 558 559 560
		store_function_docstring (sym, pos + end + 1 - buf);

	      else
		error ("DOC file invalid at position %d", pos);
Jim Blandy's avatar
Jim Blandy committed
561 562 563 564 565 566
	    }
	}
      pos += end - buf;
      filled -= end - buf;
      bcopy (end, buf, filled);
    }
567
  emacs_close (fd);
Jim Blandy's avatar
Jim Blandy committed
568 569 570 571
  return Qnil;
}

DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
572 573 574 575 576 577 578 579 580 581 582 583
       Ssubstitute_command_keys, 1, 1, 0,
       doc: /* Substitute key descriptions for command names in STRING.
Return a new string which is STRING with substrings of the form \\=\\[COMMAND]
replaced by either:  a keystroke sequence that will invoke COMMAND,
or "M-x COMMAND" if COMMAND is not on any keys.
Substrings of the form \\=\\{MAPVAR} are replaced by summaries
\(made by describe-bindings) of the value of MAPVAR, taken as a keymap.
Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR
as the keymap for future \\=\\[COMMAND] substrings.
\\=\\= quotes the following character and is discarded;
thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.  */)
     (string)
584
     Lisp_Object string;
Jim Blandy's avatar
Jim Blandy committed
585 586 587 588 589 590 591
{
  unsigned char *buf;
  int changed = 0;
  register unsigned char *strp;
  register unsigned char *bufp;
  int idx;
  int bsize;
Jim Blandy's avatar
Jim Blandy committed
592
  Lisp_Object tem;
Jim Blandy's avatar
Jim Blandy committed
593 594
  Lisp_Object keymap;
  unsigned char *start;
595
  int length, length_byte;
Jim Blandy's avatar
Jim Blandy committed
596 597
  Lisp_Object name;
  struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
Richard M. Stallman's avatar
Richard M. Stallman committed
598 599
  int multibyte;
  int nchars;
Jim Blandy's avatar
Jim Blandy committed
600

601
  if (NILP (string))
Jim Blandy's avatar
Jim Blandy committed
602 603
    return Qnil;

604
  CHECK_STRING (string);
Jim Blandy's avatar
Jim Blandy committed
605 606 607
  tem = Qnil;
  keymap = Qnil;
  name = Qnil;
608
  GCPRO4 (string, tem, keymap, name);
Jim Blandy's avatar
Jim Blandy committed
609

Richard M. Stallman's avatar
Richard M. Stallman committed
610 611 612
  multibyte = STRING_MULTIBYTE (string);
  nchars = 0;

613 614 615
  /* KEYMAP is either nil (which means search all the active keymaps)
     or a specified local map (which means search just that and the
     global map).  If non-nil, it might come from Voverriding_local_map,
616
     or from a \\<mapname> construct in STRING itself..  */
Karl Heuer's avatar
Karl Heuer committed
617 618 619
  keymap = current_kboard->Voverriding_terminal_local_map;
  if (NILP (keymap))
    keymap = Voverriding_local_map;
Jim Blandy's avatar
Jim Blandy committed
620

621
  bsize = STRING_BYTES (XSTRING (string));
Jim Blandy's avatar
Jim Blandy committed
622 623
  bufp = buf = (unsigned char *) xmalloc (bsize);

624
  strp = (unsigned char *) XSTRING (string)->data;
625
  while (strp < XSTRING (string)->data + STRING_BYTES (XSTRING (string)))
Jim Blandy's avatar
Jim Blandy committed
626 627 628 629 630 631
    {
      if (strp[0] == '\\' && strp[1] == '=')
	{
	  /* \= quotes the next character;
	     thus, to put in \[ without its special meaning, use \=\[.  */
	  changed = 1;
Richard M. Stallman's avatar
Richard M. Stallman committed
632 633 634 635
	  strp += 2;
	  if (multibyte)
	    {
	      int len;
636
	      int maxlen = XSTRING (string)->data + STRING_BYTES (XSTRING (string)) - strp;
Richard M. Stallman's avatar
Richard M. Stallman committed
637 638 639 640 641 642 643 644 645 646 647 648

	      STRING_CHAR_AND_LENGTH (strp, maxlen, len);
	      if (len == 1)
		*bufp = *strp;
	      else
		bcopy (strp, bufp, len);
	      strp += len;
	      bufp += len;
	      nchars++;
	    }
	  else
	    *bufp++ = *strp++, nchars++;
Jim Blandy's avatar
Jim Blandy committed
649 650 651
	}
      else if (strp[0] == '\\' && strp[1] == '[')
	{
652
	  Lisp_Object firstkey;
653
	  int start_idx;
654

Jim Blandy's avatar
Jim Blandy committed
655 656 657
	  changed = 1;
	  strp += 2;		/* skip \[ */
	  start = strp;
658
	  start_idx = start - XSTRING (string)->data;
Jim Blandy's avatar
Jim Blandy committed
659

660
	  while ((strp - (unsigned char *) XSTRING (string)->data
661
		  < STRING_BYTES (XSTRING (string)))
Jim Blandy's avatar
Jim Blandy committed
662 663
		 && *strp != ']')
	    strp++;
Richard M. Stallman's avatar
Richard M. Stallman committed
664 665
	  length_byte = strp - start;

Jim Blandy's avatar
Jim Blandy committed
666 667 668
	  strp++;		/* skip ] */

	  /* Save STRP in IDX.  */
669
	  idx = strp - (unsigned char *) XSTRING (string)->data;
Richard M. Stallman's avatar
Richard M. Stallman committed
670
	  tem = Fintern (make_string (start, length_byte), Qnil);
671 672 673

	  /* Note the Fwhere_is_internal can GC, so we have to take
	     relocation of string contents into account.  */
674
	  tem = Fwhere_is_internal (tem, keymap, Qt, Qnil, Qnil);
675 676
	  strp = XSTRING (string)->data + idx;
	  start = XSTRING (string)->data + start_idx;
Jim Blandy's avatar
Jim Blandy committed
677

678 679 680
	  /* Disregard menu bar bindings; it is positively annoying to
	     mention them when there's no menu bar, and it isn't terribly
	     useful even when there is a menu bar.  */
681 682 683 684 685 686
	  if (!NILP (tem))
	    {
	      firstkey = Faref (tem, make_number (0));
	      if (EQ (firstkey, Qmenu_bar))
		tem = Qnil;
	    }
687

Jim Blandy's avatar
Jim Blandy committed
688
	  if (NILP (tem))	/* but not on any keys */
Jim Blandy's avatar
Jim Blandy committed
689
	    {
690 691 692
	      int offset = bufp - buf;
	      buf = (unsigned char *) xrealloc (buf, bsize += 4);
	      bufp = buf + offset;
Jim Blandy's avatar
Jim Blandy committed
693 694
	      bcopy ("M-x ", bufp, 4);
	      bufp += 4;
Richard M. Stallman's avatar
Richard M. Stallman committed
695 696 697 698 699
	      nchars += 4;
	      if (multibyte)
		length = multibyte_chars_in_text (start, length_byte);
	      else
		length = length_byte;
Jim Blandy's avatar
Jim Blandy committed
700 701 702 703 704 705 706 707 708 709 710 711 712
	      goto subst;
	    }
	  else
	    {			/* function is on a key */
	      tem = Fkey_description (tem);
	      goto subst_string;
	    }
	}
      /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
	 \<foo> just sets the keymap used for \[cmd].  */
      else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<'))
	{
	  struct buffer *oldbuf;
713
	  int start_idx;
Jim Blandy's avatar
Jim Blandy committed
714 715 716 717

	  changed = 1;
	  strp += 2;		/* skip \{ or \< */
	  start = strp;
718
	  start_idx = start - XSTRING (string)->data;
Jim Blandy's avatar
Jim Blandy committed
719

720 721
	  while ((strp - (unsigned char *) XSTRING (string)->data
		  < XSTRING (string)->size)
Jim Blandy's avatar
Jim Blandy committed
722 723
		 && *strp != '}' && *strp != '>')
	    strp++;
Richard M. Stallman's avatar
Richard M. Stallman committed
724 725

	  length_byte = strp - start;
Jim Blandy's avatar
Jim Blandy committed
726 727 728
	  strp++;			/* skip } or > */

	  /* Save STRP in IDX.  */
729
	  idx = strp - (unsigned char *) XSTRING (string)->data;
Jim Blandy's avatar
Jim Blandy committed
730 731 732 733

	  /* Get the value of the keymap in TEM, or nil if undefined.
	     Do this while still in the user's current buffer
	     in case it is a local variable.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
734
	  name = Fintern (make_string (start, length_byte), Qnil);
Jim Blandy's avatar
Jim Blandy committed
735
	  tem = Fboundp (name);
Jim Blandy's avatar
Jim Blandy committed
736
	  if (! NILP (tem))
Jim Blandy's avatar
Jim Blandy committed
737 738
	    {
	      tem = Fsymbol_value (name);
Jim Blandy's avatar
Jim Blandy committed
739
	      if (! NILP (tem))
740
		{
741 742
		  tem = get_keymap (tem, 0, 1);
		  /* Note that get_keymap can GC.  */
743 744 745
		  strp = XSTRING (string)->data + idx;
		  start = XSTRING (string)->data + start_idx;
		}
Jim Blandy's avatar
Jim Blandy committed
746 747 748 749 750 751
	    }

	  /* Now switch to a temp buffer.  */
	  oldbuf = current_buffer;
	  set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));

Jim Blandy's avatar
Jim Blandy committed
752
	  if (NILP (tem))
Jim Blandy's avatar
Jim Blandy committed
753 754 755
	    {
	      name = Fsymbol_name (name);
	      insert_string ("\nUses keymap \"");
Richard M. Stallman's avatar
Richard M. Stallman committed
756 757
	      insert_from_string (name, 0, 0,
				  XSTRING (name)->size,
758
				  STRING_BYTES (XSTRING (name)), 1);
Jim Blandy's avatar
Jim Blandy committed
759 760 761 762 763 764
	      insert_string ("\", which is not currently defined.\n");
	      if (start[-1] == '<') keymap = Qnil;
	    }
	  else if (start[-1] == '<')
	    keymap = tem;
	  else
765
	    describe_map_tree (tem, 1, Qnil, Qnil, (char *)0, 1, 0, 0);
Jim Blandy's avatar
Jim Blandy committed
766 767 768 769 770 771 772
	  tem = Fbuffer_string ();
	  Ferase_buffer ();
	  set_buffer_internal (oldbuf);

	subst_string:
	  start = XSTRING (tem)->data;
	  length = XSTRING (tem)->size;
773
	  length_byte = STRING_BYTES (XSTRING (tem));
Jim Blandy's avatar
Jim Blandy committed
774
	subst:
775 776 777 778 779 780 781 782 783 784
	  {
	    int offset = bufp - buf;
	    buf = (unsigned char *) xrealloc (buf, bsize += length_byte);
	    bufp = buf + offset;
	    bcopy (start, bufp, length_byte);
	    bufp += length_byte;
	    nchars += length;
	    /* Check STRING again in case gc relocated it.  */
	    strp = (unsigned char *) XSTRING (string)->data + idx;
	  }
Jim Blandy's avatar
Jim Blandy committed
785
	}
Richard M. Stallman's avatar
Richard M. Stallman committed
786 787 788 789 790
      else if (! multibyte)		/* just copy other chars */
	*bufp++ = *strp++, nchars++;
      else
	{
	  int len;
791
	  int maxlen = XSTRING (string)->data + STRING_BYTES (XSTRING (string)) - strp;
Richard M. Stallman's avatar
Richard M. Stallman committed
792 793 794 795 796 797 798 799 800 801

	  STRING_CHAR_AND_LENGTH (strp, maxlen, len);
	  if (len == 1)
	    *bufp = *strp;
	  else
	    bcopy (strp, bufp, len);
	  strp += len;
	  bufp += len;
	  nchars++;
	}
Jim Blandy's avatar
Jim Blandy committed
802 803 804
    }

  if (changed)			/* don't bother if nothing substituted */
805
    tem = make_string_from_bytes (buf, nchars, bufp - buf);
Jim Blandy's avatar
Jim Blandy committed
806
  else
807
    tem = string;
808
  xfree (buf);
Jim Blandy's avatar
Jim Blandy committed
809
  RETURN_UNGCPRO (tem);
Jim Blandy's avatar
Jim Blandy committed
810 811
}

Andreas Schwab's avatar
Andreas Schwab committed
812
void
Jim Blandy's avatar
Jim Blandy committed
813 814
syms_of_doc ()
{
815 816 817
  Qfunction_documentation = intern ("function-documentation");
  staticpro (&Qfunction_documentation);
  
Jim Blandy's avatar
Jim Blandy committed
818
  DEFVAR_LISP ("internal-doc-file-name", &Vdoc_file_name,
819
	       doc: /* Name of file containing documentation strings of built-in symbols.  */);
Jim Blandy's avatar
Jim Blandy committed
820 821 822 823 824 825 826
  Vdoc_file_name = Qnil;

  defsubr (&Sdocumentation);
  defsubr (&Sdocumentation_property);
  defsubr (&Ssnarf_documentation);
  defsubr (&Ssubstitute_command_keys);
}