1/* Record indices of function doc strings stored in a file.
2   Copyright (C) 1985, 1986, 1993, 1994, 1995, 1997, 1998, 1999, 2000, 2001,
3                 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
4
5This file is part of GNU Emacs.
6
7GNU Emacs is free software; you can redistribute it and/or modify
8it under the terms of the GNU General Public License as published by
9the Free Software Foundation; either version 2, or (at your option)
10any later version.
11
12GNU Emacs is distributed in the hope that it will be useful,
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15GNU General Public License for more details.
16
17You should have received a copy of the GNU General Public License
18along with GNU Emacs; see the file COPYING.  If not, write to
19the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
20Boston, MA 02110-1301, USA.  */
21
22
23#include <config.h>
24
25#include <sys/types.h>
26#include <sys/file.h>	/* Must be after sys/types.h for USG and BSD4_1*/
27#include <ctype.h>
28
29#ifdef HAVE_FCNTL_H
30#include <fcntl.h>
31#endif
32
33#ifdef HAVE_UNISTD_H
34#include <unistd.h>
35#endif
36
37#ifndef O_RDONLY
38#define O_RDONLY 0
39#endif
40
41#include "lisp.h"
42#include "buffer.h"
43#include "keyboard.h"
44#include "charset.h"
45#include "keymap.h"
46
47#ifdef HAVE_INDEX
48extern char *index P_ ((const char *, int));
49#endif
50
51Lisp_Object Vdoc_file_name;
52
53Lisp_Object Qfunction_documentation;
54
55/* A list of files used to build this Emacs binary.  */
56static Lisp_Object Vbuild_files;
57
58extern Lisp_Object Voverriding_local_map;
59
60extern Lisp_Object Qremap;
61
62/* For VMS versions with limited file name syntax,
63   convert the name to something VMS will allow.  */
64static void
65munge_doc_file_name (name)
66     char *name;
67{
68#ifdef VMS
69#ifndef NO_HYPHENS_IN_FILENAMES
70  extern char * sys_translate_unix (char *ufile);
71  strcpy (name, sys_translate_unix (name));
72#else /* NO_HYPHENS_IN_FILENAMES */
73  char *p = name;
74  while (*p)
75    {
76      if (*p == '-')
77	*p = '_';
78      p++;
79    }
80#endif /* NO_HYPHENS_IN_FILENAMES */
81#endif /* VMS */
82}
83
84/* Buffer used for reading from documentation file.  */
85static char *get_doc_string_buffer;
86static int get_doc_string_buffer_size;
87
88static unsigned char *read_bytecode_pointer;
89Lisp_Object Fsnarf_documentation P_ ((Lisp_Object));
90
91/* readchar in lread.c calls back here to fetch the next byte.
92   If UNREADFLAG is 1, we unread a byte.  */
93
94int
95read_bytecode_char (unreadflag)
96     int unreadflag;
97{
98  if (unreadflag)
99    {
100      read_bytecode_pointer--;
101      return 0;
102    }
103  return *read_bytecode_pointer++;
104}
105
106/* Extract a doc string from a file.  FILEPOS says where to get it.
107   If it is an integer, use that position in the standard DOC-... file.
108   If it is (FILE . INTEGER), use FILE as the file name
109   and INTEGER as the position in that file.
110   But if INTEGER is negative, make it positive.
111   (A negative integer is used for user variables, so we can distinguish
112   them without actually fetching the doc string.)
113
114   If the location does not point to the beginning of a docstring
115   (e.g. because the file has been modified and the location is stale),
116   return nil.
117
118   If UNIBYTE is nonzero, always make a unibyte string.
119
120   If DEFINITION is nonzero, assume this is for reading
121   a dynamic function definition; convert the bytestring
122   and the constants vector with appropriate byte handling,
123   and return a cons cell.  */
124
125Lisp_Object
126get_doc_string (filepos, unibyte, definition)
127     Lisp_Object filepos;
128     int unibyte, definition;
129{
130  char *from, *to;
131  register int fd;
132  register char *name;
133  register char *p, *p1;
134  int minsize;
135  int offset, position;
136  Lisp_Object file, tem;
137
138  if (INTEGERP (filepos))
139    {
140      file = Vdoc_file_name;
141      position = XINT (filepos);
142    }
143  else if (CONSP (filepos))
144    {
145      file = XCAR (filepos);
146      position = XINT (XCDR (filepos));
147    }
148  else
149    return Qnil;
150
151  if (position < 0)
152    position = - position;
153
154  if (!STRINGP (Vdoc_directory))
155    return Qnil;
156
157  if (!STRINGP (file))
158    return Qnil;
159
160  /* Put the file name in NAME as a C string.
161     If it is relative, combine it with Vdoc_directory.  */
162
163  tem = Ffile_name_absolute_p (file);
164  if (NILP (tem))
165    {
166      minsize = SCHARS (Vdoc_directory);
167      /* sizeof ("../etc/") == 8 */
168      if (minsize < 8)
169	minsize = 8;
170      name = (char *) alloca (minsize + SCHARS (file) + 8);
171      strcpy (name, SDATA (Vdoc_directory));
172      strcat (name, SDATA (file));
173      munge_doc_file_name (name);
174    }
175  else
176    {
177      name = (char *) SDATA (file);
178    }
179
180  fd = emacs_open (name, O_RDONLY, 0);
181  if (fd < 0)
182    {
183#ifndef CANNOT_DUMP
184      if (!NILP (Vpurify_flag))
185	{
186	  /* Preparing to dump; DOC file is probably not installed.
187	     So check in ../etc. */
188	  strcpy (name, "../etc/");
189	  strcat (name, SDATA (file));
190	  munge_doc_file_name (name);
191
192	  fd = emacs_open (name, O_RDONLY, 0);
193	}
194#endif
195      if (fd < 0)
196	error ("Cannot open doc string file \"%s\"", name);
197    }
198
199  /* Seek only to beginning of disk block.  */
200  /* Make sure we read at least 1024 bytes before `position'
201     so we can check the leading text for consistency.  */
202  offset = min (position, max (1024, position % (8 * 1024)));
203  if (0 > lseek (fd, position - offset, 0))
204    {
205      emacs_close (fd);
206      error ("Position %ld out of range in doc string file \"%s\"",
207	     position, name);
208    }
209
210  /* Read the doc string into get_doc_string_buffer.
211     P points beyond the data just read.  */
212
213  p = get_doc_string_buffer;
214  while (1)
215    {
216      int space_left = (get_doc_string_buffer_size
217			- (p - get_doc_string_buffer));
218      int nread;
219
220      /* Allocate or grow the buffer if we need to.  */
221      if (space_left == 0)
222	{
223	  int in_buffer = p - get_doc_string_buffer;
224	  get_doc_string_buffer_size += 16 * 1024;
225	  get_doc_string_buffer
226	    = (char *) xrealloc (get_doc_string_buffer,
227				 get_doc_string_buffer_size + 1);
228	  p = get_doc_string_buffer + in_buffer;
229	  space_left = (get_doc_string_buffer_size
230			- (p - get_doc_string_buffer));
231	}
232
233      /* Read a disk block at a time.
234         If we read the same block last time, maybe skip this?  */
235      if (space_left > 1024 * 8)
236	space_left = 1024 * 8;
237      nread = emacs_read (fd, p, space_left);
238      if (nread < 0)
239	{
240	  emacs_close (fd);
241	  error ("Read error on documentation file");
242	}
243      p[nread] = 0;
244      if (!nread)
245	break;
246      if (p == get_doc_string_buffer)
247	p1 = (char *) index (p + offset, '\037');
248      else
249	p1 = (char *) index (p, '\037');
250      if (p1)
251	{
252	  *p1 = 0;
253	  p = p1;
254	  break;
255	}
256      p += nread;
257    }
258  emacs_close (fd);
259
260  /* Sanity checking.  */
261  if (CONSP (filepos))
262    {
263      int test = 1;
264      if (get_doc_string_buffer[offset - test++] != ' ')
265	return Qnil;
266      while (get_doc_string_buffer[offset - test] >= '0'
267	     && get_doc_string_buffer[offset - test] <= '9')
268	test++;
269      if (get_doc_string_buffer[offset - test++] != '@'
270	  || get_doc_string_buffer[offset - test] != '#')
271	return Qnil;
272    }
273  else
274    {
275      int test = 1;
276      if (get_doc_string_buffer[offset - test++] != '\n')
277	return Qnil;
278      while (get_doc_string_buffer[offset - test] > ' ')
279	test++;
280      if (get_doc_string_buffer[offset - test] != '\037')
281	return Qnil;
282    }
283
284  /* Scan the text and perform quoting with ^A (char code 1).
285     ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_.  */
286  from = get_doc_string_buffer + offset;
287  to = get_doc_string_buffer + offset;
288  while (from != p)
289    {
290      if (*from == 1)
291	{
292	  int c;
293
294	  from++;
295	  c = *from++;
296	  if (c == 1)
297	    *to++ = c;
298	  else if (c == '0')
299	    *to++ = 0;
300	  else if (c == '_')
301	    *to++ = 037;
302	  else
303	    error ("Invalid data in documentation file -- ^A followed by code 0%o", c);
304	}
305      else
306	*to++ = *from++;
307    }
308
309  /* If DEFINITION, read from this buffer
310     the same way we would read bytes from a file.  */
311  if (definition)
312    {
313      read_bytecode_pointer = get_doc_string_buffer + offset;
314      return Fread (Qlambda);
315    }
316
317  if (unibyte)
318    return make_unibyte_string (get_doc_string_buffer + offset,
319				to - (get_doc_string_buffer + offset));
320  else
321    {
322      /* Let the data determine whether the string is multibyte,
323	 even if Emacs is running in --unibyte mode.  */
324      int nchars = multibyte_chars_in_text (get_doc_string_buffer + offset,
325					    to - (get_doc_string_buffer + offset));
326      return make_string_from_bytes (get_doc_string_buffer + offset,
327				     nchars,
328				     to - (get_doc_string_buffer + offset));
329    }
330}
331
332/* Get a string from position FILEPOS and pass it through the Lisp reader.
333   We use this for fetching the bytecode string and constants vector
334   of a compiled function from the .elc file.  */
335
336Lisp_Object
337read_doc_string (filepos)
338     Lisp_Object filepos;
339{
340  return get_doc_string (filepos, 0, 1);
341}
342
343static int
344reread_doc_file (file)
345     Lisp_Object file;
346{
347#if 0
348  Lisp_Object reply, prompt[3];
349  struct gcpro gcpro1;
350  GCPRO1 (file);
351  prompt[0] = build_string ("File ");
352  prompt[1] = NILP (file) ? Vdoc_file_name : file;
353  prompt[2] = build_string (" is out of sync.  Reload? ");
354  reply = Fy_or_n_p (Fconcat (3, prompt));
355  UNGCPRO;
356  if (NILP (reply))
357    return 0;
358#endif
359
360  if (NILP (file))
361    Fsnarf_documentation (Vdoc_file_name);
362  else
363    Fload (file, Qt, Qt, Qt, Qnil);
364
365  return 1;
366}
367
368DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0,
369       doc: /* Return the documentation string of FUNCTION.
370Unless a non-nil second argument RAW is given, the
371string is passed through `substitute-command-keys'.  */)
372     (function, raw)
373     Lisp_Object function, raw;
374{
375  Lisp_Object fun;
376  Lisp_Object funcar;
377  Lisp_Object tem, doc;
378  int try_reload = 1;
379
380 documentation:
381
382  doc = Qnil;
383
384  if (SYMBOLP (function)
385      && (tem = Fget (function, Qfunction_documentation),
386	  !NILP (tem)))
387    return Fdocumentation_property (function, Qfunction_documentation, raw);
388
389  fun = Findirect_function (function, Qnil);
390  if (SUBRP (fun))
391    {
392      if (XSUBR (fun)->doc == 0)
393	return Qnil;
394      else if ((EMACS_INT) XSUBR (fun)->doc >= 0)
395	doc = build_string (XSUBR (fun)->doc);
396      else
397	doc = make_number ((EMACS_INT) XSUBR (fun)->doc);
398    }
399  else if (COMPILEDP (fun))
400    {
401      if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_DOC_STRING)
402	return Qnil;
403      tem = AREF (fun, COMPILED_DOC_STRING);
404      if (STRINGP (tem))
405	doc = tem;
406      else if (NATNUMP (tem) || CONSP (tem))
407	doc = tem;
408      else
409	return Qnil;
410    }
411  else if (STRINGP (fun) || VECTORP (fun))
412    {
413      return build_string ("Keyboard macro.");
414    }
415  else if (CONSP (fun))
416    {
417      funcar = Fcar (fun);
418      if (!SYMBOLP (funcar))
419	xsignal1 (Qinvalid_function, fun);
420      else if (EQ (funcar, Qkeymap))
421	return build_string ("Prefix command (definition is a keymap associating keystrokes with commands).");
422      else if (EQ (funcar, Qlambda)
423	       || EQ (funcar, Qautoload))
424	{
425	  Lisp_Object tem1;
426	  tem1 = Fcdr (Fcdr (fun));
427	  tem = Fcar (tem1);
428	  if (STRINGP (tem))
429	    doc = tem;
430	  /* Handle a doc reference--but these never come last
431	     in the function body, so reject them if they are last.  */
432	  else if ((NATNUMP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
433		   && !NILP (XCDR (tem1)))
434	    doc = tem;
435	  else
436	    return Qnil;
437	}
438      else if (EQ (funcar, Qmacro))
439	return Fdocumentation (Fcdr (fun), raw);
440      else
441	goto oops;
442    }
443  else
444    {
445    oops:
446      xsignal1 (Qinvalid_function, fun);
447    }
448
449  /* If DOC is 0, it's typically because of a dumped file missing
450     from the DOC file (bug in src/Makefile.in).  */
451  if (EQ (doc, make_number (0)))
452    doc = Qnil;
453  if (INTEGERP (doc) || CONSP (doc))
454    {
455      Lisp_Object tem;
456      tem = get_doc_string (doc, 0, 0);
457      if (NILP (tem) && try_reload)
458	{
459	  /* The file is newer, we need to reset the pointers.  */
460	  struct gcpro gcpro1, gcpro2;
461	  GCPRO2 (function, raw);
462	  try_reload = reread_doc_file (Fcar_safe (doc));
463	  UNGCPRO;
464	  if (try_reload)
465	    {
466	      try_reload = 0;
467	      goto documentation;
468	    }
469	}
470      else
471	doc = tem;
472    }
473
474  if (NILP (raw))
475    doc = Fsubstitute_command_keys (doc);
476  return doc;
477}
478
479DEFUN ("documentation-property", Fdocumentation_property,
480       Sdocumentation_property, 2, 3, 0,
481       doc: /* Return the documentation string that is SYMBOL's PROP property.
482Third argument RAW omitted or nil means pass the result through
483`substitute-command-keys' if it is a string.
484
485This differs from `get' in that it can refer to strings stored in the
486`etc/DOC' file; and that it evaluates documentation properties that
487aren't strings.  */)
488  (symbol, prop, raw)
489     Lisp_Object symbol, prop, raw;
490{
491  int try_reload = 1;
492  Lisp_Object tem;
493
494 documentation_property:
495
496  tem = Fget (symbol, prop);
497  if (EQ (tem, make_number (0)))
498    tem = Qnil;
499  if (INTEGERP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
500    {
501      Lisp_Object doc = tem;
502      tem = get_doc_string (tem, 0, 0);
503      if (NILP (tem) && try_reload)
504	{
505	  /* The file is newer, we need to reset the pointers.  */
506	  struct gcpro gcpro1, gcpro2, gcpro3;
507	  GCPRO3 (symbol, prop, raw);
508	  try_reload = reread_doc_file (Fcar_safe (doc));
509	  UNGCPRO;
510	  if (try_reload)
511	    {
512	      try_reload = 0;
513	      goto documentation_property;
514	    }
515	}
516    }
517  else if (!STRINGP (tem))
518    /* Feval protects its argument.  */
519    tem = Feval (tem);
520
521  if (NILP (raw) && STRINGP (tem))
522    tem = Fsubstitute_command_keys (tem);
523  return tem;
524}
525
526/* Scanning the DOC files and placing docstring offsets into functions.  */
527
528static void
529store_function_docstring (fun, offset)
530     Lisp_Object fun;
531     /* Use EMACS_INT because we get this from pointer subtraction.  */
532     EMACS_INT offset;
533{
534  fun = indirect_function (fun);
535
536  /* The type determines where the docstring is stored.  */
537
538  /* Lisp_Subrs have a slot for it.  */
539  if (SUBRP (fun))
540    XSUBR (fun)->doc = (char *) - offset;
541
542  /* If it's a lisp form, stick it in the form.  */
543  else if (CONSP (fun))
544    {
545      Lisp_Object tem;
546
547      tem = XCAR (fun);
548      if (EQ (tem, Qlambda) || EQ (tem, Qautoload))
549	{
550	  tem = Fcdr (Fcdr (fun));
551	  if (CONSP (tem) && INTEGERP (XCAR (tem)))
552	    XSETCARFASTINT (tem, offset);
553	}
554      else if (EQ (tem, Qmacro))
555	store_function_docstring (XCDR (fun), offset);
556    }
557
558  /* Bytecode objects sometimes have slots for it.  */
559  else if (COMPILEDP (fun))
560    {
561      /* This bytecode object must have a slot for the
562	 docstring, since we've found a docstring for it.  */
563      if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
564	XSETFASTINT (AREF (fun, COMPILED_DOC_STRING), offset);
565    }
566}
567
568
569DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
570       1, 1, 0,
571       doc: /* Used during Emacs initialization to scan the `etc/DOC...' file.
572This searches the `etc/DOC...' file for doc strings and
573records them in function and variable definitions.
574The function takes one argument, FILENAME, a string;
575it specifies the file name (without a directory) of the DOC file.
576That file is found in `../etc' now; later, when the dumped Emacs is run,
577the same file name is found in the `doc-directory'.  */)
578     (filename)
579     Lisp_Object filename;
580{
581  int fd;
582  char buf[1024 + 1];
583  register int filled;
584  register int pos;
585  register char *p, *end;
586  Lisp_Object sym;
587  char *name;
588  int skip_file = 0;
589
590  CHECK_STRING (filename);
591
592  if
593#ifndef CANNOT_DUMP
594    (!NILP (Vpurify_flag))
595#else /* CANNOT_DUMP */
596      (0)
597#endif /* CANNOT_DUMP */
598    {
599      name = (char *) alloca (SCHARS (filename) + 14);
600      strcpy (name, "../etc/");
601    }
602  else
603    {
604      CHECK_STRING (Vdoc_directory);
605      name = (char *) alloca (SCHARS (filename)
606			  + SCHARS (Vdoc_directory) + 1);
607      strcpy (name, SDATA (Vdoc_directory));
608    }
609  strcat (name, SDATA (filename)); 	/*** Add this line ***/
610  munge_doc_file_name (name);
611
612  /* Vbuild_files is nil when temacs is run, and non-nil after that.  */
613  if (NILP (Vbuild_files))
614  {
615    size_t cp_size = 0;
616    size_t to_read;
617    int nr_read;
618    char *cp = NULL;
619    char *beg, *end;
620
621    fd = emacs_open ("buildobj.lst", O_RDONLY, 0);
622    if (fd < 0)
623      report_file_error ("Opening file buildobj.lst", Qnil);
624
625    filled = 0;
626    for (;;)
627      {
628        cp_size += 1024;
629        to_read = cp_size - 1 - filled;
630        cp = xrealloc (cp, cp_size);
631        nr_read = emacs_read (fd, &cp[filled], to_read);
632        filled += nr_read;
633        if (nr_read < to_read)
634          break;
635      }
636
637    emacs_close (fd);
638    cp[filled] = 0;
639
640    for (beg = cp; *beg; beg = end)
641      {
642        int len;
643
644        while (*beg && isspace (*beg)) ++beg;
645
646        for (end = beg; *end && ! isspace (*end); ++end)
647          if (*end == '/') beg = end+1;  /* skip directory part  */
648
649        len = end - beg;
650        if (len > 4 && end[-4] == '.' && end[-3] == 'o')
651          len -= 2;  /* Just take .o if it ends in .obj  */
652
653        if (len > 0)
654          Vbuild_files = Fcons (make_string (beg, len), Vbuild_files);
655      }
656
657    xfree (cp);
658  }
659
660  fd = emacs_open (name, O_RDONLY, 0);
661  if (fd < 0)
662    report_file_error ("Opening doc string file",
663		       Fcons (build_string (name), Qnil));
664  Vdoc_file_name = filename;
665  filled = 0;
666  pos = 0;
667  while (1)
668    {
669      if (filled < 512)
670	filled += emacs_read (fd, &buf[filled], sizeof buf - 1 - filled);
671      if (!filled)
672	break;
673
674      buf[filled] = 0;
675      p = buf;
676      end = buf + (filled < 512 ? filled : filled - 128);
677      while (p != end && *p != '\037') p++;
678      /* p points to ^_Ffunctionname\n or ^_Vvarname\n.  */
679      if (p != end)
680	{
681	  end = (char *) index (p, '\n');
682
683          /* See if this is a file name, and if it is a file in build-files.  */
684          if (p[1] == 'S' && end - p > 4 && end[-2] == '.'
685              && (end[-1] == 'o' || end[-1] == 'c'))
686            {
687              int len = end - p - 2;
688              char *fromfile = alloca (len + 1);
689              strncpy (fromfile, &p[2], len);
690              fromfile[len] = 0;
691              if (fromfile[len-1] == 'c')
692                fromfile[len-1] = 'o';
693
694              if (EQ (Fmember (build_string (fromfile), Vbuild_files), Qnil))
695                skip_file = 1;
696              else
697                skip_file = 0;
698            }
699
700	  sym = oblookup (Vobarray, p + 2,
701			  multibyte_chars_in_text (p + 2, end - p - 2),
702			  end - p - 2);
703	  if (! skip_file && SYMBOLP (sym))
704	    {
705	      /* Attach a docstring to a variable?  */
706	      if (p[1] == 'V')
707		{
708		  /* Install file-position as variable-documentation property
709		     and make it negative for a user-variable
710		     (doc starts with a `*').  */
711		  Fput (sym, Qvariable_documentation,
712			make_number ((pos + end + 1 - buf)
713				     * (end[1] == '*' ? -1 : 1)));
714		}
715
716	      /* Attach a docstring to a function?  */
717	      else if (p[1] == 'F')
718		store_function_docstring (sym, pos + end + 1 - buf);
719
720	      else if (p[1] == 'S')
721		; /* Just a source file name boundary marker.  Ignore it.  */
722
723	      else
724		error ("DOC file invalid at position %d", pos);
725	    }
726	}
727      pos += end - buf;
728      filled -= end - buf;
729      bcopy (end, buf, filled);
730    }
731  emacs_close (fd);
732  return Qnil;
733}
734
735DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
736       Ssubstitute_command_keys, 1, 1, 0,
737       doc: /* Substitute key descriptions for command names in STRING.
738Substrings of the form \\=\\[COMMAND] replaced by either: a keystroke
739sequence that will invoke COMMAND, or "M-x COMMAND" if COMMAND is not
740on any keys.
741Substrings of the form \\=\\{MAPVAR} are replaced by summaries
742\(made by `describe-bindings') of the value of MAPVAR, taken as a keymap.
743Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR
744as the keymap for future \\=\\[COMMAND] substrings.
745\\=\\= quotes the following character and is discarded;
746thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.
747
748Returns original STRING if no substitutions were made.  Otherwise,
749a new string, without any text properties, is returned.  */)
750     (string)
751     Lisp_Object string;
752{
753  unsigned char *buf;
754  int changed = 0;
755  register unsigned char *strp;
756  register unsigned char *bufp;
757  int idx;
758  int bsize;
759  Lisp_Object tem;
760  Lisp_Object keymap;
761  unsigned char *start;
762  int length, length_byte;
763  Lisp_Object name;
764  struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
765  int multibyte;
766  int nchars;
767
768  if (NILP (string))
769    return Qnil;
770
771  CHECK_STRING (string);
772  tem = Qnil;
773  keymap = Qnil;
774  name = Qnil;
775  GCPRO4 (string, tem, keymap, name);
776
777  multibyte = STRING_MULTIBYTE (string);
778  nchars = 0;
779
780  /* KEYMAP is either nil (which means search all the active keymaps)
781     or a specified local map (which means search just that and the
782     global map).  If non-nil, it might come from Voverriding_local_map,
783     or from a \\<mapname> construct in STRING itself..  */
784  keymap = current_kboard->Voverriding_terminal_local_map;
785  if (NILP (keymap))
786    keymap = Voverriding_local_map;
787
788  bsize = SBYTES (string);
789  bufp = buf = (unsigned char *) xmalloc (bsize);
790
791  strp = SDATA (string);
792  while (strp < SDATA (string) + SBYTES (string))
793    {
794      if (strp[0] == '\\' && strp[1] == '=')
795	{
796	  /* \= quotes the next character;
797	     thus, to put in \[ without its special meaning, use \=\[.  */
798	  changed = 1;
799	  strp += 2;
800	  if (multibyte)
801	    {
802	      int len;
803	      int maxlen = SDATA (string) + SBYTES (string) - strp;
804
805	      STRING_CHAR_AND_LENGTH (strp, maxlen, len);
806	      if (len == 1)
807		*bufp = *strp;
808	      else
809		bcopy (strp, bufp, len);
810	      strp += len;
811	      bufp += len;
812	      nchars++;
813	    }
814	  else
815	    *bufp++ = *strp++, nchars++;
816	}
817      else if (strp[0] == '\\' && strp[1] == '[')
818	{
819	  int start_idx;
820	  int follow_remap = 1;
821
822	  changed = 1;
823	  strp += 2;		/* skip \[ */
824	  start = strp;
825	  start_idx = start - SDATA (string);
826
827	  while ((strp - SDATA (string)
828		  < SBYTES (string))
829		 && *strp != ']')
830	    strp++;
831	  length_byte = strp - start;
832
833	  strp++;		/* skip ] */
834
835	  /* Save STRP in IDX.  */
836	  idx = strp - SDATA (string);
837	  name = Fintern (make_string (start, length_byte), Qnil);
838
839	do_remap:
840	  /* Ignore remappings unless there are no ordinary bindings. */
841 	  tem = Fwhere_is_internal (name, keymap, Qt, Qnil, Qt);
842 	  if (NILP (tem))
843	    tem = Fwhere_is_internal (name, keymap, Qt, Qnil, Qnil);
844
845	  if (VECTORP (tem) && XVECTOR (tem)->size > 1
846	      && EQ (AREF (tem, 0), Qremap) && SYMBOLP (AREF (tem, 1))
847	      && follow_remap)
848	    {
849	      name = AREF (tem, 1);
850	      follow_remap = 0;
851	      goto do_remap;
852	    }
853
854	  /* Note the Fwhere_is_internal can GC, so we have to take
855	     relocation of string contents into account.  */
856	  strp = SDATA (string) + idx;
857	  start = SDATA (string) + start_idx;
858
859	  if (NILP (tem))	/* but not on any keys */
860	    {
861	      int offset = bufp - buf;
862	      buf = (unsigned char *) xrealloc (buf, bsize += 4);
863	      bufp = buf + offset;
864	      bcopy ("M-x ", bufp, 4);
865	      bufp += 4;
866	      nchars += 4;
867	      if (multibyte)
868		length = multibyte_chars_in_text (start, length_byte);
869	      else
870		length = length_byte;
871	      goto subst;
872	    }
873	  else
874	    {			/* function is on a key */
875	      tem = Fkey_description (tem, Qnil);
876	      goto subst_string;
877	    }
878	}
879      /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
880	 \<foo> just sets the keymap used for \[cmd].  */
881      else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<'))
882	{
883	  struct buffer *oldbuf;
884	  int start_idx;
885	  /* This is for computing the SHADOWS arg for describe_map_tree.  */
886	  Lisp_Object active_maps = Fcurrent_active_maps (Qnil);
887	  Lisp_Object earlier_maps;
888
889	  changed = 1;
890	  strp += 2;		/* skip \{ or \< */
891	  start = strp;
892	  start_idx = start - SDATA (string);
893
894	  while ((strp - SDATA (string) < SBYTES (string))
895		 && *strp != '}' && *strp != '>')
896	    strp++;
897
898	  length_byte = strp - start;
899	  strp++;			/* skip } or > */
900
901	  /* Save STRP in IDX.  */
902	  idx = strp - SDATA (string);
903
904	  /* Get the value of the keymap in TEM, or nil if undefined.
905	     Do this while still in the user's current buffer
906	     in case it is a local variable.  */
907	  name = Fintern (make_string (start, length_byte), Qnil);
908	  tem = Fboundp (name);
909	  if (! NILP (tem))
910	    {
911	      tem = Fsymbol_value (name);
912	      if (! NILP (tem))
913		{
914		  tem = get_keymap (tem, 0, 1);
915		  /* Note that get_keymap can GC.  */
916		  strp = SDATA (string) + idx;
917		  start = SDATA (string) + start_idx;
918		}
919	    }
920
921	  /* Now switch to a temp buffer.  */
922	  oldbuf = current_buffer;
923	  set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
924
925	  if (NILP (tem))
926	    {
927	      name = Fsymbol_name (name);
928	      insert_string ("\nUses keymap \"");
929	      insert_from_string (name, 0, 0,
930				  SCHARS (name),
931				  SBYTES (name), 1);
932	      insert_string ("\", which is not currently defined.\n");
933	      if (start[-1] == '<') keymap = Qnil;
934	    }
935	  else if (start[-1] == '<')
936	    keymap = tem;
937	  else
938	    {
939	      /* Get the list of active keymaps that precede this one.
940		 If this one's not active, get nil.  */
941	      earlier_maps = Fcdr (Fmemq (tem, Freverse (active_maps)));
942	      describe_map_tree (tem, 1, Fnreverse (earlier_maps),
943				 Qnil, (char *)0, 1, 0, 0, 1);
944	    }
945	  tem = Fbuffer_string ();
946	  Ferase_buffer ();
947	  set_buffer_internal (oldbuf);
948
949	subst_string:
950	  start = SDATA (tem);
951	  length = SCHARS (tem);
952	  length_byte = SBYTES (tem);
953	subst:
954	  {
955	    int offset = bufp - buf;
956	    buf = (unsigned char *) xrealloc (buf, bsize += length_byte);
957	    bufp = buf + offset;
958	    bcopy (start, bufp, length_byte);
959	    bufp += length_byte;
960	    nchars += length;
961	    /* Check STRING again in case gc relocated it.  */
962	    strp = (unsigned char *) SDATA (string) + idx;
963	  }
964	}
965      else if (! multibyte)		/* just copy other chars */
966	*bufp++ = *strp++, nchars++;
967      else
968	{
969	  int len;
970	  int maxlen = SDATA (string) + SBYTES (string) - strp;
971
972	  STRING_CHAR_AND_LENGTH (strp, maxlen, len);
973	  if (len == 1)
974	    *bufp = *strp;
975	  else
976	    bcopy (strp, bufp, len);
977	  strp += len;
978	  bufp += len;
979	  nchars++;
980	}
981    }
982
983  if (changed)			/* don't bother if nothing substituted */
984    tem = make_string_from_bytes (buf, nchars, bufp - buf);
985  else
986    tem = string;
987  xfree (buf);
988  RETURN_UNGCPRO (tem);
989}
990
991void
992syms_of_doc ()
993{
994  Qfunction_documentation = intern ("function-documentation");
995  staticpro (&Qfunction_documentation);
996
997  DEFVAR_LISP ("internal-doc-file-name", &Vdoc_file_name,
998	       doc: /* Name of file containing documentation strings of built-in symbols.  */);
999  Vdoc_file_name = Qnil;
1000
1001  DEFVAR_LISP ("build-files", &Vbuild_files,
1002               doc: /* A list of files used to build this Emacs binary.  */);
1003  Vbuild_files = Qnil;
1004
1005  defsubr (&Sdocumentation);
1006  defsubr (&Sdocumentation_property);
1007  defsubr (&Ssnarf_documentation);
1008  defsubr (&Ssubstitute_command_keys);
1009}
1010
1011/* arch-tag: 56281d4d-6949-43e2-be2e-f6517de744ba
1012   (do not change this comment) */
1013