|
17052
|
1 /* GNU Emacs routines to deal with category tables.
|
|
18341
|
2 Copyright (C) 1995, 1997 Electrotechnical Laboratory, JAPAN.
|
|
|
3 Licensed to the Free Software Foundation.
|
|
17052
|
4
|
|
|
5 This file is part of GNU Emacs.
|
|
|
6
|
|
|
7 GNU Emacs is free software; you can redistribute it and/or modify
|
|
|
8 it under the terms of the GNU General Public License as published by
|
|
|
9 the Free Software Foundation; either version 2, or (at your option)
|
|
|
10 any later version.
|
|
|
11
|
|
|
12 GNU Emacs is distributed in the hope that it will be useful,
|
|
|
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
15 GNU General Public License for more details.
|
|
|
16
|
|
|
17 You should have received a copy of the GNU General Public License
|
|
|
18 along with GNU Emacs; see the file COPYING. If not, write to
|
|
17071
|
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
20 Boston, MA 02111-1307, USA. */
|
|
17052
|
21
|
|
|
22
|
|
|
23 /* Here we handle three objects: category, category set, and category
|
|
|
24 table. Read comments in the file category.h to understand them. */
|
|
|
25
|
|
|
26 #include <config.h>
|
|
|
27 #include <ctype.h>
|
|
|
28 #include "lisp.h"
|
|
|
29 #include "buffer.h"
|
|
|
30 #include "charset.h"
|
|
|
31 #include "category.h"
|
|
39748
|
32 #include "keymap.h"
|
|
17052
|
33
|
|
|
34 /* The version number of the latest category table. Each category
|
|
|
35 table has a unique version number. It is assigned a new number
|
|
|
36 also when it is modified. When a regular expression is compiled
|
|
|
37 into the struct re_pattern_buffer, the version number of the
|
|
|
38 category table (of the current buffer) at that moment is also
|
|
|
39 embedded in the structure.
|
|
|
40
|
|
|
41 For the moment, we are not using this feature. */
|
|
|
42 static int category_table_version;
|
|
|
43
|
|
|
44 Lisp_Object Qcategory_table, Qcategoryp, Qcategorysetp, Qcategory_table_p;
|
|
|
45
|
|
|
46 /* Variables to determine word boundary. */
|
|
|
47 Lisp_Object Vword_combining_categories, Vword_separating_categories;
|
|
|
48
|
|
|
49 /* Temporary internal variable used in macro CHAR_HAS_CATEGORY. */
|
|
|
50 Lisp_Object _temp_category_set;
|
|
|
51
|
|
|
52
|
|
|
53 /* Category set staff. */
|
|
|
54
|
|
|
55 DEFUN ("make-category-set", Fmake_category_set, Smake_category_set, 1, 1, 0,
|
|
40103
|
56 doc: /* Return a newly created category-set which contains CATEGORIES.
|
|
|
57 CATEGORIES is a string of category mnemonics.
|
|
|
58 The value is a bool-vector which has t at the indices corresponding to
|
|
|
59 those categories. */)
|
|
|
60 (categories)
|
|
17052
|
61 Lisp_Object categories;
|
|
|
62 {
|
|
|
63 Lisp_Object val;
|
|
|
64 int len;
|
|
|
65
|
|
40656
|
66 CHECK_STRING (categories);
|
|
17052
|
67 val = MAKE_CATEGORY_SET;
|
|
|
68
|
|
20612
|
69 if (STRING_MULTIBYTE (categories))
|
|
63694
|
70 error ("Multibyte string in `make-category-set'");
|
|
20612
|
71
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
72 len = SCHARS (categories);
|
|
17052
|
73 while (--len >= 0)
|
|
|
74 {
|
|
17369
|
75 Lisp_Object category;
|
|
17052
|
76
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
77 XSETFASTINT (category, SREF (categories, len));
|
|
40656
|
78 CHECK_CATEGORY (category);
|
|
17052
|
79 SET_CATEGORY_SET (val, category, Qt);
|
|
|
80 }
|
|
|
81 return val;
|
|
|
82 }
|
|
|
83
|
|
|
84
|
|
|
85 /* Category staff. */
|
|
|
86
|
|
|
87 Lisp_Object check_category_table ();
|
|
|
88
|
|
|
89 DEFUN ("define-category", Fdefine_category, Sdefine_category, 2, 3, 0,
|
|
54091
|
90 doc: /* Define CATEGORY as a category which is described by DOCSTRING.
|
|
|
91 CATEGORY should be an ASCII printing character in the range ` ' to `~'.
|
|
|
92 DOCSTRING is the documentation string of the category.
|
|
40103
|
93 The category is defined only in category table TABLE, which defaults to
|
|
54091
|
94 the current buffer's category table. */)
|
|
40103
|
95 (category, docstring, table)
|
|
17052
|
96 Lisp_Object category, docstring, table;
|
|
|
97 {
|
|
40656
|
98 CHECK_CATEGORY (category);
|
|
|
99 CHECK_STRING (docstring);
|
|
17052
|
100 table = check_category_table (table);
|
|
|
101
|
|
|
102 if (!NILP (CATEGORY_DOCSTRING (table, XFASTINT (category))))
|
|
|
103 error ("Category `%c' is already defined", XFASTINT (category));
|
|
|
104 CATEGORY_DOCSTRING (table, XFASTINT (category)) = docstring;
|
|
|
105
|
|
|
106 return Qnil;
|
|
|
107 }
|
|
|
108
|
|
|
109 DEFUN ("category-docstring", Fcategory_docstring, Scategory_docstring, 1, 2, 0,
|
|
54091
|
110 doc: /* Return the documentation string of CATEGORY, as defined in TABLE.
|
|
|
111 TABLE should be a category table and defaults to the current buffer's
|
|
|
112 category table. */)
|
|
40103
|
113 (category, table)
|
|
17052
|
114 Lisp_Object category, table;
|
|
|
115 {
|
|
40656
|
116 CHECK_CATEGORY (category);
|
|
17052
|
117 table = check_category_table (table);
|
|
|
118
|
|
|
119 return CATEGORY_DOCSTRING (table, XFASTINT (category));
|
|
|
120 }
|
|
|
121
|
|
|
122 DEFUN ("get-unused-category", Fget_unused_category, Sget_unused_category,
|
|
|
123 0, 1, 0,
|
|
54091
|
124 doc: /* Return a category which is not yet defined in TABLE.
|
|
41038
|
125 If no category remains available, return nil.
|
|
54091
|
126 The optional argument TABLE specifies which category table to modify;
|
|
41038
|
127 it defaults to the current buffer's category table. */)
|
|
40103
|
128 (table)
|
|
17052
|
129 Lisp_Object table;
|
|
|
130 {
|
|
|
131 int i;
|
|
|
132
|
|
|
133 table = check_category_table (table);
|
|
|
134
|
|
|
135 for (i = ' '; i <= '~'; i++)
|
|
|
136 if (NILP (CATEGORY_DOCSTRING (table, i)))
|
|
|
137 return make_number (i);
|
|
|
138
|
|
|
139 return Qnil;
|
|
|
140 }
|
|
|
141
|
|
|
142
|
|
|
143 /* Category-table staff. */
|
|
|
144
|
|
|
145 DEFUN ("category-table-p", Fcategory_table_p, Scategory_table_p, 1, 1, 0,
|
|
40103
|
146 doc: /* Return t if ARG is a category table. */)
|
|
|
147 (arg)
|
|
17052
|
148 Lisp_Object arg;
|
|
|
149 {
|
|
|
150 if (CHAR_TABLE_P (arg)
|
|
17324
|
151 && EQ (XCHAR_TABLE (arg)->purpose, Qcategory_table))
|
|
17052
|
152 return Qt;
|
|
|
153 return Qnil;
|
|
|
154 }
|
|
|
155
|
|
|
156 /* If TABLE is nil, return the current category table. If TABLE is
|
|
|
157 not nil, check the validity of TABLE as a category table. If
|
|
|
158 valid, return TABLE itself, but if not valid, signal an error of
|
|
|
159 wrong-type-argument. */
|
|
|
160
|
|
|
161 Lisp_Object
|
|
|
162 check_category_table (table)
|
|
|
163 Lisp_Object table;
|
|
|
164 {
|
|
|
165 register Lisp_Object tem;
|
|
|
166 if (NILP (table))
|
|
|
167 return current_buffer->category_table;
|
|
|
168 while (tem = Fcategory_table_p (table), NILP (tem))
|
|
|
169 table = wrong_type_argument (Qcategory_table_p, table);
|
|
|
170 return table;
|
|
49600
|
171 }
|
|
17052
|
172
|
|
|
173 DEFUN ("category-table", Fcategory_table, Scategory_table, 0, 0, 0,
|
|
40103
|
174 doc: /* Return the current category table.
|
|
|
175 This is the one specified by the current buffer. */)
|
|
|
176 ()
|
|
17052
|
177 {
|
|
|
178 return current_buffer->category_table;
|
|
|
179 }
|
|
|
180
|
|
|
181 DEFUN ("standard-category-table", Fstandard_category_table,
|
|
|
182 Sstandard_category_table, 0, 0, 0,
|
|
40103
|
183 doc: /* Return the standard category table.
|
|
|
184 This is the one used for new buffers. */)
|
|
|
185 ()
|
|
17052
|
186 {
|
|
|
187 return Vstandard_category_table;
|
|
|
188 }
|
|
|
189
|
|
|
190 /* Return a copy of category table TABLE. We can't simply use the
|
|
|
191 function copy-sequence because no contents should be shared between
|
|
17324
|
192 the original and the copy. This function is called recursively by
|
|
20189
|
193 binding TABLE to a sub char table. */
|
|
17052
|
194
|
|
|
195 Lisp_Object
|
|
17324
|
196 copy_category_table (table)
|
|
17052
|
197 Lisp_Object table;
|
|
|
198 {
|
|
17324
|
199 Lisp_Object tmp;
|
|
|
200 int i, to;
|
|
17052
|
201
|
|
17324
|
202 if (!NILP (XCHAR_TABLE (table)->top))
|
|
17052
|
203 {
|
|
17324
|
204 /* TABLE is a top level char table.
|
|
|
205 At first, make a copy of tree structure of the table. */
|
|
|
206 table = Fcopy_sequence (table);
|
|
17052
|
207
|
|
17324
|
208 /* Then, copy elements for single byte characters one by one. */
|
|
|
209 for (i = 0; i < CHAR_TABLE_SINGLE_BYTE_SLOTS; i++)
|
|
|
210 if (!NILP (tmp = XCHAR_TABLE (table)->contents[i]))
|
|
|
211 XCHAR_TABLE (table)->contents[i] = Fcopy_sequence (tmp);
|
|
|
212 to = CHAR_TABLE_ORDINARY_SLOTS;
|
|
20189
|
213
|
|
|
214 /* Also copy the first (and sole) extra slot. It is a vector
|
|
|
215 containing docstring of each category. */
|
|
|
216 Fset_char_table_extra_slot
|
|
|
217 (table, make_number (0),
|
|
|
218 Fcopy_sequence (Fchar_table_extra_slot (table, make_number (0))));
|
|
17324
|
219 }
|
|
|
220 else
|
|
|
221 {
|
|
|
222 i = 32;
|
|
|
223 to = SUB_CHAR_TABLE_ORDINARY_SLOTS;
|
|
17052
|
224 }
|
|
|
225
|
|
17324
|
226 /* If the table has non-nil default value, copy it. */
|
|
|
227 if (!NILP (tmp = XCHAR_TABLE (table)->defalt))
|
|
|
228 XCHAR_TABLE (table)->defalt = Fcopy_sequence (tmp);
|
|
|
229
|
|
|
230 /* At last, copy the remaining elements while paying attention to a
|
|
|
231 sub char table. */
|
|
|
232 for (; i < to; i++)
|
|
|
233 if (!NILP (tmp = XCHAR_TABLE (table)->contents[i]))
|
|
|
234 XCHAR_TABLE (table)->contents[i]
|
|
|
235 = (SUB_CHAR_TABLE_P (tmp)
|
|
|
236 ? copy_category_table (tmp) : Fcopy_sequence (tmp));
|
|
|
237
|
|
17052
|
238 return table;
|
|
|
239 }
|
|
|
240
|
|
|
241 DEFUN ("copy-category-table", Fcopy_category_table, Scopy_category_table,
|
|
|
242 0, 1, 0,
|
|
40103
|
243 doc: /* Construct a new category table and return it.
|
|
|
244 It is a copy of the TABLE, which defaults to the standard category table. */)
|
|
|
245 (table)
|
|
17052
|
246 Lisp_Object table;
|
|
|
247 {
|
|
|
248 if (!NILP (table))
|
|
|
249 check_category_table (table);
|
|
|
250 else
|
|
|
251 table = Vstandard_category_table;
|
|
|
252
|
|
20189
|
253 return copy_category_table (table);
|
|
17052
|
254 }
|
|
|
255
|
|
26841
|
256 DEFUN ("make-category-table", Fmake_category_table, Smake_category_table,
|
|
|
257 0, 0, 0,
|
|
40103
|
258 doc: /* Construct a new and empty category table and return it. */)
|
|
|
259 ()
|
|
26841
|
260 {
|
|
|
261 Lisp_Object val;
|
|
|
262
|
|
|
263 val = Fmake_char_table (Qcategory_table, Qnil);
|
|
|
264 XCHAR_TABLE (val)->defalt = MAKE_CATEGORY_SET;
|
|
|
265 Fset_char_table_extra_slot (val, make_number (0),
|
|
|
266 Fmake_vector (make_number (95), Qnil));
|
|
|
267 return val;
|
|
|
268 }
|
|
|
269
|
|
17052
|
270 DEFUN ("set-category-table", Fset_category_table, Sset_category_table, 1, 1, 0,
|
|
54091
|
271 doc: /* Specify TABLE as the category table for the current buffer.
|
|
|
272 Return TABLE. */)
|
|
40103
|
273 (table)
|
|
17052
|
274 Lisp_Object table;
|
|
|
275 {
|
|
28315
|
276 int idx;
|
|
17052
|
277 table = check_category_table (table);
|
|
|
278 current_buffer->category_table = table;
|
|
|
279 /* Indicate that this buffer now has a specified category table. */
|
|
28351
|
280 idx = PER_BUFFER_VAR_IDX (category_table);
|
|
|
281 SET_PER_BUFFER_VALUE_P (current_buffer, idx, 1);
|
|
17052
|
282 return table;
|
|
|
283 }
|
|
|
284
|
|
|
285
|
|
|
286 DEFUN ("char-category-set", Fchar_category_set, Schar_category_set, 1, 1, 0,
|
|
40103
|
287 doc: /* Return the category set of CHAR. */)
|
|
|
288 (ch)
|
|
17052
|
289 Lisp_Object ch;
|
|
|
290 {
|
|
40656
|
291 CHECK_NUMBER (ch);
|
|
17052
|
292 return CATEGORY_SET (XFASTINT (ch));
|
|
|
293 }
|
|
|
294
|
|
|
295 DEFUN ("category-set-mnemonics", Fcategory_set_mnemonics,
|
|
|
296 Scategory_set_mnemonics, 1, 1, 0,
|
|
40103
|
297 doc: /* Return a string containing mnemonics of the categories in CATEGORY-SET.
|
|
|
298 CATEGORY-SET is a bool-vector, and the categories \"in\" it are those
|
|
54091
|
299 that are indexes where t occurs in the bool-vector.
|
|
40103
|
300 The return value is a string containing those same categories. */)
|
|
|
301 (category_set)
|
|
17052
|
302 Lisp_Object category_set;
|
|
|
303 {
|
|
|
304 int i, j;
|
|
|
305 char str[96];
|
|
|
306
|
|
40656
|
307 CHECK_CATEGORY_SET (category_set);
|
|
17052
|
308
|
|
|
309 j = 0;
|
|
|
310 for (i = 32; i < 127; i++)
|
|
|
311 if (CATEGORY_MEMBER (i, category_set))
|
|
|
312 str[j++] = i;
|
|
|
313 str[j] = '\0';
|
|
|
314
|
|
|
315 return build_string (str);
|
|
|
316 }
|
|
|
317
|
|
17324
|
318 /* Modify all category sets stored under sub char-table TABLE so that
|
|
17052
|
319 they contain (SET_VALUE is t) or don't contain (SET_VALUE is nil)
|
|
|
320 CATEGORY. */
|
|
|
321
|
|
|
322 void
|
|
|
323 modify_lower_category_set (table, category, set_value)
|
|
|
324 Lisp_Object table, category, set_value;
|
|
|
325 {
|
|
|
326 Lisp_Object val;
|
|
|
327 int i;
|
|
|
328
|
|
25835
|
329 val = XCHAR_TABLE (table)->defalt;
|
|
|
330 if (!CATEGORY_SET_P (val))
|
|
|
331 val = MAKE_CATEGORY_SET;
|
|
|
332 SET_CATEGORY_SET (val, category, set_value);
|
|
|
333 XCHAR_TABLE (table)->defalt = val;
|
|
17052
|
334
|
|
17324
|
335 for (i = 32; i < SUB_CHAR_TABLE_ORDINARY_SLOTS; i++)
|
|
17052
|
336 {
|
|
|
337 val = XCHAR_TABLE (table)->contents[i];
|
|
|
338
|
|
|
339 if (CATEGORY_SET_P (val))
|
|
|
340 SET_CATEGORY_SET (val, category, set_value);
|
|
17324
|
341 else if (SUB_CHAR_TABLE_P (val))
|
|
17052
|
342 modify_lower_category_set (val, category, set_value);
|
|
|
343 }
|
|
|
344 }
|
|
|
345
|
|
|
346 void
|
|
|
347 set_category_set (category_set, category, val)
|
|
|
348 Lisp_Object category_set, category, val;
|
|
|
349 {
|
|
|
350 do {
|
|
|
351 int idx = XINT (category) / 8;
|
|
|
352 unsigned char bits = 1 << (XINT (category) % 8);
|
|
|
353
|
|
|
354 if (NILP (val))
|
|
|
355 XCATEGORY_SET (category_set)->data[idx] &= ~bits;
|
|
|
356 else
|
|
|
357 XCATEGORY_SET (category_set)->data[idx] |= bits;
|
|
|
358 } while (0);
|
|
|
359 }
|
|
|
360
|
|
|
361 DEFUN ("modify-category-entry", Fmodify_category_entry,
|
|
|
362 Smodify_category_entry, 2, 4, 0,
|
|
40103
|
363 doc: /* Modify the category set of CHARACTER by adding CATEGORY to it.
|
|
|
364 The category is changed only for table TABLE, which defaults to
|
|
|
365 the current buffer's category table.
|
|
|
366 If optional fourth argument RESET is non-nil,
|
|
|
367 then delete CATEGORY from the category set instead of adding it. */)
|
|
|
368 (character, category, table, reset)
|
|
20825
|
369 Lisp_Object character, category, table, reset;
|
|
17052
|
370 {
|
|
|
371 int c, charset, c1, c2;
|
|
|
372 Lisp_Object set_value; /* Actual value to be set in category sets. */
|
|
|
373 Lisp_Object val, category_set;
|
|
|
374
|
|
40656
|
375 CHECK_NUMBER (character);
|
|
20825
|
376 c = XINT (character);
|
|
40656
|
377 CHECK_CATEGORY (category);
|
|
17052
|
378 table = check_category_table (table);
|
|
|
379
|
|
|
380 if (NILP (CATEGORY_DOCSTRING (table, XFASTINT (category))))
|
|
|
381 error ("Undefined category: %c", XFASTINT (category));
|
|
49600
|
382
|
|
17052
|
383 set_value = NILP (reset) ? Qt : Qnil;
|
|
|
384
|
|
17324
|
385 if (c < CHAR_TABLE_SINGLE_BYTE_SLOTS)
|
|
17052
|
386 {
|
|
|
387 val = XCHAR_TABLE (table)->contents[c];
|
|
|
388 if (!CATEGORY_SET_P (val))
|
|
|
389 XCHAR_TABLE (table)->contents[c] = (val = MAKE_CATEGORY_SET);
|
|
|
390 SET_CATEGORY_SET (val, category, set_value);
|
|
|
391 return Qnil;
|
|
|
392 }
|
|
|
393
|
|
29001
|
394 SPLIT_CHAR (c, charset, c1, c2);
|
|
17052
|
395
|
|
|
396 /* The top level table. */
|
|
17187
|
397 val = XCHAR_TABLE (table)->contents[charset + 128];
|
|
17324
|
398 if (CATEGORY_SET_P (val))
|
|
|
399 category_set = val;
|
|
|
400 else if (!SUB_CHAR_TABLE_P (val))
|
|
17052
|
401 {
|
|
17324
|
402 category_set = val = MAKE_CATEGORY_SET;
|
|
17187
|
403 XCHAR_TABLE (table)->contents[charset + 128] = category_set;
|
|
17052
|
404 }
|
|
|
405
|
|
17324
|
406 if (c1 <= 0)
|
|
17052
|
407 {
|
|
|
408 /* Only a charset is specified. */
|
|
17324
|
409 if (SUB_CHAR_TABLE_P (val))
|
|
|
410 /* All characters in CHARSET should be the same as for having
|
|
|
411 CATEGORY or not. */
|
|
17052
|
412 modify_lower_category_set (val, category, set_value);
|
|
|
413 else
|
|
|
414 SET_CATEGORY_SET (category_set, category, set_value);
|
|
|
415 return Qnil;
|
|
|
416 }
|
|
|
417
|
|
|
418 /* The second level table. */
|
|
17324
|
419 if (!SUB_CHAR_TABLE_P (val))
|
|
17052
|
420 {
|
|
17324
|
421 val = make_sub_char_table (Qnil);
|
|
17187
|
422 XCHAR_TABLE (table)->contents[charset + 128] = val;
|
|
17052
|
423 /* We must set default category set of CHARSET in `defalt' slot. */
|
|
|
424 XCHAR_TABLE (val)->defalt = category_set;
|
|
|
425 }
|
|
|
426 table = val;
|
|
|
427
|
|
|
428 val = XCHAR_TABLE (table)->contents[c1];
|
|
17324
|
429 if (CATEGORY_SET_P (val))
|
|
|
430 category_set = val;
|
|
|
431 else if (!SUB_CHAR_TABLE_P (val))
|
|
17052
|
432 {
|
|
17324
|
433 category_set = val = Fcopy_sequence (XCHAR_TABLE (table)->defalt);
|
|
17052
|
434 XCHAR_TABLE (table)->contents[c1] = category_set;
|
|
|
435 }
|
|
|
436
|
|
17324
|
437 if (c2 <= 0)
|
|
17052
|
438 {
|
|
17324
|
439 if (SUB_CHAR_TABLE_P (val))
|
|
17052
|
440 /* All characters in C1 group of CHARSET should be the same as
|
|
|
441 for CATEGORY. */
|
|
|
442 modify_lower_category_set (val, category, set_value);
|
|
|
443 else
|
|
|
444 SET_CATEGORY_SET (category_set, category, set_value);
|
|
|
445 return Qnil;
|
|
|
446 }
|
|
|
447
|
|
|
448 /* The third (bottom) level table. */
|
|
17324
|
449 if (!SUB_CHAR_TABLE_P (val))
|
|
17052
|
450 {
|
17459
22fc94ab9e79
(Fmodify_category_entry): Delete second arg in call to make_sub_char_table.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
451 val = make_sub_char_table (Qnil);
|
|
17052
|
452 XCHAR_TABLE (table)->contents[c1] = val;
|
|
|
453 /* We must set default category set of CHARSET and C1 in
|
|
|
454 `defalt' slot. */
|
|
|
455 XCHAR_TABLE (val)->defalt = category_set;
|
|
|
456 }
|
|
|
457 table = val;
|
|
|
458
|
|
|
459 val = XCHAR_TABLE (table)->contents[c2];
|
|
17324
|
460 if (CATEGORY_SET_P (val))
|
|
|
461 category_set = val;
|
|
|
462 else if (!SUB_CHAR_TABLE_P (val))
|
|
17052
|
463 {
|
|
|
464 category_set = Fcopy_sequence (XCHAR_TABLE (table)->defalt);
|
|
|
465 XCHAR_TABLE (table)->contents[c2] = category_set;
|
|
|
466 }
|
|
|
467 else
|
|
|
468 /* This should never happen. */
|
|
|
469 error ("Invalid category table");
|
|
|
470
|
|
|
471 SET_CATEGORY_SET (category_set, category, set_value);
|
|
|
472
|
|
|
473 return Qnil;
|
|
|
474 }
|
|
|
475
|
|
|
476 /* Return 1 if there is a word boundary between two word-constituent
|
|
|
477 characters C1 and C2 if they appear in this order, else return 0.
|
|
|
478 Use the macro WORD_BOUNDARY_P instead of calling this function
|
|
|
479 directly. */
|
|
|
480
|
|
|
481 int
|
|
|
482 word_boundary_p (c1, c2)
|
|
|
483 int c1, c2;
|
|
|
484 {
|
|
|
485 Lisp_Object category_set1, category_set2;
|
|
|
486 Lisp_Object tail;
|
|
|
487 int default_result;
|
|
|
488
|
|
|
489 if (CHAR_CHARSET (c1) == CHAR_CHARSET (c2))
|
|
|
490 {
|
|
|
491 tail = Vword_separating_categories;
|
|
|
492 default_result = 0;
|
|
|
493 }
|
|
|
494 else
|
|
|
495 {
|
|
|
496 tail = Vword_combining_categories;
|
|
|
497 default_result = 1;
|
|
|
498 }
|
|
|
499
|
|
|
500 category_set1 = CATEGORY_SET (c1);
|
|
|
501 if (NILP (category_set1))
|
|
|
502 return default_result;
|
|
|
503 category_set2 = CATEGORY_SET (c2);
|
|
|
504 if (NILP (category_set2))
|
|
|
505 return default_result;
|
|
|
506
|
25662
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
507 for (; CONSP (tail); tail = XCDR (tail))
|
|
17052
|
508 {
|
25662
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
509 Lisp_Object elt = XCAR (tail);
|
|
17052
|
510
|
|
|
511 if (CONSP (elt)
|
25662
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
512 && CATEGORYP (XCAR (elt))
|
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
513 && CATEGORYP (XCDR (elt))
|
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
514 && CATEGORY_MEMBER (XFASTINT (XCAR (elt)), category_set1)
|
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
515 && CATEGORY_MEMBER (XFASTINT (XCDR (elt)), category_set2))
|
|
17052
|
516 return !default_result;
|
|
|
517 }
|
|
|
518 return default_result;
|
|
|
519 }
|
|
|
520
|
|
|
521
|
|
21514
|
522 void
|
|
17052
|
523 init_category_once ()
|
|
|
524 {
|
|
|
525 /* This has to be done here, before we call Fmake_char_table. */
|
|
|
526 Qcategory_table = intern ("category-table");
|
|
|
527 staticpro (&Qcategory_table);
|
|
|
528
|
|
|
529 /* Intern this now in case it isn't already done.
|
|
|
530 Setting this variable twice is harmless.
|
|
|
531 But don't staticpro it here--that is done in alloc.c. */
|
|
|
532 Qchar_table_extra_slots = intern ("char-table-extra-slots");
|
|
|
533
|
|
|
534 /* Now we are ready to set up this property, so we can
|
|
|
535 create category tables. */
|
|
|
536 Fput (Qcategory_table, Qchar_table_extra_slots, make_number (2));
|
|
|
537
|
|
|
538 Vstandard_category_table = Fmake_char_table (Qcategory_table, Qnil);
|
|
49600
|
539 /* Set a category set which contains nothing to the default. */
|
|
17052
|
540 XCHAR_TABLE (Vstandard_category_table)->defalt = MAKE_CATEGORY_SET;
|
|
20189
|
541 Fset_char_table_extra_slot (Vstandard_category_table, make_number (0),
|
|
17052
|
542 Fmake_vector (make_number (95), Qnil));
|
|
|
543 }
|
|
|
544
|
|
21514
|
545 void
|
|
17052
|
546 syms_of_category ()
|
|
|
547 {
|
|
|
548 Qcategoryp = intern ("categoryp");
|
|
|
549 staticpro (&Qcategoryp);
|
|
|
550 Qcategorysetp = intern ("categorysetp");
|
|
|
551 staticpro (&Qcategorysetp);
|
|
|
552 Qcategory_table_p = intern ("category-table-p");
|
|
|
553 staticpro (&Qcategory_table_p);
|
|
|
554
|
|
|
555 DEFVAR_LISP ("word-combining-categories", &Vword_combining_categories,
|
|
40103
|
556 doc: /* List of pair (cons) of categories to determine word boundary.
|
|
|
557
|
|
|
558 Emacs treats a sequence of word constituent characters as a single
|
|
|
559 word (i.e. finds no word boundary between them) iff they belongs to
|
|
|
560 the same charset. But, exceptions are allowed in the following cases.
|
|
|
561
|
|
|
562 \(1) The case that characters are in different charsets is controlled
|
|
|
563 by the variable `word-combining-categories'.
|
|
|
564
|
|
|
565 Emacs finds no word boundary between characters of different charsets
|
|
|
566 if they have categories matching some element of this list.
|
|
|
567
|
|
|
568 More precisely, if an element of this list is a cons of category CAT1
|
|
|
569 and CAT2, and a multibyte character C1 which has CAT1 is followed by
|
|
|
570 C2 which has CAT2, there's no word boundary between C1 and C2.
|
|
|
571
|
|
|
572 For instance, to tell that ASCII characters and Latin-1 characters can
|
|
|
573 form a single word, the element `(?l . ?l)' should be in this list
|
|
|
574 because both characters have the category `l' (Latin characters).
|
|
|
575
|
|
|
576 \(2) The case that character are in the same charset is controlled by
|
|
|
577 the variable `word-separating-categories'.
|
|
|
578
|
|
|
579 Emacs find a word boundary between characters of the same charset
|
|
|
580 if they have categories matching some element of this list.
|
|
|
581
|
|
|
582 More precisely, if an element of this list is a cons of category CAT1
|
|
|
583 and CAT2, and a multibyte character C1 which has CAT1 is followed by
|
|
|
584 C2 which has CAT2, there's a word boundary between C1 and C2.
|
|
|
585
|
|
|
586 For instance, to tell that there's a word boundary between Japanese
|
|
|
587 Hiragana and Japanese Kanji (both are in the same charset), the
|
|
|
588 element `(?H . ?C) should be in this list. */);
|
|
17052
|
589
|
|
|
590 Vword_combining_categories = Qnil;
|
|
|
591
|
|
|
592 DEFVAR_LISP ("word-separating-categories", &Vword_separating_categories,
|
|
40103
|
593 doc: /* List of pair (cons) of categories to determine word boundary.
|
|
|
594 See the documentation of the variable `word-combining-categories'. */);
|
|
17052
|
595
|
|
|
596 Vword_separating_categories = Qnil;
|
|
|
597
|
|
|
598 defsubr (&Smake_category_set);
|
|
|
599 defsubr (&Sdefine_category);
|
|
|
600 defsubr (&Scategory_docstring);
|
|
|
601 defsubr (&Sget_unused_category);
|
|
|
602 defsubr (&Scategory_table_p);
|
|
|
603 defsubr (&Scategory_table);
|
|
|
604 defsubr (&Sstandard_category_table);
|
|
|
605 defsubr (&Scopy_category_table);
|
|
26841
|
606 defsubr (&Smake_category_table);
|
|
17052
|
607 defsubr (&Sset_category_table);
|
|
|
608 defsubr (&Schar_category_set);
|
|
|
609 defsubr (&Scategory_set_mnemonics);
|
|
|
610 defsubr (&Smodify_category_entry);
|
|
|
611
|
|
|
612 category_table_version = 0;
|
|
|
613 }
|
|
52401
|
614
|
|
|
615 /* arch-tag: 74ebf524-121b-4d9c-bd68-07f8d708b211
|
|
|
616 (do not change this comment) */
|
