From: tomo <tomo>
Date: Fri, 10 Aug 2001 10:18:33 +0000 (+0000)
Subject: (Ffind_char): New function in XEmacs UTF-2000.
X-Git-Tag: r21-2-38-utf-2000-0_17-1~30
X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=a4e1ab21fb8d6994e3dbc71d288633a9db6dd46d;p=chise%2Fxemacs-chise.git

(Ffind_char): New function in XEmacs UTF-2000.
(syms_of_mule_charset): Add new function `find-char'.
---

diff --git a/src/mule-charset.c b/src/mule-charset.c
index f8bb68b..4626e60 100644
--- a/src/mule-charset.c
+++ b/src/mule-charset.c
@@ -1564,6 +1564,42 @@ Store character's ATTRIBUTES.
   return character;
 }
 
+DEFUN ("find-char", Ffind_char, 1, 1, 0, /*
+Retrieve the character of the given ATTRIBUTES.
+*/
+       (attributes))
+{
+  Lisp_Object rest = attributes;
+  Lisp_Object code;
+
+  while (CONSP (rest))
+    {
+      Lisp_Object cell = Fcar (rest);
+      Lisp_Object ccs;
+
+      if (!LISTP (cell))
+	signal_simple_error ("Invalid argument", attributes);
+      if (!NILP (ccs = Ffind_charset (Fcar (cell))))
+	{
+	  cell = Fcdr (cell);
+	  if (CONSP (cell))
+	    return Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
+	  else
+	    return Fdecode_char (ccs, cell);
+	}
+      rest = Fcdr (rest);
+    }
+  if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) ||
+       (!NILP (code = Fcdr (Fassq (Q_ucs, attributes)))) )
+    {
+      if (!INTP (code))
+	signal_simple_error ("Invalid argument", attributes);
+      else
+	return make_char (XINT (code) + 0x100000);
+    }
+  return Qnil;
+}
+
 Lisp_Object Vutf_2000_version;
 #endif
 
@@ -3462,6 +3498,7 @@ syms_of_mule_charset (void)
   DEFSUBR (Fput_char_attribute);
   DEFSUBR (Fremove_char_attribute);
   DEFSUBR (Fdefine_char);
+  DEFSUBR (Ffind_char);
   DEFSUBR (Fchar_variants);
   DEFSUBR (Fget_composite_char);
   DEFSUBR (Fcharset_mapping_table);