Update copyright year to 2014 by running admin/update-copyright.
[emacs.git] / src / composite.c
blob367fc8e3f9f99fcc0979e35012b1f9d8d7e51cc4
1 /* Composite sequence support.
2 Copyright (C) 2001-2014 Free Software Foundation, Inc.
3 Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
4 National Institute of Advanced Industrial Science and Technology (AIST)
5 Registration Number H14PRO021
6 Copyright (C) 2003, 2006
7 National Institute of Advanced Industrial Science and Technology (AIST)
8 Registration Number H13PRO009
10 This file is part of GNU Emacs.
12 GNU Emacs is free software: you can redistribute it and/or modify
13 it under the terms of the GNU General Public License as published by
14 the Free Software Foundation, either version 3 of the License, or
15 (at your option) any later version.
17 GNU Emacs is distributed in the hope that it will be useful,
18 but WITHOUT ANY WARRANTY; without even the implied warranty of
19 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 GNU General Public License for more details.
22 You should have received a copy of the GNU General Public License
23 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
25 #include <config.h>
27 #include "lisp.h"
28 #include "character.h"
29 #include "buffer.h"
30 #include "coding.h"
31 #include "intervals.h"
32 #include "window.h"
33 #include "frame.h"
34 #include "dispextern.h"
35 #include "font.h"
36 #include "termhooks.h"
39 /* Emacs uses special text property `composition' to support character
40 composition. A sequence of characters that have the same (i.e. eq)
41 `composition' property value is treated as a single composite
42 sequence (we call it just `composition' here after). Characters in
43 a composition are all composed somehow on the screen.
45 The property value has this form when the composition is made:
46 ((LENGTH . COMPONENTS) . MODIFICATION-FUNC)
47 then turns to this form:
48 (COMPOSITION-ID . (LENGTH COMPONENTS-VEC . MODIFICATION-FUNC))
49 when the composition is registered in composition_hash_table and
50 composition_table. These rather peculiar structures were designed
51 to make it easy to distinguish them quickly (we can do that by
52 checking only the first element) and to extract LENGTH (from the
53 former form) and COMPOSITION-ID (from the latter form).
55 We register a composition when it is displayed, or when the width
56 is required (for instance, to calculate columns).
58 LENGTH -- Length of the composition. This information is used to
59 check the validity of the composition.
61 COMPONENTS -- Character, string, vector, list, or nil.
63 If it is nil, characters in the text are composed relatively
64 according to their metrics in font glyphs.
66 If it is a character or a string, the character or characters
67 in the string are composed relatively.
69 If it is a vector or list of integers, the element is a
70 character or an encoded composition rule. The characters are
71 composed according to the rules. (2N)th elements are
72 characters to be composed and (2N+1)th elements are
73 composition rules to tell how to compose (2N+2)th element with
74 the previously composed 2N glyphs.
76 COMPONENTS-VEC -- Vector of integers. In a relative composition,
77 the elements are the characters to be composed. In a rule-base
78 composition, the elements are characters or encoded
79 composition rules.
81 MODIFICATION-FUNC -- If non nil, it is a function to call when the
82 composition gets invalid after a modification in a buffer. If
83 it is nil, a function in `composition-function-table' of the
84 first character in the sequence is called.
86 COMPOSITION-ID --Identification number of the composition. It is
87 used as an index to composition_table for the composition.
89 When Emacs has to display a composition or has to know its
90 displaying width, the function get_composition_id is called. It
91 returns COMPOSITION-ID so that the caller can access the
92 information about the composition through composition_table. If a
93 COMPOSITION-ID has not yet been assigned to the composition,
94 get_composition_id checks the validity of `composition' property,
95 and, if valid, assigns a new ID, registers the information in
96 composition_hash_table and composition_table, and changes the form
97 of the property value. If the property is invalid,
98 get_composition_id returns -1 without changing the property value.
100 We use two tables to keep the information about composition;
101 composition_hash_table and composition_table.
103 The former is a hash table whose keys are COMPONENTS-VECs and
104 values are the corresponding COMPOSITION-IDs. This hash table is
105 weak, but as each key (COMPONENTS-VEC) is also kept as a value of the
106 `composition' property, it won't be collected as garbage until all
107 bits of text that have the same COMPONENTS-VEC are deleted.
109 The latter is a table of pointers to `struct composition' indexed
110 by COMPOSITION-ID. This structure keeps the other information (see
111 composite.h).
113 In general, a text property holds information about individual
114 characters. But, a `composition' property holds information about
115 a sequence of characters (in this sense, it is like the `intangible'
116 property). That means that we should not share the property value
117 in adjacent compositions -- we can't distinguish them if they have the
118 same property. So, after any changes, we call
119 `update_compositions' and change a property of one of adjacent
120 compositions to a copy of it. This function also runs a proper
121 composition modification function to make a composition that gets
122 invalid by the change valid again.
124 As the value of the `composition' property holds information about a
125 specific range of text, the value gets invalid if we change the
126 text in the range. We treat the `composition' property as always
127 rear-nonsticky (currently by setting default-text-properties to
128 (rear-nonsticky (composition))) and we never make properties of
129 adjacent compositions identical. Thus, any such changes make the
130 range just shorter. So, we can check the validity of the `composition'
131 property by comparing LENGTH information with the actual length of
132 the composition.
137 Lisp_Object Qcomposition;
139 /* Table of pointers to the structure `composition' indexed by
140 COMPOSITION-ID. This structure is for storing information about
141 each composition except for COMPONENTS-VEC. */
142 struct composition **composition_table;
144 /* The current size of `composition_table'. */
145 static ptrdiff_t composition_table_size;
147 /* Number of compositions currently made. */
148 ptrdiff_t n_compositions;
150 /* Hash table for compositions. The key is COMPONENTS-VEC of
151 `composition' property. The value is the corresponding
152 COMPOSITION-ID. */
153 Lisp_Object composition_hash_table;
155 static Lisp_Object Qauto_composed;
156 static Lisp_Object Qauto_composition_function;
157 /* Maximum number of characters to look back for
158 auto-compositions. */
159 #define MAX_AUTO_COMPOSITION_LOOKBACK 3
161 /* Return COMPOSITION-ID of a composition at buffer position
162 CHARPOS/BYTEPOS and length NCHARS. The `composition' property of
163 the sequence is PROP. STRING, if non-nil, is a string that
164 contains the composition instead of the current buffer.
166 If the composition is invalid, return -1. */
168 ptrdiff_t
169 get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars,
170 Lisp_Object prop, Lisp_Object string)
172 Lisp_Object id, length, components, key, *key_contents;
173 ptrdiff_t glyph_len;
174 struct Lisp_Hash_Table *hash_table = XHASH_TABLE (composition_hash_table);
175 ptrdiff_t hash_index;
176 EMACS_UINT hash_code;
177 enum composition_method method;
178 struct composition *cmp;
179 ptrdiff_t i;
180 int ch;
182 /* Maximum length of a string of glyphs. XftGlyphExtents limits
183 this to INT_MAX, and Emacs limits it further. Divide INT_MAX - 1
184 by 2 because x_produce_glyphs computes glyph_len * 2 + 1. Divide
185 the size by MAX_MULTIBYTE_LENGTH because encode_terminal_code
186 multiplies glyph_len by MAX_MULTIBYTE_LENGTH. */
187 enum {
188 GLYPH_LEN_MAX = min ((INT_MAX - 1) / 2,
189 min (PTRDIFF_MAX, SIZE_MAX) / MAX_MULTIBYTE_LENGTH)
192 /* PROP should be
193 Form-A: ((LENGTH . COMPONENTS) . MODIFICATION-FUNC)
195 Form-B: (COMPOSITION-ID . (LENGTH COMPONENTS-VEC . MODIFICATION-FUNC))
197 if (nchars == 0 || !CONSP (prop))
198 goto invalid_composition;
200 id = XCAR (prop);
201 if (INTEGERP (id))
203 /* PROP should be Form-B. */
204 if (XINT (id) < 0 || XINT (id) >= n_compositions)
205 goto invalid_composition;
206 return XINT (id);
209 /* PROP should be Form-A.
210 Thus, ID should be (LENGTH . COMPONENTS). */
211 if (!CONSP (id))
212 goto invalid_composition;
213 length = XCAR (id);
214 if (!INTEGERP (length) || XINT (length) != nchars)
215 goto invalid_composition;
217 components = XCDR (id);
219 /* Check if the same composition has already been registered or not
220 by consulting composition_hash_table. The key for this table is
221 COMPONENTS (converted to a vector COMPONENTS-VEC) or, if it is
222 nil, vector of characters in the composition range. */
223 if (INTEGERP (components))
224 key = Fmake_vector (make_number (1), components);
225 else if (STRINGP (components) || CONSP (components))
226 key = Fvconcat (1, &components);
227 else if (VECTORP (components))
228 key = components;
229 else if (NILP (components))
231 key = make_uninit_vector (nchars);
232 if (STRINGP (string))
233 for (i = 0; i < nchars; i++)
235 FETCH_STRING_CHAR_ADVANCE (ch, string, charpos, bytepos);
236 ASET (key, i, make_number (ch));
238 else
239 for (i = 0; i < nchars; i++)
241 FETCH_CHAR_ADVANCE (ch, charpos, bytepos);
242 ASET (key, i, make_number (ch));
245 else
246 goto invalid_composition;
248 hash_index = hash_lookup (hash_table, key, &hash_code);
249 if (hash_index >= 0)
251 /* We have already registered the same composition. Change PROP
252 from Form-A above to Form-B while replacing COMPONENTS with
253 COMPONENTS-VEC stored in the hash table. We can directly
254 modify the cons cell of PROP because it is not shared. */
255 key = HASH_KEY (hash_table, hash_index);
256 id = HASH_VALUE (hash_table, hash_index);
257 XSETCAR (prop, id);
258 XSETCDR (prop, Fcons (make_number (nchars), Fcons (key, XCDR (prop))));
259 return XINT (id);
262 /* This composition is a new one. We must register it. */
264 /* Check if we have sufficient memory to store this information. */
265 if (composition_table_size <= n_compositions)
266 composition_table = xpalloc (composition_table, &composition_table_size,
267 1, -1, sizeof *composition_table);
269 key_contents = XVECTOR (key)->contents;
271 /* Check if the contents of COMPONENTS are valid if COMPONENTS is a
272 vector or a list. It should be a sequence of:
273 char1 rule1 char2 rule2 char3 ... ruleN charN+1 */
275 if (VECTORP (components)
276 && ASIZE (components) >= 2
277 && VECTORP (AREF (components, 0)))
279 /* COMPONENTS is a glyph-string. */
280 ptrdiff_t len = ASIZE (key);
282 for (i = 1; i < len; i++)
283 if (! VECTORP (AREF (key, i)))
284 goto invalid_composition;
286 else if (VECTORP (components) || CONSP (components))
288 ptrdiff_t len = ASIZE (key);
290 /* The number of elements should be odd. */
291 if ((len % 2) == 0)
292 goto invalid_composition;
293 /* All elements should be integers (character or encoded
294 composition rule). */
295 for (i = 0; i < len; i++)
297 if (!INTEGERP (key_contents[i]))
298 goto invalid_composition;
302 /* Change PROP from Form-A above to Form-B. We can directly modify
303 the cons cell of PROP because it is not shared. */
304 XSETFASTINT (id, n_compositions);
305 XSETCAR (prop, id);
306 XSETCDR (prop, Fcons (make_number (nchars), Fcons (key, XCDR (prop))));
308 /* Register the composition in composition_hash_table. */
309 hash_index = hash_put (hash_table, key, id, hash_code);
311 method = (NILP (components)
312 ? COMPOSITION_RELATIVE
313 : ((INTEGERP (components) || STRINGP (components))
314 ? COMPOSITION_WITH_ALTCHARS
315 : COMPOSITION_WITH_RULE_ALTCHARS));
317 glyph_len = (method == COMPOSITION_WITH_RULE_ALTCHARS
318 ? (ASIZE (key) + 1) / 2
319 : ASIZE (key));
321 if (GLYPH_LEN_MAX < glyph_len)
322 memory_full (SIZE_MAX);
324 /* Register the composition in composition_table. */
325 cmp = xmalloc (sizeof *cmp);
327 cmp->method = method;
328 cmp->hash_index = hash_index;
329 cmp->glyph_len = glyph_len;
330 cmp->offsets = xnmalloc (glyph_len, 2 * sizeof *cmp->offsets);
331 cmp->font = NULL;
333 if (cmp->method != COMPOSITION_WITH_RULE_ALTCHARS)
335 /* Relative composition. */
336 cmp->width = 0;
337 for (i = 0; i < glyph_len; i++)
339 int this_width;
340 ch = XINT (key_contents[i]);
341 /* TAB in a composition means display glyphs with padding
342 space on the left or right. */
343 this_width = (ch == '\t' ? 1 : CHAR_WIDTH (ch));
344 if (cmp->width < this_width)
345 cmp->width = this_width;
348 else
350 /* Rule-base composition. */
351 double leftmost = 0.0, rightmost;
353 ch = XINT (key_contents[0]);
354 rightmost = ch != '\t' ? CHAR_WIDTH (ch) : 1;
356 for (i = 1; i < glyph_len; i += 2)
358 int rule, gref, nref;
359 int this_width;
360 double this_left;
362 rule = XINT (key_contents[i]);
363 ch = XINT (key_contents[i + 1]);
364 this_width = ch != '\t' ? CHAR_WIDTH (ch) : 1;
366 /* A composition rule is specified by an integer value
367 that encodes global and new reference points (GREF and
368 NREF). GREF and NREF are specified by numbers as
369 below:
370 0---1---2 -- ascent
374 9--10--11 -- center
376 ---3---4---5--- baseline
378 6---7---8 -- descent
380 COMPOSITION_DECODE_REFS (rule, gref, nref);
381 this_left = (leftmost
382 + (gref % 3) * (rightmost - leftmost) / 2.0
383 - (nref % 3) * this_width / 2.0);
385 if (this_left < leftmost)
386 leftmost = this_left;
387 if (this_left + this_width > rightmost)
388 rightmost = this_left + this_width;
391 cmp->width = rightmost - leftmost;
392 if (cmp->width < (rightmost - leftmost))
393 /* To get a ceiling integer value. */
394 cmp->width++;
397 composition_table[n_compositions] = cmp;
399 return n_compositions++;
401 invalid_composition:
402 /* Would it be better to remove this `composition' property? */
403 return -1;
407 /* Find a static composition at or nearest to position POS of OBJECT
408 (buffer or string).
410 OBJECT defaults to the current buffer. If there's a composition at
411 POS, set *START and *END to the start and end of the sequence,
412 *PROP to the `composition' property, and return 1.
414 If there's no composition at POS and LIMIT is negative, return 0.
416 Otherwise, search for a composition forward (LIMIT > POS) or
417 backward (LIMIT < POS). In this case, LIMIT bounds the search.
419 If a composition is found, set *START, *END, and *PROP as above,
420 and return 1, else return 0.
422 This doesn't check the validity of composition. */
424 bool
425 find_composition (ptrdiff_t pos, ptrdiff_t limit,
426 ptrdiff_t *start, ptrdiff_t *end,
427 Lisp_Object *prop, Lisp_Object object)
429 Lisp_Object val;
431 if (get_property_and_range (pos, Qcomposition, prop, start, end, object))
432 return 1;
434 if (limit < 0 || limit == pos)
435 return 0;
437 if (limit > pos) /* search forward */
439 val = Fnext_single_property_change (make_number (pos), Qcomposition,
440 object, make_number (limit));
441 pos = XINT (val);
442 if (pos == limit)
443 return 0;
445 else /* search backward */
447 if (get_property_and_range (pos - 1, Qcomposition, prop, start, end,
448 object))
449 return 1;
450 val = Fprevious_single_property_change (make_number (pos), Qcomposition,
451 object, make_number (limit));
452 pos = XINT (val);
453 if (pos == limit)
454 return 0;
455 pos--;
457 get_property_and_range (pos, Qcomposition, prop, start, end, object);
458 return 1;
461 /* Run a proper function to adjust the composition sitting between
462 FROM and TO with property PROP. */
464 static void
465 run_composition_function (ptrdiff_t from, ptrdiff_t to, Lisp_Object prop)
467 Lisp_Object func;
468 ptrdiff_t start, end;
470 func = COMPOSITION_MODIFICATION_FUNC (prop);
471 /* If an invalid composition precedes or follows, try to make them
472 valid too. */
473 if (from > BEGV
474 && find_composition (from - 1, -1, &start, &end, &prop, Qnil)
475 && !composition_valid_p (start, end, prop))
476 from = start;
477 if (to < ZV
478 && find_composition (to, -1, &start, &end, &prop, Qnil)
479 && !composition_valid_p (start, end, prop))
480 to = end;
481 if (!NILP (Ffboundp (func)))
482 call2 (func, make_number (from), make_number (to));
485 /* Make invalid compositions adjacent to or inside FROM and TO valid.
486 CHECK_MASK is bitwise `or' of mask bits defined by macros
487 CHECK_XXX (see the comment in composite.h).
489 It also resets the text-property `auto-composed' to a proper region
490 so that automatic character composition works correctly later while
491 displaying the region.
493 This function is called when a buffer text is changed. If the
494 change is deletion, FROM == TO. Otherwise, FROM < TO. */
496 void
497 update_compositions (ptrdiff_t from, ptrdiff_t to, int check_mask)
499 Lisp_Object prop;
500 ptrdiff_t start, end;
501 /* The beginning and end of the region to set the property
502 `auto-composed' to nil. */
503 ptrdiff_t min_pos = from, max_pos = to;
505 if (inhibit_modification_hooks)
506 return;
508 /* If FROM and TO are not in a valid range, do nothing. */
509 if (! (BEGV <= from && from <= to && to <= ZV))
510 return;
512 if (check_mask & CHECK_HEAD)
514 /* FROM should be at composition boundary. But, insertion or
515 deletion will make two compositions adjacent and
516 indistinguishable when they have same (eq) property. To
517 avoid it, in such a case, we change the property of the
518 latter to the copy of it. */
519 if (from > BEGV
520 && find_composition (from - 1, -1, &start, &end, &prop, Qnil)
521 && composition_valid_p (start, end, prop))
523 min_pos = start;
524 if (end > to)
525 max_pos = end;
526 if (from < end)
527 Fput_text_property (make_number (from), make_number (end),
528 Qcomposition,
529 Fcons (XCAR (prop), XCDR (prop)), Qnil);
530 run_composition_function (start, end, prop);
531 from = end;
533 else if (from < ZV
534 && find_composition (from, -1, &start, &from, &prop, Qnil)
535 && composition_valid_p (start, from, prop))
537 if (from > to)
538 max_pos = from;
539 run_composition_function (start, from, prop);
543 if (check_mask & CHECK_INSIDE)
545 /* In this case, we are sure that (check & CHECK_TAIL) is also
546 nonzero. Thus, here we should check only compositions before
547 (to - 1). */
548 while (from < to - 1
549 && find_composition (from, to, &start, &from, &prop, Qnil)
550 && composition_valid_p (start, from, prop)
551 && from < to - 1)
552 run_composition_function (start, from, prop);
555 if (check_mask & CHECK_TAIL)
557 if (from < to
558 && find_composition (to - 1, -1, &start, &end, &prop, Qnil)
559 && composition_valid_p (start, end, prop))
561 /* TO should be also at composition boundary. But,
562 insertion or deletion will make two compositions adjacent
563 and indistinguishable when they have same (eq) property.
564 To avoid it, in such a case, we change the property of
565 the former to the copy of it. */
566 if (to < end)
568 Fput_text_property (make_number (start), make_number (to),
569 Qcomposition,
570 Fcons (XCAR (prop), XCDR (prop)), Qnil);
571 max_pos = end;
573 run_composition_function (start, end, prop);
575 else if (to < ZV
576 && find_composition (to, -1, &start, &end, &prop, Qnil)
577 && composition_valid_p (start, end, prop))
579 run_composition_function (start, end, prop);
580 max_pos = end;
583 if (min_pos < max_pos)
585 ptrdiff_t count = SPECPDL_INDEX ();
587 specbind (Qinhibit_read_only, Qt);
588 specbind (Qinhibit_modification_hooks, Qt);
589 specbind (Qinhibit_point_motion_hooks, Qt);
590 Fremove_list_of_text_properties (make_number (min_pos),
591 make_number (max_pos),
592 list1 (Qauto_composed), Qnil);
593 unbind_to (count, Qnil);
598 /* Modify composition property values in LIST destructively. LIST is
599 a list as returned from text_property_list. Change values to the
600 top-level copies of them so that none of them are `eq'. */
602 void
603 make_composition_value_copy (Lisp_Object list)
605 Lisp_Object plist, val;
607 for (; CONSP (list); list = XCDR (list))
609 plist = XCAR (XCDR (XCDR (XCAR (list))));
610 while (CONSP (plist) && CONSP (XCDR (plist)))
612 if (EQ (XCAR (plist), Qcomposition)
613 && (val = XCAR (XCDR (plist)), CONSP (val)))
614 XSETCAR (XCDR (plist), Fcons (XCAR (val), XCDR (val)));
615 plist = XCDR (XCDR (plist));
621 /* Make text in the region between START and END a composition that
622 has COMPONENTS and MODIFICATION-FUNC.
624 If STRING is non-nil, then operate on characters contained between
625 indices START and END in STRING. */
627 void
628 compose_text (ptrdiff_t start, ptrdiff_t end, Lisp_Object components,
629 Lisp_Object modification_func, Lisp_Object string)
631 Lisp_Object prop;
633 prop = Fcons (Fcons (make_number (end - start), components),
634 modification_func);
635 Fput_text_property (make_number (start), make_number (end),
636 Qcomposition, prop, string);
639 /* Lisp glyph-string handlers. */
641 /* Hash table for automatic composition. The key is a header of a
642 lgstring (Lispy glyph-string), and the value is a body of a
643 lgstring. */
645 static Lisp_Object gstring_hash_table;
647 static Lisp_Object gstring_lookup_cache (Lisp_Object);
649 static Lisp_Object
650 gstring_lookup_cache (Lisp_Object header)
652 struct Lisp_Hash_Table *h = XHASH_TABLE (gstring_hash_table);
653 ptrdiff_t i = hash_lookup (h, header, NULL);
655 return (i >= 0 ? HASH_VALUE (h, i) : Qnil);
658 Lisp_Object
659 composition_gstring_put_cache (Lisp_Object gstring, ptrdiff_t len)
661 struct Lisp_Hash_Table *h = XHASH_TABLE (gstring_hash_table);
662 EMACS_UINT hash;
663 Lisp_Object header, copy;
664 ptrdiff_t i;
666 header = LGSTRING_HEADER (gstring);
667 hash = h->test.hashfn (&h->test, header);
668 if (len < 0)
670 ptrdiff_t j, glyph_len = LGSTRING_GLYPH_LEN (gstring);
671 for (j = 0; j < glyph_len; j++)
672 if (NILP (LGSTRING_GLYPH (gstring, j)))
673 break;
674 len = j;
677 copy = Fmake_vector (make_number (len + 2), Qnil);
678 LGSTRING_SET_HEADER (copy, Fcopy_sequence (header));
679 for (i = 0; i < len; i++)
680 LGSTRING_SET_GLYPH (copy, i, Fcopy_sequence (LGSTRING_GLYPH (gstring, i)));
681 i = hash_put (h, LGSTRING_HEADER (copy), copy, hash);
682 LGSTRING_SET_ID (copy, make_number (i));
683 return copy;
686 Lisp_Object
687 composition_gstring_from_id (ptrdiff_t id)
689 struct Lisp_Hash_Table *h = XHASH_TABLE (gstring_hash_table);
691 return HASH_VALUE (h, id);
694 bool
695 composition_gstring_p (Lisp_Object gstring)
697 Lisp_Object header;
698 ptrdiff_t i;
700 if (! VECTORP (gstring) || ASIZE (gstring) < 2)
701 return 0;
702 header = LGSTRING_HEADER (gstring);
703 if (! VECTORP (header) || ASIZE (header) < 2)
704 return 0;
705 if (! NILP (LGSTRING_FONT (gstring))
706 && (! FONT_OBJECT_P (LGSTRING_FONT (gstring))
707 && ! CODING_SYSTEM_P (LGSTRING_FONT (gstring))))
708 return 0;
709 for (i = 1; i < ASIZE (LGSTRING_HEADER (gstring)); i++)
710 if (! NATNUMP (AREF (LGSTRING_HEADER (gstring), i)))
711 return 0;
712 if (! NILP (LGSTRING_ID (gstring)) && ! NATNUMP (LGSTRING_ID (gstring)))
713 return 0;
714 for (i = 0; i < LGSTRING_GLYPH_LEN (gstring); i++)
716 Lisp_Object glyph = LGSTRING_GLYPH (gstring, i);
717 if (NILP (glyph))
718 break;
719 if (! VECTORP (glyph) || ASIZE (glyph) != LGLYPH_SIZE)
720 return 0;
722 return 1;
726 composition_gstring_width (Lisp_Object gstring, ptrdiff_t from, ptrdiff_t to,
727 struct font_metrics *metrics)
729 Lisp_Object *glyph;
730 int width = 0;
732 if (metrics)
734 Lisp_Object font_object = LGSTRING_FONT (gstring);
736 if (FONT_OBJECT_P (font_object))
738 struct font *font = XFONT_OBJECT (font_object);
740 metrics->ascent = font->ascent;
741 metrics->descent = font->descent;
743 else
745 metrics->ascent = 1;
746 metrics->descent = 0;
748 metrics->width = metrics->lbearing = metrics->rbearing = 0;
750 for (glyph = lgstring_glyph_addr (gstring, from); from < to; from++, glyph++)
752 int x;
754 if (NILP (LGLYPH_ADJUSTMENT (*glyph)))
755 width += LGLYPH_WIDTH (*glyph);
756 else
757 width += LGLYPH_WADJUST (*glyph);
758 if (metrics)
760 x = metrics->width + LGLYPH_LBEARING (*glyph) + LGLYPH_XOFF (*glyph);
761 if (metrics->lbearing > x)
762 metrics->lbearing = x;
763 x = metrics->width + LGLYPH_RBEARING (*glyph) + LGLYPH_XOFF (*glyph);
764 if (metrics->rbearing < x)
765 metrics->rbearing = x;
766 metrics->width = width;
767 x = LGLYPH_ASCENT (*glyph) - LGLYPH_YOFF (*glyph);
768 if (metrics->ascent < x)
769 metrics->ascent = x;
770 x = LGLYPH_DESCENT (*glyph) + LGLYPH_YOFF (*glyph);
771 if (metrics->descent < x)
772 metrics->descent = x;
775 return width;
779 static Lisp_Object gstring_work;
780 static Lisp_Object gstring_work_headers;
782 static Lisp_Object
783 fill_gstring_header (Lisp_Object header, Lisp_Object start, Lisp_Object end,
784 Lisp_Object font_object, Lisp_Object string)
786 ptrdiff_t from, to, from_byte;
787 ptrdiff_t len, i;
789 if (NILP (string))
791 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
792 error ("Attempt to shape unibyte text");
793 validate_region (&start, &end);
794 from = XFASTINT (start);
795 to = XFASTINT (end);
796 from_byte = CHAR_TO_BYTE (from);
798 else
800 CHECK_STRING (string);
801 if (! STRING_MULTIBYTE (string))
802 error ("Attempt to shape unibyte text");
803 /* The caller checks that START and END are nonnegative integers. */
804 if (! (XINT (start) <= XINT (end) && XINT (end) <= SCHARS (string)))
805 args_out_of_range_3 (string, start, end);
806 from = XINT (start);
807 to = XINT (end);
808 from_byte = string_char_to_byte (string, from);
811 len = to - from;
812 if (len == 0)
813 error ("Attempt to shape zero-length text");
814 if (VECTORP (header))
816 if (ASIZE (header) != len + 1)
817 args_out_of_range (header, make_number (len + 1));
819 else
821 if (len <= 8)
822 header = AREF (gstring_work_headers, len - 1);
823 else
824 header = make_uninit_vector (len + 1);
827 ASET (header, 0, font_object);
828 for (i = 0; i < len; i++)
830 int c;
832 if (NILP (string))
833 FETCH_CHAR_ADVANCE_NO_CHECK (c, from, from_byte);
834 else
835 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, from, from_byte);
836 ASET (header, i + 1, make_number (c));
838 return header;
841 static void
842 fill_gstring_body (Lisp_Object gstring)
844 Lisp_Object font_object = LGSTRING_FONT (gstring);
845 Lisp_Object header = AREF (gstring, 0);
846 ptrdiff_t len = LGSTRING_CHAR_LEN (gstring);
847 ptrdiff_t i;
849 for (i = 0; i < len; i++)
851 Lisp_Object g = LGSTRING_GLYPH (gstring, i);
852 int c = XFASTINT (AREF (header, i + 1));
854 if (NILP (g))
856 g = LGLYPH_NEW ();
857 LGSTRING_SET_GLYPH (gstring, i, g);
859 LGLYPH_SET_FROM (g, i);
860 LGLYPH_SET_TO (g, i);
861 LGLYPH_SET_CHAR (g, c);
862 if (FONT_OBJECT_P (font_object))
864 font_fill_lglyph_metrics (g, font_object);
866 else
868 int width = XFASTINT (CHAR_TABLE_REF (Vchar_width_table, c));
870 LGLYPH_SET_CODE (g, c);
871 LGLYPH_SET_LBEARING (g, 0);
872 LGLYPH_SET_RBEARING (g, width);
873 LGLYPH_SET_WIDTH (g, width);
874 LGLYPH_SET_ASCENT (g, 1);
875 LGLYPH_SET_DESCENT (g, 0);
877 LGLYPH_SET_ADJUSTMENT (g, Qnil);
879 if (i < LGSTRING_GLYPH_LEN (gstring))
880 LGSTRING_SET_GLYPH (gstring, i, Qnil);
884 /* Try to compose the characters at CHARPOS according to composition
885 rule RULE ([PATTERN PREV-CHARS FUNC]). LIMIT limits the characters
886 to compose. STRING, if not nil, is a target string. WIN is a
887 window where the characters are being displayed. If characters are
888 successfully composed, return the composition as a glyph-string
889 object. Otherwise return nil. */
891 static Lisp_Object
892 autocmp_chars (Lisp_Object rule, ptrdiff_t charpos, ptrdiff_t bytepos,
893 ptrdiff_t limit, struct window *win, struct face *face,
894 Lisp_Object string)
896 ptrdiff_t count = SPECPDL_INDEX ();
897 struct frame *f = XFRAME (win->frame);
898 Lisp_Object pos = make_number (charpos);
899 ptrdiff_t to;
900 ptrdiff_t pt = PT, pt_byte = PT_BYTE;
901 Lisp_Object re, font_object, lgstring;
902 ptrdiff_t len;
904 record_unwind_save_match_data ();
905 re = AREF (rule, 0);
906 if (NILP (re))
907 len = 1;
908 else if (! STRINGP (re))
909 return unbind_to (count, Qnil);
910 else if ((len = fast_looking_at (re, charpos, bytepos, limit, -1, string))
911 > 0)
913 if (NILP (string))
914 len = BYTE_TO_CHAR (bytepos + len) - charpos;
915 else
916 len = string_byte_to_char (string, bytepos + len) - charpos;
918 if (len <= 0)
919 return unbind_to (count, Qnil);
920 to = limit = charpos + len;
921 #ifdef HAVE_WINDOW_SYSTEM
922 if (FRAME_WINDOW_P (f))
924 font_object = font_range (charpos, bytepos, &to, win, face, string);
925 if (! FONT_OBJECT_P (font_object)
926 || (! NILP (re)
927 && to < limit
928 && (fast_looking_at (re, charpos, bytepos, to, -1, string) <= 0)))
929 return unbind_to (count, Qnil);
931 else
932 #endif /* not HAVE_WINDOW_SYSTEM */
933 font_object = win->frame;
934 lgstring = Fcomposition_get_gstring (pos, make_number (to), font_object,
935 string);
936 if (NILP (LGSTRING_ID (lgstring)))
938 /* Save point as marker before calling out to lisp. */
939 if (NILP (string))
940 record_unwind_protect (restore_point_unwind,
941 build_marker (current_buffer, pt, pt_byte));
942 lgstring = safe_call (6, Vauto_composition_function, AREF (rule, 2),
943 pos, make_number (to), font_object, string);
945 return unbind_to (count, lgstring);
948 static Lisp_Object _work_val;
950 /* 1 iff the character C is composable. Characters of general
951 category Z? or C? are not composable except for ZWNJ and ZWJ. */
953 #define CHAR_COMPOSABLE_P(C) \
954 ((C) > ' ' \
955 && ((C) == 0x200C || (C) == 0x200D \
956 || (_work_val = CHAR_TABLE_REF (Vunicode_category_table, (C)), \
957 (INTEGERP (_work_val) \
958 && (XINT (_work_val) <= UNICODE_CATEGORY_So)))))
960 /* Update cmp_it->stop_pos to the next position after CHARPOS (and
961 BYTEPOS) where character composition may happen. If BYTEPOS is
962 negative, compute it. ENDPOS is a limit of searching. If it is
963 less than CHARPOS, search backward to ENDPOS+1 assuming that
964 set_iterator_to_next works in reverse order. In this case, if a
965 composition closest to CHARPOS is found, set cmp_it->stop_pos to
966 the last character of the composition.
968 If no composition is found, set cmp_it->ch to -2. If a static
969 composition is found, set cmp_it->ch to -1. Otherwise, set
970 cmp_it->ch to the character that triggers the automatic
971 composition. */
973 void
974 composition_compute_stop_pos (struct composition_it *cmp_it, ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t endpos, Lisp_Object string)
976 ptrdiff_t start, end;
977 int c;
978 Lisp_Object prop, val;
979 /* This is from forward_to_next_line_start in xdisp.c. */
980 const int MAX_NEWLINE_DISTANCE = 500;
982 if (charpos < endpos)
984 if (endpos > charpos + MAX_NEWLINE_DISTANCE)
985 endpos = charpos + MAX_NEWLINE_DISTANCE;
987 else if (endpos < charpos)
989 /* We search backward for a position to check composition. */
990 if (endpos < 0)
992 /* But we don't know where to stop the searching. */
993 endpos = NILP (string) ? BEGV - 1 : -1;
994 /* Usually we don't reach ENDPOS because we stop searching
995 at an uncomposable character (NL, LRE, etc). */
998 cmp_it->id = -1;
999 cmp_it->ch = -2;
1000 cmp_it->reversed_p = 0;
1001 cmp_it->stop_pos = endpos;
1002 if (charpos == endpos)
1003 return;
1004 /* FIXME: Bidi is not yet handled well in static composition. */
1005 if (charpos < endpos
1006 && find_composition (charpos, endpos, &start, &end, &prop, string)
1007 && start >= charpos
1008 && composition_valid_p (start, end, prop))
1010 cmp_it->stop_pos = endpos = start;
1011 cmp_it->ch = -1;
1013 if (NILP (BVAR (current_buffer, enable_multibyte_characters))
1014 || NILP (Vauto_composition_mode))
1015 return;
1016 if (bytepos < 0)
1018 if (NILP (string))
1019 bytepos = CHAR_TO_BYTE (charpos);
1020 else
1021 bytepos = string_char_to_byte (string, charpos);
1024 start = charpos;
1025 if (charpos < endpos)
1027 /* Forward search. */
1028 while (charpos < endpos)
1030 if (STRINGP (string))
1031 FETCH_STRING_CHAR_ADVANCE (c, string, charpos, bytepos);
1032 else
1033 FETCH_CHAR_ADVANCE (c, charpos, bytepos);
1034 if (c == '\n')
1036 cmp_it->ch = -2;
1037 break;
1039 val = CHAR_TABLE_REF (Vcomposition_function_table, c);
1040 if (! NILP (val))
1042 Lisp_Object elt;
1043 int ridx;
1045 for (ridx = 0; CONSP (val); val = XCDR (val), ridx++)
1047 elt = XCAR (val);
1048 if (VECTORP (elt) && ASIZE (elt) == 3
1049 && NATNUMP (AREF (elt, 1))
1050 && charpos - 1 - XFASTINT (AREF (elt, 1)) >= start)
1051 break;
1053 if (CONSP (val))
1055 cmp_it->rule_idx = ridx;
1056 cmp_it->lookback = XFASTINT (AREF (elt, 1));
1057 cmp_it->stop_pos = charpos - 1 - cmp_it->lookback;
1058 cmp_it->ch = c;
1059 return;
1063 if (charpos == endpos)
1065 /* We couldn't find a composition point before ENDPOS. But,
1066 some character after ENDPOS may be composed with
1067 characters before ENDPOS. So, we should stop at the safe
1068 point. */
1069 charpos = endpos - MAX_AUTO_COMPOSITION_LOOKBACK;
1070 if (charpos < start)
1071 charpos = start;
1074 else if (charpos > endpos)
1076 /* Search backward for a pattern that may be composed and the
1077 position of (possibly) the last character of the match is
1078 closest to (but not after) START. The reason for the last
1079 character is that set_iterator_to_next works in reverse order,
1080 and thus we must stop at the last character for composition
1081 check. */
1082 unsigned char *p;
1083 int len;
1084 /* Limit byte position used in fast_looking_at. This is the
1085 byte position of the character after START. */
1086 ptrdiff_t limit;
1088 if (NILP (string))
1089 p = BYTE_POS_ADDR (bytepos);
1090 else
1091 p = SDATA (string) + bytepos;
1092 c = STRING_CHAR_AND_LENGTH (p, len);
1093 limit = bytepos + len;
1094 while (CHAR_COMPOSABLE_P (c))
1096 val = CHAR_TABLE_REF (Vcomposition_function_table, c);
1097 if (! NILP (val))
1099 Lisp_Object elt;
1100 int ridx, blen;
1102 for (ridx = 0; CONSP (val); val = XCDR (val), ridx++)
1104 elt = XCAR (val);
1105 if (VECTORP (elt) && ASIZE (elt) == 3
1106 && NATNUMP (AREF (elt, 1))
1107 && charpos - XFASTINT (AREF (elt, 1)) > endpos)
1109 ptrdiff_t back = XFASTINT (AREF (elt, 1));
1110 ptrdiff_t cpos = charpos - back, bpos;
1112 if (back == 0)
1113 bpos = bytepos;
1114 else
1115 bpos = (NILP (string) ? CHAR_TO_BYTE (cpos)
1116 : string_char_to_byte (string, cpos));
1117 if (STRINGP (AREF (elt, 0)))
1118 blen = fast_looking_at (AREF (elt, 0), cpos, bpos,
1119 start + 1, limit, string);
1120 else
1121 blen = 1;
1122 if (blen > 0)
1124 /* Make CPOS point to the last character of
1125 match. Note that BLEN is byte-length. */
1126 if (blen > 1)
1128 bpos += blen;
1129 if (NILP (string))
1130 cpos = BYTE_TO_CHAR (bpos) - 1;
1131 else
1132 cpos = string_byte_to_char (string, bpos) - 1;
1134 back = cpos - (charpos - back);
1135 if (cmp_it->stop_pos < cpos
1136 || (cmp_it->stop_pos == cpos
1137 && cmp_it->lookback < back))
1139 cmp_it->rule_idx = ridx;
1140 cmp_it->stop_pos = cpos;
1141 cmp_it->ch = c;
1142 cmp_it->lookback = back;
1143 cmp_it->nchars = back + 1;
1149 if (charpos - 1 == endpos)
1150 break;
1151 if (STRINGP (string))
1153 p--, bytepos--;
1154 while (! CHAR_HEAD_P (*p))
1155 p--, bytepos--;
1156 charpos--;
1158 else
1160 DEC_BOTH (charpos, bytepos);
1161 p = BYTE_POS_ADDR (bytepos);
1163 c = STRING_CHAR (p);
1165 if (cmp_it->ch >= 0)
1166 /* We found a position to check. */
1167 return;
1168 /* Skip all uncomposable characters. */
1169 if (NILP (string))
1171 while (charpos - 1 > endpos && ! CHAR_COMPOSABLE_P (c))
1173 DEC_BOTH (charpos, bytepos);
1174 c = FETCH_MULTIBYTE_CHAR (bytepos);
1177 else
1179 while (charpos - 1 > endpos && ! CHAR_COMPOSABLE_P (c))
1181 p--;
1182 while (! CHAR_HEAD_P (*p))
1183 p--;
1184 charpos--;
1185 c = STRING_CHAR (p);
1189 cmp_it->stop_pos = charpos;
1192 /* Check if the character at CHARPOS (and BYTEPOS) is composed
1193 (possibly with the following characters) on window W. ENDPOS limits
1194 characters to be composed. FACE, if non-NULL, is a base face of
1195 the character. If STRING is not nil, it is a string containing the
1196 character to check, and CHARPOS and BYTEPOS are indices in the
1197 string. In that case, FACE must not be NULL.
1199 If the character is composed, setup members of CMP_IT (id, nglyphs,
1200 from, to, reversed_p), and return true. Otherwise, update
1201 CMP_IT->stop_pos, and return false. */
1203 bool
1204 composition_reseat_it (struct composition_it *cmp_it, ptrdiff_t charpos,
1205 ptrdiff_t bytepos, ptrdiff_t endpos, struct window *w,
1206 struct face *face, Lisp_Object string)
1208 if (cmp_it->ch == -2)
1210 composition_compute_stop_pos (cmp_it, charpos, bytepos, endpos, string);
1211 if (cmp_it->ch == -2 || cmp_it->stop_pos != charpos)
1212 /* The current position is not composed. */
1213 return 0;
1216 if (endpos < 0)
1217 endpos = NILP (string) ? BEGV : 0;
1219 if (cmp_it->ch < 0)
1221 /* We are looking at a static composition. */
1222 ptrdiff_t start, end;
1223 Lisp_Object prop;
1225 find_composition (charpos, -1, &start, &end, &prop, string);
1226 cmp_it->id = get_composition_id (charpos, bytepos, end - start,
1227 prop, string);
1228 if (cmp_it->id < 0)
1229 goto no_composition;
1230 cmp_it->nchars = end - start;
1231 cmp_it->nglyphs = composition_table[cmp_it->id]->glyph_len;
1233 else if (w)
1235 Lisp_Object lgstring = Qnil;
1236 Lisp_Object val, elt;
1237 ptrdiff_t i;
1239 val = CHAR_TABLE_REF (Vcomposition_function_table, cmp_it->ch);
1240 for (i = 0; i < cmp_it->rule_idx; i++, val = XCDR (val));
1241 if (charpos < endpos)
1243 for (; CONSP (val); val = XCDR (val))
1245 elt = XCAR (val);
1246 if (! VECTORP (elt) || ASIZE (elt) != 3
1247 || ! INTEGERP (AREF (elt, 1)))
1248 continue;
1249 if (XFASTINT (AREF (elt, 1)) != cmp_it->lookback)
1250 goto no_composition;
1251 lgstring = autocmp_chars (elt, charpos, bytepos, endpos,
1252 w, face, string);
1253 if (composition_gstring_p (lgstring))
1254 break;
1255 lgstring = Qnil;
1256 /* Composition failed perhaps because the font doesn't
1257 support sufficient range of characters. Try the
1258 other composition rules if any. */
1260 cmp_it->reversed_p = 0;
1262 else
1264 ptrdiff_t cpos = charpos, bpos = bytepos;
1266 cmp_it->reversed_p = 1;
1267 elt = XCAR (val);
1268 if (cmp_it->lookback > 0)
1270 cpos = charpos - cmp_it->lookback;
1271 if (STRINGP (string))
1272 bpos = string_char_to_byte (string, cpos);
1273 else
1274 bpos = CHAR_TO_BYTE (cpos);
1276 lgstring = autocmp_chars (elt, cpos, bpos, charpos + 1, w, face,
1277 string);
1278 if (! composition_gstring_p (lgstring)
1279 || cpos + LGSTRING_CHAR_LEN (lgstring) - 1 != charpos)
1280 /* Composition failed or didn't cover the current
1281 character. */
1282 goto no_composition;
1284 if (NILP (lgstring))
1285 goto no_composition;
1286 if (NILP (LGSTRING_ID (lgstring)))
1287 lgstring = composition_gstring_put_cache (lgstring, -1);
1288 cmp_it->id = XINT (LGSTRING_ID (lgstring));
1289 for (i = 0; i < LGSTRING_GLYPH_LEN (lgstring); i++)
1290 if (NILP (LGSTRING_GLYPH (lgstring, i)))
1291 break;
1292 cmp_it->nglyphs = i;
1293 cmp_it->from = 0;
1294 cmp_it->to = i;
1296 else
1297 goto no_composition;
1298 return 1;
1300 no_composition:
1301 if (charpos == endpos)
1302 return 0;
1303 if (charpos < endpos)
1305 charpos++;
1306 if (NILP (string))
1307 INC_POS (bytepos);
1308 else
1309 bytepos += BYTES_BY_CHAR_HEAD (*(SDATA (string) + bytepos));
1311 else
1313 charpos--;
1314 /* BYTEPOS is calculated in composition_compute_stop_pos */
1315 bytepos = -1;
1317 if (cmp_it->reversed_p)
1318 endpos = -1;
1319 composition_compute_stop_pos (cmp_it, charpos, bytepos, endpos, string);
1320 return 0;
1323 /* Update charpos, nchars, nbytes, and width of the current grapheme
1324 cluster.
1326 If the composition is static or automatic in L2R context, the
1327 cluster is identified by CMP_IT->from, and CHARPOS is the position
1328 of the first character of the cluster. In this case, update
1329 CMP_IT->to too.
1331 If the composition is automatic in R2L context, the cluster is
1332 identified by CMP_IT->to, and CHARPOS is the position of the last
1333 character of the cluster. In this case, update CMP_IT->from too.
1335 The return value is the character code of the first character of
1336 the cluster, or -1 if the composition is somehow broken. */
1339 composition_update_it (struct composition_it *cmp_it, ptrdiff_t charpos, ptrdiff_t bytepos, Lisp_Object string)
1341 int i, c IF_LINT (= 0);
1343 if (cmp_it->ch < 0)
1345 /* static composition */
1346 struct composition *cmp = composition_table[cmp_it->id];
1348 cmp_it->charpos = charpos;
1349 cmp_it->to = cmp_it->nglyphs;
1350 if (cmp_it->nglyphs == 0)
1351 c = -1;
1352 else
1354 for (i = 0; i < cmp->glyph_len; i++)
1355 /* TAB in a composition means display glyphs with padding
1356 space on the left or right. */
1357 if ((c = COMPOSITION_GLYPH (cmp, i)) != '\t')
1358 break;
1359 if (c == '\t')
1360 c = ' ';
1362 cmp_it->width = cmp->width;
1363 charpos += cmp_it->nchars;
1364 if (STRINGP (string))
1365 cmp_it->nbytes = string_char_to_byte (string, charpos) - bytepos;
1366 else
1367 cmp_it->nbytes = CHAR_TO_BYTE (charpos) - bytepos;
1369 else
1371 /* Automatic composition. */
1372 Lisp_Object gstring = composition_gstring_from_id (cmp_it->id);
1373 Lisp_Object glyph;
1374 ptrdiff_t from;
1376 if (cmp_it->nglyphs == 0)
1378 cmp_it->nchars = LGSTRING_CHAR_LEN (gstring);
1379 cmp_it->width = 0;
1380 cmp_it->from = cmp_it->to = 0;
1381 return -1;
1383 if (! cmp_it->reversed_p)
1385 glyph = LGSTRING_GLYPH (gstring, cmp_it->from);
1386 from = LGLYPH_FROM (glyph);
1387 for (cmp_it->to = cmp_it->from + 1; cmp_it->to < cmp_it->nglyphs;
1388 cmp_it->to++)
1390 glyph = LGSTRING_GLYPH (gstring, cmp_it->to);
1391 if (LGLYPH_FROM (glyph) != from)
1392 break;
1394 cmp_it->charpos = charpos;
1396 else
1398 glyph = LGSTRING_GLYPH (gstring, cmp_it->to - 1);
1399 from = LGLYPH_FROM (glyph);
1400 cmp_it->charpos = charpos - (LGLYPH_TO (glyph) - from);
1401 for (cmp_it->from = cmp_it->to - 1; cmp_it->from > 0;
1402 cmp_it->from--)
1404 glyph = LGSTRING_GLYPH (gstring, cmp_it->from - 1);
1405 if (LGLYPH_FROM (glyph) != from)
1406 break;
1409 glyph = LGSTRING_GLYPH (gstring, cmp_it->from);
1410 cmp_it->nchars = LGLYPH_TO (glyph) + 1 - from;
1411 cmp_it->nbytes = 0;
1412 cmp_it->width = 0;
1413 for (i = cmp_it->nchars - 1; i >= 0; i--)
1415 c = XINT (LGSTRING_CHAR (gstring, i));
1416 cmp_it->nbytes += CHAR_BYTES (c);
1417 cmp_it->width += CHAR_WIDTH (c);
1420 return c;
1424 struct position_record
1426 ptrdiff_t pos, pos_byte;
1427 unsigned char *p;
1430 /* Update the members of POSITION to the next character boundary. */
1431 #define FORWARD_CHAR(POSITION, STOP) \
1432 do { \
1433 (POSITION).pos++; \
1434 if ((POSITION).pos == (STOP)) \
1436 (POSITION).p = GAP_END_ADDR; \
1437 (POSITION).pos_byte = GPT_BYTE; \
1439 else \
1441 (POSITION).pos_byte += BYTES_BY_CHAR_HEAD (*((POSITION).p)); \
1442 (POSITION).p += BYTES_BY_CHAR_HEAD (*((POSITION).p)); \
1444 } while (0)
1446 /* Update the members of POSITION to the previous character boundary. */
1447 #define BACKWARD_CHAR(POSITION, STOP) \
1448 do { \
1449 if ((POSITION).pos == (STOP)) \
1450 (POSITION).p = GPT_ADDR; \
1451 do { \
1452 (POSITION).pos_byte--; \
1453 (POSITION).p--; \
1454 } while (! CHAR_HEAD_P (*((POSITION).p))); \
1455 (POSITION).pos--; \
1456 } while (0)
1458 /* This is like find_composition, but find an automatic composition
1459 instead. It is assured that POS is not within a static
1460 composition. If found, set *GSTRING to the glyph-string
1461 representing the composition, and return true. Otherwise, *GSTRING to
1462 Qnil, and return false. */
1464 static bool
1465 find_automatic_composition (ptrdiff_t pos, ptrdiff_t limit,
1466 ptrdiff_t *start, ptrdiff_t *end,
1467 Lisp_Object *gstring, Lisp_Object string)
1469 ptrdiff_t head, tail, stop;
1470 /* Forward limit position of checking a composition taking a
1471 looking-back count into account. */
1472 ptrdiff_t fore_check_limit;
1473 struct position_record cur, prev;
1474 int c;
1475 Lisp_Object window;
1476 struct window *w;
1477 bool need_adjustment = 0;
1479 window = Fget_buffer_window (Fcurrent_buffer (), Qnil);
1480 if (NILP (window))
1481 return 0;
1482 w = XWINDOW (window);
1484 cur.pos = pos;
1485 if (NILP (string))
1487 head = BEGV, tail = ZV, stop = GPT;
1488 cur.pos_byte = CHAR_TO_BYTE (cur.pos);
1489 cur.p = BYTE_POS_ADDR (cur.pos_byte);
1491 else
1493 head = 0, tail = SCHARS (string), stop = -1;
1494 cur.pos_byte = string_char_to_byte (string, cur.pos);
1495 cur.p = SDATA (string) + cur.pos_byte;
1497 if (limit < 0)
1498 /* Finding a composition covering the character after POS is the
1499 same as setting LIMIT to POS. */
1500 limit = pos;
1501 if (limit <= pos)
1502 fore_check_limit = min (tail, pos + 1 + MAX_AUTO_COMPOSITION_LOOKBACK);
1503 else
1504 fore_check_limit = min (tail, limit + MAX_AUTO_COMPOSITION_LOOKBACK);
1506 /* Provided that we have these possible compositions now:
1508 POS: 1 2 3 4 5 6 7 8 9
1509 |-A-|
1510 |-B-|-C-|--D--|
1512 Here, it is known that characters after positions 1 and 9 can
1513 never be composed (i.e. ! CHAR_COMPOSABLE_P (CH)), and
1514 composition A is an invalid one because it's partially covered by
1515 the valid composition C. And to know whether a composition is
1516 valid or not, the only way is to start searching forward from a
1517 position that can not be a tail part of composition (it's 2 in
1518 the above case).
1520 Now we have these cases (1 through 4):
1522 -- character after POS is ... --
1523 not composable composable
1524 LIMIT <= POS (1) (3)
1525 POS < LIMIT (2) (4)
1527 Among them, in case (2), we simply search forward from POS.
1529 In the other cases, we at first rewind back to the position where
1530 the previous character is not composable or the beginning of
1531 buffer (string), then search compositions forward. In case (1)
1532 and (3) we repeat this process until a composition is found. */
1534 while (1)
1536 c = STRING_CHAR (cur.p);
1537 if (! CHAR_COMPOSABLE_P (c))
1539 if (limit <= pos) /* case (1) */
1541 do {
1542 if (cur.pos <= limit)
1543 return 0;
1544 BACKWARD_CHAR (cur, stop);
1545 c = STRING_CHAR (cur.p);
1546 } while (! CHAR_COMPOSABLE_P (c));
1547 fore_check_limit = cur.pos + 1;
1549 else /* case (2) */
1550 /* No need of rewinding back. */
1551 goto search_forward;
1554 /* Rewind back to the position where we can safely search
1555 forward for compositions. It is assured that the character
1556 at cur.pos is composable. */
1557 while (head < cur.pos)
1559 prev = cur;
1560 BACKWARD_CHAR (cur, stop);
1561 c = STRING_CHAR (cur.p);
1562 if (! CHAR_COMPOSABLE_P (c))
1564 cur = prev;
1565 break;
1569 search_forward:
1570 /* Now search forward. */
1571 *gstring = Qnil;
1572 prev = cur; /* remember the start of searching position. */
1573 while (cur.pos < fore_check_limit)
1575 Lisp_Object val;
1577 c = STRING_CHAR (cur.p);
1578 for (val = CHAR_TABLE_REF (Vcomposition_function_table, c);
1579 CONSP (val); val = XCDR (val))
1581 Lisp_Object elt = XCAR (val);
1583 if (VECTORP (elt) && ASIZE (elt) == 3 && NATNUMP (AREF (elt, 1)))
1585 EMACS_INT check_pos = cur.pos - XFASTINT (AREF (elt, 1));
1586 struct position_record check;
1588 if (check_pos < head
1589 || (limit <= pos ? pos < check_pos
1590 : limit <= check_pos))
1591 continue;
1592 for (check = cur; check_pos < check.pos; )
1593 BACKWARD_CHAR (check, stop);
1594 *gstring = autocmp_chars (elt, check.pos, check.pos_byte,
1595 tail, w, NULL, string);
1596 need_adjustment = 1;
1597 if (NILP (*gstring))
1599 /* As we have called Lisp, there's a possibility
1600 that buffer/string is relocated. */
1601 if (NILP (string))
1602 cur.p = BYTE_POS_ADDR (cur.pos_byte);
1603 else
1604 cur.p = SDATA (string) + cur.pos_byte;
1606 else
1608 /* We found a candidate of a target composition. */
1609 *start = check.pos;
1610 *end = check.pos + LGSTRING_CHAR_LEN (*gstring);
1611 if (pos < limit
1612 ? pos < *end
1613 : *start <= pos && pos < *end)
1614 /* This is the target composition. */
1615 return 1;
1616 cur.pos = *end;
1617 if (NILP (string))
1619 cur.pos_byte = CHAR_TO_BYTE (cur.pos);
1620 cur.p = BYTE_POS_ADDR (cur.pos_byte);
1622 else
1624 cur.pos_byte = string_char_to_byte (string, cur.pos);
1625 cur.p = SDATA (string) + cur.pos_byte;
1627 break;
1631 if (! CONSP (val))
1632 /* We found no composition here. */
1633 FORWARD_CHAR (cur, stop);
1636 if (pos < limit) /* case (2) and (4)*/
1637 return 0;
1638 if (! NILP (*gstring))
1639 return 1;
1640 if (prev.pos == head)
1641 return 0;
1642 cur = prev;
1643 if (need_adjustment)
1645 if (NILP (string))
1646 cur.p = BYTE_POS_ADDR (cur.pos_byte);
1647 else
1648 cur.p = SDATA (string) + cur.pos_byte;
1650 BACKWARD_CHAR (cur, stop);
1654 /* Return the adjusted point provided that point is moved from LAST_PT
1655 to NEW_PT. */
1657 ptrdiff_t
1658 composition_adjust_point (ptrdiff_t last_pt, ptrdiff_t new_pt)
1660 ptrdiff_t i, beg, end;
1661 Lisp_Object val;
1663 if (new_pt == BEGV || new_pt == ZV)
1664 return new_pt;
1666 /* At first check the static composition. */
1667 if (get_property_and_range (new_pt, Qcomposition, &val, &beg, &end, Qnil)
1668 && composition_valid_p (beg, end, val))
1670 if (beg < new_pt /* && end > new_pt <- It's always the case. */
1671 && (last_pt <= beg || last_pt >= end))
1672 return (new_pt < last_pt ? beg : end);
1673 return new_pt;
1676 if (NILP (BVAR (current_buffer, enable_multibyte_characters))
1677 || NILP (Vauto_composition_mode))
1678 return new_pt;
1680 /* Next check the automatic composition. */
1681 if (! find_automatic_composition (new_pt, (ptrdiff_t) -1, &beg, &end, &val,
1682 Qnil)
1683 || beg == new_pt)
1684 return new_pt;
1685 for (i = 0; i < LGSTRING_GLYPH_LEN (val); i++)
1687 Lisp_Object glyph = LGSTRING_GLYPH (val, i);
1689 if (NILP (glyph))
1690 break;
1691 if (beg + LGLYPH_FROM (glyph) == new_pt)
1692 return new_pt;
1693 if (beg + LGLYPH_TO (glyph) >= new_pt)
1694 return (new_pt < last_pt
1695 ? beg + LGLYPH_FROM (glyph)
1696 : beg + LGLYPH_TO (glyph) + 1);
1698 return new_pt;
1701 DEFUN ("composition-get-gstring", Fcomposition_get_gstring,
1702 Scomposition_get_gstring, 4, 4, 0,
1703 doc: /* Return a glyph-string for characters between FROM and TO.
1704 If the glyph string is for graphic display, FONT-OBJECT must be
1705 a font-object to use for those characters.
1706 Otherwise (for terminal display), FONT-OBJECT must be a terminal ID, a
1707 frame, or nil for the selected frame's terminal device.
1709 If the optional 4th argument STRING is not nil, it is a string
1710 containing the target characters between indices FROM and TO.
1712 A glyph-string is a vector containing information about how to display
1713 a specific character sequence. The format is:
1714 [HEADER ID GLYPH ...]
1716 HEADER is a vector of this form:
1717 [FONT-OBJECT CHAR ...]
1718 where
1719 FONT-OBJECT is a font-object for all glyphs in the glyph-string,
1720 or the terminal coding system of the specified terminal.
1721 CHARs are characters to be composed by GLYPHs.
1723 ID is an identification number of the glyph-string. It may be nil if
1724 not yet shaped.
1726 GLYPH is a vector whose elements have this form:
1727 [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT
1728 [ [X-OFF Y-OFF WADJUST] | nil] ]
1729 where
1730 FROM-IDX and TO-IDX are used internally and should not be touched.
1731 C is the character of the glyph.
1732 CODE is the glyph-code of C in FONT-OBJECT.
1733 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
1734 X-OFF and Y-OFF are offsets to the base position for the glyph.
1735 WADJUST is the adjustment to the normal width of the glyph.
1737 If GLYPH is nil, the remaining elements of the glyph-string vector
1738 should be ignored. */)
1739 (Lisp_Object from, Lisp_Object to, Lisp_Object font_object, Lisp_Object string)
1741 Lisp_Object gstring, header;
1742 ptrdiff_t frompos, topos;
1744 CHECK_NATNUM (from);
1745 CHECK_NATNUM (to);
1746 if (! FONT_OBJECT_P (font_object))
1748 struct coding_system *coding;
1749 struct terminal *terminal = get_terminal (font_object, 1);
1751 coding = ((TERMINAL_TERMINAL_CODING (terminal)->common_flags
1752 & CODING_REQUIRE_ENCODING_MASK)
1753 ? TERMINAL_TERMINAL_CODING (terminal) : &safe_terminal_coding);
1754 font_object = CODING_ID_NAME (coding->id);
1757 header = fill_gstring_header (Qnil, from, to, font_object, string);
1758 gstring = gstring_lookup_cache (header);
1759 if (! NILP (gstring))
1760 return gstring;
1762 frompos = XINT (from);
1763 topos = XINT (to);
1764 if (LGSTRING_GLYPH_LEN (gstring_work) < topos - frompos)
1765 gstring_work = Fmake_vector (make_number (topos - frompos + 2), Qnil);
1766 LGSTRING_SET_HEADER (gstring_work, header);
1767 LGSTRING_SET_ID (gstring_work, Qnil);
1768 fill_gstring_body (gstring_work);
1769 return gstring_work;
1773 /* Emacs Lisp APIs. */
1775 DEFUN ("compose-region-internal", Fcompose_region_internal,
1776 Scompose_region_internal, 2, 4, 0,
1777 doc: /* Internal use only.
1779 Compose text in the region between START and END.
1780 Optional 3rd and 4th arguments are COMPONENTS and MODIFICATION-FUNC
1781 for the composition. See `compose-region' for more details. */)
1782 (Lisp_Object start, Lisp_Object end, Lisp_Object components, Lisp_Object modification_func)
1784 validate_region (&start, &end);
1785 if (!NILP (components)
1786 && !INTEGERP (components)
1787 && !CONSP (components)
1788 && !STRINGP (components))
1789 CHECK_VECTOR (components);
1791 compose_text (XINT (start), XINT (end), components, modification_func, Qnil);
1792 return Qnil;
1795 DEFUN ("compose-string-internal", Fcompose_string_internal,
1796 Scompose_string_internal, 3, 5, 0,
1797 doc: /* Internal use only.
1799 Compose text between indices START and END of STRING.
1800 Optional 4th and 5th arguments are COMPONENTS and MODIFICATION-FUNC
1801 for the composition. See `compose-string' for more details. */)
1802 (Lisp_Object string, Lisp_Object start, Lisp_Object end, Lisp_Object components, Lisp_Object modification_func)
1804 CHECK_STRING (string);
1805 CHECK_NUMBER (start);
1806 CHECK_NUMBER (end);
1808 if (XINT (start) < 0 ||
1809 XINT (start) > XINT (end)
1810 || XINT (end) > SCHARS (string))
1811 args_out_of_range (start, end);
1813 compose_text (XINT (start), XINT (end), components, modification_func, string);
1814 return string;
1817 DEFUN ("find-composition-internal", Ffind_composition_internal,
1818 Sfind_composition_internal, 4, 4, 0,
1819 doc: /* Internal use only.
1821 Return information about composition at or nearest to position POS.
1822 See `find-composition' for more details. */)
1823 (Lisp_Object pos, Lisp_Object limit, Lisp_Object string, Lisp_Object detail_p)
1825 Lisp_Object prop, tail, gstring;
1826 ptrdiff_t start, end, from, to;
1827 int id;
1829 CHECK_NUMBER_COERCE_MARKER (pos);
1830 if (!NILP (limit))
1832 CHECK_NUMBER_COERCE_MARKER (limit);
1833 to = min (XINT (limit), ZV);
1835 else
1836 to = -1;
1838 if (!NILP (string))
1840 CHECK_STRING (string);
1841 if (XINT (pos) < 0 || XINT (pos) > SCHARS (string))
1842 args_out_of_range (string, pos);
1844 else
1846 if (XINT (pos) < BEGV || XINT (pos) > ZV)
1847 args_out_of_range (Fcurrent_buffer (), pos);
1849 from = XINT (pos);
1851 if (!find_composition (from, to, &start, &end, &prop, string))
1853 if (!NILP (BVAR (current_buffer, enable_multibyte_characters))
1854 && ! NILP (Vauto_composition_mode)
1855 && find_automatic_composition (from, to, &start, &end, &gstring,
1856 string))
1857 return list3 (make_number (start), make_number (end), gstring);
1858 return Qnil;
1860 if ((end <= XINT (pos) || start > XINT (pos)))
1862 ptrdiff_t s, e;
1864 if (find_automatic_composition (from, to, &s, &e, &gstring, string)
1865 && (e <= XINT (pos) ? e > end : s < start))
1866 return list3 (make_number (s), make_number (e), gstring);
1868 if (!composition_valid_p (start, end, prop))
1869 return list3 (make_number (start), make_number (end), Qnil);
1870 if (NILP (detail_p))
1871 return list3 (make_number (start), make_number (end), Qt);
1873 if (composition_registered_p (prop))
1874 id = COMPOSITION_ID (prop);
1875 else
1877 ptrdiff_t start_byte = (NILP (string)
1878 ? CHAR_TO_BYTE (start)
1879 : string_char_to_byte (string, start));
1880 id = get_composition_id (start, start_byte, end - start, prop, string);
1883 if (id >= 0)
1885 Lisp_Object components, relative_p, mod_func;
1886 enum composition_method method = composition_method (prop);
1887 int width = composition_table[id]->width;
1889 components = Fcopy_sequence (COMPOSITION_COMPONENTS (prop));
1890 relative_p = (method == COMPOSITION_WITH_RULE_ALTCHARS
1891 ? Qnil : Qt);
1892 mod_func = COMPOSITION_MODIFICATION_FUNC (prop);
1893 tail = list4 (components, relative_p, mod_func, make_number (width));
1895 else
1896 tail = Qnil;
1898 return Fcons (make_number (start), Fcons (make_number (end), tail));
1902 void
1903 syms_of_composite (void)
1905 int i;
1907 DEFSYM (Qcomposition, "composition");
1909 /* Make a hash table for static composition. */
1911 Lisp_Object args[6];
1913 args[0] = QCtest;
1914 args[1] = Qequal;
1915 args[2] = QCweakness;
1916 /* We used to make the hash table weak so that unreferenced
1917 compositions can be garbage-collected. But, usually once
1918 created compositions are repeatedly used in an Emacs session,
1919 and thus it's not worth to save memory in such a way. So, we
1920 make the table not weak. */
1921 args[3] = Qnil;
1922 args[4] = QCsize;
1923 args[5] = make_number (311);
1924 composition_hash_table = Fmake_hash_table (6, args);
1925 staticpro (&composition_hash_table);
1928 /* Make a hash table for glyph-string. */
1930 Lisp_Object args[6];
1931 args[0] = QCtest;
1932 args[1] = Qequal;
1933 args[2] = QCweakness;
1934 args[3] = Qnil;
1935 args[4] = QCsize;
1936 args[5] = make_number (311);
1937 gstring_hash_table = Fmake_hash_table (6, args);
1938 staticpro (&gstring_hash_table);
1941 staticpro (&gstring_work_headers);
1942 gstring_work_headers = make_uninit_vector (8);
1943 for (i = 0; i < 8; i++)
1944 ASET (gstring_work_headers, i, Fmake_vector (make_number (i + 2), Qnil));
1945 staticpro (&gstring_work);
1946 gstring_work = Fmake_vector (make_number (10), Qnil);
1948 /* Text property `composition' should be nonsticky by default. */
1949 Vtext_property_default_nonsticky
1950 = Fcons (Fcons (Qcomposition, Qt), Vtext_property_default_nonsticky);
1952 DEFVAR_LISP ("compose-chars-after-function", Vcompose_chars_after_function,
1953 doc: /* Function to adjust composition of buffer text.
1955 This function is called with three arguments: FROM, TO, and OBJECT.
1956 FROM and TO specify the range of text whose composition should be
1957 adjusted. OBJECT, if non-nil, is a string that contains the text.
1959 This function is called after a text with `composition' property is
1960 inserted or deleted to keep `composition' property of buffer text
1961 valid.
1963 The default value is the function `compose-chars-after'. */);
1964 Vcompose_chars_after_function = intern_c_string ("compose-chars-after");
1966 DEFSYM (Qauto_composed, "auto-composed");
1967 DEFSYM (Qauto_composition_function, "auto-composition-function");
1969 DEFVAR_LISP ("auto-composition-mode", Vauto_composition_mode,
1970 doc: /* Non-nil if Auto-Composition mode is enabled.
1971 Use the command `auto-composition-mode' to change this variable. */);
1972 Vauto_composition_mode = Qt;
1974 DEFVAR_LISP ("auto-composition-function", Vauto_composition_function,
1975 doc: /* Function to call to compose characters automatically.
1976 This function is called from the display routine with four arguments:
1977 FROM, TO, WINDOW, and STRING.
1979 If STRING is nil, the function must compose characters in the region
1980 between FROM and TO in the current buffer.
1982 Otherwise, STRING is a string, and FROM and TO are indices into the
1983 string. In this case, the function must compose characters in the
1984 string. */);
1985 Vauto_composition_function = Qnil;
1987 DEFVAR_LISP ("composition-function-table", Vcomposition_function_table,
1988 doc: /* Char-table of functions for automatic character composition.
1989 For each character that has to be composed automatically with
1990 preceding and/or following characters, this char-table contains
1991 a function to call to compose that character.
1993 The element at index C in the table, if non-nil, is a list of
1994 composition rules of this form: ([PATTERN PREV-CHARS FUNC] ...)
1996 PATTERN is a regular expression which C and the surrounding
1997 characters must match.
1999 PREV-CHARS is a non-negative integer (less than 4) specifying how many
2000 characters before C to check the matching with PATTERN. If it is 0,
2001 PATTERN must match C and the following characters. If it is 1,
2002 PATTERN must match a character before C and the following characters.
2004 If PREV-CHARS is 0, PATTERN can be nil, which means that the
2005 single character C should be composed.
2007 FUNC is a function to return a glyph-string representing a
2008 composition of the characters that match PATTERN. It is
2009 called with one argument GSTRING.
2011 GSTRING is a template of a glyph-string to return. It is already
2012 filled with a proper header for the characters to compose, and
2013 glyphs corresponding to those characters one by one. The
2014 function must return a new glyph-string with the same header as
2015 GSTRING, or modify GSTRING itself and return it.
2017 See also the documentation of `auto-composition-mode'. */);
2018 Vcomposition_function_table = Fmake_char_table (Qnil, Qnil);
2020 defsubr (&Scompose_region_internal);
2021 defsubr (&Scompose_string_internal);
2022 defsubr (&Sfind_composition_internal);
2023 defsubr (&Scomposition_get_gstring);