changeset 89759:d11866e9fbf4

(QCmnemonic, QCdefalut_char) (QCdecode_translation_table, QCencode_translation_table) (QCpost_read_conversion, QCpre_write_conversion): New variables. (get_translation_table): Return a list of translation tables if necessary. (decode_coding): Call get_translation_table with ENCODEP 0. (char_encodable_p): If translation_table is non-nil, always call translate_char. (Fdefine_coding_system_internal): Accept list of translation tables as :encode-translation-table and :decode-translation-table. (Fcoding_system_put): New function. (syms_of_coding): Declare new symbols. Defsubr Scoding_system_put.
author Kenichi Handa <handa@m17n.org>
date Tue, 27 Jan 2004 02:21:37 +0000
parents b07ce3d8fc4e
children 292dab2b369e
files src/coding.c
diffstat 1 files changed, 89 insertions(+), 12 deletions(-) [+]
line wrap: on
line diff
--- a/src/coding.c	Tue Jan 27 02:17:46 2004 +0000
+++ b/src/coding.c	Tue Jan 27 02:21:37 2004 +0000
@@ -311,7 +311,9 @@
 Lisp_Object Qbig, Qlittle;
 Lisp_Object Qcoding_system_history;
 Lisp_Object Qvalid_codes;
-Lisp_Object QCcategory;
+Lisp_Object QCcategory, QCmnemonic, QCdefalut_char;
+Lisp_Object QCdecode_translation_table, QCencode_translation_table;
+Lisp_Object QCpost_read_conversion, QCpre_write_conversion;
 
 extern Lisp_Object Qinsert_file_contents, Qwrite_region;
 Lisp_Object Qcall_process, Qcall_process_region, Qprocess_argument;
@@ -5484,8 +5486,9 @@
 }
 
 
-/* Return a translation table from coding system attribute vector ATTRS
-   for encoding (ENCODEP is nonzero) or decoding (ENCODEP is zeor). */
+/* Return a translation table (or list of them) from coding system
+   attribute vector ATTRS for encoding (ENCODEP is nonzero) or
+   decoding (ENCODEP is zero). */
 
 static INLINE
 get_translation_table (attrs, encodep)
@@ -5498,12 +5501,26 @@
   else
     translation_table = CODING_ATTR_DECODE_TBL (attrs),
       standard = Vstandard_translation_table_for_decode;
-  if (! NILP (translation_table) && SYMBOLP (translation_table))
+  if (NILP (translation_table))
+    return standard;
+  if (SYMBOLP (translation_table))
     translation_table = Fget (translation_table, Qtranslation_table);
-  if (NILP (translation_table))
-    translation_table = standard;
-  if (! CHAR_TABLE_P (translation_table))
-    translation_table = Qnil;
+  else if (CONSP (translation_table))
+    {
+      Lisp_Object val;
+
+      translation_table = Fcopy_sequence (translation_table);
+      for (val = translation_table; CONSP (val); val = XCDR (val))
+	if (SYMBOLP (XCAR (val)))
+	  XSETCAR (val, Fget (XCAR (val), Qtranslation_table));
+    }
+  if (! NILP (standard))
+    {
+      if (CONSP (translation_table))
+	translation_table = nconc2 (translation_table, Fcons (standard, Qnil));
+      else
+	translation_table = Fcons (translation_table, Fcons (standard, Qnil));
+    }
   return translation_table;
 }
 
@@ -5892,7 +5909,7 @@
   ALLOC_CONVERSION_WORK_AREA (coding);
 
   attrs = CODING_ID_ATTRS (coding->id);
-  translation_table = get_translation_table (attrs, 1);
+  translation_table = get_translation_table (attrs, 0);
 
   do
     {
@@ -7099,7 +7116,7 @@
   Lisp_Object translation_table;
 
   translation_table = CODING_ATTR_TRANS_TBL (attrs);
-  if (CHAR_TABLE_P (translation_table))
+  if (! NILP (translation_table))
     c = translate_char (translation_table, c);
   for (tail = CODING_ATTR_CHARSET_LIST (attrs);
        CONSP (tail); tail = XCDR (tail))
@@ -8166,12 +8183,12 @@
   CODING_ATTR_ASCII_COMPAT (attrs) = args[coding_arg_ascii_compatible_p];
 
   val = args[coding_arg_decode_translation_table];
-  if (! CHAR_TABLE_P (val))
+  if (! CHAR_TABLE_P (val) && ! CONSP (val))
     CHECK_SYMBOL (val);
   CODING_ATTR_DECODE_TBL (attrs) = val;
 
   val = args[coding_arg_encode_translation_table];
-  if (! CHAR_TABLE_P (val))
+  if (! CHAR_TABLE_P (val) && ! CONSP (val))
     CHECK_SYMBOL (val);
   CODING_ATTR_ENCODE_TBL (attrs) = val;
 
@@ -8581,6 +8598,59 @@
 }
 
 
+DEFUN ("coding-system-put", Fcoding_system_put, Scoding_system_put,
+       3, 3, 0,
+       doc: /* Change value in CODING-SYSTEM's property list PROP to VAL.  */)
+  (coding_system, prop, val)
+     Lisp_Object coding_system, prop, val;
+{
+  Lisp_Object spec, attrs, plist;
+
+  CHECK_CODING_SYSTEM_GET_SPEC (coding_system, spec);
+  attrs = AREF (spec, 0);
+  if (EQ (prop, QCmnemonic))
+    {
+      if (! STRINGP (val))
+	CHECK_CHARACTER (val);
+      CODING_ATTR_MNEMONIC (attrs) = val;
+    }
+  else if (EQ (prop, QCdefalut_char))
+    {
+      if (NILP (val))
+	val = make_number (' ');
+      else
+	CHECK_CHARACTER (val);
+      CODING_ATTR_DEFAULT_CHAR (attrs) = val;
+    }
+  else if (EQ (prop, QCdecode_translation_table))
+    {
+      if (! CHAR_TABLE_P (val) && ! CONSP (val))
+	CHECK_SYMBOL (val);
+      CODING_ATTR_DECODE_TBL (attrs) = val;
+    }
+  else if (EQ (prop, QCencode_translation_table))
+    {
+      if (! CHAR_TABLE_P (val) && ! CONSP (val))
+	CHECK_SYMBOL (val);
+      CODING_ATTR_ENCODE_TBL (attrs) = val;
+    }
+  else if (EQ (prop, QCpost_read_conversion))
+    {
+      CHECK_SYMBOL (val);
+      CODING_ATTR_POST_READ (attrs) = val;
+    }
+  else if (EQ (prop, QCpre_write_conversion))
+    {
+      CHECK_SYMBOL (val);
+      CODING_ATTR_PRE_WRITE (attrs) = val;
+    }
+
+  CODING_ATTR_PLIST (attrs)
+    = Fplist_put (CODING_ATTR_PLIST (attrs), prop, val);
+  return val;
+}
+
+
 DEFUN ("define-coding-system-alias", Fdefine_coding_system_alias,
        Sdefine_coding_system_alias, 2, 2, 0,
        doc: /* Define ALIAS as an alias for CODING-SYSTEM.  */)
@@ -8843,6 +8913,12 @@
   DEFSYM (Qemacs_mule, "emacs-mule");
 
   DEFSYM (QCcategory, ":category");
+  DEFSYM (QCmnemonic, ":mnemonic");
+  DEFSYM (QCdefalut_char, ":default-char");
+  DEFSYM (QCdecode_translation_table, ":decode-translation-table");
+  DEFSYM (QCencode_translation_table, ":encode-translation-table");
+  DEFSYM (QCpost_read_conversion, ":post-read-conversion");
+  DEFSYM (QCpre_write_conversion, ":pre-write-conversion");
 
   Vcoding_category_table
     = Fmake_vector (make_number (coding_category_max), Qnil);
@@ -8920,6 +8996,7 @@
   defsubr (&Sset_coding_system_priority);
   defsubr (&Sdefine_coding_system_internal);
   defsubr (&Sdefine_coding_system_alias);
+  defsubr (&Scoding_system_put);
   defsubr (&Scoding_system_base);
   defsubr (&Scoding_system_plist);
   defsubr (&Scoding_system_aliases);