X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/4c539a7b387874577136190d8e1a413da1d7e240..52a4e87c630ea397408efe4f8486be55e1199905:/src/data.c diff --git a/src/data.c b/src/data.c index 0c90944f0a..3992792fdd 100644 --- a/src/data.c +++ b/src/data.c @@ -1,5 +1,5 @@ /* 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. @@ -89,7 +89,8 @@ static Lisp_Object Qdefun; 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) @@ -729,7 +730,7 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0, /* 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); @@ -971,6 +972,51 @@ do_symval_forwarding (register union Lisp_Fwd *valcontents) } } +/* 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 @@ -1027,10 +1073,33 @@ store_symval_forwarding (union Lisp_Fwd *valcontents, register Lisp_Object newva 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); @@ -1246,10 +1315,10 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where, /* 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; @@ -1887,19 +1956,11 @@ DEFUN ("local-variable-p", Flocal_variable_p, Slocal_variable_p, 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); @@ -2253,7 +2314,7 @@ bool-vector. IDX starts at 0. */) { if (! SINGLE_BYTE_CHAR_P (c)) { - int i; + ptrdiff_t i; for (i = SBYTES (array) - 1; i >= 0; i--) if (SREF (array, i) >= 0x80) @@ -2347,7 +2408,7 @@ usage: (= NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS) */) } 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) { @@ -2355,7 +2416,7 @@ usage: (< NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS) */) } 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) { @@ -2363,8 +2424,7 @@ usage: (> NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS) */) } 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) { @@ -2372,8 +2432,7 @@ usage: (<= NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS) */) } 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) {