XEmacs 21.2.38 (Peisino)

[chise/xemacs-chise.git.1] / src / mule-charset.c

diff --git a/src/mule-charset.c b/src/mule-charset.c
index ea04c9d..86b1652 100644 (file)
--- a/src/mule-charset.c
+++ b/src/mule-charset.c
@@ -322,26 +322,18 @@ non_ascii_valid_char_p (Emchar ch)
 /*                       Basic string functions                         */
 /************************************************************************/
 
-/* Copy the character pointed to by PTR into STR, assuming it's
-   non-ASCII.  Do not call this directly.  Use the macro
-   charptr_copy_char() instead. */
+/* Copy the character pointed to by SRC into DST.  Do not call this
+   directly.  Use the macro charptr_copy_char() instead.
+   Return the number of bytes copied.  */
 
 Bytecount
-non_ascii_charptr_copy_char (const Bufbyte *ptr, Bufbyte *str)
+non_ascii_charptr_copy_char (const Bufbyte *src, Bufbyte *dst)
 {
-  Bufbyte *strptr = str;
-  *strptr = *ptr++;
-  switch (REP_BYTES_BY_FIRST_BYTE (*strptr))
-    {
-      /* Notice fallthrough. */
-    case 4: *++strptr = *ptr++;
-    case 3: *++strptr = *ptr++;
-    case 2: *++strptr = *ptr;
-      break;
-    default:
-      abort ();
-    }
-  return strptr + 1 - str;
+  unsigned int bytes = REP_BYTES_BY_FIRST_BYTE (*src);
+  unsigned int i;
+  for (i = bytes; i; i--, dst++, src++)
+    *dst = *src;
+  return bytes;
 }
 
 \f
@@ -358,26 +350,15 @@ Lstream_get_emchar_1 (Lstream *stream, int ch)
 {
   Bufbyte str[MAX_EMCHAR_LEN];
   Bufbyte *strptr = str;
+  unsigned int bytes;
 
   str[0] = (Bufbyte) ch;
-  switch (REP_BYTES_BY_FIRST_BYTE (ch))
+
+  for (bytes = REP_BYTES_BY_FIRST_BYTE (ch) - 1; bytes; bytes--)
     {
-      /* Notice fallthrough. */
-    case 4:
-      ch = Lstream_getc (stream);
-      assert (ch >= 0);
-      *++strptr = (Bufbyte) ch;
-    case 3:
-      ch = Lstream_getc (stream);
-      assert (ch >= 0);
-      *++strptr = (Bufbyte) ch;
-    case 2:
-      ch = Lstream_getc (stream);
-      assert (ch >= 0);
-      *++strptr = (Bufbyte) ch;
-      break;
-    default:
-      abort ();
+      int c = Lstream_getc (stream);
+      bufpos_checking_assert (c >= 0);
+      *++strptr = (Bufbyte) c;
     }
   return charptr_emchar (str);
 }
@@ -464,8 +445,9 @@ static const struct lrecord_description charset_description[] = {
 DEFINE_LRECORD_IMPLEMENTATION ("charset", charset,
                                mark_charset, print_charset, 0, 0, 0, charset_description,
                               Lisp_Charset);
-/* Make a new charset. */
 
+/* Make a new charset. */
+/* #### SJT Should generic properties be allowed? */
 static Lisp_Object
 make_charset (int id, Lisp_Object name, unsigned char rep_bytes,
              unsigned char type, unsigned char columns, unsigned char graphic,
@@ -629,13 +611,14 @@ Return a list of the names of all defined charsets.
 }
 
 DEFUN ("charset-name", Fcharset_name, 1, 1, 0, /*
-Return the name of the given charset.
+Return the name of charset CHARSET.
 */
        (charset))
 {
   return XCHARSET_NAME (Fget_charset (charset));
 }
 
+/* #### SJT Should generic properties be allowed? */
 DEFUN ("make-charset", Fmake_charset, 3, 3, 0, /*
 Define a new character set.
 This function is for use with Mule support.
@@ -774,7 +757,10 @@ character set.  Recognized properties are:
 
        else if (EQ (keyword, Qccl_program))
          {
-           CHECK_VECTOR (value);
+           struct ccl_program test_ccl;
+
+           if (setup_ccl_program (&test_ccl, value) < 0)
+             signal_simple_error ("Invalid value for 'ccl-program", value);
            ccl_program = value;
          }
 
@@ -977,7 +963,7 @@ Return dimension of CHARSET.
 }
 
 DEFUN ("charset-property", Fcharset_property, 2, 2, 0, /*
-Return property PROP of CHARSET.
+Return property PROP of CHARSET, a charset object or symbol naming a charset.
 Recognized properties are those listed in `make-charset', as well as
 'name and 'doc-string.
 */
@@ -1005,10 +991,8 @@ Recognized properties are those listed in `make-charset', as well as
   if (EQ (prop, Qreverse_direction_charset))
     {
       Lisp_Object obj = CHARSET_REVERSE_DIRECTION_CHARSET (cs);
-      if (NILP (obj))
-       return Qnil;
-      else
-       return XCHARSET_NAME (obj);
+      /* #### Is this translation OK?  If so, error checking sufficient? */
+      return CHARSETP (obj) ? XCHARSET_NAME (obj) : obj;
     }
   signal_simple_error ("Unrecognized charset property name", prop);
   return Qnil; /* not reached */
@@ -1030,8 +1014,11 @@ Set the 'ccl-program property of CHARSET to CCL-PROGRAM.
 */
        (charset, ccl_program))
 {
+  struct ccl_program test_ccl;
+
   charset = Fget_charset (charset);
-  CHECK_VECTOR (ccl_program);
+  if (setup_ccl_program (&test_ccl, ccl_program) < 0)
+    signal_simple_error ("Invalid ccl-program", ccl_program);
   XCHARSET_CCL_PROGRAM (charset) = ccl_program;
   return Qnil;
 }
@@ -1115,28 +1102,28 @@ character s with caron.
 }
 
 DEFUN ("char-charset", Fchar_charset, 1, 1, 0, /*
-Return the character set of char CH.
+Return the character set of CHARACTER.
 */
-       (ch))
+       (character))
 {
-  CHECK_CHAR_COERCE_INT (ch);
+  CHECK_CHAR_COERCE_INT (character);
 
   return XCHARSET_NAME (CHARSET_BY_LEADING_BYTE
-                       (CHAR_LEADING_BYTE (XCHAR (ch))));
+                       (CHAR_LEADING_BYTE (XCHAR (character))));
 }
 
 DEFUN ("char-octet", Fchar_octet, 1, 2, 0, /*
-Return the octet numbered N (should be 0 or 1) of char CH.
+Return the octet numbered N (should be 0 or 1) of CHARACTER.
 N defaults to 0 if omitted.
 */
-       (ch, n))
+       (character, n))
 {
   Lisp_Object charset;
   int octet0, octet1;
 
-  CHECK_CHAR_COERCE_INT (ch);
+  CHECK_CHAR_COERCE_INT (character);
 
-  BREAKUP_CHAR (XCHAR (ch), charset, octet0, octet1);
+  BREAKUP_CHAR (XCHAR (character), charset, octet0, octet1);
 
   if (NILP (n) || EQ (n, Qzero))
     return make_int (octet0);
@@ -1147,7 +1134,7 @@ N defaults to 0 if omitted.
 }
 
 DEFUN ("split-char", Fsplit_char, 1, 1, 0, /*
-Return list of charset and one or two position-codes of CHAR.
+Return list of charset and one or two position-codes of CHARACTER.
 */
        (character))
 {