1 /* chartab.c -- char-table support
2 Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008
3 National Institute of Advanced Industrial Science and Technology (AIST)
4 Registration Number H13PRO009
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
23 #include "character.h"
29 /* Number of elements in Nth level char-table. */
30 const int chartab_size
[4] =
31 { (1 << CHARTAB_SIZE_BITS_0
),
32 (1 << CHARTAB_SIZE_BITS_1
),
33 (1 << CHARTAB_SIZE_BITS_2
),
34 (1 << CHARTAB_SIZE_BITS_3
) };
36 /* Number of characters each element of Nth level char-table
38 const int chartab_chars
[4] =
39 { (1 << (CHARTAB_SIZE_BITS_1
+ CHARTAB_SIZE_BITS_2
+ CHARTAB_SIZE_BITS_3
)),
40 (1 << (CHARTAB_SIZE_BITS_2
+ CHARTAB_SIZE_BITS_3
)),
41 (1 << CHARTAB_SIZE_BITS_3
),
44 /* Number of characters (in bits) each element of Nth level char-table
46 const int chartab_bits
[4] =
47 { (CHARTAB_SIZE_BITS_1
+ CHARTAB_SIZE_BITS_2
+ CHARTAB_SIZE_BITS_3
),
48 (CHARTAB_SIZE_BITS_2
+ CHARTAB_SIZE_BITS_3
),
52 #define CHARTAB_IDX(c, depth, min_char) \
53 (((c) - (min_char)) >> chartab_bits[(depth)])
56 DEFUN ("make-char-table", Fmake_char_table
, Smake_char_table
, 1, 2, 0,
57 doc
: /* Return a newly created char-table, with purpose PURPOSE.
58 Each element is initialized to INIT, which defaults to nil.
60 PURPOSE should be a symbol. If it has a `char-table-extra-slots'
61 property, the property's value should be an integer between 0 and 10
62 that specifies how many extra slots the char-table has. Otherwise,
63 the char-table has no extra slot. */)
65 register Lisp_Object purpose
, init
;
72 CHECK_SYMBOL (purpose
);
73 n
= Fget (purpose
, Qchar_table_extra_slots
);
81 args_out_of_range (n
, Qnil
);
84 size
= VECSIZE (struct Lisp_Char_Table
) - 1 + n_extras
;
85 vector
= Fmake_vector (make_number (size
), init
);
86 XSETPVECTYPE (XVECTOR (vector
), PVEC_CHAR_TABLE
);
87 XCHAR_TABLE (vector
)->parent
= Qnil
;
88 XCHAR_TABLE (vector
)->purpose
= purpose
;
89 XSETCHAR_TABLE (vector
, XCHAR_TABLE (vector
));
94 make_sub_char_table (depth
, min_char
, defalt
)
99 int size
= VECSIZE (struct Lisp_Sub_Char_Table
) - 1 + chartab_size
[depth
];
101 table
= Fmake_vector (make_number (size
), defalt
);
102 XSETPVECTYPE (XVECTOR (table
), PVEC_SUB_CHAR_TABLE
);
103 XSUB_CHAR_TABLE (table
)->depth
= make_number (depth
);
104 XSUB_CHAR_TABLE (table
)->min_char
= make_number (min_char
);
110 char_table_ascii (table
)
115 sub
= XCHAR_TABLE (table
)->contents
[0];
116 if (! SUB_CHAR_TABLE_P (sub
))
118 sub
= XSUB_CHAR_TABLE (sub
)->contents
[0];
119 if (! SUB_CHAR_TABLE_P (sub
))
121 return XSUB_CHAR_TABLE (sub
)->contents
[0];
125 copy_sub_char_table (table
)
129 int depth
= XINT (XSUB_CHAR_TABLE (table
)->depth
);
130 int min_char
= XINT (XSUB_CHAR_TABLE (table
)->min_char
);
134 copy
= make_sub_char_table (depth
, min_char
, Qnil
);
135 /* Recursively copy any sub char-tables. */
136 for (i
= 0; i
< chartab_size
[depth
]; i
++)
138 val
= XSUB_CHAR_TABLE (table
)->contents
[i
];
139 if (SUB_CHAR_TABLE_P (val
))
140 XSUB_CHAR_TABLE (copy
)->contents
[i
] = copy_sub_char_table (val
);
142 XSUB_CHAR_TABLE (copy
)->contents
[i
] = val
;
150 copy_char_table (table
)
154 int size
= XCHAR_TABLE (table
)->size
& PSEUDOVECTOR_SIZE_MASK
;
157 copy
= Fmake_vector (make_number (size
), Qnil
);
158 XSETPVECTYPE (XVECTOR (copy
), PVEC_CHAR_TABLE
);
159 XCHAR_TABLE (copy
)->defalt
= XCHAR_TABLE (table
)->defalt
;
160 XCHAR_TABLE (copy
)->parent
= XCHAR_TABLE (table
)->parent
;
161 XCHAR_TABLE (copy
)->purpose
= XCHAR_TABLE (table
)->purpose
;
162 for (i
= 0; i
< chartab_size
[0]; i
++)
163 XCHAR_TABLE (copy
)->contents
[i
]
164 = (SUB_CHAR_TABLE_P (XCHAR_TABLE (table
)->contents
[i
])
165 ? copy_sub_char_table (XCHAR_TABLE (table
)->contents
[i
])
166 : XCHAR_TABLE (table
)->contents
[i
]);
167 XCHAR_TABLE (copy
)->ascii
= char_table_ascii (copy
);
168 size
-= VECSIZE (struct Lisp_Char_Table
) - 1;
169 for (i
= 0; i
< size
; i
++)
170 XCHAR_TABLE (copy
)->extras
[i
] = XCHAR_TABLE (table
)->extras
[i
];
172 XSETCHAR_TABLE (copy
, XCHAR_TABLE (copy
));
177 sub_char_table_ref (table
, c
)
181 struct Lisp_Sub_Char_Table
*tbl
= XSUB_CHAR_TABLE (table
);
182 int depth
= XINT (tbl
->depth
);
183 int min_char
= XINT (tbl
->min_char
);
186 val
= tbl
->contents
[CHARTAB_IDX (c
, depth
, min_char
)];
187 if (SUB_CHAR_TABLE_P (val
))
188 val
= sub_char_table_ref (val
, c
);
193 char_table_ref (table
, c
)
197 struct Lisp_Char_Table
*tbl
= XCHAR_TABLE (table
);
200 if (ASCII_CHAR_P (c
))
203 if (SUB_CHAR_TABLE_P (val
))
204 val
= XSUB_CHAR_TABLE (val
)->contents
[c
];
208 val
= tbl
->contents
[CHARTAB_IDX (c
, 0, 0)];
209 if (SUB_CHAR_TABLE_P (val
))
210 val
= sub_char_table_ref (val
, c
);
215 if (NILP (val
) && CHAR_TABLE_P (tbl
->parent
))
216 val
= char_table_ref (tbl
->parent
, c
);
222 sub_char_table_ref_and_range (table
, c
, from
, to
, defalt
)
228 struct Lisp_Sub_Char_Table
*tbl
= XSUB_CHAR_TABLE (table
);
229 int depth
= XINT (tbl
->depth
);
230 int min_char
= XINT (tbl
->min_char
);
231 int max_char
= min_char
+ chartab_chars
[depth
- 1] - 1;
232 int index
= CHARTAB_IDX (c
, depth
, min_char
);
235 val
= tbl
->contents
[index
];
236 *from
= min_char
+ index
* chartab_chars
[depth
];
237 *to
= *from
+ chartab_chars
[depth
] - 1;
238 if (SUB_CHAR_TABLE_P (val
))
239 val
= sub_char_table_ref_and_range (val
, c
, from
, to
, defalt
);
243 while (*from
> min_char
244 && *from
== min_char
+ index
* chartab_chars
[depth
])
246 Lisp_Object this_val
;
247 int this_from
= *from
- chartab_chars
[depth
];
248 int this_to
= *from
- 1;
251 this_val
= tbl
->contents
[index
];
252 if (SUB_CHAR_TABLE_P (this_val
))
253 this_val
= sub_char_table_ref_and_range (this_val
, this_to
,
254 &this_from
, &this_to
,
256 else if (NILP (this_val
))
259 if (! EQ (this_val
, val
))
263 index
= CHARTAB_IDX (c
, depth
, min_char
);
264 while (*to
< max_char
265 && *to
== min_char
+ (index
+ 1) * chartab_chars
[depth
] - 1)
267 Lisp_Object this_val
;
268 int this_from
= *to
+ 1;
269 int this_to
= this_from
+ chartab_chars
[depth
] - 1;
272 this_val
= tbl
->contents
[index
];
273 if (SUB_CHAR_TABLE_P (this_val
))
274 this_val
= sub_char_table_ref_and_range (this_val
, this_from
,
275 &this_from
, &this_to
,
277 else if (NILP (this_val
))
279 if (! EQ (this_val
, val
))
288 /* Return the value for C in char-table TABLE. Set *FROM and *TO to
289 the range of characters (containing C) that have the same value as
290 C. It is not assured that the value of (*FROM - 1) and (*TO + 1)
291 is different from that of C. */
294 char_table_ref_and_range (table
, c
, from
, to
)
299 struct Lisp_Char_Table
*tbl
= XCHAR_TABLE (table
);
300 int index
= CHARTAB_IDX (c
, 0, 0);
303 val
= tbl
->contents
[index
];
304 *from
= index
* chartab_chars
[0];
305 *to
= *from
+ chartab_chars
[0] - 1;
306 if (SUB_CHAR_TABLE_P (val
))
307 val
= sub_char_table_ref_and_range (val
, c
, from
, to
, tbl
->defalt
);
311 while (*from
> 0 && *from
== index
* chartab_chars
[0])
313 Lisp_Object this_val
;
314 int this_from
= *from
- chartab_chars
[0];
315 int this_to
= *from
- 1;
318 this_val
= tbl
->contents
[index
];
319 if (SUB_CHAR_TABLE_P (this_val
))
320 this_val
= sub_char_table_ref_and_range (this_val
, this_to
,
321 &this_from
, &this_to
,
323 else if (NILP (this_val
))
324 this_val
= tbl
->defalt
;
326 if (! EQ (this_val
, val
))
330 while (*to
< MAX_CHAR
&& *to
== (index
+ 1) * chartab_chars
[0] - 1)
332 Lisp_Object this_val
;
333 int this_from
= *to
+ 1;
334 int this_to
= this_from
+ chartab_chars
[0] - 1;
337 this_val
= tbl
->contents
[index
];
338 if (SUB_CHAR_TABLE_P (this_val
))
339 this_val
= sub_char_table_ref_and_range (this_val
, this_from
,
340 &this_from
, &this_to
,
342 else if (NILP (this_val
))
343 this_val
= tbl
->defalt
;
344 if (! EQ (this_val
, val
))
353 #define ASET_RANGE(ARRAY, FROM, TO, LIMIT, VAL) \
355 int limit = (TO) < (LIMIT) ? (TO) : (LIMIT); \
356 for (; (FROM) < limit; (FROM)++) (ARRAY)->contents[(FROM)] = (VAL); \
359 #define GET_SUB_CHAR_TABLE(TABLE, SUBTABLE, IDX, DEPTH, MIN_CHAR) \
361 (SUBTABLE) = (TABLE)->contents[(IDX)]; \
362 if (!SUB_CHAR_TABLE_P (SUBTABLE)) \
363 (SUBTABLE) = make_sub_char_table ((DEPTH), (MIN_CHAR), (SUBTABLE)); \
368 sub_char_table_set (table
, c
, val
)
373 struct Lisp_Sub_Char_Table
*tbl
= XSUB_CHAR_TABLE (table
);
374 int depth
= XINT ((tbl
)->depth
);
375 int min_char
= XINT ((tbl
)->min_char
);
376 int i
= CHARTAB_IDX (c
, depth
, min_char
);
380 tbl
->contents
[i
] = val
;
383 sub
= tbl
->contents
[i
];
384 if (! SUB_CHAR_TABLE_P (sub
))
386 sub
= make_sub_char_table (depth
+ 1,
387 min_char
+ i
* chartab_chars
[depth
], sub
);
388 tbl
->contents
[i
] = sub
;
390 sub_char_table_set (sub
, c
, val
);
395 char_table_set (table
, c
, val
)
400 struct Lisp_Char_Table
*tbl
= XCHAR_TABLE (table
);
403 && SUB_CHAR_TABLE_P (tbl
->ascii
))
405 XSUB_CHAR_TABLE (tbl
->ascii
)->contents
[c
] = val
;
409 int i
= CHARTAB_IDX (c
, 0, 0);
412 sub
= tbl
->contents
[i
];
413 if (! SUB_CHAR_TABLE_P (sub
))
415 sub
= make_sub_char_table (1, i
* chartab_chars
[0], sub
);
416 tbl
->contents
[i
] = sub
;
418 sub_char_table_set (sub
, c
, val
);
419 if (ASCII_CHAR_P (c
))
420 tbl
->ascii
= char_table_ascii (table
);
426 sub_char_table_set_range (table
, depth
, min_char
, from
, to
, val
)
433 int max_char
= min_char
+ chartab_chars
[depth
] - 1;
435 if (depth
== 3 || (from
<= min_char
&& to
>= max_char
))
442 if (! SUB_CHAR_TABLE_P (*table
))
443 *table
= make_sub_char_table (depth
, min_char
, *table
);
448 i
= CHARTAB_IDX (from
, depth
, min_char
);
449 j
= CHARTAB_IDX (to
, depth
, min_char
);
450 min_char
+= chartab_chars
[depth
] * i
;
451 for (; i
<= j
; i
++, min_char
+= chartab_chars
[depth
])
452 sub_char_table_set_range (XSUB_CHAR_TABLE (*table
)->contents
+ i
,
453 depth
, min_char
, from
, to
, val
);
459 char_table_set_range (table
, from
, to
, val
)
464 struct Lisp_Char_Table
*tbl
= XCHAR_TABLE (table
);
465 Lisp_Object
*contents
= tbl
->contents
;
469 char_table_set (table
, from
, val
);
472 for (i
= CHARTAB_IDX (from
, 0, 0), min_char
= i
* chartab_chars
[0];
474 i
++, min_char
+= chartab_chars
[0])
475 sub_char_table_set_range (contents
+ i
, 0, min_char
, from
, to
, val
);
476 if (ASCII_CHAR_P (from
))
477 tbl
->ascii
= char_table_ascii (table
);
483 DEFUN ("char-table-subtype", Fchar_table_subtype
, Schar_table_subtype
,
486 Return the subtype of char-table CHAR-TABLE. The value is a symbol. */)
488 Lisp_Object char_table
;
490 CHECK_CHAR_TABLE (char_table
);
492 return XCHAR_TABLE (char_table
)->purpose
;
495 DEFUN ("char-table-parent", Fchar_table_parent
, Schar_table_parent
,
497 doc
: /* Return the parent char-table of CHAR-TABLE.
498 The value is either nil or another char-table.
499 If CHAR-TABLE holds nil for a given character,
500 then the actual applicable value is inherited from the parent char-table
501 \(or from its parents, if necessary). */)
503 Lisp_Object char_table
;
505 CHECK_CHAR_TABLE (char_table
);
507 return XCHAR_TABLE (char_table
)->parent
;
510 DEFUN ("set-char-table-parent", Fset_char_table_parent
, Sset_char_table_parent
,
512 doc
: /* Set the parent char-table of CHAR-TABLE to PARENT.
513 Return PARENT. PARENT must be either nil or another char-table. */)
515 Lisp_Object char_table
, parent
;
519 CHECK_CHAR_TABLE (char_table
);
523 CHECK_CHAR_TABLE (parent
);
525 for (temp
= parent
; !NILP (temp
); temp
= XCHAR_TABLE (temp
)->parent
)
526 if (EQ (temp
, char_table
))
527 error ("Attempt to make a chartable be its own parent");
530 XCHAR_TABLE (char_table
)->parent
= parent
;
535 DEFUN ("char-table-extra-slot", Fchar_table_extra_slot
, Schar_table_extra_slot
,
537 doc
: /* Return the value of CHAR-TABLE's extra-slot number N. */)
539 Lisp_Object char_table
, n
;
541 CHECK_CHAR_TABLE (char_table
);
544 || XINT (n
) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table
)))
545 args_out_of_range (char_table
, n
);
547 return XCHAR_TABLE (char_table
)->extras
[XINT (n
)];
550 DEFUN ("set-char-table-extra-slot", Fset_char_table_extra_slot
,
551 Sset_char_table_extra_slot
,
553 doc
: /* Set CHAR-TABLE's extra-slot number N to VALUE. */)
554 (char_table
, n
, value
)
555 Lisp_Object char_table
, n
, value
;
557 CHECK_CHAR_TABLE (char_table
);
560 || XINT (n
) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table
)))
561 args_out_of_range (char_table
, n
);
563 return XCHAR_TABLE (char_table
)->extras
[XINT (n
)] = value
;
566 DEFUN ("char-table-range", Fchar_table_range
, Schar_table_range
,
568 doc
: /* Return the value in CHAR-TABLE for a range of characters RANGE.
569 RANGE should be nil (for the default value),
570 a cons of character codes (for characters in the range), or a character code. */)
572 Lisp_Object char_table
, range
;
575 CHECK_CHAR_TABLE (char_table
);
577 if (EQ (range
, Qnil
))
578 val
= XCHAR_TABLE (char_table
)->defalt
;
579 else if (INTEGERP (range
))
580 val
= CHAR_TABLE_REF (char_table
, XINT (range
));
581 else if (CONSP (range
))
585 CHECK_CHARACTER_CAR (range
);
586 CHECK_CHARACTER_CDR (range
);
587 val
= char_table_ref_and_range (char_table
, XINT (XCAR (range
)),
589 /* Not yet implemented. */
592 error ("Invalid RANGE argument to `char-table-range'");
596 DEFUN ("set-char-table-range", Fset_char_table_range
, Sset_char_table_range
,
598 doc
: /* Set the value in CHAR-TABLE for a range of characters RANGE to VALUE.
599 RANGE should be t (for all characters), nil (for the default value),
600 a cons of character codes (for characters in the range),
601 or a character code. Return VALUE. */)
602 (char_table
, range
, value
)
603 Lisp_Object char_table
, range
, value
;
605 CHECK_CHAR_TABLE (char_table
);
610 XCHAR_TABLE (char_table
)->ascii
= value
;
611 for (i
= 0; i
< chartab_size
[0]; i
++)
612 XCHAR_TABLE (char_table
)->contents
[i
] = value
;
614 else if (EQ (range
, Qnil
))
615 XCHAR_TABLE (char_table
)->defalt
= value
;
616 else if (INTEGERP (range
))
617 char_table_set (char_table
, XINT (range
), value
);
618 else if (CONSP (range
))
620 CHECK_CHARACTER_CAR (range
);
621 CHECK_CHARACTER_CDR (range
);
622 char_table_set_range (char_table
,
623 XINT (XCAR (range
)), XINT (XCDR (range
)), value
);
626 error ("Invalid RANGE argument to `set-char-table-range'");
631 DEFUN ("set-char-table-default", Fset_char_table_default
,
632 Sset_char_table_default
, 3, 3, 0,
634 This function is obsolete and has no effect. */)
635 (char_table
, ch
, value
)
636 Lisp_Object char_table
, ch
, value
;
641 /* Look up the element in TABLE at index CH, and return it as an
642 integer. If the element is not a character, return CH itself. */
645 char_table_translate (table
, ch
)
650 value
= Faref (table
, make_number (ch
));
651 if (! CHARACTERP (value
))
657 optimize_sub_char_table (table
, test
)
658 Lisp_Object table
, test
;
660 struct Lisp_Sub_Char_Table
*tbl
= XSUB_CHAR_TABLE (table
);
661 int depth
= XINT (tbl
->depth
);
662 Lisp_Object elt
, this;
665 elt
= XSUB_CHAR_TABLE (table
)->contents
[0];
666 if (SUB_CHAR_TABLE_P (elt
))
667 elt
= XSUB_CHAR_TABLE (table
)->contents
[0]
668 = optimize_sub_char_table (elt
, test
);
669 optimizable
= SUB_CHAR_TABLE_P (elt
) ? 0 : 1;
670 for (i
= 1; i
< chartab_size
[depth
]; i
++)
672 this = XSUB_CHAR_TABLE (table
)->contents
[i
];
673 if (SUB_CHAR_TABLE_P (this))
674 this = XSUB_CHAR_TABLE (table
)->contents
[i
]
675 = optimize_sub_char_table (this, test
);
677 && (NILP (test
) ? NILP (Fequal (this, elt
)) /* defaults to `equal'. */
678 : EQ (test
, Qeq
) ? !EQ (this, elt
) /* Optimize `eq' case. */
679 : NILP (call2 (test
, this, elt
))))
683 return (optimizable
? elt
: table
);
686 DEFUN ("optimize-char-table", Foptimize_char_table
, Soptimize_char_table
,
688 doc
: /* Optimize CHAR-TABLE.
689 TEST is the comparison function used to decide whether two entries are
690 equivalent and can be merged. It defaults to `equal'. */)
692 Lisp_Object char_table
, test
;
697 CHECK_CHAR_TABLE (char_table
);
699 for (i
= 0; i
< chartab_size
[0]; i
++)
701 elt
= XCHAR_TABLE (char_table
)->contents
[i
];
702 if (SUB_CHAR_TABLE_P (elt
))
703 XCHAR_TABLE (char_table
)->contents
[i
]
704 = optimize_sub_char_table (elt
, test
);
706 /* Reset the `ascii' cache, in case it got optimized away. */
707 XCHAR_TABLE (char_table
)->ascii
= char_table_ascii (char_table
);
713 /* Map C_FUNCTION or FUNCTION over TABLE (top or sub char-table),
714 calling it for each character or group of characters that share a
715 value. RANGE is a cons (FROM . TO) specifying the range of target
716 characters, VAL is a value of FROM in TABLE, DEFAULT_VAL is the
717 default value of the char-table, PARENT is the parent of the
720 ARG is passed to C_FUNCTION when that is called.
722 It returns the value of last character covered by TABLE (not the
723 value inheritted from the parent), and by side-effect, the car part
724 of RANGE is updated to the minimum character C where C and all the
725 following characters in TABLE have the same value. */
728 map_sub_char_table (c_function
, function
, table
, arg
, val
, range
,
730 void (*c_function
) P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
));
731 Lisp_Object function
, table
, arg
, val
, range
, default_val
, parent
;
733 /* Pointer to the elements of TABLE. */
734 Lisp_Object
*contents
;
735 /* Depth of TABLE. */
737 /* Minimum and maxinum characters covered by TABLE. */
738 int min_char
, max_char
;
739 /* Number of characters covered by one element of TABLE. */
741 int from
= XINT (XCAR (range
)), to
= XINT (XCDR (range
));
744 if (SUB_CHAR_TABLE_P (table
))
746 struct Lisp_Sub_Char_Table
*tbl
= XSUB_CHAR_TABLE (table
);
748 depth
= XINT (tbl
->depth
);
749 contents
= tbl
->contents
;
750 min_char
= XINT (tbl
->min_char
);
751 max_char
= min_char
+ chartab_chars
[depth
- 1] - 1;
756 contents
= XCHAR_TABLE (table
)->contents
;
760 chars_in_block
= chartab_chars
[depth
];
764 /* Set I to the index of the first element to check. */
765 if (from
<= min_char
)
768 i
= (from
- min_char
) / chars_in_block
;
769 for (c
= min_char
+ chars_in_block
* i
; c
<= max_char
;
770 i
++, c
+= chars_in_block
)
772 Lisp_Object
this = contents
[i
];
773 int nextc
= c
+ chars_in_block
;
775 if (SUB_CHAR_TABLE_P (this))
778 XSETCDR (range
, make_number (nextc
- 1));
779 val
= map_sub_char_table (c_function
, function
, this, arg
,
780 val
, range
, default_val
, parent
);
788 int different_value
= 1;
794 Lisp_Object temp
= XCHAR_TABLE (parent
)->parent
;
796 /* This is to get a value of FROM in PARENT
797 without checking the parent of PARENT. */
798 XCHAR_TABLE (parent
)->parent
= Qnil
;
799 val
= CHAR_TABLE_REF (parent
, from
);
800 XCHAR_TABLE (parent
)->parent
= temp
;
801 XSETCDR (range
, make_number (c
- 1));
802 val
= map_sub_char_table (c_function
, function
,
803 parent
, arg
, val
, range
,
804 XCHAR_TABLE (parent
)->defalt
,
805 XCHAR_TABLE (parent
)->parent
);
810 if (! NILP (val
) && different_value
)
812 XSETCDR (range
, make_number (c
- 1));
813 if (EQ (XCAR (range
), XCDR (range
)))
816 (*c_function
) (arg
, XCAR (range
), val
);
818 call2 (function
, XCAR (range
), val
);
823 (*c_function
) (arg
, range
, val
);
825 call2 (function
, range
, val
);
830 XSETCAR (range
, make_number (c
));
833 XSETCDR (range
, make_number (to
));
839 /* Map C_FUNCTION or FUNCTION over TABLE, calling it for each
840 character or group of characters that share a value.
842 ARG is passed to C_FUNCTION when that is called. */
845 map_char_table (c_function
, function
, table
, arg
)
846 void (*c_function
) P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
));
847 Lisp_Object function
, table
, arg
;
849 Lisp_Object range
, val
;
850 struct gcpro gcpro1
, gcpro2
, gcpro3
;
852 range
= Fcons (make_number (0), make_number (MAX_CHAR
));
853 GCPRO3 (table
, arg
, range
);
854 val
= XCHAR_TABLE (table
)->ascii
;
855 if (SUB_CHAR_TABLE_P (val
))
856 val
= XSUB_CHAR_TABLE (val
)->contents
[0];
857 val
= map_sub_char_table (c_function
, function
, table
, arg
, val
, range
,
858 XCHAR_TABLE (table
)->defalt
,
859 XCHAR_TABLE (table
)->parent
);
860 /* If VAL is nil and TABLE has a parent, we must consult the parent
862 while (NILP (val
) && ! NILP (XCHAR_TABLE (table
)->parent
))
864 Lisp_Object parent
= XCHAR_TABLE (table
)->parent
;
865 Lisp_Object temp
= XCHAR_TABLE (parent
)->parent
;
866 int from
= XINT (XCAR (range
));
868 /* This is to get a value of FROM in PARENT without checking the
870 XCHAR_TABLE (parent
)->parent
= Qnil
;
871 val
= CHAR_TABLE_REF (parent
, from
);
872 XCHAR_TABLE (parent
)->parent
= temp
;
873 val
= map_sub_char_table (c_function
, function
, parent
, arg
, val
, range
,
874 XCHAR_TABLE (parent
)->defalt
,
875 XCHAR_TABLE (parent
)->parent
);
881 if (EQ (XCAR (range
), XCDR (range
)))
884 (*c_function
) (arg
, XCAR (range
), val
);
886 call2 (function
, XCAR (range
), val
);
891 (*c_function
) (arg
, range
, val
);
893 call2 (function
, range
, val
);
900 DEFUN ("map-char-table", Fmap_char_table
, Smap_char_table
,
903 Call FUNCTION for each character in CHAR-TABLE that has non-nil value.
904 FUNCTION is called with two arguments--a key and a value.
905 The key is a character code or a cons of character codes specifying a
906 range of characters that have the same value. */)
907 (function
, char_table
)
908 Lisp_Object function
, char_table
;
910 CHECK_CHAR_TABLE (char_table
);
912 map_char_table (NULL
, function
, char_table
, char_table
);
918 map_sub_char_table_for_charset (c_function
, function
, table
, arg
, range
,
920 void (*c_function
) P_ ((Lisp_Object
, Lisp_Object
));
921 Lisp_Object function
, table
, arg
, range
;
922 struct charset
*charset
;
925 struct Lisp_Sub_Char_Table
*tbl
= XSUB_CHAR_TABLE (table
);
926 int depth
= XINT (tbl
->depth
);
930 for (i
= 0, c
= XINT (tbl
->min_char
); i
< chartab_size
[depth
];
931 i
++, c
+= chartab_chars
[depth
])
935 this = tbl
->contents
[i
];
936 if (SUB_CHAR_TABLE_P (this))
937 map_sub_char_table_for_charset (c_function
, function
, this, arg
,
938 range
, charset
, from
, to
);
941 if (! NILP (XCAR (range
)))
943 XSETCDR (range
, make_number (c
- 1));
945 (*c_function
) (arg
, range
);
947 call2 (function
, range
, arg
);
949 XSETCAR (range
, Qnil
);
953 for (i
= 0, c
= XINT (tbl
->min_char
); i
< chartab_size
[depth
]; i
++, c
++)
958 this = tbl
->contents
[i
];
961 && (code
= ENCODE_CHAR (charset
, c
),
962 (code
< from
|| code
> to
))))
964 if (! NILP (XCAR (range
)))
966 XSETCDR (range
, make_number (c
- 1));
968 (*c_function
) (arg
, range
);
970 call2 (function
, range
, arg
);
971 XSETCAR (range
, Qnil
);
976 if (NILP (XCAR (range
)))
977 XSETCAR (range
, make_number (c
));
984 map_char_table_for_charset (c_function
, function
, table
, arg
,
986 void (*c_function
) P_ ((Lisp_Object
, Lisp_Object
));
987 Lisp_Object function
, table
, arg
;
988 struct charset
*charset
;
995 range
= Fcons (Qnil
, Qnil
);
998 for (i
= 0, c
= 0; i
< chartab_size
[0]; i
++, c
+= chartab_chars
[0])
1002 this = XCHAR_TABLE (table
)->contents
[i
];
1003 if (SUB_CHAR_TABLE_P (this))
1004 map_sub_char_table_for_charset (c_function
, function
, this, arg
,
1005 range
, charset
, from
, to
);
1008 if (! NILP (XCAR (range
)))
1010 XSETCDR (range
, make_number (c
- 1));
1012 (*c_function
) (arg
, range
);
1014 call2 (function
, range
, arg
);
1016 XSETCAR (range
, Qnil
);
1019 if (! NILP (XCAR (range
)))
1021 XSETCDR (range
, make_number (c
- 1));
1023 (*c_function
) (arg
, range
);
1025 call2 (function
, range
, arg
);
1035 defsubr (&Smake_char_table
);
1036 defsubr (&Schar_table_parent
);
1037 defsubr (&Schar_table_subtype
);
1038 defsubr (&Sset_char_table_parent
);
1039 defsubr (&Schar_table_extra_slot
);
1040 defsubr (&Sset_char_table_extra_slot
);
1041 defsubr (&Schar_table_range
);
1042 defsubr (&Sset_char_table_range
);
1043 defsubr (&Sset_char_table_default
);
1044 defsubr (&Soptimize_char_table
);
1045 defsubr (&Smap_char_table
);
1048 /* arch-tag: 18b5b560-7ab5-4108-b09e-d5dd65dc6fda
1049 (do not change this comment) */