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
));
851 extern void font_fill_lglyph_metrics (Lisp_Object
, Lisp_Object
);
854 fill_gstring_body (Lisp_Object gstring
)
856 Lisp_Object font_object
= LGSTRING_FONT (gstring
);
857 Lisp_Object header
= AREF (gstring
, 0);
858 EMACS_INT len
= LGSTRING_CHAR_LEN (gstring
);
861 for (i
= 0; i
< len
; i
++)
863 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
864 EMACS_INT c
= XINT (AREF (header
, i
+ 1));
869 LGSTRING_SET_GLYPH (gstring
, i
, g
);
871 LGLYPH_SET_FROM (g
, i
);
872 LGLYPH_SET_TO (g
, i
);
873 LGLYPH_SET_CHAR (g
, c
);
874 if (FONT_OBJECT_P (font_object
))
876 font_fill_lglyph_metrics (g
, font_object
);
880 int width
= XFASTINT (CHAR_TABLE_REF (Vchar_width_table
, c
));
882 LGLYPH_SET_CODE (g
, c
);
883 LGLYPH_SET_LBEARING (g
, 0);
884 LGLYPH_SET_RBEARING (g
, width
);
885 LGLYPH_SET_WIDTH (g
, width
);
886 LGLYPH_SET_ASCENT (g
, 1);
887 LGLYPH_SET_DESCENT (g
, 0);
889 LGLYPH_SET_ADJUSTMENT (g
, Qnil
);
891 if (i
< LGSTRING_GLYPH_LEN (gstring
))
892 LGSTRING_SET_GLYPH (gstring
, i
, Qnil
);
896 /* Try to compose the characters at CHARPOS according to composition
897 rule RULE ([PATTERN PREV-CHARS FUNC]). LIMIT limits the characters
898 to compose. STRING, if not nil, is a target string. WIN is a
899 window where the characters are being displayed. If characters are
900 successfully composed, return the composition as a glyph-string
901 object. Otherwise return nil. */
904 autocmp_chars (Lisp_Object rule
, EMACS_INT charpos
, EMACS_INT bytepos
, EMACS_INT limit
, struct window
*win
, struct face
*face
, Lisp_Object string
)
906 int count
= SPECPDL_INDEX ();
907 FRAME_PTR f
= XFRAME (win
->frame
);
908 Lisp_Object pos
= make_number (charpos
);
910 EMACS_INT pt
= PT
, pt_byte
= PT_BYTE
;
911 Lisp_Object re
, font_object
, lgstring
;
914 record_unwind_save_match_data ();
918 else if (! STRINGP (re
))
919 return unbind_to (count
, Qnil
);
920 else if ((len
= fast_looking_at (re
, charpos
, bytepos
, limit
, -1, string
))
924 len
= BYTE_TO_CHAR (bytepos
+ len
) - charpos
;
926 len
= string_byte_to_char (string
, bytepos
+ len
) - charpos
;
929 return unbind_to (count
, Qnil
);
930 to
= limit
= charpos
+ len
;
931 #ifdef HAVE_WINDOW_SYSTEM
932 if (FRAME_WINDOW_P (f
))
934 font_object
= font_range (charpos
, &to
, win
, face
, string
);
935 if (! FONT_OBJECT_P (font_object
)
938 && (fast_looking_at (re
, charpos
, bytepos
, to
, -1, string
) <= 0)))
939 return unbind_to (count
, Qnil
);
942 #endif /* not HAVE_WINDOW_SYSTEM */
943 font_object
= win
->frame
;
944 lgstring
= Fcomposition_get_gstring (pos
, make_number (to
), font_object
,
946 if (NILP (LGSTRING_ID (lgstring
)))
950 /* Save point as marker before calling out to lisp. */
953 Lisp_Object m
= Fmake_marker ();
954 set_marker_both (m
, Qnil
, pt
, pt_byte
);
955 record_unwind_protect (restore_point_unwind
, m
);
958 args
[0] = Vauto_composition_function
;
959 args
[1] = AREF (rule
, 2);
961 args
[3] = make_number (to
);
962 args
[4] = font_object
;
964 lgstring
= safe_call (6, args
);
966 TEMP_SET_PT_BOTH (pt
, pt_byte
);
968 return unbind_to (count
, lgstring
);
971 static Lisp_Object _work_val
;
972 static int _work_char
;
974 /* 1 iff the character C is composable. */
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
;
1035 /* A composition never strides over PT. */
1039 cmp_it
->stop_pos
= endpos
= PT
;
1041 else if (PT
< charpos
&& PT
> endpos
)
1043 cmp_it
->stop_pos
= endpos
= PT
- 1;
1046 if (NILP (current_buffer
->enable_multibyte_characters
)
1047 || NILP (Vauto_composition_mode
))
1052 bytepos
= CHAR_TO_BYTE (charpos
);
1054 bytepos
= string_char_to_byte (string
, charpos
);
1058 if (charpos
< endpos
)
1060 /* Forward search. */
1061 while (charpos
< endpos
)
1063 if (STRINGP (string
))
1064 FETCH_STRING_CHAR_ADVANCE (c
, string
, charpos
, bytepos
);
1066 FETCH_CHAR_ADVANCE (c
, charpos
, bytepos
);
1072 val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1078 for (ridx
= 0; CONSP (val
); val
= XCDR (val
), ridx
++)
1081 if (VECTORP (elt
) && ASIZE (elt
) == 3
1082 && NATNUMP (AREF (elt
, 1))
1083 && charpos
- 1 - XFASTINT (AREF (elt
, 1)) >= start
)
1088 cmp_it
->rule_idx
= ridx
;
1089 cmp_it
->lookback
= XFASTINT (AREF (elt
, 1));
1090 cmp_it
->stop_pos
= charpos
- 1 - cmp_it
->lookback
;
1097 else if (charpos
> endpos
)
1099 /* Search backward for a pattern that may be composed and the
1100 position of (possibly) the last character of the match is
1101 closest to (but not after) START. The reason for the last
1102 character is that set_iterator_to_next works in reverse order,
1103 and thus we must stop at the last character for composition
1107 /* Limit byte position used in fast_looking_at. This is the
1108 byte position of the character after START. */
1112 p
= BYTE_POS_ADDR (bytepos
);
1114 p
= SDATA (string
) + bytepos
;
1115 c
= STRING_CHAR_AND_LENGTH (p
, len
);
1116 limit
= bytepos
+ len
;
1117 while (CHAR_COMPOSABLE_P (c
))
1119 val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1123 int ridx
, back
, len
;
1125 for (ridx
= 0; CONSP (val
); val
= XCDR (val
), ridx
++)
1128 if (VECTORP (elt
) && ASIZE (elt
) == 3
1129 && NATNUMP (AREF (elt
, 1))
1130 && charpos
- (back
= XFASTINT (AREF (elt
, 1))) > endpos
)
1132 EMACS_INT cpos
= charpos
- back
, bpos
;
1137 bpos
= (NILP (string
) ? CHAR_TO_BYTE (cpos
)
1138 : string_char_to_byte (string
, cpos
));
1139 if (STRINGP (AREF (elt
, 0)))
1140 len
= fast_looking_at (AREF (elt
, 0), cpos
, bpos
,
1141 start
+ 1, limit
, string
);
1146 /* Make CPOS point to the last character of
1147 match. Note that LEN is byte-length. */
1152 cpos
= BYTE_TO_CHAR (bpos
) - 1;
1154 cpos
= string_byte_to_char (string
, bpos
) - 1;
1156 back
= cpos
- (charpos
- back
);
1157 if (cmp_it
->stop_pos
< cpos
1158 || (cmp_it
->stop_pos
== cpos
1159 && cmp_it
->lookback
< back
))
1161 cmp_it
->rule_idx
= ridx
;
1162 cmp_it
->stop_pos
= cpos
;
1164 cmp_it
->lookback
= back
;
1165 cmp_it
->nchars
= back
+ 1;
1171 if (charpos
- 1 == endpos
)
1173 if (STRINGP (string
))
1176 while (! CHAR_HEAD_P (*p
))
1182 DEC_BOTH (charpos
, bytepos
);
1183 p
= BYTE_POS_ADDR (bytepos
);
1185 c
= STRING_CHAR (p
);
1187 if (cmp_it
->ch
>= 0)
1188 /* We found a position to check. */
1190 /* Skip all uncomposable characters. */
1193 while (charpos
- 1 > endpos
&& ! CHAR_COMPOSABLE_P (c
))
1195 DEC_BOTH (charpos
, bytepos
);
1196 c
= FETCH_MULTIBYTE_CHAR (bytepos
);
1201 while (charpos
- 1 > endpos
&& ! CHAR_COMPOSABLE_P (c
))
1204 while (! CHAR_HEAD_P (*p
))
1207 c
= STRING_CHAR (p
);
1211 cmp_it
->stop_pos
= charpos
;
1214 /* Check if the character at CHARPOS (and BYTEPOS) is composed
1215 (possibly with the following characters) on window W. ENDPOS limits
1216 characters to be composed. FACE, in non-NULL, is a base face of
1217 the character. If STRING is not nil, it is a string containing the
1218 character to check, and CHARPOS and BYTEPOS are indices in the
1219 string. In that case, FACE must not be NULL.
1221 If the character is composed, setup members of CMP_IT (id, nglyphs,
1222 from, to, reversed_p), and return 1. Otherwise, update
1223 CMP_IT->stop_pos, and return 0. */
1226 composition_reseat_it (struct composition_it
*cmp_it
, EMACS_INT charpos
, EMACS_INT bytepos
, EMACS_INT endpos
, struct window
*w
, struct face
*face
, Lisp_Object string
)
1228 if (endpos
<= charpos
)
1234 if (endpos
< PT
&& PT
< charpos
)
1237 else if (endpos
< 0)
1242 if (NILP (string
) && charpos
< PT
&& PT
< endpos
)
1246 if (cmp_it
->ch
== -2)
1248 composition_compute_stop_pos (cmp_it
, charpos
, bytepos
, endpos
, string
);
1249 if (cmp_it
->ch
== -2 || cmp_it
->stop_pos
!= charpos
)
1250 /* The current position is not composed. */
1256 /* We are looking at a static composition. */
1257 EMACS_INT start
, end
;
1260 find_composition (charpos
, -1, &start
, &end
, &prop
, string
);
1261 cmp_it
->id
= get_composition_id (charpos
, bytepos
, end
- start
,
1264 goto no_composition
;
1265 cmp_it
->nchars
= end
- start
;
1266 cmp_it
->nglyphs
= composition_table
[cmp_it
->id
]->glyph_len
;
1270 Lisp_Object lgstring
= Qnil
;
1271 Lisp_Object val
, elt
, re
;
1274 val
= CHAR_TABLE_REF (Vcomposition_function_table
, cmp_it
->ch
);
1275 for (i
= 0; i
< cmp_it
->rule_idx
; i
++, val
= XCDR (val
));
1276 if (charpos
< endpos
)
1278 for (; CONSP (val
); val
= XCDR (val
))
1281 if (! VECTORP (elt
) || ASIZE (elt
) != 3
1282 || ! INTEGERP (AREF (elt
, 1)))
1284 if (XFASTINT (AREF (elt
, 1)) != cmp_it
->lookback
)
1285 goto no_composition
;
1286 lgstring
= autocmp_chars (elt
, charpos
, bytepos
, endpos
,
1288 if (composition_gstring_p (lgstring
))
1291 /* Composition failed perhaps because the font doesn't
1292 support sufficient range of characters. Try the
1293 other composition rules if any. */
1295 cmp_it
->reversed_p
= 0;
1299 EMACS_INT cpos
= charpos
, bpos
= bytepos
;
1304 if (cmp_it
->lookback
> 0)
1306 cpos
-= cmp_it
->lookback
;
1307 if (STRINGP (string
))
1308 bpos
= string_char_to_byte (string
, cpos
);
1310 bpos
= CHAR_TO_BYTE (cpos
);
1312 lgstring
= autocmp_chars (elt
, cpos
, bpos
, charpos
+ 1, w
, face
,
1314 if (composition_gstring_p (lgstring
)
1315 && cpos
+ LGSTRING_CHAR_LEN (lgstring
) - 1 == charpos
)
1317 /* Composition failed or didn't cover the current
1319 if (cmp_it
->lookback
== 0)
1320 goto no_composition
;
1322 /* Try to find a shorter compostion that starts after CPOS. */
1323 composition_compute_stop_pos (cmp_it
, charpos
, bytepos
, cpos
,
1325 if (cmp_it
->ch
== -2 || cmp_it
->stop_pos
< charpos
)
1326 goto no_composition
;
1327 val
= CHAR_TABLE_REF (Vcomposition_function_table
, cmp_it
->ch
);
1328 for (i
= 0; i
< cmp_it
->rule_idx
; i
++, val
= XCDR (val
));
1330 cmp_it
->reversed_p
= 1;
1332 if (NILP (lgstring
))
1333 goto no_composition
;
1334 if (NILP (LGSTRING_ID (lgstring
)))
1335 lgstring
= composition_gstring_put_cache (lgstring
, -1);
1336 cmp_it
->id
= XINT (LGSTRING_ID (lgstring
));
1337 for (i
= 0; i
< LGSTRING_GLYPH_LEN (lgstring
); i
++)
1338 if (NILP (LGSTRING_GLYPH (lgstring
, i
)))
1340 cmp_it
->nglyphs
= i
;
1345 goto no_composition
;
1349 if (charpos
== endpos
)
1351 if (charpos
< endpos
)
1357 bytepos
+= BYTES_BY_CHAR_HEAD (*(SDATA (string
) + bytepos
));
1362 /* BYTEPOS is calculated in composition_compute_stop_pos */
1365 composition_compute_stop_pos (cmp_it
, charpos
, bytepos
, endpos
, string
);
1369 /* Update charpos, nchars, nbytes, and width of the current grapheme
1372 If the composition is static or automatic in L2R context, the
1373 cluster is identified by CMP_IT->from, and CHARPOS is the position
1374 of the first character of the cluster. In this case, update
1377 If the composition is automatic in R2L context, the cluster is
1378 identified by CMP_IT->to, and CHARPOS is the position of the last
1379 character of the cluster. In this case, update CMP_IT->from too.
1381 The return value is the character code of the first character of
1382 the cluster, or -1 if the composition is somehow broken. */
1385 composition_update_it (struct composition_it
*cmp_it
, EMACS_INT charpos
, EMACS_INT bytepos
, Lisp_Object string
)
1391 /* static composition */
1392 struct composition
*cmp
= composition_table
[cmp_it
->id
];
1394 cmp_it
->charpos
= charpos
;
1395 cmp_it
->to
= cmp_it
->nglyphs
;
1396 if (cmp_it
->nglyphs
== 0)
1400 for (i
= 0; i
< cmp
->glyph_len
; i
++)
1401 if ((c
= COMPOSITION_GLYPH (cmp
, i
)) != '\t')
1406 cmp_it
->width
= cmp
->width
;
1407 charpos
+= cmp_it
->nchars
;
1408 if (STRINGP (string
))
1409 cmp_it
->nbytes
= string_char_to_byte (string
, charpos
) - bytepos
;
1411 cmp_it
->nbytes
= CHAR_TO_BYTE (charpos
) - bytepos
;
1415 /* automatic composition */
1416 Lisp_Object gstring
= composition_gstring_from_id (cmp_it
->id
);
1420 if (cmp_it
->nglyphs
== 0)
1422 cmp_it
->nchars
= LGSTRING_CHAR_LEN (gstring
);
1424 cmp_it
->from
= cmp_it
->to
= 0;
1427 if (! cmp_it
->reversed_p
)
1429 glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->from
);
1430 from
= LGLYPH_FROM (glyph
);
1431 for (cmp_it
->to
= cmp_it
->from
+ 1; cmp_it
->to
< cmp_it
->nglyphs
;
1434 glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->to
);
1435 if (LGLYPH_FROM (glyph
) != from
)
1438 cmp_it
->charpos
= charpos
;
1442 glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->to
- 1);
1443 from
= LGLYPH_FROM (glyph
);
1444 cmp_it
->charpos
= charpos
- (LGLYPH_TO (glyph
) - from
);
1445 for (cmp_it
->from
= cmp_it
->to
- 1; cmp_it
->from
> 0;
1448 glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->from
- 1);
1449 if (LGLYPH_FROM (glyph
) != from
)
1453 glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->from
);
1454 cmp_it
->nchars
= LGLYPH_TO (glyph
) + 1 - from
;
1457 for (i
= cmp_it
->nchars
- 1; i
>= 0; i
--)
1459 c
= XINT (LGSTRING_CHAR (gstring
, i
));
1460 cmp_it
->nbytes
+= CHAR_BYTES (c
);
1461 cmp_it
->width
= (LGLYPH_WIDTH (glyph
) > 0
1462 ? CHAR_WIDTH (LGLYPH_CHAR (glyph
)) : 0);
1469 struct position_record
1471 EMACS_INT pos
, pos_byte
;
1475 /* Update the members of POSITION to the next character boundary. */
1476 #define FORWARD_CHAR(POSITION, STOP) \
1479 if ((POSITION).pos == (STOP)) \
1481 (POSITION).p = GAP_END_ADDR; \
1482 (POSITION).pos_byte = GPT_BYTE; \
1486 (POSITION).pos_byte += BYTES_BY_CHAR_HEAD (*((POSITION).p)); \
1487 (POSITION).p += BYTES_BY_CHAR_HEAD (*((POSITION).p)); \
1491 /* Update the members of POSITION to the previous character boundary. */
1492 #define BACKWARD_CHAR(POSITION, STOP) \
1494 if ((POSITION).pos == STOP) \
1495 (POSITION).p = GPT_ADDR; \
1497 (POSITION).pos_byte--; \
1499 } while (! CHAR_HEAD_P (*((POSITION).p))); \
1503 /* This is like find_composition, but find an automatic composition
1504 instead. If found, set *GSTRING to the glyph-string representing
1505 the composition, and return 1. Otherwise, return 0. */
1508 find_automatic_composition (EMACS_INT pos
, EMACS_INT limit
, EMACS_INT
*start
, EMACS_INT
*end
, Lisp_Object
*gstring
, Lisp_Object string
)
1510 EMACS_INT head
, tail
, stop
;
1511 /* Limit to check a composition after POS. */
1512 EMACS_INT fore_check_limit
;
1513 struct position_record orig
, cur
, check
, prev
;
1514 Lisp_Object check_val
, val
, elt
;
1520 window
= Fget_buffer_window (Fcurrent_buffer (), Qnil
);
1523 w
= XWINDOW (window
);
1528 head
= BEGV
, tail
= ZV
, stop
= GPT
;
1529 orig
.pos_byte
= CHAR_TO_BYTE (orig
.pos
);
1530 orig
.p
= BYTE_POS_ADDR (orig
.pos_byte
);
1534 head
= 0, tail
= SCHARS (string
), stop
= -1;
1535 orig
.pos_byte
= string_char_to_byte (string
, orig
.pos
);
1536 orig
.p
= SDATA (string
) + orig
.pos_byte
;
1539 fore_check_limit
= min (tail
, pos
+ MAX_AUTO_COMPOSITION_LOOKBACK
);
1541 fore_check_limit
= min (tail
, limit
+ MAX_AUTO_COMPOSITION_LOOKBACK
);
1546 /* At first, check if POS is composable. */
1547 c
= STRING_CHAR (cur
.p
);
1548 if (! CHAR_COMPOSABLE_P (c
))
1552 if (limit
>= cur
.pos
)
1553 goto search_forward
;
1557 val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1559 check_val
= val
, check
= cur
;
1561 while (cur
.pos
+ 1 < fore_check_limit
)
1565 FORWARD_CHAR (cur
, stop
);
1566 if (get_property_and_range (cur
.pos
, Qcomposition
, &val
, &b
, &e
,
1568 && COMPOSITION_VALID_P (b
, e
, val
))
1570 fore_check_limit
= cur
.pos
;
1573 c
= STRING_CHAR (cur
.p
);
1574 if (! CHAR_COMPOSABLE_P (c
))
1576 val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1579 check_val
= val
, check
= cur
;
1584 /* Rewind back to the position where we can safely search forward
1585 for compositions. */
1586 while (cur
.pos
> head
)
1590 BACKWARD_CHAR (cur
, stop
);
1591 if (get_property_and_range (cur
.pos
, Qcomposition
, &val
, &b
, &e
, Qnil
)
1592 && COMPOSITION_VALID_P (b
, e
, val
))
1594 c
= STRING_CHAR (cur
.p
);
1595 if (! CHAR_COMPOSABLE_P (c
))
1597 val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1599 check_val
= val
, check
= cur
;
1602 /* Now search forward. */
1605 if (! NILP (check_val
) || limit
>= orig
.pos
)
1607 if (NILP (check_val
))
1611 while (cur
.pos
< fore_check_limit
)
1613 int need_adjustment
= 0;
1615 if (NILP (check_val
))
1617 c
= STRING_CHAR (cur
.p
);
1618 check_val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1620 for (; CONSP (check_val
); check_val
= XCDR (check_val
))
1622 elt
= XCAR (check_val
);
1623 if (VECTORP (elt
) && ASIZE (elt
) == 3 && NATNUMP (AREF (elt
, 1))
1624 && cur
.pos
- XFASTINT (AREF (elt
, 1)) >= head
)
1626 check
.pos
= cur
.pos
- XFASTINT (AREF (elt
, 1));
1627 if (check
.pos
== cur
.pos
)
1628 check
.pos_byte
= cur
.pos_byte
;
1630 check
.pos_byte
= CHAR_TO_BYTE (check
.pos
);
1631 val
= autocmp_chars (elt
, check
.pos
, check
.pos_byte
,
1632 tail
, w
, NULL
, string
);
1633 need_adjustment
= 1;
1638 *end
= check
.pos
+ LGSTRING_CHAR_LEN (*gstring
);
1639 if (*start
<= orig
.pos
? *end
> orig
.pos
1640 : limit
>= orig
.pos
)
1643 cur
.pos_byte
= CHAR_TO_BYTE (cur
.pos
);
1648 if (need_adjustment
)
1650 /* As we have called Lisp, there's a possibility that
1651 buffer/string is relocated. */
1653 cur
.p
= BYTE_POS_ADDR (cur
.pos_byte
);
1655 cur
.p
= SDATA (string
) + cur
.pos_byte
;
1657 if (! CONSP (check_val
))
1658 FORWARD_CHAR (cur
, stop
);
1662 if (! NILP (*gstring
))
1663 return (limit
>= 0 || (*start
<= orig
.pos
&& *end
> orig
.pos
));
1664 if (limit
>= 0 && limit
< orig
.pos
&& prev
.pos
> head
)
1667 BACKWARD_CHAR (cur
, stop
);
1669 fore_check_limit
= orig
.pos
;
1675 /* Return the adjusted point provided that point is moved from LAST_PT
1679 composition_adjust_point (EMACS_INT last_pt
, EMACS_INT new_pt
)
1681 EMACS_INT charpos
, bytepos
, startpos
, beg
, end
, pos
;
1685 if (new_pt
== BEGV
|| new_pt
== ZV
)
1688 /* At first check the static composition. */
1689 if (get_property_and_range (new_pt
, Qcomposition
, &val
, &beg
, &end
, Qnil
)
1690 && COMPOSITION_VALID_P (beg
, end
, val
))
1692 if (beg
< new_pt
/* && end > new_pt <- It's always the case. */
1693 && (last_pt
<= beg
|| last_pt
>= end
))
1694 return (new_pt
< last_pt
? beg
: end
);
1698 if (NILP (current_buffer
->enable_multibyte_characters
)
1699 || NILP (Vauto_composition_mode
))
1702 /* Next check the automatic composition. */
1703 if (! find_automatic_composition (new_pt
, (EMACS_INT
) -1, &beg
, &end
, &val
,
1707 for (i
= 0; i
< LGSTRING_GLYPH_LEN (val
); i
++)
1709 Lisp_Object glyph
= LGSTRING_GLYPH (val
, i
);
1713 if (beg
+ LGLYPH_FROM (glyph
) == new_pt
)
1715 if (beg
+ LGLYPH_TO (glyph
) >= new_pt
)
1716 return (new_pt
< last_pt
1717 ? beg
+ LGLYPH_FROM (glyph
)
1718 : beg
+ LGLYPH_TO (glyph
) + 1);
1723 DEFUN ("composition-get-gstring", Fcomposition_get_gstring
,
1724 Scomposition_get_gstring
, 4, 4, 0,
1725 doc
: /* Return a glyph-string for characters between FROM and TO.
1726 If the glyph string is for graphic display, FONT-OBJECT must be
1727 a font-object to use for those characters.
1728 Otherwise (for terminal display), FONT-OBJECT must be a terminal ID, a
1729 frame, or nil for the selected frame's terminal device.
1731 If the optional 4th argument STRING is not nil, it is a string
1732 containing the target characters between indices FROM and TO.
1734 A glyph-string is a vector containing information about how to display
1735 a specific character sequence. The format is:
1736 [HEADER ID GLYPH ...]
1738 HEADER is a vector of this form:
1739 [FONT-OBJECT CHAR ...]
1741 FONT-OBJECT is a font-object for all glyphs in the glyph-string,
1742 or the terminal coding system of the specified terminal.
1743 CHARs are characters to be composed by GLYPHs.
1745 ID is an identification number of the glyph-string. It may be nil if
1748 GLYPH is a vector whose elements have this form:
1749 [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT
1750 [ [X-OFF Y-OFF WADJUST] | nil] ]
1752 FROM-IDX and TO-IDX are used internally and should not be touched.
1753 C is the character of the glyph.
1754 CODE is the glyph-code of C in FONT-OBJECT.
1755 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
1756 X-OFF and Y-OFF are offsets to the base position for the glyph.
1757 WADJUST is the adjustment to the normal width of the glyph.
1759 If GLYPH is nil, the remaining elements of the glyph-string vector
1760 should be ignored. */)
1761 (from
, to
, font_object
, string
)
1762 Lisp_Object font_object
, from
, to
, string
;
1764 Lisp_Object gstring
, header
;
1765 EMACS_INT frompos
, topos
;
1767 CHECK_NATNUM (from
);
1769 if (XINT (to
) > XINT (from
) + MAX_COMPOSITION_COMPONENTS
)
1770 to
= make_number (XINT (from
) + MAX_COMPOSITION_COMPONENTS
);
1771 if (! FONT_OBJECT_P (font_object
))
1773 struct coding_system
*coding
;
1774 struct terminal
*terminal
= get_terminal (font_object
, 1);
1776 coding
= ((TERMINAL_TERMINAL_CODING (terminal
)->common_flags
1777 & CODING_REQUIRE_ENCODING_MASK
)
1778 ? TERMINAL_TERMINAL_CODING (terminal
) : &safe_terminal_coding
);
1779 font_object
= CODING_ID_NAME (coding
->id
);
1782 header
= fill_gstring_header (Qnil
, from
, to
, font_object
, string
);
1783 gstring
= gstring_lookup_cache (header
);
1784 if (! NILP (gstring
))
1787 frompos
= XINT (from
);
1789 if (LGSTRING_GLYPH_LEN (gstring_work
) < topos
- frompos
)
1790 gstring_work
= Fmake_vector (make_number (topos
- frompos
+ 2), Qnil
);
1791 LGSTRING_SET_HEADER (gstring_work
, header
);
1792 LGSTRING_SET_ID (gstring_work
, Qnil
);
1793 fill_gstring_body (gstring_work
);
1794 return gstring_work
;
1798 /* Emacs Lisp APIs. */
1800 DEFUN ("compose-region-internal", Fcompose_region_internal
,
1801 Scompose_region_internal
, 2, 4, 0,
1802 doc
: /* Internal use only.
1804 Compose text in the region between START and END.
1805 Optional 3rd and 4th arguments are COMPONENTS and MODIFICATION-FUNC
1806 for the composition. See `compose-region' for more details. */)
1807 (start
, end
, components
, modification_func
)
1808 Lisp_Object start
, end
, components
, modification_func
;
1810 validate_region (&start
, &end
);
1811 if (!NILP (components
)
1812 && !INTEGERP (components
)
1813 && !CONSP (components
)
1814 && !STRINGP (components
))
1815 CHECK_VECTOR (components
);
1817 compose_text (XINT (start
), XINT (end
), components
, modification_func
, Qnil
);
1821 DEFUN ("compose-string-internal", Fcompose_string_internal
,
1822 Scompose_string_internal
, 3, 5, 0,
1823 doc
: /* Internal use only.
1825 Compose text between indices START and END of STRING.
1826 Optional 4th and 5th arguments are COMPONENTS and MODIFICATION-FUNC
1827 for the composition. See `compose-string' for more details. */)
1828 (string
, start
, end
, components
, modification_func
)
1829 Lisp_Object string
, start
, end
, components
, modification_func
;
1831 CHECK_STRING (string
);
1832 CHECK_NUMBER (start
);
1835 if (XINT (start
) < 0 ||
1836 XINT (start
) > XINT (end
)
1837 || XINT (end
) > SCHARS (string
))
1838 args_out_of_range (start
, end
);
1840 compose_text (XINT (start
), XINT (end
), components
, modification_func
, string
);
1844 DEFUN ("find-composition-internal", Ffind_composition_internal
,
1845 Sfind_composition_internal
, 4, 4, 0,
1846 doc
: /* Internal use only.
1848 Return information about composition at or nearest to position POS.
1849 See `find-composition' for more details. */)
1850 (pos
, limit
, string
, detail_p
)
1851 Lisp_Object pos
, limit
, string
, detail_p
;
1853 Lisp_Object prop
, tail
, gstring
;
1854 EMACS_INT start
, end
, from
, to
;
1857 CHECK_NUMBER_COERCE_MARKER (pos
);
1861 CHECK_NUMBER_COERCE_MARKER (limit
);
1869 CHECK_STRING (string
);
1870 if (XINT (pos
) < 0 || XINT (pos
) > SCHARS (string
))
1871 args_out_of_range (string
, pos
);
1875 if (XINT (pos
) < BEGV
|| XINT (pos
) > ZV
)
1876 args_out_of_range (Fcurrent_buffer (), pos
);
1879 if (!find_composition (from
, to
, &start
, &end
, &prop
, string
))
1881 if (!NILP (current_buffer
->enable_multibyte_characters
)
1882 && ! NILP (Vauto_composition_mode
)
1883 && find_automatic_composition (from
, to
, &start
, &end
, &gstring
,
1885 return list3 (make_number (start
), make_number (end
), gstring
);
1888 if ((end
<= XINT (pos
) || start
> XINT (pos
)))
1892 if (find_automatic_composition (from
, to
, &s
, &e
, &gstring
, string
)
1893 && (e
<= XINT (pos
) ? e
> end
: s
< start
))
1894 return list3 (make_number (s
), make_number (e
), gstring
);
1896 if (!COMPOSITION_VALID_P (start
, end
, prop
))
1897 return Fcons (make_number (start
), Fcons (make_number (end
),
1898 Fcons (Qnil
, Qnil
)));
1899 if (NILP (detail_p
))
1900 return Fcons (make_number (start
), Fcons (make_number (end
),
1903 if (COMPOSITION_REGISTERD_P (prop
))
1904 id
= COMPOSITION_ID (prop
);
1907 int start_byte
= (NILP (string
)
1908 ? CHAR_TO_BYTE (start
)
1909 : string_char_to_byte (string
, start
));
1910 id
= get_composition_id (start
, start_byte
, end
- start
, prop
, string
);
1915 Lisp_Object components
, relative_p
, mod_func
;
1916 enum composition_method method
= COMPOSITION_METHOD (prop
);
1917 int width
= composition_table
[id
]->width
;
1919 components
= Fcopy_sequence (COMPOSITION_COMPONENTS (prop
));
1920 relative_p
= (method
== COMPOSITION_WITH_RULE_ALTCHARS
1922 mod_func
= COMPOSITION_MODIFICATION_FUNC (prop
);
1923 tail
= Fcons (components
,
1926 Fcons (make_number (width
), Qnil
))));
1931 return Fcons (make_number (start
), Fcons (make_number (end
), tail
));
1936 syms_of_composite (void)
1940 Qcomposition
= intern_c_string ("composition");
1941 staticpro (&Qcomposition
);
1943 /* Make a hash table for static composition. */
1945 Lisp_Object args
[6];
1946 extern Lisp_Object QCsize
;
1950 args
[2] = QCweakness
;
1951 /* We used to make the hash table weak so that unreferenced
1952 compositions can be garbage-collected. But, usually once
1953 created compositions are repeatedly used in an Emacs session,
1954 and thus it's not worth to save memory in such a way. So, we
1955 make the table not weak. */
1958 args
[5] = make_number (311);
1959 composition_hash_table
= Fmake_hash_table (6, args
);
1960 staticpro (&composition_hash_table
);
1963 /* Make a hash table for glyph-string. */
1965 Lisp_Object args
[6];
1966 extern Lisp_Object QCsize
;
1970 args
[2] = QCweakness
;
1973 args
[5] = make_number (311);
1974 gstring_hash_table
= Fmake_hash_table (6, args
);
1975 staticpro (&gstring_hash_table
);
1978 staticpro (&gstring_work_headers
);
1979 gstring_work_headers
= Fmake_vector (make_number (8), Qnil
);
1980 for (i
= 0; i
< 8; i
++)
1981 ASET (gstring_work_headers
, i
, Fmake_vector (make_number (i
+ 2), Qnil
));
1982 staticpro (&gstring_work
);
1983 gstring_work
= Fmake_vector (make_number (10), Qnil
);
1985 /* Text property `composition' should be nonsticky by default. */
1986 Vtext_property_default_nonsticky
1987 = Fcons (Fcons (Qcomposition
, Qt
), Vtext_property_default_nonsticky
);
1989 DEFVAR_LISP ("compose-chars-after-function", &Vcompose_chars_after_function
,
1990 doc
: /* Function to adjust composition of buffer text.
1992 This function is called with three arguments: FROM, TO, and OBJECT.
1993 FROM and TO specify the range of text whose composition should be
1994 adjusted. OBJECT, if non-nil, is a string that contains the text.
1996 This function is called after a text with `composition' property is
1997 inserted or deleted to keep `composition' property of buffer text
2000 The default value is the function `compose-chars-after'. */);
2001 Vcompose_chars_after_function
= intern_c_string ("compose-chars-after");
2003 Qauto_composed
= intern_c_string ("auto-composed");
2004 staticpro (&Qauto_composed
);
2006 Qauto_composition_function
= intern_c_string ("auto-composition-function");
2007 staticpro (&Qauto_composition_function
);
2009 DEFVAR_LISP ("auto-composition-mode", &Vauto_composition_mode
,
2010 doc
: /* Non-nil if Auto-Composition mode is enabled.
2011 Use the command `auto-composition-mode' to change this variable. */);
2012 Vauto_composition_mode
= Qt
;
2014 DEFVAR_LISP ("auto-composition-function", &Vauto_composition_function
,
2015 doc
: /* Function to call to compose characters automatically.
2016 This function is called from the display routine with four arguments:
2017 FROM, TO, WINDOW, and STRING.
2019 If STRING is nil, the function must compose characters in the region
2020 between FROM and TO in the current buffer.
2022 Otherwise, STRING is a string, and FROM and TO are indices into the
2023 string. In this case, the function must compose characters in the
2025 Vauto_composition_function
= Qnil
;
2027 DEFVAR_LISP ("composition-function-table", &Vcomposition_function_table
,
2028 doc
: /* Char-table of functions for automatic character composition.
2029 For each character that has to be composed automatically with
2030 preceding and/or following characters, this char-table contains
2031 a function to call to compose that character.
2033 The element at index C in the table, if non-nil, is a list of
2034 composition rules of this form: ([PATTERN PREV-CHARS FUNC] ...)
2036 PATTERN is a regular expression which C and the surrounding
2037 characters must match.
2039 PREV-CHARS is a non-negative integer (less than 4) specifying how many
2040 characters before C to check the matching with PATTERN. If it is 0,
2041 PATTERN must match C and the following characters. If it is 1,
2042 PATTERN must match a character before C and the following characters.
2044 If PREV-CHARS is 0, PATTERN can be nil, which means that the
2045 single character C should be composed.
2047 FUNC is a function to return a glyph-string representing a
2048 composition of the characters that match PATTERN. It is
2049 called with one argument GSTRING.
2051 GSTRING is a template of a glyph-string to return. It is already
2052 filled with a proper header for the characters to compose, and
2053 glyphs corresponding to those characters one by one. The
2054 function must return a new glyph-string with the same header as
2055 GSTRING, or modify GSTRING itself and return it.
2057 See also the documentation of `auto-composition-mode'. */);
2058 Vcomposition_function_table
= Fmake_char_table (Qnil
, Qnil
);
2060 defsubr (&Scompose_region_internal
);
2061 defsubr (&Scompose_string_internal
);
2062 defsubr (&Sfind_composition_internal
);
2063 defsubr (&Scomposition_get_gstring
);
2066 /* arch-tag: 79cefaf8-ca48-4eed-97e5-d5afb290d272
2067 (do not change this comment) */