1 /* chartab.c -- char-table support
2 Copyright (C) 2001, 2002
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.
60 Each element is initialized to INIT, which defaults to nil.
62 Optional second argument PURPOSE, if non-nil, should be a symbol
63 which has a `char-table-extra-slots' property.
64 The property's value should be an integer between 0 and 10
65 that specify how many extra slots the char-table has.
66 By default, the char-table has no extra slot. */)
68 register Lisp_Object purpose
, init
;
75 CHECK_SYMBOL (purpose
);
78 n
= Fget (purpose
, Qchar_table_extra_slots
);
81 if (XINT (n
) < 0 || XINT (n
) > 10)
82 args_out_of_range (n
, Qnil
);
87 size
= VECSIZE (struct Lisp_Char_Table
) - 1 + n_extras
;
88 vector
= Fmake_vector (make_number (size
), init
);
89 XCHAR_TABLE (vector
)->parent
= Qnil
;
90 XCHAR_TABLE (vector
)->purpose
= purpose
;
91 XSETCHAR_TABLE (vector
, XCHAR_TABLE (vector
));
96 make_sub_char_table (depth
, min_char
, defalt
)
101 int size
= VECSIZE (struct Lisp_Sub_Char_Table
) - 1 + chartab_size
[depth
];
103 table
= Fmake_vector (make_number (size
), defalt
);
104 XSUB_CHAR_TABLE (table
)->depth
= make_number (depth
);
105 XSUB_CHAR_TABLE (table
)->min_char
= make_number (min_char
);
106 XSETSUB_CHAR_TABLE (table
, XSUB_CHAR_TABLE (table
));
112 char_table_ascii (table
)
117 sub
= XCHAR_TABLE (table
)->contents
[0];
118 sub
= XSUB_CHAR_TABLE (sub
)->contents
[0];
119 return XSUB_CHAR_TABLE (sub
)->contents
[0];
123 copy_sub_char_table (table
)
127 int depth
= XINT (XSUB_CHAR_TABLE (table
)->depth
);
128 int min_char
= XINT (XSUB_CHAR_TABLE (table
)->min_char
);
132 copy
= make_sub_char_table (depth
, min_char
, Qnil
);
133 /* Recursively copy any sub char-tables. */
134 for (i
= 0; i
< chartab_size
[depth
]; i
++)
136 val
= XSUB_CHAR_TABLE (table
)->contents
[i
];
137 if (SUB_CHAR_TABLE_P (val
))
138 XSUB_CHAR_TABLE (copy
)->contents
[i
] = copy_sub_char_table (val
);
140 XSUB_CHAR_TABLE (copy
)->contents
[i
] = val
;
148 copy_char_table (table
)
152 int size
= XCHAR_TABLE (table
)->size
& PSEUDOVECTOR_SIZE_MASK
;
155 copy
= Fmake_vector (make_number (size
), Qnil
);
156 XCHAR_TABLE (copy
)->defalt
= XCHAR_TABLE (table
)->defalt
;
157 XCHAR_TABLE (copy
)->parent
= XCHAR_TABLE (table
)->parent
;
158 XCHAR_TABLE (copy
)->purpose
= XCHAR_TABLE (table
)->purpose
;
159 XCHAR_TABLE (copy
)->ascii
= XCHAR_TABLE (table
)->ascii
;
160 for (i
= 0; i
< chartab_size
[0]; i
++)
161 XCHAR_TABLE (copy
)->contents
[i
]
162 = (SUB_CHAR_TABLE_P (XCHAR_TABLE (table
)->contents
[i
])
163 ? copy_sub_char_table (XCHAR_TABLE (table
)->contents
[i
])
164 : XCHAR_TABLE (table
)->contents
[i
]);
165 if (SUB_CHAR_TABLE_P (XCHAR_TABLE (copy
)->ascii
))
166 XCHAR_TABLE (copy
)->ascii
= char_table_ascii (copy
);
167 size
-= VECSIZE (struct Lisp_Char_Table
) - 1;
168 for (i
= 0; i
< size
; i
++)
169 XCHAR_TABLE (copy
)->extras
[i
] = XCHAR_TABLE (table
)->extras
[i
];
171 XSETCHAR_TABLE (copy
, XCHAR_TABLE (copy
));
176 sub_char_table_ref (table
, c
)
180 struct Lisp_Sub_Char_Table
*tbl
= XSUB_CHAR_TABLE (table
);
181 int depth
= XINT (tbl
->depth
);
182 int min_char
= XINT (tbl
->min_char
);
185 val
= tbl
->contents
[CHARTAB_IDX (c
, depth
, min_char
)];
186 if (SUB_CHAR_TABLE_P (val
))
187 val
= sub_char_table_ref (val
, c
);
192 char_table_ref (table
, c
)
196 struct Lisp_Char_Table
*tbl
= XCHAR_TABLE (table
);
199 if (ASCII_CHAR_P (c
))
202 if (SUB_CHAR_TABLE_P (val
))
203 val
= XSUB_CHAR_TABLE (val
)->contents
[c
];
207 val
= tbl
->contents
[CHARTAB_IDX (c
, 0, 0)];
208 if (SUB_CHAR_TABLE_P (val
))
209 val
= sub_char_table_ref (val
, c
);
214 if (NILP (val
) && CHAR_TABLE_P (tbl
->parent
))
215 val
= char_table_ref (tbl
->parent
, c
);
221 sub_char_table_ref_and_range (table
, c
, from
, to
, defalt
)
227 struct Lisp_Sub_Char_Table
*tbl
= XSUB_CHAR_TABLE (table
);
228 int depth
= XINT (tbl
->depth
);
229 int min_char
= XINT (tbl
->min_char
);
230 int max_char
= min_char
+ chartab_chars
[depth
- 1] - 1;
231 int index
= CHARTAB_IDX (c
, depth
, min_char
);
234 val
= tbl
->contents
[index
];
235 *from
= min_char
+ index
* chartab_chars
[depth
];
236 *to
= *from
+ chartab_chars
[depth
] - 1;
237 if (SUB_CHAR_TABLE_P (val
))
238 val
= sub_char_table_ref_and_range (val
, c
, from
, to
, defalt
);
242 while (*from
> min_char
243 && *from
== min_char
+ index
* chartab_chars
[depth
])
245 Lisp_Object this_val
;
246 int this_from
= *from
- chartab_chars
[depth
];
247 int this_to
= *from
- 1;
250 this_val
= tbl
->contents
[index
];
251 if (SUB_CHAR_TABLE_P (this_val
))
252 this_val
= sub_char_table_ref_and_range (this_val
, this_to
,
253 &this_from
, &this_to
,
255 else if (NILP (this_val
))
258 if (! EQ (this_val
, val
))
262 index
= CHARTAB_IDX (c
, depth
, min_char
);
263 while (*to
< max_char
264 && *to
== min_char
+ (index
+ 1) * chartab_chars
[depth
] - 1)
266 Lisp_Object this_val
;
267 int this_from
= *to
+ 1;
268 int this_to
= this_from
+ chartab_chars
[depth
] - 1;
271 this_val
= tbl
->contents
[index
];
272 if (SUB_CHAR_TABLE_P (this_val
))
273 this_val
= sub_char_table_ref_and_range (this_val
, this_from
,
274 &this_from
, &this_to
,
276 else if (NILP (this_val
))
278 if (! EQ (this_val
, val
))
287 /* Return the value for C in char-table TABLE. Set *FROM and *TO to
288 the range of characters (containing C) that have the same value as
289 C. It is not assured that the value of (*FROM - 1) and (*TO + 1)
290 is different from that of C. */
293 char_table_ref_and_range (table
, c
, from
, to
)
298 struct Lisp_Char_Table
*tbl
= XCHAR_TABLE (table
);
299 int index
= CHARTAB_IDX (c
, 0, 0);
302 val
= tbl
->contents
[index
];
303 *from
= index
* chartab_chars
[0];
304 *to
= *from
+ chartab_chars
[0] - 1;
305 if (SUB_CHAR_TABLE_P (val
))
306 val
= sub_char_table_ref_and_range (val
, c
, from
, to
, tbl
->defalt
);
310 while (*from
> 0 && *from
== index
* chartab_chars
[0])
312 Lisp_Object this_val
;
313 int this_from
= *from
- chartab_chars
[0];
314 int this_to
= *from
- 1;
317 this_val
= tbl
->contents
[index
];
318 if (SUB_CHAR_TABLE_P (this_val
))
319 this_val
= sub_char_table_ref_and_range (this_val
, this_to
,
320 &this_from
, &this_to
,
322 else if (NILP (this_val
))
323 this_val
= tbl
->defalt
;
325 if (! EQ (this_val
, val
))
329 while (*to
< MAX_CHAR
&& *to
== (index
+ 1) * chartab_chars
[0] - 1)
331 Lisp_Object this_val
;
332 int this_from
= *to
+ 1;
333 int this_to
= this_from
+ chartab_chars
[0] - 1;
336 this_val
= tbl
->contents
[index
];
337 if (SUB_CHAR_TABLE_P (this_val
))
338 this_val
= sub_char_table_ref_and_range (this_val
, this_from
,
339 &this_from
, &this_to
,
341 else if (NILP (this_val
))
342 this_val
= tbl
->defalt
;
343 if (! EQ (this_val
, val
))
352 #define ASET_RANGE(ARRAY, FROM, TO, LIMIT, VAL) \
354 int limit = (TO) < (LIMIT) ? (TO) : (LIMIT); \
355 for (; (FROM) < limit; (FROM)++) (ARRAY)->contents[(FROM)] = (VAL); \
358 #define GET_SUB_CHAR_TABLE(TABLE, SUBTABLE, IDX, DEPTH, MIN_CHAR) \
360 (SUBTABLE) = (TABLE)->contents[(IDX)]; \
361 if (!SUB_CHAR_TABLE_P (SUBTABLE)) \
362 (SUBTABLE) = make_sub_char_table ((DEPTH), (MIN_CHAR), (SUBTABLE)); \
367 sub_char_table_set (table
, c
, val
)
372 struct Lisp_Sub_Char_Table
*tbl
= XSUB_CHAR_TABLE (table
);
373 int depth
= XINT ((tbl
)->depth
);
374 int min_char
= XINT ((tbl
)->min_char
);
375 int i
= CHARTAB_IDX (c
, depth
, min_char
);
379 tbl
->contents
[i
] = val
;
382 sub
= tbl
->contents
[i
];
383 if (! SUB_CHAR_TABLE_P (sub
))
385 sub
= make_sub_char_table (depth
+ 1,
386 min_char
+ i
* chartab_chars
[depth
], sub
);
387 tbl
->contents
[i
] = sub
;
389 sub_char_table_set (sub
, c
, val
);
394 char_table_set (table
, c
, val
)
399 struct Lisp_Char_Table
*tbl
= XCHAR_TABLE (table
);
402 && SUB_CHAR_TABLE_P (tbl
->ascii
))
404 XSUB_CHAR_TABLE (tbl
->ascii
)->contents
[c
] = val
;
408 int i
= CHARTAB_IDX (c
, 0, 0);
411 sub
= tbl
->contents
[i
];
412 if (! SUB_CHAR_TABLE_P (sub
))
414 sub
= make_sub_char_table (1, i
* chartab_chars
[0], sub
);
415 tbl
->contents
[i
] = sub
;
417 sub_char_table_set (sub
, c
, val
);
418 if (ASCII_CHAR_P (c
))
419 tbl
->ascii
= char_table_ascii (tbl
);
425 sub_char_table_set_range (table
, depth
, min_char
, from
, to
, val
)
432 int max_char
= min_char
+ chartab_chars
[depth
] - 1;
434 if (depth
== 3 || from
<= min_char
&& to
>= max_char
)
441 if (! SUB_CHAR_TABLE_P (*table
))
442 *table
= make_sub_char_table (depth
, min_char
, *table
);
447 i
= CHARTAB_IDX (from
, depth
, min_char
);
448 j
= CHARTAB_IDX (to
, depth
, min_char
);
449 min_char
+= chartab_chars
[depth
] * i
;
450 for (; i
<= j
; i
++, min_char
+= chartab_chars
[depth
])
451 sub_char_table_set_range (XSUB_CHAR_TABLE (*table
)->contents
+ i
,
452 depth
, min_char
, from
, to
, val
);
458 char_table_set_range (table
, from
, to
, val
)
463 struct Lisp_Char_Table
*tbl
= XCHAR_TABLE (table
);
464 Lisp_Object
*contents
= tbl
->contents
;
468 char_table_set (table
, from
, val
);
471 for (i
= CHARTAB_IDX (from
, 0, 0), min_char
= i
* chartab_chars
[0];
473 i
++, min_char
+= chartab_chars
[0])
474 sub_char_table_set_range (contents
+ i
, 0, min_char
, from
, to
, val
);
475 if (ASCII_CHAR_P (from
))
476 tbl
->ascii
= char_table_ascii (tbl
);
482 DEFUN ("char-table-subtype", Fchar_table_subtype
, Schar_table_subtype
,
485 Return the subtype of char-table CHAR-TABLE. The value is a symbol. */)
487 Lisp_Object char_table
;
489 CHECK_CHAR_TABLE (char_table
);
491 return XCHAR_TABLE (char_table
)->purpose
;
494 DEFUN ("char-table-parent", Fchar_table_parent
, Schar_table_parent
,
496 doc
: /* Return the parent char-table of CHAR-TABLE.
497 The value is either nil or another char-table.
498 If CHAR-TABLE holds nil for a given character,
499 then the actual applicable value is inherited from the parent char-table
500 \(or from its parents, if necessary). */)
502 Lisp_Object char_table
;
504 CHECK_CHAR_TABLE (char_table
);
506 return XCHAR_TABLE (char_table
)->parent
;
509 DEFUN ("set-char-table-parent", Fset_char_table_parent
, Sset_char_table_parent
,
511 doc
: /* Set the parent char-table of CHAR-TABLE to PARENT.
512 PARENT must be either nil or another char-table. */)
514 Lisp_Object char_table
, parent
;
518 CHECK_CHAR_TABLE (char_table
);
522 CHECK_CHAR_TABLE (parent
);
524 for (temp
= parent
; !NILP (temp
); temp
= XCHAR_TABLE (temp
)->parent
)
525 if (EQ (temp
, char_table
))
526 error ("Attempt to make a chartable be its own parent");
529 XCHAR_TABLE (char_table
)->parent
= parent
;
534 DEFUN ("char-table-extra-slot", Fchar_table_extra_slot
, Schar_table_extra_slot
,
536 doc
: /* Return the value of CHAR-TABLE's extra-slot number N. */)
538 Lisp_Object char_table
, n
;
540 CHECK_CHAR_TABLE (char_table
);
543 || XINT (n
) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table
)))
544 args_out_of_range (char_table
, n
);
546 return XCHAR_TABLE (char_table
)->extras
[XINT (n
)];
549 DEFUN ("set-char-table-extra-slot", Fset_char_table_extra_slot
,
550 Sset_char_table_extra_slot
,
552 doc
: /* Set CHAR-TABLE's extra-slot number N to VALUE. */)
553 (char_table
, n
, value
)
554 Lisp_Object char_table
, n
, value
;
556 CHECK_CHAR_TABLE (char_table
);
559 || XINT (n
) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table
)))
560 args_out_of_range (char_table
, n
);
562 return XCHAR_TABLE (char_table
)->extras
[XINT (n
)] = value
;
565 DEFUN ("char-table-range", Fchar_table_range
, Schar_table_range
,
567 doc
: /* Return the value in CHAR-TABLE for a range of characters RANGE.
568 RANGE should be nil (for the default value),
569 a cons of character codes (for characters in the range), or a character code. */)
571 Lisp_Object char_table
, range
;
574 CHECK_CHAR_TABLE (char_table
);
576 if (EQ (range
, Qnil
))
577 val
= XCHAR_TABLE (char_table
)->defalt
;
578 else if (INTEGERP (range
))
579 val
= CHAR_TABLE_REF (char_table
, XINT (range
));
580 else if (CONSP (range
))
584 CHECK_CHARACTER (XCAR (range
));
585 CHECK_CHARACTER (XCDR (range
));
586 val
= char_table_ref_and_range (char_table
, XINT (XCAR (range
)),
588 /* Not yet implemented. */
591 error ("Invalid RANGE argument to `char-table-range'");
595 DEFUN ("set-char-table-range", Fset_char_table_range
, Sset_char_table_range
,
598 Set the value in CHAR-TABLE for characters specified by 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), or a character code. */)
601 (char_table
, range
, value
)
602 Lisp_Object char_table
, range
, value
;
604 CHECK_CHAR_TABLE (char_table
);
609 XCHAR_TABLE (char_table
)->ascii
= Qnil
;
610 for (i
= 0; i
< chartab_size
[0]; i
++)
611 XCHAR_TABLE (char_table
)->contents
[i
] = Qnil
;
612 XCHAR_TABLE (char_table
)->defalt
= 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 (XCAR (range
));
621 CHECK_CHARACTER (XCDR (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 nil, return CH itself. (Actually we do
643 that for any non-integer.) */
646 char_table_translate (table
, ch
)
651 value
= Faref (table
, make_number (ch
));
652 if (! INTEGERP (value
)) /* fixme: use CHARACTERP? */
658 optimize_sub_char_table (table
)
661 struct Lisp_Sub_Char_Table
*tbl
= XSUB_CHAR_TABLE (table
);
662 int depth
= XINT (tbl
->depth
);
663 Lisp_Object elt
, this;
666 elt
= XSUB_CHAR_TABLE (table
)->contents
[0];
667 if (SUB_CHAR_TABLE_P (elt
))
668 elt
= XSUB_CHAR_TABLE (table
)->contents
[0] = optimize_sub_char_table (elt
);
669 if (SUB_CHAR_TABLE_P (elt
))
671 for (i
= 1; i
< chartab_size
[depth
]; i
++)
673 this = XSUB_CHAR_TABLE (table
)->contents
[i
];
674 if (SUB_CHAR_TABLE_P (this))
675 this = XSUB_CHAR_TABLE (table
)->contents
[i
]
676 = optimize_sub_char_table (this);
677 if (SUB_CHAR_TABLE_P (this)
678 || NILP (Fequal (this, elt
)))
682 return (i
< chartab_size
[depth
] ? table
: elt
);
685 DEFUN ("optimize-char-table", Foptimize_char_table
, Soptimize_char_table
,
687 doc
: /* Optimize CHAR-TABLE. */)
689 Lisp_Object char_table
;
694 CHECK_CHAR_TABLE (char_table
);
696 for (i
= 0; i
< chartab_size
[0]; i
++)
698 elt
= XCHAR_TABLE (char_table
)->contents
[i
];
699 if (SUB_CHAR_TABLE_P (elt
))
700 XCHAR_TABLE (char_table
)->contents
[i
] = optimize_sub_char_table (elt
);
707 map_sub_char_table (c_function
, function
, table
, arg
, val
, range
)
708 void (*c_function
) P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
));
709 Lisp_Object function
, table
, arg
, val
, range
;
711 struct Lisp_Sub_Char_Table
*tbl
= XSUB_CHAR_TABLE (table
);
712 int depth
= XINT (tbl
->depth
);
715 for (i
= 0, c
= XINT (tbl
->min_char
); i
< chartab_size
[depth
];
716 i
++, c
+= chartab_chars
[depth
])
720 this = tbl
->contents
[i
];
721 if (SUB_CHAR_TABLE_P (this))
722 val
= map_sub_char_table (c_function
, function
, this, arg
, val
, range
);
723 else if (NILP (Fequal (val
, this)))
727 XCDR (range
) = make_number (c
- 1);
729 && EQ (XCAR (range
), XCDR (range
)))
732 (*c_function
) (arg
, XCAR (range
), val
);
734 call2 (function
, XCAR (range
), val
);
739 (*c_function
) (arg
, range
, val
);
741 call2 (function
, range
, val
);
745 XCAR (range
) = make_number (c
);
752 /* Map C_FUNCTION or FUNCTION over TABLE, calling it for each
753 character or group of characters that share a value.
755 ARG is passed to C_FUNCTION when that is called.
757 DEPTH and INDICES are ignored. They are removed in the new
761 map_char_table (c_function
, function
, table
, arg
, depth
, indices
)
762 void (*c_function
) P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
));
763 Lisp_Object function
, table
, arg
, *indices
;
766 Lisp_Object range
, val
;
769 range
= Fcons (make_number (0), Qnil
);
770 val
= char_table_ref (table
, 0);
772 for (i
= 0, c
= 0; i
< chartab_size
[0]; i
++, c
+= chartab_chars
[0])
776 this = XCHAR_TABLE (table
)->contents
[i
];
777 if (SUB_CHAR_TABLE_P (this))
778 val
= map_sub_char_table (c_function
, function
, this, arg
, val
, range
);
779 else if (NILP (Fequal (val
, this)))
783 XCDR (range
) = make_number (c
- 1);
785 (*c_function
) (arg
, range
, val
);
787 call2 (function
, range
, val
);
790 XCAR (range
) = make_number (c
);
795 DEFUN ("map-char-table", Fmap_char_table
, Smap_char_table
,
798 Call FUNCTION for each character in CHAR-TABLE.
799 FUNCTION is called with two arguments--a key and a value.
800 The key is always a possible IDX argument to `aref'. */)
801 (function
, char_table
)
802 Lisp_Object function
, char_table
;
804 CHECK_CHAR_TABLE (char_table
);
806 map_char_table (NULL
, function
, char_table
, char_table
, 0, NULL
);
812 map_sub_char_table_for_charset (c_function
, function
, table
, arg
, range
,
814 void (*c_function
) P_ ((Lisp_Object
, Lisp_Object
));
815 Lisp_Object function
, table
, arg
, range
;
816 struct charset
*charset
;
819 struct Lisp_Sub_Char_Table
*tbl
= XSUB_CHAR_TABLE (table
);
820 int depth
= XINT (tbl
->depth
);
824 for (i
= 0, c
= XINT (tbl
->min_char
); i
< chartab_size
[depth
];
825 i
++, c
+= chartab_chars
[depth
])
829 this = tbl
->contents
[i
];
830 if (SUB_CHAR_TABLE_P (this))
831 map_sub_char_table_for_charset (c_function
, function
, this, arg
,
832 range
, charset
, from
, to
);
835 if (! NILP (XCAR (range
)))
837 XSETCDR (range
, make_number (c
- 1));
839 (*c_function
) (arg
, range
);
841 call2 (function
, range
, arg
);
843 XSETCAR (range
, Qnil
);
847 for (i
= 0, c
= XINT (tbl
->min_char
); i
< chartab_size
[depth
]; i
++, c
++)
852 this = tbl
->contents
[i
];
855 && (code
= ENCODE_CHAR (charset
, c
),
856 (code
< from
|| code
> to
))))
858 if (! NILP (XCAR (range
)))
860 XSETCDR (range
, make_number (c
- 1));
862 (*c_function
) (range
, arg
);
864 call2 (function
, range
, arg
);
865 XSETCAR (range
, Qnil
);
870 if (NILP (XCAR (range
)))
871 XSETCAR (range
, make_number (c
));
878 map_char_table_for_charset (c_function
, function
, table
, arg
,
880 void (*c_function
) P_ ((Lisp_Object
, Lisp_Object
));
881 Lisp_Object function
, table
, arg
;
882 struct charset
*charset
;
888 if (NILP (char_table_ref (table
, 0)))
889 range
= Fcons (Qnil
, Qnil
);
891 range
= Fcons (make_number (0), make_number (0));
893 for (i
= 0, c
= 0; i
< chartab_size
[0]; i
++, c
+= chartab_chars
[0])
897 this = XCHAR_TABLE (table
)->contents
[i
];
898 if (SUB_CHAR_TABLE_P (this))
899 map_sub_char_table_for_charset (c_function
, function
, this, arg
,
900 range
, charset
, from
, to
);
903 if (! NILP (XCAR (range
)))
905 XSETCDR (range
, make_number (c
- 1));
907 (*c_function
) (arg
, range
);
909 call2 (function
, range
, arg
);
911 XSETCAR (range
, Qnil
);
914 if (! NILP (XCAR (range
)))
916 XSETCDR (range
, make_number (c
- 1));
918 (*c_function
) (arg
, range
);
920 call2 (function
, range
, arg
);
928 make_class_table (purpose
)
936 args
[2] = QCextra_slots
;
937 args
[3] = Fmake_vector (make_number (2), Qnil
);
938 ASET (args
[3], 0, Fmakehash (Qequal
));
939 table
= Fmake_char_table (4, args
);
944 modify_class_entry (c
, val
, table
, set
)
946 Lisp_Object val
, table
, set
;
948 Lisp_Object classes
, hash
, canon
;
951 hash
= XCHAR_TABLE (table
)->extras
[0];
952 classes
= CHAR_TABLE_REF (table
, c
);
954 if (! BOOL_VECTOR_P (classes
))
955 classes
= (NILP (set
)
957 : Fmake_bool_vector (make_number ((ival
/ 8) * 8 + 8), Qnil
));
958 else if (ival
< XBOOL_VECTOR (classes
)->size
)
962 classes
= Fmake_bool_vector (make_number ((ival
/ 8) * 8 + 8), Qnil
);
963 for (i
= 0; i
< XBOOL_VECTOR (classes
)->size
; i
++)
964 Faset (classes
, make_number (i
), Faref (old
, make_number (i
)));
965 Faset (classes
, val
, set
);
967 else if (NILP (Faref (classes
, val
)) != NILP (set
))
969 classes
= Fcopy_sequence (classes
);
970 Faset (classes
, val
, set
);
977 canon
= Fgethash (classes
, hash
, Qnil
);
981 Fputhash (canon
, canon
, hash
);
983 char_table_set (table
, c
, canon
);
994 defsubr (&Smake_char_table
);
995 defsubr (&Schar_table_parent
);
996 defsubr (&Schar_table_subtype
);
997 defsubr (&Sset_char_table_parent
);
998 defsubr (&Schar_table_extra_slot
);
999 defsubr (&Sset_char_table_extra_slot
);
1000 defsubr (&Schar_table_range
);
1001 defsubr (&Sset_char_table_range
);
1002 defsubr (&Sset_char_table_default
);
1003 defsubr (&Soptimize_char_table
);
1004 defsubr (&Smap_char_table
);