[bpt/emacs.git] / src / doc.c

/* Record indices of function doc strings stored in a file.
   Copyright (C) 1985, 1986, 1992 Free Software Foundation, Inc.

This file is part of GNU Emacs.

GNU Emacs is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 1, or (at your option)
any later version.

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
along with GNU Emacs; see the file COPYING.  If not, write to
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */


#include "config.h"

#include <sys/types.h>
#include <sys/file.h>	/* Must be after sys/types.h for USG and BSD4_1*/

#ifdef USG5
#include <fcntl.h>
#endif

#ifndef O_RDONLY
#define O_RDONLY 0
#endif

#include "lisp.h"
#include "buffer.h"

Lisp_Object Vdoc_file_name;

Lisp_Object
get_doc_string (filepos)
     long filepos;
{
  char buf[512 * 32 + 1];
  register int fd;
  register char *name;
  register char *p, *p1;
  register int count;
  extern char *index ();

  if (XTYPE (Vdata_directory) != Lisp_String
      || XTYPE (Vdoc_file_name) != Lisp_String)
    return Qnil;

  name = (char *) alloca (XSTRING (Vdata_directory)->size
			  + XSTRING (Vdoc_file_name)->size + 8);
  strcpy (name, XSTRING (Vdata_directory)->data);
  strcat (name, XSTRING (Vdoc_file_name)->data);
#ifdef VMS
#ifndef VMS4_4
  /* For VMS versions with limited file name syntax,
     convert the name to something VMS will allow.  */
  p = name;
  while (*p)
    {
      if (*p == '-')
	*p = '_';
      p++;
    }
#endif /* not VMS4_4 */
#ifdef VMS4_4
  strcpy (name, sys_translate_unix (name));
#endif /* VMS4_4 */
#endif /* VMS */

  fd = open (name, O_RDONLY, 0);
  if (fd < 0)
    error ("Cannot open doc string file \"%s\"", name);
  if (0 > lseek (fd, filepos, 0))
    {
      close (fd);
      error ("Position %ld out of range in doc string file \"%s\"",
	     filepos, name);
    }
  p = buf;
  while (p != buf + sizeof buf - 1)
    {
      count = read (fd, p, 512);
      p[count] = 0;
      if (!count)
	break;
      p1 = index (p, '\037');
      if (p1)
	{
	  *p1 = 0;
	  p = p1;
	  break;
	}
      p += count;
    }
  close (fd);
  return make_string (buf, p - buf);
}

DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0,
  "Return the documentation string of FUNCTION.\n\
Unless a non-nil second argument is given, the\n\
string is passed through `substitute-command-keys'.")
  (function, raw)
     Lisp_Object function, raw;
{
  Lisp_Object fun;
  Lisp_Object funcar;
  Lisp_Object tem, doc;

  fun = Findirect_function (function);

  switch (XTYPE (fun))
    {
    case Lisp_Subr:
      if (XSUBR (fun)->doc == 0) return Qnil;
      if ((int) XSUBR (fun)->doc >= 0)
	doc = build_string (XSUBR (fun)->doc);
      else
	doc = get_doc_string (- (int) XSUBR (fun)->doc);
      break;
      
    case Lisp_Compiled:
      if (XVECTOR (fun)->size <= COMPILED_DOC_STRING)
	return Qnil;
      tem = XVECTOR (fun)->contents[COMPILED_DOC_STRING];
      if (XTYPE (tem) == Lisp_String)
	doc = tem;
      else if (XTYPE (tem) == Lisp_Int && XINT (tem) >= 0)
	doc = get_doc_string (XFASTINT (tem));
      else
	return Qnil;
      break;

    case Lisp_String:
    case Lisp_Vector:
      return build_string ("Keyboard macro.");

    case Lisp_Cons:
      funcar = Fcar (fun);
      if (XTYPE (funcar) != Lisp_Symbol)
	return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
      else if (EQ (funcar, Qkeymap))
	return build_string ("Prefix command (definition is a keymap associating keystrokes with\n\
subcommands.)");
      else if (EQ (funcar, Qlambda)
	       || EQ (funcar, Qautoload))
	{
	  tem = Fcar (Fcdr (Fcdr (fun)));
	  if (XTYPE (tem) == Lisp_String)
	    doc = tem;
	  else if (XTYPE (tem) == Lisp_Int && XINT (tem) >= 0)
	    doc = get_doc_string (XFASTINT (tem));
	  else
	    return Qnil;

	  break;
	}
      else if (EQ (funcar, Qmocklisp))
	return Qnil;
      else if (EQ (funcar, Qmacro))
	return Fdocumentation (Fcdr (fun), raw);

      /* Fall through to the default to report an error.  */

    default:
      return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
    }

  if (NILP (raw))
    doc = Fsubstitute_command_keys (doc);
  return doc;
}

DEFUN ("documentation-property", Fdocumentation_property, Sdocumentation_property, 2, 2, 0,
  "Return the documentation string that is SYMBOL's PROP property.\n\
This is like `get', but it can refer to strings stored in the\n\
`etc/DOC' file; and if the value is a string, it is passed through\n\
`substitute-command-keys'.  A non-nil third argument avoids this\n\
translation.")
  (sym, prop, raw)
     Lisp_Object sym, prop, raw;
{
  register Lisp_Object tem;

  tem = Fget (sym, prop);
  if (XTYPE (tem) == Lisp_Int)
    tem = get_doc_string (XINT (tem) > 0 ? XINT (tem) : - XINT (tem));
  if (NILP (raw) && XTYPE (tem) == Lisp_String)
    return Fsubstitute_command_keys (tem);
  return tem;
}
\f
DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
  1, 1, 0,
  "Used during Emacs initialization, before dumping runnable Emacs,\n\
to find pointers to doc strings stored in `etc/DOC...' and\n\
record them in function definitions.\n\
One arg, FILENAME, a string which does not include a directory.\n\
The file is found in `../etc' now; found in the `data-directory'\n\
when doc strings are referred to later in the dumped Emacs.")
  (filename)
     Lisp_Object filename;
{
  int fd;
  char buf[1024 + 1];
  register int filled;
  register int pos;
  register char *p, *end;
  Lisp_Object sym, fun, tem;
  char *name;
  extern char *index ();

#ifndef CANNOT_DUMP
  if (NILP (Vpurify_flag))
    error ("Snarf-documentation can only be called in an undumped Emacs");
#endif

  CHECK_STRING (filename, 0);

#ifndef CANNOT_DUMP
  name = (char *) alloca (XSTRING (filename)->size + 14);
  strcpy (name, "../etc/");
#else /* CANNOT_DUMP */
  CHECK_STRING (Vdata_directory, 0);
  name = (char *) alloca (XSTRING (filename)->size +
			  XSTRING (Vdata_directory)->size + 1);
  strcpy (name, XSTRING (Vdata_directory)->data);
#endif /* CANNOT_DUMP */
  strcat (name, XSTRING (filename)->data); 	/*** Add this line ***/
#ifdef VMS
#ifndef VMS4_4
  /* For VMS versions with limited file name syntax,
     convert the name to something VMS will allow.  */
  p = name;
  while (*p)
    {
      if (*p == '-')
	*p = '_';
      p++;
    }
#endif /* not VMS4_4 */
#ifdef VMS4_4
  strcpy (name, sys_translate_unix (name));
#endif /* VMS4_4 */
#endif /* VMS */

  fd = open (name, O_RDONLY, 0);
  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)
	filled += read (fd, &buf[filled], sizeof buf - 1 - filled);
      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)
	{
	  end = index (p, '\n');
	  sym = oblookup (Vobarray, p + 2, end - p - 2);
	  if (XTYPE (sym) == Lisp_Symbol)
	    {
	      /* 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)));
		}

	      /* Attach a docstring to a function?  The type determines where
	         the docstring is stored.  */
	      else if (p[1] == 'F')
		{
		  fun = XSYMBOL (sym)->function;

		  /* Lisp_Subrs have a slot for it.  */
		  if (XTYPE (fun) == Lisp_Subr)
		    XSUBR (fun)->doc = (char *) - (pos + end + 1 - buf);

		  /* If it's a lisp form, stick it in the form.  */
		  else if (CONSP (fun))
		    {
		      tem = XCONS (fun)->car;
		      if (EQ (tem, Qlambda) || EQ (tem, Qautoload))
			{
			  tem = Fcdr (Fcdr (fun));
			  if (CONSP (tem) &&
			      XTYPE (XCONS (tem)->car) == Lisp_Int)
			    XFASTINT (XCONS (tem)->car) = (pos + end + 1 - buf);
			}
		    }

		  /* Bytecode objects sometimes have slots for it.  */
		  else if (XTYPE (fun) == Lisp_Compiled)
		    {
		      /* This bytecode object must have a slot for the
			 docstring, since we've found a docstring for it.  */
		      if (XVECTOR (fun)->size <= COMPILED_DOC_STRING)
			abort ();

		      XFASTINT (XVECTOR (fun)->contents[COMPILED_DOC_STRING])
			= pos + end + 1 - buf;
		    }
		}
	      else error ("DOC file invalid at position %d", pos);
	    }
	}
      pos += end - buf;
      filled -= end - buf;
      bcopy (end, buf, filled);
    }
  close (fd);
  return Qnil;
}
\f
DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
  Ssubstitute_command_keys, 1, 1, 0,
  "Substitute key descriptions for command names in STRING.\n\
Return a new string which is STRING with substrings of the form \\=\\[COMMAND]\n\
replaced by either:  a keystroke sequence that will invoke COMMAND,\n\
or \"M-x COMMAND\" if COMMAND is not on any keys.\n\
Substrings of the form \\=\\{MAPVAR} are replaced by summaries\n\
\(made by describe-bindings) of the value of MAPVAR, taken as a keymap.\n\
Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR\n\
as the keymap for future \\=\\[COMMAND] substrings.\n\
\\=\\= quotes the following character and is discarded;\n\
thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.")
  (str)
     Lisp_Object str;
{
  unsigned char *buf;
  int changed = 0;
  register unsigned char *strp;
  register unsigned char *bufp;
  int idx;
  int bsize;
  unsigned char *new;
  register Lisp_Object tem;
  Lisp_Object keymap;
  unsigned char *start;
  int length;
  struct gcpro gcpro1;

  if (NILP (str))
    return Qnil;

  CHECK_STRING (str, 0);
  GCPRO1 (str);

  keymap = current_buffer->keymap;

  bsize = XSTRING (str)->size;
  bufp = buf = (unsigned char *) xmalloc (bsize);

  strp = (unsigned char *) XSTRING (str)->data;
  while (strp < (unsigned char *) XSTRING (str)->data + XSTRING (str)->size)
    {
      if (strp[0] == '\\' && strp[1] == '=')
	{
	  /* \= quotes the next character;
	     thus, to put in \[ without its special meaning, use \=\[.  */
	  changed = 1;
	  *bufp++ = strp[2];
	  strp += 3;
	}
      else if (strp[0] == '\\' && strp[1] == '[')
	{
	  changed = 1;
	  strp += 2;		/* skip \[ */
	  start = strp;

	  while ((strp - (unsigned char *) XSTRING (str)->data
		  < XSTRING (str)->size)
		 && *strp != ']')
	    strp++;
	  length = strp - start;
	  strp++;		/* skip ] */

	  /* Save STRP in IDX.  */
	  idx = strp - (unsigned char *) XSTRING (str)->data;
	  tem = Fintern (make_string (start, length), Qnil);
	  tem = Fwhere_is_internal (tem, keymap, Qnil, Qt, Qnil);

	  if (NILP (tem))	/* but not on any keys */
	    {
	      new = (unsigned char *) xrealloc (buf, bsize += 4);
	      bufp += new - buf;
	      buf = new;
	      bcopy ("M-x ", bufp, 4);
	      bufp += 4;
	      goto subst;
	    }
	  else
	    {			/* function is on a key */
	      tem = Fkey_description (tem);
	      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;
	  Lisp_Object name;

	  changed = 1;
	  strp += 2;		/* skip \{ or \< */
	  start = strp;

	  while ((strp - (unsigned char *) XSTRING (str)->data
		  < XSTRING (str)->size)
		 && *strp != '}' && *strp != '>')
	    strp++;
	  length = strp - start;
	  strp++;			/* skip } or > */

	  /* Save STRP in IDX.  */
	  idx = strp - (unsigned char *) XSTRING (str)->data;

	  /* 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.  */
	  name = Fintern (make_string (start, length), Qnil);
	  tem = Fboundp (name);
	  if (! NILP (tem))
	    {
	      tem = Fsymbol_value (name);
	      if (! NILP (tem))
		tem = get_keymap_1 (tem, 0);
	    }

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

	  if (NILP (tem))
	    {
	      name = Fsymbol_name (name);
	      insert_string ("\nUses keymap \"");
	      insert_from_string (name, 0, XSTRING (name)->size);
	      insert_string ("\", which is not currently defined.\n");
	      if (start[-1] == '<') keymap = Qnil;
	    }
	  else if (start[-1] == '<')
	    keymap = tem;
	  else
	    describe_map_tree (tem, 1, Qnil);
	  tem = Fbuffer_string ();
	  Ferase_buffer ();
	  set_buffer_internal (oldbuf);

	subst_string:
	  start = XSTRING (tem)->data;
	  length = XSTRING (tem)->size;
	subst:
	  new = (unsigned char *) xrealloc (buf, bsize += length);
	  bufp += new - buf;
	  buf = new;
	  bcopy (start, bufp, length);
	  bufp += length;
	  /* Check STR again in case gc relocated it.  */
	  strp = (unsigned char *) XSTRING (str)->data + idx;
	}
      else			/* just copy other chars */
	*bufp++ = *strp++;
    }

  if (changed)			/* don't bother if nothing substituted */
    tem = make_string (buf, bufp - buf);
  else
    tem = str;
  UNGCPRO;
  free (buf);
  return tem;
}
\f
syms_of_doc ()
{
  DEFVAR_LISP ("internal-doc-file-name", &Vdoc_file_name,
    "Name of file containing documentation strings of built-in symbols.");
  Vdoc_file_name = Qnil;

  defsubr (&Sdocumentation);
  defsubr (&Sdocumentation_property);
  defsubr (&Ssnarf_documentation);
  defsubr (&Ssubstitute_command_keys);
}
Commit	Line	Data
c6045832	1	/* Record indices of function doc strings stored in a file.
956ace37	2	Copyright (C) 1985, 1986, 1992 Free Software Foundation, Inc.
c6045832 JB	3
	4	This file is part of GNU Emacs.
	5
	6	GNU Emacs is free software; you can redistribute it and/or modify
	7	it under the terms of the GNU General Public License as published by
	8	the Free Software Foundation; either version 1, or (at your option)
	9	any later version.
	10
	11	GNU Emacs is distributed in the hope that it will be useful,
	12	but WITHOUT ANY WARRANTY; without even the implied warranty of
	13	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	14	GNU General Public License for more details.
	15
	16	You should have received a copy of the GNU General Public License
	17	along with GNU Emacs; see the file COPYING. If not, write to
	18	the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
	19
	20
	21	#include "config.h"
	22
	23	#include <sys/types.h>
	24	#include <sys/file.h> /* Must be after sys/types.h for USG and BSD4_1*/
	25
	26	#ifdef USG5
	27	#include <fcntl.h>
	28	#endif
	29
	30	#ifndef O_RDONLY
	31	#define O_RDONLY 0
	32	#endif
	33
c6045832 JB	34	#include "lisp.h"
	35	#include "buffer.h"
	36
9fbfa962	37	Lisp_Object Vdoc_file_name;
c6045832 JB	38
	39	Lisp_Object
	40	get_doc_string (filepos)
	41	long filepos;
	42	{
	43	char buf[512 * 32 + 1];
	44	register int fd;
	45	register char *name;
	46	register char p, p1;
	47	register int count;
	48	extern char *index ();
	49
6367dc09	50	if (XTYPE (Vdata_directory) != Lisp_String
c6045832 JB	51	\|\| XTYPE (Vdoc_file_name) != Lisp_String)
	52	return Qnil;
	53
6367dc09	54	name = (char *) alloca (XSTRING (Vdata_directory)->size
c6045832	55	+ XSTRING (Vdoc_file_name)->size + 8);
6367dc09	56	strcpy (name, XSTRING (Vdata_directory)->data);
c6045832 JB	57	strcat (name, XSTRING (Vdoc_file_name)->data);
	58	#ifdef VMS
	59	#ifndef VMS4_4
	60	/* For VMS versions with limited file name syntax,
	61	convert the name to something VMS will allow. */
	62	p = name;
	63	while (*p)
	64	{
	65	if (*p == '-')
	66	*p = '_';
	67	p++;
	68	}
	69	#endif /* not VMS4_4 */
	70	#ifdef VMS4_4
	71	strcpy (name, sys_translate_unix (name));
	72	#endif /* VMS4_4 */
	73	#endif /* VMS */
	74
	75	fd = open (name, O_RDONLY, 0);
	76	if (fd < 0)
	77	error ("Cannot open doc string file \"%s\"", name);
	78	if (0 > lseek (fd, filepos, 0))
	79	{
	80	close (fd);
	81	error ("Position %ld out of range in doc string file \"%s\"",
	82	filepos, name);
	83	}
	84	p = buf;
	85	while (p != buf + sizeof buf - 1)
	86	{
	87	count = read (fd, p, 512);
	88	p[count] = 0;
	89	if (!count)
	90	break;
	91	p1 = index (p, '\037');
	92	if (p1)
	93	{
	94	*p1 = 0;
	95	p = p1;
	96	break;
	97	}
	98	p += count;
	99	}
	100	close (fd);
	101	return make_string (buf, p - buf);
	102	}
	103
ee04dc54	104	DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0,
08564963 JB	105	"Return the documentation string of FUNCTION.\n\
08564963 JB	106	Unless a non-nil second argument is given, the\n\
ee04dc54	107	string is passed through `substitute-command-keys'.")
502ddf23 JB	108	(function, raw)
502ddf23 JB	109	Lisp_Object function, raw;
c6045832 JB	110	{
	111	Lisp_Object fun;
	112	Lisp_Object funcar;
ee04dc54	113	Lisp_Object tem, doc;
c6045832	114
502ddf23	115	fun = Findirect_function (function);
c6045832 JB	116
	117	switch (XTYPE (fun))
	118	{
	119	case Lisp_Subr:
	120	if (XSUBR (fun)->doc == 0) return Qnil;
	121	if ((int) XSUBR (fun)->doc >= 0)
ee04dc54	122	doc = build_string (XSUBR (fun)->doc);
c6045832	123	else
ee04dc54 RM	124	doc = get_doc_string (- (int) XSUBR (fun)->doc);
ee04dc54 RM	125	break;
c6045832 JB	126
	127	case Lisp_Compiled:
	128	if (XVECTOR (fun)->size <= COMPILED_DOC_STRING)
	129	return Qnil;
	130	tem = XVECTOR (fun)->contents[COMPILED_DOC_STRING];
	131	if (XTYPE (tem) == Lisp_String)
ee04dc54 RM	132	doc = tem;
	133	else if (XTYPE (tem) == Lisp_Int && XINT (tem) >= 0)
	134	doc = get_doc_string (XFASTINT (tem));
	135	else
	136	return Qnil;
	137	break;
c6045832 JB	138
	139	case Lisp_String:
	140	case Lisp_Vector:
	141	return build_string ("Keyboard macro.");
	142
	143	case Lisp_Cons:
	144	funcar = Fcar (fun);
	145	if (XTYPE (funcar) != Lisp_Symbol)
	146	return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
502ddf23	147	else if (EQ (funcar, Qkeymap))
c6045832 JB	148	return build_string ("Prefix command (definition is a keymap associating keystrokes with\n\
c6045832 JB	149	subcommands.)");
502ddf23 JB	150	else if (EQ (funcar, Qlambda)
502ddf23 JB	151	\|\| EQ (funcar, Qautoload))
c6045832 JB	152	{
	153	tem = Fcar (Fcdr (Fcdr (fun)));
	154	if (XTYPE (tem) == Lisp_String)
ee04dc54 RM	155	doc = tem;
	156	else if (XTYPE (tem) == Lisp_Int && XINT (tem) >= 0)
	157	doc = get_doc_string (XFASTINT (tem));
	158	else
	159	return Qnil;
502ddf23 JB	160
502ddf23 JB	161	break;
c6045832	162	}
502ddf23	163	else if (EQ (funcar, Qmocklisp))
c6045832	164	return Qnil;
502ddf23	165	else if (EQ (funcar, Qmacro))
ee04dc54	166	return Fdocumentation (Fcdr (fun), raw);
c6045832 JB	167
	168	/* Fall through to the default to report an error. */
	169
	170	default:
	171	return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
	172	}
ee04dc54	173
956ace37	174	if (NILP (raw))
ee04dc54 RM	175	doc = Fsubstitute_command_keys (doc);
ee04dc54 RM	176	return doc;
c6045832 JB	177	}
c6045832 JB	178
956ace37	179	DEFUN ("documentation-property", Fdocumentation_property, Sdocumentation_property, 2, 2, 0,
c6045832	180	"Return the documentation string that is SYMBOL's PROP property.\n\
ee04dc54	181	This is like `get', but it can refer to strings stored in the\n\
08564963	182	`etc/DOC' file; and if the value is a string, it is passed through\n\
956ace37 JB	183	`substitute-command-keys'. A non-nil third argument avoids this\n\
956ace37 JB	184	translation.")
ee04dc54 RM	185	(sym, prop, raw)
ee04dc54 RM	186	Lisp_Object sym, prop, raw;
c6045832 JB	187	{
	188	register Lisp_Object tem;
	189
	190	tem = Fget (sym, prop);
	191	if (XTYPE (tem) == Lisp_Int)
	192	tem = get_doc_string (XINT (tem) > 0 ? XINT (tem) : - XINT (tem));
956ace37	193	if (NILP (raw) && XTYPE (tem) == Lisp_String)
992d176e RS	194	return Fsubstitute_command_keys (tem);
992d176e RS	195	return tem;
c6045832 JB	196	}
	197	\f
	198	DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
	199	1, 1, 0,
	200	"Used during Emacs initialization, before dumping runnable Emacs,\n\
08564963	201	to find pointers to doc strings stored in `etc/DOC...' and\n\
c6045832 JB	202	record them in function definitions.\n\
c6045832 JB	203	One arg, FILENAME, a string which does not include a directory.\n\
08564963	204	The file is found in `../etc' now; found in the `data-directory'\n\
c6045832 JB	205	when doc strings are referred to later in the dumped Emacs.")
	206	(filename)
	207	Lisp_Object filename;
	208	{
	209	int fd;
	210	char buf[1024 + 1];
	211	register int filled;
	212	register int pos;
	213	register char p, end;
	214	Lisp_Object sym, fun, tem;
	215	char *name;
	216	extern char *index ();
	217
2bda628c JB	218	#ifndef CANNOT_DUMP
	219	if (NILP (Vpurify_flag))
	220	error ("Snarf-documentation can only be called in an undumped Emacs");
	221	#endif
	222
c6045832 JB	223	CHECK_STRING (filename, 0);
	224
	225	#ifndef CANNOT_DUMP
6367dc09	226	name = (char *) alloca (XSTRING (filename)->size + 14);
08564963	227	strcpy (name, "../etc/");
c6045832	228	#else /* CANNOT_DUMP */
6367dc09	229	CHECK_STRING (Vdata_directory, 0);
c6045832	230	name = (char *) alloca (XSTRING (filename)->size +
6367dc09 JB	231	XSTRING (Vdata_directory)->size + 1);
6367dc09 JB	232	strcpy (name, XSTRING (Vdata_directory)->data);
c6045832 JB	233	#endif /* CANNOT_DUMP */
	234	strcat (name, XSTRING (filename)->data); /* Add this line */
	235	#ifdef VMS
	236	#ifndef VMS4_4
	237	/* For VMS versions with limited file name syntax,
	238	convert the name to something VMS will allow. */
	239	p = name;
	240	while (*p)
	241	{
	242	if (*p == '-')
	243	*p = '_';
	244	p++;
	245	}
	246	#endif /* not VMS4_4 */
	247	#ifdef VMS4_4
	248	strcpy (name, sys_translate_unix (name));
	249	#endif /* VMS4_4 */
	250	#endif /* VMS */
	251
	252	fd = open (name, O_RDONLY, 0);
	253	if (fd < 0)
	254	report_file_error ("Opening doc string file",
	255	Fcons (build_string (name), Qnil));
	256	Vdoc_file_name = filename;
	257	filled = 0;
	258	pos = 0;
	259	while (1)
	260	{
	261	if (filled < 512)
	262	filled += read (fd, &buf[filled], sizeof buf - 1 - filled);
	263	if (!filled)
	264	break;
	265
	266	buf[filled] = 0;
	267	p = buf;
	268	end = buf + (filled < 512 ? filled : filled - 128);
	269	while (p != end && *p != '\037') p++;
	270	/* p points to ^_Ffunctionname\n or ^_Vvarname\n. */
	271	if (p != end)
	272	{
	273	end = index (p, '\n');
	274	sym = oblookup (Vobarray, p + 2, end - p - 2);
	275	if (XTYPE (sym) == Lisp_Symbol)
	276	{
	277	/* Attach a docstring to a variable? */
	278	if (p[1] == 'V')
	279	{
	280	/* Install file-position as variable-documentation property
	281	and make it negative for a user-variable
	282	(doc starts with a `'). /
	283	Fput (sym, Qvariable_documentation,
	284	make_number ((pos + end + 1 - buf)
	285	* (end[1] == '*' ? -1 : 1)));
	286	}
	287
	288	/* Attach a docstring to a function? The type determines where
	289	the docstring is stored. */
	290	else if (p[1] == 'F')
	291	{
	292	fun = XSYMBOL (sym)->function;
	293
	294	/* Lisp_Subrs have a slot for it. */
	295	if (XTYPE (fun) == Lisp_Subr)
	296	XSUBR (fun)->doc = (char *) - (pos + end + 1 - buf);
297
298	/* If it's a lisp form, stick it in the form. */
299	else if (CONSP (fun))
300	{
301	tem = XCONS (fun)->car;
302	if (EQ (tem, Qlambda) \|\| EQ (tem, Qautoload))
303	{
304	tem = Fcdr (Fcdr (fun));
305	if (CONSP (tem) &&
306	XTYPE (XCONS (tem)->car) == Lisp_Int)
307	XFASTINT (XCONS (tem)->car) = (pos + end + 1 - buf);
308	}
309	}
310
311	/* Bytecode objects sometimes have slots for it. */
312	else if (XTYPE (fun) == Lisp_Compiled)
313	{
314	/* This bytecode object must have a slot for the
315	docstring, since we've found a docstring for it. */
316	if (XVECTOR (fun)->size <= COMPILED_DOC_STRING)
317	abort ();
318
319	XFASTINT (XVECTOR (fun)->contents[COMPILED_DOC_STRING])
320	= pos + end + 1 - buf;
321	}
322	}
323	else error ("DOC file invalid at position %d", pos);
324	}
325	}
326	pos += end - buf;
327	filled -= end - buf;
328	bcopy (end, buf, filled);
329	}
330	close (fd);
331	return Qnil;
332	}
333	\f
334	DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
335	Ssubstitute_command_keys, 1, 1, 0,
336	"Substitute key descriptions for command names in STRING.\n\
337	Return a new string which is STRING with substrings of the form \\=\\[COMMAND]\n\
338	replaced by either: a keystroke sequence that will invoke COMMAND,\n\
339	or \"M-x COMMAND\" if COMMAND is not on any keys.\n\
340	Substrings of the form \\=\\{MAPVAR} are replaced by summaries\n\
341	\(made by describe-bindings) of the value of MAPVAR, taken as a keymap.\n\
342	Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR\n\
343	as the keymap for future \\=\\[COMMAND] substrings.\n\
344	\\=\\= quotes the following character and is discarded;\n\
345	thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.")
346	(str)
347	Lisp_Object str;
348	{
349	unsigned char *buf;
350	int changed = 0;
351	register unsigned char *strp;
352	register unsigned char *bufp;
353	int idx;
354	int bsize;
355	unsigned char *new;
356	register Lisp_Object tem;
357	Lisp_Object keymap;
358	unsigned char *start;
359	int length;
360	struct gcpro gcpro1;
361
265a9e55	362	if (NILP (str))
c6045832 JB	363	return Qnil;
	364
	365	CHECK_STRING (str, 0);
	366	GCPRO1 (str);
	367
	368	keymap = current_buffer->keymap;
	369
	370	bsize = XSTRING (str)->size;
	371	bufp = buf = (unsigned char *) xmalloc (bsize);
	372
	373	strp = (unsigned char *) XSTRING (str)->data;
	374	while (strp < (unsigned char *) XSTRING (str)->data + XSTRING (str)->size)
	375	{
	376	if (strp[0] == '\\' && strp[1] == '=')
	377	{
	378	/* \= quotes the next character;
	379	thus, to put in \[ without its special meaning, use \=\[. */
	380	changed = 1;
	381	*bufp++ = strp[2];
	382	strp += 3;
	383	}
	384	else if (strp[0] == '\\' && strp[1] == '[')
	385	{
	386	changed = 1;
	387	strp += 2; /* skip \[ */
	388	start = strp;
	389
	390	while ((strp - (unsigned char *) XSTRING (str)->data
	391	< XSTRING (str)->size)
	392	&& *strp != ']')
	393	strp++;
	394	length = strp - start;
	395	strp++; /* skip ] */
	396
	397	/* Save STRP in IDX. */
	398	idx = strp - (unsigned char *) XSTRING (str)->data;
	399	tem = Fintern (make_string (start, length), Qnil);
	400	tem = Fwhere_is_internal (tem, keymap, Qnil, Qt, Qnil);
	401
265a9e55	402	if (NILP (tem)) /* but not on any keys */
c6045832 JB	403	{
	404	new = (unsigned char *) xrealloc (buf, bsize += 4);
	405	bufp += new - buf;
	406	buf = new;
	407	bcopy ("M-x ", bufp, 4);
	408	bufp += 4;
	409	goto subst;
	410	}
	411	else
	412	{ /* function is on a key */
	413	tem = Fkey_description (tem);
	414	goto subst_string;
	415	}
	416	}
	417	/* \{foo} is replaced with a summary of the keymap (symbol-value foo).
	418	\<foo> just sets the keymap used for \[cmd]. */
	419	else if (strp[0] == '\\' && (strp[1] == '{' \|\| strp[1] == '<'))
	420	{
	421	struct buffer *oldbuf;
	422	Lisp_Object name;
	423
	424	changed = 1;
	425	strp += 2; /* skip \{ or \< */
	426	start = strp;
	427
	428	while ((strp - (unsigned char *) XSTRING (str)->data
	429	< XSTRING (str)->size)
	430	&& strp != '}' && strp != '>')
	431	strp++;
	432	length = strp - start;
	433	strp++; /* skip } or > */
	434
	435	/* Save STRP in IDX. */
	436	idx = strp - (unsigned char *) XSTRING (str)->data;
	437
	438	/* Get the value of the keymap in TEM, or nil if undefined.
	439	Do this while still in the user's current buffer
	440	in case it is a local variable. */
	441	name = Fintern (make_string (start, length), Qnil);
	442	tem = Fboundp (name);
265a9e55	443	if (! NILP (tem))
c6045832 JB	444	{
c6045832 JB	445	tem = Fsymbol_value (name);
265a9e55	446	if (! NILP (tem))
c6045832 JB	447	tem = get_keymap_1 (tem, 0);
	448	}
	449
	450	/* Now switch to a temp buffer. */
	451	oldbuf = current_buffer;
	452	set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
	453
265a9e55	454	if (NILP (tem))
c6045832 JB	455	{
	456	name = Fsymbol_name (name);
	457	insert_string ("\nUses keymap \"");
	458	insert_from_string (name, 0, XSTRING (name)->size);
	459	insert_string ("\", which is not currently defined.\n");
	460	if (start[-1] == '<') keymap = Qnil;
	461	}
	462	else if (start[-1] == '<')
	463	keymap = tem;
	464	else
	465	describe_map_tree (tem, 1, Qnil);
	466	tem = Fbuffer_string ();
	467	Ferase_buffer ();
	468	set_buffer_internal (oldbuf);
	469
	470	subst_string:
	471	start = XSTRING (tem)->data;
	472	length = XSTRING (tem)->size;
	473	subst:
	474	new = (unsigned char *) xrealloc (buf, bsize += length);
	475	bufp += new - buf;
	476	buf = new;
	477	bcopy (start, bufp, length);
	478	bufp += length;
	479	/* Check STR again in case gc relocated it. */
	480	strp = (unsigned char *) XSTRING (str)->data + idx;
	481	}
	482	else /* just copy other chars */
	483	bufp++ = strp++;
	484	}
	485
	486	if (changed) /* don't bother if nothing substituted */
	487	tem = make_string (buf, bufp - buf);
	488	else
	489	tem = str;
	490	UNGCPRO;
	491	free (buf);
	492	return tem;
	493	}
	494	\f
	495	syms_of_doc ()
	496	{
	497	DEFVAR_LISP ("internal-doc-file-name", &Vdoc_file_name,
	498	"Name of file containing documentation strings of built-in symbols.");
	499	Vdoc_file_name = Qnil;
	500
	501	defsubr (&Sdocumentation);
	502	defsubr (&Sdocumentation_property);
	503	defsubr (&Ssnarf_documentation);
	504	defsubr (&Ssubstitute_command_keys);
	505	}