[bpt/emacs.git] / lib-src / make-docfile.c

/* Generate doc-string file for GNU Emacs from source files.
   Copyright (C) 1985, 1986, 1992, 1993, 1994 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 2, 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.  */

/* The arguments given to this program are all the C and Lisp source files
 of GNU Emacs.  .elc and .el and .c files are allowed.
 A .o file can also be specified; the .c file it was made from is used.
 This helps the makefile pass the correct list of files.

 The results, which go to standard output or to a file
 specified with -a or -o (-a to append, -o to start from nothing),
 are entries containing function or variable names and their documentation.
 Each entry starts with a ^_ character.
 Then comes F for a function or V for a variable.
 Then comes the function or variable name, terminated with a newline.
 Then comes the documentation for that function or variable.
 */

#include <stdio.h>
#ifdef MSDOS
#include <fcntl.h>
#endif /* MSDOS */
#ifdef WINDOWSNT
#include <stdlib.h>
#include <fcntl.h>
#include <direct.h>
#endif /* WINDOWSNT */

#ifdef DOS_NT
#define READ_TEXT "rt"
#define READ_BINARY "rb"
#else  /* not DOS_NT */
#define READ_TEXT "r"
#define READ_BINARY "r"
#endif /* not DOS_NT */

int scan_file ();
int scan_lisp_file ();
int scan_c_file ();

FILE *outfile;

int
main (argc, argv)
     int argc;
     char **argv;
{
  int i;
  int err_count = 0;
  int first_infile;

  /* Don't put CRs in the DOC file.  */
#ifdef MSDOS
  _fmode = O_BINARY;
  (stdout)->_flag &= ~_IOTEXT;
  _setmode (fileno (stdout), O_BINARY);
#endif /* MSDOS */
#ifdef WINDOWSNT
  _fmode = O_BINARY;
  _setmode (fileno (stdout), O_BINARY);
#endif /* WINDOWSNT */

  outfile = stdout;

  /* If first two args are -o FILE, output to FILE.  */
  i = 1;
  if (argc > i + 1 && !strcmp (argv[i], "-o"))
    {
      outfile = fopen (argv[i + 1], "w");
      i += 2;
    }
  if (argc > i + 1 && !strcmp (argv[i], "-a"))
    {
      outfile = fopen (argv[i + 1], "a");
      i += 2;
    }
  if (argc > i + 1 && !strcmp (argv[i], "-d"))
    {
      chdir (argv[i + 1]);
      i += 2;
    }

  first_infile = i;
  for (; i < argc; i++)
    {
      int j;
      /* Don't process one file twice.  */
      for (j = first_infile; j < i; j++)
	if (! strcmp (argv[i], argv[j]))
	  break;
      if (j == i)
	err_count += scan_file (argv[i]);
    }
#ifndef VMS
  exit (err_count > 0);
#endif /* VMS */
  return err_count > 0;
}

/* Read file FILENAME and output its doc strings to outfile.  */
/* Return 1 if file is not found, 0 if it is found.  */

int
scan_file (filename)
     char *filename;
{
  int len = strlen (filename);
  if (!strcmp (filename + len - 4, ".elc"))
    return scan_lisp_file (filename, READ_BINARY);
  else if (!strcmp (filename + len - 3, ".el"))
    return scan_lisp_file (filename, READ_TEXT);
  else
    return scan_c_file (filename, READ_TEXT);
}
\f
char buf[128];

/* Skip a C string from INFILE,
 and return the character that follows the closing ".
 If printflag is positive, output string contents to outfile.
 If it is negative, store contents in buf.
 Convert escape sequences \n and \t to newline and tab;
 discard \ followed by newline.  */

int
read_c_string (infile, printflag)
     FILE *infile;
     int printflag;
{
  register int c;
  char *p = buf;

  c = getc (infile);
  while (c != EOF)
    {
      while (c != '"' && c != EOF)
	{
	  if (c == '\\')
	    {
	      c = getc (infile);
	      if (c == '\n')
		{
		  c = getc (infile);
		  continue;
		}
	      if (c == 'n')
		c = '\n';
	      if (c == 't')
		c = '\t';
	    }
	  if (printflag > 0)
	    putc (c, outfile);
	  else if (printflag < 0)
	    *p++ = c;
	  c = getc (infile);
	}
      c = getc (infile);
      if (c != '"')
	break;
      /* If we had a "", concatenate the two strings.  */
      c = getc (infile);
    }

  if (printflag < 0)
    *p = 0;

  return c;
}
\f
/* Write to file OUT the argument names of function FUNC, whose text is in BUF.
   MINARGS and MAXARGS are the minimum and maximum number of arguments.  */

void
write_c_args (out, func, buf, minargs, maxargs)
     FILE *out;
     char *func, *buf;
     int minargs, maxargs;
{
  register char *p;
  int in_ident = 0;
  int just_spaced = 0;
  int need_space = 1;

  fprintf (out, "(%s", func);

  if (*buf == '(')
    ++buf;

  for (p = buf; *p; p++)
    {
      char c = *p;
      int ident_start = 0;

      /* Notice when we start printing a new identifier.  */
      if ((('A' <= c && c <= 'Z')
	   || ('a' <= c && c <= 'z')
	   || ('0' <= c && c <= '9')
	   || c == '_')
	  != in_ident)
	{
	  if (!in_ident)
	    {
	      in_ident = 1;
	      ident_start = 1;

	      if (need_space)
		putc (' ', out);

	      if (minargs == 0 && maxargs > 0)
		fprintf (out, "&optional ");
	      just_spaced = 1;

	      minargs--;
	      maxargs--;
	    }
	  else
	    in_ident = 0;
	}

      /* Print the C argument list as it would appear in lisp:
	 print underscores as hyphens, and print commas as spaces.
	 Collapse adjacent spaces into one.  */
      if (c == '_') c = '-';
      if (c == ',') c = ' ';

      /* In C code, `default' is a reserved word, so we spell it
	 `defalt'; unmangle that here.  */
      if (ident_start
	  && strncmp (p, "defalt", 6) == 0
	  && ! (('A' <= p[6] && p[6] <= 'Z')
		|| ('a' <= p[6] && p[6] <= 'z')
		|| ('0' <= p[6] && p[6] <= '9')
		|| p[6] == '_'))
	{
	  fprintf (out, "DEFAULT");
	  p += 5;
	  in_ident = 0;
	  just_spaced = 0;
	}
      else if (c != ' ' || ! just_spaced)
	{
	  if (c >= 'a' && c <= 'z')
	    /* Upcase the letter.  */
	    c += 'A' - 'a';
	  putc (c, out);
	}

      just_spaced = (c == ' ');
      need_space = 0;
    }
}
\f
/* Read through a c file.  If a .o file is named,
   the corresponding .c file is read instead.
   Looks for DEFUN constructs such as are defined in ../src/lisp.h.
   Accepts any word starting DEF... so it finds DEFSIMPLE and DEFPRED.  */

int
scan_c_file (filename, mode)
     char *filename, *mode;
{
  FILE *infile;
  register int c;
  register int commas;
  register int defunflag;
  register int defvarperbufferflag;
  register int defvarflag;
  int minargs, maxargs;

  if (filename[strlen (filename) - 1] == 'o')
    filename[strlen (filename) - 1] = 'c';

  infile = fopen (filename, mode);

  /* No error if non-ex input file */
  if (infile == NULL)
    {
      perror (filename);
      return 0;
    }

  c = '\n';
  while (!feof (infile))
    {
      if (c != '\n')
	{
	  c = getc (infile);
	  continue;
	}
      c = getc (infile);
      if (c == ' ')
	{
	  while (c == ' ')
	    c = getc (infile);
	  if (c != 'D')
	    continue;
	  c = getc (infile);
	  if (c != 'E')
	    continue;
	  c = getc (infile);
	  if (c != 'F')
	    continue;
	  c = getc (infile);
	  if (c != 'V')
	    continue;
	  c = getc (infile);
	  if (c != 'A')
	    continue;
	  c = getc (infile);
	  if (c != 'R')
	    continue;
	  c = getc (infile);
	  if (c != '_')
	    continue;

	  defvarflag = 1;
	  defunflag = 0;

	  c = getc (infile);
	  defvarperbufferflag = (c == 'P');

	  c = getc (infile);
	}
      else if (c == 'D')
	{
	  c = getc (infile);
	  if (c != 'E')
	    continue;
	  c = getc (infile);
	  if (c != 'F')
	    continue;
	  c = getc (infile);
	  defunflag = c == 'U';
	  defvarflag = 0;
	}
      else continue;

      while (c != '(')
	{
	  if (c < 0)
	    goto eof;
	  c = getc (infile);
	}

      c = getc (infile);
      if (c != '"')
	continue;
      c = read_c_string (infile, -1);

      if (defunflag)
	commas = 5;
      else if (defvarperbufferflag)
	commas = 2;
      else if (defvarflag)
	commas = 1;
      else  /* For DEFSIMPLE and DEFPRED */
	commas = 2;

      while (commas)
	{
	  if (c == ',')
	    {
	      commas--;
	      if (defunflag && (commas == 1 || commas == 2))
		{
		  do
		    c = getc (infile);
		  while (c == ' ' || c == '\n' || c == '\t');
		  if (c < 0)
		    goto eof;
		  ungetc (c, infile);
		  if (commas == 2) /* pick up minargs */
		    fscanf (infile, "%d", &minargs);
		  else /* pick up maxargs */
		    if (c == 'M' || c == 'U') /* MANY || UNEVALLED */
		      maxargs = -1;
		    else
		      fscanf (infile, "%d", &maxargs);
		}
	    }
	  if (c < 0)
	    goto eof;
	  c = getc (infile);
	}
      while (c == ' ' || c == '\n' || c == '\t')
	c = getc (infile);
      if (c == '"')
	c = read_c_string (infile, 0);
      while (c != ',')
	c = getc (infile);
      c = getc (infile);
      while (c == ' ' || c == '\n' || c == '\t')
	c = getc (infile);

      if (c == '"')
	{
	  putc (037, outfile);
	  putc (defvarflag ? 'V' : 'F', outfile);
	  fprintf (outfile, "%s\n", buf);
	  c = read_c_string (infile, 1);

	  /* If this is a defun, find the arguments and print them.  If
	     this function takes MANY or UNEVALLED args, then the C source
	     won't give the names of the arguments, so we shouldn't bother
	     trying to find them.  */
	  if (defunflag && maxargs != -1)
	    {
	      char argbuf[1024], *p = argbuf;
	      while (c != ')')
		{
		  if (c < 0)
		    goto eof;
		  c = getc (infile);
		}
	      /* Skip into arguments.  */
	      while (c != '(')
		{
		  if (c < 0)
		    goto eof;
		  c = getc (infile);
		}
	      /* Copy arguments into ARGBUF.  */
	      *p++ = c;
	      do
		*p++ = c = getc (infile);
	      while (c != ')');
	      *p = '\0';
	      /* Output them.  */
	      fprintf (outfile, "\n\n");
	      write_c_args (outfile, buf, argbuf, minargs, maxargs);
	    }
	}
    }
 eof:
  fclose (infile);
  return 0;
}
\f
/* Read a file of Lisp code, compiled or interpreted.
 Looks for
  (defun NAME ARGS DOCSTRING ...)
  (defmacro NAME ARGS DOCSTRING ...)
  (autoload (quote NAME) FILE DOCSTRING ...)
  (defvar NAME VALUE DOCSTRING)
  (defconst NAME VALUE DOCSTRING)
  (fset (quote NAME) (make-byte-code ... DOCSTRING ...))
  (fset (quote NAME) #[... DOCSTRING ...])
  (defalias (quote NAME) #[... DOCSTRING ...])
 starting in column zero.
 (quote NAME) may appear as 'NAME as well.
 For defun, defmacro, and autoload, we know how to skip over the arglist.
 For defvar, defconst, and fset we skip to the docstring with a kludgy 
 formatting convention: all docstrings must appear on the same line as the
 initial open-paren (the one in column zero) and must contain a backslash 
 and a double-quote immediately after the initial double-quote.  No newlines
 must appear between the beginning of the form and the first double-quote.
 The only source file that must follow this convention is loaddefs.el; aside
 from that, it is always the .elc file that we look at, and they are no
 problem because byte-compiler output follows this convention.
 The NAME and DOCSTRING are output.
 NAME is preceded by `F' for a function or `V' for a variable.
 An entry is output only if DOCSTRING has \ newline just after the opening "
 */

void
skip_white (infile)
     FILE *infile;
{
  char c = ' ';
  while (c == ' ' || c == '\t' || c == '\n')
    c = getc (infile);
  ungetc (c, infile);
}

void
read_lisp_symbol (infile, buffer)
     FILE *infile;
     char *buffer;
{
  char c;
  char *fillp = buffer;

  skip_white (infile);
  while (1)
    {
      c = getc (infile);
      if (c == '\\')
	*(++fillp) = getc (infile);
      else if (c == ' ' || c == '\t' || c == '\n' || c == '(' || c == ')')
	{
	  ungetc (c, infile);
	  *fillp = 0;
	  break;
	}
      else
	*fillp++ = c;
    }

  if (! buffer[0])
    fprintf (stderr, "## expected a symbol, got '%c'\n", c);
  
  skip_white (infile);
}

int
scan_lisp_file (filename, mode)
     char *filename, *mode;
{
  FILE *infile;
  register int c;

  infile = fopen (filename, mode);
  if (infile == NULL)
    {
      perror (filename);
      return 0;				/* No error */
    }

  c = '\n';
  while (!feof (infile))
    {
      char buffer [BUFSIZ];
      char type;

      if (c != '\n')
	{
	  c = getc (infile);
	  continue;
	}
      c = getc (infile);
      if (c != '(')
	continue;

      read_lisp_symbol (infile, buffer);

      if (! strcmp (buffer, "defun") ||
	  ! strcmp (buffer, "defmacro"))
	{
	  type = 'F';
	  read_lisp_symbol (infile, buffer);

	  /* Skip the arguments: either "nil" or a list in parens */

	  c = getc (infile);
	  if (c == 'n') /* nil */
	    {
	      if ((c = getc (infile)) != 'i' ||
		  (c = getc (infile)) != 'l')
		{
		  fprintf (stderr, "## unparsable arglist in %s (%s)\n",
			   buffer, filename);
		  continue;
		}
	    }
	  else if (c != '(')
	    {
	      fprintf (stderr, "## unparsable arglist in %s (%s)\n",
		       buffer, filename);
	      continue;
	    }
	  else
	    while (c != ')')
	      c = getc (infile);
	  skip_white (infile);

	  /* If the next three characters aren't `dquote bslash newline'
	     then we're not reading a docstring.
	   */
	  if ((c = getc (infile)) != '"' ||
	      (c = getc (infile)) != '\\' ||
	      (c = getc (infile)) != '\n')
	    {
#ifdef DEBUG
	      fprintf (stderr, "## non-docstring in %s (%s)\n",
		       buffer, filename);
#endif
	      continue;
	    }
	}

      else if (! strcmp (buffer, "defvar") ||
	       ! strcmp (buffer, "defconst"))
	{
	  char c1 = 0, c2 = 0;
	  type = 'V';
	  read_lisp_symbol (infile, buffer);

	  /* Skip until the first newline; remember the two previous chars. */
	  while (c != '\n' && c >= 0)
	    {
	      c2 = c1;
	      c1 = c;
	      c = getc (infile);
	    }
	  
	  /* If two previous characters were " and \,
	     this is a doc string.  Otherwise, there is none.  */
	  if (c2 != '"' || c1 != '\\')
	    {
#ifdef DEBUG
	      fprintf (stderr, "## non-docstring in %s (%s)\n",
		       buffer, filename);
#endif
	      continue;
	    }
	}

      else if (! strcmp (buffer, "fset") || ! strcmp (buffer, "defalias"))
	{
	  char c1 = 0, c2 = 0;
	  type = 'F';

	  c = getc (infile);
	  if (c == '\'')
	    read_lisp_symbol (infile, buffer);
	  else
	    {
	      if (c != '(')
		{
		  fprintf (stderr, "## unparsable name in fset in %s\n",
			   filename);
		  continue;
		}
	      read_lisp_symbol (infile, buffer);
	      if (strcmp (buffer, "quote"))
		{
		  fprintf (stderr, "## unparsable name in fset in %s\n",
			   filename);
		  continue;
		}
	      read_lisp_symbol (infile, buffer);
	      c = getc (infile);
	      if (c != ')')
		{
		  fprintf (stderr,
			   "## unparsable quoted name in fset in %s\n",
			   filename);
		  continue;
		}
	    }

	  /* Skip until the first newline; remember the two previous chars. */
	  while (c != '\n' && c >= 0)
	    {
	      c2 = c1;
	      c1 = c;
	      c = getc (infile);
	    }
	  
	  /* If two previous characters were " and \,
	     this is a doc string.  Otherwise, there is none.  */
	  if (c2 != '"' || c1 != '\\')
	    {
#ifdef DEBUG
	      fprintf (stderr, "## non-docstring in %s (%s)\n",
		       buffer, filename);
#endif
	      continue;
	    }
	}

      else if (! strcmp (buffer, "autoload"))
	{
	  type = 'F';
	  c = getc (infile);
	  if (c == '\'')
	    read_lisp_symbol (infile, buffer);
	  else
	    {
	      if (c != '(')
		{
		  fprintf (stderr, "## unparsable name in autoload in %s\n",
			   filename);
		  continue;
		}
	      read_lisp_symbol (infile, buffer);
	      if (strcmp (buffer, "quote"))
		{
		  fprintf (stderr, "## unparsable name in autoload in %s\n",
			   filename);
		  continue;
		}
	      read_lisp_symbol (infile, buffer);
	      c = getc (infile);
	      if (c != ')')
		{
		  fprintf (stderr,
			   "## unparsable quoted name in autoload in %s\n",
			   filename);
		  continue;
		}
	    }
	  skip_white (infile);
	  if ((c = getc (infile)) != '\"')
	    {
	      fprintf (stderr, "## autoload of %s unparsable (%s)\n",
		       buffer, filename);
	      continue;
	    }
	  read_c_string (infile, 0);
	  skip_white (infile);

	  /* If the next three characters aren't `dquote bslash newline'
	     then we're not reading a docstring.
	   */
	  if ((c = getc (infile)) != '"' ||
	      (c = getc (infile)) != '\\' ||
	      (c = getc (infile)) != '\n')
	    {
#ifdef DEBUG
	      fprintf (stderr, "## non-docstring in %s (%s)\n",
		       buffer, filename);
#endif
	      continue;
	    }
	}

#ifdef DEBUG
      else if (! strcmp (buffer, "if") ||
	       ! strcmp (buffer, "byte-code"))
	;
#endif

      else
	{
#ifdef DEBUG
	  fprintf (stderr, "## unrecognised top-level form, %s (%s)\n",
		   buffer, filename);
#endif
	  continue;
	}

      /* At this point, there is a docstring that we should gobble.
	 The opening quote (and leading backslash-newline) have already
	 been read.
       */
      putc (037, outfile);
      putc (type, outfile);
      fprintf (outfile, "%s\n", buffer);
      read_c_string (infile, 1);
    }
  fclose (infile);
  return 0;
}
Commit	Line	Data
f2cc4248	1	/* Generate doc-string file for GNU Emacs from source files.
069ad9ea	2	Copyright (C) 1985, 1986, 1992, 1993, 1994 Free Software Foundation, Inc.
f2cc4248 RS	3
	4	This file is part of GNU Emacs.
	5
93320c23 JA	6	GNU Emacs is free software; you can redistribute it and/or modify
93320c23 JA	7	it under the terms of the GNU General Public License as published by
e065a56e	8	the Free Software Foundation; either version 2, or (at your option)
93320c23 JA	9	any later version.
93320c23 JA	10
f2cc4248	11	GNU Emacs is distributed in the hope that it will be useful,
93320c23 JA	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.
f2cc4248	15
93320c23 JA	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. */
f2cc4248 RS	19
	20	/* The arguments given to this program are all the C and Lisp source files
	21	of GNU Emacs. .elc and .el and .c files are allowed.
	22	A .o file can also be specified; the .c file it was made from is used.
	23	This helps the makefile pass the correct list of files.
	24
	25	The results, which go to standard output or to a file
	26	specified with -a or -o (-a to append, -o to start from nothing),
	27	are entries containing function or variable names and their documentation.
	28	Each entry starts with a ^_ character.
	29	Then comes F for a function or V for a variable.
	30	Then comes the function or variable name, terminated with a newline.
	31	Then comes the documentation for that function or variable.
	32	*/
	33
	34	#include <stdio.h>
e3938952 RS	35	#ifdef MSDOS
	36	#include <fcntl.h>
	37	#endif /* MSDOS */
86b0513a RS	38	#ifdef WINDOWSNT
	39	#include <stdlib.h>
	40	#include <fcntl.h>
	41	#include <direct.h>
	42	#endif /* WINDOWSNT */
e3938952	43
86b0513a	44	#ifdef DOS_NT
e3938952 RS	45	#define READ_TEXT "rt"
e3938952 RS	46	#define READ_BINARY "rb"
86b0513a	47	#else /* not DOS_NT */
e3938952 RS	48	#define READ_TEXT "r"
e3938952 RS	49	#define READ_BINARY "r"
86b0513a	50	#endif /* not DOS_NT */
f2cc4248	51
340ff9de DM	52	int scan_file ();
	53	int scan_lisp_file ();
	54	int scan_c_file ();
	55
f2cc4248 RS	56	FILE *outfile;
f2cc4248 RS	57
340ff9de	58	int
f2cc4248 RS	59	main (argc, argv)
	60	int argc;
	61	char **argv;
	62	{
	63	int i;
	64	int err_count = 0;
a27897c9	65	int first_infile;
f2cc4248	66
86b0513a	67	/* Don't put CRs in the DOC file. */
e3938952	68	#ifdef MSDOS
86b0513a	69	_fmode = O_BINARY;
e3938952 RS	70	(stdout)->_flag &= ~_IOTEXT;
	71	_setmode (fileno (stdout), O_BINARY);
	72	#endif /* MSDOS */
86b0513a RS	73	#ifdef WINDOWSNT
	74	_fmode = O_BINARY;
	75	_setmode (fileno (stdout), O_BINARY);
	76	#endif /* WINDOWSNT */
	77
f2cc4248 RS	78	outfile = stdout;
	79
	80	/* If first two args are -o FILE, output to FILE. */
	81	i = 1;
	82	if (argc > i + 1 && !strcmp (argv[i], "-o"))
	83	{
	84	outfile = fopen (argv[i + 1], "w");
	85	i += 2;
	86	}
	87	if (argc > i + 1 && !strcmp (argv[i], "-a"))
	88	{
	89	outfile = fopen (argv[i + 1], "a");
	90	i += 2;
	91	}
d2d92f7a JB	92	if (argc > i + 1 && !strcmp (argv[i], "-d"))
	93	{
	94	chdir (argv[i + 1]);
	95	i += 2;
	96	}
f2cc4248	97
a27897c9	98	first_infile = i;
f2cc4248	99	for (; i < argc; i++)
a27897c9 RS	100	{
	101	int j;
	102	/* Don't process one file twice. */
	103	for (j = first_infile; j < i; j++)
	104	if (! strcmp (argv[i], argv[j]))
	105	break;
	106	if (j == i)
	107	err_count += scan_file (argv[i]);
	108	}
f2cc4248	109	#ifndef VMS
a27897c9	110	exit (err_count > 0);
a706b808	111	#endif /* VMS */
a27897c9	112	return err_count > 0;
f2cc4248 RS	113	}
f2cc4248 RS	114
a8a7afbe	115	/* Read file FILENAME and output its doc strings to outfile. */
f2cc4248 RS	116	/* Return 1 if file is not found, 0 if it is found. */
f2cc4248 RS	117
340ff9de	118	int
f2cc4248 RS	119	scan_file (filename)
	120	char *filename;
	121	{
	122	int len = strlen (filename);
	123	if (!strcmp (filename + len - 4, ".elc"))
e3938952	124	return scan_lisp_file (filename, READ_BINARY);
f2cc4248	125	else if (!strcmp (filename + len - 3, ".el"))
e3938952	126	return scan_lisp_file (filename, READ_TEXT);
f2cc4248	127	else
e3938952	128	return scan_c_file (filename, READ_TEXT);
f2cc4248 RS	129	}
	130	\f
	131	char buf[128];
	132
	133	/* Skip a C string from INFILE,
	134	and return the character that follows the closing ".
a8a7afbe	135	If printflag is positive, output string contents to outfile.
f2cc4248 RS	136	If it is negative, store contents in buf.
	137	Convert escape sequences \n and \t to newline and tab;
	138	discard \ followed by newline. */
	139
340ff9de	140	int
f2cc4248 RS	141	read_c_string (infile, printflag)
	142	FILE *infile;
	143	int printflag;
	144	{
	145	register int c;
	146	char *p = buf;
	147
	148	c = getc (infile);
	149	while (c != EOF)
	150	{
	151	while (c != '"' && c != EOF)
	152	{
	153	if (c == '\\')
	154	{
	155	c = getc (infile);
	156	if (c == '\n')
	157	{
	158	c = getc (infile);
	159	continue;
	160	}
	161	if (c == 'n')
	162	c = '\n';
	163	if (c == 't')
	164	c = '\t';
	165	}
	166	if (printflag > 0)
	167	putc (c, outfile);
	168	else if (printflag < 0)
	169	*p++ = c;
	170	c = getc (infile);
	171	}
	172	c = getc (infile);
	173	if (c != '"')
	174	break;
d48e616e	175	/* If we had a "", concatenate the two strings. */
f2cc4248 RS	176	c = getc (infile);
	177	}
	178
	179	if (printflag < 0)
	180	*p = 0;
	181
	182	return c;
	183	}
	184	\f
069ad9ea	185	/* Write to file OUT the argument names of function FUNC, whose text is in BUF.
f2cc4248 RS	186	MINARGS and MAXARGS are the minimum and maximum number of arguments. */
f2cc4248 RS	187
340ff9de	188	void
069ad9ea	189	write_c_args (out, func, buf, minargs, maxargs)
f2cc4248	190	FILE *out;
069ad9ea	191	char func, buf;
f2cc4248 RS	192	int minargs, maxargs;
f2cc4248 RS	193	{
f125a9e8	194	register char *p;
30e4c427 JB	195	int in_ident = 0;
30e4c427 JB	196	int just_spaced = 0;
069ad9ea	197	int need_space = 1;
f2cc4248	198
069ad9ea RM	199	fprintf (out, "(%s", func);
	200
	201	if (*buf == '(')
	202	++buf;
f2cc4248	203
f125a9e8	204	for (p = buf; *p; p++)
f2cc4248	205	{
30e4c427	206	char c = *p;
3941a179	207	int ident_start = 0;
30e4c427 JB	208
	209	/* Notice when we start printing a new identifier. */
	210	if ((('A' <= c && c <= 'Z')
	211	\|\| ('a' <= c && c <= 'z')
	212	\|\| ('0' <= c && c <= '9')
	213	\|\| c == '_')
	214	!= in_ident)
f2cc4248	215	{
30e4c427 JB	216	if (!in_ident)
	217	{
	218	in_ident = 1;
3941a179	219	ident_start = 1;
f125a9e8	220
069ad9ea RM	221	if (need_space)
	222	putc (' ', out);
	223
30e4c427 JB	224	if (minargs == 0 && maxargs > 0)
	225	fprintf (out, "&optional ");
	226	just_spaced = 1;
f125a9e8	227
30e4c427 JB	228	minargs--;
	229	maxargs--;
	230	}
	231	else
	232	in_ident = 0;
f2cc4248	233	}
30e4c427 JB	234
	235	/* Print the C argument list as it would appear in lisp:
	236	print underscores as hyphens, and print commas as spaces.
	237	Collapse adjacent spaces into one. */
	238	if (c == '_') c = '-';
	239	if (c == ',') c = ' ';
	240
3941a179 JB	241	/* In C code, `default' is a reserved word, so we spell it
	242	`defalt'; unmangle that here. */
	243	if (ident_start
	244	&& strncmp (p, "defalt", 6) == 0
	245	&& ! (('A' <= p[6] && p[6] <= 'Z')
	246	\|\| ('a' <= p[6] && p[6] <= 'z')
	247	\|\| ('0' <= p[6] && p[6] <= '9')
	248	\|\| p[6] == '_'))
	249	{
4607ea99	250	fprintf (out, "DEFAULT");
3941a179 JB	251	p += 5;
	252	in_ident = 0;
	253	just_spaced = 0;
	254	}
	255	else if (c != ' ' \|\| ! just_spaced)
069ad9ea RM	256	{
	257	if (c >= 'a' && c <= 'z')
	258	/* Upcase the letter. */
	259	c += 'A' - 'a';
	260	putc (c, out);
	261	}
30e4c427 JB	262
30e4c427 JB	263	just_spaced = (c == ' ');
069ad9ea	264	need_space = 0;
f2cc4248	265	}
f2cc4248 RS	266	}
	267	\f
	268	/* Read through a c file. If a .o file is named,
	269	the corresponding .c file is read instead.
	270	Looks for DEFUN constructs such as are defined in ../src/lisp.h.
	271	Accepts any word starting DEF... so it finds DEFSIMPLE and DEFPRED. */
	272
340ff9de	273	int
e3938952 RS	274	scan_c_file (filename, mode)
e3938952 RS	275	char filename, mode;
f2cc4248 RS	276	{
	277	FILE *infile;
	278	register int c;
	279	register int commas;
	280	register int defunflag;
84128dee	281	register int defvarperbufferflag;
f2cc4248 RS	282	register int defvarflag;
	283	int minargs, maxargs;
	284
	285	if (filename[strlen (filename) - 1] == 'o')
	286	filename[strlen (filename) - 1] = 'c';
	287
e3938952	288	infile = fopen (filename, mode);
f2cc4248 RS	289
	290	/* No error if non-ex input file */
	291	if (infile == NULL)
	292	{
	293	perror (filename);
	294	return 0;
	295	}
	296
	297	c = '\n';
	298	while (!feof (infile))
	299	{
	300	if (c != '\n')
	301	{
	302	c = getc (infile);
	303	continue;
	304	}
	305	c = getc (infile);
	306	if (c == ' ')
	307	{
	308	while (c == ' ')
	309	c = getc (infile);
	310	if (c != 'D')
	311	continue;
	312	c = getc (infile);
	313	if (c != 'E')
	314	continue;
	315	c = getc (infile);
	316	if (c != 'F')
	317	continue;
	318	c = getc (infile);
	319	if (c != 'V')
	320	continue;
84128dee JB	321	c = getc (infile);
	322	if (c != 'A')
	323	continue;
	324	c = getc (infile);
	325	if (c != 'R')
	326	continue;
	327	c = getc (infile);
	328	if (c != '_')
	329	continue;
	330
f2cc4248 RS	331	defvarflag = 1;
f2cc4248 RS	332	defunflag = 0;
84128dee JB	333
	334	c = getc (infile);
	335	defvarperbufferflag = (c == 'P');
	336
f2cc4248 RS	337	c = getc (infile);
	338	}
	339	else if (c == 'D')
	340	{
	341	c = getc (infile);
	342	if (c != 'E')
	343	continue;
	344	c = getc (infile);
	345	if (c != 'F')
	346	continue;
	347	c = getc (infile);
	348	defunflag = c == 'U';
	349	defvarflag = 0;
	350	}
	351	else continue;
	352
	353	while (c != '(')
	354	{
	355	if (c < 0)
	356	goto eof;
	357	c = getc (infile);
	358	}
	359
	360	c = getc (infile);
	361	if (c != '"')
	362	continue;
	363	c = read_c_string (infile, -1);
	364
	365	if (defunflag)
	366	commas = 5;
84128dee JB	367	else if (defvarperbufferflag)
84128dee JB	368	commas = 2;
f2cc4248 RS	369	else if (defvarflag)
	370	commas = 1;
	371	else /* For DEFSIMPLE and DEFPRED */
	372	commas = 2;
	373
	374	while (commas)
	375	{
	376	if (c == ',')
	377	{
	378	commas--;
	379	if (defunflag && (commas == 1 \|\| commas == 2))
	380	{
	381	do
	382	c = getc (infile);
	383	while (c == ' ' \|\| c == '\n' \|\| c == '\t');
	384	if (c < 0)
	385	goto eof;
	386	ungetc (c, infile);
	387	if (commas == 2) /* pick up minargs */
	388	fscanf (infile, "%d", &minargs);
	389	else /* pick up maxargs */
	390	if (c == 'M' \|\| c == 'U') /* MANY \|\| UNEVALLED */
	391	maxargs = -1;
	392	else
	393	fscanf (infile, "%d", &maxargs);
	394	}
	395	}
	396	if (c < 0)
	397	goto eof;
	398	c = getc (infile);
	399	}
	400	while (c == ' ' \|\| c == '\n' \|\| c == '\t')
	401	c = getc (infile);
	402	if (c == '"')
	403	c = read_c_string (infile, 0);
	404	while (c != ',')
	405	c = getc (infile);
	406	c = getc (infile);
	407	while (c == ' ' \|\| c == '\n' \|\| c == '\t')
	408	c = getc (infile);
	409
	410	if (c == '"')
	411	{
	412	putc (037, outfile);
	413	putc (defvarflag ? 'V' : 'F', outfile);
	414	fprintf (outfile, "%s\n", buf);
772e2009 JB	415	c = read_c_string (infile, 1);
	416
	417	/* If this is a defun, find the arguments and print them. If
	418	this function takes MANY or UNEVALLED args, then the C source
	419	won't give the names of the arguments, so we shouldn't bother
	420	trying to find them. */
	421	if (defunflag && maxargs != -1)
f2cc4248 RS	422	{
	423	char argbuf[1024], *p = argbuf;
	424	while (c != ')')
	425	{
	426	if (c < 0)
	427	goto eof;
	428	c = getc (infile);
	429	}
	430	/* Skip into arguments. */
	431	while (c != '(')
	432	{
	433	if (c < 0)
	434	goto eof;
	435	c = getc (infile);
	436	}
	437	/* Copy arguments into ARGBUF. */
	438	*p++ = c;
	439	do
	440	*p++ = c = getc (infile);
	441	while (c != ')');
	442	*p = '\0';
	443	/* Output them. */
	444	fprintf (outfile, "\n\n");
069ad9ea	445	write_c_args (outfile, buf, argbuf, minargs, maxargs);
f2cc4248 RS	446	}
	447	}
	448	}
	449	eof:
	450	fclose (infile);
	451	return 0;
	452	}
	453	\f
	454	/* Read a file of Lisp code, compiled or interpreted.
	455	Looks for
	456	(defun NAME ARGS DOCSTRING ...)
23d6b5a6 JB	457	(defmacro NAME ARGS DOCSTRING ...)
23d6b5a6 JB	458	(autoload (quote NAME) FILE DOCSTRING ...)
f2cc4248 RS	459	(defvar NAME VALUE DOCSTRING)
f2cc4248 RS	460	(defconst NAME VALUE DOCSTRING)
23d6b5a6 JB	461	(fset (quote NAME) (make-byte-code ... DOCSTRING ...))
23d6b5a6 JB	462	(fset (quote NAME) #[... DOCSTRING ...])
2d6e2619	463	(defalias (quote NAME) #[... DOCSTRING ...])
f2cc4248	464	starting in column zero.
23d6b5a6 JB	465	(quote NAME) may appear as 'NAME as well.
23d6b5a6 JB	466	For defun, defmacro, and autoload, we know how to skip over the arglist.
eb8c3be9	467	For defvar, defconst, and fset we skip to the docstring with a kludgy
23d6b5a6 JB	468	formatting convention: all docstrings must appear on the same line as the
	469	initial open-paren (the one in column zero) and must contain a backslash
	470	and a double-quote immediately after the initial double-quote. No newlines
	471	must appear between the beginning of the form and the first double-quote.
	472	The only source file that must follow this convention is loaddefs.el; aside
	473	from that, it is always the .elc file that we look at, and they are no
	474	problem because byte-compiler output follows this convention.
f2cc4248 RS	475	The NAME and DOCSTRING are output.
	476	NAME is preceded by `F' for a function or `V' for a variable.
	477	An entry is output only if DOCSTRING has \ newline just after the opening "
	478	*/
	479
23d6b5a6 JB	480	void
	481	skip_white (infile)
	482	FILE *infile;
	483	{
	484	char c = ' ';
	485	while (c == ' ' \|\| c == '\t' \|\| c == '\n')
	486	c = getc (infile);
	487	ungetc (c, infile);
	488	}
	489
	490	void
	491	read_lisp_symbol (infile, buffer)
	492	FILE *infile;
	493	char *buffer;
	494	{
	495	char c;
	496	char *fillp = buffer;
	497
	498	skip_white (infile);
	499	while (1)
	500	{
	501	c = getc (infile);
	502	if (c == '\\')
	503	*(++fillp) = getc (infile);
	504	else if (c == ' ' \|\| c == '\t' \|\| c == '\n' \|\| c == '(' \|\| c == ')')
	505	{
	506	ungetc (c, infile);
	507	*fillp = 0;
	508	break;
	509	}
	510	else
	511	*fillp++ = c;
	512	}
	513
	514	if (! buffer[0])
	515	fprintf (stderr, "## expected a symbol, got '%c'\n", c);
	516
	517	skip_white (infile);
	518	}
	519
340ff9de	520	int
e3938952 RS	521	scan_lisp_file (filename, mode)
e3938952 RS	522	char filename, mode;
f2cc4248 RS	523	{
	524	FILE *infile;
	525	register int c;
f2cc4248	526
e3938952	527	infile = fopen (filename, mode);
f2cc4248 RS	528	if (infile == NULL)
	529	{
	530	perror (filename);
	531	return 0; /* No error */
	532	}
	533
	534	c = '\n';
	535	while (!feof (infile))
	536	{
23d6b5a6	537	char buffer [BUFSIZ];
23d6b5a6 JB	538	char type;
23d6b5a6 JB	539
f2cc4248 RS	540	if (c != '\n')
	541	{
	542	c = getc (infile);
	543	continue;
	544	}
	545	c = getc (infile);
	546	if (c != '(')
	547	continue;
a8a7afbe	548
23d6b5a6 JB	549	read_lisp_symbol (infile, buffer);
	550
	551	if (! strcmp (buffer, "defun") \|\|
	552	! strcmp (buffer, "defmacro"))
f2cc4248	553	{
23d6b5a6 JB	554	type = 'F';
23d6b5a6 JB	555	read_lisp_symbol (infile, buffer);
f2cc4248	556
23d6b5a6	557	/* Skip the arguments: either "nil" or a list in parens */
f2cc4248	558
23d6b5a6 JB	559	c = getc (infile);
23d6b5a6 JB	560	if (c == 'n') /* nil */
f2cc4248	561	{
23d6b5a6 JB	562	if ((c = getc (infile)) != 'i' \|\|
	563	(c = getc (infile)) != 'l')
	564	{
	565	fprintf (stderr, "## unparsable arglist in %s (%s)\n",
	566	buffer, filename);
	567	continue;
	568	}
f2cc4248	569	}
23d6b5a6	570	else if (c != '(')
f2cc4248	571	{
23d6b5a6 JB	572	fprintf (stderr, "## unparsable arglist in %s (%s)\n",
	573	buffer, filename);
	574	continue;
f2cc4248	575	}
23d6b5a6 JB	576	else
23d6b5a6 JB	577	while (c != ')')
f2cc4248	578	c = getc (infile);
23d6b5a6 JB	579	skip_white (infile);
	580
	581	/* If the next three characters aren't `dquote bslash newline'
	582	then we're not reading a docstring.
	583	*/
	584	if ((c = getc (infile)) != '"' \|\|
	585	(c = getc (infile)) != '\\' \|\|
	586	(c = getc (infile)) != '\n')
f2cc4248	587	{
23d6b5a6 JB	588	#ifdef DEBUG
	589	fprintf (stderr, "## non-docstring in %s (%s)\n",
	590	buffer, filename);
	591	#endif
	592	continue;
f2cc4248	593	}
f2cc4248	594	}
a8a7afbe	595
23d6b5a6 JB	596	else if (! strcmp (buffer, "defvar") \|\|
23d6b5a6 JB	597	! strcmp (buffer, "defconst"))
f2cc4248	598	{
23d6b5a6 JB	599	char c1 = 0, c2 = 0;
	600	type = 'V';
	601	read_lisp_symbol (infile, buffer);
a8a7afbe	602
23d6b5a6 JB	603	/* Skip until the first newline; remember the two previous chars. */
23d6b5a6 JB	604	while (c != '\n' && c >= 0)
f2cc4248	605	{
23d6b5a6 JB	606	c2 = c1;
23d6b5a6 JB	607	c1 = c;
f2cc4248	608	c = getc (infile);
f2cc4248	609	}
23d6b5a6 JB	610
	611	/* If two previous characters were " and \,
	612	this is a doc string. Otherwise, there is none. */
	613	if (c2 != '"' \|\| c1 != '\\')
f2cc4248	614	{
23d6b5a6 JB	615	#ifdef DEBUG
	616	fprintf (stderr, "## non-docstring in %s (%s)\n",
	617	buffer, filename);
	618	#endif
	619	continue;
f2cc4248	620	}
23d6b5a6 JB	621	}
23d6b5a6 JB	622
2d6e2619	623	else if (! strcmp (buffer, "fset") \|\| ! strcmp (buffer, "defalias"))
23d6b5a6 JB	624	{
	625	char c1 = 0, c2 = 0;
	626	type = 'F';
a8a7afbe	627
23d6b5a6 JB	628	c = getc (infile);
	629	if (c == '\'')
	630	read_lisp_symbol (infile, buffer);
	631	else
f2cc4248	632	{
23d6b5a6 JB	633	if (c != '(')
	634	{
	635	fprintf (stderr, "## unparsable name in fset in %s\n",
	636	filename);
	637	continue;
	638	}
	639	read_lisp_symbol (infile, buffer);
	640	if (strcmp (buffer, "quote"))
	641	{
	642	fprintf (stderr, "## unparsable name in fset in %s\n",
	643	filename);
	644	continue;
	645	}
	646	read_lisp_symbol (infile, buffer);
f2cc4248	647	c = getc (infile);
23d6b5a6 JB	648	if (c != ')')
	649	{
	650	fprintf (stderr,
	651	"## unparsable quoted name in fset in %s\n",
	652	filename);
	653	continue;
	654	}
f2cc4248	655	}
f2cc4248	656
23d6b5a6 JB	657	/* Skip until the first newline; remember the two previous chars. */
23d6b5a6 JB	658	while (c != '\n' && c >= 0)
f2cc4248	659	{
23d6b5a6 JB	660	c2 = c1;
23d6b5a6 JB	661	c1 = c;
f2cc4248 RS	662	c = getc (infile);
f2cc4248 RS	663	}
23d6b5a6 JB	664
	665	/* If two previous characters were " and \,
	666	this is a doc string. Otherwise, there is none. */
	667	if (c2 != '"' \|\| c1 != '\\')
	668	{
	669	#ifdef DEBUG
	670	fprintf (stderr, "## non-docstring in %s (%s)\n",
	671	buffer, filename);
	672	#endif
	673	continue;
	674	}
	675	}
f2cc4248	676
23d6b5a6 JB	677	else if (! strcmp (buffer, "autoload"))
	678	{
	679	type = 'F';
	680	c = getc (infile);
	681	if (c == '\'')
	682	read_lisp_symbol (infile, buffer);
	683	else
f2cc4248	684	{
23d6b5a6	685	if (c != '(')
f2cc4248	686	{
23d6b5a6 JB	687	fprintf (stderr, "## unparsable name in autoload in %s\n",
	688	filename);
	689	continue;
f2cc4248	690	}
23d6b5a6 JB	691	read_lisp_symbol (infile, buffer);
23d6b5a6 JB	692	if (strcmp (buffer, "quote"))
f2cc4248	693	{
23d6b5a6 JB	694	fprintf (stderr, "## unparsable name in autoload in %s\n",
	695	filename);
	696	continue;
f2cc4248	697	}
23d6b5a6	698	read_lisp_symbol (infile, buffer);
f2cc4248	699	c = getc (infile);
23d6b5a6	700	if (c != ')')
f2cc4248	701	{
23d6b5a6 JB	702	fprintf (stderr,
	703	"## unparsable quoted name in autoload in %s\n",
	704	filename);
	705	continue;
f2cc4248	706	}
23d6b5a6 JB	707	}
	708	skip_white (infile);
	709	if ((c = getc (infile)) != '\"')
	710	{
	711	fprintf (stderr, "## autoload of %s unparsable (%s)\n",
	712	buffer, filename);
f2cc4248 RS	713	continue;
f2cc4248 RS	714	}
23d6b5a6 JB	715	read_c_string (infile, 0);
	716	skip_white (infile);
	717
	718	/* If the next three characters aren't `dquote bslash newline'
	719	then we're not reading a docstring.
	720	*/
	721	if ((c = getc (infile)) != '"' \|\|
	722	(c = getc (infile)) != '\\' \|\|
	723	(c = getc (infile)) != '\n')
a8a7afbe	724	{
23d6b5a6 JB	725	#ifdef DEBUG
	726	fprintf (stderr, "## non-docstring in %s (%s)\n",
	727	buffer, filename);
	728	#endif
	729	continue;
a8a7afbe	730	}
a8a7afbe	731	}
f2cc4248	732
23d6b5a6 JB	733	#ifdef DEBUG
	734	else if (! strcmp (buffer, "if") \|\|
	735	! strcmp (buffer, "byte-code"))
	736	;
	737	#endif
f2cc4248	738
23d6b5a6 JB	739	else
	740	{
	741	#ifdef DEBUG
	742	fprintf (stderr, "## unrecognised top-level form, %s (%s)\n",
	743	buffer, filename);
	744	#endif
	745	continue;
	746	}
f2cc4248	747
23d6b5a6 JB	748	/* At this point, there is a docstring that we should gobble.
	749	The opening quote (and leading backslash-newline) have already
	750	been read.
	751	*/
f2cc4248	752	putc (037, outfile);
23d6b5a6 JB	753	putc (type, outfile);
23d6b5a6 JB	754	fprintf (outfile, "%s\n", buffer);
f2cc4248 RS	755	read_c_string (infile, 1);
	756	}
	757	fclose (infile);
	758	return 0;
	759	}