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 TEMP_SET_PT_BOTH (pt
, pt_byte
);
966 return unbind_to (count
, lgstring
);
969 static Lisp_Object _work_val
;
970 static int _work_char
;
972 /* 1 iff the character C is composable. Characters of general
973 category Z? or C? are not composable except for ZWNJ and ZWJ. */
975 #define CHAR_COMPOSABLE_P(C) \
977 && ((C) == 0x200C || (C) == 0x200D \
978 || (_work_val = CHAR_TABLE_REF (Vunicode_category_table, (C)), \
979 (SYMBOLP (_work_val) \
980 && (_work_char = SDATA (SYMBOL_NAME (_work_val))[0]) != 'C' \
981 && _work_char != 'Z'))))
983 /* Update cmp_it->stop_pos to the next position after CHARPOS (and
984 BYTEPOS) where character composition may happen. If BYTEPOS is
985 negative, compute it. ENDPOS is a limit of searching. If it is
986 less than CHARPOS, search backward to ENDPOS+1 assuming that
987 set_iterator_to_next works in reverse order. In this case, if a
988 composition closest to CHARPOS is found, set cmp_it->stop_pos to
989 the last character of the composition.
991 If no composition is found, set cmp_it->ch to -2. If a static
992 composition is found, set cmp_it->ch to -1. Otherwise, set
993 cmp_it->ch to the character that triggers the automatic
997 composition_compute_stop_pos (struct composition_it
*cmp_it
, EMACS_INT charpos
, EMACS_INT bytepos
, EMACS_INT endpos
, Lisp_Object string
)
999 EMACS_INT start
, end
;
1001 Lisp_Object prop
, val
;
1002 /* This is from forward_to_next_line_start in xdisp.c. */
1003 const int MAX_NEWLINE_DISTANCE
= 500;
1005 if (charpos
< endpos
)
1007 if (endpos
> charpos
+ MAX_NEWLINE_DISTANCE
)
1008 endpos
= charpos
+ MAX_NEWLINE_DISTANCE
;
1010 else if (endpos
< charpos
)
1012 /* We search backward for a position to check composition. */
1015 /* But we don't know where to stop the searching. */
1016 endpos
= NILP (string
) ? BEGV
- 1 : -1;
1017 /* Usually we don't reach ENDPOS because we stop searching
1018 at an uncomposable character (NL, LRE, etc). */
1023 cmp_it
->reversed_p
= 0;
1024 cmp_it
->stop_pos
= endpos
;
1025 if (charpos
== endpos
)
1027 /* FIXME: Bidi is not yet handled well in static composition. */
1028 if (charpos
< endpos
1029 && find_composition (charpos
, endpos
, &start
, &end
, &prop
, string
)
1030 && COMPOSITION_VALID_P (start
, end
, prop
))
1032 cmp_it
->stop_pos
= endpos
= start
;
1035 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
))
1036 || NILP (Vauto_composition_mode
))
1041 bytepos
= CHAR_TO_BYTE (charpos
);
1043 bytepos
= string_char_to_byte (string
, charpos
);
1047 if (charpos
< endpos
)
1049 /* Forward search. */
1050 while (charpos
< endpos
)
1052 if (STRINGP (string
))
1053 FETCH_STRING_CHAR_ADVANCE (c
, string
, charpos
, bytepos
);
1055 FETCH_CHAR_ADVANCE (c
, charpos
, bytepos
);
1061 val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1067 for (ridx
= 0; CONSP (val
); val
= XCDR (val
), ridx
++)
1070 if (VECTORP (elt
) && ASIZE (elt
) == 3
1071 && NATNUMP (AREF (elt
, 1))
1072 && charpos
- 1 - XFASTINT (AREF (elt
, 1)) >= start
)
1077 cmp_it
->rule_idx
= ridx
;
1078 cmp_it
->lookback
= XFASTINT (AREF (elt
, 1));
1079 cmp_it
->stop_pos
= charpos
- 1 - cmp_it
->lookback
;
1085 if (charpos
== endpos
)
1087 /* We couldn't find a composition point before ENDPOS. But,
1088 some character after ENDPOS may be composed with
1089 characters before ENDPOS. So, we should stop at the safe
1091 charpos
= endpos
- MAX_AUTO_COMPOSITION_LOOKBACK
;
1092 if (charpos
< start
)
1096 else if (charpos
> endpos
)
1098 /* Search backward for a pattern that may be composed and the
1099 position of (possibly) the last character of the match is
1100 closest to (but not after) START. The reason for the last
1101 character is that set_iterator_to_next works in reverse order,
1102 and thus we must stop at the last character for composition
1106 /* Limit byte position used in fast_looking_at. This is the
1107 byte position of the character after START. */
1111 p
= BYTE_POS_ADDR (bytepos
);
1113 p
= SDATA (string
) + bytepos
;
1114 c
= STRING_CHAR_AND_LENGTH (p
, len
);
1115 limit
= bytepos
+ len
;
1116 while (CHAR_COMPOSABLE_P (c
))
1118 val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1122 int ridx
, back
, blen
;
1124 for (ridx
= 0; CONSP (val
); val
= XCDR (val
), ridx
++)
1127 if (VECTORP (elt
) && ASIZE (elt
) == 3
1128 && NATNUMP (AREF (elt
, 1))
1129 && charpos
- (back
= XFASTINT (AREF (elt
, 1))) > endpos
)
1131 EMACS_INT cpos
= charpos
- back
, bpos
;
1136 bpos
= (NILP (string
) ? CHAR_TO_BYTE (cpos
)
1137 : string_char_to_byte (string
, cpos
));
1138 if (STRINGP (AREF (elt
, 0)))
1139 blen
= fast_looking_at (AREF (elt
, 0), cpos
, bpos
,
1140 start
+ 1, limit
, string
);
1145 /* Make CPOS point to the last character of
1146 match. Note that BLEN is byte-length. */
1151 cpos
= BYTE_TO_CHAR (bpos
) - 1;
1153 cpos
= string_byte_to_char (string
, bpos
) - 1;
1155 back
= cpos
- (charpos
- back
);
1156 if (cmp_it
->stop_pos
< cpos
1157 || (cmp_it
->stop_pos
== cpos
1158 && cmp_it
->lookback
< back
))
1160 cmp_it
->rule_idx
= ridx
;
1161 cmp_it
->stop_pos
= cpos
;
1163 cmp_it
->lookback
= back
;
1164 cmp_it
->nchars
= back
+ 1;
1170 if (charpos
- 1 == endpos
)
1172 if (STRINGP (string
))
1175 while (! CHAR_HEAD_P (*p
))
1181 DEC_BOTH (charpos
, bytepos
);
1182 p
= BYTE_POS_ADDR (bytepos
);
1184 c
= STRING_CHAR (p
);
1186 if (cmp_it
->ch
>= 0)
1187 /* We found a position to check. */
1189 /* Skip all uncomposable characters. */
1192 while (charpos
- 1 > endpos
&& ! CHAR_COMPOSABLE_P (c
))
1194 DEC_BOTH (charpos
, bytepos
);
1195 c
= FETCH_MULTIBYTE_CHAR (bytepos
);
1200 while (charpos
- 1 > endpos
&& ! CHAR_COMPOSABLE_P (c
))
1203 while (! CHAR_HEAD_P (*p
))
1206 c
= STRING_CHAR (p
);
1210 cmp_it
->stop_pos
= charpos
;
1213 /* Check if the character at CHARPOS (and BYTEPOS) is composed
1214 (possibly with the following characters) on window W. ENDPOS limits
1215 characters to be composed. FACE, in non-NULL, is a base face of
1216 the character. If STRING is not nil, it is a string containing the
1217 character to check, and CHARPOS and BYTEPOS are indices in the
1218 string. In that case, FACE must not be NULL.
1220 If the character is composed, setup members of CMP_IT (id, nglyphs,
1221 from, to, reversed_p), and return 1. Otherwise, update
1222 CMP_IT->stop_pos, and return 0. */
1225 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
)
1228 endpos
= NILP (string
) ? BEGV
: 0;
1230 if (cmp_it
->ch
== -2)
1232 composition_compute_stop_pos (cmp_it
, charpos
, bytepos
, endpos
, string
);
1233 if (cmp_it
->ch
== -2 || cmp_it
->stop_pos
!= charpos
)
1234 /* The current position is not composed. */
1240 /* We are looking at a static composition. */
1241 EMACS_INT start
, end
;
1244 find_composition (charpos
, -1, &start
, &end
, &prop
, string
);
1245 cmp_it
->id
= get_composition_id (charpos
, bytepos
, end
- start
,
1248 goto no_composition
;
1249 cmp_it
->nchars
= end
- start
;
1250 cmp_it
->nglyphs
= composition_table
[cmp_it
->id
]->glyph_len
;
1254 Lisp_Object lgstring
= Qnil
;
1255 Lisp_Object val
, elt
;
1258 val
= CHAR_TABLE_REF (Vcomposition_function_table
, cmp_it
->ch
);
1259 for (i
= 0; i
< cmp_it
->rule_idx
; i
++, val
= XCDR (val
));
1260 if (charpos
< endpos
)
1262 for (; CONSP (val
); val
= XCDR (val
))
1265 if (! VECTORP (elt
) || ASIZE (elt
) != 3
1266 || ! INTEGERP (AREF (elt
, 1)))
1268 if (XFASTINT (AREF (elt
, 1)) != cmp_it
->lookback
)
1269 goto no_composition
;
1270 lgstring
= autocmp_chars (elt
, charpos
, bytepos
, endpos
,
1272 if (composition_gstring_p (lgstring
))
1275 /* Composition failed perhaps because the font doesn't
1276 support sufficient range of characters. Try the
1277 other composition rules if any. */
1279 cmp_it
->reversed_p
= 0;
1283 EMACS_INT cpos
= charpos
, bpos
= bytepos
;
1288 if (cmp_it
->lookback
> 0)
1290 cpos
= charpos
- cmp_it
->lookback
;
1291 if (STRINGP (string
))
1292 bpos
= string_char_to_byte (string
, cpos
);
1294 bpos
= CHAR_TO_BYTE (cpos
);
1296 lgstring
= autocmp_chars (elt
, cpos
, bpos
, charpos
+ 1, w
, face
,
1298 if (composition_gstring_p (lgstring
)
1299 && cpos
+ LGSTRING_CHAR_LEN (lgstring
) - 1 == charpos
)
1301 /* Composition failed or didn't cover the current
1303 if (cmp_it
->lookback
== 0)
1304 goto no_composition
;
1306 /* Try to find a shorter compostion that starts after CPOS. */
1307 composition_compute_stop_pos (cmp_it
, charpos
, bytepos
, cpos
,
1309 if (cmp_it
->ch
== -2 || cmp_it
->stop_pos
< charpos
)
1310 goto no_composition
;
1311 val
= CHAR_TABLE_REF (Vcomposition_function_table
, cmp_it
->ch
);
1312 for (i
= 0; i
< cmp_it
->rule_idx
; i
++, val
= XCDR (val
));
1314 cmp_it
->reversed_p
= 1;
1316 if (NILP (lgstring
))
1317 goto no_composition
;
1318 if (NILP (LGSTRING_ID (lgstring
)))
1319 lgstring
= composition_gstring_put_cache (lgstring
, -1);
1320 cmp_it
->id
= XINT (LGSTRING_ID (lgstring
));
1321 for (i
= 0; i
< LGSTRING_GLYPH_LEN (lgstring
); i
++)
1322 if (NILP (LGSTRING_GLYPH (lgstring
, i
)))
1324 cmp_it
->nglyphs
= i
;
1329 goto no_composition
;
1333 if (charpos
== endpos
)
1335 if (charpos
< endpos
)
1341 bytepos
+= BYTES_BY_CHAR_HEAD (*(SDATA (string
) + bytepos
));
1346 /* BYTEPOS is calculated in composition_compute_stop_pos */
1349 composition_compute_stop_pos (cmp_it
, charpos
, bytepos
, endpos
, string
);
1353 /* Update charpos, nchars, nbytes, and width of the current grapheme
1356 If the composition is static or automatic in L2R context, the
1357 cluster is identified by CMP_IT->from, and CHARPOS is the position
1358 of the first character of the cluster. In this case, update
1361 If the composition is automatic in R2L context, the cluster is
1362 identified by CMP_IT->to, and CHARPOS is the position of the last
1363 character of the cluster. In this case, update CMP_IT->from too.
1365 The return value is the character code of the first character of
1366 the cluster, or -1 if the composition is somehow broken. */
1369 composition_update_it (struct composition_it
*cmp_it
, EMACS_INT charpos
, EMACS_INT bytepos
, Lisp_Object string
)
1371 int i
, c
IF_LINT (= 0);
1375 /* static composition */
1376 struct composition
*cmp
= composition_table
[cmp_it
->id
];
1378 cmp_it
->charpos
= charpos
;
1379 cmp_it
->to
= cmp_it
->nglyphs
;
1380 if (cmp_it
->nglyphs
== 0)
1384 for (i
= 0; i
< cmp
->glyph_len
; i
++)
1385 if ((c
= COMPOSITION_GLYPH (cmp
, i
)) != '\t')
1390 cmp_it
->width
= cmp
->width
;
1391 charpos
+= cmp_it
->nchars
;
1392 if (STRINGP (string
))
1393 cmp_it
->nbytes
= string_char_to_byte (string
, charpos
) - bytepos
;
1395 cmp_it
->nbytes
= CHAR_TO_BYTE (charpos
) - bytepos
;
1399 /* automatic composition */
1400 Lisp_Object gstring
= composition_gstring_from_id (cmp_it
->id
);
1404 if (cmp_it
->nglyphs
== 0)
1406 cmp_it
->nchars
= LGSTRING_CHAR_LEN (gstring
);
1408 cmp_it
->from
= cmp_it
->to
= 0;
1411 if (! cmp_it
->reversed_p
)
1413 glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->from
);
1414 from
= LGLYPH_FROM (glyph
);
1415 for (cmp_it
->to
= cmp_it
->from
+ 1; cmp_it
->to
< cmp_it
->nglyphs
;
1418 glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->to
);
1419 if (LGLYPH_FROM (glyph
) != from
)
1422 cmp_it
->charpos
= charpos
;
1426 glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->to
- 1);
1427 from
= LGLYPH_FROM (glyph
);
1428 cmp_it
->charpos
= charpos
- (LGLYPH_TO (glyph
) - from
);
1429 for (cmp_it
->from
= cmp_it
->to
- 1; cmp_it
->from
> 0;
1432 glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->from
- 1);
1433 if (LGLYPH_FROM (glyph
) != from
)
1437 glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->from
);
1438 cmp_it
->nchars
= LGLYPH_TO (glyph
) + 1 - from
;
1441 for (i
= cmp_it
->nchars
- 1; i
>= 0; i
--)
1443 c
= XINT (LGSTRING_CHAR (gstring
, i
));
1444 cmp_it
->nbytes
+= CHAR_BYTES (c
);
1445 cmp_it
->width
+= CHAR_WIDTH (c
);
1452 struct position_record
1454 EMACS_INT pos
, pos_byte
;
1458 /* Update the members of POSITION to the next character boundary. */
1459 #define FORWARD_CHAR(POSITION, STOP) \
1462 if ((POSITION).pos == (STOP)) \
1464 (POSITION).p = GAP_END_ADDR; \
1465 (POSITION).pos_byte = GPT_BYTE; \
1469 (POSITION).pos_byte += BYTES_BY_CHAR_HEAD (*((POSITION).p)); \
1470 (POSITION).p += BYTES_BY_CHAR_HEAD (*((POSITION).p)); \
1474 /* Update the members of POSITION to the previous character boundary. */
1475 #define BACKWARD_CHAR(POSITION, STOP) \
1477 if ((POSITION).pos == (STOP)) \
1478 (POSITION).p = GPT_ADDR; \
1480 (POSITION).pos_byte--; \
1482 } while (! CHAR_HEAD_P (*((POSITION).p))); \
1486 /* This is like find_composition, but find an automatic composition
1487 instead. It is assured that POS is not within a static
1488 composition. If found, set *GSTRING to the glyph-string
1489 representing the composition, and return 1. Otherwise, *GSTRING to
1490 Qnil, and return 0. */
1493 find_automatic_composition (EMACS_INT pos
, EMACS_INT limit
,
1494 EMACS_INT
*start
, EMACS_INT
*end
,
1495 Lisp_Object
*gstring
, Lisp_Object string
)
1497 EMACS_INT head
, tail
, stop
;
1498 /* Forward limit position of checking a composition taking a
1499 looking-back count into account. */
1500 EMACS_INT fore_check_limit
;
1501 struct position_record cur
, prev
;
1505 int need_adjustment
= 0;
1507 window
= Fget_buffer_window (Fcurrent_buffer (), Qnil
);
1510 w
= XWINDOW (window
);
1515 head
= BEGV
, tail
= ZV
, stop
= GPT
;
1516 cur
.pos_byte
= CHAR_TO_BYTE (cur
.pos
);
1517 cur
.p
= BYTE_POS_ADDR (cur
.pos_byte
);
1521 head
= 0, tail
= SCHARS (string
), stop
= -1;
1522 cur
.pos_byte
= string_char_to_byte (string
, cur
.pos
);
1523 cur
.p
= SDATA (string
) + cur
.pos_byte
;
1526 /* Finding a composition covering the character after POS is the
1527 same as setting LIMIT to POS. */
1530 fore_check_limit
= min (tail
, pos
+ 1 + MAX_AUTO_COMPOSITION_LOOKBACK
);
1532 fore_check_limit
= min (tail
, limit
+ MAX_AUTO_COMPOSITION_LOOKBACK
);
1534 /* Provided that we have these possible compositions now:
1536 POS: 1 2 3 4 5 6 7 8 9
1540 Here, it is known that characters after positions 1 and 9 can
1541 never be composed (i.e. ! CHAR_COMPOSABLE_P (CH)), and
1542 composition A is an invalid one because it's partially covered by
1543 the valid composition C. And to know whether a composition is
1544 valid or not, the only way is to start searching forward from a
1545 position that can not be a tail part of composition (it's 2 in
1548 Now we have these cases (1 through 4):
1550 -- character after POS is ... --
1551 not composable composable
1552 LIMIT <= POS (1) (3)
1555 Among them, in case (2), we simply search forward from POS.
1557 In the other cases, we at first rewind back to the position where
1558 the previous character is not composable or the beginning of
1559 buffer (string), then search compositions forward. In case (1)
1560 and (3) we repeat this process until a composition is found. */
1564 c
= STRING_CHAR (cur
.p
);
1565 if (! CHAR_COMPOSABLE_P (c
))
1567 if (limit
<= pos
) /* case (1) */
1570 if (cur
.pos
<= limit
)
1572 BACKWARD_CHAR (cur
, stop
);
1573 c
= STRING_CHAR (cur
.p
);
1574 } while (! CHAR_COMPOSABLE_P (c
));
1575 fore_check_limit
= cur
.pos
+ 1;
1578 /* No need of rewinding back. */
1579 goto search_forward
;
1582 /* Rewind back to the position where we can safely search
1583 forward for compositions. It is assured that the character
1584 at cur.pos is composable. */
1585 while (head
< cur
.pos
)
1588 BACKWARD_CHAR (cur
, stop
);
1589 c
= STRING_CHAR (cur
.p
);
1590 if (! CHAR_COMPOSABLE_P (c
))
1598 /* Now search forward. */
1600 prev
= cur
; /* remember the start of searching position. */
1601 while (cur
.pos
< fore_check_limit
)
1605 c
= STRING_CHAR (cur
.p
);
1606 for (val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1607 CONSP (val
); val
= XCDR (val
))
1609 Lisp_Object elt
= XCAR (val
);
1611 if (VECTORP (elt
) && ASIZE (elt
) == 3 && NATNUMP (AREF (elt
, 1)))
1613 EMACS_INT check_pos
= cur
.pos
- XFASTINT (AREF (elt
, 1));
1614 struct position_record check
;
1616 if (check_pos
< head
1617 || (limit
<= pos
? pos
< check_pos
1618 : limit
<= check_pos
))
1620 for (check
= cur
; check_pos
< check
.pos
; )
1621 BACKWARD_CHAR (check
, stop
);
1622 *gstring
= autocmp_chars (elt
, check
.pos
, check
.pos_byte
,
1623 tail
, w
, NULL
, string
);
1624 need_adjustment
= 1;
1625 if (NILP (*gstring
))
1627 /* As we have called Lisp, there's a possibility
1628 that buffer/string is relocated. */
1630 cur
.p
= BYTE_POS_ADDR (cur
.pos_byte
);
1632 cur
.p
= SDATA (string
) + cur
.pos_byte
;
1636 /* We found a candidate of a target composition. */
1638 *end
= check
.pos
+ LGSTRING_CHAR_LEN (*gstring
);
1641 : *start
<= pos
&& pos
< *end
)
1642 /* This is the target composition. */
1647 cur
.pos_byte
= CHAR_TO_BYTE (cur
.pos
);
1648 cur
.p
= BYTE_POS_ADDR (cur
.pos_byte
);
1652 cur
.pos_byte
= string_char_to_byte (string
, cur
.pos
);
1653 cur
.p
= SDATA (string
) + cur
.pos_byte
;
1660 /* We found no composition here. */
1661 FORWARD_CHAR (cur
, stop
);
1664 if (pos
< limit
) /* case (2) and (4)*/
1666 if (! NILP (*gstring
))
1668 if (prev
.pos
== head
)
1671 if (need_adjustment
)
1674 cur
.p
= BYTE_POS_ADDR (cur
.pos_byte
);
1676 cur
.p
= SDATA (string
) + cur
.pos_byte
;
1678 BACKWARD_CHAR (cur
, stop
);
1682 /* Return the adjusted point provided that point is moved from LAST_PT
1686 composition_adjust_point (EMACS_INT last_pt
, EMACS_INT new_pt
)
1688 EMACS_INT i
, beg
, end
;
1691 if (new_pt
== BEGV
|| new_pt
== ZV
)
1694 /* At first check the static composition. */
1695 if (get_property_and_range (new_pt
, Qcomposition
, &val
, &beg
, &end
, Qnil
)
1696 && COMPOSITION_VALID_P (beg
, end
, val
))
1698 if (beg
< new_pt
/* && end > new_pt <- It's always the case. */
1699 && (last_pt
<= beg
|| last_pt
>= end
))
1700 return (new_pt
< last_pt
? beg
: end
);
1704 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
))
1705 || NILP (Vauto_composition_mode
))
1708 /* Next check the automatic composition. */
1709 if (! find_automatic_composition (new_pt
, (EMACS_INT
) -1, &beg
, &end
, &val
,
1713 for (i
= 0; i
< LGSTRING_GLYPH_LEN (val
); i
++)
1715 Lisp_Object glyph
= LGSTRING_GLYPH (val
, i
);
1719 if (beg
+ LGLYPH_FROM (glyph
) == new_pt
)
1721 if (beg
+ LGLYPH_TO (glyph
) >= new_pt
)
1722 return (new_pt
< last_pt
1723 ? beg
+ LGLYPH_FROM (glyph
)
1724 : beg
+ LGLYPH_TO (glyph
) + 1);
1729 DEFUN ("composition-get-gstring", Fcomposition_get_gstring
,
1730 Scomposition_get_gstring
, 4, 4, 0,
1731 doc
: /* Return a glyph-string for characters between FROM and TO.
1732 If the glyph string is for graphic display, FONT-OBJECT must be
1733 a font-object to use for those characters.
1734 Otherwise (for terminal display), FONT-OBJECT must be a terminal ID, a
1735 frame, or nil for the selected frame's terminal device.
1737 If the optional 4th argument STRING is not nil, it is a string
1738 containing the target characters between indices FROM and TO.
1740 A glyph-string is a vector containing information about how to display
1741 a specific character sequence. The format is:
1742 [HEADER ID GLYPH ...]
1744 HEADER is a vector of this form:
1745 [FONT-OBJECT CHAR ...]
1747 FONT-OBJECT is a font-object for all glyphs in the glyph-string,
1748 or the terminal coding system of the specified terminal.
1749 CHARs are characters to be composed by GLYPHs.
1751 ID is an identification number of the glyph-string. It may be nil if
1754 GLYPH is a vector whose elements have this form:
1755 [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT
1756 [ [X-OFF Y-OFF WADJUST] | nil] ]
1758 FROM-IDX and TO-IDX are used internally and should not be touched.
1759 C is the character of the glyph.
1760 CODE is the glyph-code of C in FONT-OBJECT.
1761 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
1762 X-OFF and Y-OFF are offsets to the base position for the glyph.
1763 WADJUST is the adjustment to the normal width of the glyph.
1765 If GLYPH is nil, the remaining elements of the glyph-string vector
1766 should be ignored. */)
1767 (Lisp_Object from
, Lisp_Object to
, Lisp_Object font_object
, Lisp_Object string
)
1769 Lisp_Object gstring
, header
;
1770 EMACS_INT frompos
, topos
;
1772 CHECK_NATNUM (from
);
1774 if (! FONT_OBJECT_P (font_object
))
1776 struct coding_system
*coding
;
1777 struct terminal
*terminal
= get_terminal (font_object
, 1);
1779 coding
= ((TERMINAL_TERMINAL_CODING (terminal
)->common_flags
1780 & CODING_REQUIRE_ENCODING_MASK
)
1781 ? TERMINAL_TERMINAL_CODING (terminal
) : &safe_terminal_coding
);
1782 font_object
= CODING_ID_NAME (coding
->id
);
1785 header
= fill_gstring_header (Qnil
, from
, to
, font_object
, string
);
1786 gstring
= gstring_lookup_cache (header
);
1787 if (! NILP (gstring
))
1790 frompos
= XINT (from
);
1792 if (LGSTRING_GLYPH_LEN (gstring_work
) < topos
- frompos
)
1793 gstring_work
= Fmake_vector (make_number (topos
- frompos
+ 2), Qnil
);
1794 LGSTRING_SET_HEADER (gstring_work
, header
);
1795 LGSTRING_SET_ID (gstring_work
, Qnil
);
1796 fill_gstring_body (gstring_work
);
1797 return gstring_work
;
1801 /* Emacs Lisp APIs. */
1803 DEFUN ("compose-region-internal", Fcompose_region_internal
,
1804 Scompose_region_internal
, 2, 4, 0,
1805 doc
: /* Internal use only.
1807 Compose text in the region between START and END.
1808 Optional 3rd and 4th arguments are COMPONENTS and MODIFICATION-FUNC
1809 for the composition. See `compose-region' for more details. */)
1810 (Lisp_Object start
, Lisp_Object end
, Lisp_Object components
, Lisp_Object modification_func
)
1812 validate_region (&start
, &end
);
1813 if (!NILP (components
)
1814 && !INTEGERP (components
)
1815 && !CONSP (components
)
1816 && !STRINGP (components
))
1817 CHECK_VECTOR (components
);
1819 compose_text (XINT (start
), XINT (end
), components
, modification_func
, Qnil
);
1823 DEFUN ("compose-string-internal", Fcompose_string_internal
,
1824 Scompose_string_internal
, 3, 5, 0,
1825 doc
: /* Internal use only.
1827 Compose text between indices START and END of STRING.
1828 Optional 4th and 5th arguments are COMPONENTS and MODIFICATION-FUNC
1829 for the composition. See `compose-string' for more details. */)
1830 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
, Lisp_Object components
, Lisp_Object modification_func
)
1832 CHECK_STRING (string
);
1833 CHECK_NUMBER (start
);
1836 if (XINT (start
) < 0 ||
1837 XINT (start
) > XINT (end
)
1838 || XINT (end
) > SCHARS (string
))
1839 args_out_of_range (start
, end
);
1841 compose_text (XINT (start
), XINT (end
), components
, modification_func
, string
);
1845 DEFUN ("find-composition-internal", Ffind_composition_internal
,
1846 Sfind_composition_internal
, 4, 4, 0,
1847 doc
: /* Internal use only.
1849 Return information about composition at or nearest to position POS.
1850 See `find-composition' for more details. */)
1851 (Lisp_Object pos
, Lisp_Object limit
, Lisp_Object string
, Lisp_Object detail_p
)
1853 Lisp_Object prop
, tail
, gstring
;
1854 EMACS_INT start
, end
, from
, to
;
1857 CHECK_NUMBER_COERCE_MARKER (pos
);
1861 CHECK_NUMBER_COERCE_MARKER (limit
);
1869 CHECK_STRING (string
);
1870 if (XINT (pos
) < 0 || XINT (pos
) > SCHARS (string
))
1871 args_out_of_range (string
, pos
);
1875 if (XINT (pos
) < BEGV
|| XINT (pos
) > ZV
)
1876 args_out_of_range (Fcurrent_buffer (), pos
);
1879 if (!find_composition (from
, to
, &start
, &end
, &prop
, string
))
1881 if (!NILP (BVAR (current_buffer
, enable_multibyte_characters
))
1882 && ! NILP (Vauto_composition_mode
)
1883 && find_automatic_composition (from
, to
, &start
, &end
, &gstring
,
1885 return list3 (make_number (start
), make_number (end
), gstring
);
1888 if ((end
<= XINT (pos
) || start
> XINT (pos
)))
1892 if (find_automatic_composition (from
, to
, &s
, &e
, &gstring
, string
)
1893 && (e
<= XINT (pos
) ? e
> end
: s
< start
))
1894 return list3 (make_number (s
), make_number (e
), gstring
);
1896 if (!COMPOSITION_VALID_P (start
, end
, prop
))
1897 return Fcons (make_number (start
), Fcons (make_number (end
),
1898 Fcons (Qnil
, Qnil
)));
1899 if (NILP (detail_p
))
1900 return Fcons (make_number (start
), Fcons (make_number (end
),
1903 if (COMPOSITION_REGISTERD_P (prop
))
1904 id
= COMPOSITION_ID (prop
);
1907 EMACS_INT start_byte
= (NILP (string
)
1908 ? CHAR_TO_BYTE (start
)
1909 : string_char_to_byte (string
, start
));
1910 id
= get_composition_id (start
, start_byte
, end
- start
, prop
, string
);
1915 Lisp_Object components
, relative_p
, mod_func
;
1916 enum composition_method method
= COMPOSITION_METHOD (prop
);
1917 int width
= composition_table
[id
]->width
;
1919 components
= Fcopy_sequence (COMPOSITION_COMPONENTS (prop
));
1920 relative_p
= (method
== COMPOSITION_WITH_RULE_ALTCHARS
1922 mod_func
= COMPOSITION_MODIFICATION_FUNC (prop
);
1923 tail
= Fcons (components
,
1926 Fcons (make_number (width
), Qnil
))));
1931 return Fcons (make_number (start
), Fcons (make_number (end
), tail
));
1936 syms_of_composite (void)
1940 Qcomposition
= intern_c_string ("composition");
1941 staticpro (&Qcomposition
);
1943 /* Make a hash table for static composition. */
1945 Lisp_Object args
[6];
1949 args
[2] = QCweakness
;
1950 /* We used to make the hash table weak so that unreferenced
1951 compositions can be garbage-collected. But, usually once
1952 created compositions are repeatedly used in an Emacs session,
1953 and thus it's not worth to save memory in such a way. So, we
1954 make the table not weak. */
1957 args
[5] = make_number (311);
1958 composition_hash_table
= Fmake_hash_table (6, args
);
1959 staticpro (&composition_hash_table
);
1962 /* Make a hash table for glyph-string. */
1964 Lisp_Object args
[6];
1967 args
[2] = QCweakness
;
1970 args
[5] = make_number (311);
1971 gstring_hash_table
= Fmake_hash_table (6, args
);
1972 staticpro (&gstring_hash_table
);
1975 staticpro (&gstring_work_headers
);
1976 gstring_work_headers
= Fmake_vector (make_number (8), Qnil
);
1977 for (i
= 0; i
< 8; i
++)
1978 ASET (gstring_work_headers
, i
, Fmake_vector (make_number (i
+ 2), Qnil
));
1979 staticpro (&gstring_work
);
1980 gstring_work
= Fmake_vector (make_number (10), Qnil
);
1982 /* Text property `composition' should be nonsticky by default. */
1983 Vtext_property_default_nonsticky
1984 = Fcons (Fcons (Qcomposition
, Qt
), Vtext_property_default_nonsticky
);
1986 DEFVAR_LISP ("compose-chars-after-function", Vcompose_chars_after_function
,
1987 doc
: /* Function to adjust composition of buffer text.
1989 This function is called with three arguments: FROM, TO, and OBJECT.
1990 FROM and TO specify the range of text whose composition should be
1991 adjusted. OBJECT, if non-nil, is a string that contains the text.
1993 This function is called after a text with `composition' property is
1994 inserted or deleted to keep `composition' property of buffer text
1997 The default value is the function `compose-chars-after'. */);
1998 Vcompose_chars_after_function
= intern_c_string ("compose-chars-after");
2000 Qauto_composed
= intern_c_string ("auto-composed");
2001 staticpro (&Qauto_composed
);
2003 Qauto_composition_function
= intern_c_string ("auto-composition-function");
2004 staticpro (&Qauto_composition_function
);
2006 DEFVAR_LISP ("auto-composition-mode", Vauto_composition_mode
,
2007 doc
: /* Non-nil if Auto-Composition mode is enabled.
2008 Use the command `auto-composition-mode' to change this variable. */);
2009 Vauto_composition_mode
= Qt
;
2011 DEFVAR_LISP ("auto-composition-function", Vauto_composition_function
,
2012 doc
: /* Function to call to compose characters automatically.
2013 This function is called from the display routine with four arguments:
2014 FROM, TO, WINDOW, and STRING.
2016 If STRING is nil, the function must compose characters in the region
2017 between FROM and TO in the current buffer.
2019 Otherwise, STRING is a string, and FROM and TO are indices into the
2020 string. In this case, the function must compose characters in the
2022 Vauto_composition_function
= Qnil
;
2024 DEFVAR_LISP ("composition-function-table", Vcomposition_function_table
,
2025 doc
: /* Char-table of functions for automatic character composition.
2026 For each character that has to be composed automatically with
2027 preceding and/or following characters, this char-table contains
2028 a function to call to compose that character.
2030 The element at index C in the table, if non-nil, is a list of
2031 composition rules of this form: ([PATTERN PREV-CHARS FUNC] ...)
2033 PATTERN is a regular expression which C and the surrounding
2034 characters must match.
2036 PREV-CHARS is a non-negative integer (less than 4) specifying how many
2037 characters before C to check the matching with PATTERN. If it is 0,
2038 PATTERN must match C and the following characters. If it is 1,
2039 PATTERN must match a character before C and the following characters.
2041 If PREV-CHARS is 0, PATTERN can be nil, which means that the
2042 single character C should be composed.
2044 FUNC is a function to return a glyph-string representing a
2045 composition of the characters that match PATTERN. It is
2046 called with one argument GSTRING.
2048 GSTRING is a template of a glyph-string to return. It is already
2049 filled with a proper header for the characters to compose, and
2050 glyphs corresponding to those characters one by one. The
2051 function must return a new glyph-string with the same header as
2052 GSTRING, or modify GSTRING itself and return it.
2054 See also the documentation of `auto-composition-mode'. */);
2055 Vcomposition_function_table
= Fmake_char_table (Qnil
, Qnil
);
2057 defsubr (&Scompose_region_internal
);
2058 defsubr (&Scompose_string_internal
);
2059 defsubr (&Sfind_composition_internal
);
2060 defsubr (&Scomposition_get_gstring
);