1 /* Composite sequence support.
2 Copyright (C) 2001-2011 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/>. */
29 #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 int composition_table_size
;
147 /* Number of compositions currently made. */
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 static Lisp_Object
Fcomposition_get_gstring (Lisp_Object
, Lisp_Object
,
162 Lisp_Object
, Lisp_Object
);
164 /* Temporary variable used in macros COMPOSITION_XXX. */
165 Lisp_Object composition_temp
;
168 /* Return COMPOSITION-ID of a composition at buffer position
169 CHARPOS/BYTEPOS and length NCHARS. The `composition' property of
170 the sequence is PROP. STRING, if non-nil, is a string that
171 contains the composition instead of the current buffer.
173 If the composition is invalid, return -1. */
176 get_composition_id (EMACS_INT charpos
, EMACS_INT bytepos
, EMACS_INT nchars
,
177 Lisp_Object prop
, Lisp_Object string
)
179 Lisp_Object id
, length
, components
, key
, *key_contents
;
181 struct Lisp_Hash_Table
*hash_table
= XHASH_TABLE (composition_hash_table
);
182 EMACS_INT hash_index
;
183 EMACS_UINT hash_code
;
184 struct composition
*cmp
;
189 Form-A: ((LENGTH . COMPONENTS) . MODIFICATION-FUNC)
191 Form-B: (COMPOSITION-ID . (LENGTH COMPONENTS-VEC . MODIFICATION-FUNC))
193 if (nchars
== 0 || !CONSP (prop
))
194 goto invalid_composition
;
199 /* PROP should be Form-B. */
200 if (XINT (id
) < 0 || XINT (id
) >= n_compositions
)
201 goto invalid_composition
;
205 /* PROP should be Form-A.
206 Thus, ID should be (LENGTH . COMPONENTS). */
208 goto invalid_composition
;
210 if (!INTEGERP (length
) || XINT (length
) != nchars
)
211 goto invalid_composition
;
213 components
= XCDR (id
);
215 /* Check if the same composition has already been registered or not
216 by consulting composition_hash_table. The key for this table is
217 COMPONENTS (converted to a vector COMPONENTS-VEC) or, if it is
218 nil, vector of characters in the composition range. */
219 if (INTEGERP (components
))
220 key
= Fmake_vector (make_number (1), components
);
221 else if (STRINGP (components
) || CONSP (components
))
222 key
= Fvconcat (1, &components
);
223 else if (VECTORP (components
))
225 else if (NILP (components
))
227 key
= Fmake_vector (make_number (nchars
), Qnil
);
228 if (STRINGP (string
))
229 for (i
= 0; i
< nchars
; i
++)
231 FETCH_STRING_CHAR_ADVANCE (ch
, string
, charpos
, bytepos
);
232 XVECTOR (key
)->contents
[i
] = make_number (ch
);
235 for (i
= 0; i
< nchars
; i
++)
237 FETCH_CHAR_ADVANCE (ch
, charpos
, bytepos
);
238 XVECTOR (key
)->contents
[i
] = make_number (ch
);
242 goto invalid_composition
;
244 hash_index
= hash_lookup (hash_table
, key
, &hash_code
);
247 /* We have already registered the same composition. Change PROP
248 from Form-A above to Form-B while replacing COMPONENTS with
249 COMPONENTS-VEC stored in the hash table. We can directly
250 modify the cons cell of PROP because it is not shared. */
251 key
= HASH_KEY (hash_table
, hash_index
);
252 id
= HASH_VALUE (hash_table
, hash_index
);
254 XSETCDR (prop
, Fcons (make_number (nchars
), Fcons (key
, XCDR (prop
))));
258 /* This composition is a new one. We must register it. */
260 /* Check if we have sufficient memory to store this information. */
261 if (composition_table_size
== 0)
263 composition_table_size
= 256;
265 = (struct composition
**) xmalloc (sizeof (composition_table
[0])
266 * composition_table_size
);
268 else if (composition_table_size
<= n_compositions
)
270 composition_table_size
+= 256;
272 = (struct composition
**) xrealloc (composition_table
,
273 sizeof (composition_table
[0])
274 * composition_table_size
);
277 key_contents
= XVECTOR (key
)->contents
;
279 /* Check if the contents of COMPONENTS are valid if COMPONENTS is a
280 vector or a list. It should be a sequence of:
281 char1 rule1 char2 rule2 char3 ... ruleN charN+1 */
283 if (VECTORP (components
)
284 && ASIZE (components
) >= 2
285 && VECTORP (AREF (components
, 0)))
287 /* COMPONENTS is a glyph-string. */
288 EMACS_INT len
= ASIZE (key
);
290 for (i
= 1; i
< len
; i
++)
291 if (! VECTORP (AREF (key
, i
)))
292 goto invalid_composition
;
294 else if (VECTORP (components
) || CONSP (components
))
296 EMACS_INT len
= ASIZE (key
);
298 /* The number of elements should be odd. */
300 goto invalid_composition
;
301 /* All elements should be integers (character or encoded
302 composition rule). */
303 for (i
= 0; i
< len
; i
++)
305 if (!INTEGERP (key_contents
[i
]))
306 goto invalid_composition
;
310 /* Change PROP from Form-A above to Form-B. We can directly modify
311 the cons cell of PROP because it is not shared. */
312 XSETFASTINT (id
, n_compositions
);
314 XSETCDR (prop
, Fcons (make_number (nchars
), Fcons (key
, XCDR (prop
))));
316 /* Register the composition in composition_hash_table. */
317 hash_index
= hash_put (hash_table
, key
, id
, hash_code
);
319 /* Register the composition in composition_table. */
320 cmp
= (struct composition
*) xmalloc (sizeof (struct composition
));
322 cmp
->method
= (NILP (components
)
323 ? COMPOSITION_RELATIVE
324 : ((INTEGERP (components
) || STRINGP (components
))
325 ? COMPOSITION_WITH_ALTCHARS
326 : COMPOSITION_WITH_RULE_ALTCHARS
));
327 cmp
->hash_index
= hash_index
;
328 glyph_len
= (cmp
->method
== COMPOSITION_WITH_RULE_ALTCHARS
329 ? (ASIZE (key
) + 1) / 2
331 cmp
->glyph_len
= glyph_len
;
332 cmp
->offsets
= (short *) xmalloc (sizeof (short) * glyph_len
* 2);
335 if (cmp
->method
!= COMPOSITION_WITH_RULE_ALTCHARS
)
337 /* Relative composition. */
339 for (i
= 0; i
< glyph_len
; i
++)
342 ch
= XINT (key_contents
[i
]);
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 float 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 (EMACS_INT pos
, EMACS_INT limit
,
426 EMACS_INT
*start
, EMACS_INT
*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 (EMACS_INT from
, EMACS_INT to
, Lisp_Object prop
)
468 EMACS_INT 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 (EMACS_INT from
, EMACS_INT to
, int check_mask
)
500 EMACS_INT start
, end
;
501 /* The beginning and end of the region to set the property
502 `auto-composed' to nil. */
503 EMACS_INT 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 int 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 Fcons (Qauto_composed
, Qnil
), 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 (EMACS_INT start
, EMACS_INT 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
);
640 static Lisp_Object
autocmp_chars (Lisp_Object
, EMACS_INT
, EMACS_INT
,
641 EMACS_INT
, struct window
*,
642 struct face
*, Lisp_Object
);
645 /* Lisp glyph-string handlers */
647 /* Hash table for automatic composition. The key is a header of a
648 lgstring (Lispy glyph-string), and the value is a body of a
651 static Lisp_Object gstring_hash_table
;
653 static Lisp_Object
gstring_lookup_cache (Lisp_Object
);
656 gstring_lookup_cache (Lisp_Object header
)
658 struct Lisp_Hash_Table
*h
= XHASH_TABLE (gstring_hash_table
);
659 EMACS_INT i
= hash_lookup (h
, header
, NULL
);
661 return (i
>= 0 ? HASH_VALUE (h
, i
) : Qnil
);
665 composition_gstring_put_cache (Lisp_Object gstring
, EMACS_INT len
)
667 struct Lisp_Hash_Table
*h
= XHASH_TABLE (gstring_hash_table
);
669 Lisp_Object header
, copy
;
672 header
= LGSTRING_HEADER (gstring
);
673 hash
= h
->hashfn (h
, header
);
676 EMACS_INT j
, glyph_len
= LGSTRING_GLYPH_LEN (gstring
);
677 for (j
= 0; j
< glyph_len
; j
++)
678 if (NILP (LGSTRING_GLYPH (gstring
, j
)))
683 lint_assume (len
<= TYPE_MAXIMUM (EMACS_INT
) - 2);
684 copy
= Fmake_vector (make_number (len
+ 2), Qnil
);
685 LGSTRING_SET_HEADER (copy
, Fcopy_sequence (header
));
686 for (i
= 0; i
< len
; i
++)
687 LGSTRING_SET_GLYPH (copy
, i
, Fcopy_sequence (LGSTRING_GLYPH (gstring
, i
)));
688 i
= hash_put (h
, LGSTRING_HEADER (copy
), copy
, hash
);
689 LGSTRING_SET_ID (copy
, make_number (i
));
694 composition_gstring_from_id (int id
)
696 struct Lisp_Hash_Table
*h
= XHASH_TABLE (gstring_hash_table
);
698 return HASH_VALUE (h
, id
);
701 static Lisp_Object
fill_gstring_header (Lisp_Object
, Lisp_Object
,
702 Lisp_Object
, Lisp_Object
,
706 composition_gstring_p (Lisp_Object gstring
)
711 if (! VECTORP (gstring
) || ASIZE (gstring
) < 2)
713 header
= LGSTRING_HEADER (gstring
);
714 if (! VECTORP (header
) || ASIZE (header
) < 2)
716 if (! NILP (LGSTRING_FONT (gstring
))
717 && (! FONT_OBJECT_P (LGSTRING_FONT (gstring
))
718 && ! CODING_SYSTEM_P (LGSTRING_FONT (gstring
))))
720 for (i
= 1; i
< ASIZE (LGSTRING_HEADER (gstring
)); i
++)
721 if (! NATNUMP (AREF (LGSTRING_HEADER (gstring
), i
)))
723 if (! NILP (LGSTRING_ID (gstring
)) && ! NATNUMP (LGSTRING_ID (gstring
)))
725 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
727 Lisp_Object glyph
= LGSTRING_GLYPH (gstring
, i
);
730 if (! VECTORP (glyph
) || ASIZE (glyph
) != LGLYPH_SIZE
)
737 composition_gstring_width (Lisp_Object gstring
, EMACS_INT from
, EMACS_INT to
,
738 struct font_metrics
*metrics
)
745 Lisp_Object font_object
= LGSTRING_FONT (gstring
);
747 if (FONT_OBJECT_P (font_object
))
749 struct font
*font
= XFONT_OBJECT (font_object
);
751 metrics
->ascent
= font
->ascent
;
752 metrics
->descent
= font
->descent
;
757 metrics
->descent
= 0;
759 metrics
->width
= metrics
->lbearing
= metrics
->rbearing
= 0;
761 for (glyph
= &LGSTRING_GLYPH (gstring
, from
); from
< to
; from
++, glyph
++)
765 if (NILP (LGLYPH_ADJUSTMENT (*glyph
)))
766 width
+= LGLYPH_WIDTH (*glyph
);
768 width
+= LGLYPH_WADJUST (*glyph
);
771 x
= metrics
->width
+ LGLYPH_LBEARING (*glyph
) + LGLYPH_XOFF (*glyph
);
772 if (metrics
->lbearing
> x
)
773 metrics
->lbearing
= x
;
774 x
= metrics
->width
+ LGLYPH_RBEARING (*glyph
) + LGLYPH_XOFF (*glyph
);
775 if (metrics
->rbearing
< x
)
776 metrics
->rbearing
= x
;
777 metrics
->width
= width
;
778 x
= LGLYPH_ASCENT (*glyph
) - LGLYPH_YOFF (*glyph
);
779 if (metrics
->ascent
< x
)
781 x
= LGLYPH_DESCENT (*glyph
) + LGLYPH_YOFF (*glyph
);
782 if (metrics
->descent
< x
)
783 metrics
->descent
= x
;
790 static Lisp_Object gstring_work
;
791 static Lisp_Object gstring_work_headers
;
794 fill_gstring_header (Lisp_Object header
, Lisp_Object start
, Lisp_Object end
, Lisp_Object font_object
, Lisp_Object string
)
796 EMACS_INT from
, to
, from_byte
;
801 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
802 error ("Attempt to shape unibyte text");
803 validate_region (&start
, &end
);
804 from
= XFASTINT (start
);
806 from_byte
= CHAR_TO_BYTE (from
);
810 CHECK_STRING (string
);
811 if (! STRING_MULTIBYTE (string
))
812 error ("Attempt to shape unibyte text");
813 /* FROM and TO are checked by the caller. */
816 if (from
< 0 || from
> to
|| to
> SCHARS (string
))
817 args_out_of_range_3 (string
, start
, end
);
818 from_byte
= string_char_to_byte (string
, from
);
823 error ("Attempt to shape zero-length text");
824 if (VECTORP (header
))
826 if (ASIZE (header
) != len
+ 1)
827 args_out_of_range (header
, make_number (len
+ 1));
832 header
= AREF (gstring_work_headers
, len
- 1);
834 header
= Fmake_vector (make_number (len
+ 1), Qnil
);
837 ASET (header
, 0, font_object
);
838 for (i
= 0; i
< len
; i
++)
843 FETCH_CHAR_ADVANCE_NO_CHECK (c
, from
, from_byte
);
845 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, from
, from_byte
);
846 ASET (header
, i
+ 1, make_number (c
));
852 fill_gstring_body (Lisp_Object gstring
)
854 Lisp_Object font_object
= LGSTRING_FONT (gstring
);
855 Lisp_Object header
= AREF (gstring
, 0);
856 EMACS_INT len
= LGSTRING_CHAR_LEN (gstring
);
859 for (i
= 0; i
< len
; i
++)
861 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
862 int c
= XFASTINT (AREF (header
, i
+ 1));
867 LGSTRING_SET_GLYPH (gstring
, i
, g
);
869 LGLYPH_SET_FROM (g
, i
);
870 LGLYPH_SET_TO (g
, i
);
871 LGLYPH_SET_CHAR (g
, c
);
872 if (FONT_OBJECT_P (font_object
))
874 font_fill_lglyph_metrics (g
, font_object
);
878 int width
= XFASTINT (CHAR_TABLE_REF (Vchar_width_table
, c
));
880 LGLYPH_SET_CODE (g
, c
);
881 LGLYPH_SET_LBEARING (g
, 0);
882 LGLYPH_SET_RBEARING (g
, width
);
883 LGLYPH_SET_WIDTH (g
, width
);
884 LGLYPH_SET_ASCENT (g
, 1);
885 LGLYPH_SET_DESCENT (g
, 0);
887 LGLYPH_SET_ADJUSTMENT (g
, Qnil
);
889 if (i
< LGSTRING_GLYPH_LEN (gstring
))
890 LGSTRING_SET_GLYPH (gstring
, i
, Qnil
);
894 /* Try to compose the characters at CHARPOS according to composition
895 rule RULE ([PATTERN PREV-CHARS FUNC]). LIMIT limits the characters
896 to compose. STRING, if not nil, is a target string. WIN is a
897 window where the characters are being displayed. If characters are
898 successfully composed, return the composition as a glyph-string
899 object. Otherwise return nil. */
902 autocmp_chars (Lisp_Object rule
, EMACS_INT charpos
, EMACS_INT bytepos
, EMACS_INT limit
, struct window
*win
, struct face
*face
, Lisp_Object string
)
904 int count
= SPECPDL_INDEX ();
905 FRAME_PTR f
= XFRAME (win
->frame
);
906 Lisp_Object pos
= make_number (charpos
);
908 EMACS_INT pt
= PT
, pt_byte
= PT_BYTE
;
909 Lisp_Object re
, font_object
, lgstring
;
912 record_unwind_save_match_data ();
916 else if (! STRINGP (re
))
917 return unbind_to (count
, Qnil
);
918 else if ((len
= fast_looking_at (re
, charpos
, bytepos
, limit
, -1, string
))
922 len
= BYTE_TO_CHAR (bytepos
+ len
) - charpos
;
924 len
= string_byte_to_char (string
, bytepos
+ len
) - charpos
;
927 return unbind_to (count
, Qnil
);
928 to
= limit
= charpos
+ len
;
929 #ifdef HAVE_WINDOW_SYSTEM
930 if (FRAME_WINDOW_P (f
))
932 font_object
= font_range (charpos
, &to
, win
, face
, string
);
933 if (! FONT_OBJECT_P (font_object
)
936 && (fast_looking_at (re
, charpos
, bytepos
, to
, -1, string
) <= 0)))
937 return unbind_to (count
, Qnil
);
940 #endif /* not HAVE_WINDOW_SYSTEM */
941 font_object
= win
->frame
;
942 lgstring
= Fcomposition_get_gstring (pos
, make_number (to
), font_object
,
944 if (NILP (LGSTRING_ID (lgstring
)))
948 /* Save point as marker before calling out to lisp. */
951 Lisp_Object m
= Fmake_marker ();
952 set_marker_both (m
, Qnil
, pt
, pt_byte
);
953 record_unwind_protect (restore_point_unwind
, m
);
956 args
[0] = Vauto_composition_function
;
957 args
[1] = AREF (rule
, 2);
959 args
[3] = make_number (to
);
960 args
[4] = font_object
;
962 lgstring
= safe_call (6, args
);
964 return unbind_to (count
, lgstring
);
967 static Lisp_Object _work_val
;
969 /* 1 iff the character C is composable. Characters of general
970 category Z? or C? are not composable except for ZWNJ and ZWJ. */
972 #define CHAR_COMPOSABLE_P(C) \
974 && ((C) == 0x200C || (C) == 0x200D \
975 || (_work_val = CHAR_TABLE_REF (Vunicode_category_table, (C)), \
976 (INTEGERP (_work_val) \
977 && (XINT (_work_val) <= UNICODE_CATEGORY_So)))))
979 /* Update cmp_it->stop_pos to the next position after CHARPOS (and
980 BYTEPOS) where character composition may happen. If BYTEPOS is
981 negative, compute it. ENDPOS is a limit of searching. If it is
982 less than CHARPOS, search backward to ENDPOS+1 assuming that
983 set_iterator_to_next works in reverse order. In this case, if a
984 composition closest to CHARPOS is found, set cmp_it->stop_pos to
985 the last character of the composition.
987 If no composition is found, set cmp_it->ch to -2. If a static
988 composition is found, set cmp_it->ch to -1. Otherwise, set
989 cmp_it->ch to the character that triggers the automatic
993 composition_compute_stop_pos (struct composition_it
*cmp_it
, EMACS_INT charpos
, EMACS_INT bytepos
, EMACS_INT endpos
, Lisp_Object string
)
995 EMACS_INT start
, end
;
997 Lisp_Object prop
, val
;
998 /* This is from forward_to_next_line_start in xdisp.c. */
999 const int MAX_NEWLINE_DISTANCE
= 500;
1001 if (charpos
< endpos
)
1003 if (endpos
> charpos
+ MAX_NEWLINE_DISTANCE
)
1004 endpos
= charpos
+ MAX_NEWLINE_DISTANCE
;
1006 else if (endpos
< charpos
)
1008 /* We search backward for a position to check composition. */
1011 /* But we don't know where to stop the searching. */
1012 endpos
= NILP (string
) ? BEGV
- 1 : -1;
1013 /* Usually we don't reach ENDPOS because we stop searching
1014 at an uncomposable character (NL, LRE, etc). */
1019 cmp_it
->reversed_p
= 0;
1020 cmp_it
->stop_pos
= endpos
;
1021 if (charpos
== endpos
)
1023 /* FIXME: Bidi is not yet handled well in static composition. */
1024 if (charpos
< endpos
1025 && find_composition (charpos
, endpos
, &start
, &end
, &prop
, string
)
1027 && COMPOSITION_VALID_P (start
, end
, prop
))
1029 cmp_it
->stop_pos
= endpos
= start
;
1032 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
))
1033 || NILP (Vauto_composition_mode
))
1038 bytepos
= CHAR_TO_BYTE (charpos
);
1040 bytepos
= string_char_to_byte (string
, charpos
);
1044 if (charpos
< endpos
)
1046 /* Forward search. */
1047 while (charpos
< endpos
)
1049 if (STRINGP (string
))
1050 FETCH_STRING_CHAR_ADVANCE (c
, string
, charpos
, bytepos
);
1052 FETCH_CHAR_ADVANCE (c
, charpos
, bytepos
);
1058 val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1064 for (ridx
= 0; CONSP (val
); val
= XCDR (val
), ridx
++)
1067 if (VECTORP (elt
) && ASIZE (elt
) == 3
1068 && NATNUMP (AREF (elt
, 1))
1069 && charpos
- 1 - XFASTINT (AREF (elt
, 1)) >= start
)
1074 cmp_it
->rule_idx
= ridx
;
1075 cmp_it
->lookback
= XFASTINT (AREF (elt
, 1));
1076 cmp_it
->stop_pos
= charpos
- 1 - cmp_it
->lookback
;
1082 if (charpos
== endpos
)
1084 /* We couldn't find a composition point before ENDPOS. But,
1085 some character after ENDPOS may be composed with
1086 characters before ENDPOS. So, we should stop at the safe
1088 charpos
= endpos
- MAX_AUTO_COMPOSITION_LOOKBACK
;
1089 if (charpos
< start
)
1093 else if (charpos
> endpos
)
1095 /* Search backward for a pattern that may be composed and the
1096 position of (possibly) the last character of the match is
1097 closest to (but not after) START. The reason for the last
1098 character is that set_iterator_to_next works in reverse order,
1099 and thus we must stop at the last character for composition
1103 /* Limit byte position used in fast_looking_at. This is the
1104 byte position of the character after START. */
1108 p
= BYTE_POS_ADDR (bytepos
);
1110 p
= SDATA (string
) + bytepos
;
1111 c
= STRING_CHAR_AND_LENGTH (p
, len
);
1112 limit
= bytepos
+ len
;
1113 while (CHAR_COMPOSABLE_P (c
))
1115 val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1119 int ridx
, back
, blen
;
1121 for (ridx
= 0; CONSP (val
); val
= XCDR (val
), ridx
++)
1124 if (VECTORP (elt
) && ASIZE (elt
) == 3
1125 && NATNUMP (AREF (elt
, 1))
1126 && charpos
- (back
= XFASTINT (AREF (elt
, 1))) > endpos
)
1128 EMACS_INT cpos
= charpos
- back
, bpos
;
1133 bpos
= (NILP (string
) ? CHAR_TO_BYTE (cpos
)
1134 : string_char_to_byte (string
, cpos
));
1135 if (STRINGP (AREF (elt
, 0)))
1136 blen
= fast_looking_at (AREF (elt
, 0), cpos
, bpos
,
1137 start
+ 1, limit
, string
);
1142 /* Make CPOS point to the last character of
1143 match. Note that BLEN is byte-length. */
1148 cpos
= BYTE_TO_CHAR (bpos
) - 1;
1150 cpos
= string_byte_to_char (string
, bpos
) - 1;
1152 back
= cpos
- (charpos
- back
);
1153 if (cmp_it
->stop_pos
< cpos
1154 || (cmp_it
->stop_pos
== cpos
1155 && cmp_it
->lookback
< back
))
1157 cmp_it
->rule_idx
= ridx
;
1158 cmp_it
->stop_pos
= cpos
;
1160 cmp_it
->lookback
= back
;
1161 cmp_it
->nchars
= back
+ 1;
1167 if (charpos
- 1 == endpos
)
1169 if (STRINGP (string
))
1172 while (! CHAR_HEAD_P (*p
))
1178 DEC_BOTH (charpos
, bytepos
);
1179 p
= BYTE_POS_ADDR (bytepos
);
1181 c
= STRING_CHAR (p
);
1183 if (cmp_it
->ch
>= 0)
1184 /* We found a position to check. */
1186 /* Skip all uncomposable characters. */
1189 while (charpos
- 1 > endpos
&& ! CHAR_COMPOSABLE_P (c
))
1191 DEC_BOTH (charpos
, bytepos
);
1192 c
= FETCH_MULTIBYTE_CHAR (bytepos
);
1197 while (charpos
- 1 > endpos
&& ! CHAR_COMPOSABLE_P (c
))
1200 while (! CHAR_HEAD_P (*p
))
1203 c
= STRING_CHAR (p
);
1207 cmp_it
->stop_pos
= charpos
;
1210 /* Check if the character at CHARPOS (and BYTEPOS) is composed
1211 (possibly with the following characters) on window W. ENDPOS limits
1212 characters to be composed. FACE, in non-NULL, is a base face of
1213 the character. If STRING is not nil, it is a string containing the
1214 character to check, and CHARPOS and BYTEPOS are indices in the
1215 string. In that case, FACE must not be NULL.
1217 If the character is composed, setup members of CMP_IT (id, nglyphs,
1218 from, to, reversed_p), and return 1. Otherwise, update
1219 CMP_IT->stop_pos, and return 0. */
1222 composition_reseat_it (struct composition_it
*cmp_it
, EMACS_INT charpos
, EMACS_INT bytepos
, EMACS_INT endpos
, struct window
*w
, struct face
*face
, Lisp_Object string
)
1225 endpos
= NILP (string
) ? BEGV
: 0;
1227 if (cmp_it
->ch
== -2)
1229 composition_compute_stop_pos (cmp_it
, charpos
, bytepos
, endpos
, string
);
1230 if (cmp_it
->ch
== -2 || cmp_it
->stop_pos
!= charpos
)
1231 /* The current position is not composed. */
1237 /* We are looking at a static composition. */
1238 EMACS_INT start
, end
;
1241 find_composition (charpos
, -1, &start
, &end
, &prop
, string
);
1242 cmp_it
->id
= get_composition_id (charpos
, bytepos
, end
- start
,
1245 goto no_composition
;
1246 cmp_it
->nchars
= end
- start
;
1247 cmp_it
->nglyphs
= composition_table
[cmp_it
->id
]->glyph_len
;
1251 Lisp_Object lgstring
= Qnil
;
1252 Lisp_Object val
, elt
;
1255 val
= CHAR_TABLE_REF (Vcomposition_function_table
, cmp_it
->ch
);
1256 for (i
= 0; i
< cmp_it
->rule_idx
; i
++, val
= XCDR (val
));
1257 if (charpos
< endpos
)
1259 for (; CONSP (val
); val
= XCDR (val
))
1262 if (! VECTORP (elt
) || ASIZE (elt
) != 3
1263 || ! INTEGERP (AREF (elt
, 1)))
1265 if (XFASTINT (AREF (elt
, 1)) != cmp_it
->lookback
)
1266 goto no_composition
;
1267 lgstring
= autocmp_chars (elt
, charpos
, bytepos
, endpos
,
1269 if (composition_gstring_p (lgstring
))
1272 /* Composition failed perhaps because the font doesn't
1273 support sufficient range of characters. Try the
1274 other composition rules if any. */
1276 cmp_it
->reversed_p
= 0;
1280 EMACS_INT cpos
= charpos
, bpos
= bytepos
;
1285 if (cmp_it
->lookback
> 0)
1287 cpos
= charpos
- cmp_it
->lookback
;
1288 if (STRINGP (string
))
1289 bpos
= string_char_to_byte (string
, cpos
);
1291 bpos
= CHAR_TO_BYTE (cpos
);
1293 lgstring
= autocmp_chars (elt
, cpos
, bpos
, charpos
+ 1, w
, face
,
1295 if (composition_gstring_p (lgstring
)
1296 && cpos
+ LGSTRING_CHAR_LEN (lgstring
) - 1 == charpos
)
1298 /* Composition failed or didn't cover the current
1300 if (cmp_it
->lookback
== 0)
1301 goto no_composition
;
1303 /* Try to find a shorter compostion that starts after CPOS. */
1304 composition_compute_stop_pos (cmp_it
, charpos
, bytepos
, cpos
,
1306 if (cmp_it
->ch
== -2 || cmp_it
->stop_pos
< charpos
)
1307 goto no_composition
;
1308 val
= CHAR_TABLE_REF (Vcomposition_function_table
, cmp_it
->ch
);
1309 for (i
= 0; i
< cmp_it
->rule_idx
; i
++, val
= XCDR (val
));
1311 cmp_it
->reversed_p
= 1;
1313 if (NILP (lgstring
))
1314 goto no_composition
;
1315 if (NILP (LGSTRING_ID (lgstring
)))
1316 lgstring
= composition_gstring_put_cache (lgstring
, -1);
1317 cmp_it
->id
= XINT (LGSTRING_ID (lgstring
));
1318 for (i
= 0; i
< LGSTRING_GLYPH_LEN (lgstring
); i
++)
1319 if (NILP (LGSTRING_GLYPH (lgstring
, i
)))
1321 cmp_it
->nglyphs
= i
;
1326 goto no_composition
;
1330 if (charpos
== endpos
)
1332 if (charpos
< endpos
)
1338 bytepos
+= BYTES_BY_CHAR_HEAD (*(SDATA (string
) + bytepos
));
1343 /* BYTEPOS is calculated in composition_compute_stop_pos */
1346 composition_compute_stop_pos (cmp_it
, charpos
, bytepos
, endpos
, string
);
1350 /* Update charpos, nchars, nbytes, and width of the current grapheme
1353 If the composition is static or automatic in L2R context, the
1354 cluster is identified by CMP_IT->from, and CHARPOS is the position
1355 of the first character of the cluster. In this case, update
1358 If the composition is automatic in R2L context, the cluster is
1359 identified by CMP_IT->to, and CHARPOS is the position of the last
1360 character of the cluster. In this case, update CMP_IT->from too.
1362 The return value is the character code of the first character of
1363 the cluster, or -1 if the composition is somehow broken. */
1366 composition_update_it (struct composition_it
*cmp_it
, EMACS_INT charpos
, EMACS_INT bytepos
, Lisp_Object string
)
1368 int i
, c
IF_LINT (= 0);
1372 /* static composition */
1373 struct composition
*cmp
= composition_table
[cmp_it
->id
];
1375 cmp_it
->charpos
= charpos
;
1376 cmp_it
->to
= cmp_it
->nglyphs
;
1377 if (cmp_it
->nglyphs
== 0)
1381 for (i
= 0; i
< cmp
->glyph_len
; i
++)
1382 if ((c
= COMPOSITION_GLYPH (cmp
, i
)) != '\t')
1387 cmp_it
->width
= cmp
->width
;
1388 charpos
+= cmp_it
->nchars
;
1389 if (STRINGP (string
))
1390 cmp_it
->nbytes
= string_char_to_byte (string
, charpos
) - bytepos
;
1392 cmp_it
->nbytes
= CHAR_TO_BYTE (charpos
) - bytepos
;
1396 /* automatic composition */
1397 Lisp_Object gstring
= composition_gstring_from_id (cmp_it
->id
);
1401 if (cmp_it
->nglyphs
== 0)
1403 cmp_it
->nchars
= LGSTRING_CHAR_LEN (gstring
);
1405 cmp_it
->from
= cmp_it
->to
= 0;
1408 if (! cmp_it
->reversed_p
)
1410 glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->from
);
1411 from
= LGLYPH_FROM (glyph
);
1412 for (cmp_it
->to
= cmp_it
->from
+ 1; cmp_it
->to
< cmp_it
->nglyphs
;
1415 glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->to
);
1416 if (LGLYPH_FROM (glyph
) != from
)
1419 cmp_it
->charpos
= charpos
;
1423 glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->to
- 1);
1424 from
= LGLYPH_FROM (glyph
);
1425 cmp_it
->charpos
= charpos
- (LGLYPH_TO (glyph
) - from
);
1426 for (cmp_it
->from
= cmp_it
->to
- 1; cmp_it
->from
> 0;
1429 glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->from
- 1);
1430 if (LGLYPH_FROM (glyph
) != from
)
1434 glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->from
);
1435 cmp_it
->nchars
= LGLYPH_TO (glyph
) + 1 - from
;
1438 for (i
= cmp_it
->nchars
- 1; i
>= 0; i
--)
1440 c
= XINT (LGSTRING_CHAR (gstring
, i
));
1441 cmp_it
->nbytes
+= CHAR_BYTES (c
);
1442 cmp_it
->width
+= CHAR_WIDTH (c
);
1449 struct position_record
1451 EMACS_INT pos
, pos_byte
;
1455 /* Update the members of POSITION to the next character boundary. */
1456 #define FORWARD_CHAR(POSITION, STOP) \
1459 if ((POSITION).pos == (STOP)) \
1461 (POSITION).p = GAP_END_ADDR; \
1462 (POSITION).pos_byte = GPT_BYTE; \
1466 (POSITION).pos_byte += BYTES_BY_CHAR_HEAD (*((POSITION).p)); \
1467 (POSITION).p += BYTES_BY_CHAR_HEAD (*((POSITION).p)); \
1471 /* Update the members of POSITION to the previous character boundary. */
1472 #define BACKWARD_CHAR(POSITION, STOP) \
1474 if ((POSITION).pos == (STOP)) \
1475 (POSITION).p = GPT_ADDR; \
1477 (POSITION).pos_byte--; \
1479 } while (! CHAR_HEAD_P (*((POSITION).p))); \
1483 /* This is like find_composition, but find an automatic composition
1484 instead. It is assured that POS is not within a static
1485 composition. If found, set *GSTRING to the glyph-string
1486 representing the composition, and return 1. Otherwise, *GSTRING to
1487 Qnil, and return 0. */
1490 find_automatic_composition (EMACS_INT pos
, EMACS_INT limit
,
1491 EMACS_INT
*start
, EMACS_INT
*end
,
1492 Lisp_Object
*gstring
, Lisp_Object string
)
1494 EMACS_INT head
, tail
, stop
;
1495 /* Forward limit position of checking a composition taking a
1496 looking-back count into account. */
1497 EMACS_INT fore_check_limit
;
1498 struct position_record cur
, prev
;
1502 int need_adjustment
= 0;
1504 window
= Fget_buffer_window (Fcurrent_buffer (), Qnil
);
1507 w
= XWINDOW (window
);
1512 head
= BEGV
, tail
= ZV
, stop
= GPT
;
1513 cur
.pos_byte
= CHAR_TO_BYTE (cur
.pos
);
1514 cur
.p
= BYTE_POS_ADDR (cur
.pos_byte
);
1518 head
= 0, tail
= SCHARS (string
), stop
= -1;
1519 cur
.pos_byte
= string_char_to_byte (string
, cur
.pos
);
1520 cur
.p
= SDATA (string
) + cur
.pos_byte
;
1523 /* Finding a composition covering the character after POS is the
1524 same as setting LIMIT to POS. */
1527 fore_check_limit
= min (tail
, pos
+ 1 + MAX_AUTO_COMPOSITION_LOOKBACK
);
1529 fore_check_limit
= min (tail
, limit
+ MAX_AUTO_COMPOSITION_LOOKBACK
);
1531 /* Provided that we have these possible compositions now:
1533 POS: 1 2 3 4 5 6 7 8 9
1537 Here, it is known that characters after positions 1 and 9 can
1538 never be composed (i.e. ! CHAR_COMPOSABLE_P (CH)), and
1539 composition A is an invalid one because it's partially covered by
1540 the valid composition C. And to know whether a composition is
1541 valid or not, the only way is to start searching forward from a
1542 position that can not be a tail part of composition (it's 2 in
1545 Now we have these cases (1 through 4):
1547 -- character after POS is ... --
1548 not composable composable
1549 LIMIT <= POS (1) (3)
1552 Among them, in case (2), we simply search forward from POS.
1554 In the other cases, we at first rewind back to the position where
1555 the previous character is not composable or the beginning of
1556 buffer (string), then search compositions forward. In case (1)
1557 and (3) we repeat this process until a composition is found. */
1561 c
= STRING_CHAR (cur
.p
);
1562 if (! CHAR_COMPOSABLE_P (c
))
1564 if (limit
<= pos
) /* case (1) */
1567 if (cur
.pos
<= limit
)
1569 BACKWARD_CHAR (cur
, stop
);
1570 c
= STRING_CHAR (cur
.p
);
1571 } while (! CHAR_COMPOSABLE_P (c
));
1572 fore_check_limit
= cur
.pos
+ 1;
1575 /* No need of rewinding back. */
1576 goto search_forward
;
1579 /* Rewind back to the position where we can safely search
1580 forward for compositions. It is assured that the character
1581 at cur.pos is composable. */
1582 while (head
< cur
.pos
)
1585 BACKWARD_CHAR (cur
, stop
);
1586 c
= STRING_CHAR (cur
.p
);
1587 if (! CHAR_COMPOSABLE_P (c
))
1595 /* Now search forward. */
1597 prev
= cur
; /* remember the start of searching position. */
1598 while (cur
.pos
< fore_check_limit
)
1602 c
= STRING_CHAR (cur
.p
);
1603 for (val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1604 CONSP (val
); val
= XCDR (val
))
1606 Lisp_Object elt
= XCAR (val
);
1608 if (VECTORP (elt
) && ASIZE (elt
) == 3 && NATNUMP (AREF (elt
, 1)))
1610 EMACS_INT check_pos
= cur
.pos
- XFASTINT (AREF (elt
, 1));
1611 struct position_record check
;
1613 if (check_pos
< head
1614 || (limit
<= pos
? pos
< check_pos
1615 : limit
<= check_pos
))
1617 for (check
= cur
; check_pos
< check
.pos
; )
1618 BACKWARD_CHAR (check
, stop
);
1619 *gstring
= autocmp_chars (elt
, check
.pos
, check
.pos_byte
,
1620 tail
, w
, NULL
, string
);
1621 need_adjustment
= 1;
1622 if (NILP (*gstring
))
1624 /* As we have called Lisp, there's a possibility
1625 that buffer/string is relocated. */
1627 cur
.p
= BYTE_POS_ADDR (cur
.pos_byte
);
1629 cur
.p
= SDATA (string
) + cur
.pos_byte
;
1633 /* We found a candidate of a target composition. */
1635 *end
= check
.pos
+ LGSTRING_CHAR_LEN (*gstring
);
1638 : *start
<= pos
&& pos
< *end
)
1639 /* This is the target composition. */
1644 cur
.pos_byte
= CHAR_TO_BYTE (cur
.pos
);
1645 cur
.p
= BYTE_POS_ADDR (cur
.pos_byte
);
1649 cur
.pos_byte
= string_char_to_byte (string
, cur
.pos
);
1650 cur
.p
= SDATA (string
) + cur
.pos_byte
;
1657 /* We found no composition here. */
1658 FORWARD_CHAR (cur
, stop
);
1661 if (pos
< limit
) /* case (2) and (4)*/
1663 if (! NILP (*gstring
))
1665 if (prev
.pos
== head
)
1668 if (need_adjustment
)
1671 cur
.p
= BYTE_POS_ADDR (cur
.pos_byte
);
1673 cur
.p
= SDATA (string
) + cur
.pos_byte
;
1675 BACKWARD_CHAR (cur
, stop
);
1679 /* Return the adjusted point provided that point is moved from LAST_PT
1683 composition_adjust_point (EMACS_INT last_pt
, EMACS_INT new_pt
)
1685 EMACS_INT i
, beg
, end
;
1688 if (new_pt
== BEGV
|| new_pt
== ZV
)
1691 /* At first check the static composition. */
1692 if (get_property_and_range (new_pt
, Qcomposition
, &val
, &beg
, &end
, Qnil
)
1693 && COMPOSITION_VALID_P (beg
, end
, val
))
1695 if (beg
< new_pt
/* && end > new_pt <- It's always the case. */
1696 && (last_pt
<= beg
|| last_pt
>= end
))
1697 return (new_pt
< last_pt
? beg
: end
);
1701 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
))
1702 || NILP (Vauto_composition_mode
))
1705 /* Next check the automatic composition. */
1706 if (! find_automatic_composition (new_pt
, (EMACS_INT
) -1, &beg
, &end
, &val
,
1710 for (i
= 0; i
< LGSTRING_GLYPH_LEN (val
); i
++)
1712 Lisp_Object glyph
= LGSTRING_GLYPH (val
, i
);
1716 if (beg
+ LGLYPH_FROM (glyph
) == new_pt
)
1718 if (beg
+ LGLYPH_TO (glyph
) >= new_pt
)
1719 return (new_pt
< last_pt
1720 ? beg
+ LGLYPH_FROM (glyph
)
1721 : beg
+ LGLYPH_TO (glyph
) + 1);
1726 DEFUN ("composition-get-gstring", Fcomposition_get_gstring
,
1727 Scomposition_get_gstring
, 4, 4, 0,
1728 doc
: /* Return a glyph-string for characters between FROM and TO.
1729 If the glyph string is for graphic display, FONT-OBJECT must be
1730 a font-object to use for those characters.
1731 Otherwise (for terminal display), FONT-OBJECT must be a terminal ID, a
1732 frame, or nil for the selected frame's terminal device.
1734 If the optional 4th argument STRING is not nil, it is a string
1735 containing the target characters between indices FROM and TO.
1737 A glyph-string is a vector containing information about how to display
1738 a specific character sequence. The format is:
1739 [HEADER ID GLYPH ...]
1741 HEADER is a vector of this form:
1742 [FONT-OBJECT CHAR ...]
1744 FONT-OBJECT is a font-object for all glyphs in the glyph-string,
1745 or the terminal coding system of the specified terminal.
1746 CHARs are characters to be composed by GLYPHs.
1748 ID is an identification number of the glyph-string. It may be nil if
1751 GLYPH is a vector whose elements have this form:
1752 [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT
1753 [ [X-OFF Y-OFF WADJUST] | nil] ]
1755 FROM-IDX and TO-IDX are used internally and should not be touched.
1756 C is the character of the glyph.
1757 CODE is the glyph-code of C in FONT-OBJECT.
1758 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
1759 X-OFF and Y-OFF are offsets to the base position for the glyph.
1760 WADJUST is the adjustment to the normal width of the glyph.
1762 If GLYPH is nil, the remaining elements of the glyph-string vector
1763 should be ignored. */)
1764 (Lisp_Object from
, Lisp_Object to
, Lisp_Object font_object
, Lisp_Object string
)
1766 Lisp_Object gstring
, header
;
1767 EMACS_INT frompos
, topos
;
1769 CHECK_NATNUM (from
);
1771 if (! FONT_OBJECT_P (font_object
))
1773 struct coding_system
*coding
;
1774 struct terminal
*terminal
= get_terminal (font_object
, 1);
1776 coding
= ((TERMINAL_TERMINAL_CODING (terminal
)->common_flags
1777 & CODING_REQUIRE_ENCODING_MASK
)
1778 ? TERMINAL_TERMINAL_CODING (terminal
) : &safe_terminal_coding
);
1779 font_object
= CODING_ID_NAME (coding
->id
);
1782 header
= fill_gstring_header (Qnil
, from
, to
, font_object
, string
);
1783 gstring
= gstring_lookup_cache (header
);
1784 if (! NILP (gstring
))
1787 frompos
= XINT (from
);
1789 if (LGSTRING_GLYPH_LEN (gstring_work
) < topos
- frompos
)
1790 gstring_work
= Fmake_vector (make_number (topos
- frompos
+ 2), Qnil
);
1791 LGSTRING_SET_HEADER (gstring_work
, header
);
1792 LGSTRING_SET_ID (gstring_work
, Qnil
);
1793 fill_gstring_body (gstring_work
);
1794 return gstring_work
;
1798 /* Emacs Lisp APIs. */
1800 DEFUN ("compose-region-internal", Fcompose_region_internal
,
1801 Scompose_region_internal
, 2, 4, 0,
1802 doc
: /* Internal use only.
1804 Compose text in the region between START and END.
1805 Optional 3rd and 4th arguments are COMPONENTS and MODIFICATION-FUNC
1806 for the composition. See `compose-region' for more details. */)
1807 (Lisp_Object start
, Lisp_Object end
, Lisp_Object components
, Lisp_Object modification_func
)
1809 validate_region (&start
, &end
);
1810 if (!NILP (components
)
1811 && !INTEGERP (components
)
1812 && !CONSP (components
)
1813 && !STRINGP (components
))
1814 CHECK_VECTOR (components
);
1816 compose_text (XINT (start
), XINT (end
), components
, modification_func
, Qnil
);
1820 DEFUN ("compose-string-internal", Fcompose_string_internal
,
1821 Scompose_string_internal
, 3, 5, 0,
1822 doc
: /* Internal use only.
1824 Compose text between indices START and END of STRING.
1825 Optional 4th and 5th arguments are COMPONENTS and MODIFICATION-FUNC
1826 for the composition. See `compose-string' for more details. */)
1827 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
, Lisp_Object components
, Lisp_Object modification_func
)
1829 CHECK_STRING (string
);
1830 CHECK_NUMBER (start
);
1833 if (XINT (start
) < 0 ||
1834 XINT (start
) > XINT (end
)
1835 || XINT (end
) > SCHARS (string
))
1836 args_out_of_range (start
, end
);
1838 compose_text (XINT (start
), XINT (end
), components
, modification_func
, string
);
1842 DEFUN ("find-composition-internal", Ffind_composition_internal
,
1843 Sfind_composition_internal
, 4, 4, 0,
1844 doc
: /* Internal use only.
1846 Return information about composition at or nearest to position POS.
1847 See `find-composition' for more details. */)
1848 (Lisp_Object pos
, Lisp_Object limit
, Lisp_Object string
, Lisp_Object detail_p
)
1850 Lisp_Object prop
, tail
, gstring
;
1851 EMACS_INT start
, end
, from
, to
;
1854 CHECK_NUMBER_COERCE_MARKER (pos
);
1858 CHECK_NUMBER_COERCE_MARKER (limit
);
1866 CHECK_STRING (string
);
1867 if (XINT (pos
) < 0 || XINT (pos
) > SCHARS (string
))
1868 args_out_of_range (string
, pos
);
1872 if (XINT (pos
) < BEGV
|| XINT (pos
) > ZV
)
1873 args_out_of_range (Fcurrent_buffer (), pos
);
1876 if (!find_composition (from
, to
, &start
, &end
, &prop
, string
))
1878 if (!NILP (BVAR (current_buffer
, enable_multibyte_characters
))
1879 && ! NILP (Vauto_composition_mode
)
1880 && find_automatic_composition (from
, to
, &start
, &end
, &gstring
,
1882 return list3 (make_number (start
), make_number (end
), gstring
);
1885 if ((end
<= XINT (pos
) || start
> XINT (pos
)))
1889 if (find_automatic_composition (from
, to
, &s
, &e
, &gstring
, string
)
1890 && (e
<= XINT (pos
) ? e
> end
: s
< start
))
1891 return list3 (make_number (s
), make_number (e
), gstring
);
1893 if (!COMPOSITION_VALID_P (start
, end
, prop
))
1894 return Fcons (make_number (start
), Fcons (make_number (end
),
1895 Fcons (Qnil
, Qnil
)));
1896 if (NILP (detail_p
))
1897 return Fcons (make_number (start
), Fcons (make_number (end
),
1900 if (COMPOSITION_REGISTERD_P (prop
))
1901 id
= COMPOSITION_ID (prop
);
1904 EMACS_INT start_byte
= (NILP (string
)
1905 ? CHAR_TO_BYTE (start
)
1906 : string_char_to_byte (string
, start
));
1907 id
= get_composition_id (start
, start_byte
, end
- start
, prop
, string
);
1912 Lisp_Object components
, relative_p
, mod_func
;
1913 enum composition_method method
= COMPOSITION_METHOD (prop
);
1914 int width
= composition_table
[id
]->width
;
1916 components
= Fcopy_sequence (COMPOSITION_COMPONENTS (prop
));
1917 relative_p
= (method
== COMPOSITION_WITH_RULE_ALTCHARS
1919 mod_func
= COMPOSITION_MODIFICATION_FUNC (prop
);
1920 tail
= Fcons (components
,
1923 Fcons (make_number (width
), Qnil
))));
1928 return Fcons (make_number (start
), Fcons (make_number (end
), tail
));
1933 syms_of_composite (void)
1937 DEFSYM (Qcomposition
, "composition");
1939 /* Make a hash table for static composition. */
1941 Lisp_Object args
[6];
1945 args
[2] = QCweakness
;
1946 /* We used to make the hash table weak so that unreferenced
1947 compositions can be garbage-collected. But, usually once
1948 created compositions are repeatedly used in an Emacs session,
1949 and thus it's not worth to save memory in such a way. So, we
1950 make the table not weak. */
1953 args
[5] = make_number (311);
1954 composition_hash_table
= Fmake_hash_table (6, args
);
1955 staticpro (&composition_hash_table
);
1958 /* Make a hash table for glyph-string. */
1960 Lisp_Object args
[6];
1963 args
[2] = QCweakness
;
1966 args
[5] = make_number (311);
1967 gstring_hash_table
= Fmake_hash_table (6, args
);
1968 staticpro (&gstring_hash_table
);
1971 staticpro (&gstring_work_headers
);
1972 gstring_work_headers
= Fmake_vector (make_number (8), Qnil
);
1973 for (i
= 0; i
< 8; i
++)
1974 ASET (gstring_work_headers
, i
, Fmake_vector (make_number (i
+ 2), Qnil
));
1975 staticpro (&gstring_work
);
1976 gstring_work
= Fmake_vector (make_number (10), Qnil
);
1978 /* Text property `composition' should be nonsticky by default. */
1979 Vtext_property_default_nonsticky
1980 = Fcons (Fcons (Qcomposition
, Qt
), Vtext_property_default_nonsticky
);
1982 DEFVAR_LISP ("compose-chars-after-function", Vcompose_chars_after_function
,
1983 doc
: /* Function to adjust composition of buffer text.
1985 This function is called with three arguments: FROM, TO, and OBJECT.
1986 FROM and TO specify the range of text whose composition should be
1987 adjusted. OBJECT, if non-nil, is a string that contains the text.
1989 This function is called after a text with `composition' property is
1990 inserted or deleted to keep `composition' property of buffer text
1993 The default value is the function `compose-chars-after'. */);
1994 Vcompose_chars_after_function
= intern_c_string ("compose-chars-after");
1996 DEFSYM (Qauto_composed
, "auto-composed");
1997 DEFSYM (Qauto_composition_function
, "auto-composition-function");
1999 DEFVAR_LISP ("auto-composition-mode", Vauto_composition_mode
,
2000 doc
: /* Non-nil if Auto-Composition mode is enabled.
2001 Use the command `auto-composition-mode' to change this variable. */);
2002 Vauto_composition_mode
= Qt
;
2004 DEFVAR_LISP ("auto-composition-function", Vauto_composition_function
,
2005 doc
: /* Function to call to compose characters automatically.
2006 This function is called from the display routine with four arguments:
2007 FROM, TO, WINDOW, and STRING.
2009 If STRING is nil, the function must compose characters in the region
2010 between FROM and TO in the current buffer.
2012 Otherwise, STRING is a string, and FROM and TO are indices into the
2013 string. In this case, the function must compose characters in the
2015 Vauto_composition_function
= Qnil
;
2017 DEFVAR_LISP ("composition-function-table", Vcomposition_function_table
,
2018 doc
: /* Char-table of functions for automatic character composition.
2019 For each character that has to be composed automatically with
2020 preceding and/or following characters, this char-table contains
2021 a function to call to compose that character.
2023 The element at index C in the table, if non-nil, is a list of
2024 composition rules of this form: ([PATTERN PREV-CHARS FUNC] ...)
2026 PATTERN is a regular expression which C and the surrounding
2027 characters must match.
2029 PREV-CHARS is a non-negative integer (less than 4) specifying how many
2030 characters before C to check the matching with PATTERN. If it is 0,
2031 PATTERN must match C and the following characters. If it is 1,
2032 PATTERN must match a character before C and the following characters.
2034 If PREV-CHARS is 0, PATTERN can be nil, which means that the
2035 single character C should be composed.
2037 FUNC is a function to return a glyph-string representing a
2038 composition of the characters that match PATTERN. It is
2039 called with one argument GSTRING.
2041 GSTRING is a template of a glyph-string to return. It is already
2042 filled with a proper header for the characters to compose, and
2043 glyphs corresponding to those characters one by one. The
2044 function must return a new glyph-string with the same header as
2045 GSTRING, or modify GSTRING itself and return it.
2047 See also the documentation of `auto-composition-mode'. */);
2048 Vcomposition_function_table
= Fmake_char_table (Qnil
, Qnil
);
2050 defsubr (&Scompose_region_internal
);
2051 defsubr (&Scompose_string_internal
);
2052 defsubr (&Sfind_composition_internal
);
2053 defsubr (&Scomposition_get_gstring
);