1 /* Composite sequence support.
2 Copyright (C) 2001-2013 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 /* Return COMPOSITION-ID of a composition at buffer position
162 CHARPOS/BYTEPOS and length NCHARS. The `composition' property of
163 the sequence is PROP. STRING, if non-nil, is a string that
164 contains the composition instead of the current buffer.
166 If the composition is invalid, return -1. */
169 get_composition_id (ptrdiff_t charpos
, ptrdiff_t bytepos
, ptrdiff_t nchars
,
170 Lisp_Object prop
, Lisp_Object string
)
172 Lisp_Object id
, length
, components
, key
, *key_contents
;
174 struct Lisp_Hash_Table
*hash_table
= XHASH_TABLE (composition_hash_table
);
175 ptrdiff_t hash_index
;
176 EMACS_UINT hash_code
;
177 enum composition_method method
;
178 struct composition
*cmp
;
182 /* Maximum length of a string of glyphs. XftGlyphExtents limits
183 this to INT_MAX, and Emacs limits it further. Divide INT_MAX - 1
184 by 2 because x_produce_glyphs computes glyph_len * 2 + 1. Divide
185 the size by MAX_MULTIBYTE_LENGTH because encode_terminal_code
186 multiplies glyph_len by MAX_MULTIBYTE_LENGTH. */
188 GLYPH_LEN_MAX
= min ((INT_MAX
- 1) / 2,
189 min (PTRDIFF_MAX
, SIZE_MAX
) / MAX_MULTIBYTE_LENGTH
)
193 Form-A: ((LENGTH . COMPONENTS) . MODIFICATION-FUNC)
195 Form-B: (COMPOSITION-ID . (LENGTH COMPONENTS-VEC . MODIFICATION-FUNC))
197 if (nchars
== 0 || !CONSP (prop
))
198 goto invalid_composition
;
203 /* PROP should be Form-B. */
204 if (XINT (id
) < 0 || XINT (id
) >= n_compositions
)
205 goto invalid_composition
;
209 /* PROP should be Form-A.
210 Thus, ID should be (LENGTH . COMPONENTS). */
212 goto invalid_composition
;
214 if (!INTEGERP (length
) || XINT (length
) != nchars
)
215 goto invalid_composition
;
217 components
= XCDR (id
);
219 /* Check if the same composition has already been registered or not
220 by consulting composition_hash_table. The key for this table is
221 COMPONENTS (converted to a vector COMPONENTS-VEC) or, if it is
222 nil, vector of characters in the composition range. */
223 if (INTEGERP (components
))
224 key
= Fmake_vector (make_number (1), components
);
225 else if (STRINGP (components
) || CONSP (components
))
226 key
= Fvconcat (1, &components
);
227 else if (VECTORP (components
))
229 else if (NILP (components
))
231 key
= make_uninit_vector (nchars
);
232 if (STRINGP (string
))
233 for (i
= 0; i
< nchars
; i
++)
235 FETCH_STRING_CHAR_ADVANCE (ch
, string
, charpos
, bytepos
);
236 ASET (key
, i
, make_number (ch
));
239 for (i
= 0; i
< nchars
; i
++)
241 FETCH_CHAR_ADVANCE (ch
, charpos
, bytepos
);
242 ASET (key
, i
, make_number (ch
));
246 goto invalid_composition
;
248 hash_index
= hash_lookup (hash_table
, key
, &hash_code
);
251 /* We have already registered the same composition. Change PROP
252 from Form-A above to Form-B while replacing COMPONENTS with
253 COMPONENTS-VEC stored in the hash table. We can directly
254 modify the cons cell of PROP because it is not shared. */
255 key
= HASH_KEY (hash_table
, hash_index
);
256 id
= HASH_VALUE (hash_table
, hash_index
);
258 XSETCDR (prop
, Fcons (make_number (nchars
), Fcons (key
, XCDR (prop
))));
262 /* This composition is a new one. We must register it. */
264 /* Check if we have sufficient memory to store this information. */
265 if (composition_table_size
<= n_compositions
)
266 composition_table
= xpalloc (composition_table
, &composition_table_size
,
267 1, -1, sizeof *composition_table
);
269 key_contents
= XVECTOR (key
)->u
.contents
;
271 /* Check if the contents of COMPONENTS are valid if COMPONENTS is a
272 vector or a list. It should be a sequence of:
273 char1 rule1 char2 rule2 char3 ... ruleN charN+1 */
275 if (VECTORP (components
)
276 && ASIZE (components
) >= 2
277 && VECTORP (AREF (components
, 0)))
279 /* COMPONENTS is a glyph-string. */
280 ptrdiff_t len
= ASIZE (key
);
282 for (i
= 1; i
< len
; i
++)
283 if (! VECTORP (AREF (key
, i
)))
284 goto invalid_composition
;
286 else if (VECTORP (components
) || CONSP (components
))
288 ptrdiff_t len
= ASIZE (key
);
290 /* The number of elements should be odd. */
292 goto invalid_composition
;
293 /* All elements should be integers (character or encoded
294 composition rule). */
295 for (i
= 0; i
< len
; i
++)
297 if (!INTEGERP (key_contents
[i
]))
298 goto invalid_composition
;
302 /* Change PROP from Form-A above to Form-B. We can directly modify
303 the cons cell of PROP because it is not shared. */
304 XSETFASTINT (id
, n_compositions
);
306 XSETCDR (prop
, Fcons (make_number (nchars
), Fcons (key
, XCDR (prop
))));
308 /* Register the composition in composition_hash_table. */
309 hash_index
= hash_put (hash_table
, key
, id
, hash_code
);
311 method
= (NILP (components
)
312 ? COMPOSITION_RELATIVE
313 : ((INTEGERP (components
) || STRINGP (components
))
314 ? COMPOSITION_WITH_ALTCHARS
315 : COMPOSITION_WITH_RULE_ALTCHARS
));
317 glyph_len
= (method
== COMPOSITION_WITH_RULE_ALTCHARS
318 ? (ASIZE (key
) + 1) / 2
321 if (GLYPH_LEN_MAX
< glyph_len
)
322 memory_full (SIZE_MAX
);
324 /* Register the composition in composition_table. */
325 cmp
= xmalloc (sizeof *cmp
);
327 cmp
->method
= method
;
328 cmp
->hash_index
= hash_index
;
329 cmp
->glyph_len
= glyph_len
;
330 cmp
->offsets
= xnmalloc (glyph_len
, 2 * sizeof *cmp
->offsets
);
333 if (cmp
->method
!= COMPOSITION_WITH_RULE_ALTCHARS
)
335 /* Relative composition. */
337 for (i
= 0; i
< glyph_len
; i
++)
340 ch
= XINT (key_contents
[i
]);
341 /* TAB in a composition means display glyphs with padding
342 space on the left or right. */
343 this_width
= (ch
== '\t' ? 1 : CHAR_WIDTH (ch
));
344 if (cmp
->width
< this_width
)
345 cmp
->width
= this_width
;
350 /* Rule-base composition. */
351 double leftmost
= 0.0, rightmost
;
353 ch
= XINT (key_contents
[0]);
354 rightmost
= ch
!= '\t' ? CHAR_WIDTH (ch
) : 1;
356 for (i
= 1; i
< glyph_len
; i
+= 2)
358 int rule
, gref
, nref
;
362 rule
= XINT (key_contents
[i
]);
363 ch
= XINT (key_contents
[i
+ 1]);
364 this_width
= ch
!= '\t' ? CHAR_WIDTH (ch
) : 1;
366 /* A composition rule is specified by an integer value
367 that encodes global and new reference points (GREF and
368 NREF). GREF and NREF are specified by numbers as
376 ---3---4---5--- baseline
380 COMPOSITION_DECODE_REFS (rule
, gref
, nref
);
381 this_left
= (leftmost
382 + (gref
% 3) * (rightmost
- leftmost
) / 2.0
383 - (nref
% 3) * this_width
/ 2.0);
385 if (this_left
< leftmost
)
386 leftmost
= this_left
;
387 if (this_left
+ this_width
> rightmost
)
388 rightmost
= this_left
+ this_width
;
391 cmp
->width
= rightmost
- leftmost
;
392 if (cmp
->width
< (rightmost
- leftmost
))
393 /* To get a ceiling integer value. */
397 composition_table
[n_compositions
] = cmp
;
399 return n_compositions
++;
402 /* Would it be better to remove this `composition' property? */
407 /* Find a static composition at or nearest to position POS of OBJECT
410 OBJECT defaults to the current buffer. If there's a composition at
411 POS, set *START and *END to the start and end of the sequence,
412 *PROP to the `composition' property, and return 1.
414 If there's no composition at POS and LIMIT is negative, return 0.
416 Otherwise, search for a composition forward (LIMIT > POS) or
417 backward (LIMIT < POS). In this case, LIMIT bounds the search.
419 If a composition is found, set *START, *END, and *PROP as above,
420 and return 1, else return 0.
422 This doesn't check the validity of composition. */
425 find_composition (ptrdiff_t pos
, ptrdiff_t limit
,
426 ptrdiff_t *start
, ptrdiff_t *end
,
427 Lisp_Object
*prop
, Lisp_Object object
)
431 if (get_property_and_range (pos
, Qcomposition
, prop
, start
, end
, object
))
434 if (limit
< 0 || limit
== pos
)
437 if (limit
> pos
) /* search forward */
439 val
= Fnext_single_property_change (make_number (pos
), Qcomposition
,
440 object
, make_number (limit
));
445 else /* search backward */
447 if (get_property_and_range (pos
- 1, Qcomposition
, prop
, start
, end
,
450 val
= Fprevious_single_property_change (make_number (pos
), Qcomposition
,
451 object
, make_number (limit
));
457 get_property_and_range (pos
, Qcomposition
, prop
, start
, end
, object
);
461 /* Run a proper function to adjust the composition sitting between
462 FROM and TO with property PROP. */
465 run_composition_function (ptrdiff_t from
, ptrdiff_t to
, Lisp_Object prop
)
468 ptrdiff_t start
, end
;
470 func
= COMPOSITION_MODIFICATION_FUNC (prop
);
471 /* If an invalid composition precedes or follows, try to make them
474 && find_composition (from
- 1, -1, &start
, &end
, &prop
, Qnil
)
475 && !composition_valid_p (start
, end
, prop
))
478 && find_composition (to
, -1, &start
, &end
, &prop
, Qnil
)
479 && !composition_valid_p (start
, end
, prop
))
481 if (!NILP (Ffboundp (func
)))
482 call2 (func
, make_number (from
), make_number (to
));
485 /* Make invalid compositions adjacent to or inside FROM and TO valid.
486 CHECK_MASK is bitwise `or' of mask bits defined by macros
487 CHECK_XXX (see the comment in composite.h).
489 It also resets the text-property `auto-composed' to a proper region
490 so that automatic character composition works correctly later while
491 displaying the region.
493 This function is called when a buffer text is changed. If the
494 change is deletion, FROM == TO. Otherwise, FROM < TO. */
497 update_compositions (ptrdiff_t from
, ptrdiff_t to
, int check_mask
)
500 ptrdiff_t start
, end
;
501 /* The beginning and end of the region to set the property
502 `auto-composed' to nil. */
503 ptrdiff_t min_pos
= from
, max_pos
= to
;
505 if (inhibit_modification_hooks
)
508 /* If FROM and TO are not in a valid range, do nothing. */
509 if (! (BEGV
<= from
&& from
<= to
&& to
<= ZV
))
512 if (check_mask
& CHECK_HEAD
)
514 /* FROM should be at composition boundary. But, insertion or
515 deletion will make two compositions adjacent and
516 indistinguishable when they have same (eq) property. To
517 avoid it, in such a case, we change the property of the
518 latter to the copy of it. */
520 && find_composition (from
- 1, -1, &start
, &end
, &prop
, Qnil
)
521 && composition_valid_p (start
, end
, prop
))
527 Fput_text_property (make_number (from
), make_number (end
),
529 Fcons (XCAR (prop
), XCDR (prop
)), Qnil
);
530 run_composition_function (start
, end
, prop
);
534 && find_composition (from
, -1, &start
, &from
, &prop
, Qnil
)
535 && composition_valid_p (start
, from
, prop
))
539 run_composition_function (start
, from
, prop
);
543 if (check_mask
& CHECK_INSIDE
)
545 /* In this case, we are sure that (check & CHECK_TAIL) is also
546 nonzero. Thus, here we should check only compositions before
549 && find_composition (from
, to
, &start
, &from
, &prop
, Qnil
)
550 && composition_valid_p (start
, from
, prop
)
552 run_composition_function (start
, from
, prop
);
555 if (check_mask
& CHECK_TAIL
)
558 && find_composition (to
- 1, -1, &start
, &end
, &prop
, Qnil
)
559 && composition_valid_p (start
, end
, prop
))
561 /* TO should be also at composition boundary. But,
562 insertion or deletion will make two compositions adjacent
563 and indistinguishable when they have same (eq) property.
564 To avoid it, in such a case, we change the property of
565 the former to the copy of it. */
568 Fput_text_property (make_number (start
), make_number (to
),
570 Fcons (XCAR (prop
), XCDR (prop
)), Qnil
);
573 run_composition_function (start
, end
, prop
);
576 && find_composition (to
, -1, &start
, &end
, &prop
, Qnil
)
577 && composition_valid_p (start
, end
, prop
))
579 run_composition_function (start
, end
, prop
);
583 if (min_pos
< max_pos
)
585 ptrdiff_t count
= SPECPDL_INDEX ();
587 specbind (Qinhibit_read_only
, Qt
);
588 specbind (Qinhibit_modification_hooks
, Qt
);
589 specbind (Qinhibit_point_motion_hooks
, Qt
);
590 Fremove_list_of_text_properties (make_number (min_pos
),
591 make_number (max_pos
),
592 list1 (Qauto_composed
), Qnil
);
593 unbind_to (count
, Qnil
);
598 /* Modify composition property values in LIST destructively. LIST is
599 a list as returned from text_property_list. Change values to the
600 top-level copies of them so that none of them are `eq'. */
603 make_composition_value_copy (Lisp_Object list
)
605 Lisp_Object plist
, val
;
607 for (; CONSP (list
); list
= XCDR (list
))
609 plist
= XCAR (XCDR (XCDR (XCAR (list
))));
610 while (CONSP (plist
) && CONSP (XCDR (plist
)))
612 if (EQ (XCAR (plist
), Qcomposition
)
613 && (val
= XCAR (XCDR (plist
)), CONSP (val
)))
614 XSETCAR (XCDR (plist
), Fcons (XCAR (val
), XCDR (val
)));
615 plist
= XCDR (XCDR (plist
));
621 /* Make text in the region between START and END a composition that
622 has COMPONENTS and MODIFICATION-FUNC.
624 If STRING is non-nil, then operate on characters contained between
625 indices START and END in STRING. */
628 compose_text (ptrdiff_t start
, ptrdiff_t end
, Lisp_Object components
,
629 Lisp_Object modification_func
, Lisp_Object string
)
633 prop
= Fcons (Fcons (make_number (end
- start
), components
),
635 Fput_text_property (make_number (start
), make_number (end
),
636 Qcomposition
, prop
, string
);
639 /* Lisp glyph-string handlers. */
641 /* Hash table for automatic composition. The key is a header of a
642 lgstring (Lispy glyph-string), and the value is a body of a
645 static Lisp_Object gstring_hash_table
;
647 static Lisp_Object
gstring_lookup_cache (Lisp_Object
);
650 gstring_lookup_cache (Lisp_Object header
)
652 struct Lisp_Hash_Table
*h
= XHASH_TABLE (gstring_hash_table
);
653 ptrdiff_t i
= hash_lookup (h
, header
, NULL
);
655 return (i
>= 0 ? HASH_VALUE (h
, i
) : Qnil
);
659 composition_gstring_put_cache (Lisp_Object gstring
, ptrdiff_t len
)
661 struct Lisp_Hash_Table
*h
= XHASH_TABLE (gstring_hash_table
);
663 Lisp_Object header
, copy
;
666 header
= LGSTRING_HEADER (gstring
);
667 hash
= h
->test
.hashfn (&h
->test
, header
);
670 ptrdiff_t j
, glyph_len
= LGSTRING_GLYPH_LEN (gstring
);
671 for (j
= 0; j
< glyph_len
; j
++)
672 if (NILP (LGSTRING_GLYPH (gstring
, j
)))
677 assume (len
<= TYPE_MAXIMUM (ptrdiff_t) - 2);
678 copy
= Fmake_vector (make_number (len
+ 2), Qnil
);
679 LGSTRING_SET_HEADER (copy
, Fcopy_sequence (header
));
680 for (i
= 0; i
< len
; i
++)
681 LGSTRING_SET_GLYPH (copy
, i
, Fcopy_sequence (LGSTRING_GLYPH (gstring
, i
)));
682 i
= hash_put (h
, LGSTRING_HEADER (copy
), copy
, hash
);
683 LGSTRING_SET_ID (copy
, make_number (i
));
688 composition_gstring_from_id (ptrdiff_t id
)
690 struct Lisp_Hash_Table
*h
= XHASH_TABLE (gstring_hash_table
);
692 return HASH_VALUE (h
, id
);
696 composition_gstring_p (Lisp_Object gstring
)
701 if (! VECTORP (gstring
) || ASIZE (gstring
) < 2)
703 header
= LGSTRING_HEADER (gstring
);
704 if (! VECTORP (header
) || ASIZE (header
) < 2)
706 if (! NILP (LGSTRING_FONT (gstring
))
707 && (! FONT_OBJECT_P (LGSTRING_FONT (gstring
))
708 && ! CODING_SYSTEM_P (LGSTRING_FONT (gstring
))))
710 for (i
= 1; i
< ASIZE (LGSTRING_HEADER (gstring
)); i
++)
711 if (! NATNUMP (AREF (LGSTRING_HEADER (gstring
), i
)))
713 if (! NILP (LGSTRING_ID (gstring
)) && ! NATNUMP (LGSTRING_ID (gstring
)))
715 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
717 Lisp_Object glyph
= LGSTRING_GLYPH (gstring
, i
);
720 if (! VECTORP (glyph
) || ASIZE (glyph
) != LGLYPH_SIZE
)
727 composition_gstring_width (Lisp_Object gstring
, ptrdiff_t from
, ptrdiff_t to
,
728 struct font_metrics
*metrics
)
735 Lisp_Object font_object
= LGSTRING_FONT (gstring
);
737 if (FONT_OBJECT_P (font_object
))
739 struct font
*font
= XFONT_OBJECT (font_object
);
741 metrics
->ascent
= font
->ascent
;
742 metrics
->descent
= font
->descent
;
747 metrics
->descent
= 0;
749 metrics
->width
= metrics
->lbearing
= metrics
->rbearing
= 0;
751 for (glyph
= lgstring_glyph_addr (gstring
, from
); from
< to
; from
++, glyph
++)
755 if (NILP (LGLYPH_ADJUSTMENT (*glyph
)))
756 width
+= LGLYPH_WIDTH (*glyph
);
758 width
+= LGLYPH_WADJUST (*glyph
);
761 x
= metrics
->width
+ LGLYPH_LBEARING (*glyph
) + LGLYPH_XOFF (*glyph
);
762 if (metrics
->lbearing
> x
)
763 metrics
->lbearing
= x
;
764 x
= metrics
->width
+ LGLYPH_RBEARING (*glyph
) + LGLYPH_XOFF (*glyph
);
765 if (metrics
->rbearing
< x
)
766 metrics
->rbearing
= x
;
767 metrics
->width
= width
;
768 x
= LGLYPH_ASCENT (*glyph
) - LGLYPH_YOFF (*glyph
);
769 if (metrics
->ascent
< x
)
771 x
= LGLYPH_DESCENT (*glyph
) + LGLYPH_YOFF (*glyph
);
772 if (metrics
->descent
< x
)
773 metrics
->descent
= x
;
780 static Lisp_Object gstring_work
;
781 static Lisp_Object gstring_work_headers
;
784 fill_gstring_header (Lisp_Object header
, Lisp_Object start
, Lisp_Object end
,
785 Lisp_Object font_object
, Lisp_Object string
)
787 ptrdiff_t from
, to
, from_byte
;
792 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
793 error ("Attempt to shape unibyte text");
794 validate_region (&start
, &end
);
795 from
= XFASTINT (start
);
797 from_byte
= CHAR_TO_BYTE (from
);
801 CHECK_STRING (string
);
802 if (! STRING_MULTIBYTE (string
))
803 error ("Attempt to shape unibyte text");
804 /* The caller checks that START and END are nonnegative integers. */
805 if (! (XINT (start
) <= XINT (end
) && XINT (end
) <= SCHARS (string
)))
806 args_out_of_range_3 (string
, start
, end
);
809 from_byte
= string_char_to_byte (string
, from
);
814 error ("Attempt to shape zero-length text");
815 if (VECTORP (header
))
817 if (ASIZE (header
) != len
+ 1)
818 args_out_of_range (header
, make_number (len
+ 1));
823 header
= AREF (gstring_work_headers
, len
- 1);
825 header
= make_uninit_vector (len
+ 1);
828 ASET (header
, 0, font_object
);
829 for (i
= 0; i
< len
; i
++)
834 FETCH_CHAR_ADVANCE_NO_CHECK (c
, from
, from_byte
);
836 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, from
, from_byte
);
837 ASET (header
, i
+ 1, make_number (c
));
843 fill_gstring_body (Lisp_Object gstring
)
845 Lisp_Object font_object
= LGSTRING_FONT (gstring
);
846 Lisp_Object header
= AREF (gstring
, 0);
847 ptrdiff_t len
= LGSTRING_CHAR_LEN (gstring
);
850 for (i
= 0; i
< len
; i
++)
852 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
853 int c
= XFASTINT (AREF (header
, i
+ 1));
858 LGSTRING_SET_GLYPH (gstring
, i
, g
);
860 LGLYPH_SET_FROM (g
, i
);
861 LGLYPH_SET_TO (g
, i
);
862 LGLYPH_SET_CHAR (g
, c
);
863 if (FONT_OBJECT_P (font_object
))
865 font_fill_lglyph_metrics (g
, font_object
);
869 int width
= XFASTINT (CHAR_TABLE_REF (Vchar_width_table
, c
));
871 LGLYPH_SET_CODE (g
, c
);
872 LGLYPH_SET_LBEARING (g
, 0);
873 LGLYPH_SET_RBEARING (g
, width
);
874 LGLYPH_SET_WIDTH (g
, width
);
875 LGLYPH_SET_ASCENT (g
, 1);
876 LGLYPH_SET_DESCENT (g
, 0);
878 LGLYPH_SET_ADJUSTMENT (g
, Qnil
);
880 if (i
< LGSTRING_GLYPH_LEN (gstring
))
881 LGSTRING_SET_GLYPH (gstring
, i
, Qnil
);
885 /* Try to compose the characters at CHARPOS according to composition
886 rule RULE ([PATTERN PREV-CHARS FUNC]). LIMIT limits the characters
887 to compose. STRING, if not nil, is a target string. WIN is a
888 window where the characters are being displayed. If characters are
889 successfully composed, return the composition as a glyph-string
890 object. Otherwise return nil. */
893 autocmp_chars (Lisp_Object rule
, ptrdiff_t charpos
, ptrdiff_t bytepos
,
894 ptrdiff_t limit
, struct window
*win
, struct face
*face
,
897 ptrdiff_t count
= SPECPDL_INDEX ();
898 struct frame
*f
= XFRAME (win
->frame
);
899 Lisp_Object pos
= make_number (charpos
);
901 ptrdiff_t pt
= PT
, pt_byte
= PT_BYTE
;
902 Lisp_Object re
, font_object
, lgstring
;
905 record_unwind_save_match_data ();
909 else if (! STRINGP (re
))
910 return unbind_to (count
, Qnil
);
911 else if ((len
= fast_looking_at (re
, charpos
, bytepos
, limit
, -1, string
))
915 len
= BYTE_TO_CHAR (bytepos
+ len
) - charpos
;
917 len
= string_byte_to_char (string
, bytepos
+ len
) - charpos
;
920 return unbind_to (count
, Qnil
);
921 to
= limit
= charpos
+ len
;
922 #ifdef HAVE_WINDOW_SYSTEM
923 if (FRAME_WINDOW_P (f
))
925 font_object
= font_range (charpos
, bytepos
, &to
, win
, face
, string
);
926 if (! FONT_OBJECT_P (font_object
)
929 && (fast_looking_at (re
, charpos
, bytepos
, to
, -1, string
) <= 0)))
930 return unbind_to (count
, Qnil
);
933 #endif /* not HAVE_WINDOW_SYSTEM */
934 font_object
= win
->frame
;
935 lgstring
= Fcomposition_get_gstring (pos
, make_number (to
), font_object
,
937 if (NILP (LGSTRING_ID (lgstring
)))
939 /* Save point as marker before calling out to lisp. */
941 record_unwind_protect (restore_point_unwind
,
942 build_marker (current_buffer
, pt
, pt_byte
));
943 lgstring
= safe_call (6, Vauto_composition_function
, AREF (rule
, 2),
944 pos
, make_number (to
), font_object
, string
);
946 return unbind_to (count
, lgstring
);
949 static Lisp_Object _work_val
;
951 /* 1 iff the character C is composable. Characters of general
952 category Z? or C? are not composable except for ZWNJ and ZWJ. */
954 #define CHAR_COMPOSABLE_P(C) \
956 && ((C) == 0x200C || (C) == 0x200D \
957 || (_work_val = CHAR_TABLE_REF (Vunicode_category_table, (C)), \
958 (INTEGERP (_work_val) \
959 && (XINT (_work_val) <= UNICODE_CATEGORY_So)))))
961 /* Update cmp_it->stop_pos to the next position after CHARPOS (and
962 BYTEPOS) where character composition may happen. If BYTEPOS is
963 negative, compute it. ENDPOS is a limit of searching. If it is
964 less than CHARPOS, search backward to ENDPOS+1 assuming that
965 set_iterator_to_next works in reverse order. In this case, if a
966 composition closest to CHARPOS is found, set cmp_it->stop_pos to
967 the last character of the composition.
969 If no composition is found, set cmp_it->ch to -2. If a static
970 composition is found, set cmp_it->ch to -1. Otherwise, set
971 cmp_it->ch to the character that triggers the automatic
975 composition_compute_stop_pos (struct composition_it
*cmp_it
, ptrdiff_t charpos
, ptrdiff_t bytepos
, ptrdiff_t endpos
, Lisp_Object string
)
977 ptrdiff_t start
, end
;
979 Lisp_Object prop
, val
;
980 /* This is from forward_to_next_line_start in xdisp.c. */
981 const int MAX_NEWLINE_DISTANCE
= 500;
983 if (charpos
< endpos
)
985 if (endpos
> charpos
+ MAX_NEWLINE_DISTANCE
)
986 endpos
= charpos
+ MAX_NEWLINE_DISTANCE
;
988 else if (endpos
< charpos
)
990 /* We search backward for a position to check composition. */
993 /* But we don't know where to stop the searching. */
994 endpos
= NILP (string
) ? BEGV
- 1 : -1;
995 /* Usually we don't reach ENDPOS because we stop searching
996 at an uncomposable character (NL, LRE, etc). */
1001 cmp_it
->reversed_p
= 0;
1002 cmp_it
->stop_pos
= endpos
;
1003 if (charpos
== endpos
)
1005 /* FIXME: Bidi is not yet handled well in static composition. */
1006 if (charpos
< endpos
1007 && find_composition (charpos
, endpos
, &start
, &end
, &prop
, string
)
1009 && composition_valid_p (start
, end
, prop
))
1011 cmp_it
->stop_pos
= endpos
= start
;
1014 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
))
1015 || NILP (Vauto_composition_mode
))
1020 bytepos
= CHAR_TO_BYTE (charpos
);
1022 bytepos
= string_char_to_byte (string
, charpos
);
1026 if (charpos
< endpos
)
1028 /* Forward search. */
1029 while (charpos
< endpos
)
1031 if (STRINGP (string
))
1032 FETCH_STRING_CHAR_ADVANCE (c
, string
, charpos
, bytepos
);
1034 FETCH_CHAR_ADVANCE (c
, charpos
, bytepos
);
1040 val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1046 for (ridx
= 0; CONSP (val
); val
= XCDR (val
), ridx
++)
1049 if (VECTORP (elt
) && ASIZE (elt
) == 3
1050 && NATNUMP (AREF (elt
, 1))
1051 && charpos
- 1 - XFASTINT (AREF (elt
, 1)) >= start
)
1056 cmp_it
->rule_idx
= ridx
;
1057 cmp_it
->lookback
= XFASTINT (AREF (elt
, 1));
1058 cmp_it
->stop_pos
= charpos
- 1 - cmp_it
->lookback
;
1064 if (charpos
== endpos
)
1066 /* We couldn't find a composition point before ENDPOS. But,
1067 some character after ENDPOS may be composed with
1068 characters before ENDPOS. So, we should stop at the safe
1070 charpos
= endpos
- MAX_AUTO_COMPOSITION_LOOKBACK
;
1071 if (charpos
< start
)
1075 else if (charpos
> endpos
)
1077 /* Search backward for a pattern that may be composed and the
1078 position of (possibly) the last character of the match is
1079 closest to (but not after) START. The reason for the last
1080 character is that set_iterator_to_next works in reverse order,
1081 and thus we must stop at the last character for composition
1085 /* Limit byte position used in fast_looking_at. This is the
1086 byte position of the character after START. */
1090 p
= BYTE_POS_ADDR (bytepos
);
1092 p
= SDATA (string
) + bytepos
;
1093 c
= STRING_CHAR_AND_LENGTH (p
, len
);
1094 limit
= bytepos
+ len
;
1095 while (CHAR_COMPOSABLE_P (c
))
1097 val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1103 for (ridx
= 0; CONSP (val
); val
= XCDR (val
), ridx
++)
1106 if (VECTORP (elt
) && ASIZE (elt
) == 3
1107 && NATNUMP (AREF (elt
, 1))
1108 && charpos
- XFASTINT (AREF (elt
, 1)) > endpos
)
1110 ptrdiff_t back
= XFASTINT (AREF (elt
, 1));
1111 ptrdiff_t cpos
= charpos
- back
, bpos
;
1116 bpos
= (NILP (string
) ? CHAR_TO_BYTE (cpos
)
1117 : string_char_to_byte (string
, cpos
));
1118 if (STRINGP (AREF (elt
, 0)))
1119 blen
= fast_looking_at (AREF (elt
, 0), cpos
, bpos
,
1120 start
+ 1, limit
, string
);
1125 /* Make CPOS point to the last character of
1126 match. Note that BLEN is byte-length. */
1131 cpos
= BYTE_TO_CHAR (bpos
) - 1;
1133 cpos
= string_byte_to_char (string
, bpos
) - 1;
1135 back
= cpos
- (charpos
- back
);
1136 if (cmp_it
->stop_pos
< cpos
1137 || (cmp_it
->stop_pos
== cpos
1138 && cmp_it
->lookback
< back
))
1140 cmp_it
->rule_idx
= ridx
;
1141 cmp_it
->stop_pos
= cpos
;
1143 cmp_it
->lookback
= back
;
1144 cmp_it
->nchars
= back
+ 1;
1150 if (charpos
- 1 == endpos
)
1152 if (STRINGP (string
))
1155 while (! CHAR_HEAD_P (*p
))
1161 DEC_BOTH (charpos
, bytepos
);
1162 p
= BYTE_POS_ADDR (bytepos
);
1164 c
= STRING_CHAR (p
);
1166 if (cmp_it
->ch
>= 0)
1167 /* We found a position to check. */
1169 /* Skip all uncomposable characters. */
1172 while (charpos
- 1 > endpos
&& ! CHAR_COMPOSABLE_P (c
))
1174 DEC_BOTH (charpos
, bytepos
);
1175 c
= FETCH_MULTIBYTE_CHAR (bytepos
);
1180 while (charpos
- 1 > endpos
&& ! CHAR_COMPOSABLE_P (c
))
1183 while (! CHAR_HEAD_P (*p
))
1186 c
= STRING_CHAR (p
);
1190 cmp_it
->stop_pos
= charpos
;
1193 /* Check if the character at CHARPOS (and BYTEPOS) is composed
1194 (possibly with the following characters) on window W. ENDPOS limits
1195 characters to be composed. FACE, in non-NULL, is a base face of
1196 the character. If STRING is not nil, it is a string containing the
1197 character to check, and CHARPOS and BYTEPOS are indices in the
1198 string. In that case, FACE must not be NULL.
1200 If the character is composed, setup members of CMP_IT (id, nglyphs,
1201 from, to, reversed_p), and return true. Otherwise, update
1202 CMP_IT->stop_pos, and return false. */
1205 composition_reseat_it (struct composition_it
*cmp_it
, ptrdiff_t charpos
,
1206 ptrdiff_t bytepos
, ptrdiff_t endpos
, struct window
*w
,
1207 struct face
*face
, Lisp_Object string
)
1209 if (cmp_it
->ch
== -2)
1211 composition_compute_stop_pos (cmp_it
, charpos
, bytepos
, endpos
, string
);
1212 if (cmp_it
->ch
== -2 || cmp_it
->stop_pos
!= charpos
)
1213 /* The current position is not composed. */
1218 endpos
= NILP (string
) ? BEGV
: 0;
1222 /* We are looking at a static composition. */
1223 ptrdiff_t start
, end
;
1226 find_composition (charpos
, -1, &start
, &end
, &prop
, string
);
1227 cmp_it
->id
= get_composition_id (charpos
, bytepos
, end
- start
,
1230 goto no_composition
;
1231 cmp_it
->nchars
= end
- start
;
1232 cmp_it
->nglyphs
= composition_table
[cmp_it
->id
]->glyph_len
;
1236 Lisp_Object lgstring
= Qnil
;
1237 Lisp_Object val
, elt
;
1240 val
= CHAR_TABLE_REF (Vcomposition_function_table
, cmp_it
->ch
);
1241 for (i
= 0; i
< cmp_it
->rule_idx
; i
++, val
= XCDR (val
));
1242 if (charpos
< endpos
)
1244 for (; CONSP (val
); val
= XCDR (val
))
1247 if (! VECTORP (elt
) || ASIZE (elt
) != 3
1248 || ! INTEGERP (AREF (elt
, 1)))
1250 if (XFASTINT (AREF (elt
, 1)) != cmp_it
->lookback
)
1251 goto no_composition
;
1252 lgstring
= autocmp_chars (elt
, charpos
, bytepos
, endpos
,
1254 if (composition_gstring_p (lgstring
))
1257 /* Composition failed perhaps because the font doesn't
1258 support sufficient range of characters. Try the
1259 other composition rules if any. */
1261 cmp_it
->reversed_p
= 0;
1265 ptrdiff_t cpos
= charpos
, bpos
= bytepos
;
1267 cmp_it
->reversed_p
= 1;
1269 if (cmp_it
->lookback
> 0)
1271 cpos
= charpos
- cmp_it
->lookback
;
1272 if (STRINGP (string
))
1273 bpos
= string_char_to_byte (string
, cpos
);
1275 bpos
= CHAR_TO_BYTE (cpos
);
1277 lgstring
= autocmp_chars (elt
, cpos
, bpos
, charpos
+ 1, w
, face
,
1279 if (! composition_gstring_p (lgstring
)
1280 || cpos
+ LGSTRING_CHAR_LEN (lgstring
) - 1 != charpos
)
1281 /* Composition failed or didn't cover the current
1283 goto no_composition
;
1285 if (NILP (lgstring
))
1286 goto no_composition
;
1287 if (NILP (LGSTRING_ID (lgstring
)))
1288 lgstring
= composition_gstring_put_cache (lgstring
, -1);
1289 cmp_it
->id
= XINT (LGSTRING_ID (lgstring
));
1290 for (i
= 0; i
< LGSTRING_GLYPH_LEN (lgstring
); i
++)
1291 if (NILP (LGSTRING_GLYPH (lgstring
, i
)))
1293 cmp_it
->nglyphs
= i
;
1298 goto no_composition
;
1302 if (charpos
== endpos
)
1304 if (charpos
< endpos
)
1310 bytepos
+= BYTES_BY_CHAR_HEAD (*(SDATA (string
) + bytepos
));
1315 /* BYTEPOS is calculated in composition_compute_stop_pos */
1318 if (cmp_it
->reversed_p
)
1320 composition_compute_stop_pos (cmp_it
, charpos
, bytepos
, endpos
, string
);
1324 /* Update charpos, nchars, nbytes, and width of the current grapheme
1327 If the composition is static or automatic in L2R context, the
1328 cluster is identified by CMP_IT->from, and CHARPOS is the position
1329 of the first character of the cluster. In this case, update
1332 If the composition is automatic in R2L context, the cluster is
1333 identified by CMP_IT->to, and CHARPOS is the position of the last
1334 character of the cluster. In this case, update CMP_IT->from too.
1336 The return value is the character code of the first character of
1337 the cluster, or -1 if the composition is somehow broken. */
1340 composition_update_it (struct composition_it
*cmp_it
, ptrdiff_t charpos
, ptrdiff_t bytepos
, Lisp_Object string
)
1342 int i
, c
IF_LINT (= 0);
1346 /* static composition */
1347 struct composition
*cmp
= composition_table
[cmp_it
->id
];
1349 cmp_it
->charpos
= charpos
;
1350 cmp_it
->to
= cmp_it
->nglyphs
;
1351 if (cmp_it
->nglyphs
== 0)
1355 for (i
= 0; i
< cmp
->glyph_len
; i
++)
1356 /* TAB in a composition means display glyphs with padding
1357 space on the left or right. */
1358 if ((c
= COMPOSITION_GLYPH (cmp
, i
)) != '\t')
1363 cmp_it
->width
= cmp
->width
;
1364 charpos
+= cmp_it
->nchars
;
1365 if (STRINGP (string
))
1366 cmp_it
->nbytes
= string_char_to_byte (string
, charpos
) - bytepos
;
1368 cmp_it
->nbytes
= CHAR_TO_BYTE (charpos
) - bytepos
;
1372 /* Automatic composition. */
1373 Lisp_Object gstring
= composition_gstring_from_id (cmp_it
->id
);
1377 if (cmp_it
->nglyphs
== 0)
1379 cmp_it
->nchars
= LGSTRING_CHAR_LEN (gstring
);
1381 cmp_it
->from
= cmp_it
->to
= 0;
1384 if (! cmp_it
->reversed_p
)
1386 glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->from
);
1387 from
= LGLYPH_FROM (glyph
);
1388 for (cmp_it
->to
= cmp_it
->from
+ 1; cmp_it
->to
< cmp_it
->nglyphs
;
1391 glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->to
);
1392 if (LGLYPH_FROM (glyph
) != from
)
1395 cmp_it
->charpos
= charpos
;
1399 glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->to
- 1);
1400 from
= LGLYPH_FROM (glyph
);
1401 cmp_it
->charpos
= charpos
- (LGLYPH_TO (glyph
) - from
);
1402 for (cmp_it
->from
= cmp_it
->to
- 1; cmp_it
->from
> 0;
1405 glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->from
- 1);
1406 if (LGLYPH_FROM (glyph
) != from
)
1410 glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->from
);
1411 cmp_it
->nchars
= LGLYPH_TO (glyph
) + 1 - from
;
1414 for (i
= cmp_it
->nchars
- 1; i
>= 0; i
--)
1416 c
= XINT (LGSTRING_CHAR (gstring
, i
));
1417 cmp_it
->nbytes
+= CHAR_BYTES (c
);
1418 cmp_it
->width
+= CHAR_WIDTH (c
);
1425 struct position_record
1427 ptrdiff_t pos
, pos_byte
;
1431 /* Update the members of POSITION to the next character boundary. */
1432 #define FORWARD_CHAR(POSITION, STOP) \
1435 if ((POSITION).pos == (STOP)) \
1437 (POSITION).p = GAP_END_ADDR; \
1438 (POSITION).pos_byte = GPT_BYTE; \
1442 (POSITION).pos_byte += BYTES_BY_CHAR_HEAD (*((POSITION).p)); \
1443 (POSITION).p += BYTES_BY_CHAR_HEAD (*((POSITION).p)); \
1447 /* Update the members of POSITION to the previous character boundary. */
1448 #define BACKWARD_CHAR(POSITION, STOP) \
1450 if ((POSITION).pos == (STOP)) \
1451 (POSITION).p = GPT_ADDR; \
1453 (POSITION).pos_byte--; \
1455 } while (! CHAR_HEAD_P (*((POSITION).p))); \
1459 /* This is like find_composition, but find an automatic composition
1460 instead. It is assured that POS is not within a static
1461 composition. If found, set *GSTRING to the glyph-string
1462 representing the composition, and return true. Otherwise, *GSTRING to
1463 Qnil, and return false. */
1466 find_automatic_composition (ptrdiff_t pos
, ptrdiff_t limit
,
1467 ptrdiff_t *start
, ptrdiff_t *end
,
1468 Lisp_Object
*gstring
, Lisp_Object string
)
1470 ptrdiff_t head
, tail
, stop
;
1471 /* Forward limit position of checking a composition taking a
1472 looking-back count into account. */
1473 ptrdiff_t fore_check_limit
;
1474 struct position_record cur
, prev
;
1478 bool need_adjustment
= 0;
1480 window
= Fget_buffer_window (Fcurrent_buffer (), Qnil
);
1483 w
= XWINDOW (window
);
1488 head
= BEGV
, tail
= ZV
, stop
= GPT
;
1489 cur
.pos_byte
= CHAR_TO_BYTE (cur
.pos
);
1490 cur
.p
= BYTE_POS_ADDR (cur
.pos_byte
);
1494 head
= 0, tail
= SCHARS (string
), stop
= -1;
1495 cur
.pos_byte
= string_char_to_byte (string
, cur
.pos
);
1496 cur
.p
= SDATA (string
) + cur
.pos_byte
;
1499 /* Finding a composition covering the character after POS is the
1500 same as setting LIMIT to POS. */
1503 fore_check_limit
= min (tail
, pos
+ 1 + MAX_AUTO_COMPOSITION_LOOKBACK
);
1505 fore_check_limit
= min (tail
, limit
+ MAX_AUTO_COMPOSITION_LOOKBACK
);
1507 /* Provided that we have these possible compositions now:
1509 POS: 1 2 3 4 5 6 7 8 9
1513 Here, it is known that characters after positions 1 and 9 can
1514 never be composed (i.e. ! CHAR_COMPOSABLE_P (CH)), and
1515 composition A is an invalid one because it's partially covered by
1516 the valid composition C. And to know whether a composition is
1517 valid or not, the only way is to start searching forward from a
1518 position that can not be a tail part of composition (it's 2 in
1521 Now we have these cases (1 through 4):
1523 -- character after POS is ... --
1524 not composable composable
1525 LIMIT <= POS (1) (3)
1528 Among them, in case (2), we simply search forward from POS.
1530 In the other cases, we at first rewind back to the position where
1531 the previous character is not composable or the beginning of
1532 buffer (string), then search compositions forward. In case (1)
1533 and (3) we repeat this process until a composition is found. */
1537 c
= STRING_CHAR (cur
.p
);
1538 if (! CHAR_COMPOSABLE_P (c
))
1540 if (limit
<= pos
) /* case (1) */
1543 if (cur
.pos
<= limit
)
1545 BACKWARD_CHAR (cur
, stop
);
1546 c
= STRING_CHAR (cur
.p
);
1547 } while (! CHAR_COMPOSABLE_P (c
));
1548 fore_check_limit
= cur
.pos
+ 1;
1551 /* No need of rewinding back. */
1552 goto search_forward
;
1555 /* Rewind back to the position where we can safely search
1556 forward for compositions. It is assured that the character
1557 at cur.pos is composable. */
1558 while (head
< cur
.pos
)
1561 BACKWARD_CHAR (cur
, stop
);
1562 c
= STRING_CHAR (cur
.p
);
1563 if (! CHAR_COMPOSABLE_P (c
))
1571 /* Now search forward. */
1573 prev
= cur
; /* remember the start of searching position. */
1574 while (cur
.pos
< fore_check_limit
)
1578 c
= STRING_CHAR (cur
.p
);
1579 for (val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1580 CONSP (val
); val
= XCDR (val
))
1582 Lisp_Object elt
= XCAR (val
);
1584 if (VECTORP (elt
) && ASIZE (elt
) == 3 && NATNUMP (AREF (elt
, 1)))
1586 EMACS_INT check_pos
= cur
.pos
- XFASTINT (AREF (elt
, 1));
1587 struct position_record check
;
1589 if (check_pos
< head
1590 || (limit
<= pos
? pos
< check_pos
1591 : limit
<= check_pos
))
1593 for (check
= cur
; check_pos
< check
.pos
; )
1594 BACKWARD_CHAR (check
, stop
);
1595 *gstring
= autocmp_chars (elt
, check
.pos
, check
.pos_byte
,
1596 tail
, w
, NULL
, string
);
1597 need_adjustment
= 1;
1598 if (NILP (*gstring
))
1600 /* As we have called Lisp, there's a possibility
1601 that buffer/string is relocated. */
1603 cur
.p
= BYTE_POS_ADDR (cur
.pos_byte
);
1605 cur
.p
= SDATA (string
) + cur
.pos_byte
;
1609 /* We found a candidate of a target composition. */
1611 *end
= check
.pos
+ LGSTRING_CHAR_LEN (*gstring
);
1614 : *start
<= pos
&& pos
< *end
)
1615 /* This is the target composition. */
1620 cur
.pos_byte
= CHAR_TO_BYTE (cur
.pos
);
1621 cur
.p
= BYTE_POS_ADDR (cur
.pos_byte
);
1625 cur
.pos_byte
= string_char_to_byte (string
, cur
.pos
);
1626 cur
.p
= SDATA (string
) + cur
.pos_byte
;
1633 /* We found no composition here. */
1634 FORWARD_CHAR (cur
, stop
);
1637 if (pos
< limit
) /* case (2) and (4)*/
1639 if (! NILP (*gstring
))
1641 if (prev
.pos
== head
)
1644 if (need_adjustment
)
1647 cur
.p
= BYTE_POS_ADDR (cur
.pos_byte
);
1649 cur
.p
= SDATA (string
) + cur
.pos_byte
;
1651 BACKWARD_CHAR (cur
, stop
);
1655 /* Return the adjusted point provided that point is moved from LAST_PT
1659 composition_adjust_point (ptrdiff_t last_pt
, ptrdiff_t new_pt
)
1661 ptrdiff_t i
, beg
, end
;
1664 if (new_pt
== BEGV
|| new_pt
== ZV
)
1667 /* At first check the static composition. */
1668 if (get_property_and_range (new_pt
, Qcomposition
, &val
, &beg
, &end
, Qnil
)
1669 && composition_valid_p (beg
, end
, val
))
1671 if (beg
< new_pt
/* && end > new_pt <- It's always the case. */
1672 && (last_pt
<= beg
|| last_pt
>= end
))
1673 return (new_pt
< last_pt
? beg
: end
);
1677 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
))
1678 || NILP (Vauto_composition_mode
))
1681 /* Next check the automatic composition. */
1682 if (! find_automatic_composition (new_pt
, (ptrdiff_t) -1, &beg
, &end
, &val
,
1686 for (i
= 0; i
< LGSTRING_GLYPH_LEN (val
); i
++)
1688 Lisp_Object glyph
= LGSTRING_GLYPH (val
, i
);
1692 if (beg
+ LGLYPH_FROM (glyph
) == new_pt
)
1694 if (beg
+ LGLYPH_TO (glyph
) >= new_pt
)
1695 return (new_pt
< last_pt
1696 ? beg
+ LGLYPH_FROM (glyph
)
1697 : beg
+ LGLYPH_TO (glyph
) + 1);
1702 DEFUN ("composition-get-gstring", Fcomposition_get_gstring
,
1703 Scomposition_get_gstring
, 4, 4, 0,
1704 doc
: /* Return a glyph-string for characters between FROM and TO.
1705 If the glyph string is for graphic display, FONT-OBJECT must be
1706 a font-object to use for those characters.
1707 Otherwise (for terminal display), FONT-OBJECT must be a terminal ID, a
1708 frame, or nil for the selected frame's terminal device.
1710 If the optional 4th argument STRING is not nil, it is a string
1711 containing the target characters between indices FROM and TO.
1713 A glyph-string is a vector containing information about how to display
1714 a specific character sequence. The format is:
1715 [HEADER ID GLYPH ...]
1717 HEADER is a vector of this form:
1718 [FONT-OBJECT CHAR ...]
1720 FONT-OBJECT is a font-object for all glyphs in the glyph-string,
1721 or the terminal coding system of the specified terminal.
1722 CHARs are characters to be composed by GLYPHs.
1724 ID is an identification number of the glyph-string. It may be nil if
1727 GLYPH is a vector whose elements have this form:
1728 [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT
1729 [ [X-OFF Y-OFF WADJUST] | nil] ]
1731 FROM-IDX and TO-IDX are used internally and should not be touched.
1732 C is the character of the glyph.
1733 CODE is the glyph-code of C in FONT-OBJECT.
1734 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
1735 X-OFF and Y-OFF are offsets to the base position for the glyph.
1736 WADJUST is the adjustment to the normal width of the glyph.
1738 If GLYPH is nil, the remaining elements of the glyph-string vector
1739 should be ignored. */)
1740 (Lisp_Object from
, Lisp_Object to
, Lisp_Object font_object
, Lisp_Object string
)
1742 Lisp_Object gstring
, header
;
1743 ptrdiff_t frompos
, topos
;
1745 CHECK_NATNUM (from
);
1747 if (! FONT_OBJECT_P (font_object
))
1749 struct coding_system
*coding
;
1750 struct terminal
*terminal
= get_terminal (font_object
, 1);
1752 coding
= ((TERMINAL_TERMINAL_CODING (terminal
)->common_flags
1753 & CODING_REQUIRE_ENCODING_MASK
)
1754 ? TERMINAL_TERMINAL_CODING (terminal
) : &safe_terminal_coding
);
1755 font_object
= CODING_ID_NAME (coding
->id
);
1758 header
= fill_gstring_header (Qnil
, from
, to
, font_object
, string
);
1759 gstring
= gstring_lookup_cache (header
);
1760 if (! NILP (gstring
))
1763 frompos
= XINT (from
);
1765 if (LGSTRING_GLYPH_LEN (gstring_work
) < topos
- frompos
)
1766 gstring_work
= Fmake_vector (make_number (topos
- frompos
+ 2), Qnil
);
1767 LGSTRING_SET_HEADER (gstring_work
, header
);
1768 LGSTRING_SET_ID (gstring_work
, Qnil
);
1769 fill_gstring_body (gstring_work
);
1770 return gstring_work
;
1774 /* Emacs Lisp APIs. */
1776 DEFUN ("compose-region-internal", Fcompose_region_internal
,
1777 Scompose_region_internal
, 2, 4, 0,
1778 doc
: /* Internal use only.
1780 Compose text in the region between START and END.
1781 Optional 3rd and 4th arguments are COMPONENTS and MODIFICATION-FUNC
1782 for the composition. See `compose-region' for more details. */)
1783 (Lisp_Object start
, Lisp_Object end
, Lisp_Object components
, Lisp_Object modification_func
)
1785 validate_region (&start
, &end
);
1786 if (!NILP (components
)
1787 && !INTEGERP (components
)
1788 && !CONSP (components
)
1789 && !STRINGP (components
))
1790 CHECK_VECTOR (components
);
1792 compose_text (XINT (start
), XINT (end
), components
, modification_func
, Qnil
);
1796 DEFUN ("compose-string-internal", Fcompose_string_internal
,
1797 Scompose_string_internal
, 3, 5, 0,
1798 doc
: /* Internal use only.
1800 Compose text between indices START and END of STRING.
1801 Optional 4th and 5th arguments are COMPONENTS and MODIFICATION-FUNC
1802 for the composition. See `compose-string' for more details. */)
1803 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
, Lisp_Object components
, Lisp_Object modification_func
)
1805 CHECK_STRING (string
);
1806 CHECK_NUMBER (start
);
1809 if (XINT (start
) < 0 ||
1810 XINT (start
) > XINT (end
)
1811 || XINT (end
) > SCHARS (string
))
1812 args_out_of_range (start
, end
);
1814 compose_text (XINT (start
), XINT (end
), components
, modification_func
, string
);
1818 DEFUN ("find-composition-internal", Ffind_composition_internal
,
1819 Sfind_composition_internal
, 4, 4, 0,
1820 doc
: /* Internal use only.
1822 Return information about composition at or nearest to position POS.
1823 See `find-composition' for more details. */)
1824 (Lisp_Object pos
, Lisp_Object limit
, Lisp_Object string
, Lisp_Object detail_p
)
1826 Lisp_Object prop
, tail
, gstring
;
1827 ptrdiff_t start
, end
, from
, to
;
1830 CHECK_NUMBER_COERCE_MARKER (pos
);
1833 CHECK_NUMBER_COERCE_MARKER (limit
);
1834 to
= min (XINT (limit
), ZV
);
1841 CHECK_STRING (string
);
1842 if (XINT (pos
) < 0 || XINT (pos
) > SCHARS (string
))
1843 args_out_of_range (string
, pos
);
1847 if (XINT (pos
) < BEGV
|| XINT (pos
) > ZV
)
1848 args_out_of_range (Fcurrent_buffer (), pos
);
1852 if (!find_composition (from
, to
, &start
, &end
, &prop
, string
))
1854 if (!NILP (BVAR (current_buffer
, enable_multibyte_characters
))
1855 && ! NILP (Vauto_composition_mode
)
1856 && find_automatic_composition (from
, to
, &start
, &end
, &gstring
,
1858 return list3 (make_number (start
), make_number (end
), gstring
);
1861 if ((end
<= XINT (pos
) || start
> XINT (pos
)))
1865 if (find_automatic_composition (from
, to
, &s
, &e
, &gstring
, string
)
1866 && (e
<= XINT (pos
) ? e
> end
: s
< start
))
1867 return list3 (make_number (s
), make_number (e
), gstring
);
1869 if (!composition_valid_p (start
, end
, prop
))
1870 return list3 (make_number (start
), make_number (end
), Qnil
);
1871 if (NILP (detail_p
))
1872 return list3 (make_number (start
), make_number (end
), Qt
);
1874 if (composition_registered_p (prop
))
1875 id
= COMPOSITION_ID (prop
);
1878 ptrdiff_t start_byte
= (NILP (string
)
1879 ? CHAR_TO_BYTE (start
)
1880 : string_char_to_byte (string
, start
));
1881 id
= get_composition_id (start
, start_byte
, end
- start
, prop
, string
);
1886 Lisp_Object components
, relative_p
, mod_func
;
1887 enum composition_method method
= composition_method (prop
);
1888 int width
= composition_table
[id
]->width
;
1890 components
= Fcopy_sequence (COMPOSITION_COMPONENTS (prop
));
1891 relative_p
= (method
== COMPOSITION_WITH_RULE_ALTCHARS
1893 mod_func
= COMPOSITION_MODIFICATION_FUNC (prop
);
1894 tail
= list4 (components
, relative_p
, mod_func
, make_number (width
));
1899 return Fcons (make_number (start
), Fcons (make_number (end
), tail
));
1904 syms_of_composite (void)
1908 DEFSYM (Qcomposition
, "composition");
1910 /* Make a hash table for static composition. */
1912 Lisp_Object args
[6];
1916 args
[2] = QCweakness
;
1917 /* We used to make the hash table weak so that unreferenced
1918 compositions can be garbage-collected. But, usually once
1919 created compositions are repeatedly used in an Emacs session,
1920 and thus it's not worth to save memory in such a way. So, we
1921 make the table not weak. */
1924 args
[5] = make_number (311);
1925 composition_hash_table
= Fmake_hash_table (6, args
);
1926 staticpro (&composition_hash_table
);
1929 /* Make a hash table for glyph-string. */
1931 Lisp_Object args
[6];
1934 args
[2] = QCweakness
;
1937 args
[5] = make_number (311);
1938 gstring_hash_table
= Fmake_hash_table (6, args
);
1939 staticpro (&gstring_hash_table
);
1942 staticpro (&gstring_work_headers
);
1943 gstring_work_headers
= make_uninit_vector (8);
1944 for (i
= 0; i
< 8; i
++)
1945 ASET (gstring_work_headers
, i
, Fmake_vector (make_number (i
+ 2), Qnil
));
1946 staticpro (&gstring_work
);
1947 gstring_work
= Fmake_vector (make_number (10), Qnil
);
1949 /* Text property `composition' should be nonsticky by default. */
1950 Vtext_property_default_nonsticky
1951 = Fcons (Fcons (Qcomposition
, Qt
), Vtext_property_default_nonsticky
);
1953 DEFVAR_LISP ("compose-chars-after-function", Vcompose_chars_after_function
,
1954 doc
: /* Function to adjust composition of buffer text.
1956 This function is called with three arguments: FROM, TO, and OBJECT.
1957 FROM and TO specify the range of text whose composition should be
1958 adjusted. OBJECT, if non-nil, is a string that contains the text.
1960 This function is called after a text with `composition' property is
1961 inserted or deleted to keep `composition' property of buffer text
1964 The default value is the function `compose-chars-after'. */);
1965 Vcompose_chars_after_function
= intern_c_string ("compose-chars-after");
1967 DEFSYM (Qauto_composed
, "auto-composed");
1968 DEFSYM (Qauto_composition_function
, "auto-composition-function");
1970 DEFVAR_LISP ("auto-composition-mode", Vauto_composition_mode
,
1971 doc
: /* Non-nil if Auto-Composition mode is enabled.
1972 Use the command `auto-composition-mode' to change this variable. */);
1973 Vauto_composition_mode
= Qt
;
1975 DEFVAR_LISP ("auto-composition-function", Vauto_composition_function
,
1976 doc
: /* Function to call to compose characters automatically.
1977 This function is called from the display routine with four arguments:
1978 FROM, TO, WINDOW, and STRING.
1980 If STRING is nil, the function must compose characters in the region
1981 between FROM and TO in the current buffer.
1983 Otherwise, STRING is a string, and FROM and TO are indices into the
1984 string. In this case, the function must compose characters in the
1986 Vauto_composition_function
= Qnil
;
1988 DEFVAR_LISP ("composition-function-table", Vcomposition_function_table
,
1989 doc
: /* Char-table of functions for automatic character composition.
1990 For each character that has to be composed automatically with
1991 preceding and/or following characters, this char-table contains
1992 a function to call to compose that character.
1994 The element at index C in the table, if non-nil, is a list of
1995 composition rules of this form: ([PATTERN PREV-CHARS FUNC] ...)
1997 PATTERN is a regular expression which C and the surrounding
1998 characters must match.
2000 PREV-CHARS is a non-negative integer (less than 4) specifying how many
2001 characters before C to check the matching with PATTERN. If it is 0,
2002 PATTERN must match C and the following characters. If it is 1,
2003 PATTERN must match a character before C and the following characters.
2005 If PREV-CHARS is 0, PATTERN can be nil, which means that the
2006 single character C should be composed.
2008 FUNC is a function to return a glyph-string representing a
2009 composition of the characters that match PATTERN. It is
2010 called with one argument GSTRING.
2012 GSTRING is a template of a glyph-string to return. It is already
2013 filled with a proper header for the characters to compose, and
2014 glyphs corresponding to those characters one by one. The
2015 function must return a new glyph-string with the same header as
2016 GSTRING, or modify GSTRING itself and return it.
2018 See also the documentation of `auto-composition-mode'. */);
2019 Vcomposition_function_table
= Fmake_char_table (Qnil
, Qnil
);
2021 defsubr (&Scompose_region_internal
);
2022 defsubr (&Scompose_string_internal
);
2023 defsubr (&Sfind_composition_internal
);
2024 defsubr (&Scomposition_get_gstring
);