doc.c 26.2 KB
Newer Older
Jim Blandy's avatar
Jim Blandy committed
1
/* Record indices of function doc strings stored in a file.
Glenn Morris's avatar
Glenn Morris committed
2 3

Copyright (C) 1985-1986, 1993-1995, 1997-2012 Free Software Foundation, Inc.
Jim Blandy's avatar
Jim Blandy committed
4 5 6

This file is part of GNU Emacs.

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

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

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


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

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

Jim Blandy's avatar
Jim Blandy committed
30
#include "lisp.h"
31
#include "character.h"
Jim Blandy's avatar
Jim Blandy committed
32
#include "buffer.h"
Jim Blandy's avatar
Jim Blandy committed
33
#include "keyboard.h"
Stefan Monnier's avatar
Stefan Monnier committed
34
#include "keymap.h"
35
#include "buildobj.h"
Jim Blandy's avatar
Jim Blandy committed
36

37 38
Lisp_Object Qfunction_documentation;

Stefan Monnier's avatar
Stefan Monnier committed
39
extern Lisp_Object Qclosure;
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 46 47 48 49
static unsigned char *read_bytecode_pointer;

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

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

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

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

72 73
   If UNIBYTE is nonzero, always make a unibyte string.

74 75 76 77
   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.  */
78

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

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

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

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

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

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

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

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

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)
Jim Blandy's avatar
Jim Blandy committed
159
    {
160
      emacs_close (fd);
161
      error ("Position %"pI"d out of range in doc string file \"%s\"",
162
	     position, name);
Jim Blandy's avatar
Jim Blandy committed
163
    }
164

165 166
  SAFE_FREE ();

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

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

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

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

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

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

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

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

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

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

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

  return 1;
326 327
}

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

 documentation:
Jim Blandy's avatar
Jim Blandy committed
340

341
  doc = Qnil;
342

343 344 345 346 347 348 349
  if (SYMBOLP (function))
    {
      Lisp_Object tem = Fget (function, Qfunction_documentation);
      if (!NILP (tem))
	return Fdocumentation_property (function, Qfunction_documentation,
					raw);
    }
350

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

416 417 418 419 420 421 422 423 424 425 426 427
  /* 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);
    }

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

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

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

472
 documentation_property:
473

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

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

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

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

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

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

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

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

549
static const char buildobj[] = BUILDOBJ;
550

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

571
  CHECK_STRING (filename);
Jim Blandy's avatar
Jim Blandy committed
572

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

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

596
    for (beg = buildobj; *beg; beg = end)
597
      {
598
        ptrdiff_t len;
599 600 601 602 603 604 605 606 607 608 609 610 611

        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);
      }
612
    Vbuild_files = Fpurecopy (Vbuild_files);
613 614
  }

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

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

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

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

Richard M. Stallman's avatar
Richard M. Stallman committed
658
	  sym = oblookup (Vobarray, p + 2,
659 660
			  multibyte_chars_in_text ((unsigned char *) p + 2,
						   end - p - 2),
Richard M. Stallman's avatar
Richard M. Stallman committed
661
			  end - p - 2);
662 663 664 665
	  /* Check skip_file so that when a function is defined several
	     times in different files (typically, once in xterm, once in
	     w32term, ...), we only pay attention to the one that
	     matters.  */
666
	  if (! skip_file && SYMBOLP (sym))
Jim Blandy's avatar
Jim Blandy committed
667 668 669 670 671 672 673
	    {
	      /* Attach a docstring to a variable?  */
	      if (p[1] == 'V')
		{
		  /* Install file-position as variable-documentation property
		     and make it negative for a user-variable
		     (doc starts with a `*').  */
Glenn Morris's avatar
Glenn Morris committed
674 675 676 677
                  if (!NILP (Fboundp (sym)))
                    Fput (sym, Qvariable_documentation,
                          make_number ((pos + end + 1 - buf)
                                       * (end[1] == '*' ? -1 : 1)));
Jim Blandy's avatar
Jim Blandy committed
678 679
		}

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

689
	      else
690
		error ("DOC file invalid at position %"pI"d", pos);
Jim Blandy's avatar
Jim Blandy committed
691 692 693 694
	    }
	}
      pos += end - buf;
      filled -= end - buf;
695
      memmove (buf, end, filled);
Jim Blandy's avatar
Jim Blandy committed
696
    }
697
  emacs_close (fd);
Jim Blandy's avatar
Jim Blandy committed
698 699 700
  return Qnil;
}

Paul Eggert's avatar
Paul Eggert committed
701
DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
702 703
       Ssubstitute_command_keys, 1, 1, 0,
       doc: /* Substitute key descriptions for command names in STRING.
704 705 706 707 708 709 710 711 712 713 714
Each substring of the form \\=\\[COMMAND] is replaced by either a
keystroke sequence that invokes COMMAND, or "M-x COMMAND" if COMMAND
is not on any keys.

Each substring of the form \\=\\{MAPVAR} is replaced by a summary of
the value of MAPVAR as a keymap.  This summary is similar to the one
produced by `describe-bindings'.  The summary ends in two newlines
\(used by the helper function `help-make-xrefs' to find the end of the
summary).

Each substring of the form \\=\\<MAPVAR> specifies the use of MAPVAR
715 716
as the keymap for future \\=\\[COMMAND] substrings.
\\=\\= quotes the following character and is discarded;
717 718
thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.

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

738
  if (NILP (string))
Jim Blandy's avatar
Jim Blandy committed
739 740
    return Qnil;

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

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

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

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

761
  strp = SDATA (string);
762
  while (strp < SDATA (string) + SBYTES (string))
Jim Blandy's avatar
Jim Blandy committed
763 764 765 766 767 768
    {
      if (strp[0] == '\\' && strp[1] == '=')
	{
	  /* \= quotes the next character;
	     thus, to put in \[ without its special meaning, use \=\[.  */
	  changed = 1;
Richard M. Stallman's avatar
Richard M. Stallman committed
769 770 771 772 773
	  strp += 2;
	  if (multibyte)
	    {
	      int len;

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

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

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

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

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

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

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

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

Jim Blandy's avatar
Jim Blandy committed
825
	  if (NILP (tem))	/* but not on any keys */
Jim Blandy's avatar
Jim Blandy committed
826
	    {
827 828 829
	      ptrdiff_t offset = bufp - buf;
	      if (STRING_BYTES_BOUND - 4 < bsize)
		string_overflow ();
830
	      buf = xrealloc (buf, bsize += 4);
831
	      bufp = buf + offset;
832
	      memcpy (bufp, "M-x ", 4);
Jim Blandy's avatar
Jim Blandy committed
833
	      bufp += 4;
Richard M. Stallman's avatar
Richard M. Stallman committed
834 835 836 837 838
	      nchars += 4;
	      if (multibyte)
		length = multibyte_chars_in_text (start, length_byte);
	      else
		length = length_byte;
Jim Blandy's avatar
Jim Blandy committed
839 840 841 842
	      goto subst;
	    }
	  else
	    {			/* function is on a key */
843
	      tem = Fkey_description (tem, Qnil);
Jim Blandy's avatar
Jim Blandy committed
844 845 846 847 848 849 850 851
	      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;
852
	  ptrdiff_t start_idx;
853
	  /* This is for computing the SHADOWS arg for describe_map_tree.  */
854
	  Lisp_Object active_maps = Fcurrent_active_maps (Qnil, Qnil);
855
	  Lisp_Object earlier_maps;
Jim Blandy's avatar
Jim Blandy committed
856 857 858 859

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

Kenichi Handa's avatar
Kenichi Handa committed
862
	  while ((strp - SDATA (string) < SBYTES (string))
Jim Blandy's avatar
Jim Blandy committed
863 864
		 && *strp != '}' && *strp != '>')
	    strp++;
Richard M. Stallman's avatar
Richard M. Stallman committed
865 866

	  length_byte = strp - start;
Jim Blandy's avatar
Jim Blandy committed
867 868 869
	  strp++;			/* skip } or > */

	  /* Save STRP in IDX.  */
870
	  idx = strp - SDATA (string);
Jim Blandy's avatar
Jim Blandy committed
871 872 873 874

	  /* 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.  */
875
	  name = Fintern (make_string ((char *) start, length_byte), Qnil);
Jim Blandy's avatar
Jim Blandy committed
876
	  tem = Fboundp (name);
Jim Blandy's avatar
Jim Blandy committed
877
	  if (! NILP (tem))
Jim Blandy's avatar
Jim Blandy committed
878 879
	    {
	      tem = Fsymbol_value (name);
Jim Blandy's avatar
Jim Blandy committed
880
	      if (! NILP (tem))
881
		{
882 883
		  tem = get_keymap (tem, 0, 1);
		  /* Note that get_keymap can GC.  */
884 885
		  strp = SDATA (string) + idx;
		  start = SDATA (string) + start_idx;
886
		}
Jim Blandy's avatar
Jim Blandy committed
887 888 889 890 891 892
	    }

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

Jim Blandy's avatar
Jim Blandy committed
893
	  if (NILP (tem))
Jim Blandy's avatar
Jim Blandy committed
894 895
	    {
	      name = Fsymbol_name (name);
896
	      insert_string ("\nUses keymap `");
Richard M. Stallman's avatar
Richard M. Stallman committed
897
	      insert_from_string (name, 0, 0,
898 899
				  SCHARS (name),
				  SBYTES (name), 1);
900
	      insert_string ("', which is not currently defined.\n");
Jim Blandy's avatar
Jim Blandy committed
901 902 903 904 905
	      if (start[-1] == '<') keymap = Qnil;
	    }
	  else if (start[-1] == '<')
	    keymap = tem;
	  else
906 907 908 909 910 911 912
	    {
	      /* Get the list of active keymaps that precede this one.
		 If this one's not active, get nil.  */
	      earlier_maps = Fcdr (Fmemq (tem, Freverse (active_maps)));
	      describe_map_tree (tem, 1, Fnreverse (earlier_maps),
				 Qnil, (char *)0, 1, 0, 0, 1);
	    }
Jim Blandy's avatar
Jim Blandy committed
913 914 915 916 917
	  tem = Fbuffer_string ();
	  Ferase_buffer ();
	  set_buffer_internal (oldbuf);

	subst_string:
918 919 920
	  start = SDATA (tem);
	  length = SCHARS (tem);
	  length_byte = SBYTES (tem);
Jim Blandy's avatar
Jim Blandy committed
921
	subst:
922
	  {
923 924 925
	    ptrdiff_t offset = bufp - buf;
	    if (STRING_BYTES_BOUND - length_byte < bsize)
	      string_overflow ();
926
	    buf = xrealloc (buf, bsize += length_byte);
927
	    bufp = buf + offset;
928
	    memcpy (bufp, start, length_byte);
929 930 931
	    bufp += length_byte;
	    nchars += length;
	    /* Check STRING again in case gc relocated it.  */
932
	    strp = SDATA (string) + idx;
933
	  }
Jim Blandy's avatar
Jim Blandy committed
934
	}
Richard M. Stallman's avatar
Richard M. Stallman committed
935 936 937 938 939 940
      else if (! multibyte)		/* just copy other chars */
	*bufp++ = *strp++, nchars++;
      else
	{
	  int len;

941
	  STRING_CHAR_AND_LENGTH (strp, len);
Richard M. Stallman's avatar
Richard M. Stallman committed
942 943 944
	  if (len == 1)
	    *bufp = *strp;
	  else
945
	    memcpy (bufp, strp, len);
Richard M. Stallman's avatar
Richard M. Stallman committed
946 947 948 949
	  strp += len;
	  bufp += len;
	  nchars++;
	}
Jim Blandy's avatar
Jim Blandy committed
950 951 952
    }

  if (changed)			/* don't bother if nothing substituted */
953
    tem = make_string_from_bytes (buf, nchars, bufp - buf);
Jim Blandy's avatar
Jim Blandy committed
954
  else
955
    tem = string;
956
  xfree (buf);
Jim Blandy's avatar
Jim Blandy committed
957
  RETURN_UNGCPRO (tem);
Jim Blandy's avatar
Jim Blandy committed
958 959
}

Andreas Schwab's avatar
Andreas Schwab committed
960
void
961
syms_of_doc (void)
Jim Blandy's avatar
Jim Blandy committed
962
{
963
  DEFSYM (Qfunction_documentation, "function-documentation");
964

965
  DEFVAR_LISP ("internal-doc-file-name", Vdoc_file_name,
966
	       doc: /* Name of file containing documentation strings of built-in symbols.  */);
Jim Blandy's avatar
Jim Blandy committed
967 968
  Vdoc_file_name = Qnil;

969
  DEFVAR_LISP ("build-files", Vbuild_files,
970 971 972
               doc: /* A list of files used to build this Emacs binary.  */);
  Vbuild_files = Qnil;

Jim Blandy's avatar
Jim Blandy committed
973 974 975 976 977
  defsubr (&Sdocumentation);
  defsubr (&Sdocumentation_property);
  defsubr (&Ssnarf_documentation);
  defsubr (&Ssubstitute_command_keys);
}