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/>. */
28 #include "character.h"
31 #include "intervals.h"
34 #include "dispextern.h"
36 #include "termhooks.h"
39 /* Emacs uses special text property `composition' to support character
40 composition. A sequence of characters that have the same (i.e. eq)
41 `composition' property value is treated as a single composite
42 sequence (we call it just `composition' here after). Characters in
43 a composition are all composed somehow on the screen.
45 The property value has this form when the composition is made:
46 ((LENGTH . COMPONENTS) . MODIFICATION-FUNC)
47 then turns to this form:
48 (COMPOSITION-ID . (LENGTH COMPONENTS-VEC . MODIFICATION-FUNC))
49 when the composition is registered in composition_hash_table and
50 composition_table. These rather peculiar structures were designed
51 to make it easy to distinguish them quickly (we can do that by
52 checking only the first element) and to extract LENGTH (from the
53 former form) and COMPOSITION-ID (from the latter form).
55 We register a composition when it is displayed, or when the width
56 is required (for instance, to calculate columns).
58 LENGTH -- Length of the composition. This information is used to
59 check the validity of the composition.
61 COMPONENTS -- Character, string, vector, list, or nil.
63 If it is nil, characters in the text are composed relatively
64 according to their metrics in font glyphs.
66 If it is a character or a string, the character or characters
67 in the string are composed relatively.
69 If it is a vector or list of integers, the element is a
70 character or an encoded composition rule. The characters are
71 composed according to the rules. (2N)th elements are
72 characters to be composed and (2N+1)th elements are
73 composition rules to tell how to compose (2N+2)th element with
74 the previously composed 2N glyphs.
76 COMPONENTS-VEC -- Vector of integers. In a relative composition,
77 the elements are the characters to be composed. In a rule-base
78 composition, the elements are characters or encoded
81 MODIFICATION-FUNC -- If non nil, it is a function to call when the
82 composition gets invalid after a modification in a buffer. If
83 it is nil, a function in `composition-function-table' of the
84 first character in the sequence is called.
86 COMPOSITION-ID --Identification number of the composition. It is
87 used as an index to composition_table for the composition.
89 When Emacs has to display a composition or has to know its
90 displaying width, the function get_composition_id is called. It
91 returns COMPOSITION-ID so that the caller can access the
92 information about the composition through composition_table. If a
93 COMPOSITION-ID has not yet been assigned to the composition,
94 get_composition_id checks the validity of `composition' property,
95 and, if valid, assigns a new ID, registers the information in
96 composition_hash_table and composition_table, and changes the form
97 of the property value. If the property is invalid,
98 get_composition_id returns -1 without changing the property value.
100 We use two tables to keep the information about composition;
101 composition_hash_table and composition_table.
103 The former is a hash table whose keys are COMPONENTS-VECs and
104 values are the corresponding COMPOSITION-IDs. This hash table is
105 weak, but as each key (COMPONENTS-VEC) is also kept as a value of the
106 `composition' property, it won't be collected as garbage until all
107 bits of text that have the same COMPONENTS-VEC are deleted.
109 The latter is a table of pointers to `struct composition' indexed
110 by COMPOSITION-ID. This structure keeps the other information (see
113 In general, a text property holds information about individual
114 characters. But, a `composition' property holds information about
115 a sequence of characters (in this sense, it is like the `intangible'
116 property). That means that we should not share the property value
117 in adjacent compositions -- we can't distinguish them if they have the
118 same property. So, after any changes, we call
119 `update_compositions' and change a property of one of adjacent
120 compositions to a copy of it. This function also runs a proper
121 composition modification function to make a composition that gets
122 invalid by the change valid again.
124 As the value of the `composition' property holds information about a
125 specific range of text, the value gets invalid if we change the
126 text in the range. We treat the `composition' property as always
127 rear-nonsticky (currently by setting default-text-properties to
128 (rear-nonsticky (composition))) and we never make properties of
129 adjacent compositions identical. Thus, any such changes make the
130 range just shorter. So, we can check the validity of the `composition'
131 property by comparing LENGTH information with the actual length of
137 Lisp_Object Qcomposition
;
139 /* Table of pointers to the structure `composition' indexed by
140 COMPOSITION-ID. This structure is for storing information about
141 each composition except for COMPONENTS-VEC. */
142 struct composition
**composition_table
;
144 /* The current size of `composition_table'. */
145 static ptrdiff_t composition_table_size
;
147 /* Number of compositions currently made. */
148 ptrdiff_t n_compositions
;
150 /* Hash table for compositions. The key is COMPONENTS-VEC of
151 `composition' property. The value is the corresponding
153 Lisp_Object composition_hash_table
;
155 static Lisp_Object Qauto_composed
;
156 static Lisp_Object Qauto_composition_function
;
157 /* Maximum number of characters to look back for
158 auto-compositions. */
159 #define MAX_AUTO_COMPOSITION_LOOKBACK 3
161 /* Temporary variable used in macros COMPOSITION_XXX. */
162 Lisp_Object composition_temp
;
165 /* Return COMPOSITION-ID of a composition at buffer position
166 CHARPOS/BYTEPOS and length NCHARS. The `composition' property of
167 the sequence is PROP. STRING, if non-nil, is a string that
168 contains the composition instead of the current buffer.
170 If the composition is invalid, return -1. */
173 get_composition_id (ptrdiff_t charpos
, ptrdiff_t bytepos
, ptrdiff_t nchars
,
174 Lisp_Object prop
, Lisp_Object string
)
176 Lisp_Object id
, length
, components
, key
, *key_contents
;
178 struct Lisp_Hash_Table
*hash_table
= XHASH_TABLE (composition_hash_table
);
179 ptrdiff_t hash_index
;
180 EMACS_UINT hash_code
;
181 enum composition_method method
;
182 struct composition
*cmp
;
186 /* Maximum length of a string of glyphs. XftGlyphExtents limits
187 this to INT_MAX, and Emacs limits it further. Divide INT_MAX - 1
188 by 2 because x_produce_glyphs computes glyph_len * 2 + 1. Divide
189 the size by MAX_MULTIBYTE_LENGTH because encode_terminal_code
190 multiplies glyph_len by MAX_MULTIBYTE_LENGTH. */
192 GLYPH_LEN_MAX
= min ((INT_MAX
- 1) / 2,
193 min (PTRDIFF_MAX
, SIZE_MAX
) / MAX_MULTIBYTE_LENGTH
)
197 Form-A: ((LENGTH . COMPONENTS) . MODIFICATION-FUNC)
199 Form-B: (COMPOSITION-ID . (LENGTH COMPONENTS-VEC . MODIFICATION-FUNC))
201 if (nchars
== 0 || !CONSP (prop
))
202 goto invalid_composition
;
207 /* PROP should be Form-B. */
208 if (XINT (id
) < 0 || XINT (id
) >= n_compositions
)
209 goto invalid_composition
;
213 /* PROP should be Form-A.
214 Thus, ID should be (LENGTH . COMPONENTS). */
216 goto invalid_composition
;
218 if (!INTEGERP (length
) || XINT (length
) != nchars
)
219 goto invalid_composition
;
221 components
= XCDR (id
);
223 /* Check if the same composition has already been registered or not
224 by consulting composition_hash_table. The key for this table is
225 COMPONENTS (converted to a vector COMPONENTS-VEC) or, if it is
226 nil, vector of characters in the composition range. */
227 if (INTEGERP (components
))
228 key
= Fmake_vector (make_number (1), components
);
229 else if (STRINGP (components
) || CONSP (components
))
230 key
= Fvconcat (1, &components
);
231 else if (VECTORP (components
))
233 else if (NILP (components
))
235 key
= Fmake_vector (make_number (nchars
), Qnil
);
236 if (STRINGP (string
))
237 for (i
= 0; i
< nchars
; i
++)
239 FETCH_STRING_CHAR_ADVANCE (ch
, string
, charpos
, bytepos
);
240 ASET (key
, i
, make_number (ch
));
243 for (i
= 0; i
< nchars
; i
++)
245 FETCH_CHAR_ADVANCE (ch
, charpos
, bytepos
);
246 ASET (key
, i
, make_number (ch
));
250 goto invalid_composition
;
252 hash_index
= hash_lookup (hash_table
, key
, &hash_code
);
255 /* We have already registered the same composition. Change PROP
256 from Form-A above to Form-B while replacing COMPONENTS with
257 COMPONENTS-VEC stored in the hash table. We can directly
258 modify the cons cell of PROP because it is not shared. */
259 key
= HASH_KEY (hash_table
, hash_index
);
260 id
= HASH_VALUE (hash_table
, hash_index
);
262 XSETCDR (prop
, Fcons (make_number (nchars
), Fcons (key
, XCDR (prop
))));
266 /* This composition is a new one. We must register it. */
268 /* Check if we have sufficient memory to store this information. */
269 if (composition_table_size
<= n_compositions
)
270 composition_table
= xpalloc (composition_table
, &composition_table_size
,
271 1, -1, sizeof *composition_table
);
273 key_contents
= XVECTOR (key
)->contents
;
275 /* Check if the contents of COMPONENTS are valid if COMPONENTS is a
276 vector or a list. It should be a sequence of:
277 char1 rule1 char2 rule2 char3 ... ruleN charN+1 */
279 if (VECTORP (components
)
280 && ASIZE (components
) >= 2
281 && VECTORP (AREF (components
, 0)))
283 /* COMPONENTS is a glyph-string. */
284 ptrdiff_t len
= ASIZE (key
);
286 for (i
= 1; i
< len
; i
++)
287 if (! VECTORP (AREF (key
, i
)))
288 goto invalid_composition
;
290 else if (VECTORP (components
) || CONSP (components
))
292 ptrdiff_t len
= ASIZE (key
);
294 /* The number of elements should be odd. */
296 goto invalid_composition
;
297 /* All elements should be integers (character or encoded
298 composition rule). */
299 for (i
= 0; i
< len
; i
++)
301 if (!INTEGERP (key_contents
[i
]))
302 goto invalid_composition
;
306 /* Change PROP from Form-A above to Form-B. We can directly modify
307 the cons cell of PROP because it is not shared. */
308 XSETFASTINT (id
, n_compositions
);
310 XSETCDR (prop
, Fcons (make_number (nchars
), Fcons (key
, XCDR (prop
))));
312 /* Register the composition in composition_hash_table. */
313 hash_index
= hash_put (hash_table
, key
, id
, hash_code
);
315 method
= (NILP (components
)
316 ? COMPOSITION_RELATIVE
317 : ((INTEGERP (components
) || STRINGP (components
))
318 ? COMPOSITION_WITH_ALTCHARS
319 : COMPOSITION_WITH_RULE_ALTCHARS
));
321 glyph_len
= (method
== COMPOSITION_WITH_RULE_ALTCHARS
322 ? (ASIZE (key
) + 1) / 2
325 if (GLYPH_LEN_MAX
< glyph_len
)
326 memory_full (SIZE_MAX
);
328 /* Register the composition in composition_table. */
329 cmp
= (struct composition
*) xmalloc (sizeof (struct composition
));
331 cmp
->method
= method
;
332 cmp
->hash_index
= hash_index
;
333 cmp
->glyph_len
= glyph_len
;
334 cmp
->offsets
= xnmalloc (glyph_len
, 2 * sizeof *cmp
->offsets
);
337 if (cmp
->method
!= COMPOSITION_WITH_RULE_ALTCHARS
)
339 /* Relative composition. */
341 for (i
= 0; i
< glyph_len
; i
++)
344 ch
= XINT (key_contents
[i
]);
345 /* TAB in a composition means display glyphs with padding
346 space on the left or right. */
347 this_width
= (ch
== '\t' ? 1 : CHAR_WIDTH (ch
));
348 if (cmp
->width
< this_width
)
349 cmp
->width
= this_width
;
354 /* Rule-base composition. */
355 double leftmost
= 0.0, rightmost
;
357 ch
= XINT (key_contents
[0]);
358 rightmost
= ch
!= '\t' ? CHAR_WIDTH (ch
) : 1;
360 for (i
= 1; i
< glyph_len
; i
+= 2)
362 int rule
, gref
, nref
;
366 rule
= XINT (key_contents
[i
]);
367 ch
= XINT (key_contents
[i
+ 1]);
368 this_width
= ch
!= '\t' ? CHAR_WIDTH (ch
) : 1;
370 /* A composition rule is specified by an integer value
371 that encodes global and new reference points (GREF and
372 NREF). GREF and NREF are specified by numbers as
380 ---3---4---5--- baseline
384 COMPOSITION_DECODE_REFS (rule
, gref
, nref
);
385 this_left
= (leftmost
386 + (gref
% 3) * (rightmost
- leftmost
) / 2.0
387 - (nref
% 3) * this_width
/ 2.0);
389 if (this_left
< leftmost
)
390 leftmost
= this_left
;
391 if (this_left
+ this_width
> rightmost
)
392 rightmost
= this_left
+ this_width
;
395 cmp
->width
= rightmost
- leftmost
;
396 if (cmp
->width
< (rightmost
- leftmost
))
397 /* To get a ceiling integer value. */
401 composition_table
[n_compositions
] = cmp
;
403 return n_compositions
++;
406 /* Would it be better to remove this `composition' property? */
411 /* Find a static composition at or nearest to position POS of OBJECT
414 OBJECT defaults to the current buffer. If there's a composition at
415 POS, set *START and *END to the start and end of the sequence,
416 *PROP to the `composition' property, and return 1.
418 If there's no composition at POS and LIMIT is negative, return 0.
420 Otherwise, search for a composition forward (LIMIT > POS) or
421 backward (LIMIT < POS). In this case, LIMIT bounds the search.
423 If a composition is found, set *START, *END, and *PROP as above,
424 and return 1, else return 0.
426 This doesn't check the validity of composition. */
429 find_composition (ptrdiff_t pos
, ptrdiff_t limit
,
430 ptrdiff_t *start
, ptrdiff_t *end
,
431 Lisp_Object
*prop
, Lisp_Object object
)
435 if (get_property_and_range (pos
, Qcomposition
, prop
, start
, end
, object
))
438 if (limit
< 0 || limit
== pos
)
441 if (limit
> pos
) /* search forward */
443 val
= Fnext_single_property_change (make_number (pos
), Qcomposition
,
444 object
, make_number (limit
));
449 else /* search backward */
451 if (get_property_and_range (pos
- 1, Qcomposition
, prop
, start
, end
,
454 val
= Fprevious_single_property_change (make_number (pos
), Qcomposition
,
455 object
, make_number (limit
));
461 get_property_and_range (pos
, Qcomposition
, prop
, start
, end
, object
);
465 /* Run a proper function to adjust the composition sitting between
466 FROM and TO with property PROP. */
469 run_composition_function (ptrdiff_t from
, ptrdiff_t to
, Lisp_Object prop
)
472 ptrdiff_t start
, end
;
474 func
= COMPOSITION_MODIFICATION_FUNC (prop
);
475 /* If an invalid composition precedes or follows, try to make them
478 && find_composition (from
- 1, -1, &start
, &end
, &prop
, Qnil
)
479 && !COMPOSITION_VALID_P (start
, end
, prop
))
482 && find_composition (to
, -1, &start
, &end
, &prop
, Qnil
)
483 && !COMPOSITION_VALID_P (start
, end
, prop
))
485 if (!NILP (Ffboundp (func
)))
486 call2 (func
, make_number (from
), make_number (to
));
489 /* Make invalid compositions adjacent to or inside FROM and TO valid.
490 CHECK_MASK is bitwise `or' of mask bits defined by macros
491 CHECK_XXX (see the comment in composite.h).
493 It also resets the text-property `auto-composed' to a proper region
494 so that automatic character composition works correctly later while
495 displaying the region.
497 This function is called when a buffer text is changed. If the
498 change is deletion, FROM == TO. Otherwise, FROM < TO. */
501 update_compositions (ptrdiff_t from
, ptrdiff_t to
, int check_mask
)
504 ptrdiff_t start
, end
;
505 /* The beginning and end of the region to set the property
506 `auto-composed' to nil. */
507 ptrdiff_t min_pos
= from
, max_pos
= to
;
509 if (inhibit_modification_hooks
)
512 /* If FROM and TO are not in a valid range, do nothing. */
513 if (! (BEGV
<= from
&& from
<= to
&& to
<= ZV
))
516 if (check_mask
& CHECK_HEAD
)
518 /* FROM should be at composition boundary. But, insertion or
519 deletion will make two compositions adjacent and
520 indistinguishable when they have same (eq) property. To
521 avoid it, in such a case, we change the property of the
522 latter to the copy of it. */
524 && find_composition (from
- 1, -1, &start
, &end
, &prop
, Qnil
)
525 && COMPOSITION_VALID_P (start
, end
, prop
))
531 Fput_text_property (make_number (from
), make_number (end
),
533 Fcons (XCAR (prop
), XCDR (prop
)), Qnil
);
534 run_composition_function (start
, end
, prop
);
538 && find_composition (from
, -1, &start
, &from
, &prop
, Qnil
)
539 && COMPOSITION_VALID_P (start
, from
, prop
))
543 run_composition_function (start
, from
, prop
);
547 if (check_mask
& CHECK_INSIDE
)
549 /* In this case, we are sure that (check & CHECK_TAIL) is also
550 nonzero. Thus, here we should check only compositions before
553 && find_composition (from
, to
, &start
, &from
, &prop
, Qnil
)
554 && COMPOSITION_VALID_P (start
, from
, prop
)
556 run_composition_function (start
, from
, prop
);
559 if (check_mask
& CHECK_TAIL
)
562 && find_composition (to
- 1, -1, &start
, &end
, &prop
, Qnil
)
563 && COMPOSITION_VALID_P (start
, end
, prop
))
565 /* TO should be also at composition boundary. But,
566 insertion or deletion will make two compositions adjacent
567 and indistinguishable when they have same (eq) property.
568 To avoid it, in such a case, we change the property of
569 the former to the copy of it. */
572 Fput_text_property (make_number (start
), make_number (to
),
574 Fcons (XCAR (prop
), XCDR (prop
)), Qnil
);
577 run_composition_function (start
, end
, prop
);
580 && find_composition (to
, -1, &start
, &end
, &prop
, Qnil
)
581 && COMPOSITION_VALID_P (start
, end
, prop
))
583 run_composition_function (start
, end
, prop
);
587 if (min_pos
< max_pos
)
589 ptrdiff_t count
= SPECPDL_INDEX ();
591 specbind (Qinhibit_read_only
, Qt
);
592 specbind (Qinhibit_modification_hooks
, Qt
);
593 specbind (Qinhibit_point_motion_hooks
, Qt
);
594 Fremove_list_of_text_properties (make_number (min_pos
),
595 make_number (max_pos
),
596 Fcons (Qauto_composed
, Qnil
), Qnil
);
597 unbind_to (count
, Qnil
);
602 /* Modify composition property values in LIST destructively. LIST is
603 a list as returned from text_property_list. Change values to the
604 top-level copies of them so that none of them are `eq'. */
607 make_composition_value_copy (Lisp_Object list
)
609 Lisp_Object plist
, val
;
611 for (; CONSP (list
); list
= XCDR (list
))
613 plist
= XCAR (XCDR (XCDR (XCAR (list
))));
614 while (CONSP (plist
) && CONSP (XCDR (plist
)))
616 if (EQ (XCAR (plist
), Qcomposition
)
617 && (val
= XCAR (XCDR (plist
)), CONSP (val
)))
618 XSETCAR (XCDR (plist
), Fcons (XCAR (val
), XCDR (val
)));
619 plist
= XCDR (XCDR (plist
));
625 /* Make text in the region between START and END a composition that
626 has COMPONENTS and MODIFICATION-FUNC.
628 If STRING is non-nil, then operate on characters contained between
629 indices START and END in STRING. */
632 compose_text (ptrdiff_t start
, ptrdiff_t end
, Lisp_Object components
,
633 Lisp_Object modification_func
, Lisp_Object string
)
637 prop
= Fcons (Fcons (make_number (end
- start
), components
),
639 Fput_text_property (make_number (start
), make_number (end
),
640 Qcomposition
, prop
, string
);
644 static Lisp_Object
autocmp_chars (Lisp_Object
, ptrdiff_t, ptrdiff_t,
645 ptrdiff_t, struct window
*,
646 struct face
*, Lisp_Object
);
649 /* Lisp glyph-string handlers */
651 /* Hash table for automatic composition. The key is a header of a
652 lgstring (Lispy glyph-string), and the value is a body of a
655 static Lisp_Object gstring_hash_table
;
657 static Lisp_Object
gstring_lookup_cache (Lisp_Object
);
660 gstring_lookup_cache (Lisp_Object header
)
662 struct Lisp_Hash_Table
*h
= XHASH_TABLE (gstring_hash_table
);
663 ptrdiff_t i
= hash_lookup (h
, header
, NULL
);
665 return (i
>= 0 ? HASH_VALUE (h
, i
) : Qnil
);
669 composition_gstring_put_cache (Lisp_Object gstring
, ptrdiff_t len
)
671 struct Lisp_Hash_Table
*h
= XHASH_TABLE (gstring_hash_table
);
673 Lisp_Object header
, copy
;
676 header
= LGSTRING_HEADER (gstring
);
677 hash
= h
->hashfn (h
, header
);
680 ptrdiff_t j
, glyph_len
= LGSTRING_GLYPH_LEN (gstring
);
681 for (j
= 0; j
< glyph_len
; j
++)
682 if (NILP (LGSTRING_GLYPH (gstring
, j
)))
687 lint_assume (len
<= TYPE_MAXIMUM (ptrdiff_t) - 2);
688 copy
= Fmake_vector (make_number (len
+ 2), Qnil
);
689 LGSTRING_SET_HEADER (copy
, Fcopy_sequence (header
));
690 for (i
= 0; i
< len
; i
++)
691 LGSTRING_SET_GLYPH (copy
, i
, Fcopy_sequence (LGSTRING_GLYPH (gstring
, i
)));
692 i
= hash_put (h
, LGSTRING_HEADER (copy
), copy
, hash
);
693 LGSTRING_SET_ID (copy
, make_number (i
));
698 composition_gstring_from_id (ptrdiff_t id
)
700 struct Lisp_Hash_Table
*h
= XHASH_TABLE (gstring_hash_table
);
702 return HASH_VALUE (h
, id
);
705 static Lisp_Object
fill_gstring_header (Lisp_Object
, Lisp_Object
,
706 Lisp_Object
, Lisp_Object
,
710 composition_gstring_p (Lisp_Object gstring
)
715 if (! VECTORP (gstring
) || ASIZE (gstring
) < 2)
717 header
= LGSTRING_HEADER (gstring
);
718 if (! VECTORP (header
) || ASIZE (header
) < 2)
720 if (! NILP (LGSTRING_FONT (gstring
))
721 && (! FONT_OBJECT_P (LGSTRING_FONT (gstring
))
722 && ! CODING_SYSTEM_P (LGSTRING_FONT (gstring
))))
724 for (i
= 1; i
< ASIZE (LGSTRING_HEADER (gstring
)); i
++)
725 if (! NATNUMP (AREF (LGSTRING_HEADER (gstring
), i
)))
727 if (! NILP (LGSTRING_ID (gstring
)) && ! NATNUMP (LGSTRING_ID (gstring
)))
729 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
731 Lisp_Object glyph
= LGSTRING_GLYPH (gstring
, i
);
734 if (! VECTORP (glyph
) || ASIZE (glyph
) != LGLYPH_SIZE
)
741 composition_gstring_width (Lisp_Object gstring
, ptrdiff_t from
, ptrdiff_t to
,
742 struct font_metrics
*metrics
)
749 Lisp_Object font_object
= LGSTRING_FONT (gstring
);
751 if (FONT_OBJECT_P (font_object
))
753 struct font
*font
= XFONT_OBJECT (font_object
);
755 metrics
->ascent
= font
->ascent
;
756 metrics
->descent
= font
->descent
;
761 metrics
->descent
= 0;
763 metrics
->width
= metrics
->lbearing
= metrics
->rbearing
= 0;
765 for (glyph
= &LGSTRING_GLYPH (gstring
, from
); from
< to
; from
++, glyph
++)
769 if (NILP (LGLYPH_ADJUSTMENT (*glyph
)))
770 width
+= LGLYPH_WIDTH (*glyph
);
772 width
+= LGLYPH_WADJUST (*glyph
);
775 x
= metrics
->width
+ LGLYPH_LBEARING (*glyph
) + LGLYPH_XOFF (*glyph
);
776 if (metrics
->lbearing
> x
)
777 metrics
->lbearing
= x
;
778 x
= metrics
->width
+ LGLYPH_RBEARING (*glyph
) + LGLYPH_XOFF (*glyph
);
779 if (metrics
->rbearing
< x
)
780 metrics
->rbearing
= x
;
781 metrics
->width
= width
;
782 x
= LGLYPH_ASCENT (*glyph
) - LGLYPH_YOFF (*glyph
);
783 if (metrics
->ascent
< x
)
785 x
= LGLYPH_DESCENT (*glyph
) + LGLYPH_YOFF (*glyph
);
786 if (metrics
->descent
< x
)
787 metrics
->descent
= x
;
794 static Lisp_Object gstring_work
;
795 static Lisp_Object gstring_work_headers
;
798 fill_gstring_header (Lisp_Object header
, Lisp_Object start
, Lisp_Object end
, Lisp_Object font_object
, Lisp_Object string
)
800 ptrdiff_t from
, to
, from_byte
;
805 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
806 error ("Attempt to shape unibyte text");
807 validate_region (&start
, &end
);
808 from
= XFASTINT (start
);
810 from_byte
= CHAR_TO_BYTE (from
);
814 CHECK_STRING (string
);
815 if (! STRING_MULTIBYTE (string
))
816 error ("Attempt to shape unibyte text");
817 /* The caller checks that START and END are nonnegative integers. */
818 if (! (XINT (start
) <= XINT (end
) && XINT (end
) <= SCHARS (string
)))
819 args_out_of_range_3 (string
, start
, end
);
822 from_byte
= string_char_to_byte (string
, from
);
827 error ("Attempt to shape zero-length text");
828 if (VECTORP (header
))
830 if (ASIZE (header
) != len
+ 1)
831 args_out_of_range (header
, make_number (len
+ 1));
836 header
= AREF (gstring_work_headers
, len
- 1);
838 header
= Fmake_vector (make_number (len
+ 1), Qnil
);
841 ASET (header
, 0, font_object
);
842 for (i
= 0; i
< len
; i
++)
847 FETCH_CHAR_ADVANCE_NO_CHECK (c
, from
, from_byte
);
849 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, from
, from_byte
);
850 ASET (header
, i
+ 1, make_number (c
));
856 fill_gstring_body (Lisp_Object gstring
)
858 Lisp_Object font_object
= LGSTRING_FONT (gstring
);
859 Lisp_Object header
= AREF (gstring
, 0);
860 ptrdiff_t len
= LGSTRING_CHAR_LEN (gstring
);
863 for (i
= 0; i
< len
; i
++)
865 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
866 int c
= XFASTINT (AREF (header
, i
+ 1));
871 LGSTRING_SET_GLYPH (gstring
, i
, g
);
873 LGLYPH_SET_FROM (g
, i
);
874 LGLYPH_SET_TO (g
, i
);
875 LGLYPH_SET_CHAR (g
, c
);
876 if (FONT_OBJECT_P (font_object
))
878 font_fill_lglyph_metrics (g
, font_object
);
882 int width
= XFASTINT (CHAR_TABLE_REF (Vchar_width_table
, c
));
884 LGLYPH_SET_CODE (g
, c
);
885 LGLYPH_SET_LBEARING (g
, 0);
886 LGLYPH_SET_RBEARING (g
, width
);
887 LGLYPH_SET_WIDTH (g
, width
);
888 LGLYPH_SET_ASCENT (g
, 1);
889 LGLYPH_SET_DESCENT (g
, 0);
891 LGLYPH_SET_ADJUSTMENT (g
, Qnil
);
893 if (i
< LGSTRING_GLYPH_LEN (gstring
))
894 LGSTRING_SET_GLYPH (gstring
, i
, Qnil
);
898 /* Try to compose the characters at CHARPOS according to composition
899 rule RULE ([PATTERN PREV-CHARS FUNC]). LIMIT limits the characters
900 to compose. STRING, if not nil, is a target string. WIN is a
901 window where the characters are being displayed. If characters are
902 successfully composed, return the composition as a glyph-string
903 object. Otherwise return nil. */
906 autocmp_chars (Lisp_Object rule
, ptrdiff_t charpos
, ptrdiff_t bytepos
, ptrdiff_t limit
, struct window
*win
, struct face
*face
, Lisp_Object string
)
908 ptrdiff_t count
= SPECPDL_INDEX ();
909 FRAME_PTR f
= XFRAME (win
->frame
);
910 Lisp_Object pos
= make_number (charpos
);
912 ptrdiff_t pt
= PT
, pt_byte
= PT_BYTE
;
913 Lisp_Object re
, font_object
, lgstring
;
916 record_unwind_save_match_data ();
920 else if (! STRINGP (re
))
921 return unbind_to (count
, Qnil
);
922 else if ((len
= fast_looking_at (re
, charpos
, bytepos
, limit
, -1, string
))
926 len
= BYTE_TO_CHAR (bytepos
+ len
) - charpos
;
928 len
= string_byte_to_char (string
, bytepos
+ len
) - charpos
;
931 return unbind_to (count
, Qnil
);
932 to
= limit
= charpos
+ len
;
933 #ifdef HAVE_WINDOW_SYSTEM
934 if (FRAME_WINDOW_P (f
))
936 font_object
= font_range (charpos
, &to
, win
, face
, string
);
937 if (! FONT_OBJECT_P (font_object
)
940 && (fast_looking_at (re
, charpos
, bytepos
, to
, -1, string
) <= 0)))
941 return unbind_to (count
, Qnil
);
944 #endif /* not HAVE_WINDOW_SYSTEM */
945 font_object
= win
->frame
;
946 lgstring
= Fcomposition_get_gstring (pos
, make_number (to
), font_object
,
948 if (NILP (LGSTRING_ID (lgstring
)))
952 /* Save point as marker before calling out to lisp. */
955 Lisp_Object m
= Fmake_marker ();
956 set_marker_both (m
, Qnil
, pt
, pt_byte
);
957 record_unwind_protect (restore_point_unwind
, m
);
960 args
[0] = Vauto_composition_function
;
961 args
[1] = AREF (rule
, 2);
963 args
[3] = make_number (to
);
964 args
[4] = font_object
;
966 lgstring
= safe_call (6, args
);
968 return unbind_to (count
, lgstring
);
971 static Lisp_Object _work_val
;
973 /* 1 iff the character C is composable. Characters of general
974 category Z? or C? are not composable except for ZWNJ and ZWJ. */
976 #define CHAR_COMPOSABLE_P(C) \
978 && ((C) == 0x200C || (C) == 0x200D \
979 || (_work_val = CHAR_TABLE_REF (Vunicode_category_table, (C)), \
980 (INTEGERP (_work_val) \
981 && (XINT (_work_val) <= UNICODE_CATEGORY_So)))))
983 /* Update cmp_it->stop_pos to the next position after CHARPOS (and
984 BYTEPOS) where character composition may happen. If BYTEPOS is
985 negative, compute it. ENDPOS is a limit of searching. If it is
986 less than CHARPOS, search backward to ENDPOS+1 assuming that
987 set_iterator_to_next works in reverse order. In this case, if a
988 composition closest to CHARPOS is found, set cmp_it->stop_pos to
989 the last character of the composition.
991 If no composition is found, set cmp_it->ch to -2. If a static
992 composition is found, set cmp_it->ch to -1. Otherwise, set
993 cmp_it->ch to the character that triggers the automatic
997 composition_compute_stop_pos (struct composition_it
*cmp_it
, ptrdiff_t charpos
, ptrdiff_t bytepos
, ptrdiff_t endpos
, Lisp_Object string
)
999 ptrdiff_t start
, end
;
1001 Lisp_Object prop
, val
;
1002 /* This is from forward_to_next_line_start in xdisp.c. */
1003 const int MAX_NEWLINE_DISTANCE
= 500;
1005 if (charpos
< endpos
)
1007 if (endpos
> charpos
+ MAX_NEWLINE_DISTANCE
)
1008 endpos
= charpos
+ MAX_NEWLINE_DISTANCE
;
1010 else if (endpos
< charpos
)
1012 /* We search backward for a position to check composition. */
1015 /* But we don't know where to stop the searching. */
1016 endpos
= NILP (string
) ? BEGV
- 1 : -1;
1017 /* Usually we don't reach ENDPOS because we stop searching
1018 at an uncomposable character (NL, LRE, etc). */
1023 cmp_it
->reversed_p
= 0;
1024 cmp_it
->stop_pos
= endpos
;
1025 if (charpos
== endpos
)
1027 /* FIXME: Bidi is not yet handled well in static composition. */
1028 if (charpos
< endpos
1029 && find_composition (charpos
, endpos
, &start
, &end
, &prop
, string
)
1031 && COMPOSITION_VALID_P (start
, end
, prop
))
1033 cmp_it
->stop_pos
= endpos
= start
;
1036 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
))
1037 || NILP (Vauto_composition_mode
))
1042 bytepos
= CHAR_TO_BYTE (charpos
);
1044 bytepos
= string_char_to_byte (string
, charpos
);
1048 if (charpos
< endpos
)
1050 /* Forward search. */
1051 while (charpos
< endpos
)
1053 if (STRINGP (string
))
1054 FETCH_STRING_CHAR_ADVANCE (c
, string
, charpos
, bytepos
);
1056 FETCH_CHAR_ADVANCE (c
, charpos
, bytepos
);
1062 val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1068 for (ridx
= 0; CONSP (val
); val
= XCDR (val
), ridx
++)
1071 if (VECTORP (elt
) && ASIZE (elt
) == 3
1072 && NATNUMP (AREF (elt
, 1))
1073 && charpos
- 1 - XFASTINT (AREF (elt
, 1)) >= start
)
1078 cmp_it
->rule_idx
= ridx
;
1079 cmp_it
->lookback
= XFASTINT (AREF (elt
, 1));
1080 cmp_it
->stop_pos
= charpos
- 1 - cmp_it
->lookback
;
1086 if (charpos
== endpos
)
1088 /* We couldn't find a composition point before ENDPOS. But,
1089 some character after ENDPOS may be composed with
1090 characters before ENDPOS. So, we should stop at the safe
1092 charpos
= endpos
- MAX_AUTO_COMPOSITION_LOOKBACK
;
1093 if (charpos
< start
)
1097 else if (charpos
> endpos
)
1099 /* Search backward for a pattern that may be composed and the
1100 position of (possibly) the last character of the match is
1101 closest to (but not after) START. The reason for the last
1102 character is that set_iterator_to_next works in reverse order,
1103 and thus we must stop at the last character for composition
1107 /* Limit byte position used in fast_looking_at. This is the
1108 byte position of the character after START. */
1112 p
= BYTE_POS_ADDR (bytepos
);
1114 p
= SDATA (string
) + bytepos
;
1115 c
= STRING_CHAR_AND_LENGTH (p
, len
);
1116 limit
= bytepos
+ len
;
1117 while (CHAR_COMPOSABLE_P (c
))
1119 val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1125 for (ridx
= 0; CONSP (val
); val
= XCDR (val
), ridx
++)
1128 if (VECTORP (elt
) && ASIZE (elt
) == 3
1129 && NATNUMP (AREF (elt
, 1))
1130 && charpos
- XFASTINT (AREF (elt
, 1)) > endpos
)
1132 ptrdiff_t back
= XFASTINT (AREF (elt
, 1));
1133 ptrdiff_t cpos
= charpos
- back
, bpos
;
1138 bpos
= (NILP (string
) ? CHAR_TO_BYTE (cpos
)
1139 : string_char_to_byte (string
, cpos
));
1140 if (STRINGP (AREF (elt
, 0)))
1141 blen
= fast_looking_at (AREF (elt
, 0), cpos
, bpos
,
1142 start
+ 1, limit
, string
);
1147 /* Make CPOS point to the last character of
1148 match. Note that BLEN is byte-length. */
1153 cpos
= BYTE_TO_CHAR (bpos
) - 1;
1155 cpos
= string_byte_to_char (string
, bpos
) - 1;
1157 back
= cpos
- (charpos
- back
);
1158 if (cmp_it
->stop_pos
< cpos
1159 || (cmp_it
->stop_pos
== cpos
1160 && cmp_it
->lookback
< back
))
1162 cmp_it
->rule_idx
= ridx
;
1163 cmp_it
->stop_pos
= cpos
;
1165 cmp_it
->lookback
= back
;
1166 cmp_it
->nchars
= back
+ 1;
1172 if (charpos
- 1 == endpos
)
1174 if (STRINGP (string
))
1177 while (! CHAR_HEAD_P (*p
))
1183 DEC_BOTH (charpos
, bytepos
);
1184 p
= BYTE_POS_ADDR (bytepos
);
1186 c
= STRING_CHAR (p
);
1188 if (cmp_it
->ch
>= 0)
1189 /* We found a position to check. */
1191 /* Skip all uncomposable characters. */
1194 while (charpos
- 1 > endpos
&& ! CHAR_COMPOSABLE_P (c
))
1196 DEC_BOTH (charpos
, bytepos
);
1197 c
= FETCH_MULTIBYTE_CHAR (bytepos
);
1202 while (charpos
- 1 > endpos
&& ! CHAR_COMPOSABLE_P (c
))
1205 while (! CHAR_HEAD_P (*p
))
1208 c
= STRING_CHAR (p
);
1212 cmp_it
->stop_pos
= charpos
;
1215 /* Check if the character at CHARPOS (and BYTEPOS) is composed
1216 (possibly with the following characters) on window W. ENDPOS limits
1217 characters to be composed. FACE, in non-NULL, is a base face of
1218 the character. If STRING is not nil, it is a string containing the
1219 character to check, and CHARPOS and BYTEPOS are indices in the
1220 string. In that case, FACE must not be NULL.
1222 If the character is composed, setup members of CMP_IT (id, nglyphs,
1223 from, to, reversed_p), and return 1. Otherwise, update
1224 CMP_IT->stop_pos, and return 0. */
1227 composition_reseat_it (struct composition_it
*cmp_it
, ptrdiff_t charpos
, ptrdiff_t bytepos
, ptrdiff_t endpos
, struct window
*w
, struct face
*face
, Lisp_Object string
)
1230 endpos
= NILP (string
) ? BEGV
: 0;
1232 if (cmp_it
->ch
== -2)
1234 composition_compute_stop_pos (cmp_it
, charpos
, bytepos
, endpos
, string
);
1235 if (cmp_it
->ch
== -2 || cmp_it
->stop_pos
!= charpos
)
1236 /* The current position is not composed. */
1242 /* We are looking at a static composition. */
1243 ptrdiff_t start
, end
;
1246 find_composition (charpos
, -1, &start
, &end
, &prop
, string
);
1247 cmp_it
->id
= get_composition_id (charpos
, bytepos
, end
- start
,
1250 goto no_composition
;
1251 cmp_it
->nchars
= end
- start
;
1252 cmp_it
->nglyphs
= composition_table
[cmp_it
->id
]->glyph_len
;
1256 Lisp_Object lgstring
= Qnil
;
1257 Lisp_Object val
, elt
;
1260 val
= CHAR_TABLE_REF (Vcomposition_function_table
, cmp_it
->ch
);
1261 for (i
= 0; i
< cmp_it
->rule_idx
; i
++, val
= XCDR (val
));
1262 if (charpos
< endpos
)
1264 for (; CONSP (val
); val
= XCDR (val
))
1267 if (! VECTORP (elt
) || ASIZE (elt
) != 3
1268 || ! INTEGERP (AREF (elt
, 1)))
1270 if (XFASTINT (AREF (elt
, 1)) != cmp_it
->lookback
)
1271 goto no_composition
;
1272 lgstring
= autocmp_chars (elt
, charpos
, bytepos
, endpos
,
1274 if (composition_gstring_p (lgstring
))
1277 /* Composition failed perhaps because the font doesn't
1278 support sufficient range of characters. Try the
1279 other composition rules if any. */
1281 cmp_it
->reversed_p
= 0;
1285 ptrdiff_t cpos
= charpos
, bpos
= bytepos
;
1290 if (cmp_it
->lookback
> 0)
1292 cpos
= charpos
- cmp_it
->lookback
;
1293 if (STRINGP (string
))
1294 bpos
= string_char_to_byte (string
, cpos
);
1296 bpos
= CHAR_TO_BYTE (cpos
);
1298 lgstring
= autocmp_chars (elt
, cpos
, bpos
, charpos
+ 1, w
, face
,
1300 if (composition_gstring_p (lgstring
)
1301 && cpos
+ LGSTRING_CHAR_LEN (lgstring
) - 1 == charpos
)
1303 /* Composition failed or didn't cover the current
1305 if (cmp_it
->lookback
== 0)
1306 goto no_composition
;
1308 /* Try to find a shorter composition that starts after CPOS. */
1309 composition_compute_stop_pos (cmp_it
, charpos
, bytepos
, cpos
,
1311 if (cmp_it
->ch
== -2 || cmp_it
->stop_pos
< charpos
)
1312 goto no_composition
;
1313 val
= CHAR_TABLE_REF (Vcomposition_function_table
, cmp_it
->ch
);
1314 for (i
= 0; i
< cmp_it
->rule_idx
; i
++, val
= XCDR (val
));
1316 cmp_it
->reversed_p
= 1;
1318 if (NILP (lgstring
))
1319 goto no_composition
;
1320 if (NILP (LGSTRING_ID (lgstring
)))
1321 lgstring
= composition_gstring_put_cache (lgstring
, -1);
1322 cmp_it
->id
= XINT (LGSTRING_ID (lgstring
));
1323 for (i
= 0; i
< LGSTRING_GLYPH_LEN (lgstring
); i
++)
1324 if (NILP (LGSTRING_GLYPH (lgstring
, i
)))
1326 cmp_it
->nglyphs
= i
;
1331 goto no_composition
;
1335 if (charpos
== endpos
)
1337 if (charpos
< endpos
)
1343 bytepos
+= BYTES_BY_CHAR_HEAD (*(SDATA (string
) + bytepos
));
1348 /* BYTEPOS is calculated in composition_compute_stop_pos */
1351 composition_compute_stop_pos (cmp_it
, charpos
, bytepos
, endpos
, string
);
1355 /* Update charpos, nchars, nbytes, and width of the current grapheme
1358 If the composition is static or automatic in L2R context, the
1359 cluster is identified by CMP_IT->from, and CHARPOS is the position
1360 of the first character of the cluster. In this case, update
1363 If the composition is automatic in R2L context, the cluster is
1364 identified by CMP_IT->to, and CHARPOS is the position of the last
1365 character of the cluster. In this case, update CMP_IT->from too.
1367 The return value is the character code of the first character of
1368 the cluster, or -1 if the composition is somehow broken. */
1371 composition_update_it (struct composition_it
*cmp_it
, ptrdiff_t charpos
, ptrdiff_t bytepos
, Lisp_Object string
)
1373 int i
, c
IF_LINT (= 0);
1377 /* static composition */
1378 struct composition
*cmp
= composition_table
[cmp_it
->id
];
1380 cmp_it
->charpos
= charpos
;
1381 cmp_it
->to
= cmp_it
->nglyphs
;
1382 if (cmp_it
->nglyphs
== 0)
1386 for (i
= 0; i
< cmp
->glyph_len
; i
++)
1387 /* TAB in a composition means display glyphs with padding
1388 space on the left or right. */
1389 if ((c
= COMPOSITION_GLYPH (cmp
, i
)) != '\t')
1394 cmp_it
->width
= cmp
->width
;
1395 charpos
+= cmp_it
->nchars
;
1396 if (STRINGP (string
))
1397 cmp_it
->nbytes
= string_char_to_byte (string
, charpos
) - bytepos
;
1399 cmp_it
->nbytes
= CHAR_TO_BYTE (charpos
) - bytepos
;
1403 /* automatic composition */
1404 Lisp_Object gstring
= composition_gstring_from_id (cmp_it
->id
);
1408 if (cmp_it
->nglyphs
== 0)
1410 cmp_it
->nchars
= LGSTRING_CHAR_LEN (gstring
);
1412 cmp_it
->from
= cmp_it
->to
= 0;
1415 if (! cmp_it
->reversed_p
)
1417 glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->from
);
1418 from
= LGLYPH_FROM (glyph
);
1419 for (cmp_it
->to
= cmp_it
->from
+ 1; cmp_it
->to
< cmp_it
->nglyphs
;
1422 glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->to
);
1423 if (LGLYPH_FROM (glyph
) != from
)
1426 cmp_it
->charpos
= charpos
;
1430 glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->to
- 1);
1431 from
= LGLYPH_FROM (glyph
);
1432 cmp_it
->charpos
= charpos
- (LGLYPH_TO (glyph
) - from
);
1433 for (cmp_it
->from
= cmp_it
->to
- 1; cmp_it
->from
> 0;
1436 glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->from
- 1);
1437 if (LGLYPH_FROM (glyph
) != from
)
1441 glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->from
);
1442 cmp_it
->nchars
= LGLYPH_TO (glyph
) + 1 - from
;
1445 for (i
= cmp_it
->nchars
- 1; i
>= 0; i
--)
1447 c
= XINT (LGSTRING_CHAR (gstring
, i
));
1448 cmp_it
->nbytes
+= CHAR_BYTES (c
);
1449 cmp_it
->width
+= CHAR_WIDTH (c
);
1456 struct position_record
1458 ptrdiff_t pos
, pos_byte
;
1462 /* Update the members of POSITION to the next character boundary. */
1463 #define FORWARD_CHAR(POSITION, STOP) \
1466 if ((POSITION).pos == (STOP)) \
1468 (POSITION).p = GAP_END_ADDR; \
1469 (POSITION).pos_byte = GPT_BYTE; \
1473 (POSITION).pos_byte += BYTES_BY_CHAR_HEAD (*((POSITION).p)); \
1474 (POSITION).p += BYTES_BY_CHAR_HEAD (*((POSITION).p)); \
1478 /* Update the members of POSITION to the previous character boundary. */
1479 #define BACKWARD_CHAR(POSITION, STOP) \
1481 if ((POSITION).pos == (STOP)) \
1482 (POSITION).p = GPT_ADDR; \
1484 (POSITION).pos_byte--; \
1486 } while (! CHAR_HEAD_P (*((POSITION).p))); \
1490 /* This is like find_composition, but find an automatic composition
1491 instead. It is assured that POS is not within a static
1492 composition. If found, set *GSTRING to the glyph-string
1493 representing the composition, and return 1. Otherwise, *GSTRING to
1494 Qnil, and return 0. */
1497 find_automatic_composition (ptrdiff_t pos
, ptrdiff_t limit
,
1498 ptrdiff_t *start
, ptrdiff_t *end
,
1499 Lisp_Object
*gstring
, Lisp_Object string
)
1501 ptrdiff_t head
, tail
, stop
;
1502 /* Forward limit position of checking a composition taking a
1503 looking-back count into account. */
1504 ptrdiff_t fore_check_limit
;
1505 struct position_record cur
, prev
;
1509 int need_adjustment
= 0;
1511 window
= Fget_buffer_window (Fcurrent_buffer (), Qnil
);
1514 w
= XWINDOW (window
);
1519 head
= BEGV
, tail
= ZV
, stop
= GPT
;
1520 cur
.pos_byte
= CHAR_TO_BYTE (cur
.pos
);
1521 cur
.p
= BYTE_POS_ADDR (cur
.pos_byte
);
1525 head
= 0, tail
= SCHARS (string
), stop
= -1;
1526 cur
.pos_byte
= string_char_to_byte (string
, cur
.pos
);
1527 cur
.p
= SDATA (string
) + cur
.pos_byte
;
1530 /* Finding a composition covering the character after POS is the
1531 same as setting LIMIT to POS. */
1534 fore_check_limit
= min (tail
, pos
+ 1 + MAX_AUTO_COMPOSITION_LOOKBACK
);
1536 fore_check_limit
= min (tail
, limit
+ MAX_AUTO_COMPOSITION_LOOKBACK
);
1538 /* Provided that we have these possible compositions now:
1540 POS: 1 2 3 4 5 6 7 8 9
1544 Here, it is known that characters after positions 1 and 9 can
1545 never be composed (i.e. ! CHAR_COMPOSABLE_P (CH)), and
1546 composition A is an invalid one because it's partially covered by
1547 the valid composition C. And to know whether a composition is
1548 valid or not, the only way is to start searching forward from a
1549 position that can not be a tail part of composition (it's 2 in
1552 Now we have these cases (1 through 4):
1554 -- character after POS is ... --
1555 not composable composable
1556 LIMIT <= POS (1) (3)
1559 Among them, in case (2), we simply search forward from POS.
1561 In the other cases, we at first rewind back to the position where
1562 the previous character is not composable or the beginning of
1563 buffer (string), then search compositions forward. In case (1)
1564 and (3) we repeat this process until a composition is found. */
1568 c
= STRING_CHAR (cur
.p
);
1569 if (! CHAR_COMPOSABLE_P (c
))
1571 if (limit
<= pos
) /* case (1) */
1574 if (cur
.pos
<= limit
)
1576 BACKWARD_CHAR (cur
, stop
);
1577 c
= STRING_CHAR (cur
.p
);
1578 } while (! CHAR_COMPOSABLE_P (c
));
1579 fore_check_limit
= cur
.pos
+ 1;
1582 /* No need of rewinding back. */
1583 goto search_forward
;
1586 /* Rewind back to the position where we can safely search
1587 forward for compositions. It is assured that the character
1588 at cur.pos is composable. */
1589 while (head
< cur
.pos
)
1592 BACKWARD_CHAR (cur
, stop
);
1593 c
= STRING_CHAR (cur
.p
);
1594 if (! CHAR_COMPOSABLE_P (c
))
1602 /* Now search forward. */
1604 prev
= cur
; /* remember the start of searching position. */
1605 while (cur
.pos
< fore_check_limit
)
1609 c
= STRING_CHAR (cur
.p
);
1610 for (val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1611 CONSP (val
); val
= XCDR (val
))
1613 Lisp_Object elt
= XCAR (val
);
1615 if (VECTORP (elt
) && ASIZE (elt
) == 3 && NATNUMP (AREF (elt
, 1)))
1617 EMACS_INT check_pos
= cur
.pos
- XFASTINT (AREF (elt
, 1));
1618 struct position_record check
;
1620 if (check_pos
< head
1621 || (limit
<= pos
? pos
< check_pos
1622 : limit
<= check_pos
))
1624 for (check
= cur
; check_pos
< check
.pos
; )
1625 BACKWARD_CHAR (check
, stop
);
1626 *gstring
= autocmp_chars (elt
, check
.pos
, check
.pos_byte
,
1627 tail
, w
, NULL
, string
);
1628 need_adjustment
= 1;
1629 if (NILP (*gstring
))
1631 /* As we have called Lisp, there's a possibility
1632 that buffer/string is relocated. */
1634 cur
.p
= BYTE_POS_ADDR (cur
.pos_byte
);
1636 cur
.p
= SDATA (string
) + cur
.pos_byte
;
1640 /* We found a candidate of a target composition. */
1642 *end
= check
.pos
+ LGSTRING_CHAR_LEN (*gstring
);
1645 : *start
<= pos
&& pos
< *end
)
1646 /* This is the target composition. */
1651 cur
.pos_byte
= CHAR_TO_BYTE (cur
.pos
);
1652 cur
.p
= BYTE_POS_ADDR (cur
.pos_byte
);
1656 cur
.pos_byte
= string_char_to_byte (string
, cur
.pos
);
1657 cur
.p
= SDATA (string
) + cur
.pos_byte
;
1664 /* We found no composition here. */
1665 FORWARD_CHAR (cur
, stop
);
1668 if (pos
< limit
) /* case (2) and (4)*/
1670 if (! NILP (*gstring
))
1672 if (prev
.pos
== head
)
1675 if (need_adjustment
)
1678 cur
.p
= BYTE_POS_ADDR (cur
.pos_byte
);
1680 cur
.p
= SDATA (string
) + cur
.pos_byte
;
1682 BACKWARD_CHAR (cur
, stop
);
1686 /* Return the adjusted point provided that point is moved from LAST_PT
1690 composition_adjust_point (ptrdiff_t last_pt
, ptrdiff_t new_pt
)
1692 ptrdiff_t i
, beg
, end
;
1695 if (new_pt
== BEGV
|| new_pt
== ZV
)
1698 /* At first check the static composition. */
1699 if (get_property_and_range (new_pt
, Qcomposition
, &val
, &beg
, &end
, Qnil
)
1700 && COMPOSITION_VALID_P (beg
, end
, val
))
1702 if (beg
< new_pt
/* && end > new_pt <- It's always the case. */
1703 && (last_pt
<= beg
|| last_pt
>= end
))
1704 return (new_pt
< last_pt
? beg
: end
);
1708 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
))
1709 || NILP (Vauto_composition_mode
))
1712 /* Next check the automatic composition. */
1713 if (! find_automatic_composition (new_pt
, (ptrdiff_t) -1, &beg
, &end
, &val
,
1717 for (i
= 0; i
< LGSTRING_GLYPH_LEN (val
); i
++)
1719 Lisp_Object glyph
= LGSTRING_GLYPH (val
, i
);
1723 if (beg
+ LGLYPH_FROM (glyph
) == new_pt
)
1725 if (beg
+ LGLYPH_TO (glyph
) >= new_pt
)
1726 return (new_pt
< last_pt
1727 ? beg
+ LGLYPH_FROM (glyph
)
1728 : beg
+ LGLYPH_TO (glyph
) + 1);
1733 DEFUN ("composition-get-gstring", Fcomposition_get_gstring
,
1734 Scomposition_get_gstring
, 4, 4, 0,
1735 doc
: /* Return a glyph-string for characters between FROM and TO.
1736 If the glyph string is for graphic display, FONT-OBJECT must be
1737 a font-object to use for those characters.
1738 Otherwise (for terminal display), FONT-OBJECT must be a terminal ID, a
1739 frame, or nil for the selected frame's terminal device.
1741 If the optional 4th argument STRING is not nil, it is a string
1742 containing the target characters between indices FROM and TO.
1744 A glyph-string is a vector containing information about how to display
1745 a specific character sequence. The format is:
1746 [HEADER ID GLYPH ...]
1748 HEADER is a vector of this form:
1749 [FONT-OBJECT CHAR ...]
1751 FONT-OBJECT is a font-object for all glyphs in the glyph-string,
1752 or the terminal coding system of the specified terminal.
1753 CHARs are characters to be composed by GLYPHs.
1755 ID is an identification number of the glyph-string. It may be nil if
1758 GLYPH is a vector whose elements have this form:
1759 [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT
1760 [ [X-OFF Y-OFF WADJUST] | nil] ]
1762 FROM-IDX and TO-IDX are used internally and should not be touched.
1763 C is the character of the glyph.
1764 CODE is the glyph-code of C in FONT-OBJECT.
1765 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
1766 X-OFF and Y-OFF are offsets to the base position for the glyph.
1767 WADJUST is the adjustment to the normal width of the glyph.
1769 If GLYPH is nil, the remaining elements of the glyph-string vector
1770 should be ignored. */)
1771 (Lisp_Object from
, Lisp_Object to
, Lisp_Object font_object
, Lisp_Object string
)
1773 Lisp_Object gstring
, header
;
1774 ptrdiff_t frompos
, topos
;
1776 CHECK_NATNUM (from
);
1778 if (! FONT_OBJECT_P (font_object
))
1780 struct coding_system
*coding
;
1781 struct terminal
*terminal
= get_terminal (font_object
, 1);
1783 coding
= ((TERMINAL_TERMINAL_CODING (terminal
)->common_flags
1784 & CODING_REQUIRE_ENCODING_MASK
)
1785 ? TERMINAL_TERMINAL_CODING (terminal
) : &safe_terminal_coding
);
1786 font_object
= CODING_ID_NAME (coding
->id
);
1789 header
= fill_gstring_header (Qnil
, from
, to
, font_object
, string
);
1790 gstring
= gstring_lookup_cache (header
);
1791 if (! NILP (gstring
))
1794 frompos
= XINT (from
);
1796 if (LGSTRING_GLYPH_LEN (gstring_work
) < topos
- frompos
)
1797 gstring_work
= Fmake_vector (make_number (topos
- frompos
+ 2), Qnil
);
1798 LGSTRING_SET_HEADER (gstring_work
, header
);
1799 LGSTRING_SET_ID (gstring_work
, Qnil
);
1800 fill_gstring_body (gstring_work
);
1801 return gstring_work
;
1805 /* Emacs Lisp APIs. */
1807 DEFUN ("compose-region-internal", Fcompose_region_internal
,
1808 Scompose_region_internal
, 2, 4, 0,
1809 doc
: /* Internal use only.
1811 Compose text in the region between START and END.
1812 Optional 3rd and 4th arguments are COMPONENTS and MODIFICATION-FUNC
1813 for the composition. See `compose-region' for more details. */)
1814 (Lisp_Object start
, Lisp_Object end
, Lisp_Object components
, Lisp_Object modification_func
)
1816 validate_region (&start
, &end
);
1817 if (!NILP (components
)
1818 && !INTEGERP (components
)
1819 && !CONSP (components
)
1820 && !STRINGP (components
))
1821 CHECK_VECTOR (components
);
1823 compose_text (XINT (start
), XINT (end
), components
, modification_func
, Qnil
);
1827 DEFUN ("compose-string-internal", Fcompose_string_internal
,
1828 Scompose_string_internal
, 3, 5, 0,
1829 doc
: /* Internal use only.
1831 Compose text between indices START and END of STRING.
1832 Optional 4th and 5th arguments are COMPONENTS and MODIFICATION-FUNC
1833 for the composition. See `compose-string' for more details. */)
1834 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
, Lisp_Object components
, Lisp_Object modification_func
)
1836 CHECK_STRING (string
);
1837 CHECK_NUMBER (start
);
1840 if (XINT (start
) < 0 ||
1841 XINT (start
) > XINT (end
)
1842 || XINT (end
) > SCHARS (string
))
1843 args_out_of_range (start
, end
);
1845 compose_text (XINT (start
), XINT (end
), components
, modification_func
, string
);
1849 DEFUN ("find-composition-internal", Ffind_composition_internal
,
1850 Sfind_composition_internal
, 4, 4, 0,
1851 doc
: /* Internal use only.
1853 Return information about composition at or nearest to position POS.
1854 See `find-composition' for more details. */)
1855 (Lisp_Object pos
, Lisp_Object limit
, Lisp_Object string
, Lisp_Object detail_p
)
1857 Lisp_Object prop
, tail
, gstring
;
1858 ptrdiff_t start
, end
, from
, to
;
1861 CHECK_NUMBER_COERCE_MARKER (pos
);
1864 CHECK_NUMBER_COERCE_MARKER (limit
);
1865 to
= min (XINT (limit
), ZV
);
1872 CHECK_STRING (string
);
1873 if (XINT (pos
) < 0 || XINT (pos
) > SCHARS (string
))
1874 args_out_of_range (string
, pos
);
1878 if (XINT (pos
) < BEGV
|| XINT (pos
) > ZV
)
1879 args_out_of_range (Fcurrent_buffer (), pos
);
1883 if (!find_composition (from
, to
, &start
, &end
, &prop
, string
))
1885 if (!NILP (BVAR (current_buffer
, enable_multibyte_characters
))
1886 && ! NILP (Vauto_composition_mode
)
1887 && find_automatic_composition (from
, to
, &start
, &end
, &gstring
,
1889 return list3 (make_number (start
), make_number (end
), gstring
);
1892 if ((end
<= XINT (pos
) || start
> XINT (pos
)))
1896 if (find_automatic_composition (from
, to
, &s
, &e
, &gstring
, string
)
1897 && (e
<= XINT (pos
) ? e
> end
: s
< start
))
1898 return list3 (make_number (s
), make_number (e
), gstring
);
1900 if (!COMPOSITION_VALID_P (start
, end
, prop
))
1901 return Fcons (make_number (start
), Fcons (make_number (end
),
1902 Fcons (Qnil
, Qnil
)));
1903 if (NILP (detail_p
))
1904 return Fcons (make_number (start
), Fcons (make_number (end
),
1907 if (COMPOSITION_REGISTERD_P (prop
))
1908 id
= COMPOSITION_ID (prop
);
1911 ptrdiff_t start_byte
= (NILP (string
)
1912 ? CHAR_TO_BYTE (start
)
1913 : string_char_to_byte (string
, start
));
1914 id
= get_composition_id (start
, start_byte
, end
- start
, prop
, string
);
1919 Lisp_Object components
, relative_p
, mod_func
;
1920 enum composition_method method
= COMPOSITION_METHOD (prop
);
1921 int width
= composition_table
[id
]->width
;
1923 components
= Fcopy_sequence (COMPOSITION_COMPONENTS (prop
));
1924 relative_p
= (method
== COMPOSITION_WITH_RULE_ALTCHARS
1926 mod_func
= COMPOSITION_MODIFICATION_FUNC (prop
);
1927 tail
= Fcons (components
,
1930 Fcons (make_number (width
), Qnil
))));
1935 return Fcons (make_number (start
), Fcons (make_number (end
), tail
));
1940 syms_of_composite (void)
1944 DEFSYM (Qcomposition
, "composition");
1946 /* Make a hash table for static composition. */
1948 Lisp_Object args
[6];
1952 args
[2] = QCweakness
;
1953 /* We used to make the hash table weak so that unreferenced
1954 compositions can be garbage-collected. But, usually once
1955 created compositions are repeatedly used in an Emacs session,
1956 and thus it's not worth to save memory in such a way. So, we
1957 make the table not weak. */
1960 args
[5] = make_number (311);
1961 composition_hash_table
= Fmake_hash_table (6, args
);
1962 staticpro (&composition_hash_table
);
1965 /* Make a hash table for glyph-string. */
1967 Lisp_Object args
[6];
1970 args
[2] = QCweakness
;
1973 args
[5] = make_number (311);
1974 gstring_hash_table
= Fmake_hash_table (6, args
);
1975 staticpro (&gstring_hash_table
);
1978 staticpro (&gstring_work_headers
);
1979 gstring_work_headers
= Fmake_vector (make_number (8), Qnil
);
1980 for (i
= 0; i
< 8; i
++)
1981 ASET (gstring_work_headers
, i
, Fmake_vector (make_number (i
+ 2), Qnil
));
1982 staticpro (&gstring_work
);
1983 gstring_work
= Fmake_vector (make_number (10), Qnil
);
1985 /* Text property `composition' should be nonsticky by default. */
1986 Vtext_property_default_nonsticky
1987 = Fcons (Fcons (Qcomposition
, Qt
), Vtext_property_default_nonsticky
);
1989 DEFVAR_LISP ("compose-chars-after-function", Vcompose_chars_after_function
,
1990 doc
: /* Function to adjust composition of buffer text.
1992 This function is called with three arguments: FROM, TO, and OBJECT.
1993 FROM and TO specify the range of text whose composition should be
1994 adjusted. OBJECT, if non-nil, is a string that contains the text.
1996 This function is called after a text with `composition' property is
1997 inserted or deleted to keep `composition' property of buffer text
2000 The default value is the function `compose-chars-after'. */);
2001 Vcompose_chars_after_function
= intern_c_string ("compose-chars-after");
2003 DEFSYM (Qauto_composed
, "auto-composed");
2004 DEFSYM (Qauto_composition_function
, "auto-composition-function");
2006 DEFVAR_LISP ("auto-composition-mode", Vauto_composition_mode
,
2007 doc
: /* Non-nil if Auto-Composition mode is enabled.
2008 Use the command `auto-composition-mode' to change this variable. */);
2009 Vauto_composition_mode
= Qt
;
2011 DEFVAR_LISP ("auto-composition-function", Vauto_composition_function
,
2012 doc
: /* Function to call to compose characters automatically.
2013 This function is called from the display routine with four arguments:
2014 FROM, TO, WINDOW, and STRING.
2016 If STRING is nil, the function must compose characters in the region
2017 between FROM and TO in the current buffer.
2019 Otherwise, STRING is a string, and FROM and TO are indices into the
2020 string. In this case, the function must compose characters in the
2022 Vauto_composition_function
= Qnil
;
2024 DEFVAR_LISP ("composition-function-table", Vcomposition_function_table
,
2025 doc
: /* Char-table of functions for automatic character composition.
2026 For each character that has to be composed automatically with
2027 preceding and/or following characters, this char-table contains
2028 a function to call to compose that character.
2030 The element at index C in the table, if non-nil, is a list of
2031 composition rules of this form: ([PATTERN PREV-CHARS FUNC] ...)
2033 PATTERN is a regular expression which C and the surrounding
2034 characters must match.
2036 PREV-CHARS is a non-negative integer (less than 4) specifying how many
2037 characters before C to check the matching with PATTERN. If it is 0,
2038 PATTERN must match C and the following characters. If it is 1,
2039 PATTERN must match a character before C and the following characters.
2041 If PREV-CHARS is 0, PATTERN can be nil, which means that the
2042 single character C should be composed.
2044 FUNC is a function to return a glyph-string representing a
2045 composition of the characters that match PATTERN. It is
2046 called with one argument GSTRING.
2048 GSTRING is a template of a glyph-string to return. It is already
2049 filled with a proper header for the characters to compose, and
2050 glyphs corresponding to those characters one by one. The
2051 function must return a new glyph-string with the same header as
2052 GSTRING, or modify GSTRING itself and return it.
2054 See also the documentation of `auto-composition-mode'. */);
2055 Vcomposition_function_table
= Fmake_char_table (Qnil
, Qnil
);
2057 defsubr (&Scompose_region_internal
);
2058 defsubr (&Scompose_string_internal
);
2059 defsubr (&Sfind_composition_internal
);
2060 defsubr (&Scomposition_get_gstring
);