Restore follow-scroll-up/down to scrolling by the combined size of all windows
[emacs.git] / src / composite.c
blob49b00036361267623a2d25da76cb17aa31a43cb8
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 #ifdef HAVE_WINDOW_SYSTEM
895 if (FRAME_WINDOW_P (f))
897 font_object = font_range (charpos, bytepos, &to, win, face, string);
898 if (! FONT_OBJECT_P (font_object)
899 || (! NILP (re)
900 && to < limit
901 && (fast_looking_at (re, charpos, bytepos, to, -1, string) <= 0)))
902 return unbind_to (count, Qnil);
904 else
905 #endif /* not HAVE_WINDOW_SYSTEM */
906 font_object = win->frame;
907 lgstring = Fcomposition_get_gstring (pos, make_number (to), font_object,
908 string);
909 if (NILP (LGSTRING_ID (lgstring)))
911 /* Save point as marker before calling out to lisp. */
912 if (NILP (string))
913 record_unwind_protect (restore_point_unwind,
914 build_marker (current_buffer, pt, pt_byte));
915 lgstring = safe_call (6, Vauto_composition_function, AREF (rule, 2),
916 pos, make_number (to), font_object, string);
918 return unbind_to (count, lgstring);
921 /* 1 iff the character C is composable. Characters of general
922 category Z? or C? are not composable except for ZWNJ and ZWJ. */
924 static bool
925 char_composable_p (int c)
927 Lisp_Object val;
928 return (c > ' '
929 && (c == ZERO_WIDTH_NON_JOINER || c == ZERO_WIDTH_JOINER
930 || (val = CHAR_TABLE_REF (Vunicode_category_table, c),
931 (INTEGERP (val) && (XINT (val) <= UNICODE_CATEGORY_So)))));
934 /* Update cmp_it->stop_pos to the next position after CHARPOS (and
935 BYTEPOS) where character composition may happen. If BYTEPOS is
936 negative, compute it. ENDPOS is a limit of searching. If it is
937 less than CHARPOS, search backward to ENDPOS+1 assuming that
938 set_iterator_to_next works in reverse order. In this case, if a
939 composition closest to CHARPOS is found, set cmp_it->stop_pos to
940 the last character of the composition.
942 If no composition is found, set cmp_it->ch to -2. If a static
943 composition is found, set cmp_it->ch to -1. Otherwise, set
944 cmp_it->ch to the character that triggers the automatic
945 composition. */
947 void
948 composition_compute_stop_pos (struct composition_it *cmp_it, ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t endpos, Lisp_Object string)
950 ptrdiff_t start, end;
951 int c;
952 Lisp_Object prop, val;
953 /* This is from forward_to_next_line_start in xdisp.c. */
954 const int MAX_NEWLINE_DISTANCE = 500;
956 if (charpos < endpos)
958 if (endpos > charpos + MAX_NEWLINE_DISTANCE)
959 endpos = charpos + MAX_NEWLINE_DISTANCE;
961 else if (endpos < charpos)
963 /* We search backward for a position to check composition. */
964 if (endpos < 0)
966 /* But we don't know where to stop the searching. */
967 endpos = NILP (string) ? BEGV - 1 : -1;
968 /* Usually we don't reach ENDPOS because we stop searching
969 at an uncomposable character (NL, LRE, etc). */
972 cmp_it->id = -1;
973 cmp_it->ch = -2;
974 cmp_it->reversed_p = 0;
975 cmp_it->stop_pos = endpos;
976 if (charpos == endpos)
977 return;
978 /* FIXME: Bidi is not yet handled well in static composition. */
979 if (charpos < endpos
980 && find_composition (charpos, endpos, &start, &end, &prop, string)
981 && start >= charpos
982 && composition_valid_p (start, end, prop))
984 cmp_it->stop_pos = endpos = start;
985 cmp_it->ch = -1;
987 if (NILP (BVAR (current_buffer, enable_multibyte_characters))
988 || NILP (Vauto_composition_mode))
989 return;
990 if (bytepos < 0)
992 if (NILP (string))
993 bytepos = CHAR_TO_BYTE (charpos);
994 else
995 bytepos = string_char_to_byte (string, charpos);
998 start = charpos;
999 if (charpos < endpos)
1001 /* Forward search. */
1002 while (charpos < endpos)
1004 if (STRINGP (string))
1005 FETCH_STRING_CHAR_ADVANCE (c, string, charpos, bytepos);
1006 else
1007 FETCH_CHAR_ADVANCE (c, charpos, bytepos);
1008 if (c == '\n')
1010 cmp_it->ch = -2;
1011 break;
1013 val = CHAR_TABLE_REF (Vcomposition_function_table, c);
1014 if (! NILP (val))
1016 for (int ridx = 0; CONSP (val); val = XCDR (val), ridx++)
1018 Lisp_Object elt = XCAR (val);
1019 if (VECTORP (elt) && ASIZE (elt) == 3
1020 && NATNUMP (AREF (elt, 1))
1021 && charpos - 1 - XFASTINT (AREF (elt, 1)) >= start)
1023 cmp_it->rule_idx = ridx;
1024 cmp_it->lookback = XFASTINT (AREF (elt, 1));
1025 cmp_it->stop_pos = charpos - 1 - cmp_it->lookback;
1026 cmp_it->ch = c;
1027 return;
1032 if (charpos == endpos
1033 && !(STRINGP (string) && endpos == SCHARS (string)))
1035 /* We couldn't find a composition point before ENDPOS. But,
1036 some character after ENDPOS may be composed with
1037 characters before ENDPOS. So, we should stop at the safe
1038 point. */
1039 charpos = endpos - MAX_AUTO_COMPOSITION_LOOKBACK;
1040 if (charpos < start)
1041 charpos = start;
1044 else if (charpos > endpos)
1046 /* Search backward for a pattern that may be composed and the
1047 position of (possibly) the last character of the match is
1048 closest to (but not after) START. The reason for the last
1049 character is that set_iterator_to_next works in reverse order,
1050 and thus we must stop at the last character for composition
1051 check. */
1052 unsigned char *p;
1053 int len;
1054 /* Limit byte position used in fast_looking_at. This is the
1055 byte position of the character after START. */
1056 ptrdiff_t limit;
1058 if (NILP (string))
1059 p = BYTE_POS_ADDR (bytepos);
1060 else
1061 p = SDATA (string) + bytepos;
1062 c = STRING_CHAR_AND_LENGTH (p, len);
1063 limit = bytepos + len;
1064 while (char_composable_p (c))
1066 val = CHAR_TABLE_REF (Vcomposition_function_table, c);
1067 if (! NILP (val))
1069 Lisp_Object elt;
1070 int ridx, blen;
1072 for (ridx = 0; CONSP (val); val = XCDR (val), ridx++)
1074 elt = XCAR (val);
1075 if (VECTORP (elt) && ASIZE (elt) == 3
1076 && NATNUMP (AREF (elt, 1))
1077 && charpos - XFASTINT (AREF (elt, 1)) > endpos)
1079 ptrdiff_t back = XFASTINT (AREF (elt, 1));
1080 ptrdiff_t cpos = charpos - back, bpos;
1082 if (back == 0)
1083 bpos = bytepos;
1084 else
1085 bpos = (NILP (string) ? CHAR_TO_BYTE (cpos)
1086 : string_char_to_byte (string, cpos));
1087 if (STRINGP (AREF (elt, 0)))
1088 blen = fast_looking_at (AREF (elt, 0), cpos, bpos,
1089 start + 1, limit, string);
1090 else
1091 blen = 1;
1092 if (blen > 0)
1094 /* Make CPOS point to the last character of
1095 match. Note that BLEN is byte-length. */
1096 if (blen > 1)
1098 bpos += blen;
1099 if (NILP (string))
1100 cpos = BYTE_TO_CHAR (bpos) - 1;
1101 else
1102 cpos = string_byte_to_char (string, bpos) - 1;
1104 back = cpos - (charpos - back);
1105 if (cmp_it->stop_pos < cpos
1106 || (cmp_it->stop_pos == cpos
1107 && cmp_it->lookback < back))
1109 cmp_it->rule_idx = ridx;
1110 cmp_it->stop_pos = cpos;
1111 cmp_it->ch = c;
1112 cmp_it->lookback = back;
1113 cmp_it->nchars = back + 1;
1119 if (charpos - 1 == endpos)
1120 break;
1121 if (STRINGP (string))
1123 p--, bytepos--;
1124 while (! CHAR_HEAD_P (*p))
1125 p--, bytepos--;
1126 charpos--;
1128 else
1130 DEC_BOTH (charpos, bytepos);
1131 p = BYTE_POS_ADDR (bytepos);
1133 c = STRING_CHAR (p);
1135 if (cmp_it->ch >= 0)
1136 /* We found a position to check. */
1137 return;
1138 /* Skip all uncomposable characters. */
1139 if (NILP (string))
1141 while (charpos - 1 > endpos && ! char_composable_p (c))
1143 DEC_BOTH (charpos, bytepos);
1144 c = FETCH_MULTIBYTE_CHAR (bytepos);
1147 else
1149 while (charpos - 1 > endpos && ! char_composable_p (c))
1151 p--;
1152 while (! CHAR_HEAD_P (*p))
1153 p--;
1154 charpos--;
1155 c = STRING_CHAR (p);
1159 cmp_it->stop_pos = charpos;
1162 /* Check if the character at CHARPOS (and BYTEPOS) is composed
1163 (possibly with the following characters) on window W. ENDPOS limits
1164 characters to be composed. FACE, if non-NULL, is a base face of
1165 the character. If STRING is not nil, it is a string containing the
1166 character to check, and CHARPOS and BYTEPOS are indices in the
1167 string. In that case, FACE must not be NULL.
1169 If the character is composed, setup members of CMP_IT (id, nglyphs,
1170 from, to, reversed_p), and return true. Otherwise, update
1171 CMP_IT->stop_pos, and return false. */
1173 bool
1174 composition_reseat_it (struct composition_it *cmp_it, ptrdiff_t charpos,
1175 ptrdiff_t bytepos, ptrdiff_t endpos, struct window *w,
1176 struct face *face, Lisp_Object string)
1178 if (cmp_it->ch == -2)
1180 composition_compute_stop_pos (cmp_it, charpos, bytepos, endpos, string);
1181 if (cmp_it->ch == -2 || cmp_it->stop_pos != charpos)
1182 /* The current position is not composed. */
1183 return 0;
1186 if (endpos < 0)
1187 endpos = NILP (string) ? BEGV : 0;
1189 if (cmp_it->ch < 0)
1191 /* We are looking at a static composition. */
1192 ptrdiff_t start, end;
1193 Lisp_Object prop;
1195 find_composition (charpos, -1, &start, &end, &prop, string);
1196 cmp_it->id = get_composition_id (charpos, bytepos, end - start,
1197 prop, string);
1198 if (cmp_it->id < 0)
1199 goto no_composition;
1200 cmp_it->nchars = end - start;
1201 cmp_it->nglyphs = composition_table[cmp_it->id]->glyph_len;
1203 else if (w)
1205 Lisp_Object lgstring = Qnil;
1206 Lisp_Object val, elt;
1207 ptrdiff_t i;
1209 val = CHAR_TABLE_REF (Vcomposition_function_table, cmp_it->ch);
1210 for (i = 0; i < cmp_it->rule_idx; i++, val = XCDR (val));
1211 if (charpos < endpos)
1213 for (; CONSP (val); val = XCDR (val))
1215 elt = XCAR (val);
1216 if (! VECTORP (elt) || ASIZE (elt) != 3
1217 || ! INTEGERP (AREF (elt, 1)))
1218 continue;
1219 if (XFASTINT (AREF (elt, 1)) != cmp_it->lookback)
1220 goto no_composition;
1221 lgstring = autocmp_chars (elt, charpos, bytepos, endpos,
1222 w, face, string);
1223 if (composition_gstring_p (lgstring))
1224 break;
1225 lgstring = Qnil;
1226 /* Composition failed perhaps because the font doesn't
1227 support sufficient range of characters. Try the
1228 other composition rules if any. */
1230 cmp_it->reversed_p = 0;
1232 else
1234 ptrdiff_t cpos = charpos, bpos = bytepos;
1236 cmp_it->reversed_p = 1;
1237 elt = XCAR (val);
1238 if (cmp_it->lookback > 0)
1240 cpos = charpos - cmp_it->lookback;
1241 if (STRINGP (string))
1242 bpos = string_char_to_byte (string, cpos);
1243 else
1244 bpos = CHAR_TO_BYTE (cpos);
1246 lgstring = autocmp_chars (elt, cpos, bpos, charpos + 1, w, face,
1247 string);
1248 if (! composition_gstring_p (lgstring)
1249 || cpos + LGSTRING_CHAR_LEN (lgstring) - 1 != charpos)
1250 /* Composition failed or didn't cover the current
1251 character. */
1252 goto no_composition;
1254 if (NILP (lgstring))
1255 goto no_composition;
1256 if (NILP (LGSTRING_ID (lgstring)))
1257 lgstring = composition_gstring_put_cache (lgstring, -1);
1258 cmp_it->id = XINT (LGSTRING_ID (lgstring));
1259 for (i = 0; i < LGSTRING_GLYPH_LEN (lgstring); i++)
1260 if (NILP (LGSTRING_GLYPH (lgstring, i)))
1261 break;
1262 cmp_it->nglyphs = i;
1263 cmp_it->from = 0;
1264 cmp_it->to = i;
1266 else
1267 goto no_composition;
1268 return 1;
1270 no_composition:
1271 if (charpos == endpos)
1272 return 0;
1273 if (charpos < endpos)
1275 charpos++;
1276 if (NILP (string))
1277 INC_POS (bytepos);
1278 else
1279 bytepos += BYTES_BY_CHAR_HEAD (*(SDATA (string) + bytepos));
1281 else
1283 charpos--;
1284 /* BYTEPOS is calculated in composition_compute_stop_pos */
1285 bytepos = -1;
1287 if (cmp_it->reversed_p)
1288 endpos = -1;
1289 composition_compute_stop_pos (cmp_it, charpos, bytepos, endpos, string);
1290 return 0;
1293 /* Update charpos, nchars, nbytes, and width of the current grapheme
1294 cluster.
1296 If the composition is static or automatic in L2R context, the
1297 cluster is identified by CMP_IT->from, and CHARPOS is the position
1298 of the first character of the cluster. In this case, update
1299 CMP_IT->to too.
1301 If the composition is automatic in R2L context, the cluster is
1302 identified by CMP_IT->to, and CHARPOS is the position of the last
1303 character of the cluster. In this case, update CMP_IT->from too.
1305 The return value is the character code of the first character of
1306 the cluster, or -1 if the composition is somehow broken. */
1309 composition_update_it (struct composition_it *cmp_it, ptrdiff_t charpos, ptrdiff_t bytepos, Lisp_Object string)
1311 int i, c IF_LINT (= 0);
1313 if (cmp_it->ch < 0)
1315 /* static composition */
1316 struct composition *cmp = composition_table[cmp_it->id];
1318 cmp_it->charpos = charpos;
1319 cmp_it->to = cmp_it->nglyphs;
1320 if (cmp_it->nglyphs == 0)
1321 c = -1;
1322 else
1324 for (i = 0; i < cmp->glyph_len; i++)
1325 /* TAB in a composition means display glyphs with padding
1326 space on the left or right. */
1327 if ((c = COMPOSITION_GLYPH (cmp, i)) != '\t')
1328 break;
1329 if (c == '\t')
1330 c = ' ';
1332 cmp_it->width = cmp->width;
1333 charpos += cmp_it->nchars;
1334 if (STRINGP (string))
1335 cmp_it->nbytes = string_char_to_byte (string, charpos) - bytepos;
1336 else
1337 cmp_it->nbytes = CHAR_TO_BYTE (charpos) - bytepos;
1339 else
1341 /* Automatic composition. */
1342 Lisp_Object gstring = composition_gstring_from_id (cmp_it->id);
1343 Lisp_Object glyph;
1344 ptrdiff_t from;
1346 if (cmp_it->nglyphs == 0)
1348 cmp_it->nchars = LGSTRING_CHAR_LEN (gstring);
1349 cmp_it->width = 0;
1350 cmp_it->from = cmp_it->to = 0;
1351 return -1;
1353 if (! cmp_it->reversed_p)
1355 glyph = LGSTRING_GLYPH (gstring, cmp_it->from);
1356 from = LGLYPH_FROM (glyph);
1357 for (cmp_it->to = cmp_it->from + 1; cmp_it->to < cmp_it->nglyphs;
1358 cmp_it->to++)
1360 glyph = LGSTRING_GLYPH (gstring, cmp_it->to);
1361 if (LGLYPH_FROM (glyph) != from)
1362 break;
1364 cmp_it->charpos = charpos;
1366 else
1368 glyph = LGSTRING_GLYPH (gstring, cmp_it->to - 1);
1369 from = LGLYPH_FROM (glyph);
1370 cmp_it->charpos = charpos - (LGLYPH_TO (glyph) - from);
1371 for (cmp_it->from = cmp_it->to - 1; cmp_it->from > 0;
1372 cmp_it->from--)
1374 glyph = LGSTRING_GLYPH (gstring, cmp_it->from - 1);
1375 if (LGLYPH_FROM (glyph) != from)
1376 break;
1379 glyph = LGSTRING_GLYPH (gstring, cmp_it->from);
1380 cmp_it->nchars = LGLYPH_TO (glyph) + 1 - from;
1381 cmp_it->nbytes = 0;
1382 cmp_it->width = 0;
1383 for (i = cmp_it->nchars - 1; i >= 0; i--)
1385 c = XINT (LGSTRING_CHAR (gstring, from + i));
1386 cmp_it->nbytes += CHAR_BYTES (c);
1387 cmp_it->width += CHAR_WIDTH (c);
1390 return c;
1394 struct position_record
1396 ptrdiff_t pos, pos_byte;
1397 unsigned char *p;
1400 /* Update the members of POSITION to the next character boundary. */
1401 #define FORWARD_CHAR(POSITION, STOP) \
1402 do { \
1403 (POSITION).pos++; \
1404 if ((POSITION).pos == (STOP)) \
1406 (POSITION).p = GAP_END_ADDR; \
1407 (POSITION).pos_byte = GPT_BYTE; \
1409 else \
1411 (POSITION).pos_byte += BYTES_BY_CHAR_HEAD (*((POSITION).p)); \
1412 (POSITION).p += BYTES_BY_CHAR_HEAD (*((POSITION).p)); \
1414 } while (0)
1416 /* Update the members of POSITION to the previous character boundary. */
1417 #define BACKWARD_CHAR(POSITION, STOP) \
1418 do { \
1419 if ((POSITION).pos == (STOP)) \
1420 (POSITION).p = GPT_ADDR; \
1421 do { \
1422 (POSITION).pos_byte--; \
1423 (POSITION).p--; \
1424 } while (! CHAR_HEAD_P (*((POSITION).p))); \
1425 (POSITION).pos--; \
1426 } while (0)
1428 /* This is like find_composition, but find an automatic composition
1429 instead. It is assured that POS is not within a static
1430 composition. If found, set *GSTRING to the glyph-string
1431 representing the composition, and return true. Otherwise, *GSTRING to
1432 Qnil, and return false. */
1434 static bool
1435 find_automatic_composition (ptrdiff_t pos, ptrdiff_t limit,
1436 ptrdiff_t *start, ptrdiff_t *end,
1437 Lisp_Object *gstring, Lisp_Object string)
1439 ptrdiff_t head, tail, stop;
1440 /* Forward limit position of checking a composition taking a
1441 looking-back count into account. */
1442 ptrdiff_t fore_check_limit;
1443 struct position_record cur, prev;
1444 int c;
1445 Lisp_Object window;
1446 struct window *w;
1447 bool need_adjustment = 0;
1449 window = Fget_buffer_window (Fcurrent_buffer (), Qnil);
1450 if (NILP (window))
1451 return 0;
1452 w = XWINDOW (window);
1454 cur.pos = pos;
1455 if (NILP (string))
1457 head = BEGV, tail = ZV, stop = GPT;
1458 cur.pos_byte = CHAR_TO_BYTE (cur.pos);
1459 cur.p = BYTE_POS_ADDR (cur.pos_byte);
1461 else
1463 head = 0, tail = SCHARS (string), stop = -1;
1464 cur.pos_byte = string_char_to_byte (string, cur.pos);
1465 cur.p = SDATA (string) + cur.pos_byte;
1467 if (limit < 0)
1468 /* Finding a composition covering the character after POS is the
1469 same as setting LIMIT to POS. */
1470 limit = pos;
1471 if (limit <= pos)
1472 fore_check_limit = min (tail, pos + 1 + MAX_AUTO_COMPOSITION_LOOKBACK);
1473 else
1474 fore_check_limit = min (tail, limit + MAX_AUTO_COMPOSITION_LOOKBACK);
1476 /* Provided that we have these possible compositions now:
1478 POS: 1 2 3 4 5 6 7 8 9
1479 |-A-|
1480 |-B-|-C-|--D--|
1482 Here, it is known that characters after positions 1 and 9 can
1483 never be composed (i.e. ! char_composable_p (CH)), and
1484 composition A is an invalid one because it's partially covered by
1485 the valid composition C. And to know whether a composition is
1486 valid or not, the only way is to start searching forward from a
1487 position that can not be a tail part of composition (it's 2 in
1488 the above case).
1490 Now we have these cases (1 through 4):
1492 -- character after POS is ... --
1493 not composable composable
1494 LIMIT <= POS (1) (3)
1495 POS < LIMIT (2) (4)
1497 Among them, in case (2), we simply search forward from POS.
1499 In the other cases, we at first rewind back to the position where
1500 the previous character is not composable or the beginning of
1501 buffer (string), then search compositions forward. In case (1)
1502 and (3) we repeat this process until a composition is found. */
1504 while (1)
1506 c = STRING_CHAR (cur.p);
1507 if (! char_composable_p (c))
1509 if (limit <= pos) /* case (1) */
1511 do {
1512 if (cur.pos <= limit)
1513 return 0;
1514 BACKWARD_CHAR (cur, stop);
1515 c = STRING_CHAR (cur.p);
1516 } while (! char_composable_p (c));
1517 fore_check_limit = cur.pos + 1;
1519 else /* case (2) */
1520 /* No need of rewinding back. */
1521 goto search_forward;
1524 /* Rewind back to the position where we can safely search
1525 forward for compositions. It is assured that the character
1526 at cur.pos is composable. */
1527 while (head < cur.pos)
1529 prev = cur;
1530 BACKWARD_CHAR (cur, stop);
1531 c = STRING_CHAR (cur.p);
1532 if (! char_composable_p (c))
1534 cur = prev;
1535 break;
1539 search_forward:
1540 /* Now search forward. */
1541 *gstring = Qnil;
1542 prev = cur; /* remember the start of searching position. */
1543 while (cur.pos < fore_check_limit)
1545 Lisp_Object val;
1547 c = STRING_CHAR (cur.p);
1548 for (val = CHAR_TABLE_REF (Vcomposition_function_table, c);
1549 CONSP (val); val = XCDR (val))
1551 Lisp_Object elt = XCAR (val);
1553 if (VECTORP (elt) && ASIZE (elt) == 3 && NATNUMP (AREF (elt, 1)))
1555 EMACS_INT check_pos = cur.pos - XFASTINT (AREF (elt, 1));
1556 struct position_record check;
1558 if (check_pos < head
1559 || (limit <= pos ? pos < check_pos
1560 : limit <= check_pos))
1561 continue;
1562 for (check = cur; check_pos < check.pos; )
1563 BACKWARD_CHAR (check, stop);
1564 *gstring = autocmp_chars (elt, check.pos, check.pos_byte,
1565 tail, w, NULL, string);
1566 need_adjustment = 1;
1567 if (NILP (*gstring))
1569 /* As we have called Lisp, there's a possibility
1570 that buffer/string is relocated. */
1571 if (NILP (string))
1572 cur.p = BYTE_POS_ADDR (cur.pos_byte);
1573 else
1574 cur.p = SDATA (string) + cur.pos_byte;
1576 else
1578 /* We found a candidate of a target composition. */
1579 *start = check.pos;
1580 *end = check.pos + LGSTRING_CHAR_LEN (*gstring);
1581 if (pos < limit
1582 ? pos < *end
1583 : *start <= pos && pos < *end)
1584 /* This is the target composition. */
1585 return 1;
1586 cur.pos = *end;
1587 if (NILP (string))
1589 cur.pos_byte = CHAR_TO_BYTE (cur.pos);
1590 cur.p = BYTE_POS_ADDR (cur.pos_byte);
1592 else
1594 cur.pos_byte = string_char_to_byte (string, cur.pos);
1595 cur.p = SDATA (string) + cur.pos_byte;
1597 break;
1601 if (! CONSP (val))
1602 /* We found no composition here. */
1603 FORWARD_CHAR (cur, stop);
1606 if (pos < limit) /* case (2) and (4)*/
1607 return 0;
1608 if (! NILP (*gstring))
1609 return 1;
1610 if (prev.pos == head)
1611 return 0;
1612 cur = prev;
1613 if (need_adjustment)
1615 if (NILP (string))
1616 cur.p = BYTE_POS_ADDR (cur.pos_byte);
1617 else
1618 cur.p = SDATA (string) + cur.pos_byte;
1620 BACKWARD_CHAR (cur, stop);
1624 /* Return the adjusted point provided that point is moved from LAST_PT
1625 to NEW_PT. */
1627 ptrdiff_t
1628 composition_adjust_point (ptrdiff_t last_pt, ptrdiff_t new_pt)
1630 ptrdiff_t i, beg, end;
1631 Lisp_Object val;
1633 if (new_pt == BEGV || new_pt == ZV)
1634 return new_pt;
1636 /* At first check the static composition. */
1637 if (get_property_and_range (new_pt, Qcomposition, &val, &beg, &end, Qnil)
1638 && composition_valid_p (beg, end, val))
1640 if (beg < new_pt /* && end > new_pt <- It's always the case. */
1641 && (last_pt <= beg || last_pt >= end))
1642 return (new_pt < last_pt ? beg : end);
1643 return new_pt;
1646 if (NILP (BVAR (current_buffer, enable_multibyte_characters))
1647 || NILP (Vauto_composition_mode))
1648 return new_pt;
1650 /* Next check the automatic composition. */
1651 if (! find_automatic_composition (new_pt, (ptrdiff_t) -1, &beg, &end, &val,
1652 Qnil)
1653 || beg == new_pt)
1654 return new_pt;
1655 for (i = 0; i < LGSTRING_GLYPH_LEN (val); i++)
1657 Lisp_Object glyph = LGSTRING_GLYPH (val, i);
1659 if (NILP (glyph))
1660 break;
1661 if (beg + LGLYPH_FROM (glyph) == new_pt)
1662 return new_pt;
1663 if (beg + LGLYPH_TO (glyph) >= new_pt)
1664 return (new_pt < last_pt
1665 ? beg + LGLYPH_FROM (glyph)
1666 : beg + LGLYPH_TO (glyph) + 1);
1668 return new_pt;
1671 DEFUN ("composition-get-gstring", Fcomposition_get_gstring,
1672 Scomposition_get_gstring, 4, 4, 0,
1673 doc: /* Return a glyph-string for characters between FROM and TO.
1674 If the glyph string is for graphic display, FONT-OBJECT must be
1675 a font-object to use for those characters.
1676 Otherwise (for terminal display), FONT-OBJECT must be a terminal ID, a
1677 frame, or nil for the selected frame's terminal device.
1679 If the optional 4th argument STRING is not nil, it is a string
1680 containing the target characters between indices FROM and TO,
1681 which are treated as in `substring'. Otherwise FROM and TO are
1682 character positions in current buffer; they can be in either order,
1683 and can be integers or markers.
1685 A glyph-string is a vector containing information about how to display
1686 a specific character sequence. The format is:
1687 [HEADER ID GLYPH ...]
1689 HEADER is a vector of this form:
1690 [FONT-OBJECT CHAR ...]
1691 where
1692 FONT-OBJECT is a font-object for all glyphs in the glyph-string,
1693 or the terminal coding system of the specified terminal.
1694 CHARs are characters to be composed by GLYPHs.
1696 ID is an identification number of the glyph-string. It may be nil if
1697 not yet shaped.
1699 GLYPH is a vector whose elements have this form:
1700 [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT
1701 [ [X-OFF Y-OFF WADJUST] | nil] ]
1702 where
1703 FROM-IDX and TO-IDX are used internally and should not be touched.
1704 C is the character of the glyph.
1705 CODE is the glyph-code of C in FONT-OBJECT.
1706 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
1707 X-OFF and Y-OFF are offsets to the base position for the glyph.
1708 WADJUST is the adjustment to the normal width of the glyph.
1710 If GLYPH is nil, the remaining elements of the glyph-string vector
1711 should be ignored. */)
1712 (Lisp_Object from, Lisp_Object to, Lisp_Object font_object, Lisp_Object string)
1714 Lisp_Object gstring, header;
1715 ptrdiff_t frompos, frombyte, topos;
1717 if (! FONT_OBJECT_P (font_object))
1719 struct coding_system *coding;
1720 struct terminal *terminal = decode_live_terminal (font_object);
1722 coding = ((TERMINAL_TERMINAL_CODING (terminal)->common_flags
1723 & CODING_REQUIRE_ENCODING_MASK)
1724 ? TERMINAL_TERMINAL_CODING (terminal) : &safe_terminal_coding);
1725 font_object = CODING_ID_NAME (coding->id);
1728 if (NILP (string))
1730 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
1731 error ("Attempt to shape unibyte text");
1732 validate_region (&from, &to);
1733 frompos = XFASTINT (from);
1734 topos = XFASTINT (to);
1735 frombyte = CHAR_TO_BYTE (frompos);
1737 else
1739 CHECK_STRING (string);
1740 validate_subarray (string, from, to, SCHARS (string), &frompos, &topos);
1741 if (! STRING_MULTIBYTE (string))
1742 error ("Attempt to shape unibyte text");
1743 frombyte = string_char_to_byte (string, frompos);
1746 header = fill_gstring_header (Qnil, frompos, frombyte,
1747 topos, font_object, string);
1748 gstring = gstring_lookup_cache (header);
1749 if (! NILP (gstring))
1750 return gstring;
1752 if (LGSTRING_GLYPH_LEN (gstring_work) < topos - frompos)
1753 gstring_work = Fmake_vector (make_number (topos - frompos + 2), Qnil);
1754 LGSTRING_SET_HEADER (gstring_work, header);
1755 LGSTRING_SET_ID (gstring_work, Qnil);
1756 fill_gstring_body (gstring_work);
1757 return gstring_work;
1761 /* Emacs Lisp APIs. */
1763 DEFUN ("compose-region-internal", Fcompose_region_internal,
1764 Scompose_region_internal, 2, 4, 0,
1765 doc: /* Internal use only.
1767 Compose text in the region between START and END.
1768 Optional 3rd and 4th arguments are COMPONENTS and MODIFICATION-FUNC
1769 for the composition. See `compose-region' for more details. */)
1770 (Lisp_Object start, Lisp_Object end, Lisp_Object components, Lisp_Object modification_func)
1772 validate_region (&start, &end);
1773 if (!NILP (components)
1774 && !INTEGERP (components)
1775 && !CONSP (components)
1776 && !STRINGP (components))
1777 CHECK_VECTOR (components);
1779 compose_text (XINT (start), XINT (end), components, modification_func, Qnil);
1780 return Qnil;
1783 DEFUN ("compose-string-internal", Fcompose_string_internal,
1784 Scompose_string_internal, 3, 5, 0,
1785 doc: /* Internal use only.
1787 Compose text between indices START and END of STRING, where
1788 START and END are treated as in `substring'. Optional 4th
1789 and 5th arguments are COMPONENTS and MODIFICATION-FUNC
1790 for the composition. See `compose-string' for more details. */)
1791 (Lisp_Object string, Lisp_Object start, Lisp_Object end,
1792 Lisp_Object components, Lisp_Object modification_func)
1794 ptrdiff_t from, to;
1796 CHECK_STRING (string);
1797 validate_subarray (string, start, end, SCHARS (string), &from, &to);
1798 compose_text (from, to, components, modification_func, string);
1799 return string;
1802 DEFUN ("find-composition-internal", Ffind_composition_internal,
1803 Sfind_composition_internal, 4, 4, 0,
1804 doc: /* Internal use only.
1806 Return information about composition at or nearest to position POS.
1807 See `find-composition' for more details. */)
1808 (Lisp_Object pos, Lisp_Object limit, Lisp_Object string, Lisp_Object detail_p)
1810 Lisp_Object prop, tail, gstring;
1811 ptrdiff_t start, end, from, to;
1812 int id;
1814 CHECK_NUMBER_COERCE_MARKER (pos);
1815 if (!NILP (limit))
1817 CHECK_NUMBER_COERCE_MARKER (limit);
1818 to = min (XINT (limit), ZV);
1820 else
1821 to = -1;
1823 if (!NILP (string))
1825 CHECK_STRING (string);
1826 if (XINT (pos) < 0 || XINT (pos) > SCHARS (string))
1827 args_out_of_range (string, pos);
1829 else
1831 if (XINT (pos) < BEGV || XINT (pos) > ZV)
1832 args_out_of_range (Fcurrent_buffer (), pos);
1834 from = XINT (pos);
1836 if (!find_composition (from, to, &start, &end, &prop, string))
1838 if (!NILP (BVAR (current_buffer, enable_multibyte_characters))
1839 && ! NILP (Vauto_composition_mode)
1840 && find_automatic_composition (from, to, &start, &end, &gstring,
1841 string))
1842 return list3 (make_number (start), make_number (end), gstring);
1843 return Qnil;
1845 if ((end <= XINT (pos) || start > XINT (pos)))
1847 ptrdiff_t s, e;
1849 if (find_automatic_composition (from, to, &s, &e, &gstring, string)
1850 && (e <= XINT (pos) ? e > end : s < start))
1851 return list3 (make_number (s), make_number (e), gstring);
1853 if (!composition_valid_p (start, end, prop))
1854 return list3 (make_number (start), make_number (end), Qnil);
1855 if (NILP (detail_p))
1856 return list3 (make_number (start), make_number (end), Qt);
1858 if (composition_registered_p (prop))
1859 id = COMPOSITION_ID (prop);
1860 else
1862 ptrdiff_t start_byte = (NILP (string)
1863 ? CHAR_TO_BYTE (start)
1864 : string_char_to_byte (string, start));
1865 id = get_composition_id (start, start_byte, end - start, prop, string);
1868 if (id >= 0)
1870 Lisp_Object components, relative_p, mod_func;
1871 enum composition_method method = composition_method (prop);
1872 int width = composition_table[id]->width;
1874 components = Fcopy_sequence (COMPOSITION_COMPONENTS (prop));
1875 relative_p = (method == COMPOSITION_WITH_RULE_ALTCHARS
1876 ? Qnil : Qt);
1877 mod_func = COMPOSITION_MODIFICATION_FUNC (prop);
1878 tail = list4 (components, relative_p, mod_func, make_number (width));
1880 else
1881 tail = Qnil;
1883 return Fcons (make_number (start), Fcons (make_number (end), tail));
1887 void
1888 syms_of_composite (void)
1890 int i;
1892 DEFSYM (Qcomposition, "composition");
1894 /* Make a hash table for static composition. */
1895 /* We used to make the hash table weak so that unreferenced
1896 compositions can be garbage-collected. But, usually once
1897 created compositions are repeatedly used in an Emacs session,
1898 and thus it's not worth to save memory in such a way. So, we
1899 make the table not weak. */
1900 Lisp_Object args[] = {QCtest, Qequal, QCsize, make_number (311)};
1901 composition_hash_table = CALLMANY (Fmake_hash_table, args);
1902 staticpro (&composition_hash_table);
1904 /* Make a hash table for glyph-string. */
1905 gstring_hash_table = CALLMANY (Fmake_hash_table, args);
1906 staticpro (&gstring_hash_table);
1908 staticpro (&gstring_work_headers);
1909 gstring_work_headers = make_uninit_vector (8);
1910 for (i = 0; i < 8; i++)
1911 ASET (gstring_work_headers, i, Fmake_vector (make_number (i + 2), Qnil));
1912 staticpro (&gstring_work);
1913 gstring_work = Fmake_vector (make_number (10), Qnil);
1915 /* Text property `composition' should be nonsticky by default. */
1916 Vtext_property_default_nonsticky
1917 = Fcons (Fcons (Qcomposition, Qt), Vtext_property_default_nonsticky);
1919 DEFVAR_LISP ("compose-chars-after-function", Vcompose_chars_after_function,
1920 doc: /* Function to adjust composition of buffer text.
1922 This function is called with three arguments: FROM, TO, and OBJECT.
1923 FROM and TO specify the range of text whose composition should be
1924 adjusted. OBJECT, if non-nil, is a string that contains the text.
1926 This function is called after a text with `composition' property is
1927 inserted or deleted to keep `composition' property of buffer text
1928 valid.
1930 The default value is the function `compose-chars-after'. */);
1931 Vcompose_chars_after_function = intern_c_string ("compose-chars-after");
1933 DEFSYM (Qauto_composed, "auto-composed");
1935 DEFVAR_LISP ("auto-composition-mode", Vauto_composition_mode,
1936 doc: /* Non-nil if Auto-Composition mode is enabled.
1937 Use the command `auto-composition-mode' to change this variable. */);
1938 Vauto_composition_mode = Qt;
1940 DEFVAR_LISP ("auto-composition-function", Vauto_composition_function,
1941 doc: /* Function to call to compose characters automatically.
1942 This function is called from the display routine with four arguments:
1943 FROM, TO, WINDOW, and STRING.
1945 If STRING is nil, the function must compose characters in the region
1946 between FROM and TO in the current buffer.
1948 Otherwise, STRING is a string, and FROM and TO are indices into the
1949 string. In this case, the function must compose characters in the
1950 string. */);
1951 Vauto_composition_function = Qnil;
1953 DEFVAR_LISP ("composition-function-table", Vcomposition_function_table,
1954 doc: /* Char-table of functions for automatic character composition.
1955 For each character that has to be composed automatically with
1956 preceding and/or following characters, this char-table contains
1957 a function to call to compose that character.
1959 The element at index C in the table, if non-nil, is a list of
1960 composition rules of this form: ([PATTERN PREV-CHARS FUNC] ...)
1962 PATTERN is a regular expression which C and the surrounding
1963 characters must match.
1965 PREV-CHARS is a non-negative integer (less than 4) specifying how many
1966 characters before C to check the matching with PATTERN. If it is 0,
1967 PATTERN must match C and the following characters. If it is 1,
1968 PATTERN must match a character before C and the following characters.
1970 If PREV-CHARS is 0, PATTERN can be nil, which means that the
1971 single character C should be composed.
1973 FUNC is a function to return a glyph-string representing a
1974 composition of the characters that match PATTERN. It is
1975 called with one argument GSTRING.
1977 GSTRING is a template of a glyph-string to return. It is already
1978 filled with a proper header for the characters to compose, and
1979 glyphs corresponding to those characters one by one. The
1980 function must return a new glyph-string with the same header as
1981 GSTRING, or modify GSTRING itself and return it.
1983 See also the documentation of `auto-composition-mode'. */);
1984 Vcomposition_function_table = Fmake_char_table (Qnil, Qnil);
1986 defsubr (&Scompose_region_internal);
1987 defsubr (&Scompose_string_internal);
1988 defsubr (&Sfind_composition_internal);
1989 defsubr (&Scomposition_get_gstring);