#define NO_SHORTNAMES
#include <config.h>
#undef main
#undef fopen
#undef chdir
#include <stdio.h>
#ifdef MSDOS
#include <fcntl.h>
#endif
#ifdef WINDOWSNT
#include <stdlib.h>
#include <fcntl.h>
#include <direct.h>
#endif
#ifdef DOS_NT
#define READ_TEXT "rt"
#define READ_BINARY "rb"
#else
#define READ_TEXT "r"
#define READ_BINARY "r"
#endif
#ifndef DIRECTORY_SEP
#ifdef MAC_OS8
#define DIRECTORY_SEP ':'
#else
#define DIRECTORY_SEP '/'
#endif
#endif
#ifndef IS_DIRECTORY_SEP
#define IS_DIRECTORY_SEP(_c_) ((_c_) == DIRECTORY_SEP)
#endif
int scan_file ();
int scan_lisp_file ();
int scan_c_file ();
#ifdef MSDOS
#undef chdir
#endif
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
FILE *outfile;
char *progname;
void
error (s1, s2)
char *s1, *s2;
{
fprintf (stderr, "%s: ", progname);
fprintf (stderr, s1, s2);
fprintf (stderr, "\n");
}
void
fatal (s1, s2)
char *s1, *s2;
{
error (s1, s2);
exit (EXIT_FAILURE);
}
void *
xmalloc (size)
unsigned int size;
{
void *result = (void *) malloc (size);
if (result == NULL)
fatal ("virtual memory exhausted", 0);
return result;
}
int
main (argc, argv)
int argc;
char **argv;
{
int i;
int err_count = 0;
int first_infile;
progname = argv[0];
outfile = stdout;
#ifdef MSDOS
_fmode = O_BINARY;
#if 0
(stdout)->_flag &= ~_IOTEXT;
_setmode (fileno (stdout), O_BINARY);
#endif
outfile = 0;
#endif
#ifdef WINDOWSNT
_fmode = O_BINARY;
_setmode (fileno (stdout), O_BINARY);
#endif
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;
}
if (outfile == 0)
fatal ("No output file specified", "");
first_infile = i;
for (; i < argc; i++)
{
int j;
for (j = first_infile; j < i; j++)
if (! strcmp (argv[i], argv[j]))
break;
if (j == i)
err_count += scan_file (argv[i]);
}
return (err_count > 0 ? EXIT_FAILURE : EXIT_SUCCESS);
}
void
put_filename (filename)
char *filename;
{
char *tmp;
for (tmp = filename; *tmp; tmp++)
{
if (IS_DIRECTORY_SEP(*tmp))
filename = tmp + 1;
}
putc (037, outfile);
putc ('S', outfile);
fprintf (outfile, "%s\n", filename);
}
int
scan_file (filename)
char *filename;
{
int len = strlen (filename);
put_filename (filename);
if (len > 4 && !strcmp (filename + len - 4, ".elc"))
return scan_lisp_file (filename, READ_BINARY);
else if (len > 3 && !strcmp (filename + len - 3, ".el"))
return scan_lisp_file (filename, READ_TEXT);
else
return scan_c_file (filename, READ_TEXT);
}
char buf[128];
struct rcsoc_state
{
unsigned pending_spaces, pending_newlines;
FILE *in_file;
char *buf_ptr;
FILE *out_file;
char *keyword;
char *cur_keyword_ptr;
int saw_keyword;
};
static INLINE void
put_char (ch, state)
int ch;
struct rcsoc_state *state;
{
int out_ch;
do
{
if (state->pending_newlines > 0)
{
state->pending_newlines--;
out_ch = '\n';
}
else if (state->pending_spaces > 0)
{
state->pending_spaces--;
out_ch = ' ';
}
else
out_ch = ch;
if (state->out_file)
putc (out_ch, state->out_file);
if (state->buf_ptr)
*state->buf_ptr++ = out_ch;
}
while (out_ch != ch);
}
static void
scan_keyword_or_put_char (ch, state)
int ch;
struct rcsoc_state *state;
{
if (state->keyword
&& *state->cur_keyword_ptr == ch
&& (state->cur_keyword_ptr > state->keyword
|| state->pending_newlines > 0))
{
if (*++state->cur_keyword_ptr == '\0')
{
state->saw_keyword = 1;
state->cur_keyword_ptr = state->keyword;
state->pending_newlines = 2;
state->pending_spaces = 0;
do
ch = getc (state->in_file);
while (ch == ' ' || ch == '\n');
put_char (ch, state);
do
ch = getc (state->in_file);
while (ch != ' ' && ch != ')');
put_char ('f', state);
put_char ('n', state);
ungetc (ch, state->in_file);
}
}
else
{
if (state->keyword && state->cur_keyword_ptr > state->keyword)
{
char *p;
for (p = state->keyword; p < state->cur_keyword_ptr; p++)
put_char (*p, state);
state->cur_keyword_ptr = state->keyword;
}
put_char (ch, state);
}
}
int
read_c_string_or_comment (infile, printflag, comment, saw_usage)
FILE *infile;
int printflag;
int *saw_usage;
int comment;
{
register int c;
struct rcsoc_state state;
state.in_file = infile;
state.buf_ptr = (printflag < 0 ? buf : 0);
state.out_file = (printflag > 0 ? outfile : 0);
state.pending_spaces = 0;
state.pending_newlines = 0;
state.keyword = (saw_usage ? "usage:" : 0);
state.cur_keyword_ptr = state.keyword;
state.saw_keyword = 0;
c = getc (infile);
if (comment)
while (c == '\n' || c == '\r' || c == '\t' || c == ' ')
c = getc (infile);
while (c != EOF)
{
while (c != EOF && (comment ? c != '*' : c != '"'))
{
if (c == '\\')
{
c = getc (infile);
if (c == '\n' || c == '\r')
{
c = getc (infile);
continue;
}
if (c == 'n')
c = '\n';
if (c == 't')
c = '\t';
}
if (c == ' ')
state.pending_spaces++;
else if (c == '\n')
{
state.pending_newlines++;
state.pending_spaces = 0;
}
else
scan_keyword_or_put_char (c, &state);
c = getc (infile);
}
if (c != EOF)
c = getc (infile);
if (comment)
{
if (c == '/')
{
c = getc (infile);
break;
}
scan_keyword_or_put_char ('*', &state);
}
else
{
if (c != '"')
break;
c = getc (infile);
}
}
if (printflag < 0)
*state.buf_ptr = 0;
if (saw_usage)
*saw_usage = state.saw_keyword;
return c;
}
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, "(fn");
if (*buf == '(')
++buf;
for (p = buf; *p; p++)
{
char c = *p;
int ident_start = 0;
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;
}
if (c == '_')
c = '-';
else if (c == ',' || c == '\n')
c = ' ';
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')
c += 'A' - 'a';
putc (c, out);
}
just_spaced = c == ' ';
need_space = 0;
}
}
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;
int extension = filename[strlen (filename) - 1];
if (extension == 'o')
filename[strlen (filename) - 1] = 'c';
infile = fopen (filename, mode);
if (infile == NULL)
{
perror (filename);
return 0;
}
filename[strlen (filename) - 1] = extension;
c = '\n';
while (!feof (infile))
{
int doc_keyword = 0;
if (c != '\n' && c != '\r')
{
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;
defvarperbufferflag = 0;
}
else continue;
while (c != '(')
{
if (c < 0)
goto eof;
c = getc (infile);
}
c = getc (infile);
if (c != '"')
continue;
c = read_c_string_or_comment (infile, -1, 0, 0);
if (defunflag)
commas = 5;
else if (defvarperbufferflag)
commas = 2;
else if (defvarflag)
commas = 1;
else
commas = 2;
while (commas)
{
if (c == ',')
{
commas--;
if (defunflag && (commas == 1 || commas == 2))
{
do
c = getc (infile);
while (c == ' ' || c == '\n' || c == '\r' || c == '\t');
if (c < 0)
goto eof;
ungetc (c, infile);
if (commas == 2)
fscanf (infile, "%d", &minargs);
else
if (c == 'M' || c == 'U')
maxargs = -1;
else
fscanf (infile, "%d", &maxargs);
}
}
if (c == EOF)
goto eof;
c = getc (infile);
}
while (c == ' ' || c == '\n' || c == '\r' || c == '\t')
c = getc (infile);
if (c == '"')
c = read_c_string_or_comment (infile, 0, 0, 0);
while (c != EOF && c != ',' && c != '/')
c = getc (infile);
if (c == ',')
{
c = getc (infile);
while (c == ' ' || c == '\n' || c == '\r' || c == '\t')
c = getc (infile);
while ((c >= 'a' && c <= 'z') || (c >= 'Z' && c <= 'Z'))
c = getc (infile);
if (c == ':')
{
doc_keyword = 1;
c = getc (infile);
while (c == ' ' || c == '\n' || c == '\r' || c == '\t')
c = getc (infile);
}
}
if (c == '"'
|| (c == '/'
&& (c = getc (infile),
ungetc (c, infile),
c == '*')))
{
int comment = c != '"';
int saw_usage;
putc (037, outfile);
putc (defvarflag ? 'V' : 'F', outfile);
fprintf (outfile, "%s\n", buf);
if (comment)
getc (infile);
c = read_c_string_or_comment (infile, 1, comment, &saw_usage);
if (defunflag && maxargs != -1 && !saw_usage)
{
char argbuf[1024], *p = argbuf;
if (!comment || doc_keyword)
while (c != ')')
{
if (c < 0)
goto eof;
c = getc (infile);
}
while (c != '(')
{
if (c < 0)
goto eof;
c = getc (infile);
}
*p++ = c;
do
*p++ = c = getc (infile);
while (c != ')');
*p = '\0';
fprintf (outfile, "\n\n");
write_c_args (outfile, buf, argbuf, minargs, maxargs);
}
else if (defunflag && maxargs == -1 && !saw_usage)
fprintf (stderr, "Missing `usage' for function `%s'.\n", buf);
}
}
eof:
fclose (infile);
return 0;
}
void
skip_white (infile)
FILE *infile;
{
char c = ' ';
while (c == ' ' || c == '\t' || c == '\n' || c == '\r')
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 == '\r' || 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;
char *saved_string = 0;
infile = fopen (filename, mode);
if (infile == NULL)
{
perror (filename);
return 0;
}
c = '\n';
while (!feof (infile))
{
char buffer[BUFSIZ];
char type;
if (c != '\n' && c != '\r')
{
c = getc (infile);
continue;
}
while (c == '\n' || c == '\r')
c = getc (infile);
if (c == '#')
{
c = getc (infile);
if (c == '@')
{
int length = 0;
int i;
while ((c = getc (infile),
c >= '0' && c <= '9'))
{
length *= 10;
length += c - '0';
}
length--;
if (saved_string != 0)
free (saved_string);
saved_string = (char *) malloc (length);
for (i = 0; i < length; i++)
saved_string[i] = getc (infile);
saved_string[length - 1] = 0;
while (c == '\n' && c == '\r')
c = getc (infile);
while (c != '\n' && c != '\r')
c = getc (infile);
}
continue;
}
if (c != '(')
continue;
read_lisp_symbol (infile, buffer);
if (! strcmp (buffer, "defun")
|| ! strcmp (buffer, "defmacro")
|| ! strcmp (buffer, "defsubst"))
{
type = 'F';
read_lisp_symbol (infile, buffer);
c = getc (infile);
if (c == 'n')
{
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 ((c = getc (infile)) != '"'
|| (c = getc (infile)) != '\\'
|| ((c = getc (infile)) != '\n' && c != '\r'))
{
#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);
if (saved_string == 0)
{
while (c != '\n' && c != '\r' && c >= 0)
{
c2 = c1;
c1 = c;
c = getc (infile);
}
if (c2 != '"' || c1 != '\\')
{
#ifdef DEBUG
fprintf (stderr, "## non-docstring in %s (%s)\n",
buffer, filename);
#endif
continue;
}
}
}
else if (! strcmp (buffer, "custom-declare-variable"))
{
char c1 = 0, c2 = 0;
type = 'V';
c = getc (infile);
if (c == '\'')
read_lisp_symbol (infile, buffer);
else
{
if (c != '(')
{
fprintf (stderr,
"## unparsable name in custom-declare-variable in %s\n",
filename);
continue;
}
read_lisp_symbol (infile, buffer);
if (strcmp (buffer, "quote"))
{
fprintf (stderr,
"## unparsable name in custom-declare-variable in %s\n",
filename);
continue;
}
read_lisp_symbol (infile, buffer);
c = getc (infile);
if (c != ')')
{
fprintf (stderr,
"## unparsable quoted name in custom-declare-variable in %s\n",
filename);
continue;
}
}
if (saved_string == 0)
{
while (c != '\n' && c != '\r' && c >= 0)
{
c2 = c1;
c1 = c;
c = getc (infile);
}
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;
}
}
if (saved_string == 0)
{
while (c != '\n' && c != '\r' && c >= 0)
{
c2 = c1;
c1 = c;
c = getc (infile);
}
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_or_comment (infile, 0, 0, 0);
skip_white (infile);
if (saved_string == 0)
{
if ((c = getc (infile)) != '"'
|| (c = getc (infile)) != '\\'
|| ((c = getc (infile)) != '\n' && c != '\r'))
{
#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;
}
putc (037, outfile);
putc (type, outfile);
fprintf (outfile, "%s\n", buffer);
if (saved_string)
{
fputs (saved_string, outfile);
free (saved_string);
saved_string = 0;
}
else
read_c_string_or_comment (infile, 1, 0, 0);
}
fclose (infile);
return 0;
}