1 /* chartab.c -- char-table support
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 2, or (at your option)
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; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
21 Boston, MA 02111-1307, USA. */
25 #include "character.h"
31 /* Number of elements in Nth level char-table. */
32 const int chartab_size
[4] =
33 { (1 << CHARTAB_SIZE_BITS_0
),
34 (1 << CHARTAB_SIZE_BITS_1
),
35 (1 << CHARTAB_SIZE_BITS_2
),
36 (1 << CHARTAB_SIZE_BITS_3
) };
38 /* Number of characters each element of Nth level char-table
40 const int chartab_chars
[4] =
41 { (1 << (CHARTAB_SIZE_BITS_1
+ CHARTAB_SIZE_BITS_2
+ CHARTAB_SIZE_BITS_3
)),
42 (1 << (CHARTAB_SIZE_BITS_2
+ CHARTAB_SIZE_BITS_3
)),
43 (1 << CHARTAB_SIZE_BITS_3
),
46 /* Number of characters (in bits) each element of Nth level char-table
48 const int chartab_bits
[4] =
49 { (CHARTAB_SIZE_BITS_1
+ CHARTAB_SIZE_BITS_2
+ CHARTAB_SIZE_BITS_3
),
50 (CHARTAB_SIZE_BITS_2
+ CHARTAB_SIZE_BITS_3
),
54 #define CHARTAB_IDX(c, depth, min_char) \
55 (((c) - (min_char)) >> chartab_bits[(depth)])
58 DEFUN ("make-char-table", Fmake_char_table
, Smake_char_table
, 1, 2, 0,
59 doc
: /* Return a newly created char-table, with purpose PURPOSE.
60 Each element is initialized to INIT, which defaults to nil.
62 PURPOSE should be a symbol. If it has a `char-table-extra-slots'
63 property, the property's value should be an integer between 0 and 10
64 that specifies how many extra slots the char-table has. Otherwise,
65 the char-table has no extra slot. */)
67 register Lisp_Object purpose
, init
;
74 CHECK_SYMBOL (purpose
);
75 n
= Fget (purpose
, Qchar_table_extra_slots
);
83 args_out_of_range (n
, Qnil
);
86 size
= VECSIZE (struct Lisp_Char_Table
) - 1 + n_extras
;
87 vector
= Fmake_vector (make_number (size
), init
);
88 XCHAR_TABLE (vector
)->parent
= Qnil
;
89 XCHAR_TABLE (vector
)->purpose
= purpose
;
90 XSETCHAR_TABLE (vector
, XCHAR_TABLE (vector
));
95 make_sub_char_table (depth
, min_char
, defalt
)
100 int size
= VECSIZE (struct Lisp_Sub_Char_Table
) - 1 + chartab_size
[depth
];
102 table
= Fmake_vector (make_number (size
), defalt
);
103 XSUB_CHAR_TABLE (table
)->depth
= make_number (depth
);
104 XSUB_CHAR_TABLE (table
)->min_char
= make_number (min_char
);
105 XSETSUB_CHAR_TABLE (table
, XSUB_CHAR_TABLE (table
));
111 char_table_ascii (table
)
116 sub
= XCHAR_TABLE (table
)->contents
[0];
117 if (! SUB_CHAR_TABLE_P (sub
))
119 sub
= XSUB_CHAR_TABLE (sub
)->contents
[0];
120 if (! SUB_CHAR_TABLE_P (sub
))
122 return XSUB_CHAR_TABLE (sub
)->contents
[0];
126 copy_sub_char_table (table
)
130 int depth
= XINT (XSUB_CHAR_TABLE (table
)->depth
);
131 int min_char
= XINT (XSUB_CHAR_TABLE (table
)->min_char
);
135 copy
= make_sub_char_table (depth
, min_char
, Qnil
);
136 /* Recursively copy any sub char-tables. */
137 for (i
= 0; i
< chartab_size
[depth
]; i
++)
139 val
= XSUB_CHAR_TABLE (table
)->contents
[i
];
140 if (SUB_CHAR_TABLE_P (val
))
141 XSUB_CHAR_TABLE (copy
)->contents
[i
] = copy_sub_char_table (val
);
143 XSUB_CHAR_TABLE (copy
)->contents
[i
] = val
;
151 copy_char_table (table
)
155 int size
= XCHAR_TABLE (table
)->size
& PSEUDOVECTOR_SIZE_MASK
;
158 copy
= Fmake_vector (make_number (size
), Qnil
);
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 XCHAR_TABLE (copy
)->ascii
= XCHAR_TABLE (table
)->ascii
;
163 for (i
= 0; i
< chartab_size
[0]; i
++)
164 XCHAR_TABLE (copy
)->contents
[i
]
165 = (SUB_CHAR_TABLE_P (XCHAR_TABLE (table
)->contents
[i
])
166 ? copy_sub_char_table (XCHAR_TABLE (table
)->contents
[i
])
167 : XCHAR_TABLE (table
)->contents
[i
]);
168 if (SUB_CHAR_TABLE_P (XCHAR_TABLE (copy
)->ascii
))
169 XCHAR_TABLE (copy
)->ascii
= char_table_ascii (copy
);
170 size
-= VECSIZE (struct Lisp_Char_Table
) - 1;
171 for (i
= 0; i
< size
; i
++)
172 XCHAR_TABLE (copy
)->extras
[i
] = XCHAR_TABLE (table
)->extras
[i
];
174 XSETCHAR_TABLE (copy
, XCHAR_TABLE (copy
));
179 sub_char_table_ref (table
, c
)
183 struct Lisp_Sub_Char_Table
*tbl
= XSUB_CHAR_TABLE (table
);
184 int depth
= XINT (tbl
->depth
);
185 int min_char
= XINT (tbl
->min_char
);
188 val
= tbl
->contents
[CHARTAB_IDX (c
, depth
, min_char
)];
189 if (SUB_CHAR_TABLE_P (val
))
190 val
= sub_char_table_ref (val
, c
);
195 char_table_ref (table
, c
)
199 struct Lisp_Char_Table
*tbl
= XCHAR_TABLE (table
);
202 if (ASCII_CHAR_P (c
))
205 if (SUB_CHAR_TABLE_P (val
))
206 val
= XSUB_CHAR_TABLE (val
)->contents
[c
];
210 val
= tbl
->contents
[CHARTAB_IDX (c
, 0, 0)];
211 if (SUB_CHAR_TABLE_P (val
))
212 val
= sub_char_table_ref (val
, c
);
217 if (NILP (val
) && CHAR_TABLE_P (tbl
->parent
))
218 val
= char_table_ref (tbl
->parent
, c
);
224 sub_char_table_ref_and_range (table
, c
, from
, to
, defalt
)
230 struct Lisp_Sub_Char_Table
*tbl
= XSUB_CHAR_TABLE (table
);
231 int depth
= XINT (tbl
->depth
);
232 int min_char
= XINT (tbl
->min_char
);
233 int max_char
= min_char
+ chartab_chars
[depth
- 1] - 1;
234 int index
= CHARTAB_IDX (c
, depth
, min_char
);
237 val
= tbl
->contents
[index
];
238 *from
= min_char
+ index
* chartab_chars
[depth
];
239 *to
= *from
+ chartab_chars
[depth
] - 1;
240 if (SUB_CHAR_TABLE_P (val
))
241 val
= sub_char_table_ref_and_range (val
, c
, from
, to
, defalt
);
245 while (*from
> min_char
246 && *from
== min_char
+ index
* chartab_chars
[depth
])
248 Lisp_Object this_val
;
249 int this_from
= *from
- chartab_chars
[depth
];
250 int this_to
= *from
- 1;
253 this_val
= tbl
->contents
[index
];
254 if (SUB_CHAR_TABLE_P (this_val
))
255 this_val
= sub_char_table_ref_and_range (this_val
, this_to
,
256 &this_from
, &this_to
,
258 else if (NILP (this_val
))
261 if (! EQ (this_val
, val
))
265 index
= CHARTAB_IDX (c
, depth
, min_char
);
266 while (*to
< max_char
267 && *to
== min_char
+ (index
+ 1) * chartab_chars
[depth
] - 1)
269 Lisp_Object this_val
;
270 int this_from
= *to
+ 1;
271 int this_to
= this_from
+ chartab_chars
[depth
] - 1;
274 this_val
= tbl
->contents
[index
];
275 if (SUB_CHAR_TABLE_P (this_val
))
276 this_val
= sub_char_table_ref_and_range (this_val
, this_from
,
277 &this_from
, &this_to
,
279 else if (NILP (this_val
))
281 if (! EQ (this_val
, val
))
290 /* Return the value for C in char-table TABLE. Set *FROM and *TO to
291 the range of characters (containing C) that have the same value as
292 C. It is not assured that the value of (*FROM - 1) and (*TO + 1)
293 is different from that of C. */
296 char_table_ref_and_range (table
, c
, from
, to
)
301 struct Lisp_Char_Table
*tbl
= XCHAR_TABLE (table
);
302 int index
= CHARTAB_IDX (c
, 0, 0);
305 val
= tbl
->contents
[index
];
306 *from
= index
* chartab_chars
[0];
307 *to
= *from
+ chartab_chars
[0] - 1;
308 if (SUB_CHAR_TABLE_P (val
))
309 val
= sub_char_table_ref_and_range (val
, c
, from
, to
, tbl
->defalt
);
313 while (*from
> 0 && *from
== index
* chartab_chars
[0])
315 Lisp_Object this_val
;
316 int this_from
= *from
- chartab_chars
[0];
317 int this_to
= *from
- 1;
320 this_val
= tbl
->contents
[index
];
321 if (SUB_CHAR_TABLE_P (this_val
))
322 this_val
= sub_char_table_ref_and_range (this_val
, this_to
,
323 &this_from
, &this_to
,
325 else if (NILP (this_val
))
326 this_val
= tbl
->defalt
;
328 if (! EQ (this_val
, val
))
332 while (*to
< MAX_CHAR
&& *to
== (index
+ 1) * chartab_chars
[0] - 1)
334 Lisp_Object this_val
;
335 int this_from
= *to
+ 1;
336 int this_to
= this_from
+ chartab_chars
[0] - 1;
339 this_val
= tbl
->contents
[index
];
340 if (SUB_CHAR_TABLE_P (this_val
))
341 this_val
= sub_char_table_ref_and_range (this_val
, this_from
,
342 &this_from
, &this_to
,
344 else if (NILP (this_val
))
345 this_val
= tbl
->defalt
;
346 if (! EQ (this_val
, val
))
355 #define ASET_RANGE(ARRAY, FROM, TO, LIMIT, VAL) \
357 int limit = (TO) < (LIMIT) ? (TO) : (LIMIT); \
358 for (; (FROM) < limit; (FROM)++) (ARRAY)->contents[(FROM)] = (VAL); \
361 #define GET_SUB_CHAR_TABLE(TABLE, SUBTABLE, IDX, DEPTH, MIN_CHAR) \
363 (SUBTABLE) = (TABLE)->contents[(IDX)]; \
364 if (!SUB_CHAR_TABLE_P (SUBTABLE)) \
365 (SUBTABLE) = make_sub_char_table ((DEPTH), (MIN_CHAR), (SUBTABLE)); \
370 sub_char_table_set (table
, c
, val
)
375 struct Lisp_Sub_Char_Table
*tbl
= XSUB_CHAR_TABLE (table
);
376 int depth
= XINT ((tbl
)->depth
);
377 int min_char
= XINT ((tbl
)->min_char
);
378 int i
= CHARTAB_IDX (c
, depth
, min_char
);
382 tbl
->contents
[i
] = val
;
385 sub
= tbl
->contents
[i
];
386 if (! SUB_CHAR_TABLE_P (sub
))
388 sub
= make_sub_char_table (depth
+ 1,
389 min_char
+ i
* chartab_chars
[depth
], sub
);
390 tbl
->contents
[i
] = sub
;
392 sub_char_table_set (sub
, c
, val
);
397 char_table_set (table
, c
, val
)
402 struct Lisp_Char_Table
*tbl
= XCHAR_TABLE (table
);
405 && SUB_CHAR_TABLE_P (tbl
->ascii
))
407 XSUB_CHAR_TABLE (tbl
->ascii
)->contents
[c
] = val
;
411 int i
= CHARTAB_IDX (c
, 0, 0);
414 sub
= tbl
->contents
[i
];
415 if (! SUB_CHAR_TABLE_P (sub
))
417 sub
= make_sub_char_table (1, i
* chartab_chars
[0], sub
);
418 tbl
->contents
[i
] = sub
;
420 sub_char_table_set (sub
, c
, val
);
421 if (ASCII_CHAR_P (c
))
422 tbl
->ascii
= char_table_ascii (table
);
428 sub_char_table_set_range (table
, depth
, min_char
, from
, to
, val
)
435 int max_char
= min_char
+ chartab_chars
[depth
] - 1;
437 if (depth
== 3 || (from
<= min_char
&& to
>= max_char
))
444 if (! SUB_CHAR_TABLE_P (*table
))
445 *table
= make_sub_char_table (depth
, min_char
, *table
);
450 i
= CHARTAB_IDX (from
, depth
, min_char
);
451 j
= CHARTAB_IDX (to
, depth
, min_char
);
452 min_char
+= chartab_chars
[depth
] * i
;
453 for (; i
<= j
; i
++, min_char
+= chartab_chars
[depth
])
454 sub_char_table_set_range (XSUB_CHAR_TABLE (*table
)->contents
+ i
,
455 depth
, min_char
, from
, to
, val
);
461 char_table_set_range (table
, from
, to
, val
)
466 struct Lisp_Char_Table
*tbl
= XCHAR_TABLE (table
);
467 Lisp_Object
*contents
= tbl
->contents
;
471 char_table_set (table
, from
, val
);
474 for (i
= CHARTAB_IDX (from
, 0, 0), min_char
= i
* chartab_chars
[0];
476 i
++, min_char
+= chartab_chars
[0])
477 sub_char_table_set_range (contents
+ i
, 0, min_char
, from
, to
, val
);
478 if (ASCII_CHAR_P (from
))
479 tbl
->ascii
= char_table_ascii (table
);
485 DEFUN ("char-table-subtype", Fchar_table_subtype
, Schar_table_subtype
,
488 Return the subtype of char-table CHAR-TABLE. The value is a symbol. */)
490 Lisp_Object char_table
;
492 CHECK_CHAR_TABLE (char_table
);
494 return XCHAR_TABLE (char_table
)->purpose
;
497 DEFUN ("char-table-parent", Fchar_table_parent
, Schar_table_parent
,
499 doc
: /* Return the parent char-table of CHAR-TABLE.
500 The value is either nil or another char-table.
501 If CHAR-TABLE holds nil for a given character,
502 then the actual applicable value is inherited from the parent char-table
503 \(or from its parents, if necessary). */)
505 Lisp_Object char_table
;
507 CHECK_CHAR_TABLE (char_table
);
509 return XCHAR_TABLE (char_table
)->parent
;
512 DEFUN ("set-char-table-parent", Fset_char_table_parent
, Sset_char_table_parent
,
514 doc
: /* Set the parent char-table of CHAR-TABLE to PARENT.
515 Return PARENT. PARENT must be either nil or another char-table. */)
517 Lisp_Object char_table
, parent
;
521 CHECK_CHAR_TABLE (char_table
);
525 CHECK_CHAR_TABLE (parent
);
527 for (temp
= parent
; !NILP (temp
); temp
= XCHAR_TABLE (temp
)->parent
)
528 if (EQ (temp
, char_table
))
529 error ("Attempt to make a chartable be its own parent");
532 XCHAR_TABLE (char_table
)->parent
= parent
;
537 DEFUN ("char-table-extra-slot", Fchar_table_extra_slot
, Schar_table_extra_slot
,
539 doc
: /* Return the value of CHAR-TABLE's extra-slot number N. */)
541 Lisp_Object char_table
, n
;
543 CHECK_CHAR_TABLE (char_table
);
546 || XINT (n
) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table
)))
547 args_out_of_range (char_table
, n
);
549 return XCHAR_TABLE (char_table
)->extras
[XINT (n
)];
552 DEFUN ("set-char-table-extra-slot", Fset_char_table_extra_slot
,
553 Sset_char_table_extra_slot
,
555 doc
: /* Set CHAR-TABLE's extra-slot number N to VALUE. */)
556 (char_table
, n
, value
)
557 Lisp_Object char_table
, n
, value
;
559 CHECK_CHAR_TABLE (char_table
);
562 || XINT (n
) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table
)))
563 args_out_of_range (char_table
, n
);
565 return XCHAR_TABLE (char_table
)->extras
[XINT (n
)] = value
;
568 DEFUN ("char-table-range", Fchar_table_range
, Schar_table_range
,
570 doc
: /* Return the value in CHAR-TABLE for a range of characters RANGE.
571 RANGE should be nil (for the default value),
572 a cons of character codes (for characters in the range), or a character code. */)
574 Lisp_Object char_table
, range
;
577 CHECK_CHAR_TABLE (char_table
);
579 if (EQ (range
, Qnil
))
580 val
= XCHAR_TABLE (char_table
)->defalt
;
581 else if (INTEGERP (range
))
582 val
= CHAR_TABLE_REF (char_table
, XINT (range
));
583 else if (CONSP (range
))
587 CHECK_CHARACTER_CAR (range
);
588 CHECK_CHARACTER_CDR (range
);
589 val
= char_table_ref_and_range (char_table
, XINT (XCAR (range
)),
591 /* Not yet implemented. */
594 error ("Invalid RANGE argument to `char-table-range'");
598 DEFUN ("set-char-table-range", Fset_char_table_range
, Sset_char_table_range
,
600 doc
: /* Set the value in CHAR-TABLE for a range of characters RANGE to VALUE.
601 RANGE should be t (for all characters), nil (for the default value),
602 a cons of character codes (for characters in the range),
603 or a character code. Return VALUE. */)
604 (char_table
, range
, value
)
605 Lisp_Object char_table
, range
, value
;
607 CHECK_CHAR_TABLE (char_table
);
612 XCHAR_TABLE (char_table
)->ascii
= Qnil
;
613 for (i
= 0; i
< chartab_size
[0]; i
++)
614 XCHAR_TABLE (char_table
)->contents
[i
] = Qnil
;
615 XCHAR_TABLE (char_table
)->defalt
= value
;
617 else if (EQ (range
, Qnil
))
618 XCHAR_TABLE (char_table
)->defalt
= value
;
619 else if (INTEGERP (range
))
620 char_table_set (char_table
, XINT (range
), value
);
621 else if (CONSP (range
))
623 CHECK_CHARACTER_CAR (range
);
624 CHECK_CHARACTER_CDR (range
);
625 char_table_set_range (char_table
,
626 XINT (XCAR (range
)), XINT (XCDR (range
)), value
);
629 error ("Invalid RANGE argument to `set-char-table-range'");
634 DEFUN ("set-char-table-default", Fset_char_table_default
,
635 Sset_char_table_default
, 3, 3, 0,
637 This function is obsolete and has no effect. */)
638 (char_table
, ch
, value
)
639 Lisp_Object char_table
, ch
, value
;
644 /* Look up the element in TABLE at index CH, and return it as an
645 integer. If the element is not a character, return CH itself. */
648 char_table_translate (table
, ch
)
653 value
= Faref (table
, make_number (ch
));
654 if (! CHARACTERP (value
))
660 optimize_sub_char_table (table
)
663 struct Lisp_Sub_Char_Table
*tbl
= XSUB_CHAR_TABLE (table
);
664 int depth
= XINT (tbl
->depth
);
665 Lisp_Object elt
, this;
668 elt
= XSUB_CHAR_TABLE (table
)->contents
[0];
669 if (SUB_CHAR_TABLE_P (elt
))
670 elt
= XSUB_CHAR_TABLE (table
)->contents
[0] = optimize_sub_char_table (elt
);
671 if (SUB_CHAR_TABLE_P (elt
))
673 for (i
= 1; i
< chartab_size
[depth
]; i
++)
675 this = XSUB_CHAR_TABLE (table
)->contents
[i
];
676 if (SUB_CHAR_TABLE_P (this))
677 this = XSUB_CHAR_TABLE (table
)->contents
[i
]
678 = optimize_sub_char_table (this);
679 if (SUB_CHAR_TABLE_P (this)
680 || NILP (Fequal (this, elt
)))
684 return (i
< chartab_size
[depth
] ? table
: elt
);
687 DEFUN ("optimize-char-table", Foptimize_char_table
, Soptimize_char_table
,
689 doc
: /* Optimize CHAR-TABLE. */)
691 Lisp_Object char_table
;
696 CHECK_CHAR_TABLE (char_table
);
698 for (i
= 0; i
< chartab_size
[0]; i
++)
700 elt
= XCHAR_TABLE (char_table
)->contents
[i
];
701 if (SUB_CHAR_TABLE_P (elt
))
702 XCHAR_TABLE (char_table
)->contents
[i
] = optimize_sub_char_table (elt
);
708 /* Map C_FUNCTION or FUNCTION over TABLE (top or sub char-table),
709 calling it for each character or group of characters that share a
710 value. RANGE is a cons (FROM . TO) specifying the range of target
711 characters, VAL is a value of FROM in TABLE, DEFAULT_VAL is the
712 default value of the char-table, PARENT is the parent of the
715 ARG is passed to C_FUNCTION when that is called.
717 It returns the value of last character covered by TABLE (not the
718 value inheritted from the parent), and by side-effect, the car part
719 of RANGE is updated to the minimum character C where C and all the
720 following characters in TABLE have the same value. */
723 map_sub_char_table (c_function
, function
, table
, arg
, val
, range
,
725 void (*c_function
) P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
));
726 Lisp_Object function
, table
, arg
, val
, range
, default_val
, parent
;
728 /* Pointer to the elements of TABLE. */
729 Lisp_Object
*contents
;
730 /* Depth of TABLE. */
732 /* Minimum and maxinum characters covered by TABLE. */
733 int min_char
, max_char
;
734 /* Number of characters covered by one element of TABLE. */
736 int from
= XINT (XCAR (range
)), to
= XINT (XCDR (range
));
739 if (SUB_CHAR_TABLE_P (table
))
741 struct Lisp_Sub_Char_Table
*tbl
= XSUB_CHAR_TABLE (table
);
743 depth
= XINT (tbl
->depth
);
744 contents
= tbl
->contents
;
745 min_char
= XINT (tbl
->min_char
);
746 max_char
= min_char
+ chartab_chars
[depth
- 1] - 1;
751 contents
= XCHAR_TABLE (table
)->contents
;
755 chars_in_block
= chartab_chars
[depth
];
759 /* Set I to the index of the first element to check. */
760 if (from
<= min_char
)
763 i
= (from
- min_char
) / chars_in_block
;
764 for (c
= min_char
+ chars_in_block
* i
; c
<= max_char
;
765 i
++, c
+= chars_in_block
)
767 Lisp_Object
this = contents
[i
];
768 int nextc
= c
+ chars_in_block
;
770 if (SUB_CHAR_TABLE_P (this))
773 XSETCDR (range
, make_number (nextc
- 1));
774 val
= map_sub_char_table (c_function
, function
, this, arg
,
775 val
, range
, default_val
, parent
);
781 if (NILP (Fequal (val
, this)))
783 int different_value
= 1;
789 Lisp_Object temp
= XCHAR_TABLE (parent
)->parent
;
791 /* This is to get a value of FROM in PARENT
792 without checking the parent of PARENT. */
793 XCHAR_TABLE (parent
)->parent
= Qnil
;
794 val
= CHAR_TABLE_REF (parent
, from
);
795 XCHAR_TABLE (parent
)->parent
= temp
;
796 XSETCDR (range
, make_number (c
- 1));
797 val
= map_sub_char_table (c_function
, function
,
798 parent
, arg
, val
, range
,
799 XCHAR_TABLE (parent
)->defalt
,
800 XCHAR_TABLE (parent
)->parent
);
801 if (! NILP (Fequal (val
, this)))
805 if (! NILP (val
) && different_value
)
807 XSETCDR (range
, make_number (c
- 1));
809 && EQ (XCAR (range
), XCDR (range
)))
812 (*c_function
) (arg
, XCAR (range
), val
);
814 call2 (function
, XCAR (range
), val
);
819 (*c_function
) (arg
, range
, val
);
821 call2 (function
, range
, val
);
826 XSETCAR (range
, make_number (c
));
829 XSETCDR (range
, make_number (to
));
835 /* Map C_FUNCTION or FUNCTION over TABLE, calling it for each
836 character or group of characters that share a value.
838 ARG is passed to C_FUNCTION when that is called. */
841 map_char_table (c_function
, function
, table
, arg
)
842 void (*c_function
) P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
));
843 Lisp_Object function
, table
, arg
;
845 Lisp_Object range
, val
;
847 struct gcpro gcpro1
, gcpro2
, gcpro3
;
849 range
= Fcons (make_number (0), make_number (MAX_CHAR
));
850 GCPRO3 (table
, arg
, range
);
851 val
= XCHAR_TABLE (table
)->ascii
;
852 if (SUB_CHAR_TABLE_P (val
))
853 val
= XSUB_CHAR_TABLE (val
)->contents
[0];
854 val
= map_sub_char_table (c_function
, function
, table
, arg
, val
, range
,
855 XCHAR_TABLE (table
)->defalt
,
856 XCHAR_TABLE (table
)->parent
);
857 /* If VAL is nil and TABLE has a parent, we must consult the parent
859 while (NILP (val
) && ! NILP (XCHAR_TABLE (table
)->parent
))
861 Lisp_Object parent
= XCHAR_TABLE (table
)->parent
;
862 Lisp_Object temp
= XCHAR_TABLE (parent
)->parent
;
863 int from
= XINT (XCAR (range
));
865 /* This is to get a value of FROM in PARENT without checking the
867 XCHAR_TABLE (parent
)->parent
= Qnil
;
868 val
= CHAR_TABLE_REF (parent
, from
);
869 XCHAR_TABLE (parent
)->parent
= temp
;
870 val
= map_sub_char_table (c_function
, function
, parent
, arg
, val
, range
,
871 XCHAR_TABLE (parent
)->defalt
,
872 XCHAR_TABLE (parent
)->parent
);
879 (*c_function
) (arg
, range
, val
);
881 call2 (function
, range
, val
);
887 DEFUN ("map-char-table", Fmap_char_table
, Smap_char_table
,
890 Call FUNCTION for each character in CHAR-TABLE that has non-nil value.
891 FUNCTION is called with two arguments--a key and a value.
892 The key is a character code or a cons of character codes specifying a
893 range of characters that have the same value. */)
894 (function
, char_table
)
895 Lisp_Object function
, char_table
;
897 CHECK_CHAR_TABLE (char_table
);
899 map_char_table (NULL
, function
, char_table
, char_table
);
905 map_sub_char_table_for_charset (c_function
, function
, table
, arg
, range
,
907 void (*c_function
) P_ ((Lisp_Object
, Lisp_Object
));
908 Lisp_Object function
, table
, arg
, range
;
909 struct charset
*charset
;
912 struct Lisp_Sub_Char_Table
*tbl
= XSUB_CHAR_TABLE (table
);
913 int depth
= XINT (tbl
->depth
);
917 for (i
= 0, c
= XINT (tbl
->min_char
); i
< chartab_size
[depth
];
918 i
++, c
+= chartab_chars
[depth
])
922 this = tbl
->contents
[i
];
923 if (SUB_CHAR_TABLE_P (this))
924 map_sub_char_table_for_charset (c_function
, function
, this, arg
,
925 range
, charset
, from
, to
);
928 if (! NILP (XCAR (range
)))
930 XSETCDR (range
, make_number (c
- 1));
932 (*c_function
) (arg
, range
);
934 call2 (function
, range
, arg
);
936 XSETCAR (range
, Qnil
);
940 for (i
= 0, c
= XINT (tbl
->min_char
); i
< chartab_size
[depth
]; i
++, c
++)
945 this = tbl
->contents
[i
];
948 && (code
= ENCODE_CHAR (charset
, c
),
949 (code
< from
|| code
> to
))))
951 if (! NILP (XCAR (range
)))
953 XSETCDR (range
, make_number (c
- 1));
955 (*c_function
) (arg
, range
);
957 call2 (function
, range
, arg
);
958 XSETCAR (range
, Qnil
);
963 if (NILP (XCAR (range
)))
964 XSETCAR (range
, make_number (c
));
971 map_char_table_for_charset (c_function
, function
, table
, arg
,
973 void (*c_function
) P_ ((Lisp_Object
, Lisp_Object
));
974 Lisp_Object function
, table
, arg
;
975 struct charset
*charset
;
982 range
= Fcons (Qnil
, Qnil
);
985 for (i
= 0, c
= 0; i
< chartab_size
[0]; i
++, c
+= chartab_chars
[0])
989 this = XCHAR_TABLE (table
)->contents
[i
];
990 if (SUB_CHAR_TABLE_P (this))
991 map_sub_char_table_for_charset (c_function
, function
, this, arg
,
992 range
, charset
, from
, to
);
995 if (! NILP (XCAR (range
)))
997 XSETCDR (range
, make_number (c
- 1));
999 (*c_function
) (arg
, range
);
1001 call2 (function
, range
, arg
);
1003 XSETCAR (range
, Qnil
);
1006 if (! NILP (XCAR (range
)))
1008 XSETCDR (range
, make_number (c
- 1));
1010 (*c_function
) (arg
, range
);
1012 call2 (function
, range
, arg
);
1022 defsubr (&Smake_char_table
);
1023 defsubr (&Schar_table_parent
);
1024 defsubr (&Schar_table_subtype
);
1025 defsubr (&Sset_char_table_parent
);
1026 defsubr (&Schar_table_extra_slot
);
1027 defsubr (&Sset_char_table_extra_slot
);
1028 defsubr (&Schar_table_range
);
1029 defsubr (&Sset_char_table_range
);
1030 defsubr (&Sset_char_table_default
);
1031 defsubr (&Soptimize_char_table
);
1032 defsubr (&Smap_char_table
);
1035 /* arch-tag: 18b5b560-7ab5-4108-b09e-d5dd65dc6fda
1036 (do not change this comment) */