1 /* Composite sequence support.
2 Copyright (C) 2001, 2002, 2003, 2004, 2005,
3 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
4 Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
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 a relative composition,
78 the elements are the characters to be composed. In a 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,
99 get_composition_id returns -1 without changing the property value.
101 We use two tables to keep the information about composition;
102 composition_hash_table and composition_table.
104 The former is a hash table whose 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 /* Maximum number of characters to look back for
166 auto-compositions. */
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 int len
= XVECTOR (key
)->size
;
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 (key
)->size
+ 1) / 2
337 : XVECTOR (key
)->size
);
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
);
1021 static Lisp_Object _work_val
;
1022 static int _work_char
;
1024 /* 1 iff the character C is composable. */
1025 #define CHAR_COMPOSABLE_P(C) \
1026 ((C) == 0x200C || (C) == 0x200D \
1027 || (_work_val = CHAR_TABLE_REF (Vunicode_category_table, (C)), \
1028 (SYMBOLP (_work_val) \
1029 && (_work_char = SDATA (SYMBOL_NAME (_work_val))[0]) != 'C' \
1030 && _work_char != 'Z')))
1032 /* Update cmp_it->stop_pos to the next position after CHARPOS (and
1033 BYTEPOS) where character composition may happen. If BYTEPOS is
1034 negative, compute it. ENDPOS is a limit of searching. If it is
1035 less than CHARPOS, search backward to ENDPOS+1 assuming that
1036 set_iterator_to_next works in reverse order. In this case, if a
1037 composition closest to CHARPOS is found, set cmp_it->stop_pos to
1038 the last character of the composition.
1040 If no composition is found, set cmp_it->ch to -2. If a static
1041 composition is found, set cmp_it->ch to -1. Otherwise, set
1042 cmp_it->ch to the character that triggers the automatic
1046 composition_compute_stop_pos (cmp_it
, charpos
, bytepos
, endpos
, string
)
1047 struct composition_it
*cmp_it
;
1048 EMACS_INT charpos
, bytepos
, endpos
;
1051 EMACS_INT start
, end
, c
;
1052 Lisp_Object prop
, val
;
1053 /* This is from forward_to_next_line_start in xdisp.c. */
1054 const int MAX_NEWLINE_DISTANCE
= 500;
1056 if (charpos
< endpos
)
1058 if (endpos
> charpos
+ MAX_NEWLINE_DISTANCE
)
1059 endpos
= charpos
+ MAX_NEWLINE_DISTANCE
;
1061 else if (endpos
< charpos
)
1063 /* We search backward for a position to check composition. */
1066 /* But we don't know where to stop the searching. */
1067 endpos
= NILP (string
) ? BEGV
- 1 : -1;
1068 /* Usually we don't reach ENDPOS because we stop searching
1069 at an uncomposable character (NL, LRE, etc). */
1074 cmp_it
->reversed_p
= 0;
1075 cmp_it
->stop_pos
= endpos
;
1076 if (charpos
== endpos
)
1078 /* FIXME: Bidi is not yet handled well in static composition. */
1079 if (charpos
< endpos
1080 && find_composition (charpos
, endpos
, &start
, &end
, &prop
, string
)
1081 && COMPOSITION_VALID_P (start
, end
, prop
))
1083 cmp_it
->stop_pos
= endpos
= start
;
1088 /* A composition never strides over PT. */
1092 cmp_it
->stop_pos
= endpos
= PT
;
1094 else if (PT
< charpos
&& PT
> endpos
)
1096 cmp_it
->stop_pos
= endpos
= PT
- 1;
1099 if (NILP (current_buffer
->enable_multibyte_characters
)
1100 || NILP (Vauto_composition_mode
))
1105 bytepos
= CHAR_TO_BYTE (charpos
);
1107 bytepos
= string_char_to_byte (string
, charpos
);
1111 if (charpos
< endpos
)
1113 /* Forward search. */
1114 while (charpos
< endpos
)
1116 if (STRINGP (string
))
1117 FETCH_STRING_CHAR_ADVANCE (c
, string
, charpos
, bytepos
);
1119 FETCH_CHAR_ADVANCE (c
, charpos
, bytepos
);
1125 val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1130 for (; CONSP (val
); val
= XCDR (val
))
1133 if (VECTORP (elt
) && ASIZE (elt
) == 3
1134 && NATNUMP (AREF (elt
, 1))
1135 && charpos
- 1 - XFASTINT (AREF (elt
, 1)) >= start
)
1140 cmp_it
->lookback
= XFASTINT (AREF (elt
, 1));
1141 cmp_it
->stop_pos
= charpos
- 1 - cmp_it
->lookback
;
1150 /* Search backward for a pattern that may be composed and the
1151 position of (possibly) the last character of the match is
1152 closest to (but not after) START. The reason for the last
1153 character is that set_iterator_to_next works in reverse order,
1154 and thus we must stop at the last character for composition
1158 /* Limit byte position used in fast_looking_at. This is the
1159 byte position of the character after START. */
1163 p
= BYTE_POS_ADDR (bytepos
);
1165 p
= SDATA (string
) + bytepos
;
1166 c
= STRING_CHAR_AND_LENGTH (p
, len
);
1167 limit
= bytepos
+ len
;
1168 while (CHAR_COMPOSABLE_P (c
))
1170 for (val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1171 CONSP (val
); val
= XCDR (val
))
1173 Lisp_Object elt
= XCAR (val
);
1176 if (VECTORP (elt
) && ASIZE (elt
) == 3
1177 && NATNUMP (AREF (elt
, 1))
1178 && charpos
- (back
= XFASTINT (AREF (elt
, 1))) > endpos
)
1180 EMACS_INT cpos
= charpos
- back
, bpos
;
1185 bpos
= (NILP (string
) ? CHAR_TO_BYTE (cpos
)
1186 : string_char_to_byte (string
, cpos
));
1187 if (STRINGP (AREF (elt
, 0)))
1188 len
= fast_looking_at (AREF (elt
, 0), cpos
, bpos
,
1189 start
+ 1, limit
, string
);
1194 /* Make CPOS point to the last character of match.
1195 Note that LEN is byte-length. */
1198 cpos
= BYTE_TO_CHAR (bpos
) - 1;
1200 cpos
= string_byte_to_char (string
, bpos
) - 1;
1201 back
= cpos
- (charpos
- back
);
1202 if (cmp_it
->stop_pos
< cpos
1203 || (cmp_it
->stop_pos
== cpos
1204 && cmp_it
->lookback
< back
))
1206 cmp_it
->stop_pos
= cpos
;
1208 cmp_it
->lookback
= back
;
1213 if (charpos
- 1 == endpos
)
1215 if (STRINGP (string
))
1218 while (! CHAR_HEAD_P (*p
))
1224 DEC_BOTH (charpos
, bytepos
);
1225 p
= BYTE_POS_ADDR (bytepos
);
1227 c
= STRING_CHAR (p
);
1229 if (cmp_it
->ch
>= 0)
1230 /* We found a position to check. */
1232 /* Skip all uncomposable characters. */
1235 while (charpos
- 1 > endpos
&& ! CHAR_COMPOSABLE_P (c
))
1237 DEC_BOTH (charpos
, bytepos
);
1238 c
= FETCH_MULTIBYTE_CHAR (bytepos
);
1243 while (charpos
- 1 > endpos
&& ! CHAR_COMPOSABLE_P (c
))
1246 while (! CHAR_HEAD_P (*p
))
1249 c
= STRING_CHAR (p
);
1253 cmp_it
->stop_pos
= charpos
;
1256 /* Check if the character at CHARPOS (and BYTEPOS) is composed
1257 (possibly with the following characters) on window W. ENDPOS limits
1258 characters to be composed. FACE, in non-NULL, is a base face of
1259 the character. If STRING is not nil, it is a string containing the
1260 character to check, and CHARPOS and BYTEPOS are indices in the
1261 string. In that case, FACE must not be NULL.
1263 If the character is composed, setup members of CMP_IT (id, nglyphs,
1264 from, to, reversed_p), and return 1. Otherwise, update
1265 CMP_IT->stop_pos, and return 0. */
1268 composition_reseat_it (cmp_it
, charpos
, bytepos
, endpos
, w
, face
, string
)
1269 struct composition_it
*cmp_it
;
1270 EMACS_INT charpos
, bytepos
, endpos
;
1275 if (endpos
<= charpos
)
1281 if (endpos
< PT
&& PT
< charpos
)
1284 else if (endpos
< 0)
1289 if (NILP (string
) && charpos
< PT
&& PT
< endpos
)
1293 if (cmp_it
->ch
== -2)
1295 composition_compute_stop_pos (cmp_it
, charpos
, bytepos
, endpos
, string
);
1296 if (cmp_it
->stop_pos
!= charpos
)
1297 /* The current position is not composed. */
1303 /* We are looking at a static composition. */
1304 EMACS_INT start
, end
;
1307 find_composition (charpos
, -1, &start
, &end
, &prop
, string
);
1308 cmp_it
->id
= get_composition_id (charpos
, bytepos
, end
- start
,
1311 goto no_composition
;
1312 cmp_it
->nchars
= end
- start
;
1313 cmp_it
->nglyphs
= composition_table
[cmp_it
->id
]->glyph_len
;
1317 Lisp_Object val
, elt
;
1320 val
= CHAR_TABLE_REF (Vcomposition_function_table
, cmp_it
->ch
);
1321 if (charpos
< endpos
)
1323 for (; CONSP (val
); val
= XCDR (val
))
1326 if (cmp_it
->lookback
== XFASTINT (AREF (elt
, 1)))
1330 goto no_composition
;
1332 val
= autocmp_chars (val
, charpos
, bytepos
, endpos
, w
, face
, string
);
1333 if (! composition_gstring_p (val
))
1334 goto no_composition
;
1335 cmp_it
->reversed_p
= 0;
1339 EMACS_INT saved_charpos
= charpos
, saved_bytepos
= bytepos
;
1341 if (cmp_it
->lookback
> 0)
1343 charpos
-= cmp_it
->lookback
;
1344 if (charpos
< endpos
)
1345 goto no_composition
;
1346 if (STRINGP (string
))
1347 bytepos
= string_char_to_byte (string
, charpos
);
1349 bytepos
= CHAR_TO_BYTE (charpos
);
1351 val
= autocmp_chars (val
, charpos
, bytepos
, saved_charpos
+ 1,
1353 if (! composition_gstring_p (val
)
1354 || charpos
+ LGSTRING_CHAR_LEN (val
) <= saved_charpos
)
1356 charpos
= saved_charpos
, bytepos
= saved_bytepos
;
1357 goto no_composition
;
1359 cmp_it
->reversed_p
= 1;
1361 if (NILP (LGSTRING_ID (val
)))
1362 val
= composition_gstring_put_cache (val
, -1);
1363 cmp_it
->id
= XINT (LGSTRING_ID (val
));
1364 for (i
= 0; i
< LGSTRING_GLYPH_LEN (val
); i
++)
1365 if (NILP (LGSTRING_GLYPH (val
, i
)))
1367 cmp_it
->nglyphs
= i
;
1372 goto no_composition
;
1376 if (charpos
== endpos
)
1378 if (charpos
< endpos
)
1381 if (STRINGP (string
))
1382 bytepos
+= MULTIBYTE_LENGTH_NO_CHECK (SDATA (string
) + bytepos
);
1389 /* BYTEPOS is calculated in composition_compute_stop_pos */
1392 composition_compute_stop_pos (cmp_it
, charpos
, bytepos
, endpos
, string
);
1396 /* Update nchars, nbytes, and width of the current grapheme cluster
1397 which is identified by CMP_IT->from (if the composition is static
1398 or automatic in l2r context) or CMPT_IT->to (if the composition is
1399 automatic in r2l context). In addition, in the former case, update
1400 CMP_IT->to, and in the latter case, update CMP_IT->from. */
1403 composition_update_it (cmp_it
, charpos
, bytepos
, string
)
1404 struct composition_it
*cmp_it
;
1405 EMACS_INT charpos
, bytepos
;
1412 struct composition
*cmp
= composition_table
[cmp_it
->id
];
1414 cmp_it
->to
= cmp_it
->nglyphs
;
1415 if (cmp_it
->nglyphs
== 0)
1419 for (i
= 0; i
< cmp
->glyph_len
; i
++)
1420 if ((c
= COMPOSITION_GLYPH (cmp
, i
)) != '\t')
1425 cmp_it
->width
= cmp
->width
;
1429 Lisp_Object gstring
= composition_gstring_from_id (cmp_it
->id
);
1431 if (cmp_it
->nglyphs
== 0)
1434 cmp_it
->nchars
= LGSTRING_CHAR_LEN (gstring
);
1437 else if (! cmp_it
->reversed_p
)
1439 Lisp_Object glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->from
);
1440 int from
= LGLYPH_FROM (glyph
);
1442 c
= XINT (LGSTRING_CHAR (gstring
, from
));
1443 cmp_it
->nchars
= LGLYPH_TO (glyph
) - from
+ 1;
1444 cmp_it
->width
= (LGLYPH_WIDTH (glyph
) > 0
1445 ? CHAR_WIDTH (LGLYPH_CHAR (glyph
)) : 0);
1446 for (cmp_it
->to
= cmp_it
->from
+ 1; cmp_it
->to
< cmp_it
->nglyphs
;
1449 glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->to
);
1450 if (LGLYPH_FROM (glyph
) != from
)
1452 if (LGLYPH_WIDTH (glyph
) > 0)
1453 cmp_it
->width
+= CHAR_WIDTH (LGLYPH_CHAR (glyph
));
1458 int from_idx
= cmp_it
->to
- 1;
1459 Lisp_Object glyph
= LGSTRING_GLYPH (gstring
, from_idx
);
1460 int from
= LGLYPH_FROM (glyph
);
1462 c
= XINT (LGSTRING_CHAR (gstring
, from
));
1463 cmp_it
->nchars
= LGLYPH_TO (glyph
) - from
+ 1;
1464 cmp_it
->width
= (LGLYPH_WIDTH (glyph
) > 0
1465 ? CHAR_WIDTH (LGLYPH_CHAR (glyph
)) : 0);
1466 for (from_idx
--; from_idx
>= 0; from_idx
--)
1468 glyph
= LGSTRING_GLYPH (gstring
, from_idx
);
1469 if (LGLYPH_FROM (glyph
) != from
)
1471 if (LGLYPH_WIDTH (glyph
) > 0)
1472 cmp_it
->width
+= CHAR_WIDTH (LGLYPH_CHAR (glyph
));
1474 cmp_it
->from
= from_idx
+ 1;
1475 charpos
-= cmp_it
->nchars
- 1;
1476 bytepos
+= CHAR_BYTES (c
);
1477 if (STRINGP (string
))
1478 cmp_it
->nbytes
= bytepos
- string_char_to_byte (string
, charpos
);
1480 cmp_it
->nbytes
= bytepos
- CHAR_TO_BYTE (charpos
);
1485 charpos
+= cmp_it
->nchars
;
1486 if (STRINGP (string
))
1487 cmp_it
->nbytes
= string_char_to_byte (string
, charpos
) - bytepos
;
1489 cmp_it
->nbytes
= CHAR_TO_BYTE (charpos
) - bytepos
;
1494 struct position_record
1496 EMACS_INT pos
, pos_byte
;
1500 /* Update the members of POSITION to the next character boundary. */
1501 #define FORWARD_CHAR(POSITION, STOP) \
1504 if ((POSITION).pos == (STOP)) \
1506 (POSITION).p = GAP_END_ADDR; \
1507 (POSITION).pos_byte = GPT_BYTE; \
1511 (POSITION).pos_byte += BYTES_BY_CHAR_HEAD (*((POSITION).p)); \
1512 (POSITION).p += BYTES_BY_CHAR_HEAD (*((POSITION).p)); \
1516 /* Update the members of POSITION to the previous character boundary. */
1517 #define BACKWARD_CHAR(POSITION, STOP) \
1519 if ((POSITION).pos == STOP) \
1520 (POSITION).p = GPT_ADDR; \
1522 (POSITION).pos_byte--; \
1524 } while (! CHAR_HEAD_P (*((POSITION).p))); \
1528 /* This is like find_composition, but find an automatic composition
1529 instead. If found, set *GSTRING to the glyph-string representing
1530 the composition, and return 1. Otherwise, return 0. */
1533 find_automatic_composition (pos
, limit
, start
, end
, gstring
, string
)
1534 EMACS_INT pos
, limit
, *start
, *end
;
1535 Lisp_Object
*gstring
, string
;
1537 EMACS_INT head
, tail
, stop
;
1538 /* Limit to check a composition after POS. */
1539 EMACS_INT fore_check_limit
;
1540 struct position_record orig
, cur
, check
, prev
;
1541 Lisp_Object check_val
, val
, elt
;
1547 window
= Fget_buffer_window (Fcurrent_buffer (), Qnil
);
1550 w
= XWINDOW (window
);
1555 head
= BEGV
, tail
= ZV
, stop
= GPT
;
1556 orig
.pos_byte
= CHAR_TO_BYTE (orig
.pos
);
1557 orig
.p
= BYTE_POS_ADDR (orig
.pos_byte
);
1561 head
= 0, tail
= SCHARS (string
), stop
= -1;
1562 orig
.pos_byte
= string_char_to_byte (string
, orig
.pos
);
1563 orig
.p
= SDATA (string
) + orig
.pos_byte
;
1566 fore_check_limit
= min (tail
, pos
+ MAX_AUTO_COMPOSITION_LOOKBACK
);
1568 fore_check_limit
= min (tail
, limit
+ MAX_AUTO_COMPOSITION_LOOKBACK
);
1573 /* At first, check if POS is composable. */
1574 c
= STRING_CHAR (cur
.p
);
1575 if (! CHAR_COMPOSABLE_P (c
))
1579 if (limit
>= cur
.pos
)
1580 goto search_forward
;
1584 val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1586 check_val
= val
, check
= cur
;
1588 while (cur
.pos
+ 1 < fore_check_limit
)
1592 FORWARD_CHAR (cur
, stop
);
1593 if (get_property_and_range (cur
.pos
, Qcomposition
, &val
, &b
, &e
,
1595 && COMPOSITION_VALID_P (b
, e
, val
))
1597 fore_check_limit
= cur
.pos
;
1600 c
= STRING_CHAR (cur
.p
);
1601 if (! CHAR_COMPOSABLE_P (c
))
1603 val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1606 check_val
= val
, check
= cur
;
1611 /* Rewind back to the position where we can safely search forward
1612 for compositions. */
1613 while (cur
.pos
> head
)
1617 BACKWARD_CHAR (cur
, stop
);
1618 if (get_property_and_range (cur
.pos
, Qcomposition
, &val
, &b
, &e
, Qnil
)
1619 && COMPOSITION_VALID_P (b
, e
, val
))
1621 c
= STRING_CHAR (cur
.p
);
1622 if (! CHAR_COMPOSABLE_P (c
))
1624 val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1626 check_val
= val
, check
= cur
;
1629 /* Now search forward. */
1632 if (! NILP (check_val
) || limit
>= orig
.pos
)
1634 if (NILP (check_val
))
1638 while (cur
.pos
< fore_check_limit
)
1640 int need_adjustment
= 0;
1642 if (NILP (check_val
))
1644 c
= STRING_CHAR (cur
.p
);
1645 check_val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1647 for (; CONSP (check_val
); check_val
= XCDR (check_val
))
1649 elt
= XCAR (check_val
);
1650 if (VECTORP (elt
) && ASIZE (elt
) == 3 && NATNUMP (AREF (elt
, 1))
1651 && cur
.pos
- XFASTINT (AREF (elt
, 1)) >= head
)
1653 check
.pos
= cur
.pos
- XFASTINT (AREF (elt
, 1));
1654 if (check
.pos
== cur
.pos
)
1655 check
.pos_byte
= cur
.pos_byte
;
1657 check
.pos_byte
= CHAR_TO_BYTE (check
.pos
);
1658 val
= autocmp_chars (check_val
, check
.pos
, check
.pos_byte
,
1659 tail
, w
, NULL
, string
);
1660 need_adjustment
= 1;
1665 *end
= check
.pos
+ LGSTRING_CHAR_LEN (*gstring
);
1666 if (*start
<= orig
.pos
? *end
> orig
.pos
1667 : limit
>= orig
.pos
)
1670 cur
.pos_byte
= CHAR_TO_BYTE (cur
.pos
);
1675 if (need_adjustment
)
1677 /* As we have called Lisp, there's a possibility that
1678 buffer/string is relocated. */
1680 cur
.p
= BYTE_POS_ADDR (cur
.pos_byte
);
1682 cur
.p
= SDATA (string
) + cur
.pos_byte
;
1684 if (! CONSP (check_val
))
1685 FORWARD_CHAR (cur
, stop
);
1689 if (! NILP (*gstring
))
1690 return (limit
>= 0 || (*start
<= orig
.pos
&& *end
> orig
.pos
));
1691 if (limit
>= 0 && limit
< orig
.pos
&& prev
.pos
> head
)
1694 BACKWARD_CHAR (cur
, stop
);
1696 fore_check_limit
= orig
.pos
;
1702 /* Return the adjusted point provided that point is moved from LAST_PT
1706 composition_adjust_point (last_pt
, new_pt
)
1707 EMACS_INT last_pt
, new_pt
;
1709 EMACS_INT charpos
, bytepos
, startpos
, beg
, end
, pos
;
1713 if (new_pt
== BEGV
|| new_pt
== ZV
)
1716 /* At first check the static composition. */
1717 if (get_property_and_range (new_pt
, Qcomposition
, &val
, &beg
, &end
, Qnil
)
1718 && COMPOSITION_VALID_P (beg
, end
, val
))
1720 if (beg
< new_pt
/* && end > new_pt <- It's always the case. */
1721 && (last_pt
<= beg
|| last_pt
>= end
))
1722 return (new_pt
< last_pt
? beg
: end
);
1726 if (NILP (current_buffer
->enable_multibyte_characters
)
1727 || NILP (Vauto_composition_mode
))
1730 /* Next check the automatic composition. */
1731 if (! find_automatic_composition (new_pt
, (EMACS_INT
) -1, &beg
, &end
, &val
,
1735 for (i
= 0; i
< LGSTRING_GLYPH_LEN (val
); i
++)
1737 Lisp_Object glyph
= LGSTRING_GLYPH (val
, i
);
1741 if (beg
+ LGLYPH_FROM (glyph
) == new_pt
)
1743 if (beg
+ LGLYPH_TO (glyph
) >= new_pt
)
1744 return (new_pt
< last_pt
1745 ? beg
+ LGLYPH_FROM (glyph
)
1746 : beg
+ LGLYPH_TO (glyph
) + 1);
1751 DEFUN ("composition-get-gstring", Fcomposition_get_gstring
,
1752 Scomposition_get_gstring
, 4, 4, 0,
1753 doc
: /* Return a glyph-string for characters between FROM and TO.
1754 If the glyph string is for graphic display, FONT-OBJECT must be
1755 a font-object to use for those characters.
1756 Otherwise (for terminal display), FONT-OBJECT must be a terminal ID, a
1757 frame, or nil for the selected frame's terminal device.
1759 If the optional 4th argument STRING is not nil, it is a string
1760 containing the target characters between indices FROM and TO.
1762 A glyph-string is a vector containing information about how to display
1763 a specific character sequence. The format is:
1764 [HEADER ID GLYPH ...]
1766 HEADER is a vector of this form:
1767 [FONT-OBJECT CHAR ...]
1769 FONT-OBJECT is a font-object for all glyphs in the glyph-string,
1770 or the terminal coding system of the specified terminal.
1771 CHARs are characters to be composed by GLYPHs.
1773 ID is an identification number of the glyph-string. It may be nil if
1776 GLYPH is a vector whose elements have this form:
1777 [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT
1778 [ [X-OFF Y-OFF WADJUST] | nil] ]
1780 FROM-IDX and TO-IDX are used internally and should not be touched.
1781 C is the character of the glyph.
1782 CODE is the glyph-code of C in FONT-OBJECT.
1783 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
1784 X-OFF and Y-OFF are offsets to the base position for the glyph.
1785 WADJUST is the adjustment to the normal width of the glyph.
1787 If GLYPH is nil, the remaining elements of the glyph-string vector
1788 should be ignored. */)
1789 (from
, to
, font_object
, string
)
1790 Lisp_Object font_object
, from
, to
, string
;
1792 Lisp_Object gstring
, header
;
1793 EMACS_INT frompos
, topos
;
1795 CHECK_NATNUM (from
);
1797 if (XINT (to
) > XINT (from
) + MAX_COMPOSITION_COMPONENTS
)
1798 to
= make_number (XINT (from
) + MAX_COMPOSITION_COMPONENTS
);
1799 if (! FONT_OBJECT_P (font_object
))
1801 struct coding_system
*coding
;
1802 struct terminal
*terminal
= get_terminal (font_object
, 1);
1804 coding
= ((TERMINAL_TERMINAL_CODING (terminal
)->common_flags
1805 & CODING_REQUIRE_ENCODING_MASK
)
1806 ? TERMINAL_TERMINAL_CODING (terminal
) : &safe_terminal_coding
);
1807 font_object
= CODING_ID_NAME (coding
->id
);
1810 header
= fill_gstring_header (Qnil
, from
, to
, font_object
, string
);
1811 gstring
= gstring_lookup_cache (header
);
1812 if (! NILP (gstring
))
1815 frompos
= XINT (from
);
1817 if (LGSTRING_GLYPH_LEN (gstring_work
) < topos
- frompos
)
1818 gstring_work
= Fmake_vector (make_number (topos
- frompos
+ 2), Qnil
);
1819 LGSTRING_SET_HEADER (gstring_work
, header
);
1820 LGSTRING_SET_ID (gstring_work
, Qnil
);
1821 fill_gstring_body (gstring_work
);
1822 return gstring_work
;
1826 /* Emacs Lisp APIs. */
1828 DEFUN ("compose-region-internal", Fcompose_region_internal
,
1829 Scompose_region_internal
, 2, 4, 0,
1830 doc
: /* Internal use only.
1832 Compose text in the region between START and END.
1833 Optional 3rd and 4th arguments are COMPONENTS and MODIFICATION-FUNC
1834 for the composition. See `compose-region' for more details. */)
1835 (start
, end
, components
, modification_func
)
1836 Lisp_Object start
, end
, components
, modification_func
;
1838 validate_region (&start
, &end
);
1839 if (!NILP (components
)
1840 && !INTEGERP (components
)
1841 && !CONSP (components
)
1842 && !STRINGP (components
))
1843 CHECK_VECTOR (components
);
1845 compose_text (XINT (start
), XINT (end
), components
, modification_func
, Qnil
);
1849 DEFUN ("compose-string-internal", Fcompose_string_internal
,
1850 Scompose_string_internal
, 3, 5, 0,
1851 doc
: /* Internal use only.
1853 Compose text between indices START and END of STRING.
1854 Optional 4th and 5th arguments are COMPONENTS and MODIFICATION-FUNC
1855 for the composition. See `compose-string' for more details. */)
1856 (string
, start
, end
, components
, modification_func
)
1857 Lisp_Object string
, start
, end
, components
, modification_func
;
1859 CHECK_STRING (string
);
1860 CHECK_NUMBER (start
);
1863 if (XINT (start
) < 0 ||
1864 XINT (start
) > XINT (end
)
1865 || XINT (end
) > SCHARS (string
))
1866 args_out_of_range (start
, end
);
1868 compose_text (XINT (start
), XINT (end
), components
, modification_func
, string
);
1872 DEFUN ("find-composition-internal", Ffind_composition_internal
,
1873 Sfind_composition_internal
, 4, 4, 0,
1874 doc
: /* Internal use only.
1876 Return information about composition at or nearest to position POS.
1877 See `find-composition' for more details. */)
1878 (pos
, limit
, string
, detail_p
)
1879 Lisp_Object pos
, limit
, string
, detail_p
;
1881 Lisp_Object prop
, tail
, gstring
;
1882 EMACS_INT start
, end
, from
, to
;
1885 CHECK_NUMBER_COERCE_MARKER (pos
);
1889 CHECK_NUMBER_COERCE_MARKER (limit
);
1897 CHECK_STRING (string
);
1898 if (XINT (pos
) < 0 || XINT (pos
) > SCHARS (string
))
1899 args_out_of_range (string
, pos
);
1903 if (XINT (pos
) < BEGV
|| XINT (pos
) > ZV
)
1904 args_out_of_range (Fcurrent_buffer (), pos
);
1907 if (!find_composition (from
, to
, &start
, &end
, &prop
, string
))
1909 if (!NILP (current_buffer
->enable_multibyte_characters
)
1910 && ! NILP (Vauto_composition_mode
)
1911 && find_automatic_composition (from
, to
, &start
, &end
, &gstring
,
1913 return list3 (make_number (start
), make_number (end
), gstring
);
1916 if ((end
<= XINT (pos
) || start
> XINT (pos
)))
1920 if (find_automatic_composition (from
, to
, &s
, &e
, &gstring
, string
)
1921 && (e
<= XINT (pos
) ? e
> end
: s
< start
))
1922 return list3 (make_number (s
), make_number (e
), gstring
);
1924 if (!COMPOSITION_VALID_P (start
, end
, prop
))
1925 return Fcons (make_number (start
), Fcons (make_number (end
),
1926 Fcons (Qnil
, Qnil
)));
1927 if (NILP (detail_p
))
1928 return Fcons (make_number (start
), Fcons (make_number (end
),
1931 if (COMPOSITION_REGISTERD_P (prop
))
1932 id
= COMPOSITION_ID (prop
);
1935 int start_byte
= (NILP (string
)
1936 ? CHAR_TO_BYTE (start
)
1937 : string_char_to_byte (string
, start
));
1938 id
= get_composition_id (start
, start_byte
, end
- start
, prop
, string
);
1943 Lisp_Object components
, relative_p
, mod_func
;
1944 enum composition_method method
= COMPOSITION_METHOD (prop
);
1945 int width
= composition_table
[id
]->width
;
1947 components
= Fcopy_sequence (COMPOSITION_COMPONENTS (prop
));
1948 relative_p
= (method
== COMPOSITION_WITH_RULE_ALTCHARS
1950 mod_func
= COMPOSITION_MODIFICATION_FUNC (prop
);
1951 tail
= Fcons (components
,
1954 Fcons (make_number (width
), Qnil
))));
1959 return Fcons (make_number (start
), Fcons (make_number (end
), tail
));
1964 syms_of_composite ()
1968 Qcomposition
= intern_c_string ("composition");
1969 staticpro (&Qcomposition
);
1971 /* Make a hash table for static composition. */
1973 Lisp_Object args
[6];
1974 extern Lisp_Object QCsize
;
1978 args
[2] = QCweakness
;
1979 /* We used to make the hash table weak so that unreferenced
1980 compositions can be garbage-collected. But, usually once
1981 created compositions are repeatedly used in an Emacs session,
1982 and thus it's not worth to save memory in such a way. So, we
1983 make the table not weak. */
1986 args
[5] = make_number (311);
1987 composition_hash_table
= Fmake_hash_table (6, args
);
1988 staticpro (&composition_hash_table
);
1991 /* Make a hash table for glyph-string. */
1993 Lisp_Object args
[6];
1994 extern Lisp_Object QCsize
;
1998 args
[2] = QCweakness
;
2001 args
[5] = make_number (311);
2002 gstring_hash_table
= Fmake_hash_table (6, args
);
2003 staticpro (&gstring_hash_table
);
2006 staticpro (&gstring_work_headers
);
2007 gstring_work_headers
= Fmake_vector (make_number (8), Qnil
);
2008 for (i
= 0; i
< 8; i
++)
2009 ASET (gstring_work_headers
, i
, Fmake_vector (make_number (i
+ 2), Qnil
));
2010 staticpro (&gstring_work
);
2011 gstring_work
= Fmake_vector (make_number (10), Qnil
);
2013 /* Text property `composition' should be nonsticky by default. */
2014 Vtext_property_default_nonsticky
2015 = Fcons (Fcons (Qcomposition
, Qt
), Vtext_property_default_nonsticky
);
2017 DEFVAR_LISP ("compose-chars-after-function", &Vcompose_chars_after_function
,
2018 doc
: /* Function to adjust composition of buffer text.
2020 This function is called with three arguments: FROM, TO, and OBJECT.
2021 FROM and TO specify the range of text whose composition should be
2022 adjusted. OBJECT, if non-nil, is a string that contains the text.
2024 This function is called after a text with `composition' property is
2025 inserted or deleted to keep `composition' property of buffer text
2028 The default value is the function `compose-chars-after'. */);
2029 Vcompose_chars_after_function
= intern_c_string ("compose-chars-after");
2031 Qauto_composed
= intern_c_string ("auto-composed");
2032 staticpro (&Qauto_composed
);
2034 Qauto_composition_function
= intern_c_string ("auto-composition-function");
2035 staticpro (&Qauto_composition_function
);
2037 DEFVAR_LISP ("auto-composition-mode", &Vauto_composition_mode
,
2038 doc
: /* Non-nil if Auto-Composition mode is enabled.
2039 Use the command `auto-composition-mode' to change this variable. */);
2040 Vauto_composition_mode
= Qt
;
2042 DEFVAR_LISP ("auto-composition-function", &Vauto_composition_function
,
2043 doc
: /* Function to call to compose characters automatically.
2044 This function is called from the display routine with four arguments:
2045 FROM, TO, WINDOW, and STRING.
2047 If STRING is nil, the function must compose characters in the region
2048 between FROM and TO in the current buffer.
2050 Otherwise, STRING is a string, and FROM and TO are indices into the
2051 string. In this case, the function must compose characters in the
2053 Vauto_composition_function
= Qnil
;
2055 DEFVAR_LISP ("composition-function-table", &Vcomposition_function_table
,
2056 doc
: /* Char-table of functions for automatic character composition.
2057 For each character that has to be composed automatically with
2058 preceding and/or following characters, this char-table contains
2059 a function to call to compose that character.
2061 The element at index C in the table, if non-nil, is a list of
2062 this form: ([PATTERN PREV-CHARS FUNC] ...)
2064 PATTERN is a regular expression which C and the surrounding
2065 characters must match.
2067 PREV-CHARS is a non-negative integer (less than 4) specifying how many
2068 characters before C to check the matching with PATTERN. If it is 0,
2069 PATTERN must match C and the following characters. If it is 1,
2070 PATTERN must match a character before C and the following characters.
2072 If PREV-CHARS is 0, PATTERN can be nil, which means that the
2073 single character C should be composed.
2075 FUNC is a function to return a glyph-string representing a
2076 composition of the characters that match PATTERN. It is
2077 called with one argument GSTRING.
2079 GSTRING is a template of a glyph-string to return. It is already
2080 filled with a proper header for the characters to compose, and
2081 glyphs corresponding to those characters one by one. The
2082 function must return a new glyph-string with the same header as
2083 GSTRING, or modify GSTRING itself and return it.
2085 See also the documentation of `auto-composition-mode'. */);
2086 Vcomposition_function_table
= Fmake_char_table (Qnil
, Qnil
);
2088 defsubr (&Scompose_region_internal
);
2089 defsubr (&Scompose_string_internal
);
2090 defsubr (&Sfind_composition_internal
);
2091 defsubr (&Scomposition_get_gstring
);
2094 /* arch-tag: 79cefaf8-ca48-4eed-97e5-d5afb290d272
2095 (do not change this comment) */