diff options
Diffstat (limited to 'src/data.c')
-rw-r--r-- | src/data.c | 143 |
1 files changed, 129 insertions, 14 deletions
diff --git a/src/data.c b/src/data.c index 0e2a704f529..92e1c75dee4 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,86,88,93,94,95,97,98,99, 2000, 2001, 2003 + Copyright (C) 1985,86,88,93,94,95,97,98,99, 2000, 2001, 03, 2004 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -71,6 +71,7 @@ Lisp_Object Qinvalid_function, Qwrong_number_of_arguments, Qno_catch; Lisp_Object Qend_of_file, Qarith_error, Qmark_inactive; Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only; Lisp_Object Qtext_read_only; + Lisp_Object Qintegerp, Qnatnump, Qwholenump, Qsymbolp, Qlistp, Qconsp; Lisp_Object Qstringp, Qarrayp, Qsequencep, Qbufferp; Lisp_Object Qchar_or_string_p, Qmarkerp, Qinteger_or_marker_p, Qvectorp; @@ -87,7 +88,8 @@ Lisp_Object Qoverflow_error, Qunderflow_error; Lisp_Object Qfloatp; Lisp_Object Qnumberp, Qnumber_or_marker_p; -static Lisp_Object Qinteger, Qsymbol, Qstring, Qcons, Qmarker, Qoverlay; +Lisp_Object Qinteger; +static Lisp_Object Qsymbol, Qstring, Qcons, Qmarker, Qoverlay; static Lisp_Object Qfloat, Qwindow_configuration, Qwindow; Lisp_Object Qprocess; static Lisp_Object Qcompiled_function, Qbuffer, Qframe, Qvector; @@ -728,7 +730,7 @@ determined by DEFINITION. */) } DEFUN ("setplist", Fsetplist, Ssetplist, 2, 2, 0, - doc: /* Set SYMBOL's property list to NEWVAL, and return NEWVAL. */) + doc: /* Set SYMBOL's property list to NEWPLIST, and return NEWPLIST. */) (symbol, newplist) register Lisp_Object symbol, newplist; { @@ -759,17 +761,39 @@ function with `&rest' args, or `unevalled' for a special form. */) return Fcons (make_number (minargs), make_number (maxargs)); } -DEFUN ("subr-interactive-form", Fsubr_interactive_form, Ssubr_interactive_form, 1, 1, 0, - doc: /* Return the interactive form of SUBR or nil if none. -SUBR must be a built-in function. Value, if non-nil, is a list +DEFUN ("interactive-form", Finteractive_form, Sinteractive_form, 1, 1, 0, + doc: /* Return the interactive form of CMD or nil if none. +CMD must be a command. Value, if non-nil, is a list \(interactive SPEC). */) - (subr) - Lisp_Object subr; + (cmd) + Lisp_Object cmd; { - if (!SUBRP (subr)) - wrong_type_argument (Qsubrp, subr); - if (XSUBR (subr)->prompt) - return list2 (Qinteractive, build_string (XSUBR (subr)->prompt)); + Lisp_Object fun = indirect_function (cmd); + + if (SUBRP (fun)) + { + if (XSUBR (fun)->prompt) + return list2 (Qinteractive, build_string (XSUBR (fun)->prompt)); + } + else if (COMPILEDP (fun)) + { + if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_INTERACTIVE) + return list2 (Qinteractive, AREF (fun, COMPILED_INTERACTIVE)); + } + else if (CONSP (fun)) + { + Lisp_Object funcar = XCAR (fun); + if (EQ (funcar, Qlambda)) + return Fassq (Qinteractive, Fcdr (XCDR (fun))); + else if (EQ (funcar, Qautoload)) + { + struct gcpro gcpro1; + GCPRO1 (cmd); + do_autoload (fun, cmd); + UNGCPRO; + return Finteractive_form (cmd); + } + } return Qnil; } @@ -871,6 +895,8 @@ store_symval_forwarding (symbol, valcontents, newval, buf) register Lisp_Object valcontents, newval; struct buffer *buf; { + int offset; + switch (SWITCH_ENUM_CAST (XTYPE (valcontents))) { case Lisp_Misc: @@ -890,6 +916,36 @@ store_symval_forwarding (symbol, valcontents, newval, buf) case Lisp_Misc_Objfwd: *XOBJFWD (valcontents)->objvar = newval; + + /* If this variable is a default for something stored + in the buffer itself, such as default-fill-column, + find the buffers that don't have local values for it + and update them. */ + if (XOBJFWD (valcontents)->objvar > (Lisp_Object *) &buffer_defaults + && XOBJFWD (valcontents)->objvar < (Lisp_Object *) (&buffer_defaults + 1)) + { + int offset = ((char *) XOBJFWD (valcontents)->objvar + - (char *) &buffer_defaults); + int idx = PER_BUFFER_IDX (offset); + + Lisp_Object tail, buf; + + if (idx <= 0) + break; + + for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail)) + { + Lisp_Object buf; + struct buffer *b; + + buf = Fcdr (XCAR (tail)); + if (!BUFFERP (buf)) continue; + b = XBUFFER (buf); + + if (! PER_BUFFER_VALUE_P (b, idx)) + PER_BUFFER_VALUE (b, offset) = newval; + } + } break; case Lisp_Misc_Buffer_Objfwd: @@ -1449,6 +1505,7 @@ The function `default-value' gets the default value and `set-default' sets it. register Lisp_Object tem, valcontents, newval; CHECK_SYMBOL (variable); + variable = indirect_variable (variable); valcontents = SYMBOL_VALUE (variable); if (EQ (variable, Qnil) || EQ (variable, Qt) || KBOARD_OBJFWDP (valcontents)) @@ -1502,6 +1559,7 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */) register Lisp_Object tem, valcontents; CHECK_SYMBOL (variable); + variable = indirect_variable (variable); valcontents = SYMBOL_VALUE (variable); if (EQ (variable, Qnil) || EQ (variable, Qt) || KBOARD_OBJFWDP (valcontents)) @@ -1581,6 +1639,7 @@ From now on the default value will apply in this buffer. Return VARIABLE. */) register Lisp_Object tem, valcontents; CHECK_SYMBOL (variable); + variable = indirect_variable (variable); valcontents = SYMBOL_VALUE (variable); @@ -1645,6 +1704,7 @@ See `modify-frame-parameters' for how to set frame parameters. */) register Lisp_Object tem, valcontents, newval; CHECK_SYMBOL (variable); + variable = indirect_variable (variable); valcontents = SYMBOL_VALUE (variable); if (EQ (variable, Qnil) || EQ (variable, Qt) || KBOARD_OBJFWDP (valcontents) @@ -1694,6 +1754,7 @@ BUFFER defaults to the current buffer. */) } CHECK_SYMBOL (variable); + variable = indirect_variable (variable); valcontents = SYMBOL_VALUE (variable); if (BUFFER_LOCAL_VALUEP (valcontents) @@ -1701,7 +1762,6 @@ BUFFER defaults to the current buffer. */) { Lisp_Object tail, elt; - variable = indirect_variable (variable); for (tail = buf->local_var_alist; CONSP (tail); tail = XCDR (tail)) { elt = XCAR (tail); @@ -1738,6 +1798,7 @@ BUFFER defaults to the current buffer. */) } CHECK_SYMBOL (variable); + variable = indirect_variable (variable); valcontents = SYMBOL_VALUE (variable); @@ -1759,6 +1820,41 @@ BUFFER defaults to the current buffer. */) } return Qnil; } + +DEFUN ("variable-binding-locus", Fvariable_binding_locus, Svariable_binding_locus, + 1, 1, 0, + doc: /* Return a value indicating where VARIABLE's current binding comes from. +If the current binding is buffer-local, the value is the current buffer. +If the current binding is frame-local, the value is the selected frame. +If the current binding is global (the default), the value is nil. */) + (variable) + register Lisp_Object variable; +{ + Lisp_Object valcontents; + + CHECK_SYMBOL (variable); + variable = indirect_variable (variable); + + /* Make sure the current binding is actually swapped in. */ + find_symbol_value (variable); + + valcontents = XSYMBOL (variable)->value; + + if (BUFFER_LOCAL_VALUEP (valcontents) + || SOME_BUFFER_LOCAL_VALUEP (valcontents) + || BUFFER_OBJFWDP (valcontents)) + { + /* For a local variable, record both the symbol and which + buffer's or frame's value we are saving. */ + if (!NILP (Flocal_variable_p (variable, Qnil))) + return Fcurrent_buffer (); + else if (!BUFFER_OBJFWDP (valcontents) + && XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame) + return XBUFFER_LOCAL_VALUE (valcontents)->frame; + } + + return Qnil; +} /* Find the function at the end of a chain of symbol function indirections. */ @@ -2701,6 +2797,20 @@ DEFUN ("lognot", Flognot, Slognot, 1, 1, 0, XSETINT (number, ~XINT (number)); return number; } + +DEFUN ("byteorder", Fbyteorder, Sbyteorder, 0, 0, 0, + doc: /* Return the byteorder for the machine. +Returns 66 (ASCII uppercase B) for big endian machines or 108 (ASCII +lowercase l) for small endian machines. */) + () +{ + unsigned i = 0x04030201; + int order = *(char *)&i == 1 ? 108 : 66; + + return make_number (order); +} + + void syms_of_data () @@ -3017,7 +3127,7 @@ syms_of_data () staticpro (&Qhash_table); defsubr (&Sindirect_variable); - defsubr (&Ssubr_interactive_form); + defsubr (&Sinteractive_form); defsubr (&Seq); defsubr (&Snull); defsubr (&Stype_of); @@ -3075,6 +3185,7 @@ syms_of_data () defsubr (&Smake_variable_frame_local); defsubr (&Slocal_variable_p); defsubr (&Slocal_variable_if_set_p); + defsubr (&Svariable_binding_locus); defsubr (&Saref); defsubr (&Saset); defsubr (&Snumber_to_string); @@ -3102,6 +3213,7 @@ syms_of_data () defsubr (&Sadd1); defsubr (&Ssub1); defsubr (&Slognot); + defsubr (&Sbyteorder); defsubr (&Ssubr_arity); XSYMBOL (Qwholenump)->function = XSYMBOL (Qnatnump)->function; @@ -3154,3 +3266,6 @@ init_data () signal (SIGEMT, arith_error); #endif /* uts */ } + +/* arch-tag: 25879798-b84d-479a-9c89-7d148e2109f7 + (do not change this comment) */ |