Mercurial > hg > xemacs-beta

comparison src/chartab.c @ 5259:02c282ae97cb

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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 18c0b5909d16
children c096d8051f89 308d34e9f07d
comparison
equal deleted inserted replaced
5258:1ed4cefddd12 5259:02c282ae97cb
40 40
41 #include "buffer.h" 41 #include "buffer.h"
42 #include "chartab.h" 42 #include "chartab.h"
43 #include "syntax.h" 43 #include "syntax.h"
44 44
45 Lisp_Object Qchar_tablep, Qchar_table; 45 Lisp_Object Qchar_tablep, Qchar_table, Q_default;
46 46
47 Lisp_Object Vall_syntax_tables; 47 Lisp_Object Vall_syntax_tables;
48 48
49 #ifdef MULE 49 #ifdef MULE
50 Lisp_Object Qcategory_table_p; 50 Lisp_Object Qcategory_table_p;
299 ABORT (); 299 ABORT ();
300 } 300 }
301 return Qnil; /* not reached */ 301 return Qnil; /* not reached */
302 } 302 }
303 303
304 static Lisp_Object
305 char_table_default_for_type (enum char_table_type type)
306 {
307 switch (type)
308 {
309 case CHAR_TABLE_TYPE_CHAR:
310 return make_char (0);
311 break;
312 case CHAR_TABLE_TYPE_DISPLAY:
313 case CHAR_TABLE_TYPE_GENERIC:
314 #ifdef MULE
315 case CHAR_TABLE_TYPE_CATEGORY:
316 #endif /* MULE */
317 return Qnil;
318 break;
319
320 case CHAR_TABLE_TYPE_SYNTAX:
321 return make_integer (Sinherit);
322 break;
323 }
324 ABORT();
325 return Qzero;
326 }
327
304 struct ptemap 328 struct ptemap
305 { 329 {
306 Lisp_Object printcharfun; 330 Lisp_Object printcharfun;
307 int first; 331 int first;
308 }; 332 };
334 358
335 range.type = CHARTAB_RANGE_ALL; 359 range.type = CHARTAB_RANGE_ALL;
336 arg.printcharfun = printcharfun; 360 arg.printcharfun = printcharfun;
337 arg.first = 1; 361 arg.first = 1;
338 362
339 write_fmt_string_lisp (printcharfun, "#s(char-table :type %s :data (", 363 write_fmt_string_lisp (printcharfun,
340 1, char_table_type_to_symbol (ct->type)); 364 "#s(char-table :type %s", 1,
365 char_table_type_to_symbol (ct->type));
366 if (!(EQ (ct->default_, char_table_default_for_type (ct->type))))
367 {
368 write_fmt_string_lisp (printcharfun, " :default %S", 1, ct->default_);
369 }
370
371 write_ascstring (printcharfun, " :data (");
341 map_char_table (obj, &range, print_table_entry, &arg); 372 map_char_table (obj, &range, print_table_entry, &arg);
342 write_ascstring (printcharfun, "))"); 373 write_ascstring (printcharfun, "))");
343 374
344 /* #### need to print and read the default; but that will allow the 375 /* #### need to print and read the default; but that will allow the
345 default to be modified, which we don't (yet) support -- but FSF does */ 376 default to be modified, which we don't (yet) support -- but FSF does */
490 Reset CHAR-TABLE to its default state. 521 Reset CHAR-TABLE to its default state.
491 */ 522 */
492 (char_table)) 523 (char_table))
493 { 524 {
494 Lisp_Char_Table *ct; 525 Lisp_Char_Table *ct;
495 Lisp_Object def;
496 526
497 CHECK_CHAR_TABLE (char_table); 527 CHECK_CHAR_TABLE (char_table);
498 ct = XCHAR_TABLE (char_table); 528 ct = XCHAR_TABLE (char_table);
499 529
500 switch (ct->type)
501 {
502 case CHAR_TABLE_TYPE_CHAR:
503 def = make_char (0);
504 break;
505 case CHAR_TABLE_TYPE_DISPLAY:
506 case CHAR_TABLE_TYPE_GENERIC:
507 #ifdef MULE
508 case CHAR_TABLE_TYPE_CATEGORY:
509 #endif /* MULE */
510 def = Qnil;
511 break;
512
513 case CHAR_TABLE_TYPE_SYNTAX:
514 def = make_int (Sinherit);
515 break;
516
517 default:
518 ABORT ();
519 def = Qnil;
520 break;
521 }
522
523 /* Avoid doubly updating the syntax table by setting the default ourselves, 530 /* Avoid doubly updating the syntax table by setting the default ourselves,
524 since set_char_table_default() also updates. */ 531 since set_char_table_default() also updates. */
525 ct->default_ = def; 532 ct->default_ = char_table_default_for_type (ct->type);
526 fill_char_table (ct, Qunbound); 533 fill_char_table (ct, Qunbound);
527 534
528 return Qnil; 535 return Qnil;
529 } 536 }
530 537
1541 } 1548 }
1542 1549
1543 return 1; 1550 return 1;
1544 } 1551 }
1545 1552
1553 static int
1554 chartab_default_validate (Lisp_Object UNUSED (keyword),
1555 Lisp_Object UNUSED (value),
1556 Error_Behavior UNUSED (errb))
1557 {
1558 /* We can't yet validate this, since we don't know what the type of the
1559 char table is. We do the validation below in chartab_instantiate(). */
1560 return 1;
1561 }
1562
1546 static Lisp_Object 1563 static Lisp_Object
1547 chartab_instantiate (Lisp_Object plist) 1564 chartab_instantiate (Lisp_Object plist)
1548 { 1565 {
1549 Lisp_Object chartab; 1566 Lisp_Object chartab;
1550 Lisp_Object type = Qgeneric; 1567 Lisp_Object type = Qgeneric;
1551 Lisp_Object dataval = Qnil; 1568 Lisp_Object dataval = Qnil, default_ = Qunbound;
1552 1569
1553 if (KEYWORDP (Fcar (plist))) 1570 if (KEYWORDP (Fcar (plist)))
1554 { 1571 {
1555 PROPERTY_LIST_LOOP_3 (key, value, plist) 1572 PROPERTY_LIST_LOOP_3 (key, value, plist)
1556 { 1573 {
1559 dataval = value; 1576 dataval = value;
1560 } 1577 }
1561 else if (EQ (key, Q_type)) 1578 else if (EQ (key, Q_type))
1562 { 1579 {
1563 type = value; 1580 type = value;
1581 }
1582 else if (EQ (key, Q_default))
1583 {
1584 default_ = value;
1564 } 1585 }
1565 else if (!KEYWORDP (key)) 1586 else if (!KEYWORDP (key))
1566 { 1587 {
1567 signal_error 1588 signal_error
1568 (Qinvalid_read_syntax, 1589 (Qinvalid_read_syntax,
1596 } 1617 }
1597 } 1618 }
1598 #endif /* NEED_TO_HANDLE_21_4_CODE */ 1619 #endif /* NEED_TO_HANDLE_21_4_CODE */
1599 1620
1600 chartab = Fmake_char_table (type); 1621 chartab = Fmake_char_table (type);
1622 if (!UNBOUNDP (default_))
1623 {
1624 check_valid_char_table_value (default_, XCHAR_TABLE_TYPE (chartab),
1625 ERROR_ME);
1626 set_char_table_default (chartab, default_);
1627 set_char_table_default (XCHAR_TABLE (chartab)->mirror_table, default_);
1628 }
1601 1629
1602 while (!NILP (dataval)) 1630 while (!NILP (dataval))
1603 { 1631 {
1604 Lisp_Object range = Fcar (dataval); 1632 Lisp_Object range = Fcar (dataval);
1605 Lisp_Object val = Fcar (Fcdr (dataval)); 1633 Lisp_Object val = Fcar (Fcdr (dataval));
1870 DEFSYMBOL (Qcategory_table_value_p); 1898 DEFSYMBOL (Qcategory_table_value_p);
1871 #endif /* MULE */ 1899 #endif /* MULE */
1872 1900
1873 DEFSYMBOL (Qchar_table); 1901 DEFSYMBOL (Qchar_table);
1874 DEFSYMBOL_MULTIWORD_PREDICATE (Qchar_tablep); 1902 DEFSYMBOL_MULTIWORD_PREDICATE (Qchar_tablep);
1903 DEFKEYWORD (Q_default);
1875 1904
1876 DEFSUBR (Fchar_table_p); 1905 DEFSUBR (Fchar_table_p);
1877 DEFSUBR (Fchar_table_type_list); 1906 DEFSUBR (Fchar_table_type_list);
1878 DEFSUBR (Fvalid_char_table_type_p); 1907 DEFSUBR (Fvalid_char_table_type_p);
1879 DEFSUBR (Fchar_table_type); 1908 DEFSUBR (Fchar_table_type);
1924 define_structure_type_keyword (st, Qdata, chartab_data_validate); 1953 define_structure_type_keyword (st, Qdata, chartab_data_validate);
1925 #endif /* NEED_TO_HANDLE_21_4_CODE */ 1954 #endif /* NEED_TO_HANDLE_21_4_CODE */
1926 1955
1927 define_structure_type_keyword (st, Q_type, chartab_type_validate); 1956 define_structure_type_keyword (st, Q_type, chartab_type_validate);
1928 define_structure_type_keyword (st, Q_data, chartab_data_validate); 1957 define_structure_type_keyword (st, Q_data, chartab_data_validate);
1958 define_structure_type_keyword (st, Q_default, chartab_default_validate);
1929 } 1959 }
1930 1960
1931 void 1961 void
1932 complex_vars_of_chartab (void) 1962 complex_vars_of_chartab (void)
1933 { 1963 {