X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=src%2Ffns.c;h=9de6fea678db62550b2a888be5951b5646448157;hp=68e241431c947567084bafef047f973cfacd2489;hb=8ba3626da629f1b4ecafae24c85f3d0cb3bf8b8e;hpb=8b2e8ef2dee7da2f0d4cea712b0fc55902c3cff7

diff --git a/src/fns.c b/src/fns.c
index 68e2414..9de6fea 100644
--- 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, 2003, 2004, 2008 MORIOKA Tomohiko
 
 This file is part of XEmacs.
 
@@ -3797,6 +3798,154 @@ Characters out of the base64 alphabet are ignored.
   return result;
 }
 
+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 (Qrep_ucs, ids_char, Qnil, 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;
+}
+
+Lisp_Object simplify_char_spec (Lisp_Object char_spec);
+Lisp_Object
+simplify_char_spec (Lisp_Object char_spec)
+{
+  if (CHARP (char_spec))
+    {
+      Lisp_Object ccs;
+      int code_point = ENCODE_CHAR (XCHAR (char_spec), ccs);
+
+      if (code_point >= 0)
+	{
+	  int cid = decode_defined_char (ccs, code_point, Qnil);
+
+	  if (cid >= 0)
+	    return make_char (cid);
+	}
+      return char_spec;
+    }
+  else if (INTP (char_spec))
+    return Fdecode_char (Qrep_ucs, char_spec, Qnil, Qnil);
+  else
+    {
+#if 0
+      Lisp_Object ret = Ffind_char (char_spec);
+#else
+      Lisp_Object ret;
+      Lisp_Object rest = char_spec;
+      int have_ccs = 0;
+
+      while (CONSP (rest))
+	{
+	  Lisp_Object cell = Fcar (rest);
+	  Lisp_Object ccs;
+
+#if 0
+	  if (!LISTP (cell))
+	    signal_simple_error ("Invalid argument", char_spec);
+#endif
+	  if (!NILP (ccs = Ffind_charset (Fcar (cell))))
+	    {
+	      cell = Fcdr (cell);
+	      if (CONSP (cell))
+		ret = Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
+	      else
+		ret = Fdecode_char (ccs, cell, Qt, Qt);
+	      have_ccs = 1;
+	      if (CHARP (ret))
+		return ret;
+	    }
+	  rest = Fcdr (rest);
+	}
+      if (have_ccs)
+	ret = Fdefine_char (char_spec);
+      else
+	ret = Qnil;
+#endif
+
+      if (CHARP (ret))
+	return ret;
+      else
+	return char_spec;
+    }
+}
+
+Lisp_Object char_ref_simplify_spec (Lisp_Object char_ref);
+Lisp_Object
+char_ref_simplify_spec (Lisp_Object char_ref)
+{
+  if (!NILP (Fchar_ref_p (char_ref)))
+    {
+      Lisp_Object ret = Fplist_get (char_ref, Qkeyword_char, Qnil);
+
+      if (NILP (ret))
+	return char_ref;
+      else
+	return Fplist_put (Fcopy_sequence (char_ref), Qkeyword_char,
+			   simplify_char_spec (ret));
+    }
+  else
+    return simplify_char_spec (char_ref);
+}
+
+DEFUN ("char-refs-simplify-char-specs",
+       Fchar_refs_simplify_char_specs, 1, 1, 0, /*
+Simplify char-specs in CHAR-REFS.
+*/
+       (char_refs))
+{
+  Lisp_Object rest = char_refs;
+
+  while (CONSP (rest))
+    {
+      Fsetcar (rest, char_ref_simplify_spec (XCAR (rest)));
+      rest = XCDR (rest);
+    }
+  return char_refs;
+}
+
 Lisp_Object Qyes_or_no_p;
 
 void
@@ -3806,6 +3955,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);
@@ -3892,6 +4043,8 @@ syms_of_fns (void)
   DEFSUBR (Fbase64_encode_string);
   DEFSUBR (Fbase64_decode_region);
   DEFSUBR (Fbase64_decode_string);
+  DEFSUBR (Fideographic_structure_to_ids);
+  DEFSUBR (Fchar_refs_simplify_char_specs);
 }
 
 void