mail/mail-hist.el (mail-hist-text-too-long-p): doc fix.
[emacs.git] / src / composite.c
blob04836fb36d10a76cacf517f9586a6519c2245267
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 */
426 val = Fnext_single_property_change (make_number (pos), Qcomposition,
427 object, make_number (limit));
428 pos = XINT (val);
429 if (pos == limit)
430 return 0;
432 else /* search backward */
434 if (get_property_and_range (pos - 1, Qcomposition, prop, start, end,
435 object))
436 return 1;
437 val = Fprevious_single_property_change (make_number (pos), Qcomposition,
438 object, make_number (limit));
439 pos = XINT (val);
440 if (pos == limit)
441 return 0;
442 pos--;
444 get_property_and_range (pos, Qcomposition, prop, start, end, object);
445 return 1;
448 /* Run a proper function to adjust the composition sitting between
449 FROM and TO with property PROP. */
451 static void
452 run_composition_function (from, to, prop)
453 int from, to;
454 Lisp_Object prop;
456 Lisp_Object func;
457 int start, end;
459 func = COMPOSITION_MODIFICATION_FUNC (prop);
460 /* If an invalid composition precedes or follows, try to make them
461 valid too. */
462 if (from > BEGV
463 && find_composition (from - 1, -1, &start, &end, &prop, Qnil)
464 && !COMPOSITION_VALID_P (start, end, prop))
465 from = start;
466 if (to < ZV
467 && find_composition (to, -1, &start, &end, &prop, Qnil)
468 && !COMPOSITION_VALID_P (start, end, prop))
469 to = end;
470 if (!NILP (func))
471 call2 (func, make_number (from), make_number (to));
472 else if (!NILP (Ffboundp (Vcompose_chars_after_function)))
473 call3 (Vcompose_chars_after_function,
474 make_number (from), make_number (to), Qnil);
477 /* Make invalid compositions adjacent to or inside FROM and TO valid.
478 CHECK_MASK is bitwise `or' of mask bits defined by macros
479 CHECK_XXX (see the comment in composite.h).
481 This function is called when a buffer text is changed. If the
482 change is deletion, FROM == TO. Otherwise, FROM < TO. */
484 void
485 update_compositions (from, to, check_mask)
486 int from, to;
488 Lisp_Object prop;
489 int start, end;
491 /* If FROM and TO are not in a valid range, do nothing. */
492 if (! (BEGV <= from && from <= to && to <= ZV))
493 return;
495 if (check_mask & CHECK_HEAD)
497 /* FROM should be at composition boundary. But, insertion or
498 deletion will make two compositions adjacent and
499 indistinguishable when they have same (eq) property. To
500 avoid it, in such a case, we change the property of the
501 latter to the copy of it. */
502 if (from > BEGV
503 && find_composition (from - 1, -1, &start, &end, &prop, Qnil))
505 if (from < end)
506 Fput_text_property (make_number (from), make_number (end),
507 Qcomposition,
508 Fcons (XCAR (prop), XCDR (prop)), Qnil);
509 run_composition_function (start, end, prop);
510 from = end;
512 else if (from < to
513 && find_composition (from, -1, &start, &from, &prop, Qnil))
514 run_composition_function (start, from, prop);
517 if (check_mask & CHECK_INSIDE)
519 /* In this case, we are sure that (check & CHECK_TAIL) is also
520 nonzero. Thus, here we should check only compositions before
521 (to - 1). */
522 while (from < to - 1
523 && find_composition (from, to, &start, &from, &prop, Qnil)
524 && from < to - 1)
525 run_composition_function (start, from, prop);
528 if (check_mask & CHECK_TAIL)
530 if (from < to
531 && find_composition (to - 1, -1, &start, &end, &prop, Qnil))
533 /* TO should be also at composition boundary. But,
534 insertion or deletion will make two compositions adjacent
535 and indistinguishable when they have same (eq) property.
536 To avoid it, in such a case, we change the property of
537 the former to the copy of it. */
538 if (to < end)
539 Fput_text_property (make_number (start), make_number (to),
540 Qcomposition,
541 Fcons (XCAR (prop), XCDR (prop)), Qnil);
542 run_composition_function (start, end, prop);
544 else if (to < ZV
545 && find_composition (to, -1, &start, &end, &prop, Qnil))
546 run_composition_function (start, end, prop);
551 /* Modify composition property values in LIST destructively. LIST is
552 a list as returned from text_property_list. Change values to the
553 top-level copies of them so that none of them are `eq'. */
555 void
556 make_composition_value_copy (list)
557 Lisp_Object list;
559 Lisp_Object plist, val;
561 for (; CONSP (list); list = XCDR (list))
563 plist = XCAR (XCDR (XCDR (XCAR (list))));
564 while (CONSP (plist) && CONSP (XCDR (plist)))
566 if (EQ (XCAR (plist), Qcomposition)
567 && (val = XCAR (XCDR (plist)), CONSP (val)))
568 XCAR (XCDR (plist)) = Fcons (XCAR (val), XCDR (val));
569 plist = XCDR (XCDR (plist));
575 /* Make text in the region between START and END a composition that
576 has COMPONENTS and MODIFICATION-FUNC.
578 If STRING is non-nil, then operate on characters contained between
579 indices START and END in STRING. */
581 void
582 compose_text (start, end, components, modification_func, string)
583 int start, end;
584 Lisp_Object components, modification_func, string;
586 Lisp_Object prop;
588 prop = Fcons (Fcons (make_number (end - start), components),
589 modification_func);
590 Fput_text_property (make_number (start), make_number (end),
591 Qcomposition, prop, string);
594 /* Compose sequences of characters in the region between START and END
595 by functions registered in Vcomposition_function_table. If STRING
596 is non-nil, operate on characters contained between indices START
597 and END in STRING. */
599 void
600 compose_chars_in_text (start, end, string)
601 int start, end;
602 Lisp_Object string;
604 int count;
605 struct gcpro gcpro1;
606 Lisp_Object tail, elt, val, to;
607 /* Set to nonzero if we don't have to compose ASCII characters. */
608 int skip_ascii;
609 int i, len, stop, c;
610 unsigned char *ptr, *pend;
612 if (! CHAR_TABLE_P (Vcomposition_function_table))
613 return;
615 if (STRINGP (string))
617 count = specpdl_ptr - specpdl;
618 GCPRO1 (string);
619 stop = end;
620 ptr = XSTRING (string)->data + string_char_to_byte (string, start);
621 pend = ptr + STRING_BYTES (XSTRING (string));
623 else
625 record_unwind_protect (save_excursion_restore, save_excursion_save ());
626 TEMP_SET_PT (start);
627 stop = (start < GPT && GPT < end ? GPT : end);
628 ptr = CHAR_POS_ADDR (start);
629 pend = CHAR_POS_ADDR (end);
632 /* Preserve the match data. */
633 record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil));
635 /* If none of ASCII characters have composition functions, we can
636 skip them quickly. */
637 for (i = 0; i < 128; i++)
638 if (!NILP (CHAR_TABLE_REF (Vcomposition_function_table, i)))
639 break;
640 skip_ascii = (i == 128);
643 while (1)
645 if (skip_ascii)
646 while (start < stop && ASCII_BYTE_P (*ptr))
647 start++, ptr++;
649 if (start >= stop)
651 if (stop == end || start >= end)
652 break;
653 stop = end;
654 if (STRINGP (string))
655 ptr = XSTRING (string)->data + string_char_to_byte (string, start);
656 else
657 ptr = CHAR_POS_ADDR (start);
660 c = STRING_CHAR_AND_LENGTH (ptr, pend - ptr, len);
661 tail = CHAR_TABLE_REF (Vcomposition_function_table, c);
662 while (CONSP (tail))
664 elt = XCAR (tail);
665 if (CONSP (elt)
666 && STRINGP (XCAR (elt))
667 && !NILP (Ffboundp (XCDR (elt))))
669 if (STRINGP (string))
670 val = Fstring_match (XCAR (elt), string, make_number (start));
671 else
673 val = Flooking_at (XCAR (elt));
674 if (!NILP (val))
675 val = make_number (start);
677 if (INTEGERP (val) && XFASTINT (val) == start)
679 to = Fmatch_end (make_number (0));
680 val = call4 (XCDR (elt), val, to, XCAR (elt), string);
681 if (INTEGERP (val) && XINT (val) > 1)
683 start += XINT (val);
684 if (STRINGP (string))
685 ptr = XSTRING (string)->data + string_char_to_byte (string, start);
686 else
687 ptr = CHAR_POS_ADDR (start);
689 else
691 start++;
692 ptr += len;
694 break;
697 tail = XCDR (tail);
699 if (!CONSP (tail))
701 /* No composition done. Try the next character. */
702 start++;
703 ptr += len;
707 unbind_to (count, Qnil);
708 if (STRINGP (string))
709 UNGCPRO;
712 /* Emacs Lisp APIs. */
714 DEFUN ("compose-region-internal", Fcompose_region_internal,
715 Scompose_region_internal, 2, 4, 0,
716 "Internal use only.\n\
718 Compose text in the region between START and END.\n\
719 Optional 3rd and 4th arguments are COMPONENTS and MODIFICATION-FUNC\n\
720 for the composition. See `compose-region' for more detial.")
721 (start, end, components, mod_func)
722 Lisp_Object start, end, components, mod_func;
724 validate_region (&start, &end);
725 if (!NILP (components)
726 && !INTEGERP (components)
727 && !CONSP (components)
728 && !STRINGP (components))
729 CHECK_VECTOR (components, 2);
731 compose_text (XINT (start), XINT (end), components, mod_func, Qnil);
732 return Qnil;
735 DEFUN ("compose-string-internal", Fcompose_string_internal,
736 Scompose_string_internal, 3, 5, 0,
737 "Internal use only.\n\
739 Compose text between indices START and END of STRING.\n\
740 Optional 4th and 5th arguments are COMPONENTS and MODIFICATION-FUNC\n\
741 for the composition. See `compose-string' for more detial.")
742 (string, start, end, components, mod_func)
743 Lisp_Object string, start, end, components, mod_func;
745 CHECK_STRING (string, 0);
746 CHECK_NUMBER (start, 1);
747 CHECK_NUMBER (end, 2);
749 if (XINT (start) < 0 ||
750 XINT (start) > XINT (end)
751 || XINT (end) > XSTRING (string)->size)
752 args_out_of_range (start, end);
754 compose_text (XINT (start), XINT (end), components, mod_func, string);
755 return string;
758 DEFUN ("find-composition-internal", Ffind_composition_internal,
759 Sfind_composition_internal, 4, 4, 0,
760 "Internal use only.\n\
762 Return information about composition at or nearest to position POS.\n\
763 See `find-composition' for more detail.")
764 (pos, limit, string, detail_p)
765 Lisp_Object pos, limit, string, detail_p;
767 Lisp_Object prop, tail;
768 int start, end;
769 int id;
771 CHECK_NUMBER_COERCE_MARKER (pos, 0);
772 start = XINT (pos);
773 if (!NILP (limit))
775 CHECK_NUMBER_COERCE_MARKER (limit, 1);
776 end = XINT (limit);
778 else
779 end = -1;
780 if (!NILP (string))
781 CHECK_STRING (string, 2);
783 if (!find_composition (start, end, &start, &end, &prop, string))
784 return Qnil;
785 if (!COMPOSITION_VALID_P (start, end, prop))
786 return Fcons (make_number (start), Fcons (make_number (end),
787 Fcons (Qnil, Qnil)));
788 if (NILP (detail_p))
789 return Fcons (make_number (start), Fcons (make_number (end),
790 Fcons (Qt, Qnil)));
792 if (COMPOSITION_REGISTERD_P (prop))
793 id = COMPOSITION_ID (prop);
794 else
796 int start_byte = (NILP (string)
797 ? CHAR_TO_BYTE (start)
798 : string_char_to_byte (string, start));
799 id = get_composition_id (start, start_byte, end - start, prop, string);
802 if (id >= 0)
804 Lisp_Object components, relative_p, mod_func;
805 enum composition_method method = COMPOSITION_METHOD (prop);
806 int width = composition_table[id]->width;
808 components = Fcopy_sequence (COMPOSITION_COMPONENTS (prop));
809 relative_p = (method == COMPOSITION_WITH_RULE_ALTCHARS
810 ? Qnil : Qt);
811 mod_func = COMPOSITION_MODIFICATION_FUNC (prop);
812 tail = Fcons (components,
813 Fcons (relative_p,
814 Fcons (mod_func,
815 Fcons (make_number (width), Qnil))));
817 else
818 tail = Qnil;
820 return Fcons (make_number (start), Fcons (make_number (end), tail));
824 void
825 syms_of_composite ()
827 Qcomposition = intern ("composition");
828 staticpro (&Qcomposition);
830 /* Make a hash table for composition. */
832 Lisp_Object args[6];
833 extern Lisp_Object QCsize;
835 args[0] = QCtest;
836 args[1] = Qequal;
837 args[2] = QCweakness;
838 args[3] = Qnil;
839 args[4] = QCsize;
840 args[5] = make_number (311);
841 composition_hash_table = Fmake_hash_table (6, args);
842 staticpro (&composition_hash_table);
845 /* Text property `composition' should be nonsticky by default. */
846 Vtext_property_default_nonsticky
847 = Fcons (Fcons (Qcomposition, Qt), Vtext_property_default_nonsticky);
849 DEFVAR_LISP ("compose-chars-after-function", &Vcompose_chars_after_function,
850 "Function to adjust composition of buffer text.\n\
852 The function is called with three arguments FROM, TO, and OBJECT.\n\
853 FROM and TO specify the range of text of which composition should be\n\
854 adjusted. OBJECT, if non-nil, is a string that contains the text.\n\
856 This function is called after a text with `composition' property is\n\
857 inserted or deleted to keep `composition' property of buffer text\n\
858 valid.\n\
860 The default value is the function `compose-chars-after'.");
861 Vcompose_chars_after_function = intern ("compose-chars-after");
863 Qcomposition_function_table = intern ("composition-function-table");
864 staticpro (&Qcomposition_function_table);
866 /* Intern this now in case it isn't already done.
867 Setting this variable twice is harmless.
868 But don't staticpro it here--that is done in alloc.c. */
869 Qchar_table_extra_slots = intern ("char-table-extra-slots");
871 Fput (Qcomposition_function_table, Qchar_table_extra_slots, make_number (0));
873 DEFVAR_LISP ("composition-function-table", &Vcomposition_function_table,
874 "Char table of patterns and functions to make a composition.\n\
876 Each element is nil or an alist of PATTERNs vs FUNCs, where PATTERNs\n\
877 are regular expressions and FUNCs are functions. FUNC is responsible\n\
878 for composing text matching the corresponding PATTERN. FUNC is called\n\
879 with three arguments FROM, TO, and PATTERN. See the function\n\
880 `compose-chars-after' for more detail.\n\
882 This table is looked up by the first character of a composition when\n\
883 the composition gets invalid after a change in a buffer.");
884 Vcomposition_function_table
885 = Fmake_char_table (Qcomposition_function_table, Qnil);
887 defsubr (&Scompose_region_internal);
888 defsubr (&Scompose_string_internal);
889 defsubr (&Sfind_composition_internal);