doc.c 21.9 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"
Jim Blandy's avatar
Jim Blandy committed
43

44
Lisp_Object Vdoc_file_name, Vhelp_manyarg_func_alist;
Jim Blandy's avatar
Jim Blandy committed
45

46 47
Lisp_Object Qfunction_documentation;

48 49
extern char *index ();

50 51
extern Lisp_Object Voverriding_local_map;

52 53 54 55 56
/* 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
57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73
{
#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 */
74 75
}

76 77 78 79
/* Buffer used for reading from documentation file.  */
static char *get_doc_string_buffer;
static int get_doc_string_buffer_size;

80 81 82 83 84 85 86
static unsigned char *read_bytecode_pointer;

/* 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
87
     int unreadflag;
88 89 90 91 92 93 94 95 96
{
  if (unreadflag)
    {
      read_bytecode_pointer--;
      return 0;
    }
  return *read_bytecode_pointer++;
}

97 98 99
/* 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
100 101 102
   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
103 104
   them without actually fetching the doc string.)

105 106
   If UNIBYTE is nonzero, always make a unibyte string.

107 108 109 110
   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.  */
111

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

125 126 127 128 129 130 131
  if (INTEGERP (filepos))
    {
      file = Vdoc_file_name;
      position = XINT (filepos);
    }
  else if (CONSP (filepos))
    {
132 133
      file = XCAR (filepos);
      position = XINT (XCDR (filepos));
134 135
      if (position < 0)
	position = - position;
136 137
    }
  else
138 139
    return Qnil;

140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162
  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
    {
163
      name = (char *) XSTRING (file)->data;
164
    }
Jim Blandy's avatar
Jim Blandy committed
165

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

178
	  fd = emacs_open (name, O_RDONLY, 0);
179 180 181 182 183 184
	}
#endif
      if (fd < 0)
	error ("Cannot open doc string file \"%s\"", name);
    }

185 186 187
  /* 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
188
    {
189
      emacs_close (fd);
Jim Blandy's avatar
Jim Blandy committed
190
      error ("Position %ld out of range in doc string file \"%s\"",
191
	     position, name);
Jim Blandy's avatar
Jim Blandy committed
192
    }
193

194 195
  /* Read the doc string into get_doc_string_buffer.
     P points beyond the data just read.  */
196

197
  p = get_doc_string_buffer;
198
  while (1)
Jim Blandy's avatar
Jim Blandy committed
199
    {
200 201
      int space_left = (get_doc_string_buffer_size
			- (p - get_doc_string_buffer));
202 203
      int nread;

204
      /* Allocate or grow the buffer if we need to.  */
205 206
      if (space_left == 0)
	{
207 208 209 210 211 212 213 214
	  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));
215 216
	}

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

  /* Scan the text and perform quoting with ^A (char code 1).
     ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_.  */
246 247
  from = get_doc_string_buffer + offset;
  to = get_doc_string_buffer + offset;
248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268
  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++;
    }

269 270
  /* If DEFINITION, read from this buffer
     the same way we would read bytes from a file.  */
271 272
  if (definition)
    {
273 274
      read_bytecode_pointer = get_doc_string_buffer + offset;
      return Fread (Qlambda);
275 276
    }

277 278 279 280
  if (unibyte)
    return make_unibyte_string (get_doc_string_buffer + offset,
				to - (get_doc_string_buffer + offset));
  else
281 282 283 284 285 286 287 288 289
    {
      /* 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));
    }
290 291 292 293 294 295 296 297 298 299
}

/* 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;
{
300
  return get_doc_string (filepos, 0, 1);
Jim Blandy's avatar
Jim Blandy committed
301 302
}

Roland McGrath's avatar
Roland McGrath committed
303
DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0,
Jim Blandy's avatar
Jim Blandy committed
304
  "Return the documentation string of FUNCTION.\n\
305
Unless a non-nil second argument RAW is given, the\n\
Roland McGrath's avatar
Roland McGrath committed
306
string is passed through `substitute-command-keys'.")
Jim Blandy's avatar
Jim Blandy committed
307 308
  (function, raw)
     Lisp_Object function, raw;
Jim Blandy's avatar
Jim Blandy committed
309 310 311
{
  Lisp_Object fun;
  Lisp_Object funcar;
Roland McGrath's avatar
Roland McGrath committed
312
  Lisp_Object tem, doc;
Jim Blandy's avatar
Jim Blandy committed
313

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

Jim Blandy's avatar
Jim Blandy committed
384
  if (NILP (raw))
385
    doc = Fsubstitute_command_keys (doc);
Roland McGrath's avatar
Roland McGrath committed
386
  return doc;
Jim Blandy's avatar
Jim Blandy committed
387 388
}

389 390
DEFUN ("documentation-property", Fdocumentation_property,
       Sdocumentation_property, 2, 3, 0,
Jim Blandy's avatar
Jim Blandy committed
391
  "Return the documentation string that is SYMBOL's PROP property.\n\
392 393 394 395 396 397
Third argument RAW omitted or nil means pass the result through\n\
`substitute-command-keys' if it is a string.\n\
\n\
This is differs from `get' in that it can refer to strings stored in the\n\
`etc/DOC' file; and that it evaluates documentation properties that\n\
aren't strings.")
398 399
  (symbol, prop, raw)
     Lisp_Object symbol, prop, raw;
Jim Blandy's avatar
Jim Blandy committed
400
{
401
  Lisp_Object tem;
Jim Blandy's avatar
Jim Blandy committed
402

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

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

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

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

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

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

  /* Bytecode objects sometimes have slots for it.  */
450
  else if (COMPILEDP (fun))
451 452 453
    {
      /* This bytecode object must have a slot for the
	 docstring, since we've found a docstring for it.  */
Roland McGrath's avatar
Roland McGrath committed
454
      if ((XVECTOR (fun)->size & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
455
	XSETFASTINT (XVECTOR (fun)->contents[COMPILED_DOC_STRING], offset);
456 457 458 459
    }
}


Jim Blandy's avatar
Jim Blandy committed
460 461 462
DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
  1, 1, 0,
  "Used during Emacs initialization, before dumping runnable Emacs,\n\
Jim Blandy's avatar
Jim Blandy committed
463
to find pointers to doc strings stored in `etc/DOC...' and\n\
Jim Blandy's avatar
Jim Blandy committed
464 465
record them in function definitions.\n\
One arg, FILENAME, a string which does not include a directory.\n\
Jim Blandy's avatar
Jim Blandy committed
466
The file is found in `../etc' now; found in the `data-directory'\n\
Jim Blandy's avatar
Jim Blandy committed
467 468 469 470 471 472 473 474 475 476 477 478 479
when doc strings are referred to later in the dumped Emacs.")
  (filename)
     Lisp_Object filename;
{
  int fd;
  char buf[1024 + 1];
  register int filled;
  register int pos;
  register char *p, *end;
  Lisp_Object sym, fun, tem;
  char *name;
  extern char *index ();

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

Jim Blandy's avatar
Jim Blandy committed
485 486 487
  CHECK_STRING (filename, 0);

#ifndef CANNOT_DUMP
Jim Blandy's avatar
Jim Blandy committed
488
  name = (char *) alloca (XSTRING (filename)->size + 14);
Jim Blandy's avatar
Jim Blandy committed
489
  strcpy (name, "../etc/");
Jim Blandy's avatar
Jim Blandy committed
490
#else /* CANNOT_DUMP */
491
  CHECK_STRING (Vdoc_directory, 0);
Jim Blandy's avatar
Jim Blandy committed
492
  name = (char *) alloca (XSTRING (filename)->size +
493 494
			  XSTRING (Vdoc_directory)->size + 1);
  strcpy (name, XSTRING (Vdoc_directory)->data);
Jim Blandy's avatar
Jim Blandy committed
495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513
#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 */

514
  fd = emacs_open (name, O_RDONLY, 0);
Jim Blandy's avatar
Jim Blandy committed
515 516 517 518 519 520 521 522 523
  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)
524
	filled += emacs_read (fd, &buf[filled], sizeof buf - 1 - filled);
Jim Blandy's avatar
Jim Blandy committed
525 526 527 528 529 530 531 532 533 534 535
      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)
	{
	  end = index (p, '\n');
Richard M. Stallman's avatar
Richard M. Stallman committed
536 537 538
	  sym = oblookup (Vobarray, p + 2,
			  multibyte_chars_in_text (p + 2, end - p - 2),
			  end - p - 2);
539
	  if (SYMBOLP (sym))
Jim Blandy's avatar
Jim Blandy committed
540 541 542 543 544 545 546 547 548 549 550 551
	    {
	      /* 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)));
		}

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

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

599
  if (NILP (string))
Jim Blandy's avatar
Jim Blandy committed
600 601
    return Qnil;

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

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

611 612 613
  /* 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,
614
     or from a \\<mapname> construct in STRING itself..  */
Karl Heuer's avatar
Karl Heuer committed
615 616 617
  keymap = current_kboard->Voverriding_terminal_local_map;
  if (NILP (keymap))
    keymap = Voverriding_local_map;
Jim Blandy's avatar
Jim Blandy committed
618

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

622
  strp = (unsigned char *) XSTRING (string)->data;
623
  while (strp < XSTRING (string)->data + STRING_BYTES (XSTRING (string)))
Jim Blandy's avatar
Jim Blandy committed
624 625 626 627 628 629
    {
      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
630 631 632 633
	  strp += 2;
	  if (multibyte)
	    {
	      int len;
634
	      int maxlen = XSTRING (string)->data + STRING_BYTES (XSTRING (string)) - strp;
Richard M. Stallman's avatar
Richard M. Stallman committed
635 636 637 638 639 640 641 642 643 644 645 646

	      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
647 648 649
	}
      else if (strp[0] == '\\' && strp[1] == '[')
	{
650 651
	  Lisp_Object firstkey;

Jim Blandy's avatar
Jim Blandy committed
652 653 654 655
	  changed = 1;
	  strp += 2;		/* skip \[ */
	  start = strp;

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

Jim Blandy's avatar
Jim Blandy committed
662 663 664
	  strp++;		/* skip ] */

	  /* Save STRP in IDX.  */
665
	  idx = strp - (unsigned char *) XSTRING (string)->data;
Richard M. Stallman's avatar
Richard M. Stallman committed
666
	  tem = Fintern (make_string (start, length_byte), Qnil);
667
	  tem = Fwhere_is_internal (tem, keymap, Qt, Qnil);
Jim Blandy's avatar
Jim Blandy committed
668

669 670 671
	  /* 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.  */
672 673 674 675 676 677
	  if (!NILP (tem))
	    {
	      firstkey = Faref (tem, make_number (0));
	      if (EQ (firstkey, Qmenu_bar))
		tem = Qnil;
	    }
678

Jim Blandy's avatar
Jim Blandy committed
679
	  if (NILP (tem))	/* but not on any keys */
Jim Blandy's avatar
Jim Blandy committed
680 681 682 683 684 685
	    {
	      new = (unsigned char *) xrealloc (buf, bsize += 4);
	      bufp += new - buf;
	      buf = new;
	      bcopy ("M-x ", bufp, 4);
	      bufp += 4;
Richard M. Stallman's avatar
Richard M. Stallman committed
686 687 688 689 690
	      nchars += 4;
	      if (multibyte)
		length = multibyte_chars_in_text (start, length_byte);
	      else
		length = length_byte;
Jim Blandy's avatar
Jim Blandy committed
691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708
	      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;

	  changed = 1;
	  strp += 2;		/* skip \{ or \< */
	  start = strp;

709 710
	  while ((strp - (unsigned char *) XSTRING (string)->data
		  < XSTRING (string)->size)
Jim Blandy's avatar
Jim Blandy committed
711 712
		 && *strp != '}' && *strp != '>')
	    strp++;
Richard M. Stallman's avatar
Richard M. Stallman committed
713 714

	  length_byte = strp - start;
Jim Blandy's avatar
Jim Blandy committed
715 716 717
	  strp++;			/* skip } or > */

	  /* Save STRP in IDX.  */
718
	  idx = strp - (unsigned char *) XSTRING (string)->data;
Jim Blandy's avatar
Jim Blandy committed
719 720 721 722

	  /* 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
723
	  name = Fintern (make_string (start, length_byte), Qnil);
Jim Blandy's avatar
Jim Blandy committed
724
	  tem = Fboundp (name);
Jim Blandy's avatar
Jim Blandy committed
725
	  if (! NILP (tem))
Jim Blandy's avatar
Jim Blandy committed
726 727
	    {
	      tem = Fsymbol_value (name);
Jim Blandy's avatar
Jim Blandy committed
728
	      if (! NILP (tem))
Jim Blandy's avatar
Jim Blandy committed
729
		tem = get_keymap_1 (tem, 0, 1);
Jim Blandy's avatar
Jim Blandy committed
730 731 732 733 734 735
	    }

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

Jim Blandy's avatar
Jim Blandy committed
736
	  if (NILP (tem))
Jim Blandy's avatar
Jim Blandy committed
737 738 739
	    {
	      name = Fsymbol_name (name);
	      insert_string ("\nUses keymap \"");
Richard M. Stallman's avatar
Richard M. Stallman committed
740 741
	      insert_from_string (name, 0, 0,
				  XSTRING (name)->size,
742
				  STRING_BYTES (XSTRING (name)), 1);
Jim Blandy's avatar
Jim Blandy committed
743 744 745 746 747 748
	      insert_string ("\", which is not currently defined.\n");
	      if (start[-1] == '<') keymap = Qnil;
	    }
	  else if (start[-1] == '<')
	    keymap = tem;
	  else
749
	    describe_map_tree (tem, 1, Qnil, Qnil, (char *)0, 1, 0, 0);
Jim Blandy's avatar
Jim Blandy committed
750 751 752 753 754 755 756
	  tem = Fbuffer_string ();
	  Ferase_buffer ();
	  set_buffer_internal (oldbuf);

	subst_string:
	  start = XSTRING (tem)->data;
	  length = XSTRING (tem)->size;
757
	  length_byte = STRING_BYTES (XSTRING (tem));
Jim Blandy's avatar
Jim Blandy committed
758
	subst:
Richard M. Stallman's avatar
Richard M. Stallman committed
759
	  new = (unsigned char *) xrealloc (buf, bsize += length_byte);
Jim Blandy's avatar
Jim Blandy committed
760 761
	  bufp += new - buf;
	  buf = new;
Richard M. Stallman's avatar
Richard M. Stallman committed
762 763 764
	  bcopy (start, bufp, length_byte);
	  bufp += length_byte;
	  nchars += length;
765 766
	  /* Check STRING again in case gc relocated it.  */
	  strp = (unsigned char *) XSTRING (string)->data + idx;
Jim Blandy's avatar
Jim Blandy committed
767
	}
Richard M. Stallman's avatar
Richard M. Stallman committed
768 769 770 771 772
      else if (! multibyte)		/* just copy other chars */
	*bufp++ = *strp++, nchars++;
      else
	{
	  int len;
773
	  int maxlen = XSTRING (string)->data + STRING_BYTES (XSTRING (string)) - strp;
Richard M. Stallman's avatar
Richard M. Stallman committed
774 775 776 777 778 779 780 781 782 783

	  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
784 785 786
    }

  if (changed)			/* don't bother if nothing substituted */
787
    tem = make_string_from_bytes (buf, nchars, bufp - buf);
Jim Blandy's avatar
Jim Blandy committed
788
  else
789
    tem = string;
790
  xfree (buf);
Jim Blandy's avatar
Jim Blandy committed
791
  RETURN_UNGCPRO (tem);
Jim Blandy's avatar
Jim Blandy committed
792 793
}

Andreas Schwab's avatar
Andreas Schwab committed
794
void
Jim Blandy's avatar
Jim Blandy committed
795 796
syms_of_doc ()
{
797 798 799
  Qfunction_documentation = intern ("function-documentation");
  staticpro (&Qfunction_documentation);
  
Jim Blandy's avatar
Jim Blandy committed
800 801 802
  DEFVAR_LISP ("internal-doc-file-name", &Vdoc_file_name,
    "Name of file containing documentation strings of built-in symbols.");
  Vdoc_file_name = Qnil;
803 804 805 806 807 808
  DEFVAR_LISP ("help-manyarg-func-alist", &Vhelp_manyarg_func_alist,
    "Alist of primitive functions and descriptions of their arg lists.\n\
All special forms and primitives which effectively have &rest args\n\
should have an entry here so that `documentation' can provide their\n\
arg list.");
  Vhelp_manyarg_func_alist = Qnil;
Jim Blandy's avatar
Jim Blandy committed
809 810 811 812 813 814

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