Rewrite globals to allow indirection in C.
[emacs.git] / src / composite.c
blob6de60bdaeba1990c80c4e59d6d16aea9438a1359
1 /* Composite sequence support.
2 Copyright (C) 2001, 2002, 2003, 2004, 2005,
3 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
4 Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
5 National Institute of Advanced Industrial Science and Technology (AIST)
6 Registration Number H14PRO021
7 Copyright (C) 2003, 2006
8 National Institute of Advanced Industrial Science and Technology (AIST)
9 Registration Number H13PRO009
11 This file is part of GNU Emacs.
13 GNU Emacs is free software: you can redistribute it and/or modify
14 it under the terms of the GNU General Public License as published by
15 the Free Software Foundation, either version 3 of the License, or
16 (at your option) any later version.
18 GNU Emacs is distributed in the hope that it will be useful,
19 but WITHOUT ANY WARRANTY; without even the implied warranty of
20 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 GNU General Public License for more details.
23 You should have received a copy of the GNU General Public License
24 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
26 #include <config.h>
27 #include <setjmp.h>
28 #include "lisp.h"
29 #include "buffer.h"
30 #include "character.h"
31 #include "coding.h"
32 #include "intervals.h"
33 #include "window.h"
34 #include "frame.h"
35 #include "dispextern.h"
36 #include "font.h"
37 #include "termhooks.h"
40 /* Emacs uses special text property `composition' to support character
41 composition. A sequence of characters that have the same (i.e. eq)
42 `composition' property value is treated as a single composite
43 sequence (we call it just `composition' here after). Characters in
44 a composition are all composed somehow on the screen.
46 The property value has this form when the composition is made:
47 ((LENGTH . COMPONENTS) . MODIFICATION-FUNC)
48 then turns to this form:
49 (COMPOSITION-ID . (LENGTH COMPONENTS-VEC . MODIFICATION-FUNC))
50 when the composition is registered in composition_hash_table and
51 composition_table. These rather peculiar structures were designed
52 to make it easy to distinguish them quickly (we can do that by
53 checking only the first element) and to extract LENGTH (from the
54 former form) and COMPOSITION-ID (from the latter form).
56 We register a composition when it is displayed, or when the width
57 is required (for instance, to calculate columns).
59 LENGTH -- Length of the composition. This information is used to
60 check the validity of the composition.
62 COMPONENTS -- Character, string, vector, list, or nil.
64 If it is nil, characters in the text are composed relatively
65 according to their metrics in font glyphs.
67 If it is a character or a string, the character or characters
68 in the string are composed relatively.
70 If it is a vector or list of integers, the element is a
71 character or an encoded composition rule. The characters are
72 composed according to the rules. (2N)th elements are
73 characters to be composed and (2N+1)th elements are
74 composition rules to tell how to compose (2N+2)th element with
75 the previously composed 2N glyphs.
77 COMPONENTS-VEC -- Vector of integers. In relative composition, the
78 elements are characters to be composed. In rule-base
79 composition, the elements are characters or encoded
80 composition rules.
82 MODIFICATION-FUNC -- If non nil, it is a function to call when the
83 composition gets invalid after a modification in a buffer. If
84 it is nil, a function in `composition-function-table' of the
85 first character in the sequence is called.
87 COMPOSITION-ID --Identification number of the composition. It is
88 used as an index to composition_table for the composition.
90 When Emacs has to display a composition or has to know its
91 displaying width, the function get_composition_id is called. It
92 returns COMPOSITION-ID so that the caller can access the
93 information about the composition through composition_table. If a
94 COMPOSITION-ID has not yet been assigned to the composition,
95 get_composition_id checks the validity of `composition' property,
96 and, if valid, assigns a new ID, registers the information in
97 composition_hash_table and composition_table, and changes the form
98 of the property value. If the property is invalid, return -1
99 without changing the property value.
101 We use two tables to keep information about composition;
102 composition_hash_table and composition_table.
104 The former is a hash table in which keys are COMPONENTS-VECs and
105 values are the corresponding COMPOSITION-IDs. This hash table is
106 weak, but as each key (COMPONENTS-VEC) is also kept as a value of the
107 `composition' property, it won't be collected as garbage until all
108 bits of text that have the same COMPONENTS-VEC are deleted.
110 The latter is a table of pointers to `struct composition' indexed
111 by COMPOSITION-ID. This structure keeps the other information (see
112 composite.h).
114 In general, a text property holds information about individual
115 characters. But, a `composition' property holds information about
116 a sequence of characters (in this sense, it is like the `intangible'
117 property). That means that we should not share the property value
118 in adjacent compositions -- we can't distinguish them if they have the
119 same property. So, after any changes, we call
120 `update_compositions' and change a property of one of adjacent
121 compositions to a copy of it. This function also runs a proper
122 composition modification function to make a composition that gets
123 invalid by the change valid again.
125 As the value of the `composition' property holds information about a
126 specific range of text, the value gets invalid if we change the
127 text in the range. We treat the `composition' property as always
128 rear-nonsticky (currently by setting default-text-properties to
129 (rear-nonsticky (composition))) and we never make properties of
130 adjacent compositions identical. Thus, any such changes make the
131 range just shorter. So, we can check the validity of the `composition'
132 property by comparing LENGTH information with the actual length of
133 the composition.
138 Lisp_Object Qcomposition;
140 /* Table of pointers to the structure `composition' indexed by
141 COMPOSITION-ID. This structure is for storing information about
142 each composition except for COMPONENTS-VEC. */
143 struct composition **composition_table;
145 /* The current size of `composition_table'. */
146 static int composition_table_size;
148 /* Number of compositions currently made. */
149 int n_compositions;
151 /* Hash table for compositions. The key is COMPONENTS-VEC of
152 `composition' property. The value is the corresponding
153 COMPOSITION-ID. */
154 Lisp_Object composition_hash_table;
156 /* Function to call to adjust composition. */
157 Lisp_Object impl_Vcompose_chars_after_function;
159 Lisp_Object Qauto_composed;
160 Lisp_Object impl_Vauto_composition_mode;
161 Lisp_Object impl_Vauto_composition_function;
162 Lisp_Object Qauto_composition_function;
163 Lisp_Object impl_Vcomposition_function_table;
165 /* Maxinum number of characters to lookback to check
166 auto-composition. */
167 #define MAX_AUTO_COMPOSITION_LOOKBACK 3
169 EXFUN (Fremove_list_of_text_properties, 4);
171 /* Temporary variable used in macros COMPOSITION_XXX. */
172 Lisp_Object composition_temp;
175 /* Return COMPOSITION-ID of a composition at buffer position
176 CHARPOS/BYTEPOS and length NCHARS. The `composition' property of
177 the sequence is PROP. STRING, if non-nil, is a string that
178 contains the composition instead of the current buffer.
180 If the composition is invalid, return -1. */
183 get_composition_id (charpos, bytepos, nchars, prop, string)
184 int charpos, bytepos, nchars;
185 Lisp_Object prop, string;
187 Lisp_Object id, length, components, key, *key_contents;
188 int glyph_len;
189 struct Lisp_Hash_Table *hash_table = XHASH_TABLE (composition_hash_table);
190 int hash_index;
191 unsigned hash_code;
192 struct composition *cmp;
193 int i, ch;
195 /* PROP should be
196 Form-A: ((LENGTH . COMPONENTS) . MODIFICATION-FUNC)
198 Form-B: (COMPOSITION-ID . (LENGTH COMPONENTS-VEC . MODIFICATION-FUNC))
200 if (nchars == 0 || !CONSP (prop))
201 goto invalid_composition;
203 id = XCAR (prop);
204 if (INTEGERP (id))
206 /* PROP should be Form-B. */
207 if (XINT (id) < 0 || XINT (id) >= n_compositions)
208 goto invalid_composition;
209 return XINT (id);
212 /* PROP should be Form-A.
213 Thus, ID should be (LENGTH . COMPONENTS). */
214 if (!CONSP (id))
215 goto invalid_composition;
216 length = XCAR (id);
217 if (!INTEGERP (length) || XINT (length) != nchars)
218 goto invalid_composition;
220 components = XCDR (id);
222 /* Check if the same composition has already been registered or not
223 by consulting composition_hash_table. The key for this table is
224 COMPONENTS (converted to a vector COMPONENTS-VEC) or, if it is
225 nil, vector of characters in the composition range. */
226 if (INTEGERP (components))
227 key = Fmake_vector (make_number (1), components);
228 else if (STRINGP (components) || CONSP (components))
229 key = Fvconcat (1, &components);
230 else if (VECTORP (components))
231 key = components;
232 else if (NILP (components))
234 key = Fmake_vector (make_number (nchars), Qnil);
235 if (STRINGP (string))
236 for (i = 0; i < nchars; i++)
238 FETCH_STRING_CHAR_ADVANCE (ch, string, charpos, bytepos);
239 XVECTOR (key)->contents[i] = make_number (ch);
241 else
242 for (i = 0; i < nchars; i++)
244 FETCH_CHAR_ADVANCE (ch, charpos, bytepos);
245 XVECTOR (key)->contents[i] = make_number (ch);
248 else
249 goto invalid_composition;
251 hash_index = hash_lookup (hash_table, key, &hash_code);
252 if (hash_index >= 0)
254 /* We have already registered the same composition. Change PROP
255 from Form-A above to Form-B while replacing COMPONENTS with
256 COMPONENTS-VEC stored in the hash table. We can directly
257 modify the cons cell of PROP because it is not shared. */
258 key = HASH_KEY (hash_table, hash_index);
259 id = HASH_VALUE (hash_table, hash_index);
260 XSETCAR (prop, id);
261 XSETCDR (prop, Fcons (make_number (nchars), Fcons (key, XCDR (prop))));
262 return XINT (id);
265 /* This composition is a new one. We must register it. */
267 /* Check if we have sufficient memory to store this information. */
268 if (composition_table_size == 0)
270 composition_table_size = 256;
271 composition_table
272 = (struct composition **) xmalloc (sizeof (composition_table[0])
273 * composition_table_size);
275 else if (composition_table_size <= n_compositions)
277 composition_table_size += 256;
278 composition_table
279 = (struct composition **) xrealloc (composition_table,
280 sizeof (composition_table[0])
281 * composition_table_size);
284 key_contents = XVECTOR (key)->contents;
286 /* Check if the contents of COMPONENTS are valid if COMPONENTS is a
287 vector or a list. It should be a sequence of:
288 char1 rule1 char2 rule2 char3 ... ruleN charN+1 */
290 if (VECTORP (components)
291 && ASIZE (components) >= 2
292 && VECTORP (AREF (components, 0)))
294 /* COMPONENTS is a glyph-string. */
295 int len = ASIZE (key);
297 for (i = 1; i < len; i++)
298 if (! VECTORP (AREF (key, i)))
299 goto invalid_composition;
301 else if (VECTORP (components) || CONSP (components))
303 int len = XVECTOR (key)->size;
305 /* The number of elements should be odd. */
306 if ((len % 2) == 0)
307 goto invalid_composition;
308 /* All elements should be integers (character or encoded
309 composition rule). */
310 for (i = 0; i < len; i++)
312 if (!INTEGERP (key_contents[i]))
313 goto invalid_composition;
317 /* Change PROP from Form-A above to Form-B. We can directly modify
318 the cons cell of PROP because it is not shared. */
319 XSETFASTINT (id, n_compositions);
320 XSETCAR (prop, id);
321 XSETCDR (prop, Fcons (make_number (nchars), Fcons (key, XCDR (prop))));
323 /* Register the composition in composition_hash_table. */
324 hash_index = hash_put (hash_table, key, id, hash_code);
326 /* Register the composition in composition_table. */
327 cmp = (struct composition *) xmalloc (sizeof (struct composition));
329 cmp->method = (NILP (components)
330 ? COMPOSITION_RELATIVE
331 : ((INTEGERP (components) || STRINGP (components))
332 ? COMPOSITION_WITH_ALTCHARS
333 : COMPOSITION_WITH_RULE_ALTCHARS));
334 cmp->hash_index = hash_index;
335 glyph_len = (cmp->method == COMPOSITION_WITH_RULE_ALTCHARS
336 ? (XVECTOR (key)->size + 1) / 2
337 : XVECTOR (key)->size);
338 cmp->glyph_len = glyph_len;
339 cmp->offsets = (short *) xmalloc (sizeof (short) * glyph_len * 2);
340 cmp->font = NULL;
342 if (cmp->method != COMPOSITION_WITH_RULE_ALTCHARS)
344 /* Relative composition. */
345 cmp->width = 0;
346 for (i = 0; i < glyph_len; i++)
348 int this_width;
349 ch = XINT (key_contents[i]);
350 this_width = (ch == '\t' ? 1 : CHAR_WIDTH (ch));
351 if (cmp->width < this_width)
352 cmp->width = this_width;
355 else
357 /* Rule-base composition. */
358 float leftmost = 0.0, rightmost;
360 ch = XINT (key_contents[0]);
361 rightmost = ch != '\t' ? CHAR_WIDTH (ch) : 1;
363 for (i = 1; i < glyph_len; i += 2)
365 int rule, gref, nref, xoff, yoff;
366 int this_width;
367 float this_left;
369 rule = XINT (key_contents[i]);
370 ch = XINT (key_contents[i + 1]);
371 this_width = ch != '\t' ? CHAR_WIDTH (ch) : 1;
373 /* A composition rule is specified by an integer value
374 that encodes global and new reference points (GREF and
375 NREF). GREF and NREF are specified by numbers as
376 below:
377 0---1---2 -- ascent
381 9--10--11 -- center
383 ---3---4---5--- baseline
385 6---7---8 -- descent
387 COMPOSITION_DECODE_RULE (rule, gref, nref, xoff, yoff);
388 this_left = (leftmost
389 + (gref % 3) * (rightmost - leftmost) / 2.0
390 - (nref % 3) * this_width / 2.0);
392 if (this_left < leftmost)
393 leftmost = this_left;
394 if (this_left + this_width > rightmost)
395 rightmost = this_left + this_width;
398 cmp->width = rightmost - leftmost;
399 if (cmp->width < (rightmost - leftmost))
400 /* To get a ceiling integer value. */
401 cmp->width++;
404 composition_table[n_compositions] = cmp;
406 return n_compositions++;
408 invalid_composition:
409 /* Would it be better to remove this `composition' property? */
410 return -1;
414 /* Find a static composition at or nearest to position POS of OBJECT
415 (buffer or string).
417 OBJECT defaults to the current buffer. If there's a composition at
418 POS, set *START and *END to the start and end of the sequence,
419 *PROP to the `composition' property, and return 1.
421 If there's no composition at POS and LIMIT is negative, return 0.
423 Otherwise, search for a composition forward (LIMIT > POS) or
424 backward (LIMIT < POS). In this case, LIMIT bounds the search.
426 If a composition is found, set *START, *END, and *PROP as above,
427 and return 1, else return 0.
429 This doesn't check the validity of composition. */
432 find_composition (pos, limit, start, end, prop, object)
433 int pos, limit;
434 EMACS_INT *start, *end;
435 Lisp_Object *prop, object;
437 Lisp_Object val;
439 if (get_property_and_range (pos, Qcomposition, prop, start, end, object))
440 return 1;
442 if (limit < 0 || limit == pos)
443 return 0;
445 if (limit > pos) /* search forward */
447 val = Fnext_single_property_change (make_number (pos), Qcomposition,
448 object, make_number (limit));
449 pos = XINT (val);
450 if (pos == limit)
451 return 0;
453 else /* search backward */
455 if (get_property_and_range (pos - 1, Qcomposition, prop, start, end,
456 object))
457 return 1;
458 val = Fprevious_single_property_change (make_number (pos), Qcomposition,
459 object, make_number (limit));
460 pos = XINT (val);
461 if (pos == limit)
462 return 0;
463 pos--;
465 get_property_and_range (pos, Qcomposition, prop, start, end, object);
466 return 1;
469 /* Run a proper function to adjust the composition sitting between
470 FROM and TO with property PROP. */
472 static void
473 run_composition_function (from, to, prop)
474 int from, to;
475 Lisp_Object prop;
477 Lisp_Object func;
478 EMACS_INT start, end;
480 func = COMPOSITION_MODIFICATION_FUNC (prop);
481 /* If an invalid composition precedes or follows, try to make them
482 valid too. */
483 if (from > BEGV
484 && find_composition (from - 1, -1, &start, &end, &prop, Qnil)
485 && !COMPOSITION_VALID_P (start, end, prop))
486 from = start;
487 if (to < ZV
488 && find_composition (to, -1, &start, &end, &prop, Qnil)
489 && !COMPOSITION_VALID_P (start, end, prop))
490 to = end;
491 if (!NILP (Ffboundp (func)))
492 call2 (func, make_number (from), make_number (to));
495 /* Make invalid compositions adjacent to or inside FROM and TO valid.
496 CHECK_MASK is bitwise `or' of mask bits defined by macros
497 CHECK_XXX (see the comment in composite.h).
499 It also resets the text-property `auto-composed' to a proper region
500 so that automatic character composition works correctly later while
501 displaying the region.
503 This function is called when a buffer text is changed. If the
504 change is deletion, FROM == TO. Otherwise, FROM < TO. */
506 void
507 update_compositions (from, to, check_mask)
508 EMACS_INT from, to;
509 int check_mask;
511 Lisp_Object prop;
512 EMACS_INT start, end;
513 /* The beginning and end of the region to set the property
514 `auto-composed' to nil. */
515 EMACS_INT min_pos = from, max_pos = to;
517 if (inhibit_modification_hooks)
518 return;
520 /* If FROM and TO are not in a valid range, do nothing. */
521 if (! (BEGV <= from && from <= to && to <= ZV))
522 return;
524 if (check_mask & CHECK_HEAD)
526 /* FROM should be at composition boundary. But, insertion or
527 deletion will make two compositions adjacent and
528 indistinguishable when they have same (eq) property. To
529 avoid it, in such a case, we change the property of the
530 latter to the copy of it. */
531 if (from > BEGV
532 && find_composition (from - 1, -1, &start, &end, &prop, Qnil)
533 && COMPOSITION_VALID_P (start, end, prop))
535 min_pos = start;
536 if (end > to)
537 max_pos = end;
538 if (from < end)
539 Fput_text_property (make_number (from), make_number (end),
540 Qcomposition,
541 Fcons (XCAR (prop), XCDR (prop)), Qnil);
542 run_composition_function (start, end, prop);
543 from = end;
545 else if (from < ZV
546 && find_composition (from, -1, &start, &from, &prop, Qnil)
547 && COMPOSITION_VALID_P (start, from, prop))
549 if (from > to)
550 max_pos = from;
551 run_composition_function (start, from, prop);
555 if (check_mask & CHECK_INSIDE)
557 /* In this case, we are sure that (check & CHECK_TAIL) is also
558 nonzero. Thus, here we should check only compositions before
559 (to - 1). */
560 while (from < to - 1
561 && find_composition (from, to, &start, &from, &prop, Qnil)
562 && COMPOSITION_VALID_P (start, from, prop)
563 && from < to - 1)
564 run_composition_function (start, from, prop);
567 if (check_mask & CHECK_TAIL)
569 if (from < to
570 && find_composition (to - 1, -1, &start, &end, &prop, Qnil)
571 && COMPOSITION_VALID_P (start, end, prop))
573 /* TO should be also at composition boundary. But,
574 insertion or deletion will make two compositions adjacent
575 and indistinguishable when they have same (eq) property.
576 To avoid it, in such a case, we change the property of
577 the former to the copy of it. */
578 if (to < end)
580 Fput_text_property (make_number (start), make_number (to),
581 Qcomposition,
582 Fcons (XCAR (prop), XCDR (prop)), Qnil);
583 max_pos = end;
585 run_composition_function (start, end, prop);
587 else if (to < ZV
588 && find_composition (to, -1, &start, &end, &prop, Qnil)
589 && COMPOSITION_VALID_P (start, end, prop))
591 run_composition_function (start, end, prop);
592 max_pos = end;
595 if (min_pos < max_pos)
597 int count = SPECPDL_INDEX ();
599 specbind (Qinhibit_read_only, Qt);
600 specbind (Qinhibit_modification_hooks, Qt);
601 specbind (Qinhibit_point_motion_hooks, Qt);
602 Fremove_list_of_text_properties (make_number (min_pos),
603 make_number (max_pos),
604 Fcons (Qauto_composed, Qnil), Qnil);
605 unbind_to (count, Qnil);
610 /* Modify composition property values in LIST destructively. LIST is
611 a list as returned from text_property_list. Change values to the
612 top-level copies of them so that none of them are `eq'. */
614 void
615 make_composition_value_copy (list)
616 Lisp_Object list;
618 Lisp_Object plist, val;
620 for (; CONSP (list); list = XCDR (list))
622 plist = XCAR (XCDR (XCDR (XCAR (list))));
623 while (CONSP (plist) && CONSP (XCDR (plist)))
625 if (EQ (XCAR (plist), Qcomposition)
626 && (val = XCAR (XCDR (plist)), CONSP (val)))
627 XSETCAR (XCDR (plist), Fcons (XCAR (val), XCDR (val)));
628 plist = XCDR (XCDR (plist));
634 /* Make text in the region between START and END a composition that
635 has COMPONENTS and MODIFICATION-FUNC.
637 If STRING is non-nil, then operate on characters contained between
638 indices START and END in STRING. */
640 void
641 compose_text (start, end, components, modification_func, string)
642 int start, end;
643 Lisp_Object components, modification_func, string;
645 Lisp_Object prop;
647 prop = Fcons (Fcons (make_number (end - start), components),
648 modification_func);
649 Fput_text_property (make_number (start), make_number (end),
650 Qcomposition, prop, string);
654 static Lisp_Object autocmp_chars P_ ((Lisp_Object, EMACS_INT, EMACS_INT,
655 EMACS_INT, struct window *,
656 struct face *, Lisp_Object));
659 /* Lisp glyph-string handlers */
661 /* Hash table for automatic composition. The key is a header of a
662 lgstring (Lispy glyph-string), and the value is a body of a
663 lgstring. */
665 static Lisp_Object gstring_hash_table;
667 static Lisp_Object gstring_lookup_cache P_ ((Lisp_Object));
669 static Lisp_Object
670 gstring_lookup_cache (header)
671 Lisp_Object header;
673 struct Lisp_Hash_Table *h = XHASH_TABLE (gstring_hash_table);
674 int i = hash_lookup (h, header, NULL);
676 return (i >= 0 ? HASH_VALUE (h, i) : Qnil);
679 Lisp_Object
680 composition_gstring_put_cache (gstring, len)
681 Lisp_Object gstring;
682 int len;
684 struct Lisp_Hash_Table *h = XHASH_TABLE (gstring_hash_table);
685 unsigned hash;
686 Lisp_Object header, copy;
687 int i;
689 header = LGSTRING_HEADER (gstring);
690 hash = h->hashfn (h, header);
691 if (len < 0)
693 len = LGSTRING_GLYPH_LEN (gstring);
694 for (i = 0; i < len; i++)
695 if (NILP (LGSTRING_GLYPH (gstring, i)))
696 break;
697 len = i;
700 copy = Fmake_vector (make_number (len + 2), Qnil);
701 LGSTRING_SET_HEADER (copy, Fcopy_sequence (header));
702 for (i = 0; i < len; i++)
703 LGSTRING_SET_GLYPH (copy, i, Fcopy_sequence (LGSTRING_GLYPH (gstring, i)));
704 i = hash_put (h, LGSTRING_HEADER (copy), copy, hash);
705 LGSTRING_SET_ID (copy, make_number (i));
706 return copy;
709 Lisp_Object
710 composition_gstring_from_id (id)
711 int id;
713 struct Lisp_Hash_Table *h = XHASH_TABLE (gstring_hash_table);
715 return HASH_VALUE (h, id);
718 static Lisp_Object fill_gstring_header P_ ((Lisp_Object, Lisp_Object,
719 Lisp_Object, Lisp_Object,
720 Lisp_Object));
723 composition_gstring_p (gstring)
724 Lisp_Object gstring;
726 Lisp_Object header;
727 int i;
729 if (! VECTORP (gstring) || ASIZE (gstring) < 2)
730 return 0;
731 header = LGSTRING_HEADER (gstring);
732 if (! VECTORP (header) || ASIZE (header) < 2)
733 return 0;
734 if (! NILP (LGSTRING_FONT (gstring))
735 && (! FONT_OBJECT_P (LGSTRING_FONT (gstring))
736 && ! CODING_SYSTEM_P (LGSTRING_FONT (gstring))))
737 return 0;
738 for (i = 1; i < ASIZE (LGSTRING_HEADER (gstring)); i++)
739 if (! NATNUMP (AREF (LGSTRING_HEADER (gstring), i)))
740 return 0;
741 if (! NILP (LGSTRING_ID (gstring)) && ! NATNUMP (LGSTRING_ID (gstring)))
742 return 0;
743 for (i = 0; i < LGSTRING_GLYPH_LEN (gstring); i++)
745 Lisp_Object glyph = LGSTRING_GLYPH (gstring, i);
746 if (NILP (glyph))
747 break;
748 if (! VECTORP (glyph) || ASIZE (glyph) != LGLYPH_SIZE)
749 return 0;
751 return 1;
755 composition_gstring_width (gstring, from, to, metrics)
756 Lisp_Object gstring;
757 int from, to;
758 struct font_metrics *metrics;
760 Lisp_Object *glyph;
761 int width = 0;
763 if (metrics)
765 Lisp_Object font_object = LGSTRING_FONT (gstring);
767 if (FONT_OBJECT_P (font_object))
769 struct font *font = XFONT_OBJECT (font_object);
771 metrics->ascent = font->ascent;
772 metrics->descent = font->descent;
774 else
776 metrics->ascent = 1;
777 metrics->descent = 0;
779 metrics->width = metrics->lbearing = metrics->rbearing = 0;
781 for (glyph = &LGSTRING_GLYPH (gstring, from); from < to; from++, glyph++)
783 int x;
785 if (NILP (LGLYPH_ADJUSTMENT (*glyph)))
786 width += LGLYPH_WIDTH (*glyph);
787 else
788 width += LGLYPH_WADJUST (*glyph);
789 if (metrics)
791 x = metrics->width + LGLYPH_LBEARING (*glyph) + LGLYPH_XOFF (*glyph);
792 if (metrics->lbearing > x)
793 metrics->lbearing = x;
794 x = metrics->width + LGLYPH_RBEARING (*glyph) + LGLYPH_XOFF (*glyph);
795 if (metrics->rbearing < x)
796 metrics->rbearing = x;
797 metrics->width = width;
798 x = LGLYPH_ASCENT (*glyph) - LGLYPH_YOFF (*glyph);
799 if (metrics->ascent < x)
800 metrics->ascent = x;
801 x = LGLYPH_DESCENT (*glyph) + LGLYPH_YOFF (*glyph);
802 if (metrics->descent < x)
803 metrics->descent = x;
806 return width;
810 static Lisp_Object gstring_work;
811 static Lisp_Object gstring_work_headers;
813 static Lisp_Object
814 fill_gstring_header (header, start, end, font_object, string)
815 Lisp_Object header, start, end, font_object, string;
817 EMACS_INT from, to, from_byte;
818 EMACS_INT len, i;
820 if (NILP (string))
822 if (NILP (current_buffer->enable_multibyte_characters))
823 error ("Attempt to shape unibyte text");
824 validate_region (&start, &end);
825 from = XFASTINT (start);
826 to = XFASTINT (end);
827 from_byte = CHAR_TO_BYTE (from);
829 else
831 CHECK_STRING (string);
832 if (! STRING_MULTIBYTE (string))
833 error ("Attempt to shape unibyte text");
834 /* FROM and TO are checked by the caller. */
835 from = XINT (start);
836 to = XINT (end);
837 if (from < 0 || from > to || to > SCHARS (string))
838 args_out_of_range_3 (string, start, end);
839 from_byte = string_char_to_byte (string, from);
842 len = to - from;
843 if (len == 0)
844 error ("Attempt to shape zero-length text");
845 if (VECTORP (header))
847 if (ASIZE (header) != len + 1)
848 args_out_of_range (header, make_number (len + 1));
850 else
852 if (len <= 8)
853 header = AREF (gstring_work_headers, len - 1);
854 else
855 header = Fmake_vector (make_number (len + 1), Qnil);
858 ASET (header, 0, font_object);
859 for (i = 0; i < len; i++)
861 int c;
863 if (NILP (string))
864 FETCH_CHAR_ADVANCE_NO_CHECK (c, from, from_byte);
865 else
866 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, from, from_byte);
867 ASET (header, i + 1, make_number (c));
869 return header;
872 extern void font_fill_lglyph_metrics P_ ((Lisp_Object, Lisp_Object));
874 static void
875 fill_gstring_body (gstring)
876 Lisp_Object gstring;
878 Lisp_Object font_object = LGSTRING_FONT (gstring);
879 Lisp_Object header = AREF (gstring, 0);
880 EMACS_INT len = LGSTRING_CHAR_LEN (gstring);
881 EMACS_INT i;
883 for (i = 0; i < len; i++)
885 Lisp_Object g = LGSTRING_GLYPH (gstring, i);
886 EMACS_INT c = XINT (AREF (header, i + 1));
888 if (NILP (g))
890 g = LGLYPH_NEW ();
891 LGSTRING_SET_GLYPH (gstring, i, g);
893 LGLYPH_SET_FROM (g, i);
894 LGLYPH_SET_TO (g, i);
895 LGLYPH_SET_CHAR (g, c);
896 if (FONT_OBJECT_P (font_object))
898 font_fill_lglyph_metrics (g, font_object);
900 else
902 int width = XFASTINT (CHAR_TABLE_REF (Vchar_width_table, c));
904 LGLYPH_SET_CODE (g, c);
905 LGLYPH_SET_LBEARING (g, 0);
906 LGLYPH_SET_RBEARING (g, width);
907 LGLYPH_SET_WIDTH (g, width);
908 LGLYPH_SET_ASCENT (g, 1);
909 LGLYPH_SET_DESCENT (g, 0);
911 LGLYPH_SET_ADJUSTMENT (g, Qnil);
913 if (i < LGSTRING_GLYPH_LEN (gstring))
914 LGSTRING_SET_GLYPH (gstring, i, Qnil);
918 /* Try to compose the characters at CHARPOS according to CFT_ELEMENT
919 which is an element of composition-function-table (which see).
920 LIMIT limits the characters to compose. STRING, if not nil, is a
921 target string. WIN is a window where the characters are being
922 displayed. */
924 static Lisp_Object
925 autocmp_chars (cft_element, charpos, bytepos, limit, win, face, string)
926 Lisp_Object cft_element;
927 EMACS_INT charpos, bytepos, limit;
928 struct window *win;
929 struct face *face;
930 Lisp_Object string;
932 int count = SPECPDL_INDEX ();
933 FRAME_PTR f = XFRAME (win->frame);
934 Lisp_Object pos = make_number (charpos);
935 EMACS_INT pt = PT, pt_byte = PT_BYTE;
936 int lookback;
938 record_unwind_save_match_data ();
939 for (lookback = -1; CONSP (cft_element); cft_element = XCDR (cft_element))
941 Lisp_Object elt = XCAR (cft_element);
942 Lisp_Object re;
943 Lisp_Object font_object = Qnil, gstring;
944 EMACS_INT len, to;
946 if (! VECTORP (elt) || ASIZE (elt) != 3)
947 continue;
948 if (lookback < 0)
950 lookback = XFASTINT (AREF (elt, 1));
951 if (limit > charpos + MAX_COMPOSITION_COMPONENTS)
952 limit = charpos + MAX_COMPOSITION_COMPONENTS;
954 else if (lookback != XFASTINT (AREF (elt, 1)))
955 break;
956 re = AREF (elt, 0);
957 if (NILP (re))
958 len = 1;
959 else if ((len = fast_looking_at (re, charpos, bytepos, limit, -1, string))
960 > 0)
962 if (NILP (string))
963 len = BYTE_TO_CHAR (bytepos + len) - charpos;
964 else
965 len = string_byte_to_char (string, bytepos + len) - charpos;
967 if (len > 0)
969 limit = to = charpos + len;
970 #ifdef HAVE_WINDOW_SYSTEM
971 if (FRAME_WINDOW_P (f))
973 font_object = font_range (charpos, &to, win, face, string);
974 if (! FONT_OBJECT_P (font_object)
975 || (! NILP (re)
976 && to < limit
977 && (fast_looking_at (re, charpos, bytepos, to, -1, string) <= 0)))
979 if (NILP (string))
980 TEMP_SET_PT_BOTH (pt, pt_byte);
981 return unbind_to (count, Qnil);
984 else
985 #endif /* not HAVE_WINDOW_SYSTEM */
986 font_object = win->frame;
987 gstring = Fcomposition_get_gstring (pos, make_number (to),
988 font_object, string);
989 if (NILP (LGSTRING_ID (gstring)))
991 Lisp_Object args[6];
993 args[0] = Vauto_composition_function;
994 args[1] = AREF (elt, 2);
995 args[2] = pos;
996 args[3] = make_number (to);
997 args[4] = font_object;
998 args[5] = string;
999 gstring = safe_call (6, args);
1001 if (NILP (string))
1002 TEMP_SET_PT_BOTH (pt, pt_byte);
1003 return unbind_to (count, gstring);
1006 if (NILP (string))
1007 TEMP_SET_PT_BOTH (pt, pt_byte);
1008 return unbind_to (count, Qnil);
1012 /* Update cmp_it->stop_pos to the next position after CHARPOS (and
1013 BYTEPOS) where character composition may happen. If BYTEPOS is
1014 negative, compoute it. If it is a static composition, set
1015 cmp_it->ch to -1. Otherwise, set cmp_it->ch to the character that
1016 triggers a automatic composition. */
1018 void
1019 composition_compute_stop_pos (cmp_it, charpos, bytepos, endpos, string)
1020 struct composition_it *cmp_it;
1021 EMACS_INT charpos, bytepos, endpos;
1022 Lisp_Object string;
1024 EMACS_INT start, end, c;
1025 Lisp_Object prop, val;
1026 /* This is from forward_to_next_line_start in xdisp.c. */
1027 const int MAX_NEWLINE_DISTANCE = 500;
1029 if (endpos > charpos + MAX_NEWLINE_DISTANCE)
1030 endpos = charpos + MAX_NEWLINE_DISTANCE;
1031 cmp_it->stop_pos = endpos;
1032 cmp_it->id = -1;
1033 cmp_it->ch = -2;
1034 if (find_composition (charpos, endpos, &start, &end, &prop, string)
1035 && COMPOSITION_VALID_P (start, end, prop))
1037 cmp_it->stop_pos = endpos = start;
1038 cmp_it->ch = -1;
1040 if (NILP (string) && PT > charpos && PT < endpos)
1041 cmp_it->stop_pos = PT;
1042 if (NILP (current_buffer->enable_multibyte_characters)
1043 || NILP (Vauto_composition_mode))
1044 return;
1045 if (bytepos < 0)
1047 if (STRINGP (string))
1048 bytepos = string_char_to_byte (string, charpos);
1049 else
1050 bytepos = CHAR_TO_BYTE (charpos);
1053 start = charpos;
1054 while (charpos < endpos)
1056 if (STRINGP (string))
1057 FETCH_STRING_CHAR_ADVANCE (c, string, charpos, bytepos);
1058 else
1059 FETCH_CHAR_ADVANCE (c, charpos, bytepos);
1060 if (c == '\n')
1062 cmp_it->ch = -2;
1063 break;
1065 val = CHAR_TABLE_REF (Vcomposition_function_table, c);
1066 if (! NILP (val))
1068 Lisp_Object elt;
1070 for (; CONSP (val); val = XCDR (val))
1072 elt = XCAR (val);
1073 if (VECTORP (elt) && ASIZE (elt) == 3 && NATNUMP (AREF (elt, 1))
1074 && charpos - 1 - XFASTINT (AREF (elt, 1)) >= start)
1075 break;
1077 if (CONSP (val))
1079 cmp_it->lookback = XFASTINT (AREF (elt, 1));
1080 cmp_it->stop_pos = charpos - 1 - cmp_it->lookback;
1081 cmp_it->ch = c;
1082 return;
1086 cmp_it->stop_pos = charpos;
1089 /* Check if the character at CHARPOS (and BYTEPOS) is composed
1090 (possibly with the following characters) on window W. ENDPOS limits
1091 characters to be composed. FACE, in non-NULL, is a base face of
1092 the character. If STRING is not nil, it is a string containing the
1093 character to check, and CHARPOS and BYTEPOS are indices in the
1094 string. In that case, FACE must not be NULL.
1096 If the character is composed, setup members of CMP_IT (id, nglyphs,
1097 and from), and return 1. Otherwise, update CMP_IT->stop_pos, and
1098 return 0. */
1101 composition_reseat_it (cmp_it, charpos, bytepos, endpos, w, face, string)
1102 struct composition_it *cmp_it;
1103 EMACS_INT charpos, bytepos, endpos;
1104 struct window *w;
1105 struct face *face;
1106 Lisp_Object string;
1108 if (NILP (string) && charpos < PT && PT < endpos)
1109 endpos = PT;
1111 if (cmp_it->ch == -2)
1113 composition_compute_stop_pos (cmp_it, charpos, bytepos, endpos, string);
1114 if (cmp_it->ch == -2)
1115 return 0;
1118 if (cmp_it->ch < 0)
1120 /* We are looking at a static composition. */
1121 EMACS_INT start, end;
1122 Lisp_Object prop;
1124 find_composition (charpos, -1, &start, &end, &prop, string);
1125 cmp_it->id = get_composition_id (charpos, bytepos, end - start,
1126 prop, string);
1127 if (cmp_it->id < 0)
1128 goto no_composition;
1129 cmp_it->nchars = end - start;
1130 cmp_it->nglyphs = composition_table[cmp_it->id]->glyph_len;
1132 else if (w)
1134 Lisp_Object val, elt;
1135 int i;
1137 val = CHAR_TABLE_REF (Vcomposition_function_table, cmp_it->ch);
1138 for (; CONSP (val); val = XCDR (val))
1140 elt = XCAR (val);
1141 if (cmp_it->lookback == XFASTINT (AREF (elt, 1)))
1142 break;
1144 if (NILP (val))
1145 goto no_composition;
1147 val = autocmp_chars (val, charpos, bytepos, endpos, w, face, string);
1148 if (! composition_gstring_p (val))
1149 goto no_composition;
1150 if (NILP (LGSTRING_ID (val)))
1151 val = composition_gstring_put_cache (val, -1);
1152 cmp_it->id = XINT (LGSTRING_ID (val));
1153 for (i = 0; i < LGSTRING_GLYPH_LEN (val); i++)
1154 if (NILP (LGSTRING_GLYPH (val, i)))
1155 break;
1156 cmp_it->nglyphs = i;
1158 else
1159 goto no_composition;
1160 cmp_it->from = 0;
1161 return 1;
1163 no_composition:
1164 charpos++;
1165 if (STRINGP (string))
1166 bytepos += MULTIBYTE_LENGTH_NO_CHECK (SDATA (string) + bytepos);
1167 else
1168 INC_POS (bytepos);
1169 composition_compute_stop_pos (cmp_it, charpos, bytepos, endpos, string);
1170 return 0;
1174 composition_update_it (cmp_it, charpos, bytepos, string)
1175 struct composition_it *cmp_it;
1176 EMACS_INT charpos, bytepos;
1177 Lisp_Object string;
1179 int i, c;
1181 if (cmp_it->ch < 0)
1183 struct composition *cmp = composition_table[cmp_it->id];
1185 cmp_it->to = cmp_it->nglyphs;
1186 if (cmp_it->nglyphs == 0)
1187 c = -1;
1188 else
1190 for (i = 0; i < cmp->glyph_len; i++)
1191 if ((c = COMPOSITION_GLYPH (cmp, i)) != '\t')
1192 break;
1193 if (c == '\t')
1194 c = ' ';
1196 cmp_it->width = cmp->width;
1198 else
1200 Lisp_Object gstring = composition_gstring_from_id (cmp_it->id);
1202 if (cmp_it->nglyphs == 0)
1204 c = -1;
1205 cmp_it->nchars = LGSTRING_CHAR_LEN (gstring);
1206 cmp_it->width = 0;
1208 else
1210 Lisp_Object glyph = LGSTRING_GLYPH (gstring, cmp_it->from);
1211 int from = LGLYPH_FROM (glyph);
1213 c = XINT (LGSTRING_CHAR (gstring, from));
1214 cmp_it->nchars = LGLYPH_TO (glyph) - from + 1;
1215 cmp_it->width = (LGLYPH_WIDTH (glyph) > 0
1216 ? CHAR_WIDTH (LGLYPH_CHAR (glyph)) : 0);
1217 for (cmp_it->to = cmp_it->from + 1; cmp_it->to < cmp_it->nglyphs;
1218 cmp_it->to++)
1220 glyph = LGSTRING_GLYPH (gstring, cmp_it->to);
1221 if (LGLYPH_FROM (glyph) != from)
1222 break;
1223 if (LGLYPH_WIDTH (glyph) > 0)
1224 cmp_it->width += CHAR_WIDTH (LGLYPH_CHAR (glyph));
1229 charpos += cmp_it->nchars;
1230 if (STRINGP (string))
1231 cmp_it->nbytes = string_char_to_byte (string, charpos) - bytepos;
1232 else
1233 cmp_it->nbytes = CHAR_TO_BYTE (charpos) - bytepos;
1234 return c;
1238 struct position_record
1240 EMACS_INT pos, pos_byte;
1241 unsigned char *p;
1244 /* Update the members of POSTION to the next character boundary. */
1245 #define FORWARD_CHAR(POSITION, STOP) \
1246 do { \
1247 (POSITION).pos++; \
1248 if ((POSITION).pos == (STOP)) \
1250 (POSITION).p = GAP_END_ADDR; \
1251 (POSITION).pos_byte = GPT_BYTE; \
1253 else \
1255 (POSITION).pos_byte += BYTES_BY_CHAR_HEAD (*((POSITION).p)); \
1256 (POSITION).p += BYTES_BY_CHAR_HEAD (*((POSITION).p)); \
1258 } while (0)
1260 /* Update the members of POSTION to the previous character boundary. */
1261 #define BACKWARD_CHAR(POSITION, STOP) \
1262 do { \
1263 if ((POSITION).pos == STOP) \
1264 (POSITION).p = GPT_ADDR; \
1265 do { \
1266 (POSITION).pos_byte--; \
1267 (POSITION).p--; \
1268 } while (! CHAR_HEAD_P (*((POSITION).p))); \
1269 (POSITION).pos--; \
1270 } while (0)
1272 static Lisp_Object _work_val;
1273 static int _work_char;
1275 /* 1 iff the character C is composable. */
1276 #define CHAR_COMPOSABLE_P(C) \
1277 ((C) == 0x200C || (C) == 0x200D \
1278 || (_work_val = CHAR_TABLE_REF (Vunicode_category_table, (C)), \
1279 (SYMBOLP (_work_val) \
1280 && (_work_char = SDATA (SYMBOL_NAME (_work_val))[0]) != 'C' \
1281 && _work_char != 'Z')))
1283 /* This is like find_composition, but find an automatic composition
1284 instead. If found, set *GSTRING to the glyph-string representing
1285 the composition, and return 1. Otherwise, return 0. */
1287 static int
1288 find_automatic_composition (pos, limit, start, end, gstring, string)
1289 EMACS_INT pos, limit, *start, *end;
1290 Lisp_Object *gstring, string;
1292 EMACS_INT head, tail, stop;
1293 /* Limit to check a composition after POS. */
1294 EMACS_INT fore_check_limit;
1295 struct position_record orig, cur, check, prev;
1296 Lisp_Object check_val, val, elt;
1297 int check_lookback;
1298 int c;
1299 Lisp_Object window;
1300 struct window *w;
1302 window = Fget_buffer_window (Fcurrent_buffer (), Qnil);
1303 if (NILP (window))
1304 return 0;
1305 w = XWINDOW (window);
1307 orig.pos = pos;
1308 if (NILP (string))
1310 head = BEGV, tail = ZV, stop = GPT;
1311 orig.pos_byte = CHAR_TO_BYTE (orig.pos);
1312 orig.p = BYTE_POS_ADDR (orig.pos_byte);
1314 else
1316 head = 0, tail = SCHARS (string), stop = -1;
1317 orig.pos_byte = string_char_to_byte (string, orig.pos);
1318 orig.p = SDATA (string) + orig.pos_byte;
1320 if (limit < pos)
1321 fore_check_limit = min (tail, pos + MAX_AUTO_COMPOSITION_LOOKBACK);
1322 else
1323 fore_check_limit = min (tail, limit + MAX_AUTO_COMPOSITION_LOOKBACK);
1324 cur = orig;
1326 retry:
1327 check_val = Qnil;
1328 /* At first, check if POS is composable. */
1329 c = STRING_CHAR (cur.p);
1330 if (! CHAR_COMPOSABLE_P (c))
1332 if (limit < 0)
1333 return 0;
1334 if (limit >= cur.pos)
1335 goto search_forward;
1337 else
1339 val = CHAR_TABLE_REF (Vcomposition_function_table, c);
1340 if (! NILP (val))
1341 check_val = val, check = cur;
1342 else
1343 while (cur.pos + 1 < fore_check_limit)
1345 EMACS_INT b, e;
1347 FORWARD_CHAR (cur, stop);
1348 if (get_property_and_range (cur.pos, Qcomposition, &val, &b, &e,
1349 Qnil)
1350 && COMPOSITION_VALID_P (b, e, val))
1352 fore_check_limit = cur.pos;
1353 break;
1355 c = STRING_CHAR (cur.p);
1356 if (! CHAR_COMPOSABLE_P (c))
1357 break;
1358 val = CHAR_TABLE_REF (Vcomposition_function_table, c);
1359 if (NILP (val))
1360 continue;
1361 check_val = val, check = cur;
1362 break;
1364 cur = orig;
1366 /* Rewind back to the position where we can safely search forward
1367 for compositions. */
1368 while (cur.pos > head)
1370 EMACS_INT b, e;
1372 BACKWARD_CHAR (cur, stop);
1373 if (get_property_and_range (cur.pos, Qcomposition, &val, &b, &e, Qnil)
1374 && COMPOSITION_VALID_P (b, e, val))
1375 break;
1376 c = STRING_CHAR (cur.p);
1377 if (! CHAR_COMPOSABLE_P (c))
1378 break;
1379 val = CHAR_TABLE_REF (Vcomposition_function_table, c);
1380 if (! NILP (val))
1381 check_val = val, check = cur;
1383 prev = cur;
1384 /* Now search forward. */
1385 search_forward:
1386 *gstring = Qnil;
1387 if (! NILP (check_val) || limit >= orig.pos)
1389 if (NILP (check_val))
1390 cur = orig;
1391 else
1392 cur = check;
1393 while (cur.pos < fore_check_limit)
1395 int need_adjustment = 0;
1397 if (NILP (check_val))
1399 c = STRING_CHAR (cur.p);
1400 check_val = CHAR_TABLE_REF (Vcomposition_function_table, c);
1402 for (; CONSP (check_val); check_val = XCDR (check_val))
1404 elt = XCAR (check_val);
1405 if (VECTORP (elt) && ASIZE (elt) == 3 && NATNUMP (AREF (elt, 1))
1406 && cur.pos - XFASTINT (AREF (elt, 1)) >= head)
1408 check.pos = cur.pos - XFASTINT (AREF (elt, 1));
1409 if (check.pos == cur.pos)
1410 check.pos_byte = cur.pos_byte;
1411 else
1412 check.pos_byte = CHAR_TO_BYTE (check.pos);
1413 val = autocmp_chars (check_val, check.pos, check.pos_byte,
1414 tail, w, NULL, string);
1415 need_adjustment = 1;
1416 if (! NILP (val))
1418 *gstring = val;
1419 *start = check.pos;
1420 *end = check.pos + LGSTRING_CHAR_LEN (*gstring);
1421 if (*start <= orig.pos ? *end > orig.pos
1422 : limit >= orig.pos)
1423 return 1;
1424 cur.pos = *end;
1425 cur.pos_byte = CHAR_TO_BYTE (cur.pos);
1426 break;
1430 if (need_adjustment)
1432 /* As we have called Lisp, there's a possibilily that
1433 buffer/string is relocated. */
1434 if (NILP (string))
1435 cur.p = BYTE_POS_ADDR (cur.pos_byte);
1436 else
1437 cur.p = SDATA (string) + cur.pos_byte;
1439 if (! CONSP (check_val))
1440 FORWARD_CHAR (cur, stop);
1441 check_val = Qnil;
1444 if (! NILP (*gstring))
1445 return (limit >= 0 || (*start <= orig.pos && *end > orig.pos));
1446 if (limit >= 0 && limit < orig.pos && prev.pos > head)
1448 cur = prev;
1449 BACKWARD_CHAR (cur, stop);
1450 orig = cur;
1451 fore_check_limit = orig.pos;
1452 goto retry;
1454 return 0;
1457 /* Return the adjusted point provided that point is moved from LAST_PT
1458 to NEW_PT. */
1461 composition_adjust_point (last_pt, new_pt)
1462 EMACS_INT last_pt, new_pt;
1464 EMACS_INT charpos, bytepos, startpos, beg, end, pos;
1465 Lisp_Object val;
1466 int i;
1468 if (new_pt == BEGV || new_pt == ZV)
1469 return new_pt;
1471 /* At first check the static composition. */
1472 if (get_property_and_range (new_pt, Qcomposition, &val, &beg, &end, Qnil)
1473 && COMPOSITION_VALID_P (beg, end, val))
1475 if (beg < new_pt /* && end > new_pt <- It's always the case. */
1476 && (last_pt <= beg || last_pt >= end))
1477 return (new_pt < last_pt ? beg : end);
1478 return new_pt;
1481 if (NILP (current_buffer->enable_multibyte_characters)
1482 || NILP (Vauto_composition_mode))
1483 return new_pt;
1485 /* Next check the automatic composition. */
1486 if (! find_automatic_composition (new_pt, (EMACS_INT) -1, &beg, &end, &val,
1487 Qnil)
1488 || beg == new_pt)
1489 return new_pt;
1490 for (i = 0; i < LGSTRING_GLYPH_LEN (val); i++)
1492 Lisp_Object glyph = LGSTRING_GLYPH (val, i);
1494 if (NILP (glyph))
1495 break;
1496 if (beg + LGLYPH_FROM (glyph) == new_pt)
1497 return new_pt;
1498 if (beg + LGLYPH_TO (glyph) >= new_pt)
1499 return (new_pt < last_pt
1500 ? beg + LGLYPH_FROM (glyph)
1501 : beg + LGLYPH_TO (glyph) + 1);
1503 return new_pt;
1506 DEFUN ("composition-get-gstring", Fcomposition_get_gstring,
1507 Scomposition_get_gstring, 4, 4, 0,
1508 doc: /* Return a glyph-string for characters between FROM and TO.
1509 If the glyph string is for graphic display, FONT-OBJECT must be
1510 a font-object to use for those characters.
1511 Otherwise (for terminal display), FONT-OBJECT must be a terminal ID, a
1512 frame, or nil for the selected frame's terminal device.
1514 If the optional 4th argument STRING is not nil, it is a string
1515 containing the target characters between indices FROM and TO.
1517 A glyph-string is a vector containing information about how to display
1518 a specific character sequence. The format is:
1519 [HEADER ID GLYPH ...]
1521 HEADER is a vector of this form:
1522 [FONT-OBJECT CHAR ...]
1523 where
1524 FONT-OBJECT is a font-object for all glyphs in the glyph-string,
1525 or the terminal coding system of the specified terminal.
1526 CHARs are characters to be composed by GLYPHs.
1528 ID is an identification number of the glyph-string. It may be nil if
1529 not yet shaped.
1531 GLYPH is a vector whose elements have this form:
1532 [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT
1533 [ [X-OFF Y-OFF WADJUST] | nil] ]
1534 where
1535 FROM-IDX and TO-IDX are used internally and should not be touched.
1536 C is the character of the glyph.
1537 CODE is the glyph-code of C in FONT-OBJECT.
1538 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
1539 X-OFF and Y-OFF are offsets to the base position for the glyph.
1540 WADJUST is the adjustment to the normal width of the glyph.
1542 If GLYPH is nil, the remaining elements of the glyph-string vector
1543 should be ignored. */)
1544 (from, to, font_object, string)
1545 Lisp_Object font_object, from, to, string;
1547 Lisp_Object gstring, header;
1548 EMACS_INT frompos, topos;
1550 CHECK_NATNUM (from);
1551 CHECK_NATNUM (to);
1552 if (XINT (to) > XINT (from) + MAX_COMPOSITION_COMPONENTS)
1553 to = make_number (XINT (from) + MAX_COMPOSITION_COMPONENTS);
1554 if (! FONT_OBJECT_P (font_object))
1556 struct coding_system *coding;
1557 struct terminal *terminal = get_terminal (font_object, 1);
1559 coding = ((TERMINAL_TERMINAL_CODING (terminal)->common_flags
1560 & CODING_REQUIRE_ENCODING_MASK)
1561 ? TERMINAL_TERMINAL_CODING (terminal) : &safe_terminal_coding);
1562 font_object = CODING_ID_NAME (coding->id);
1565 header = fill_gstring_header (Qnil, from, to, font_object, string);
1566 gstring = gstring_lookup_cache (header);
1567 if (! NILP (gstring))
1568 return gstring;
1570 frompos = XINT (from);
1571 topos = XINT (to);
1572 if (LGSTRING_GLYPH_LEN (gstring_work) < topos - frompos)
1573 gstring_work = Fmake_vector (make_number (topos - frompos + 2), Qnil);
1574 LGSTRING_SET_HEADER (gstring_work, header);
1575 LGSTRING_SET_ID (gstring_work, Qnil);
1576 fill_gstring_body (gstring_work);
1577 return gstring_work;
1581 /* Emacs Lisp APIs. */
1583 DEFUN ("compose-region-internal", Fcompose_region_internal,
1584 Scompose_region_internal, 2, 4, 0,
1585 doc: /* Internal use only.
1587 Compose text in the region between START and END.
1588 Optional 3rd and 4th arguments are COMPONENTS and MODIFICATION-FUNC
1589 for the composition. See `compose-region' for more details. */)
1590 (start, end, components, modification_func)
1591 Lisp_Object start, end, components, modification_func;
1593 validate_region (&start, &end);
1594 if (!NILP (components)
1595 && !INTEGERP (components)
1596 && !CONSP (components)
1597 && !STRINGP (components))
1598 CHECK_VECTOR (components);
1600 compose_text (XINT (start), XINT (end), components, modification_func, Qnil);
1601 return Qnil;
1604 DEFUN ("compose-string-internal", Fcompose_string_internal,
1605 Scompose_string_internal, 3, 5, 0,
1606 doc: /* Internal use only.
1608 Compose text between indices START and END of STRING.
1609 Optional 4th and 5th arguments are COMPONENTS and MODIFICATION-FUNC
1610 for the composition. See `compose-string' for more details. */)
1611 (string, start, end, components, modification_func)
1612 Lisp_Object string, start, end, components, modification_func;
1614 CHECK_STRING (string);
1615 CHECK_NUMBER (start);
1616 CHECK_NUMBER (end);
1618 if (XINT (start) < 0 ||
1619 XINT (start) > XINT (end)
1620 || XINT (end) > SCHARS (string))
1621 args_out_of_range (start, end);
1623 compose_text (XINT (start), XINT (end), components, modification_func, string);
1624 return string;
1627 DEFUN ("find-composition-internal", Ffind_composition_internal,
1628 Sfind_composition_internal, 4, 4, 0,
1629 doc: /* Internal use only.
1631 Return information about composition at or nearest to position POS.
1632 See `find-composition' for more details. */)
1633 (pos, limit, string, detail_p)
1634 Lisp_Object pos, limit, string, detail_p;
1636 Lisp_Object prop, tail, gstring;
1637 EMACS_INT start, end, from, to;
1638 int id;
1640 CHECK_NUMBER_COERCE_MARKER (pos);
1641 from = XINT (pos);
1642 if (!NILP (limit))
1644 CHECK_NUMBER_COERCE_MARKER (limit);
1645 to = XINT (limit);
1647 else
1648 to = -1;
1650 if (!NILP (string))
1652 CHECK_STRING (string);
1653 if (XINT (pos) < 0 || XINT (pos) > SCHARS (string))
1654 args_out_of_range (string, pos);
1656 else
1658 if (XINT (pos) < BEGV || XINT (pos) > ZV)
1659 args_out_of_range (Fcurrent_buffer (), pos);
1662 if (!find_composition (from, to, &start, &end, &prop, string))
1664 if (!NILP (current_buffer->enable_multibyte_characters)
1665 && ! NILP (Vauto_composition_mode)
1666 && find_automatic_composition (from, to, &start, &end, &gstring,
1667 string))
1668 return list3 (make_number (start), make_number (end), gstring);
1669 return Qnil;
1671 if ((end <= XINT (pos) || start > XINT (pos)))
1673 EMACS_INT s, e;
1675 if (find_automatic_composition (from, to, &s, &e, &gstring, string)
1676 && (e <= XINT (pos) ? e > end : s < start))
1677 return list3 (make_number (start), make_number (end), gstring);
1679 if (!COMPOSITION_VALID_P (start, end, prop))
1680 return Fcons (make_number (start), Fcons (make_number (end),
1681 Fcons (Qnil, Qnil)));
1682 if (NILP (detail_p))
1683 return Fcons (make_number (start), Fcons (make_number (end),
1684 Fcons (Qt, Qnil)));
1686 if (COMPOSITION_REGISTERD_P (prop))
1687 id = COMPOSITION_ID (prop);
1688 else
1690 int start_byte = (NILP (string)
1691 ? CHAR_TO_BYTE (start)
1692 : string_char_to_byte (string, start));
1693 id = get_composition_id (start, start_byte, end - start, prop, string);
1696 if (id >= 0)
1698 Lisp_Object components, relative_p, mod_func;
1699 enum composition_method method = COMPOSITION_METHOD (prop);
1700 int width = composition_table[id]->width;
1702 components = Fcopy_sequence (COMPOSITION_COMPONENTS (prop));
1703 relative_p = (method == COMPOSITION_WITH_RULE_ALTCHARS
1704 ? Qnil : Qt);
1705 mod_func = COMPOSITION_MODIFICATION_FUNC (prop);
1706 tail = Fcons (components,
1707 Fcons (relative_p,
1708 Fcons (mod_func,
1709 Fcons (make_number (width), Qnil))));
1711 else
1712 tail = Qnil;
1714 return Fcons (make_number (start), Fcons (make_number (end), tail));
1718 void
1719 syms_of_composite ()
1721 int i;
1723 Qcomposition = intern_c_string ("composition");
1724 staticpro (&Qcomposition);
1726 /* Make a hash table for static composition. */
1728 Lisp_Object args[6];
1729 extern Lisp_Object QCsize;
1731 args[0] = QCtest;
1732 args[1] = Qequal;
1733 args[2] = QCweakness;
1734 /* We used to make the hash table weak so that unreferenced
1735 compositions can be garbage-collected. But, usually once
1736 created compositions are repeatedly used in an Emacs session,
1737 and thus it's not worth to save memory in such a way. So, we
1738 make the table not weak. */
1739 args[3] = Qnil;
1740 args[4] = QCsize;
1741 args[5] = make_number (311);
1742 composition_hash_table = Fmake_hash_table (6, args);
1743 staticpro (&composition_hash_table);
1746 /* Make a hash table for glyph-string. */
1748 Lisp_Object args[6];
1749 extern Lisp_Object QCsize;
1751 args[0] = QCtest;
1752 args[1] = Qequal;
1753 args[2] = QCweakness;
1754 args[3] = Qnil;
1755 args[4] = QCsize;
1756 args[5] = make_number (311);
1757 gstring_hash_table = Fmake_hash_table (6, args);
1758 staticpro (&gstring_hash_table);
1761 staticpro (&gstring_work_headers);
1762 gstring_work_headers = Fmake_vector (make_number (8), Qnil);
1763 for (i = 0; i < 8; i++)
1764 ASET (gstring_work_headers, i, Fmake_vector (make_number (i + 2), Qnil));
1765 staticpro (&gstring_work);
1766 gstring_work = Fmake_vector (make_number (10), Qnil);
1768 /* Text property `composition' should be nonsticky by default. */
1769 Vtext_property_default_nonsticky
1770 = Fcons (Fcons (Qcomposition, Qt), Vtext_property_default_nonsticky);
1772 DEFVAR_LISP ("compose-chars-after-function", &Vcompose_chars_after_function,
1773 doc: /* Function to adjust composition of buffer text.
1775 This function is called with three arguments: FROM, TO, and OBJECT.
1776 FROM and TO specify the range of text whose composition should be
1777 adjusted. OBJECT, if non-nil, is a string that contains the text.
1779 This function is called after a text with `composition' property is
1780 inserted or deleted to keep `composition' property of buffer text
1781 valid.
1783 The default value is the function `compose-chars-after'. */);
1784 Vcompose_chars_after_function = intern_c_string ("compose-chars-after");
1786 Qauto_composed = intern_c_string ("auto-composed");
1787 staticpro (&Qauto_composed);
1789 Qauto_composition_function = intern_c_string ("auto-composition-function");
1790 staticpro (&Qauto_composition_function);
1792 DEFVAR_LISP ("auto-composition-mode", &Vauto_composition_mode,
1793 doc: /* Non-nil if Auto-Composition mode is enabled.
1794 Use the command `auto-composition-mode' to change this variable. */);
1795 Vauto_composition_mode = Qt;
1797 DEFVAR_LISP ("auto-composition-function", &Vauto_composition_function,
1798 doc: /* Function to call to compose characters automatically.
1799 This function is called from the display routine with four arguments:
1800 FROM, TO, WINDOW, and STRING.
1802 If STRING is nil, the function must compose characters in the region
1803 between FROM and TO in the current buffer.
1805 Otherwise, STRING is a string, and FROM and TO are indices into the
1806 string. In this case, the function must compose characters in the
1807 string. */);
1808 Vauto_composition_function = Qnil;
1810 DEFVAR_LISP ("composition-function-table", &Vcomposition_function_table,
1811 doc: /* Char-table of functions for automatic character composition.
1812 For each character that has to be composed automatically with
1813 preceding and/or following characters, this char-table contains
1814 a function to call to compose that character.
1816 The element at index C in the table, if non-nil, is a list of
1817 this form: ([PATTERN PREV-CHARS FUNC] ...)
1819 PATTERN is a regular expression which C and the surrounding
1820 characters must match.
1822 PREV-CHARS is a non-negative integer (less than 4) specifying how many
1823 characters before C to check the matching with PATTERN. If it is 0,
1824 PATTERN must match C and the following characters. If it is 1,
1825 PATTERN must match a character before C and the following characters.
1827 If PREV-CHARS is 0, PATTERN can be nil, which means that the
1828 single character C should be composed.
1830 FUNC is a function to return a glyph-string representing a
1831 composition of the characters that match PATTERN. It is
1832 called with one argument GSTRING.
1834 GSTRING is a template of a glyph-string to return. It is already
1835 filled with a proper header for the characters to compose, and
1836 glyphs corresponding to those characters one by one. The
1837 function must return a new glyph-string with the same header as
1838 GSTRING, or modify GSTRING itself and return it.
1840 See also the documentation of `auto-composition-mode'. */);
1841 Vcomposition_function_table = Fmake_char_table (Qnil, Qnil);
1843 defsubr (&Scompose_region_internal);
1844 defsubr (&Scompose_string_internal);
1845 defsubr (&Sfind_composition_internal);
1846 defsubr (&Scomposition_get_gstring);
1849 /* arch-tag: 79cefaf8-ca48-4eed-97e5-d5afb290d272
1850 (do not change this comment) */