X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/58b646fafc27ea5fb93fa95d5ff84187d689d315..e6335dc16c9c8fad7dc630e9a8261e4178d8e2fa:/src/data.c diff --git a/src/data.c b/src/data.c index 8f98e6fbd6..8e7f5d2054 100644 --- a/src/data.c +++ b/src/data.c @@ -1,6 +1,6 @@ /* Primitive operations on Lisp data types for GNU Emacs Lisp interpreter. - Copyright (C) 1985,86,88,93,94,95,97,98,99, 2000, 2001, 03, 2004 - Free Software Foundation, Inc. + Copyright (C) 1985, 1986, 1988, 1993, 1994, 1995, 1997, 1998, 1999, 2000, + 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -274,7 +274,8 @@ DEFUN ("atom", Fatom, Satom, 1, 1, 0, } 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; { @@ -521,7 +522,10 @@ DEFUN ("floatp", Ffloatp, Sfloatp, 1, 1, 0, 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; { @@ -549,7 +553,10 @@ DEFUN ("car-safe", Fcar_safe, Scar_safe, 1, 1, 0, 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; { @@ -719,6 +726,7 @@ determined by DEFINITION. */) (symbol, definition, docstring) register Lisp_Object symbol, definition, docstring; { + CHECK_SYMBOL (symbol); if (CONSP (XSYMBOL (symbol)->function) && EQ (XCAR (XSYMBOL (symbol)->function), Qautoload)) LOADHIST_ATTACH (Fcons (Qt, symbol)); @@ -1708,12 +1716,20 @@ From now on the default value will apply in this buffer. Return VARIABLE. */) 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; { @@ -1911,23 +1927,26 @@ indirect_function (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); if (EQ (result, Qunbound)) - return Fsignal (Qvoid_function, Fcons (object, Qnil)); + return (NILP (noerror) + ? Fsignal (Qvoid_function, Fcons (object, Qnil)) + : Qnil); return result; } @@ -2075,39 +2094,9 @@ bool-vector. IDX starts at 0. */) args_out_of_range (array, idx); CHECK_NUMBER (newelt); - if (XINT (newelt) < 0 || ASCII_CHAR_P (XINT (newelt)) - || CHAR_BYTE8_P (XINT (newelt))) - SSET (array, idxval, XINT (newelt)); - else - { - /* We must relocate the string data while converting it to - multibyte. */ - int idxval_byte, prev_bytes, new_bytes; - unsigned char workbuf[MAX_MULTIBYTE_LENGTH], *p0 = workbuf, *p1; - unsigned char *origstr = SDATA (array), *str; - int nchars, nbytes; - USE_SAFE_ALLOCA; - - nchars = SCHARS (array); - nbytes = idxval_byte = count_size_as_multibyte (origstr, idxval); - nbytes += count_size_as_multibyte (origstr + idxval, - nchars - idxval); - SAFE_ALLOCA (str, unsigned char *, nbytes); - copy_text (SDATA (array), str, nchars, 0, 1); - PARSE_MULTIBYTE_SEQ (str + idxval_byte, nbytes - idxval_byte, - prev_bytes); - new_bytes = CHAR_STRING (XINT (newelt), p0); - allocate_string_data (XSTRING (array), nchars, - nbytes + new_bytes - prev_bytes); - bcopy (str, SDATA (array), idxval_byte); - p1 = SDATA (array) + idxval_byte; - while (new_bytes--) - *p1++ = *p0++; - bcopy (str + idxval_byte + prev_bytes, p1, - nbytes - (idxval_byte + prev_bytes)); - SAFE_FREE (); - clear_string_char_byte_cache (); - } + if (XINT (newelt) >= 0 && ! SINGLE_BYTE_CHAR_P (XINT (newelt))) + args_out_of_range (array, newelt); + SSET (array, idxval, XINT (newelt)); } return newelt;