/* Primitive operations on Lisp data types for GNU Emacs Lisp interpreter.
- Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2014 Free Software
+ Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2015 Free Software
Foundation, Inc.
This file is part of GNU Emacs.
Lisp_Object Qinteractive_form;
static Lisp_Object Qdefalias_fset_function;
-static void swap_in_symval_forwarding (struct Lisp_Symbol *, struct Lisp_Buffer_Local_Value *);
+static void swap_in_symval_forwarding (struct Lisp_Symbol *,
+ struct Lisp_Buffer_Local_Value *);
static bool
BOOLFWDP (union Lisp_Fwd *a)
/* Convert to eassert or remove after GC bug is found. In the
meantime, check unconditionally, at a slight perf hit. */
- if (valid_lisp_object_p (definition) < 1)
+ if (! valid_lisp_object_p (definition))
emacs_abort ();
set_symbol_function (symbol, definition);
}
}
+/* Used to signal a user-friendly error when symbol WRONG is
+ not a member of CHOICE, which should be a list of symbols. */
+
+void
+wrong_choice (Lisp_Object choice, Lisp_Object wrong)
+{
+ ptrdiff_t i = 0, len = XINT (Flength (choice));
+ Lisp_Object obj, *args;
+ AUTO_STRING (one_of, "One of ");
+ AUTO_STRING (comma, ", ");
+ AUTO_STRING (or, " or ");
+ AUTO_STRING (should_be_specified, " should be specified");
+
+ USE_SAFE_ALLOCA;
+ SAFE_ALLOCA_LISP (args, len * 2 + 1);
+
+ args[i++] = one_of;
+
+ for (obj = choice; !NILP (obj); obj = XCDR (obj))
+ {
+ args[i++] = SYMBOL_NAME (XCAR (obj));
+ args[i++] = (NILP (XCDR (obj)) ? should_be_specified
+ : NILP (XCDR (XCDR (obj))) ? or : comma);
+ }
+
+ obj = Fconcat (i, args);
+ SAFE_FREE ();
+ xsignal2 (Qerror, obj, wrong);
+}
+
+/* Used to signal a user-friendly error if WRONG is not a number or
+ integer/floating-point number outsize of inclusive MIN..MAX range. */
+
+static void
+wrong_range (Lisp_Object min, Lisp_Object max, Lisp_Object wrong)
+{
+ AUTO_STRING (value_should_be_from, "Value should be from ");
+ AUTO_STRING (to, " to ");
+ xsignal2 (Qerror,
+ Fconcat (4, ((Lisp_Object [])
+ {value_should_be_from, Fnumber_to_string (min),
+ to, Fnumber_to_string (max)})),
+ wrong);
+}
+
/* Store NEWVAL into SYMBOL, where VALCONTENTS is found in the value cell
of SYMBOL. If SYMBOL is buffer-local, VALCONTENTS should be the
buffer-independent contents of the value cell: forwarded just one
int offset = XBUFFER_OBJFWD (valcontents)->offset;
Lisp_Object predicate = XBUFFER_OBJFWD (valcontents)->predicate;
- if (!NILP (predicate) && !NILP (newval)
- && NILP (call1 (predicate, newval)))
- wrong_type_argument (predicate, newval);
+ if (!NILP (newval))
+ {
+ if (SYMBOLP (predicate))
+ {
+ Lisp_Object prop;
+ if ((prop = Fget (predicate, Qchoice), !NILP (prop)))
+ {
+ if (NILP (Fmemq (newval, prop)))
+ wrong_choice (prop, newval);
+ }
+ else if ((prop = Fget (predicate, Qrange), !NILP (prop)))
+ {
+ Lisp_Object min = XCAR (prop), max = XCDR (prop);
+
+ if (!NUMBERP (newval)
+ || !NILP (arithcompare (newval, min, ARITH_LESS))
+ || !NILP (arithcompare (newval, max, ARITH_GRTR)))
+ wrong_range (min, max, newval);
+ }
+ else if (FUNCTIONP (predicate))
+ {
+ if (NILP (call1 (predicate, newval)))
+ wrong_type_argument (predicate, newval);
+ }
+ }
+ }
if (buf == NULL)
buf = current_buffer;
set_per_buffer_value (buf, offset, newval);
/* Find the new binding. */
XSETSYMBOL (symbol, sym); /* May have changed via aliasing. */
- tem1 = Fassq (symbol,
- (blv->frame_local
- ? XFRAME (where)->param_alist
- : BVAR (XBUFFER (where), local_var_alist)));
+ tem1 = assq_no_quit (symbol,
+ (blv->frame_local
+ ? XFRAME (where)->param_alist
+ : BVAR (XBUFFER (where), local_var_alist)));
set_blv_where (blv, where);
blv->found = 1;
1, 2, 0,
doc: /* Non-nil if VARIABLE has a local binding in buffer BUFFER.
BUFFER defaults to the current buffer. */)
- (register Lisp_Object variable, Lisp_Object buffer)
+ (Lisp_Object variable, Lisp_Object buffer)
{
- register struct buffer *buf;
+ struct buffer *buf = decode_buffer (buffer);
struct Lisp_Symbol *sym;
- if (NILP (buffer))
- buf = current_buffer;
- else
- {
- CHECK_BUFFER (buffer);
- buf = XBUFFER (buffer);
- }
-
CHECK_SYMBOL (variable);
sym = XSYMBOL (variable);
{
if (! SINGLE_BYTE_CHAR_P (c))
{
- int i;
+ ptrdiff_t i;
for (i = SBYTES (array) - 1; i >= 0; i--)
if (SREF (array, i) >= 0x80)
ptrdiff_t argnum;
for (argnum = 1; argnum < nargs; ++argnum)
{
- if (EQ (Qnil, arithcompare (args[argnum-1], args[argnum], comparison)))
+ if (EQ (Qnil, arithcompare (args[argnum - 1], args[argnum], comparison)))
return Qnil;
}
return Qt;
}
DEFUN ("<", Flss, Slss, 1, MANY, 0,
- doc: /* Return t if each arg is less than the next arg. All must be numbers or markers.
+ doc: /* Return t if each arg (a number or marker), is less than the next arg.
usage: (< NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
}
DEFUN (">", Fgtr, Sgtr, 1, MANY, 0,
- doc: /* Return t if each arg is greater than the next arg. All must be numbers or markers.
+ doc: /* Return t if each arg (a number or marker) is greater than the next arg.
usage: (> NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
}
DEFUN ("<=", Fleq, Sleq, 1, MANY, 0,
- doc: /* Return t if each arg is less than or equal to the next arg.
-All must be numbers or markers.
+ doc: /* Return t if each arg (a number or marker) is less than or equal to the next.
usage: (<= NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
}
DEFUN (">=", Fgeq, Sgeq, 1, MANY, 0,
- doc: /* Return t if each arg is greater than or equal to the next arg.
-All must be numbers or markers.
+ doc: /* Return t if each arg (a number or marker) is greater than or equal to the next.
usage: (>= NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
{
return arithcompare (num1, num2, ARITH_NOTEQUAL);
}
-
-DEFUN ("zerop", Fzerop, Szerop, 1, 1, 0,
- doc: /* Return t if NUMBER is zero. */)
- (register Lisp_Object number)
-{
- CHECK_NUMBER_OR_FLOAT (number);
-
- if (FLOATP (number))
- {
- if (XFLOAT_DATA (number) == 0.0)
- return Qt;
- return Qnil;
- }
-
- if (!XINT (number))
- return Qt;
- return Qnil;
-}
\f
/* Convert the cons-of-integers, integer, or float value C to an
unsigned value with maximum value MAX. Signal an error if C does not
defsubr (&Sleq);
defsubr (&Sgeq);
defsubr (&Sneq);
- defsubr (&Szerop);
defsubr (&Splus);
defsubr (&Sminus);
defsubr (&Stimes);