New file with information for Emacs pretesters.
[emacs.git] / src / composite.c
blob2ef8533ea687d83277e72e9ea8620b46ae9a735d
1 /* Composite sequence support.
2 Copyright (C) 1999 Electrotechnical Laboratory, JAPAN.
3 Licensed to the Free Software Foundation.
4 Copyright (C) 2001 Free Software Foundation, Inc.
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)
11 any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs; 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. */
23 #include <config.h>
24 #include "lisp.h"
25 #include "buffer.h"
26 #include "charset.h"
27 #include "intervals.h"
29 /* Emacs uses special text property `composition' to support character
30 composition. A sequence of characters that have the same (i.e. eq)
31 `composition' property value is treated as a single composite
32 sequence (we call it just `composition' here after). Characters in
33 a composition are all composed somehow on the screen.
35 The property value has this form when the composition is made:
36 ((LENGTH . COMPONENTS) . MODIFICATION-FUNC)
37 then turns to this form:
38 (COMPOSITION-ID . (LENGTH COMPONENTS-VEC . MODIFICATION-FUNC))
39 when the composition is registered in composition_hash_table and
40 composition_table. These rather peculiar structures were designed
41 to make it easy to distinguish them quickly (we can do that by
42 checking only the first element) and to extract LENGTH (from the
43 former form) and COMPOSITION-ID (from the latter form).
45 We register a composition when it is displayed, or when the width
46 is required (for instance, to calculate columns).
48 LENGTH -- Length of the composition. This information is used to
49 check the validity of the composition.
51 COMPONENTS -- Character, string, vector, list, or nil.
53 If it is nil, characters in the text are composed relatively
54 according to their metrics in font glyphs.
56 If it is a character or a string, the character or characters
57 in the string are composed relatively.
59 If it is a vector or list of integers, the element is a
60 character or an encoded composition rule. The characters are
61 composed according to the rules. (2N)th elements are
62 characters to be composed and (2N+1)th elements are
63 composition rules to tell how to compose (2N+2)th element with
64 the previously composed 2N glyphs.
66 COMPONENTS-VEC -- Vector of integers. In relative composition, the
67 elements are characters to be composed. In rule-base
68 composition, the elements are characters or encoded
69 composition rules.
71 MODIFICATION-FUNC -- If non nil, it is a function to call when the
72 composition gets invalid after a modification in a buffer. If
73 it is nil, a function in `composition-function-table' of the
74 first character in the sequence is called.
76 COMPOSITION-ID --Identification number of the composition. It is
77 used as an index to composition_table for the composition.
79 When Emacs has to display a composition or has to know its
80 displaying width, the function get_composition_id is called. It
81 returns COMPOSITION-ID so that the caller can access the
82 information about the composition through composition_table. If a
83 COMPOSITION-ID has not yet been assigned to the composition,
84 get_composition_id checks the validity of `composition' property,
85 and, if valid, assigns a new ID, registers the information in
86 composition_hash_table and composition_table, and changes the form
87 of the property value. If the property is invalid, return -1
88 without changing the property value.
90 We use two tables to keep information about composition;
91 composition_hash_table and composition_table.
93 The former is a hash table in which keys are COMPONENTS-VECs and
94 values are the corresponding COMPOSITION-IDs. This hash table is
95 weak, but as each key (COMPONENTS-VEC) is also kept as a value of
96 `composition' property, it won't be collected as garbage until all
97 text that have the same COMPONENTS-VEC are deleted.
99 The latter is a table of pointers to `struct composition' indexed
100 by COMPOSITION-ID. This structure keep the other information (see
101 composite.h).
103 In general, a text property holds information about individual
104 characters. But, a `composition' property holds information about
105 a sequence of characters (in this sense, it is like `intangible'
106 property). That means that we should not share the property value
107 in adjacent compositions we can't distinguish them if they have the
108 same property. So, after any changes, we call
109 `update_compositions' and change a property of one of adjacent
110 compositions to a copy of it. This function also runs a proper
111 composition modification function to make a composition that gets
112 invalid by the change valid again.
114 As a value of `composition' property holds information about a
115 specific range of text, the value gets invalid if we change the
116 text in the range. We treat `composition' property always
117 rear-nonsticky (currently by setting default-text-properties to
118 (rear-nonsticky (composition))) and we never make properties of
119 adjacent compositions identical. Thus, any such changes make the
120 range just shorter. So, we can check the validity of `composition'
121 property by comparing LENGTH information with the actual length of
122 the composition.
127 Lisp_Object Qcomposition;
129 /* Table of pointers to the structure `composition' indexed by
130 COMPOSITION-ID. This structure is for storing information about
131 each composition except for COMPONENTS-VEC. */
132 struct composition **composition_table;
134 /* The current size of `composition_table'. */
135 static int composition_table_size;
137 /* Number of compositions currently made. */
138 int n_compositions;
140 /* Hash table for compositions. The key is COMPONENTS-VEC of
141 `composition' property. The value is the corresponding
142 COMPOSITION-ID. */
143 Lisp_Object composition_hash_table;
145 /* Function to call to adjust composition. */
146 Lisp_Object Vcompose_chars_after_function;
148 /* Char-table of patterns and functions to make a composition. */
149 Lisp_Object Vcomposition_function_table;
150 Lisp_Object Qcomposition_function_table;
152 /* Temporary variable used in macros COMPOSITION_XXX. */
153 Lisp_Object composition_temp;
155 /* Return how many columns C will occupy on the screen. It always
156 returns 1 for control characters and 8-bit characters because those
157 are just ignored in a composition. */
158 #define CHAR_WIDTH(c) \
159 (SINGLE_BYTE_CHAR_P (c) ? 1 : CHARSET_WIDTH (CHAR_CHARSET (c)))
161 /* The following macros for hash table are copied from fns.c. */
162 /* Value is the key part of entry IDX in hash table H. */
163 #define HASH_KEY(H, IDX) AREF ((H)->key_and_value, 2 * (IDX))
164 /* Value is the value part of entry IDX in hash table H. */
165 #define HASH_VALUE(H, IDX) AREF ((H)->key_and_value, 2 * (IDX) + 1)
167 /* Return COMPOSITION-ID of a composition at buffer position
168 CHARPOS/BYTEPOS and length NCHARS. The `composition' property of
169 the sequence is PROP. STRING, if non-nil, is a string that
170 contains the composition instead of the current buffer.
172 If the composition is invalid, return -1. */
175 get_composition_id (charpos, bytepos, nchars, prop, string)
176 int charpos, bytepos, nchars;
177 Lisp_Object prop, string;
179 Lisp_Object id, length, components, key, *key_contents;
180 int glyph_len;
181 struct Lisp_Hash_Table *hash_table = XHASH_TABLE (composition_hash_table);
182 int hash_index;
183 unsigned hash_code;
184 struct composition *cmp;
185 int i, ch;
187 /* PROP should be
188 Form-A: ((LENGTH . COMPONENTS) . MODIFICATION-FUNC)
190 Form-B: (COMPOSITION-ID . (LENGTH COMPONENTS-VEC . MODIFICATION-FUNC))
192 if (nchars == 0 || !CONSP (prop))
193 goto invalid_composition;
195 id = XCAR (prop);
196 if (INTEGERP (id))
198 /* PROP should be Form-B. */
199 if (XINT (id) < 0 || XINT (id) >= n_compositions)
200 goto invalid_composition;
201 return XINT (id);
204 /* PROP should be Form-A.
205 Thus, ID should be (LENGTH . COMPONENTS). */
206 if (!CONSP (id))
207 goto invalid_composition;
208 length = XCAR (id);
209 if (!INTEGERP (length) || XINT (length) != nchars)
210 goto invalid_composition;
212 components = XCDR (id);
214 /* Check if the same composition has already been registered or not
215 by consulting composition_hash_table. The key for this table is
216 COMPONENTS (converted to a vector COMPONENTS-VEC) or, if it is
217 nil, vector of characters in the composition range. */
218 if (INTEGERP (components))
219 key = Fmake_vector (make_number (1), components);
220 else if (STRINGP (components) || CONSP (components))
221 key = Fvconcat (1, &components);
222 else if (VECTORP (components))
223 key = components;
224 else if (NILP (components))
226 key = Fmake_vector (make_number (nchars), Qnil);
227 if (STRINGP (string))
228 for (i = 0; i < nchars; i++)
230 FETCH_STRING_CHAR_ADVANCE (ch, string, charpos, bytepos);
231 XVECTOR (key)->contents[i] = make_number (ch);
233 else
234 for (i = 0; i < nchars; i++)
236 FETCH_CHAR_ADVANCE (ch, charpos, bytepos);
237 XVECTOR (key)->contents[i] = make_number (ch);
240 else
241 goto invalid_composition;
243 hash_index = hash_lookup (hash_table, key, &hash_code);
244 if (hash_index >= 0)
246 /* We have already registered the same composition. Change PROP
247 from Form-A above to Form-B while replacing COMPONENTS with
248 COMPONENTS-VEC stored in the hash table. We can directly
249 modify the cons cell of PROP because it is not shared. */
250 key = HASH_KEY (hash_table, hash_index);
251 id = HASH_VALUE (hash_table, hash_index);
252 XSETCAR (prop, id);
253 XSETCDR (prop, Fcons (make_number (nchars), Fcons (key, XCDR (prop))));
254 return XINT (id);
257 /* This composition is a new one. We must register it. */
259 /* Check if we have sufficient memory to store this information. */
260 if (composition_table_size == 0)
262 composition_table_size = 256;
263 composition_table
264 = (struct composition **) xmalloc (sizeof (composition_table[0])
265 * composition_table_size);
267 else if (composition_table_size <= n_compositions)
269 composition_table_size += 256;
270 composition_table
271 = (struct composition **) xrealloc (composition_table,
272 sizeof (composition_table[0])
273 * composition_table_size);
276 key_contents = XVECTOR (key)->contents;
278 /* Check if the contents of COMPONENTS are valid if COMPONENTS is a
279 vector or a list. It should be a sequence of:
280 char1 rule1 char2 rule2 char3 ... ruleN charN+1 */
281 if (VECTORP (components) || CONSP (components))
283 int len = XVECTOR (key)->size;
285 /* The number of elements should be odd. */
286 if ((len % 2) == 0)
287 goto invalid_composition;
288 /* All elements should be integers (character or encoded
289 composition rule). */
290 for (i = 0; i < len; i++)
292 if (!INTEGERP (key_contents[i]))
293 goto invalid_composition;
297 /* Change PROP from Form-A above to Form-B. We can directly modify
298 the cons cell of PROP because it is not shared. */
299 XSETFASTINT (id, n_compositions);
300 XSETCAR (prop, id);
301 XSETCDR (prop, Fcons (make_number (nchars), Fcons (key, XCDR (prop))));
303 /* Register the composition in composition_hash_table. */
304 hash_index = hash_put (hash_table, key, id, hash_code);
306 /* Register the composition in composition_table. */
307 cmp = (struct composition *) xmalloc (sizeof (struct composition));
309 cmp->method = (NILP (components)
310 ? COMPOSITION_RELATIVE
311 : ((INTEGERP (components) || STRINGP (components))
312 ? COMPOSITION_WITH_ALTCHARS
313 : COMPOSITION_WITH_RULE_ALTCHARS));
314 cmp->hash_index = hash_index;
315 glyph_len = (cmp->method == COMPOSITION_WITH_RULE_ALTCHARS
316 ? (XVECTOR (key)->size + 1) / 2
317 : XVECTOR (key)->size);
318 cmp->glyph_len = glyph_len;
319 cmp->offsets = (short *) xmalloc (sizeof (short) * glyph_len * 2);
320 cmp->font = NULL;
322 /* Calculate the width of overall glyphs of the composition. */
323 if (cmp->method != COMPOSITION_WITH_RULE_ALTCHARS)
325 /* Relative composition. */
326 cmp->width = 0;
327 for (i = 0; i < glyph_len; i++)
329 int this_width;
330 ch = XINT (key_contents[i]);
331 this_width = CHAR_WIDTH (ch);
332 if (cmp->width < this_width)
333 cmp->width = this_width;
336 else
338 /* Rule-base composition. */
339 float leftmost = 0.0, rightmost;
341 ch = XINT (key_contents[0]);
342 rightmost = CHAR_WIDTH (ch);
344 for (i = 1; i < glyph_len; i += 2)
346 int rule, gref, nref;
347 int this_width;
348 float this_left;
350 rule = XINT (key_contents[i]);
351 ch = XINT (key_contents[i + 1]);
352 this_width = CHAR_WIDTH (ch);
354 /* A composition rule is specified by an integer value
355 that encodes global and new reference points (GREF and
356 NREF). GREF and NREF are specified by numbers as
357 below:
358 0---1---2 -- ascent
362 9--10--11 -- center
364 ---3---4---5--- baseline
366 6---7---8 -- descent
368 COMPOSITION_DECODE_RULE (rule, gref, nref);
369 this_left = (leftmost
370 + (gref % 3) * (rightmost - leftmost) / 2.0
371 - (nref % 3) * this_width / 2.0);
373 if (this_left < leftmost)
374 leftmost = this_left;
375 if (this_left + this_width > rightmost)
376 rightmost = this_left + this_width;
379 cmp->width = rightmost - leftmost;
380 if (cmp->width < (rightmost - leftmost))
381 /* To get a ceiling integer value. */
382 cmp->width++;
385 composition_table[n_compositions] = cmp;
387 return n_compositions++;
389 invalid_composition:
390 /* Would it be better to remove this `composition' property? */
391 return -1;
395 /* Find a composition at or nearest to position POS of OBJECT (buffer
396 or string).
398 OBJECT defaults to the current buffer. If there's a composition at
399 POS, set *START and *END to the start and end of the sequence,
400 *PROP to the `composition' property, and return 1.
402 If there's no composition at POS and LIMIT is negative, return 0.
404 Otherwise, search for a composition forward (LIMIT > POS) or
405 backward (LIMIT < POS). In this case, LIMIT bounds the search.
407 If a composition is found, set *START, *END, and *PROP as above,
408 and return 1, else return 0.
410 This doesn't check the validity of composition. */
413 find_composition (pos, limit, start, end, prop, object)
414 int pos, limit, *start, *end;
415 Lisp_Object *prop, object;
417 Lisp_Object val;
419 if (get_property_and_range (pos, Qcomposition, prop, start, end, object))
420 return 1;
422 if (limit < 0 || limit == pos)
423 return 0;
425 if (limit > pos) /* search forward */
427 val = Fnext_single_property_change (make_number (pos), Qcomposition,
428 object, make_number (limit));
429 pos = XINT (val);
430 if (pos == limit)
431 return 0;
433 else /* search backward */
435 if (get_property_and_range (pos - 1, Qcomposition, prop, start, end,
436 object))
437 return 1;
438 val = Fprevious_single_property_change (make_number (pos), Qcomposition,
439 object, make_number (limit));
440 pos = XINT (val);
441 if (pos == limit)
442 return 0;
443 pos--;
445 get_property_and_range (pos, Qcomposition, prop, start, end, object);
446 return 1;
449 /* Run a proper function to adjust the composition sitting between
450 FROM and TO with property PROP. */
452 static void
453 run_composition_function (from, to, prop)
454 int from, to;
455 Lisp_Object prop;
457 Lisp_Object func;
458 int start, end;
460 func = COMPOSITION_MODIFICATION_FUNC (prop);
461 /* If an invalid composition precedes or follows, try to make them
462 valid too. */
463 if (from > BEGV
464 && find_composition (from - 1, -1, &start, &end, &prop, Qnil)
465 && !COMPOSITION_VALID_P (start, end, prop))
466 from = start;
467 if (to < ZV
468 && find_composition (to, -1, &start, &end, &prop, Qnil)
469 && !COMPOSITION_VALID_P (start, end, prop))
470 to = end;
471 if (!NILP (func))
472 call2 (func, make_number (from), make_number (to));
473 else if (!NILP (Ffboundp (Vcompose_chars_after_function)))
474 call3 (Vcompose_chars_after_function,
475 make_number (from), make_number (to), Qnil);
478 /* Make invalid compositions adjacent to or inside FROM and TO valid.
479 CHECK_MASK is bitwise `or' of mask bits defined by macros
480 CHECK_XXX (see the comment in composite.h).
482 This function is called when a buffer text is changed. If the
483 change is deletion, FROM == TO. Otherwise, FROM < TO. */
485 void
486 update_compositions (from, to, check_mask)
487 int from, to;
489 Lisp_Object prop;
490 int start, end;
492 if (inhibit_modification_hooks)
493 return;
495 /* If FROM and TO are not in a valid range, do nothing. */
496 if (! (BEGV <= from && from <= to && to <= ZV))
497 return;
499 if (check_mask & CHECK_HEAD)
501 /* FROM should be at composition boundary. But, insertion or
502 deletion will make two compositions adjacent and
503 indistinguishable when they have same (eq) property. To
504 avoid it, in such a case, we change the property of the
505 latter to the copy of it. */
506 if (from > BEGV
507 && find_composition (from - 1, -1, &start, &end, &prop, Qnil))
509 if (from < end)
510 Fput_text_property (make_number (from), make_number (end),
511 Qcomposition,
512 Fcons (XCAR (prop), XCDR (prop)), Qnil);
513 run_composition_function (start, end, prop);
514 from = end;
516 else if (from < ZV
517 && find_composition (from, -1, &start, &from, &prop, Qnil))
518 run_composition_function (start, from, prop);
521 if (check_mask & CHECK_INSIDE)
523 /* In this case, we are sure that (check & CHECK_TAIL) is also
524 nonzero. Thus, here we should check only compositions before
525 (to - 1). */
526 while (from < to - 1
527 && find_composition (from, to, &start, &from, &prop, Qnil)
528 && from < to - 1)
529 run_composition_function (start, from, prop);
532 if (check_mask & CHECK_TAIL)
534 if (from < to
535 && find_composition (to - 1, -1, &start, &end, &prop, Qnil))
537 /* TO should be also at composition boundary. But,
538 insertion or deletion will make two compositions adjacent
539 and indistinguishable when they have same (eq) property.
540 To avoid it, in such a case, we change the property of
541 the former to the copy of it. */
542 if (to < end)
543 Fput_text_property (make_number (start), make_number (to),
544 Qcomposition,
545 Fcons (XCAR (prop), XCDR (prop)), Qnil);
546 run_composition_function (start, end, prop);
548 else if (to < ZV
549 && find_composition (to, -1, &start, &end, &prop, Qnil))
550 run_composition_function (start, end, prop);
555 /* Modify composition property values in LIST destructively. LIST is
556 a list as returned from text_property_list. Change values to the
557 top-level copies of them so that none of them are `eq'. */
559 void
560 make_composition_value_copy (list)
561 Lisp_Object list;
563 Lisp_Object plist, val;
565 for (; CONSP (list); list = XCDR (list))
567 plist = XCAR (XCDR (XCDR (XCAR (list))));
568 while (CONSP (plist) && CONSP (XCDR (plist)))
570 if (EQ (XCAR (plist), Qcomposition)
571 && (val = XCAR (XCDR (plist)), CONSP (val)))
572 XSETCAR (XCDR (plist), Fcons (XCAR (val), XCDR (val)));
573 plist = XCDR (XCDR (plist));
579 /* Make text in the region between START and END a composition that
580 has COMPONENTS and MODIFICATION-FUNC.
582 If STRING is non-nil, then operate on characters contained between
583 indices START and END in STRING. */
585 void
586 compose_text (start, end, components, modification_func, string)
587 int start, end;
588 Lisp_Object components, modification_func, string;
590 Lisp_Object prop;
592 prop = Fcons (Fcons (make_number (end - start), components),
593 modification_func);
594 Fput_text_property (make_number (start), make_number (end),
595 Qcomposition, prop, string);
598 /* Compose sequences of characters in the region between START and END
599 by functions registered in Vcomposition_function_table. If STRING
600 is non-nil, operate on characters contained between indices START
601 and END in STRING. */
603 void
604 compose_chars_in_text (start, end, string)
605 int start, end;
606 Lisp_Object string;
608 int count = 0;
609 struct gcpro gcpro1;
610 Lisp_Object tail, elt, val, to;
611 /* Set to nonzero if we don't have to compose ASCII characters. */
612 int skip_ascii;
613 int i, len, stop, c;
614 unsigned char *ptr, *pend;
616 if (! CHAR_TABLE_P (Vcomposition_function_table))
617 return;
619 if (STRINGP (string))
621 count = specpdl_ptr - specpdl;
622 GCPRO1 (string);
623 stop = end;
624 ptr = XSTRING (string)->data + string_char_to_byte (string, start);
625 pend = ptr + STRING_BYTES (XSTRING (string));
627 else
629 record_unwind_protect (save_excursion_restore, save_excursion_save ());
630 TEMP_SET_PT (start);
631 stop = (start < GPT && GPT < end ? GPT : end);
632 ptr = CHAR_POS_ADDR (start);
633 pend = CHAR_POS_ADDR (end);
636 /* Preserve the match data. */
637 record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil));
639 /* If none of ASCII characters have composition functions, we can
640 skip them quickly. */
641 for (i = 0; i < 128; i++)
642 if (!NILP (CHAR_TABLE_REF (Vcomposition_function_table, i)))
643 break;
644 skip_ascii = (i == 128);
647 while (1)
649 if (skip_ascii)
650 while (start < stop && ASCII_BYTE_P (*ptr))
651 start++, ptr++;
653 if (start >= stop)
655 if (stop == end || start >= end)
656 break;
657 stop = end;
658 if (STRINGP (string))
659 ptr = XSTRING (string)->data + string_char_to_byte (string, start);
660 else
661 ptr = CHAR_POS_ADDR (start);
664 c = STRING_CHAR_AND_LENGTH (ptr, pend - ptr, len);
665 tail = CHAR_TABLE_REF (Vcomposition_function_table, c);
666 while (CONSP (tail))
668 elt = XCAR (tail);
669 if (CONSP (elt)
670 && STRINGP (XCAR (elt))
671 && !NILP (Ffboundp (XCDR (elt))))
673 if (STRINGP (string))
674 val = Fstring_match (XCAR (elt), string, make_number (start));
675 else
677 val = Flooking_at (XCAR (elt));
678 if (!NILP (val))
679 val = make_number (start);
681 if (INTEGERP (val) && XFASTINT (val) == start)
683 to = Fmatch_end (make_number (0));
684 val = call4 (XCDR (elt), val, to, XCAR (elt), string);
685 if (INTEGERP (val) && XINT (val) > 1)
687 start += XINT (val);
688 if (STRINGP (string))
689 ptr = XSTRING (string)->data + string_char_to_byte (string, start);
690 else
691 ptr = CHAR_POS_ADDR (start);
693 else
695 start++;
696 ptr += len;
698 break;
701 tail = XCDR (tail);
703 if (!CONSP (tail))
705 /* No composition done. Try the next character. */
706 start++;
707 ptr += len;
711 unbind_to (count, Qnil);
712 if (STRINGP (string))
713 UNGCPRO;
716 /* Emacs Lisp APIs. */
718 DEFUN ("compose-region-internal", Fcompose_region_internal,
719 Scompose_region_internal, 2, 4, 0,
720 doc: /* Internal use only.
722 Compose text in the region between START and END.
723 Optional 3rd and 4th arguments are COMPONENTS and MODIFICATION-FUNC
724 for the composition. See `compose-region' for more detial. */)
725 (start, end, components, mod_func)
726 Lisp_Object start, end, components, mod_func;
728 validate_region (&start, &end);
729 if (!NILP (components)
730 && !INTEGERP (components)
731 && !CONSP (components)
732 && !STRINGP (components))
733 CHECK_VECTOR (components);
735 compose_text (XINT (start), XINT (end), components, mod_func, Qnil);
736 return Qnil;
739 DEFUN ("compose-string-internal", Fcompose_string_internal,
740 Scompose_string_internal, 3, 5, 0,
741 doc: /* Internal use only.
743 Compose text between indices START and END of STRING.
744 Optional 4th and 5th arguments are COMPONENTS and MODIFICATION-FUNC
745 for the composition. See `compose-string' for more detial. */)
746 (string, start, end, components, mod_func)
747 Lisp_Object string, start, end, components, mod_func;
749 CHECK_STRING (string);
750 CHECK_NUMBER (start);
751 CHECK_NUMBER (end);
753 if (XINT (start) < 0 ||
754 XINT (start) > XINT (end)
755 || XINT (end) > XSTRING (string)->size)
756 args_out_of_range (start, end);
758 compose_text (XINT (start), XINT (end), components, mod_func, string);
759 return string;
762 DEFUN ("find-composition-internal", Ffind_composition_internal,
763 Sfind_composition_internal, 4, 4, 0,
764 doc: /* Internal use only.
766 Return information about composition at or nearest to position POS.
767 See `find-composition' for more detail. */)
768 (pos, limit, string, detail_p)
769 Lisp_Object pos, limit, string, detail_p;
771 Lisp_Object prop, tail;
772 int start, end;
773 int id;
775 CHECK_NUMBER_COERCE_MARKER (pos);
776 start = XINT (pos);
777 if (!NILP (limit))
779 CHECK_NUMBER_COERCE_MARKER (limit);
780 end = XINT (limit);
782 else
783 end = -1;
785 if (!NILP (string))
787 CHECK_STRING (string);
788 if (XINT (pos) < 0 || XINT (pos) > XSTRING (string)->size)
789 args_out_of_range (string, pos);
791 else
793 if (XINT (pos) < BEGV || XINT (pos) > ZV)
794 args_out_of_range (Fcurrent_buffer (), pos);
797 if (!find_composition (start, end, &start, &end, &prop, string))
798 return Qnil;
799 if (!COMPOSITION_VALID_P (start, end, prop))
800 return Fcons (make_number (start), Fcons (make_number (end),
801 Fcons (Qnil, Qnil)));
802 if (NILP (detail_p))
803 return Fcons (make_number (start), Fcons (make_number (end),
804 Fcons (Qt, Qnil)));
806 if (COMPOSITION_REGISTERD_P (prop))
807 id = COMPOSITION_ID (prop);
808 else
810 int start_byte = (NILP (string)
811 ? CHAR_TO_BYTE (start)
812 : string_char_to_byte (string, start));
813 id = get_composition_id (start, start_byte, end - start, prop, string);
816 if (id >= 0)
818 Lisp_Object components, relative_p, mod_func;
819 enum composition_method method = COMPOSITION_METHOD (prop);
820 int width = composition_table[id]->width;
822 components = Fcopy_sequence (COMPOSITION_COMPONENTS (prop));
823 relative_p = (method == COMPOSITION_WITH_RULE_ALTCHARS
824 ? Qnil : Qt);
825 mod_func = COMPOSITION_MODIFICATION_FUNC (prop);
826 tail = Fcons (components,
827 Fcons (relative_p,
828 Fcons (mod_func,
829 Fcons (make_number (width), Qnil))));
831 else
832 tail = Qnil;
834 return Fcons (make_number (start), Fcons (make_number (end), tail));
838 void
839 syms_of_composite ()
841 Qcomposition = intern ("composition");
842 staticpro (&Qcomposition);
844 /* Make a hash table for composition. */
846 Lisp_Object args[6];
847 extern Lisp_Object QCsize;
849 args[0] = QCtest;
850 args[1] = Qequal;
851 args[2] = QCweakness;
852 args[3] = Qnil;
853 args[4] = QCsize;
854 args[5] = make_number (311);
855 composition_hash_table = Fmake_hash_table (6, args);
856 staticpro (&composition_hash_table);
859 /* Text property `composition' should be nonsticky by default. */
860 Vtext_property_default_nonsticky
861 = Fcons (Fcons (Qcomposition, Qt), Vtext_property_default_nonsticky);
863 DEFVAR_LISP ("compose-chars-after-function", &Vcompose_chars_after_function,
864 doc: /* Function to adjust composition of buffer text.
866 The function is called with three arguments FROM, TO, and OBJECT.
867 FROM and TO specify the range of text of which composition should be
868 adjusted. OBJECT, if non-nil, is a string that contains the text.
870 This function is called after a text with `composition' property is
871 inserted or deleted to keep `composition' property of buffer text
872 valid.
874 The default value is the function `compose-chars-after'. */);
875 Vcompose_chars_after_function = intern ("compose-chars-after");
877 Qcomposition_function_table = intern ("composition-function-table");
878 staticpro (&Qcomposition_function_table);
880 /* Intern this now in case it isn't already done.
881 Setting this variable twice is harmless.
882 But don't staticpro it here--that is done in alloc.c. */
883 Qchar_table_extra_slots = intern ("char-table-extra-slots");
885 Fput (Qcomposition_function_table, Qchar_table_extra_slots, make_number (0));
887 DEFVAR_LISP ("composition-function-table", &Vcomposition_function_table,
888 doc: /* Char table of patterns and functions to make a composition.
890 Each element is nil or an alist of PATTERNs vs FUNCs, where PATTERNs
891 are regular expressions and FUNCs are functions. FUNC is responsible
892 for composing text matching the corresponding PATTERN. FUNC is called
893 with three arguments FROM, TO, and PATTERN. See the function
894 `compose-chars-after' for more detail.
896 This table is looked up by the first character of a composition when
897 the composition gets invalid after a change in a buffer. */);
898 Vcomposition_function_table
899 = Fmake_char_table (Qcomposition_function_table, Qnil);
901 defsubr (&Scompose_region_internal);
902 defsubr (&Scompose_string_internal);
903 defsubr (&Sfind_composition_internal);