update.

[chise/xemacs-chise.git-] / src / fns.c

diff --git a/src/fns.c b/src/fns.c
index 8cfab15..d5224c4 100644 (file)
--- a/src/fns.c
+++ b/src/fns.c
@@ -1,6 +1,7 @@
 /* Random utility Lisp functions.
    Copyright (C) 1985, 86, 87, 93, 94, 95 Free Software Foundation, Inc.
    Copyright (C) 1995, 1996 Ben Wing.
+   Copyright (C) 2002 MORIOKA Tomohiko
 
 This file is part of XEmacs.
 
@@ -56,6 +57,7 @@ Lisp_Object Qstring_lessp;
 Lisp_Object Qidentity;
 
 static int internal_old_equal (Lisp_Object, Lisp_Object, int);
+Lisp_Object safe_copy_tree (Lisp_Object arg, Lisp_Object vecp, int depth);
 
 static Lisp_Object
 mark_bit_vector (Lisp_Object obj)
@@ -112,7 +114,7 @@ static size_t
 size_bit_vector (const void *lheader)
 {
   Lisp_Bit_Vector *v = (Lisp_Bit_Vector *) lheader;
-  return FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Bit_Vector, bits,
+  return FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Bit_Vector, unsigned long, bits,
                                       BIT_VECTOR_LONG_STORAGE (bit_vector_length (v)));
 }
 
@@ -863,6 +865,15 @@ are not copied.
 */
        (arg, vecp))
 {
+  return safe_copy_tree (arg, vecp, 0);
+}
+
+Lisp_Object
+safe_copy_tree (Lisp_Object arg, Lisp_Object vecp, int depth)
+{
+  if (depth > 200)
+    signal_simple_error ("Stack overflow in copy-tree", arg);
+    
   if (CONSP (arg))
     {
       Lisp_Object rest;
@@ -872,9 +883,9 @@ are not copied.
          Lisp_Object elt = XCAR (rest);
          QUIT;
          if (CONSP (elt) || VECTORP (elt))
-           XCAR (rest) = Fcopy_tree (elt, vecp);
+           XCAR (rest) = safe_copy_tree (elt, vecp, depth + 1);
          if (VECTORP (XCDR (rest))) /* hack for (a b . [c d]) */
-           XCDR (rest) = Fcopy_tree (XCDR (rest), vecp);
+           XCDR (rest) = safe_copy_tree (XCDR (rest), vecp, depth +1);
          rest = XCDR (rest);
        }
     }
@@ -888,7 +899,7 @@ are not copied.
          Lisp_Object elt = XVECTOR_DATA (arg) [j];
          QUIT;
          if (CONSP (elt) || VECTORP (elt))
-           XVECTOR_DATA (arg) [j] = Fcopy_tree (elt, vecp);
+           XVECTOR_DATA (arg) [j] = safe_copy_tree (elt, vecp, depth + 1);
        }
     }
   return arg;
@@ -3749,6 +3760,56 @@ Characters out of the base64 alphabet are ignored.
   return result;
 }
 \f
+Lisp_Object Qideographic_structure;
+Lisp_Object Qkeyword_char;
+
+EXFUN (Fideographic_structure_to_ids, 1);
+
+Lisp_Object ids_format_unit (Lisp_Object ids_char);
+Lisp_Object
+ids_format_unit (Lisp_Object ids_char)
+{
+  if (CHARP (ids_char))
+    return Fchar_to_string (ids_char);
+  else if (INTP (ids_char))
+    return Fchar_to_string (Fdecode_char (Qucs, ids_char, Qnil));
+  else
+    {
+      Lisp_Object ret = Ffind_char (ids_char);
+
+      if (CHARP (ret))
+       return Fchar_to_string (ret);
+      else
+       {
+         ret = Fassq (Qideographic_structure, ids_char);
+
+         if (CONSP (ret))
+           return Fideographic_structure_to_ids (XCDR (ret));
+       }
+    }
+  return Qnil;
+}
+
+DEFUN ("ideographic-structure-to-ids",
+       Fideographic_structure_to_ids, 1, 1, 0, /*
+Format ideographic-structure IDS-LIST as an IDS-string.
+*/
+       (ids_list))
+{
+  Lisp_Object dest = Qnil;
+
+  while (CONSP (ids_list))
+    {
+      Lisp_Object cell = XCAR (ids_list);
+
+      if (!NILP (Fchar_ref_p (cell)))
+       cell = Fplist_get (cell, Qkeyword_char, Qnil);
+      dest = concat2 (dest, ids_format_unit (cell));
+      ids_list = XCDR (ids_list);
+    }
+  return dest;
+}
+\f
 Lisp_Object Qyes_or_no_p;
 
 void
@@ -3758,6 +3819,8 @@ syms_of_fns (void)
 
   defsymbol (&Qstring_lessp, "string-lessp");
   defsymbol (&Qidentity, "identity");
+  defsymbol (&Qideographic_structure, "ideographic-structure");
+  defsymbol (&Qkeyword_char, ":char");
   defsymbol (&Qyes_or_no_p, "yes-or-no-p");
 
   DEFSUBR (Fidentity);
@@ -3844,6 +3907,7 @@ syms_of_fns (void)
   DEFSUBR (Fbase64_encode_string);
   DEFSUBR (Fbase64_decode_region);
   DEFSUBR (Fbase64_decode_string);
+  DEFSUBR (Fideographic_structure_to_ids);
 }
 
 void