Mercurial > emacs

comparison src/fns.c @ 61838:8ff9d677eeff

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(char_table_range): New function. (Fchar_table_range): Signal an error if characters in the range have inconsistent values. Don't check the parent.
author Kenichi Handa <handa@m17n.org>
date Tue, 26 Apr 2005 04:06:16 +0000
parents 76a2f6423902
children 4ca8167b7304 08185296b491
comparison
equal deleted inserted replaced
61837:7cd3ac5179ad 61838:8ff9d677eeff
2506 args_out_of_range (char_table, n); 2506 args_out_of_range (char_table, n);
2507 2507
2508 return XCHAR_TABLE (char_table)->extras[XINT (n)] = value; 2508 return XCHAR_TABLE (char_table)->extras[XINT (n)] = value;
2509 } 2509 }
2510 2510
2511 static Lisp_Object
2512 char_table_range (table, from, to, defalt)
2513 Lisp_Object table;
2514 int from, to;
2515 Lisp_Object defalt;
2516 {
2517 Lisp_Object val;
2518
2519 if (! NILP (XCHAR_TABLE (table)->defalt))
2520 defalt = XCHAR_TABLE (table)->defalt;
2521 val = XCHAR_TABLE (table)->contents[from];
2522 if (SUB_CHAR_TABLE_P (val))
2523 val = char_table_range (val, 32, 127, defalt);
2524 else if (NILP (val))
2525 val = defalt;
2526 for (from++; from <= to; from++)
2527 {
2528 Lisp_Object this_val;
2529
2530 this_val = XCHAR_TABLE (table)->contents[from];
2531 if (SUB_CHAR_TABLE_P (this_val))
2532 this_val = char_table_range (this_val, 32, 127, defalt);
2533 else if (NILP (this_val))
2534 this_val = defalt;
2535 if (! EQ (val, this_val))
2536 error ("Characters in the range have inconsistent values");
2537 }
2538 return val;
2539 }
2540
2541
2511 DEFUN ("char-table-range", Fchar_table_range, Schar_table_range, 2542 DEFUN ("char-table-range", Fchar_table_range, Schar_table_range,
2512 2, 2, 0, 2543 2, 2, 0,
2513 doc: /* Return the value in CHAR-TABLE for a range of characters RANGE. 2544 doc: /* Return the value in CHAR-TABLE for a range of characters RANGE.
2514 RANGE should be nil (for the default value) 2545 RANGE should be nil (for the default value)
2515 a vector which identifies a character set or a row of a character set, 2546 a vector which identifies a character set or a row of a character set,
2516 a character set name, or a character code. */) 2547 a character set name, or a character code.
2548 If the characters in the specified range have different values,
2549 an error is signalled.
2550
2551 Note that this function doesn't check the parent of CHAR_TABLE. */)
2517 (char_table, range) 2552 (char_table, range)
2518 Lisp_Object char_table, range; 2553 Lisp_Object char_table, range;
2519 { 2554 {
2555 int charset_id, c1 = 0, c2 = 0;
2556 int size, i;
2557 Lisp_Object ch, val, current_default;
2558
2520 CHECK_CHAR_TABLE (char_table); 2559 CHECK_CHAR_TABLE (char_table);
2521 2560
2522 if (EQ (range, Qnil)) 2561 if (EQ (range, Qnil))
2523 return XCHAR_TABLE (char_table)->defalt; 2562 return XCHAR_TABLE (char_table)->defalt;
2524 else if (INTEGERP (range)) 2563 if (INTEGERP (range))
2525 return Faref (char_table, range); 2564 {
2565 int c = XINT (range);
2566 if (! CHAR_VALID_P (c, 0))
2567 error ("Invalid character code: %d", c);
2568 ch = range;
2569 SPLIT_CHAR (c, charset_id, c1, c2);
2570 }
2526 else if (SYMBOLP (range)) 2571 else if (SYMBOLP (range))
2527 { 2572 {
2528 Lisp_Object charset_info; 2573 Lisp_Object charset_info;
2529 2574
2530 charset_info = Fget (range, Qcharset); 2575 charset_info = Fget (range, Qcharset);
2531 CHECK_VECTOR (charset_info); 2576 CHECK_VECTOR (charset_info);
2532 2577 charset_id = XINT (XVECTOR (charset_info)->contents[0]);
2533 return Faref (char_table, 2578 ch = Fmake_char_internal (make_number (charset_id),
2534 make_number (XINT (XVECTOR (charset_info)->contents[0]) 2579 make_number (0), make_number (0));
2535 + 128));
2536 } 2580 }
2537 else if (VECTORP (range)) 2581 else if (VECTORP (range))
2538 { 2582 {
2539 if (XVECTOR (range)->size == 1) 2583 size = ASIZE (range);
2540 return Faref (char_table, 2584 if (size == 0)
2541 make_number (XINT (XVECTOR (range)->contents[0]) + 128)); 2585 args_out_of_range (range, 0);
2542 else 2586 CHECK_NUMBER (AREF (range, 0));
2543 { 2587 charset_id = XINT (AREF (range, 0));
2544 int size = XVECTOR (range)->size; 2588 if (size > 1)
2545 Lisp_Object *val = XVECTOR (range)->contents; 2589 {
2546 Lisp_Object ch = Fmake_char_internal (size <= 0 ? Qnil : val[0], 2590 CHECK_NUMBER (AREF (range, 1));
2547 size <= 1 ? Qnil : val[1], 2591 c1 = XINT (AREF (range, 1));
2548 size <= 2 ? Qnil : val[2]); 2592 if (size > 2)
2549 return Faref (char_table, ch); 2593 {
2550 } 2594 CHECK_NUMBER (AREF (range, 2));
2595 c2 = XINT (AREF (range, 2));
2596 }
2597 }
2598
2599 /* This checks if charset_id, c0, and c1 are all valid or not. */
2600 ch = Fmake_char_internal (make_number (charset_id),
2601 make_number (c1), make_number (c2));
2551 } 2602 }
2552 else 2603 else
2553 error ("Invalid RANGE argument to `char-table-range'"); 2604 error ("Invalid RANGE argument to `char-table-range'");
2554 return Qt; 2605
2606 if (c1 > 0 && (CHARSET_DIMENSION (charset_id) == 1 || c2 > 0))
2607 {
2608 /* Fully specified character. */
2609 Lisp_Object parent = XCHAR_TABLE (char_table)->parent;
2610
2611 XCHAR_TABLE (char_table)->parent = Qnil;
2612 val = Faref (char_table, ch);
2613 XCHAR_TABLE (char_table)->parent = parent;
2614 return val;
2615 }
2616
2617 current_default = XCHAR_TABLE (char_table)->defalt;
2618 if (charset_id == CHARSET_ASCII
2619 || charset_id == CHARSET_8_BIT_CONTROL
2620 || charset_id == CHARSET_8_BIT_GRAPHIC)
2621 {
2622 int from, to, defalt;
2623
2624 if (charset_id == CHARSET_ASCII)
2625 from = 0, to = 127, defalt = CHAR_TABLE_DEFAULT_SLOT_ASCII;
2626 else if (charset_id == CHARSET_8_BIT_CONTROL)
2627 from = 128, to = 159, defalt = CHAR_TABLE_DEFAULT_SLOT_8_BIT_CONTROL;
2628 else
2629 from = 160, to = 255, defalt = CHAR_TABLE_DEFAULT_SLOT_8_BIT_GRAPHIC;
2630 if (! NILP (XCHAR_TABLE (char_table)->contents[defalt]))
2631 current_default = XCHAR_TABLE (char_table)->contents[defalt];
2632 return char_table_range (char_table, from, to, current_default);
2633 }
2634
2635 val = XCHAR_TABLE (char_table)->contents[128 + charset_id];
2636 if (! SUB_CHAR_TABLE_P (val))
2637 return (NILP (val) ? current_default : val);
2638 if (! NILP (XCHAR_TABLE (val)->defalt))
2639 current_default = XCHAR_TABLE (val)->defalt;
2640 if (c1 == 0)
2641 return char_table_range (val, 32, 127, current_default);
2642 val = XCHAR_TABLE (val)->contents[c1];
2643 if (! SUB_CHAR_TABLE_P (val))
2644 return (NILP (val) ? current_default : val);
2645 if (! NILP (XCHAR_TABLE (val)->defalt))
2646 current_default = XCHAR_TABLE (val)->defalt;
2647 return char_table_range (val, 32, 127, current_default);
2555 } 2648 }
2556 2649
2557 DEFUN ("set-char-table-range", Fset_char_table_range, Sset_char_table_range, 2650 DEFUN ("set-char-table-range", Fset_char_table_range, Sset_char_table_range,
2558 3, 3, 0, 2651 3, 3, 0,
2559 doc: /* Set the value in CHAR-TABLE for a range of characters RANGE to VALUE. 2652 doc: /* Set the value in CHAR-TABLE for a range of characters RANGE to VALUE.