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
);
709 map_sub_char_table (c_function
, function
, table
, arg
, val
, range
,
711 void (*c_function
) P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
));
712 Lisp_Object function
, table
, arg
, val
, range
, default_val
, parent
;
714 struct Lisp_Sub_Char_Table
*tbl
= XSUB_CHAR_TABLE (table
);
715 int depth
= XINT (tbl
->depth
);
718 for (i
= 0, c
= XINT (tbl
->min_char
); i
< chartab_size
[depth
];
719 i
++, c
+= chartab_chars
[depth
])
723 this = tbl
->contents
[i
];
724 if (SUB_CHAR_TABLE_P (this))
725 val
= map_sub_char_table (c_function
, function
, this, arg
, val
, range
,
726 default_val
, parent
);
731 if (NILP (this) && ! NILP (parent
))
732 this = CHAR_TABLE_REF (parent
, c
);
733 if (NILP (Fequal (val
, this)))
737 XSETCDR (range
, make_number (c
- 1));
739 && EQ (XCAR (range
), XCDR (range
)))
742 (*c_function
) (arg
, XCAR (range
), val
);
744 call2 (function
, XCAR (range
), val
);
749 (*c_function
) (arg
, range
, val
);
751 call2 (function
, range
, val
);
755 XSETCAR (range
, make_number (c
));
763 /* Map C_FUNCTION or FUNCTION over TABLE, calling it for each
764 character or group of characters that share a value.
766 ARG is passed to C_FUNCTION when that is called. */
769 map_char_table (c_function
, function
, table
, arg
)
770 void (*c_function
) P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
));
771 Lisp_Object function
, table
, arg
;
773 Lisp_Object range
, val
;
775 struct gcpro gcpro1
, gcpro2
, gcpro3
;
777 range
= Fcons (make_number (0), Qnil
);
778 GCPRO3 (table
, arg
, range
);
779 val
= XCHAR_TABLE (table
)->ascii
;
780 if (SUB_CHAR_TABLE_P (val
))
781 val
= XSUB_CHAR_TABLE (val
)->contents
[0];
783 for (i
= 0, c
= 0; i
< chartab_size
[0]; i
++, c
+= chartab_chars
[0])
787 this = XCHAR_TABLE (table
)->contents
[i
];
788 if (SUB_CHAR_TABLE_P (this))
789 val
= map_sub_char_table (c_function
, function
, this, arg
, val
, range
,
790 XCHAR_TABLE (table
)->defalt
,
791 XCHAR_TABLE (table
)->parent
);
795 this = XCHAR_TABLE (table
)->defalt
;
796 if (NILP (this) && ! NILP (XCHAR_TABLE (table
)->parent
))
797 this = CHAR_TABLE_REF (XCHAR_TABLE (table
)->parent
, c
);
798 if (NILP (Fequal (val
, this)))
802 XSETCDR (range
, make_number (c
- 1));
804 (*c_function
) (arg
, range
, val
);
806 call2 (function
, range
, val
);
809 XSETCAR (range
, make_number (c
));
816 XSETCDR (range
, make_number (c
- 1));
818 (*c_function
) (arg
, range
, val
);
820 call2 (function
, range
, val
);
826 DEFUN ("map-char-table", Fmap_char_table
, Smap_char_table
,
829 Call FUNCTION for each character in CHAR-TABLE that has non-nil value.
830 FUNCTION is called with two arguments--a key and a value.
831 The key is a character code or a cons of character codes specifying a
832 range of characters that have the same value. */)
833 (function
, char_table
)
834 Lisp_Object function
, char_table
;
836 CHECK_CHAR_TABLE (char_table
);
838 map_char_table (NULL
, function
, char_table
, char_table
);
844 map_sub_char_table_for_charset (c_function
, function
, table
, arg
, range
,
846 void (*c_function
) P_ ((Lisp_Object
, Lisp_Object
));
847 Lisp_Object function
, table
, arg
, range
;
848 struct charset
*charset
;
851 struct Lisp_Sub_Char_Table
*tbl
= XSUB_CHAR_TABLE (table
);
852 int depth
= XINT (tbl
->depth
);
856 for (i
= 0, c
= XINT (tbl
->min_char
); i
< chartab_size
[depth
];
857 i
++, c
+= chartab_chars
[depth
])
861 this = tbl
->contents
[i
];
862 if (SUB_CHAR_TABLE_P (this))
863 map_sub_char_table_for_charset (c_function
, function
, this, arg
,
864 range
, charset
, from
, to
);
867 if (! NILP (XCAR (range
)))
869 XSETCDR (range
, make_number (c
- 1));
871 (*c_function
) (arg
, range
);
873 call2 (function
, range
, arg
);
875 XSETCAR (range
, Qnil
);
879 for (i
= 0, c
= XINT (tbl
->min_char
); i
< chartab_size
[depth
]; i
++, c
++)
884 this = tbl
->contents
[i
];
887 && (code
= ENCODE_CHAR (charset
, c
),
888 (code
< from
|| code
> to
))))
890 if (! NILP (XCAR (range
)))
892 XSETCDR (range
, make_number (c
- 1));
894 (*c_function
) (arg
, range
);
896 call2 (function
, range
, arg
);
897 XSETCAR (range
, Qnil
);
902 if (NILP (XCAR (range
)))
903 XSETCAR (range
, make_number (c
));
910 map_char_table_for_charset (c_function
, function
, table
, arg
,
912 void (*c_function
) P_ ((Lisp_Object
, Lisp_Object
));
913 Lisp_Object function
, table
, arg
;
914 struct charset
*charset
;
921 range
= Fcons (Qnil
, Qnil
);
924 for (i
= 0, c
= 0; i
< chartab_size
[0]; i
++, c
+= chartab_chars
[0])
928 this = XCHAR_TABLE (table
)->contents
[i
];
929 if (SUB_CHAR_TABLE_P (this))
930 map_sub_char_table_for_charset (c_function
, function
, this, arg
,
931 range
, charset
, from
, to
);
934 if (! NILP (XCAR (range
)))
936 XSETCDR (range
, make_number (c
- 1));
938 (*c_function
) (arg
, range
);
940 call2 (function
, range
, arg
);
942 XSETCAR (range
, Qnil
);
945 if (! NILP (XCAR (range
)))
947 XSETCDR (range
, make_number (c
- 1));
949 (*c_function
) (arg
, range
);
951 call2 (function
, range
, arg
);
961 defsubr (&Smake_char_table
);
962 defsubr (&Schar_table_parent
);
963 defsubr (&Schar_table_subtype
);
964 defsubr (&Sset_char_table_parent
);
965 defsubr (&Schar_table_extra_slot
);
966 defsubr (&Sset_char_table_extra_slot
);
967 defsubr (&Schar_table_range
);
968 defsubr (&Sset_char_table_range
);
969 defsubr (&Sset_char_table_default
);
970 defsubr (&Soptimize_char_table
);
971 defsubr (&Smap_char_table
);
974 /* arch-tag: 18b5b560-7ab5-4108-b09e-d5dd65dc6fda
975 (do not change this comment) */