changeset 5259:02c282ae97cb

Read and print char table defaults, chartab.c 2010-09-05 Aidan Kehoe <kehoea@parhasard.net> * chartab.c (char_table_default_for_type, chartab_default_validate): New. (print_char_table, Freset_char_table, chartab_default_validate) (chartab_instantiate, structure_type_create_chartab): Accept keyword :default in the read syntax for char tables, and print the default when it is not what was expected for the time. Makes it a little easier to debug things.
author Aidan Kehoe <kehoea@parhasard.net>
date Sun, 05 Sep 2010 20:12:53 +0100
parents 1ed4cefddd12
children dceee3855f15
files src/ChangeLog src/chartab.c
diffstat 2 files changed, 69 insertions(+), 29 deletions(-) [+]
line wrap: on
line diff
--- a/src/ChangeLog	Sun Sep 05 19:22:37 2010 +0100
+++ b/src/ChangeLog	Sun Sep 05 20:12:53 2010 +0100
@@ -1,3 +1,13 @@
+2010-09-05  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* chartab.c (char_table_default_for_type,
+	chartab_default_validate): New. 
+	(print_char_table, Freset_char_table, chartab_default_validate)
+	(chartab_instantiate, structure_type_create_chartab):
+	Accept keyword :default in the read syntax for char tables, and
+	print the default when it is not what was expected for the
+	time. Makes it a little easier to debug things.
+
 2010-09-05  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* editfns.c (Fformat_time_string):
--- a/src/chartab.c	Sun Sep 05 19:22:37 2010 +0100
+++ b/src/chartab.c	Sun Sep 05 20:12:53 2010 +0100
@@ -42,7 +42,7 @@
 #include "chartab.h"
 #include "syntax.h"
 
-Lisp_Object Qchar_tablep, Qchar_table;
+Lisp_Object Qchar_tablep, Qchar_table, Q_default;
 
 Lisp_Object Vall_syntax_tables;
 
@@ -301,6 +301,30 @@
   return Qnil; /* not reached */
 }
 
+static Lisp_Object
+char_table_default_for_type (enum char_table_type type)
+{
+  switch (type)
+    {
+    case CHAR_TABLE_TYPE_CHAR:
+      return make_char (0);
+      break;
+    case CHAR_TABLE_TYPE_DISPLAY:
+    case CHAR_TABLE_TYPE_GENERIC:
+#ifdef MULE
+    case CHAR_TABLE_TYPE_CATEGORY:
+#endif /* MULE */
+      return Qnil;
+      break;
+
+    case CHAR_TABLE_TYPE_SYNTAX:
+      return make_integer (Sinherit);
+      break;
+    }
+  ABORT();
+  return Qzero;
+}
+
 struct ptemap
 {
   Lisp_Object printcharfun;
@@ -336,8 +360,15 @@
   arg.printcharfun = printcharfun;
   arg.first = 1;
 
-  write_fmt_string_lisp (printcharfun, "#s(char-table :type %s :data (",
-			 1, char_table_type_to_symbol (ct->type));
+  write_fmt_string_lisp (printcharfun,
+			 "#s(char-table :type %s", 1,
+			 char_table_type_to_symbol (ct->type));
+  if (!(EQ (ct->default_, char_table_default_for_type (ct->type))))
+    {
+      write_fmt_string_lisp (printcharfun, " :default %S", 1, ct->default_);
+    }
+
+  write_ascstring (printcharfun, " :data (");
   map_char_table (obj, &range, print_table_entry, &arg);
   write_ascstring (printcharfun, "))");
 
@@ -492,37 +523,13 @@
        (char_table))
 {
   Lisp_Char_Table *ct;
-  Lisp_Object def;
 
   CHECK_CHAR_TABLE (char_table);
   ct = XCHAR_TABLE (char_table);
 
-  switch (ct->type)
-    {
-    case CHAR_TABLE_TYPE_CHAR:
-      def = make_char (0);
-      break;
-    case CHAR_TABLE_TYPE_DISPLAY:
-    case CHAR_TABLE_TYPE_GENERIC:
-#ifdef MULE
-    case CHAR_TABLE_TYPE_CATEGORY:
-#endif /* MULE */
-      def = Qnil;
-      break;
-
-    case CHAR_TABLE_TYPE_SYNTAX:
-      def = make_int (Sinherit);
-      break;
-
-    default:
-      ABORT ();
-      def = Qnil;
-      break;
-    }
-
   /* Avoid doubly updating the syntax table by setting the default ourselves,
      since set_char_table_default() also updates. */
-  ct->default_ = def;
+  ct->default_ = char_table_default_for_type (ct->type);
   fill_char_table (ct, Qunbound);
 
   return Qnil;
@@ -1543,12 +1550,22 @@
   return 1;
 }
 
+static int
+chartab_default_validate (Lisp_Object UNUSED (keyword),
+			  Lisp_Object UNUSED (value),
+			  Error_Behavior UNUSED (errb))
+{
+  /* We can't yet validate this, since we don't know what the type of the
+     char table is. We do the validation below in chartab_instantiate(). */
+  return 1;
+}
+
 static Lisp_Object
 chartab_instantiate (Lisp_Object plist)
 {
   Lisp_Object chartab;
   Lisp_Object type = Qgeneric;
-  Lisp_Object dataval = Qnil;
+  Lisp_Object dataval = Qnil, default_ = Qunbound;
 
   if (KEYWORDP (Fcar (plist)))
     {
@@ -1562,6 +1579,10 @@
 	    {
 	      type = value;
 	    }
+	  else if (EQ (key, Q_default))
+	    {
+	      default_ = value;
+	    }
 	  else if (!KEYWORDP (key))
 	    {
 	      signal_error
@@ -1598,6 +1619,13 @@
 #endif /* NEED_TO_HANDLE_21_4_CODE */
 
   chartab = Fmake_char_table (type);
+  if (!UNBOUNDP (default_))
+    {
+      check_valid_char_table_value (default_, XCHAR_TABLE_TYPE (chartab),
+				    ERROR_ME);
+      set_char_table_default (chartab, default_);
+      set_char_table_default (XCHAR_TABLE (chartab)->mirror_table, default_);
+    }
 
   while (!NILP (dataval))
     {
@@ -1872,6 +1900,7 @@
 
   DEFSYMBOL (Qchar_table);
   DEFSYMBOL_MULTIWORD_PREDICATE (Qchar_tablep);
+  DEFKEYWORD (Q_default);
 
   DEFSUBR (Fchar_table_p);
   DEFSUBR (Fchar_table_type_list);
@@ -1926,6 +1955,7 @@
 
   define_structure_type_keyword (st, Q_type, chartab_type_validate);
   define_structure_type_keyword (st, Q_data, chartab_data_validate);
+  define_structure_type_keyword (st, Q_default, chartab_default_validate);
 }
 
 void