(cvs-enabledp): Ignore errors.
[emacs.git] / src / composite.c
blob3379d594d281d54c5dd7f433dbebdc1d79f606d6
1 /* Composite sequence support.
2 Copyright (C) 1999 Electrotechnical Laboratory, JAPAN.
3 Licensed to the Free Software Foundation.
5 This file is part of GNU Emacs.
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.
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.
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
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
22 #include <config.h>
23 #include "lisp.h"
24 #include "buffer.h"
25 #include "charset.h"
26 #include "intervals.h"
28 /* Emacs uses special text property `composition' to support character
29 composition. A sequence of characters that have the same (i.e. eq)
30 `composition' property value is treated as a single composite
31 sequence (we call it just `composition' here after). Characters in
32 a composition are all composed somehow on the screen.
34 The property value has this form when the composition is made:
35 ((LENGTH . COMPONENTS) . MODIFICATION-FUNC)
36 then turns to this form:
37 (COMPOSITION-ID . (LENGTH COMPONENTS-VEC . MODIFICATION-FUNC))
38 when the composition is registered in composition_hash_table and
39 composition_table. These rather peculiar structures were designed
40 to make it easy to distinguish them quickly (we can do that by
41 checking only the first element) and to extract LENGTH (from the
42 former form) and COMPOSITION-ID (from the latter form).
44 We register a composition when it is displayed, or when the width
45 is required (for instance, to calculate columns).
47 LENGTH -- Length of the composition. This information is used to
48 check the validity of the composition.
50 COMPONENTS -- Character, string, vector, list, or nil.
52 If it is nil, characters in the text are composed relatively
53 according to their metrics in font glyphs.
55 If it is a character or a string, the character or characters
56 in the string are composed relatively.
58 If it is a vector or list of integers, the element is a
59 character or an encoded composition rule. The characters are
60 composed according to the rules. (2N)th elements are
61 characters to be composed and (2N+1)th elements are
62 composition rules to tell how to compose (2N+2)th element with
63 the previously composed 2N glyphs.
65 COMPONENTS-VEC -- Vector of integers. In relative composition, the
66 elements are characters to be composed. In rule-base
67 composition, the elements are characters or encoded
68 composition rules.
70 MODIFICATION-FUNC -- If non nil, it is a function to call when the
71 composition gets invalid after a modification in a buffer. If
72 it is nil, a function in `composition-function-table' of the
73 first character in the sequence is called.
75 COMPOSITION-ID --Identification number of the composition. It is
76 used as an index to composition_table for the composition.
78 When Emacs has to display a composition or has to know its
79 displaying width, the function get_composition_id is called. It
80 returns COMPOSITION-ID so that the caller can access the
81 information about the composition through composition_table. If a
82 COMPOSITION-ID has not yet been assigned to the composition,
83 get_composition_id checks the validity of `composition' property,
84 and, if valid, assigns a new ID, registers the information in
85 composition_hash_table and composition_table, and changes the form
86 of the property value. If the property is invalid, return -1
87 without changing the property value.
89 We use two tables to keep information about composition;
90 composition_hash_table and composition_table.
92 The former is a hash table in which keys are COMPONENTS-VECs and
93 values are the corresponding COMPOSITION-IDs. This hash table is
94 weak, but as each key (COMPONENTS-VEC) is also kept as a value of
95 `composition' property, it won't be collected as garbage until all
96 text that have the same COMPONENTS-VEC are deleted.
98 The latter is a table of pointers to `struct composition' indexed
99 by COMPOSITION-ID. This structure keep the other information (see
100 composite.h).
102 In general, a text property holds information about individual
103 characters. But, a `composition' property holds information about
104 a sequence of characters (in this sense, it is like `intangible'
105 property). That means that we should not share the property value
106 in adjacent compositions we can't distinguish them if they have the
107 same property. So, after any changes, we call
108 `update_compositions' and change a property of one of adjacent
109 compositions to a copy of it. This function also runs a proper
110 composition modification function to make a composition that gets
111 invalid by the change valid again.
113 As a value of `composition' property holds information about a
114 specific range of text, the value gets invalid if we change the
115 text in the range. We treat `composition' property always
116 rear-nonsticky (currently by setting default-text-properties to
117 (rear-nonsticky (composition))) and we never make properties of
118 adjacent compositions identical. Thus, any such changes make the
119 range just shorter. So, we can check the validity of `composition'
120 property by comparing LENGTH information with the actual length of
121 the composition.
126 Lisp_Object Qcomposition;
128 /* Table of pointers to the structure `composition' indexed by
129 COMPOSITION-ID. This structure is for storing information about
130 each composition except for COMPONENTS-VEC. */
131 struct composition **composition_table;
133 /* The current size of `composition_table'. */
134 static int composition_table_size;
136 /* Number of compositions currently made. */
137 int n_compositions;
139 /* Hash table for compositions. The key is COMPONENTS-VEC of
140 `composition' property. The value is the corresponding
141 COMPOSITION-ID. */
142 Lisp_Object composition_hash_table;
144 /* Function to call to adjust composition. */
145 Lisp_Object Vcompose_chars_after_function;
147 /* Char-table of patterns and functions to make a composition. */
148 Lisp_Object Vcomposition_function_table;
149 Lisp_Object Qcomposition_function_table;
151 /* Temporary variable used in macros COMPOSITION_XXX. */
152 Lisp_Object composition_temp;
154 /* Return how many columns C will occupy on the screen. It always
155 returns 1 for control characters and 8-bit characters because those
156 are just ignored in a composition. */
157 #define CHAR_WIDTH(c) \
158 (SINGLE_BYTE_CHAR_P (c) ? 1 : CHARSET_WIDTH (CHAR_CHARSET (c)))
160 /* The following macros for hash table are copied from fns.c. */
161 /* Value is the key part of entry IDX in hash table H. */
162 #define HASH_KEY(H, IDX) AREF ((H)->key_and_value, 2 * (IDX))
163 /* Value is the value part of entry IDX in hash table H. */
164 #define HASH_VALUE(H, IDX) AREF ((H)->key_and_value, 2 * (IDX) + 1)
166 /* Return COMPOSITION-ID of a composition at buffer position
167 CHARPOS/BYTEPOS and length NCHARS. The `composition' property of
168 the sequence is PROP. STRING, if non-nil, is a string that
169 contains the composition instead of the current buffer.
171 If the composition is invalid, return -1. */
174 get_composition_id (charpos, bytepos, nchars, prop, string)
175 int charpos, bytepos, nchars;
176 Lisp_Object prop, string;
178 Lisp_Object id, length, components, key, *key_contents;
179 int glyph_len;
180 struct Lisp_Hash_Table *hash_table = XHASH_TABLE (composition_hash_table);
181 int hash_index;
182 unsigned hash_code;
183 struct composition *cmp;
184 int i, ch;
186 /* PROP should be
187 Form-A: ((LENGTH . COMPONENTS) . MODIFICATION-FUNC)
189 Form-B: (COMPOSITION-ID . (LENGTH COMPONENTS-VEC . MODIFICATION-FUNC))
191 if (nchars == 0 || !CONSP (prop))
192 goto invalid_composition;
194 id = XCAR (prop);
195 if (INTEGERP (id))
197 /* PROP should be Form-B. */
198 if (XINT (id) < 0 || XINT (id) >= n_compositions)
199 goto invalid_composition;
200 return XINT (id);
203 /* PROP should be Form-A.
204 Thus, ID should be (LENGTH . COMPONENTS). */
205 if (!CONSP (id))
206 goto invalid_composition;
207 length = XCAR (id);
208 if (!INTEGERP (length) || XINT (length) != nchars)
209 goto invalid_composition;
211 components = XCDR (id);
213 /* Check if the same composition has already been registered or not
214 by consulting composition_hash_table. The key for this table is
215 COMPONENTS (converted to a vector COMPONENTS-VEC) or, if it is
216 nil, vector of characters in the composition range. */
217 if (INTEGERP (components))
218 key = Fmake_vector (make_number (1), components);
219 else if (STRINGP (components) || CONSP (components))
220 key = Fvconcat (1, &components);
221 else if (VECTORP (components))
222 key = components;
223 else if (NILP (components))
225 key = Fmake_vector (make_number (nchars), Qnil);
226 if (STRINGP (string))
227 for (i = 0; i < nchars; i++)
229 FETCH_STRING_CHAR_ADVANCE (ch, string, charpos, bytepos);
230 XVECTOR (key)->contents[i] = make_number (ch);
232 else
233 for (i = 0; i < nchars; i++)
235 FETCH_CHAR_ADVANCE (ch, charpos, bytepos);
236 XVECTOR (key)->contents[i] = make_number (ch);
239 else
240 goto invalid_composition;
242 hash_index = hash_lookup (hash_table, key, &hash_code);
243 if (hash_index >= 0)
245 /* We have already registered the same composition. Change PROP
246 from Form-A above to Form-B while replacing COMPONENTS with
247 COMPONENTS-VEC stored in the hash table. We can directly
248 modify the cons cell of PROP because it is not shared. */
249 key = HASH_KEY (hash_table, hash_index);
250 id = HASH_VALUE (hash_table, hash_index);
251 XCAR (prop) = id;
252 XCDR (prop) = Fcons (make_number (nchars), Fcons (key, XCDR (prop)));
253 return XINT (id);
256 /* This composition is a new one. We must register it. */
258 /* Check if we have sufficient memory to store this information. */
259 if (composition_table_size == 0)
261 composition_table_size = 256;
262 composition_table
263 = (struct composition **) xmalloc (sizeof (composition_table[0])
264 * composition_table_size);
266 else if (composition_table_size <= n_compositions)
268 composition_table_size += 256;
269 composition_table
270 = (struct composition **) xrealloc (composition_table,
271 sizeof (composition_table[0])
272 * composition_table_size);
275 key_contents = XVECTOR (key)->contents;
277 /* Check if the contents of COMPONENTS are valid if COMPONENTS is a
278 vector or a list. It should be a sequence of:
279 char1 rule1 char2 rule2 char3 ... ruleN charN+1 */
280 if (VECTORP (components) || CONSP (components))
282 int len = XVECTOR (key)->size;
284 /* The number of elements should be odd. */
285 if ((len % 2) == 0)
286 goto invalid_composition;
287 /* All elements should be integers (character or encoded
288 composition rule). */
289 for (i = 0; i < len; i++)
291 if (!INTEGERP (key_contents[i]))
292 goto invalid_composition;
296 /* Change PROP from Form-A above to Form-B. We can directly modify
297 the cons cell of PROP because it is not shared. */
298 XSETFASTINT (id, n_compositions);
299 XCAR (prop) = id;
300 XCDR (prop) = Fcons (make_number (nchars), Fcons (key, XCDR (prop)));
302 /* Register the composition in composition_hash_table. */
303 hash_index = hash_put (hash_table, key, id, hash_code);
305 /* Register the composition in composition_table. */
306 cmp = (struct composition *) xmalloc (sizeof (struct composition));
308 cmp->method = (NILP (components)
309 ? COMPOSITION_RELATIVE
310 : ((INTEGERP (components) || STRINGP (components))
311 ? COMPOSITION_WITH_ALTCHARS
312 : COMPOSITION_WITH_RULE_ALTCHARS));
313 cmp->hash_index = hash_index;
314 glyph_len = (cmp->method == COMPOSITION_WITH_RULE_ALTCHARS
315 ? (XVECTOR (key)->size + 1) / 2
316 : XVECTOR (key)->size);
317 cmp->glyph_len = glyph_len;
318 cmp->offsets = (short *) xmalloc (sizeof (short) * glyph_len * 2);
319 cmp->font = NULL;
321 /* Calculate the width of overall glyphs of the composition. */
322 if (cmp->method != COMPOSITION_WITH_RULE_ALTCHARS)
324 /* Relative composition. */
325 cmp->width = 0;
326 for (i = 0; i < glyph_len; i++)
328 int this_width;
329 ch = XINT (key_contents[i]);
330 this_width = CHAR_WIDTH (ch);
331 if (cmp->width < this_width)
332 cmp->width = this_width;
335 else
337 /* Rule-base composition. */
338 float leftmost = 0.0, rightmost;
340 ch = XINT (key_contents[0]);
341 rightmost = CHAR_WIDTH (ch);
343 for (i = 1; i < glyph_len; i += 2)
345 int rule, gref, nref;
346 int this_width;
347 float this_left;
349 rule = XINT (key_contents[i]);
350 ch = XINT (key_contents[i + 1]);
351 this_width = CHAR_WIDTH (ch);
353 /* A composition rule is specified by an integer value
354 that encodes global and new reference points (GREF and
355 NREF). GREF and NREF are specified by numbers as
356 below:
357 0---1---2 -- ascent
361 9--10--11 -- center
363 ---3---4---5--- baseline
365 6---7---8 -- descent
367 COMPOSITION_DECODE_RULE (rule, gref, nref);
368 this_left = (leftmost
369 + (gref % 3) * (rightmost - leftmost) / 2.0
370 - (nref % 3) * this_width / 2.0);
372 if (this_left < leftmost)
373 leftmost = this_left;
374 if (this_left + this_width > rightmost)
375 rightmost = this_left + this_width;
378 cmp->width = rightmost - leftmost;
379 if (cmp->width < (rightmost - leftmost))
380 /* To get a ceiling integer value. */
381 cmp->width++;
384 composition_table[n_compositions] = cmp;
386 return n_compositions++;
388 invalid_composition:
389 /* Would it be better to remove this `composition' property? */
390 return -1;
394 /* Find a composition at or nearest to position POS of OBJECT (buffer
395 or string).
397 OBJECT defaults to the current buffer. If there's a composition at
398 POS, set *START and *END to the start and end of the sequence,
399 *PROP to the `composition' property, and return 1.
401 If there's no composition at POS and LIMIT is negative, return 0.
403 Otherwise, search for a composition forward (LIMIT > POS) or
404 backward (LIMIT < POS). In this case, LIMIT bounds the search.
406 If a composition is found, set *START, *END, and *PROP as above,
407 and return 1, else return 0.
409 This doesn't check the validity of composition. */
412 find_composition (pos, limit, start, end, prop, object)
413 int pos, limit, *start, *end;
414 Lisp_Object *prop, object;
416 Lisp_Object val;
418 if (get_property_and_range (pos, Qcomposition, prop, start, end, object))
419 return 1;
421 if (limit < 0 || limit == pos)
422 return 0;
424 if (limit > pos) /* search forward */
425 val = Fnext_single_property_change (make_number (pos), Qcomposition,
426 object, make_number (limit));
427 else /* search backward */
428 val = Fprevious_single_property_change (make_number (pos), Qcomposition,
429 object, make_number (limit));
430 pos = XINT (val);
431 if (pos == limit)
432 return 0;
433 get_property_and_range (pos, Qcomposition, prop, start, end, object);
434 return 1;
437 /* Run a proper function to adjust the composition sitting between
438 FROM and TO with property PROP. */
440 static void
441 run_composition_function (from, to, prop)
442 int from, to;
443 Lisp_Object prop;
445 Lisp_Object func, val;
446 int start, end;
448 func = COMPOSITION_MODIFICATION_FUNC (prop);
449 /* If an invalid composition precedes or follows, try to make them
450 valid too. */
451 if (from > BEGV
452 && find_composition (from - 1, -1, &start, &end, &prop, Qnil)
453 && !COMPOSITION_VALID_P (start, end, prop))
454 from = start;
455 if (to < ZV
456 && find_composition (to, -1, &start, &end, &prop, Qnil)
457 && !COMPOSITION_VALID_P (start, end, prop))
458 to = end;
459 if (!NILP (func))
460 call2 (func, make_number (from), make_number (to));
461 else if (!NILP (Ffboundp (Vcompose_chars_after_function)))
462 call3 (Vcompose_chars_after_function,
463 make_number (from), make_number (to), Qnil);
466 /* Make invalid compositions adjacent to or inside FROM and TO valid.
467 CHECK_MASK is bitwise `or' of mask bits defined by macros
468 CHECK_XXX (see the comment in composite.h).
470 This function is called when a buffer text is changed. If the
471 change is deletion, FROM == TO. Otherwise, FROM < TO. */
473 void
474 update_compositions (from, to, check_mask)
475 int from, to;
477 Lisp_Object prop, hook;
478 int start, end;
480 /* If FROM and TO are not in a valid range, do nothing. */
481 if (! (BEGV <= from && from <= to && to <= ZV))
482 return;
484 if (check_mask & CHECK_HEAD)
486 /* FROM should be at composition boundary. But, insertion or
487 deletion will make two compositions adjacent and
488 indistinguishable when they have same (eq) property. To
489 avoid it, in such a case, we change the property of the
490 latter to the copy of it. */
491 if (from > BEGV
492 && find_composition (from - 1, -1, &start, &end, &prop, Qnil))
494 if (from < end)
495 Fput_text_property (make_number (from), make_number (end),
496 Qcomposition,
497 Fcons (XCAR (prop), XCDR (prop)), Qnil);
498 run_composition_function (start, end, prop);
499 from = end;
501 else if (from < end
502 && find_composition (from, -1, &start, &from, &prop, Qnil))
503 run_composition_function (start, from, prop);
506 if (check_mask & CHECK_INSIDE)
508 /* In this case, we are sure that (check & CHECK_TAIL) is also
509 nonzero. Thus, here we should check only compositions before
510 (to - 1). */
511 while (from < to - 1
512 && find_composition (from, to, &start, &from, &prop, Qnil)
513 && from < to - 1)
514 run_composition_function (start, from, prop);
517 if (check_mask & CHECK_TAIL)
519 if (from < to
520 && find_composition (to - 1, -1, &start, &end, &prop, Qnil))
522 /* TO should be also at composition boundary. But,
523 insertion or deletion will make two compositions adjacent
524 and indistinguishable when they have same (eq) property.
525 To avoid it, in such a case, we change the property of
526 the former to the copy of it. */
527 if (to < end)
528 Fput_text_property (make_number (start), make_number (to),
529 Qcomposition,
530 Fcons (XCAR (prop), XCDR (prop)), Qnil);
531 run_composition_function (start, end, prop);
533 else if (to < ZV
534 && find_composition (to, -1, &start, &end, &prop, Qnil))
535 run_composition_function (start, end, prop);
540 /* Modify composition property values in LIST destructively. LIST is
541 a list as returned from text_property_list. Change values to the
542 top-level copies of them so that none of them are `eq'. */
544 void
545 make_composition_value_copy (list)
546 Lisp_Object list;
548 Lisp_Object plist, val;
550 for (; CONSP (list); list = XCDR (list))
552 plist = XCAR (XCDR (XCDR (XCAR (list))));
553 while (CONSP (plist) && CONSP (XCDR (plist)))
555 if (EQ (XCAR (plist), Qcomposition)
556 && (val = XCAR (XCDR (plist)), CONSP (val)))
557 XCAR (XCDR (plist)) = Fcons (XCAR (val), XCDR (val));
558 plist = XCDR (XCDR (plist));
564 /* Make text in the region between START and END a composition that
565 has COMPONENTS and MODIFICATION-FUNC.
567 If STRING is non-nil, then operate on characters contained between
568 indices START and END in STRING. */
570 void
571 compose_text (start, end, components, modification_func, string)
572 int start, end;
573 Lisp_Object components, modification_func, string;
575 Lisp_Object prop;
577 prop = Fcons (Fcons (make_number (end - start), components),
578 modification_func);
579 Fput_text_property (make_number (start), make_number (end),
580 Qcomposition, prop, string);
583 /* Compose sequences of characters in the region between START and END
584 by functions registered in Vcomposition_function_table. If STRING
585 is non-nil, operate on characters contained between indices START
586 and END in STRING. */
588 void
589 compose_chars_in_text (start, end, string)
590 int start, end;
591 Lisp_Object string;
593 int count;
594 struct gcpro gcpro1;
595 Lisp_Object tail, elt, val, to;
596 /* Set to nonzero if we don't have to compose ASCII characters. */
597 int skip_ascii;
598 int i, len, stop, c;
599 unsigned char *ptr, *pend;
601 if (! CHAR_TABLE_P (Vcomposition_function_table))
602 return;
604 if (STRINGP (string))
606 count = specpdl_ptr - specpdl;
607 GCPRO1 (string);
608 stop = end;
609 ptr = XSTRING (string)->data + string_char_to_byte (string, start);
610 pend = ptr + STRING_BYTES (XSTRING (string));
612 else
614 record_unwind_protect (save_excursion_restore, save_excursion_save ());
615 TEMP_SET_PT (start);
616 stop = (start < GPT && GPT < end ? GPT : end);
617 ptr = CHAR_POS_ADDR (start);
618 pend = CHAR_POS_ADDR (end);
621 /* Preserve the match data. */
622 record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil));
624 /* If none of ASCII characters have composition functions, we can
625 skip them quickly. */
626 for (i = 0; i < 128; i++)
627 if (!NILP (CHAR_TABLE_REF (Vcomposition_function_table, i)))
628 break;
629 skip_ascii = (i == 128);
632 while (1)
634 if (skip_ascii)
635 while (start < stop && ASCII_BYTE_P (*ptr))
636 start++, ptr++;
638 if (start >= stop)
640 if (stop == end || start >= end)
641 break;
642 stop = end;
643 if (STRINGP (string))
644 ptr = XSTRING (string)->data + string_char_to_byte (string, start);
645 else
646 ptr = CHAR_POS_ADDR (start);
649 c = STRING_CHAR_AND_LENGTH (ptr, pend - ptr, len);
650 tail = CHAR_TABLE_REF (Vcomposition_function_table, c);
651 while (CONSP (tail))
653 elt = XCAR (tail);
654 if (CONSP (elt)
655 && STRINGP (XCAR (elt))
656 && !NILP (Ffboundp (XCDR (elt))))
658 if (STRINGP (string))
659 val = Fstring_match (XCAR (elt), string, make_number (start));
660 else
662 val = Flooking_at (XCAR (elt));
663 if (!NILP (val))
664 val = make_number (start);
666 if (INTEGERP (val) && XFASTINT (val) == start)
668 to = Fmatch_end (make_number (0));
669 val = call4 (XCDR (elt), val, to, XCAR (elt), string);
670 if (INTEGERP (val) && XINT (val) > 1)
672 start += XINT (val);
673 if (STRINGP (string))
674 ptr = XSTRING (string)->data + string_char_to_byte (string, start);
675 else
676 ptr = CHAR_POS_ADDR (start);
678 else
680 start++;
681 ptr += len;
683 break;
686 tail = XCDR (tail);
688 if (!CONSP (tail))
690 /* No composition done. Try the next character. */
691 start++;
692 ptr += len;
696 unbind_to (count, Qnil);
697 if (STRINGP (string))
698 UNGCPRO;
701 /* Emacs Lisp APIs. */
703 DEFUN ("compose-region-internal", Fcompose_region_internal,
704 Scompose_region_internal, 2, 4, 0,
705 "Internal use only.\n\
707 Compose text in the region between START and END.\n\
708 Optional 3rd and 4th arguments are COMPONENTS and MODIFICATION-FUNC\n\
709 for the composition. See `compose-region' for more detial.")
710 (start, end, components, mod_func)
711 Lisp_Object start, end, components, mod_func;
713 validate_region (&start, &end);
714 if (!NILP (components)
715 && !INTEGERP (components)
716 && !CONSP (components)
717 && !STRINGP (components))
718 CHECK_VECTOR (components, 2);
720 compose_text (XINT (start), XINT (end), components, mod_func, Qnil);
721 return Qnil;
724 DEFUN ("compose-string-internal", Fcompose_string_internal,
725 Scompose_string_internal, 3, 5, 0,
726 "Internal use only.\n\
728 Compose text between indices START and END of STRING.\n\
729 Optional 4th and 5th arguments are COMPONENTS and MODIFICATION-FUNC\n\
730 for the composition. See `compose-string' for more detial.")
731 (string, start, end, components, mod_func)
732 Lisp_Object string, start, end, components, mod_func;
734 CHECK_STRING (string, 0);
735 CHECK_NUMBER (start, 1);
736 CHECK_NUMBER (end, 2);
738 if (XINT (start) < 0 ||
739 XINT (start) > XINT (end)
740 || XINT (end) > XSTRING (string)->size)
741 args_out_of_range (start, end);
743 compose_text (XINT (start), XINT (end), components, mod_func, string);
744 return string;
747 DEFUN ("find-composition-internal", Ffind_composition_internal,
748 Sfind_composition_internal, 4, 4, 0,
749 "Internal use only.\n\
751 Return information about composition at or nearest to position POS.\n\
752 See `find-composition' for more detail.")
753 (pos, limit, string, detail_p)
754 Lisp_Object pos, limit, string, detail_p;
756 Lisp_Object prop, tail;
757 int start, end;
758 int id;
760 CHECK_NUMBER_COERCE_MARKER (pos, 0);
761 start = XINT (pos);
762 if (!NILP (limit))
764 CHECK_NUMBER_COERCE_MARKER (limit, 1);
765 end = XINT (limit);
767 else
768 end = -1;
769 if (!NILP (string))
770 CHECK_STRING (string, 2);
772 if (!find_composition (start, end, &start, &end, &prop, string))
773 return Qnil;
774 if (!COMPOSITION_VALID_P (start, end, prop))
775 return Fcons (make_number (start), Fcons (make_number (end),
776 Fcons (Qnil, Qnil)));
777 if (NILP (detail_p))
778 return Fcons (make_number (start), Fcons (make_number (end),
779 Fcons (Qt, Qnil)));
781 if (COMPOSITION_REGISTERD_P (prop))
782 id = COMPOSITION_ID (prop);
783 else
785 int start_byte = (NILP (string)
786 ? CHAR_TO_BYTE (start)
787 : string_char_to_byte (string, start));
788 id = get_composition_id (start, start_byte, end - start, prop, string);
791 if (id >= 0)
793 Lisp_Object components, relative_p, mod_func;
794 enum composition_method method = COMPOSITION_METHOD (prop);
795 int width = composition_table[id]->width;
797 components = Fcopy_sequence (COMPOSITION_COMPONENTS (prop));
798 relative_p = (method == COMPOSITION_WITH_RULE_ALTCHARS
799 ? Qnil : Qt);
800 mod_func = COMPOSITION_MODIFICATION_FUNC (prop);
801 tail = Fcons (components,
802 Fcons (relative_p,
803 Fcons (mod_func,
804 Fcons (make_number (width), Qnil))));
806 else
807 tail = Qnil;
809 return Fcons (make_number (start), Fcons (make_number (end), tail));
813 void
814 syms_of_composite ()
816 Qcomposition = intern ("composition");
817 staticpro (&Qcomposition);
819 /* Make a hash table for composition. */
821 Lisp_Object args[6];
822 extern Lisp_Object QCsize;
824 args[0] = QCtest;
825 args[1] = Qequal;
826 args[2] = QCweakness;
827 args[3] = Qnil;
828 args[4] = QCsize;
829 args[5] = make_number (311);
830 composition_hash_table = Fmake_hash_table (6, args);
831 staticpro (&composition_hash_table);
834 /* Text property `composition' should be nonsticky by default. */
835 Vtext_property_default_nonsticky
836 = Fcons (Fcons (Qcomposition, Qt), Vtext_property_default_nonsticky);
838 DEFVAR_LISP ("compose-chars-after-function", &Vcompose_chars_after_function,
839 "Function to adjust composition of buffer text.\n\
841 The function is called with three arguments FROM, TO, and OBJECT.\n\
842 FROM and TO specify the range of text of which composition should be\n\
843 adjusted. OBJECT, if non-nil, is a string that contains the text.\n\
845 This function is called after a text with `composition' property is\n\
846 inserted or deleted to keep `composition' property of buffer text\n\
847 valid.\n\
849 The default value is the function `compose-chars-after'.");
850 Vcompose_chars_after_function = intern ("compose-chars-after");
852 Qcomposition_function_table = intern ("composition-function-table");
853 staticpro (&Qcomposition_function_table);
855 /* Intern this now in case it isn't already done.
856 Setting this variable twice is harmless.
857 But don't staticpro it here--that is done in alloc.c. */
858 Qchar_table_extra_slots = intern ("char-table-extra-slots");
860 Fput (Qcomposition_function_table, Qchar_table_extra_slots, make_number (0));
862 DEFVAR_LISP ("composition-function-table", &Vcomposition_function_table,
863 "Char table of patterns and functions to make a composition.\n\
865 Each element is nil or an alist of PATTERNs vs FUNCs, where PATTERNs\n\
866 are regular expressions and FUNCs are functions. FUNC is responsible\n\
867 for composing text matching the corresponding PATTERN. FUNC is called\n\
868 with three arguments FROM, TO, and PATTERN. See the function\n\
869 `compose-chars-after' for more detail.\n\
871 This table is looked up by the first character of a composition when\n\
872 the composition gets invalid after a change in a buffer.");
873 Vcomposition_function_table
874 = Fmake_char_table (Qcomposition_function_table, Qnil);
876 defsubr (&Scompose_region_internal);
877 defsubr (&Scompose_string_internal);
878 defsubr (&Sfind_composition_internal);