1 /* Composite sequence support.
2 Copyright (C) 2001, 2002, 2003, 2004, 2005,
3 2006, 2007, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
4 Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
5 National Institute of Advanced Industrial Science and Technology (AIST)
6 Registration Number H14PRO021
7 Copyright (C) 2003, 2006
8 National Institute of Advanced Industrial Science and Technology (AIST)
9 Registration Number H13PRO009
11 This file is part of GNU Emacs.
13 GNU Emacs is free software: you can redistribute it and/or modify
14 it under the terms of the GNU General Public License as published by
15 the Free Software Foundation, either version 3 of the License, or
16 (at your option) any later version.
18 GNU Emacs is distributed in the hope that it will be useful,
19 but WITHOUT ANY WARRANTY; without even the implied warranty of
20 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 GNU General Public License for more details.
23 You should have received a copy of the GNU General Public License
24 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
30 #include "character.h"
32 #include "intervals.h"
35 #include "dispextern.h"
37 #include "termhooks.h"
40 /* Emacs uses special text property `composition' to support character
41 composition. A sequence of characters that have the same (i.e. eq)
42 `composition' property value is treated as a single composite
43 sequence (we call it just `composition' here after). Characters in
44 a composition are all composed somehow on the screen.
46 The property value has this form when the composition is made:
47 ((LENGTH . COMPONENTS) . MODIFICATION-FUNC)
48 then turns to this form:
49 (COMPOSITION-ID . (LENGTH COMPONENTS-VEC . MODIFICATION-FUNC))
50 when the composition is registered in composition_hash_table and
51 composition_table. These rather peculiar structures were designed
52 to make it easy to distinguish them quickly (we can do that by
53 checking only the first element) and to extract LENGTH (from the
54 former form) and COMPOSITION-ID (from the latter form).
56 We register a composition when it is displayed, or when the width
57 is required (for instance, to calculate columns).
59 LENGTH -- Length of the composition. This information is used to
60 check the validity of the composition.
62 COMPONENTS -- Character, string, vector, list, or nil.
64 If it is nil, characters in the text are composed relatively
65 according to their metrics in font glyphs.
67 If it is a character or a string, the character or characters
68 in the string are composed relatively.
70 If it is a vector or list of integers, the element is a
71 character or an encoded composition rule. The characters are
72 composed according to the rules. (2N)th elements are
73 characters to be composed and (2N+1)th elements are
74 composition rules to tell how to compose (2N+2)th element with
75 the previously composed 2N glyphs.
77 COMPONENTS-VEC -- Vector of integers. In relative composition, the
78 elements are characters to be composed. In rule-base
79 composition, the elements are characters or encoded
82 MODIFICATION-FUNC -- If non nil, it is a function to call when the
83 composition gets invalid after a modification in a buffer. If
84 it is nil, a function in `composition-function-table' of the
85 first character in the sequence is called.
87 COMPOSITION-ID --Identification number of the composition. It is
88 used as an index to composition_table for the composition.
90 When Emacs has to display a composition or has to know its
91 displaying width, the function get_composition_id is called. It
92 returns COMPOSITION-ID so that the caller can access the
93 information about the composition through composition_table. If a
94 COMPOSITION-ID has not yet been assigned to the composition,
95 get_composition_id checks the validity of `composition' property,
96 and, if valid, assigns a new ID, registers the information in
97 composition_hash_table and composition_table, and changes the form
98 of the property value. If the property is invalid, return -1
99 without changing the property value.
101 We use two tables to keep information about composition;
102 composition_hash_table and composition_table.
104 The former is a hash table in which keys are COMPONENTS-VECs and
105 values are the corresponding COMPOSITION-IDs. This hash table is
106 weak, but as each key (COMPONENTS-VEC) is also kept as a value of the
107 `composition' property, it won't be collected as garbage until all
108 bits of text that have the same COMPONENTS-VEC are deleted.
110 The latter is a table of pointers to `struct composition' indexed
111 by COMPOSITION-ID. This structure keeps the other information (see
114 In general, a text property holds information about individual
115 characters. But, a `composition' property holds information about
116 a sequence of characters (in this sense, it is like the `intangible'
117 property). That means that we should not share the property value
118 in adjacent compositions -- we can't distinguish them if they have the
119 same property. So, after any changes, we call
120 `update_compositions' and change a property of one of adjacent
121 compositions to a copy of it. This function also runs a proper
122 composition modification function to make a composition that gets
123 invalid by the change valid again.
125 As the value of the `composition' property holds information about a
126 specific range of text, the value gets invalid if we change the
127 text in the range. We treat the `composition' property as always
128 rear-nonsticky (currently by setting default-text-properties to
129 (rear-nonsticky (composition))) and we never make properties of
130 adjacent compositions identical. Thus, any such changes make the
131 range just shorter. So, we can check the validity of the `composition'
132 property by comparing LENGTH information with the actual length of
138 Lisp_Object Qcomposition
;
140 /* Table of pointers to the structure `composition' indexed by
141 COMPOSITION-ID. This structure is for storing information about
142 each composition except for COMPONENTS-VEC. */
143 struct composition
**composition_table
;
145 /* The current size of `composition_table'. */
146 static int composition_table_size
;
148 /* Number of compositions currently made. */
151 /* Hash table for compositions. The key is COMPONENTS-VEC of
152 `composition' property. The value is the corresponding
154 Lisp_Object composition_hash_table
;
156 /* Function to call to adjust composition. */
157 Lisp_Object Vcompose_chars_after_function
;
159 Lisp_Object Qauto_composed
;
160 Lisp_Object Vauto_composition_mode
;
161 Lisp_Object Vauto_composition_function
;
162 Lisp_Object Qauto_composition_function
;
163 Lisp_Object Vcomposition_function_table
;
165 /* Maxinum number of characters to lookback to check
167 #define MAX_AUTO_COMPOSITION_LOOKBACK 3
169 EXFUN (Fremove_list_of_text_properties
, 4);
171 /* Temporary variable used in macros COMPOSITION_XXX. */
172 Lisp_Object composition_temp
;
175 /* Return COMPOSITION-ID of a composition at buffer position
176 CHARPOS/BYTEPOS and length NCHARS. The `composition' property of
177 the sequence is PROP. STRING, if non-nil, is a string that
178 contains the composition instead of the current buffer.
180 If the composition is invalid, return -1. */
183 get_composition_id (charpos
, bytepos
, nchars
, prop
, string
)
184 int charpos
, bytepos
, nchars
;
185 Lisp_Object prop
, string
;
187 Lisp_Object id
, length
, components
, key
, *key_contents
;
189 struct Lisp_Hash_Table
*hash_table
= XHASH_TABLE (composition_hash_table
);
192 struct composition
*cmp
;
196 Form-A: ((LENGTH . COMPONENTS) . MODIFICATION-FUNC)
198 Form-B: (COMPOSITION-ID . (LENGTH COMPONENTS-VEC . MODIFICATION-FUNC))
200 if (nchars
== 0 || !CONSP (prop
))
201 goto invalid_composition
;
206 /* PROP should be Form-B. */
207 if (XINT (id
) < 0 || XINT (id
) >= n_compositions
)
208 goto invalid_composition
;
212 /* PROP should be Form-A.
213 Thus, ID should be (LENGTH . COMPONENTS). */
215 goto invalid_composition
;
217 if (!INTEGERP (length
) || XINT (length
) != nchars
)
218 goto invalid_composition
;
220 components
= XCDR (id
);
222 /* Check if the same composition has already been registered or not
223 by consulting composition_hash_table. The key for this table is
224 COMPONENTS (converted to a vector COMPONENTS-VEC) or, if it is
225 nil, vector of characters in the composition range. */
226 if (INTEGERP (components
))
227 key
= Fmake_vector (make_number (1), components
);
228 else if (STRINGP (components
) || CONSP (components
))
229 key
= Fvconcat (1, &components
);
230 else if (VECTORP (components
))
232 else if (NILP (components
))
234 key
= Fmake_vector (make_number (nchars
), Qnil
);
235 if (STRINGP (string
))
236 for (i
= 0; i
< nchars
; i
++)
238 FETCH_STRING_CHAR_ADVANCE (ch
, string
, charpos
, bytepos
);
239 XVECTOR (key
)->contents
[i
] = make_number (ch
);
242 for (i
= 0; i
< nchars
; i
++)
244 FETCH_CHAR_ADVANCE (ch
, charpos
, bytepos
);
245 XVECTOR (key
)->contents
[i
] = make_number (ch
);
249 goto invalid_composition
;
251 hash_index
= hash_lookup (hash_table
, key
, &hash_code
);
254 /* We have already registered the same composition. Change PROP
255 from Form-A above to Form-B while replacing COMPONENTS with
256 COMPONENTS-VEC stored in the hash table. We can directly
257 modify the cons cell of PROP because it is not shared. */
258 key
= HASH_KEY (hash_table
, hash_index
);
259 id
= HASH_VALUE (hash_table
, hash_index
);
261 XSETCDR (prop
, Fcons (make_number (nchars
), Fcons (key
, XCDR (prop
))));
265 /* This composition is a new one. We must register it. */
267 /* Check if we have sufficient memory to store this information. */
268 if (composition_table_size
== 0)
270 composition_table_size
= 256;
272 = (struct composition
**) xmalloc (sizeof (composition_table
[0])
273 * composition_table_size
);
275 else if (composition_table_size
<= n_compositions
)
277 composition_table_size
+= 256;
279 = (struct composition
**) xrealloc (composition_table
,
280 sizeof (composition_table
[0])
281 * composition_table_size
);
284 key_contents
= XVECTOR (key
)->contents
;
286 /* Check if the contents of COMPONENTS are valid if COMPONENTS is a
287 vector or a list. It should be a sequence of:
288 char1 rule1 char2 rule2 char3 ... ruleN charN+1 */
290 if (VECTORP (components
)
291 && ASIZE (components
) >= 2
292 && VECTORP (AREF (components
, 0)))
294 /* COMPONENTS is a glyph-string. */
295 int len
= ASIZE (key
);
297 for (i
= 1; i
< len
; i
++)
298 if (! VECTORP (AREF (key
, i
)))
299 goto invalid_composition
;
301 else if (VECTORP (components
) || CONSP (components
))
303 EMACS_UINT len
= XVECTOR_SIZE (key
);
305 /* The number of elements should be odd. */
307 goto invalid_composition
;
308 /* All elements should be integers (character or encoded
309 composition rule). */
310 for (i
= 0; i
< len
; i
++)
312 if (!INTEGERP (key_contents
[i
]))
313 goto invalid_composition
;
317 /* Change PROP from Form-A above to Form-B. We can directly modify
318 the cons cell of PROP because it is not shared. */
319 XSETFASTINT (id
, n_compositions
);
321 XSETCDR (prop
, Fcons (make_number (nchars
), Fcons (key
, XCDR (prop
))));
323 /* Register the composition in composition_hash_table. */
324 hash_index
= hash_put (hash_table
, key
, id
, hash_code
);
326 /* Register the composition in composition_table. */
327 cmp
= (struct composition
*) xmalloc (sizeof (struct composition
));
329 cmp
->method
= (NILP (components
)
330 ? COMPOSITION_RELATIVE
331 : ((INTEGERP (components
) || STRINGP (components
))
332 ? COMPOSITION_WITH_ALTCHARS
333 : COMPOSITION_WITH_RULE_ALTCHARS
));
334 cmp
->hash_index
= hash_index
;
335 glyph_len
= (cmp
->method
== COMPOSITION_WITH_RULE_ALTCHARS
336 ? (XVECTOR_SIZE (key
) + 1) / 2
337 : XVECTOR_SIZE (key
));
338 cmp
->glyph_len
= glyph_len
;
339 cmp
->offsets
= (short *) xmalloc (sizeof (short) * glyph_len
* 2);
342 if (cmp
->method
!= COMPOSITION_WITH_RULE_ALTCHARS
)
344 /* Relative composition. */
346 for (i
= 0; i
< glyph_len
; i
++)
349 ch
= XINT (key_contents
[i
]);
350 this_width
= (ch
== '\t' ? 1 : CHAR_WIDTH (ch
));
351 if (cmp
->width
< this_width
)
352 cmp
->width
= this_width
;
357 /* Rule-base composition. */
358 float leftmost
= 0.0, rightmost
;
360 ch
= XINT (key_contents
[0]);
361 rightmost
= ch
!= '\t' ? CHAR_WIDTH (ch
) : 1;
363 for (i
= 1; i
< glyph_len
; i
+= 2)
365 int rule
, gref
, nref
, xoff
, yoff
;
369 rule
= XINT (key_contents
[i
]);
370 ch
= XINT (key_contents
[i
+ 1]);
371 this_width
= ch
!= '\t' ? CHAR_WIDTH (ch
) : 1;
373 /* A composition rule is specified by an integer value
374 that encodes global and new reference points (GREF and
375 NREF). GREF and NREF are specified by numbers as
383 ---3---4---5--- baseline
387 COMPOSITION_DECODE_RULE (rule
, gref
, nref
, xoff
, yoff
);
388 this_left
= (leftmost
389 + (gref
% 3) * (rightmost
- leftmost
) / 2.0
390 - (nref
% 3) * this_width
/ 2.0);
392 if (this_left
< leftmost
)
393 leftmost
= this_left
;
394 if (this_left
+ this_width
> rightmost
)
395 rightmost
= this_left
+ this_width
;
398 cmp
->width
= rightmost
- leftmost
;
399 if (cmp
->width
< (rightmost
- leftmost
))
400 /* To get a ceiling integer value. */
404 composition_table
[n_compositions
] = cmp
;
406 return n_compositions
++;
409 /* Would it be better to remove this `composition' property? */
414 /* Find a static composition at or nearest to position POS of OBJECT
417 OBJECT defaults to the current buffer. If there's a composition at
418 POS, set *START and *END to the start and end of the sequence,
419 *PROP to the `composition' property, and return 1.
421 If there's no composition at POS and LIMIT is negative, return 0.
423 Otherwise, search for a composition forward (LIMIT > POS) or
424 backward (LIMIT < POS). In this case, LIMIT bounds the search.
426 If a composition is found, set *START, *END, and *PROP as above,
427 and return 1, else return 0.
429 This doesn't check the validity of composition. */
432 find_composition (pos
, limit
, start
, end
, prop
, object
)
434 EMACS_INT
*start
, *end
;
435 Lisp_Object
*prop
, object
;
439 if (get_property_and_range (pos
, Qcomposition
, prop
, start
, end
, object
))
442 if (limit
< 0 || limit
== pos
)
445 if (limit
> pos
) /* search forward */
447 val
= Fnext_single_property_change (make_number (pos
), Qcomposition
,
448 object
, make_number (limit
));
453 else /* search backward */
455 if (get_property_and_range (pos
- 1, Qcomposition
, prop
, start
, end
,
458 val
= Fprevious_single_property_change (make_number (pos
), Qcomposition
,
459 object
, make_number (limit
));
465 get_property_and_range (pos
, Qcomposition
, prop
, start
, end
, object
);
469 /* Run a proper function to adjust the composition sitting between
470 FROM and TO with property PROP. */
473 run_composition_function (from
, to
, prop
)
478 EMACS_INT start
, end
;
480 func
= COMPOSITION_MODIFICATION_FUNC (prop
);
481 /* If an invalid composition precedes or follows, try to make them
484 && find_composition (from
- 1, -1, &start
, &end
, &prop
, Qnil
)
485 && !COMPOSITION_VALID_P (start
, end
, prop
))
488 && find_composition (to
, -1, &start
, &end
, &prop
, Qnil
)
489 && !COMPOSITION_VALID_P (start
, end
, prop
))
491 if (!NILP (Ffboundp (func
)))
492 call2 (func
, make_number (from
), make_number (to
));
495 /* Make invalid compositions adjacent to or inside FROM and TO valid.
496 CHECK_MASK is bitwise `or' of mask bits defined by macros
497 CHECK_XXX (see the comment in composite.h).
499 It also resets the text-property `auto-composed' to a proper region
500 so that automatic character composition works correctly later while
501 displaying the region.
503 This function is called when a buffer text is changed. If the
504 change is deletion, FROM == TO. Otherwise, FROM < TO. */
507 update_compositions (from
, to
, check_mask
)
512 EMACS_INT start
, end
;
513 /* The beginning and end of the region to set the property
514 `auto-composed' to nil. */
515 EMACS_INT min_pos
= from
, max_pos
= to
;
517 if (inhibit_modification_hooks
)
520 /* If FROM and TO are not in a valid range, do nothing. */
521 if (! (BEGV
<= from
&& from
<= to
&& to
<= ZV
))
524 if (check_mask
& CHECK_HEAD
)
526 /* FROM should be at composition boundary. But, insertion or
527 deletion will make two compositions adjacent and
528 indistinguishable when they have same (eq) property. To
529 avoid it, in such a case, we change the property of the
530 latter to the copy of it. */
532 && find_composition (from
- 1, -1, &start
, &end
, &prop
, Qnil
)
533 && COMPOSITION_VALID_P (start
, end
, prop
))
539 Fput_text_property (make_number (from
), make_number (end
),
541 Fcons (XCAR (prop
), XCDR (prop
)), Qnil
);
542 run_composition_function (start
, end
, prop
);
546 && find_composition (from
, -1, &start
, &from
, &prop
, Qnil
)
547 && COMPOSITION_VALID_P (start
, from
, prop
))
551 run_composition_function (start
, from
, prop
);
555 if (check_mask
& CHECK_INSIDE
)
557 /* In this case, we are sure that (check & CHECK_TAIL) is also
558 nonzero. Thus, here we should check only compositions before
561 && find_composition (from
, to
, &start
, &from
, &prop
, Qnil
)
562 && COMPOSITION_VALID_P (start
, from
, prop
)
564 run_composition_function (start
, from
, prop
);
567 if (check_mask
& CHECK_TAIL
)
570 && find_composition (to
- 1, -1, &start
, &end
, &prop
, Qnil
)
571 && COMPOSITION_VALID_P (start
, end
, prop
))
573 /* TO should be also at composition boundary. But,
574 insertion or deletion will make two compositions adjacent
575 and indistinguishable when they have same (eq) property.
576 To avoid it, in such a case, we change the property of
577 the former to the copy of it. */
580 Fput_text_property (make_number (start
), make_number (to
),
582 Fcons (XCAR (prop
), XCDR (prop
)), Qnil
);
585 run_composition_function (start
, end
, prop
);
588 && find_composition (to
, -1, &start
, &end
, &prop
, Qnil
)
589 && COMPOSITION_VALID_P (start
, end
, prop
))
591 run_composition_function (start
, end
, prop
);
595 if (min_pos
< max_pos
)
597 int count
= SPECPDL_INDEX ();
599 specbind (Qinhibit_read_only
, Qt
);
600 specbind (Qinhibit_modification_hooks
, Qt
);
601 specbind (Qinhibit_point_motion_hooks
, Qt
);
602 Fremove_list_of_text_properties (make_number (min_pos
),
603 make_number (max_pos
),
604 Fcons (Qauto_composed
, Qnil
), Qnil
);
605 unbind_to (count
, Qnil
);
610 /* Modify composition property values in LIST destructively. LIST is
611 a list as returned from text_property_list. Change values to the
612 top-level copies of them so that none of them are `eq'. */
615 make_composition_value_copy (list
)
618 Lisp_Object plist
, val
;
620 for (; CONSP (list
); list
= XCDR (list
))
622 plist
= XCAR (XCDR (XCDR (XCAR (list
))));
623 while (CONSP (plist
) && CONSP (XCDR (plist
)))
625 if (EQ (XCAR (plist
), Qcomposition
)
626 && (val
= XCAR (XCDR (plist
)), CONSP (val
)))
627 XSETCAR (XCDR (plist
), Fcons (XCAR (val
), XCDR (val
)));
628 plist
= XCDR (XCDR (plist
));
634 /* Make text in the region between START and END a composition that
635 has COMPONENTS and MODIFICATION-FUNC.
637 If STRING is non-nil, then operate on characters contained between
638 indices START and END in STRING. */
641 compose_text (start
, end
, components
, modification_func
, string
)
643 Lisp_Object components
, modification_func
, string
;
647 prop
= Fcons (Fcons (make_number (end
- start
), components
),
649 Fput_text_property (make_number (start
), make_number (end
),
650 Qcomposition
, prop
, string
);
654 static Lisp_Object autocmp_chars
P_ ((Lisp_Object
, EMACS_INT
, EMACS_INT
,
655 EMACS_INT
, struct window
*,
656 struct face
*, Lisp_Object
));
659 /* Lisp glyph-string handlers */
661 /* Hash table for automatic composition. The key is a header of a
662 lgstring (Lispy glyph-string), and the value is a body of a
665 static Lisp_Object gstring_hash_table
;
667 static Lisp_Object gstring_lookup_cache
P_ ((Lisp_Object
));
670 gstring_lookup_cache (header
)
673 struct Lisp_Hash_Table
*h
= XHASH_TABLE (gstring_hash_table
);
674 int i
= hash_lookup (h
, header
, NULL
);
676 return (i
>= 0 ? HASH_VALUE (h
, i
) : Qnil
);
680 composition_gstring_put_cache (gstring
, len
)
684 struct Lisp_Hash_Table
*h
= XHASH_TABLE (gstring_hash_table
);
686 Lisp_Object header
, copy
;
689 header
= LGSTRING_HEADER (gstring
);
690 hash
= h
->hashfn (h
, header
);
693 len
= LGSTRING_GLYPH_LEN (gstring
);
694 for (i
= 0; i
< len
; i
++)
695 if (NILP (LGSTRING_GLYPH (gstring
, i
)))
700 copy
= Fmake_vector (make_number (len
+ 2), Qnil
);
701 LGSTRING_SET_HEADER (copy
, Fcopy_sequence (header
));
702 for (i
= 0; i
< len
; i
++)
703 LGSTRING_SET_GLYPH (copy
, i
, Fcopy_sequence (LGSTRING_GLYPH (gstring
, i
)));
704 i
= hash_put (h
, LGSTRING_HEADER (copy
), copy
, hash
);
705 LGSTRING_SET_ID (copy
, make_number (i
));
710 composition_gstring_from_id (id
)
713 struct Lisp_Hash_Table
*h
= XHASH_TABLE (gstring_hash_table
);
715 return HASH_VALUE (h
, id
);
718 static Lisp_Object fill_gstring_header
P_ ((Lisp_Object
, Lisp_Object
,
719 Lisp_Object
, Lisp_Object
,
723 composition_gstring_p (gstring
)
729 if (! VECTORP (gstring
) || ASIZE (gstring
) < 2)
731 header
= LGSTRING_HEADER (gstring
);
732 if (! VECTORP (header
) || ASIZE (header
) < 2)
734 if (! NILP (LGSTRING_FONT (gstring
))
735 && (! FONT_OBJECT_P (LGSTRING_FONT (gstring
))
736 && ! CODING_SYSTEM_P (LGSTRING_FONT (gstring
))))
738 for (i
= 1; i
< ASIZE (LGSTRING_HEADER (gstring
)); i
++)
739 if (! NATNUMP (AREF (LGSTRING_HEADER (gstring
), i
)))
741 if (! NILP (LGSTRING_ID (gstring
)) && ! NATNUMP (LGSTRING_ID (gstring
)))
743 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
745 Lisp_Object glyph
= LGSTRING_GLYPH (gstring
, i
);
748 if (! VECTORP (glyph
) || ASIZE (glyph
) != LGLYPH_SIZE
)
755 composition_gstring_width (gstring
, from
, to
, metrics
)
758 struct font_metrics
*metrics
;
765 Lisp_Object font_object
= LGSTRING_FONT (gstring
);
767 if (FONT_OBJECT_P (font_object
))
769 struct font
*font
= XFONT_OBJECT (font_object
);
771 metrics
->ascent
= font
->ascent
;
772 metrics
->descent
= font
->descent
;
777 metrics
->descent
= 0;
779 metrics
->width
= metrics
->lbearing
= metrics
->rbearing
= 0;
781 for (glyph
= &LGSTRING_GLYPH (gstring
, from
); from
< to
; from
++, glyph
++)
785 if (NILP (LGLYPH_ADJUSTMENT (*glyph
)))
786 width
+= LGLYPH_WIDTH (*glyph
);
788 width
+= LGLYPH_WADJUST (*glyph
);
791 x
= metrics
->width
+ LGLYPH_LBEARING (*glyph
) + LGLYPH_XOFF (*glyph
);
792 if (metrics
->lbearing
> x
)
793 metrics
->lbearing
= x
;
794 x
= metrics
->width
+ LGLYPH_RBEARING (*glyph
) + LGLYPH_XOFF (*glyph
);
795 if (metrics
->rbearing
< x
)
796 metrics
->rbearing
= x
;
797 metrics
->width
= width
;
798 x
= LGLYPH_ASCENT (*glyph
) - LGLYPH_YOFF (*glyph
);
799 if (metrics
->ascent
< x
)
801 x
= LGLYPH_DESCENT (*glyph
) + LGLYPH_YOFF (*glyph
);
802 if (metrics
->descent
< x
)
803 metrics
->descent
= x
;
810 static Lisp_Object gstring_work
;
811 static Lisp_Object gstring_work_headers
;
814 fill_gstring_header (header
, start
, end
, font_object
, string
)
815 Lisp_Object header
, start
, end
, font_object
, string
;
817 EMACS_INT from
, to
, from_byte
;
822 if (NILP (current_buffer
->enable_multibyte_characters
))
823 error ("Attempt to shape unibyte text");
824 validate_region (&start
, &end
);
825 from
= XFASTINT (start
);
827 from_byte
= CHAR_TO_BYTE (from
);
831 CHECK_STRING (string
);
832 if (! STRING_MULTIBYTE (string
))
833 error ("Attempt to shape unibyte text");
834 /* FROM and TO are checked by the caller. */
837 if (from
< 0 || from
> to
|| to
> SCHARS (string
))
838 args_out_of_range_3 (string
, start
, end
);
839 from_byte
= string_char_to_byte (string
, from
);
844 error ("Attempt to shape zero-length text");
845 if (VECTORP (header
))
847 if (ASIZE (header
) != len
+ 1)
848 args_out_of_range (header
, make_number (len
+ 1));
853 header
= AREF (gstring_work_headers
, len
- 1);
855 header
= Fmake_vector (make_number (len
+ 1), Qnil
);
858 ASET (header
, 0, font_object
);
859 for (i
= 0; i
< len
; i
++)
864 FETCH_CHAR_ADVANCE_NO_CHECK (c
, from
, from_byte
);
866 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, from
, from_byte
);
867 ASET (header
, i
+ 1, make_number (c
));
872 extern void font_fill_lglyph_metrics
P_ ((Lisp_Object
, Lisp_Object
));
875 fill_gstring_body (gstring
)
878 Lisp_Object font_object
= LGSTRING_FONT (gstring
);
879 Lisp_Object header
= AREF (gstring
, 0);
880 EMACS_INT len
= LGSTRING_CHAR_LEN (gstring
);
883 for (i
= 0; i
< len
; i
++)
885 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
886 EMACS_INT c
= XINT (AREF (header
, i
+ 1));
891 LGSTRING_SET_GLYPH (gstring
, i
, g
);
893 LGLYPH_SET_FROM (g
, i
);
894 LGLYPH_SET_TO (g
, i
);
895 LGLYPH_SET_CHAR (g
, c
);
896 if (FONT_OBJECT_P (font_object
))
898 font_fill_lglyph_metrics (g
, font_object
);
902 int width
= XFASTINT (CHAR_TABLE_REF (Vchar_width_table
, c
));
904 LGLYPH_SET_CODE (g
, c
);
905 LGLYPH_SET_LBEARING (g
, 0);
906 LGLYPH_SET_RBEARING (g
, width
);
907 LGLYPH_SET_WIDTH (g
, width
);
908 LGLYPH_SET_ASCENT (g
, 1);
909 LGLYPH_SET_DESCENT (g
, 0);
911 LGLYPH_SET_ADJUSTMENT (g
, Qnil
);
913 if (i
< LGSTRING_GLYPH_LEN (gstring
))
914 LGSTRING_SET_GLYPH (gstring
, i
, Qnil
);
918 /* Try to compose the characters at CHARPOS according to CFT_ELEMENT
919 which is an element of composition-function-table (which see).
920 LIMIT limits the characters to compose. STRING, if not nil, is a
921 target string. WIN is a window where the characters are being
925 autocmp_chars (cft_element
, charpos
, bytepos
, limit
, win
, face
, string
)
926 Lisp_Object cft_element
;
927 EMACS_INT charpos
, bytepos
, limit
;
932 int count
= SPECPDL_INDEX ();
933 FRAME_PTR f
= XFRAME (win
->frame
);
934 Lisp_Object pos
= make_number (charpos
);
935 EMACS_INT pt
= PT
, pt_byte
= PT_BYTE
;
938 record_unwind_save_match_data ();
939 for (lookback
= -1; CONSP (cft_element
); cft_element
= XCDR (cft_element
))
941 Lisp_Object elt
= XCAR (cft_element
);
943 Lisp_Object font_object
= Qnil
, gstring
;
946 if (! VECTORP (elt
) || ASIZE (elt
) != 3)
950 lookback
= XFASTINT (AREF (elt
, 1));
951 if (limit
> charpos
+ MAX_COMPOSITION_COMPONENTS
)
952 limit
= charpos
+ MAX_COMPOSITION_COMPONENTS
;
954 else if (lookback
!= XFASTINT (AREF (elt
, 1)))
959 else if ((len
= fast_looking_at (re
, charpos
, bytepos
, limit
, -1, string
))
963 len
= BYTE_TO_CHAR (bytepos
+ len
) - charpos
;
965 len
= string_byte_to_char (string
, bytepos
+ len
) - charpos
;
969 limit
= to
= charpos
+ len
;
970 #ifdef HAVE_WINDOW_SYSTEM
971 if (FRAME_WINDOW_P (f
))
973 font_object
= font_range (charpos
, &to
, win
, face
, string
);
974 if (! FONT_OBJECT_P (font_object
)
977 && (fast_looking_at (re
, charpos
, bytepos
, to
, -1, string
) <= 0)))
980 TEMP_SET_PT_BOTH (pt
, pt_byte
);
981 return unbind_to (count
, Qnil
);
985 #endif /* not HAVE_WINDOW_SYSTEM */
986 font_object
= win
->frame
;
987 gstring
= Fcomposition_get_gstring (pos
, make_number (to
),
988 font_object
, string
);
989 if (NILP (LGSTRING_ID (gstring
)))
993 /* Save point as marker before calling out to lisp. */
996 Lisp_Object m
= Fmake_marker ();
997 set_marker_both (m
, Qnil
, pt
, pt_byte
);
998 record_unwind_protect (restore_point_unwind
, m
);
1001 args
[0] = Vauto_composition_function
;
1002 args
[1] = AREF (elt
, 2);
1004 args
[3] = make_number (to
);
1005 args
[4] = font_object
;
1007 gstring
= safe_call (6, args
);
1009 else if (NILP (string
))
1011 TEMP_SET_PT_BOTH (pt
, pt_byte
);
1013 return unbind_to (count
, gstring
);
1017 TEMP_SET_PT_BOTH (pt
, pt_byte
);
1018 return unbind_to (count
, Qnil
);
1022 /* Update cmp_it->stop_pos to the next position after CHARPOS (and
1023 BYTEPOS) where character composition may happen. If BYTEPOS is
1024 negative, compoute it. If it is a static composition, set
1025 cmp_it->ch to -1. Otherwise, set cmp_it->ch to the character that
1026 triggers a automatic composition. */
1029 composition_compute_stop_pos (cmp_it
, charpos
, bytepos
, endpos
, string
)
1030 struct composition_it
*cmp_it
;
1031 EMACS_INT charpos
, bytepos
, endpos
;
1034 EMACS_INT start
, end
, c
;
1035 Lisp_Object prop
, val
;
1036 /* This is from forward_to_next_line_start in xdisp.c. */
1037 const int MAX_NEWLINE_DISTANCE
= 500;
1039 if (endpos
> charpos
+ MAX_NEWLINE_DISTANCE
)
1040 endpos
= charpos
+ MAX_NEWLINE_DISTANCE
;
1041 cmp_it
->stop_pos
= endpos
;
1044 if (find_composition (charpos
, endpos
, &start
, &end
, &prop
, string
)
1046 && COMPOSITION_VALID_P (start
, end
, prop
))
1048 cmp_it
->stop_pos
= endpos
= start
;
1051 if (NILP (string
) && PT
> charpos
&& PT
< endpos
)
1052 cmp_it
->stop_pos
= PT
;
1053 if (NILP (current_buffer
->enable_multibyte_characters
)
1054 || NILP (Vauto_composition_mode
))
1058 if (STRINGP (string
))
1059 bytepos
= string_char_to_byte (string
, charpos
);
1061 bytepos
= CHAR_TO_BYTE (charpos
);
1065 while (charpos
< endpos
)
1067 if (STRINGP (string
))
1068 FETCH_STRING_CHAR_ADVANCE (c
, string
, charpos
, bytepos
);
1070 FETCH_CHAR_ADVANCE (c
, charpos
, bytepos
);
1076 val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1081 for (; CONSP (val
); val
= XCDR (val
))
1084 if (VECTORP (elt
) && ASIZE (elt
) == 3 && NATNUMP (AREF (elt
, 1))
1085 && charpos
- 1 - XFASTINT (AREF (elt
, 1)) >= start
)
1090 cmp_it
->lookback
= XFASTINT (AREF (elt
, 1));
1091 cmp_it
->stop_pos
= charpos
- 1 - cmp_it
->lookback
;
1097 cmp_it
->stop_pos
= charpos
;
1100 /* Check if the character at CHARPOS (and BYTEPOS) is composed
1101 (possibly with the following characters) on window W. ENDPOS limits
1102 characters to be composed. FACE, in non-NULL, is a base face of
1103 the character. If STRING is not nil, it is a string containing the
1104 character to check, and CHARPOS and BYTEPOS are indices in the
1105 string. In that case, FACE must not be NULL.
1107 If the character is composed, setup members of CMP_IT (id, nglyphs,
1108 and from), and return 1. Otherwise, update CMP_IT->stop_pos, and
1112 composition_reseat_it (cmp_it
, charpos
, bytepos
, endpos
, w
, face
, string
)
1113 struct composition_it
*cmp_it
;
1114 EMACS_INT charpos
, bytepos
, endpos
;
1119 if (NILP (string
) && charpos
< PT
&& PT
< endpos
)
1122 if (cmp_it
->ch
== -2)
1124 composition_compute_stop_pos (cmp_it
, charpos
, bytepos
, endpos
, string
);
1125 if (cmp_it
->ch
== -2)
1131 /* We are looking at a static composition. */
1132 EMACS_INT start
, end
;
1135 find_composition (charpos
, -1, &start
, &end
, &prop
, string
);
1136 cmp_it
->id
= get_composition_id (charpos
, bytepos
, end
- start
,
1139 goto no_composition
;
1140 cmp_it
->nchars
= end
- start
;
1141 cmp_it
->nglyphs
= composition_table
[cmp_it
->id
]->glyph_len
;
1145 Lisp_Object val
, elt
;
1148 val
= CHAR_TABLE_REF (Vcomposition_function_table
, cmp_it
->ch
);
1149 for (; CONSP (val
); val
= XCDR (val
))
1152 if (cmp_it
->lookback
== XFASTINT (AREF (elt
, 1)))
1156 goto no_composition
;
1158 val
= autocmp_chars (val
, charpos
, bytepos
, endpos
, w
, face
, string
);
1159 if (! composition_gstring_p (val
))
1160 goto no_composition
;
1161 if (NILP (LGSTRING_ID (val
)))
1162 val
= composition_gstring_put_cache (val
, -1);
1163 cmp_it
->id
= XINT (LGSTRING_ID (val
));
1164 for (i
= 0; i
< LGSTRING_GLYPH_LEN (val
); i
++)
1165 if (NILP (LGSTRING_GLYPH (val
, i
)))
1167 cmp_it
->nglyphs
= i
;
1170 goto no_composition
;
1176 if (STRINGP (string
))
1177 bytepos
+= MULTIBYTE_LENGTH_NO_CHECK (SDATA (string
) + bytepos
);
1180 composition_compute_stop_pos (cmp_it
, charpos
, bytepos
, endpos
, string
);
1185 composition_update_it (cmp_it
, charpos
, bytepos
, string
)
1186 struct composition_it
*cmp_it
;
1187 EMACS_INT charpos
, bytepos
;
1194 struct composition
*cmp
= composition_table
[cmp_it
->id
];
1196 cmp_it
->to
= cmp_it
->nglyphs
;
1197 if (cmp_it
->nglyphs
== 0)
1201 for (i
= 0; i
< cmp
->glyph_len
; i
++)
1202 if ((c
= COMPOSITION_GLYPH (cmp
, i
)) != '\t')
1207 cmp_it
->width
= cmp
->width
;
1211 Lisp_Object gstring
= composition_gstring_from_id (cmp_it
->id
);
1213 if (cmp_it
->nglyphs
== 0)
1216 cmp_it
->nchars
= LGSTRING_CHAR_LEN (gstring
);
1221 Lisp_Object glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->from
);
1222 int from
= LGLYPH_FROM (glyph
);
1224 c
= XINT (LGSTRING_CHAR (gstring
, from
));
1225 cmp_it
->nchars
= LGLYPH_TO (glyph
) - from
+ 1;
1226 cmp_it
->width
= (LGLYPH_WIDTH (glyph
) > 0
1227 ? CHAR_WIDTH (LGLYPH_CHAR (glyph
)) : 0);
1228 for (cmp_it
->to
= cmp_it
->from
+ 1; cmp_it
->to
< cmp_it
->nglyphs
;
1231 glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->to
);
1232 if (LGLYPH_FROM (glyph
) != from
)
1234 if (LGLYPH_WIDTH (glyph
) > 0)
1235 cmp_it
->width
+= CHAR_WIDTH (LGLYPH_CHAR (glyph
));
1240 charpos
+= cmp_it
->nchars
;
1241 if (STRINGP (string
))
1242 cmp_it
->nbytes
= string_char_to_byte (string
, charpos
) - bytepos
;
1244 cmp_it
->nbytes
= CHAR_TO_BYTE (charpos
) - bytepos
;
1249 struct position_record
1251 EMACS_INT pos
, pos_byte
;
1255 /* Update the members of POSTION to the next character boundary. */
1256 #define FORWARD_CHAR(POSITION, STOP) \
1259 if ((POSITION).pos == (STOP)) \
1261 (POSITION).p = GAP_END_ADDR; \
1262 (POSITION).pos_byte = GPT_BYTE; \
1266 (POSITION).pos_byte += BYTES_BY_CHAR_HEAD (*((POSITION).p)); \
1267 (POSITION).p += BYTES_BY_CHAR_HEAD (*((POSITION).p)); \
1271 /* Update the members of POSTION to the previous character boundary. */
1272 #define BACKWARD_CHAR(POSITION, STOP) \
1274 if ((POSITION).pos == STOP) \
1275 (POSITION).p = GPT_ADDR; \
1277 (POSITION).pos_byte--; \
1279 } while (! CHAR_HEAD_P (*((POSITION).p))); \
1283 static Lisp_Object _work_val
;
1284 static int _work_char
;
1286 /* 1 iff the character C is composable. */
1287 #define CHAR_COMPOSABLE_P(C) \
1288 ((C) == 0x200C || (C) == 0x200D \
1289 || (_work_val = CHAR_TABLE_REF (Vunicode_category_table, (C)), \
1290 (SYMBOLP (_work_val) \
1291 && (_work_char = SDATA (SYMBOL_NAME (_work_val))[0]) != 'C' \
1292 && _work_char != 'Z')))
1294 /* This is like find_composition, but find an automatic composition
1295 instead. If found, set *GSTRING to the glyph-string representing
1296 the composition, and return 1. Otherwise, return 0. */
1299 find_automatic_composition (pos
, limit
, start
, end
, gstring
, string
)
1300 EMACS_INT pos
, limit
, *start
, *end
;
1301 Lisp_Object
*gstring
, string
;
1303 EMACS_INT head
, tail
, stop
;
1304 /* Limit to check a composition after POS. */
1305 EMACS_INT fore_check_limit
;
1306 struct position_record orig
, cur
, check
, prev
;
1307 Lisp_Object check_val
, val
, elt
;
1313 window
= Fget_buffer_window (Fcurrent_buffer (), Qnil
);
1316 w
= XWINDOW (window
);
1321 head
= BEGV
, tail
= ZV
, stop
= GPT
;
1322 orig
.pos_byte
= CHAR_TO_BYTE (orig
.pos
);
1323 orig
.p
= BYTE_POS_ADDR (orig
.pos_byte
);
1327 head
= 0, tail
= SCHARS (string
), stop
= -1;
1328 orig
.pos_byte
= string_char_to_byte (string
, orig
.pos
);
1329 orig
.p
= SDATA (string
) + orig
.pos_byte
;
1332 fore_check_limit
= min (tail
, pos
+ MAX_AUTO_COMPOSITION_LOOKBACK
);
1334 fore_check_limit
= min (tail
, limit
+ MAX_AUTO_COMPOSITION_LOOKBACK
);
1339 /* At first, check if POS is composable. */
1340 c
= STRING_CHAR (cur
.p
);
1341 if (! CHAR_COMPOSABLE_P (c
))
1345 if (limit
>= cur
.pos
)
1346 goto search_forward
;
1350 val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1352 check_val
= val
, check
= cur
;
1354 while (cur
.pos
+ 1 < fore_check_limit
)
1358 FORWARD_CHAR (cur
, stop
);
1359 if (get_property_and_range (cur
.pos
, Qcomposition
, &val
, &b
, &e
,
1361 && COMPOSITION_VALID_P (b
, e
, val
))
1363 fore_check_limit
= cur
.pos
;
1366 c
= STRING_CHAR (cur
.p
);
1367 if (! CHAR_COMPOSABLE_P (c
))
1369 val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1372 check_val
= val
, check
= cur
;
1377 /* Rewind back to the position where we can safely search forward
1378 for compositions. */
1379 while (cur
.pos
> head
)
1383 BACKWARD_CHAR (cur
, stop
);
1384 if (get_property_and_range (cur
.pos
, Qcomposition
, &val
, &b
, &e
, Qnil
)
1385 && COMPOSITION_VALID_P (b
, e
, val
))
1387 c
= STRING_CHAR (cur
.p
);
1388 if (! CHAR_COMPOSABLE_P (c
))
1390 val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1392 check_val
= val
, check
= cur
;
1395 /* Now search forward. */
1398 if (! NILP (check_val
) || limit
>= orig
.pos
)
1400 if (NILP (check_val
))
1404 while (cur
.pos
< fore_check_limit
)
1406 int need_adjustment
= 0;
1408 if (NILP (check_val
))
1410 c
= STRING_CHAR (cur
.p
);
1411 check_val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1413 for (; CONSP (check_val
); check_val
= XCDR (check_val
))
1415 elt
= XCAR (check_val
);
1416 if (VECTORP (elt
) && ASIZE (elt
) == 3 && NATNUMP (AREF (elt
, 1))
1417 && cur
.pos
- XFASTINT (AREF (elt
, 1)) >= head
)
1419 check
.pos
= cur
.pos
- XFASTINT (AREF (elt
, 1));
1420 if (check
.pos
== cur
.pos
)
1421 check
.pos_byte
= cur
.pos_byte
;
1423 check
.pos_byte
= CHAR_TO_BYTE (check
.pos
);
1424 val
= autocmp_chars (check_val
, check
.pos
, check
.pos_byte
,
1425 tail
, w
, NULL
, string
);
1426 need_adjustment
= 1;
1431 *end
= check
.pos
+ LGSTRING_CHAR_LEN (*gstring
);
1432 if (*start
<= orig
.pos
? *end
> orig
.pos
1433 : limit
>= orig
.pos
)
1436 cur
.pos_byte
= CHAR_TO_BYTE (cur
.pos
);
1441 if (need_adjustment
)
1443 /* As we have called Lisp, there's a possibilily that
1444 buffer/string is relocated. */
1446 cur
.p
= BYTE_POS_ADDR (cur
.pos_byte
);
1448 cur
.p
= SDATA (string
) + cur
.pos_byte
;
1450 if (! CONSP (check_val
))
1451 FORWARD_CHAR (cur
, stop
);
1455 if (! NILP (*gstring
))
1456 return (limit
>= 0 || (*start
<= orig
.pos
&& *end
> orig
.pos
));
1457 if (limit
>= 0 && limit
< orig
.pos
&& prev
.pos
> head
)
1460 BACKWARD_CHAR (cur
, stop
);
1462 fore_check_limit
= orig
.pos
;
1468 /* Return the adjusted point provided that point is moved from LAST_PT
1472 composition_adjust_point (last_pt
, new_pt
)
1473 EMACS_INT last_pt
, new_pt
;
1475 EMACS_INT charpos
, bytepos
, startpos
, beg
, end
, pos
;
1479 if (new_pt
== BEGV
|| new_pt
== ZV
)
1482 /* At first check the static composition. */
1483 if (get_property_and_range (new_pt
, Qcomposition
, &val
, &beg
, &end
, Qnil
)
1484 && COMPOSITION_VALID_P (beg
, end
, val
))
1486 if (beg
< new_pt
/* && end > new_pt <- It's always the case. */
1487 && (last_pt
<= beg
|| last_pt
>= end
))
1488 return (new_pt
< last_pt
? beg
: end
);
1492 if (NILP (current_buffer
->enable_multibyte_characters
)
1493 || NILP (Vauto_composition_mode
))
1496 /* Next check the automatic composition. */
1497 if (! find_automatic_composition (new_pt
, (EMACS_INT
) -1, &beg
, &end
, &val
,
1501 for (i
= 0; i
< LGSTRING_GLYPH_LEN (val
); i
++)
1503 Lisp_Object glyph
= LGSTRING_GLYPH (val
, i
);
1507 if (beg
+ LGLYPH_FROM (glyph
) == new_pt
)
1509 if (beg
+ LGLYPH_TO (glyph
) >= new_pt
)
1510 return (new_pt
< last_pt
1511 ? beg
+ LGLYPH_FROM (glyph
)
1512 : beg
+ LGLYPH_TO (glyph
) + 1);
1517 DEFUN ("composition-get-gstring", Fcomposition_get_gstring
,
1518 Scomposition_get_gstring
, 4, 4, 0,
1519 doc
: /* Return a glyph-string for characters between FROM and TO.
1520 If the glyph string is for graphic display, FONT-OBJECT must be
1521 a font-object to use for those characters.
1522 Otherwise (for terminal display), FONT-OBJECT must be a terminal ID, a
1523 frame, or nil for the selected frame's terminal device.
1525 If the optional 4th argument STRING is not nil, it is a string
1526 containing the target characters between indices FROM and TO.
1528 A glyph-string is a vector containing information about how to display
1529 a specific character sequence. The format is:
1530 [HEADER ID GLYPH ...]
1532 HEADER is a vector of this form:
1533 [FONT-OBJECT CHAR ...]
1535 FONT-OBJECT is a font-object for all glyphs in the glyph-string,
1536 or the terminal coding system of the specified terminal.
1537 CHARs are characters to be composed by GLYPHs.
1539 ID is an identification number of the glyph-string. It may be nil if
1542 GLYPH is a vector whose elements have this form:
1543 [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT
1544 [ [X-OFF Y-OFF WADJUST] | nil] ]
1546 FROM-IDX and TO-IDX are used internally and should not be touched.
1547 C is the character of the glyph.
1548 CODE is the glyph-code of C in FONT-OBJECT.
1549 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
1550 X-OFF and Y-OFF are offsets to the base position for the glyph.
1551 WADJUST is the adjustment to the normal width of the glyph.
1553 If GLYPH is nil, the remaining elements of the glyph-string vector
1554 should be ignored. */)
1555 (from
, to
, font_object
, string
)
1556 Lisp_Object font_object
, from
, to
, string
;
1558 Lisp_Object gstring
, header
;
1559 EMACS_INT frompos
, topos
;
1561 CHECK_NATNUM (from
);
1563 if (XINT (to
) > XINT (from
) + MAX_COMPOSITION_COMPONENTS
)
1564 to
= make_number (XINT (from
) + MAX_COMPOSITION_COMPONENTS
);
1565 if (! FONT_OBJECT_P (font_object
))
1567 struct coding_system
*coding
;
1568 struct terminal
*terminal
= get_terminal (font_object
, 1);
1570 coding
= ((TERMINAL_TERMINAL_CODING (terminal
)->common_flags
1571 & CODING_REQUIRE_ENCODING_MASK
)
1572 ? TERMINAL_TERMINAL_CODING (terminal
) : &safe_terminal_coding
);
1573 font_object
= CODING_ID_NAME (coding
->id
);
1576 header
= fill_gstring_header (Qnil
, from
, to
, font_object
, string
);
1577 gstring
= gstring_lookup_cache (header
);
1578 if (! NILP (gstring
))
1581 frompos
= XINT (from
);
1583 if (LGSTRING_GLYPH_LEN (gstring_work
) < topos
- frompos
)
1584 gstring_work
= Fmake_vector (make_number (topos
- frompos
+ 2), Qnil
);
1585 LGSTRING_SET_HEADER (gstring_work
, header
);
1586 LGSTRING_SET_ID (gstring_work
, Qnil
);
1587 fill_gstring_body (gstring_work
);
1588 return gstring_work
;
1592 /* Emacs Lisp APIs. */
1594 DEFUN ("compose-region-internal", Fcompose_region_internal
,
1595 Scompose_region_internal
, 2, 4, 0,
1596 doc
: /* Internal use only.
1598 Compose text in the region between START and END.
1599 Optional 3rd and 4th arguments are COMPONENTS and MODIFICATION-FUNC
1600 for the composition. See `compose-region' for more details. */)
1601 (start
, end
, components
, modification_func
)
1602 Lisp_Object start
, end
, components
, modification_func
;
1604 validate_region (&start
, &end
);
1605 if (!NILP (components
)
1606 && !INTEGERP (components
)
1607 && !CONSP (components
)
1608 && !STRINGP (components
))
1609 CHECK_VECTOR (components
);
1611 compose_text (XINT (start
), XINT (end
), components
, modification_func
, Qnil
);
1615 DEFUN ("compose-string-internal", Fcompose_string_internal
,
1616 Scompose_string_internal
, 3, 5, 0,
1617 doc
: /* Internal use only.
1619 Compose text between indices START and END of STRING.
1620 Optional 4th and 5th arguments are COMPONENTS and MODIFICATION-FUNC
1621 for the composition. See `compose-string' for more details. */)
1622 (string
, start
, end
, components
, modification_func
)
1623 Lisp_Object string
, start
, end
, components
, modification_func
;
1625 CHECK_STRING (string
);
1626 CHECK_NUMBER (start
);
1629 if (XINT (start
) < 0 ||
1630 XINT (start
) > XINT (end
)
1631 || XINT (end
) > SCHARS (string
))
1632 args_out_of_range (start
, end
);
1634 compose_text (XINT (start
), XINT (end
), components
, modification_func
, string
);
1638 DEFUN ("find-composition-internal", Ffind_composition_internal
,
1639 Sfind_composition_internal
, 4, 4, 0,
1640 doc
: /* Internal use only.
1642 Return information about composition at or nearest to position POS.
1643 See `find-composition' for more details. */)
1644 (pos
, limit
, string
, detail_p
)
1645 Lisp_Object pos
, limit
, string
, detail_p
;
1647 Lisp_Object prop
, tail
, gstring
;
1648 EMACS_INT start
, end
, from
, to
;
1651 CHECK_NUMBER_COERCE_MARKER (pos
);
1655 CHECK_NUMBER_COERCE_MARKER (limit
);
1663 CHECK_STRING (string
);
1664 if (XINT (pos
) < 0 || XINT (pos
) > SCHARS (string
))
1665 args_out_of_range (string
, pos
);
1669 if (XINT (pos
) < BEGV
|| XINT (pos
) > ZV
)
1670 args_out_of_range (Fcurrent_buffer (), pos
);
1673 if (!find_composition (from
, to
, &start
, &end
, &prop
, string
))
1675 if (!NILP (current_buffer
->enable_multibyte_characters
)
1676 && ! NILP (Vauto_composition_mode
)
1677 && find_automatic_composition (from
, to
, &start
, &end
, &gstring
,
1679 return list3 (make_number (start
), make_number (end
), gstring
);
1682 if ((end
<= XINT (pos
) || start
> XINT (pos
)))
1686 if (find_automatic_composition (from
, to
, &s
, &e
, &gstring
, string
)
1687 && (e
<= XINT (pos
) ? e
> end
: s
< start
))
1688 return list3 (make_number (start
), make_number (end
), gstring
);
1690 if (!COMPOSITION_VALID_P (start
, end
, prop
))
1691 return Fcons (make_number (start
), Fcons (make_number (end
),
1692 Fcons (Qnil
, Qnil
)));
1693 if (NILP (detail_p
))
1694 return Fcons (make_number (start
), Fcons (make_number (end
),
1697 if (COMPOSITION_REGISTERD_P (prop
))
1698 id
= COMPOSITION_ID (prop
);
1701 int start_byte
= (NILP (string
)
1702 ? CHAR_TO_BYTE (start
)
1703 : string_char_to_byte (string
, start
));
1704 id
= get_composition_id (start
, start_byte
, end
- start
, prop
, string
);
1709 Lisp_Object components
, relative_p
, mod_func
;
1710 enum composition_method method
= COMPOSITION_METHOD (prop
);
1711 int width
= composition_table
[id
]->width
;
1713 components
= Fcopy_sequence (COMPOSITION_COMPONENTS (prop
));
1714 relative_p
= (method
== COMPOSITION_WITH_RULE_ALTCHARS
1716 mod_func
= COMPOSITION_MODIFICATION_FUNC (prop
);
1717 tail
= Fcons (components
,
1720 Fcons (make_number (width
), Qnil
))));
1725 return Fcons (make_number (start
), Fcons (make_number (end
), tail
));
1730 syms_of_composite ()
1734 Qcomposition
= intern_c_string ("composition");
1735 staticpro (&Qcomposition
);
1737 /* Make a hash table for static composition. */
1739 Lisp_Object args
[6];
1740 extern Lisp_Object QCsize
;
1744 args
[2] = QCweakness
;
1745 /* We used to make the hash table weak so that unreferenced
1746 compositions can be garbage-collected. But, usually once
1747 created compositions are repeatedly used in an Emacs session,
1748 and thus it's not worth to save memory in such a way. So, we
1749 make the table not weak. */
1752 args
[5] = make_number (311);
1753 composition_hash_table
= Fmake_hash_table (6, args
);
1754 staticpro (&composition_hash_table
);
1757 /* Make a hash table for glyph-string. */
1759 Lisp_Object args
[6];
1760 extern Lisp_Object QCsize
;
1764 args
[2] = QCweakness
;
1767 args
[5] = make_number (311);
1768 gstring_hash_table
= Fmake_hash_table (6, args
);
1769 staticpro (&gstring_hash_table
);
1772 staticpro (&gstring_work_headers
);
1773 gstring_work_headers
= Fmake_vector (make_number (8), Qnil
);
1774 for (i
= 0; i
< 8; i
++)
1775 ASET (gstring_work_headers
, i
, Fmake_vector (make_number (i
+ 2), Qnil
));
1776 staticpro (&gstring_work
);
1777 gstring_work
= Fmake_vector (make_number (10), Qnil
);
1779 /* Text property `composition' should be nonsticky by default. */
1780 Vtext_property_default_nonsticky
1781 = Fcons (Fcons (Qcomposition
, Qt
), Vtext_property_default_nonsticky
);
1783 DEFVAR_LISP ("compose-chars-after-function", &Vcompose_chars_after_function
,
1784 doc
: /* Function to adjust composition of buffer text.
1786 This function is called with three arguments: FROM, TO, and OBJECT.
1787 FROM and TO specify the range of text whose composition should be
1788 adjusted. OBJECT, if non-nil, is a string that contains the text.
1790 This function is called after a text with `composition' property is
1791 inserted or deleted to keep `composition' property of buffer text
1794 The default value is the function `compose-chars-after'. */);
1795 Vcompose_chars_after_function
= intern_c_string ("compose-chars-after");
1797 Qauto_composed
= intern_c_string ("auto-composed");
1798 staticpro (&Qauto_composed
);
1800 Qauto_composition_function
= intern_c_string ("auto-composition-function");
1801 staticpro (&Qauto_composition_function
);
1803 DEFVAR_LISP ("auto-composition-mode", &Vauto_composition_mode
,
1804 doc
: /* Non-nil if Auto-Composition mode is enabled.
1805 Use the command `auto-composition-mode' to change this variable. */);
1806 Vauto_composition_mode
= Qt
;
1808 DEFVAR_LISP ("auto-composition-function", &Vauto_composition_function
,
1809 doc
: /* Function to call to compose characters automatically.
1810 This function is called from the display routine with four arguments:
1811 FROM, TO, WINDOW, and STRING.
1813 If STRING is nil, the function must compose characters in the region
1814 between FROM and TO in the current buffer.
1816 Otherwise, STRING is a string, and FROM and TO are indices into the
1817 string. In this case, the function must compose characters in the
1819 Vauto_composition_function
= Qnil
;
1821 DEFVAR_LISP ("composition-function-table", &Vcomposition_function_table
,
1822 doc
: /* Char-table of functions for automatic character composition.
1823 For each character that has to be composed automatically with
1824 preceding and/or following characters, this char-table contains
1825 a function to call to compose that character.
1827 The element at index C in the table, if non-nil, is a list of
1828 this form: ([PATTERN PREV-CHARS FUNC] ...)
1830 PATTERN is a regular expression which C and the surrounding
1831 characters must match.
1833 PREV-CHARS is a non-negative integer (less than 4) specifying how many
1834 characters before C to check the matching with PATTERN. If it is 0,
1835 PATTERN must match C and the following characters. If it is 1,
1836 PATTERN must match a character before C and the following characters.
1838 If PREV-CHARS is 0, PATTERN can be nil, which means that the
1839 single character C should be composed.
1841 FUNC is a function to return a glyph-string representing a
1842 composition of the characters that match PATTERN. It is
1843 called with one argument GSTRING.
1845 GSTRING is a template of a glyph-string to return. It is already
1846 filled with a proper header for the characters to compose, and
1847 glyphs corresponding to those characters one by one. The
1848 function must return a new glyph-string with the same header as
1849 GSTRING, or modify GSTRING itself and return it.
1851 See also the documentation of `auto-composition-mode'. */);
1852 Vcomposition_function_table
= Fmake_char_table (Qnil
, Qnil
);
1854 defsubr (&Scompose_region_internal
);
1855 defsubr (&Scompose_string_internal
);
1856 defsubr (&Sfind_composition_internal
);
1857 defsubr (&Scomposition_get_gstring
);
1860 /* arch-tag: 79cefaf8-ca48-4eed-97e5-d5afb290d272
1861 (do not change this comment) */