doc.c 29.8 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-2020 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 <https://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"
37
#include "intervals.h"
Stefan Monnier's avatar
Stefan Monnier committed
38
#include "keymap.h"
Jim Blandy's avatar
Jim Blandy committed
39

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

44 45
static unsigned char *read_bytecode_pointer;

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

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

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

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

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

74
   If UNIBYTE, always make a unibyte string.
75

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

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

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

Tom Tromey's avatar
Tom Tromey committed
105
  position = eabs (XFIXNUM (pos));
106

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);
Paul Eggert's avatar
Paul Eggert committed
118 119 120
  Lisp_Object docdir
    = NILP (tem) ? ENCODE_FILE (Vdoc_directory) : empty_unibyte_string;
  ptrdiff_t docdir_sizemax = SBYTES (docdir) + 1;
Daniel Colascione's avatar
Daniel Colascione committed
121 122
  if (will_dump_p ())
    docdir_sizemax = max (docdir_sizemax, sizeof sibling_etc);
Paul Eggert's avatar
Paul Eggert committed
123 124
  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
    {
Daniel Colascione's avatar
Daniel Colascione committed
129
      if (will_dump_p ())
130 131
	{
	  /* Preparing to dump; DOC file is probably not installed.
132
	     So check in ../etc.  */
Paul Eggert's avatar
Paul Eggert committed
133
	  lispstpcpy (stpcpy (name, sibling_etc), file);
134

135
	  fd = emacs_open (name, O_RDONLY, 0);
136 137
	}
      if (fd < 0)
138
	{
139
	  if (errno != ENOENT && errno != ENOTDIR)
140 141
	    report_file_error ("Read error on documentation file", file);

142
	  SAFE_FREE ();
143 144 145
	  AUTO_STRING (cannot_open, "Cannot open doc string file \"");
	  AUTO_STRING (quote_nl, "\"\n");
	  return concat3 (cannot_open, file, quote_nl);
146
	}
147
    }
148
  record_unwind_protect_int (close_file_unwind, fd);
149

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

159 160
  /* Read the doc string into get_doc_string_buffer.
     P points beyond the data just read.  */
161

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

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

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

205 206 207 208
  /* Sanity checking.  */
  if (CONSP (filepos))
    {
      int test = 1;
209 210 211 212 213 214 215 216 217 218 219 220 221 222
      /* 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;
	}
223 224 225 226 227 228 229 230 231 232 233 234
    }
  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;
    }

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

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

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

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

299
static bool
300
reread_doc_file (Lisp_Object file)
301 302 303 304
{
  if (NILP (file))
    Fsnarf_documentation (Vdoc_file_name);
  else
305
    save_match_data_load (file, Qt, Qt, Qt, Qnil);
306 307

  return 1;
308 309
}

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

 documentation:
Jim Blandy's avatar
Jim Blandy committed
322

323
  doc = Qnil;
324

Juanma Barranquero's avatar
Juanma Barranquero committed
325 326 327 328 329 330 331 332
  if (SYMBOLP (function))
    {
      Lisp_Object tem = Fget (function, Qfunction_documentation);
      if (!NILP (tem))
	return Fdocumentation_property (function, Qfunction_documentation,
					raw);
    }

333
  fun = Findirect_function (function, Qnil);
334 335
  if (NILP (fun))
    xsignal1 (Qvoid_function, function);
336 337
  if (CONSP (fun) && EQ (XCAR (fun), Qmacro))
    fun = XCDR (fun);
338
  if (SUBRP (fun))
339
    doc = make_fixnum (XSUBR (fun)->doc);
340
#ifdef HAVE_MODULES
341
  else if (MODULE_FUNCTIONP (fun))
342 343
    doc = module_function_documentation (XMODULE_FUNCTION (fun));
#endif
344 345
  else if (COMPILEDP (fun))
    {
346
      if (PVSIZE (fun) <= COMPILED_DOC_STRING)
Jim Blandy's avatar
Jim Blandy committed
347
	return Qnil;
Roland McGrath's avatar
Roland McGrath committed
348
      else
349 350 351 352
	{
	  Lisp_Object tem = AREF (fun, COMPILED_DOC_STRING);
	  if (STRINGP (tem))
	    doc = tem;
353
	  else if (FIXNATP (tem) || CONSP (tem))
354 355 356 357
	    doc = tem;
	  else
	    return Qnil;
	}
358 359 360
    }
  else if (STRINGP (fun) || VECTORP (fun))
    {
Jim Blandy's avatar
Jim Blandy committed
361
      return build_string ("Keyboard macro.");
362 363 364
    }
  else if (CONSP (fun))
    {
365
      funcar = XCAR (fun);
366
      if (!SYMBOLP (funcar))
Kim F. Storm's avatar
Kim F. Storm committed
367
	xsignal1 (Qinvalid_function, fun);
Jim Blandy's avatar
Jim Blandy committed
368
      else if (EQ (funcar, Qkeymap))
369
	return build_string ("Prefix command (definition is a keymap associating keystrokes with commands).");
Jim Blandy's avatar
Jim Blandy committed
370
      else if (EQ (funcar, Qlambda)
371
	       || (EQ (funcar, Qclosure) && (fun = XCDR (fun), 1))
Jim Blandy's avatar
Jim Blandy committed
372
	       || EQ (funcar, Qautoload))
Jim Blandy's avatar
Jim Blandy committed
373
	{
374 375
	  Lisp_Object tem1 = Fcdr (Fcdr (fun));
	  Lisp_Object tem = Fcar (tem1);
376
	  if (STRINGP (tem))
Roland McGrath's avatar
Roland McGrath committed
377
	    doc = tem;
378 379
	  /* Handle a doc reference--but these never come last
	     in the function body, so reject them if they are last.  */
380
	  else if ((FIXNATP (tem) || (CONSP (tem) && FIXNUMP (XCDR (tem))))
381 382
		   && !NILP (XCDR (tem1)))
	    doc = tem;
Roland McGrath's avatar
Roland McGrath committed
383 384
	  else
	    return Qnil;
Jim Blandy's avatar
Jim Blandy committed
385
	}
386 387 388 389 390 391
      else
	goto oops;
    }
  else
    {
    oops:
Kim F. Storm's avatar
Kim F. Storm committed
392
      xsignal1 (Qinvalid_function, fun);
Jim Blandy's avatar
Jim Blandy committed
393
    }
Roland McGrath's avatar
Roland McGrath committed
394

395 396
  /* If DOC is 0, it's typically because of a dumped file missing
     from the DOC file (bug in src/Makefile.in).  */
397
  if (EQ (doc, make_fixnum (0)))
398
    doc = Qnil;
399
  if (FIXNUMP (doc) || CONSP (doc))
400 401 402
    {
      Lisp_Object tem;
      tem = get_doc_string (doc, 0, 0);
403
      if (NILP (tem) && try_reload)
404 405
	{
	  /* The file is newer, we need to reset the pointers.  */
406 407 408 409 410 411
	  try_reload = reread_doc_file (Fcar_safe (doc));
	  if (try_reload)
	    {
	      try_reload = 0;
	      goto documentation;
	    }
412 413 414 415
	}
      else
	doc = tem;
    }
416

Jim Blandy's avatar
Jim Blandy committed
417
  if (NILP (raw))
418
    doc = Fsubstitute_command_keys (doc);
Roland McGrath's avatar
Roland McGrath committed
419
  return doc;
Jim Blandy's avatar
Jim Blandy committed
420 421
}

422 423
DEFUN ("documentation-property", Fdocumentation_property,
       Sdocumentation_property, 2, 3, 0,
424 425 426 427 428 429 430
       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
431
  (Lisp_Object symbol, Lisp_Object prop, Lisp_Object raw)
Jim Blandy's avatar
Jim Blandy committed
432
{
433
  bool try_reload = 1;
434
  Lisp_Object tem;
Jim Blandy's avatar
Jim Blandy committed
435

436
 documentation_property:
437

438
  tem = Fget (symbol, prop);
439

440 441 442 443 444
  /* If we don't have any documentation for this symbol (and we're asking for
     the variable documentation), try to see whether it's an indirect variable
     and get the documentation from there instead. */
  if (EQ (prop, Qvariable_documentation)
      && NILP (tem))
445 446 447 448 449 450
    {
      Lisp_Object indirect = Findirect_variable (symbol);
      if (!NILP (indirect))
	tem = Fget (indirect, prop);
    }

451
  if (EQ (tem, make_fixnum (0)))
452
    tem = Qnil;
453 454

  /* See if we want to look for the string in the DOC file. */
455
  if (FIXNUMP (tem) || (CONSP (tem) && FIXNUMP (XCDR (tem))))
456 457 458
    {
      Lisp_Object doc = tem;
      tem = get_doc_string (tem, 0, 0);
459
      if (NILP (tem) && try_reload)
460 461
	{
	  /* The file is newer, we need to reset the pointers.  */
462 463 464 465 466 467
	  try_reload = reread_doc_file (Fcar_safe (doc));
	  if (try_reload)
	    {
	      try_reload = 0;
	      goto documentation_property;
	    }
468 469
	}
    }
470 471
  else if (!STRINGP (tem))
    /* Feval protects its argument.  */
472
    tem = Feval (tem, Qnil);
473

474
  if (NILP (raw) && STRINGP (tem))
475
    tem = Fsubstitute_command_keys (tem);
476
  return tem;
Jim Blandy's avatar
Jim Blandy committed
477 478
}

479 480 481
/* Scanning the DOC files and placing docstring offsets into functions.  */

static void
482
store_function_docstring (Lisp_Object obj, EMACS_INT offset)
483
{
484 485
  /* Don't use indirect_function here, or defaliases will apply their
     docstrings to the base functions (Bug#2603).  */
486
  Lisp_Object fun = SYMBOLP (obj) ? XSYMBOL (obj)->u.s.function : obj;
487 488 489 490

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

  /* If it's a lisp form, stick it in the form.  */
491 492 493
  if (CONSP (fun) && EQ (XCAR (fun), Qmacro))
    fun = XCDR (fun);
  if (CONSP (fun))
494 495 496
    {
      Lisp_Object tem;

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

  /* Lisp_Subrs have a slot for it.  */
  else if (SUBRP (fun))
511
    XSUBR (fun)->doc = offset;
512 513

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


Jim Blandy's avatar
Jim Blandy committed
532
DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
533
       1, 1, 0,
534 535 536 537 538 539
       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,
540
the same file name is found in the `doc-directory'.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
541
  (Lisp_Object filename)
Jim Blandy's avatar
Jim Blandy committed
542 543 544
{
  int fd;
  char buf[1024 + 1];
545 546
  int filled;
  EMACS_INT pos;
547
  Lisp_Object sym;
548
  char *p, *name;
549
  ptrdiff_t count;
550 551
  char const *dirname;
  ptrdiff_t dirlen;
552
  /* Preloaded defcustoms using custom-initialize-delay are added to
553
     this list, but kept unbound.  See https://debbugs.gnu.org/11565  */
554 555 556 557
  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
558

559
  CHECK_STRING (filename);
Jim Blandy's avatar
Jim Blandy committed
560

Daniel Colascione's avatar
Daniel Colascione committed
561
  if (will_dump_p ())
562
    {
563 564
      dirname = sibling_etc;
      dirlen = sizeof sibling_etc - 1;
565 566 567 568
    }
  else
    {
      CHECK_STRING (Vdoc_directory);
569 570
      dirname = SSDATA (Vdoc_directory);
      dirlen = SBYTES (Vdoc_directory);
571
    }
572 573 574 575

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

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

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

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

617 618 619 620 621 622 623 624 625 626
	  /* We used to skip files not in build_files, so that when a
	     function was defined several times in different files
	     (typically, once in xterm, once in w32term, ...), we only
	     paid attention to the relevant one.

	     But this meant the doc had to be kept and updated in
	     multiple files.  Nowadays we keep the doc only in eg xterm.
	     The (f)boundp checks below ensure we don't report
	     docs for eg w32-specific items on X.
	  */
627

Richard M. Stallman's avatar
Richard M. Stallman committed
628
	  sym = oblookup (Vobarray, p + 2,
629 630
			  multibyte_chars_in_text ((unsigned char *) p + 2,
						   end - p - 2),
Richard M. Stallman's avatar
Richard M. Stallman committed
631
			  end - p - 2);
632 633 634
          /* Ignore docs that start with SKIP.  These mark
             placeholders where the real doc is elsewhere.  */
	  if (SYMBOLP (sym))
Jim Blandy's avatar
Jim Blandy committed
635 636 637 638 639 640 641
	    {
	      /* 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 `*').  */
642
                  if ((!NILP (Fboundp (sym))
643
                      || !NILP (Fmemq (sym, delayed_init)))
644
                      && strncmp (end, "\nSKIP", 5))
Glenn Morris's avatar
Glenn Morris committed
645
                    Fput (sym, Qvariable_documentation,
646
                          make_fixnum ((pos + end + 1 - buf)
Glenn Morris's avatar
Glenn Morris committed
647
                                       * (end[1] == '*' ? -1 : 1)));
Jim Blandy's avatar
Jim Blandy committed
648 649
		}

650
	      /* Attach a docstring to a function?  */
Jim Blandy's avatar
Jim Blandy committed
651
	      else if (p[1] == 'F')
Glenn Morris's avatar
Glenn Morris committed
652
                {
653
                  if (!NILP (Ffboundp (sym)) && strncmp (end, "\nSKIP", 5))
Glenn Morris's avatar
Glenn Morris committed
654 655
                    store_function_docstring (sym, pos + end + 1 - buf);
                }
Kenichi Handa's avatar
Kenichi Handa committed
656 657 658
	      else if (p[1] == 'S')
		; /* Just a source file name boundary marker.  Ignore it.  */

659
	      else
660
		error ("DOC file invalid at position %"pI"d", pos);
Jim Blandy's avatar
Jim Blandy committed
661 662 663 664
	    }
	}
      pos += end - buf;
      filled -= end - buf;
665
      memmove (buf, end, filled);
Jim Blandy's avatar
Jim Blandy committed
666
    }
667

Paul Eggert's avatar
Paul Eggert committed
668
  return SAFE_FREE_UNBIND_TO (count, Qnil);
Jim Blandy's avatar
Jim Blandy committed
669 670
}

671
/* Return true if text quoting style should default to quote `like this'.  */
672 673 674 675 676 677 678 679 680 681
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
682
	  && EQ (AREF (dv, 0), make_fixnum ('`')));
683 684
}

685 686 687 688
/* Return the current effective text quoting style.  */
enum text_quoting_style
text_quoting_style (void)
{
689
  if (NILP (Vtext_quoting_style)
690 691
      ? default_to_grave_quoting_style ()
      : EQ (Vtext_quoting_style, Qgrave))
692 693 694
    return GRAVE_QUOTING_STYLE;
  else if (EQ (Vtext_quoting_style, Qstraight))
    return STRAIGHT_QUOTING_STYLE;
695 696
  else
    return CURVE_QUOTING_STYLE;
697 698
}

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
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
709
\(used by the helper function `help-make-xrefs' to find the end of the
710 711 712
summary).

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

Paul Eggert's avatar
Paul Eggert committed
715
Each grave accent \\=` is replaced by left quote, and each apostrophe \\='
716
is replaced by right quote.  Left and right quote characters are
717
specified by `text-quoting-style'.
718

Paul Eggert's avatar
Paul Eggert committed
719 720 721
\\=\\= quotes the following character and is discarded; thus, \\=\\=\\=\\= puts \\=\\=
into the output, \\=\\=\\=\\[ puts \\=\\[ into the output, and \\=\\=\\=` puts \\=` into the
output.
722

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

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

744 745 746 747 748
  /* If STRING contains non-ASCII unibyte data, process its
     properly-encoded multibyte equivalent instead.  This simplifies
     the implementation and is OK since substitute-command-keys is
     intended for use only on text strings.  Keep STRING around, since
     it will be returned if no changes occur.  */
749
  Lisp_Object str = Fstring_make_multibyte (string);
Jim Blandy's avatar
Jim Blandy committed
750

751
  enum text_quoting_style quoting_style = text_quoting_style ();
752

Richard M. Stallman's avatar
Richard M. Stallman committed
753 754
  nchars = 0;

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

761 762
  ptrdiff_t strbytes = SBYTES (str);
  bsize = strbytes;
763

764 765
  /* Fixed-size stack buffer.  */
  char sbuf[MAX_ALLOCA];
766

767 768
  /* Heap-allocated buffer, if any.  */
  char *abuf;
Jim Blandy's avatar
Jim Blandy committed
769

770 771 772
  /* Extra room for expansion due to replacing ‘\[]’ with ‘M-x ’.  */
  enum { EXTRA_ROOM = sizeof "M-x " - sizeof "\\[]" };

773 774
  ptrdiff_t count = SPECPDL_INDEX ();

775
  if (bsize <= sizeof sbuf - EXTRA_ROOM)
Jim Blandy's avatar
Jim Blandy committed
776
    {
777 778 779 780 781
      abuf = NULL;
      buf = sbuf;
      bsize = sizeof sbuf;
    }
  else
782 783 784 785
    {
      buf = abuf = xpalloc (NULL, &bsize, EXTRA_ROOM, STRING_BYTES_BOUND, 1);
      record_unwind_protect_ptr (xfree, abuf);
    }
786 787 788 789 790 791 792 793 794
  bufp = buf;

  strp = SDATA (str);
  while (strp < SDATA (str) + strbytes)
    {
      unsigned char *close_bracket;

      if (strp[0] == '\\' && strp[1] == '='
	  && strp + 2 < SDATA (str) + strbytes)
Jim Blandy's avatar
Jim Blandy committed
795 796 797
	{
	  /* \= quotes the next character;
	     thus, to put in \[ without its special meaning, use \=\[.  */
798
	  changed = nonquotes_changed = true;
Richard M. Stallman's avatar
Richard M. Stallman committed
799
	  strp += 2;
800
	  /* Fall through to copy one char.  */
Jim Blandy's avatar
Jim Blandy committed
801
	}
802 803 804 805
      else if (strp[0] == '\\' && strp[1] == '['
	       && (close_bracket
		   = memchr (strp + 2, ']',
			     SDATA (str) + strbytes - (strp + 2))))
Jim Blandy's avatar
Jim Blandy committed
806
	{
807
	  bool follow_remap = 1;
808

809 810 811
	  start = strp + 2;
	  length_byte = close_bracket - start;
	  idx = close_bracket + 1 - SDATA (str);
Jim Blandy's avatar
Jim Blandy committed
812

813
	  name = Fintern (make_string ((char *) start, length_byte), Qnil);
814

815
	do_remap:
816
	  tem = Fwhere_is_internal (name, keymap, Qt, Qnil, Qnil);
817

818
	  if (VECTORP (tem) && ASIZE (tem) > 1
819 820 821 822 823 824 825 826
	      && EQ (AREF (tem, 0), Qremap) && SYMBOLP (AREF (tem, 1))
	      && follow_remap)
	    {
	      name = AREF (tem, 1);
	      follow_remap = 0;
	      goto do_remap;
	    }

827 828
	  /* Fwhere_is_internal can GC, so take relocation of string
	     contents into account.  */
829 830
	  strp = SDATA (str) + idx;
	  start = strp - length_byte - 1;
Jim Blandy's avatar
Jim Blandy committed
831

Jim Blandy's avatar
Jim Blandy committed
832
	  if (NILP (tem))	/* but not on any keys */
Jim Blandy's avatar
Jim Blandy committed
833
	    {
834
	      memcpy (bufp, "M-x ", 4);
Jim Blandy's avatar
Jim Blandy committed
835
	      bufp += 4;
Richard M. Stallman's avatar
Richard M. Stallman committed
836
	      nchars += 4;
837
	      length = multibyte_chars_in_text (start, length_byte);
Jim Blandy's avatar
Jim Blandy committed
838 839 840 841
	      goto subst;
	    }
	  else
	    {			/* function is on a key */
842
	      tem = Fkey_description (tem, Qnil);
Jim Blandy's avatar
Jim Blandy committed
843 844 845 846 847
	      goto subst_string;
	    }
	}
      /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
	 \<foo> just sets the keymap used for \[cmd].  */
848 849 850 851
      else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<')
	       && (close_bracket
		   = memchr (strp + 2, strp[1] == '{' ? '}' : '>',
			     SDATA (str) + strbytes - (strp + 2))))
Jim Blandy's avatar
Jim Blandy committed
852
	{
853
	 {
854
	  bool generate_summary = strp[1] == '{';
855
	  /* This is for computing the SHADOWS arg for describe_map_tree.  */
856
	  Lisp_Object active_maps = Fcurrent_active_maps (Qnil, Qnil);
857
	  ptrdiff_t count = SPECPDL_INDEX ();
Jim Blandy's avatar
Jim Blandy committed
858