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 Lisp_Object Qauto_composed
;
156 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 EXFUN (Fremove_list_of_text_properties
, 4);
163 /* Temporary variable used in macros COMPOSITION_XXX. */
164 Lisp_Object composition_temp
;
167 /* Return COMPOSITION-ID of a composition at buffer position
168 CHARPOS/BYTEPOS and length NCHARS. The `composition' property of
169 the sequence is PROP. STRING, if non-nil, is a string that
170 contains the composition instead of the current buffer.
172 If the composition is invalid, return -1. */
175 get_composition_id (EMACS_INT charpos
, EMACS_INT bytepos
, EMACS_INT nchars
,
176 Lisp_Object prop
, Lisp_Object string
)
178 Lisp_Object id
, length
, components
, key
, *key_contents
;
180 struct Lisp_Hash_Table
*hash_table
= XHASH_TABLE (composition_hash_table
);
183 struct composition
*cmp
;
188 Form-A: ((LENGTH . COMPONENTS) . MODIFICATION-FUNC)
190 Form-B: (COMPOSITION-ID . (LENGTH COMPONENTS-VEC . MODIFICATION-FUNC))
192 if (nchars
== 0 || !CONSP (prop
))
193 goto invalid_composition
;
198 /* PROP should be Form-B. */
199 if (XINT (id
) < 0 || XINT (id
) >= n_compositions
)
200 goto invalid_composition
;
204 /* PROP should be Form-A.
205 Thus, ID should be (LENGTH . COMPONENTS). */
207 goto invalid_composition
;
209 if (!INTEGERP (length
) || XINT (length
) != nchars
)
210 goto invalid_composition
;
212 components
= XCDR (id
);
214 /* Check if the same composition has already been registered or not
215 by consulting composition_hash_table. The key for this table is
216 COMPONENTS (converted to a vector COMPONENTS-VEC) or, if it is
217 nil, vector of characters in the composition range. */
218 if (INTEGERP (components
))
219 key
= Fmake_vector (make_number (1), components
);
220 else if (STRINGP (components
) || CONSP (components
))
221 key
= Fvconcat (1, &components
);
222 else if (VECTORP (components
))
224 else if (NILP (components
))
226 key
= Fmake_vector (make_number (nchars
), Qnil
);
227 if (STRINGP (string
))
228 for (i
= 0; i
< nchars
; i
++)
230 FETCH_STRING_CHAR_ADVANCE (ch
, string
, charpos
, bytepos
);
231 XVECTOR (key
)->contents
[i
] = make_number (ch
);
234 for (i
= 0; i
< nchars
; i
++)
236 FETCH_CHAR_ADVANCE (ch
, charpos
, bytepos
);
237 XVECTOR (key
)->contents
[i
] = make_number (ch
);
241 goto invalid_composition
;
243 hash_index
= hash_lookup (hash_table
, key
, &hash_code
);
246 /* We have already registered the same composition. Change PROP
247 from Form-A above to Form-B while replacing COMPONENTS with
248 COMPONENTS-VEC stored in the hash table. We can directly
249 modify the cons cell of PROP because it is not shared. */
250 key
= HASH_KEY (hash_table
, hash_index
);
251 id
= HASH_VALUE (hash_table
, hash_index
);
253 XSETCDR (prop
, Fcons (make_number (nchars
), Fcons (key
, XCDR (prop
))));
257 /* This composition is a new one. We must register it. */
259 /* Check if we have sufficient memory to store this information. */
260 if (composition_table_size
== 0)
262 composition_table_size
= 256;
264 = (struct composition
**) xmalloc (sizeof (composition_table
[0])
265 * composition_table_size
);
267 else if (composition_table_size
<= n_compositions
)
269 composition_table_size
+= 256;
271 = (struct composition
**) xrealloc (composition_table
,
272 sizeof (composition_table
[0])
273 * composition_table_size
);
276 key_contents
= XVECTOR (key
)->contents
;
278 /* Check if the contents of COMPONENTS are valid if COMPONENTS is a
279 vector or a list. It should be a sequence of:
280 char1 rule1 char2 rule2 char3 ... ruleN charN+1 */
282 if (VECTORP (components
)
283 && ASIZE (components
) >= 2
284 && VECTORP (AREF (components
, 0)))
286 /* COMPONENTS is a glyph-string. */
287 EMACS_UINT len
= ASIZE (key
);
289 for (i
= 1; i
< len
; i
++)
290 if (! VECTORP (AREF (key
, i
)))
291 goto invalid_composition
;
293 else if (VECTORP (components
) || CONSP (components
))
295 EMACS_UINT len
= XVECTOR (key
)->size
;
297 /* The number of elements should be odd. */
299 goto invalid_composition
;
300 /* All elements should be integers (character or encoded
301 composition rule). */
302 for (i
= 0; i
< len
; i
++)
304 if (!INTEGERP (key_contents
[i
]))
305 goto invalid_composition
;
309 /* Change PROP from Form-A above to Form-B. We can directly modify
310 the cons cell of PROP because it is not shared. */
311 XSETFASTINT (id
, n_compositions
);
313 XSETCDR (prop
, Fcons (make_number (nchars
), Fcons (key
, XCDR (prop
))));
315 /* Register the composition in composition_hash_table. */
316 hash_index
= hash_put (hash_table
, key
, id
, hash_code
);
318 /* Register the composition in composition_table. */
319 cmp
= (struct composition
*) xmalloc (sizeof (struct composition
));
321 cmp
->method
= (NILP (components
)
322 ? COMPOSITION_RELATIVE
323 : ((INTEGERP (components
) || STRINGP (components
))
324 ? COMPOSITION_WITH_ALTCHARS
325 : COMPOSITION_WITH_RULE_ALTCHARS
));
326 cmp
->hash_index
= hash_index
;
327 glyph_len
= (cmp
->method
== COMPOSITION_WITH_RULE_ALTCHARS
328 ? (XVECTOR (key
)->size
+ 1) / 2
329 : XVECTOR (key
)->size
);
330 cmp
->glyph_len
= glyph_len
;
331 cmp
->offsets
= (short *) xmalloc (sizeof (short) * glyph_len
* 2);
334 if (cmp
->method
!= COMPOSITION_WITH_RULE_ALTCHARS
)
336 /* Relative composition. */
338 for (i
= 0; i
< glyph_len
; i
++)
341 ch
= XINT (key_contents
[i
]);
342 this_width
= (ch
== '\t' ? 1 : CHAR_WIDTH (ch
));
343 if (cmp
->width
< this_width
)
344 cmp
->width
= this_width
;
349 /* Rule-base composition. */
350 float leftmost
= 0.0, rightmost
;
352 ch
= XINT (key_contents
[0]);
353 rightmost
= ch
!= '\t' ? CHAR_WIDTH (ch
) : 1;
355 for (i
= 1; i
< glyph_len
; i
+= 2)
357 int rule
, gref
, nref
, xoff
, yoff
;
361 rule
= XINT (key_contents
[i
]);
362 ch
= XINT (key_contents
[i
+ 1]);
363 this_width
= ch
!= '\t' ? CHAR_WIDTH (ch
) : 1;
365 /* A composition rule is specified by an integer value
366 that encodes global and new reference points (GREF and
367 NREF). GREF and NREF are specified by numbers as
375 ---3---4---5--- baseline
379 COMPOSITION_DECODE_RULE (rule
, gref
, nref
, xoff
, yoff
);
380 this_left
= (leftmost
381 + (gref
% 3) * (rightmost
- leftmost
) / 2.0
382 - (nref
% 3) * this_width
/ 2.0);
384 if (this_left
< leftmost
)
385 leftmost
= this_left
;
386 if (this_left
+ this_width
> rightmost
)
387 rightmost
= this_left
+ this_width
;
390 cmp
->width
= rightmost
- leftmost
;
391 if (cmp
->width
< (rightmost
- leftmost
))
392 /* To get a ceiling integer value. */
396 composition_table
[n_compositions
] = cmp
;
398 return n_compositions
++;
401 /* Would it be better to remove this `composition' property? */
406 /* Find a static composition at or nearest to position POS of OBJECT
409 OBJECT defaults to the current buffer. If there's a composition at
410 POS, set *START and *END to the start and end of the sequence,
411 *PROP to the `composition' property, and return 1.
413 If there's no composition at POS and LIMIT is negative, return 0.
415 Otherwise, search for a composition forward (LIMIT > POS) or
416 backward (LIMIT < POS). In this case, LIMIT bounds the search.
418 If a composition is found, set *START, *END, and *PROP as above,
419 and return 1, else return 0.
421 This doesn't check the validity of composition. */
424 find_composition (EMACS_INT pos
, EMACS_INT limit
,
425 EMACS_INT
*start
, EMACS_INT
*end
,
426 Lisp_Object
*prop
, Lisp_Object object
)
430 if (get_property_and_range (pos
, Qcomposition
, prop
, start
, end
, object
))
433 if (limit
< 0 || limit
== pos
)
436 if (limit
> pos
) /* search forward */
438 val
= Fnext_single_property_change (make_number (pos
), Qcomposition
,
439 object
, make_number (limit
));
444 else /* search backward */
446 if (get_property_and_range (pos
- 1, Qcomposition
, prop
, start
, end
,
449 val
= Fprevious_single_property_change (make_number (pos
), Qcomposition
,
450 object
, make_number (limit
));
456 get_property_and_range (pos
, Qcomposition
, prop
, start
, end
, object
);
460 /* Run a proper function to adjust the composition sitting between
461 FROM and TO with property PROP. */
464 run_composition_function (EMACS_INT from
, EMACS_INT to
, Lisp_Object prop
)
467 EMACS_INT start
, end
;
469 func
= COMPOSITION_MODIFICATION_FUNC (prop
);
470 /* If an invalid composition precedes or follows, try to make them
473 && find_composition (from
- 1, -1, &start
, &end
, &prop
, Qnil
)
474 && !COMPOSITION_VALID_P (start
, end
, prop
))
477 && find_composition (to
, -1, &start
, &end
, &prop
, Qnil
)
478 && !COMPOSITION_VALID_P (start
, end
, prop
))
480 if (!NILP (Ffboundp (func
)))
481 call2 (func
, make_number (from
), make_number (to
));
484 /* Make invalid compositions adjacent to or inside FROM and TO valid.
485 CHECK_MASK is bitwise `or' of mask bits defined by macros
486 CHECK_XXX (see the comment in composite.h).
488 It also resets the text-property `auto-composed' to a proper region
489 so that automatic character composition works correctly later while
490 displaying the region.
492 This function is called when a buffer text is changed. If the
493 change is deletion, FROM == TO. Otherwise, FROM < TO. */
496 update_compositions (EMACS_INT from
, EMACS_INT to
, int check_mask
)
499 EMACS_INT start
, end
;
500 /* The beginning and end of the region to set the property
501 `auto-composed' to nil. */
502 EMACS_INT min_pos
= from
, max_pos
= to
;
504 if (inhibit_modification_hooks
)
507 /* If FROM and TO are not in a valid range, do nothing. */
508 if (! (BEGV
<= from
&& from
<= to
&& to
<= ZV
))
511 if (check_mask
& CHECK_HEAD
)
513 /* FROM should be at composition boundary. But, insertion or
514 deletion will make two compositions adjacent and
515 indistinguishable when they have same (eq) property. To
516 avoid it, in such a case, we change the property of the
517 latter to the copy of it. */
519 && find_composition (from
- 1, -1, &start
, &end
, &prop
, Qnil
)
520 && COMPOSITION_VALID_P (start
, end
, prop
))
526 Fput_text_property (make_number (from
), make_number (end
),
528 Fcons (XCAR (prop
), XCDR (prop
)), Qnil
);
529 run_composition_function (start
, end
, prop
);
533 && find_composition (from
, -1, &start
, &from
, &prop
, Qnil
)
534 && COMPOSITION_VALID_P (start
, from
, prop
))
538 run_composition_function (start
, from
, prop
);
542 if (check_mask
& CHECK_INSIDE
)
544 /* In this case, we are sure that (check & CHECK_TAIL) is also
545 nonzero. Thus, here we should check only compositions before
548 && find_composition (from
, to
, &start
, &from
, &prop
, Qnil
)
549 && COMPOSITION_VALID_P (start
, from
, prop
)
551 run_composition_function (start
, from
, prop
);
554 if (check_mask
& CHECK_TAIL
)
557 && find_composition (to
- 1, -1, &start
, &end
, &prop
, Qnil
)
558 && COMPOSITION_VALID_P (start
, end
, prop
))
560 /* TO should be also at composition boundary. But,
561 insertion or deletion will make two compositions adjacent
562 and indistinguishable when they have same (eq) property.
563 To avoid it, in such a case, we change the property of
564 the former to the copy of it. */
567 Fput_text_property (make_number (start
), make_number (to
),
569 Fcons (XCAR (prop
), XCDR (prop
)), Qnil
);
572 run_composition_function (start
, end
, prop
);
575 && find_composition (to
, -1, &start
, &end
, &prop
, Qnil
)
576 && COMPOSITION_VALID_P (start
, end
, prop
))
578 run_composition_function (start
, end
, prop
);
582 if (min_pos
< max_pos
)
584 int count
= SPECPDL_INDEX ();
586 specbind (Qinhibit_read_only
, Qt
);
587 specbind (Qinhibit_modification_hooks
, Qt
);
588 specbind (Qinhibit_point_motion_hooks
, Qt
);
589 Fremove_list_of_text_properties (make_number (min_pos
),
590 make_number (max_pos
),
591 Fcons (Qauto_composed
, Qnil
), Qnil
);
592 unbind_to (count
, Qnil
);
597 /* Modify composition property values in LIST destructively. LIST is
598 a list as returned from text_property_list. Change values to the
599 top-level copies of them so that none of them are `eq'. */
602 make_composition_value_copy (Lisp_Object list
)
604 Lisp_Object plist
, val
;
606 for (; CONSP (list
); list
= XCDR (list
))
608 plist
= XCAR (XCDR (XCDR (XCAR (list
))));
609 while (CONSP (plist
) && CONSP (XCDR (plist
)))
611 if (EQ (XCAR (plist
), Qcomposition
)
612 && (val
= XCAR (XCDR (plist
)), CONSP (val
)))
613 XSETCAR (XCDR (plist
), Fcons (XCAR (val
), XCDR (val
)));
614 plist
= XCDR (XCDR (plist
));
620 /* Make text in the region between START and END a composition that
621 has COMPONENTS and MODIFICATION-FUNC.
623 If STRING is non-nil, then operate on characters contained between
624 indices START and END in STRING. */
627 compose_text (EMACS_INT start
, EMACS_INT end
, Lisp_Object components
,
628 Lisp_Object modification_func
, Lisp_Object string
)
632 prop
= Fcons (Fcons (make_number (end
- start
), components
),
634 Fput_text_property (make_number (start
), make_number (end
),
635 Qcomposition
, prop
, string
);
639 static Lisp_Object
autocmp_chars (Lisp_Object
, EMACS_INT
, EMACS_INT
,
640 EMACS_INT
, struct window
*,
641 struct face
*, Lisp_Object
);
644 /* Lisp glyph-string handlers */
646 /* Hash table for automatic composition. The key is a header of a
647 lgstring (Lispy glyph-string), and the value is a body of a
650 static Lisp_Object gstring_hash_table
;
652 static Lisp_Object
gstring_lookup_cache (Lisp_Object
);
655 gstring_lookup_cache (Lisp_Object header
)
657 struct Lisp_Hash_Table
*h
= XHASH_TABLE (gstring_hash_table
);
658 int i
= hash_lookup (h
, header
, NULL
);
660 return (i
>= 0 ? HASH_VALUE (h
, i
) : Qnil
);
664 composition_gstring_put_cache (Lisp_Object gstring
, int len
)
666 struct Lisp_Hash_Table
*h
= XHASH_TABLE (gstring_hash_table
);
668 Lisp_Object header
, copy
;
671 header
= LGSTRING_HEADER (gstring
);
672 hash
= h
->hashfn (h
, header
);
675 len
= LGSTRING_GLYPH_LEN (gstring
);
676 for (i
= 0; i
< len
; i
++)
677 if (NILP (LGSTRING_GLYPH (gstring
, i
)))
682 copy
= Fmake_vector (make_number (len
+ 2), Qnil
);
683 LGSTRING_SET_HEADER (copy
, Fcopy_sequence (header
));
684 for (i
= 0; i
< len
; i
++)
685 LGSTRING_SET_GLYPH (copy
, i
, Fcopy_sequence (LGSTRING_GLYPH (gstring
, i
)));
686 i
= hash_put (h
, LGSTRING_HEADER (copy
), copy
, hash
);
687 LGSTRING_SET_ID (copy
, make_number (i
));
692 composition_gstring_from_id (int id
)
694 struct Lisp_Hash_Table
*h
= XHASH_TABLE (gstring_hash_table
);
696 return HASH_VALUE (h
, id
);
699 static Lisp_Object
fill_gstring_header (Lisp_Object
, Lisp_Object
,
700 Lisp_Object
, Lisp_Object
,
704 composition_gstring_p (Lisp_Object gstring
)
709 if (! VECTORP (gstring
) || ASIZE (gstring
) < 2)
711 header
= LGSTRING_HEADER (gstring
);
712 if (! VECTORP (header
) || ASIZE (header
) < 2)
714 if (! NILP (LGSTRING_FONT (gstring
))
715 && (! FONT_OBJECT_P (LGSTRING_FONT (gstring
))
716 && ! CODING_SYSTEM_P (LGSTRING_FONT (gstring
))))
718 for (i
= 1; i
< ASIZE (LGSTRING_HEADER (gstring
)); i
++)
719 if (! NATNUMP (AREF (LGSTRING_HEADER (gstring
), i
)))
721 if (! NILP (LGSTRING_ID (gstring
)) && ! NATNUMP (LGSTRING_ID (gstring
)))
723 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
725 Lisp_Object glyph
= LGSTRING_GLYPH (gstring
, i
);
728 if (! VECTORP (glyph
) || ASIZE (glyph
) != LGLYPH_SIZE
)
735 composition_gstring_width (Lisp_Object gstring
, EMACS_INT from
, EMACS_INT to
,
736 struct font_metrics
*metrics
)
743 Lisp_Object font_object
= LGSTRING_FONT (gstring
);
745 if (FONT_OBJECT_P (font_object
))
747 struct font
*font
= XFONT_OBJECT (font_object
);
749 metrics
->ascent
= font
->ascent
;
750 metrics
->descent
= font
->descent
;
755 metrics
->descent
= 0;
757 metrics
->width
= metrics
->lbearing
= metrics
->rbearing
= 0;
759 for (glyph
= &LGSTRING_GLYPH (gstring
, from
); from
< to
; from
++, glyph
++)
763 if (NILP (LGLYPH_ADJUSTMENT (*glyph
)))
764 width
+= LGLYPH_WIDTH (*glyph
);
766 width
+= LGLYPH_WADJUST (*glyph
);
769 x
= metrics
->width
+ LGLYPH_LBEARING (*glyph
) + LGLYPH_XOFF (*glyph
);
770 if (metrics
->lbearing
> x
)
771 metrics
->lbearing
= x
;
772 x
= metrics
->width
+ LGLYPH_RBEARING (*glyph
) + LGLYPH_XOFF (*glyph
);
773 if (metrics
->rbearing
< x
)
774 metrics
->rbearing
= x
;
775 metrics
->width
= width
;
776 x
= LGLYPH_ASCENT (*glyph
) - LGLYPH_YOFF (*glyph
);
777 if (metrics
->ascent
< x
)
779 x
= LGLYPH_DESCENT (*glyph
) + LGLYPH_YOFF (*glyph
);
780 if (metrics
->descent
< x
)
781 metrics
->descent
= x
;
788 static Lisp_Object gstring_work
;
789 static Lisp_Object gstring_work_headers
;
792 fill_gstring_header (Lisp_Object header
, Lisp_Object start
, Lisp_Object end
, Lisp_Object font_object
, Lisp_Object string
)
794 EMACS_INT from
, to
, from_byte
;
799 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
800 error ("Attempt to shape unibyte text");
801 validate_region (&start
, &end
);
802 from
= XFASTINT (start
);
804 from_byte
= CHAR_TO_BYTE (from
);
808 CHECK_STRING (string
);
809 if (! STRING_MULTIBYTE (string
))
810 error ("Attempt to shape unibyte text");
811 /* FROM and TO are checked by the caller. */
814 if (from
< 0 || from
> to
|| to
> SCHARS (string
))
815 args_out_of_range_3 (string
, start
, end
);
816 from_byte
= string_char_to_byte (string
, from
);
821 error ("Attempt to shape zero-length text");
822 if (VECTORP (header
))
824 if (ASIZE (header
) != len
+ 1)
825 args_out_of_range (header
, make_number (len
+ 1));
830 header
= AREF (gstring_work_headers
, len
- 1);
832 header
= Fmake_vector (make_number (len
+ 1), Qnil
);
835 ASET (header
, 0, font_object
);
836 for (i
= 0; i
< len
; i
++)
841 FETCH_CHAR_ADVANCE_NO_CHECK (c
, from
, from_byte
);
843 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, from
, from_byte
);
844 ASET (header
, i
+ 1, make_number (c
));
850 fill_gstring_body (Lisp_Object gstring
)
852 Lisp_Object font_object
= LGSTRING_FONT (gstring
);
853 Lisp_Object header
= AREF (gstring
, 0);
854 EMACS_INT len
= LGSTRING_CHAR_LEN (gstring
);
857 for (i
= 0; i
< len
; i
++)
859 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
860 EMACS_INT c
= XINT (AREF (header
, i
+ 1));
865 LGSTRING_SET_GLYPH (gstring
, i
, g
);
867 LGLYPH_SET_FROM (g
, i
);
868 LGLYPH_SET_TO (g
, i
);
869 LGLYPH_SET_CHAR (g
, c
);
870 if (FONT_OBJECT_P (font_object
))
872 font_fill_lglyph_metrics (g
, font_object
);
876 int width
= XFASTINT (CHAR_TABLE_REF (Vchar_width_table
, c
));
878 LGLYPH_SET_CODE (g
, c
);
879 LGLYPH_SET_LBEARING (g
, 0);
880 LGLYPH_SET_RBEARING (g
, width
);
881 LGLYPH_SET_WIDTH (g
, width
);
882 LGLYPH_SET_ASCENT (g
, 1);
883 LGLYPH_SET_DESCENT (g
, 0);
885 LGLYPH_SET_ADJUSTMENT (g
, Qnil
);
887 if (i
< LGSTRING_GLYPH_LEN (gstring
))
888 LGSTRING_SET_GLYPH (gstring
, i
, Qnil
);
892 /* Try to compose the characters at CHARPOS according to composition
893 rule RULE ([PATTERN PREV-CHARS FUNC]). LIMIT limits the characters
894 to compose. STRING, if not nil, is a target string. WIN is a
895 window where the characters are being displayed. If characters are
896 successfully composed, return the composition as a glyph-string
897 object. Otherwise return nil. */
900 autocmp_chars (Lisp_Object rule
, EMACS_INT charpos
, EMACS_INT bytepos
, EMACS_INT limit
, struct window
*win
, struct face
*face
, Lisp_Object string
)
902 int count
= SPECPDL_INDEX ();
903 FRAME_PTR f
= XFRAME (win
->frame
);
904 Lisp_Object pos
= make_number (charpos
);
906 EMACS_INT pt
= PT
, pt_byte
= PT_BYTE
;
907 Lisp_Object re
, font_object
, lgstring
;
910 record_unwind_save_match_data ();
914 else if (! STRINGP (re
))
915 return unbind_to (count
, Qnil
);
916 else if ((len
= fast_looking_at (re
, charpos
, bytepos
, limit
, -1, string
))
920 len
= BYTE_TO_CHAR (bytepos
+ len
) - charpos
;
922 len
= string_byte_to_char (string
, bytepos
+ len
) - charpos
;
925 return unbind_to (count
, Qnil
);
926 to
= limit
= charpos
+ len
;
927 #ifdef HAVE_WINDOW_SYSTEM
928 if (FRAME_WINDOW_P (f
))
930 font_object
= font_range (charpos
, &to
, win
, face
, string
);
931 if (! FONT_OBJECT_P (font_object
)
934 && (fast_looking_at (re
, charpos
, bytepos
, to
, -1, string
) <= 0)))
935 return unbind_to (count
, Qnil
);
938 #endif /* not HAVE_WINDOW_SYSTEM */
939 font_object
= win
->frame
;
940 lgstring
= Fcomposition_get_gstring (pos
, make_number (to
), font_object
,
942 if (NILP (LGSTRING_ID (lgstring
)))
946 /* Save point as marker before calling out to lisp. */
949 Lisp_Object m
= Fmake_marker ();
950 set_marker_both (m
, Qnil
, pt
, pt_byte
);
951 record_unwind_protect (restore_point_unwind
, m
);
954 args
[0] = Vauto_composition_function
;
955 args
[1] = AREF (rule
, 2);
957 args
[3] = make_number (to
);
958 args
[4] = font_object
;
960 lgstring
= safe_call (6, args
);
962 TEMP_SET_PT_BOTH (pt
, pt_byte
);
964 return unbind_to (count
, lgstring
);
967 static Lisp_Object _work_val
;
968 static int _work_char
;
970 /* 1 iff the character C is composable. Characters of general
971 category Z? or C? are not composable except for ZWNJ and ZWJ. */
973 #define CHAR_COMPOSABLE_P(C) \
974 ((C) == 0x200C || (C) == 0x200D \
975 || (_work_val = CHAR_TABLE_REF (Vunicode_category_table, (C)), \
976 (SYMBOLP (_work_val) \
977 && (_work_char = SDATA (SYMBOL_NAME (_work_val))[0]) != 'C' \
978 && _work_char != 'Z')))
980 /* Update cmp_it->stop_pos to the next position after CHARPOS (and
981 BYTEPOS) where character composition may happen. If BYTEPOS is
982 negative, compute it. ENDPOS is a limit of searching. If it is
983 less than CHARPOS, search backward to ENDPOS+1 assuming that
984 set_iterator_to_next works in reverse order. In this case, if a
985 composition closest to CHARPOS is found, set cmp_it->stop_pos to
986 the last character of the composition.
988 If no composition is found, set cmp_it->ch to -2. If a static
989 composition is found, set cmp_it->ch to -1. Otherwise, set
990 cmp_it->ch to the character that triggers the automatic
994 composition_compute_stop_pos (struct composition_it
*cmp_it
, EMACS_INT charpos
, EMACS_INT bytepos
, EMACS_INT endpos
, Lisp_Object string
)
996 EMACS_INT start
, end
, c
;
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
)
1026 && COMPOSITION_VALID_P (start
, end
, prop
))
1028 cmp_it
->stop_pos
= endpos
= start
;
1031 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
))
1032 || NILP (Vauto_composition_mode
))
1037 bytepos
= CHAR_TO_BYTE (charpos
);
1039 bytepos
= string_char_to_byte (string
, charpos
);
1043 if (charpos
< endpos
)
1045 /* Forward search. */
1046 while (charpos
< endpos
)
1048 if (STRINGP (string
))
1049 FETCH_STRING_CHAR_ADVANCE (c
, string
, charpos
, bytepos
);
1051 FETCH_CHAR_ADVANCE (c
, charpos
, bytepos
);
1057 val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1063 for (ridx
= 0; CONSP (val
); val
= XCDR (val
), ridx
++)
1066 if (VECTORP (elt
) && ASIZE (elt
) == 3
1067 && NATNUMP (AREF (elt
, 1))
1068 && charpos
- 1 - XFASTINT (AREF (elt
, 1)) >= start
)
1073 cmp_it
->rule_idx
= ridx
;
1074 cmp_it
->lookback
= XFASTINT (AREF (elt
, 1));
1075 cmp_it
->stop_pos
= charpos
- 1 - cmp_it
->lookback
;
1081 if (charpos
== endpos
)
1083 /* We couldn't find a composition point before ENDPOS. But,
1084 some character after ENDPOS may be composed with
1085 characters before ENDPOS. So, we should stop at the safe
1087 charpos
= endpos
- MAX_AUTO_COMPOSITION_LOOKBACK
;
1088 if (charpos
< start
)
1092 else if (charpos
> endpos
)
1094 /* Search backward for a pattern that may be composed and the
1095 position of (possibly) the last character of the match is
1096 closest to (but not after) START. The reason for the last
1097 character is that set_iterator_to_next works in reverse order,
1098 and thus we must stop at the last character for composition
1102 /* Limit byte position used in fast_looking_at. This is the
1103 byte position of the character after START. */
1107 p
= BYTE_POS_ADDR (bytepos
);
1109 p
= SDATA (string
) + bytepos
;
1110 c
= STRING_CHAR_AND_LENGTH (p
, len
);
1111 limit
= bytepos
+ len
;
1112 while (CHAR_COMPOSABLE_P (c
))
1114 val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1118 int ridx
, back
, blen
;
1120 for (ridx
= 0; CONSP (val
); val
= XCDR (val
), ridx
++)
1123 if (VECTORP (elt
) && ASIZE (elt
) == 3
1124 && NATNUMP (AREF (elt
, 1))
1125 && charpos
- (back
= XFASTINT (AREF (elt
, 1))) > endpos
)
1127 EMACS_INT cpos
= charpos
- back
, bpos
;
1132 bpos
= (NILP (string
) ? CHAR_TO_BYTE (cpos
)
1133 : string_char_to_byte (string
, cpos
));
1134 if (STRINGP (AREF (elt
, 0)))
1135 blen
= fast_looking_at (AREF (elt
, 0), cpos
, bpos
,
1136 start
+ 1, limit
, string
);
1141 /* Make CPOS point to the last character of
1142 match. Note that BLEN is byte-length. */
1147 cpos
= BYTE_TO_CHAR (bpos
) - 1;
1149 cpos
= string_byte_to_char (string
, bpos
) - 1;
1151 back
= cpos
- (charpos
- back
);
1152 if (cmp_it
->stop_pos
< cpos
1153 || (cmp_it
->stop_pos
== cpos
1154 && cmp_it
->lookback
< back
))
1156 cmp_it
->rule_idx
= ridx
;
1157 cmp_it
->stop_pos
= cpos
;
1159 cmp_it
->lookback
= back
;
1160 cmp_it
->nchars
= back
+ 1;
1166 if (charpos
- 1 == endpos
)
1168 if (STRINGP (string
))
1171 while (! CHAR_HEAD_P (*p
))
1177 DEC_BOTH (charpos
, bytepos
);
1178 p
= BYTE_POS_ADDR (bytepos
);
1180 c
= STRING_CHAR (p
);
1182 if (cmp_it
->ch
>= 0)
1183 /* We found a position to check. */
1185 /* Skip all uncomposable characters. */
1188 while (charpos
- 1 > endpos
&& ! CHAR_COMPOSABLE_P (c
))
1190 DEC_BOTH (charpos
, bytepos
);
1191 c
= FETCH_MULTIBYTE_CHAR (bytepos
);
1196 while (charpos
- 1 > endpos
&& ! CHAR_COMPOSABLE_P (c
))
1199 while (! CHAR_HEAD_P (*p
))
1202 c
= STRING_CHAR (p
);
1206 cmp_it
->stop_pos
= charpos
;
1209 /* Check if the character at CHARPOS (and BYTEPOS) is composed
1210 (possibly with the following characters) on window W. ENDPOS limits
1211 characters to be composed. FACE, in non-NULL, is a base face of
1212 the character. If STRING is not nil, it is a string containing the
1213 character to check, and CHARPOS and BYTEPOS are indices in the
1214 string. In that case, FACE must not be NULL.
1216 If the character is composed, setup members of CMP_IT (id, nglyphs,
1217 from, to, reversed_p), and return 1. Otherwise, update
1218 CMP_IT->stop_pos, and return 0. */
1221 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
)
1224 endpos
= NILP (string
) ? BEGV
: 0;
1226 if (cmp_it
->ch
== -2)
1228 composition_compute_stop_pos (cmp_it
, charpos
, bytepos
, endpos
, string
);
1229 if (cmp_it
->ch
== -2 || cmp_it
->stop_pos
!= charpos
)
1230 /* The current position is not composed. */
1236 /* We are looking at a static composition. */
1237 EMACS_INT start
, end
;
1240 find_composition (charpos
, -1, &start
, &end
, &prop
, string
);
1241 cmp_it
->id
= get_composition_id (charpos
, bytepos
, end
- start
,
1244 goto no_composition
;
1245 cmp_it
->nchars
= end
- start
;
1246 cmp_it
->nglyphs
= composition_table
[cmp_it
->id
]->glyph_len
;
1250 Lisp_Object lgstring
= Qnil
;
1251 Lisp_Object val
, elt
;
1254 val
= CHAR_TABLE_REF (Vcomposition_function_table
, cmp_it
->ch
);
1255 for (i
= 0; i
< cmp_it
->rule_idx
; i
++, val
= XCDR (val
));
1256 if (charpos
< endpos
)
1258 for (; CONSP (val
); val
= XCDR (val
))
1261 if (! VECTORP (elt
) || ASIZE (elt
) != 3
1262 || ! INTEGERP (AREF (elt
, 1)))
1264 if (XFASTINT (AREF (elt
, 1)) != cmp_it
->lookback
)
1265 goto no_composition
;
1266 lgstring
= autocmp_chars (elt
, charpos
, bytepos
, endpos
,
1268 if (composition_gstring_p (lgstring
))
1271 /* Composition failed perhaps because the font doesn't
1272 support sufficient range of characters. Try the
1273 other composition rules if any. */
1275 cmp_it
->reversed_p
= 0;
1279 EMACS_INT cpos
= charpos
, bpos
= bytepos
;
1284 if (cmp_it
->lookback
> 0)
1286 cpos
= charpos
- cmp_it
->lookback
;
1287 if (STRINGP (string
))
1288 bpos
= string_char_to_byte (string
, cpos
);
1290 bpos
= CHAR_TO_BYTE (cpos
);
1292 lgstring
= autocmp_chars (elt
, cpos
, bpos
, charpos
+ 1, w
, face
,
1294 if (composition_gstring_p (lgstring
)
1295 && cpos
+ LGSTRING_CHAR_LEN (lgstring
) - 1 == charpos
)
1297 /* Composition failed or didn't cover the current
1299 if (cmp_it
->lookback
== 0)
1300 goto no_composition
;
1302 /* Try to find a shorter compostion that starts after CPOS. */
1303 composition_compute_stop_pos (cmp_it
, charpos
, bytepos
, cpos
,
1305 if (cmp_it
->ch
== -2 || cmp_it
->stop_pos
< charpos
)
1306 goto no_composition
;
1307 val
= CHAR_TABLE_REF (Vcomposition_function_table
, cmp_it
->ch
);
1308 for (i
= 0; i
< cmp_it
->rule_idx
; i
++, val
= XCDR (val
));
1310 cmp_it
->reversed_p
= 1;
1312 if (NILP (lgstring
))
1313 goto no_composition
;
1314 if (NILP (LGSTRING_ID (lgstring
)))
1315 lgstring
= composition_gstring_put_cache (lgstring
, -1);
1316 cmp_it
->id
= XINT (LGSTRING_ID (lgstring
));
1317 for (i
= 0; i
< LGSTRING_GLYPH_LEN (lgstring
); i
++)
1318 if (NILP (LGSTRING_GLYPH (lgstring
, i
)))
1320 cmp_it
->nglyphs
= i
;
1325 goto no_composition
;
1329 if (charpos
== endpos
)
1331 if (charpos
< endpos
)
1337 bytepos
+= BYTES_BY_CHAR_HEAD (*(SDATA (string
) + bytepos
));
1342 /* BYTEPOS is calculated in composition_compute_stop_pos */
1345 composition_compute_stop_pos (cmp_it
, charpos
, bytepos
, endpos
, string
);
1349 /* Update charpos, nchars, nbytes, and width of the current grapheme
1352 If the composition is static or automatic in L2R context, the
1353 cluster is identified by CMP_IT->from, and CHARPOS is the position
1354 of the first character of the cluster. In this case, update
1357 If the composition is automatic in R2L context, the cluster is
1358 identified by CMP_IT->to, and CHARPOS is the position of the last
1359 character of the cluster. In this case, update CMP_IT->from too.
1361 The return value is the character code of the first character of
1362 the cluster, or -1 if the composition is somehow broken. */
1365 composition_update_it (struct composition_it
*cmp_it
, EMACS_INT charpos
, EMACS_INT bytepos
, Lisp_Object string
)
1367 int i
, c
IF_LINT (= 0);
1371 /* static composition */
1372 struct composition
*cmp
= composition_table
[cmp_it
->id
];
1374 cmp_it
->charpos
= charpos
;
1375 cmp_it
->to
= cmp_it
->nglyphs
;
1376 if (cmp_it
->nglyphs
== 0)
1380 for (i
= 0; i
< cmp
->glyph_len
; i
++)
1381 if ((c
= COMPOSITION_GLYPH (cmp
, i
)) != '\t')
1386 cmp_it
->width
= cmp
->width
;
1387 charpos
+= cmp_it
->nchars
;
1388 if (STRINGP (string
))
1389 cmp_it
->nbytes
= string_char_to_byte (string
, charpos
) - bytepos
;
1391 cmp_it
->nbytes
= CHAR_TO_BYTE (charpos
) - bytepos
;
1395 /* automatic composition */
1396 Lisp_Object gstring
= composition_gstring_from_id (cmp_it
->id
);
1400 if (cmp_it
->nglyphs
== 0)
1402 cmp_it
->nchars
= LGSTRING_CHAR_LEN (gstring
);
1404 cmp_it
->from
= cmp_it
->to
= 0;
1407 if (! cmp_it
->reversed_p
)
1409 glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->from
);
1410 from
= LGLYPH_FROM (glyph
);
1411 for (cmp_it
->to
= cmp_it
->from
+ 1; cmp_it
->to
< cmp_it
->nglyphs
;
1414 glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->to
);
1415 if (LGLYPH_FROM (glyph
) != from
)
1418 cmp_it
->charpos
= charpos
;
1422 glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->to
- 1);
1423 from
= LGLYPH_FROM (glyph
);
1424 cmp_it
->charpos
= charpos
- (LGLYPH_TO (glyph
) - from
);
1425 for (cmp_it
->from
= cmp_it
->to
- 1; cmp_it
->from
> 0;
1428 glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->from
- 1);
1429 if (LGLYPH_FROM (glyph
) != from
)
1433 glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->from
);
1434 cmp_it
->nchars
= LGLYPH_TO (glyph
) + 1 - from
;
1437 for (i
= cmp_it
->nchars
- 1; i
>= 0; i
--)
1439 c
= XINT (LGSTRING_CHAR (gstring
, i
));
1440 cmp_it
->nbytes
+= CHAR_BYTES (c
);
1441 cmp_it
->width
+= CHAR_WIDTH (c
);
1448 struct position_record
1450 EMACS_INT pos
, pos_byte
;
1454 /* Update the members of POSITION to the next character boundary. */
1455 #define FORWARD_CHAR(POSITION, STOP) \
1458 if ((POSITION).pos == (STOP)) \
1460 (POSITION).p = GAP_END_ADDR; \
1461 (POSITION).pos_byte = GPT_BYTE; \
1465 (POSITION).pos_byte += BYTES_BY_CHAR_HEAD (*((POSITION).p)); \
1466 (POSITION).p += BYTES_BY_CHAR_HEAD (*((POSITION).p)); \
1470 /* Update the members of POSITION to the previous character boundary. */
1471 #define BACKWARD_CHAR(POSITION, STOP) \
1473 if ((POSITION).pos == STOP) \
1474 (POSITION).p = GPT_ADDR; \
1476 (POSITION).pos_byte--; \
1478 } while (! CHAR_HEAD_P (*((POSITION).p))); \
1482 /* This is like find_composition, but find an automatic composition
1483 instead. If found, set *GSTRING to the glyph-string representing
1484 the composition, and return 1. Otherwise, return 0. */
1487 find_automatic_composition (EMACS_INT pos
, EMACS_INT limit
, EMACS_INT
*start
, EMACS_INT
*end
, Lisp_Object
*gstring
, Lisp_Object string
)
1489 EMACS_INT head
, tail
, stop
;
1490 /* Limit to check a composition after POS. */
1491 EMACS_INT fore_check_limit
;
1492 struct position_record orig
, cur
, check
, prev
;
1493 Lisp_Object check_val
, val
, elt
;
1498 window
= Fget_buffer_window (Fcurrent_buffer (), Qnil
);
1501 w
= XWINDOW (window
);
1506 head
= BEGV
, tail
= ZV
, stop
= GPT
;
1507 orig
.pos_byte
= CHAR_TO_BYTE (orig
.pos
);
1508 orig
.p
= BYTE_POS_ADDR (orig
.pos_byte
);
1512 head
= 0, tail
= SCHARS (string
), stop
= -1;
1513 orig
.pos_byte
= string_char_to_byte (string
, orig
.pos
);
1514 orig
.p
= SDATA (string
) + orig
.pos_byte
;
1517 fore_check_limit
= min (tail
, pos
+ MAX_AUTO_COMPOSITION_LOOKBACK
);
1519 fore_check_limit
= min (tail
, limit
+ MAX_AUTO_COMPOSITION_LOOKBACK
);
1524 /* At first, check if POS is composable. */
1525 c
= STRING_CHAR (cur
.p
);
1526 if (! CHAR_COMPOSABLE_P (c
))
1530 if (limit
>= cur
.pos
)
1531 goto search_forward
;
1535 val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1537 check_val
= val
, check
= cur
;
1539 while (cur
.pos
+ 1 < fore_check_limit
)
1543 FORWARD_CHAR (cur
, stop
);
1544 if (get_property_and_range (cur
.pos
, Qcomposition
, &val
, &b
, &e
,
1546 && COMPOSITION_VALID_P (b
, e
, val
))
1548 fore_check_limit
= cur
.pos
;
1551 c
= STRING_CHAR (cur
.p
);
1552 if (! CHAR_COMPOSABLE_P (c
))
1554 val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1557 check_val
= val
, check
= cur
;
1562 /* Rewind back to the position where we can safely search forward
1563 for compositions. */
1564 while (cur
.pos
> head
)
1568 BACKWARD_CHAR (cur
, stop
);
1569 if (get_property_and_range (cur
.pos
, Qcomposition
, &val
, &b
, &e
, Qnil
)
1570 && COMPOSITION_VALID_P (b
, e
, val
))
1572 c
= STRING_CHAR (cur
.p
);
1573 if (! CHAR_COMPOSABLE_P (c
))
1575 val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1577 check_val
= val
, check
= cur
;
1580 /* Now search forward. */
1583 if (! NILP (check_val
) || limit
>= orig
.pos
)
1585 if (NILP (check_val
))
1589 while (cur
.pos
< fore_check_limit
)
1591 int need_adjustment
= 0;
1593 if (NILP (check_val
))
1595 c
= STRING_CHAR (cur
.p
);
1596 check_val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1598 for (; CONSP (check_val
); check_val
= XCDR (check_val
))
1600 elt
= XCAR (check_val
);
1601 if (VECTORP (elt
) && ASIZE (elt
) == 3 && NATNUMP (AREF (elt
, 1))
1602 && cur
.pos
- XFASTINT (AREF (elt
, 1)) >= head
)
1604 check
.pos
= cur
.pos
- XFASTINT (AREF (elt
, 1));
1605 if (check
.pos
== cur
.pos
)
1606 check
.pos_byte
= cur
.pos_byte
;
1608 check
.pos_byte
= CHAR_TO_BYTE (check
.pos
);
1609 val
= autocmp_chars (elt
, check
.pos
, check
.pos_byte
,
1610 tail
, w
, NULL
, string
);
1611 need_adjustment
= 1;
1616 *end
= check
.pos
+ LGSTRING_CHAR_LEN (*gstring
);
1617 if (*start
<= orig
.pos
? *end
> orig
.pos
1618 : limit
>= orig
.pos
)
1621 cur
.pos_byte
= CHAR_TO_BYTE (cur
.pos
);
1626 if (need_adjustment
)
1628 /* As we have called Lisp, there's a possibility that
1629 buffer/string is relocated. */
1631 cur
.p
= BYTE_POS_ADDR (cur
.pos_byte
);
1633 cur
.p
= SDATA (string
) + cur
.pos_byte
;
1635 if (! CONSP (check_val
))
1636 FORWARD_CHAR (cur
, stop
);
1640 if (! NILP (*gstring
))
1641 return (limit
>= 0 || (*start
<= orig
.pos
&& *end
> orig
.pos
));
1642 if (limit
>= 0 && limit
< orig
.pos
&& prev
.pos
> head
)
1645 BACKWARD_CHAR (cur
, stop
);
1647 fore_check_limit
= orig
.pos
;
1653 /* Return the adjusted point provided that point is moved from LAST_PT
1657 composition_adjust_point (EMACS_INT last_pt
, EMACS_INT new_pt
)
1663 if (new_pt
== BEGV
|| new_pt
== ZV
)
1666 /* At first check the static composition. */
1667 if (get_property_and_range (new_pt
, Qcomposition
, &val
, &beg
, &end
, Qnil
)
1668 && COMPOSITION_VALID_P (beg
, end
, val
))
1670 if (beg
< new_pt
/* && end > new_pt <- It's always the case. */
1671 && (last_pt
<= beg
|| last_pt
>= end
))
1672 return (new_pt
< last_pt
? beg
: end
);
1676 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
))
1677 || NILP (Vauto_composition_mode
))
1680 /* Next check the automatic composition. */
1681 if (! find_automatic_composition (new_pt
, (EMACS_INT
) -1, &beg
, &end
, &val
,
1685 for (i
= 0; i
< LGSTRING_GLYPH_LEN (val
); i
++)
1687 Lisp_Object glyph
= LGSTRING_GLYPH (val
, i
);
1691 if (beg
+ LGLYPH_FROM (glyph
) == new_pt
)
1693 if (beg
+ LGLYPH_TO (glyph
) >= new_pt
)
1694 return (new_pt
< last_pt
1695 ? beg
+ LGLYPH_FROM (glyph
)
1696 : beg
+ LGLYPH_TO (glyph
) + 1);
1701 DEFUN ("composition-get-gstring", Fcomposition_get_gstring
,
1702 Scomposition_get_gstring
, 4, 4, 0,
1703 doc
: /* Return a glyph-string for characters between FROM and TO.
1704 If the glyph string is for graphic display, FONT-OBJECT must be
1705 a font-object to use for those characters.
1706 Otherwise (for terminal display), FONT-OBJECT must be a terminal ID, a
1707 frame, or nil for the selected frame's terminal device.
1709 If the optional 4th argument STRING is not nil, it is a string
1710 containing the target characters between indices FROM and TO.
1712 A glyph-string is a vector containing information about how to display
1713 a specific character sequence. The format is:
1714 [HEADER ID GLYPH ...]
1716 HEADER is a vector of this form:
1717 [FONT-OBJECT CHAR ...]
1719 FONT-OBJECT is a font-object for all glyphs in the glyph-string,
1720 or the terminal coding system of the specified terminal.
1721 CHARs are characters to be composed by GLYPHs.
1723 ID is an identification number of the glyph-string. It may be nil if
1726 GLYPH is a vector whose elements have this form:
1727 [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT
1728 [ [X-OFF Y-OFF WADJUST] | nil] ]
1730 FROM-IDX and TO-IDX are used internally and should not be touched.
1731 C is the character of the glyph.
1732 CODE is the glyph-code of C in FONT-OBJECT.
1733 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
1734 X-OFF and Y-OFF are offsets to the base position for the glyph.
1735 WADJUST is the adjustment to the normal width of the glyph.
1737 If GLYPH is nil, the remaining elements of the glyph-string vector
1738 should be ignored. */)
1739 (Lisp_Object from
, Lisp_Object to
, Lisp_Object font_object
, Lisp_Object string
)
1741 Lisp_Object gstring
, header
;
1742 EMACS_INT frompos
, topos
;
1744 CHECK_NATNUM (from
);
1746 if (! FONT_OBJECT_P (font_object
))
1748 struct coding_system
*coding
;
1749 struct terminal
*terminal
= get_terminal (font_object
, 1);
1751 coding
= ((TERMINAL_TERMINAL_CODING (terminal
)->common_flags
1752 & CODING_REQUIRE_ENCODING_MASK
)
1753 ? TERMINAL_TERMINAL_CODING (terminal
) : &safe_terminal_coding
);
1754 font_object
= CODING_ID_NAME (coding
->id
);
1757 header
= fill_gstring_header (Qnil
, from
, to
, font_object
, string
);
1758 gstring
= gstring_lookup_cache (header
);
1759 if (! NILP (gstring
))
1762 frompos
= XINT (from
);
1764 if (LGSTRING_GLYPH_LEN (gstring_work
) < topos
- frompos
)
1765 gstring_work
= Fmake_vector (make_number (topos
- frompos
+ 2), Qnil
);
1766 LGSTRING_SET_HEADER (gstring_work
, header
);
1767 LGSTRING_SET_ID (gstring_work
, Qnil
);
1768 fill_gstring_body (gstring_work
);
1769 return gstring_work
;
1773 /* Emacs Lisp APIs. */
1775 DEFUN ("compose-region-internal", Fcompose_region_internal
,
1776 Scompose_region_internal
, 2, 4, 0,
1777 doc
: /* Internal use only.
1779 Compose text in the region between START and END.
1780 Optional 3rd and 4th arguments are COMPONENTS and MODIFICATION-FUNC
1781 for the composition. See `compose-region' for more details. */)
1782 (Lisp_Object start
, Lisp_Object end
, Lisp_Object components
, Lisp_Object modification_func
)
1784 validate_region (&start
, &end
);
1785 if (!NILP (components
)
1786 && !INTEGERP (components
)
1787 && !CONSP (components
)
1788 && !STRINGP (components
))
1789 CHECK_VECTOR (components
);
1791 compose_text (XINT (start
), XINT (end
), components
, modification_func
, Qnil
);
1795 DEFUN ("compose-string-internal", Fcompose_string_internal
,
1796 Scompose_string_internal
, 3, 5, 0,
1797 doc
: /* Internal use only.
1799 Compose text between indices START and END of STRING.
1800 Optional 4th and 5th arguments are COMPONENTS and MODIFICATION-FUNC
1801 for the composition. See `compose-string' for more details. */)
1802 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
, Lisp_Object components
, Lisp_Object modification_func
)
1804 CHECK_STRING (string
);
1805 CHECK_NUMBER (start
);
1808 if (XINT (start
) < 0 ||
1809 XINT (start
) > XINT (end
)
1810 || XINT (end
) > SCHARS (string
))
1811 args_out_of_range (start
, end
);
1813 compose_text (XINT (start
), XINT (end
), components
, modification_func
, string
);
1817 DEFUN ("find-composition-internal", Ffind_composition_internal
,
1818 Sfind_composition_internal
, 4, 4, 0,
1819 doc
: /* Internal use only.
1821 Return information about composition at or nearest to position POS.
1822 See `find-composition' for more details. */)
1823 (Lisp_Object pos
, Lisp_Object limit
, Lisp_Object string
, Lisp_Object detail_p
)
1825 Lisp_Object prop
, tail
, gstring
;
1826 EMACS_INT start
, end
, from
, to
;
1829 CHECK_NUMBER_COERCE_MARKER (pos
);
1833 CHECK_NUMBER_COERCE_MARKER (limit
);
1841 CHECK_STRING (string
);
1842 if (XINT (pos
) < 0 || XINT (pos
) > SCHARS (string
))
1843 args_out_of_range (string
, pos
);
1847 if (XINT (pos
) < BEGV
|| XINT (pos
) > ZV
)
1848 args_out_of_range (Fcurrent_buffer (), pos
);
1851 if (!find_composition (from
, to
, &start
, &end
, &prop
, string
))
1853 if (!NILP (BVAR (current_buffer
, enable_multibyte_characters
))
1854 && ! NILP (Vauto_composition_mode
)
1855 && find_automatic_composition (from
, to
, &start
, &end
, &gstring
,
1857 return list3 (make_number (start
), make_number (end
), gstring
);
1860 if ((end
<= XINT (pos
) || start
> XINT (pos
)))
1864 if (find_automatic_composition (from
, to
, &s
, &e
, &gstring
, string
)
1865 && (e
<= XINT (pos
) ? e
> end
: s
< start
))
1866 return list3 (make_number (s
), make_number (e
), gstring
);
1868 if (!COMPOSITION_VALID_P (start
, end
, prop
))
1869 return Fcons (make_number (start
), Fcons (make_number (end
),
1870 Fcons (Qnil
, Qnil
)));
1871 if (NILP (detail_p
))
1872 return Fcons (make_number (start
), Fcons (make_number (end
),
1875 if (COMPOSITION_REGISTERD_P (prop
))
1876 id
= COMPOSITION_ID (prop
);
1879 EMACS_INT start_byte
= (NILP (string
)
1880 ? CHAR_TO_BYTE (start
)
1881 : string_char_to_byte (string
, start
));
1882 id
= get_composition_id (start
, start_byte
, end
- start
, prop
, string
);
1887 Lisp_Object components
, relative_p
, mod_func
;
1888 enum composition_method method
= COMPOSITION_METHOD (prop
);
1889 int width
= composition_table
[id
]->width
;
1891 components
= Fcopy_sequence (COMPOSITION_COMPONENTS (prop
));
1892 relative_p
= (method
== COMPOSITION_WITH_RULE_ALTCHARS
1894 mod_func
= COMPOSITION_MODIFICATION_FUNC (prop
);
1895 tail
= Fcons (components
,
1898 Fcons (make_number (width
), Qnil
))));
1903 return Fcons (make_number (start
), Fcons (make_number (end
), tail
));
1908 syms_of_composite (void)
1912 Qcomposition
= intern_c_string ("composition");
1913 staticpro (&Qcomposition
);
1915 /* Make a hash table for static composition. */
1917 Lisp_Object args
[6];
1921 args
[2] = QCweakness
;
1922 /* We used to make the hash table weak so that unreferenced
1923 compositions can be garbage-collected. But, usually once
1924 created compositions are repeatedly used in an Emacs session,
1925 and thus it's not worth to save memory in such a way. So, we
1926 make the table not weak. */
1929 args
[5] = make_number (311);
1930 composition_hash_table
= Fmake_hash_table (6, args
);
1931 staticpro (&composition_hash_table
);
1934 /* Make a hash table for glyph-string. */
1936 Lisp_Object args
[6];
1939 args
[2] = QCweakness
;
1942 args
[5] = make_number (311);
1943 gstring_hash_table
= Fmake_hash_table (6, args
);
1944 staticpro (&gstring_hash_table
);
1947 staticpro (&gstring_work_headers
);
1948 gstring_work_headers
= Fmake_vector (make_number (8), Qnil
);
1949 for (i
= 0; i
< 8; i
++)
1950 ASET (gstring_work_headers
, i
, Fmake_vector (make_number (i
+ 2), Qnil
));
1951 staticpro (&gstring_work
);
1952 gstring_work
= Fmake_vector (make_number (10), Qnil
);
1954 /* Text property `composition' should be nonsticky by default. */
1955 Vtext_property_default_nonsticky
1956 = Fcons (Fcons (Qcomposition
, Qt
), Vtext_property_default_nonsticky
);
1958 DEFVAR_LISP ("compose-chars-after-function", Vcompose_chars_after_function
,
1959 doc
: /* Function to adjust composition of buffer text.
1961 This function is called with three arguments: FROM, TO, and OBJECT.
1962 FROM and TO specify the range of text whose composition should be
1963 adjusted. OBJECT, if non-nil, is a string that contains the text.
1965 This function is called after a text with `composition' property is
1966 inserted or deleted to keep `composition' property of buffer text
1969 The default value is the function `compose-chars-after'. */);
1970 Vcompose_chars_after_function
= intern_c_string ("compose-chars-after");
1972 Qauto_composed
= intern_c_string ("auto-composed");
1973 staticpro (&Qauto_composed
);
1975 Qauto_composition_function
= intern_c_string ("auto-composition-function");
1976 staticpro (&Qauto_composition_function
);
1978 DEFVAR_LISP ("auto-composition-mode", Vauto_composition_mode
,
1979 doc
: /* Non-nil if Auto-Composition mode is enabled.
1980 Use the command `auto-composition-mode' to change this variable. */);
1981 Vauto_composition_mode
= Qt
;
1983 DEFVAR_LISP ("auto-composition-function", Vauto_composition_function
,
1984 doc
: /* Function to call to compose characters automatically.
1985 This function is called from the display routine with four arguments:
1986 FROM, TO, WINDOW, and STRING.
1988 If STRING is nil, the function must compose characters in the region
1989 between FROM and TO in the current buffer.
1991 Otherwise, STRING is a string, and FROM and TO are indices into the
1992 string. In this case, the function must compose characters in the
1994 Vauto_composition_function
= Qnil
;
1996 DEFVAR_LISP ("composition-function-table", Vcomposition_function_table
,
1997 doc
: /* Char-table of functions for automatic character composition.
1998 For each character that has to be composed automatically with
1999 preceding and/or following characters, this char-table contains
2000 a function to call to compose that character.
2002 The element at index C in the table, if non-nil, is a list of
2003 composition rules of this form: ([PATTERN PREV-CHARS FUNC] ...)
2005 PATTERN is a regular expression which C and the surrounding
2006 characters must match.
2008 PREV-CHARS is a non-negative integer (less than 4) specifying how many
2009 characters before C to check the matching with PATTERN. If it is 0,
2010 PATTERN must match C and the following characters. If it is 1,
2011 PATTERN must match a character before C and the following characters.
2013 If PREV-CHARS is 0, PATTERN can be nil, which means that the
2014 single character C should be composed.
2016 FUNC is a function to return a glyph-string representing a
2017 composition of the characters that match PATTERN. It is
2018 called with one argument GSTRING.
2020 GSTRING is a template of a glyph-string to return. It is already
2021 filled with a proper header for the characters to compose, and
2022 glyphs corresponding to those characters one by one. The
2023 function must return a new glyph-string with the same header as
2024 GSTRING, or modify GSTRING itself and return it.
2026 See also the documentation of `auto-composition-mode'. */);
2027 Vcomposition_function_table
= Fmake_char_table (Qnil
, Qnil
);
2029 defsubr (&Scompose_region_internal
);
2030 defsubr (&Scompose_string_internal
);
2031 defsubr (&Sfind_composition_internal
);
2032 defsubr (&Scomposition_get_gstring
);