doc.c 29.1 KB
Newer Older
1
/* Record indices of function doc strings stored in a file. -*- coding: utf-8 -*-
Glenn Morris's avatar
Glenn Morris committed
2

Paul Eggert's avatar
Paul Eggert committed
3
Copyright (C) 1985-1986, 1993-1995, 1997-2016 Free Software Foundation,
Paul Eggert's avatar
Paul Eggert committed
4
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 <errno.h>
Jim Blandy's avatar
Jim Blandy committed
25
#include <sys/types.h>
26
#include <sys/file.h>	/* Must be after sys/types.h for USG.  */
Jim Blandy's avatar
Jim Blandy committed
27
#include <fcntl.h>
28 29
#include <unistd.h>

30 31
#include <c-ctype.h>

Jim Blandy's avatar
Jim Blandy committed
32
#include "lisp.h"
33
#include "character.h"
34
#include "coding.h"
Jim Blandy's avatar
Jim Blandy committed
35
#include "buffer.h"
36
#include "disptab.h"
Stefan Monnier's avatar
Stefan Monnier committed
37
#include "keymap.h"
Jim Blandy's avatar
Jim Blandy committed
38

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;

Paul Eggert's avatar
Paul Eggert committed
45 46
static char const sibling_etc[] = "../etc/";

47
/* `readchar' in lread.c calls back here to fetch the next byte.
48 49 50
   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
/* Extract a doc string from a file.  FILEPOS says where to get it.
62
   If it is an integer, use that position in the standard DOC file.
63
   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
  int offset;
  EMACS_INT position;
Paul Eggert's avatar
Paul Eggert committed
87
  Lisp_Object file, tem, pos;
88
  ptrdiff_t count;
89
  USE_SAFE_ALLOCA;
90

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

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

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

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

112 113 114 115
  /* 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);
116
  file = ENCODE_FILE (file);
Paul Eggert's avatar
Paul Eggert committed
117 118 119 120 121 122 123 124
  Lisp_Object docdir
    = NILP (tem) ? ENCODE_FILE (Vdoc_directory) : empty_unibyte_string;
  ptrdiff_t docdir_sizemax = SBYTES (docdir) + 1;
#ifndef CANNOT_DUMP
  docdir_sizemax = max (docdir_sizemax, sizeof sibling_etc);
#endif
  name = SAFE_ALLOCA (docdir_sizemax + SBYTES (file));
  lispstpcpy (lispstpcpy (name, docdir), file);
Jim Blandy's avatar
Jim Blandy committed
125

126
  fd = emacs_open (name, O_RDONLY, 0);
Jim Blandy's avatar
Jim Blandy committed
127
  if (fd < 0)
128 129 130 131 132
    {
#ifndef CANNOT_DUMP
      if (!NILP (Vpurify_flag))
	{
	  /* Preparing to dump; DOC file is probably not installed.
133
	     So check in ../etc.  */
Paul Eggert's avatar
Paul Eggert committed
134
	  lispstpcpy (stpcpy (name, sibling_etc), file);
135

136
	  fd = emacs_open (name, O_RDONLY, 0);
137 138 139
	}
#endif
      if (fd < 0)
140
	{
141 142 143
	  if (errno == EMFILE || errno == ENFILE)
	    report_file_error ("Read error on documentation file", file);

144
	  SAFE_FREE ();
145 146 147
	  AUTO_STRING (cannot_open, "Cannot open doc string file \"");
	  AUTO_STRING (quote_nl, "\"\n");
	  return concat3 (cannot_open, file, quote_nl);
148
	}
149
    }
150 151
  count = SPECPDL_INDEX ();
  record_unwind_protect_int (close_file_unwind, fd);
152

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

162 163
  /* Read the doc string into get_doc_string_buffer.
     P points beyond the data just read.  */
164

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

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

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

209 210 211 212
  /* Sanity checking.  */
  if (CONSP (filepos))
    {
      int test = 1;
213 214 215 216 217 218 219 220 221 222 223 224 225 226
      /* 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;
	}
227 228 229 230 231 232 233 234 235 236 237 238
    }
  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 284 285 286
      ptrdiff_t nchars
	= 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 307 308 309
{
  if (NILP (file))
    Fsnarf_documentation (Vdoc_file_name);
  else
    Fload (file, Qt, Qt, Qt, Qnil);
310 311

  return 1;
312 313
}

Roland McGrath's avatar
Roland McGrath committed
314
DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0,
315 316 317
       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
318
  (Lisp_Object function, Lisp_Object raw)
Jim Blandy's avatar
Jim Blandy committed
319 320 321
{
  Lisp_Object fun;
  Lisp_Object funcar;
322
  Lisp_Object doc;
323
  bool try_reload = 1;
324 325

 documentation:
Jim Blandy's avatar
Jim Blandy committed
326

327
  doc = Qnil;
328

Juanma Barranquero's avatar
Juanma Barranquero committed
329 330 331 332 333 334 335 336
  if (SYMBOLP (function))
    {
      Lisp_Object tem = Fget (function, Qfunction_documentation);
      if (!NILP (tem))
	return Fdocumentation_property (function, Qfunction_documentation,
					raw);
    }

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

402 403
  /* If DOC is 0, it's typically because of a dumped file missing
     from the DOC file (bug in src/Makefile.in).  */
404 405
  if (EQ (doc, make_number (0)))
    doc = Qnil;
406
  if (INTEGERP (doc) || CONSP (doc))
407 408 409
    {
      Lisp_Object tem;
      tem = get_doc_string (doc, 0, 0);
410
      if (NILP (tem) && try_reload)
411 412
	{
	  /* The file is newer, we need to reset the pointers.  */
413 414 415 416 417 418
	  try_reload = reread_doc_file (Fcar_safe (doc));
	  if (try_reload)
	    {
	      try_reload = 0;
	      goto documentation;
	    }
419 420 421 422
	}
      else
	doc = tem;
    }
423

Jim Blandy's avatar
Jim Blandy committed
424
  if (NILP (raw))
425
    doc = Fsubstitute_command_keys (doc);
Roland McGrath's avatar
Roland McGrath committed
426
  return doc;
Jim Blandy's avatar
Jim Blandy committed
427 428
}

429 430
DEFUN ("documentation-property", Fdocumentation_property,
       Sdocumentation_property, 2, 3, 0,
431 432 433 434 435 436 437
       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
438
  (Lisp_Object symbol, Lisp_Object prop, Lisp_Object raw)
Jim Blandy's avatar
Jim Blandy committed
439
{
440
  bool try_reload = 1;
441
  Lisp_Object tem;
Jim Blandy's avatar
Jim Blandy committed
442

443
 documentation_property:
444

445
  tem = Fget (symbol, prop);
446
  if (EQ (tem, make_number (0)))
447
    tem = Qnil;
448
  if (INTEGERP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
449 450 451
    {
      Lisp_Object doc = tem;
      tem = get_doc_string (tem, 0, 0);
452
      if (NILP (tem) && try_reload)
453 454
	{
	  /* The file is newer, we need to reset the pointers.  */
455 456 457 458 459 460
	  try_reload = reread_doc_file (Fcar_safe (doc));
	  if (try_reload)
	    {
	      try_reload = 0;
	      goto documentation_property;
	    }
461 462
	}
    }
463 464
  else if (!STRINGP (tem))
    /* Feval protects its argument.  */
465
    tem = Feval (tem, Qnil);
466

467
  if (NILP (raw) && STRINGP (tem))
468
    tem = Fsubstitute_command_keys (tem);
469
  return tem;
Jim Blandy's avatar
Jim Blandy committed
470 471
}

472 473 474
/* Scanning the DOC files and placing docstring offsets into functions.  */

static void
Paul Eggert's avatar
Paul Eggert committed
475
store_function_docstring (Lisp_Object obj, ptrdiff_t offset)
476
{
477 478
  /* Don't use indirect_function here, or defaliases will apply their
     docstrings to the base functions (Bug#2603).  */
479
  Lisp_Object fun = SYMBOLP (obj) ? XSYMBOL (obj)->function : obj;
480 481 482 483

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

  /* Lisp_Subrs have a slot for it.  */
484
  if (SUBRP (fun))
485 486 487 488
    {
      intptr_t negative_offset = - offset;
      XSUBR (fun)->doc = (char *) negative_offset;
    }
489 490 491 492 493 494

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

495
      tem = XCAR (fun);
496 497
      if (EQ (tem, Qlambda) || EQ (tem, Qautoload)
	  || (EQ (tem, Qclosure) && (fun = XCDR (fun), 1)))
498 499
	{
	  tem = Fcdr (Fcdr (fun));
500
	  if (CONSP (tem) && INTEGERP (XCAR (tem)))
501 502
	    /* FIXME: This modifies typically pure hash-cons'd data, so its
	       correctness is quite delicate.  */
503
	    XSETCAR (tem, make_number (offset));
504 505
	}
      else if (EQ (tem, Qmacro))
506
	store_function_docstring (XCDR (fun), offset);
507 508 509
    }

  /* Bytecode objects sometimes have slots for it.  */
510
  else if (COMPILEDP (fun))
511 512 513
    {
      /* This bytecode object must have a slot for the
	 docstring, since we've found a docstring for it.  */
514
      if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
515
	ASET (fun, COMPILED_DOC_STRING, make_number (offset));
516
      else
517 518 519 520 521 522 523
	{
	  AUTO_STRING (format, "No docstring slot for %s");
	  CALLN (Fmessage, format,
		 (SYMBOLP (obj)
		  ? SYMBOL_NAME (obj)
		  : build_string ("<anonymous>")));
	}
524 525 526 527
    }
}


Jim Blandy's avatar
Jim Blandy committed
528
DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
529
       1, 1, 0,
530 531 532 533 534 535
       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,
536
the same file name is found in the `doc-directory'.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
537
  (Lisp_Object filename)
Jim Blandy's avatar
Jim Blandy committed
538 539 540
{
  int fd;
  char buf[1024 + 1];
541 542
  int filled;
  EMACS_INT pos;
543
  Lisp_Object sym;
544 545
  char *p, *name;
  bool skip_file = 0;
546
  ptrdiff_t count;
547 548
  char const *dirname;
  ptrdiff_t dirlen;
549 550 551 552 553 554
  /* 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
555

556
  CHECK_STRING (filename);
Jim Blandy's avatar
Jim Blandy committed
557

558
  if
Jim Blandy's avatar
Jim Blandy committed
559
#ifndef CANNOT_DUMP
560
    (!NILP (Vpurify_flag))
Jim Blandy's avatar
Jim Blandy committed
561
#else /* CANNOT_DUMP */
562
      (0)
Jim Blandy's avatar
Jim Blandy committed
563
#endif /* CANNOT_DUMP */
564
    {
565 566
      dirname = sibling_etc;
      dirlen = sizeof sibling_etc - 1;
567 568 569 570
    }
  else
    {
      CHECK_STRING (Vdoc_directory);
571 572
      dirname = SSDATA (Vdoc_directory);
      dirlen = SBYTES (Vdoc_directory);
573
    }
574 575 576 577

  count = SPECPDL_INDEX ();
  USE_SAFE_ALLOCA;
  name = SAFE_ALLOCA (dirlen + SBYTES (filename) + 1);
Paul Eggert's avatar
Paul Eggert committed
578
  lispstpcpy (stpcpy (name, dirname), filename); 	/*** Add this line ***/
Jim Blandy's avatar
Jim Blandy committed
579

580 581
  /* Vbuild_files is nil when temacs is run, and non-nil after that.  */
  if (NILP (Vbuild_files))
Paul Eggert's avatar
Paul Eggert committed
582 583 584 585 586
    {
      static char const *const buildobj[] =
	{
	  #include "buildobj.h"
	};
587
      int i = ARRAYELTS (buildobj);
Paul Eggert's avatar
Paul Eggert committed
588 589 590 591
      while (0 <= --i)
	Vbuild_files = Fcons (build_string (buildobj[i]), Vbuild_files);
      Vbuild_files = Fpurecopy (Vbuild_files);
    }
592

593
  fd = emacs_open (name, O_RDONLY, 0);
Jim Blandy's avatar
Jim Blandy committed
594
  if (fd < 0)
595 596 597 598 599
    {
      int open_errno = errno;
      report_file_errno ("Opening doc string file", build_string (name),
			 open_errno);
    }
600
  record_unwind_protect_int (close_file_unwind, fd);
Jim Blandy's avatar
Jim Blandy committed
601 602 603 604 605
  Vdoc_file_name = filename;
  filled = 0;
  pos = 0;
  while (1)
    {
606
      register char *end;
Jim Blandy's avatar
Jim Blandy committed
607
      if (filled < 512)
608
	filled += emacs_read (fd, &buf[filled], sizeof buf - 1 - filled);
Jim Blandy's avatar
Jim Blandy committed
609 610 611 612 613
      if (!filled)
	break;

      buf[filled] = 0;
      end = buf + (filled < 512 ? filled : filled - 128);
614
      p = memchr (buf, '\037', end - buf);
615
      /* p points to ^_Ffunctionname\n or ^_Vvarname\n or ^_Sfilename\n.  */
616
      if (p)
Jim Blandy's avatar
Jim Blandy committed
617
	{
618
	  end = strchr (p, '\n');
619 620

          /* See if this is a file name, and if it is a file in build-files.  */
621
          if (p[1] == 'S')
622
            {
623 624 625 626
              skip_file = 0;
              if (end - p > 4 && end[-2] == '.'
                  && (end[-1] == 'o' || end[-1] == 'c'))
                {
627
                  ptrdiff_t len = end - p - 2;
628
                  char *fromfile = SAFE_ALLOCA (len + 1);
629
                  memcpy (fromfile, &p[2], len);
630 631 632 633 634 635 636
                  fromfile[len] = 0;
                  if (fromfile[len-1] == 'c')
                    fromfile[len-1] = 'o';

                  skip_file = NILP (Fmember (build_string (fromfile),
                                             Vbuild_files));
                }
637 638
            }

Richard M. Stallman's avatar
Richard M. Stallman committed
639
	  sym = oblookup (Vobarray, p + 2,
640 641
			  multibyte_chars_in_text ((unsigned char *) p + 2,
						   end - p - 2),
Richard M. Stallman's avatar
Richard M. Stallman committed
642
			  end - p - 2);
643 644 645 646
	  /* 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.  */
647
	  if (! skip_file && SYMBOLP (sym))
Jim Blandy's avatar
Jim Blandy committed
648 649 650 651 652 653 654
	    {
	      /* 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 `*').  */
655 656
                  if (!NILP (Fboundp (sym))
                      || !NILP (Fmemq (sym, delayed_init)))
Glenn Morris's avatar
Glenn Morris committed
657 658 659
                    Fput (sym, Qvariable_documentation,
                          make_number ((pos + end + 1 - buf)
                                       * (end[1] == '*' ? -1 : 1)));
Jim Blandy's avatar
Jim Blandy committed
660 661
		}

662
	      /* Attach a docstring to a function?  */
Jim Blandy's avatar
Jim Blandy committed
663
	      else if (p[1] == 'F')
Glenn Morris's avatar
Glenn Morris committed
664 665 666 667
                {
                  if (!NILP (Ffboundp (sym)))
                    store_function_docstring (sym, pos + end + 1 - buf);
                }
Kenichi Handa's avatar
Kenichi Handa committed
668 669 670
	      else if (p[1] == 'S')
		; /* Just a source file name boundary marker.  Ignore it.  */

671
	      else
672
		error ("DOC file invalid at position %"pI"d", pos);
Jim Blandy's avatar
Jim Blandy committed
673 674 675 676
	    }
	}
      pos += end - buf;
      filled -= end - buf;
677
      memmove (buf, end, filled);
Jim Blandy's avatar
Jim Blandy committed
678
    }
679 680

  SAFE_FREE ();
681
  return unbind_to (count, Qnil);
Jim Blandy's avatar
Jim Blandy committed
682 683
}

684
/* Return true if text quoting style should default to quote `like this'.  */
685 686 687 688 689 690 691 692 693 694 695 696 697
static bool
default_to_grave_quoting_style (void)
{
  if (!text_quoting_flag)
    return true;
  if (! DISP_TABLE_P (Vstandard_display_table))
    return false;
  Lisp_Object dv = DISP_CHAR_VECTOR (XCHAR_TABLE (Vstandard_display_table),
				     LEFT_SINGLE_QUOTATION_MARK);
  return (VECTORP (dv) && ASIZE (dv) == 1
	  && EQ (AREF (dv, 0), make_number ('`')));
}

698 699 700 701
/* Return the current effective text quoting style.  */
enum text_quoting_style
text_quoting_style (void)
{
702 703 704
  if (NILP (Vtext_quoting_style)
      ? default_to_grave_quoting_style ()
      : EQ (Vtext_quoting_style, Qgrave))
705 706 707
    return GRAVE_QUOTING_STYLE;
  else if (EQ (Vtext_quoting_style, Qstraight))
    return STRAIGHT_QUOTING_STYLE;
708 709
  else
    return CURVE_QUOTING_STYLE;
710 711
}

Paul Eggert's avatar
Paul Eggert committed
712
DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
713 714
       Ssubstitute_command_keys, 1, 1, 0,
       doc: /* Substitute key descriptions for command names in STRING.
715 716 717 718 719 720 721
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
722
(used by the helper function `help-make-xrefs' to find the end of the
723 724 725
summary).

Each substring of the form \\=\\<MAPVAR> specifies the use of MAPVAR
726
as the keymap for future \\=\\[COMMAND] substrings.
727

728 729
Each \\=‘ and \\=` is replaced by left quote, and each \\=’ and \\='
is replaced by right quote.  Left and right quote characters are
730
specified by `text-quoting-style'.
731 732 733 734

\\=\\= quotes the following character and is discarded; thus,
\\=\\=\\=\\= puts \\=\\= into the output, \\=\\=\\=\\[ puts \\=\\[ into the output, and
\\=\\=\\=` puts \\=` into the output.
735

736
Return the original STRING if no substitutions are made.
737
Otherwise, return a new string.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
738
  (Lisp_Object string)
Jim Blandy's avatar
Jim Blandy committed
739
{
740
  char *buf;
741
  bool changed = false;
742 743
  unsigned char *strp;
  char *bufp;
744 745
  ptrdiff_t idx;
  ptrdiff_t bsize;
Jim Blandy's avatar
Jim Blandy committed
746
  Lisp_Object tem;
Jim Blandy's avatar
Jim Blandy committed
747
  Lisp_Object keymap;
748
  unsigned char const *start;
749
  ptrdiff_t length, length_byte;
Jim Blandy's avatar
Jim Blandy committed
750
  Lisp_Object name;
751
  bool multibyte;
752
  ptrdiff_t nchars;
Jim Blandy's avatar
Jim Blandy committed
753

754
  if (NILP (string))
Jim Blandy's avatar
Jim Blandy committed
755 756
    return Qnil;

757
  CHECK_STRING (string);
Jim Blandy's avatar
Jim Blandy committed
758 759 760
  tem = Qnil;
  keymap = Qnil;
  name = Qnil;
Jim Blandy's avatar
Jim Blandy committed
761

762
  enum text_quoting_style quoting_style = text_quoting_style ();
763

Richard M. Stallman's avatar
Richard M. Stallman committed
764 765 766
  multibyte = STRING_MULTIBYTE (string);
  nchars = 0;

767 768 769
  /* 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,
770
     or from a \\<mapname> construct in STRING itself..  */
771
  keymap = Voverriding_local_map;
Jim Blandy's avatar
Jim Blandy committed
772

773
  bsize = SBYTES (string);
774 775 776 777 778 779

  /* Add some room for expansion due to quote replacement.  */
  enum { EXTRA_ROOM = 20 };
  if (bsize <= STRING_BYTES_BOUND - EXTRA_ROOM)
    bsize += EXTRA_ROOM;

Dmitry Antipov's avatar
Dmitry Antipov committed
780
  bufp = buf = xmalloc (bsize);
Jim Blandy's avatar
Jim Blandy committed
781

782
  strp = SDATA (string);
783
  while (strp < SDATA (string) + SBYTES (string))
Jim Blandy's avatar
Jim Blandy committed
784 785 786 787 788
    {
      if (strp[0] == '\\' && strp[1] == '=')
	{
	  /* \= quotes the next character;
	     thus, to put in \[ without its special meaning, use \=\[.  */
789
	  changed = true;
Richard M. Stallman's avatar
Richard M. Stallman committed
790 791 792 793 794
	  strp += 2;
	  if (multibyte)
	    {
	      int len;

795
	      STRING_CHAR_AND_LENGTH (strp, len);
Richard M. Stallman's avatar
Richard M. Stallman committed
796 797 798
	      if (len == 1)
		*bufp = *strp;
	      else
799
		memcpy (bufp, strp, len);
Richard M. Stallman's avatar
Richard M. Stallman committed
800 801 802 803 804 805
	      strp += len;
	      bufp += len;
	      nchars++;
	    }
	  else
	    *bufp++ = *strp++, nchars++;
Jim Blandy's avatar
Jim Blandy committed
806 807 808
	}
      else if (strp[0] == '\\' && strp[1] == '[')
	{
809
	  ptrdiff_t start_idx;
810
	  bool follow_remap = 1;
811

Jim Blandy's avatar
Jim Blandy committed
812 813
	  strp += 2;		/* skip \[ */
	  start = strp;
814
	  start_idx = start - SDATA (string);
Jim Blandy's avatar
Jim Blandy committed
815

816
	  while ((strp - SDATA (string)
817
		  < SBYTES (string))
Jim Blandy's avatar
Jim Blandy committed
818 819
		 && *strp != ']')
	    strp++;
Richard M. Stallman's avatar
Richard M. Stallman committed
820 821
	  length_byte = strp - start;

Jim Blandy's avatar
Jim Blandy committed
822 823 824
	  strp++;		/* skip ] */

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

828
	do_remap:
829
	  tem = Fwhere_is_internal (name, keymap, Qt, Qnil, Qnil);
830

831
	  if (VECTORP (tem) && ASIZE (tem) > 1
832 833 834 835 836 837 838 839
	      && EQ (AREF (tem, 0), Qremap) && SYMBOLP (AREF (tem, 1))
	      && follow_remap)
	    {
	      name = AREF (tem, 1);
	      follow_remap = 0;
	      goto do_remap;
	    }

840 841
	  /* Note the Fwhere_is_internal can GC, so we have to take
	     relocation of string contents into account.  */
842 843
	  strp = SDATA (string) + idx;
	  start = SDATA (string) + start_idx;
Jim Blandy's avatar
Jim Blandy committed
844

Jim Blandy's avatar
Jim Blandy committed
845
	  if (NILP (tem))	/* but not on any keys */
Jim Blandy's avatar
Jim Blandy committed
846
	    {
847 848 849
	      ptrdiff_t offset = bufp - buf;
	      if (STRING_BYTES_BOUND - 4 < bsize)
		string_overflow ();
850
	      buf = xrealloc (buf, bsize += 4);
851
	      bufp = buf + offset;
852
	      memcpy (bufp, "M-x ", 4);
Jim Blandy's avatar
Jim Blandy committed
853
	      bufp += 4;
Richard M. Stallman's avatar
Richard M. Stallman committed
854 855 856 857 858
	      nchars += 4;
	      if (multibyte)
		length = multibyte_chars_in_text (start, length_byte);
	      else
		length = length_byte;
Jim Blandy's avatar
Jim Blandy committed
859 860 861 862
	      goto subst;
	    }
	  else
	    {			/* function is on a key */
863
	      tem = Fkey_description (tem, Qnil);
Jim Blandy's avatar
Jim Blandy committed
864 865 866 867 868 869 870 871
	      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;
872
	  ptrdiff_t start_idx;
873
	  /* This is for computing the SHADOWS arg for describe_map_tree.  */
874
	  Lisp_Object active_maps = Fcurrent_active_maps (Qnil, Qnil);
875
	  Lisp_Object earlier_maps;
876
	  ptrdiff_t count = SPECPDL_INDEX ();
Jim Blandy's avatar
Jim Blandy committed
877 878 879

	  strp += 2;		/* skip \{ or \< */
	  start = strp;
880
	  start_idx = start - SDATA (string);
Jim Blandy's avatar
Jim Blandy committed
881

Kenichi Handa's avatar
Kenichi Handa committed
882
	  while ((strp - SDATA (string) < SBYTES (string))
Jim Blandy's avatar
Jim Blandy committed
883 884
		 && *strp != '}' && *strp != '>')
	    strp++;
Richard M. Stallman's avatar
Richard M. Stallman committed
885 886

	  length_byte = strp - start;<