]> code.delx.au - gnu-emacs/blobdiff - src/fns.c
(add_properties, remove_properties, set_properties):
[gnu-emacs] / src / fns.c
index efa8e23f4538c7a15d8e2c94e8c0e792e449dd7b..7474fc3b3800abeec40d13519c51148252d4a15d 100644 (file)
--- a/src/fns.c
+++ b/src/fns.c
@@ -153,7 +153,7 @@ which is at least the number of distinct elements.")
       if (EQ (tail, halftail) && len != 0)
        break;
       len++;
-      if (len & 1 == 0)
+      if ((len & 1) == 0)
        halftail = XCONS (halftail)->cdr;
     }
 
@@ -301,7 +301,7 @@ with the original.")
 
       /* Calculate the number of extra slots.  */
       size = CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (arg));
-      copy = Fmake_char_table (make_number (size), Qnil);
+      copy = Fmake_char_table (XCHAR_TABLE (arg)->purpose, Qnil);
       /* Copy all the slots, including the extra ones.  */
       bcopy (XCHAR_TABLE (arg)->contents, XCHAR_TABLE (copy)->contents,
             (XCHAR_TABLE (arg)->size & PSEUDOVECTOR_SIZE_MASK) * sizeof (Lisp_Object));
@@ -318,9 +318,8 @@ with the original.")
   if (BOOL_VECTOR_P (arg))
     {
       Lisp_Object val;
-      int bits_per_char = INTBITS / sizeof (int);
       int size_in_chars
-       = (XBOOL_VECTOR (arg)->size + bits_per_char) / bits_per_char;
+       = (XBOOL_VECTOR (arg)->size + BITS_PER_CHAR) / BITS_PER_CHAR;
 
       val = Fmake_bool_vector (Flength (arg), Qnil);
       bcopy (XBOOL_VECTOR (arg)->data, XBOOL_VECTOR (val)->data,
@@ -432,12 +431,11 @@ concat (nargs, args, target_type, last_special)
                XSETFASTINT (elt, XSTRING (this)->data[thisindex++]);
              else if (BOOL_VECTOR_P (this))
                {
-                 int bits_per_char = INTBITS / sizeof (int);
                  int size_in_chars
-                   = ((XBOOL_VECTOR (this)->size + bits_per_char)
-                      / bits_per_char);
+                   = ((XBOOL_VECTOR (this)->size + BITS_PER_CHAR)
+                      / BITS_PER_CHAR);
                  int byte;
-                 byte = XBOOL_VECTOR (val)->data[thisindex / bits_per_char];
+                 byte = XBOOL_VECTOR (val)->data[thisindex / BITS_PER_CHAR];
                  if (byte & (1 << thisindex))
                    elt = Qt;
                  else
@@ -1075,9 +1073,8 @@ internal_equal (o1, o2, depth)
        /* Boolvectors are compared much like strings.  */
        if (BOOL_VECTOR_P (o1))
          {
-           int bits_per_char = INTBITS / sizeof (int);
            int size_in_chars
-             = (XBOOL_VECTOR (o1)->size + bits_per_char) / bits_per_char;
+             = (XBOOL_VECTOR (o1)->size + BITS_PER_CHAR) / BITS_PER_CHAR;
 
            if (XBOOL_VECTOR (o1)->size != XBOOL_VECTOR (o2)->size)
              return 0;
@@ -1160,9 +1157,8 @@ ARRAY is a vector, string, char-table, or bool-vector.")
   else if (BOOL_VECTOR_P (array))
     {
       register unsigned char *p = XBOOL_VECTOR (array)->data;
-      int bits_per_char = INTBITS / sizeof (int);
       int size_in_chars
-       = (XBOOL_VECTOR (array)->size + bits_per_char) / bits_per_char;
+       = (XBOOL_VECTOR (array)->size + BITS_PER_CHAR) / BITS_PER_CHAR;
 
       charval = (! NILP (item) ? -1 : 0);
       for (index = 0; index < size_in_chars; index++)
@@ -1176,6 +1172,17 @@ ARRAY is a vector, string, char-table, or bool-vector.")
   return array;
 }
 
+DEFUN ("char-table-subtype", Fchar_table_subtype, Schar_table_subtype,
+       1, 1, 0,
+  "Return the subtype of char-table CHAR-TABLE.   The value is a symbol.")
+  (chartable)
+     Lisp_Object chartable;
+{
+  CHECK_CHAR_TABLE (chartable, 0);  
+
+  return XCHAR_TABLE (chartable)->purpose;
+}
+
 DEFUN ("char-table-parent", Fchar_table_parent, Schar_table_parent,
        1, 1, 0,
   "Return the parent char-table of CHAR-TABLE.\n\
@@ -1201,11 +1208,15 @@ PARENT must be either nil or another char-table.")
   Lisp_Object temp;
 
   CHECK_CHAR_TABLE (chartable, 0);  
-  CHECK_CHAR_TABLE (parent, 0);  
 
-  for (temp = parent; !NILP (temp); temp = XCHAR_TABLE (temp)->parent)
-    if (EQ (temp, chartable))
-      error ("Attempt to make a chartable be its own parent");
+  if (!NILP (parent))
+    {
+      CHECK_CHAR_TABLE (parent, 0);  
+
+      for (temp = parent; !NILP (temp); temp = XCHAR_TABLE (temp)->parent)
+       if (EQ (temp, chartable))
+         error ("Attempt to make a chartable be its own parent");
+    }
 
   XCHAR_TABLE (chartable)->parent = parent;
 
@@ -1243,6 +1254,37 @@ DEFUN ("set-char-table-extra-slot", Fset_char_table_extra_slot,
   return XCHAR_TABLE (chartable)->extras[XINT (n)] = value;
 }
 
+DEFUN ("char-table-range", Fchar_table_range, Schar_table_range,
+       2, 2, 0,
+  "Return the value in CHARTABLE for a range of characters RANGE.\n\
+RANGE should be t (for all characters), nil (for the default value)\n\
+a vector which identifies a character set or a row of a character set,\n\
+or a character code.")
+  (chartable, range)
+     Lisp_Object chartable, range;
+{
+  int i;
+
+  CHECK_CHAR_TABLE (chartable, 0);
+  
+  if (EQ (range, Qnil))
+    return XCHAR_TABLE (chartable)->defalt;
+  else if (INTEGERP (range))
+    return Faref (chartable, range);
+  else if (VECTORP (range))
+    {
+      for (i = 0; i < XVECTOR (range)->size - 1; i++)
+       chartable = Faref (chartable, XVECTOR (range)->contents[i]);
+
+      if (EQ (XVECTOR (range)->contents[i], Qnil))
+       return XCHAR_TABLE (chartable)->defalt;
+      else
+       return Faref (chartable, XVECTOR (range)->contents[i]);
+    }
+  else
+    error ("Invalid RANGE argument to `char-table-range'");
+}
+
 DEFUN ("set-char-table-range", Fset_char_table_range, Sset_char_table_range,
        3, 3, 0,
   "Set the value in CHARTABLE for a range of characters RANGE to VALUE.\n\
@@ -1279,12 +1321,18 @@ or a character code.")
   return value;
 }
 \f
-static void
-map_char_table (function, chartable, depth, indices)
-     Lisp_Object function, chartable, depth, *indices;
+/* Map C_FUNCTION or FUNCTION over CHARTABLE, calling it for each
+   character or group of characters that share a value.
+   DEPTH is the current depth in the originally specified
+   chartable, and INDICES contains the vector indices
+   for the levels our callers have descended.  */
+
+void
+map_char_table (c_function, function, chartable, depth, indices)
+     Lisp_Object (*c_function) (), function, chartable, depth, *indices;
 {
   int i;
-  int size = XCHAR_TABLE (chartable)->size;
+  int size = CHAR_TABLE_ORDINARY_SLOTS;
 
   /* Make INDICES longer if we are about to fill it up.  */
   if ((depth % 10) == 9)
@@ -1300,10 +1348,17 @@ map_char_table (function, chartable, depth, indices)
       Lisp_Object elt;
       indices[depth] = i;
       elt = XCHAR_TABLE (chartable)->contents[i];
-      if (!CHAR_TABLE_P (elt))
-       call2 (function, Fvector (depth + 1, indices), elt);
+      if (CHAR_TABLE_P (elt))
+       map_char_table (chartable, c_function, function, depth + 1, indices);
+      else if (c_function)
+       (*c_function) (depth + 1, indices, elt);
+      /* Here we should handle all cases where the range is a single character
+        by passing that character as a number.  Currently, that is
+        all the time, but with the MULE code this will have to be changed.  */
+      else if (depth == 0)
+       call2 (function, make_number (i), elt);
       else
-       map_char_table (chartable, function, depth + 1, indices);
+       call2 (function, Fvector (depth + 1, indices), elt);
     }
 }
 
@@ -1318,7 +1373,7 @@ The key is always a possible RANGE argument to `set-char-table-range'.")
   Lisp_Object keyvec;
   Lisp_Object *indices = (Lisp_Object *) alloca (10 * sizeof (Lisp_Object));
 
-  map_char_table (function, chartable, 0, indices);
+  map_char_table (NULL, function, chartable, 0, indices);
   return Qnil;
 }
 \f
@@ -1513,7 +1568,7 @@ Also accepts Space to mean yes, or Delete to mean no.")
 
   while (1)
     {
-#ifdef HAVE_X_MENU
+#if defined (HAVE_X_MENU) || defined (HAVE_NTGUI)
       if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
          && using_x_p ())
        {
@@ -1621,8 +1676,8 @@ and can edit it until it has been confirmed.")
 
   CHECK_STRING (prompt, 0);
 
-#ifdef HAVE_X_MENU
-  if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
+#if defined (HAVE_X_MENU) || defined (HAVE_NTGUI)
+  if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event)) 
       && using_x_p ())
     {
       Lisp_Object pane, menu, obj;
@@ -1804,10 +1859,12 @@ Used by `featurep' and `require', and altered by `provide'.");
   defsubr (&Sput);
   defsubr (&Sequal);
   defsubr (&Sfillarray);
+  defsubr (&Schar_table_subtype);
   defsubr (&Schar_table_parent);
   defsubr (&Sset_char_table_parent);
   defsubr (&Schar_table_extra_slot);
   defsubr (&Sset_char_table_extra_slot);
+  defsubr (&Schar_table_range);
   defsubr (&Sset_char_table_range);
   defsubr (&Smap_char_table);
   defsubr (&Snconc);