Copy just non-empty strings to kill-ring
[emacs.git] / src / composite.c
blob8aa69746595a01ad612790824a5dbf52bd485381
1 /* Composite sequence support.
2 Copyright (C) 2001-2016 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 (at
15 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 "composite.h"
30 #include "buffer.h"
31 #include "coding.h"
32 #include "intervals.h"
33 #include "frame.h"
34 #include "dispextern.h"
35 #include "termhooks.h"
38 /* Emacs uses special text property `composition' to support character
39 composition. A sequence of characters that have the same (i.e. eq)
40 `composition' property value is treated as a single composite
41 sequence (we call it just `composition' here after). Characters in
42 a composition are all composed somehow on the screen.
44 The property value has this form when the composition is made:
45 ((LENGTH . COMPONENTS) . MODIFICATION-FUNC)
46 then turns to this form:
47 (COMPOSITION-ID . (LENGTH COMPONENTS-VEC . MODIFICATION-FUNC))
48 when the composition is registered in composition_hash_table and
49 composition_table. These rather peculiar structures were designed
50 to make it easy to distinguish them quickly (we can do that by
51 checking only the first element) and to extract LENGTH (from the
52 former form) and COMPOSITION-ID (from the latter form).
54 We register a composition when it is displayed, or when the width
55 is required (for instance, to calculate columns).
57 LENGTH -- Length of the composition. This information is used to
58 check the validity of the composition.
60 COMPONENTS -- Character, string, vector, list, or nil.
62 If it is nil, characters in the text are composed relatively
63 according to their metrics in font glyphs.
65 If it is a character or a string, the character or characters
66 in the string are composed relatively.
68 If it is a vector or list of integers, the element is a
69 character or an encoded composition rule. The characters are
70 composed according to the rules. (2N)th elements are
71 characters to be composed and (2N+1)th elements are
72 composition rules to tell how to compose (2N+2)th element with
73 the previously composed 2N glyphs.
75 COMPONENTS-VEC -- Vector of integers. In a relative composition,
76 the elements are the characters to be composed. In a rule-base
77 composition, the elements are characters or encoded
78 composition rules.
80 MODIFICATION-FUNC -- If non nil, it is a function to call when the
81 composition gets invalid after a modification in a buffer. If
82 it is nil, a function in `composition-function-table' of the
83 first character in the sequence is called.
85 COMPOSITION-ID --Identification number of the composition. It is
86 used as an index to composition_table for the composition.
88 When Emacs has to display a composition or has to know its
89 displaying width, the function get_composition_id is called. It
90 returns COMPOSITION-ID so that the caller can access the
91 information about the composition through composition_table. If a
92 COMPOSITION-ID has not yet been assigned to the composition,
93 get_composition_id checks the validity of `composition' property,
94 and, if valid, assigns a new ID, registers the information in
95 composition_hash_table and composition_table, and changes the form
96 of the property value. If the property is invalid,
97 get_composition_id returns -1 without changing the property value.
99 We use two tables to keep the information about composition;
100 composition_hash_table and composition_table.
102 The former is a hash table whose keys are COMPONENTS-VECs and
103 values are the corresponding COMPOSITION-IDs. This hash table is
104 weak, but as each key (COMPONENTS-VEC) is also kept as a value of the
105 `composition' property, it won't be collected as garbage until all
106 bits of text that have the same COMPONENTS-VEC are deleted.
108 The latter is a table of pointers to `struct composition' indexed
109 by COMPOSITION-ID. This structure keeps the other information (see
110 composite.h).
112 In general, a text property holds information about individual
113 characters. But, a `composition' property holds information about
114 a sequence of characters (in this sense, it is like the `intangible'
115 property). That means that we should not share the property value
116 in adjacent compositions -- we can't distinguish them if they have the
117 same property. So, after any changes, we call
118 `update_compositions' and change a property of one of adjacent
119 compositions to a copy of it. This function also runs a proper
120 composition modification function to make a composition that gets
121 invalid by the change valid again.
123 As the value of the `composition' property holds information about a
124 specific range of text, the value gets invalid if we change the
125 text in the range. We treat the `composition' property as always
126 rear-nonsticky (currently by setting default-text-properties to
127 (rear-nonsticky (composition))) and we never make properties of
128 adjacent compositions identical. Thus, any such changes make the
129 range just shorter. So, we can check the validity of the `composition'
130 property by comparing LENGTH information with the actual length of
131 the composition.
136 /* Table of pointers to the structure `composition' indexed by
137 COMPOSITION-ID. This structure is for storing information about
138 each composition except for COMPONENTS-VEC. */
139 struct composition **composition_table;
141 /* The current size of `composition_table'. */
142 static ptrdiff_t composition_table_size;
144 /* Number of compositions currently made. */
145 ptrdiff_t n_compositions;
147 /* Hash table for compositions. The key is COMPONENTS-VEC of
148 `composition' property. The value is the corresponding
149 COMPOSITION-ID. */
150 Lisp_Object composition_hash_table;
152 /* Maximum number of characters to look back for
153 auto-compositions. */
154 #define MAX_AUTO_COMPOSITION_LOOKBACK 3
156 /* Return COMPOSITION-ID of a composition at buffer position
157 CHARPOS/BYTEPOS and length NCHARS. The `composition' property of
158 the sequence is PROP. STRING, if non-nil, is a string that
159 contains the composition instead of the current buffer.
161 If the composition is invalid, return -1. */
163 ptrdiff_t
164 get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars,
165 Lisp_Object prop, Lisp_Object string)
167 Lisp_Object id, length, components, key, *key_contents;
168 ptrdiff_t glyph_len;
169 struct Lisp_Hash_Table *hash_table = XHASH_TABLE (composition_hash_table);
170 ptrdiff_t hash_index;
171 EMACS_UINT hash_code;
172 enum composition_method method;
173 struct composition *cmp;
174 ptrdiff_t i;
175 int ch;
177 /* Maximum length of a string of glyphs. XftGlyphExtents limits
178 this to INT_MAX, and Emacs limits it further. Divide INT_MAX - 1
179 by 2 because x_produce_glyphs computes glyph_len * 2 + 1. Divide
180 the size by MAX_MULTIBYTE_LENGTH because encode_terminal_code
181 multiplies glyph_len by MAX_MULTIBYTE_LENGTH. */
182 enum {
183 GLYPH_LEN_MAX = min ((INT_MAX - 1) / 2,
184 min (PTRDIFF_MAX, SIZE_MAX) / MAX_MULTIBYTE_LENGTH)
187 /* PROP should be
188 Form-A: ((LENGTH . COMPONENTS) . MODIFICATION-FUNC)
190 Form-B: (COMPOSITION-ID . (LENGTH COMPONENTS-VEC . MODIFICATION-FUNC))
192 if (nchars == 0 || !CONSP (prop))
193 goto invalid_composition;
195 id = XCAR (prop);
196 if (INTEGERP (id))
198 /* PROP should be Form-B. */
199 if (XINT (id) < 0 || XINT (id) >= n_compositions)
200 goto invalid_composition;
201 return XINT (id);
204 /* PROP should be Form-A.
205 Thus, ID should be (LENGTH . COMPONENTS). */
206 if (!CONSP (id))
207 goto invalid_composition;
208 length = XCAR (id);
209 if (!INTEGERP (length) || XINT (length) != nchars)
210 goto invalid_composition;
212 components = XCDR (id);
214 /* Check if the same composition has already been registered or not
215 by consulting composition_hash_table. The key for this table is
216 COMPONENTS (converted to a vector COMPONENTS-VEC) or, if it is
217 nil, vector of characters in the composition range. */
218 if (INTEGERP (components))
219 key = Fmake_vector (make_number (1), components);
220 else if (STRINGP (components) || CONSP (components))
221 key = Fvconcat (1, &components);
222 else if (VECTORP (components))
223 key = components;
224 else if (NILP (components))
226 key = make_uninit_vector (nchars);
227 if (STRINGP (string))
228 for (i = 0; i < nchars; i++)
230 FETCH_STRING_CHAR_ADVANCE (ch, string, charpos, bytepos);
231 ASET (key, i, make_number (ch));
233 else
234 for (i = 0; i < nchars; i++)
236 FETCH_CHAR_ADVANCE (ch, charpos, bytepos);
237 ASET (key, i, make_number (ch));
240 else
241 goto invalid_composition;
243 hash_index = hash_lookup (hash_table, key, &hash_code);
244 if (hash_index >= 0)
246 /* We have already registered the same composition. Change PROP
247 from Form-A above to Form-B while replacing COMPONENTS with
248 COMPONENTS-VEC stored in the hash table. We can directly
249 modify the cons cell of PROP because it is not shared. */
250 key = HASH_KEY (hash_table, hash_index);
251 id = HASH_VALUE (hash_table, hash_index);
252 XSETCAR (prop, id);
253 XSETCDR (prop, Fcons (make_number (nchars), Fcons (key, XCDR (prop))));
254 return XINT (id);
257 /* This composition is a new one. We must register it. */
259 /* Check if we have sufficient memory to store this information. */
260 if (composition_table_size <= n_compositions)
261 composition_table = xpalloc (composition_table, &composition_table_size,
262 1, -1, sizeof *composition_table);
264 key_contents = XVECTOR (key)->contents;
266 /* Check if the contents of COMPONENTS are valid if COMPONENTS is a
267 vector or a list. It should be a sequence of:
268 char1 rule1 char2 rule2 char3 ... ruleN charN+1 */
270 if (VECTORP (components)
271 && ASIZE (components) >= 2
272 && VECTORP (AREF (components, 0)))
274 /* COMPONENTS is a glyph-string. */
275 ptrdiff_t len = ASIZE (key);
277 for (i = 1; i < len; i++)
278 if (! VECTORP (AREF (key, i)))
279 goto invalid_composition;
281 else if (VECTORP (components) || CONSP (components))
283 ptrdiff_t len = ASIZE (key);
285 /* The number of elements should be odd. */
286 if ((len % 2) == 0)
287 goto invalid_composition;
288 /* All elements should be integers (character or encoded
289 composition rule). */
290 for (i = 0; i < len; i++)
292 if (!INTEGERP (key_contents[i]))
293 goto invalid_composition;
297 /* Change PROP from Form-A above to Form-B. We can directly modify
298 the cons cell of PROP because it is not shared. */
299 XSETFASTINT (id, n_compositions);
300 XSETCAR (prop, id);
301 XSETCDR (prop, Fcons (make_number (nchars), Fcons (key, XCDR (prop))));
303 /* Register the composition in composition_hash_table. */
304 hash_index = hash_put (hash_table, key, id, hash_code);
306 method = (NILP (components)
307 ? COMPOSITION_RELATIVE
308 : ((INTEGERP (components) || STRINGP (components))
309 ? COMPOSITION_WITH_ALTCHARS
310 : COMPOSITION_WITH_RULE_ALTCHARS));
312 glyph_len = (method == COMPOSITION_WITH_RULE_ALTCHARS
313 ? (ASIZE (key) + 1) / 2
314 : ASIZE (key));
316 if (GLYPH_LEN_MAX < glyph_len)
317 memory_full (SIZE_MAX);
319 /* Register the composition in composition_table. */
320 cmp = xmalloc (sizeof *cmp);
322 cmp->method = method;
323 cmp->hash_index = hash_index;
324 cmp->glyph_len = glyph_len;
325 cmp->offsets = xnmalloc (glyph_len, 2 * sizeof *cmp->offsets);
326 cmp->font = NULL;
328 if (cmp->method != COMPOSITION_WITH_RULE_ALTCHARS)
330 /* Relative composition. */
331 cmp->width = 0;
332 for (i = 0; i < glyph_len; i++)
334 int this_width;
335 ch = XINT (key_contents[i]);
336 /* TAB in a composition means display glyphs with padding
337 space on the left or right. */
338 this_width = (ch == '\t' ? 1 : CHAR_WIDTH (ch));
339 if (cmp->width < this_width)
340 cmp->width = this_width;
343 else
345 /* Rule-base composition. */
346 double leftmost = 0.0, rightmost;
348 ch = XINT (key_contents[0]);
349 rightmost = ch != '\t' ? CHAR_WIDTH (ch) : 1;
351 for (i = 1; i < glyph_len; i += 2)
353 int rule, gref, nref;
354 int this_width;
355 double this_left;
357 rule = XINT (key_contents[i]);
358 ch = XINT (key_contents[i + 1]);
359 this_width = ch != '\t' ? CHAR_WIDTH (ch) : 1;
361 /* A composition rule is specified by an integer value
362 that encodes global and new reference points (GREF and
363 NREF). GREF and NREF are specified by numbers as
364 below:
365 0---1---2 -- ascent
369 9--10--11 -- center
371 ---3---4---5--- baseline
373 6---7---8 -- descent
375 COMPOSITION_DECODE_REFS (rule, gref, nref);
376 this_left = (leftmost
377 + (gref % 3) * (rightmost - leftmost) / 2.0
378 - (nref % 3) * this_width / 2.0);
380 if (this_left < leftmost)
381 leftmost = this_left;
382 if (this_left + this_width > rightmost)
383 rightmost = this_left + this_width;
386 cmp->width = rightmost - leftmost;
387 if (cmp->width < (rightmost - leftmost))
388 /* To get a ceiling integer value. */
389 cmp->width++;
392 composition_table[n_compositions] = cmp;
394 return n_compositions++;
396 invalid_composition:
397 /* Would it be better to remove this `composition' property? */
398 return -1;
402 /* Find a static composition at or nearest to position POS of OBJECT
403 (buffer or string).
405 OBJECT defaults to the current buffer. If there's a composition at
406 POS, set *START and *END to the start and end of the sequence,
407 *PROP to the `composition' property, and return 1.
409 If there's no composition at POS and LIMIT is negative, return 0.
411 Otherwise, search for a composition forward (LIMIT > POS) or
412 backward (LIMIT < POS). In this case, LIMIT bounds the search.
414 If a composition is found, set *START, *END, and *PROP as above,
415 and return 1, else return 0.
417 This doesn't check the validity of composition. */
419 bool
420 find_composition (ptrdiff_t pos, ptrdiff_t limit,
421 ptrdiff_t *start, ptrdiff_t *end,
422 Lisp_Object *prop, Lisp_Object object)
424 Lisp_Object val;
426 if (get_property_and_range (pos, Qcomposition, prop, start, end, object))
427 return 1;
429 if (limit < 0 || limit == pos)
430 return 0;
432 if (limit > pos) /* search forward */
434 val = Fnext_single_property_change (make_number (pos), Qcomposition,
435 object, make_number (limit));
436 pos = XINT (val);
437 if (pos == limit)
438 return 0;
440 else /* search backward */
442 if (get_property_and_range (pos - 1, Qcomposition, prop, start, end,
443 object))
444 return 1;
445 val = Fprevious_single_property_change (make_number (pos), Qcomposition,
446 object, make_number (limit));
447 pos = XINT (val);
448 if (pos == limit)
449 return 0;
450 pos--;
452 get_property_and_range (pos, Qcomposition, prop, start, end, object);
453 return 1;
456 /* Run a proper function to adjust the composition sitting between
457 FROM and TO with property PROP. */
459 static void
460 run_composition_function (ptrdiff_t from, ptrdiff_t to, Lisp_Object prop)
462 Lisp_Object func;
463 ptrdiff_t start, end;
465 func = COMPOSITION_MODIFICATION_FUNC (prop);
466 /* If an invalid composition precedes or follows, try to make them
467 valid too. */
468 if (from > BEGV
469 && find_composition (from - 1, -1, &start, &end, &prop, Qnil)
470 && !composition_valid_p (start, end, prop))
471 from = start;
472 if (to < ZV
473 && find_composition (to, -1, &start, &end, &prop, Qnil)
474 && !composition_valid_p (start, end, prop))
475 to = end;
476 if (!NILP (Ffboundp (func)))
477 call2 (func, make_number (from), make_number (to));
480 /* Make invalid compositions adjacent to or inside FROM and TO valid.
481 CHECK_MASK is bitwise `or' of mask bits defined by macros
482 CHECK_XXX (see the comment in composite.h).
484 It also resets the text-property `auto-composed' to a proper region
485 so that automatic character composition works correctly later while
486 displaying the region.
488 This function is called when a buffer text is changed. If the
489 change is deletion, FROM == TO. Otherwise, FROM < TO. */
491 void
492 update_compositions (ptrdiff_t from, ptrdiff_t to, int check_mask)
494 Lisp_Object prop;
495 ptrdiff_t start, end;
496 /* The beginning and end of the region to set the property
497 `auto-composed' to nil. */
498 ptrdiff_t min_pos = from, max_pos = to;
500 if (inhibit_modification_hooks)
501 return;
503 /* If FROM and TO are not in a valid range, do nothing. */
504 if (! (BEGV <= from && from <= to && to <= ZV))
505 return;
507 if (check_mask & CHECK_HEAD)
509 /* FROM should be at composition boundary. But, insertion or
510 deletion will make two compositions adjacent and
511 indistinguishable when they have same (eq) property. To
512 avoid it, in such a case, we change the property of the
513 latter to the copy of it. */
514 if (from > BEGV
515 && find_composition (from - 1, -1, &start, &end, &prop, Qnil)
516 && composition_valid_p (start, end, prop))
518 min_pos = start;
519 if (end > to)
520 max_pos = end;
521 if (from < end)
522 Fput_text_property (make_number (from), make_number (end),
523 Qcomposition,
524 Fcons (XCAR (prop), XCDR (prop)), Qnil);
525 run_composition_function (start, end, prop);
526 from = end;
528 else if (from < ZV
529 && find_composition (from, -1, &start, &from, &prop, Qnil)
530 && composition_valid_p (start, from, prop))
532 if (from > to)
533 max_pos = from;
534 run_composition_function (start, from, prop);
538 if (check_mask & CHECK_INSIDE)
540 /* In this case, we are sure that (check & CHECK_TAIL) is also
541 nonzero. Thus, here we should check only compositions before
542 (to - 1). */
543 while (from < to - 1
544 && find_composition (from, to, &start, &from, &prop, Qnil)
545 && composition_valid_p (start, from, prop)
546 && from < to - 1)
547 run_composition_function (start, from, prop);
550 if (check_mask & CHECK_TAIL)
552 if (from < to
553 && find_composition (to - 1, -1, &start, &end, &prop, Qnil)
554 && composition_valid_p (start, end, prop))
556 /* TO should be also at composition boundary. But,
557 insertion or deletion will make two compositions adjacent
558 and indistinguishable when they have same (eq) property.
559 To avoid it, in such a case, we change the property of
560 the former to the copy of it. */
561 if (to < end)
563 Fput_text_property (make_number (start), make_number (to),
564 Qcomposition,
565 Fcons (XCAR (prop), XCDR (prop)), Qnil);
566 max_pos = end;
568 run_composition_function (start, end, prop);
570 else if (to < ZV
571 && find_composition (to, -1, &start, &end, &prop, Qnil)
572 && composition_valid_p (start, end, prop))
574 run_composition_function (start, end, prop);
575 max_pos = end;
578 if (min_pos < max_pos)
580 ptrdiff_t count = SPECPDL_INDEX ();
582 specbind (Qinhibit_read_only, Qt);
583 specbind (Qinhibit_modification_hooks, Qt);
584 specbind (Qinhibit_point_motion_hooks, Qt);
585 Fremove_list_of_text_properties (make_number (min_pos),
586 make_number (max_pos),
587 list1 (Qauto_composed), Qnil);
588 unbind_to (count, Qnil);
593 /* Modify composition property values in LIST destructively. LIST is
594 a list as returned from text_property_list. Change values to the
595 top-level copies of them so that none of them are `eq'. */
597 void
598 make_composition_value_copy (Lisp_Object list)
600 Lisp_Object plist, val;
602 for (; CONSP (list); list = XCDR (list))
604 plist = XCAR (XCDR (XCDR (XCAR (list))));
605 while (CONSP (plist) && CONSP (XCDR (plist)))
607 if (EQ (XCAR (plist), Qcomposition)
608 && (val = XCAR (XCDR (plist)), CONSP (val)))
609 XSETCAR (XCDR (plist), Fcons (XCAR (val), XCDR (val)));
610 plist = XCDR (XCDR (plist));
616 /* Make text in the region between START and END a composition that
617 has COMPONENTS and MODIFICATION-FUNC.
619 If STRING is non-nil, then operate on characters contained between
620 indices START and END in STRING. */
622 void
623 compose_text (ptrdiff_t start, ptrdiff_t end, Lisp_Object components,
624 Lisp_Object modification_func, Lisp_Object string)
626 Lisp_Object prop;
628 prop = Fcons (Fcons (make_number (end - start), components),
629 modification_func);
630 Fput_text_property (make_number (start), make_number (end),
631 Qcomposition, prop, string);
634 /* Lisp glyph-string handlers. */
636 /* Hash table for automatic composition. The key is a header of a
637 lgstring (Lispy glyph-string), and the value is a body of a
638 lgstring. */
640 static Lisp_Object gstring_hash_table;
642 static Lisp_Object gstring_lookup_cache (Lisp_Object);
644 static Lisp_Object
645 gstring_lookup_cache (Lisp_Object header)
647 struct Lisp_Hash_Table *h = XHASH_TABLE (gstring_hash_table);
648 ptrdiff_t i = hash_lookup (h, header, NULL);
650 return (i >= 0 ? HASH_VALUE (h, i) : Qnil);
653 Lisp_Object
654 composition_gstring_put_cache (Lisp_Object gstring, ptrdiff_t len)
656 struct Lisp_Hash_Table *h = XHASH_TABLE (gstring_hash_table);
657 EMACS_UINT hash;
658 Lisp_Object header, copy;
659 ptrdiff_t i;
661 header = LGSTRING_HEADER (gstring);
662 hash = h->test.hashfn (&h->test, header);
663 if (len < 0)
665 ptrdiff_t j, glyph_len = LGSTRING_GLYPH_LEN (gstring);
666 for (j = 0; j < glyph_len; j++)
667 if (NILP (LGSTRING_GLYPH (gstring, j)))
668 break;
669 len = j;
672 copy = Fmake_vector (make_number (len + 2), Qnil);
673 LGSTRING_SET_HEADER (copy, Fcopy_sequence (header));
674 for (i = 0; i < len; i++)
675 LGSTRING_SET_GLYPH (copy, i, Fcopy_sequence (LGSTRING_GLYPH (gstring, i)));
676 i = hash_put (h, LGSTRING_HEADER (copy), copy, hash);
677 LGSTRING_SET_ID (copy, make_number (i));
678 return copy;
681 Lisp_Object
682 composition_gstring_from_id (ptrdiff_t id)
684 struct Lisp_Hash_Table *h = XHASH_TABLE (gstring_hash_table);
686 return HASH_VALUE (h, id);
689 bool
690 composition_gstring_p (Lisp_Object gstring)
692 Lisp_Object header;
693 ptrdiff_t i;
695 if (! VECTORP (gstring) || ASIZE (gstring) < 2)
696 return 0;
697 header = LGSTRING_HEADER (gstring);
698 if (! VECTORP (header) || ASIZE (header) < 2)
699 return 0;
700 if (! NILP (LGSTRING_FONT (gstring))
701 && (! FONT_OBJECT_P (LGSTRING_FONT (gstring))
702 && ! CODING_SYSTEM_P (LGSTRING_FONT (gstring))))
703 return 0;
704 for (i = 1; i < ASIZE (LGSTRING_HEADER (gstring)); i++)
705 if (! NATNUMP (AREF (LGSTRING_HEADER (gstring), i)))
706 return 0;
707 if (! NILP (LGSTRING_ID (gstring)) && ! NATNUMP (LGSTRING_ID (gstring)))
708 return 0;
709 for (i = 0; i < LGSTRING_GLYPH_LEN (gstring); i++)
711 Lisp_Object glyph = LGSTRING_GLYPH (gstring, i);
712 if (NILP (glyph))
713 break;
714 if (! VECTORP (glyph) || ASIZE (glyph) != LGLYPH_SIZE)
715 return 0;
717 return 1;
721 composition_gstring_width (Lisp_Object gstring, ptrdiff_t from, ptrdiff_t to,
722 struct font_metrics *metrics)
724 Lisp_Object *glyph;
725 int width = 0;
727 if (metrics)
729 Lisp_Object font_object = LGSTRING_FONT (gstring);
731 if (FONT_OBJECT_P (font_object))
733 struct font *font = XFONT_OBJECT (font_object);
734 int font_ascent, font_descent;
736 get_font_ascent_descent (font, &font_ascent, &font_descent);
737 metrics->ascent = font_ascent;
738 metrics->descent = font_descent;
740 else
742 metrics->ascent = 1;
743 metrics->descent = 0;
745 metrics->width = metrics->lbearing = metrics->rbearing = 0;
747 for (glyph = lgstring_glyph_addr (gstring, from); from < to; from++, glyph++)
749 int x;
751 if (NILP (LGLYPH_ADJUSTMENT (*glyph)))
752 width += LGLYPH_WIDTH (*glyph);
753 else
754 width += LGLYPH_WADJUST (*glyph);
755 if (metrics)
757 x = metrics->width + LGLYPH_LBEARING (*glyph) + LGLYPH_XOFF (*glyph);
758 if (metrics->lbearing > x)
759 metrics->lbearing = x;
760 x = metrics->width + LGLYPH_RBEARING (*glyph) + LGLYPH_XOFF (*glyph);
761 if (metrics->rbearing < x)
762 metrics->rbearing = x;
763 metrics->width = width;
764 x = LGLYPH_ASCENT (*glyph) - LGLYPH_YOFF (*glyph);
765 if (metrics->ascent < x)
766 metrics->ascent = x;
767 x = LGLYPH_DESCENT (*glyph) + LGLYPH_YOFF (*glyph);
768 if (metrics->descent < x)
769 metrics->descent = x;
772 return width;
776 static Lisp_Object gstring_work;
777 static Lisp_Object gstring_work_headers;
779 static Lisp_Object
780 fill_gstring_header (Lisp_Object header, ptrdiff_t from, ptrdiff_t from_byte,
781 ptrdiff_t to, Lisp_Object font_object, Lisp_Object string)
783 ptrdiff_t len = to - from, i;
785 if (len == 0)
786 error ("Attempt to shape zero-length text");
787 if (VECTORP (header))
789 if (ASIZE (header) != len + 1)
790 args_out_of_range (header, make_number (len + 1));
792 else
794 if (len <= 8)
795 header = AREF (gstring_work_headers, len - 1);
796 else
797 header = make_uninit_vector (len + 1);
800 ASET (header, 0, font_object);
801 for (i = 0; i < len; i++)
803 int c;
805 if (NILP (string))
806 FETCH_CHAR_ADVANCE_NO_CHECK (c, from, from_byte);
807 else
808 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, from, from_byte);
809 ASET (header, i + 1, make_number (c));
811 return header;
814 static void
815 fill_gstring_body (Lisp_Object gstring)
817 Lisp_Object font_object = LGSTRING_FONT (gstring);
818 Lisp_Object header = AREF (gstring, 0);
819 ptrdiff_t len = LGSTRING_CHAR_LEN (gstring);
820 ptrdiff_t i;
822 for (i = 0; i < len; i++)
824 Lisp_Object g = LGSTRING_GLYPH (gstring, i);
825 int c = XFASTINT (AREF (header, i + 1));
827 if (NILP (g))
829 g = LGLYPH_NEW ();
830 LGSTRING_SET_GLYPH (gstring, i, g);
832 LGLYPH_SET_FROM (g, i);
833 LGLYPH_SET_TO (g, i);
834 LGLYPH_SET_CHAR (g, c);
835 if (FONT_OBJECT_P (font_object))
837 font_fill_lglyph_metrics (g, font_object);
839 else
841 int width = XFASTINT (CHAR_TABLE_REF (Vchar_width_table, c));
843 LGLYPH_SET_CODE (g, c);
844 LGLYPH_SET_LBEARING (g, 0);
845 LGLYPH_SET_RBEARING (g, width);
846 LGLYPH_SET_WIDTH (g, width);
847 LGLYPH_SET_ASCENT (g, 1);
848 LGLYPH_SET_DESCENT (g, 0);
850 LGLYPH_SET_ADJUSTMENT (g, Qnil);
852 if (i < LGSTRING_GLYPH_LEN (gstring))
853 LGSTRING_SET_GLYPH (gstring, i, Qnil);
857 /* Try to compose the characters at CHARPOS according to composition
858 rule RULE ([PATTERN PREV-CHARS FUNC]). LIMIT limits the characters
859 to compose. STRING, if not nil, is a target string. WIN is a
860 window where the characters are being displayed. If characters are
861 successfully composed, return the composition as a glyph-string
862 object. Otherwise return nil. */
864 static Lisp_Object
865 autocmp_chars (Lisp_Object rule, ptrdiff_t charpos, ptrdiff_t bytepos,
866 ptrdiff_t limit, struct window *win, struct face *face,
867 Lisp_Object string)
869 ptrdiff_t count = SPECPDL_INDEX ();
870 struct frame *f = XFRAME (win->frame);
871 Lisp_Object pos = make_number (charpos);
872 ptrdiff_t to;
873 ptrdiff_t pt = PT, pt_byte = PT_BYTE;
874 Lisp_Object re, font_object, lgstring;
875 ptrdiff_t len;
877 record_unwind_save_match_data ();
878 re = AREF (rule, 0);
879 if (NILP (re))
880 len = 1;
881 else if (! STRINGP (re))
882 return unbind_to (count, Qnil);
883 else if ((len = fast_looking_at (re, charpos, bytepos, limit, -1, string))
884 > 0)
886 if (NILP (string))
887 len = BYTE_TO_CHAR (bytepos + len) - charpos;
888 else
889 len = string_byte_to_char (string, bytepos + len) - charpos;
891 if (len <= 0)
892 return unbind_to (count, Qnil);
893 to = limit = charpos + len;
894 if (FRAME_WINDOW_P (f))
896 font_object = font_range (charpos, bytepos, &to, win, face, string);
897 if (! FONT_OBJECT_P (font_object)
898 || (! NILP (re)
899 && to < limit
900 && (fast_looking_at (re, charpos, bytepos, to, -1, string) <= 0)))
901 return unbind_to (count, Qnil);
903 else
904 font_object = win->frame;
905 lgstring = Fcomposition_get_gstring (pos, make_number (to), font_object,
906 string);
907 if (NILP (LGSTRING_ID (lgstring)))
909 /* Save point as marker before calling out to lisp. */
910 if (NILP (string))
911 record_unwind_protect (restore_point_unwind,
912 build_marker (current_buffer, pt, pt_byte));
913 lgstring = safe_call (6, Vauto_composition_function, AREF (rule, 2),
914 pos, make_number (to), font_object, string);
916 return unbind_to (count, lgstring);
919 /* 1 iff the character C is composable. Characters of general
920 category Z? or C? are not composable except for ZWNJ and ZWJ. */
922 static bool
923 char_composable_p (int c)
925 Lisp_Object val;
926 return (c > ' '
927 && (c == ZERO_WIDTH_NON_JOINER || c == ZERO_WIDTH_JOINER
928 || (val = CHAR_TABLE_REF (Vunicode_category_table, c),
929 (INTEGERP (val) && (XINT (val) <= UNICODE_CATEGORY_So)))));
932 /* Update cmp_it->stop_pos to the next position after CHARPOS (and
933 BYTEPOS) where character composition may happen. If BYTEPOS is
934 negative, compute it. ENDPOS is a limit of searching. If it is
935 less than CHARPOS, search backward to ENDPOS+1 assuming that
936 set_iterator_to_next works in reverse order. In this case, if a
937 composition closest to CHARPOS is found, set cmp_it->stop_pos to
938 the last character of the composition.
940 If no composition is found, set cmp_it->ch to -2. If a static
941 composition is found, set cmp_it->ch to -1. Otherwise, set
942 cmp_it->ch to the character that triggers the automatic
943 composition. */
945 void
946 composition_compute_stop_pos (struct composition_it *cmp_it, ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t endpos, Lisp_Object string)
948 ptrdiff_t start, end;
949 int c;
950 Lisp_Object prop, val;
951 /* This is from forward_to_next_line_start in xdisp.c. */
952 const int MAX_NEWLINE_DISTANCE = 500;
954 if (charpos < endpos)
956 if (endpos > charpos + MAX_NEWLINE_DISTANCE)
957 endpos = charpos + MAX_NEWLINE_DISTANCE;
959 else if (endpos < charpos)
961 /* We search backward for a position to check composition. */
962 if (endpos < 0)
964 /* But we don't know where to stop the searching. */
965 endpos = NILP (string) ? BEGV - 1 : -1;
966 /* Usually we don't reach ENDPOS because we stop searching
967 at an uncomposable character (NL, LRE, etc). */
970 cmp_it->id = -1;
971 cmp_it->ch = -2;
972 cmp_it->reversed_p = 0;
973 cmp_it->stop_pos = endpos;
974 if (charpos == endpos)
975 return;
976 /* FIXME: Bidi is not yet handled well in static composition. */
977 if (charpos < endpos
978 && find_composition (charpos, endpos, &start, &end, &prop, string)
979 && start >= charpos
980 && composition_valid_p (start, end, prop))
982 cmp_it->stop_pos = endpos = start;
983 cmp_it->ch = -1;
985 if (NILP (BVAR (current_buffer, enable_multibyte_characters))
986 || NILP (Vauto_composition_mode))
987 return;
988 if (bytepos < 0)
990 if (NILP (string))
991 bytepos = CHAR_TO_BYTE (charpos);
992 else
993 bytepos = string_char_to_byte (string, charpos);
996 start = charpos;
997 if (charpos < endpos)
999 /* Forward search. */
1000 while (charpos < endpos)
1002 if (STRINGP (string))
1003 FETCH_STRING_CHAR_ADVANCE (c, string, charpos, bytepos);
1004 else
1005 FETCH_CHAR_ADVANCE (c, charpos, bytepos);
1006 if (c == '\n')
1008 cmp_it->ch = -2;
1009 break;
1011 val = CHAR_TABLE_REF (Vcomposition_function_table, c);
1012 if (! NILP (val))
1014 for (int ridx = 0; CONSP (val); val = XCDR (val), ridx++)
1016 Lisp_Object elt = XCAR (val);
1017 if (VECTORP (elt) && ASIZE (elt) == 3
1018 && NATNUMP (AREF (elt, 1))
1019 && charpos - 1 - XFASTINT (AREF (elt, 1)) >= start)
1021 cmp_it->rule_idx = ridx;
1022 cmp_it->lookback = XFASTINT (AREF (elt, 1));
1023 cmp_it->stop_pos = charpos - 1 - cmp_it->lookback;
1024 cmp_it->ch = c;
1025 return;
1030 if (charpos == endpos
1031 && !(STRINGP (string) && endpos == SCHARS (string)))
1033 /* We couldn't find a composition point before ENDPOS. But,
1034 some character after ENDPOS may be composed with
1035 characters before ENDPOS. So, we should stop at the safe
1036 point. */
1037 charpos = endpos - MAX_AUTO_COMPOSITION_LOOKBACK;
1038 if (charpos < start)
1039 charpos = start;
1042 else if (charpos > endpos)
1044 /* Search backward for a pattern that may be composed and the
1045 position of (possibly) the last character of the match is
1046 closest to (but not after) START. The reason for the last
1047 character is that set_iterator_to_next works in reverse order,
1048 and thus we must stop at the last character for composition
1049 check. */
1050 unsigned char *p;
1051 int len;
1052 /* Limit byte position used in fast_looking_at. This is the
1053 byte position of the character after START. */
1054 ptrdiff_t limit;
1056 if (NILP (string))
1057 p = BYTE_POS_ADDR (bytepos);
1058 else
1059 p = SDATA (string) + bytepos;
1060 c = STRING_CHAR_AND_LENGTH (p, len);
1061 limit = bytepos + len;
1062 while (char_composable_p (c))
1064 val = CHAR_TABLE_REF (Vcomposition_function_table, c);
1065 if (! NILP (val))
1067 Lisp_Object elt;
1068 int ridx, blen;
1070 for (ridx = 0; CONSP (val); val = XCDR (val), ridx++)
1072 elt = XCAR (val);
1073 if (VECTORP (elt) && ASIZE (elt) == 3
1074 && NATNUMP (AREF (elt, 1))
1075 && charpos - XFASTINT (AREF (elt, 1)) > endpos)
1077 ptrdiff_t back = XFASTINT (AREF (elt, 1));
1078 ptrdiff_t cpos = charpos - back, bpos;
1080 if (back == 0)
1081 bpos = bytepos;
1082 else
1083 bpos = (NILP (string) ? CHAR_TO_BYTE (cpos)
1084 : string_char_to_byte (string, cpos));
1085 if (STRINGP (AREF (elt, 0)))
1086 blen = fast_looking_at (AREF (elt, 0), cpos, bpos,
1087 start + 1, limit, string);
1088 else
1089 blen = 1;
1090 if (blen > 0)
1092 /* Make CPOS point to the last character of
1093 match. Note that BLEN is byte-length. */
1094 if (blen > 1)
1096 bpos += blen;
1097 if (NILP (string))
1098 cpos = BYTE_TO_CHAR (bpos) - 1;
1099 else
1100 cpos = string_byte_to_char (string, bpos) - 1;
1102 back = cpos - (charpos - back);
1103 if (cmp_it->stop_pos < cpos
1104 || (cmp_it->stop_pos == cpos
1105 && cmp_it->lookback < back))
1107 cmp_it->rule_idx = ridx;
1108 cmp_it->stop_pos = cpos;
1109 cmp_it->ch = c;
1110 cmp_it->lookback = back;
1111 cmp_it->nchars = back + 1;
1117 if (charpos - 1 == endpos)
1118 break;
1119 if (STRINGP (string))
1121 p--, bytepos--;
1122 while (! CHAR_HEAD_P (*p))
1123 p--, bytepos--;
1124 charpos--;
1126 else
1128 DEC_BOTH (charpos, bytepos);
1129 p = BYTE_POS_ADDR (bytepos);
1131 c = STRING_CHAR (p);
1133 if (cmp_it->ch >= 0)
1134 /* We found a position to check. */
1135 return;
1136 /* Skip all uncomposable characters. */
1137 if (NILP (string))
1139 while (charpos - 1 > endpos && ! char_composable_p (c))
1141 DEC_BOTH (charpos, bytepos);
1142 c = FETCH_MULTIBYTE_CHAR (bytepos);
1145 else
1147 while (charpos - 1 > endpos && ! char_composable_p (c))
1149 p--;
1150 while (! CHAR_HEAD_P (*p))
1151 p--;
1152 charpos--;
1153 c = STRING_CHAR (p);
1157 cmp_it->stop_pos = charpos;
1160 /* Check if the character at CHARPOS (and BYTEPOS) is composed
1161 (possibly with the following characters) on window W. ENDPOS limits
1162 characters to be composed. FACE, if non-NULL, is a base face of
1163 the character. If STRING is not nil, it is a string containing the
1164 character to check, and CHARPOS and BYTEPOS are indices in the
1165 string. In that case, FACE must not be NULL.
1167 If the character is composed, setup members of CMP_IT (id, nglyphs,
1168 from, to, reversed_p), and return true. Otherwise, update
1169 CMP_IT->stop_pos, and return false. */
1171 bool
1172 composition_reseat_it (struct composition_it *cmp_it, ptrdiff_t charpos,
1173 ptrdiff_t bytepos, ptrdiff_t endpos, struct window *w,
1174 struct face *face, Lisp_Object string)
1176 if (cmp_it->ch == -2)
1178 composition_compute_stop_pos (cmp_it, charpos, bytepos, endpos, string);
1179 if (cmp_it->ch == -2 || cmp_it->stop_pos != charpos)
1180 /* The current position is not composed. */
1181 return 0;
1184 if (endpos < 0)
1185 endpos = NILP (string) ? BEGV : 0;
1187 if (cmp_it->ch < 0)
1189 /* We are looking at a static composition. */
1190 ptrdiff_t start, end;
1191 Lisp_Object prop;
1193 find_composition (charpos, -1, &start, &end, &prop, string);
1194 cmp_it->id = get_composition_id (charpos, bytepos, end - start,
1195 prop, string);
1196 if (cmp_it->id < 0)
1197 goto no_composition;
1198 cmp_it->nchars = end - start;
1199 cmp_it->nglyphs = composition_table[cmp_it->id]->glyph_len;
1201 else if (w)
1203 Lisp_Object lgstring = Qnil;
1204 Lisp_Object val, elt;
1205 ptrdiff_t i;
1207 val = CHAR_TABLE_REF (Vcomposition_function_table, cmp_it->ch);
1208 for (i = 0; i < cmp_it->rule_idx; i++, val = XCDR (val));
1209 if (charpos < endpos)
1211 for (; CONSP (val); val = XCDR (val))
1213 elt = XCAR (val);
1214 if (! VECTORP (elt) || ASIZE (elt) != 3
1215 || ! INTEGERP (AREF (elt, 1)))
1216 continue;
1217 if (XFASTINT (AREF (elt, 1)) != cmp_it->lookback)
1218 goto no_composition;
1219 lgstring = autocmp_chars (elt, charpos, bytepos, endpos,
1220 w, face, string);
1221 if (composition_gstring_p (lgstring))
1222 break;
1223 lgstring = Qnil;
1224 /* Composition failed perhaps because the font doesn't
1225 support sufficient range of characters. Try the
1226 other composition rules if any. */
1228 cmp_it->reversed_p = 0;
1230 else
1232 ptrdiff_t cpos = charpos, bpos = bytepos;
1234 cmp_it->reversed_p = 1;
1235 elt = XCAR (val);
1236 if (cmp_it->lookback > 0)
1238 cpos = charpos - cmp_it->lookback;
1239 if (STRINGP (string))
1240 bpos = string_char_to_byte (string, cpos);
1241 else
1242 bpos = CHAR_TO_BYTE (cpos);
1244 lgstring = autocmp_chars (elt, cpos, bpos, charpos + 1, w, face,
1245 string);
1246 if (! composition_gstring_p (lgstring)
1247 || cpos + LGSTRING_CHAR_LEN (lgstring) - 1 != charpos)
1248 /* Composition failed or didn't cover the current
1249 character. */
1250 goto no_composition;
1252 if (NILP (lgstring))
1253 goto no_composition;
1254 if (NILP (LGSTRING_ID (lgstring)))
1255 lgstring = composition_gstring_put_cache (lgstring, -1);
1256 cmp_it->id = XINT (LGSTRING_ID (lgstring));
1257 for (i = 0; i < LGSTRING_GLYPH_LEN (lgstring); i++)
1258 if (NILP (LGSTRING_GLYPH (lgstring, i)))
1259 break;
1260 cmp_it->nglyphs = i;
1261 cmp_it->from = 0;
1262 cmp_it->to = i;
1264 else
1265 goto no_composition;
1266 return 1;
1268 no_composition:
1269 if (charpos == endpos)
1270 return 0;
1271 if (charpos < endpos)
1273 charpos++;
1274 if (NILP (string))
1275 INC_POS (bytepos);
1276 else
1277 bytepos += BYTES_BY_CHAR_HEAD (*(SDATA (string) + bytepos));
1279 else
1281 charpos--;
1282 /* BYTEPOS is calculated in composition_compute_stop_pos */
1283 bytepos = -1;
1285 if (cmp_it->reversed_p)
1286 endpos = -1;
1287 composition_compute_stop_pos (cmp_it, charpos, bytepos, endpos, string);
1288 return 0;
1291 /* Update charpos, nchars, nbytes, and width of the current grapheme
1292 cluster.
1294 If the composition is static or automatic in L2R context, the
1295 cluster is identified by CMP_IT->from, and CHARPOS is the position
1296 of the first character of the cluster. In this case, update
1297 CMP_IT->to too.
1299 If the composition is automatic in R2L context, the cluster is
1300 identified by CMP_IT->to, and CHARPOS is the position of the last
1301 character of the cluster. In this case, update CMP_IT->from too.
1303 The return value is the character code of the first character of
1304 the cluster, or -1 if the composition is somehow broken. */
1307 composition_update_it (struct composition_it *cmp_it, ptrdiff_t charpos, ptrdiff_t bytepos, Lisp_Object string)
1309 int i;
1310 int c UNINIT;
1312 if (cmp_it->ch < 0)
1314 /* static composition */
1315 struct composition *cmp = composition_table[cmp_it->id];
1317 cmp_it->charpos = charpos;
1318 cmp_it->to = cmp_it->nglyphs;
1319 if (cmp_it->nglyphs == 0)
1320 c = -1;
1321 else
1323 for (i = 0; i < cmp->glyph_len; i++)
1324 /* TAB in a composition means display glyphs with padding
1325 space on the left or right. */
1326 if ((c = COMPOSITION_GLYPH (cmp, i)) != '\t')
1327 break;
1328 if (c == '\t')
1329 c = ' ';
1331 cmp_it->width = cmp->width;
1332 charpos += cmp_it->nchars;
1333 if (STRINGP (string))
1334 cmp_it->nbytes = string_char_to_byte (string, charpos) - bytepos;
1335 else
1336 cmp_it->nbytes = CHAR_TO_BYTE (charpos) - bytepos;
1338 else
1340 /* Automatic composition. */
1341 Lisp_Object gstring = composition_gstring_from_id (cmp_it->id);
1342 Lisp_Object glyph;
1343 ptrdiff_t from;
1345 if (cmp_it->nglyphs == 0)
1347 cmp_it->nchars = LGSTRING_CHAR_LEN (gstring);
1348 cmp_it->width = 0;
1349 cmp_it->from = cmp_it->to = 0;
1350 return -1;
1352 if (! cmp_it->reversed_p)
1354 glyph = LGSTRING_GLYPH (gstring, cmp_it->from);
1355 from = LGLYPH_FROM (glyph);
1356 for (cmp_it->to = cmp_it->from + 1; cmp_it->to < cmp_it->nglyphs;
1357 cmp_it->to++)
1359 glyph = LGSTRING_GLYPH (gstring, cmp_it->to);
1360 if (LGLYPH_FROM (glyph) != from)
1361 break;
1363 cmp_it->charpos = charpos;
1365 else
1367 glyph = LGSTRING_GLYPH (gstring, cmp_it->to - 1);
1368 from = LGLYPH_FROM (glyph);
1369 cmp_it->charpos = charpos - (LGLYPH_TO (glyph) - from);
1370 for (cmp_it->from = cmp_it->to - 1; cmp_it->from > 0;
1371 cmp_it->from--)
1373 glyph = LGSTRING_GLYPH (gstring, cmp_it->from - 1);
1374 if (LGLYPH_FROM (glyph) != from)
1375 break;
1378 glyph = LGSTRING_GLYPH (gstring, cmp_it->from);
1379 cmp_it->nchars = LGLYPH_TO (glyph) + 1 - from;
1380 cmp_it->nbytes = 0;
1381 cmp_it->width = 0;
1382 for (i = cmp_it->nchars - 1; i >= 0; i--)
1384 c = XINT (LGSTRING_CHAR (gstring, from + i));
1385 cmp_it->nbytes += CHAR_BYTES (c);
1386 cmp_it->width += CHAR_WIDTH (c);
1389 return c;
1393 struct position_record
1395 ptrdiff_t pos, pos_byte;
1396 unsigned char *p;
1399 /* Update the members of POSITION to the next character boundary. */
1400 #define FORWARD_CHAR(POSITION, STOP) \
1401 do { \
1402 (POSITION).pos++; \
1403 if ((POSITION).pos == (STOP)) \
1405 (POSITION).p = GAP_END_ADDR; \
1406 (POSITION).pos_byte = GPT_BYTE; \
1408 else \
1410 (POSITION).pos_byte += BYTES_BY_CHAR_HEAD (*((POSITION).p)); \
1411 (POSITION).p += BYTES_BY_CHAR_HEAD (*((POSITION).p)); \
1413 } while (0)
1415 /* Update the members of POSITION to the previous character boundary. */
1416 #define BACKWARD_CHAR(POSITION, STOP) \
1417 do { \
1418 if ((POSITION).pos == (STOP)) \
1419 (POSITION).p = GPT_ADDR; \
1420 do { \
1421 (POSITION).pos_byte--; \
1422 (POSITION).p--; \
1423 } while (! CHAR_HEAD_P (*((POSITION).p))); \
1424 (POSITION).pos--; \
1425 } while (0)
1427 /* This is like find_composition, but find an automatic composition
1428 instead. It is assured that POS is not within a static
1429 composition. If found, set *GSTRING to the glyph-string
1430 representing the composition, and return true. Otherwise, *GSTRING to
1431 Qnil, and return false. */
1433 static bool
1434 find_automatic_composition (ptrdiff_t pos, ptrdiff_t limit,
1435 ptrdiff_t *start, ptrdiff_t *end,
1436 Lisp_Object *gstring, Lisp_Object string)
1438 ptrdiff_t head, tail, stop;
1439 /* Forward limit position of checking a composition taking a
1440 looking-back count into account. */
1441 ptrdiff_t fore_check_limit;
1442 struct position_record cur, prev;
1443 int c;
1444 Lisp_Object window;
1445 struct window *w;
1446 bool need_adjustment = 0;
1448 window = Fget_buffer_window (Fcurrent_buffer (), Qnil);
1449 if (NILP (window))
1450 return 0;
1451 w = XWINDOW (window);
1453 cur.pos = pos;
1454 if (NILP (string))
1456 head = BEGV, tail = ZV, stop = GPT;
1457 cur.pos_byte = CHAR_TO_BYTE (cur.pos);
1458 cur.p = BYTE_POS_ADDR (cur.pos_byte);
1460 else
1462 head = 0, tail = SCHARS (string), stop = -1;
1463 cur.pos_byte = string_char_to_byte (string, cur.pos);
1464 cur.p = SDATA (string) + cur.pos_byte;
1466 if (limit < 0)
1467 /* Finding a composition covering the character after POS is the
1468 same as setting LIMIT to POS. */
1469 limit = pos;
1470 if (limit <= pos)
1471 fore_check_limit = min (tail, pos + 1 + MAX_AUTO_COMPOSITION_LOOKBACK);
1472 else
1473 fore_check_limit = min (tail, limit + MAX_AUTO_COMPOSITION_LOOKBACK);
1475 /* Provided that we have these possible compositions now:
1477 POS: 1 2 3 4 5 6 7 8 9
1478 |-A-|
1479 |-B-|-C-|--D--|
1481 Here, it is known that characters after positions 1 and 9 can
1482 never be composed (i.e. ! char_composable_p (CH)), and
1483 composition A is an invalid one because it's partially covered by
1484 the valid composition C. And to know whether a composition is
1485 valid or not, the only way is to start searching forward from a
1486 position that can not be a tail part of composition (it's 2 in
1487 the above case).
1489 Now we have these cases (1 through 4):
1491 -- character after POS is ... --
1492 not composable composable
1493 LIMIT <= POS (1) (3)
1494 POS < LIMIT (2) (4)
1496 Among them, in case (2), we simply search forward from POS.
1498 In the other cases, we at first rewind back to the position where
1499 the previous character is not composable or the beginning of
1500 buffer (string), then search compositions forward. In case (1)
1501 and (3) we repeat this process until a composition is found. */
1503 while (1)
1505 c = STRING_CHAR (cur.p);
1506 if (! char_composable_p (c))
1508 if (limit <= pos) /* case (1) */
1510 do {
1511 if (cur.pos <= limit)
1512 return 0;
1513 BACKWARD_CHAR (cur, stop);
1514 c = STRING_CHAR (cur.p);
1515 } while (! char_composable_p (c));
1516 fore_check_limit = cur.pos + 1;
1518 else /* case (2) */
1519 /* No need of rewinding back. */
1520 goto search_forward;
1523 /* Rewind back to the position where we can safely search
1524 forward for compositions. It is assured that the character
1525 at cur.pos is composable. */
1526 while (head < cur.pos)
1528 prev = cur;
1529 BACKWARD_CHAR (cur, stop);
1530 c = STRING_CHAR (cur.p);
1531 if (! char_composable_p (c))
1533 cur = prev;
1534 break;
1538 search_forward:
1539 /* Now search forward. */
1540 *gstring = Qnil;
1541 prev = cur; /* remember the start of searching position. */
1542 while (cur.pos < fore_check_limit)
1544 Lisp_Object val;
1546 c = STRING_CHAR (cur.p);
1547 for (val = CHAR_TABLE_REF (Vcomposition_function_table, c);
1548 CONSP (val); val = XCDR (val))
1550 Lisp_Object elt = XCAR (val);
1552 if (VECTORP (elt) && ASIZE (elt) == 3 && NATNUMP (AREF (elt, 1)))
1554 EMACS_INT check_pos = cur.pos - XFASTINT (AREF (elt, 1));
1555 struct position_record check;
1557 if (check_pos < head
1558 || (limit <= pos ? pos < check_pos
1559 : limit <= check_pos))
1560 continue;
1561 for (check = cur; check_pos < check.pos; )
1562 BACKWARD_CHAR (check, stop);
1563 *gstring = autocmp_chars (elt, check.pos, check.pos_byte,
1564 tail, w, NULL, string);
1565 need_adjustment = 1;
1566 if (NILP (*gstring))
1568 /* As we have called Lisp, there's a possibility
1569 that buffer/string is relocated. */
1570 if (NILP (string))
1571 cur.p = BYTE_POS_ADDR (cur.pos_byte);
1572 else
1573 cur.p = SDATA (string) + cur.pos_byte;
1575 else
1577 /* We found a candidate of a target composition. */
1578 *start = check.pos;
1579 *end = check.pos + LGSTRING_CHAR_LEN (*gstring);
1580 if (pos < limit
1581 ? pos < *end
1582 : *start <= pos && pos < *end)
1583 /* This is the target composition. */
1584 return 1;
1585 cur.pos = *end;
1586 if (NILP (string))
1588 cur.pos_byte = CHAR_TO_BYTE (cur.pos);
1589 cur.p = BYTE_POS_ADDR (cur.pos_byte);
1591 else
1593 cur.pos_byte = string_char_to_byte (string, cur.pos);
1594 cur.p = SDATA (string) + cur.pos_byte;
1596 break;
1600 if (! CONSP (val))
1601 /* We found no composition here. */
1602 FORWARD_CHAR (cur, stop);
1605 if (pos < limit) /* case (2) and (4)*/
1606 return 0;
1607 if (! NILP (*gstring))
1608 return 1;
1609 if (prev.pos == head)
1610 return 0;
1611 cur = prev;
1612 if (need_adjustment)
1614 if (NILP (string))
1615 cur.p = BYTE_POS_ADDR (cur.pos_byte);
1616 else
1617 cur.p = SDATA (string) + cur.pos_byte;
1619 BACKWARD_CHAR (cur, stop);
1623 /* Return the adjusted point provided that point is moved from LAST_PT
1624 to NEW_PT. */
1626 ptrdiff_t
1627 composition_adjust_point (ptrdiff_t last_pt, ptrdiff_t new_pt)
1629 ptrdiff_t i, beg, end;
1630 Lisp_Object val;
1632 if (new_pt == BEGV || new_pt == ZV)
1633 return new_pt;
1635 /* At first check the static composition. */
1636 if (get_property_and_range (new_pt, Qcomposition, &val, &beg, &end, Qnil)
1637 && composition_valid_p (beg, end, val))
1639 if (beg < new_pt /* && end > new_pt <- It's always the case. */
1640 && (last_pt <= beg || last_pt >= end))
1641 return (new_pt < last_pt ? beg : end);
1642 return new_pt;
1645 if (NILP (BVAR (current_buffer, enable_multibyte_characters))
1646 || NILP (Vauto_composition_mode))
1647 return new_pt;
1649 /* Next check the automatic composition. */
1650 if (! find_automatic_composition (new_pt, (ptrdiff_t) -1, &beg, &end, &val,
1651 Qnil)
1652 || beg == new_pt)
1653 return new_pt;
1654 for (i = 0; i < LGSTRING_GLYPH_LEN (val); i++)
1656 Lisp_Object glyph = LGSTRING_GLYPH (val, i);
1658 if (NILP (glyph))
1659 break;
1660 if (beg + LGLYPH_FROM (glyph) == new_pt)
1661 return new_pt;
1662 if (beg + LGLYPH_TO (glyph) >= new_pt)
1663 return (new_pt < last_pt
1664 ? beg + LGLYPH_FROM (glyph)
1665 : beg + LGLYPH_TO (glyph) + 1);
1667 return new_pt;
1670 DEFUN ("composition-get-gstring", Fcomposition_get_gstring,
1671 Scomposition_get_gstring, 4, 4, 0,
1672 doc: /* Return a glyph-string for characters between FROM and TO.
1673 If the glyph string is for graphic display, FONT-OBJECT must be
1674 a font-object to use for those characters.
1675 Otherwise (for terminal display), FONT-OBJECT must be a terminal ID, a
1676 frame, or nil for the selected frame's terminal device.
1678 If the optional 4th argument STRING is not nil, it is a string
1679 containing the target characters between indices FROM and TO,
1680 which are treated as in `substring'. Otherwise FROM and TO are
1681 character positions in current buffer; they can be in either order,
1682 and can be integers or markers.
1684 A glyph-string is a vector containing information about how to display
1685 a specific character sequence. The format is:
1686 [HEADER ID GLYPH ...]
1688 HEADER is a vector of this form:
1689 [FONT-OBJECT CHAR ...]
1690 where
1691 FONT-OBJECT is a font-object for all glyphs in the glyph-string,
1692 or the terminal coding system of the specified terminal.
1693 CHARs are characters to be composed by GLYPHs.
1695 ID is an identification number of the glyph-string. It may be nil if
1696 not yet shaped.
1698 GLYPH is a vector whose elements have this form:
1699 [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT
1700 [ [X-OFF Y-OFF WADJUST] | nil] ]
1701 where
1702 FROM-IDX and TO-IDX are used internally and should not be touched.
1703 C is the character of the glyph.
1704 CODE is the glyph-code of C in FONT-OBJECT.
1705 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
1706 X-OFF and Y-OFF are offsets to the base position for the glyph.
1707 WADJUST is the adjustment to the normal width of the glyph.
1709 If GLYPH is nil, the remaining elements of the glyph-string vector
1710 should be ignored. */)
1711 (Lisp_Object from, Lisp_Object to, Lisp_Object font_object, Lisp_Object string)
1713 Lisp_Object gstring, header;
1714 ptrdiff_t frompos, frombyte, topos;
1716 if (! FONT_OBJECT_P (font_object))
1718 struct coding_system *coding;
1719 struct terminal *terminal = decode_live_terminal (font_object);
1721 coding = ((TERMINAL_TERMINAL_CODING (terminal)->common_flags
1722 & CODING_REQUIRE_ENCODING_MASK)
1723 ? TERMINAL_TERMINAL_CODING (terminal) : &safe_terminal_coding);
1724 font_object = CODING_ID_NAME (coding->id);
1727 if (NILP (string))
1729 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
1730 error ("Attempt to shape unibyte text");
1731 validate_region (&from, &to);
1732 frompos = XFASTINT (from);
1733 topos = XFASTINT (to);
1734 frombyte = CHAR_TO_BYTE (frompos);
1736 else
1738 CHECK_STRING (string);
1739 validate_subarray (string, from, to, SCHARS (string), &frompos, &topos);
1740 if (! STRING_MULTIBYTE (string))
1741 error ("Attempt to shape unibyte text");
1742 frombyte = string_char_to_byte (string, frompos);
1745 header = fill_gstring_header (Qnil, frompos, frombyte,
1746 topos, font_object, string);
1747 gstring = gstring_lookup_cache (header);
1748 if (! NILP (gstring))
1749 return gstring;
1751 if (LGSTRING_GLYPH_LEN (gstring_work) < topos - frompos)
1752 gstring_work = Fmake_vector (make_number (topos - frompos + 2), Qnil);
1753 LGSTRING_SET_HEADER (gstring_work, header);
1754 LGSTRING_SET_ID (gstring_work, Qnil);
1755 fill_gstring_body (gstring_work);
1756 return gstring_work;
1760 /* Emacs Lisp APIs. */
1762 DEFUN ("compose-region-internal", Fcompose_region_internal,
1763 Scompose_region_internal, 2, 4, 0,
1764 doc: /* Internal use only.
1766 Compose text in the region between START and END.
1767 Optional 3rd and 4th arguments are COMPONENTS and MODIFICATION-FUNC
1768 for the composition. See `compose-region' for more details. */)
1769 (Lisp_Object start, Lisp_Object end, Lisp_Object components, Lisp_Object modification_func)
1771 validate_region (&start, &end);
1772 if (!NILP (components)
1773 && !INTEGERP (components)
1774 && !CONSP (components)
1775 && !STRINGP (components))
1776 CHECK_VECTOR (components);
1778 compose_text (XINT (start), XINT (end), components, modification_func, Qnil);
1779 return Qnil;
1782 DEFUN ("compose-string-internal", Fcompose_string_internal,
1783 Scompose_string_internal, 3, 5, 0,
1784 doc: /* Internal use only.
1786 Compose text between indices START and END of STRING, where
1787 START and END are treated as in `substring'. Optional 4th
1788 and 5th arguments are COMPONENTS and MODIFICATION-FUNC
1789 for the composition. See `compose-string' for more details. */)
1790 (Lisp_Object string, Lisp_Object start, Lisp_Object end,
1791 Lisp_Object components, Lisp_Object modification_func)
1793 ptrdiff_t from, to;
1795 CHECK_STRING (string);
1796 validate_subarray (string, start, end, SCHARS (string), &from, &to);
1797 compose_text (from, to, components, modification_func, string);
1798 return string;
1801 DEFUN ("find-composition-internal", Ffind_composition_internal,
1802 Sfind_composition_internal, 4, 4, 0,
1803 doc: /* Internal use only.
1805 Return information about composition at or nearest to position POS.
1806 See `find-composition' for more details. */)
1807 (Lisp_Object pos, Lisp_Object limit, Lisp_Object string, Lisp_Object detail_p)
1809 Lisp_Object prop, tail, gstring;
1810 ptrdiff_t start, end, from, to;
1811 int id;
1813 CHECK_NUMBER_COERCE_MARKER (pos);
1814 if (!NILP (limit))
1816 CHECK_NUMBER_COERCE_MARKER (limit);
1817 to = min (XINT (limit), ZV);
1819 else
1820 to = -1;
1822 if (!NILP (string))
1824 CHECK_STRING (string);
1825 if (XINT (pos) < 0 || XINT (pos) > SCHARS (string))
1826 args_out_of_range (string, pos);
1828 else
1830 if (XINT (pos) < BEGV || XINT (pos) > ZV)
1831 args_out_of_range (Fcurrent_buffer (), pos);
1833 from = XINT (pos);
1835 if (!find_composition (from, to, &start, &end, &prop, string))
1837 if (!NILP (BVAR (current_buffer, enable_multibyte_characters))
1838 && ! NILP (Vauto_composition_mode)
1839 && find_automatic_composition (from, to, &start, &end, &gstring,
1840 string))
1841 return list3 (make_number (start), make_number (end), gstring);
1842 return Qnil;
1844 if ((end <= XINT (pos) || start > XINT (pos)))
1846 ptrdiff_t s, e;
1848 if (find_automatic_composition (from, to, &s, &e, &gstring, string)
1849 && (e <= XINT (pos) ? e > end : s < start))
1850 return list3 (make_number (s), make_number (e), gstring);
1852 if (!composition_valid_p (start, end, prop))
1853 return list3 (make_number (start), make_number (end), Qnil);
1854 if (NILP (detail_p))
1855 return list3 (make_number (start), make_number (end), Qt);
1857 if (composition_registered_p (prop))
1858 id = COMPOSITION_ID (prop);
1859 else
1861 ptrdiff_t start_byte = (NILP (string)
1862 ? CHAR_TO_BYTE (start)
1863 : string_char_to_byte (string, start));
1864 id = get_composition_id (start, start_byte, end - start, prop, string);
1867 if (id >= 0)
1869 Lisp_Object components, relative_p, mod_func;
1870 enum composition_method method = composition_method (prop);
1871 int width = composition_table[id]->width;
1873 components = Fcopy_sequence (COMPOSITION_COMPONENTS (prop));
1874 relative_p = (method == COMPOSITION_WITH_RULE_ALTCHARS
1875 ? Qnil : Qt);
1876 mod_func = COMPOSITION_MODIFICATION_FUNC (prop);
1877 tail = list4 (components, relative_p, mod_func, make_number (width));
1879 else
1880 tail = Qnil;
1882 return Fcons (make_number (start), Fcons (make_number (end), tail));
1886 void
1887 syms_of_composite (void)
1889 int i;
1891 DEFSYM (Qcomposition, "composition");
1893 /* Make a hash table for static composition. */
1894 /* We used to make the hash table weak so that unreferenced
1895 compositions can be garbage-collected. But, usually once
1896 created compositions are repeatedly used in an Emacs session,
1897 and thus it's not worth to save memory in such a way. So, we
1898 make the table not weak. */
1899 Lisp_Object args[] = {QCtest, Qequal, QCsize, make_number (311)};
1900 composition_hash_table = CALLMANY (Fmake_hash_table, args);
1901 staticpro (&composition_hash_table);
1903 /* Make a hash table for glyph-string. */
1904 gstring_hash_table = CALLMANY (Fmake_hash_table, args);
1905 staticpro (&gstring_hash_table);
1907 staticpro (&gstring_work_headers);
1908 gstring_work_headers = make_uninit_vector (8);
1909 for (i = 0; i < 8; i++)
1910 ASET (gstring_work_headers, i, Fmake_vector (make_number (i + 2), Qnil));
1911 staticpro (&gstring_work);
1912 gstring_work = Fmake_vector (make_number (10), Qnil);
1914 /* Text property `composition' should be nonsticky by default. */
1915 Vtext_property_default_nonsticky
1916 = Fcons (Fcons (Qcomposition, Qt), Vtext_property_default_nonsticky);
1918 DEFVAR_LISP ("compose-chars-after-function", Vcompose_chars_after_function,
1919 doc: /* Function to adjust composition of buffer text.
1921 This function is called with three arguments: FROM, TO, and OBJECT.
1922 FROM and TO specify the range of text whose composition should be
1923 adjusted. OBJECT, if non-nil, is a string that contains the text.
1925 This function is called after a text with `composition' property is
1926 inserted or deleted to keep `composition' property of buffer text
1927 valid.
1929 The default value is the function `compose-chars-after'. */);
1930 Vcompose_chars_after_function = intern_c_string ("compose-chars-after");
1932 DEFSYM (Qauto_composed, "auto-composed");
1934 DEFVAR_LISP ("auto-composition-mode", Vauto_composition_mode,
1935 doc: /* Non-nil if Auto-Composition mode is enabled.
1936 Use the command `auto-composition-mode' to change this variable. */);
1937 Vauto_composition_mode = Qt;
1939 DEFVAR_LISP ("auto-composition-function", Vauto_composition_function,
1940 doc: /* Function to call to compose characters automatically.
1941 This function is called from the display routine with four arguments:
1942 FROM, TO, WINDOW, and STRING.
1944 If STRING is nil, the function must compose characters in the region
1945 between FROM and TO in the current buffer.
1947 Otherwise, STRING is a string, and FROM and TO are indices into the
1948 string. In this case, the function must compose characters in the
1949 string. */);
1950 Vauto_composition_function = Qnil;
1952 DEFVAR_LISP ("composition-function-table", Vcomposition_function_table,
1953 doc: /* Char-table of functions for automatic character composition.
1954 For each character that has to be composed automatically with
1955 preceding and/or following characters, this char-table contains
1956 a function to call to compose that character.
1958 The element at index C in the table, if non-nil, is a list of
1959 composition rules of this form: ([PATTERN PREV-CHARS FUNC] ...)
1961 PATTERN is a regular expression which C and the surrounding
1962 characters must match.
1964 PREV-CHARS is a non-negative integer (less than 4) specifying how many
1965 characters before C to check the matching with PATTERN. If it is 0,
1966 PATTERN must match C and the following characters. If it is 1,
1967 PATTERN must match a character before C and the following characters.
1969 If PREV-CHARS is 0, PATTERN can be nil, which means that the
1970 single character C should be composed.
1972 FUNC is a function to return a glyph-string representing a
1973 composition of the characters that match PATTERN. It is
1974 called with one argument GSTRING.
1976 GSTRING is a template of a glyph-string to return. It is already
1977 filled with a proper header for the characters to compose, and
1978 glyphs corresponding to those characters one by one. The
1979 function must return a new glyph-string with the same header as
1980 GSTRING, or modify GSTRING itself and return it.
1982 See also the documentation of `auto-composition-mode'. */);
1983 Vcomposition_function_table = Fmake_char_table (Qnil, Qnil);
1985 defsubr (&Scompose_region_internal);
1986 defsubr (&Scompose_string_internal);
1987 defsubr (&Sfind_composition_internal);
1988 defsubr (&Scomposition_get_gstring);