1 /* Composite sequence support.
2 Copyright (C) 2001, 2002, 2003, 2004, 2005,
3 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
4 Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
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/>. */
29 #include "character.h"
31 #include "intervals.h"
34 #include "dispextern.h"
36 #include "termhooks.h"
39 /* Emacs uses special text property `composition' to support character
40 composition. A sequence of characters that have the same (i.e. eq)
41 `composition' property value is treated as a single composite
42 sequence (we call it just `composition' here after). Characters in
43 a composition are all composed somehow on the screen.
45 The property value has this form when the composition is made:
46 ((LENGTH . COMPONENTS) . MODIFICATION-FUNC)
47 then turns to this form:
48 (COMPOSITION-ID . (LENGTH COMPONENTS-VEC . MODIFICATION-FUNC))
49 when the composition is registered in composition_hash_table and
50 composition_table. These rather peculiar structures were designed
51 to make it easy to distinguish them quickly (we can do that by
52 checking only the first element) and to extract LENGTH (from the
53 former form) and COMPOSITION-ID (from the latter form).
55 We register a composition when it is displayed, or when the width
56 is required (for instance, to calculate columns).
58 LENGTH -- Length of the composition. This information is used to
59 check the validity of the composition.
61 COMPONENTS -- Character, string, vector, list, or nil.
63 If it is nil, characters in the text are composed relatively
64 according to their metrics in font glyphs.
66 If it is a character or a string, the character or characters
67 in the string are composed relatively.
69 If it is a vector or list of integers, the element is a
70 character or an encoded composition rule. The characters are
71 composed according to the rules. (2N)th elements are
72 characters to be composed and (2N+1)th elements are
73 composition rules to tell how to compose (2N+2)th element with
74 the previously composed 2N glyphs.
76 COMPONENTS-VEC -- Vector of integers. In relative composition, the
77 elements are characters to be composed. In rule-base
78 composition, the elements are characters or encoded
81 MODIFICATION-FUNC -- If non nil, it is a function to call when the
82 composition gets invalid after a modification in a buffer. If
83 it is nil, a function in `composition-function-table' of the
84 first character in the sequence is called.
86 COMPOSITION-ID --Identification number of the composition. It is
87 used as an index to composition_table for the composition.
89 When Emacs has to display a composition or has to know its
90 displaying width, the function get_composition_id is called. It
91 returns COMPOSITION-ID so that the caller can access the
92 information about the composition through composition_table. If a
93 COMPOSITION-ID has not yet been assigned to the composition,
94 get_composition_id checks the validity of `composition' property,
95 and, if valid, assigns a new ID, registers the information in
96 composition_hash_table and composition_table, and changes the form
97 of the property value. If the property is invalid, return -1
98 without changing the property value.
100 We use two tables to keep information about composition;
101 composition_hash_table and composition_table.
103 The former is a hash table in which keys are COMPONENTS-VECs and
104 values are the corresponding COMPOSITION-IDs. This hash table is
105 weak, but as each key (COMPONENTS-VEC) is also kept as a value of the
106 `composition' property, it won't be collected as garbage until all
107 bits of text that have the same COMPONENTS-VEC are deleted.
109 The latter is a table of pointers to `struct composition' indexed
110 by COMPOSITION-ID. This structure keeps the other information (see
113 In general, a text property holds information about individual
114 characters. But, a `composition' property holds information about
115 a sequence of characters (in this sense, it is like the `intangible'
116 property). That means that we should not share the property value
117 in adjacent compositions -- we can't distinguish them if they have the
118 same property. So, after any changes, we call
119 `update_compositions' and change a property of one of adjacent
120 compositions to a copy of it. This function also runs a proper
121 composition modification function to make a composition that gets
122 invalid by the change valid again.
124 As the value of the `composition' property holds information about a
125 specific range of text, the value gets invalid if we change the
126 text in the range. We treat the `composition' property as always
127 rear-nonsticky (currently by setting default-text-properties to
128 (rear-nonsticky (composition))) and we never make properties of
129 adjacent compositions identical. Thus, any such changes make the
130 range just shorter. So, we can check the validity of the `composition'
131 property by comparing LENGTH information with the actual length of
137 Lisp_Object Qcomposition
;
139 /* Table of pointers to the structure `composition' indexed by
140 COMPOSITION-ID. This structure is for storing information about
141 each composition except for COMPONENTS-VEC. */
142 struct composition
**composition_table
;
144 /* The current size of `composition_table'. */
145 static int composition_table_size
;
147 /* Number of compositions currently made. */
150 /* Hash table for compositions. The key is COMPONENTS-VEC of
151 `composition' property. The value is the corresponding
153 Lisp_Object composition_hash_table
;
155 /* Function to call to adjust composition. */
156 Lisp_Object Vcompose_chars_after_function
;
158 Lisp_Object Qauto_composed
;
159 Lisp_Object Vauto_composition_function
;
160 Lisp_Object Qauto_composition_function
;
161 Lisp_Object Vcomposition_function_table
;
163 EXFUN (Fremove_list_of_text_properties
, 4);
165 /* Temporary variable used in macros COMPOSITION_XXX. */
166 Lisp_Object composition_temp
;
169 /* Return COMPOSITION-ID of a composition at buffer position
170 CHARPOS/BYTEPOS and length NCHARS. The `composition' property of
171 the sequence is PROP. STRING, if non-nil, is a string that
172 contains the composition instead of the current buffer.
174 If the composition is invalid, return -1. */
177 get_composition_id (charpos
, bytepos
, nchars
, prop
, string
)
178 int charpos
, bytepos
, nchars
;
179 Lisp_Object prop
, string
;
181 Lisp_Object id
, length
, components
, key
, *key_contents
;
183 struct Lisp_Hash_Table
*hash_table
= XHASH_TABLE (composition_hash_table
);
186 struct composition
*cmp
;
190 Form-A: ((LENGTH . COMPONENTS) . MODIFICATION-FUNC)
192 Form-B: (COMPOSITION-ID . (LENGTH COMPONENTS-VEC . MODIFICATION-FUNC))
194 if (nchars
== 0 || !CONSP (prop
))
195 goto invalid_composition
;
200 /* PROP should be Form-B. */
201 if (XINT (id
) < 0 || XINT (id
) >= n_compositions
)
202 goto invalid_composition
;
206 /* PROP should be Form-A.
207 Thus, ID should be (LENGTH . COMPONENTS). */
209 goto invalid_composition
;
211 if (!INTEGERP (length
) || XINT (length
) != nchars
)
212 goto invalid_composition
;
214 components
= XCDR (id
);
216 /* Check if the same composition has already been registered or not
217 by consulting composition_hash_table. The key for this table is
218 COMPONENTS (converted to a vector COMPONENTS-VEC) or, if it is
219 nil, vector of characters in the composition range. */
220 if (INTEGERP (components
))
221 key
= Fmake_vector (make_number (1), components
);
222 else if (STRINGP (components
) || CONSP (components
))
223 key
= Fvconcat (1, &components
);
224 else if (VECTORP (components
))
226 else if (NILP (components
))
228 key
= Fmake_vector (make_number (nchars
), Qnil
);
229 if (STRINGP (string
))
230 for (i
= 0; i
< nchars
; i
++)
232 FETCH_STRING_CHAR_ADVANCE (ch
, string
, charpos
, bytepos
);
233 XVECTOR (key
)->contents
[i
] = make_number (ch
);
236 for (i
= 0; i
< nchars
; i
++)
238 FETCH_CHAR_ADVANCE (ch
, charpos
, bytepos
);
239 XVECTOR (key
)->contents
[i
] = make_number (ch
);
243 goto invalid_composition
;
245 hash_index
= hash_lookup (hash_table
, key
, &hash_code
);
248 /* We have already registered the same composition. Change PROP
249 from Form-A above to Form-B while replacing COMPONENTS with
250 COMPONENTS-VEC stored in the hash table. We can directly
251 modify the cons cell of PROP because it is not shared. */
252 key
= HASH_KEY (hash_table
, hash_index
);
253 id
= HASH_VALUE (hash_table
, hash_index
);
255 XSETCDR (prop
, Fcons (make_number (nchars
), Fcons (key
, XCDR (prop
))));
259 /* This composition is a new one. We must register it. */
261 /* Check if we have sufficient memory to store this information. */
262 if (composition_table_size
== 0)
264 composition_table_size
= 256;
266 = (struct composition
**) xmalloc (sizeof (composition_table
[0])
267 * composition_table_size
);
269 else if (composition_table_size
<= n_compositions
)
271 composition_table_size
+= 256;
273 = (struct composition
**) xrealloc (composition_table
,
274 sizeof (composition_table
[0])
275 * composition_table_size
);
278 key_contents
= XVECTOR (key
)->contents
;
280 /* Check if the contents of COMPONENTS are valid if COMPONENTS is a
281 vector or a list. It should be a sequence of:
282 char1 rule1 char2 rule2 char3 ... ruleN charN+1 */
284 if (VECTORP (components
)
285 && ASIZE (components
) >= 2
286 && VECTORP (AREF (components
, 0)))
288 /* COMPONENTS is a glyph-string. */
289 int len
= ASIZE (key
);
291 for (i
= 1; i
< len
; i
++)
292 if (! VECTORP (AREF (key
, i
)))
293 goto invalid_composition
;
295 else if (VECTORP (components
) || CONSP (components
))
297 int len
= XVECTOR (key
)->size
;
299 /* The number of elements should be odd. */
301 goto invalid_composition
;
302 /* All elements should be integers (character or encoded
303 composition rule). */
304 for (i
= 0; i
< len
; i
++)
306 if (!INTEGERP (key_contents
[i
]))
307 goto invalid_composition
;
311 /* Change PROP from Form-A above to Form-B. We can directly modify
312 the cons cell of PROP because it is not shared. */
313 XSETFASTINT (id
, n_compositions
);
315 XSETCDR (prop
, Fcons (make_number (nchars
), Fcons (key
, XCDR (prop
))));
317 /* Register the composition in composition_hash_table. */
318 hash_index
= hash_put (hash_table
, key
, id
, hash_code
);
320 /* Register the composition in composition_table. */
321 cmp
= (struct composition
*) xmalloc (sizeof (struct composition
));
323 cmp
->method
= (NILP (components
)
324 ? COMPOSITION_RELATIVE
325 : ((INTEGERP (components
) || STRINGP (components
))
326 ? COMPOSITION_WITH_ALTCHARS
327 : COMPOSITION_WITH_RULE_ALTCHARS
));
328 cmp
->hash_index
= hash_index
;
329 glyph_len
= (cmp
->method
== COMPOSITION_WITH_RULE_ALTCHARS
330 ? (XVECTOR (key
)->size
+ 1) / 2
331 : XVECTOR (key
)->size
);
332 cmp
->glyph_len
= glyph_len
;
333 cmp
->offsets
= (short *) xmalloc (sizeof (short) * glyph_len
* 2);
336 if (cmp
->method
!= COMPOSITION_WITH_RULE_ALTCHARS
)
338 /* Relative composition. */
340 for (i
= 0; i
< glyph_len
; i
++)
343 ch
= XINT (key_contents
[i
]);
344 this_width
= (ch
== '\t' ? 1 : CHAR_WIDTH (ch
));
345 if (cmp
->width
< this_width
)
346 cmp
->width
= this_width
;
351 /* Rule-base composition. */
352 float leftmost
= 0.0, rightmost
;
354 ch
= XINT (key_contents
[0]);
355 rightmost
= ch
!= '\t' ? CHAR_WIDTH (ch
) : 1;
357 for (i
= 1; i
< glyph_len
; i
+= 2)
359 int rule
, gref
, nref
, xoff
, yoff
;
363 rule
= XINT (key_contents
[i
]);
364 ch
= XINT (key_contents
[i
+ 1]);
365 this_width
= ch
!= '\t' ? CHAR_WIDTH (ch
) : 1;
367 /* A composition rule is specified by an integer value
368 that encodes global and new reference points (GREF and
369 NREF). GREF and NREF are specified by numbers as
377 ---3---4---5--- baseline
381 COMPOSITION_DECODE_RULE (rule
, gref
, nref
, xoff
, yoff
);
382 this_left
= (leftmost
383 + (gref
% 3) * (rightmost
- leftmost
) / 2.0
384 - (nref
% 3) * this_width
/ 2.0);
386 if (this_left
< leftmost
)
387 leftmost
= this_left
;
388 if (this_left
+ this_width
> rightmost
)
389 rightmost
= this_left
+ this_width
;
392 cmp
->width
= rightmost
- leftmost
;
393 if (cmp
->width
< (rightmost
- leftmost
))
394 /* To get a ceiling integer value. */
398 composition_table
[n_compositions
] = cmp
;
400 return n_compositions
++;
403 /* Would it be better to remove this `composition' property? */
408 /* Find a static composition at or nearest to position POS of OBJECT
411 OBJECT defaults to the current buffer. If there's a composition at
412 POS, set *START and *END to the start and end of the sequence,
413 *PROP to the `composition' property, and return 1.
415 If there's no composition at POS and LIMIT is negative, return 0.
417 Otherwise, search for a composition forward (LIMIT > POS) or
418 backward (LIMIT < POS). In this case, LIMIT bounds the search.
420 If a composition is found, set *START, *END, and *PROP as above,
421 and return 1, else return 0.
423 This doesn't check the validity of composition. */
426 find_composition (pos
, limit
, start
, end
, prop
, object
)
428 EMACS_INT
*start
, *end
;
429 Lisp_Object
*prop
, object
;
433 if (get_property_and_range (pos
, Qcomposition
, prop
, start
, end
, object
))
436 if (limit
< 0 || limit
== pos
)
439 if (limit
> pos
) /* search forward */
441 val
= Fnext_single_property_change (make_number (pos
), Qcomposition
,
442 object
, make_number (limit
));
447 else /* search backward */
449 if (get_property_and_range (pos
- 1, Qcomposition
, prop
, start
, end
,
452 val
= Fprevious_single_property_change (make_number (pos
), Qcomposition
,
453 object
, make_number (limit
));
459 get_property_and_range (pos
, Qcomposition
, prop
, start
, end
, object
);
463 /* Run a proper function to adjust the composition sitting between
464 FROM and TO with property PROP. */
467 run_composition_function (from
, to
, prop
)
472 EMACS_INT start
, end
;
474 func
= COMPOSITION_MODIFICATION_FUNC (prop
);
475 /* If an invalid composition precedes or follows, try to make them
478 && find_composition (from
- 1, -1, &start
, &end
, &prop
, Qnil
)
479 && !COMPOSITION_VALID_P (start
, end
, prop
))
482 && find_composition (to
, -1, &start
, &end
, &prop
, Qnil
)
483 && !COMPOSITION_VALID_P (start
, end
, prop
))
485 if (!NILP (Ffboundp (func
)))
486 call2 (func
, make_number (from
), make_number (to
));
489 /* Make invalid compositions adjacent to or inside FROM and TO valid.
490 CHECK_MASK is bitwise `or' of mask bits defined by macros
491 CHECK_XXX (see the comment in composite.h).
493 It also resets the text-property `auto-composed' to a proper region
494 so that automatic character composition works correctly later while
495 displaying the region.
497 This function is called when a buffer text is changed. If the
498 change is deletion, FROM == TO. Otherwise, FROM < TO. */
501 update_compositions (from
, to
, check_mask
)
506 EMACS_INT start
, end
;
507 /* The beginning and end of the region to set the property
508 `auto-composed' to nil. */
509 EMACS_INT min_pos
= from
, max_pos
= to
;
511 if (inhibit_modification_hooks
)
514 /* If FROM and TO are not in a valid range, do nothing. */
515 if (! (BEGV
<= from
&& from
<= to
&& to
<= ZV
))
518 if (check_mask
& CHECK_HEAD
)
520 /* FROM should be at composition boundary. But, insertion or
521 deletion will make two compositions adjacent and
522 indistinguishable when they have same (eq) property. To
523 avoid it, in such a case, we change the property of the
524 latter to the copy of it. */
526 && find_composition (from
- 1, -1, &start
, &end
, &prop
, Qnil
)
527 && COMPOSITION_VALID_P (start
, end
, prop
))
533 Fput_text_property (make_number (from
), make_number (end
),
535 Fcons (XCAR (prop
), XCDR (prop
)), Qnil
);
536 run_composition_function (start
, end
, prop
);
540 && find_composition (from
, -1, &start
, &from
, &prop
, Qnil
)
541 && COMPOSITION_VALID_P (start
, from
, prop
))
545 run_composition_function (start
, from
, prop
);
549 if (check_mask
& CHECK_INSIDE
)
551 /* In this case, we are sure that (check & CHECK_TAIL) is also
552 nonzero. Thus, here we should check only compositions before
555 && find_composition (from
, to
, &start
, &from
, &prop
, Qnil
)
556 && COMPOSITION_VALID_P (start
, from
, prop
)
558 run_composition_function (start
, from
, prop
);
561 if (check_mask
& CHECK_TAIL
)
564 && find_composition (to
- 1, -1, &start
, &end
, &prop
, Qnil
)
565 && COMPOSITION_VALID_P (start
, end
, prop
))
567 /* TO should be also at composition boundary. But,
568 insertion or deletion will make two compositions adjacent
569 and indistinguishable when they have same (eq) property.
570 To avoid it, in such a case, we change the property of
571 the former to the copy of it. */
574 Fput_text_property (make_number (start
), make_number (to
),
576 Fcons (XCAR (prop
), XCDR (prop
)), Qnil
);
579 run_composition_function (start
, end
, prop
);
582 && find_composition (to
, -1, &start
, &end
, &prop
, Qnil
)
583 && COMPOSITION_VALID_P (start
, end
, prop
))
585 run_composition_function (start
, end
, prop
);
589 if (min_pos
< max_pos
)
591 int count
= SPECPDL_INDEX ();
593 specbind (Qinhibit_read_only
, Qt
);
594 specbind (Qinhibit_modification_hooks
, Qt
);
595 specbind (Qinhibit_point_motion_hooks
, Qt
);
596 Fremove_list_of_text_properties (make_number (min_pos
),
597 make_number (max_pos
),
598 Fcons (Qauto_composed
, Qnil
), Qnil
);
599 unbind_to (count
, Qnil
);
604 /* Modify composition property values in LIST destructively. LIST is
605 a list as returned from text_property_list. Change values to the
606 top-level copies of them so that none of them are `eq'. */
609 make_composition_value_copy (list
)
612 Lisp_Object plist
, val
;
614 for (; CONSP (list
); list
= XCDR (list
))
616 plist
= XCAR (XCDR (XCDR (XCAR (list
))));
617 while (CONSP (plist
) && CONSP (XCDR (plist
)))
619 if (EQ (XCAR (plist
), Qcomposition
)
620 && (val
= XCAR (XCDR (plist
)), CONSP (val
)))
621 XSETCAR (XCDR (plist
), Fcons (XCAR (val
), XCDR (val
)));
622 plist
= XCDR (XCDR (plist
));
628 /* Make text in the region between START and END a composition that
629 has COMPONENTS and MODIFICATION-FUNC.
631 If STRING is non-nil, then operate on characters contained between
632 indices START and END in STRING. */
635 compose_text (start
, end
, components
, modification_func
, string
)
637 Lisp_Object components
, modification_func
, string
;
641 prop
= Fcons (Fcons (make_number (end
- start
), components
),
643 Fput_text_property (make_number (start
), make_number (end
),
644 Qcomposition
, prop
, string
);
648 static Lisp_Object autocmp_chars
P_ ((Lisp_Object
, EMACS_INT
, EMACS_INT
,
649 EMACS_INT
, struct window
*,
650 struct face
*, Lisp_Object
));
653 /* Lisp glyph-string handlers */
655 /* Hash table for automatic composition. The key is a header of a
656 lgstring (Lispy glyph-string), and the value is a body of a
659 static Lisp_Object gstring_hash_table
;
661 static Lisp_Object gstring_lookup_cache
P_ ((Lisp_Object
));
664 gstring_lookup_cache (header
)
667 struct Lisp_Hash_Table
*h
= XHASH_TABLE (gstring_hash_table
);
668 int i
= hash_lookup (h
, header
, NULL
);
670 return (i
>= 0 ? HASH_VALUE (h
, i
) : Qnil
);
674 composition_gstring_put_cache (gstring
, len
)
678 struct Lisp_Hash_Table
*h
= XHASH_TABLE (gstring_hash_table
);
680 Lisp_Object header
, copy
;
683 header
= LGSTRING_HEADER (gstring
);
684 hash
= h
->hashfn (h
, header
);
687 len
= LGSTRING_GLYPH_LEN (gstring
);
688 for (i
= 0; i
< len
; i
++)
689 if (NILP (LGSTRING_GLYPH (gstring
, i
)))
694 copy
= Fmake_vector (make_number (len
+ 2), Qnil
);
695 LGSTRING_SET_HEADER (copy
, Fcopy_sequence (header
));
696 for (i
= 0; i
< len
; i
++)
697 LGSTRING_SET_GLYPH (copy
, i
, Fcopy_sequence (LGSTRING_GLYPH (gstring
, i
)));
698 i
= hash_put (h
, LGSTRING_HEADER (copy
), copy
, hash
);
699 LGSTRING_SET_ID (copy
, make_number (i
));
704 composition_gstring_from_id (id
)
707 struct Lisp_Hash_Table
*h
= XHASH_TABLE (gstring_hash_table
);
709 return HASH_VALUE (h
, id
);
712 static Lisp_Object fill_gstring_header
P_ ((Lisp_Object
, Lisp_Object
,
713 Lisp_Object
, Lisp_Object
,
717 composition_gstring_p (gstring
)
723 if (! VECTORP (gstring
) || ASIZE (gstring
) < 2)
725 header
= LGSTRING_HEADER (gstring
);
726 if (! VECTORP (header
) || ASIZE (header
) < 2)
728 if (! NILP (LGSTRING_FONT (gstring
))
729 && (! FONT_OBJECT_P (LGSTRING_FONT (gstring
))
730 && ! CODING_SYSTEM_P (LGSTRING_FONT (gstring
))))
732 for (i
= 1; i
< ASIZE (LGSTRING_HEADER (gstring
)); i
++)
733 if (! NATNUMP (AREF (LGSTRING_HEADER (gstring
), i
)))
735 if (! NILP (LGSTRING_ID (gstring
)) && ! NATNUMP (LGSTRING_ID (gstring
)))
737 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
739 Lisp_Object glyph
= LGSTRING_GLYPH (gstring
, i
);
742 if (! VECTORP (glyph
) || ASIZE (glyph
) != LGLYPH_SIZE
)
749 composition_gstring_width (gstring
, from
, to
, metrics
)
752 struct font_metrics
*metrics
;
759 Lisp_Object font_object
= LGSTRING_FONT (gstring
);
761 if (FONT_OBJECT_P (font_object
))
763 struct font
*font
= XFONT_OBJECT (font_object
);
765 metrics
->ascent
= font
->ascent
;
766 metrics
->descent
= font
->descent
;
771 metrics
->descent
= 0;
773 metrics
->width
= metrics
->lbearing
= metrics
->rbearing
= 0;
775 for (glyph
= &LGSTRING_GLYPH (gstring
, from
); from
< to
; from
++, glyph
++)
779 if (NILP (LGLYPH_ADJUSTMENT (*glyph
)))
780 width
+= LGLYPH_WIDTH (*glyph
);
782 width
+= LGLYPH_WADJUST (*glyph
);
785 x
= metrics
->width
+ LGLYPH_LBEARING (*glyph
) + LGLYPH_XOFF (*glyph
);
786 if (metrics
->lbearing
> x
)
787 metrics
->lbearing
= x
;
788 x
= metrics
->width
+ LGLYPH_RBEARING (*glyph
) + LGLYPH_XOFF (*glyph
);
789 if (metrics
->rbearing
< x
)
790 metrics
->rbearing
= x
;
791 metrics
->width
= width
;
792 x
= LGLYPH_ASCENT (*glyph
) - LGLYPH_YOFF (*glyph
);
793 if (metrics
->ascent
< x
)
795 x
= LGLYPH_DESCENT (*glyph
) - LGLYPH_YOFF (*glyph
);
796 if (metrics
->descent
< x
)
797 metrics
->descent
= x
;
804 static Lisp_Object gstring_work
;
805 static Lisp_Object gstring_work_headers
;
808 fill_gstring_header (header
, start
, end
, font_object
, string
)
809 Lisp_Object header
, start
, end
, font_object
, string
;
811 EMACS_INT from
, to
, from_byte
;
816 if (NILP (current_buffer
->enable_multibyte_characters
))
817 error ("Attempt to shape unibyte text");
818 validate_region (&start
, &end
);
819 from
= XFASTINT (start
);
821 from_byte
= CHAR_TO_BYTE (from
);
825 CHECK_STRING (string
);
826 if (! STRING_MULTIBYTE (string
))
827 error ("Attempt to shape unibyte text");
828 /* FROM and TO are checked by the caller. */
831 if (from
< 0 || from
> to
|| to
> SCHARS (string
))
832 args_out_of_range_3 (string
, start
, end
);
833 from_byte
= string_char_to_byte (string
, from
);
838 error ("Attempt to shape zero-length text");
839 if (VECTORP (header
))
841 if (ASIZE (header
) != len
+ 1)
842 args_out_of_range (header
, make_number (len
+ 1));
847 header
= AREF (gstring_work_headers
, len
- 1);
849 header
= Fmake_vector (make_number (len
+ 1), Qnil
);
852 ASET (header
, 0, font_object
);
853 for (i
= 0; i
< len
; i
++)
858 FETCH_CHAR_ADVANCE_NO_CHECK (c
, from
, from_byte
);
860 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, from
, from_byte
);
861 ASET (header
, i
+ 1, make_number (c
));
866 extern void font_fill_lglyph_metrics
P_ ((Lisp_Object
, Lisp_Object
));
869 fill_gstring_body (gstring
)
872 Lisp_Object font_object
= LGSTRING_FONT (gstring
);
873 Lisp_Object header
= AREF (gstring
, 0);
874 EMACS_INT len
= LGSTRING_CHAR_LEN (gstring
);
877 for (i
= 0; i
< len
; i
++)
879 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
880 EMACS_INT c
= XINT (AREF (header
, i
+ 1));
885 LGSTRING_SET_GLYPH (gstring
, i
, g
);
887 LGLYPH_SET_FROM (g
, i
);
888 LGLYPH_SET_TO (g
, i
);
889 LGLYPH_SET_CHAR (g
, c
);
890 if (FONT_OBJECT_P (font_object
))
892 font_fill_lglyph_metrics (g
, font_object
);
896 int width
= XFASTINT (CHAR_TABLE_REF (Vchar_width_table
, c
));
898 LGLYPH_SET_CODE (g
, c
);
899 LGLYPH_SET_LBEARING (g
, 0);
900 LGLYPH_SET_RBEARING (g
, width
);
901 LGLYPH_SET_WIDTH (g
, width
);
902 LGLYPH_SET_ASCENT (g
, 1);
903 LGLYPH_SET_DESCENT (g
, 0);
905 LGLYPH_SET_ADJUSTMENT (g
, Qnil
);
907 if (i
< LGSTRING_GLYPH_LEN (gstring
))
908 LGSTRING_SET_GLYPH (gstring
, i
, Qnil
);
911 EXFUN (Fre_search_forward
, 4);
913 /* Try to compose the characters at CHARPOS according to CFT_ELEMENT
914 which is an element of composition-fucntion-table (which see).
915 LIMIT limits the characters to compose. STRING, if not nil, is a
916 target string. WIN is a window where the characters are being
920 autocmp_chars (cft_element
, charpos
, bytepos
, limit
, win
, face
, string
)
921 Lisp_Object cft_element
;
922 EMACS_INT charpos
, bytepos
, limit
;
927 int count
= SPECPDL_INDEX ();
928 FRAME_PTR f
= XFRAME (win
->frame
);
929 Lisp_Object pos
= make_number (charpos
);
930 EMACS_INT pt
= PT
, pt_byte
= PT_BYTE
;
933 record_unwind_save_match_data ();
934 for (lookback
= -1; CONSP (cft_element
); cft_element
= XCDR (cft_element
))
936 Lisp_Object elt
= XCAR (cft_element
);
938 Lisp_Object font_object
= Qnil
, gstring
;
941 if (! VECTORP (elt
) || ASIZE (elt
) != 3)
944 lookback
= XFASTINT (AREF (elt
, 1));
945 else if (lookback
!= XFASTINT (AREF (elt
, 1)))
949 TEMP_SET_PT_BOTH (charpos
, bytepos
);
953 ? EQ (Fstring_match (re
, string
, pos
), pos
)
954 : (! NILP (Fre_search_forward (re
, make_number (limit
), Qt
, Qnil
))
955 && EQ (Fmatch_beginning (make_number (0)), pos
)))))
957 to
= (NILP (re
) ? charpos
+ 1 : XINT (Fmatch_end (make_number (0))));
958 #ifdef HAVE_WINDOW_SYSTEM
959 if (FRAME_WINDOW_P (f
))
961 font_object
= font_range (charpos
, &to
, win
, face
, string
);
962 if (! FONT_OBJECT_P (font_object
))
965 TEMP_SET_PT_BOTH (pt
, pt_byte
);
966 return unbind_to (count
, Qnil
);
970 #endif /* not HAVE_WINDOW_SYSTEM */
971 font_object
= win
->frame
;
972 gstring
= Fcomposition_get_gstring (pos
, make_number (to
),
973 font_object
, string
);
974 if (NILP (LGSTRING_ID (gstring
)))
978 args
[0] = Vauto_composition_function
;
979 args
[1] = AREF (elt
, 2);
981 args
[3] = make_number (to
);
982 args
[4] = font_object
;
984 gstring
= safe_call (6, args
);
987 TEMP_SET_PT_BOTH (pt
, pt_byte
);
988 return unbind_to (count
, gstring
);
992 TEMP_SET_PT_BOTH (pt
, pt_byte
);
993 return unbind_to (count
, Qnil
);
997 /* Update cmp_it->stop_pos to the next position after CHARPOS (and
998 BYTEPOS) where character composition may happen. If BYTEPOS is
999 negative, compoute it. If it is a static composition, set
1000 cmp_it->ch to -1. Otherwise, set cmp_it->ch to the character that
1001 triggers a automatic composition. */
1004 composition_compute_stop_pos (cmp_it
, charpos
, bytepos
, endpos
, string
)
1005 struct composition_it
*cmp_it
;
1006 EMACS_INT charpos
, bytepos
, endpos
;
1009 EMACS_INT start
, end
, c
;
1010 Lisp_Object prop
, val
;
1011 /* This is from forward_to_next_line_start in xdisp.c. */
1012 const int MAX_NEWLINE_DISTANCE
= 500;
1014 if (endpos
> charpos
+ MAX_NEWLINE_DISTANCE
)
1015 endpos
= charpos
+ MAX_NEWLINE_DISTANCE
;
1016 cmp_it
->stop_pos
= endpos
;
1019 if (find_composition (charpos
, endpos
, &start
, &end
, &prop
, string
)
1020 && COMPOSITION_VALID_P (start
, end
, prop
))
1022 cmp_it
->stop_pos
= endpos
= start
;
1025 if (NILP (string
) && PT
> charpos
&& PT
< endpos
)
1026 cmp_it
->stop_pos
= PT
;
1027 if (NILP (current_buffer
->enable_multibyte_characters
)
1028 || ! FUNCTIONP (Vauto_composition_function
))
1032 if (STRINGP (string
))
1033 bytepos
= string_char_to_byte (string
, charpos
);
1035 bytepos
= CHAR_TO_BYTE (charpos
);
1039 while (charpos
< endpos
)
1041 if (STRINGP (string
))
1042 FETCH_STRING_CHAR_ADVANCE (c
, string
, charpos
, bytepos
);
1044 FETCH_CHAR_ADVANCE (c
, charpos
, bytepos
);
1050 val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1055 for (; CONSP (val
); val
= XCDR (val
))
1058 if (VECTORP (elt
) && ASIZE (elt
) == 3 && NATNUMP (AREF (elt
, 1))
1059 && charpos
- 1 - XFASTINT (AREF (elt
, 1)) >= start
)
1064 cmp_it
->lookback
= XFASTINT (AREF (elt
, 1));
1065 cmp_it
->stop_pos
= charpos
- 1 - cmp_it
->lookback
;
1071 cmp_it
->stop_pos
= charpos
;
1074 /* Check if the character at CHARPOS (and BYTEPOS) is composed
1075 (possibly with the following characters) on window W. ENDPOS limits
1076 characters to be composed. FACE, in non-NULL, is a base face of
1077 the character. If STRING is not nil, it is a string containing the
1078 character to check, and CHARPOS and BYTEPOS are indices in the
1079 string. In that case, FACE must not be NULL.
1081 If the character is composed, setup members of CMP_IT (id, nglyphs,
1082 and from), and return 1. Otherwise, update CMP_IT->stop_pos, and
1086 composition_reseat_it (cmp_it
, charpos
, bytepos
, endpos
, w
, face
, string
)
1087 struct composition_it
*cmp_it
;
1088 EMACS_INT charpos
, bytepos
, endpos
;
1093 if (cmp_it
->ch
== -2)
1095 composition_compute_stop_pos (cmp_it
, charpos
, bytepos
, endpos
, string
);
1096 if (cmp_it
->ch
== -2)
1102 /* We are looking at a static composition. */
1103 EMACS_INT start
, end
;
1106 find_composition (charpos
, -1, &start
, &end
, &prop
, string
);
1107 cmp_it
->id
= get_composition_id (charpos
, bytepos
, end
- start
,
1110 goto no_composition
;
1111 cmp_it
->nchars
= end
- start
;
1112 cmp_it
->nglyphs
= composition_table
[cmp_it
->id
]->glyph_len
;
1116 Lisp_Object val
, elt
;
1119 val
= CHAR_TABLE_REF (Vcomposition_function_table
, cmp_it
->ch
);
1120 for (; CONSP (val
); val
= XCDR (val
))
1123 if (cmp_it
->lookback
== XFASTINT (AREF (elt
, 1)))
1127 goto no_composition
;
1129 val
= autocmp_chars (val
, charpos
, bytepos
, endpos
, w
, face
, string
);
1130 if (! composition_gstring_p (val
))
1131 goto no_composition
;
1132 if (NILP (LGSTRING_ID (val
)))
1133 val
= composition_gstring_put_cache (val
, -1);
1134 cmp_it
->id
= XINT (LGSTRING_ID (val
));
1135 for (i
= 0; i
< LGSTRING_GLYPH_LEN (val
); i
++)
1136 if (NILP (LGSTRING_GLYPH (val
, i
)))
1138 cmp_it
->nglyphs
= i
;
1141 goto no_composition
;
1147 if (STRINGP (string
))
1148 bytepos
+= MULTIBYTE_LENGTH_NO_CHECK (SDATA (string
) + bytepos
);
1151 composition_compute_stop_pos (cmp_it
, charpos
, bytepos
, endpos
, string
);
1156 composition_update_it (cmp_it
, charpos
, bytepos
, string
)
1157 struct composition_it
*cmp_it
;
1158 EMACS_INT charpos
, bytepos
;
1165 struct composition
*cmp
= composition_table
[cmp_it
->id
];
1167 cmp_it
->to
= cmp_it
->nglyphs
;
1168 if (cmp_it
->nglyphs
== 0)
1172 for (i
= 0; i
< cmp
->glyph_len
; i
++)
1173 if ((c
= COMPOSITION_GLYPH (cmp
, i
)) != '\t')
1178 cmp_it
->width
= cmp
->width
;
1182 Lisp_Object gstring
= composition_gstring_from_id (cmp_it
->id
);
1184 if (cmp_it
->nglyphs
== 0)
1187 cmp_it
->nchars
= LGSTRING_CHAR_LEN (gstring
);
1192 Lisp_Object glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->from
);
1193 int from
= LGLYPH_FROM (glyph
);
1195 c
= XINT (LGSTRING_CHAR (gstring
, from
));
1196 cmp_it
->nchars
= LGLYPH_TO (glyph
) - from
+ 1;
1197 cmp_it
->width
= (LGLYPH_WIDTH (glyph
) > 0
1198 ? CHAR_WIDTH (LGLYPH_CHAR (glyph
)) : 0);
1199 for (cmp_it
->to
= cmp_it
->from
+ 1; cmp_it
->to
< cmp_it
->nglyphs
;
1202 glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->to
);
1203 if (LGLYPH_FROM (glyph
) != from
)
1205 if (LGLYPH_WIDTH (glyph
) > 0)
1206 cmp_it
->width
+= CHAR_WIDTH (LGLYPH_CHAR (glyph
));
1211 charpos
+= cmp_it
->nchars
;
1212 if (STRINGP (string
))
1213 cmp_it
->nbytes
= string_char_to_byte (string
, charpos
) - bytepos
;
1215 cmp_it
->nbytes
= CHAR_TO_BYTE (charpos
) - bytepos
;
1220 struct position_record
1222 EMACS_INT pos
, pos_byte
;
1226 /* Update the members of POSTION to the next character boundary. */
1227 #define FORWARD_CHAR(POSITION, STOP) \
1230 if ((POSITION).pos == (STOP)) \
1232 (POSITION).p = GAP_END_ADDR; \
1233 (POSITION).pos_byte = GPT_BYTE; \
1237 (POSITION).pos_byte += BYTES_BY_CHAR_HEAD (*((POSITION).p)); \
1238 (POSITION).p += BYTES_BY_CHAR_HEAD (*((POSITION).p)); \
1242 /* Update the members of POSTION to the previous character boundary. */
1243 #define BACKWARD_CHAR(POSITION, STOP) \
1245 if ((POSITION).pos == STOP) \
1246 (POSITION).p = GPT_ADDR; \
1248 (POSITION).pos_byte--; \
1250 } while (! CHAR_HEAD_P (*((POSITION).p))); \
1254 static Lisp_Object _work_val
;
1255 static int _work_char
;
1257 /* 1 iff the character C is composable. */
1258 #define CHAR_COMPOSABLE_P(C) \
1259 (_work_val = CHAR_TABLE_REF (Vunicode_category_table, (C)), \
1260 (SYMBOLP (_work_val) \
1261 && (_work_char = SDATA (SYMBOL_NAME (_work_val))[0]) != 'C' \
1262 && _work_char != 'Z'))
1264 /* This is like find_composition, but find an automatic composition
1265 instead. If found, set *GSTRING to the glyph-string representing
1266 the composition, and return 1. Otherwise, return 0. */
1269 find_automatic_composition (pos
, limit
, start
, end
, gstring
, string
)
1270 EMACS_INT pos
, limit
, *start
, *end
;
1271 Lisp_Object
*gstring
, string
;
1273 EMACS_INT head
, tail
, stop
;
1274 struct position_record orig
, cur
, check
, prev
;
1275 Lisp_Object check_val
, val
, elt
;
1281 window
= Fget_buffer_window (Fcurrent_buffer (), Qnil
);
1284 w
= XWINDOW (window
);
1289 head
= BEGV
, tail
= ZV
, stop
= GPT
;
1290 orig
.pos_byte
= CHAR_TO_BYTE (orig
.pos
);
1291 orig
.p
= BYTE_POS_ADDR (orig
.pos_byte
);
1295 head
= 0, tail
= SCHARS (string
), stop
= -1;
1296 orig
.pos_byte
= string_char_to_byte (string
, orig
.pos
);
1297 orig
.p
= SDATA (string
) + orig
.pos_byte
;
1301 head
= max (head
, limit
);
1302 tail
= min (tail
, pos
+ 3);
1306 tail
= min (tail
, limit
+ 3);
1312 /* At first, check if POS is compoable. */
1313 c
= STRING_CHAR (cur
.p
, 0);
1314 if (! CHAR_COMPOSABLE_P (c
))
1318 if (limit
>= cur
.pos
)
1319 goto search_forward
;
1323 val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1325 check_val
= val
, check
= cur
;
1327 while (cur
.pos
+ 1 < tail
)
1329 FORWARD_CHAR (cur
, stop
);
1330 c
= STRING_CHAR (cur
.p
, 0);
1331 if (! CHAR_COMPOSABLE_P (c
))
1333 val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1336 check_val
= val
, check
= cur
;
1341 /* Rewind back to the position where we can safely search forward
1342 for compositions. */
1343 while (cur
.pos
> head
)
1345 BACKWARD_CHAR (cur
, stop
);
1346 c
= STRING_CHAR (cur
.p
, 0);
1347 if (! CHAR_COMPOSABLE_P (c
))
1349 val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1351 check_val
= val
, check
= cur
;
1354 /* Now search forward. */
1357 if (! NILP (check_val
) || limit
>= orig
.pos
)
1359 if (NILP (check_val
))
1363 while (cur
.pos
< tail
)
1365 int need_adjustment
= 0;
1367 if (NILP (check_val
))
1369 c
= STRING_CHAR (cur
.p
, 0);
1370 check_val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1372 for (; CONSP (check_val
); check_val
= XCDR (check_val
))
1374 elt
= XCAR (check_val
);
1375 if (VECTORP (elt
) && ASIZE (elt
) == 3 && NATNUMP (AREF (elt
, 1))
1376 && cur
.pos
- XFASTINT (AREF (elt
, 1)) >= head
)
1378 check
.pos
= cur
.pos
- XFASTINT (AREF (elt
, 1));
1379 if (check
.pos
== cur
.pos
)
1380 check
.pos_byte
= cur
.pos_byte
;
1382 check
.pos_byte
= CHAR_TO_BYTE (check
.pos
);
1383 val
= autocmp_chars (check_val
, check
.pos
, check
.pos_byte
,
1384 tail
, w
, NULL
, string
);
1385 need_adjustment
= 1;
1390 *end
= check
.pos
+ LGSTRING_CHAR_LEN (*gstring
);
1391 if (*start
<= orig
.pos
? *end
> orig
.pos
1392 : limit
>= orig
.pos
)
1395 cur
.pos_byte
= CHAR_TO_BYTE (cur
.pos
);
1400 if (need_adjustment
)
1402 /* As we have called Lisp, there's a possibilily that
1403 buffer/string is relocated. */
1405 cur
.p
= BYTE_POS_ADDR (cur
.pos_byte
);
1407 cur
.p
= SDATA (string
) + cur
.pos_byte
;
1409 if (! CONSP (check_val
))
1410 FORWARD_CHAR (cur
, stop
);
1414 if (! NILP (*gstring
))
1415 return (limit
>= 0 || (*start
<= orig
.pos
&& *end
> orig
.pos
));
1416 if (limit
>= 0 && limit
< orig
.pos
&& prev
.pos
> head
)
1419 BACKWARD_CHAR (cur
, stop
);
1428 composition_adjust_point (last_pt
)
1431 EMACS_INT charpos
, bytepos
, startpos
, beg
, end
, pos
;
1435 if (PT
== BEGV
|| PT
== ZV
)
1438 /* At first check the static composition. */
1439 if (get_property_and_range (PT
, Qcomposition
, &val
, &beg
, &end
, Qnil
)
1440 && COMPOSITION_VALID_P (beg
, end
, val
)
1441 && beg
< PT
/* && end > PT <- It's always the case. */
1442 && (last_pt
<= beg
|| last_pt
>= end
))
1443 return (PT
< last_pt
? beg
: end
);
1445 if (NILP (current_buffer
->enable_multibyte_characters
)
1446 || ! FUNCTIONP (Vauto_composition_function
))
1449 /* Next check the automatic composition. */
1450 if (! find_automatic_composition (PT
, (EMACS_INT
) -1, &beg
, &end
, &val
, Qnil
)
1453 for (i
= 0; i
< LGSTRING_GLYPH_LEN (val
); i
++)
1455 Lisp_Object glyph
= LGSTRING_GLYPH (val
, i
);
1459 if (beg
+ LGLYPH_FROM (glyph
) == PT
)
1461 if (beg
+ LGLYPH_TO (glyph
) >= PT
)
1462 return (PT
< last_pt
1463 ? beg
+ LGLYPH_FROM (glyph
)
1464 : beg
+ LGLYPH_TO (glyph
) + 1);
1469 DEFUN ("composition-get-gstring", Fcomposition_get_gstring
,
1470 Scomposition_get_gstring
, 4, 4, 0,
1471 doc
: /* Return a glyph-string for characters between FROM and TO.
1472 If the glyph string is for graphic display, FONT-OBJECT must be
1473 a font-object to use for those characters.
1474 Otherwise (for terminal display), FONT-OBJECT must be a terminal ID, a
1475 frame, or nil for the selected frame's terminal device.
1477 If the optional 4th argument STRING is not nil, it is a string
1478 containing the target characters between indices FROM and TO.
1480 A glyph-string is a vector containing information about how to display
1481 a specific character sequence. The format is:
1482 [HEADER ID GLYPH ...]
1484 HEADER is a vector of this form:
1485 [FONT-OBJECT CHAR ...]
1487 FONT-OBJECT is a font-object for all glyphs in the glyph-string,
1488 or the terminal coding system of the specified terminal.
1489 CHARs are characters to be composed by GLYPHs.
1491 ID is an identification number of the glyph-string. It may be nil if
1494 GLYPH is a vector whose elements have this form:
1495 [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT
1496 [ [X-OFF Y-OFF WADJUST] | nil] ]
1498 FROM-IDX and TO-IDX are used internally and should not be touched.
1499 C is the character of the glyph.
1500 CODE is the glyph-code of C in FONT-OBJECT.
1501 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
1502 X-OFF and Y-OFF are offsets to the base position for the glyph.
1503 WADJUST is the adjustment to the normal width of the glyph.
1505 If GLYPH is nil, the remaining elements of the glyph-string vector
1506 should be ignored. */)
1507 (from
, to
, font_object
, string
)
1508 Lisp_Object font_object
, from
, to
, string
;
1510 Lisp_Object gstring
, header
;
1511 EMACS_INT frompos
, topos
;
1513 CHECK_NATNUM (from
);
1515 if (! FONT_OBJECT_P (font_object
))
1517 struct coding_system
*coding
;
1518 struct terminal
*terminal
= get_terminal (font_object
, 1);
1520 coding
= ((TERMINAL_TERMINAL_CODING (terminal
)->common_flags
1521 & CODING_REQUIRE_ENCODING_MASK
)
1522 ? TERMINAL_TERMINAL_CODING (terminal
) : &safe_terminal_coding
);
1523 font_object
= CODING_ID_NAME (coding
->id
);
1526 header
= fill_gstring_header (Qnil
, from
, to
, font_object
, string
);
1527 gstring
= gstring_lookup_cache (header
);
1528 if (! NILP (gstring
))
1531 frompos
= XINT (from
);
1533 if (LGSTRING_GLYPH_LEN (gstring_work
) < topos
- frompos
)
1534 gstring_work
= Fmake_vector (make_number (topos
- frompos
+ 2), Qnil
);
1535 LGSTRING_SET_HEADER (gstring_work
, header
);
1536 LGSTRING_SET_ID (gstring_work
, Qnil
);
1537 fill_gstring_body (gstring_work
);
1538 return gstring_work
;
1542 /* Emacs Lisp APIs. */
1544 DEFUN ("compose-region-internal", Fcompose_region_internal
,
1545 Scompose_region_internal
, 2, 4, 0,
1546 doc
: /* Internal use only.
1548 Compose text in the region between START and END.
1549 Optional 3rd and 4th arguments are COMPONENTS and MODIFICATION-FUNC
1550 for the composition. See `compose-region' for more details. */)
1551 (start
, end
, components
, modification_func
)
1552 Lisp_Object start
, end
, components
, modification_func
;
1554 validate_region (&start
, &end
);
1555 if (!NILP (components
)
1556 && !INTEGERP (components
)
1557 && !CONSP (components
)
1558 && !STRINGP (components
))
1559 CHECK_VECTOR (components
);
1561 compose_text (XINT (start
), XINT (end
), components
, modification_func
, Qnil
);
1565 DEFUN ("compose-string-internal", Fcompose_string_internal
,
1566 Scompose_string_internal
, 3, 5, 0,
1567 doc
: /* Internal use only.
1569 Compose text between indices START and END of STRING.
1570 Optional 4th and 5th arguments are COMPONENTS and MODIFICATION-FUNC
1571 for the composition. See `compose-string' for more details. */)
1572 (string
, start
, end
, components
, modification_func
)
1573 Lisp_Object string
, start
, end
, components
, modification_func
;
1575 CHECK_STRING (string
);
1576 CHECK_NUMBER (start
);
1579 if (XINT (start
) < 0 ||
1580 XINT (start
) > XINT (end
)
1581 || XINT (end
) > SCHARS (string
))
1582 args_out_of_range (start
, end
);
1584 compose_text (XINT (start
), XINT (end
), components
, modification_func
, string
);
1588 DEFUN ("find-composition-internal", Ffind_composition_internal
,
1589 Sfind_composition_internal
, 4, 4, 0,
1590 doc
: /* Internal use only.
1592 Return information about composition at or nearest to position POS.
1593 See `find-composition' for more details. */)
1594 (pos
, limit
, string
, detail_p
)
1595 Lisp_Object pos
, limit
, string
, detail_p
;
1597 Lisp_Object prop
, tail
, gstring
;
1598 EMACS_INT start
, end
, from
, to
;
1601 CHECK_NUMBER_COERCE_MARKER (pos
);
1605 CHECK_NUMBER_COERCE_MARKER (limit
);
1613 CHECK_STRING (string
);
1614 if (XINT (pos
) < 0 || XINT (pos
) > SCHARS (string
))
1615 args_out_of_range (string
, pos
);
1619 if (XINT (pos
) < BEGV
|| XINT (pos
) > ZV
)
1620 args_out_of_range (Fcurrent_buffer (), pos
);
1623 if (!find_composition (from
, to
, &start
, &end
, &prop
, string
))
1625 if (!NILP (current_buffer
->enable_multibyte_characters
)
1626 && FUNCTIONP (Vauto_composition_function
)
1627 && find_automatic_composition (from
, to
, &start
, &end
, &gstring
,
1629 return list3 (make_number (start
), make_number (end
), gstring
);
1632 if ((end
<= XINT (pos
) || start
> XINT (pos
)))
1636 if (find_automatic_composition (from
, to
, &s
, &e
, &gstring
, string
)
1637 && (e
<= XINT (pos
) ? e
> end
: s
< start
))
1638 return list3 (make_number (start
), make_number (end
), gstring
);
1640 if (!COMPOSITION_VALID_P (start
, end
, prop
))
1641 return Fcons (make_number (start
), Fcons (make_number (end
),
1642 Fcons (Qnil
, Qnil
)));
1643 if (NILP (detail_p
))
1644 return Fcons (make_number (start
), Fcons (make_number (end
),
1647 if (COMPOSITION_REGISTERD_P (prop
))
1648 id
= COMPOSITION_ID (prop
);
1651 int start_byte
= (NILP (string
)
1652 ? CHAR_TO_BYTE (start
)
1653 : string_char_to_byte (string
, start
));
1654 id
= get_composition_id (start
, start_byte
, end
- start
, prop
, string
);
1659 Lisp_Object components
, relative_p
, mod_func
;
1660 enum composition_method method
= COMPOSITION_METHOD (prop
);
1661 int width
= composition_table
[id
]->width
;
1663 components
= Fcopy_sequence (COMPOSITION_COMPONENTS (prop
));
1664 relative_p
= (method
== COMPOSITION_WITH_RULE_ALTCHARS
1666 mod_func
= COMPOSITION_MODIFICATION_FUNC (prop
);
1667 tail
= Fcons (components
,
1670 Fcons (make_number (width
), Qnil
))));
1675 return Fcons (make_number (start
), Fcons (make_number (end
), tail
));
1680 syms_of_composite ()
1684 Qcomposition
= intern ("composition");
1685 staticpro (&Qcomposition
);
1687 /* Make a hash table for static composition. */
1689 Lisp_Object args
[6];
1690 extern Lisp_Object QCsize
;
1694 args
[2] = QCweakness
;
1695 /* We used to make the hash table weak so that unreferenced
1696 compositions can be garbage-collected. But, usually once
1697 created compositions are repeatedly used in an Emacs session,
1698 and thus it's not worth to save memory in such a way. So, we
1699 make the table not weak. */
1702 args
[5] = make_number (311);
1703 composition_hash_table
= Fmake_hash_table (6, args
);
1704 staticpro (&composition_hash_table
);
1707 /* Make a hash table for glyph-string. */
1709 Lisp_Object args
[6];
1710 extern Lisp_Object QCsize
;
1714 args
[2] = QCweakness
;
1717 args
[5] = make_number (311);
1718 gstring_hash_table
= Fmake_hash_table (6, args
);
1719 staticpro (&gstring_hash_table
);
1722 staticpro (&gstring_work_headers
);
1723 gstring_work_headers
= Fmake_vector (make_number (8), Qnil
);
1724 for (i
= 0; i
< 8; i
++)
1725 ASET (gstring_work_headers
, i
, Fmake_vector (make_number (i
+ 2), Qnil
));
1726 staticpro (&gstring_work
);
1727 gstring_work
= Fmake_vector (make_number (10), Qnil
);
1729 /* Text property `composition' should be nonsticky by default. */
1730 Vtext_property_default_nonsticky
1731 = Fcons (Fcons (Qcomposition
, Qt
), Vtext_property_default_nonsticky
);
1733 DEFVAR_LISP ("compose-chars-after-function", &Vcompose_chars_after_function
,
1734 doc
: /* Function to adjust composition of buffer text.
1736 This function is called with three arguments: FROM, TO, and OBJECT.
1737 FROM and TO specify the range of text whose composition should be
1738 adjusted. OBJECT, if non-nil, is a string that contains the text.
1740 This function is called after a text with `composition' property is
1741 inserted or deleted to keep `composition' property of buffer text
1744 The default value is the function `compose-chars-after'. */);
1745 Vcompose_chars_after_function
= intern ("compose-chars-after");
1747 Qauto_composed
= intern ("auto-composed");
1748 staticpro (&Qauto_composed
);
1750 Qauto_composition_function
= intern ("auto-composition-function");
1751 staticpro (&Qauto_composition_function
);
1753 DEFVAR_LISP ("auto-composition-function", &Vauto_composition_function
,
1754 doc
: /* Function to call to compose characters automatically.
1755 This function is called from the display routine with four arguments:
1756 FROM, TO, WINDOW, and STRING.
1758 If STRING is nil, the function must compose characters in the region
1759 between FROM and TO in the current buffer.
1761 Otherwise, STRING is a string, and FROM and TO are indices into the
1762 string. In this case, the function must compose characters in the
1764 Vauto_composition_function
= Qnil
;
1766 DEFVAR_LISP ("composition-function-table", &Vcomposition_function_table
,
1767 doc
: /* Char-table of functions for automatic character composition.
1768 For each character that has to be composed automatically with
1769 preceding and/or following characters, this char-table contains
1770 a function to call to compose that character.
1772 The element at index C in the table, if non-nil, is a list of
1773 this form: ([PATTERN PREV-CHARS FUNC] ...)
1775 PATTERN is a regular expression which C and the surrounding
1776 characters must match.
1778 PREV-CHARS is a number of characters before C to check the
1779 matching with PATTERN. If it is 0, PATTERN must match C and
1780 the following characters. If it is 1, PATTERN must match a
1781 character before C and the following characters.
1783 If PREV-CHARS is 0, PATTERN can be nil, which means that the
1784 single character C should be composed.
1786 FUNC is a function to return a glyph-string representing a
1787 composition of the characters that match PATTERN. It is
1788 called with one argument GSTRING.
1790 GSTRING is a template of a glyph-string to return. It is already
1791 filled with a proper header for the characters to compose, and
1792 glyphs corresponding to those characters one by one. The
1793 function must return a new glyph-string with the same header as
1794 GSTRING, or modify GSTRING itself and return it.
1796 See also the documentation of `auto-composition-mode'. */);
1797 Vcomposition_function_table
= Fmake_char_table (Qnil
, Qnil
);
1799 defsubr (&Scompose_region_internal
);
1800 defsubr (&Scompose_string_internal
);
1801 defsubr (&Sfind_composition_internal
);
1802 defsubr (&Scomposition_get_gstring
);
1805 /* arch-tag: 79cefaf8-ca48-4eed-97e5-d5afb290d272
1806 (do not change this comment) */