static void
scan_lisp_file (const char *filename, const char *mode)
{
FILE *infile;
int c;
char *saved_string = 0;
/* These are the only files that are loaded uncompiled, and must
follow the conventions of the doc strings expected by this
function. These conventions are automatically followed by the
byte compiler when it produces the .elc files. */
static struct {
const char *fn;
int fl;
} const uncompiled[] = {
DEF_ELISP_FILE (loaddefs.el),
DEF_ELISP_FILE (loadup.el),
DEF_ELISP_FILE (charprop.el),
DEF_ELISP_FILE (cp51932.el),
DEF_ELISP_FILE (eucjp-ms.el)
};
int i;
int flen = strlen (filename);
if (generate_globals)
fatal ("scanning lisp file when -g specified");
if (flen > 3 && !strcmp (filename + flen - 3, ".el"))
{
bool match = false;
for (i = 0; i < sizeof (uncompiled) / sizeof (uncompiled[0]); i++)
{
if (uncompiled[i].fl <= flen
&& !strcmp (filename + flen - uncompiled[i].fl, uncompiled[i].fn)
&& (flen == uncompiled[i].fl
|| IS_SLASH (filename[flen - uncompiled[i].fl - 1])))
{
match = true;
break;
}
}
if (!match)
fatal ("uncompiled lisp file %s is not supported", filename);
}
infile = fopen (filename, mode);
if (infile == NULL)
{
perror (filename);
exit (EXIT_FAILURE);
}
c = '\n';
while (!feof (infile))
{
char buffer[BUFSIZ];
char type;
/* If not at end of line, skip till we get to one. */
if (c != '\n' && c != '\r')
{
c = getc (infile);
continue;
}
/* Skip the line break. */
while (c == '\n' || c == '\r')
c = getc (infile);
/* Detect a dynamic doc string and save it for the next expression. */
if (c == '#')
{
c = getc (infile);
if (c == '@')
{
ptrdiff_t length = 0;
ptrdiff_t i;
/* Read the length. */
while ((c = getc (infile),
c >= '0' && c <= '9'))
{
if (INT_MULTIPLY_WRAPV (length, 10, &length)
|| INT_ADD_WRAPV (length, c - '0', &length)
|| SIZE_MAX < length)
memory_exhausted ();
}
if (length <= 1)
fatal ("invalid dynamic doc string length");
if (c != ' ')
fatal ("space not found after dynamic doc string length");
/* The next character is a space that is counted in the length
but not part of the doc string.
We already read it, so just ignore it. */
length--;
/* Read in the contents. */
free (saved_string);
saved_string = xmalloc (length);
for (i = 0; i < length; i++)
saved_string[i] = getc (infile);
/* The last character is a ^_.
That is needed in the .elc file
but it is redundant in DOC. So get rid of it here. */
saved_string[length - 1] = 0;
/* Skip the line break. */
while (c == '\n' || c == '\r')
c = getc (infile);
/* Skip the following line. */
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);
/* 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' && c != '\r'))
{
#ifdef DEBUG
fprintf (stderr, "## non-docstring in %s (%s)\n",
buffer, filename);
#endif
continue;
}
}
/* defcustom can only occur in uncompiled Lisp files. */
else if (! strcmp (buffer, "defvar")
|| ! strcmp (buffer, "defconst")
|| ! strcmp (buffer, "defcustom"))
{
type = 'V';
read_lisp_symbol (infile, buffer);
if (saved_string == 0)
if (!search_lisp_doc_at_eol (infile))
continue;
}
else if (! strcmp (buffer, "custom-declare-variable")
|| ! strcmp (buffer, "defvaralias")
)
{
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)
if (!search_lisp_doc_at_eol (infile))
continue;
}
else if (! strcmp (buffer, "fset") || ! strcmp (buffer, "defalias"))
{
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)
if (!search_lisp_doc_at_eol (infile))
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, false, 0);
if (saved_string == 0)
if (!search_lisp_doc_at_eol (infile))
continue;
}
#ifdef DEBUG
else if (! strcmp (buffer, "if")
|| ! strcmp (buffer, "byte-code"))
continue;
#endif
else
{
#ifdef DEBUG
fprintf (stderr, "## unrecognized top-level form, %s (%s)\n",
buffer, filename);
#endif
continue;
}
/* At this point, we should either use the previous dynamic doc string in
saved_string or gobble a doc string from the input file.
In the latter case, the opening quote (and leading backslash-newline)
have already been read. */
printf ("\037%c%s\n", type, buffer);
if (saved_string)
{
fputs (saved_string, stdout);
/* Don't use one dynamic doc string twice. */
free (saved_string);
saved_string = 0;
}
else
read_c_string_or_comment (infile, 1, false, 0);
}
free (saved_string);
if (ferror (infile) || fclose (infile) != 0)
fatal ("%s: read error", filename);
}
static void
smc_save_yourself_CB (SmcConn smcConn,
SmPointer clientData,
int saveType,
Bool shutdown,
int interactStyle,
Bool fast)
{
#define NR_PROPS 5
SmProp *props[NR_PROPS];
SmProp prop_ptr[NR_PROPS];
SmPropValue values[20], *vp;
int val_idx = 0, vp_idx = 0;
int props_idx = 0;
int i;
char *smid_opt, *chdir_opt = NULL;
Lisp_Object user_login_name = Fuser_login_name (Qnil);
/* Must have these. */
if (! STRINGP (Vinvocation_name) || ! STRINGP (user_login_name))
return;
/* How to start a new instance of Emacs. */
props[props_idx] = &prop_ptr[props_idx];
props[props_idx]->name = xstrdup (SmCloneCommand);
props[props_idx]->type = xstrdup (SmLISTofARRAY8);
props[props_idx]->num_vals = 1;
props[props_idx]->vals = &values[val_idx++];
props[props_idx]->vals[0].length = strlen (emacs_program);
props[props_idx]->vals[0].value = emacs_program;
++props_idx;
/* The name of the program. */
props[props_idx] = &prop_ptr[props_idx];
props[props_idx]->name = xstrdup (SmProgram);
props[props_idx]->type = xstrdup (SmARRAY8);
props[props_idx]->num_vals = 1;
props[props_idx]->vals = &values[val_idx++];
props[props_idx]->vals[0].length = SBYTES (Vinvocation_name);
props[props_idx]->vals[0].value = SDATA (Vinvocation_name);
++props_idx;
/* User id. */
props[props_idx] = &prop_ptr[props_idx];
props[props_idx]->name = xstrdup (SmUserID);
props[props_idx]->type = xstrdup (SmARRAY8);
props[props_idx]->num_vals = 1;
props[props_idx]->vals = &values[val_idx++];
props[props_idx]->vals[0].length = SBYTES (user_login_name);
props[props_idx]->vals[0].value = SDATA (user_login_name);
++props_idx;
char *cwd = get_current_dir_name ();
if (cwd)
{
props[props_idx] = &prop_ptr[props_idx];
props[props_idx]->name = xstrdup (SmCurrentDirectory);
props[props_idx]->type = xstrdup (SmARRAY8);
props[props_idx]->num_vals = 1;
props[props_idx]->vals = &values[val_idx++];
props[props_idx]->vals[0].length = strlen (cwd);
props[props_idx]->vals[0].value = cwd;
++props_idx;
}
/* How to restart Emacs. */
props[props_idx] = &prop_ptr[props_idx];
props[props_idx]->name = xstrdup (SmRestartCommand);
props[props_idx]->type = xstrdup (SmLISTofARRAY8);
/* /path/to/emacs, --smid=xxx --no-splash --chdir=dir ... */
if (INT_ADD_WRAPV (initial_argc, 3, &i))
memory_full (SIZE_MAX);
props[props_idx]->num_vals = i;
vp = xnmalloc (i, sizeof *vp);
props[props_idx]->vals = vp;
props[props_idx]->vals[vp_idx].length = strlen (emacs_program);
props[props_idx]->vals[vp_idx++].value = emacs_program;
smid_opt = xmalloc (strlen (SMID_OPT) + strlen (client_id) + 1);
strcpy (stpcpy (smid_opt, SMID_OPT), client_id);
props[props_idx]->vals[vp_idx].length = strlen (smid_opt);
props[props_idx]->vals[vp_idx++].value = smid_opt;
props[props_idx]->vals[vp_idx].length = strlen (NOSPLASH_OPT);
props[props_idx]->vals[vp_idx++].value = NOSPLASH_OPT;
if (cwd)
{
chdir_opt = xmalloc (strlen (CHDIR_OPT) + strlen (cwd) + 1);
strcpy (stpcpy (chdir_opt, CHDIR_OPT), cwd);
props[props_idx]->vals[vp_idx].length = strlen (chdir_opt);
props[props_idx]->vals[vp_idx++].value = chdir_opt;
}
for (i = 1; i < initial_argc; ++i)
{
props[props_idx]->vals[vp_idx].length = strlen (initial_argv[i]);
props[props_idx]->vals[vp_idx++].value = initial_argv[i];
}
++props_idx;
SmcSetProperties (smcConn, props_idx, props);
xfree (smid_opt);
xfree (chdir_opt);
xfree (cwd);
xfree (vp);
for (i = 0; i < props_idx; ++i)
{
xfree (props[i]->type);
xfree (props[i]->name);
}
/* See if we maybe shall interact with the user. */
if (interactStyle != SmInteractStyleAny
|| ! shutdown
|| saveType == SmSaveLocal
|| ! SmcInteractRequest (smcConn, SmDialogNormal, smc_interact_CB, 0))
{
/* No interaction, we are done saving ourself. */
SmcSaveYourselfDone (smcConn, True);
}
}
ptrdiff_t
doprnt (char *buffer, ptrdiff_t bufsize, const char *format,
const char *format_end, va_list ap)
{
const char *fmt = format; /* Pointer into format string. */
char *bufptr = buffer; /* Pointer into output buffer. */
/* Enough to handle floating point formats with large numbers. */
enum { SIZE_BOUND_EXTRA = DBL_MAX_10_EXP + 50 };
/* Use this for sprintf unless we need something really big. */
char tembuf[SIZE_BOUND_EXTRA + 50];
/* Size of sprintf_buffer. */
ptrdiff_t size_allocated = sizeof (tembuf);
/* Buffer to use for sprintf. Either tembuf or same as BIG_BUFFER. */
char *sprintf_buffer = tembuf;
/* Buffer we have got with malloc. */
char *big_buffer = NULL;
enum text_quoting_style quoting_style = text_quoting_style ();
ptrdiff_t tem = -1;
char *string;
char fixed_buffer[20]; /* Default buffer for small formatting. */
char *fmtcpy;
int minlen;
char charbuf[MAX_MULTIBYTE_LENGTH + 1]; /* Used for %c. */
USE_SAFE_ALLOCA;
if (format_end == 0)
format_end = format + strlen (format);
fmtcpy = (format_end - format < sizeof (fixed_buffer) - 1
? fixed_buffer
: SAFE_ALLOCA (format_end - format + 1));
bufsize--;
/* Loop until end of format string or buffer full. */
while (fmt < format_end && bufsize > 0)
{
char const *fmt0 = fmt;
char fmtchar = *fmt++;
if (fmtchar == '%')
{
ptrdiff_t size_bound = 0;
ptrdiff_t width; /* Columns occupied by STRING on display. */
enum {
pDlen = sizeof pD - 1,
pIlen = sizeof pI - 1,
pMlen = sizeof pMd - 2
};
enum {
no_modifier, long_modifier, pD_modifier, pI_modifier, pM_modifier
} length_modifier = no_modifier;
static char const modifier_len[] = { 0, 1, pDlen, pIlen, pMlen };
int maxmlen = max (max (1, pDlen), max (pIlen, pMlen));
int mlen;
/* Copy this one %-spec into fmtcpy. */
string = fmtcpy;
*string++ = '%';
while (fmt < format_end)
{
*string++ = *fmt;
if ('0' <= *fmt && *fmt <= '9')
{
/* Get an idea of how much space we might need.
This might be a field width or a precision; e.g.
%1.1000f and %1000.1f both might need 1000+ bytes.
Parse the width or precision, checking for overflow. */
int n = *fmt - '0';
bool overflow = false;
while (fmt + 1 < format_end
&& '0' <= fmt[1] && fmt[1] <= '9')
{
overflow |= INT_MULTIPLY_WRAPV (n, 10, &n);
overflow |= INT_ADD_WRAPV (n, fmt[1] - '0', &n);
*string++ = *++fmt;
}
if (overflow
|| min (PTRDIFF_MAX, SIZE_MAX) - SIZE_BOUND_EXTRA < n)
error ("Format width or precision too large");
if (size_bound < n)
size_bound = n;
}
else if (! (*fmt == '-' || *fmt == ' ' || *fmt == '.'
|| *fmt == '+'))
break;
fmt++;
}
/* Check for the length modifiers in textual length order, so
that longer modifiers override shorter ones. */
for (mlen = 1; mlen <= maxmlen; mlen++)
{
if (format_end - fmt < mlen)
break;
if (mlen == 1 && *fmt == 'l')
length_modifier = long_modifier;
if (mlen == pDlen && memcmp (fmt, pD, pDlen) == 0)
length_modifier = pD_modifier;
if (mlen == pIlen && memcmp (fmt, pI, pIlen) == 0)
length_modifier = pI_modifier;
if (mlen == pMlen && memcmp (fmt, pMd, pMlen) == 0)
length_modifier = pM_modifier;
}
mlen = modifier_len[length_modifier];
memcpy (string, fmt + 1, mlen);
string += mlen;
fmt += mlen;
*string = 0;
/* Make the size bound large enough to handle floating point formats
with large numbers. */
size_bound += SIZE_BOUND_EXTRA;
/* Make sure we have that much. */
if (size_bound > size_allocated)
{
if (big_buffer)
xfree (big_buffer);
big_buffer = xmalloc (size_bound);
sprintf_buffer = big_buffer;
size_allocated = size_bound;
}
minlen = 0;
switch (*fmt++)
{
default:
error ("Invalid format operation %s", fmtcpy);
/* case 'b': */
case 'l':
case 'd':
switch (length_modifier)
{
case no_modifier:
{
int v = va_arg (ap, int);
tem = sprintf (sprintf_buffer, fmtcpy, v);
}
break;
case long_modifier:
{
long v = va_arg (ap, long);
tem = sprintf (sprintf_buffer, fmtcpy, v);
}
break;
case pD_modifier:
signed_pD_modifier:
{
ptrdiff_t v = va_arg (ap, ptrdiff_t);
tem = sprintf (sprintf_buffer, fmtcpy, v);
}
break;
case pI_modifier:
{
EMACS_INT v = va_arg (ap, EMACS_INT);
tem = sprintf (sprintf_buffer, fmtcpy, v);
}
break;
case pM_modifier:
{
intmax_t v = va_arg (ap, intmax_t);
tem = sprintf (sprintf_buffer, fmtcpy, v);
}
break;
}
/* Now copy into final output, truncating as necessary. */
string = sprintf_buffer;
goto doit;
case 'o':
case 'x':
switch (length_modifier)
{
case no_modifier:
{
unsigned v = va_arg (ap, unsigned);
tem = sprintf (sprintf_buffer, fmtcpy, v);
}
break;
case long_modifier:
{
unsigned long v = va_arg (ap, unsigned long);
tem = sprintf (sprintf_buffer, fmtcpy, v);
}
break;
case pD_modifier:
goto signed_pD_modifier;
case pI_modifier:
{
EMACS_UINT v = va_arg (ap, EMACS_UINT);
tem = sprintf (sprintf_buffer, fmtcpy, v);
}
break;
case pM_modifier:
{
uintmax_t v = va_arg (ap, uintmax_t);
tem = sprintf (sprintf_buffer, fmtcpy, v);
}
break;
}
/* Now copy into final output, truncating as necessary. */
string = sprintf_buffer;
goto doit;
case 'f':
case 'e':
case 'g':
{
double d = va_arg (ap, double);
tem = sprintf (sprintf_buffer, fmtcpy, d);
/* Now copy into final output, truncating as necessary. */
string = sprintf_buffer;
goto doit;
}
case 'S':
string[-1] = 's';
FALLTHROUGH;
case 's':
if (fmtcpy[1] != 's')
minlen = atoi (&fmtcpy[1]);
string = va_arg (ap, char *);
tem = strlen (string);
if (STRING_BYTES_BOUND < tem)
error ("String for %%s or %%S format is too long");
width = strwidth (string, tem);
goto doit1;
/* Copy string into final output, truncating if no room. */
doit:
eassert (0 <= tem);
/* Coming here means STRING contains ASCII only. */
if (STRING_BYTES_BOUND < tem)
error ("Format width or precision too large");
width = tem;
doit1:
/* We have already calculated:
TEM -- length of STRING,
WIDTH -- columns occupied by STRING when displayed, and
MINLEN -- minimum columns of the output. */
if (minlen > 0)
{
while (minlen > width && bufsize > 0)
{
*bufptr++ = ' ';
bufsize--;
minlen--;
}
minlen = 0;
}
if (tem > bufsize)
{
/* Truncate the string at character boundary. */
tem = bufsize;
do
{
tem--;
if (CHAR_HEAD_P (string[tem]))
{
if (BYTES_BY_CHAR_HEAD (string[tem]) <= bufsize - tem)
tem = bufsize;
break;
}
}
while (tem != 0);
memcpy (bufptr, string, tem);
bufptr[tem] = 0;
/* Trigger exit from the loop, but make sure we
return to the caller a value which will indicate
that the buffer was too small. */
bufptr += bufsize;
bufsize = 0;
continue;
}
memcpy (bufptr, string, tem);
bufptr += tem;
bufsize -= tem;
if (minlen < 0)
{
while (minlen < - width && bufsize > 0)
{
*bufptr++ = ' ';
bufsize--;
minlen++;
}
minlen = 0;
}
continue;
case 'c':
{
int chr = va_arg (ap, int);
tem = CHAR_STRING (chr, (unsigned char *) charbuf);
string = charbuf;
string[tem] = 0;
width = strwidth (string, tem);
if (fmtcpy[1] != 'c')
minlen = atoi (&fmtcpy[1]);
goto doit1;
}
case '%':
/* Treat this '%' as normal. */
fmt0 = fmt - 1;
break;
}
}
char const *src;
ptrdiff_t srclen;
if (quoting_style == CURVE_QUOTING_STYLE && fmtchar == '`')
src = uLSQM, srclen = sizeof uLSQM - 1;
else if (quoting_style == CURVE_QUOTING_STYLE && fmtchar == '\'')
src = uRSQM, srclen = sizeof uRSQM - 1;
else if (quoting_style == STRAIGHT_QUOTING_STYLE && fmtchar == '`')
src = "'", srclen = 1;
else
{
while (fmt < format_end && !CHAR_HEAD_P (*fmt))
fmt++;
src = fmt0, srclen = fmt - fmt0;
}
if (bufsize < srclen)
{
/* Truncate, but return value that will signal to caller
that the buffer was too small. */
do
*bufptr++ = '\0';
while (--bufsize != 0);
}
else
{
do
*bufptr++ = *src++;
while (--srclen != 0);
}
}
