1 /* Composite sequence support.
2 Copyright (C) 2001-2012 Free Software Foundation, Inc.
3 Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
4 National Institute of Advanced Industrial Science and Technology (AIST)
5 Registration Number H14PRO021
6 Copyright (C) 2003, 2006
7 National Institute of Advanced Industrial Science and Technology (AIST)
8 Registration Number H13PRO009
10 This file is part of GNU Emacs.
12 GNU Emacs is free software: you can redistribute it and/or modify
13 it under the terms of the GNU General Public License as published by
14 the Free Software Foundation, either version 3 of the License, or
15 (at your option) any later version.
17 GNU Emacs is distributed in the hope that it will be useful,
18 but WITHOUT ANY WARRANTY; without even the implied warranty of
19 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 GNU General Public License for more details.
22 You should have received a copy of the GNU General Public License
23 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
27 #define COMPOSITE_INLINE EXTERN_INLINE
31 #include "character.h"
34 #include "intervals.h"
37 #include "dispextern.h"
39 #include "termhooks.h"
42 /* Emacs uses special text property `composition' to support character
43 composition. A sequence of characters that have the same (i.e. eq)
44 `composition' property value is treated as a single composite
45 sequence (we call it just `composition' here after). Characters in
46 a composition are all composed somehow on the screen.
48 The property value has this form when the composition is made:
49 ((LENGTH . COMPONENTS) . MODIFICATION-FUNC)
50 then turns to this form:
51 (COMPOSITION-ID . (LENGTH COMPONENTS-VEC . MODIFICATION-FUNC))
52 when the composition is registered in composition_hash_table and
53 composition_table. These rather peculiar structures were designed
54 to make it easy to distinguish them quickly (we can do that by
55 checking only the first element) and to extract LENGTH (from the
56 former form) and COMPOSITION-ID (from the latter form).
58 We register a composition when it is displayed, or when the width
59 is required (for instance, to calculate columns).
61 LENGTH -- Length of the composition. This information is used to
62 check the validity of the composition.
64 COMPONENTS -- Character, string, vector, list, or nil.
66 If it is nil, characters in the text are composed relatively
67 according to their metrics in font glyphs.
69 If it is a character or a string, the character or characters
70 in the string are composed relatively.
72 If it is a vector or list of integers, the element is a
73 character or an encoded composition rule. The characters are
74 composed according to the rules. (2N)th elements are
75 characters to be composed and (2N+1)th elements are
76 composition rules to tell how to compose (2N+2)th element with
77 the previously composed 2N glyphs.
79 COMPONENTS-VEC -- Vector of integers. In a relative composition,
80 the elements are the characters to be composed. In a rule-base
81 composition, the elements are characters or encoded
84 MODIFICATION-FUNC -- If non nil, it is a function to call when the
85 composition gets invalid after a modification in a buffer. If
86 it is nil, a function in `composition-function-table' of the
87 first character in the sequence is called.
89 COMPOSITION-ID --Identification number of the composition. It is
90 used as an index to composition_table for the composition.
92 When Emacs has to display a composition or has to know its
93 displaying width, the function get_composition_id is called. It
94 returns COMPOSITION-ID so that the caller can access the
95 information about the composition through composition_table. If a
96 COMPOSITION-ID has not yet been assigned to the composition,
97 get_composition_id checks the validity of `composition' property,
98 and, if valid, assigns a new ID, registers the information in
99 composition_hash_table and composition_table, and changes the form
100 of the property value. If the property is invalid,
101 get_composition_id returns -1 without changing the property value.
103 We use two tables to keep the information about composition;
104 composition_hash_table and composition_table.
106 The former is a hash table whose keys are COMPONENTS-VECs and
107 values are the corresponding COMPOSITION-IDs. This hash table is
108 weak, but as each key (COMPONENTS-VEC) is also kept as a value of the
109 `composition' property, it won't be collected as garbage until all
110 bits of text that have the same COMPONENTS-VEC are deleted.
112 The latter is a table of pointers to `struct composition' indexed
113 by COMPOSITION-ID. This structure keeps the other information (see
116 In general, a text property holds information about individual
117 characters. But, a `composition' property holds information about
118 a sequence of characters (in this sense, it is like the `intangible'
119 property). That means that we should not share the property value
120 in adjacent compositions -- we can't distinguish them if they have the
121 same property. So, after any changes, we call
122 `update_compositions' and change a property of one of adjacent
123 compositions to a copy of it. This function also runs a proper
124 composition modification function to make a composition that gets
125 invalid by the change valid again.
127 As the value of the `composition' property holds information about a
128 specific range of text, the value gets invalid if we change the
129 text in the range. We treat the `composition' property as always
130 rear-nonsticky (currently by setting default-text-properties to
131 (rear-nonsticky (composition))) and we never make properties of
132 adjacent compositions identical. Thus, any such changes make the
133 range just shorter. So, we can check the validity of the `composition'
134 property by comparing LENGTH information with the actual length of
140 Lisp_Object Qcomposition
;
142 /* Table of pointers to the structure `composition' indexed by
143 COMPOSITION-ID. This structure is for storing information about
144 each composition except for COMPONENTS-VEC. */
145 struct composition
**composition_table
;
147 /* The current size of `composition_table'. */
148 static ptrdiff_t composition_table_size
;
150 /* Number of compositions currently made. */
151 ptrdiff_t n_compositions
;
153 /* Hash table for compositions. The key is COMPONENTS-VEC of
154 `composition' property. The value is the corresponding
156 Lisp_Object composition_hash_table
;
158 static Lisp_Object Qauto_composed
;
159 static Lisp_Object Qauto_composition_function
;
160 /* Maximum number of characters to look back for
161 auto-compositions. */
162 #define MAX_AUTO_COMPOSITION_LOOKBACK 3
164 /* Temporary variable used in macros COMPOSITION_XXX. */
165 Lisp_Object composition_temp
;
168 /* Return COMPOSITION-ID of a composition at buffer position
169 CHARPOS/BYTEPOS and length NCHARS. The `composition' property of
170 the sequence is PROP. STRING, if non-nil, is a string that
171 contains the composition instead of the current buffer.
173 If the composition is invalid, return -1. */
176 get_composition_id (ptrdiff_t charpos
, ptrdiff_t bytepos
, ptrdiff_t nchars
,
177 Lisp_Object prop
, Lisp_Object string
)
179 Lisp_Object id
, length
, components
, key
, *key_contents
;
181 struct Lisp_Hash_Table
*hash_table
= XHASH_TABLE (composition_hash_table
);
182 ptrdiff_t hash_index
;
183 EMACS_UINT hash_code
;
184 enum composition_method method
;
185 struct composition
*cmp
;
189 /* Maximum length of a string of glyphs. XftGlyphExtents limits
190 this to INT_MAX, and Emacs limits it further. Divide INT_MAX - 1
191 by 2 because x_produce_glyphs computes glyph_len * 2 + 1. Divide
192 the size by MAX_MULTIBYTE_LENGTH because encode_terminal_code
193 multiplies glyph_len by MAX_MULTIBYTE_LENGTH. */
195 GLYPH_LEN_MAX
= min ((INT_MAX
- 1) / 2,
196 min (PTRDIFF_MAX
, SIZE_MAX
) / MAX_MULTIBYTE_LENGTH
)
200 Form-A: ((LENGTH . COMPONENTS) . MODIFICATION-FUNC)
202 Form-B: (COMPOSITION-ID . (LENGTH COMPONENTS-VEC . MODIFICATION-FUNC))
204 if (nchars
== 0 || !CONSP (prop
))
205 goto invalid_composition
;
210 /* PROP should be Form-B. */
211 if (XINT (id
) < 0 || XINT (id
) >= n_compositions
)
212 goto invalid_composition
;
216 /* PROP should be Form-A.
217 Thus, ID should be (LENGTH . COMPONENTS). */
219 goto invalid_composition
;
221 if (!INTEGERP (length
) || XINT (length
) != nchars
)
222 goto invalid_composition
;
224 components
= XCDR (id
);
226 /* Check if the same composition has already been registered or not
227 by consulting composition_hash_table. The key for this table is
228 COMPONENTS (converted to a vector COMPONENTS-VEC) or, if it is
229 nil, vector of characters in the composition range. */
230 if (INTEGERP (components
))
231 key
= Fmake_vector (make_number (1), components
);
232 else if (STRINGP (components
) || CONSP (components
))
233 key
= Fvconcat (1, &components
);
234 else if (VECTORP (components
))
236 else if (NILP (components
))
238 key
= Fmake_vector (make_number (nchars
), Qnil
);
239 if (STRINGP (string
))
240 for (i
= 0; i
< nchars
; i
++)
242 FETCH_STRING_CHAR_ADVANCE (ch
, string
, charpos
, bytepos
);
243 ASET (key
, i
, make_number (ch
));
246 for (i
= 0; i
< nchars
; i
++)
248 FETCH_CHAR_ADVANCE (ch
, charpos
, bytepos
);
249 ASET (key
, i
, make_number (ch
));
253 goto invalid_composition
;
255 hash_index
= hash_lookup (hash_table
, key
, &hash_code
);
258 /* We have already registered the same composition. Change PROP
259 from Form-A above to Form-B while replacing COMPONENTS with
260 COMPONENTS-VEC stored in the hash table. We can directly
261 modify the cons cell of PROP because it is not shared. */
262 key
= HASH_KEY (hash_table
, hash_index
);
263 id
= HASH_VALUE (hash_table
, hash_index
);
265 XSETCDR (prop
, Fcons (make_number (nchars
), Fcons (key
, XCDR (prop
))));
269 /* This composition is a new one. We must register it. */
271 /* Check if we have sufficient memory to store this information. */
272 if (composition_table_size
<= n_compositions
)
273 composition_table
= xpalloc (composition_table
, &composition_table_size
,
274 1, -1, sizeof *composition_table
);
276 key_contents
= XVECTOR (key
)->contents
;
278 /* Check if the contents of COMPONENTS are valid if COMPONENTS is a
279 vector or a list. It should be a sequence of:
280 char1 rule1 char2 rule2 char3 ... ruleN charN+1 */
282 if (VECTORP (components
)
283 && ASIZE (components
) >= 2
284 && VECTORP (AREF (components
, 0)))
286 /* COMPONENTS is a glyph-string. */
287 ptrdiff_t len
= ASIZE (key
);
289 for (i
= 1; i
< len
; i
++)
290 if (! VECTORP (AREF (key
, i
)))
291 goto invalid_composition
;
293 else if (VECTORP (components
) || CONSP (components
))
295 ptrdiff_t len
= ASIZE (key
);
297 /* The number of elements should be odd. */
299 goto invalid_composition
;
300 /* All elements should be integers (character or encoded
301 composition rule). */
302 for (i
= 0; i
< len
; i
++)
304 if (!INTEGERP (key_contents
[i
]))
305 goto invalid_composition
;
309 /* Change PROP from Form-A above to Form-B. We can directly modify
310 the cons cell of PROP because it is not shared. */
311 XSETFASTINT (id
, n_compositions
);
313 XSETCDR (prop
, Fcons (make_number (nchars
), Fcons (key
, XCDR (prop
))));
315 /* Register the composition in composition_hash_table. */
316 hash_index
= hash_put (hash_table
, key
, id
, hash_code
);
318 method
= (NILP (components
)
319 ? COMPOSITION_RELATIVE
320 : ((INTEGERP (components
) || STRINGP (components
))
321 ? COMPOSITION_WITH_ALTCHARS
322 : COMPOSITION_WITH_RULE_ALTCHARS
));
324 glyph_len
= (method
== COMPOSITION_WITH_RULE_ALTCHARS
325 ? (ASIZE (key
) + 1) / 2
328 if (GLYPH_LEN_MAX
< glyph_len
)
329 memory_full (SIZE_MAX
);
331 /* Register the composition in composition_table. */
332 cmp
= xmalloc (sizeof *cmp
);
334 cmp
->method
= method
;
335 cmp
->hash_index
= hash_index
;
336 cmp
->glyph_len
= glyph_len
;
337 cmp
->offsets
= xnmalloc (glyph_len
, 2 * sizeof *cmp
->offsets
);
340 if (cmp
->method
!= COMPOSITION_WITH_RULE_ALTCHARS
)
342 /* Relative composition. */
344 for (i
= 0; i
< glyph_len
; i
++)
347 ch
= XINT (key_contents
[i
]);
348 /* TAB in a composition means display glyphs with padding
349 space on the left or right. */
350 this_width
= (ch
== '\t' ? 1 : CHAR_WIDTH (ch
));
351 if (cmp
->width
< this_width
)
352 cmp
->width
= this_width
;
357 /* Rule-base composition. */
358 double leftmost
= 0.0, rightmost
;
360 ch
= XINT (key_contents
[0]);
361 rightmost
= ch
!= '\t' ? CHAR_WIDTH (ch
) : 1;
363 for (i
= 1; i
< glyph_len
; i
+= 2)
365 int rule
, gref
, nref
;
369 rule
= XINT (key_contents
[i
]);
370 ch
= XINT (key_contents
[i
+ 1]);
371 this_width
= ch
!= '\t' ? CHAR_WIDTH (ch
) : 1;
373 /* A composition rule is specified by an integer value
374 that encodes global and new reference points (GREF and
375 NREF). GREF and NREF are specified by numbers as
383 ---3---4---5--- baseline
387 COMPOSITION_DECODE_REFS (rule
, gref
, nref
);
388 this_left
= (leftmost
389 + (gref
% 3) * (rightmost
- leftmost
) / 2.0
390 - (nref
% 3) * this_width
/ 2.0);
392 if (this_left
< leftmost
)
393 leftmost
= this_left
;
394 if (this_left
+ this_width
> rightmost
)
395 rightmost
= this_left
+ this_width
;
398 cmp
->width
= rightmost
- leftmost
;
399 if (cmp
->width
< (rightmost
- leftmost
))
400 /* To get a ceiling integer value. */
404 composition_table
[n_compositions
] = cmp
;
406 return n_compositions
++;
409 /* Would it be better to remove this `composition' property? */
414 /* Find a static composition at or nearest to position POS of OBJECT
417 OBJECT defaults to the current buffer. If there's a composition at
418 POS, set *START and *END to the start and end of the sequence,
419 *PROP to the `composition' property, and return 1.
421 If there's no composition at POS and LIMIT is negative, return 0.
423 Otherwise, search for a composition forward (LIMIT > POS) or
424 backward (LIMIT < POS). In this case, LIMIT bounds the search.
426 If a composition is found, set *START, *END, and *PROP as above,
427 and return 1, else return 0.
429 This doesn't check the validity of composition. */
432 find_composition (ptrdiff_t pos
, ptrdiff_t limit
,
433 ptrdiff_t *start
, ptrdiff_t *end
,
434 Lisp_Object
*prop
, Lisp_Object object
)
438 if (get_property_and_range (pos
, Qcomposition
, prop
, start
, end
, object
))
441 if (limit
< 0 || limit
== pos
)
444 if (limit
> pos
) /* search forward */
446 val
= Fnext_single_property_change (make_number (pos
), Qcomposition
,
447 object
, make_number (limit
));
452 else /* search backward */
454 if (get_property_and_range (pos
- 1, Qcomposition
, prop
, start
, end
,
457 val
= Fprevious_single_property_change (make_number (pos
), Qcomposition
,
458 object
, make_number (limit
));
464 get_property_and_range (pos
, Qcomposition
, prop
, start
, end
, object
);
468 /* Run a proper function to adjust the composition sitting between
469 FROM and TO with property PROP. */
472 run_composition_function (ptrdiff_t from
, ptrdiff_t to
, Lisp_Object prop
)
475 ptrdiff_t start
, end
;
477 func
= COMPOSITION_MODIFICATION_FUNC (prop
);
478 /* If an invalid composition precedes or follows, try to make them
481 && find_composition (from
- 1, -1, &start
, &end
, &prop
, Qnil
)
482 && !COMPOSITION_VALID_P (start
, end
, prop
))
485 && find_composition (to
, -1, &start
, &end
, &prop
, Qnil
)
486 && !COMPOSITION_VALID_P (start
, end
, prop
))
488 if (!NILP (Ffboundp (func
)))
489 call2 (func
, make_number (from
), make_number (to
));
492 /* Make invalid compositions adjacent to or inside FROM and TO valid.
493 CHECK_MASK is bitwise `or' of mask bits defined by macros
494 CHECK_XXX (see the comment in composite.h).
496 It also resets the text-property `auto-composed' to a proper region
497 so that automatic character composition works correctly later while
498 displaying the region.
500 This function is called when a buffer text is changed. If the
501 change is deletion, FROM == TO. Otherwise, FROM < TO. */
504 update_compositions (ptrdiff_t from
, ptrdiff_t to
, int check_mask
)
507 ptrdiff_t start
, end
;
508 /* The beginning and end of the region to set the property
509 `auto-composed' to nil. */
510 ptrdiff_t min_pos
= from
, max_pos
= to
;
512 if (inhibit_modification_hooks
)
515 /* If FROM and TO are not in a valid range, do nothing. */
516 if (! (BEGV
<= from
&& from
<= to
&& to
<= ZV
))
519 if (check_mask
& CHECK_HEAD
)
521 /* FROM should be at composition boundary. But, insertion or
522 deletion will make two compositions adjacent and
523 indistinguishable when they have same (eq) property. To
524 avoid it, in such a case, we change the property of the
525 latter to the copy of it. */
527 && find_composition (from
- 1, -1, &start
, &end
, &prop
, Qnil
)
528 && COMPOSITION_VALID_P (start
, end
, prop
))
534 Fput_text_property (make_number (from
), make_number (end
),
536 Fcons (XCAR (prop
), XCDR (prop
)), Qnil
);
537 run_composition_function (start
, end
, prop
);
541 && find_composition (from
, -1, &start
, &from
, &prop
, Qnil
)
542 && COMPOSITION_VALID_P (start
, from
, prop
))
546 run_composition_function (start
, from
, prop
);
550 if (check_mask
& CHECK_INSIDE
)
552 /* In this case, we are sure that (check & CHECK_TAIL) is also
553 nonzero. Thus, here we should check only compositions before
556 && find_composition (from
, to
, &start
, &from
, &prop
, Qnil
)
557 && COMPOSITION_VALID_P (start
, from
, prop
)
559 run_composition_function (start
, from
, prop
);
562 if (check_mask
& CHECK_TAIL
)
565 && find_composition (to
- 1, -1, &start
, &end
, &prop
, Qnil
)
566 && COMPOSITION_VALID_P (start
, end
, prop
))
568 /* TO should be also at composition boundary. But,
569 insertion or deletion will make two compositions adjacent
570 and indistinguishable when they have same (eq) property.
571 To avoid it, in such a case, we change the property of
572 the former to the copy of it. */
575 Fput_text_property (make_number (start
), make_number (to
),
577 Fcons (XCAR (prop
), XCDR (prop
)), Qnil
);
580 run_composition_function (start
, end
, prop
);
583 && find_composition (to
, -1, &start
, &end
, &prop
, Qnil
)
584 && COMPOSITION_VALID_P (start
, end
, prop
))
586 run_composition_function (start
, end
, prop
);
590 if (min_pos
< max_pos
)
592 ptrdiff_t count
= SPECPDL_INDEX ();
594 specbind (Qinhibit_read_only
, Qt
);
595 specbind (Qinhibit_modification_hooks
, Qt
);
596 specbind (Qinhibit_point_motion_hooks
, Qt
);
597 Fremove_list_of_text_properties (make_number (min_pos
),
598 make_number (max_pos
),
599 Fcons (Qauto_composed
, Qnil
), Qnil
);
600 unbind_to (count
, Qnil
);
605 /* Modify composition property values in LIST destructively. LIST is
606 a list as returned from text_property_list. Change values to the
607 top-level copies of them so that none of them are `eq'. */
610 make_composition_value_copy (Lisp_Object list
)
612 Lisp_Object plist
, val
;
614 for (; CONSP (list
); list
= XCDR (list
))
616 plist
= XCAR (XCDR (XCDR (XCAR (list
))));
617 while (CONSP (plist
) && CONSP (XCDR (plist
)))
619 if (EQ (XCAR (plist
), Qcomposition
)
620 && (val
= XCAR (XCDR (plist
)), CONSP (val
)))
621 XSETCAR (XCDR (plist
), Fcons (XCAR (val
), XCDR (val
)));
622 plist
= XCDR (XCDR (plist
));
628 /* Make text in the region between START and END a composition that
629 has COMPONENTS and MODIFICATION-FUNC.
631 If STRING is non-nil, then operate on characters contained between
632 indices START and END in STRING. */
635 compose_text (ptrdiff_t start
, ptrdiff_t end
, Lisp_Object components
,
636 Lisp_Object modification_func
, Lisp_Object string
)
640 prop
= Fcons (Fcons (make_number (end
- start
), components
),
642 Fput_text_property (make_number (start
), make_number (end
),
643 Qcomposition
, prop
, string
);
647 static Lisp_Object
autocmp_chars (Lisp_Object
, ptrdiff_t, ptrdiff_t,
648 ptrdiff_t, struct window
*,
649 struct face
*, Lisp_Object
);
652 /* Lisp glyph-string handlers */
654 /* Hash table for automatic composition. The key is a header of a
655 lgstring (Lispy glyph-string), and the value is a body of a
658 static Lisp_Object gstring_hash_table
;
660 static Lisp_Object
gstring_lookup_cache (Lisp_Object
);
663 gstring_lookup_cache (Lisp_Object header
)
665 struct Lisp_Hash_Table
*h
= XHASH_TABLE (gstring_hash_table
);
666 ptrdiff_t i
= hash_lookup (h
, header
, NULL
);
668 return (i
>= 0 ? HASH_VALUE (h
, i
) : Qnil
);
672 composition_gstring_put_cache (Lisp_Object gstring
, ptrdiff_t len
)
674 struct Lisp_Hash_Table
*h
= XHASH_TABLE (gstring_hash_table
);
676 Lisp_Object header
, copy
;
679 header
= LGSTRING_HEADER (gstring
);
680 hash
= h
->hashfn (h
, header
);
683 ptrdiff_t j
, glyph_len
= LGSTRING_GLYPH_LEN (gstring
);
684 for (j
= 0; j
< glyph_len
; j
++)
685 if (NILP (LGSTRING_GLYPH (gstring
, j
)))
690 lint_assume (len
<= TYPE_MAXIMUM (ptrdiff_t) - 2);
691 copy
= Fmake_vector (make_number (len
+ 2), Qnil
);
692 LGSTRING_SET_HEADER (copy
, Fcopy_sequence (header
));
693 for (i
= 0; i
< len
; i
++)
694 LGSTRING_SET_GLYPH (copy
, i
, Fcopy_sequence (LGSTRING_GLYPH (gstring
, i
)));
695 i
= hash_put (h
, LGSTRING_HEADER (copy
), copy
, hash
);
696 LGSTRING_SET_ID (copy
, make_number (i
));
701 composition_gstring_from_id (ptrdiff_t id
)
703 struct Lisp_Hash_Table
*h
= XHASH_TABLE (gstring_hash_table
);
705 return HASH_VALUE (h
, id
);
708 static Lisp_Object
fill_gstring_header (Lisp_Object
, Lisp_Object
,
709 Lisp_Object
, Lisp_Object
,
713 composition_gstring_p (Lisp_Object gstring
)
718 if (! VECTORP (gstring
) || ASIZE (gstring
) < 2)
720 header
= LGSTRING_HEADER (gstring
);
721 if (! VECTORP (header
) || ASIZE (header
) < 2)
723 if (! NILP (LGSTRING_FONT (gstring
))
724 && (! FONT_OBJECT_P (LGSTRING_FONT (gstring
))
725 && ! CODING_SYSTEM_P (LGSTRING_FONT (gstring
))))
727 for (i
= 1; i
< ASIZE (LGSTRING_HEADER (gstring
)); i
++)
728 if (! NATNUMP (AREF (LGSTRING_HEADER (gstring
), i
)))
730 if (! NILP (LGSTRING_ID (gstring
)) && ! NATNUMP (LGSTRING_ID (gstring
)))
732 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
734 Lisp_Object glyph
= LGSTRING_GLYPH (gstring
, i
);
737 if (! VECTORP (glyph
) || ASIZE (glyph
) != LGLYPH_SIZE
)
744 composition_gstring_width (Lisp_Object gstring
, ptrdiff_t from
, ptrdiff_t to
,
745 struct font_metrics
*metrics
)
752 Lisp_Object font_object
= LGSTRING_FONT (gstring
);
754 if (FONT_OBJECT_P (font_object
))
756 struct font
*font
= XFONT_OBJECT (font_object
);
758 metrics
->ascent
= font
->ascent
;
759 metrics
->descent
= font
->descent
;
764 metrics
->descent
= 0;
766 metrics
->width
= metrics
->lbearing
= metrics
->rbearing
= 0;
768 for (glyph
= lgstring_glyph_addr (gstring
, from
); from
< to
; from
++, glyph
++)
772 if (NILP (LGLYPH_ADJUSTMENT (*glyph
)))
773 width
+= LGLYPH_WIDTH (*glyph
);
775 width
+= LGLYPH_WADJUST (*glyph
);
778 x
= metrics
->width
+ LGLYPH_LBEARING (*glyph
) + LGLYPH_XOFF (*glyph
);
779 if (metrics
->lbearing
> x
)
780 metrics
->lbearing
= x
;
781 x
= metrics
->width
+ LGLYPH_RBEARING (*glyph
) + LGLYPH_XOFF (*glyph
);
782 if (metrics
->rbearing
< x
)
783 metrics
->rbearing
= x
;
784 metrics
->width
= width
;
785 x
= LGLYPH_ASCENT (*glyph
) - LGLYPH_YOFF (*glyph
);
786 if (metrics
->ascent
< x
)
788 x
= LGLYPH_DESCENT (*glyph
) + LGLYPH_YOFF (*glyph
);
789 if (metrics
->descent
< x
)
790 metrics
->descent
= x
;
797 static Lisp_Object gstring_work
;
798 static Lisp_Object gstring_work_headers
;
801 fill_gstring_header (Lisp_Object header
, Lisp_Object start
, Lisp_Object end
, Lisp_Object font_object
, Lisp_Object string
)
803 ptrdiff_t from
, to
, from_byte
;
808 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
809 error ("Attempt to shape unibyte text");
810 validate_region (&start
, &end
);
811 from
= XFASTINT (start
);
813 from_byte
= CHAR_TO_BYTE (from
);
817 CHECK_STRING (string
);
818 if (! STRING_MULTIBYTE (string
))
819 error ("Attempt to shape unibyte text");
820 /* The caller checks that START and END are nonnegative integers. */
821 if (! (XINT (start
) <= XINT (end
) && XINT (end
) <= SCHARS (string
)))
822 args_out_of_range_3 (string
, start
, end
);
825 from_byte
= string_char_to_byte (string
, from
);
830 error ("Attempt to shape zero-length text");
831 if (VECTORP (header
))
833 if (ASIZE (header
) != len
+ 1)
834 args_out_of_range (header
, make_number (len
+ 1));
839 header
= AREF (gstring_work_headers
, len
- 1);
841 header
= Fmake_vector (make_number (len
+ 1), Qnil
);
844 ASET (header
, 0, font_object
);
845 for (i
= 0; i
< len
; i
++)
850 FETCH_CHAR_ADVANCE_NO_CHECK (c
, from
, from_byte
);
852 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, from
, from_byte
);
853 ASET (header
, i
+ 1, make_number (c
));
859 fill_gstring_body (Lisp_Object gstring
)
861 Lisp_Object font_object
= LGSTRING_FONT (gstring
);
862 Lisp_Object header
= AREF (gstring
, 0);
863 ptrdiff_t len
= LGSTRING_CHAR_LEN (gstring
);
866 for (i
= 0; i
< len
; i
++)
868 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
869 int c
= XFASTINT (AREF (header
, i
+ 1));
874 LGSTRING_SET_GLYPH (gstring
, i
, g
);
876 LGLYPH_SET_FROM (g
, i
);
877 LGLYPH_SET_TO (g
, i
);
878 LGLYPH_SET_CHAR (g
, c
);
879 if (FONT_OBJECT_P (font_object
))
881 font_fill_lglyph_metrics (g
, font_object
);
885 int width
= XFASTINT (CHAR_TABLE_REF (Vchar_width_table
, c
));
887 LGLYPH_SET_CODE (g
, c
);
888 LGLYPH_SET_LBEARING (g
, 0);
889 LGLYPH_SET_RBEARING (g
, width
);
890 LGLYPH_SET_WIDTH (g
, width
);
891 LGLYPH_SET_ASCENT (g
, 1);
892 LGLYPH_SET_DESCENT (g
, 0);
894 LGLYPH_SET_ADJUSTMENT (g
, Qnil
);
896 if (i
< LGSTRING_GLYPH_LEN (gstring
))
897 LGSTRING_SET_GLYPH (gstring
, i
, Qnil
);
901 /* Try to compose the characters at CHARPOS according to composition
902 rule RULE ([PATTERN PREV-CHARS FUNC]). LIMIT limits the characters
903 to compose. STRING, if not nil, is a target string. WIN is a
904 window where the characters are being displayed. If characters are
905 successfully composed, return the composition as a glyph-string
906 object. Otherwise return nil. */
909 autocmp_chars (Lisp_Object rule
, ptrdiff_t charpos
, ptrdiff_t bytepos
, ptrdiff_t limit
, struct window
*win
, struct face
*face
, Lisp_Object string
)
911 ptrdiff_t count
= SPECPDL_INDEX ();
912 FRAME_PTR f
= XFRAME (win
->frame
);
913 Lisp_Object pos
= make_number (charpos
);
915 ptrdiff_t pt
= PT
, pt_byte
= PT_BYTE
;
916 Lisp_Object re
, font_object
, lgstring
;
919 record_unwind_save_match_data ();
923 else if (! STRINGP (re
))
924 return unbind_to (count
, Qnil
);
925 else if ((len
= fast_looking_at (re
, charpos
, bytepos
, limit
, -1, string
))
929 len
= BYTE_TO_CHAR (bytepos
+ len
) - charpos
;
931 len
= string_byte_to_char (string
, bytepos
+ len
) - charpos
;
934 return unbind_to (count
, Qnil
);
935 to
= limit
= charpos
+ len
;
936 #ifdef HAVE_WINDOW_SYSTEM
937 if (FRAME_WINDOW_P (f
))
939 font_object
= font_range (charpos
, &to
, win
, face
, string
);
940 if (! FONT_OBJECT_P (font_object
)
943 && (fast_looking_at (re
, charpos
, bytepos
, to
, -1, string
) <= 0)))
944 return unbind_to (count
, Qnil
);
947 #endif /* not HAVE_WINDOW_SYSTEM */
948 font_object
= win
->frame
;
949 lgstring
= Fcomposition_get_gstring (pos
, make_number (to
), font_object
,
951 if (NILP (LGSTRING_ID (lgstring
)))
953 /* Save point as marker before calling out to lisp. */
955 record_unwind_protect (restore_point_unwind
,
956 build_marker (current_buffer
, pt
, pt_byte
));
957 lgstring
= safe_call (6, Vauto_composition_function
, AREF (rule
, 2),
958 pos
, make_number (to
), font_object
, string
);
960 return unbind_to (count
, lgstring
);
963 static Lisp_Object _work_val
;
965 /* 1 iff the character C is composable. Characters of general
966 category Z? or C? are not composable except for ZWNJ and ZWJ. */
968 #define CHAR_COMPOSABLE_P(C) \
970 && ((C) == 0x200C || (C) == 0x200D \
971 || (_work_val = CHAR_TABLE_REF (Vunicode_category_table, (C)), \
972 (INTEGERP (_work_val) \
973 && (XINT (_work_val) <= UNICODE_CATEGORY_So)))))
975 /* Update cmp_it->stop_pos to the next position after CHARPOS (and
976 BYTEPOS) where character composition may happen. If BYTEPOS is
977 negative, compute it. ENDPOS is a limit of searching. If it is
978 less than CHARPOS, search backward to ENDPOS+1 assuming that
979 set_iterator_to_next works in reverse order. In this case, if a
980 composition closest to CHARPOS is found, set cmp_it->stop_pos to
981 the last character of the composition.
983 If no composition is found, set cmp_it->ch to -2. If a static
984 composition is found, set cmp_it->ch to -1. Otherwise, set
985 cmp_it->ch to the character that triggers the automatic
989 composition_compute_stop_pos (struct composition_it
*cmp_it
, ptrdiff_t charpos
, ptrdiff_t bytepos
, ptrdiff_t endpos
, Lisp_Object string
)
991 ptrdiff_t start
, end
;
993 Lisp_Object prop
, val
;
994 /* This is from forward_to_next_line_start in xdisp.c. */
995 const int MAX_NEWLINE_DISTANCE
= 500;
997 if (charpos
< endpos
)
999 if (endpos
> charpos
+ MAX_NEWLINE_DISTANCE
)
1000 endpos
= charpos
+ MAX_NEWLINE_DISTANCE
;
1002 else if (endpos
< charpos
)
1004 /* We search backward for a position to check composition. */
1007 /* But we don't know where to stop the searching. */
1008 endpos
= NILP (string
) ? BEGV
- 1 : -1;
1009 /* Usually we don't reach ENDPOS because we stop searching
1010 at an uncomposable character (NL, LRE, etc). */
1015 cmp_it
->reversed_p
= 0;
1016 cmp_it
->stop_pos
= endpos
;
1017 if (charpos
== endpos
)
1019 /* FIXME: Bidi is not yet handled well in static composition. */
1020 if (charpos
< endpos
1021 && find_composition (charpos
, endpos
, &start
, &end
, &prop
, string
)
1023 && COMPOSITION_VALID_P (start
, end
, prop
))
1025 cmp_it
->stop_pos
= endpos
= start
;
1028 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
))
1029 || NILP (Vauto_composition_mode
))
1034 bytepos
= CHAR_TO_BYTE (charpos
);
1036 bytepos
= string_char_to_byte (string
, charpos
);
1040 if (charpos
< endpos
)
1042 /* Forward search. */
1043 while (charpos
< endpos
)
1045 if (STRINGP (string
))
1046 FETCH_STRING_CHAR_ADVANCE (c
, string
, charpos
, bytepos
);
1048 FETCH_CHAR_ADVANCE (c
, charpos
, bytepos
);
1054 val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1060 for (ridx
= 0; CONSP (val
); val
= XCDR (val
), ridx
++)
1063 if (VECTORP (elt
) && ASIZE (elt
) == 3
1064 && NATNUMP (AREF (elt
, 1))
1065 && charpos
- 1 - XFASTINT (AREF (elt
, 1)) >= start
)
1070 cmp_it
->rule_idx
= ridx
;
1071 cmp_it
->lookback
= XFASTINT (AREF (elt
, 1));
1072 cmp_it
->stop_pos
= charpos
- 1 - cmp_it
->lookback
;
1078 if (charpos
== endpos
)
1080 /* We couldn't find a composition point before ENDPOS. But,
1081 some character after ENDPOS may be composed with
1082 characters before ENDPOS. So, we should stop at the safe
1084 charpos
= endpos
- MAX_AUTO_COMPOSITION_LOOKBACK
;
1085 if (charpos
< start
)
1089 else if (charpos
> endpos
)
1091 /* Search backward for a pattern that may be composed and the
1092 position of (possibly) the last character of the match is
1093 closest to (but not after) START. The reason for the last
1094 character is that set_iterator_to_next works in reverse order,
1095 and thus we must stop at the last character for composition
1099 /* Limit byte position used in fast_looking_at. This is the
1100 byte position of the character after START. */
1104 p
= BYTE_POS_ADDR (bytepos
);
1106 p
= SDATA (string
) + bytepos
;
1107 c
= STRING_CHAR_AND_LENGTH (p
, len
);
1108 limit
= bytepos
+ len
;
1109 while (CHAR_COMPOSABLE_P (c
))
1111 val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1117 for (ridx
= 0; CONSP (val
); val
= XCDR (val
), ridx
++)
1120 if (VECTORP (elt
) && ASIZE (elt
) == 3
1121 && NATNUMP (AREF (elt
, 1))
1122 && charpos
- XFASTINT (AREF (elt
, 1)) > endpos
)
1124 ptrdiff_t back
= XFASTINT (AREF (elt
, 1));
1125 ptrdiff_t cpos
= charpos
- back
, bpos
;
1130 bpos
= (NILP (string
) ? CHAR_TO_BYTE (cpos
)
1131 : string_char_to_byte (string
, cpos
));
1132 if (STRINGP (AREF (elt
, 0)))
1133 blen
= fast_looking_at (AREF (elt
, 0), cpos
, bpos
,
1134 start
+ 1, limit
, string
);
1139 /* Make CPOS point to the last character of
1140 match. Note that BLEN is byte-length. */
1145 cpos
= BYTE_TO_CHAR (bpos
) - 1;
1147 cpos
= string_byte_to_char (string
, bpos
) - 1;
1149 back
= cpos
- (charpos
- back
);
1150 if (cmp_it
->stop_pos
< cpos
1151 || (cmp_it
->stop_pos
== cpos
1152 && cmp_it
->lookback
< back
))
1154 cmp_it
->rule_idx
= ridx
;
1155 cmp_it
->stop_pos
= cpos
;
1157 cmp_it
->lookback
= back
;
1158 cmp_it
->nchars
= back
+ 1;
1164 if (charpos
- 1 == endpos
)
1166 if (STRINGP (string
))
1169 while (! CHAR_HEAD_P (*p
))
1175 DEC_BOTH (charpos
, bytepos
);
1176 p
= BYTE_POS_ADDR (bytepos
);
1178 c
= STRING_CHAR (p
);
1180 if (cmp_it
->ch
>= 0)
1181 /* We found a position to check. */
1183 /* Skip all uncomposable characters. */
1186 while (charpos
- 1 > endpos
&& ! CHAR_COMPOSABLE_P (c
))
1188 DEC_BOTH (charpos
, bytepos
);
1189 c
= FETCH_MULTIBYTE_CHAR (bytepos
);
1194 while (charpos
- 1 > endpos
&& ! CHAR_COMPOSABLE_P (c
))
1197 while (! CHAR_HEAD_P (*p
))
1200 c
= STRING_CHAR (p
);
1204 cmp_it
->stop_pos
= charpos
;
1207 /* Check if the character at CHARPOS (and BYTEPOS) is composed
1208 (possibly with the following characters) on window W. ENDPOS limits
1209 characters to be composed. FACE, in non-NULL, is a base face of
1210 the character. If STRING is not nil, it is a string containing the
1211 character to check, and CHARPOS and BYTEPOS are indices in the
1212 string. In that case, FACE must not be NULL.
1214 If the character is composed, setup members of CMP_IT (id, nglyphs,
1215 from, to, reversed_p), and return true. Otherwise, update
1216 CMP_IT->stop_pos, and return false. */
1219 composition_reseat_it (struct composition_it
*cmp_it
, ptrdiff_t charpos
,
1220 ptrdiff_t bytepos
, ptrdiff_t endpos
, struct window
*w
,
1221 struct face
*face
, Lisp_Object string
)
1224 endpos
= NILP (string
) ? BEGV
: 0;
1226 if (cmp_it
->ch
== -2)
1228 composition_compute_stop_pos (cmp_it
, charpos
, bytepos
, endpos
, string
);
1229 if (cmp_it
->ch
== -2 || cmp_it
->stop_pos
!= charpos
)
1230 /* The current position is not composed. */
1236 /* We are looking at a static composition. */
1237 ptrdiff_t start
, end
;
1240 find_composition (charpos
, -1, &start
, &end
, &prop
, string
);
1241 cmp_it
->id
= get_composition_id (charpos
, bytepos
, end
- start
,
1244 goto no_composition
;
1245 cmp_it
->nchars
= end
- start
;
1246 cmp_it
->nglyphs
= composition_table
[cmp_it
->id
]->glyph_len
;
1250 Lisp_Object lgstring
= Qnil
;
1251 Lisp_Object val
, elt
;
1254 val
= CHAR_TABLE_REF (Vcomposition_function_table
, cmp_it
->ch
);
1255 for (i
= 0; i
< cmp_it
->rule_idx
; i
++, val
= XCDR (val
));
1256 if (charpos
< endpos
)
1258 for (; CONSP (val
); val
= XCDR (val
))
1261 if (! VECTORP (elt
) || ASIZE (elt
) != 3
1262 || ! INTEGERP (AREF (elt
, 1)))
1264 if (XFASTINT (AREF (elt
, 1)) != cmp_it
->lookback
)
1265 goto no_composition
;
1266 lgstring
= autocmp_chars (elt
, charpos
, bytepos
, endpos
,
1268 if (composition_gstring_p (lgstring
))
1271 /* Composition failed perhaps because the font doesn't
1272 support sufficient range of characters. Try the
1273 other composition rules if any. */
1275 cmp_it
->reversed_p
= 0;
1279 ptrdiff_t cpos
= charpos
, bpos
= bytepos
;
1284 if (cmp_it
->lookback
> 0)
1286 cpos
= charpos
- cmp_it
->lookback
;
1287 if (STRINGP (string
))
1288 bpos
= string_char_to_byte (string
, cpos
);
1290 bpos
= CHAR_TO_BYTE (cpos
);
1292 lgstring
= autocmp_chars (elt
, cpos
, bpos
, charpos
+ 1, w
, face
,
1294 if (composition_gstring_p (lgstring
)
1295 && cpos
+ LGSTRING_CHAR_LEN (lgstring
) - 1 == charpos
)
1297 /* Composition failed or didn't cover the current
1299 if (cmp_it
->lookback
== 0)
1300 goto no_composition
;
1302 /* Try to find a shorter composition that starts after CPOS. */
1303 composition_compute_stop_pos (cmp_it
, charpos
, bytepos
, cpos
,
1305 if (cmp_it
->ch
== -2 || cmp_it
->stop_pos
< charpos
)
1306 goto no_composition
;
1307 val
= CHAR_TABLE_REF (Vcomposition_function_table
, cmp_it
->ch
);
1308 for (i
= 0; i
< cmp_it
->rule_idx
; i
++, val
= XCDR (val
));
1310 cmp_it
->reversed_p
= 1;
1312 if (NILP (lgstring
))
1313 goto no_composition
;
1314 if (NILP (LGSTRING_ID (lgstring
)))
1315 lgstring
= composition_gstring_put_cache (lgstring
, -1);
1316 cmp_it
->id
= XINT (LGSTRING_ID (lgstring
));
1317 for (i
= 0; i
< LGSTRING_GLYPH_LEN (lgstring
); i
++)
1318 if (NILP (LGSTRING_GLYPH (lgstring
, i
)))
1320 cmp_it
->nglyphs
= i
;
1325 goto no_composition
;
1329 if (charpos
== endpos
)
1331 if (charpos
< endpos
)
1337 bytepos
+= BYTES_BY_CHAR_HEAD (*(SDATA (string
) + bytepos
));
1342 /* BYTEPOS is calculated in composition_compute_stop_pos */
1345 composition_compute_stop_pos (cmp_it
, charpos
, bytepos
, endpos
, string
);
1349 /* Update charpos, nchars, nbytes, and width of the current grapheme
1352 If the composition is static or automatic in L2R context, the
1353 cluster is identified by CMP_IT->from, and CHARPOS is the position
1354 of the first character of the cluster. In this case, update
1357 If the composition is automatic in R2L context, the cluster is
1358 identified by CMP_IT->to, and CHARPOS is the position of the last
1359 character of the cluster. In this case, update CMP_IT->from too.
1361 The return value is the character code of the first character of
1362 the cluster, or -1 if the composition is somehow broken. */
1365 composition_update_it (struct composition_it
*cmp_it
, ptrdiff_t charpos
, ptrdiff_t bytepos
, Lisp_Object string
)
1367 int i
, c
IF_LINT (= 0);
1371 /* static composition */
1372 struct composition
*cmp
= composition_table
[cmp_it
->id
];
1374 cmp_it
->charpos
= charpos
;
1375 cmp_it
->to
= cmp_it
->nglyphs
;
1376 if (cmp_it
->nglyphs
== 0)
1380 for (i
= 0; i
< cmp
->glyph_len
; i
++)
1381 /* TAB in a composition means display glyphs with padding
1382 space on the left or right. */
1383 if ((c
= COMPOSITION_GLYPH (cmp
, i
)) != '\t')
1388 cmp_it
->width
= cmp
->width
;
1389 charpos
+= cmp_it
->nchars
;
1390 if (STRINGP (string
))
1391 cmp_it
->nbytes
= string_char_to_byte (string
, charpos
) - bytepos
;
1393 cmp_it
->nbytes
= CHAR_TO_BYTE (charpos
) - bytepos
;
1397 /* automatic composition */
1398 Lisp_Object gstring
= composition_gstring_from_id (cmp_it
->id
);
1402 if (cmp_it
->nglyphs
== 0)
1404 cmp_it
->nchars
= LGSTRING_CHAR_LEN (gstring
);
1406 cmp_it
->from
= cmp_it
->to
= 0;
1409 if (! cmp_it
->reversed_p
)
1411 glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->from
);
1412 from
= LGLYPH_FROM (glyph
);
1413 for (cmp_it
->to
= cmp_it
->from
+ 1; cmp_it
->to
< cmp_it
->nglyphs
;
1416 glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->to
);
1417 if (LGLYPH_FROM (glyph
) != from
)
1420 cmp_it
->charpos
= charpos
;
1424 glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->to
- 1);
1425 from
= LGLYPH_FROM (glyph
);
1426 cmp_it
->charpos
= charpos
- (LGLYPH_TO (glyph
) - from
);
1427 for (cmp_it
->from
= cmp_it
->to
- 1; cmp_it
->from
> 0;
1430 glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->from
- 1);
1431 if (LGLYPH_FROM (glyph
) != from
)
1435 glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->from
);
1436 cmp_it
->nchars
= LGLYPH_TO (glyph
) + 1 - from
;
1439 for (i
= cmp_it
->nchars
- 1; i
>= 0; i
--)
1441 c
= XINT (LGSTRING_CHAR (gstring
, i
));
1442 cmp_it
->nbytes
+= CHAR_BYTES (c
);
1443 cmp_it
->width
+= CHAR_WIDTH (c
);
1450 struct position_record
1452 ptrdiff_t pos
, pos_byte
;
1456 /* Update the members of POSITION to the next character boundary. */
1457 #define FORWARD_CHAR(POSITION, STOP) \
1460 if ((POSITION).pos == (STOP)) \
1462 (POSITION).p = GAP_END_ADDR; \
1463 (POSITION).pos_byte = GPT_BYTE; \
1467 (POSITION).pos_byte += BYTES_BY_CHAR_HEAD (*((POSITION).p)); \
1468 (POSITION).p += BYTES_BY_CHAR_HEAD (*((POSITION).p)); \
1472 /* Update the members of POSITION to the previous character boundary. */
1473 #define BACKWARD_CHAR(POSITION, STOP) \
1475 if ((POSITION).pos == (STOP)) \
1476 (POSITION).p = GPT_ADDR; \
1478 (POSITION).pos_byte--; \
1480 } while (! CHAR_HEAD_P (*((POSITION).p))); \
1484 /* This is like find_composition, but find an automatic composition
1485 instead. It is assured that POS is not within a static
1486 composition. If found, set *GSTRING to the glyph-string
1487 representing the composition, and return true. Otherwise, *GSTRING to
1488 Qnil, and return false. */
1491 find_automatic_composition (ptrdiff_t pos
, ptrdiff_t limit
,
1492 ptrdiff_t *start
, ptrdiff_t *end
,
1493 Lisp_Object
*gstring
, Lisp_Object string
)
1495 ptrdiff_t head
, tail
, stop
;
1496 /* Forward limit position of checking a composition taking a
1497 looking-back count into account. */
1498 ptrdiff_t fore_check_limit
;
1499 struct position_record cur
, prev
;
1503 bool need_adjustment
= 0;
1505 window
= Fget_buffer_window (Fcurrent_buffer (), Qnil
);
1508 w
= XWINDOW (window
);
1513 head
= BEGV
, tail
= ZV
, stop
= GPT
;
1514 cur
.pos_byte
= CHAR_TO_BYTE (cur
.pos
);
1515 cur
.p
= BYTE_POS_ADDR (cur
.pos_byte
);
1519 head
= 0, tail
= SCHARS (string
), stop
= -1;
1520 cur
.pos_byte
= string_char_to_byte (string
, cur
.pos
);
1521 cur
.p
= SDATA (string
) + cur
.pos_byte
;
1524 /* Finding a composition covering the character after POS is the
1525 same as setting LIMIT to POS. */
1528 fore_check_limit
= min (tail
, pos
+ 1 + MAX_AUTO_COMPOSITION_LOOKBACK
);
1530 fore_check_limit
= min (tail
, limit
+ MAX_AUTO_COMPOSITION_LOOKBACK
);
1532 /* Provided that we have these possible compositions now:
1534 POS: 1 2 3 4 5 6 7 8 9
1538 Here, it is known that characters after positions 1 and 9 can
1539 never be composed (i.e. ! CHAR_COMPOSABLE_P (CH)), and
1540 composition A is an invalid one because it's partially covered by
1541 the valid composition C. And to know whether a composition is
1542 valid or not, the only way is to start searching forward from a
1543 position that can not be a tail part of composition (it's 2 in
1546 Now we have these cases (1 through 4):
1548 -- character after POS is ... --
1549 not composable composable
1550 LIMIT <= POS (1) (3)
1553 Among them, in case (2), we simply search forward from POS.
1555 In the other cases, we at first rewind back to the position where
1556 the previous character is not composable or the beginning of
1557 buffer (string), then search compositions forward. In case (1)
1558 and (3) we repeat this process until a composition is found. */
1562 c
= STRING_CHAR (cur
.p
);
1563 if (! CHAR_COMPOSABLE_P (c
))
1565 if (limit
<= pos
) /* case (1) */
1568 if (cur
.pos
<= limit
)
1570 BACKWARD_CHAR (cur
, stop
);
1571 c
= STRING_CHAR (cur
.p
);
1572 } while (! CHAR_COMPOSABLE_P (c
));
1573 fore_check_limit
= cur
.pos
+ 1;
1576 /* No need of rewinding back. */
1577 goto search_forward
;
1580 /* Rewind back to the position where we can safely search
1581 forward for compositions. It is assured that the character
1582 at cur.pos is composable. */
1583 while (head
< cur
.pos
)
1586 BACKWARD_CHAR (cur
, stop
);
1587 c
= STRING_CHAR (cur
.p
);
1588 if (! CHAR_COMPOSABLE_P (c
))
1596 /* Now search forward. */
1598 prev
= cur
; /* remember the start of searching position. */
1599 while (cur
.pos
< fore_check_limit
)
1603 c
= STRING_CHAR (cur
.p
);
1604 for (val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1605 CONSP (val
); val
= XCDR (val
))
1607 Lisp_Object elt
= XCAR (val
);
1609 if (VECTORP (elt
) && ASIZE (elt
) == 3 && NATNUMP (AREF (elt
, 1)))
1611 EMACS_INT check_pos
= cur
.pos
- XFASTINT (AREF (elt
, 1));
1612 struct position_record check
;
1614 if (check_pos
< head
1615 || (limit
<= pos
? pos
< check_pos
1616 : limit
<= check_pos
))
1618 for (check
= cur
; check_pos
< check
.pos
; )
1619 BACKWARD_CHAR (check
, stop
);
1620 *gstring
= autocmp_chars (elt
, check
.pos
, check
.pos_byte
,
1621 tail
, w
, NULL
, string
);
1622 need_adjustment
= 1;
1623 if (NILP (*gstring
))
1625 /* As we have called Lisp, there's a possibility
1626 that buffer/string is relocated. */
1628 cur
.p
= BYTE_POS_ADDR (cur
.pos_byte
);
1630 cur
.p
= SDATA (string
) + cur
.pos_byte
;
1634 /* We found a candidate of a target composition. */
1636 *end
= check
.pos
+ LGSTRING_CHAR_LEN (*gstring
);
1639 : *start
<= pos
&& pos
< *end
)
1640 /* This is the target composition. */
1645 cur
.pos_byte
= CHAR_TO_BYTE (cur
.pos
);
1646 cur
.p
= BYTE_POS_ADDR (cur
.pos_byte
);
1650 cur
.pos_byte
= string_char_to_byte (string
, cur
.pos
);
1651 cur
.p
= SDATA (string
) + cur
.pos_byte
;
1658 /* We found no composition here. */
1659 FORWARD_CHAR (cur
, stop
);
1662 if (pos
< limit
) /* case (2) and (4)*/
1664 if (! NILP (*gstring
))
1666 if (prev
.pos
== head
)
1669 if (need_adjustment
)
1672 cur
.p
= BYTE_POS_ADDR (cur
.pos_byte
);
1674 cur
.p
= SDATA (string
) + cur
.pos_byte
;
1676 BACKWARD_CHAR (cur
, stop
);
1680 /* Return the adjusted point provided that point is moved from LAST_PT
1684 composition_adjust_point (ptrdiff_t last_pt
, ptrdiff_t new_pt
)
1686 ptrdiff_t i
, beg
, end
;
1689 if (new_pt
== BEGV
|| new_pt
== ZV
)
1692 /* At first check the static composition. */
1693 if (get_property_and_range (new_pt
, Qcomposition
, &val
, &beg
, &end
, Qnil
)
1694 && COMPOSITION_VALID_P (beg
, end
, val
))
1696 if (beg
< new_pt
/* && end > new_pt <- It's always the case. */
1697 && (last_pt
<= beg
|| last_pt
>= end
))
1698 return (new_pt
< last_pt
? beg
: end
);
1702 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
))
1703 || NILP (Vauto_composition_mode
))
1706 /* Next check the automatic composition. */
1707 if (! find_automatic_composition (new_pt
, (ptrdiff_t) -1, &beg
, &end
, &val
,
1711 for (i
= 0; i
< LGSTRING_GLYPH_LEN (val
); i
++)
1713 Lisp_Object glyph
= LGSTRING_GLYPH (val
, i
);
1717 if (beg
+ LGLYPH_FROM (glyph
) == new_pt
)
1719 if (beg
+ LGLYPH_TO (glyph
) >= new_pt
)
1720 return (new_pt
< last_pt
1721 ? beg
+ LGLYPH_FROM (glyph
)
1722 : beg
+ LGLYPH_TO (glyph
) + 1);
1727 DEFUN ("composition-get-gstring", Fcomposition_get_gstring
,
1728 Scomposition_get_gstring
, 4, 4, 0,
1729 doc
: /* Return a glyph-string for characters between FROM and TO.
1730 If the glyph string is for graphic display, FONT-OBJECT must be
1731 a font-object to use for those characters.
1732 Otherwise (for terminal display), FONT-OBJECT must be a terminal ID, a
1733 frame, or nil for the selected frame's terminal device.
1735 If the optional 4th argument STRING is not nil, it is a string
1736 containing the target characters between indices FROM and TO.
1738 A glyph-string is a vector containing information about how to display
1739 a specific character sequence. The format is:
1740 [HEADER ID GLYPH ...]
1742 HEADER is a vector of this form:
1743 [FONT-OBJECT CHAR ...]
1745 FONT-OBJECT is a font-object for all glyphs in the glyph-string,
1746 or the terminal coding system of the specified terminal.
1747 CHARs are characters to be composed by GLYPHs.
1749 ID is an identification number of the glyph-string. It may be nil if
1752 GLYPH is a vector whose elements have this form:
1753 [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT
1754 [ [X-OFF Y-OFF WADJUST] | nil] ]
1756 FROM-IDX and TO-IDX are used internally and should not be touched.
1757 C is the character of the glyph.
1758 CODE is the glyph-code of C in FONT-OBJECT.
1759 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
1760 X-OFF and Y-OFF are offsets to the base position for the glyph.
1761 WADJUST is the adjustment to the normal width of the glyph.
1763 If GLYPH is nil, the remaining elements of the glyph-string vector
1764 should be ignored. */)
1765 (Lisp_Object from
, Lisp_Object to
, Lisp_Object font_object
, Lisp_Object string
)
1767 Lisp_Object gstring
, header
;
1768 ptrdiff_t frompos
, topos
;
1770 CHECK_NATNUM (from
);
1772 if (! FONT_OBJECT_P (font_object
))
1774 struct coding_system
*coding
;
1775 struct terminal
*terminal
= get_terminal (font_object
, 1);
1777 coding
= ((TERMINAL_TERMINAL_CODING (terminal
)->common_flags
1778 & CODING_REQUIRE_ENCODING_MASK
)
1779 ? TERMINAL_TERMINAL_CODING (terminal
) : &safe_terminal_coding
);
1780 font_object
= CODING_ID_NAME (coding
->id
);
1783 header
= fill_gstring_header (Qnil
, from
, to
, font_object
, string
);
1784 gstring
= gstring_lookup_cache (header
);
1785 if (! NILP (gstring
))
1788 frompos
= XINT (from
);
1790 if (LGSTRING_GLYPH_LEN (gstring_work
) < topos
- frompos
)
1791 gstring_work
= Fmake_vector (make_number (topos
- frompos
+ 2), Qnil
);
1792 LGSTRING_SET_HEADER (gstring_work
, header
);
1793 LGSTRING_SET_ID (gstring_work
, Qnil
);
1794 fill_gstring_body (gstring_work
);
1795 return gstring_work
;
1799 /* Emacs Lisp APIs. */
1801 DEFUN ("compose-region-internal", Fcompose_region_internal
,
1802 Scompose_region_internal
, 2, 4, 0,
1803 doc
: /* Internal use only.
1805 Compose text in the region between START and END.
1806 Optional 3rd and 4th arguments are COMPONENTS and MODIFICATION-FUNC
1807 for the composition. See `compose-region' for more details. */)
1808 (Lisp_Object start
, Lisp_Object end
, Lisp_Object components
, Lisp_Object modification_func
)
1810 validate_region (&start
, &end
);
1811 if (!NILP (components
)
1812 && !INTEGERP (components
)
1813 && !CONSP (components
)
1814 && !STRINGP (components
))
1815 CHECK_VECTOR (components
);
1817 compose_text (XINT (start
), XINT (end
), components
, modification_func
, Qnil
);
1821 DEFUN ("compose-string-internal", Fcompose_string_internal
,
1822 Scompose_string_internal
, 3, 5, 0,
1823 doc
: /* Internal use only.
1825 Compose text between indices START and END of STRING.
1826 Optional 4th and 5th arguments are COMPONENTS and MODIFICATION-FUNC
1827 for the composition. See `compose-string' for more details. */)
1828 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
, Lisp_Object components
, Lisp_Object modification_func
)
1830 CHECK_STRING (string
);
1831 CHECK_NUMBER (start
);
1834 if (XINT (start
) < 0 ||
1835 XINT (start
) > XINT (end
)
1836 || XINT (end
) > SCHARS (string
))
1837 args_out_of_range (start
, end
);
1839 compose_text (XINT (start
), XINT (end
), components
, modification_func
, string
);
1843 DEFUN ("find-composition-internal", Ffind_composition_internal
,
1844 Sfind_composition_internal
, 4, 4, 0,
1845 doc
: /* Internal use only.
1847 Return information about composition at or nearest to position POS.
1848 See `find-composition' for more details. */)
1849 (Lisp_Object pos
, Lisp_Object limit
, Lisp_Object string
, Lisp_Object detail_p
)
1851 Lisp_Object prop
, tail
, gstring
;
1852 ptrdiff_t start
, end
, from
, to
;
1855 CHECK_NUMBER_COERCE_MARKER (pos
);
1858 CHECK_NUMBER_COERCE_MARKER (limit
);
1859 to
= min (XINT (limit
), ZV
);
1866 CHECK_STRING (string
);
1867 if (XINT (pos
) < 0 || XINT (pos
) > SCHARS (string
))
1868 args_out_of_range (string
, pos
);
1872 if (XINT (pos
) < BEGV
|| XINT (pos
) > ZV
)
1873 args_out_of_range (Fcurrent_buffer (), pos
);
1877 if (!find_composition (from
, to
, &start
, &end
, &prop
, string
))
1879 if (!NILP (BVAR (current_buffer
, enable_multibyte_characters
))
1880 && ! NILP (Vauto_composition_mode
)
1881 && find_automatic_composition (from
, to
, &start
, &end
, &gstring
,
1883 return list3 (make_number (start
), make_number (end
), gstring
);
1886 if ((end
<= XINT (pos
) || start
> XINT (pos
)))
1890 if (find_automatic_composition (from
, to
, &s
, &e
, &gstring
, string
)
1891 && (e
<= XINT (pos
) ? e
> end
: s
< start
))
1892 return list3 (make_number (s
), make_number (e
), gstring
);
1894 if (!COMPOSITION_VALID_P (start
, end
, prop
))
1895 return Fcons (make_number (start
), Fcons (make_number (end
),
1896 Fcons (Qnil
, Qnil
)));
1897 if (NILP (detail_p
))
1898 return Fcons (make_number (start
), Fcons (make_number (end
),
1901 if (COMPOSITION_REGISTERD_P (prop
))
1902 id
= COMPOSITION_ID (prop
);
1905 ptrdiff_t start_byte
= (NILP (string
)
1906 ? CHAR_TO_BYTE (start
)
1907 : string_char_to_byte (string
, start
));
1908 id
= get_composition_id (start
, start_byte
, end
- start
, prop
, string
);
1913 Lisp_Object components
, relative_p
, mod_func
;
1914 enum composition_method method
= COMPOSITION_METHOD (prop
);
1915 int width
= composition_table
[id
]->width
;
1917 components
= Fcopy_sequence (COMPOSITION_COMPONENTS (prop
));
1918 relative_p
= (method
== COMPOSITION_WITH_RULE_ALTCHARS
1920 mod_func
= COMPOSITION_MODIFICATION_FUNC (prop
);
1921 tail
= Fcons (components
,
1924 Fcons (make_number (width
), Qnil
))));
1929 return Fcons (make_number (start
), Fcons (make_number (end
), tail
));
1934 syms_of_composite (void)
1938 DEFSYM (Qcomposition
, "composition");
1940 /* Make a hash table for static composition. */
1942 Lisp_Object args
[6];
1946 args
[2] = QCweakness
;
1947 /* We used to make the hash table weak so that unreferenced
1948 compositions can be garbage-collected. But, usually once
1949 created compositions are repeatedly used in an Emacs session,
1950 and thus it's not worth to save memory in such a way. So, we
1951 make the table not weak. */
1954 args
[5] = make_number (311);
1955 composition_hash_table
= Fmake_hash_table (6, args
);
1956 staticpro (&composition_hash_table
);
1959 /* Make a hash table for glyph-string. */
1961 Lisp_Object args
[6];
1964 args
[2] = QCweakness
;
1967 args
[5] = make_number (311);
1968 gstring_hash_table
= Fmake_hash_table (6, args
);
1969 staticpro (&gstring_hash_table
);
1972 staticpro (&gstring_work_headers
);
1973 gstring_work_headers
= Fmake_vector (make_number (8), Qnil
);
1974 for (i
= 0; i
< 8; i
++)
1975 ASET (gstring_work_headers
, i
, Fmake_vector (make_number (i
+ 2), Qnil
));
1976 staticpro (&gstring_work
);
1977 gstring_work
= Fmake_vector (make_number (10), Qnil
);
1979 /* Text property `composition' should be nonsticky by default. */
1980 Vtext_property_default_nonsticky
1981 = Fcons (Fcons (Qcomposition
, Qt
), Vtext_property_default_nonsticky
);
1983 DEFVAR_LISP ("compose-chars-after-function", Vcompose_chars_after_function
,
1984 doc
: /* Function to adjust composition of buffer text.
1986 This function is called with three arguments: FROM, TO, and OBJECT.
1987 FROM and TO specify the range of text whose composition should be
1988 adjusted. OBJECT, if non-nil, is a string that contains the text.
1990 This function is called after a text with `composition' property is
1991 inserted or deleted to keep `composition' property of buffer text
1994 The default value is the function `compose-chars-after'. */);
1995 Vcompose_chars_after_function
= intern_c_string ("compose-chars-after");
1997 DEFSYM (Qauto_composed
, "auto-composed");
1998 DEFSYM (Qauto_composition_function
, "auto-composition-function");
2000 DEFVAR_LISP ("auto-composition-mode", Vauto_composition_mode
,
2001 doc
: /* Non-nil if Auto-Composition mode is enabled.
2002 Use the command `auto-composition-mode' to change this variable. */);
2003 Vauto_composition_mode
= Qt
;
2005 DEFVAR_LISP ("auto-composition-function", Vauto_composition_function
,
2006 doc
: /* Function to call to compose characters automatically.
2007 This function is called from the display routine with four arguments:
2008 FROM, TO, WINDOW, and STRING.
2010 If STRING is nil, the function must compose characters in the region
2011 between FROM and TO in the current buffer.
2013 Otherwise, STRING is a string, and FROM and TO are indices into the
2014 string. In this case, the function must compose characters in the
2016 Vauto_composition_function
= Qnil
;
2018 DEFVAR_LISP ("composition-function-table", Vcomposition_function_table
,
2019 doc
: /* Char-table of functions for automatic character composition.
2020 For each character that has to be composed automatically with
2021 preceding and/or following characters, this char-table contains
2022 a function to call to compose that character.
2024 The element at index C in the table, if non-nil, is a list of
2025 composition rules of this form: ([PATTERN PREV-CHARS FUNC] ...)
2027 PATTERN is a regular expression which C and the surrounding
2028 characters must match.
2030 PREV-CHARS is a non-negative integer (less than 4) specifying how many
2031 characters before C to check the matching with PATTERN. If it is 0,
2032 PATTERN must match C and the following characters. If it is 1,
2033 PATTERN must match a character before C and the following characters.
2035 If PREV-CHARS is 0, PATTERN can be nil, which means that the
2036 single character C should be composed.
2038 FUNC is a function to return a glyph-string representing a
2039 composition of the characters that match PATTERN. It is
2040 called with one argument GSTRING.
2042 GSTRING is a template of a glyph-string to return. It is already
2043 filled with a proper header for the characters to compose, and
2044 glyphs corresponding to those characters one by one. The
2045 function must return a new glyph-string with the same header as
2046 GSTRING, or modify GSTRING itself and return it.
2048 See also the documentation of `auto-composition-mode'. */);
2049 Vcomposition_function_table
= Fmake_char_table (Qnil
, Qnil
);
2051 defsubr (&Scompose_region_internal
);
2052 defsubr (&Scompose_string_internal
);
2053 defsubr (&Sfind_composition_internal
);
2054 defsubr (&Scomposition_get_gstring
);