doc.c 26.1 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-2012 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 <sys/types.h>
Dan Nicolaescu's avatar
Dan Nicolaescu committed
24
#include <sys/file.h>	/* Must be after sys/types.h for USG*/
25
#include <setjmp.h>
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;

Stefan Monnier's avatar
Stefan Monnier committed
40
extern Lisp_Object Qclosure;
41 42
/* Buffer used for reading from documentation file.  */
static char *get_doc_string_buffer;
43
static ptrdiff_t get_doc_string_buffer_size;
44

45 46 47 48 49 50
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
51
read_bytecode_char (bool unreadflag)
52 53 54 55 56 57 58 59 60
{
  if (unreadflag)
    {
      read_bytecode_pointer--;
      return 0;
    }
  return *read_bytecode_pointer++;
}

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

69 70 71 72
   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.

73
   If UNIBYTE, always make a unibyte string.
74

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

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

91 92 93 94 95 96 97
  if (INTEGERP (filepos))
    {
      file = Vdoc_file_name;
      position = XINT (filepos);
    }
  else if (CONSP (filepos))
    {
98 99
      file = XCAR (filepos);
      position = XINT (XCDR (filepos));
100 101
    }
  else
102 103
    return Qnil;

104 105 106
  if (position < 0)
    position = - position;

107 108 109 110 111
  if (!STRINGP (Vdoc_directory))
    return Qnil;

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

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

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

145
	  fd = emacs_open (name, O_RDONLY, 0);
146 147 148 149 150 151
	}
#endif
      if (fd < 0)
	error ("Cannot open doc string file \"%s\"", name);
    }

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

164 165
  SAFE_FREE ();

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

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

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

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

215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238
  /* 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;
    }

239 240
  /* Scan the text and perform quoting with ^A (char code 1).
     ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_.  */
241 242
  from = get_doc_string_buffer + offset;
  to = get_doc_string_buffer + offset;
243 244 245 246 247 248 249 250 251 252 253 254 255 256 257
  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
258 259 260
	    {
	      unsigned char uc = c;
	      error ("\
261
Invalid data in documentation file -- %c followed by code %03o",
262 263
		     1, uc);
	    }
264 265 266 267 268
	}
      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
      read_bytecode_pointer = (unsigned char *) get_doc_string_buffer + offset;
274
      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
      /* The data determines whether the string is multibyte.  */
283
      ptrdiff_t nchars =
284 285 286
	multibyte_chars_in_text (((unsigned char *) get_doc_string_buffer
				  + offset),
				 to - (get_doc_string_buffer + offset));
287 288 289 290
      return make_string_from_bytes (get_doc_string_buffer + offset,
				     nchars,
				     to - (get_doc_string_buffer + offset));
    }
291 292 293 294 295 296 297
}

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

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

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

  return 1;
325 326
}

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

 documentation:
Jim Blandy's avatar
Jim Blandy committed
339

340
  doc = Qnil;
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

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

415 416 417 418 419 420 421 422 423 424 425 426
  /* Check for an advised function.  Its doc string
     has an `ad-advice-info' text property.  */
  if (STRINGP (doc))
    {
      Lisp_Object innerfunc;
      innerfunc = Fget_text_property (make_number (0),
				      intern ("ad-advice-info"),
				      doc);
      if (! NILP (innerfunc))
	doc = call1 (intern ("ad-make-advised-docstring"), innerfunc);
    }

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

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

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

471
 documentation_property:
472

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

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

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

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

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

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

526
      tem = XCAR (fun);
527 528
      if (EQ (tem, Qlambda) || EQ (tem, Qautoload)
	  || (EQ (tem, Qclosure) && (fun = XCDR (fun), 1)))
529 530
	{
	  tem = Fcdr (Fcdr (fun));
531
	  if (CONSP (tem) && INTEGERP (XCAR (tem)))
532
	    XSETCAR (tem, make_number (offset));
533 534
	}
      else if (EQ (tem, Qmacro))
535
	store_function_docstring (XCDR (fun), offset);
536 537 538
    }

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

548
static const char buildobj[] = BUILDOBJ;
549

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

569
  CHECK_STRING (filename);
Jim Blandy's avatar
Jim Blandy committed
570

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

589 590 591
  /* Vbuild_files is nil when temacs is run, and non-nil after that.  */
  if (NILP (Vbuild_files))
  {
592
    const char *beg, *end;
593

594
    for (beg = buildobj; *beg; beg = end)
595
      {
596
        ptrdiff_t len;
597

598
        while (*beg && c_isspace (*beg)) ++beg;
599

600
        for (end = beg; *end && ! c_isspace (*end); ++end)
601 602 603 604 605 606 607 608 609
          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);
      }
610
    Vbuild_files = Fpurecopy (Vbuild_files);
611 612
  }

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

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

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

                  skip_file = NILP (Fmember (build_string (fromfile),
                                             Vbuild_files));
                }
654 655
            }

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

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

687
	      else
688
		error ("DOC file invalid at position %"pI"d", pos);
Jim Blandy's avatar
Jim Blandy committed
689 690 691 692
	    }
	}
      pos += end - buf;
      filled -= end - buf;
693
      memmove (buf, end, filled);
Jim Blandy's avatar
Jim Blandy committed
694
    }
695
  emacs_close (fd);
Jim Blandy's avatar
Jim Blandy committed
696 697 698
  return Qnil;
}

Paul Eggert's avatar
Paul Eggert committed
699
DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
700 701
       Ssubstitute_command_keys, 1, 1, 0,
       doc: /* Substitute key descriptions for command names in STRING.
702 703 704 705 706 707 708 709 710 711 712
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
713 714
as the keymap for future \\=\\[COMMAND] substrings.
\\=\\= quotes the following character and is discarded;
715 716
thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.

717 718
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
719
  (Lisp_Object string)
Jim Blandy's avatar
Jim Blandy committed
720
{
721
  char *buf;
722 723 724
  bool changed = 0;
  unsigned char *strp;
  char *bufp;
725 726
  ptrdiff_t idx;
  ptrdiff_t bsize;
Jim Blandy's avatar
Jim Blandy committed
727
  Lisp_Object tem;
Jim Blandy's avatar
Jim Blandy committed
728 729
  Lisp_Object keymap;
  unsigned char *start;
730
  ptrdiff_t length, length_byte;
Jim Blandy's avatar
Jim Blandy committed
731 732
  Lisp_Object name;
  struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
733
  bool multibyte;
734
  ptrdiff_t nchars;
Jim Blandy's avatar
Jim Blandy committed
735

736
  if (NILP (string))
Jim Blandy's avatar
Jim Blandy committed
737 738
    return Qnil;

739
  CHECK_STRING (string);
Jim Blandy's avatar
Jim Blandy committed
740 741 742
  tem = Qnil;
  keymap = Qnil;
  name = Qnil;
743
  GCPRO4 (string, tem, keymap, name);
Jim Blandy's avatar
Jim Blandy committed
744

Richard M. Stallman's avatar
Richard M. Stallman committed
745 746 747
  multibyte = STRING_MULTIBYTE (string);
  nchars = 0;

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

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

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

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

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

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

Jim Blandy's avatar
Jim Blandy committed
800 801 802
	  strp++;		/* skip ] */

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

806
	do_remap:
807
	  tem = Fwhere_is_internal (name, keymap, Qt, Qnil, Qnil);
808

809
	  if (VECTORP (tem) && ASIZE (tem) > 1
810 811 812 813 814 815 816 817
	      && EQ (AREF (tem, 0), Qremap) && SYMBOLP (AREF (tem, 1))
	      && follow_remap)
	    {
	      name = AREF (tem, 1);
	      follow_remap = 0;
	      goto do_remap;
	    }

818 819
	  /* Note the Fwhere_is_internal can GC, so we have to take
	     relocation of string contents into account.  */
820 821
	  strp = SDATA (string) + idx;
	  start = SDATA (string) + start_idx;
Jim Blandy's avatar
Jim Blandy committed
822

Jim Blandy's avatar
Jim Blandy committed
823
	  if (NILP (tem))	/* but not on any keys */
Jim Blandy's avatar
Jim Blandy committed
824
	    {
825 826 827
	      ptrdiff_t offset = bufp - buf;
	      if (STRING_BYTES_BOUND - 4 < bsize)
		string_overflow ();