emacs: src/data.c comparison

comparison src/data.c @ 89909:68c22ea6027c

Sync to HEAD

author	Kenichi Handa <handa@m17n.org>
date	Fri, 16 Apr 2004 12:51:06 +0000
parents	58eb89f2fdfc
children	4c90ffeb71c5

comparison

equal deleted inserted replaced

-:ee1402f7b568
+:68c22ea6027c
 /* 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.
 GNU Emacs is free software; you can redistribute it and/or modify
 Lisp_Object Qsetting_constant, Qinvalid_read_syntax;
 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;
 Lisp_Object Qbuffer_or_string_p, Qkeywordp;
 Lisp_Object Qboundp, Qfboundp;
 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;
 static Lisp_Object Qchar_table, Qbool_vector, Qhash_table;
 static Lisp_Object Qsubrp, Qmany, Qunevalled;
 Fput (symbol, Qfunction_documentation, docstring);
 return 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;
 {
 CHECK_SYMBOL (symbol);
 XSYMBOL (symbol)->plist = newplist;
 return Fcons (make_number (minargs), Qunevalled);
 else
 return Fcons (make_number (minargs), make_number (maxargs));
 }
-DEFUN ("subr-interactive-form", Fsubr_interactive_form, Ssubr_interactive_form, 1, 1, 0,
+DEFUN ("interactive-form", Finteractive_form, Sinteractive_form, 1, 1, 0,
-doc: /* Return the interactive form of SUBR or nil if none.
+doc: /* Return the interactive form of CMD or nil if none.
-SUBR must be a built-in function.  Value, if non-nil, is a list
+CMD must be a command.  Value, if non-nil, is a list
 \(interactive SPEC).  */)
-(subr)
+(cmd)
-Lisp_Object subr;
+Lisp_Object cmd;
 {
-if (!SUBRP (subr))
+Lisp_Object fun = indirect_function (cmd);
-wrong_type_argument (Qsubrp, subr);
-if (XSUBR (subr)->prompt)
+if (SUBRP (fun))
-return list2 (Qinteractive, build_string (XSUBR (subr)->prompt));
+{
+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;
 }
 /***********************************************************************
 store_symval_forwarding (symbol, valcontents, newval, buf)
 Lisp_Object symbol;
 register Lisp_Object valcontents, newval;
 struct buffer *buf;
 {
+int offset;
 switch (SWITCH_ENUM_CAST (XTYPE (valcontents)))
 {
 case Lisp_Misc:
 switch (XMISCTYPE (valcontents))
 	{
 	  *XBOOLFWD (valcontents)->boolvar = NILP (newval) ? 0 : 1;
 	  break;
 	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:
 	  {
 	    int offset = XBUFFER_OBJFWD (valcontents)->offset;
 register Lisp_Object variable;
 {
 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))
 error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME (variable)));
 register Lisp_Object variable;
 {
 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))
 error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME (variable)));
 register Lisp_Object variable;
 {
 register Lisp_Object tem, valcontents;
 CHECK_SYMBOL (variable);
+variable = indirect_variable (variable);
 valcontents = SYMBOL_VALUE (variable);
 if (BUFFER_OBJFWDP (valcontents))
 {
 register Lisp_Object variable;
 {
 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)
 || BUFFER_OBJFWDP (valcontents))
 error ("Symbol %s may not be frame-local", SDATA (SYMBOL_NAME (variable)));
 CHECK_BUFFER (buffer);
 buf = XBUFFER (buffer);
 }
 CHECK_SYMBOL (variable);
+variable = indirect_variable (variable);
 valcontents = SYMBOL_VALUE (variable);
 if (BUFFER_LOCAL_VALUEP (valcontents)
 || SOME_BUFFER_LOCAL_VALUEP (valcontents))
 {
 Lisp_Object tail, elt;
-variable = indirect_variable (variable);
 for (tail = buf->local_var_alist; CONSP (tail); tail = XCDR (tail))
 	{
 	  elt = XCAR (tail);
 	  if (EQ (variable, XCAR (elt)))
 	    return Qt;
 CHECK_BUFFER (buffer);
 buf = XBUFFER (buffer);
 }
 CHECK_SYMBOL (variable);
+variable = indirect_variable (variable);
 valcontents = SYMBOL_VALUE (variable);
 /* This means that make-variable-buffer-local was done.  */
 if (BUFFER_LOCAL_VALUEP (valcontents))
 	  elt = XCAR (tail);
 	  if (EQ (variable, XCAR (elt)))
 	    return Qt;
 	}
 }
+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.  */
 {
 CHECK_NUMBER (number);
 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 ()
 {
 Lisp_Object error_tail, arith_tail;
 staticpro (&Qchar_table);
 staticpro (&Qbool_vector);
 staticpro (&Qhash_table);
 defsubr (&Sindirect_variable);
-defsubr (&Ssubr_interactive_form);
+defsubr (&Sinteractive_form);
 defsubr (&Seq);
 defsubr (&Snull);
 defsubr (&Stype_of);
 defsubr (&Slistp);
 defsubr (&Snlistp);
 defsubr (&Smake_local_variable);
 defsubr (&Skill_local_variable);
 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);
 defsubr (&Sstring_to_number);
 defsubr (&Seqlsign);
 defsubr (&Slsh);
 defsubr (&Sash);
 defsubr (&Sadd1);
 defsubr (&Ssub1);
 defsubr (&Slognot);
+defsubr (&Sbyteorder);
 defsubr (&Ssubr_arity);
 XSYMBOL (Qwholenump)->function = XSYMBOL (Qnatnump)->function;
 DEFVAR_LISP ("most-positive-fixnum", &Vmost_positive_fixnum,
 #ifdef uts
 signal (SIGEMT, arith_error);
 #endif /* uts */
 }
+/* arch-tag: 25879798-b84d-479a-9c89-7d148e2109f7
+(do not change this comment) */

Mercurial > emacs

comparison src/data.c @ 89909:68c22ea6027c