doc.c 26.3 KB
Newer Older
Jim Blandy's avatar
Jim Blandy committed
1
/* Record indices of function doc strings stored in a file.
Glenn Morris's avatar
Glenn Morris committed
2

3 4
Copyright (C) 1985-1986, 1993-1995, 1997-2013 Free Software Foundation,
Inc.
Jim Blandy's avatar
Jim Blandy committed
5 6 7

This file is part of GNU Emacs.

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

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
19
along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
Jim Blandy's avatar
Jim Blandy committed
20 21


22
#include <config.h>
Jim Blandy's avatar
Jim Blandy committed
23 24

#include <sys/types.h>
25
#include <sys/file.h>	/* Must be after sys/types.h for USG.  */
Jim Blandy's avatar
Jim Blandy committed
26
#include <fcntl.h>
27 28
#include <unistd.h>

29 30
#include <c-ctype.h>

Jim Blandy's avatar
Jim Blandy committed
31
#include "lisp.h"
32
#include "character.h"
Jim Blandy's avatar
Jim Blandy committed
33
#include "buffer.h"
Jim Blandy's avatar
Jim Blandy committed
34
#include "keyboard.h"
Stefan Monnier's avatar
Stefan Monnier committed
35
#include "keymap.h"
36
#include "buildobj.h"
Jim Blandy's avatar
Jim Blandy committed
37

38 39
Lisp_Object Qfunction_documentation;

40 41
/* Buffer used for reading from documentation file.  */
static char *get_doc_string_buffer;
42
static ptrdiff_t get_doc_string_buffer_size;
43

44 45
static unsigned char *read_bytecode_pointer;

46
/* `readchar' in lread.c calls back here to fetch the next byte.
47 48 49
   If UNREADFLAG is 1, we unread a byte.  */

int
50
read_bytecode_char (bool unreadflag)
51 52 53 54 55 56 57 58 59
{
  if (unreadflag)
    {
      read_bytecode_pointer--;
      return 0;
    }
  return *read_bytecode_pointer++;
}

60 61 62
/* 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
63 64 65
   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
66 67
   them without actually fetching the doc string.)

68 69 70 71
   If the location does not point to the beginning of a docstring
   (e.g. because the file has been modified and the location is stale),
   return nil.

72
   If UNIBYTE, always make a unibyte string.
73

74
   If DEFINITION, assume this is for reading
75 76 77
   a dynamic function definition; convert the bytestring
   and the constants vector with appropriate byte handling,
   and return a cons cell.  */
78

79
Lisp_Object
80
get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
81
{
82 83
  char *from, *to, *name, *p, *p1;
  int fd;
84 85 86
  ptrdiff_t minsize;
  int offset;
  EMACS_INT position;
Paul Eggert's avatar
Paul Eggert committed
87
  Lisp_Object file, tem, pos;
88
  USE_SAFE_ALLOCA;
89

90 91 92
  if (INTEGERP (filepos))
    {
      file = Vdoc_file_name;
Paul Eggert's avatar
Paul Eggert committed
93
      pos = filepos;
94 95 96
    }
  else if (CONSP (filepos))
    {
97
      file = XCAR (filepos);
Paul Eggert's avatar
Paul Eggert committed
98
      pos = XCDR (filepos);
99 100
    }
  else
101 102
    return Qnil;

Paul Eggert's avatar
Paul Eggert committed
103
  position = eabs (XINT (pos));
104

105 106 107 108 109
  if (!STRINGP (Vdoc_directory))
    return Qnil;

  if (!STRINGP (file))
    return Qnil;
110

111 112 113 114
  /* 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);
115
  file = ENCODE_FILE (file);
116 117
  if (NILP (tem))
    {
118 119
      Lisp_Object docdir = ENCODE_FILE (Vdoc_directory);
      minsize = SCHARS (docdir);
120 121 122
      /* sizeof ("../etc/") == 8 */
      if (minsize < 8)
	minsize = 8;
123
      name = SAFE_ALLOCA (minsize + SCHARS (file) + 8);
124
      strcpy (name, SSDATA (docdir));
125
      strcat (name, SSDATA (file));
126 127 128
    }
  else
    {
129
      name = SSDATA (file);
130
    }
Jim Blandy's avatar
Jim Blandy committed
131

132
  fd = emacs_open (name, O_RDONLY, 0);
Jim Blandy's avatar
Jim Blandy committed
133
  if (fd < 0)
134 135 136 137 138
    {
#ifndef CANNOT_DUMP
      if (!NILP (Vpurify_flag))
	{
	  /* Preparing to dump; DOC file is probably not installed.
139
	     So check in ../etc.  */
140
	  strcpy (name, "../etc/");
141
	  strcat (name, SSDATA (file));
142

143
	  fd = emacs_open (name, O_RDONLY, 0);
144 145 146
	}
#endif
      if (fd < 0)
147 148
	return concat3 (build_string ("Cannot open doc string file \""),
			file, build_string ("\"\n"));
149 150
    }

151
  /* Seek only to beginning of disk block.  */
152 153 154
  /* Make sure we read at least 1024 bytes before `position'
     so we can check the leading text for consistency.  */
  offset = min (position, max (1024, position % (8 * 1024)));
155 156
  if (TYPE_MAXIMUM (off_t) < position
      || lseek (fd, position - offset, 0) < 0)
Jim Blandy's avatar
Jim Blandy committed
157
    {
158
      emacs_close (fd);
159
      error ("Position %"pI"d out of range in doc string file \"%s\"",
160
	     position, name);
Jim Blandy's avatar
Jim Blandy committed
161
    }
162

163 164
  SAFE_FREE ();

165 166
  /* Read the doc string into get_doc_string_buffer.
     P points beyond the data just read.  */
167

168
  p = get_doc_string_buffer;
169
  while (1)
Jim Blandy's avatar
Jim Blandy committed
170
    {
171
      ptrdiff_t space_left = (get_doc_string_buffer_size - 1
172
			      - (p - get_doc_string_buffer));
173 174
      int nread;

175
      /* Allocate or grow the buffer if we need to.  */
176
      if (space_left <= 0)
177
	{
178
	  ptrdiff_t in_buffer = p - get_doc_string_buffer;
179 180 181
	  get_doc_string_buffer
	    = xpalloc (get_doc_string_buffer, &get_doc_string_buffer_size,
		       16 * 1024, -1, 1);
182
	  p = get_doc_string_buffer + in_buffer;
183
	  space_left = (get_doc_string_buffer_size - 1
184
			- (p - get_doc_string_buffer));
185 186
	}

187 188
      /* Read a disk block at a time.
         If we read the same block last time, maybe skip this?  */
189 190
      if (space_left > 1024 * 8)
	space_left = 1024 * 8;
191
      nread = emacs_read (fd, p, space_left);
192 193
      if (nread < 0)
	{
194
	  emacs_close (fd);
195 196 197 198
	  error ("Read error on documentation file");
	}
      p[nread] = 0;
      if (!nread)
Jim Blandy's avatar
Jim Blandy committed
199
	break;
200
      if (p == get_doc_string_buffer)
201
	p1 = strchr (p + offset, '\037');
202
      else
203
	p1 = strchr (p, '\037');
Jim Blandy's avatar
Jim Blandy committed
204 205 206 207 208 209
      if (p1)
	{
	  *p1 = 0;
	  p = p1;
	  break;
	}
210
      p += nread;
Jim Blandy's avatar
Jim Blandy committed
211
    }
212
  emacs_close (fd);
213

214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237
  /* Sanity checking.  */
  if (CONSP (filepos))
    {
      int test = 1;
      if (get_doc_string_buffer[offset - test++] != ' ')
	return Qnil;
      while (get_doc_string_buffer[offset - test] >= '0'
	     && get_doc_string_buffer[offset - test] <= '9')
	test++;
      if (get_doc_string_buffer[offset - test++] != '@'
	  || get_doc_string_buffer[offset - test] != '#')
	return Qnil;
    }
  else
    {
      int test = 1;
      if (get_doc_string_buffer[offset - test++] != '\n')
	return Qnil;
      while (get_doc_string_buffer[offset - test] > ' ')
	test++;
      if (get_doc_string_buffer[offset - test] != '\037')
	return Qnil;
    }

238 239
  /* Scan the text and perform quoting with ^A (char code 1).
     ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_.  */
240 241
  from = get_doc_string_buffer + offset;
  to = get_doc_string_buffer + offset;
242 243 244 245 246 247 248 249 250 251 252 253 254 255 256
  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
257 258 259
	    {
	      unsigned char uc = c;
	      error ("\
260
Invalid data in documentation file -- %c followed by code %03o",
261 262
		     1, uc);
	    }
263 264 265 266 267
	}
      else
	*to++ = *from++;
    }

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

276 277 278 279
  if (unibyte)
    return make_unibyte_string (get_doc_string_buffer + offset,
				to - (get_doc_string_buffer + offset));
  else
280
    {
281
      /* The data determines whether the string is multibyte.  */
282 283 284 285
      ptrdiff_t nchars
	= multibyte_chars_in_text (((unsigned char *) get_doc_string_buffer
				    + offset),
				   to - (get_doc_string_buffer + offset));
286 287 288 289
      return make_string_from_bytes (get_doc_string_buffer + offset,
				     nchars,
				     to - (get_doc_string_buffer + offset));
    }
290 291 292 293 294 295 296
}

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

302
static bool
303
reread_doc_file (Lisp_Object file)
304
{
305
#if 0
306 307 308 309 310
  Lisp_Object reply, prompt[3];
  struct gcpro gcpro1;
  GCPRO1 (file);
  prompt[0] = build_string ("File ");
  prompt[1] = NILP (file) ? Vdoc_file_name : file;
311
  prompt[2] = build_string (" is out of sync.  Reload? ");
312 313 314
  reply = Fy_or_n_p (Fconcat (3, prompt));
  UNGCPRO;
  if (NILP (reply))
315
    return 0;
316
#endif
317 318 319 320 321

  if (NILP (file))
    Fsnarf_documentation (Vdoc_file_name);
  else
    Fload (file, Qt, Qt, Qt, Qnil);
322 323

  return 1;
324 325
}

Roland McGrath's avatar
Roland McGrath committed
326
DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0,
327 328 329
       doc: /* Return the documentation string of FUNCTION.
Unless a non-nil second argument RAW is given, the
string is passed through `substitute-command-keys'.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
330
  (Lisp_Object function, Lisp_Object raw)
Jim Blandy's avatar
Jim Blandy committed
331 332 333
{
  Lisp_Object fun;
  Lisp_Object funcar;
334
  Lisp_Object doc;
335
  bool try_reload = 1;
336 337

 documentation:
Jim Blandy's avatar
Jim Blandy committed
338

339
  doc = Qnil;
340

Juanma Barranquero's avatar
Juanma Barranquero committed
341 342 343 344 345 346 347 348
  if (SYMBOLP (function))
    {
      Lisp_Object tem = Fget (function, Qfunction_documentation);
      if (!NILP (tem))
	return Fdocumentation_property (function, Qfunction_documentation,
					raw);
    }

349
  fun = Findirect_function (function, Qnil);
350 351
  if (CONSP (fun) && EQ (XCAR (fun), Qmacro))
    fun = XCDR (fun);
352
  if (SUBRP (fun))
Jim Blandy's avatar
Jim Blandy committed
353
    {
354 355
      if (XSUBR (fun)->doc == 0)
	return Qnil;
Paul Eggert's avatar
Paul Eggert committed
356 357
      /* FIXME: This is not portable, as it assumes that string
	 pointers have the top bit clear.  */
358
      else if ((intptr_t) XSUBR (fun)->doc >= 0)
Roland McGrath's avatar
Roland McGrath committed
359
	doc = build_string (XSUBR (fun)->doc);
Jim Blandy's avatar
Jim Blandy committed
360
      else
361
	doc = make_number ((intptr_t) XSUBR (fun)->doc);
362 363 364
    }
  else if (COMPILEDP (fun))
    {
365
      if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_DOC_STRING)
Jim Blandy's avatar
Jim Blandy committed
366
	return Qnil;
Roland McGrath's avatar
Roland McGrath committed
367
      else
368 369 370 371 372 373 374 375 376
	{
	  Lisp_Object tem = AREF (fun, COMPILED_DOC_STRING);
	  if (STRINGP (tem))
	    doc = tem;
	  else if (NATNUMP (tem) || CONSP (tem))
	    doc = tem;
	  else
	    return Qnil;
	}
377 378 379
    }
  else if (STRINGP (fun) || VECTORP (fun))
    {
Jim Blandy's avatar
Jim Blandy committed
380
      return build_string ("Keyboard macro.");
381 382 383
    }
  else if (CONSP (fun))
    {
384
      funcar = XCAR (fun);
385
      if (!SYMBOLP (funcar))
Kim F. Storm's avatar
Kim F. Storm committed
386
	xsignal1 (Qinvalid_function, fun);
Jim Blandy's avatar
Jim Blandy committed
387
      else if (EQ (funcar, Qkeymap))
388
	return build_string ("Prefix command (definition is a keymap associating keystrokes with commands).");
Jim Blandy's avatar
Jim Blandy committed
389
      else if (EQ (funcar, Qlambda)
390
	       || (EQ (funcar, Qclosure) && (fun = XCDR (fun), 1))
Jim Blandy's avatar
Jim Blandy committed
391
	       || EQ (funcar, Qautoload))
Jim Blandy's avatar
Jim Blandy committed
392
	{
393 394
	  Lisp_Object tem1 = Fcdr (Fcdr (fun));
	  Lisp_Object tem = Fcar (tem1);
395
	  if (STRINGP (tem))
Roland McGrath's avatar
Roland McGrath committed
396
	    doc = tem;
397 398
	  /* Handle a doc reference--but these never come last
	     in the function body, so reject them if they are last.  */
399 400 401
	  else if ((NATNUMP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
		   && !NILP (XCDR (tem1)))
	    doc = tem;
Roland McGrath's avatar
Roland McGrath committed
402 403
	  else
	    return Qnil;
Jim Blandy's avatar
Jim Blandy committed
404
	}
405 406 407 408 409 410
      else
	goto oops;
    }
  else
    {
    oops:
Kim F. Storm's avatar
Kim F. Storm committed
411
      xsignal1 (Qinvalid_function, fun);
Jim Blandy's avatar
Jim Blandy committed
412
    }
Roland McGrath's avatar
Roland McGrath committed
413

414 415
  /* Check for a dynamic docstring.  These come with
     a dynamic-docstring-function text property.  */
416 417
  if (STRINGP (doc))
    {
418 419 420
      Lisp_Object func
	= Fget_text_property (make_number (0),
			      intern ("dynamic-docstring-function"),
421
				      doc);
422 423 424 425 426
      if (!NILP (func))
	/* Pass both `doc' and `function' since `function' can be needed, and
	   finding `doc' can be annoying: calling `documentation' is not an
	   option because it would infloop.  */
	doc = call2 (func, doc, function);
427 428
    }

429 430
  /* If DOC is 0, it's typically because of a dumped file missing
     from the DOC file (bug in src/Makefile.in).  */
431 432
  if (EQ (doc, make_number (0)))
    doc = Qnil;
433
  if (INTEGERP (doc) || CONSP (doc))
434 435 436
    {
      Lisp_Object tem;
      tem = get_doc_string (doc, 0, 0);
437
      if (NILP (tem) && try_reload)
438 439 440 441
	{
	  /* The file is newer, we need to reset the pointers.  */
	  struct gcpro gcpro1, gcpro2;
	  GCPRO2 (function, raw);
442
	  try_reload = reread_doc_file (Fcar_safe (doc));
443
	  UNGCPRO;
444 445 446 447 448
	  if (try_reload)
	    {
	      try_reload = 0;
	      goto documentation;
	    }
449 450 451 452
	}
      else
	doc = tem;
    }
453

Jim Blandy's avatar
Jim Blandy committed
454
  if (NILP (raw))
455
    doc = Fsubstitute_command_keys (doc);
Roland McGrath's avatar
Roland McGrath committed
456
  return doc;
Jim Blandy's avatar
Jim Blandy committed
457 458
}

459 460
DEFUN ("documentation-property", Fdocumentation_property,
       Sdocumentation_property, 2, 3, 0,
461 462 463 464 465 466 467
       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.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
468
  (Lisp_Object symbol, Lisp_Object prop, Lisp_Object raw)
Jim Blandy's avatar
Jim Blandy committed
469
{
470
  bool try_reload = 1;
471
  Lisp_Object tem;
Jim Blandy's avatar
Jim Blandy committed
472

473
 documentation_property:
474

475
  tem = Fget (symbol, prop);
476
  if (EQ (tem, make_number (0)))
477
    tem = Qnil;
478
  if (INTEGERP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
479 480 481
    {
      Lisp_Object doc = tem;
      tem = get_doc_string (tem, 0, 0);
482
      if (NILP (tem) && try_reload)
483 484 485 486
	{
	  /* The file is newer, we need to reset the pointers.  */
	  struct gcpro gcpro1, gcpro2, gcpro3;
	  GCPRO3 (symbol, prop, raw);
487
	  try_reload = reread_doc_file (Fcar_safe (doc));
488
	  UNGCPRO;
489 490 491 492 493
	  if (try_reload)
	    {
	      try_reload = 0;
	      goto documentation_property;
	    }
494 495
	}
    }
496 497
  else if (!STRINGP (tem))
    /* Feval protects its argument.  */
498
    tem = Feval (tem, Qnil);
499

500
  if (NILP (raw) && STRINGP (tem))
501
    tem = Fsubstitute_command_keys (tem);
502
  return tem;
Jim Blandy's avatar
Jim Blandy committed
503 504
}

505 506 507
/* Scanning the DOC files and placing docstring offsets into functions.  */

static void
Paul Eggert's avatar
Paul Eggert committed
508
store_function_docstring (Lisp_Object obj, ptrdiff_t offset)
509
{
510 511
  /* Don't use indirect_function here, or defaliases will apply their
     docstrings to the base functions (Bug#2603).  */
512
  Lisp_Object fun = SYMBOLP (obj) ? XSYMBOL (obj)->function : obj;
513 514 515 516

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

  /* Lisp_Subrs have a slot for it.  */
517
  if (SUBRP (fun))
518 519 520 521
    {
      intptr_t negative_offset = - offset;
      XSUBR (fun)->doc = (char *) negative_offset;
    }
522 523 524 525 526 527

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

528
      tem = XCAR (fun);
529 530
      if (EQ (tem, Qlambda) || EQ (tem, Qautoload)
	  || (EQ (tem, Qclosure) && (fun = XCDR (fun), 1)))
531 532
	{
	  tem = Fcdr (Fcdr (fun));
533
	  if (CONSP (tem) && INTEGERP (XCAR (tem)))
534 535
	    /* FIXME: This modifies typically pure hash-cons'd data, so its
	       correctness is quite delicate.  */
536
	    XSETCAR (tem, make_number (offset));
537 538
	}
      else if (EQ (tem, Qmacro))
539
	store_function_docstring (XCDR (fun), offset);
540 541 542
    }

  /* Bytecode objects sometimes have slots for it.  */
543
  else if (COMPILEDP (fun))
544 545 546
    {
      /* This bytecode object must have a slot for the
	 docstring, since we've found a docstring for it.  */
547
      if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
548
	ASET (fun, COMPILED_DOC_STRING, make_number (offset));
549 550 551
    }
}

552
static const char buildobj[] = BUILDOBJ;
553

Jim Blandy's avatar
Jim Blandy committed
554
DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
555
       1, 1, 0,
556 557 558 559 560 561
       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,
562
the same file name is found in the `doc-directory'.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
563
  (Lisp_Object filename)
Jim Blandy's avatar
Jim Blandy committed
564 565 566
{
  int fd;
  char buf[1024 + 1];
567 568
  int filled;
  EMACS_INT pos;
569
  Lisp_Object sym;
570 571
  char *p, *name;
  bool skip_file = 0;
Jim Blandy's avatar
Jim Blandy committed
572

573
  CHECK_STRING (filename);
Jim Blandy's avatar
Jim Blandy committed
574

575
  if
Jim Blandy's avatar
Jim Blandy committed
576
#ifndef CANNOT_DUMP
577
    (!NILP (Vpurify_flag))
Jim Blandy's avatar
Jim Blandy committed
578
#else /* CANNOT_DUMP */
579
      (0)
Jim Blandy's avatar
Jim Blandy committed
580
#endif /* CANNOT_DUMP */
581
    {
582
      name = alloca (SCHARS (filename) + 14);
583 584 585 586 587
      strcpy (name, "../etc/");
    }
  else
    {
      CHECK_STRING (Vdoc_directory);
588
      name = alloca (SCHARS (filename) + SCHARS (Vdoc_directory) + 1);
589
      strcpy (name, SSDATA (Vdoc_directory));
590
    }
591
  strcat (name, SSDATA (filename)); 	/*** Add this line ***/
Jim Blandy's avatar
Jim Blandy committed
592

593 594 595
  /* Vbuild_files is nil when temacs is run, and non-nil after that.  */
  if (NILP (Vbuild_files))
  {
596
    const char *beg, *end;
597

598
    for (beg = buildobj; *beg; beg = end)
599
      {
600
        ptrdiff_t len;
601

602
        while (*beg && c_isspace (*beg)) ++beg;
603

604
        for (end = beg; *end && ! c_isspace (*end); ++end)
605 606 607 608 609 610 611 612 613
          if (*end == '/') beg = end+1;  /* skip directory part  */

        len = end - beg;
        if (len > 4 && end[-4] == '.' && end[-3] == 'o')
          len -= 2;  /* Just take .o if it ends in .obj  */

        if (len > 0)
          Vbuild_files = Fcons (make_string (beg, len), Vbuild_files);
      }
614
    Vbuild_files = Fpurecopy (Vbuild_files);
615 616
  }

617
  fd = emacs_open (name, O_RDONLY, 0);
Jim Blandy's avatar
Jim Blandy committed
618 619 620 621 622 623 624 625
  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)
    {
626
      register char *end;
Jim Blandy's avatar
Jim Blandy committed
627
      if (filled < 512)
628
	filled += emacs_read (fd, &buf[filled], sizeof buf - 1 - filled);
Jim Blandy's avatar
Jim Blandy committed
629 630 631 632 633
      if (!filled)
	break;

      buf[filled] = 0;
      end = buf + (filled < 512 ? filled : filled - 128);
634
      p = memchr (buf, '\037', end - buf);
635
      /* p points to ^_Ffunctionname\n or ^_Vvarname\n or ^_Sfilename\n.  */
636
      if (p)
Jim Blandy's avatar
Jim Blandy committed
637
	{
638
	  end = strchr (p, '\n');
639 640

          /* See if this is a file name, and if it is a file in build-files.  */
641
          if (p[1] == 'S')
642
            {
643 644 645 646
              skip_file = 0;
              if (end - p > 4 && end[-2] == '.'
                  && (end[-1] == 'o' || end[-1] == 'c'))
                {
647
                  ptrdiff_t len = end - p - 2;
648
                  char *fromfile = alloca (len + 1);
649
                  memcpy (fromfile, &p[2], len);
650 651 652 653 654 655 656
                  fromfile[len] = 0;
                  if (fromfile[len-1] == 'c')
                    fromfile[len-1] = 'o';

                  skip_file = NILP (Fmember (build_string (fromfile),
                                             Vbuild_files));
                }
657 658
            }

Richard M. Stallman's avatar
Richard M. Stallman committed
659
	  sym = oblookup (Vobarray, p + 2,
660 661
			  multibyte_chars_in_text ((unsigned char *) p + 2,
						   end - p - 2),
Richard M. Stallman's avatar
Richard M. Stallman committed
662
			  end - p - 2);
663 664 665 666
	  /* Check skip_file so that when a function is defined several
	     times in different files (typically, once in xterm, once in
	     w32term, ...), we only pay attention to the one that
	     matters.  */
667
	  if (! skip_file && SYMBOLP (sym))
Jim Blandy's avatar
Jim Blandy committed
668 669 670 671 672 673 674
	    {
	      /* 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 `*').  */
Glenn Morris's avatar
Glenn Morris committed
675 676 677 678
                  if (!NILP (Fboundp (sym)))
                    Fput (sym, Qvariable_documentation,
                          make_number ((pos + end + 1 - buf)
                                       * (end[1] == '*' ? -1 : 1)));
Jim Blandy's avatar
Jim Blandy committed
679 680
		}

681
	      /* Attach a docstring to a function?  */
Jim Blandy's avatar
Jim Blandy committed
682
	      else if (p[1] == 'F')
Glenn Morris's avatar
Glenn Morris committed
683 684 685 686
                {
                  if (!NILP (Ffboundp (sym)))
                    store_function_docstring (sym, pos + end + 1 - buf);
                }
Kenichi Handa's avatar
Kenichi Handa committed
687 688 689
	      else if (p[1] == 'S')
		; /* Just a source file name boundary marker.  Ignore it.  */

690
	      else
691
		error ("DOC file invalid at position %"pI"d", pos);
Jim Blandy's avatar
Jim Blandy committed
692 693 694 695
	    }
	}
      pos += end - buf;
      filled -= end - buf;
696
      memmove (buf, end, filled);
Jim Blandy's avatar
Jim Blandy committed
697
    }
698
  emacs_close (fd);
Jim Blandy's avatar
Jim Blandy committed
699 700 701
  return Qnil;
}

Paul Eggert's avatar
Paul Eggert committed
702
DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
703 704
       Ssubstitute_command_keys, 1, 1, 0,
       doc: /* Substitute key descriptions for command names in STRING.
705 706 707 708 709 710 711 712 713 714 715
Each substring of the form \\=\\[COMMAND] is replaced by either a
keystroke sequence that invokes COMMAND, or "M-x COMMAND" if COMMAND
is not on any keys.

Each substring of the form \\=\\{MAPVAR} is replaced by a summary of
the value of MAPVAR as a keymap.  This summary is similar to the one
produced by `describe-bindings'.  The summary ends in two newlines
\(used by the helper function `help-make-xrefs' to find the end of the
summary).

Each substring of the form \\=\\<MAPVAR> specifies the use of MAPVAR
716 717
as the keymap for future \\=\\[COMMAND] substrings.
\\=\\= quotes the following character and is discarded;
718 719
thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.

720 721
Return the original STRING if no substitutions are made.
Otherwise, return a new string, without any text properties.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
722
  (Lisp_Object string)
Jim Blandy's avatar
Jim Blandy committed
723
{
724
  char *buf;
725 726 727
  bool changed = 0;
  unsigned char *strp;
  char *bufp;
728 729
  ptrdiff_t idx;
  ptrdiff_t bsize;
Jim Blandy's avatar
Jim Blandy committed
730
  Lisp_Object tem;
Jim Blandy's avatar
Jim Blandy committed
731 732
  Lisp_Object keymap;
  unsigned char *start;
733
  ptrdiff_t length, length_byte;
Jim Blandy's avatar
Jim Blandy committed
734 735
  Lisp_Object name;
  struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
736
  bool multibyte;
737
  ptrdiff_t nchars;
Jim Blandy's avatar
Jim Blandy committed
738

739
  if (NILP (string))
Jim Blandy's avatar
Jim Blandy committed
740 741
    return Qnil;

742
  CHECK_STRING (string);
Jim Blandy's avatar
Jim Blandy committed
743 744 745
  tem = Qnil;
  keymap = Qnil;
  name = Qnil;
746
  GCPRO4 (string, tem, keymap, name);
Jim Blandy's avatar
Jim Blandy committed
747

Richard M. Stallman's avatar
Richard M. Stallman committed
748 749 750
  multibyte = STRING_MULTIBYTE (string);
  nchars = 0;

751 752 753
  /* 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,
754
     or from a \\<mapname> construct in STRING itself..  */
755
  keymap = KVAR (current_kboard, Voverriding_terminal_local_map);
Karl Heuer's avatar
Karl Heuer committed
756 757
  if (NILP (keymap))
    keymap = Voverriding_local_map;
Jim Blandy's avatar
Jim Blandy committed
758

759
  bsize = SBYTES (string);
Dmitry Antipov's avatar
Dmitry Antipov committed
760
  bufp = buf = xmalloc (bsize);
Jim Blandy's avatar
Jim Blandy committed
761

762
  strp = SDATA (string);
763
  while (strp < SDATA (string) + SBYTES (string))
Jim Blandy's avatar
Jim Blandy committed
764 765 766 767 768 769
    {
      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
770 771 772 773 774
	  strp += 2;
	  if (multibyte)
	    {
	      int len;

775
	      STRING_CHAR_AND_LENGTH (strp, len);
Richard M. Stallman's avatar
Richard M. Stallman committed
776 777 778
	      if (len == 1)
		*bufp = *strp;
	      else
779
		memcpy (bufp, strp, len);
Richard M. Stallman's avatar
Richard M. Stallman committed
780 781 782 783 784 785
	      strp += len;
	      bufp += len;
	      nchars++;
	    }
	  else
	    *bufp++ = *strp++, nchars++;
Jim Blandy's avatar
Jim Blandy committed
786 787 788
	}
      else if (strp[0] == '\\' && strp[1] == '[')
	{
789
	  ptrdiff_t start_idx;
790
	  bool follow_remap = 1;
791

Jim Blandy's avatar
Jim Blandy committed
792 793 794
	  changed = 1;
	  strp += 2;		/* skip \[ */
	  start = strp;
795
	  start_idx = start - SDATA (string);
Jim Blandy's avatar
Jim Blandy committed
796

797
	  while ((strp - SDATA (string)
798
		  < SBYTES (string))
Jim Blandy's avatar
Jim Blandy committed
799 800
		 && *strp != ']')
	    strp++;
Richard M. Stallman's avatar
Richard M. Stallman committed
801 802
	  length_byte = strp - start;

Jim Blandy's avatar
Jim Blandy committed
803 804 805
	  strp++;		/* skip ] */

	  /* Save STRP in IDX.  */
806
	  idx = strp - SDATA (string);
807
	  name = Fintern (make_string ((char *) start, length_byte), Qnil);
808

809
	do_remap:
810
	  tem = Fwhere_is_internal (name, keymap, Qt, Qnil, Qnil);
811

812
	  if (VECTORP (tem) && ASIZE (tem) > 1