doc.c 25.6 KB
Newer Older
Jim Blandy's avatar
Jim Blandy committed
1
/* Record indices of function doc strings stored in a file.
2
   Copyright (C) 1985, 1986, 1993, 1994, 1995, 1997, 1998, 1999, 2000, 2001,
Glenn Morris's avatar
Glenn Morris committed
3
                 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
Glenn Morris's avatar
Glenn Morris committed
4
                 Free Software Foundation, Inc.
Jim Blandy's avatar
Jim Blandy committed
5 6 7

This file is part of GNU Emacs.

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

GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
19
along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
Jim Blandy's avatar
Jim Blandy committed
20 21


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

#include <sys/types.h>
Dan Nicolaescu's avatar
Dan Nicolaescu committed
25
#include <sys/file.h>	/* Must be after sys/types.h for USG*/
Kim F. Storm's avatar
Kim F. Storm committed
26
#include <ctype.h>
27
#include <setjmp.h>
Jim Blandy's avatar
Jim Blandy committed
28

Dave Love's avatar
Dave Love committed
29
#ifdef HAVE_FCNTL_H
Jim Blandy's avatar
Jim Blandy committed
30 31 32
#include <fcntl.h>
#endif

33 34 35 36
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif

Jim Blandy's avatar
Jim Blandy committed
37 38 39 40 41 42
#ifndef O_RDONLY
#define O_RDONLY 0
#endif

#include "lisp.h"
#include "buffer.h"
Jim Blandy's avatar
Jim Blandy committed
43
#include "keyboard.h"
44
#include "character.h"
Stefan Monnier's avatar
Stefan Monnier committed
45
#include "keymap.h"
46
#include "buildobj.h"
Jim Blandy's avatar
Jim Blandy committed
47

Gerd Moellmann's avatar
Gerd Moellmann committed
48
#ifdef HAVE_INDEX
49
extern char *index (const char *, int);
50 51
#endif

52
Lisp_Object Vdoc_file_name;
Jim Blandy's avatar
Jim Blandy committed
53

54 55
Lisp_Object Qfunction_documentation;

56 57 58
/* A list of files used to build this Emacs binary.  */
static Lisp_Object Vbuild_files;

59 60
extern Lisp_Object Voverriding_local_map;

61 62
extern Lisp_Object Qremap;

63 64 65 66
/* Buffer used for reading from documentation file.  */
static char *get_doc_string_buffer;
static int get_doc_string_buffer_size;

67
static unsigned char *read_bytecode_pointer;
68
Lisp_Object Fsnarf_documentation (Lisp_Object);
69 70 71 72 73

/* readchar in lread.c calls back here to fetch the next byte.
   If UNREADFLAG is 1, we unread a byte.  */

int
74
read_bytecode_char (int unreadflag)
75 76 77 78 79 80 81 82 83
{
  if (unreadflag)
    {
      read_bytecode_pointer--;
      return 0;
    }
  return *read_bytecode_pointer++;
}

84 85 86
/* 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
87 88 89
   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
90 91
   them without actually fetching the doc string.)

92 93 94 95
   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.

96 97
   If UNIBYTE is nonzero, always make a unibyte string.

98 99 100 101
   If DEFINITION is nonzero, assume this is for reading
   a dynamic function definition; convert the bytestring
   and the constants vector with appropriate byte handling,
   and return a cons cell.  */
102

103
Lisp_Object
104
get_doc_string (Lisp_Object filepos, int unibyte, int definition)
105
{
106
  char *from, *to;
107 108 109 110
  register int fd;
  register char *name;
  register char *p, *p1;
  int minsize;
111
  int offset, position;
112
  Lisp_Object file, tem;
113

114 115 116 117 118 119 120
  if (INTEGERP (filepos))
    {
      file = Vdoc_file_name;
      position = XINT (filepos);
    }
  else if (CONSP (filepos))
    {
121 122
      file = XCAR (filepos);
      position = XINT (XCDR (filepos));
123 124
    }
  else
125 126
    return Qnil;

127 128 129
  if (position < 0)
    position = - position;

130 131 132 133 134
  if (!STRINGP (Vdoc_directory))
    return Qnil;

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

136 137 138 139 140 141
  /* 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);
  if (NILP (tem))
    {
142
      minsize = SCHARS (Vdoc_directory);
143 144 145
      /* sizeof ("../etc/") == 8 */
      if (minsize < 8)
	minsize = 8;
146 147 148
      name = (char *) alloca (minsize + SCHARS (file) + 8);
      strcpy (name, SDATA (Vdoc_directory));
      strcat (name, SDATA (file));
149 150 151
    }
  else
    {
152
      name = (char *) SDATA (file);
153
    }
Jim Blandy's avatar
Jim Blandy committed
154

155
  fd = emacs_open (name, O_RDONLY, 0);
Jim Blandy's avatar
Jim Blandy committed
156
  if (fd < 0)
157 158 159 160 161 162 163
    {
#ifndef CANNOT_DUMP
      if (!NILP (Vpurify_flag))
	{
	  /* Preparing to dump; DOC file is probably not installed.
	     So check in ../etc. */
	  strcpy (name, "../etc/");
164
	  strcat (name, SDATA (file));
165

166
	  fd = emacs_open (name, O_RDONLY, 0);
167 168 169 170 171 172
	}
#endif
      if (fd < 0)
	error ("Cannot open doc string file \"%s\"", name);
    }

173
  /* Seek only to beginning of disk block.  */
174 175 176
  /* 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)));
177
  if (0 > lseek (fd, position - offset, 0))
Jim Blandy's avatar
Jim Blandy committed
178
    {
179
      emacs_close (fd);
Jim Blandy's avatar
Jim Blandy committed
180
      error ("Position %ld out of range in doc string file \"%s\"",
181
	     position, name);
Jim Blandy's avatar
Jim Blandy committed
182
    }
183

184 185
  /* Read the doc string into get_doc_string_buffer.
     P points beyond the data just read.  */
186

187
  p = get_doc_string_buffer;
188
  while (1)
Jim Blandy's avatar
Jim Blandy committed
189
    {
190 191
      int space_left = (get_doc_string_buffer_size
			- (p - get_doc_string_buffer));
192 193
      int nread;

194
      /* Allocate or grow the buffer if we need to.  */
195 196
      if (space_left == 0)
	{
197 198 199 200 201 202 203 204
	  int in_buffer = p - get_doc_string_buffer;
	  get_doc_string_buffer_size += 16 * 1024;
	  get_doc_string_buffer
	    = (char *) xrealloc (get_doc_string_buffer,
				 get_doc_string_buffer_size + 1);
	  p = get_doc_string_buffer + in_buffer;
	  space_left = (get_doc_string_buffer_size
			- (p - get_doc_string_buffer));
205 206
	}

207 208
      /* Read a disk block at a time.
         If we read the same block last time, maybe skip this?  */
209 210
      if (space_left > 1024 * 8)
	space_left = 1024 * 8;
211
      nread = emacs_read (fd, p, space_left);
212 213
      if (nread < 0)
	{
214
	  emacs_close (fd);
215 216 217 218
	  error ("Read error on documentation file");
	}
      p[nread] = 0;
      if (!nread)
Jim Blandy's avatar
Jim Blandy committed
219
	break;
220
      if (p == get_doc_string_buffer)
221
	p1 = (char *) index (p + offset, '\037');
222
      else
223
	p1 = (char *) index (p, '\037');
Jim Blandy's avatar
Jim Blandy committed
224 225 226 227 228 229
      if (p1)
	{
	  *p1 = 0;
	  p = p1;
	  break;
	}
230
      p += nread;
Jim Blandy's avatar
Jim Blandy committed
231
    }
232
  emacs_close (fd);
233

234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257
  /* 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;
    }

258 259
  /* Scan the text and perform quoting with ^A (char code 1).
     ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_.  */
260 261
  from = get_doc_string_buffer + offset;
  to = get_doc_string_buffer + offset;
262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282
  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
	    error ("Invalid data in documentation file -- ^A followed by code 0%o", c);
	}
      else
	*to++ = *from++;
    }

283 284
  /* If DEFINITION, read from this buffer
     the same way we would read bytes from a file.  */
285 286
  if (definition)
    {
287 288
      read_bytecode_pointer = get_doc_string_buffer + offset;
      return Fread (Qlambda);
289 290
    }

291 292 293 294
  if (unibyte)
    return make_unibyte_string (get_doc_string_buffer + offset,
				to - (get_doc_string_buffer + offset));
  else
295 296 297 298 299 300 301 302 303
    {
      /* Let the data determine whether the string is multibyte,
	 even if Emacs is running in --unibyte mode.  */
      int nchars = multibyte_chars_in_text (get_doc_string_buffer + offset,
					    to - (get_doc_string_buffer + offset));
      return make_string_from_bytes (get_doc_string_buffer + offset,
				     nchars,
				     to - (get_doc_string_buffer + offset));
    }
304 305 306 307 308 309 310
}

/* 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
311
read_doc_string (Lisp_Object filepos)
312
{
313
  return get_doc_string (filepos, 0, 1);
Jim Blandy's avatar
Jim Blandy committed
314 315
}

316
static int
317
reread_doc_file (Lisp_Object file)
318
{
319
#if 0
320 321 322 323 324
  Lisp_Object reply, prompt[3];
  struct gcpro gcpro1;
  GCPRO1 (file);
  prompt[0] = build_string ("File ");
  prompt[1] = NILP (file) ? Vdoc_file_name : file;
325
  prompt[2] = build_string (" is out of sync.  Reload? ");
326 327 328
  reply = Fy_or_n_p (Fconcat (3, prompt));
  UNGCPRO;
  if (NILP (reply))
329
    return 0;
330
#endif
331 332 333 334 335

  if (NILP (file))
    Fsnarf_documentation (Vdoc_file_name);
  else
    Fload (file, Qt, Qt, Qt, Qnil);
336 337

  return 1;
338 339
}

Roland McGrath's avatar
Roland McGrath committed
340
DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0,
341 342 343 344
       doc: /* Return the documentation string of FUNCTION.
Unless a non-nil second argument RAW is given, the
string is passed through `substitute-command-keys'.  */)
     (function, raw)
Jim Blandy's avatar
Jim Blandy committed
345
     Lisp_Object function, raw;
Jim Blandy's avatar
Jim Blandy committed
346 347 348
{
  Lisp_Object fun;
  Lisp_Object funcar;
Roland McGrath's avatar
Roland McGrath committed
349
  Lisp_Object tem, doc;
350 351 352
  int try_reload = 1;

 documentation:
Jim Blandy's avatar
Jim Blandy committed
353

354
  doc = Qnil;
355

356 357 358 359
  if (SYMBOLP (function)
      && (tem = Fget (function, Qfunction_documentation),
	  !NILP (tem)))
    return Fdocumentation_property (function, Qfunction_documentation, raw);
360

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

421 422 423 424 425 426 427 428 429 430 431 432
  /* 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);
    }

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

Jim Blandy's avatar
Jim Blandy committed
458
  if (NILP (raw))
459
    doc = Fsubstitute_command_keys (doc);
Roland McGrath's avatar
Roland McGrath committed
460
  return doc;
Jim Blandy's avatar
Jim Blandy committed
461 462
}

463 464
DEFUN ("documentation-property", Fdocumentation_property,
       Sdocumentation_property, 2, 3, 0,
465 466 467 468 469 470 471
       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.  */)
472 473
  (symbol, prop, raw)
     Lisp_Object symbol, prop, raw;
Jim Blandy's avatar
Jim Blandy committed
474
{
475
  int try_reload = 1;
476
  Lisp_Object tem;
Jim Blandy's avatar
Jim Blandy committed
477

478
 documentation_property:
479

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

505
  if (NILP (raw) && STRINGP (tem))
506
    tem = Fsubstitute_command_keys (tem);
507
  return tem;
Jim Blandy's avatar
Jim Blandy committed
508 509
}

510 511 512
/* Scanning the DOC files and placing docstring offsets into functions.  */

static void
513
store_function_docstring (Lisp_Object fun, EMACS_INT offset)
514
/* Use EMACS_INT because we get offset from pointer subtraction.  */
515 516 517 518 519 520
{
  fun = indirect_function (fun);

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

  /* Lisp_Subrs have a slot for it.  */
521
  if (SUBRP (fun))
522 523 524 525 526 527 528
    XSUBR (fun)->doc = (char *) - offset;

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

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

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

550
static const char buildobj[] = BUILDOBJ;
551

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

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

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

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

599
    for (beg = buildobj; *beg; beg = end)
600 601 602 603 604 605 606 607 608 609 610 611 612 613 614
      {
        int len;

        while (*beg && isspace (*beg)) ++beg;

        for (end = beg; *end && ! isspace (*end); ++end)
          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);
      }
615
    Vbuild_files = Fpurecopy (Vbuild_files);
616 617
  }

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

      buf[filled] = 0;
      p = buf;
      end = buf + (filled < 512 ? filled : filled - 128);
      while (p != end && *p != '\037') p++;
      /* p points to ^_Ffunctionname\n or ^_Vvarname\n.  */
      if (p != end)
	{
639
	  end = (char *) index (p, '\n');
640 641 642 643 644 645 646 647 648 649 650 651

          /* See if this is a file name, and if it is a file in build-files.  */
          if (p[1] == 'S' && end - p > 4 && end[-2] == '.'
              && (end[-1] == 'o' || end[-1] == 'c'))
            {
              int len = end - p - 2;
              char *fromfile = alloca (len + 1);
              strncpy (fromfile, &p[2], len);
              fromfile[len] = 0;
              if (fromfile[len-1] == 'c')
                fromfile[len-1] = 'o';

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

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

676
	      /* Attach a docstring to a function?  */
Jim Blandy's avatar
Jim Blandy committed
677
	      else if (p[1] == 'F')
678 679
		store_function_docstring (sym, pos + end + 1 - buf);

Kenichi Handa's avatar
Kenichi Handa committed
680 681 682
	      else if (p[1] == 'S')
		; /* Just a source file name boundary marker.  Ignore it.  */

683 684
	      else
		error ("DOC file invalid at position %d", pos);
Jim Blandy's avatar
Jim Blandy committed
685 686 687 688 689 690
	    }
	}
      pos += end - buf;
      filled -= end - buf;
      bcopy (end, buf, filled);
    }
691
  emacs_close (fd);
Jim Blandy's avatar
Jim Blandy committed
692 693 694 695
  return Qnil;
}

DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
696 697
       Ssubstitute_command_keys, 1, 1, 0,
       doc: /* Substitute key descriptions for command names in STRING.
698 699 700
Substrings of the form \\=\\[COMMAND] replaced by either: a keystroke
sequence that will invoke COMMAND, or "M-x COMMAND" if COMMAND is not
on any keys.
701
Substrings of the form \\=\\{MAPVAR} are replaced by summaries
702
\(made by `describe-bindings') of the value of MAPVAR, taken as a keymap.
703 704 705
Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR
as the keymap for future \\=\\[COMMAND] substrings.
\\=\\= quotes the following character and is discarded;
706 707
thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.

708
Returns original STRING if no substitutions were made.  Otherwise,
709
a new string, without any text properties, is returned.  */)
710
     (string)
711
     Lisp_Object string;
Jim Blandy's avatar
Jim Blandy committed
712 713 714 715 716 717 718
{
  unsigned char *buf;
  int changed = 0;
  register unsigned char *strp;
  register unsigned char *bufp;
  int idx;
  int bsize;
Jim Blandy's avatar
Jim Blandy committed
719
  Lisp_Object tem;
Jim Blandy's avatar
Jim Blandy committed
720 721
  Lisp_Object keymap;
  unsigned char *start;
722
  int length, length_byte;
Jim Blandy's avatar
Jim Blandy committed
723 724
  Lisp_Object name;
  struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
Richard M. Stallman's avatar
Richard M. Stallman committed
725 726
  int multibyte;
  int nchars;
Jim Blandy's avatar
Jim Blandy committed
727

728
  if (NILP (string))
Jim Blandy's avatar
Jim Blandy committed
729 730
    return Qnil;

731
  CHECK_STRING (string);
Jim Blandy's avatar
Jim Blandy committed
732 733 734
  tem = Qnil;
  keymap = Qnil;
  name = Qnil;
735
  GCPRO4 (string, tem, keymap, name);
Jim Blandy's avatar
Jim Blandy committed
736

Richard M. Stallman's avatar
Richard M. Stallman committed
737 738 739
  multibyte = STRING_MULTIBYTE (string);
  nchars = 0;

740 741 742
  /* 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,
743
     or from a \\<mapname> construct in STRING itself..  */
Karl Heuer's avatar
Karl Heuer committed
744 745 746
  keymap = current_kboard->Voverriding_terminal_local_map;
  if (NILP (keymap))
    keymap = Voverriding_local_map;
Jim Blandy's avatar
Jim Blandy committed
747

748
  bsize = SBYTES (string);
Jim Blandy's avatar
Jim Blandy committed
749 750
  bufp = buf = (unsigned char *) xmalloc (bsize);

751
  strp = SDATA (string);
752
  while (strp < SDATA (string) + SBYTES (string))
Jim Blandy's avatar
Jim Blandy committed
753 754 755 756 757 758
    {
      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
759 760 761 762 763
	  strp += 2;
	  if (multibyte)
	    {
	      int len;

764
	      STRING_CHAR_AND_LENGTH (strp, len);
Richard M. Stallman's avatar
Richard M. Stallman committed
765 766 767 768 769 770 771 772 773 774
	      if (len == 1)
		*bufp = *strp;
	      else
		bcopy (strp, bufp, len);
	      strp += len;
	      bufp += len;
	      nchars++;
	    }
	  else
	    *bufp++ = *strp++, nchars++;
Jim Blandy's avatar
Jim Blandy committed
775 776 777
	}
      else if (strp[0] == '\\' && strp[1] == '[')
	{
778
	  int start_idx;
779
	  int follow_remap = 1;
780

Jim Blandy's avatar
Jim Blandy committed
781 782 783
	  changed = 1;
	  strp += 2;		/* skip \[ */
	  start = strp;
784
	  start_idx = start - SDATA (string);
Jim Blandy's avatar
Jim Blandy committed
785

786
	  while ((strp - SDATA (string)
787
		  < SBYTES (string))
Jim Blandy's avatar
Jim Blandy committed
788 789
		 && *strp != ']')
	    strp++;
Richard M. Stallman's avatar
Richard M. Stallman committed
790 791
	  length_byte = strp - start;

Jim Blandy's avatar
Jim Blandy committed
792 793 794
	  strp++;		/* skip ] */

	  /* Save STRP in IDX.  */
795
	  idx = strp - SDATA (string);
796
	  name = Fintern (make_string (start, length_byte), Qnil);
797

798
	do_remap:
799
	  tem = Fwhere_is_internal (name, keymap, Qt, Qnil, Qnil);
800

801 802 803 804 805 806 807 808 809
	  if (VECTORP (tem) && XVECTOR (tem)->size > 1
	      && EQ (AREF (tem, 0), Qremap) && SYMBOLP (AREF (tem, 1))
	      && follow_remap)
	    {
	      name = AREF (tem, 1);
	      follow_remap = 0;
	      goto do_remap;
	    }

810 811
	  /* Note the Fwhere_is_internal can GC, so we have to take
	     relocation of string contents into account.  */
812 813
	  strp = SDATA (string) + idx;
	  start = SDATA (string) + start_idx;
Jim Blandy's avatar
Jim Blandy committed
814

Jim Blandy's avatar
Jim Blandy committed
815
	  if (NILP (tem))	/* but not on any keys */
Jim Blandy's avatar
Jim Blandy committed
816
	    {
817 818 819
	      int offset = bufp - buf;
	      buf = (unsigned char *) xrealloc (buf, bsize += 4);
	      bufp = buf + offset;
Jim Blandy's avatar
Jim Blandy committed
820 821
	      bcopy ("M-x ", bufp, 4);
	      bufp += 4;
Richard M. Stallman's avatar
Richard M. Stallman committed
822 823 824 825 826
	      nchars += 4;
	      if (multibyte)
		length = multibyte_chars_in_text (start, length_byte);
	      else
		length = length_byte;
Jim Blandy's avatar
Jim Blandy committed
827 828 829 830
	      goto subst;
	    }
	  else
	    {			/* function is on a key */
831
	      tem = Fkey_description (tem, Qnil);
Jim Blandy's avatar
Jim Blandy committed
832 833 834 835 836 837 838 839
	      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;
840
	  int start_idx;
841
	  /* This is for computing the SHADOWS arg for describe_map_tree.  */
842
	  Lisp_Object active_maps = Fcurrent_active_maps (Qnil, Qnil);
843
	  Lisp_Object earlier_maps;
Jim Blandy's avatar
Jim Blandy committed
844 845 846 847

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

Kenichi Handa's avatar
Kenichi Handa committed
850
	  while ((strp - SDATA (string) < SBYTES (string))
Jim Blandy's avatar
Jim Blandy committed
851 852
		 && *strp != '}' && *strp != '>')
	    strp++;
Richard M. Stallman's avatar
Richard M. Stallman committed
853 854

	  length_byte = strp - start;
Jim Blandy's avatar
Jim Blandy committed
855 856 857
	  strp++;			/* skip } or > */

	  /* Save STRP in IDX.  */
858
	  idx = strp - SDATA (string);
Jim Blandy's avatar
Jim Blandy committed
859 860 861 862

	  /* Get the value of the keymap in TEM, or nil if undefined.
	     Do this while still in the user's current buffer
	     in case it is a local variable.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
863
	  name = Fintern (make_string (start, length_byte), Qnil);
Jim Blandy's avatar
Jim Blandy committed
864
	  tem = Fboundp (name);
Jim Blandy's avatar
Jim Blandy committed
865
	  if (! NILP (tem))
Jim Blandy's avatar
Jim Blandy committed
866 867
	    {
	      tem = Fsymbol_value (name);
Jim Blandy's avatar
Jim Blandy committed
868
	      if (! NILP (tem))
869
		{
870 871
		  tem = get_keymap (tem, 0, 1);
		  /* Note that get_keymap can GC.  */
872 873
		  strp = SDATA (string) + idx;
		  start = SDATA (string) + start_idx;
874
		}
Jim Blandy's avatar
Jim Blandy committed
875 876 877 878 879 880
	    }

	  /* Now switch to a temp buffer.  */
	  oldbuf = current_buffer;
	  set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));

Jim Blandy's avatar
Jim Blandy committed
881
	  if (NILP (tem))
Jim Blandy's avatar
Jim Blandy committed
882 883 884
	    {
	      name = Fsymbol_name (name);
	      insert_string ("\nUses keymap \"");
Richard M. Stallman's avatar
Richard M. Stallman committed
885
	      insert_from_string (name, 0, 0,
886 887
				  SCHARS (name),
				  SBYTES (name), 1);
Jim Blandy's avatar
Jim Blandy committed
888