#include <config.h>
#include <limits.h>
#include <setjmp.h>
+#include <stdio.h>
#include "lisp.h"
#include "blockinput.h"
#include "commands.h"
static Lisp_Object Qdeclare;
Lisp_Object Qinternal_interpreter_environment, Qclosure;
-static Lisp_Object Qdebug;
+Lisp_Object Qdebug;
/* This holds either the symbol `run-hooks' or nil.
It is nil at an early stage of startup, and when Emacs
static void unwind_to_catch (struct catchtag *, Lisp_Object) NO_RETURN;
static int interactive_p (int);
static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args);
-INFUN (Ffetch_bytecode, 1);
+static Lisp_Object Ffetch_bytecode (Lisp_Object);
\f
void
init_eval_once (void)
return val;
}
-DEFUE ("progn", Fprogn, Sprogn, 0, UNEVALLED, 0,
+DEFUN ("progn", Fprogn, Sprogn, 0, UNEVALLED, 0,
doc: /* Eval BODY forms sequentially and return value of last one.
usage: (progn BODY...) */)
(Lisp_Object args)
}
-DEFUE ("interactive-p", Finteractive_p, Sinteractive_p, 0, 0, 0,
+DEFUN ("interactive-p", Finteractive_p, Sinteractive_p, 0, 0, 0,
doc: /* Return t if the containing function was run directly by user input.
This means that the function was called with `call-interactively'
\(which includes being called as the binding of a key)
_longjmp (catch->jmp, 1);
}
-DEFUE ("throw", Fthrow, Sthrow, 2, 2, 0,
+DEFUN ("throw", Fthrow, Sthrow, 2, 2, 0,
doc: /* Throw to the catch for TAG and return VALUE from it.
Both TAG and VALUE are evalled. */)
(register Lisp_Object tag, Lisp_Object value)
|| (CONSP (tem)
&& (SYMBOLP (XCAR (tem))
|| CONSP (XCAR (tem))))))
- error ("Invalid condition handler");
+ error ("Invalid condition handler: %s",
+ SDATA (Fprin1_to_string (tem, Qt)));
}
c.tag = Qnil;
static int maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig,
Lisp_Object data);
-DEFUE ("signal", Fsignal, Ssignal, 2, 2, 0,
+DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0,
doc: /* Signal an error. Args are ERROR-SYMBOL and associated DATA.
This function does not return.
{
char buf[4000];
size_t size = sizeof buf;
- size_t size_max =
- min (MOST_POSITIVE_FIXNUM, min (INT_MAX, SIZE_MAX - 1)) + 1;
+ size_t size_max = min (MOST_POSITIVE_FIXNUM, SIZE_MAX);
+ size_t mlen = strlen (m);
char *buffer = buf;
- int used;
+ size_t used;
Lisp_Object string;
while (1)
{
- used = vsnprintf (buffer, size, m, ap);
+ used = doprnt (buffer, size, m, m + mlen, ap);
- if (used < 0)
- {
- /* Non-C99 vsnprintf, such as w32, returns -1 when SIZE is too small.
- Guess a larger USED to work around the incompatibility. */
- used = (size <= size_max / 2 ? 2 * size
- : size < size_max ? size_max - 1
- : size_max);
- }
- else if (used < size)
+ /* Note: the -1 below is because `doprnt' returns the number of bytes
+ excluding the terminating null byte, and it always terminates with a
+ null byte, even when producing a truncated message. */
+ if (used < size - 1)
break;
- if (size_max <= used)
- memory_full ();
- size = used + 1;
+ if (size <= size_max / 2)
+ size *= 2;
+ else if (size < size_max)
+ size = size_max;
+ else
+ break; /* and leave the message truncated */
if (buffer != buf)
xfree (buffer);
va_end (ap);
}
\f
-DEFUE ("commandp", Fcommandp, Scommandp, 1, 2, 0,
+DEFUN ("commandp", Fcommandp, Scommandp, 1, 2, 0,
doc: /* Non-nil if FUNCTION makes provisions for interactive calling.
This means it contains a description for how to read arguments to give it.
The value is nil for an invalid function or a symbol with no function
}
\f
-DEFUE ("eval", Feval, Seval, 1, 2, 0,
+DEFUN ("eval", Feval, Seval, 1, 2, 0,
doc: /* Evaluate FORM and return its value.
If LEXICAL is t, evaluate using lexical scoping. */)
(Lisp_Object form, Lisp_Object lexical)
return val;
}
\f
-DEFUE ("apply", Fapply, Sapply, 2, MANY, 0,
+DEFUN ("apply", Fapply, Sapply, 2, MANY, 0,
doc: /* Call FUNCTION with our remaining args, using our last arg as list of args.
Then return the value FUNCTION returns.
Thus, (apply '+ 1 2 '(3 4)) returns 10.
return Qnil;
}
-DEFUE ("run-hooks", Frun_hooks, Srun_hooks, 0, MANY, 0,
+DEFUN ("run-hooks", Frun_hooks, Srun_hooks, 0, MANY, 0,
doc: /* Run each hook in HOOKS.
Each argument should be a symbol, a hook variable.
These symbols are processed in the order specified.
return Qnil;
}
-DEFUE ("run-hook-with-args", Frun_hook_with_args,
+DEFUN ("run-hook-with-args", Frun_hook_with_args,
Srun_hook_with_args, 1, MANY, 0,
doc: /* Run HOOK with the specified arguments ARGS.
HOOK should be a symbol, a hook variable. If HOOK has a non-nil
return NILP (Ffuncall (nargs, args)) ? Qt : Qnil;
}
-DEFUE ("run-hook-with-args-until-failure", Frun_hook_with_args_until_failure,
+DEFUN ("run-hook-with-args-until-failure", Frun_hook_with_args_until_failure,
Srun_hook_with_args_until_failure, 1, MANY, 0,
doc: /* Run HOOK with the specified arguments ARGS.
HOOK should be a symbol, a hook variable. If HOOK has a non-nil
/* The caller should GCPRO all the elements of ARGS. */
-DEFUE ("functionp", Ffunctionp, Sfunctionp, 1, 1, 0,
+DEFUN ("functionp", Ffunctionp, Sfunctionp, 1, 1, 0,
doc: /* Non-nil if OBJECT is a function. */)
(Lisp_Object object)
{
return Qnil;
}
-DEFUE ("funcall", Ffuncall, Sfuncall, 1, MANY, 0,
+DEFUN ("funcall", Ffuncall, Sfuncall, 1, MANY, 0,
doc: /* Call first argument as a function, passing remaining arguments to it.
Return the value that function returns.
Thus, (funcall 'cons 'x 'y) returns (x . y).
HCoop / bpt / emacs.git / blobdiff