/* Primitive operations on Lisp data types for GNU Emacs Lisp interpreter.
Copyright (C) 1985, 1986, 1988, 1993, 1994, 1995, 1997, 1998, 1999, 2000,
- 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
+ 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
This file is part of GNU Emacs.
circular_list_error (list)
Lisp_Object list;
{
- Fsignal (Qcircular_list, list);
+ xsignal (Qcircular_list, list);
}
wrong_type_argument (predicate, value)
register Lisp_Object predicate, value;
{
- register Lisp_Object tem;
- do
- {
- /* If VALUE is not even a valid Lisp object, abort here
- where we can get a backtrace showing where it came from. */
- if ((unsigned int) XGCTYPE (value) >= Lisp_Type_Limit)
- abort ();
+ /* If VALUE is not even a valid Lisp object, abort here
+ where we can get a backtrace showing where it came from. */
+ if ((unsigned int) XGCTYPE (value) >= Lisp_Type_Limit)
+ abort ();
- value = Fsignal (Qwrong_type_argument, Fcons (predicate, Fcons (value, Qnil)));
- tem = call1 (predicate, value);
- }
- while (NILP (tem));
- return value;
+ xsignal2 (Qwrong_type_argument, predicate, value);
}
void
args_out_of_range (a1, a2)
Lisp_Object a1, a2;
{
- while (1)
- Fsignal (Qargs_out_of_range, Fcons (a1, Fcons (a2, Qnil)));
+ xsignal2 (Qargs_out_of_range, a1, a2);
}
void
args_out_of_range_3 (a1, a2, a3)
Lisp_Object a1, a2, a3;
{
- while (1)
- Fsignal (Qargs_out_of_range, Fcons (a1, Fcons (a2, Fcons (a3, Qnil))));
+ xsignal3 (Qargs_out_of_range, a1, a2, a3);
}
/* On some machines, XINT needs a temporary location.
}
DEFUN ("listp", Flistp, Slistp, 1, 1, 0,
- doc: /* Return t if OBJECT is a list. This includes nil. */)
+ doc: /* Return t if OBJECT is a list, that is, a cons cell or nil.
+Otherwise, return nil. */)
(object)
Lisp_Object object;
{
(object)
Lisp_Object object;
{
- if (VECTORP (object) || STRINGP (object)
- || CHAR_TABLE_P (object) || BOOL_VECTOR_P (object))
+ if (ARRAYP (object))
return Qt;
return Qnil;
}
(object)
register Lisp_Object object;
{
- if (CONSP (object) || NILP (object) || VECTORP (object) || STRINGP (object)
- || CHAR_TABLE_P (object) || BOOL_VECTOR_P (object))
+ if (CONSP (object) || NILP (object) || ARRAYP (object))
return Qt;
return Qnil;
}
DEFUN ("car", Fcar, Scar, 1, 1, 0,
doc: /* Return the car of LIST. If arg is nil, return nil.
-Error if arg is not nil and not a cons cell. See also `car-safe'. */)
+Error if arg is not nil and not a cons cell. See also `car-safe'.
+
+See Info node `(elisp)Cons Cells' for a discussion of related basic
+Lisp concepts such as car, cdr, cons cell and list. */)
(list)
register Lisp_Object list;
{
- while (1)
- {
- if (CONSP (list))
- return XCAR (list);
- else if (EQ (list, Qnil))
- return Qnil;
- else
- list = wrong_type_argument (Qlistp, list);
- }
+ return CAR (list);
}
DEFUN ("car-safe", Fcar_safe, Scar_safe, 1, 1, 0,
(object)
Lisp_Object object;
{
- if (CONSP (object))
- return XCAR (object);
- else
- return Qnil;
+ return CAR_SAFE (object);
}
DEFUN ("cdr", Fcdr, Scdr, 1, 1, 0,
doc: /* Return the cdr of LIST. If arg is nil, return nil.
-Error if arg is not nil and not a cons cell. See also `cdr-safe'. */)
+Error if arg is not nil and not a cons cell. See also `cdr-safe'.
+
+See Info node `(elisp)Cons Cells' for a discussion of related basic
+Lisp concepts such as cdr, car, cons cell and list. */)
(list)
register Lisp_Object list;
{
- while (1)
- {
- if (CONSP (list))
- return XCDR (list);
- else if (EQ (list, Qnil))
- return Qnil;
- else
- list = wrong_type_argument (Qlistp, list);
- }
+ return CDR (list);
}
DEFUN ("cdr-safe", Fcdr_safe, Scdr_safe, 1, 1, 0,
(object)
Lisp_Object object;
{
- if (CONSP (object))
- return XCDR (object);
- else
- return Qnil;
+ return CDR_SAFE (object);
}
DEFUN ("setcar", Fsetcar, Ssetcar, 2, 2, 0,
(cell, newcar)
register Lisp_Object cell, newcar;
{
- if (!CONSP (cell))
- cell = wrong_type_argument (Qconsp, cell);
-
+ CHECK_CONS (cell);
CHECK_IMPURE (cell);
XSETCAR (cell, newcar);
return newcar;
(cell, newcdr)
register Lisp_Object cell, newcdr;
{
- if (!CONSP (cell))
- cell = wrong_type_argument (Qconsp, cell);
-
+ CHECK_CONS (cell);
CHECK_IMPURE (cell);
XSETCDR (cell, newcdr);
return newcdr;
register Lisp_Object symbol;
{
CHECK_SYMBOL (symbol);
- if (XSYMBOL (symbol)->constant)
- return Fsignal (Qsetting_constant, Fcons (symbol, Qnil));
+ if (SYMBOL_CONSTANT_P (symbol))
+ xsignal1 (Qsetting_constant, symbol);
Fset (symbol, Qunbound);
return symbol;
}
{
CHECK_SYMBOL (symbol);
if (NILP (symbol) || EQ (symbol, Qt))
- return Fsignal (Qsetting_constant, Fcons (symbol, Qnil));
+ xsignal1 (Qsetting_constant, symbol);
XSYMBOL (symbol)->function = Qunbound;
return symbol;
}
register Lisp_Object symbol;
{
CHECK_SYMBOL (symbol);
- if (EQ (XSYMBOL (symbol)->function, Qunbound))
- return Fsignal (Qvoid_function, Fcons (symbol, Qnil));
- return XSYMBOL (symbol)->function;
+ if (!EQ (XSYMBOL (symbol)->function, Qunbound))
+ return XSYMBOL (symbol)->function;
+ xsignal1 (Qvoid_function, symbol);
}
DEFUN ("symbol-plist", Fsymbol_plist, Ssymbol_plist, 1, 1, 0,
{
CHECK_SYMBOL (symbol);
if (NILP (symbol) || EQ (symbol, Qt))
- return Fsignal (Qsetting_constant, Fcons (symbol, Qnil));
+ xsignal1 (Qsetting_constant, symbol);
if (!NILP (Vautoload_queue) && !EQ (XSYMBOL (symbol)->function, Qunbound))
Vautoload_queue = Fcons (Fcons (symbol, XSYMBOL (symbol)->function),
Vautoload_queue);
Lisp_Object subr;
{
short minargs, maxargs;
- if (!SUBRP (subr))
- wrong_type_argument (Qsubrp, subr);
+ CHECK_SUBR (subr);
minargs = XSUBR (subr)->min_args;
maxargs = XSUBR (subr)->max_args;
if (maxargs == MANY)
Lisp_Object subr;
{
const char *name;
- if (!SUBRP (subr))
- wrong_type_argument (Qsubrp, subr);
+ CHECK_SUBR (subr);
name = XSUBR (subr)->symbol_name;
return make_string (name, strlen (name));
}
tortoise = XSYMBOL (tortoise)->value;
if (EQ (hare, tortoise))
- Fsignal (Qcyclic_variable_indirection, Fcons (symbol, Qnil));
+ xsignal1 (Qcyclic_variable_indirection, symbol);
}
return hare;
case Lisp_Misc_Kboard_Objfwd:
offset = XKBOARD_OBJFWD (valcontents)->offset;
- return *(Lisp_Object *)(offset + (char *)current_kboard);
+ /* We used to simply use current_kboard here, but from Lisp
+ code, it's value is often unexpected. It seems nicer to
+ allow constructions like this to work as intuitively expected:
+
+ (with-selected-frame frame
+ (define-key local-function-map "\eOP" [f1]))
+
+ On the other hand, this affects the semantics of
+ last-command and real-last-command, and people may rely on
+ that. I took a quick look at the Lisp codebase, and I
+ don't think anything will break. --lorentey */
+ return *(Lisp_Object *)(offset + (char *)FRAME_KBOARD (SELECTED_FRAME ()));
}
return valcontents;
}
case Lisp_Misc_Kboard_Objfwd:
{
- char *base = (char *) current_kboard;
+ char *base = (char *) FRAME_KBOARD (SELECTED_FRAME ());
char *p = base + XKBOARD_OBJFWD (valcontents)->offset;
*(Lisp_Object *) p = newval;
}
case Lisp_Misc_Kboard_Objfwd:
return *(Lisp_Object *)(XKBOARD_OBJFWD (valcontents)->offset
- + (char *)current_kboard);
+ + (char *)FRAME_KBOARD (SELECTED_FRAME ()));
}
}
Lisp_Object val;
val = find_symbol_value (symbol);
- if (EQ (val, Qunbound))
- return Fsignal (Qvoid_variable, Fcons (symbol, Qnil));
- else
+ if (!EQ (val, Qunbound))
return val;
+
+ xsignal1 (Qvoid_variable, symbol);
}
DEFUN ("set", Fset, Sset, 2, 2, 0,
if (SYMBOL_CONSTANT_P (symbol)
&& (NILP (Fkeywordp (symbol))
|| !EQ (newval, SYMBOL_VALUE (symbol))))
- return Fsignal (Qsetting_constant, Fcons (symbol, Qnil));
+ xsignal1 (Qsetting_constant, symbol);
innercontents = valcontents = SYMBOL_VALUE (symbol);
register Lisp_Object value;
value = default_value (symbol);
- if (EQ (value, Qunbound))
- return Fsignal (Qvoid_variable, Fcons (symbol, Qnil));
- return value;
+ if (!EQ (value, Qunbound))
+ return value;
+
+ xsignal1 (Qvoid_variable, symbol);
}
DEFUN ("set-default", Fset_default, Sset_default, 2, 2, 0,
DEFUN ("make-variable-frame-local", Fmake_variable_frame_local, Smake_variable_frame_local,
1, 1, "vMake Variable Frame Local: ",
doc: /* Enable VARIABLE to have frame-local bindings.
-When a frame-local binding exists in the current frame,
-it is in effect whenever the current buffer has no buffer-local binding.
-A frame-local binding is actually a frame parameter value;
-thus, any given frame has a local binding for VARIABLE if it has
-a value for the frame parameter named VARIABLE. Return VARIABLE.
-See `modify-frame-parameters' for how to set frame parameters. */)
+This does not create any frame-local bindings for VARIABLE,
+it just makes them possible.
+
+A frame-local binding is actually a frame parameter value.
+If a frame F has a value for the frame parameter named VARIABLE,
+that also acts as a frame-local binding for VARIABLE in F--
+provided this function has been called to enable VARIABLE
+to have frame-local bindings at all.
+
+The only way to create a frame-local binding for VARIABLE in a frame
+is to set the VARIABLE frame parameter of that frame. See
+`modify-frame-parameters' for how to set frame parameters.
+
+Buffer-local bindings take precedence over frame-local bindings. */)
(variable)
register Lisp_Object variable;
{
return Qnil;
}
-extern struct device *get_device P_ ((Lisp_Object display, int));
+/* This code is disabled now that we use the selected frame to return
+ keyboard-local-values. */
+#if 0
+extern struct terminal *get_terminal P_ ((Lisp_Object display, int));
DEFUN ("terminal-local-value", Fterminal_local_value, Sterminal_local_value, 2, 2, 0,
- doc: /* Return the terminal-local value of SYMBOL on DEVICE.
+ doc: /* Return the terminal-local value of SYMBOL on TERMINAL.
If SYMBOL is not a terminal-local variable, then return its normal
value, like `symbol-value'.
-DEVICE may be a display device id, a frame, or nil (meaning the
-selected frame's display device). */)
- (symbol, device)
+TERMINAL may be a terminal id, a frame, or nil (meaning the
+selected frame's terminal device). */)
+ (symbol, terminal)
Lisp_Object symbol;
- Lisp_Object device;
+ Lisp_Object terminal;
{
Lisp_Object result;
- struct device *d = get_device (device, 1);
- push_kboard (d->kboard);
+ struct terminal *t = get_terminal (terminal, 1);
+ push_kboard (t->kboard);
result = Fsymbol_value (symbol);
pop_kboard ();
return result;
}
DEFUN ("set-terminal-local-value", Fset_terminal_local_value, Sset_terminal_local_value, 3, 3, 0,
- doc: /* Set the terminal-local binding of SYMBOL on DEVICE to VALUE.
+ doc: /* Set the terminal-local binding of SYMBOL on TERMINAL to VALUE.
If VARIABLE is not a terminal-local variable, then set its normal
binding, like `set'.
-DEVICE may be a display device id, a frame, or nil (meaning the
-selected frame's display device). */)
- (symbol, device, value)
+TERMINAL may be a terminal id, a frame, or nil (meaning the
+selected frame's terminal device). */)
+ (symbol, terminal, value)
Lisp_Object symbol;
- Lisp_Object device;
+ Lisp_Object terminal;
Lisp_Object value;
{
Lisp_Object result;
- struct device *d = get_device (device, 1);
+ struct terminal *t = get_terminal (terminal, 1);
push_kboard (d->kboard);
result = Fset (symbol, value);
pop_kboard ();
return result;
}
+#endif
\f
/* Find the function at the end of a chain of symbol function indirections. */
tortoise = XSYMBOL (tortoise)->function;
if (EQ (hare, tortoise))
- Fsignal (Qcyclic_function_indirection, Fcons (object, Qnil));
+ xsignal1 (Qcyclic_function_indirection, object);
}
return hare;
}
-DEFUN ("indirect-function", Findirect_function, Sindirect_function, 1, 1, 0,
+DEFUN ("indirect-function", Findirect_function, Sindirect_function, 1, 2, 0,
doc: /* Return the function at the end of OBJECT's function chain.
-If OBJECT is a symbol, follow all function indirections and return the final
-function binding.
-If OBJECT is not a symbol, just return it.
-Signal a void-function error if the final symbol is unbound.
+If OBJECT is not a symbol, just return it. Otherwise, follow all
+function indirections to find the final function binding and return it.
+If the final symbol in the chain is unbound, signal a void-function error.
+Optional arg NOERROR non-nil means to return nil instead of signalling.
Signal a cyclic-function-indirection error if there is a loop in the
function chain of symbols. */)
- (object)
+ (object, noerror)
register Lisp_Object object;
+ Lisp_Object noerror;
{
Lisp_Object result;
- result = indirect_function (object);
+ /* Optimize for no indirection. */
+ result = object;
+ if (SYMBOLP (result) && !EQ (result, Qunbound)
+ && (result = XSYMBOL (result)->function, SYMBOLP (result)))
+ result = indirect_function (result);
+ if (!EQ (result, Qunbound))
+ return result;
- if (EQ (result, Qunbound))
- return Fsignal (Qvoid_function, Fcons (object, Qnil));
- return result;
+ if (NILP (noerror))
+ xsignal1 (Qvoid_function, object);
+
+ return Qnil;
}
\f
/* Extract and set vector and string elements */
CHECK_NUMBER (idx);
idxval = XINT (idx);
- if (!VECTORP (array) && !STRINGP (array) && !BOOL_VECTOR_P (array)
- && ! CHAR_TABLE_P (array))
- array = wrong_type_argument (Qarrayp, array);
+ CHECK_ARRAY (array, Qarrayp);
CHECK_IMPURE (array);
if (VECTORP (array))
CHECK_NUMBER (base);
b = XINT (base);
if (b < 2 || b > 16)
- Fsignal (Qargs_out_of_range, Fcons (base, Qnil));
+ xsignal1 (Qargs_out_of_range, base);
}
/* Skip any whitespace at the front of the number. Some versions of
else
{
if (next == 0)
- Fsignal (Qarith_error, Qnil);
+ xsignal0 (Qarith_error);
accum /= next;
}
break;
else
{
if (! IEEE_FLOATING_POINT && next == 0)
- Fsignal (Qarith_error, Qnil);
+ xsignal0 (Qarith_error);
accum /= next;
}
break;
CHECK_NUMBER_COERCE_MARKER (y);
if (XFASTINT (y) == 0)
- Fsignal (Qarith_error, Qnil);
+ xsignal0 (Qarith_error);
XSETINT (val, XINT (x) % XINT (y));
return val;
i2 = XINT (y);
if (i2 == 0)
- Fsignal (Qarith_error, Qnil);
+ xsignal0 (Qarith_error);
i1 %= i2;
DEFUN ("logxor", Flogxor, Slogxor, 0, MANY, 0,
doc: /* Return bitwise-exclusive-or of all the arguments.
Arguments may be integers, or markers converted to integers.
-usage: (logxor &rest INTS-OR-MARKERS) */)
+usage: (logxor &rest INTS-OR-MARKERS) */)
(nargs, args)
int nargs;
Lisp_Object *args;
defsubr (&Slocal_variable_p);
defsubr (&Slocal_variable_if_set_p);
defsubr (&Svariable_binding_locus);
+#if 0 /* XXX Remove this. --lorentey */
defsubr (&Sterminal_local_value);
defsubr (&Sset_terminal_local_value);
+#endif
defsubr (&Saref);
defsubr (&Saset);
defsubr (&Snumber_to_string);
#endif /* not BSD4_1 */
SIGNAL_THREAD_CHECK (signo);
- Fsignal (Qarith_error, Qnil);
+ xsignal0 (Qarith_error);
}
void
HCoop / bpt / emacs.git / blobdiff