Mercurial > hg > xemacs-beta
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