doc.c 26.7 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
Copyright (C) 1985-1986, 1993-1995, 1997-2014 Free Software Foundation, Inc.
Jim Blandy's avatar
Jim Blandy committed
4 5 6

This file is part of GNU Emacs.

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

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


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

23
#include <errno.h>
Jim Blandy's avatar
Jim Blandy committed
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"
Jim Blandy's avatar
Jim Blandy committed
36

37 38
Lisp_Object Qfunction_documentation;

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

43 44
static unsigned char *read_bytecode_pointer;

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

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

59
/* Extract a doc string from a file.  FILEPOS says where to get it.
60
   If it is an integer, use that position in the standard DOC file.
61
   If it is (FILE . INTEGER), use FILE as the file name
62 63 64
   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
65 66
   them without actually fetching the doc string.)

67 68 69 70
   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.

71
   If UNIBYTE, always make a unibyte string.
72

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

78
Lisp_Object
79
get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
80
{
81 82
  char *from, *to, *name, *p, *p1;
  int fd;
83 84 85
  ptrdiff_t minsize;
  int offset;
  EMACS_INT position;
Paul Eggert's avatar
Paul Eggert committed
86
  Lisp_Object file, tem, pos;
87
  ptrdiff_t count;
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
      lispstpcpy (name, 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
	{
	  SAFE_FREE ();
149 150
	  return concat3 (build_local_string ("Cannot open doc string file \""),
			  file, build_local_string ("\"\n"));
151
	}
152
    }
153 154
  count = SPECPDL_INDEX ();
  record_unwind_protect_int (close_file_unwind, fd);
155

156
  /* Seek only to beginning of disk block.  */
157 158 159
  /* 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)));
160 161
  if (TYPE_MAXIMUM (off_t) < position
      || lseek (fd, position - offset, 0) < 0)
162 163
    error ("Position %"pI"d out of range in doc string file \"%s\"",
	   position, name);
164

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
      if (nread < 0)
193
	report_file_error ("Read error on documentation file", file);
194 195
      p[nread] = 0;
      if (!nread)
Jim Blandy's avatar
Jim Blandy committed
196
	break;
197
      if (p == get_doc_string_buffer)
198
	p1 = strchr (p + offset, '\037');
199
      else
200
	p1 = strchr (p, '\037');
Jim Blandy's avatar
Jim Blandy committed
201 202 203 204 205 206
      if (p1)
	{
	  *p1 = 0;
	  p = p1;
	  break;
	}
207
      p += nread;
Jim Blandy's avatar
Jim Blandy committed
208
    }
209 210
  unbind_to (count, Qnil);
  SAFE_FREE ();
211

212 213 214 215
  /* Sanity checking.  */
  if (CONSP (filepos))
    {
      int test = 1;
216 217 218 219 220 221 222 223 224 225 226 227 228 229
      /* A dynamic docstring should be either at the very beginning of a "#@
	 comment" or right after a dynamic docstring delimiter (in case we
	 pack several such docstrings within the same comment).  */
      if (get_doc_string_buffer[offset - test] != '\037')
	{
	  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;
	}
230 231 232 233 234 235 236 237 238 239 240 241
    }
  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;
    }

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

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

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

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

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

  if (NILP (file))
    Fsnarf_documentation (Vdoc_file_name);
  else
    Fload (file, Qt, Qt, Qt, Qnil);
326 327

  return 1;
328 329
}

Roland McGrath's avatar
Roland McGrath committed
330
DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0,
331 332 333
       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
334
  (Lisp_Object function, Lisp_Object raw)
Jim Blandy's avatar
Jim Blandy committed
335 336 337
{
  Lisp_Object fun;
  Lisp_Object funcar;
338
  Lisp_Object doc;
339
  bool try_reload = 1;
340 341

 documentation:
Jim Blandy's avatar
Jim Blandy committed
342

343
  doc = Qnil;
344

Juanma Barranquero's avatar
Juanma Barranquero committed
345 346 347 348 349 350 351 352
  if (SYMBOLP (function))
    {
      Lisp_Object tem = Fget (function, Qfunction_documentation);
      if (!NILP (tem))
	return Fdocumentation_property (function, Qfunction_documentation,
					raw);
    }

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

418 419
  /* If DOC is 0, it's typically because of a dumped file missing
     from the DOC file (bug in src/Makefile.in).  */
420 421
  if (EQ (doc, make_number (0)))
    doc = Qnil;
422
  if (INTEGERP (doc) || CONSP (doc))
423 424 425
    {
      Lisp_Object tem;
      tem = get_doc_string (doc, 0, 0);
426
      if (NILP (tem) && try_reload)
427 428 429 430
	{
	  /* The file is newer, we need to reset the pointers.  */
	  struct gcpro gcpro1, gcpro2;
	  GCPRO2 (function, raw);
431
	  try_reload = reread_doc_file (Fcar_safe (doc));
432
	  UNGCPRO;
433 434 435 436 437
	  if (try_reload)
	    {
	      try_reload = 0;
	      goto documentation;
	    }
438 439 440 441
	}
      else
	doc = tem;
    }
442

Jim Blandy's avatar
Jim Blandy committed
443
  if (NILP (raw))
444
    doc = Fsubstitute_command_keys (doc);
Roland McGrath's avatar
Roland McGrath committed
445
  return doc;
Jim Blandy's avatar
Jim Blandy committed
446 447
}

448 449
DEFUN ("documentation-property", Fdocumentation_property,
       Sdocumentation_property, 2, 3, 0,
450 451 452 453 454 455 456
       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
457
  (Lisp_Object symbol, Lisp_Object prop, Lisp_Object raw)
Jim Blandy's avatar
Jim Blandy committed
458
{
459
  bool try_reload = 1;
460
  Lisp_Object tem;
Jim Blandy's avatar
Jim Blandy committed
461

462
 documentation_property:
463

464
  tem = Fget (symbol, prop);
465
  if (EQ (tem, make_number (0)))
466
    tem = Qnil;
467
  if (INTEGERP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
468 469 470
    {
      Lisp_Object doc = tem;
      tem = get_doc_string (tem, 0, 0);
471
      if (NILP (tem) && try_reload)
472 473 474 475
	{
	  /* The file is newer, we need to reset the pointers.  */
	  struct gcpro gcpro1, gcpro2, gcpro3;
	  GCPRO3 (symbol, prop, raw);
476
	  try_reload = reread_doc_file (Fcar_safe (doc));
477
	  UNGCPRO;
478 479 480 481 482
	  if (try_reload)
	    {
	      try_reload = 0;
	      goto documentation_property;
	    }
483 484
	}
    }
485 486
  else if (!STRINGP (tem))
    /* Feval protects its argument.  */
487
    tem = Feval (tem, Qnil);
488

489
  if (NILP (raw) && STRINGP (tem))
490
    tem = Fsubstitute_command_keys (tem);
491
  return tem;
Jim Blandy's avatar
Jim Blandy committed
492 493
}

494 495 496
/* Scanning the DOC files and placing docstring offsets into functions.  */

static void
Paul Eggert's avatar
Paul Eggert committed
497
store_function_docstring (Lisp_Object obj, ptrdiff_t offset)
498
{
499 500
  /* Don't use indirect_function here, or defaliases will apply their
     docstrings to the base functions (Bug#2603).  */
501
  Lisp_Object fun = SYMBOLP (obj) ? XSYMBOL (obj)->function : obj;
502 503 504 505

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

  /* Lisp_Subrs have a slot for it.  */
506
  if (SUBRP (fun))
507 508 509 510
    {
      intptr_t negative_offset = - offset;
      XSUBR (fun)->doc = (char *) negative_offset;
    }
511 512 513 514 515 516

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

517
      tem = XCAR (fun);
518 519
      if (EQ (tem, Qlambda) || EQ (tem, Qautoload)
	  || (EQ (tem, Qclosure) && (fun = XCDR (fun), 1)))
520 521
	{
	  tem = Fcdr (Fcdr (fun));
522
	  if (CONSP (tem) && INTEGERP (XCAR (tem)))
523 524
	    /* FIXME: This modifies typically pure hash-cons'd data, so its
	       correctness is quite delicate.  */
525
	    XSETCAR (tem, make_number (offset));
526 527
	}
      else if (EQ (tem, Qmacro))
528
	store_function_docstring (XCDR (fun), offset);
529 530 531
    }

  /* Bytecode objects sometimes have slots for it.  */
532
  else if (COMPILEDP (fun))
533 534 535
    {
      /* This bytecode object must have a slot for the
	 docstring, since we've found a docstring for it.  */
536
      if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
537
	ASET (fun, COMPILED_DOC_STRING, make_number (offset));
538 539
      else
	message ("No docstring slot for %s",
540
		 SYMBOLP (obj) ? SSDATA (SYMBOL_NAME (obj)) : "<anonymous>");
541 542 543 544
    }
}


Jim Blandy's avatar
Jim Blandy committed
545
DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
546
       1, 1, 0,
547 548 549 550 551 552
       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,
553
the same file name is found in the `doc-directory'.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
554
  (Lisp_Object filename)
Jim Blandy's avatar
Jim Blandy committed
555 556 557
{
  int fd;
  char buf[1024 + 1];
558 559
  int filled;
  EMACS_INT pos;
560
  Lisp_Object sym;
561 562
  char *p, *name;
  bool skip_file = 0;
563
  ptrdiff_t count;
564 565
  char const *dirname;
  ptrdiff_t dirlen;
566 567 568 569 570 571
  /* Preloaded defcustoms using custom-initialize-delay are added to
     this list, but kept unbound.  See http://debbugs.gnu.org/11565  */
  Lisp_Object delayed_init =
    find_symbol_value (intern ("custom-delayed-init-variables"));

  if (EQ (delayed_init, Qunbound)) delayed_init = Qnil;
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 583 584
      static char const sibling_etc[] = "../etc/";
      dirname = sibling_etc;
      dirlen = sizeof sibling_etc - 1;
585 586 587 588
    }
  else
    {
      CHECK_STRING (Vdoc_directory);
589 590
      dirname = SSDATA (Vdoc_directory);
      dirlen = SBYTES (Vdoc_directory);
591
    }
592 593 594 595 596

  count = SPECPDL_INDEX ();
  USE_SAFE_ALLOCA;
  name = SAFE_ALLOCA (dirlen + SBYTES (filename) + 1);
  strcpy (name, dirname);
597
  strcat (name, SSDATA (filename)); 	/*** Add this line ***/
Jim Blandy's avatar
Jim Blandy committed
598

599 600
  /* Vbuild_files is nil when temacs is run, and non-nil after that.  */
  if (NILP (Vbuild_files))
Paul Eggert's avatar
Paul Eggert committed
601 602 603 604 605
    {
      static char const *const buildobj[] =
	{
	  #include "buildobj.h"
	};
606
      int i = ARRAYELTS (buildobj);
Paul Eggert's avatar
Paul Eggert committed
607 608 609 610
      while (0 <= --i)
	Vbuild_files = Fcons (build_string (buildobj[i]), Vbuild_files);
      Vbuild_files = Fpurecopy (Vbuild_files);
    }
611

612
  fd = emacs_open (name, O_RDONLY, 0);
Jim Blandy's avatar
Jim Blandy committed
613
  if (fd < 0)
614 615 616 617 618
    {
      int open_errno = errno;
      report_file_errno ("Opening doc string file", build_string (name),
			 open_errno);
    }
619
  record_unwind_protect_int (close_file_unwind, fd);
Jim Blandy's avatar
Jim Blandy committed
620 621 622 623 624
  Vdoc_file_name = filename;
  filled = 0;
  pos = 0;
  while (1)
    {
625
      register char *end;
Jim Blandy's avatar
Jim Blandy committed
626
      if (filled < 512)
627
	filled += emacs_read (fd, &buf[filled], sizeof buf - 1 - filled);
Jim Blandy's avatar
Jim Blandy committed
628 629 630 631 632
      if (!filled)
	break;

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

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

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

Richard M. Stallman's avatar
Richard M. Stallman committed
658
	  sym = oblookup (Vobarray, p + 2,
659 660
			  multibyte_chars_in_text ((unsigned char *) p + 2,
						   end - p - 2),
Richard M. Stallman's avatar
Richard M. Stallman committed
661
			  end - p - 2);
662 663 664 665
	  /* 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.  */
666
	  if (! skip_file && SYMBOLP (sym))
Jim Blandy's avatar
Jim Blandy committed
667 668 669 670 671 672 673
	    {
	      /* 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 `*').  */
674 675
                  if (!NILP (Fboundp (sym))
                      || !NILP (Fmemq (sym, delayed_init)))
Glenn Morris's avatar
Glenn Morris committed
676 677 678
                    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 699

  SAFE_FREE ();
700
  return unbind_to (count, Qnil);
Jim Blandy's avatar
Jim Blandy committed
701 702
}

Paul Eggert's avatar
Paul Eggert committed
703
DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
704 705
       Ssubstitute_command_keys, 1, 1, 0,
       doc: /* Substitute key descriptions for command names in STRING.
706 707 708 709 710 711 712 713 714 715 716
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
717 718
as the keymap for future \\=\\[COMMAND] substrings.
\\=\\= quotes the following character and is discarded;
719 720
thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.

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

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

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

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

752 753 754
  /* 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,
755
     or from a \\<mapname> construct in STRING itself..  */
756
  keymap = Voverriding_local_map;
Jim Blandy's avatar
Jim Blandy committed
757

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

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

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

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

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

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

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

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

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