X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/7b1019e2781472c793d0bf74e2b9ee17894270b8..d7306fe6b15ccdc49a066c05e5e86df8e005e859:/src/data.c diff --git a/src/data.c b/src/data.c index cb9d210c62..6d469e161d 100644 --- a/src/data.c +++ b/src/data.c @@ -1,14 +1,14 @@ /* 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, 2006, 2007, 2008 + 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. This file is part of GNU Emacs. -GNU Emacs is free software; you can redistribute it and/or modify +GNU Emacs is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. +the Free Software Foundation, either version 3 of the License, or +(at your option) any later version. GNU Emacs is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -16,14 +16,13 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License -along with GNU Emacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -Boston, MA 02110-1301, USA. */ +along with GNU Emacs. If not, see . */ #include #include #include +#include #include "lisp.h" #include "puresize.h" #include "character.h" @@ -32,6 +31,7 @@ Boston, MA 02110-1301, USA. */ #include "frame.h" #include "syssignal.h" #include "termhooks.h" /* For FRAME_KBOARD reference in y-or-n-p. */ +#include "font.h" #ifdef STDC_HEADERS #include @@ -47,16 +47,6 @@ Boston, MA 02110-1301, USA. */ #endif #endif -/* Work around a problem that happens because math.h on hpux 7 - defines two static variables--which, in Emacs, are not really static, - because `static' is defined as nothing. The problem is that they are - here, in floatfns.c, and in lread.c. - These macros prevent the name conflict. */ -#if defined (HPUX) && !defined (HPUX8) -#define _MAXLDBL data_c_maxldbl -#define _NMAXLDBL data_c_nmaxldbl -#endif - #include #if !defined (atof) @@ -97,6 +87,9 @@ Lisp_Object Qprocess; static Lisp_Object Qcompiled_function, Qbuffer, Qframe, Qvector; static Lisp_Object Qchar_table, Qbool_vector, Qhash_table; static Lisp_Object Qsubrp, Qmany, Qunevalled; +Lisp_Object Qfont_spec, Qfont_entity, Qfont_object; + +Lisp_Object Qinteractive_form; static Lisp_Object swap_in_symval_forwarding P_ ((Lisp_Object, Lisp_Object)); @@ -236,6 +229,12 @@ for example, (type-of 1) returns `integer'. */) return Qframe; if (HASH_TABLE_P (object)) return Qhash_table; + if (FONT_SPEC_P (object)) + return Qfont_spec; + if (FONT_ENTITY_P (object)) + return Qfont_entity; + if (FONT_OBJECT_P (object)) + return Qfont_object; return Qvector; case Lisp_Float: @@ -769,7 +768,7 @@ Value, if non-nil, is a list \(interactive SPEC). */) fun = cmd; while (SYMBOLP (fun)) { - Lisp_Object tmp = Fget (fun, intern ("interactive-form")); + Lisp_Object tmp = Fget (fun, Qinteractive_form); if (!NILP (tmp)) return tmp; else @@ -815,25 +814,29 @@ Value, if non-nil, is a list \(interactive SPEC). */) `cyclic-variable-indirection' if SYMBOL's chain of variable indirections contains a loop. */ -Lisp_Object +struct Lisp_Symbol * indirect_variable (symbol) - Lisp_Object symbol; + struct Lisp_Symbol *symbol; { - Lisp_Object tortoise, hare; + struct Lisp_Symbol *tortoise, *hare; hare = tortoise = symbol; - while (XSYMBOL (hare)->indirect_variable) + while (hare->indirect_variable) { - hare = XSYMBOL (hare)->value; - if (!XSYMBOL (hare)->indirect_variable) + hare = XSYMBOL (hare->value); + if (!hare->indirect_variable) break; - hare = XSYMBOL (hare)->value; - tortoise = XSYMBOL (tortoise)->value; + hare = XSYMBOL (hare->value); + tortoise = XSYMBOL (tortoise->value); - if (EQ (hare, tortoise)) - xsignal1 (Qcyclic_variable_indirection, symbol); + if (hare == tortoise) + { + Lisp_Object tem; + XSETSYMBOL (tem, symbol); + xsignal1 (Qcyclic_variable_indirection, tem); + } } return hare; @@ -850,7 +853,7 @@ variable chain of symbols. */) Lisp_Object object; { if (SYMBOLP (object)) - object = indirect_variable (object); + XSETSYMBOL (object, indirect_variable (XSYMBOL (object))); return object; } @@ -974,7 +977,7 @@ store_symval_forwarding (symbol, valcontents, newval, buf) if (! NILP (type) && ! NILP (newval) && XTYPE (newval) != XINT (type)) - buffer_slot_type_mismatch (symbol, XINT (type)); + buffer_slot_type_mismatch (newval, XINT (type)); if (buf == NULL) buf = current_buffer; @@ -1051,8 +1054,12 @@ swap_in_symval_forwarding (symbol, valcontents) || (XBUFFER_LOCAL_VALUE (valcontents)->check_frame && ! EQ (selected_frame, XBUFFER_LOCAL_VALUE (valcontents)->frame))) { - if (XSYMBOL (symbol)->indirect_variable) - symbol = indirect_variable (symbol); + struct Lisp_Symbol *sym = XSYMBOL (symbol); + if (sym->indirect_variable) + { + sym = indirect_variable (sym); + XSETSYMBOL (symbol, sym); + } /* Unload the previously loaded binding. */ tem1 = XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr); @@ -1134,7 +1141,7 @@ DEFUN ("set", Fset, Sset, 2, 2, 0, static int let_shadows_buffer_binding_p (symbol) - Lisp_Object symbol; + struct Lisp_Symbol *symbol; { volatile struct specbinding *p; @@ -1142,10 +1149,10 @@ let_shadows_buffer_binding_p (symbol) if (p->func == NULL && CONSP (p->symbol)) { - Lisp_Object let_bound_symbol = XCAR (p->symbol); - if ((EQ (symbol, let_bound_symbol) - || (XSYMBOL (let_bound_symbol)->indirect_variable - && EQ (symbol, indirect_variable (let_bound_symbol)))) + struct Lisp_Symbol *let_bound_symbol = XSYMBOL (XCAR (p->symbol)); + if ((symbol == let_bound_symbol + || (let_bound_symbol->indirect_variable + && symbol == indirect_variable (let_bound_symbol))) && XBUFFER (XCDR (XCDR (p->symbol))) == current_buffer) break; } @@ -1192,14 +1199,14 @@ set_internal (symbol, newval, buf, bindflag) int idx = PER_BUFFER_IDX (offset); if (idx > 0 && !bindflag - && !let_shadows_buffer_binding_p (symbol)) + && !let_shadows_buffer_binding_p (XSYMBOL (symbol))) SET_PER_BUFFER_VALUE_P (buf, idx, 1); } else if (BUFFER_LOCAL_VALUEP (valcontents)) { /* valcontents is a struct Lisp_Buffer_Local_Value. */ if (XSYMBOL (symbol)->indirect_variable) - symbol = indirect_variable (symbol); + XSETSYMBOL (symbol, indirect_variable (XSYMBOL (symbol))); /* What binding is loaded right now? */ current_alist_element @@ -1241,7 +1248,7 @@ set_internal (symbol, newval, buf, bindflag) Likewise if the variable has been let-bound in the current buffer. */ if (bindflag || !XBUFFER_LOCAL_VALUE (valcontents)->local_if_set - || let_shadows_buffer_binding_p (symbol)) + || let_shadows_buffer_binding_p (XSYMBOL (symbol))) { XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 0; @@ -1475,34 +1482,39 @@ The function `default-value' gets the default value and `set-default' sets it. register Lisp_Object variable; { register Lisp_Object tem, valcontents, newval; + struct Lisp_Symbol *sym; CHECK_SYMBOL (variable); - variable = indirect_variable (variable); + sym = indirect_variable (XSYMBOL (variable)); - valcontents = SYMBOL_VALUE (variable); - if (XSYMBOL (variable)->constant || KBOARD_OBJFWDP (valcontents)) - error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME (variable))); + valcontents = sym->value; + if (sym->constant || KBOARD_OBJFWDP (valcontents)) + error ("Symbol %s may not be buffer-local", SDATA (sym->xname)); if (BUFFER_OBJFWDP (valcontents)) return variable; else if (BUFFER_LOCAL_VALUEP (valcontents)) - newval = valcontents; + { + if (XBUFFER_LOCAL_VALUE (valcontents)->check_frame) + error ("Symbol %s may not be buffer-local", SDATA (sym->xname)); + newval = valcontents; + } else { if (EQ (valcontents, Qunbound)) - SET_SYMBOL_VALUE (variable, Qnil); + sym->value = Qnil; tem = Fcons (Qnil, Fsymbol_value (variable)); XSETCAR (tem, tem); newval = allocate_misc (); XMISCTYPE (newval) = Lisp_Misc_Buffer_Local_Value; - XBUFFER_LOCAL_VALUE (newval)->realvalue = SYMBOL_VALUE (variable); + XBUFFER_LOCAL_VALUE (newval)->realvalue = sym->value; XBUFFER_LOCAL_VALUE (newval)->buffer = Fcurrent_buffer (); XBUFFER_LOCAL_VALUE (newval)->frame = Qnil; XBUFFER_LOCAL_VALUE (newval)->found_for_buffer = 0; XBUFFER_LOCAL_VALUE (newval)->found_for_frame = 0; XBUFFER_LOCAL_VALUE (newval)->check_frame = 0; XBUFFER_LOCAL_VALUE (newval)->cdr = tem; - SET_SYMBOL_VALUE (variable, newval); + sym->value = newval; } XBUFFER_LOCAL_VALUE (newval)->local_if_set = 1; return variable; @@ -1532,13 +1544,16 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */) register Lisp_Object variable; { register Lisp_Object tem, valcontents; + struct Lisp_Symbol *sym; CHECK_SYMBOL (variable); - variable = indirect_variable (variable); + sym = indirect_variable (XSYMBOL (variable)); - valcontents = SYMBOL_VALUE (variable); - if (XSYMBOL (variable)->constant || KBOARD_OBJFWDP (valcontents)) - error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME (variable))); + valcontents = sym->value; + if (sym->constant || KBOARD_OBJFWDP (valcontents) + || (BUFFER_LOCAL_VALUEP (valcontents) + && (XBUFFER_LOCAL_VALUE (valcontents)->check_frame))) + error ("Symbol %s may not be buffer-local", SDATA (sym->xname)); if ((BUFFER_LOCAL_VALUEP (valcontents) && XBUFFER_LOCAL_VALUE (valcontents)->local_if_set) @@ -1559,7 +1574,7 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */) XSETCAR (tem, tem); newval = allocate_misc (); XMISCTYPE (newval) = Lisp_Misc_Buffer_Local_Value; - XBUFFER_LOCAL_VALUE (newval)->realvalue = SYMBOL_VALUE (variable); + XBUFFER_LOCAL_VALUE (newval)->realvalue = sym->value; XBUFFER_LOCAL_VALUE (newval)->buffer = Qnil; XBUFFER_LOCAL_VALUE (newval)->frame = Qnil; XBUFFER_LOCAL_VALUE (newval)->local_if_set = 0; @@ -1567,9 +1582,10 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */) XBUFFER_LOCAL_VALUE (newval)->found_for_frame = 0; XBUFFER_LOCAL_VALUE (newval)->check_frame = 0; XBUFFER_LOCAL_VALUE (newval)->cdr = tem; - SET_SYMBOL_VALUE (variable, newval); + sym->value = newval; } /* Make sure this buffer has its own value of symbol. */ + XSETSYMBOL (variable, sym); /* Propagate variable indirections. */ tem = Fassq (variable, current_buffer->local_var_alist); if (NILP (tem)) { @@ -1579,7 +1595,7 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */) find_symbol_value (variable); current_buffer->local_var_alist - = Fcons (Fcons (variable, XCDR (XBUFFER_LOCAL_VALUE (SYMBOL_VALUE (variable))->cdr)), + = Fcons (Fcons (variable, XCDR (XBUFFER_LOCAL_VALUE (sym->value)->cdr)), current_buffer->local_var_alist); /* Make sure symbol does not think it is set up for this buffer; @@ -1587,7 +1603,7 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */) { Lisp_Object *pvalbuf; - valcontents = SYMBOL_VALUE (variable); + valcontents = sym->value; pvalbuf = &XBUFFER_LOCAL_VALUE (valcontents)->buffer; if (current_buffer == XBUFFER (*pvalbuf)) @@ -1600,9 +1616,9 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */) for this buffer now. If C code modifies the variable before we load the binding in, then that new value will clobber the default binding the next time we unload it. */ - valcontents = XBUFFER_LOCAL_VALUE (SYMBOL_VALUE (variable))->realvalue; + valcontents = XBUFFER_LOCAL_VALUE (sym->value)->realvalue; if (INTFWDP (valcontents) || BOOLFWDP (valcontents) || OBJFWDP (valcontents)) - swap_in_symval_forwarding (variable, SYMBOL_VALUE (variable)); + swap_in_symval_forwarding (variable, sym->value); return variable; } @@ -1615,11 +1631,12 @@ From now on the default value will apply in this buffer. Return VARIABLE. */) register Lisp_Object variable; { register Lisp_Object tem, valcontents; + struct Lisp_Symbol *sym; CHECK_SYMBOL (variable); - variable = indirect_variable (variable); + sym = indirect_variable (XSYMBOL (variable)); - valcontents = SYMBOL_VALUE (variable); + valcontents = sym->value; if (BUFFER_OBJFWDP (valcontents)) { @@ -1639,7 +1656,7 @@ From now on the default value will apply in this buffer. Return VARIABLE. */) return variable; /* Get rid of this buffer's alist element, if any. */ - + XSETSYMBOL (variable, sym); /* Propagate variable indirection. */ tem = Fassq (variable, current_buffer->local_var_alist); if (!NILP (tem)) current_buffer->local_var_alist @@ -1650,7 +1667,7 @@ From now on the default value will apply in this buffer. Return VARIABLE. */) forwarded objects won't work right. */ { Lisp_Object *pvalbuf, buf; - valcontents = SYMBOL_VALUE (variable); + valcontents = sym->value; pvalbuf = &XBUFFER_LOCAL_VALUE (valcontents)->buffer; XSETBUFFER (buf, current_buffer); if (EQ (buf, *pvalbuf)) @@ -1666,6 +1683,9 @@ From now on the default value will apply in this buffer. Return VARIABLE. */) /* Lisp functions for creating and removing buffer-local variables. */ +/* Obsolete since 22.2. NB adjust doc of modify-frame-parameters + when/if this is removed. */ + 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. @@ -1682,33 +1702,37 @@ 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. */) +Note that since Emacs 23.1, variables cannot be both buffer-local and +frame-local any more (buffer-local bindings used to take precedence over +frame-local bindings). */) (variable) register Lisp_Object variable; { register Lisp_Object tem, valcontents, newval; + struct Lisp_Symbol *sym; CHECK_SYMBOL (variable); - variable = indirect_variable (variable); + sym = indirect_variable (XSYMBOL (variable)); - valcontents = SYMBOL_VALUE (variable); - if (XSYMBOL (variable)->constant || KBOARD_OBJFWDP (valcontents) + valcontents = sym->value; + if (sym->constant || KBOARD_OBJFWDP (valcontents) || BUFFER_OBJFWDP (valcontents)) - error ("Symbol %s may not be frame-local", SDATA (SYMBOL_NAME (variable))); + error ("Symbol %s may not be frame-local", SDATA (sym->xname)); if (BUFFER_LOCAL_VALUEP (valcontents)) { - XBUFFER_LOCAL_VALUE (valcontents)->check_frame = 1; + if (!XBUFFER_LOCAL_VALUE (valcontents)->check_frame) + error ("Symbol %s may not be frame-local", SDATA (sym->xname)); return variable; } if (EQ (valcontents, Qunbound)) - SET_SYMBOL_VALUE (variable, Qnil); + sym->value = Qnil; tem = Fcons (Qnil, Fsymbol_value (variable)); XSETCAR (tem, tem); newval = allocate_misc (); XMISCTYPE (newval) = Lisp_Misc_Buffer_Local_Value; - XBUFFER_LOCAL_VALUE (newval)->realvalue = SYMBOL_VALUE (variable); + XBUFFER_LOCAL_VALUE (newval)->realvalue = sym->value; XBUFFER_LOCAL_VALUE (newval)->buffer = Qnil; XBUFFER_LOCAL_VALUE (newval)->frame = Qnil; XBUFFER_LOCAL_VALUE (newval)->local_if_set = 0; @@ -1716,7 +1740,7 @@ Buffer-local bindings take precedence over frame-local bindings. */) XBUFFER_LOCAL_VALUE (newval)->found_for_frame = 0; XBUFFER_LOCAL_VALUE (newval)->check_frame = 1; XBUFFER_LOCAL_VALUE (newval)->cdr = tem; - SET_SYMBOL_VALUE (variable, newval); + sym->value = newval; return variable; } @@ -1729,6 +1753,7 @@ BUFFER defaults to the current buffer. */) { Lisp_Object valcontents; register struct buffer *buf; + struct Lisp_Symbol *sym; if (NILP (buffer)) buf = current_buffer; @@ -1739,9 +1764,10 @@ BUFFER defaults to the current buffer. */) } CHECK_SYMBOL (variable); - variable = indirect_variable (variable); - - valcontents = SYMBOL_VALUE (variable); + sym = indirect_variable (XSYMBOL (variable)); + XSETSYMBOL (variable, sym); + + valcontents = sym->value; if (BUFFER_LOCAL_VALUEP (valcontents)) { Lisp_Object tail, elt; @@ -1776,6 +1802,7 @@ BUFFER defaults to the current buffer. */) { Lisp_Object valcontents; register struct buffer *buf; + struct Lisp_Symbol *sym; if (NILP (buffer)) buf = current_buffer; @@ -1786,9 +1813,10 @@ BUFFER defaults to the current buffer. */) } CHECK_SYMBOL (variable); - variable = indirect_variable (variable); + sym = indirect_variable (XSYMBOL (variable)); + XSETSYMBOL (variable, sym); - valcontents = SYMBOL_VALUE (variable); + valcontents = sym->value; if (BUFFER_OBJFWDP (valcontents)) /* All these slots become local if they are set. */ @@ -1818,14 +1846,15 @@ If the current binding is global (the default), the value is nil. */) register Lisp_Object variable; { Lisp_Object valcontents; + struct Lisp_Symbol *sym; CHECK_SYMBOL (variable); - variable = indirect_variable (variable); + sym = indirect_variable (XSYMBOL (variable)); /* Make sure the current binding is actually swapped in. */ find_symbol_value (variable); - valcontents = XSYMBOL (variable)->value; + valcontents = sym->value; if (BUFFER_LOCAL_VALUEP (valcontents) || BUFFER_OBJFWDP (valcontents)) @@ -1852,7 +1881,7 @@ DEFUN ("terminal-local-value", Fterminal_local_value, Sterminal_local_value, 2, If SYMBOL is not a terminal-local variable, then return its normal value, like `symbol-value'. -TERMINAL may be a terminal id, a frame, or nil (meaning the +TERMINAL may be a terminal object, a frame, or nil (meaning the selected frame's terminal device). */) (symbol, terminal) Lisp_Object symbol; @@ -1871,7 +1900,7 @@ DEFUN ("set-terminal-local-value", Fset_terminal_local_value, Sset_terminal_loca If VARIABLE is not a terminal-local variable, then set its normal binding, like `set'. -TERMINAL may be a terminal id, a frame, or nil (meaning the +TERMINAL may be a terminal object, a frame, or nil (meaning the selected frame's terminal device). */) (symbol, terminal, value) Lisp_Object symbol; @@ -3122,6 +3151,12 @@ syms_of_data () Qbool_vector = intern ("bool-vector"); Qhash_table = intern ("hash-table"); + DEFSYM (Qfont_spec, "font-spec"); + DEFSYM (Qfont_entity, "font-entity"); + DEFSYM (Qfont_object, "font-object"); + + DEFSYM (Qinteractive_form, "interactive-form"); + staticpro (&Qinteger); staticpro (&Qsymbol); staticpro (&Qstring); @@ -3258,15 +3293,7 @@ arith_error (signo) must reestablish each time */ signal (signo, arith_error); #endif /* USG */ -#ifdef VMS - /* VMS systems are like USG. */ - signal (signo, arith_error); -#endif /* VMS */ -#ifdef BSD4_1 - sigrelse (SIGFPE); -#else /* not BSD4_1 */ sigsetmask (SIGEMPTYMASK); -#endif /* not BSD4_1 */ SIGNAL_THREAD_CHECK (signo); xsignal0 (Qarith_error);