Mercurial > hg > xemacs-beta
diff src/chartab.c @ 5495:1f0b15040456
Merge.
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Sun, 01 May 2011 18:44:03 +0100 |
parents | 6506fcb40fcf |
children | 58b38d5b32d0 |
line wrap: on
line diff
--- a/src/chartab.c Sat Feb 20 06:03:00 2010 -0600 +++ b/src/chartab.c Sun May 01 18:44:03 2011 +0100 @@ -7,10 +7,10 @@ This file is part of XEmacs. -XEmacs is free software; you can redistribute it and/or modify it +XEmacs is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. +Free Software Foundation, either version 3 of the License, or (at your +option) any later version. XEmacs is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or @@ -18,9 +18,7 @@ for more details. You should have received a copy of the GNU General Public License -along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +along with XEmacs. If not, see <http://www.gnu.org/licenses/>. */ /* Synched up with: Mule 2.3. Not synched with FSF. @@ -128,11 +126,11 @@ } static Hashcode -char_table_entry_hash (Lisp_Object obj, int depth) +char_table_entry_hash (Lisp_Object obj, int depth, Boolint equalp) { Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj); - return internal_array_hash (cte->level2, 96, depth + 1); + return internal_array_hash (cte->level2, 96, depth + 1, equalp); } static const struct memory_description char_table_entry_description[] = { @@ -140,13 +138,12 @@ { XD_END } }; -DEFINE_LRECORD_IMPLEMENTATION ("char-table-entry", char_table_entry, - 1, /* dumpable flag */ - mark_char_table_entry, internal_object_printer, - 0, char_table_entry_equal, - char_table_entry_hash, - char_table_entry_description, - Lisp_Char_Table_Entry); +DEFINE_DUMPABLE_LISP_OBJECT ("char-table-entry", char_table_entry, + mark_char_table_entry, internal_object_printer, + 0, char_table_entry_equal, + char_table_entry_hash, + char_table_entry_description, + Lisp_Char_Table_Entry); #endif /* MULE */ @@ -258,10 +255,12 @@ sferror ("Charset in row vector must be multi-byte", outrange->charset); case CHARSET_TYPE_94X94: - check_int_range (outrange->row, 33, 126); + check_integer_range (make_int (outrange->row), make_int (33), + make_int (126)); break; case CHARSET_TYPE_96X96: - check_int_range (outrange->row, 32, 127); + check_integer_range (make_int (outrange->row), make_int (32), + make_int (127)); break; default: ABORT (); @@ -302,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; @@ -337,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, "))"); @@ -370,17 +400,17 @@ } static Hashcode -char_table_hash (Lisp_Object obj, int depth) +char_table_hash (Lisp_Object obj, int depth, Boolint equalp) { Lisp_Char_Table *ct = XCHAR_TABLE (obj); Hashcode hashval = internal_array_hash (ct->ascii, NUM_ASCII_CHARS, - depth + 1); + depth + 1, equalp); #ifdef MULE hashval = HASH2 (hashval, internal_array_hash (ct->level1, NUM_LEADING_BYTES, - depth + 1)); + depth + 1, equalp)); #endif /* MULE */ - return HASH2 (hashval, internal_hash (ct->default_, depth + 1)); + return HASH2 (hashval, internal_hash (ct->default_, depth + 1, equalp)); } static const struct memory_description char_table_description[] = { @@ -395,12 +425,11 @@ { XD_END } }; -DEFINE_LRECORD_IMPLEMENTATION ("char-table", char_table, - 1, /*dumpable-flag*/ - mark_char_table, print_char_table, 0, - char_table_equal, char_table_hash, - char_table_description, - Lisp_Char_Table); +DEFINE_DUMPABLE_LISP_OBJECT ("char-table", char_table, + mark_char_table, print_char_table, 0, + char_table_equal, char_table_hash, + char_table_description, + Lisp_Char_Table); DEFUN ("char-table-p", Fchar_table_p, 1, 1, 0, /* Return non-nil if OBJECT is a char table. @@ -479,7 +508,7 @@ if (!EQ (ct->level1[i], Qnull_pointer) && CHAR_TABLE_ENTRYP (ct->level1[i]) && !OBJECT_DUMPED_P (ct->level1[1])) - FREE_LCRECORD (ct->level1[i]); + free_normal_lisp_object (ct->level1[i]); ct->level1[i] = value; } #endif /* MULE */ @@ -494,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; @@ -598,13 +603,11 @@ */ (type)) { - Lisp_Char_Table *ct; - Lisp_Object obj; + Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (char_table); + Lisp_Char_Table *ct = XCHAR_TABLE (obj); enum char_table_type ty = symbol_to_char_table_type (type); - ct = ALLOC_LCRECORD_TYPE (Lisp_Char_Table, &lrecord_char_table); ct->type = ty; - obj = wrap_char_table (ct); if (ty == CHAR_TABLE_TYPE_SYNTAX) { /* Qgeneric not Qsyntax because a syntax table has a mirror table @@ -634,13 +637,13 @@ make_char_table_entry (Lisp_Object initval) { int i; - Lisp_Char_Table_Entry *cte = - ALLOC_LCRECORD_TYPE (Lisp_Char_Table_Entry, &lrecord_char_table_entry); + Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (char_table_entry); + Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj); for (i = 0; i < 96; i++) cte->level2[i] = initval; - return wrap_char_table_entry (cte); + return obj; } static Lisp_Object @@ -648,8 +651,8 @@ { Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (entry); int i; - Lisp_Char_Table_Entry *ctenew = - ALLOC_LCRECORD_TYPE (Lisp_Char_Table_Entry, &lrecord_char_table_entry); + Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (char_table_entry); + Lisp_Char_Table_Entry *ctenew = XCHAR_TABLE_ENTRY (obj); for (i = 0; i < 96; i++) { @@ -660,7 +663,7 @@ ctenew->level2[i] = new_; } - return wrap_char_table_entry (ctenew); + return obj; } #endif /* MULE */ @@ -679,12 +682,12 @@ CHECK_CHAR_TABLE (char_table); ct = XCHAR_TABLE (char_table); assert(!ct->mirror_table_p); - ctnew = ALLOC_LCRECORD_TYPE (Lisp_Char_Table, &lrecord_char_table); + obj = ALLOC_NORMAL_LISP_OBJECT (char_table); + ctnew = XCHAR_TABLE (obj); ctnew->type = ct->type; ctnew->parent = ct->parent; ctnew->default_ = ct->default_; ctnew->mirror_table_p = 0; - obj = wrap_char_table (ctnew); for (i = 0; i < NUM_ASCII_CHARS; i++) { @@ -1075,7 +1078,7 @@ int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE; if (CHAR_TABLE_ENTRYP (ct->level1[lb]) && !OBJECT_DUMPED_P (ct->level1[lb])) - FREE_LCRECORD (ct->level1[lb]); + free_normal_lisp_object (ct->level1[lb]); ct->level1[lb] = val; } break; @@ -1547,36 +1550,93 @@ 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 data) +chartab_instantiate (Lisp_Object plist) { Lisp_Object chartab; Lisp_Object type = Qgeneric; - Lisp_Object dataval = Qnil; - - while (!NILP (data)) - { - Lisp_Object keyw = Fcar (data); - Lisp_Object valw; + Lisp_Object dataval = Qnil, default_ = Qunbound; - data = Fcdr (data); - valw = Fcar (data); - data = Fcdr (data); - if (EQ (keyw, Qtype)) - type = valw; - else if (EQ (keyw, Qdata)) - dataval = valw; + if (KEYWORDP (Fcar (plist))) + { + PROPERTY_LIST_LOOP_3 (key, value, plist) + { + if (EQ (key, Q_data)) + { + dataval = value; + } + else if (EQ (key, Q_type)) + { + type = value; + } + else if (EQ (key, Q_default_)) + { + default_ = value; + } + else if (!KEYWORDP (key)) + { + signal_error + (Qinvalid_read_syntax, + "can't mix keyword and non-keyword structure syntax", + key); + } + else + ABORT (); + } + } +#ifdef NEED_TO_HANDLE_21_4_CODE + else + { + PROPERTY_LIST_LOOP_3 (key, value, plist) + { + if (EQ (key, Qdata)) + { + dataval = value; + } + else if (EQ (key, Qtype)) + { + type = value; + } + else if (KEYWORDP (key)) + signal_error + (Qinvalid_read_syntax, + "can't mix keyword and non-keyword structure syntax", + key); + else + ABORT (); + } + } +#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_); + if (!NILP (XCHAR_TABLE (chartab)->mirror_table)) + { + set_char_table_default (XCHAR_TABLE (chartab)->mirror_table, + default_); + } } - chartab = Fmake_char_table (type); - - data = dataval; - while (!NILP (data)) + while (!NILP (dataval)) { - Lisp_Object range = Fcar (data); - Lisp_Object val = Fcar (Fcdr (data)); + Lisp_Object range = Fcar (dataval); + Lisp_Object val = Fcar (Fcdr (dataval)); - data = Fcdr (Fcdr (data)); + dataval = Fcdr (Fcdr (dataval)); if (CONSP (range)) { if (CHAR_OR_CHAR_INTP (XCAR (range))) @@ -1832,10 +1892,10 @@ void syms_of_chartab (void) { - INIT_LRECORD_IMPLEMENTATION (char_table); + INIT_LISP_OBJECT (char_table); #ifdef MULE - INIT_LRECORD_IMPLEMENTATION (char_table_entry); + INIT_LISP_OBJECT (char_table_entry); DEFSYMBOL (Qcategory_table_p); DEFSYMBOL (Qcategory_designator_p); @@ -1891,8 +1951,14 @@ st = define_structure_type (Qchar_table, 0, chartab_instantiate); +#ifdef NEED_TO_HANDLE_21_4_CODE define_structure_type_keyword (st, Qtype, chartab_type_validate); define_structure_type_keyword (st, Qdata, chartab_data_validate); +#endif /* NEED_TO_HANDLE_21_4_CODE */ + + 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