]> code.delx.au - gnu-emacs/blobdiff - src/data.c
(Vnonascii_translation_table): Name changed from
[gnu-emacs] / src / data.c
index bf637585cd013aa1d72bc8567baba58ee79bc1c5..eb04f5a39aac42f5dccbb6bc271e4187a46be2ca 100644 (file)
@@ -68,6 +68,10 @@ Boston, MA 02111-1307, USA.  */
 extern double atof ();
 #endif /* !atof */
 
+/* Nonzero means it is an error to set a symbol whose name starts with
+   colon.  */
+int keyword_symbols_constant_flag;
+
 Lisp_Object Qnil, Qt, Qquote, Qlambda, Qsubr, Qunbound;
 Lisp_Object Qerror_conditions, Qerror_message, Qtop_level;
 Lisp_Object Qerror, Qquit, Qwrong_type_argument, Qargs_out_of_range;
@@ -132,6 +136,7 @@ wrong_type_argument (predicate, value)
   return value;
 }
 
+void
 pure_write_error ()
 {
   error ("Attempt to modify read-only object");
@@ -611,7 +616,10 @@ DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0, "Make SYMBOL's value be
      register Lisp_Object symbol;
 {
   CHECK_SYMBOL (symbol, 0);
-  if (NILP (symbol) || EQ (symbol, Qt))
+  if (NILP (symbol) || EQ (symbol, Qt)
+      || (XSYMBOL (symbol)->name->data[0] == ':'
+         && EQ (XSYMBOL (symbol)->obarray, initial_obarray)
+         && keyword_symbols_constant_flag))
     return Fsignal (Qsetting_constant, Fcons (symbol, Qnil));
   Fset (symbol, Qunbound);
   return symbol;
@@ -960,7 +968,10 @@ set_internal (symbol, newval, bindflag)
   register Lisp_Object valcontents, tem1, current_alist_element;
 
   CHECK_SYMBOL (symbol, 0);
-  if (NILP (symbol) || EQ (symbol, Qt))
+  if (NILP (symbol) || EQ (symbol, Qt)
+      || (XSYMBOL (symbol)->name->data[0] == ':'
+         && EQ (XSYMBOL (symbol)->obarray, initial_obarray)
+         && keyword_symbols_constant_flag && ! EQ (newval, symbol)))
     return Fsignal (Qsetting_constant, Fcons (symbol, Qnil));
   valcontents = XSYMBOL (symbol)->value;
 
@@ -1444,13 +1455,13 @@ From now on the default value will apply in this buffer.")
 
 DEFUN ("make-variable-frame-local", Fmake_variable_frame_local, Smake_variable_frame_local,
   1, 1, "vMake Variable Frame Local: ",
-  "Make VARIABLE have a separate value for each buffer.\n\
-At any time, the value for the current buffer is in effect.\n\
-There is also a default value which is seen in any buffer which has not yet\n\
-set its own value.\n\
-Using `set' or `setq' to set the variable causes it to have a separate value\n\
-for the current buffer if it was previously using the default value.\n\
-The function `default-value' gets the default value and `set-default' sets it.")
+  "Enable VARIABLE to have frame-local bindings.\n\
+When a frame-local binding exists in the current frame,\n\
+it is in effect whenever the current buffer has no buffer-local binding.\n\
+A frame-local binding is actual a frame parameter value;\n\
+thus, any given frame has a local binding for VARIABLE\n\
+if it has a value for the frame parameter named VARIABLE.\n\
+See `modify-frame-parameters'.")
   (variable)
      register Lisp_Object variable;
 {
@@ -1648,7 +1659,7 @@ or a byte-code object.  IDX starts at 0.")
       idxval_byte = string_char_to_byte (array, idxval);
 
       c = STRING_CHAR (&XSTRING (array)->data[idxval_byte],
-                      XSTRING (array)->size_byte - idxval_byte);
+                      STRING_BYTES (XSTRING (array)) - idxval_byte);
       return make_number (c);
     }
   else if (BOOL_VECTOR_P (array))
@@ -1847,7 +1858,7 @@ IDX starts at 0.")
       p = &XSTRING (array)->data[idxval_byte];
 
       actual_len
-       = MULTIBYTE_FORM_LENGTH (p, XSTRING (array)->size_byte - idxval_byte);
+       = MULTIBYTE_FORM_LENGTH (p, STRING_BYTES (XSTRING (array)) - idxval_byte);
       new_len = Fchar_bytes (newelt);
       if (actual_len != XINT (new_len))
        error ("Attempt to change byte length of a string");
@@ -2470,8 +2481,12 @@ In this case, the sign bit is duplicated.")
   CHECK_NUMBER (value, 0);
   CHECK_NUMBER (count, 1);
 
-  if (XINT (count) > 0)
+  if (XINT (count) >= BITS_PER_EMACS_INT)
+    XSETINT (val, 0);
+  else if (XINT (count) > 0)
     XSETINT (val, XINT (value) << XFASTINT (count));
+  else if (XINT (count) <= -BITS_PER_EMACS_INT)
+    XSETINT (val, XINT (value) < 0 ? -1 : 0);
   else
     XSETINT (val, XINT (value) >> -XINT (count));
   return val;
@@ -2489,8 +2504,12 @@ In this case,  zeros are shifted in on the left.")
   CHECK_NUMBER (value, 0);
   CHECK_NUMBER (count, 1);
 
-  if (XINT (count) > 0)
+  if (XINT (count) >= BITS_PER_EMACS_INT)
+    XSETINT (val, 0);
+  else if (XINT (count) > 0)
     XSETINT (val, (EMACS_UINT) XUINT (value) << XFASTINT (count));
+  else if (XINT (count) <= -BITS_PER_EMACS_INT)
+    XSETINT (val, 0);
   else
     XSETINT (val, (EMACS_UINT) XUINT (value) >> -XINT (count));
   return val;
@@ -2833,6 +2852,11 @@ syms_of_data ()
   staticpro (&Qchar_table);
   staticpro (&Qbool_vector);
 
+  DEFVAR_BOOL ("keyword-symbols-constant-flag", &keyword_symbols_constant_flag,
+    "Non-nil means it is an error to set a keyword symbol.\n\
+A keyword symbol is a symbol whose name starts with a colon (`:').");
+  keyword_symbols_constant_flag = 1;
+
   defsubr (&Seq);
   defsubr (&Snull);
   defsubr (&Stype_of);
@@ -2944,6 +2968,7 @@ arith_error (signo)
   Fsignal (Qarith_error, Qnil);
 }
 
+void
 init_data ()
 {
   /* Don't do this if just dumping out.