1 /* Composite sequence support.
2 Copyright (C) 2001-2016 Free Software Foundation, Inc.
3 Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
4 National Institute of Advanced Industrial Science and Technology (AIST)
5 Registration Number H14PRO021
6 Copyright (C) 2003, 2006
7 National Institute of Advanced Industrial Science and Technology (AIST)
8 Registration Number H13PRO009
10 This file is part of GNU Emacs.
12 GNU Emacs is free software: you can redistribute it and/or modify
13 it under the terms of the GNU General Public License as published by
14 the Free Software Foundation, either version 3 of the License, or (at
15 your option) any later version.
17 GNU Emacs is distributed in the hope that it will be useful,
18 but WITHOUT ANY WARRANTY; without even the implied warranty of
19 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 GNU General Public License for more details.
22 You should have received a copy of the GNU General Public License
23 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
28 #include "character.h"
29 #include "composite.h"
32 #include "intervals.h"
34 #include "dispextern.h"
35 #include "termhooks.h"
38 /* Emacs uses special text property `composition' to support character
39 composition. A sequence of characters that have the same (i.e. eq)
40 `composition' property value is treated as a single composite
41 sequence (we call it just `composition' here after). Characters in
42 a composition are all composed somehow on the screen.
44 The property value has this form when the composition is made:
45 ((LENGTH . COMPONENTS) . MODIFICATION-FUNC)
46 then turns to this form:
47 (COMPOSITION-ID . (LENGTH COMPONENTS-VEC . MODIFICATION-FUNC))
48 when the composition is registered in composition_hash_table and
49 composition_table. These rather peculiar structures were designed
50 to make it easy to distinguish them quickly (we can do that by
51 checking only the first element) and to extract LENGTH (from the
52 former form) and COMPOSITION-ID (from the latter form).
54 We register a composition when it is displayed, or when the width
55 is required (for instance, to calculate columns).
57 LENGTH -- Length of the composition. This information is used to
58 check the validity of the composition.
60 COMPONENTS -- Character, string, vector, list, or nil.
62 If it is nil, characters in the text are composed relatively
63 according to their metrics in font glyphs.
65 If it is a character or a string, the character or characters
66 in the string are composed relatively.
68 If it is a vector or list of integers, the element is a
69 character or an encoded composition rule. The characters are
70 composed according to the rules. (2N)th elements are
71 characters to be composed and (2N+1)th elements are
72 composition rules to tell how to compose (2N+2)th element with
73 the previously composed 2N glyphs.
75 COMPONENTS-VEC -- Vector of integers. In a relative composition,
76 the elements are the characters to be composed. In a rule-base
77 composition, the elements are characters or encoded
80 MODIFICATION-FUNC -- If non nil, it is a function to call when the
81 composition gets invalid after a modification in a buffer. If
82 it is nil, a function in `composition-function-table' of the
83 first character in the sequence is called.
85 COMPOSITION-ID --Identification number of the composition. It is
86 used as an index to composition_table for the composition.
88 When Emacs has to display a composition or has to know its
89 displaying width, the function get_composition_id is called. It
90 returns COMPOSITION-ID so that the caller can access the
91 information about the composition through composition_table. If a
92 COMPOSITION-ID has not yet been assigned to the composition,
93 get_composition_id checks the validity of `composition' property,
94 and, if valid, assigns a new ID, registers the information in
95 composition_hash_table and composition_table, and changes the form
96 of the property value. If the property is invalid,
97 get_composition_id returns -1 without changing the property value.
99 We use two tables to keep the information about composition;
100 composition_hash_table and composition_table.
102 The former is a hash table whose keys are COMPONENTS-VECs and
103 values are the corresponding COMPOSITION-IDs. This hash table is
104 weak, but as each key (COMPONENTS-VEC) is also kept as a value of the
105 `composition' property, it won't be collected as garbage until all
106 bits of text that have the same COMPONENTS-VEC are deleted.
108 The latter is a table of pointers to `struct composition' indexed
109 by COMPOSITION-ID. This structure keeps the other information (see
112 In general, a text property holds information about individual
113 characters. But, a `composition' property holds information about
114 a sequence of characters (in this sense, it is like the `intangible'
115 property). That means that we should not share the property value
116 in adjacent compositions -- we can't distinguish them if they have the
117 same property. So, after any changes, we call
118 `update_compositions' and change a property of one of adjacent
119 compositions to a copy of it. This function also runs a proper
120 composition modification function to make a composition that gets
121 invalid by the change valid again.
123 As the value of the `composition' property holds information about a
124 specific range of text, the value gets invalid if we change the
125 text in the range. We treat the `composition' property as always
126 rear-nonsticky (currently by setting default-text-properties to
127 (rear-nonsticky (composition))) and we never make properties of
128 adjacent compositions identical. Thus, any such changes make the
129 range just shorter. So, we can check the validity of the `composition'
130 property by comparing LENGTH information with the actual length of
136 /* Table of pointers to the structure `composition' indexed by
137 COMPOSITION-ID. This structure is for storing information about
138 each composition except for COMPONENTS-VEC. */
139 struct composition
**composition_table
;
141 /* The current size of `composition_table'. */
142 static ptrdiff_t composition_table_size
;
144 /* Number of compositions currently made. */
145 ptrdiff_t n_compositions
;
147 /* Hash table for compositions. The key is COMPONENTS-VEC of
148 `composition' property. The value is the corresponding
150 Lisp_Object composition_hash_table
;
152 /* Maximum number of characters to look back for
153 auto-compositions. */
154 #define MAX_AUTO_COMPOSITION_LOOKBACK 3
156 /* Return COMPOSITION-ID of a composition at buffer position
157 CHARPOS/BYTEPOS and length NCHARS. The `composition' property of
158 the sequence is PROP. STRING, if non-nil, is a string that
159 contains the composition instead of the current buffer.
161 If the composition is invalid, return -1. */
164 get_composition_id (ptrdiff_t charpos
, ptrdiff_t bytepos
, ptrdiff_t nchars
,
165 Lisp_Object prop
, Lisp_Object string
)
167 Lisp_Object id
, length
, components
, key
, *key_contents
;
169 struct Lisp_Hash_Table
*hash_table
= XHASH_TABLE (composition_hash_table
);
170 ptrdiff_t hash_index
;
171 EMACS_UINT hash_code
;
172 enum composition_method method
;
173 struct composition
*cmp
;
177 /* Maximum length of a string of glyphs. XftGlyphExtents limits
178 this to INT_MAX, and Emacs limits it further. Divide INT_MAX - 1
179 by 2 because x_produce_glyphs computes glyph_len * 2 + 1. Divide
180 the size by MAX_MULTIBYTE_LENGTH because encode_terminal_code
181 multiplies glyph_len by MAX_MULTIBYTE_LENGTH. */
183 GLYPH_LEN_MAX
= min ((INT_MAX
- 1) / 2,
184 min (PTRDIFF_MAX
, SIZE_MAX
) / MAX_MULTIBYTE_LENGTH
)
188 Form-A: ((LENGTH . COMPONENTS) . MODIFICATION-FUNC)
190 Form-B: (COMPOSITION-ID . (LENGTH COMPONENTS-VEC . MODIFICATION-FUNC))
192 if (nchars
== 0 || !CONSP (prop
))
193 goto invalid_composition
;
198 /* PROP should be Form-B. */
199 if (XINT (id
) < 0 || XINT (id
) >= n_compositions
)
200 goto invalid_composition
;
204 /* PROP should be Form-A.
205 Thus, ID should be (LENGTH . COMPONENTS). */
207 goto invalid_composition
;
209 if (!INTEGERP (length
) || XINT (length
) != nchars
)
210 goto invalid_composition
;
212 components
= XCDR (id
);
214 /* Check if the same composition has already been registered or not
215 by consulting composition_hash_table. The key for this table is
216 COMPONENTS (converted to a vector COMPONENTS-VEC) or, if it is
217 nil, vector of characters in the composition range. */
218 if (INTEGERP (components
))
219 key
= Fmake_vector (make_number (1), components
);
220 else if (STRINGP (components
) || CONSP (components
))
221 key
= Fvconcat (1, &components
);
222 else if (VECTORP (components
))
224 else if (NILP (components
))
226 key
= make_uninit_vector (nchars
);
227 if (STRINGP (string
))
228 for (i
= 0; i
< nchars
; i
++)
230 FETCH_STRING_CHAR_ADVANCE (ch
, string
, charpos
, bytepos
);
231 ASET (key
, i
, make_number (ch
));
234 for (i
= 0; i
< nchars
; i
++)
236 FETCH_CHAR_ADVANCE (ch
, charpos
, bytepos
);
237 ASET (key
, i
, make_number (ch
));
241 goto invalid_composition
;
243 hash_index
= hash_lookup (hash_table
, key
, &hash_code
);
246 /* We have already registered the same composition. Change PROP
247 from Form-A above to Form-B while replacing COMPONENTS with
248 COMPONENTS-VEC stored in the hash table. We can directly
249 modify the cons cell of PROP because it is not shared. */
250 key
= HASH_KEY (hash_table
, hash_index
);
251 id
= HASH_VALUE (hash_table
, hash_index
);
253 XSETCDR (prop
, Fcons (make_number (nchars
), Fcons (key
, XCDR (prop
))));
257 /* This composition is a new one. We must register it. */
259 /* Check if we have sufficient memory to store this information. */
260 if (composition_table_size
<= n_compositions
)
261 composition_table
= xpalloc (composition_table
, &composition_table_size
,
262 1, -1, sizeof *composition_table
);
264 key_contents
= XVECTOR (key
)->contents
;
266 /* Check if the contents of COMPONENTS are valid if COMPONENTS is a
267 vector or a list. It should be a sequence of:
268 char1 rule1 char2 rule2 char3 ... ruleN charN+1 */
270 if (VECTORP (components
)
271 && ASIZE (components
) >= 2
272 && VECTORP (AREF (components
, 0)))
274 /* COMPONENTS is a glyph-string. */
275 ptrdiff_t len
= ASIZE (key
);
277 for (i
= 1; i
< len
; i
++)
278 if (! VECTORP (AREF (key
, i
)))
279 goto invalid_composition
;
281 else if (VECTORP (components
) || CONSP (components
))
283 ptrdiff_t len
= ASIZE (key
);
285 /* The number of elements should be odd. */
287 goto invalid_composition
;
288 /* All elements should be integers (character or encoded
289 composition rule). */
290 for (i
= 0; i
< len
; i
++)
292 if (!INTEGERP (key_contents
[i
]))
293 goto invalid_composition
;
297 /* Change PROP from Form-A above to Form-B. We can directly modify
298 the cons cell of PROP because it is not shared. */
299 XSETFASTINT (id
, n_compositions
);
301 XSETCDR (prop
, Fcons (make_number (nchars
), Fcons (key
, XCDR (prop
))));
303 /* Register the composition in composition_hash_table. */
304 hash_index
= hash_put (hash_table
, key
, id
, hash_code
);
306 method
= (NILP (components
)
307 ? COMPOSITION_RELATIVE
308 : ((INTEGERP (components
) || STRINGP (components
))
309 ? COMPOSITION_WITH_ALTCHARS
310 : COMPOSITION_WITH_RULE_ALTCHARS
));
312 glyph_len
= (method
== COMPOSITION_WITH_RULE_ALTCHARS
313 ? (ASIZE (key
) + 1) / 2
316 if (GLYPH_LEN_MAX
< glyph_len
)
317 memory_full (SIZE_MAX
);
319 /* Register the composition in composition_table. */
320 cmp
= xmalloc (sizeof *cmp
);
322 cmp
->method
= method
;
323 cmp
->hash_index
= hash_index
;
324 cmp
->glyph_len
= glyph_len
;
325 cmp
->offsets
= xnmalloc (glyph_len
, 2 * sizeof *cmp
->offsets
);
328 if (cmp
->method
!= COMPOSITION_WITH_RULE_ALTCHARS
)
330 /* Relative composition. */
332 for (i
= 0; i
< glyph_len
; i
++)
335 ch
= XINT (key_contents
[i
]);
336 /* TAB in a composition means display glyphs with padding
337 space on the left or right. */
338 this_width
= (ch
== '\t' ? 1 : CHAR_WIDTH (ch
));
339 if (cmp
->width
< this_width
)
340 cmp
->width
= this_width
;
345 /* Rule-base composition. */
346 double leftmost
= 0.0, rightmost
;
348 ch
= XINT (key_contents
[0]);
349 rightmost
= ch
!= '\t' ? CHAR_WIDTH (ch
) : 1;
351 for (i
= 1; i
< glyph_len
; i
+= 2)
353 int rule
, gref
, nref
;
357 rule
= XINT (key_contents
[i
]);
358 ch
= XINT (key_contents
[i
+ 1]);
359 this_width
= ch
!= '\t' ? CHAR_WIDTH (ch
) : 1;
361 /* A composition rule is specified by an integer value
362 that encodes global and new reference points (GREF and
363 NREF). GREF and NREF are specified by numbers as
371 ---3---4---5--- baseline
375 COMPOSITION_DECODE_REFS (rule
, gref
, nref
);
376 this_left
= (leftmost
377 + (gref
% 3) * (rightmost
- leftmost
) / 2.0
378 - (nref
% 3) * this_width
/ 2.0);
380 if (this_left
< leftmost
)
381 leftmost
= this_left
;
382 if (this_left
+ this_width
> rightmost
)
383 rightmost
= this_left
+ this_width
;
386 cmp
->width
= rightmost
- leftmost
;
387 if (cmp
->width
< (rightmost
- leftmost
))
388 /* To get a ceiling integer value. */
392 composition_table
[n_compositions
] = cmp
;
394 return n_compositions
++;
397 /* Would it be better to remove this `composition' property? */
402 /* Find a static composition at or nearest to position POS of OBJECT
405 OBJECT defaults to the current buffer. If there's a composition at
406 POS, set *START and *END to the start and end of the sequence,
407 *PROP to the `composition' property, and return 1.
409 If there's no composition at POS and LIMIT is negative, return 0.
411 Otherwise, search for a composition forward (LIMIT > POS) or
412 backward (LIMIT < POS). In this case, LIMIT bounds the search.
414 If a composition is found, set *START, *END, and *PROP as above,
415 and return 1, else return 0.
417 This doesn't check the validity of composition. */
420 find_composition (ptrdiff_t pos
, ptrdiff_t limit
,
421 ptrdiff_t *start
, ptrdiff_t *end
,
422 Lisp_Object
*prop
, Lisp_Object object
)
426 if (get_property_and_range (pos
, Qcomposition
, prop
, start
, end
, object
))
429 if (limit
< 0 || limit
== pos
)
432 if (limit
> pos
) /* search forward */
434 val
= Fnext_single_property_change (make_number (pos
), Qcomposition
,
435 object
, make_number (limit
));
440 else /* search backward */
442 if (get_property_and_range (pos
- 1, Qcomposition
, prop
, start
, end
,
445 val
= Fprevious_single_property_change (make_number (pos
), Qcomposition
,
446 object
, make_number (limit
));
452 get_property_and_range (pos
, Qcomposition
, prop
, start
, end
, object
);
456 /* Run a proper function to adjust the composition sitting between
457 FROM and TO with property PROP. */
460 run_composition_function (ptrdiff_t from
, ptrdiff_t to
, Lisp_Object prop
)
463 ptrdiff_t start
, end
;
465 func
= COMPOSITION_MODIFICATION_FUNC (prop
);
466 /* If an invalid composition precedes or follows, try to make them
469 && find_composition (from
- 1, -1, &start
, &end
, &prop
, Qnil
)
470 && !composition_valid_p (start
, end
, prop
))
473 && find_composition (to
, -1, &start
, &end
, &prop
, Qnil
)
474 && !composition_valid_p (start
, end
, prop
))
476 if (!NILP (Ffboundp (func
)))
477 call2 (func
, make_number (from
), make_number (to
));
480 /* Make invalid compositions adjacent to or inside FROM and TO valid.
481 CHECK_MASK is bitwise `or' of mask bits defined by macros
482 CHECK_XXX (see the comment in composite.h).
484 It also resets the text-property `auto-composed' to a proper region
485 so that automatic character composition works correctly later while
486 displaying the region.
488 This function is called when a buffer text is changed. If the
489 change is deletion, FROM == TO. Otherwise, FROM < TO. */
492 update_compositions (ptrdiff_t from
, ptrdiff_t to
, int check_mask
)
495 ptrdiff_t start
, end
;
496 /* The beginning and end of the region to set the property
497 `auto-composed' to nil. */
498 ptrdiff_t min_pos
= from
, max_pos
= to
;
500 if (inhibit_modification_hooks
)
503 /* If FROM and TO are not in a valid range, do nothing. */
504 if (! (BEGV
<= from
&& from
<= to
&& to
<= ZV
))
507 if (check_mask
& CHECK_HEAD
)
509 /* FROM should be at composition boundary. But, insertion or
510 deletion will make two compositions adjacent and
511 indistinguishable when they have same (eq) property. To
512 avoid it, in such a case, we change the property of the
513 latter to the copy of it. */
515 && find_composition (from
- 1, -1, &start
, &end
, &prop
, Qnil
)
516 && composition_valid_p (start
, end
, prop
))
522 Fput_text_property (make_number (from
), make_number (end
),
524 Fcons (XCAR (prop
), XCDR (prop
)), Qnil
);
525 run_composition_function (start
, end
, prop
);
529 && find_composition (from
, -1, &start
, &from
, &prop
, Qnil
)
530 && composition_valid_p (start
, from
, prop
))
534 run_composition_function (start
, from
, prop
);
538 if (check_mask
& CHECK_INSIDE
)
540 /* In this case, we are sure that (check & CHECK_TAIL) is also
541 nonzero. Thus, here we should check only compositions before
544 && find_composition (from
, to
, &start
, &from
, &prop
, Qnil
)
545 && composition_valid_p (start
, from
, prop
)
547 run_composition_function (start
, from
, prop
);
550 if (check_mask
& CHECK_TAIL
)
553 && find_composition (to
- 1, -1, &start
, &end
, &prop
, Qnil
)
554 && composition_valid_p (start
, end
, prop
))
556 /* TO should be also at composition boundary. But,
557 insertion or deletion will make two compositions adjacent
558 and indistinguishable when they have same (eq) property.
559 To avoid it, in such a case, we change the property of
560 the former to the copy of it. */
563 Fput_text_property (make_number (start
), make_number (to
),
565 Fcons (XCAR (prop
), XCDR (prop
)), Qnil
);
568 run_composition_function (start
, end
, prop
);
571 && find_composition (to
, -1, &start
, &end
, &prop
, Qnil
)
572 && composition_valid_p (start
, end
, prop
))
574 run_composition_function (start
, end
, prop
);
578 if (min_pos
< max_pos
)
580 ptrdiff_t count
= SPECPDL_INDEX ();
582 specbind (Qinhibit_read_only
, Qt
);
583 specbind (Qinhibit_modification_hooks
, Qt
);
584 specbind (Qinhibit_point_motion_hooks
, Qt
);
585 Fremove_list_of_text_properties (make_number (min_pos
),
586 make_number (max_pos
),
587 list1 (Qauto_composed
), Qnil
);
588 unbind_to (count
, Qnil
);
593 /* Modify composition property values in LIST destructively. LIST is
594 a list as returned from text_property_list. Change values to the
595 top-level copies of them so that none of them are `eq'. */
598 make_composition_value_copy (Lisp_Object list
)
600 Lisp_Object plist
, val
;
602 for (; CONSP (list
); list
= XCDR (list
))
604 plist
= XCAR (XCDR (XCDR (XCAR (list
))));
605 while (CONSP (plist
) && CONSP (XCDR (plist
)))
607 if (EQ (XCAR (plist
), Qcomposition
)
608 && (val
= XCAR (XCDR (plist
)), CONSP (val
)))
609 XSETCAR (XCDR (plist
), Fcons (XCAR (val
), XCDR (val
)));
610 plist
= XCDR (XCDR (plist
));
616 /* Make text in the region between START and END a composition that
617 has COMPONENTS and MODIFICATION-FUNC.
619 If STRING is non-nil, then operate on characters contained between
620 indices START and END in STRING. */
623 compose_text (ptrdiff_t start
, ptrdiff_t end
, Lisp_Object components
,
624 Lisp_Object modification_func
, Lisp_Object string
)
628 prop
= Fcons (Fcons (make_number (end
- start
), components
),
630 Fput_text_property (make_number (start
), make_number (end
),
631 Qcomposition
, prop
, string
);
634 /* Lisp glyph-string handlers. */
636 /* Hash table for automatic composition. The key is a header of a
637 lgstring (Lispy glyph-string), and the value is a body of a
640 static Lisp_Object gstring_hash_table
;
642 static Lisp_Object
gstring_lookup_cache (Lisp_Object
);
645 gstring_lookup_cache (Lisp_Object header
)
647 struct Lisp_Hash_Table
*h
= XHASH_TABLE (gstring_hash_table
);
648 ptrdiff_t i
= hash_lookup (h
, header
, NULL
);
650 return (i
>= 0 ? HASH_VALUE (h
, i
) : Qnil
);
654 composition_gstring_put_cache (Lisp_Object gstring
, ptrdiff_t len
)
656 struct Lisp_Hash_Table
*h
= XHASH_TABLE (gstring_hash_table
);
658 Lisp_Object header
, copy
;
661 header
= LGSTRING_HEADER (gstring
);
662 hash
= h
->test
.hashfn (&h
->test
, header
);
665 ptrdiff_t j
, glyph_len
= LGSTRING_GLYPH_LEN (gstring
);
666 for (j
= 0; j
< glyph_len
; j
++)
667 if (NILP (LGSTRING_GLYPH (gstring
, j
)))
672 copy
= Fmake_vector (make_number (len
+ 2), Qnil
);
673 LGSTRING_SET_HEADER (copy
, Fcopy_sequence (header
));
674 for (i
= 0; i
< len
; i
++)
675 LGSTRING_SET_GLYPH (copy
, i
, Fcopy_sequence (LGSTRING_GLYPH (gstring
, i
)));
676 i
= hash_put (h
, LGSTRING_HEADER (copy
), copy
, hash
);
677 LGSTRING_SET_ID (copy
, make_number (i
));
682 composition_gstring_from_id (ptrdiff_t id
)
684 struct Lisp_Hash_Table
*h
= XHASH_TABLE (gstring_hash_table
);
686 return HASH_VALUE (h
, id
);
690 composition_gstring_p (Lisp_Object gstring
)
695 if (! VECTORP (gstring
) || ASIZE (gstring
) < 2)
697 header
= LGSTRING_HEADER (gstring
);
698 if (! VECTORP (header
) || ASIZE (header
) < 2)
700 if (! NILP (LGSTRING_FONT (gstring
))
701 && (! FONT_OBJECT_P (LGSTRING_FONT (gstring
))
702 && ! CODING_SYSTEM_P (LGSTRING_FONT (gstring
))))
704 for (i
= 1; i
< ASIZE (LGSTRING_HEADER (gstring
)); i
++)
705 if (! NATNUMP (AREF (LGSTRING_HEADER (gstring
), i
)))
707 if (! NILP (LGSTRING_ID (gstring
)) && ! NATNUMP (LGSTRING_ID (gstring
)))
709 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
711 Lisp_Object glyph
= LGSTRING_GLYPH (gstring
, i
);
714 if (! VECTORP (glyph
) || ASIZE (glyph
) != LGLYPH_SIZE
)
721 composition_gstring_width (Lisp_Object gstring
, ptrdiff_t from
, ptrdiff_t to
,
722 struct font_metrics
*metrics
)
729 Lisp_Object font_object
= LGSTRING_FONT (gstring
);
731 if (FONT_OBJECT_P (font_object
))
733 struct font
*font
= XFONT_OBJECT (font_object
);
734 int font_ascent
, font_descent
;
736 get_font_ascent_descent (font
, &font_ascent
, &font_descent
);
737 metrics
->ascent
= font_ascent
;
738 metrics
->descent
= font_descent
;
743 metrics
->descent
= 0;
745 metrics
->width
= metrics
->lbearing
= metrics
->rbearing
= 0;
747 for (glyph
= lgstring_glyph_addr (gstring
, from
); from
< to
; from
++, glyph
++)
751 if (NILP (LGLYPH_ADJUSTMENT (*glyph
)))
752 width
+= LGLYPH_WIDTH (*glyph
);
754 width
+= LGLYPH_WADJUST (*glyph
);
757 x
= metrics
->width
+ LGLYPH_LBEARING (*glyph
) + LGLYPH_XOFF (*glyph
);
758 if (metrics
->lbearing
> x
)
759 metrics
->lbearing
= x
;
760 x
= metrics
->width
+ LGLYPH_RBEARING (*glyph
) + LGLYPH_XOFF (*glyph
);
761 if (metrics
->rbearing
< x
)
762 metrics
->rbearing
= x
;
763 metrics
->width
= width
;
764 x
= LGLYPH_ASCENT (*glyph
) - LGLYPH_YOFF (*glyph
);
765 if (metrics
->ascent
< x
)
767 x
= LGLYPH_DESCENT (*glyph
) + LGLYPH_YOFF (*glyph
);
768 if (metrics
->descent
< x
)
769 metrics
->descent
= x
;
776 static Lisp_Object gstring_work
;
777 static Lisp_Object gstring_work_headers
;
780 fill_gstring_header (Lisp_Object header
, ptrdiff_t from
, ptrdiff_t from_byte
,
781 ptrdiff_t to
, Lisp_Object font_object
, Lisp_Object string
)
783 ptrdiff_t len
= to
- from
, i
;
786 error ("Attempt to shape zero-length text");
787 if (VECTORP (header
))
789 if (ASIZE (header
) != len
+ 1)
790 args_out_of_range (header
, make_number (len
+ 1));
795 header
= AREF (gstring_work_headers
, len
- 1);
797 header
= make_uninit_vector (len
+ 1);
800 ASET (header
, 0, font_object
);
801 for (i
= 0; i
< len
; i
++)
806 FETCH_CHAR_ADVANCE_NO_CHECK (c
, from
, from_byte
);
808 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, from
, from_byte
);
809 ASET (header
, i
+ 1, make_number (c
));
815 fill_gstring_body (Lisp_Object gstring
)
817 Lisp_Object font_object
= LGSTRING_FONT (gstring
);
818 Lisp_Object header
= AREF (gstring
, 0);
819 ptrdiff_t len
= LGSTRING_CHAR_LEN (gstring
);
822 for (i
= 0; i
< len
; i
++)
824 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
825 int c
= XFASTINT (AREF (header
, i
+ 1));
830 LGSTRING_SET_GLYPH (gstring
, i
, g
);
832 LGLYPH_SET_FROM (g
, i
);
833 LGLYPH_SET_TO (g
, i
);
834 LGLYPH_SET_CHAR (g
, c
);
835 if (FONT_OBJECT_P (font_object
))
837 font_fill_lglyph_metrics (g
, font_object
);
841 int width
= XFASTINT (CHAR_TABLE_REF (Vchar_width_table
, c
));
843 LGLYPH_SET_CODE (g
, c
);
844 LGLYPH_SET_LBEARING (g
, 0);
845 LGLYPH_SET_RBEARING (g
, width
);
846 LGLYPH_SET_WIDTH (g
, width
);
847 LGLYPH_SET_ASCENT (g
, 1);
848 LGLYPH_SET_DESCENT (g
, 0);
850 LGLYPH_SET_ADJUSTMENT (g
, Qnil
);
852 if (i
< LGSTRING_GLYPH_LEN (gstring
))
853 LGSTRING_SET_GLYPH (gstring
, i
, Qnil
);
857 /* Try to compose the characters at CHARPOS according to composition
858 rule RULE ([PATTERN PREV-CHARS FUNC]). LIMIT limits the characters
859 to compose. STRING, if not nil, is a target string. WIN is a
860 window where the characters are being displayed. If characters are
861 successfully composed, return the composition as a glyph-string
862 object. Otherwise return nil. */
865 autocmp_chars (Lisp_Object rule
, ptrdiff_t charpos
, ptrdiff_t bytepos
,
866 ptrdiff_t limit
, struct window
*win
, struct face
*face
,
869 ptrdiff_t count
= SPECPDL_INDEX ();
870 #ifdef HAVE_WINDOW_SYSTEM
871 struct frame
*f
= XFRAME (win
->frame
);
873 (void) XFRAME (win
->frame
);
875 Lisp_Object pos
= make_number (charpos
);
877 ptrdiff_t pt
= PT
, pt_byte
= PT_BYTE
;
878 Lisp_Object re
, font_object
, lgstring
;
881 record_unwind_save_match_data ();
885 else if (! STRINGP (re
))
886 return unbind_to (count
, Qnil
);
887 else if ((len
= fast_looking_at (re
, charpos
, bytepos
, limit
, -1, string
))
891 len
= BYTE_TO_CHAR (bytepos
+ len
) - charpos
;
893 len
= string_byte_to_char (string
, bytepos
+ len
) - charpos
;
896 return unbind_to (count
, Qnil
);
897 to
= limit
= charpos
+ len
;
898 #ifdef HAVE_WINDOW_SYSTEM
899 if (FRAME_WINDOW_P (f
))
901 font_object
= font_range (charpos
, bytepos
, &to
, win
, face
, string
);
902 if (! FONT_OBJECT_P (font_object
)
905 && (fast_looking_at (re
, charpos
, bytepos
, to
, -1, string
) <= 0)))
906 return unbind_to (count
, Qnil
);
909 #endif /* not HAVE_WINDOW_SYSTEM */
910 font_object
= win
->frame
;
911 lgstring
= Fcomposition_get_gstring (pos
, make_number (to
), font_object
,
913 if (NILP (LGSTRING_ID (lgstring
)))
915 /* Save point as marker before calling out to lisp. */
917 record_unwind_protect (restore_point_unwind
,
918 build_marker (current_buffer
, pt
, pt_byte
));
919 lgstring
= safe_call (6, Vauto_composition_function
, AREF (rule
, 2),
920 pos
, make_number (to
), font_object
, string
);
922 return unbind_to (count
, lgstring
);
925 /* 1 iff the character C is composable. Characters of general
926 category Z? or C? are not composable except for ZWNJ and ZWJ. */
929 char_composable_p (int c
)
933 && (c
== ZERO_WIDTH_NON_JOINER
|| c
== ZERO_WIDTH_JOINER
934 || (val
= CHAR_TABLE_REF (Vunicode_category_table
, c
),
935 (INTEGERP (val
) && (XINT (val
) <= UNICODE_CATEGORY_So
)))));
938 /* Update cmp_it->stop_pos to the next position after CHARPOS (and
939 BYTEPOS) where character composition may happen. If BYTEPOS is
940 negative, compute it. ENDPOS is a limit of searching. If it is
941 less than CHARPOS, search backward to ENDPOS+1 assuming that
942 set_iterator_to_next works in reverse order. In this case, if a
943 composition closest to CHARPOS is found, set cmp_it->stop_pos to
944 the last character of the composition.
946 If no composition is found, set cmp_it->ch to -2. If a static
947 composition is found, set cmp_it->ch to -1. Otherwise, set
948 cmp_it->ch to the character that triggers the automatic
952 composition_compute_stop_pos (struct composition_it
*cmp_it
, ptrdiff_t charpos
, ptrdiff_t bytepos
, ptrdiff_t endpos
, Lisp_Object string
)
954 ptrdiff_t start
, end
;
956 Lisp_Object prop
, val
;
957 /* This is from forward_to_next_line_start in xdisp.c. */
958 const int MAX_NEWLINE_DISTANCE
= 500;
960 if (charpos
< endpos
)
962 if (endpos
> charpos
+ MAX_NEWLINE_DISTANCE
)
963 endpos
= charpos
+ MAX_NEWLINE_DISTANCE
;
965 else if (endpos
< charpos
)
967 /* We search backward for a position to check composition. */
970 /* But we don't know where to stop the searching. */
971 endpos
= NILP (string
) ? BEGV
- 1 : -1;
972 /* Usually we don't reach ENDPOS because we stop searching
973 at an uncomposable character (NL, LRE, etc). */
978 cmp_it
->reversed_p
= 0;
979 cmp_it
->stop_pos
= endpos
;
980 if (charpos
== endpos
)
982 /* FIXME: Bidi is not yet handled well in static composition. */
984 && find_composition (charpos
, endpos
, &start
, &end
, &prop
, string
)
986 && composition_valid_p (start
, end
, prop
))
988 cmp_it
->stop_pos
= endpos
= start
;
991 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
))
992 || NILP (Vauto_composition_mode
))
997 bytepos
= CHAR_TO_BYTE (charpos
);
999 bytepos
= string_char_to_byte (string
, charpos
);
1003 if (charpos
< endpos
)
1005 /* Forward search. */
1006 while (charpos
< endpos
)
1008 if (STRINGP (string
))
1009 FETCH_STRING_CHAR_ADVANCE (c
, string
, charpos
, bytepos
);
1011 FETCH_CHAR_ADVANCE (c
, charpos
, bytepos
);
1017 val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1020 for (int ridx
= 0; CONSP (val
); val
= XCDR (val
), ridx
++)
1022 Lisp_Object elt
= XCAR (val
);
1023 if (VECTORP (elt
) && ASIZE (elt
) == 3
1024 && NATNUMP (AREF (elt
, 1))
1025 && charpos
- 1 - XFASTINT (AREF (elt
, 1)) >= start
)
1027 cmp_it
->rule_idx
= ridx
;
1028 cmp_it
->lookback
= XFASTINT (AREF (elt
, 1));
1029 cmp_it
->stop_pos
= charpos
- 1 - cmp_it
->lookback
;
1036 if (charpos
== endpos
1037 && !(STRINGP (string
) && endpos
== SCHARS (string
)))
1039 /* We couldn't find a composition point before ENDPOS. But,
1040 some character after ENDPOS may be composed with
1041 characters before ENDPOS. So, we should stop at the safe
1043 charpos
= endpos
- MAX_AUTO_COMPOSITION_LOOKBACK
;
1044 if (charpos
< start
)
1048 else if (charpos
> endpos
)
1050 /* Search backward for a pattern that may be composed and the
1051 position of (possibly) the last character of the match is
1052 closest to (but not after) START. The reason for the last
1053 character is that set_iterator_to_next works in reverse order,
1054 and thus we must stop at the last character for composition
1058 /* Limit byte position used in fast_looking_at. This is the
1059 byte position of the character after START. */
1063 p
= BYTE_POS_ADDR (bytepos
);
1065 p
= SDATA (string
) + bytepos
;
1066 c
= STRING_CHAR_AND_LENGTH (p
, len
);
1067 limit
= bytepos
+ len
;
1068 while (char_composable_p (c
))
1070 val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1076 for (ridx
= 0; CONSP (val
); val
= XCDR (val
), ridx
++)
1079 if (VECTORP (elt
) && ASIZE (elt
) == 3
1080 && NATNUMP (AREF (elt
, 1))
1081 && charpos
- XFASTINT (AREF (elt
, 1)) > endpos
)
1083 ptrdiff_t back
= XFASTINT (AREF (elt
, 1));
1084 ptrdiff_t cpos
= charpos
- back
, bpos
;
1089 bpos
= (NILP (string
) ? CHAR_TO_BYTE (cpos
)
1090 : string_char_to_byte (string
, cpos
));
1091 if (STRINGP (AREF (elt
, 0)))
1092 blen
= fast_looking_at (AREF (elt
, 0), cpos
, bpos
,
1093 start
+ 1, limit
, string
);
1098 /* Make CPOS point to the last character of
1099 match. Note that BLEN is byte-length. */
1104 cpos
= BYTE_TO_CHAR (bpos
) - 1;
1106 cpos
= string_byte_to_char (string
, bpos
) - 1;
1108 back
= cpos
- (charpos
- back
);
1109 if (cmp_it
->stop_pos
< cpos
1110 || (cmp_it
->stop_pos
== cpos
1111 && cmp_it
->lookback
< back
))
1113 cmp_it
->rule_idx
= ridx
;
1114 cmp_it
->stop_pos
= cpos
;
1116 cmp_it
->lookback
= back
;
1117 cmp_it
->nchars
= back
+ 1;
1123 if (charpos
- 1 == endpos
)
1125 if (STRINGP (string
))
1128 while (! CHAR_HEAD_P (*p
))
1134 DEC_BOTH (charpos
, bytepos
);
1135 p
= BYTE_POS_ADDR (bytepos
);
1137 c
= STRING_CHAR (p
);
1139 if (cmp_it
->ch
>= 0)
1140 /* We found a position to check. */
1142 /* Skip all uncomposable characters. */
1145 while (charpos
- 1 > endpos
&& ! char_composable_p (c
))
1147 DEC_BOTH (charpos
, bytepos
);
1148 c
= FETCH_MULTIBYTE_CHAR (bytepos
);
1153 while (charpos
- 1 > endpos
&& ! char_composable_p (c
))
1156 while (! CHAR_HEAD_P (*p
))
1159 c
= STRING_CHAR (p
);
1163 cmp_it
->stop_pos
= charpos
;
1166 /* Check if the character at CHARPOS (and BYTEPOS) is composed
1167 (possibly with the following characters) on window W. ENDPOS limits
1168 characters to be composed. FACE, if non-NULL, is a base face of
1169 the character. If STRING is not nil, it is a string containing the
1170 character to check, and CHARPOS and BYTEPOS are indices in the
1171 string. In that case, FACE must not be NULL.
1173 If the character is composed, setup members of CMP_IT (id, nglyphs,
1174 from, to, reversed_p), and return true. Otherwise, update
1175 CMP_IT->stop_pos, and return false. */
1178 composition_reseat_it (struct composition_it
*cmp_it
, ptrdiff_t charpos
,
1179 ptrdiff_t bytepos
, ptrdiff_t endpos
, struct window
*w
,
1180 struct face
*face
, Lisp_Object string
)
1182 if (cmp_it
->ch
== -2)
1184 composition_compute_stop_pos (cmp_it
, charpos
, bytepos
, endpos
, string
);
1185 if (cmp_it
->ch
== -2 || cmp_it
->stop_pos
!= charpos
)
1186 /* The current position is not composed. */
1191 endpos
= NILP (string
) ? BEGV
: 0;
1195 /* We are looking at a static composition. */
1196 ptrdiff_t start
, end
;
1199 find_composition (charpos
, -1, &start
, &end
, &prop
, string
);
1200 cmp_it
->id
= get_composition_id (charpos
, bytepos
, end
- start
,
1203 goto no_composition
;
1204 cmp_it
->nchars
= end
- start
;
1205 cmp_it
->nglyphs
= composition_table
[cmp_it
->id
]->glyph_len
;
1209 Lisp_Object lgstring
= Qnil
;
1210 Lisp_Object val
, elt
;
1213 val
= CHAR_TABLE_REF (Vcomposition_function_table
, cmp_it
->ch
);
1214 for (i
= 0; i
< cmp_it
->rule_idx
; i
++, val
= XCDR (val
));
1215 if (charpos
< endpos
)
1217 for (; CONSP (val
); val
= XCDR (val
))
1220 if (! VECTORP (elt
) || ASIZE (elt
) != 3
1221 || ! INTEGERP (AREF (elt
, 1)))
1223 if (XFASTINT (AREF (elt
, 1)) != cmp_it
->lookback
)
1224 goto no_composition
;
1225 lgstring
= autocmp_chars (elt
, charpos
, bytepos
, endpos
,
1227 if (composition_gstring_p (lgstring
))
1230 /* Composition failed perhaps because the font doesn't
1231 support sufficient range of characters. Try the
1232 other composition rules if any. */
1234 cmp_it
->reversed_p
= 0;
1238 ptrdiff_t cpos
= charpos
, bpos
= bytepos
;
1240 cmp_it
->reversed_p
= 1;
1242 if (cmp_it
->lookback
> 0)
1244 cpos
= charpos
- cmp_it
->lookback
;
1245 if (STRINGP (string
))
1246 bpos
= string_char_to_byte (string
, cpos
);
1248 bpos
= CHAR_TO_BYTE (cpos
);
1250 lgstring
= autocmp_chars (elt
, cpos
, bpos
, charpos
+ 1, w
, face
,
1252 if (! composition_gstring_p (lgstring
)
1253 || cpos
+ LGSTRING_CHAR_LEN (lgstring
) - 1 != charpos
)
1254 /* Composition failed or didn't cover the current
1256 goto no_composition
;
1258 if (NILP (lgstring
))
1259 goto no_composition
;
1260 if (NILP (LGSTRING_ID (lgstring
)))
1261 lgstring
= composition_gstring_put_cache (lgstring
, -1);
1262 cmp_it
->id
= XINT (LGSTRING_ID (lgstring
));
1263 for (i
= 0; i
< LGSTRING_GLYPH_LEN (lgstring
); i
++)
1264 if (NILP (LGSTRING_GLYPH (lgstring
, i
)))
1266 cmp_it
->nglyphs
= i
;
1271 goto no_composition
;
1275 if (charpos
== endpos
)
1277 if (charpos
< endpos
)
1283 bytepos
+= BYTES_BY_CHAR_HEAD (*(SDATA (string
) + bytepos
));
1288 /* BYTEPOS is calculated in composition_compute_stop_pos */
1291 if (cmp_it
->reversed_p
)
1293 composition_compute_stop_pos (cmp_it
, charpos
, bytepos
, endpos
, string
);
1297 /* Update charpos, nchars, nbytes, and width of the current grapheme
1300 If the composition is static or automatic in L2R context, the
1301 cluster is identified by CMP_IT->from, and CHARPOS is the position
1302 of the first character of the cluster. In this case, update
1305 If the composition is automatic in R2L context, the cluster is
1306 identified by CMP_IT->to, and CHARPOS is the position of the last
1307 character of the cluster. In this case, update CMP_IT->from too.
1309 The return value is the character code of the first character of
1310 the cluster, or -1 if the composition is somehow broken. */
1313 composition_update_it (struct composition_it
*cmp_it
, ptrdiff_t charpos
, ptrdiff_t bytepos
, Lisp_Object string
)
1320 /* static composition */
1321 struct composition
*cmp
= composition_table
[cmp_it
->id
];
1323 cmp_it
->charpos
= charpos
;
1324 cmp_it
->to
= cmp_it
->nglyphs
;
1325 if (cmp_it
->nglyphs
== 0)
1329 for (i
= 0; i
< cmp
->glyph_len
; i
++)
1330 /* TAB in a composition means display glyphs with padding
1331 space on the left or right. */
1332 if ((c
= COMPOSITION_GLYPH (cmp
, i
)) != '\t')
1337 cmp_it
->width
= cmp
->width
;
1338 charpos
+= cmp_it
->nchars
;
1339 if (STRINGP (string
))
1340 cmp_it
->nbytes
= string_char_to_byte (string
, charpos
) - bytepos
;
1342 cmp_it
->nbytes
= CHAR_TO_BYTE (charpos
) - bytepos
;
1346 /* Automatic composition. */
1347 Lisp_Object gstring
= composition_gstring_from_id (cmp_it
->id
);
1351 if (cmp_it
->nglyphs
== 0)
1353 cmp_it
->nchars
= LGSTRING_CHAR_LEN (gstring
);
1355 cmp_it
->from
= cmp_it
->to
= 0;
1358 if (! cmp_it
->reversed_p
)
1360 glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->from
);
1361 from
= LGLYPH_FROM (glyph
);
1362 for (cmp_it
->to
= cmp_it
->from
+ 1; cmp_it
->to
< cmp_it
->nglyphs
;
1365 glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->to
);
1366 if (LGLYPH_FROM (glyph
) != from
)
1369 cmp_it
->charpos
= charpos
;
1373 glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->to
- 1);
1374 from
= LGLYPH_FROM (glyph
);
1375 cmp_it
->charpos
= charpos
- (LGLYPH_TO (glyph
) - from
);
1376 for (cmp_it
->from
= cmp_it
->to
- 1; cmp_it
->from
> 0;
1379 glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->from
- 1);
1380 if (LGLYPH_FROM (glyph
) != from
)
1384 glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->from
);
1385 cmp_it
->nchars
= LGLYPH_TO (glyph
) + 1 - from
;
1388 for (i
= cmp_it
->nchars
- 1; i
>= 0; i
--)
1390 c
= XINT (LGSTRING_CHAR (gstring
, from
+ i
));
1391 cmp_it
->nbytes
+= CHAR_BYTES (c
);
1392 cmp_it
->width
+= CHAR_WIDTH (c
);
1399 struct position_record
1401 ptrdiff_t pos
, pos_byte
;
1405 /* Update the members of POSITION to the next character boundary. */
1406 #define FORWARD_CHAR(POSITION, STOP) \
1409 if ((POSITION).pos == (STOP)) \
1411 (POSITION).p = GAP_END_ADDR; \
1412 (POSITION).pos_byte = GPT_BYTE; \
1416 (POSITION).pos_byte += BYTES_BY_CHAR_HEAD (*((POSITION).p)); \
1417 (POSITION).p += BYTES_BY_CHAR_HEAD (*((POSITION).p)); \
1421 /* Update the members of POSITION to the previous character boundary. */
1422 #define BACKWARD_CHAR(POSITION, STOP) \
1424 if ((POSITION).pos == (STOP)) \
1425 (POSITION).p = GPT_ADDR; \
1427 (POSITION).pos_byte--; \
1429 } while (! CHAR_HEAD_P (*((POSITION).p))); \
1433 /* This is like find_composition, but find an automatic composition
1434 instead. It is assured that POS is not within a static
1435 composition. If found, set *GSTRING to the glyph-string
1436 representing the composition, and return true. Otherwise, *GSTRING to
1437 Qnil, and return false. */
1440 find_automatic_composition (ptrdiff_t pos
, ptrdiff_t limit
,
1441 ptrdiff_t *start
, ptrdiff_t *end
,
1442 Lisp_Object
*gstring
, Lisp_Object string
)
1444 ptrdiff_t head
, tail
, stop
;
1445 /* Forward limit position of checking a composition taking a
1446 looking-back count into account. */
1447 ptrdiff_t fore_check_limit
;
1448 struct position_record cur
, prev
;
1452 bool need_adjustment
= 0;
1454 window
= Fget_buffer_window (Fcurrent_buffer (), Qnil
);
1457 w
= XWINDOW (window
);
1462 head
= BEGV
, tail
= ZV
, stop
= GPT
;
1463 cur
.pos_byte
= CHAR_TO_BYTE (cur
.pos
);
1464 cur
.p
= BYTE_POS_ADDR (cur
.pos_byte
);
1468 head
= 0, tail
= SCHARS (string
), stop
= -1;
1469 cur
.pos_byte
= string_char_to_byte (string
, cur
.pos
);
1470 cur
.p
= SDATA (string
) + cur
.pos_byte
;
1473 /* Finding a composition covering the character after POS is the
1474 same as setting LIMIT to POS. */
1477 fore_check_limit
= min (tail
, pos
+ 1 + MAX_AUTO_COMPOSITION_LOOKBACK
);
1479 fore_check_limit
= min (tail
, limit
+ MAX_AUTO_COMPOSITION_LOOKBACK
);
1481 /* Provided that we have these possible compositions now:
1483 POS: 1 2 3 4 5 6 7 8 9
1487 Here, it is known that characters after positions 1 and 9 can
1488 never be composed (i.e. ! char_composable_p (CH)), and
1489 composition A is an invalid one because it's partially covered by
1490 the valid composition C. And to know whether a composition is
1491 valid or not, the only way is to start searching forward from a
1492 position that can not be a tail part of composition (it's 2 in
1495 Now we have these cases (1 through 4):
1497 -- character after POS is ... --
1498 not composable composable
1499 LIMIT <= POS (1) (3)
1502 Among them, in case (2), we simply search forward from POS.
1504 In the other cases, we at first rewind back to the position where
1505 the previous character is not composable or the beginning of
1506 buffer (string), then search compositions forward. In case (1)
1507 and (3) we repeat this process until a composition is found. */
1511 c
= STRING_CHAR (cur
.p
);
1512 if (! char_composable_p (c
))
1514 if (limit
<= pos
) /* case (1) */
1517 if (cur
.pos
<= limit
)
1519 BACKWARD_CHAR (cur
, stop
);
1520 c
= STRING_CHAR (cur
.p
);
1521 } while (! char_composable_p (c
));
1522 fore_check_limit
= cur
.pos
+ 1;
1525 /* No need of rewinding back. */
1526 goto search_forward
;
1529 /* Rewind back to the position where we can safely search
1530 forward for compositions. It is assured that the character
1531 at cur.pos is composable. */
1532 while (head
< cur
.pos
)
1535 BACKWARD_CHAR (cur
, stop
);
1536 c
= STRING_CHAR (cur
.p
);
1537 if (! char_composable_p (c
))
1545 /* Now search forward. */
1547 prev
= cur
; /* remember the start of searching position. */
1548 while (cur
.pos
< fore_check_limit
)
1552 c
= STRING_CHAR (cur
.p
);
1553 for (val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1554 CONSP (val
); val
= XCDR (val
))
1556 Lisp_Object elt
= XCAR (val
);
1558 if (VECTORP (elt
) && ASIZE (elt
) == 3 && NATNUMP (AREF (elt
, 1)))
1560 EMACS_INT check_pos
= cur
.pos
- XFASTINT (AREF (elt
, 1));
1561 struct position_record check
;
1563 if (check_pos
< head
1564 || (limit
<= pos
? pos
< check_pos
1565 : limit
<= check_pos
))
1567 for (check
= cur
; check_pos
< check
.pos
; )
1568 BACKWARD_CHAR (check
, stop
);
1569 *gstring
= autocmp_chars (elt
, check
.pos
, check
.pos_byte
,
1570 tail
, w
, NULL
, string
);
1571 need_adjustment
= 1;
1572 if (NILP (*gstring
))
1574 /* As we have called Lisp, there's a possibility
1575 that buffer/string is relocated. */
1577 cur
.p
= BYTE_POS_ADDR (cur
.pos_byte
);
1579 cur
.p
= SDATA (string
) + cur
.pos_byte
;
1583 /* We found a candidate of a target composition. */
1585 *end
= check
.pos
+ LGSTRING_CHAR_LEN (*gstring
);
1588 : *start
<= pos
&& pos
< *end
)
1589 /* This is the target composition. */
1594 cur
.pos_byte
= CHAR_TO_BYTE (cur
.pos
);
1595 cur
.p
= BYTE_POS_ADDR (cur
.pos_byte
);
1599 cur
.pos_byte
= string_char_to_byte (string
, cur
.pos
);
1600 cur
.p
= SDATA (string
) + cur
.pos_byte
;
1607 /* We found no composition here. */
1608 FORWARD_CHAR (cur
, stop
);
1611 if (pos
< limit
) /* case (2) and (4)*/
1613 if (! NILP (*gstring
))
1615 if (prev
.pos
== head
)
1618 if (need_adjustment
)
1621 cur
.p
= BYTE_POS_ADDR (cur
.pos_byte
);
1623 cur
.p
= SDATA (string
) + cur
.pos_byte
;
1625 BACKWARD_CHAR (cur
, stop
);
1629 /* Return the adjusted point provided that point is moved from LAST_PT
1633 composition_adjust_point (ptrdiff_t last_pt
, ptrdiff_t new_pt
)
1635 ptrdiff_t i
, beg
, end
;
1638 if (new_pt
== BEGV
|| new_pt
== ZV
)
1641 /* At first check the static composition. */
1642 if (get_property_and_range (new_pt
, Qcomposition
, &val
, &beg
, &end
, Qnil
)
1643 && composition_valid_p (beg
, end
, val
))
1645 if (beg
< new_pt
/* && end > new_pt <- It's always the case. */
1646 && (last_pt
<= beg
|| last_pt
>= end
))
1647 return (new_pt
< last_pt
? beg
: end
);
1651 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
))
1652 || NILP (Vauto_composition_mode
))
1655 /* Next check the automatic composition. */
1656 if (! find_automatic_composition (new_pt
, (ptrdiff_t) -1, &beg
, &end
, &val
,
1660 for (i
= 0; i
< LGSTRING_GLYPH_LEN (val
); i
++)
1662 Lisp_Object glyph
= LGSTRING_GLYPH (val
, i
);
1666 if (beg
+ LGLYPH_FROM (glyph
) == new_pt
)
1668 if (beg
+ LGLYPH_TO (glyph
) >= new_pt
)
1669 return (new_pt
< last_pt
1670 ? beg
+ LGLYPH_FROM (glyph
)
1671 : beg
+ LGLYPH_TO (glyph
) + 1);
1676 DEFUN ("composition-get-gstring", Fcomposition_get_gstring
,
1677 Scomposition_get_gstring
, 4, 4, 0,
1678 doc
: /* Return a glyph-string for characters between FROM and TO.
1679 If the glyph string is for graphic display, FONT-OBJECT must be
1680 a font-object to use for those characters.
1681 Otherwise (for terminal display), FONT-OBJECT must be a terminal ID, a
1682 frame, or nil for the selected frame's terminal device.
1684 If the optional 4th argument STRING is not nil, it is a string
1685 containing the target characters between indices FROM and TO,
1686 which are treated as in `substring'. Otherwise FROM and TO are
1687 character positions in current buffer; they can be in either order,
1688 and can be integers or markers.
1690 A glyph-string is a vector containing information about how to display
1691 a specific character sequence. The format is:
1692 [HEADER ID GLYPH ...]
1694 HEADER is a vector of this form:
1695 [FONT-OBJECT CHAR ...]
1697 FONT-OBJECT is a font-object for all glyphs in the glyph-string,
1698 or the terminal coding system of the specified terminal.
1699 CHARs are characters to be composed by GLYPHs.
1701 ID is an identification number of the glyph-string. It may be nil if
1704 GLYPH is a vector whose elements have this form:
1705 [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT
1706 [ [X-OFF Y-OFF WADJUST] | nil] ]
1708 FROM-IDX and TO-IDX are used internally and should not be touched.
1709 C is the character of the glyph.
1710 CODE is the glyph-code of C in FONT-OBJECT.
1711 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
1712 X-OFF and Y-OFF are offsets to the base position for the glyph.
1713 WADJUST is the adjustment to the normal width of the glyph.
1715 If GLYPH is nil, the remaining elements of the glyph-string vector
1716 should be ignored. */)
1717 (Lisp_Object from
, Lisp_Object to
, Lisp_Object font_object
, Lisp_Object string
)
1719 Lisp_Object gstring
, header
;
1720 ptrdiff_t frompos
, frombyte
, topos
;
1722 if (! FONT_OBJECT_P (font_object
))
1724 struct coding_system
*coding
;
1725 struct terminal
*terminal
= decode_live_terminal (font_object
);
1727 coding
= ((TERMINAL_TERMINAL_CODING (terminal
)->common_flags
1728 & CODING_REQUIRE_ENCODING_MASK
)
1729 ? TERMINAL_TERMINAL_CODING (terminal
) : &safe_terminal_coding
);
1730 font_object
= CODING_ID_NAME (coding
->id
);
1735 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
1736 error ("Attempt to shape unibyte text");
1737 validate_region (&from
, &to
);
1738 frompos
= XFASTINT (from
);
1739 topos
= XFASTINT (to
);
1740 frombyte
= CHAR_TO_BYTE (frompos
);
1744 CHECK_STRING (string
);
1745 validate_subarray (string
, from
, to
, SCHARS (string
), &frompos
, &topos
);
1746 if (! STRING_MULTIBYTE (string
))
1747 error ("Attempt to shape unibyte text");
1748 frombyte
= string_char_to_byte (string
, frompos
);
1751 header
= fill_gstring_header (Qnil
, frompos
, frombyte
,
1752 topos
, font_object
, string
);
1753 gstring
= gstring_lookup_cache (header
);
1754 if (! NILP (gstring
))
1757 if (LGSTRING_GLYPH_LEN (gstring_work
) < topos
- frompos
)
1758 gstring_work
= Fmake_vector (make_number (topos
- frompos
+ 2), Qnil
);
1759 LGSTRING_SET_HEADER (gstring_work
, header
);
1760 LGSTRING_SET_ID (gstring_work
, Qnil
);
1761 fill_gstring_body (gstring_work
);
1762 return gstring_work
;
1766 /* Emacs Lisp APIs. */
1768 DEFUN ("compose-region-internal", Fcompose_region_internal
,
1769 Scompose_region_internal
, 2, 4, 0,
1770 doc
: /* Internal use only.
1772 Compose text in the region between START and END.
1773 Optional 3rd and 4th arguments are COMPONENTS and MODIFICATION-FUNC
1774 for the composition. See `compose-region' for more details. */)
1775 (Lisp_Object start
, Lisp_Object end
, Lisp_Object components
, Lisp_Object modification_func
)
1777 validate_region (&start
, &end
);
1778 if (!NILP (components
)
1779 && !INTEGERP (components
)
1780 && !CONSP (components
)
1781 && !STRINGP (components
))
1782 CHECK_VECTOR (components
);
1784 compose_text (XINT (start
), XINT (end
), components
, modification_func
, Qnil
);
1788 DEFUN ("compose-string-internal", Fcompose_string_internal
,
1789 Scompose_string_internal
, 3, 5, 0,
1790 doc
: /* Internal use only.
1792 Compose text between indices START and END of STRING, where
1793 START and END are treated as in `substring'. Optional 4th
1794 and 5th arguments are COMPONENTS and MODIFICATION-FUNC
1795 for the composition. See `compose-string' for more details. */)
1796 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
,
1797 Lisp_Object components
, Lisp_Object modification_func
)
1801 CHECK_STRING (string
);
1802 validate_subarray (string
, start
, end
, SCHARS (string
), &from
, &to
);
1803 compose_text (from
, to
, components
, modification_func
, string
);
1807 DEFUN ("find-composition-internal", Ffind_composition_internal
,
1808 Sfind_composition_internal
, 4, 4, 0,
1809 doc
: /* Internal use only.
1811 Return information about composition at or nearest to position POS.
1812 See `find-composition' for more details. */)
1813 (Lisp_Object pos
, Lisp_Object limit
, Lisp_Object string
, Lisp_Object detail_p
)
1815 Lisp_Object prop
, tail
, gstring
;
1816 ptrdiff_t start
, end
, from
, to
;
1819 CHECK_NUMBER_COERCE_MARKER (pos
);
1822 CHECK_NUMBER_COERCE_MARKER (limit
);
1823 to
= min (XINT (limit
), ZV
);
1830 CHECK_STRING (string
);
1831 if (XINT (pos
) < 0 || XINT (pos
) > SCHARS (string
))
1832 args_out_of_range (string
, pos
);
1836 if (XINT (pos
) < BEGV
|| XINT (pos
) > ZV
)
1837 args_out_of_range (Fcurrent_buffer (), pos
);
1841 if (!find_composition (from
, to
, &start
, &end
, &prop
, string
))
1843 if (!NILP (BVAR (current_buffer
, enable_multibyte_characters
))
1844 && ! NILP (Vauto_composition_mode
)
1845 && find_automatic_composition (from
, to
, &start
, &end
, &gstring
,
1847 return list3 (make_number (start
), make_number (end
), gstring
);
1850 if ((end
<= XINT (pos
) || start
> XINT (pos
)))
1854 if (find_automatic_composition (from
, to
, &s
, &e
, &gstring
, string
)
1855 && (e
<= XINT (pos
) ? e
> end
: s
< start
))
1856 return list3 (make_number (s
), make_number (e
), gstring
);
1858 if (!composition_valid_p (start
, end
, prop
))
1859 return list3 (make_number (start
), make_number (end
), Qnil
);
1860 if (NILP (detail_p
))
1861 return list3 (make_number (start
), make_number (end
), Qt
);
1863 if (composition_registered_p (prop
))
1864 id
= COMPOSITION_ID (prop
);
1867 ptrdiff_t start_byte
= (NILP (string
)
1868 ? CHAR_TO_BYTE (start
)
1869 : string_char_to_byte (string
, start
));
1870 id
= get_composition_id (start
, start_byte
, end
- start
, prop
, string
);
1875 Lisp_Object components
, relative_p
, mod_func
;
1876 enum composition_method method
= composition_method (prop
);
1877 int width
= composition_table
[id
]->width
;
1879 components
= Fcopy_sequence (COMPOSITION_COMPONENTS (prop
));
1880 relative_p
= (method
== COMPOSITION_WITH_RULE_ALTCHARS
1882 mod_func
= COMPOSITION_MODIFICATION_FUNC (prop
);
1883 tail
= list4 (components
, relative_p
, mod_func
, make_number (width
));
1888 return Fcons (make_number (start
), Fcons (make_number (end
), tail
));
1893 syms_of_composite (void)
1897 DEFSYM (Qcomposition
, "composition");
1899 /* Make a hash table for static composition. */
1900 /* We used to make the hash table weak so that unreferenced
1901 compositions can be garbage-collected. But, usually once
1902 created compositions are repeatedly used in an Emacs session,
1903 and thus it's not worth to save memory in such a way. So, we
1904 make the table not weak. */
1905 Lisp_Object args
[] = {QCtest
, Qequal
, QCsize
, make_number (311)};
1906 composition_hash_table
= CALLMANY (Fmake_hash_table
, args
);
1907 staticpro (&composition_hash_table
);
1909 /* Make a hash table for glyph-string. */
1910 gstring_hash_table
= CALLMANY (Fmake_hash_table
, args
);
1911 staticpro (&gstring_hash_table
);
1913 staticpro (&gstring_work_headers
);
1914 gstring_work_headers
= make_uninit_vector (8);
1915 for (i
= 0; i
< 8; i
++)
1916 ASET (gstring_work_headers
, i
, Fmake_vector (make_number (i
+ 2), Qnil
));
1917 staticpro (&gstring_work
);
1918 gstring_work
= Fmake_vector (make_number (10), Qnil
);
1920 /* Text property `composition' should be nonsticky by default. */
1921 Vtext_property_default_nonsticky
1922 = Fcons (Fcons (Qcomposition
, Qt
), Vtext_property_default_nonsticky
);
1924 DEFVAR_LISP ("compose-chars-after-function", Vcompose_chars_after_function
,
1925 doc
: /* Function to adjust composition of buffer text.
1927 This function is called with three arguments: FROM, TO, and OBJECT.
1928 FROM and TO specify the range of text whose composition should be
1929 adjusted. OBJECT, if non-nil, is a string that contains the text.
1931 This function is called after a text with `composition' property is
1932 inserted or deleted to keep `composition' property of buffer text
1935 The default value is the function `compose-chars-after'. */);
1936 Vcompose_chars_after_function
= intern_c_string ("compose-chars-after");
1938 DEFSYM (Qauto_composed
, "auto-composed");
1940 DEFVAR_LISP ("auto-composition-mode", Vauto_composition_mode
,
1941 doc
: /* Non-nil if Auto-Composition mode is enabled.
1942 Use the command `auto-composition-mode' to change this variable. */);
1943 Vauto_composition_mode
= Qt
;
1945 DEFVAR_LISP ("auto-composition-function", Vauto_composition_function
,
1946 doc
: /* Function to call to compose characters automatically.
1947 This function is called from the display routine with four arguments:
1948 FROM, TO, WINDOW, and STRING.
1950 If STRING is nil, the function must compose characters in the region
1951 between FROM and TO in the current buffer.
1953 Otherwise, STRING is a string, and FROM and TO are indices into the
1954 string. In this case, the function must compose characters in the
1956 Vauto_composition_function
= Qnil
;
1958 DEFVAR_LISP ("composition-function-table", Vcomposition_function_table
,
1959 doc
: /* Char-table of functions for automatic character composition.
1960 For each character that has to be composed automatically with
1961 preceding and/or following characters, this char-table contains
1962 a function to call to compose that character.
1964 The element at index C in the table, if non-nil, is a list of
1965 composition rules of this form: ([PATTERN PREV-CHARS FUNC] ...)
1967 PATTERN is a regular expression which C and the surrounding
1968 characters must match.
1970 PREV-CHARS is a non-negative integer (less than 4) specifying how many
1971 characters before C to check the matching with PATTERN. If it is 0,
1972 PATTERN must match C and the following characters. If it is 1,
1973 PATTERN must match a character before C and the following characters.
1975 If PREV-CHARS is 0, PATTERN can be nil, which means that the
1976 single character C should be composed.
1978 FUNC is a function to return a glyph-string representing a
1979 composition of the characters that match PATTERN. It is
1980 called with one argument GSTRING.
1982 GSTRING is a template of a glyph-string to return. It is already
1983 filled with a proper header for the characters to compose, and
1984 glyphs corresponding to those characters one by one. The
1985 function must return a new glyph-string with the same header as
1986 GSTRING, or modify GSTRING itself and return it.
1988 See also the documentation of `auto-composition-mode'. */);
1989 Vcomposition_function_table
= Fmake_char_table (Qnil
, Qnil
);
1991 defsubr (&Scompose_region_internal
);
1992 defsubr (&Scompose_string_internal
);
1993 defsubr (&Sfind_composition_internal
);
1994 defsubr (&Scomposition_get_gstring
);