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 (int charpos
, int bytepos
, int nchars
, Lisp_Object prop
, Lisp_Object string
)
185 Lisp_Object id
, length
, components
, key
, *key_contents
;
187 struct Lisp_Hash_Table
*hash_table
= XHASH_TABLE (composition_hash_table
);
190 struct composition
*cmp
;
194 Form-A: ((LENGTH . COMPONENTS) . MODIFICATION-FUNC)
196 Form-B: (COMPOSITION-ID . (LENGTH COMPONENTS-VEC . MODIFICATION-FUNC))
198 if (nchars
== 0 || !CONSP (prop
))
199 goto invalid_composition
;
204 /* PROP should be Form-B. */
205 if (XINT (id
) < 0 || XINT (id
) >= n_compositions
)
206 goto invalid_composition
;
210 /* PROP should be Form-A.
211 Thus, ID should be (LENGTH . COMPONENTS). */
213 goto invalid_composition
;
215 if (!INTEGERP (length
) || XINT (length
) != nchars
)
216 goto invalid_composition
;
218 components
= XCDR (id
);
220 /* Check if the same composition has already been registered or not
221 by consulting composition_hash_table. The key for this table is
222 COMPONENTS (converted to a vector COMPONENTS-VEC) or, if it is
223 nil, vector of characters in the composition range. */
224 if (INTEGERP (components
))
225 key
= Fmake_vector (make_number (1), components
);
226 else if (STRINGP (components
) || CONSP (components
))
227 key
= Fvconcat (1, &components
);
228 else if (VECTORP (components
))
230 else if (NILP (components
))
232 key
= Fmake_vector (make_number (nchars
), Qnil
);
233 if (STRINGP (string
))
234 for (i
= 0; i
< nchars
; i
++)
236 FETCH_STRING_CHAR_ADVANCE (ch
, string
, charpos
, bytepos
);
237 XVECTOR (key
)->contents
[i
] = make_number (ch
);
240 for (i
= 0; i
< nchars
; i
++)
242 FETCH_CHAR_ADVANCE (ch
, charpos
, bytepos
);
243 XVECTOR (key
)->contents
[i
] = make_number (ch
);
247 goto invalid_composition
;
249 hash_index
= hash_lookup (hash_table
, key
, &hash_code
);
252 /* We have already registered the same composition. Change PROP
253 from Form-A above to Form-B while replacing COMPONENTS with
254 COMPONENTS-VEC stored in the hash table. We can directly
255 modify the cons cell of PROP because it is not shared. */
256 key
= HASH_KEY (hash_table
, hash_index
);
257 id
= HASH_VALUE (hash_table
, hash_index
);
259 XSETCDR (prop
, Fcons (make_number (nchars
), Fcons (key
, XCDR (prop
))));
263 /* This composition is a new one. We must register it. */
265 /* Check if we have sufficient memory to store this information. */
266 if (composition_table_size
== 0)
268 composition_table_size
= 256;
270 = (struct composition
**) xmalloc (sizeof (composition_table
[0])
271 * composition_table_size
);
273 else if (composition_table_size
<= n_compositions
)
275 composition_table_size
+= 256;
277 = (struct composition
**) xrealloc (composition_table
,
278 sizeof (composition_table
[0])
279 * composition_table_size
);
282 key_contents
= XVECTOR (key
)->contents
;
284 /* Check if the contents of COMPONENTS are valid if COMPONENTS is a
285 vector or a list. It should be a sequence of:
286 char1 rule1 char2 rule2 char3 ... ruleN charN+1 */
288 if (VECTORP (components
)
289 && ASIZE (components
) >= 2
290 && VECTORP (AREF (components
, 0)))
292 /* COMPONENTS is a glyph-string. */
293 int len
= ASIZE (key
);
295 for (i
= 1; i
< len
; i
++)
296 if (! VECTORP (AREF (key
, i
)))
297 goto invalid_composition
;
299 else if (VECTORP (components
) || CONSP (components
))
301 int len
= XVECTOR (key
)->size
;
303 /* The number of elements should be odd. */
305 goto invalid_composition
;
306 /* All elements should be integers (character or encoded
307 composition rule). */
308 for (i
= 0; i
< len
; i
++)
310 if (!INTEGERP (key_contents
[i
]))
311 goto invalid_composition
;
315 /* Change PROP from Form-A above to Form-B. We can directly modify
316 the cons cell of PROP because it is not shared. */
317 XSETFASTINT (id
, n_compositions
);
319 XSETCDR (prop
, Fcons (make_number (nchars
), Fcons (key
, XCDR (prop
))));
321 /* Register the composition in composition_hash_table. */
322 hash_index
= hash_put (hash_table
, key
, id
, hash_code
);
324 /* Register the composition in composition_table. */
325 cmp
= (struct composition
*) xmalloc (sizeof (struct composition
));
327 cmp
->method
= (NILP (components
)
328 ? COMPOSITION_RELATIVE
329 : ((INTEGERP (components
) || STRINGP (components
))
330 ? COMPOSITION_WITH_ALTCHARS
331 : COMPOSITION_WITH_RULE_ALTCHARS
));
332 cmp
->hash_index
= hash_index
;
333 glyph_len
= (cmp
->method
== COMPOSITION_WITH_RULE_ALTCHARS
334 ? (XVECTOR (key
)->size
+ 1) / 2
335 : XVECTOR (key
)->size
);
336 cmp
->glyph_len
= glyph_len
;
337 cmp
->offsets
= (short *) xmalloc (sizeof (short) * glyph_len
* 2);
340 if (cmp
->method
!= COMPOSITION_WITH_RULE_ALTCHARS
)
342 /* Relative composition. */
344 for (i
= 0; i
< glyph_len
; i
++)
347 ch
= XINT (key_contents
[i
]);
348 this_width
= (ch
== '\t' ? 1 : CHAR_WIDTH (ch
));
349 if (cmp
->width
< this_width
)
350 cmp
->width
= this_width
;
355 /* Rule-base composition. */
356 float leftmost
= 0.0, rightmost
;
358 ch
= XINT (key_contents
[0]);
359 rightmost
= ch
!= '\t' ? CHAR_WIDTH (ch
) : 1;
361 for (i
= 1; i
< glyph_len
; i
+= 2)
363 int rule
, gref
, nref
, xoff
, yoff
;
367 rule
= XINT (key_contents
[i
]);
368 ch
= XINT (key_contents
[i
+ 1]);
369 this_width
= ch
!= '\t' ? CHAR_WIDTH (ch
) : 1;
371 /* A composition rule is specified by an integer value
372 that encodes global and new reference points (GREF and
373 NREF). GREF and NREF are specified by numbers as
381 ---3---4---5--- baseline
385 COMPOSITION_DECODE_RULE (rule
, gref
, nref
, xoff
, yoff
);
386 this_left
= (leftmost
387 + (gref
% 3) * (rightmost
- leftmost
) / 2.0
388 - (nref
% 3) * this_width
/ 2.0);
390 if (this_left
< leftmost
)
391 leftmost
= this_left
;
392 if (this_left
+ this_width
> rightmost
)
393 rightmost
= this_left
+ this_width
;
396 cmp
->width
= rightmost
- leftmost
;
397 if (cmp
->width
< (rightmost
- leftmost
))
398 /* To get a ceiling integer value. */
402 composition_table
[n_compositions
] = cmp
;
404 return n_compositions
++;
407 /* Would it be better to remove this `composition' property? */
412 /* Find a static composition at or nearest to position POS of OBJECT
415 OBJECT defaults to the current buffer. If there's a composition at
416 POS, set *START and *END to the start and end of the sequence,
417 *PROP to the `composition' property, and return 1.
419 If there's no composition at POS and LIMIT is negative, return 0.
421 Otherwise, search for a composition forward (LIMIT > POS) or
422 backward (LIMIT < POS). In this case, LIMIT bounds the search.
424 If a composition is found, set *START, *END, and *PROP as above,
425 and return 1, else return 0.
427 This doesn't check the validity of composition. */
430 find_composition (int pos
, int limit
, EMACS_INT
*start
, EMACS_INT
*end
, Lisp_Object
*prop
, Lisp_Object object
)
434 if (get_property_and_range (pos
, Qcomposition
, prop
, start
, end
, object
))
437 if (limit
< 0 || limit
== pos
)
440 if (limit
> pos
) /* search forward */
442 val
= Fnext_single_property_change (make_number (pos
), Qcomposition
,
443 object
, make_number (limit
));
448 else /* search backward */
450 if (get_property_and_range (pos
- 1, Qcomposition
, prop
, start
, end
,
453 val
= Fprevious_single_property_change (make_number (pos
), Qcomposition
,
454 object
, make_number (limit
));
460 get_property_and_range (pos
, Qcomposition
, prop
, start
, end
, object
);
464 /* Run a proper function to adjust the composition sitting between
465 FROM and TO with property PROP. */
468 run_composition_function (int from
, int to
, Lisp_Object prop
)
471 EMACS_INT start
, end
;
473 func
= COMPOSITION_MODIFICATION_FUNC (prop
);
474 /* If an invalid composition precedes or follows, try to make them
477 && find_composition (from
- 1, -1, &start
, &end
, &prop
, Qnil
)
478 && !COMPOSITION_VALID_P (start
, end
, prop
))
481 && find_composition (to
, -1, &start
, &end
, &prop
, Qnil
)
482 && !COMPOSITION_VALID_P (start
, end
, prop
))
484 if (!NILP (Ffboundp (func
)))
485 call2 (func
, make_number (from
), make_number (to
));
488 /* Make invalid compositions adjacent to or inside FROM and TO valid.
489 CHECK_MASK is bitwise `or' of mask bits defined by macros
490 CHECK_XXX (see the comment in composite.h).
492 It also resets the text-property `auto-composed' to a proper region
493 so that automatic character composition works correctly later while
494 displaying the region.
496 This function is called when a buffer text is changed. If the
497 change is deletion, FROM == TO. Otherwise, FROM < TO. */
500 update_compositions (EMACS_INT from
, EMACS_INT to
, int check_mask
)
503 EMACS_INT start
, end
;
504 /* The beginning and end of the region to set the property
505 `auto-composed' to nil. */
506 EMACS_INT min_pos
= from
, max_pos
= to
;
508 if (inhibit_modification_hooks
)
511 /* If FROM and TO are not in a valid range, do nothing. */
512 if (! (BEGV
<= from
&& from
<= to
&& to
<= ZV
))
515 if (check_mask
& CHECK_HEAD
)
517 /* FROM should be at composition boundary. But, insertion or
518 deletion will make two compositions adjacent and
519 indistinguishable when they have same (eq) property. To
520 avoid it, in such a case, we change the property of the
521 latter to the copy of it. */
523 && find_composition (from
- 1, -1, &start
, &end
, &prop
, Qnil
)
524 && COMPOSITION_VALID_P (start
, end
, prop
))
530 Fput_text_property (make_number (from
), make_number (end
),
532 Fcons (XCAR (prop
), XCDR (prop
)), Qnil
);
533 run_composition_function (start
, end
, prop
);
537 && find_composition (from
, -1, &start
, &from
, &prop
, Qnil
)
538 && COMPOSITION_VALID_P (start
, from
, prop
))
542 run_composition_function (start
, from
, prop
);
546 if (check_mask
& CHECK_INSIDE
)
548 /* In this case, we are sure that (check & CHECK_TAIL) is also
549 nonzero. Thus, here we should check only compositions before
552 && find_composition (from
, to
, &start
, &from
, &prop
, Qnil
)
553 && COMPOSITION_VALID_P (start
, from
, prop
)
555 run_composition_function (start
, from
, prop
);
558 if (check_mask
& CHECK_TAIL
)
561 && find_composition (to
- 1, -1, &start
, &end
, &prop
, Qnil
)
562 && COMPOSITION_VALID_P (start
, end
, prop
))
564 /* TO should be also at composition boundary. But,
565 insertion or deletion will make two compositions adjacent
566 and indistinguishable when they have same (eq) property.
567 To avoid it, in such a case, we change the property of
568 the former to the copy of it. */
571 Fput_text_property (make_number (start
), make_number (to
),
573 Fcons (XCAR (prop
), XCDR (prop
)), Qnil
);
576 run_composition_function (start
, end
, prop
);
579 && find_composition (to
, -1, &start
, &end
, &prop
, Qnil
)
580 && COMPOSITION_VALID_P (start
, end
, prop
))
582 run_composition_function (start
, end
, prop
);
586 if (min_pos
< max_pos
)
588 int count
= SPECPDL_INDEX ();
590 specbind (Qinhibit_read_only
, Qt
);
591 specbind (Qinhibit_modification_hooks
, Qt
);
592 specbind (Qinhibit_point_motion_hooks
, Qt
);
593 Fremove_list_of_text_properties (make_number (min_pos
),
594 make_number (max_pos
),
595 Fcons (Qauto_composed
, Qnil
), Qnil
);
596 unbind_to (count
, Qnil
);
601 /* Modify composition property values in LIST destructively. LIST is
602 a list as returned from text_property_list. Change values to the
603 top-level copies of them so that none of them are `eq'. */
606 make_composition_value_copy (Lisp_Object list
)
608 Lisp_Object plist
, val
;
610 for (; CONSP (list
); list
= XCDR (list
))
612 plist
= XCAR (XCDR (XCDR (XCAR (list
))));
613 while (CONSP (plist
) && CONSP (XCDR (plist
)))
615 if (EQ (XCAR (plist
), Qcomposition
)
616 && (val
= XCAR (XCDR (plist
)), CONSP (val
)))
617 XSETCAR (XCDR (plist
), Fcons (XCAR (val
), XCDR (val
)));
618 plist
= XCDR (XCDR (plist
));
624 /* Make text in the region between START and END a composition that
625 has COMPONENTS and MODIFICATION-FUNC.
627 If STRING is non-nil, then operate on characters contained between
628 indices START and END in STRING. */
631 compose_text (int start
, int end
, Lisp_Object components
, Lisp_Object modification_func
, Lisp_Object string
)
635 prop
= Fcons (Fcons (make_number (end
- start
), components
),
637 Fput_text_property (make_number (start
), make_number (end
),
638 Qcomposition
, prop
, string
);
642 static Lisp_Object
autocmp_chars (Lisp_Object
, EMACS_INT
, EMACS_INT
,
643 EMACS_INT
, struct window
*,
644 struct face
*, Lisp_Object
);
647 /* Lisp glyph-string handlers */
649 /* Hash table for automatic composition. The key is a header of a
650 lgstring (Lispy glyph-string), and the value is a body of a
653 static Lisp_Object gstring_hash_table
;
655 static Lisp_Object
gstring_lookup_cache (Lisp_Object
);
658 gstring_lookup_cache (Lisp_Object header
)
660 struct Lisp_Hash_Table
*h
= XHASH_TABLE (gstring_hash_table
);
661 int i
= hash_lookup (h
, header
, NULL
);
663 return (i
>= 0 ? HASH_VALUE (h
, i
) : Qnil
);
667 composition_gstring_put_cache (Lisp_Object gstring
, int len
)
669 struct Lisp_Hash_Table
*h
= XHASH_TABLE (gstring_hash_table
);
671 Lisp_Object header
, copy
;
674 header
= LGSTRING_HEADER (gstring
);
675 hash
= h
->hashfn (h
, header
);
678 len
= LGSTRING_GLYPH_LEN (gstring
);
679 for (i
= 0; i
< len
; i
++)
680 if (NILP (LGSTRING_GLYPH (gstring
, i
)))
685 copy
= Fmake_vector (make_number (len
+ 2), Qnil
);
686 LGSTRING_SET_HEADER (copy
, Fcopy_sequence (header
));
687 for (i
= 0; i
< len
; i
++)
688 LGSTRING_SET_GLYPH (copy
, i
, Fcopy_sequence (LGSTRING_GLYPH (gstring
, i
)));
689 i
= hash_put (h
, LGSTRING_HEADER (copy
), copy
, hash
);
690 LGSTRING_SET_ID (copy
, make_number (i
));
695 composition_gstring_from_id (int id
)
697 struct Lisp_Hash_Table
*h
= XHASH_TABLE (gstring_hash_table
);
699 return HASH_VALUE (h
, id
);
702 static Lisp_Object
fill_gstring_header (Lisp_Object
, Lisp_Object
,
703 Lisp_Object
, Lisp_Object
,
707 composition_gstring_p (Lisp_Object gstring
)
712 if (! VECTORP (gstring
) || ASIZE (gstring
) < 2)
714 header
= LGSTRING_HEADER (gstring
);
715 if (! VECTORP (header
) || ASIZE (header
) < 2)
717 if (! NILP (LGSTRING_FONT (gstring
))
718 && (! FONT_OBJECT_P (LGSTRING_FONT (gstring
))
719 && ! CODING_SYSTEM_P (LGSTRING_FONT (gstring
))))
721 for (i
= 1; i
< ASIZE (LGSTRING_HEADER (gstring
)); i
++)
722 if (! NATNUMP (AREF (LGSTRING_HEADER (gstring
), i
)))
724 if (! NILP (LGSTRING_ID (gstring
)) && ! NATNUMP (LGSTRING_ID (gstring
)))
726 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
728 Lisp_Object glyph
= LGSTRING_GLYPH (gstring
, i
);
731 if (! VECTORP (glyph
) || ASIZE (glyph
) != LGLYPH_SIZE
)
738 composition_gstring_width (Lisp_Object gstring
, int from
, int to
, struct font_metrics
*metrics
)
745 Lisp_Object font_object
= LGSTRING_FONT (gstring
);
747 if (FONT_OBJECT_P (font_object
))
749 struct font
*font
= XFONT_OBJECT (font_object
);
751 metrics
->ascent
= font
->ascent
;
752 metrics
->descent
= font
->descent
;
757 metrics
->descent
= 0;
759 metrics
->width
= metrics
->lbearing
= metrics
->rbearing
= 0;
761 for (glyph
= &LGSTRING_GLYPH (gstring
, from
); from
< to
; from
++, glyph
++)
765 if (NILP (LGLYPH_ADJUSTMENT (*glyph
)))
766 width
+= LGLYPH_WIDTH (*glyph
);
768 width
+= LGLYPH_WADJUST (*glyph
);
771 x
= metrics
->width
+ LGLYPH_LBEARING (*glyph
) + LGLYPH_XOFF (*glyph
);
772 if (metrics
->lbearing
> x
)
773 metrics
->lbearing
= x
;
774 x
= metrics
->width
+ LGLYPH_RBEARING (*glyph
) + LGLYPH_XOFF (*glyph
);
775 if (metrics
->rbearing
< x
)
776 metrics
->rbearing
= x
;
777 metrics
->width
= width
;
778 x
= LGLYPH_ASCENT (*glyph
) - LGLYPH_YOFF (*glyph
);
779 if (metrics
->ascent
< x
)
781 x
= LGLYPH_DESCENT (*glyph
) + LGLYPH_YOFF (*glyph
);
782 if (metrics
->descent
< x
)
783 metrics
->descent
= x
;
790 static Lisp_Object gstring_work
;
791 static Lisp_Object gstring_work_headers
;
794 fill_gstring_header (Lisp_Object header
, Lisp_Object start
, Lisp_Object end
, Lisp_Object font_object
, Lisp_Object string
)
796 EMACS_INT from
, to
, from_byte
;
801 if (NILP (current_buffer
->enable_multibyte_characters
))
802 error ("Attempt to shape unibyte text");
803 validate_region (&start
, &end
);
804 from
= XFASTINT (start
);
806 from_byte
= CHAR_TO_BYTE (from
);
810 CHECK_STRING (string
);
811 if (! STRING_MULTIBYTE (string
))
812 error ("Attempt to shape unibyte text");
813 /* FROM and TO are checked by the caller. */
816 if (from
< 0 || from
> to
|| to
> SCHARS (string
))
817 args_out_of_range_3 (string
, start
, end
);
818 from_byte
= string_char_to_byte (string
, from
);
823 error ("Attempt to shape zero-length text");
824 if (VECTORP (header
))
826 if (ASIZE (header
) != len
+ 1)
827 args_out_of_range (header
, make_number (len
+ 1));
832 header
= AREF (gstring_work_headers
, len
- 1);
834 header
= Fmake_vector (make_number (len
+ 1), Qnil
);
837 ASET (header
, 0, font_object
);
838 for (i
= 0; i
< len
; i
++)
843 FETCH_CHAR_ADVANCE_NO_CHECK (c
, from
, from_byte
);
845 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, from
, from_byte
);
846 ASET (header
, i
+ 1, make_number (c
));
852 fill_gstring_body (Lisp_Object gstring
)
854 Lisp_Object font_object
= LGSTRING_FONT (gstring
);
855 Lisp_Object header
= AREF (gstring
, 0);
856 EMACS_INT len
= LGSTRING_CHAR_LEN (gstring
);
859 for (i
= 0; i
< len
; i
++)
861 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
862 EMACS_INT c
= XINT (AREF (header
, i
+ 1));
867 LGSTRING_SET_GLYPH (gstring
, i
, g
);
869 LGLYPH_SET_FROM (g
, i
);
870 LGLYPH_SET_TO (g
, i
);
871 LGLYPH_SET_CHAR (g
, c
);
872 if (FONT_OBJECT_P (font_object
))
874 font_fill_lglyph_metrics (g
, font_object
);
878 int width
= XFASTINT (CHAR_TABLE_REF (Vchar_width_table
, c
));
880 LGLYPH_SET_CODE (g
, c
);
881 LGLYPH_SET_LBEARING (g
, 0);
882 LGLYPH_SET_RBEARING (g
, width
);
883 LGLYPH_SET_WIDTH (g
, width
);
884 LGLYPH_SET_ASCENT (g
, 1);
885 LGLYPH_SET_DESCENT (g
, 0);
887 LGLYPH_SET_ADJUSTMENT (g
, Qnil
);
889 if (i
< LGSTRING_GLYPH_LEN (gstring
))
890 LGSTRING_SET_GLYPH (gstring
, i
, Qnil
);
894 /* Try to compose the characters at CHARPOS according to composition
895 rule RULE ([PATTERN PREV-CHARS FUNC]). LIMIT limits the characters
896 to compose. STRING, if not nil, is a target string. WIN is a
897 window where the characters are being displayed. If characters are
898 successfully composed, return the composition as a glyph-string
899 object. Otherwise return nil. */
902 autocmp_chars (Lisp_Object rule
, EMACS_INT charpos
, EMACS_INT bytepos
, EMACS_INT limit
, struct window
*win
, struct face
*face
, Lisp_Object string
)
904 int count
= SPECPDL_INDEX ();
905 FRAME_PTR f
= XFRAME (win
->frame
);
906 Lisp_Object pos
= make_number (charpos
);
908 EMACS_INT pt
= PT
, pt_byte
= PT_BYTE
;
909 Lisp_Object re
, font_object
, lgstring
;
912 record_unwind_save_match_data ();
916 else if (! STRINGP (re
))
917 return unbind_to (count
, Qnil
);
918 else if ((len
= fast_looking_at (re
, charpos
, bytepos
, limit
, -1, string
))
922 len
= BYTE_TO_CHAR (bytepos
+ len
) - charpos
;
924 len
= string_byte_to_char (string
, bytepos
+ len
) - charpos
;
927 return unbind_to (count
, Qnil
);
928 to
= limit
= charpos
+ len
;
929 #ifdef HAVE_WINDOW_SYSTEM
930 if (FRAME_WINDOW_P (f
))
932 font_object
= font_range (charpos
, &to
, win
, face
, string
);
933 if (! FONT_OBJECT_P (font_object
)
936 && (fast_looking_at (re
, charpos
, bytepos
, to
, -1, string
) <= 0)))
937 return unbind_to (count
, Qnil
);
940 #endif /* not HAVE_WINDOW_SYSTEM */
941 font_object
= win
->frame
;
942 lgstring
= Fcomposition_get_gstring (pos
, make_number (to
), font_object
,
944 if (NILP (LGSTRING_ID (lgstring
)))
948 /* Save point as marker before calling out to lisp. */
951 Lisp_Object m
= Fmake_marker ();
952 set_marker_both (m
, Qnil
, pt
, pt_byte
);
953 record_unwind_protect (restore_point_unwind
, m
);
956 args
[0] = Vauto_composition_function
;
957 args
[1] = AREF (rule
, 2);
959 args
[3] = make_number (to
);
960 args
[4] = font_object
;
962 lgstring
= safe_call (6, args
);
964 TEMP_SET_PT_BOTH (pt
, pt_byte
);
966 return unbind_to (count
, lgstring
);
969 static Lisp_Object _work_val
;
970 static int _work_char
;
972 /* 1 iff the character C is composable. Characters of general
973 category Z? or C? are not composable except for ZWNJ and ZWJ. */
975 #define CHAR_COMPOSABLE_P(C) \
976 ((C) == 0x200C || (C) == 0x200D \
977 || (_work_val = CHAR_TABLE_REF (Vunicode_category_table, (C)), \
978 (SYMBOLP (_work_val) \
979 && (_work_char = SDATA (SYMBOL_NAME (_work_val))[0]) != 'C' \
980 && _work_char != 'Z')))
982 /* Update cmp_it->stop_pos to the next position after CHARPOS (and
983 BYTEPOS) where character composition may happen. If BYTEPOS is
984 negative, compute it. ENDPOS is a limit of searching. If it is
985 less than CHARPOS, search backward to ENDPOS+1 assuming that
986 set_iterator_to_next works in reverse order. In this case, if a
987 composition closest to CHARPOS is found, set cmp_it->stop_pos to
988 the last character of the composition.
990 If no composition is found, set cmp_it->ch to -2. If a static
991 composition is found, set cmp_it->ch to -1. Otherwise, set
992 cmp_it->ch to the character that triggers the automatic
996 composition_compute_stop_pos (struct composition_it
*cmp_it
, EMACS_INT charpos
, EMACS_INT bytepos
, EMACS_INT endpos
, Lisp_Object string
)
998 EMACS_INT start
, end
, c
;
999 Lisp_Object prop
, val
;
1000 /* This is from forward_to_next_line_start in xdisp.c. */
1001 const int MAX_NEWLINE_DISTANCE
= 500;
1003 if (charpos
< endpos
)
1005 if (endpos
> charpos
+ MAX_NEWLINE_DISTANCE
)
1006 endpos
= charpos
+ MAX_NEWLINE_DISTANCE
;
1008 else if (endpos
< charpos
)
1010 /* We search backward for a position to check composition. */
1013 /* But we don't know where to stop the searching. */
1014 endpos
= NILP (string
) ? BEGV
- 1 : -1;
1015 /* Usually we don't reach ENDPOS because we stop searching
1016 at an uncomposable character (NL, LRE, etc). */
1021 cmp_it
->reversed_p
= 0;
1022 cmp_it
->stop_pos
= endpos
;
1023 if (charpos
== endpos
)
1025 /* FIXME: Bidi is not yet handled well in static composition. */
1026 if (charpos
< endpos
1027 && find_composition (charpos
, endpos
, &start
, &end
, &prop
, string
)
1028 && COMPOSITION_VALID_P (start
, end
, prop
))
1030 cmp_it
->stop_pos
= endpos
= start
;
1033 if (NILP (current_buffer
->enable_multibyte_characters
)
1034 || NILP (Vauto_composition_mode
))
1039 bytepos
= CHAR_TO_BYTE (charpos
);
1041 bytepos
= string_char_to_byte (string
, charpos
);
1045 if (charpos
< endpos
)
1047 /* Forward search. */
1048 while (charpos
< endpos
)
1050 if (STRINGP (string
))
1051 FETCH_STRING_CHAR_ADVANCE (c
, string
, charpos
, bytepos
);
1053 FETCH_CHAR_ADVANCE (c
, charpos
, bytepos
);
1059 val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1065 for (ridx
= 0; CONSP (val
); val
= XCDR (val
), ridx
++)
1068 if (VECTORP (elt
) && ASIZE (elt
) == 3
1069 && NATNUMP (AREF (elt
, 1))
1070 && charpos
- 1 - XFASTINT (AREF (elt
, 1)) >= start
)
1075 cmp_it
->rule_idx
= ridx
;
1076 cmp_it
->lookback
= XFASTINT (AREF (elt
, 1));
1077 cmp_it
->stop_pos
= charpos
- 1 - cmp_it
->lookback
;
1083 if (charpos
== endpos
)
1085 /* We couldn't find a composition point before ENDPOS. But,
1086 some character after ENDPOS may be composed with
1087 characters before ENDPOS. So, we should stop at the safe
1089 charpos
= endpos
- MAX_AUTO_COMPOSITION_LOOKBACK
;
1090 if (charpos
< start
)
1094 else if (charpos
> endpos
)
1096 /* Search backward for a pattern that may be composed and the
1097 position of (possibly) the last character of the match is
1098 closest to (but not after) START. The reason for the last
1099 character is that set_iterator_to_next works in reverse order,
1100 and thus we must stop at the last character for composition
1104 /* Limit byte position used in fast_looking_at. This is the
1105 byte position of the character after START. */
1109 p
= BYTE_POS_ADDR (bytepos
);
1111 p
= SDATA (string
) + bytepos
;
1112 c
= STRING_CHAR_AND_LENGTH (p
, len
);
1113 limit
= bytepos
+ len
;
1114 while (CHAR_COMPOSABLE_P (c
))
1116 val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1120 int ridx
, back
, len
;
1122 for (ridx
= 0; CONSP (val
); val
= XCDR (val
), ridx
++)
1125 if (VECTORP (elt
) && ASIZE (elt
) == 3
1126 && NATNUMP (AREF (elt
, 1))
1127 && charpos
- (back
= XFASTINT (AREF (elt
, 1))) > endpos
)
1129 EMACS_INT cpos
= charpos
- back
, bpos
;
1134 bpos
= (NILP (string
) ? CHAR_TO_BYTE (cpos
)
1135 : string_char_to_byte (string
, cpos
));
1136 if (STRINGP (AREF (elt
, 0)))
1137 len
= fast_looking_at (AREF (elt
, 0), cpos
, bpos
,
1138 start
+ 1, limit
, string
);
1143 /* Make CPOS point to the last character of
1144 match. Note that LEN is byte-length. */
1149 cpos
= BYTE_TO_CHAR (bpos
) - 1;
1151 cpos
= string_byte_to_char (string
, bpos
) - 1;
1153 back
= cpos
- (charpos
- back
);
1154 if (cmp_it
->stop_pos
< cpos
1155 || (cmp_it
->stop_pos
== cpos
1156 && cmp_it
->lookback
< back
))
1158 cmp_it
->rule_idx
= ridx
;
1159 cmp_it
->stop_pos
= cpos
;
1161 cmp_it
->lookback
= back
;
1162 cmp_it
->nchars
= back
+ 1;
1168 if (charpos
- 1 == endpos
)
1170 if (STRINGP (string
))
1173 while (! CHAR_HEAD_P (*p
))
1179 DEC_BOTH (charpos
, bytepos
);
1180 p
= BYTE_POS_ADDR (bytepos
);
1182 c
= STRING_CHAR (p
);
1184 if (cmp_it
->ch
>= 0)
1185 /* We found a position to check. */
1187 /* Skip all uncomposable characters. */
1190 while (charpos
- 1 > endpos
&& ! CHAR_COMPOSABLE_P (c
))
1192 DEC_BOTH (charpos
, bytepos
);
1193 c
= FETCH_MULTIBYTE_CHAR (bytepos
);
1198 while (charpos
- 1 > endpos
&& ! CHAR_COMPOSABLE_P (c
))
1201 while (! CHAR_HEAD_P (*p
))
1204 c
= STRING_CHAR (p
);
1208 cmp_it
->stop_pos
= charpos
;
1211 /* Check if the character at CHARPOS (and BYTEPOS) is composed
1212 (possibly with the following characters) on window W. ENDPOS limits
1213 characters to be composed. FACE, in non-NULL, is a base face of
1214 the character. If STRING is not nil, it is a string containing the
1215 character to check, and CHARPOS and BYTEPOS are indices in the
1216 string. In that case, FACE must not be NULL.
1218 If the character is composed, setup members of CMP_IT (id, nglyphs,
1219 from, to, reversed_p), and return 1. Otherwise, update
1220 CMP_IT->stop_pos, and return 0. */
1223 composition_reseat_it (struct composition_it
*cmp_it
, EMACS_INT charpos
, EMACS_INT bytepos
, EMACS_INT endpos
, struct window
*w
, struct face
*face
, Lisp_Object string
)
1226 endpos
= NILP (string
) ? BEGV
: 0;
1228 if (cmp_it
->ch
== -2)
1230 composition_compute_stop_pos (cmp_it
, charpos
, bytepos
, endpos
, string
);
1231 if (cmp_it
->ch
== -2 || cmp_it
->stop_pos
!= charpos
)
1232 /* The current position is not composed. */
1238 /* We are looking at a static composition. */
1239 EMACS_INT start
, end
;
1242 find_composition (charpos
, -1, &start
, &end
, &prop
, string
);
1243 cmp_it
->id
= get_composition_id (charpos
, bytepos
, end
- start
,
1246 goto no_composition
;
1247 cmp_it
->nchars
= end
- start
;
1248 cmp_it
->nglyphs
= composition_table
[cmp_it
->id
]->glyph_len
;
1252 Lisp_Object lgstring
= Qnil
;
1253 Lisp_Object val
, elt
, re
;
1256 val
= CHAR_TABLE_REF (Vcomposition_function_table
, cmp_it
->ch
);
1257 for (i
= 0; i
< cmp_it
->rule_idx
; i
++, val
= XCDR (val
));
1258 if (charpos
< endpos
)
1260 for (; CONSP (val
); val
= XCDR (val
))
1263 if (! VECTORP (elt
) || ASIZE (elt
) != 3
1264 || ! INTEGERP (AREF (elt
, 1)))
1266 if (XFASTINT (AREF (elt
, 1)) != cmp_it
->lookback
)
1267 goto no_composition
;
1268 lgstring
= autocmp_chars (elt
, charpos
, bytepos
, endpos
,
1270 if (composition_gstring_p (lgstring
))
1273 /* Composition failed perhaps because the font doesn't
1274 support sufficient range of characters. Try the
1275 other composition rules if any. */
1277 cmp_it
->reversed_p
= 0;
1281 EMACS_INT cpos
= charpos
, bpos
= bytepos
;
1286 if (cmp_it
->lookback
> 0)
1288 cpos
= charpos
- cmp_it
->lookback
;
1289 if (STRINGP (string
))
1290 bpos
= string_char_to_byte (string
, cpos
);
1292 bpos
= CHAR_TO_BYTE (cpos
);
1294 lgstring
= autocmp_chars (elt
, cpos
, bpos
, charpos
+ 1, w
, face
,
1296 if (composition_gstring_p (lgstring
)
1297 && cpos
+ LGSTRING_CHAR_LEN (lgstring
) - 1 == charpos
)
1299 /* Composition failed or didn't cover the current
1301 if (cmp_it
->lookback
== 0)
1302 goto no_composition
;
1304 /* Try to find a shorter compostion that starts after CPOS. */
1305 composition_compute_stop_pos (cmp_it
, charpos
, bytepos
, cpos
,
1307 if (cmp_it
->ch
== -2 || cmp_it
->stop_pos
< charpos
)
1308 goto no_composition
;
1309 val
= CHAR_TABLE_REF (Vcomposition_function_table
, cmp_it
->ch
);
1310 for (i
= 0; i
< cmp_it
->rule_idx
; i
++, val
= XCDR (val
));
1312 cmp_it
->reversed_p
= 1;
1314 if (NILP (lgstring
))
1315 goto no_composition
;
1316 if (NILP (LGSTRING_ID (lgstring
)))
1317 lgstring
= composition_gstring_put_cache (lgstring
, -1);
1318 cmp_it
->id
= XINT (LGSTRING_ID (lgstring
));
1319 for (i
= 0; i
< LGSTRING_GLYPH_LEN (lgstring
); i
++)
1320 if (NILP (LGSTRING_GLYPH (lgstring
, i
)))
1322 cmp_it
->nglyphs
= i
;
1327 goto no_composition
;
1331 if (charpos
== endpos
)
1333 if (charpos
< endpos
)
1339 bytepos
+= BYTES_BY_CHAR_HEAD (*(SDATA (string
) + bytepos
));
1344 /* BYTEPOS is calculated in composition_compute_stop_pos */
1347 composition_compute_stop_pos (cmp_it
, charpos
, bytepos
, endpos
, string
);
1351 /* Update charpos, nchars, nbytes, and width of the current grapheme
1354 If the composition is static or automatic in L2R context, the
1355 cluster is identified by CMP_IT->from, and CHARPOS is the position
1356 of the first character of the cluster. In this case, update
1359 If the composition is automatic in R2L context, the cluster is
1360 identified by CMP_IT->to, and CHARPOS is the position of the last
1361 character of the cluster. In this case, update CMP_IT->from too.
1363 The return value is the character code of the first character of
1364 the cluster, or -1 if the composition is somehow broken. */
1367 composition_update_it (struct composition_it
*cmp_it
, EMACS_INT charpos
, EMACS_INT bytepos
, Lisp_Object string
)
1373 /* static composition */
1374 struct composition
*cmp
= composition_table
[cmp_it
->id
];
1376 cmp_it
->charpos
= charpos
;
1377 cmp_it
->to
= cmp_it
->nglyphs
;
1378 if (cmp_it
->nglyphs
== 0)
1382 for (i
= 0; i
< cmp
->glyph_len
; i
++)
1383 if ((c
= COMPOSITION_GLYPH (cmp
, i
)) != '\t')
1388 cmp_it
->width
= cmp
->width
;
1389 charpos
+= cmp_it
->nchars
;
1390 if (STRINGP (string
))
1391 cmp_it
->nbytes
= string_char_to_byte (string
, charpos
) - bytepos
;
1393 cmp_it
->nbytes
= CHAR_TO_BYTE (charpos
) - bytepos
;
1397 /* automatic composition */
1398 Lisp_Object gstring
= composition_gstring_from_id (cmp_it
->id
);
1402 if (cmp_it
->nglyphs
== 0)
1404 cmp_it
->nchars
= LGSTRING_CHAR_LEN (gstring
);
1406 cmp_it
->from
= cmp_it
->to
= 0;
1409 if (! cmp_it
->reversed_p
)
1411 glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->from
);
1412 from
= LGLYPH_FROM (glyph
);
1413 for (cmp_it
->to
= cmp_it
->from
+ 1; cmp_it
->to
< cmp_it
->nglyphs
;
1416 glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->to
);
1417 if (LGLYPH_FROM (glyph
) != from
)
1420 cmp_it
->charpos
= charpos
;
1424 glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->to
- 1);
1425 from
= LGLYPH_FROM (glyph
);
1426 cmp_it
->charpos
= charpos
- (LGLYPH_TO (glyph
) - from
);
1427 for (cmp_it
->from
= cmp_it
->to
- 1; cmp_it
->from
> 0;
1430 glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->from
- 1);
1431 if (LGLYPH_FROM (glyph
) != from
)
1435 glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->from
);
1436 cmp_it
->nchars
= LGLYPH_TO (glyph
) + 1 - from
;
1439 for (i
= cmp_it
->nchars
- 1; i
>= 0; i
--)
1441 c
= XINT (LGSTRING_CHAR (gstring
, i
));
1442 cmp_it
->nbytes
+= CHAR_BYTES (c
);
1443 cmp_it
->width
+= CHAR_WIDTH (c
);
1450 struct position_record
1452 EMACS_INT pos
, pos_byte
;
1456 /* Update the members of POSITION to the next character boundary. */
1457 #define FORWARD_CHAR(POSITION, STOP) \
1460 if ((POSITION).pos == (STOP)) \
1462 (POSITION).p = GAP_END_ADDR; \
1463 (POSITION).pos_byte = GPT_BYTE; \
1467 (POSITION).pos_byte += BYTES_BY_CHAR_HEAD (*((POSITION).p)); \
1468 (POSITION).p += BYTES_BY_CHAR_HEAD (*((POSITION).p)); \
1472 /* Update the members of POSITION to the previous character boundary. */
1473 #define BACKWARD_CHAR(POSITION, STOP) \
1475 if ((POSITION).pos == STOP) \
1476 (POSITION).p = GPT_ADDR; \
1478 (POSITION).pos_byte--; \
1480 } while (! CHAR_HEAD_P (*((POSITION).p))); \
1484 /* This is like find_composition, but find an automatic composition
1485 instead. If found, set *GSTRING to the glyph-string representing
1486 the composition, and return 1. Otherwise, return 0. */
1489 find_automatic_composition (EMACS_INT pos
, EMACS_INT limit
, EMACS_INT
*start
, EMACS_INT
*end
, Lisp_Object
*gstring
, Lisp_Object string
)
1491 EMACS_INT head
, tail
, stop
;
1492 /* Limit to check a composition after POS. */
1493 EMACS_INT fore_check_limit
;
1494 struct position_record orig
, cur
, check
, prev
;
1495 Lisp_Object check_val
, val
, elt
;
1501 window
= Fget_buffer_window (Fcurrent_buffer (), Qnil
);
1504 w
= XWINDOW (window
);
1509 head
= BEGV
, tail
= ZV
, stop
= GPT
;
1510 orig
.pos_byte
= CHAR_TO_BYTE (orig
.pos
);
1511 orig
.p
= BYTE_POS_ADDR (orig
.pos_byte
);
1515 head
= 0, tail
= SCHARS (string
), stop
= -1;
1516 orig
.pos_byte
= string_char_to_byte (string
, orig
.pos
);
1517 orig
.p
= SDATA (string
) + orig
.pos_byte
;
1520 fore_check_limit
= min (tail
, pos
+ MAX_AUTO_COMPOSITION_LOOKBACK
);
1522 fore_check_limit
= min (tail
, limit
+ MAX_AUTO_COMPOSITION_LOOKBACK
);
1527 /* At first, check if POS is composable. */
1528 c
= STRING_CHAR (cur
.p
);
1529 if (! CHAR_COMPOSABLE_P (c
))
1533 if (limit
>= cur
.pos
)
1534 goto search_forward
;
1538 val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1540 check_val
= val
, check
= cur
;
1542 while (cur
.pos
+ 1 < fore_check_limit
)
1546 FORWARD_CHAR (cur
, stop
);
1547 if (get_property_and_range (cur
.pos
, Qcomposition
, &val
, &b
, &e
,
1549 && COMPOSITION_VALID_P (b
, e
, val
))
1551 fore_check_limit
= cur
.pos
;
1554 c
= STRING_CHAR (cur
.p
);
1555 if (! CHAR_COMPOSABLE_P (c
))
1557 val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1560 check_val
= val
, check
= cur
;
1565 /* Rewind back to the position where we can safely search forward
1566 for compositions. */
1567 while (cur
.pos
> head
)
1571 BACKWARD_CHAR (cur
, stop
);
1572 if (get_property_and_range (cur
.pos
, Qcomposition
, &val
, &b
, &e
, Qnil
)
1573 && COMPOSITION_VALID_P (b
, e
, val
))
1575 c
= STRING_CHAR (cur
.p
);
1576 if (! CHAR_COMPOSABLE_P (c
))
1578 val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1580 check_val
= val
, check
= cur
;
1583 /* Now search forward. */
1586 if (! NILP (check_val
) || limit
>= orig
.pos
)
1588 if (NILP (check_val
))
1592 while (cur
.pos
< fore_check_limit
)
1594 int need_adjustment
= 0;
1596 if (NILP (check_val
))
1598 c
= STRING_CHAR (cur
.p
);
1599 check_val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1601 for (; CONSP (check_val
); check_val
= XCDR (check_val
))
1603 elt
= XCAR (check_val
);
1604 if (VECTORP (elt
) && ASIZE (elt
) == 3 && NATNUMP (AREF (elt
, 1))
1605 && cur
.pos
- XFASTINT (AREF (elt
, 1)) >= head
)
1607 check
.pos
= cur
.pos
- XFASTINT (AREF (elt
, 1));
1608 if (check
.pos
== cur
.pos
)
1609 check
.pos_byte
= cur
.pos_byte
;
1611 check
.pos_byte
= CHAR_TO_BYTE (check
.pos
);
1612 val
= autocmp_chars (elt
, check
.pos
, check
.pos_byte
,
1613 tail
, w
, NULL
, string
);
1614 need_adjustment
= 1;
1619 *end
= check
.pos
+ LGSTRING_CHAR_LEN (*gstring
);
1620 if (*start
<= orig
.pos
? *end
> orig
.pos
1621 : limit
>= orig
.pos
)
1624 cur
.pos_byte
= CHAR_TO_BYTE (cur
.pos
);
1629 if (need_adjustment
)
1631 /* As we have called Lisp, there's a possibility that
1632 buffer/string is relocated. */
1634 cur
.p
= BYTE_POS_ADDR (cur
.pos_byte
);
1636 cur
.p
= SDATA (string
) + cur
.pos_byte
;
1638 if (! CONSP (check_val
))
1639 FORWARD_CHAR (cur
, stop
);
1643 if (! NILP (*gstring
))
1644 return (limit
>= 0 || (*start
<= orig
.pos
&& *end
> orig
.pos
));
1645 if (limit
>= 0 && limit
< orig
.pos
&& prev
.pos
> head
)
1648 BACKWARD_CHAR (cur
, stop
);
1650 fore_check_limit
= orig
.pos
;
1656 /* Return the adjusted point provided that point is moved from LAST_PT
1660 composition_adjust_point (EMACS_INT last_pt
, EMACS_INT new_pt
)
1662 EMACS_INT charpos
, bytepos
, startpos
, beg
, end
, pos
;
1666 if (new_pt
== BEGV
|| new_pt
== ZV
)
1669 /* At first check the static composition. */
1670 if (get_property_and_range (new_pt
, Qcomposition
, &val
, &beg
, &end
, Qnil
)
1671 && COMPOSITION_VALID_P (beg
, end
, val
))
1673 if (beg
< new_pt
/* && end > new_pt <- It's always the case. */
1674 && (last_pt
<= beg
|| last_pt
>= end
))
1675 return (new_pt
< last_pt
? beg
: end
);
1679 if (NILP (current_buffer
->enable_multibyte_characters
)
1680 || NILP (Vauto_composition_mode
))
1683 /* Next check the automatic composition. */
1684 if (! find_automatic_composition (new_pt
, (EMACS_INT
) -1, &beg
, &end
, &val
,
1688 for (i
= 0; i
< LGSTRING_GLYPH_LEN (val
); i
++)
1690 Lisp_Object glyph
= LGSTRING_GLYPH (val
, i
);
1694 if (beg
+ LGLYPH_FROM (glyph
) == new_pt
)
1696 if (beg
+ LGLYPH_TO (glyph
) >= new_pt
)
1697 return (new_pt
< last_pt
1698 ? beg
+ LGLYPH_FROM (glyph
)
1699 : beg
+ LGLYPH_TO (glyph
) + 1);
1704 DEFUN ("composition-get-gstring", Fcomposition_get_gstring
,
1705 Scomposition_get_gstring
, 4, 4, 0,
1706 doc
: /* Return a glyph-string for characters between FROM and TO.
1707 If the glyph string is for graphic display, FONT-OBJECT must be
1708 a font-object to use for those characters.
1709 Otherwise (for terminal display), FONT-OBJECT must be a terminal ID, a
1710 frame, or nil for the selected frame's terminal device.
1712 If the optional 4th argument STRING is not nil, it is a string
1713 containing the target characters between indices FROM and TO.
1715 A glyph-string is a vector containing information about how to display
1716 a specific character sequence. The format is:
1717 [HEADER ID GLYPH ...]
1719 HEADER is a vector of this form:
1720 [FONT-OBJECT CHAR ...]
1722 FONT-OBJECT is a font-object for all glyphs in the glyph-string,
1723 or the terminal coding system of the specified terminal.
1724 CHARs are characters to be composed by GLYPHs.
1726 ID is an identification number of the glyph-string. It may be nil if
1729 GLYPH is a vector whose elements have this form:
1730 [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT
1731 [ [X-OFF Y-OFF WADJUST] | nil] ]
1733 FROM-IDX and TO-IDX are used internally and should not be touched.
1734 C is the character of the glyph.
1735 CODE is the glyph-code of C in FONT-OBJECT.
1736 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
1737 X-OFF and Y-OFF are offsets to the base position for the glyph.
1738 WADJUST is the adjustment to the normal width of the glyph.
1740 If GLYPH is nil, the remaining elements of the glyph-string vector
1741 should be ignored. */)
1742 (Lisp_Object from
, Lisp_Object to
, Lisp_Object font_object
, Lisp_Object string
)
1744 Lisp_Object gstring
, header
;
1745 EMACS_INT frompos
, topos
;
1747 CHECK_NATNUM (from
);
1749 if (! FONT_OBJECT_P (font_object
))
1751 struct coding_system
*coding
;
1752 struct terminal
*terminal
= get_terminal (font_object
, 1);
1754 coding
= ((TERMINAL_TERMINAL_CODING (terminal
)->common_flags
1755 & CODING_REQUIRE_ENCODING_MASK
)
1756 ? TERMINAL_TERMINAL_CODING (terminal
) : &safe_terminal_coding
);
1757 font_object
= CODING_ID_NAME (coding
->id
);
1760 header
= fill_gstring_header (Qnil
, from
, to
, font_object
, string
);
1761 gstring
= gstring_lookup_cache (header
);
1762 if (! NILP (gstring
))
1765 frompos
= XINT (from
);
1767 if (LGSTRING_GLYPH_LEN (gstring_work
) < topos
- frompos
)
1768 gstring_work
= Fmake_vector (make_number (topos
- frompos
+ 2), Qnil
);
1769 LGSTRING_SET_HEADER (gstring_work
, header
);
1770 LGSTRING_SET_ID (gstring_work
, Qnil
);
1771 fill_gstring_body (gstring_work
);
1772 return gstring_work
;
1776 /* Emacs Lisp APIs. */
1778 DEFUN ("compose-region-internal", Fcompose_region_internal
,
1779 Scompose_region_internal
, 2, 4, 0,
1780 doc
: /* Internal use only.
1782 Compose text in the region between START and END.
1783 Optional 3rd and 4th arguments are COMPONENTS and MODIFICATION-FUNC
1784 for the composition. See `compose-region' for more details. */)
1785 (Lisp_Object start
, Lisp_Object end
, Lisp_Object components
, Lisp_Object modification_func
)
1787 validate_region (&start
, &end
);
1788 if (!NILP (components
)
1789 && !INTEGERP (components
)
1790 && !CONSP (components
)
1791 && !STRINGP (components
))
1792 CHECK_VECTOR (components
);
1794 compose_text (XINT (start
), XINT (end
), components
, modification_func
, Qnil
);
1798 DEFUN ("compose-string-internal", Fcompose_string_internal
,
1799 Scompose_string_internal
, 3, 5, 0,
1800 doc
: /* Internal use only.
1802 Compose text between indices START and END of STRING.
1803 Optional 4th and 5th arguments are COMPONENTS and MODIFICATION-FUNC
1804 for the composition. See `compose-string' for more details. */)
1805 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
, Lisp_Object components
, Lisp_Object modification_func
)
1807 CHECK_STRING (string
);
1808 CHECK_NUMBER (start
);
1811 if (XINT (start
) < 0 ||
1812 XINT (start
) > XINT (end
)
1813 || XINT (end
) > SCHARS (string
))
1814 args_out_of_range (start
, end
);
1816 compose_text (XINT (start
), XINT (end
), components
, modification_func
, string
);
1820 DEFUN ("find-composition-internal", Ffind_composition_internal
,
1821 Sfind_composition_internal
, 4, 4, 0,
1822 doc
: /* Internal use only.
1824 Return information about composition at or nearest to position POS.
1825 See `find-composition' for more details. */)
1826 (Lisp_Object pos
, Lisp_Object limit
, Lisp_Object string
, Lisp_Object detail_p
)
1828 Lisp_Object prop
, tail
, gstring
;
1829 EMACS_INT start
, end
, from
, to
;
1832 CHECK_NUMBER_COERCE_MARKER (pos
);
1836 CHECK_NUMBER_COERCE_MARKER (limit
);
1844 CHECK_STRING (string
);
1845 if (XINT (pos
) < 0 || XINT (pos
) > SCHARS (string
))
1846 args_out_of_range (string
, pos
);
1850 if (XINT (pos
) < BEGV
|| XINT (pos
) > ZV
)
1851 args_out_of_range (Fcurrent_buffer (), pos
);
1854 if (!find_composition (from
, to
, &start
, &end
, &prop
, string
))
1856 if (!NILP (current_buffer
->enable_multibyte_characters
)
1857 && ! NILP (Vauto_composition_mode
)
1858 && find_automatic_composition (from
, to
, &start
, &end
, &gstring
,
1860 return list3 (make_number (start
), make_number (end
), gstring
);
1863 if ((end
<= XINT (pos
) || start
> XINT (pos
)))
1867 if (find_automatic_composition (from
, to
, &s
, &e
, &gstring
, string
)
1868 && (e
<= XINT (pos
) ? e
> end
: s
< start
))
1869 return list3 (make_number (s
), make_number (e
), gstring
);
1871 if (!COMPOSITION_VALID_P (start
, end
, prop
))
1872 return Fcons (make_number (start
), Fcons (make_number (end
),
1873 Fcons (Qnil
, Qnil
)));
1874 if (NILP (detail_p
))
1875 return Fcons (make_number (start
), Fcons (make_number (end
),
1878 if (COMPOSITION_REGISTERD_P (prop
))
1879 id
= COMPOSITION_ID (prop
);
1882 int start_byte
= (NILP (string
)
1883 ? CHAR_TO_BYTE (start
)
1884 : string_char_to_byte (string
, start
));
1885 id
= get_composition_id (start
, start_byte
, end
- start
, prop
, string
);
1890 Lisp_Object components
, relative_p
, mod_func
;
1891 enum composition_method method
= COMPOSITION_METHOD (prop
);
1892 int width
= composition_table
[id
]->width
;
1894 components
= Fcopy_sequence (COMPOSITION_COMPONENTS (prop
));
1895 relative_p
= (method
== COMPOSITION_WITH_RULE_ALTCHARS
1897 mod_func
= COMPOSITION_MODIFICATION_FUNC (prop
);
1898 tail
= Fcons (components
,
1901 Fcons (make_number (width
), Qnil
))));
1906 return Fcons (make_number (start
), Fcons (make_number (end
), tail
));
1911 syms_of_composite (void)
1915 Qcomposition
= intern_c_string ("composition");
1916 staticpro (&Qcomposition
);
1918 /* Make a hash table for static composition. */
1920 Lisp_Object args
[6];
1924 args
[2] = QCweakness
;
1925 /* We used to make the hash table weak so that unreferenced
1926 compositions can be garbage-collected. But, usually once
1927 created compositions are repeatedly used in an Emacs session,
1928 and thus it's not worth to save memory in such a way. So, we
1929 make the table not weak. */
1932 args
[5] = make_number (311);
1933 composition_hash_table
= Fmake_hash_table (6, args
);
1934 staticpro (&composition_hash_table
);
1937 /* Make a hash table for glyph-string. */
1939 Lisp_Object args
[6];
1942 args
[2] = QCweakness
;
1945 args
[5] = make_number (311);
1946 gstring_hash_table
= Fmake_hash_table (6, args
);
1947 staticpro (&gstring_hash_table
);
1950 staticpro (&gstring_work_headers
);
1951 gstring_work_headers
= Fmake_vector (make_number (8), Qnil
);
1952 for (i
= 0; i
< 8; i
++)
1953 ASET (gstring_work_headers
, i
, Fmake_vector (make_number (i
+ 2), Qnil
));
1954 staticpro (&gstring_work
);
1955 gstring_work
= Fmake_vector (make_number (10), Qnil
);
1957 /* Text property `composition' should be nonsticky by default. */
1958 Vtext_property_default_nonsticky
1959 = Fcons (Fcons (Qcomposition
, Qt
), Vtext_property_default_nonsticky
);
1961 DEFVAR_LISP ("compose-chars-after-function", &Vcompose_chars_after_function
,
1962 doc
: /* Function to adjust composition of buffer text.
1964 This function is called with three arguments: FROM, TO, and OBJECT.
1965 FROM and TO specify the range of text whose composition should be
1966 adjusted. OBJECT, if non-nil, is a string that contains the text.
1968 This function is called after a text with `composition' property is
1969 inserted or deleted to keep `composition' property of buffer text
1972 The default value is the function `compose-chars-after'. */);
1973 Vcompose_chars_after_function
= intern_c_string ("compose-chars-after");
1975 Qauto_composed
= intern_c_string ("auto-composed");
1976 staticpro (&Qauto_composed
);
1978 Qauto_composition_function
= intern_c_string ("auto-composition-function");
1979 staticpro (&Qauto_composition_function
);
1981 DEFVAR_LISP ("auto-composition-mode", &Vauto_composition_mode
,
1982 doc
: /* Non-nil if Auto-Composition mode is enabled.
1983 Use the command `auto-composition-mode' to change this variable. */);
1984 Vauto_composition_mode
= Qt
;
1986 DEFVAR_LISP ("auto-composition-function", &Vauto_composition_function
,
1987 doc
: /* Function to call to compose characters automatically.
1988 This function is called from the display routine with four arguments:
1989 FROM, TO, WINDOW, and STRING.
1991 If STRING is nil, the function must compose characters in the region
1992 between FROM and TO in the current buffer.
1994 Otherwise, STRING is a string, and FROM and TO are indices into the
1995 string. In this case, the function must compose characters in the
1997 Vauto_composition_function
= Qnil
;
1999 DEFVAR_LISP ("composition-function-table", &Vcomposition_function_table
,
2000 doc
: /* Char-table of functions for automatic character composition.
2001 For each character that has to be composed automatically with
2002 preceding and/or following characters, this char-table contains
2003 a function to call to compose that character.
2005 The element at index C in the table, if non-nil, is a list of
2006 composition rules of this form: ([PATTERN PREV-CHARS FUNC] ...)
2008 PATTERN is a regular expression which C and the surrounding
2009 characters must match.
2011 PREV-CHARS is a non-negative integer (less than 4) specifying how many
2012 characters before C to check the matching with PATTERN. If it is 0,
2013 PATTERN must match C and the following characters. If it is 1,
2014 PATTERN must match a character before C and the following characters.
2016 If PREV-CHARS is 0, PATTERN can be nil, which means that the
2017 single character C should be composed.
2019 FUNC is a function to return a glyph-string representing a
2020 composition of the characters that match PATTERN. It is
2021 called with one argument GSTRING.
2023 GSTRING is a template of a glyph-string to return. It is already
2024 filled with a proper header for the characters to compose, and
2025 glyphs corresponding to those characters one by one. The
2026 function must return a new glyph-string with the same header as
2027 GSTRING, or modify GSTRING itself and return it.
2029 See also the documentation of `auto-composition-mode'. */);
2030 Vcomposition_function_table
= Fmake_char_table (Qnil
, Qnil
);
2032 defsubr (&Scompose_region_internal
);
2033 defsubr (&Scompose_string_internal
);
2034 defsubr (&Sfind_composition_internal
);
2035 defsubr (&Scomposition_get_gstring
);
2038 /* arch-tag: 79cefaf8-ca48-4eed-97e5-d5afb290d272
2039 (do not change this comment) */