XEmacs 21.4.15
[chise/xemacs-chise.git.1] / src / symbols.c
index 7599d00..58cf76f 100644 (file)
@@ -790,10 +790,15 @@ Set SYMBOL's property list to NEWPLIST, and return NEWPLIST.
       the symbol-value-forward. (See below.)
 
    SYMVAL_FIXNUM_FORWARD:
+      (declare with DEFVAR_INT)
+      Similar to SYMVAL_OBJECT_FORWARD except that the C variable
+      is of type "Fixnum", a typedef for "EMACS_INT", and the corresponding
+      lisp variable is always the corresponding integer.
+
    SYMVAL_BOOLEAN_FORWARD:
-      (declare with DEFVAR_INT or DEFVAR_BOOL)
+      (declare with DEFVAR_BOOL)
       Similar to SYMVAL_OBJECT_FORWARD except that the C variable
-      is of type "int" and is an integer or boolean, respectively.
+      is of type "int" and is a boolean.
 
    SYMVAL_CONST_OBJECT_FORWARD:
    SYMVAL_CONST_FIXNUM_FORWARD:
@@ -995,8 +1000,10 @@ static const struct lrecord_description symbol_value_forward_description[] = {
 };
 
 static const struct lrecord_description symbol_value_buffer_local_description[] = {
-  { XD_LISP_OBJECT,  offsetof (struct symbol_value_buffer_local, default_value) },
-  { XD_LO_RESET_NIL, offsetof (struct symbol_value_buffer_local, current_value), 3 },
+  { XD_LISP_OBJECT, offsetof (struct symbol_value_buffer_local, default_value) },
+  { XD_LISP_OBJECT, offsetof (struct symbol_value_buffer_local, current_value) },
+  { XD_LISP_OBJECT, offsetof (struct symbol_value_buffer_local, current_buffer) },
+  { XD_LISP_OBJECT, offsetof (struct symbol_value_buffer_local, current_alist_element) },
   { XD_END }
 };
 
@@ -1071,7 +1078,7 @@ do_symval_forwarding (Lisp_Object valcontents, struct buffer *buffer,
     {
     case SYMVAL_FIXNUM_FORWARD:
     case SYMVAL_CONST_FIXNUM_FORWARD:
-      return make_int (*((int *)symbol_value_forward_forward (fwd)));
+      return make_int (*((Fixnum *)symbol_value_forward_forward (fwd)));
 
     case SYMVAL_BOOLEAN_FORWARD:
     case SYMVAL_CONST_BOOLEAN_FORWARD:
@@ -1244,7 +1251,7 @@ store_symval_forwarding (Lisp_Object sym, Lisp_Object ovalue,
          CHECK_INT (newval);
          if (magicfun)
            magicfun (sym, &newval, Qnil, 0);
-         *((int *) symbol_value_forward_forward (fwd)) = XINT (newval);
+         *((Fixnum *) symbol_value_forward_forward (fwd)) = XINT (newval);
          return;
 
        case SYMVAL_BOOLEAN_FORWARD:
@@ -1395,6 +1402,71 @@ set_up_buffer_local_cache (Lisp_Object sym,
   store_symval_forwarding (sym, bfwd->current_value, new_val);
 }
 
+
+/* SYM is a buffer-local variable, and BFWD is its buffer-local structure.
+   Flush the cache.  BFWD->CURRENT_BUFFER will be nil after this operation.
+*/
+
+static void
+flush_buffer_local_cache (Lisp_Object sym,
+                         struct symbol_value_buffer_local *bfwd)
+{
+  if (NILP (bfwd->current_buffer))
+    /* Cache is already flushed. */
+    return;
+
+  /* Flush out the old cache. */
+  write_out_buffer_local_cache (sym, bfwd);
+
+  bfwd->current_alist_element = Qnil;
+  bfwd->current_buffer = Qnil;
+
+  /* Now store default the value into the current-value slot.
+     We don't simply write it there, because the current-value
+     slot might be a forwarding pointer, in which case we need
+     to instead write the value into the C variable.
+
+     We might also want to call a magic function.
+
+     So instead, we call this function. */
+  store_symval_forwarding (sym, bfwd->current_value, bfwd->default_value);
+}
+
+/* Flush all the buffer-local variable caches.  Whoever has a
+   non-interned buffer-local variable will be spanked.  Whoever has a
+   magic variable that interns or uninterns symbols... I don't even
+   want to think about it.
+*/
+
+void
+flush_all_buffer_local_cache (void)
+{
+  Lisp_Object *syms = XVECTOR_DATA (Vobarray);
+  long count = XVECTOR_LENGTH (Vobarray);
+  long i;
+
+  for (i=0; i<count; i++)
+    {
+      Lisp_Object sym = syms[i];
+      Lisp_Object value;
+
+      if (!ZEROP (sym))
+       for(;;)
+         {
+           Lisp_Symbol *next;
+           assert (SYMBOLP (sym));
+           value = fetch_value_maybe_past_magic (sym, Qt);
+           if (SYMBOL_VALUE_BUFFER_LOCAL_P (value))
+             flush_buffer_local_cache (sym, XSYMBOL_VALUE_BUFFER_LOCAL (value));
+
+           next = symbol_next (XSYMBOL (sym));
+           if (!next)
+             break;
+           XSETSYMBOL (sym, next);
+         }
+    }
+}
+
 \f
 void
 kill_buffer_local_variables (struct buffer *buf)
@@ -2096,6 +2168,7 @@ sets it.
       = alloc_lcrecord_type (struct symbol_value_buffer_local,
                             &lrecord_symbol_value_buffer_local);
     Lisp_Object foo;
+    zero_lcrecord (&bfwd->magic);
     bfwd->magic.type = SYMVAL_BUFFER_LOCAL;
 
     bfwd->default_value = find_symbol_value (variable);
@@ -2203,6 +2276,7 @@ Use `make-local-hook' instead.
   /* Make sure variable is set up to hold per-buffer values */
   bfwd = alloc_lcrecord_type (struct symbol_value_buffer_local,
                              &lrecord_symbol_value_buffer_local);
+  zero_lcrecord (&bfwd->magic);
   bfwd->magic.type = SYMVAL_SOME_BUFFER_LOCAL;
 
   bfwd->current_buffer = Qnil;
@@ -2923,6 +2997,7 @@ pity, thereby invalidating your code.
     {
       bfwd = alloc_lcrecord_type (struct symbol_value_lisp_magic,
                                  &lrecord_symbol_value_lisp_magic);
+      zero_lcrecord (&bfwd->magic);
       bfwd->magic.type = SYMVAL_LISP_MAGIC;
       for (i = 0; i < MAGIC_HANDLER_MAX; i++)
        {
@@ -3059,6 +3134,7 @@ has a buffer-local value in any buffer, or the symbols nil or t.
 
   bfwd = alloc_lcrecord_type (struct symbol_value_varalias,
                              &lrecord_symbol_value_varalias);
+  zero_lcrecord (&bfwd->magic);
   bfwd->magic.type = SYMVAL_VARALIAS;
   bfwd->aliasee = alias;
   bfwd->shadowed = valcontents;
@@ -3116,6 +3192,31 @@ variable chain of symbols.
   return follow_varalias_pointers (object, follow_past_lisp_magic);
 }
 
+DEFUN ("variable-binding-locus", Fvariable_binding_locus, 1, 1, 0, /*
+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 global (the default), the value is nil. 
+*/
+       (variable))
+{
+  Lisp_Object valcontents;
+
+  CHECK_SYMBOL (variable);
+  variable = Findirect_variable (variable, Qnil);
+
+  /* Make sure the current binding is actually swapped in.  */
+  find_symbol_value (variable);
+
+  valcontents = XSYMBOL (variable)->value;
+
+  if (SYMBOL_VALUE_MAGIC_P (valcontents)
+      && ((XSYMBOL_VALUE_MAGIC_TYPE (valcontents) == SYMVAL_BUFFER_LOCAL)
+         || (XSYMBOL_VALUE_MAGIC_TYPE (valcontents) == SYMVAL_SOME_BUFFER_LOCAL))
+      && (!NILP (Flocal_variable_p (variable, Fcurrent_buffer (), Qnil))))
+    return Fcurrent_buffer ();
+  else
+    return Qnil;
+}
 \f
 /************************************************************************/
 /*                            initialization                            */
@@ -3192,9 +3293,9 @@ init_symbols_once_early (void)
   XSYMBOL (Qt)->value = Qt;    /* Veritas aeterna */
   Vquit_flag = Qnil;
 
-  pdump_wire (&Qnil);
-  pdump_wire (&Qunbound);
-  pdump_wire (&Vquit_flag);
+  dump_add_root_object (&Qnil);
+  dump_add_root_object (&Qunbound);
+  dump_add_root_object (&Vquit_flag);
 }
 
 void
@@ -3216,8 +3317,8 @@ defsymbol_massage_name_1 (Lisp_Object *location, const char *name, int dump_p,
                          int multiword_predicate_p)
 {
   char temp[500];
-  int len = strlen (name) - 1;
-  int i;
+  size_t len = strlen (name) - 1;
+  size_t i;
 
   if (multiword_predicate_p)
     assert (len + 1 < sizeof (temp));
@@ -3293,7 +3394,7 @@ void
 defkeyword_massage_name (Lisp_Object *location, const char *name)
 {
   char temp[500];
-  int len = strlen (name);
+  size_t len = strlen (name);
 
   assert (len < sizeof (temp));
   strcpy (temp, name);
@@ -3428,8 +3529,8 @@ deferror_massage_name_and_message (Lisp_Object *symbol, const char *name,
                                   Lisp_Object inherits_from)
 {
   char temp[500];
-  int i;
-  int len = strlen (name) - 1;
+  size_t i;
+  size_t len = strlen (name) - 1;
 
   assert (len < sizeof (temp));
   strcpy (temp, name + 1); /* Remove initial Q */
@@ -3472,7 +3573,6 @@ syms_of_symbols (void)
   DEFSYMBOL (Qsymbol_value_in_buffer);
   DEFSYMBOL (Qsymbol_value_in_console);
   DEFSYMBOL (Qlocal_variable_p);
-
   DEFSYMBOL (Qconst_integer);
   DEFSYMBOL (Qconst_boolean);
   DEFSYMBOL (Qconst_object);
@@ -3519,6 +3619,7 @@ syms_of_symbols (void)
   DEFSUBR (Fdefvaralias);
   DEFSUBR (Fvariable_alias);
   DEFSUBR (Findirect_variable);
+  DEFSUBR (Fvariable_binding_locus);
   DEFSUBR (Fdontusethis_set_symbol_value_handler);
 }