1 /* Composite sequence support.
2 Copyright (C) 2001, 2002, 2003, 2004, 2005,
3 2006, 2007, 2008 Free Software Foundation, Inc.
4 Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
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"
30 #include "intervals.h"
33 #include "dispextern.h"
36 /* Emacs uses special text property `composition' to support character
37 composition. A sequence of characters that have the same (i.e. eq)
38 `composition' property value is treated as a single composite
39 sequence (we call it just `composition' here after). Characters in
40 a composition are all composed somehow on the screen.
42 The property value has this form when the composition is made:
43 ((LENGTH . COMPONENTS) . MODIFICATION-FUNC)
44 then turns to this form:
45 (COMPOSITION-ID . (LENGTH COMPONENTS-VEC . MODIFICATION-FUNC))
46 when the composition is registered in composition_hash_table and
47 composition_table. These rather peculiar structures were designed
48 to make it easy to distinguish them quickly (we can do that by
49 checking only the first element) and to extract LENGTH (from the
50 former form) and COMPOSITION-ID (from the latter form).
52 We register a composition when it is displayed, or when the width
53 is required (for instance, to calculate columns).
55 LENGTH -- Length of the composition. This information is used to
56 check the validity of the composition.
58 COMPONENTS -- Character, string, vector, list, or nil.
60 If it is nil, characters in the text are composed relatively
61 according to their metrics in font glyphs.
63 If it is a character or a string, the character or characters
64 in the string are composed relatively.
66 If it is a vector or list of integers, the element is a
67 character or an encoded composition rule. The characters are
68 composed according to the rules. (2N)th elements are
69 characters to be composed and (2N+1)th elements are
70 composition rules to tell how to compose (2N+2)th element with
71 the previously composed 2N glyphs.
73 COMPONENTS-VEC -- Vector of integers. In relative composition, the
74 elements are characters to be composed. In rule-base
75 composition, the elements are characters or encoded
78 MODIFICATION-FUNC -- If non nil, it is a function to call when the
79 composition gets invalid after a modification in a buffer. If
80 it is nil, a function in `composition-function-table' of the
81 first character in the sequence is called.
83 COMPOSITION-ID --Identification number of the composition. It is
84 used as an index to composition_table for the composition.
86 When Emacs has to display a composition or has to know its
87 displaying width, the function get_composition_id is called. It
88 returns COMPOSITION-ID so that the caller can access the
89 information about the composition through composition_table. If a
90 COMPOSITION-ID has not yet been assigned to the composition,
91 get_composition_id checks the validity of `composition' property,
92 and, if valid, assigns a new ID, registers the information in
93 composition_hash_table and composition_table, and changes the form
94 of the property value. If the property is invalid, return -1
95 without changing the property value.
97 We use two tables to keep information about composition;
98 composition_hash_table and composition_table.
100 The former is a hash table in which keys are COMPONENTS-VECs and
101 values are the corresponding COMPOSITION-IDs. This hash table is
102 weak, but as each key (COMPONENTS-VEC) is also kept as a value of the
103 `composition' property, it won't be collected as garbage until all
104 bits of text that have the same COMPONENTS-VEC are deleted.
106 The latter is a table of pointers to `struct composition' indexed
107 by COMPOSITION-ID. This structure keeps the other information (see
110 In general, a text property holds information about individual
111 characters. But, a `composition' property holds information about
112 a sequence of characters (in this sense, it is like the `intangible'
113 property). That means that we should not share the property value
114 in adjacent compositions -- we can't distinguish them if they have the
115 same property. So, after any changes, we call
116 `update_compositions' and change a property of one of adjacent
117 compositions to a copy of it. This function also runs a proper
118 composition modification function to make a composition that gets
119 invalid by the change valid again.
121 As the value of the `composition' property holds information about a
122 specific range of text, the value gets invalid if we change the
123 text in the range. We treat the `composition' property as always
124 rear-nonsticky (currently by setting default-text-properties to
125 (rear-nonsticky (composition))) and we never make properties of
126 adjacent compositions identical. Thus, any such changes make the
127 range just shorter. So, we can check the validity of the `composition'
128 property by comparing LENGTH information with the actual length of
134 Lisp_Object Qcomposition
;
136 /* Table of pointers to the structure `composition' indexed by
137 COMPOSITION-ID. This structure is for storing information about
138 each composition except for COMPONENTS-VEC. */
139 struct composition
**composition_table
;
141 /* The current size of `composition_table'. */
142 static int composition_table_size
;
144 /* Number of compositions currently made. */
147 /* Hash table for compositions. The key is COMPONENTS-VEC of
148 `composition' property. The value is the corresponding
150 Lisp_Object composition_hash_table
;
152 /* Function to call to adjust composition. */
153 Lisp_Object Vcompose_chars_after_function
;
155 Lisp_Object Qauto_composed
;
156 Lisp_Object Vauto_composition_function
;
157 Lisp_Object Qauto_composition_function
;
158 Lisp_Object Vcomposition_function_table
;
160 EXFUN (Fremove_list_of_text_properties
, 4);
162 /* Temporary variable used in macros COMPOSITION_XXX. */
163 Lisp_Object composition_temp
;
166 /* Return COMPOSITION-ID of a composition at buffer position
167 CHARPOS/BYTEPOS and length NCHARS. The `composition' property of
168 the sequence is PROP. STRING, if non-nil, is a string that
169 contains the composition instead of the current buffer.
171 If the composition is invalid, return -1. */
174 get_composition_id (charpos
, bytepos
, nchars
, prop
, string
)
175 int charpos
, bytepos
, nchars
;
176 Lisp_Object prop
, string
;
178 Lisp_Object id
, length
, components
, key
, *key_contents
;
180 struct Lisp_Hash_Table
*hash_table
= XHASH_TABLE (composition_hash_table
);
183 struct composition
*cmp
;
187 Form-A: ((LENGTH . COMPONENTS) . MODIFICATION-FUNC)
189 Form-B: (COMPOSITION-ID . (LENGTH COMPONENTS-VEC . MODIFICATION-FUNC))
191 if (nchars
== 0 || !CONSP (prop
))
192 goto invalid_composition
;
197 /* PROP should be Form-B. */
198 if (XINT (id
) < 0 || XINT (id
) >= n_compositions
)
199 goto invalid_composition
;
203 /* PROP should be Form-A.
204 Thus, ID should be (LENGTH . COMPONENTS). */
206 goto invalid_composition
;
208 if (!INTEGERP (length
) || XINT (length
) != nchars
)
209 goto invalid_composition
;
211 components
= XCDR (id
);
213 /* Check if the same composition has already been registered or not
214 by consulting composition_hash_table. The key for this table is
215 COMPONENTS (converted to a vector COMPONENTS-VEC) or, if it is
216 nil, vector of characters in the composition range. */
217 if (INTEGERP (components
))
218 key
= Fmake_vector (make_number (1), components
);
219 else if (STRINGP (components
) || CONSP (components
))
220 key
= Fvconcat (1, &components
);
221 else if (VECTORP (components
))
223 else if (NILP (components
))
225 key
= Fmake_vector (make_number (nchars
), Qnil
);
226 if (STRINGP (string
))
227 for (i
= 0; i
< nchars
; i
++)
229 FETCH_STRING_CHAR_ADVANCE (ch
, string
, charpos
, bytepos
);
230 XVECTOR (key
)->contents
[i
] = make_number (ch
);
233 for (i
= 0; i
< nchars
; i
++)
235 FETCH_CHAR_ADVANCE (ch
, charpos
, bytepos
);
236 XVECTOR (key
)->contents
[i
] = make_number (ch
);
240 goto invalid_composition
;
242 hash_index
= hash_lookup (hash_table
, key
, &hash_code
);
245 /* We have already registered the same composition. Change PROP
246 from Form-A above to Form-B while replacing COMPONENTS with
247 COMPONENTS-VEC stored in the hash table. We can directly
248 modify the cons cell of PROP because it is not shared. */
249 key
= HASH_KEY (hash_table
, hash_index
);
250 id
= HASH_VALUE (hash_table
, hash_index
);
252 XSETCDR (prop
, Fcons (make_number (nchars
), Fcons (key
, XCDR (prop
))));
256 /* This composition is a new one. We must register it. */
258 /* Check if we have sufficient memory to store this information. */
259 if (composition_table_size
== 0)
261 composition_table_size
= 256;
263 = (struct composition
**) xmalloc (sizeof (composition_table
[0])
264 * composition_table_size
);
266 else if (composition_table_size
<= n_compositions
)
268 composition_table_size
+= 256;
270 = (struct composition
**) xrealloc (composition_table
,
271 sizeof (composition_table
[0])
272 * composition_table_size
);
275 key_contents
= XVECTOR (key
)->contents
;
277 /* Check if the contents of COMPONENTS are valid if COMPONENTS is a
278 vector or a list. It should be a sequence of:
279 char1 rule1 char2 rule2 char3 ... ruleN charN+1 */
281 if (VECTORP (components
)
282 && ASIZE (components
) >= 2
283 && VECTORP (AREF (components
, 0)))
285 /* COMPONENTS is a glyph-string. */
286 int len
= ASIZE (key
);
288 for (i
= 1; i
< len
; i
++)
289 if (! VECTORP (AREF (key
, i
)))
290 goto invalid_composition
;
292 else if (VECTORP (components
) || CONSP (components
))
294 int len
= XVECTOR (key
)->size
;
296 /* The number of elements should be odd. */
298 goto invalid_composition
;
299 /* All elements should be integers (character or encoded
300 composition rule). */
301 for (i
= 0; i
< len
; i
++)
303 if (!INTEGERP (key_contents
[i
]))
304 goto invalid_composition
;
308 /* Change PROP from Form-A above to Form-B. We can directly modify
309 the cons cell of PROP because it is not shared. */
310 XSETFASTINT (id
, n_compositions
);
312 XSETCDR (prop
, Fcons (make_number (nchars
), Fcons (key
, XCDR (prop
))));
314 /* Register the composition in composition_hash_table. */
315 hash_index
= hash_put (hash_table
, key
, id
, hash_code
);
317 /* Register the composition in composition_table. */
318 cmp
= (struct composition
*) xmalloc (sizeof (struct composition
));
320 cmp
->method
= (NILP (components
)
321 ? COMPOSITION_RELATIVE
322 : ((INTEGERP (components
) || STRINGP (components
))
323 ? COMPOSITION_WITH_ALTCHARS
324 : COMPOSITION_WITH_RULE_ALTCHARS
));
325 cmp
->hash_index
= hash_index
;
326 glyph_len
= (cmp
->method
== COMPOSITION_WITH_RULE_ALTCHARS
327 ? (XVECTOR (key
)->size
+ 1) / 2
328 : XVECTOR (key
)->size
);
329 cmp
->glyph_len
= glyph_len
;
330 cmp
->offsets
= (short *) xmalloc (sizeof (short) * glyph_len
* 2);
333 if (cmp
->method
!= COMPOSITION_WITH_RULE_ALTCHARS
)
335 /* Relative composition. */
337 for (i
= 0; i
< glyph_len
; i
++)
340 ch
= XINT (key_contents
[i
]);
341 this_width
= (ch
== '\t' ? 1 : CHAR_WIDTH (ch
));
342 if (cmp
->width
< this_width
)
343 cmp
->width
= this_width
;
348 /* Rule-base composition. */
349 float leftmost
= 0.0, rightmost
;
351 ch
= XINT (key_contents
[0]);
352 rightmost
= ch
!= '\t' ? CHAR_WIDTH (ch
) : 1;
354 for (i
= 1; i
< glyph_len
; i
+= 2)
356 int rule
, gref
, nref
, xoff
, yoff
;
360 rule
= XINT (key_contents
[i
]);
361 ch
= XINT (key_contents
[i
+ 1]);
362 this_width
= ch
!= '\t' ? CHAR_WIDTH (ch
) : 1;
364 /* A composition rule is specified by an integer value
365 that encodes global and new reference points (GREF and
366 NREF). GREF and NREF are specified by numbers as
374 ---3---4---5--- baseline
378 COMPOSITION_DECODE_RULE (rule
, gref
, nref
, xoff
, yoff
);
379 this_left
= (leftmost
380 + (gref
% 3) * (rightmost
- leftmost
) / 2.0
381 - (nref
% 3) * this_width
/ 2.0);
383 if (this_left
< leftmost
)
384 leftmost
= this_left
;
385 if (this_left
+ this_width
> rightmost
)
386 rightmost
= this_left
+ this_width
;
389 cmp
->width
= rightmost
- leftmost
;
390 if (cmp
->width
< (rightmost
- leftmost
))
391 /* To get a ceiling integer value. */
395 composition_table
[n_compositions
] = cmp
;
397 return n_compositions
++;
400 /* Would it be better to remove this `composition' property? */
405 /* Find a static composition at or nearest to position POS of OBJECT
408 OBJECT defaults to the current buffer. If there's a composition at
409 POS, set *START and *END to the start and end of the sequence,
410 *PROP to the `composition' property, and return 1.
412 If there's no composition at POS and LIMIT is negative, return 0.
414 Otherwise, search for a composition forward (LIMIT > POS) or
415 backward (LIMIT < POS). In this case, LIMIT bounds the search.
417 If a composition is found, set *START, *END, and *PROP as above,
418 and return 1, else return 0.
420 This doesn't check the validity of composition. */
423 find_composition (pos
, limit
, start
, end
, prop
, object
)
425 EMACS_INT
*start
, *end
;
426 Lisp_Object
*prop
, object
;
430 if (get_property_and_range (pos
, Qcomposition
, prop
, start
, end
, object
))
433 if (limit
< 0 || limit
== pos
)
436 if (limit
> pos
) /* search forward */
438 val
= Fnext_single_property_change (make_number (pos
), Qcomposition
,
439 object
, make_number (limit
));
444 else /* search backward */
446 if (get_property_and_range (pos
- 1, Qcomposition
, prop
, start
, end
,
449 val
= Fprevious_single_property_change (make_number (pos
), Qcomposition
,
450 object
, make_number (limit
));
456 get_property_and_range (pos
, Qcomposition
, prop
, start
, end
, object
);
460 /* Run a proper function to adjust the composition sitting between
461 FROM and TO with property PROP. */
464 run_composition_function (from
, to
, prop
)
469 EMACS_INT start
, end
;
471 func
= COMPOSITION_MODIFICATION_FUNC (prop
);
472 /* If an invalid composition precedes or follows, try to make them
475 && find_composition (from
- 1, -1, &start
, &end
, &prop
, Qnil
)
476 && !COMPOSITION_VALID_P (start
, end
, prop
))
479 && find_composition (to
, -1, &start
, &end
, &prop
, Qnil
)
480 && !COMPOSITION_VALID_P (start
, end
, prop
))
482 if (!NILP (Ffboundp (func
)))
483 call2 (func
, make_number (from
), make_number (to
));
486 /* Make invalid compositions adjacent to or inside FROM and TO valid.
487 CHECK_MASK is bitwise `or' of mask bits defined by macros
488 CHECK_XXX (see the comment in composite.h).
490 It also resets the text-property `auto-composed' to a proper region
491 so that automatic character composition works correctly later while
492 displaying the region.
494 This function is called when a buffer text is changed. If the
495 change is deletion, FROM == TO. Otherwise, FROM < TO. */
498 update_compositions (from
, to
, 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 (list
)
609 Lisp_Object plist
, val
;
611 for (; CONSP (list
); list
= XCDR (list
))
613 plist
= XCAR (XCDR (XCDR (XCAR (list
))));
614 while (CONSP (plist
) && CONSP (XCDR (plist
)))
616 if (EQ (XCAR (plist
), Qcomposition
)
617 && (val
= XCAR (XCDR (plist
)), CONSP (val
)))
618 XSETCAR (XCDR (plist
), Fcons (XCAR (val
), XCDR (val
)));
619 plist
= XCDR (XCDR (plist
));
625 /* Make text in the region between START and END a composition that
626 has COMPONENTS and MODIFICATION-FUNC.
628 If STRING is non-nil, then operate on characters contained between
629 indices START and END in STRING. */
632 compose_text (start
, end
, components
, modification_func
, string
)
634 Lisp_Object components
, modification_func
, string
;
638 prop
= Fcons (Fcons (make_number (end
- start
), components
),
640 Fput_text_property (make_number (start
), make_number (end
),
641 Qcomposition
, prop
, string
);
645 static Lisp_Object autocmp_chars
P_ ((Lisp_Object
, EMACS_INT
, EMACS_INT
,
646 EMACS_INT
, struct window
*,
647 struct face
*, Lisp_Object
));
650 /* Lisp glyph-string handlers */
652 /* Hash table for automatic composition. The key is a header of a
653 lgstring (Lispy glyph-string), and the value is a body of a
656 static Lisp_Object gstring_hash_table
;
658 static Lisp_Object gstring_lookup_cache
P_ ((Lisp_Object
));
661 gstring_lookup_cache (header
)
664 struct Lisp_Hash_Table
*h
= XHASH_TABLE (gstring_hash_table
);
665 int i
= hash_lookup (h
, header
, NULL
);
667 return (i
>= 0 ? HASH_VALUE (h
, i
) : Qnil
);
671 composition_gstring_put_cache (gstring
, len
)
675 struct Lisp_Hash_Table
*h
= XHASH_TABLE (gstring_hash_table
);
677 Lisp_Object header
, copy
;
680 header
= LGSTRING_HEADER (gstring
);
681 hash
= h
->hashfn (h
, header
);
684 len
= LGSTRING_GLYPH_LEN (gstring
);
685 for (i
= 0; i
< len
; i
++)
686 if (NILP (LGSTRING_GLYPH (gstring
, i
)))
691 copy
= Fmake_vector (make_number (len
+ 2), Qnil
);
692 LGSTRING_SET_HEADER (copy
, Fcopy_sequence (header
));
693 for (i
= 0; i
< len
; i
++)
694 LGSTRING_SET_GLYPH (copy
, i
, Fcopy_sequence (LGSTRING_GLYPH (gstring
, i
)));
695 i
= hash_put (h
, LGSTRING_HEADER (copy
), copy
, hash
);
696 LGSTRING_SET_ID (copy
, make_number (i
));
701 composition_gstring_from_id (id
)
704 struct Lisp_Hash_Table
*h
= XHASH_TABLE (gstring_hash_table
);
706 return HASH_VALUE (h
, id
);
709 static Lisp_Object fill_gstring_header
P_ ((Lisp_Object
, Lisp_Object
,
710 Lisp_Object
, Lisp_Object
,
714 composition_gstring_p (gstring
)
720 if (! VECTORP (gstring
) || ASIZE (gstring
) < 2)
722 header
= LGSTRING_HEADER (gstring
);
723 if (! VECTORP (header
) || ASIZE (header
) < 2)
725 if (! NILP (LGSTRING_FONT (gstring
))
726 && ! FONT_OBJECT_P (LGSTRING_FONT (gstring
)))
728 for (i
= 1; i
< ASIZE (LGSTRING_HEADER (gstring
)); i
++)
729 if (! NATNUMP (AREF (LGSTRING_HEADER (gstring
), i
)))
731 if (! NILP (LGSTRING_ID (gstring
)) && ! NATNUMP (LGSTRING_ID (gstring
)))
733 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
735 Lisp_Object glyph
= LGSTRING_GLYPH (gstring
, i
);
738 if (! VECTORP (glyph
) || ASIZE (glyph
) != LGLYPH_SIZE
)
745 composition_gstring_width (gstring
, from
, to
, metrics
)
748 struct font_metrics
*metrics
;
755 Lisp_Object font_object
= LGSTRING_FONT (gstring
);
756 struct font
*font
= XFONT_OBJECT (font_object
);
758 metrics
->ascent
= font
->ascent
;
759 metrics
->descent
= font
->descent
;
760 metrics
->width
= metrics
->lbearing
= metrics
->rbearing
= 0;
762 for (glyph
= &LGSTRING_GLYPH (gstring
, from
); from
< to
; from
++, glyph
++)
766 if (NILP (LGLYPH_ADJUSTMENT (*glyph
)))
767 width
+= LGLYPH_WIDTH (*glyph
);
769 width
+= LGLYPH_WADJUST (*glyph
);
772 x
= metrics
->width
+ LGLYPH_LBEARING (*glyph
) + LGLYPH_XOFF (*glyph
);
773 if (metrics
->lbearing
> x
)
774 metrics
->lbearing
= x
;
775 x
= metrics
->width
+ LGLYPH_RBEARING (*glyph
) + LGLYPH_XOFF (*glyph
);
776 if (metrics
->rbearing
< x
)
777 metrics
->rbearing
= x
;
778 metrics
->width
= width
;
779 x
= LGLYPH_ASCENT (*glyph
) - LGLYPH_YOFF (*glyph
);
780 if (metrics
->ascent
< x
)
782 x
= LGLYPH_DESCENT (*glyph
) - LGLYPH_YOFF (*glyph
);
783 if (metrics
->descent
< x
)
784 metrics
->descent
= x
;
791 static Lisp_Object gstring_work
;
792 static Lisp_Object gstring_work_headers
;
795 fill_gstring_header (header
, start
, end
, font_object
, string
)
796 Lisp_Object header
, start
, end
, font_object
, string
;
798 EMACS_INT from
, to
, from_byte
;
803 if (NILP (current_buffer
->enable_multibyte_characters
))
804 error ("Attempt to shape unibyte text");
805 validate_region (&start
, &end
);
806 from
= XFASTINT (start
);
808 from_byte
= CHAR_TO_BYTE (from
);
812 CHECK_STRING (string
);
813 if (! STRING_MULTIBYTE (current_buffer
->enable_multibyte_characters
))
814 error ("Attempt to shape unibyte text");
815 CHECK_NATNUM (start
);
819 if (from
< 0 || from
> to
|| to
> SCHARS (string
))
820 args_out_of_range_3 (string
, start
, end
);
821 from_byte
= string_char_to_byte (string
, from
);
826 error ("Attempt to shape zero-length text");
827 if (VECTORP (header
))
829 if (ASIZE (header
) != len
+ 1)
830 args_out_of_range (header
, make_number (len
+ 1));
835 header
= AREF (gstring_work_headers
, len
- 1);
837 header
= Fmake_vector (make_number (len
+ 1), Qnil
);
840 ASET (header
, 0, font_object
);
841 for (i
= 0; i
< len
; i
++)
846 FETCH_CHAR_ADVANCE_NO_CHECK (c
, from
, from_byte
);
848 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, from
, from_byte
);
849 ASET (header
, i
+ 1, make_number (c
));
854 extern void font_fill_lglyph_metrics
P_ ((Lisp_Object
, Lisp_Object
));
857 fill_gstring_body (gstring
)
860 Lisp_Object font_object
= LGSTRING_FONT (gstring
);
861 Lisp_Object header
= AREF (gstring
, 0);
862 EMACS_INT len
= LGSTRING_CHAR_LEN (gstring
);
865 for (i
= 0; i
< len
; i
++)
867 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
868 EMACS_INT c
= XINT (AREF (header
, i
+ 1));
873 LGSTRING_SET_GLYPH (gstring
, i
, g
);
875 LGLYPH_SET_FROM (g
, i
);
876 LGLYPH_SET_TO (g
, i
);
877 LGLYPH_SET_CHAR (g
, c
);
878 if (! NILP (font_object
))
880 font_fill_lglyph_metrics (g
, font_object
);
884 int width
= XFASTINT (CHAR_TABLE_REF (Vchar_width_table
, c
));
886 LGLYPH_SET_CODE (g
, c
);
887 LGLYPH_SET_LBEARING (g
, 0);
888 LGLYPH_SET_RBEARING (g
, width
);
889 LGLYPH_SET_WIDTH (g
, width
);
890 LGLYPH_SET_ASCENT (g
, 1);
891 LGLYPH_SET_DESCENT (g
, 0);
893 LGLYPH_SET_ADJUSTMENT (g
, Qnil
);
895 if (i
< LGSTRING_GLYPH_LEN (gstring
))
896 LGSTRING_SET_GLYPH (gstring
, i
, Qnil
);
899 EXFUN (Fre_search_forward
, 4);
901 /* Try to compose the characters at CHARPOS according to CFT_ELEMENT
902 which is an element of composition-fucntion-table (which see).
903 LIMIT limits the characters to compose. STRING, if not nil, is a
904 target string. WIN is a window where the characters are being
908 autocmp_chars (cft_element
, charpos
, bytepos
, limit
, win
, face
, string
)
909 Lisp_Object cft_element
;
910 EMACS_INT charpos
, bytepos
, limit
;
915 int count
= SPECPDL_INDEX ();
916 FRAME_PTR f
= XFRAME (win
->frame
);
917 Lisp_Object pos
= make_number (charpos
);
918 EMACS_INT pt
= PT
, pt_byte
= PT_BYTE
;
921 record_unwind_save_match_data ();
922 for (lookback
= -1; CONSP (cft_element
); cft_element
= XCDR (cft_element
))
924 Lisp_Object elt
= XCAR (cft_element
);
926 Lisp_Object font_object
= Qnil
, gstring
;
929 if (! VECTORP (elt
) || ASIZE (elt
) != 3)
932 lookback
= XFASTINT (AREF (elt
, 1));
933 else if (lookback
!= XFASTINT (AREF (elt
, 1)))
937 TEMP_SET_PT_BOTH (charpos
, bytepos
);
941 ? EQ (Fstring_match (re
, string
, pos
), pos
)
942 : (! NILP (Fre_search_forward (re
, make_number (limit
), Qt
, Qnil
))
943 && EQ (Fmatch_beginning (make_number (0)), pos
)))))
945 to
= (NILP (re
) ? charpos
+ 1 : XINT (Fmatch_end (make_number (0))));
946 #ifdef HAVE_WINDOW_SYSTEM
947 if (FRAME_WINDOW_P (f
))
949 font_object
= font_range (charpos
, &to
, win
, face
, string
);
950 if (! FONT_OBJECT_P (font_object
))
953 TEMP_SET_PT_BOTH (pt
, pt_byte
);
954 return unbind_to (count
, Qnil
);
957 #endif /* not HAVE_WINDOW_SYSTEM */
958 gstring
= Fcomposition_get_gstring (pos
, make_number (to
),
959 font_object
, string
);
960 if (NILP (LGSTRING_ID (gstring
)))
964 args
[0] = Vauto_composition_function
;
965 args
[1] = AREF (elt
, 2);
967 args
[3] = make_number (to
);
968 args
[4] = font_object
;
970 gstring
= safe_call (6, args
);
973 TEMP_SET_PT_BOTH (pt
, pt_byte
);
974 return unbind_to (count
, gstring
);
978 TEMP_SET_PT_BOTH (pt
, pt_byte
);
979 return unbind_to (count
, Qnil
);
983 /* Update cmp_it->stop_pos to the next position after CHARPOS (and
984 BYTEPOS) where character composition may happen. If BYTEPOS is
985 negative, compoute it. If it is a static composition, set
986 cmp_it->ch to -1. Otherwise, set cmp_it->ch to the character that
987 triggers a automatic composition. */
990 composition_compute_stop_pos (cmp_it
, charpos
, bytepos
, endpos
, string
)
991 struct composition_it
*cmp_it
;
992 EMACS_INT charpos
, bytepos
, endpos
;
995 EMACS_INT start
, end
, c
;
996 Lisp_Object prop
, val
;
997 /* This is from forward_to_next_line_start in xdisp.c. */
998 const int MAX_NEWLINE_DISTANCE
= 500;
1000 if (endpos
> charpos
+ MAX_NEWLINE_DISTANCE
)
1001 endpos
= charpos
+ MAX_NEWLINE_DISTANCE
;
1002 cmp_it
->stop_pos
= endpos
;
1003 if (find_composition (charpos
, endpos
, &start
, &end
, &prop
, string
)
1004 && COMPOSITION_VALID_P (start
, end
, prop
))
1006 cmp_it
->stop_pos
= endpos
= start
;
1009 if (NILP (current_buffer
->enable_multibyte_characters
)
1010 || ! FUNCTIONP (Vauto_composition_function
))
1014 if (STRINGP (string
))
1015 bytepos
= string_char_to_byte (string
, charpos
);
1017 bytepos
= CHAR_TO_BYTE (charpos
);
1021 while (charpos
< endpos
)
1023 if (STRINGP (string
))
1024 FETCH_STRING_CHAR_ADVANCE (c
, string
, charpos
, bytepos
);
1026 FETCH_CHAR_ADVANCE (c
, charpos
, bytepos
);
1029 val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1034 for (; CONSP (val
); val
= XCDR (val
))
1037 if (VECTORP (elt
) && ASIZE (elt
) == 3 && NATNUMP (AREF (elt
, 1))
1038 && charpos
- 1 - XFASTINT (AREF (elt
, 1)) >= start
)
1043 cmp_it
->lookback
= XFASTINT (AREF (elt
, 1));
1044 cmp_it
->stop_pos
= charpos
- 1 - cmp_it
->lookback
;
1050 if (charpos
== endpos
)
1052 cmp_it
->stop_pos
= endpos
;
1057 /* Check if the character at CHARPOS (and BYTEPOS) is composed
1058 (possibly with the following charaters) on window W. ENDPOS limits
1059 characters to be composed. FACE, in non-NULL, is a base face of
1060 the character. If STRING is not nil, it is a string containing the
1061 character to check, and CHARPOS and BYTEPOS are indices in the
1062 string. In that case, FACE must not be NULL.
1064 If the character is composed, setup members of CMP_IT (id, nglyphs,
1065 and from), and return 1. Otherwise, update CMP_IT->stop_pos, and
1069 composition_reseat_it (cmp_it
, charpos
, bytepos
, endpos
, w
, face
, string
)
1070 struct composition_it
*cmp_it
;
1071 EMACS_INT charpos
, bytepos
, endpos
;
1076 if (cmp_it
->ch
== -2)
1078 composition_compute_stop_pos (cmp_it
, charpos
, bytepos
, endpos
, string
);
1079 if (cmp_it
->ch
== -2)
1085 /* We are looking at a static composition. */
1086 EMACS_INT start
, end
;
1089 find_composition (charpos
, -1, &start
, &end
, &prop
, string
);
1090 cmp_it
->id
= get_composition_id (charpos
, bytepos
, end
- start
,
1093 goto no_composition
;
1094 cmp_it
->nchars
= end
- start
;
1095 cmp_it
->nglyphs
= composition_table
[cmp_it
->id
]->glyph_len
;
1099 Lisp_Object val
, elt
;
1102 val
= CHAR_TABLE_REF (Vcomposition_function_table
, cmp_it
->ch
);
1103 for (; CONSP (val
); val
= XCDR (val
))
1106 if (cmp_it
->lookback
== XFASTINT (AREF (elt
, 1)))
1110 goto no_composition
;
1112 val
= autocmp_chars (val
, charpos
, bytepos
, endpos
, w
, face
, string
);
1113 if (! composition_gstring_p (val
))
1114 goto no_composition
;
1115 if (NILP (LGSTRING_ID (val
)))
1116 val
= composition_gstring_put_cache (val
, -1);
1117 cmp_it
->id
= XINT (LGSTRING_ID (val
));
1118 for (i
= 0; i
< LGSTRING_GLYPH_LEN (val
); i
++)
1119 if (NILP (LGSTRING_GLYPH (val
, i
)))
1121 cmp_it
->nglyphs
= i
;
1128 if (STRINGP (string
))
1129 bytepos
+= MULTIBYTE_LENGTH_NO_CHECK (SDATA (string
) + bytepos
);
1132 composition_compute_stop_pos (cmp_it
, charpos
, bytepos
, endpos
, string
);
1137 composition_update_it (cmp_it
, charpos
, bytepos
, string
)
1138 struct composition_it
*cmp_it
;
1139 EMACS_INT charpos
, bytepos
;
1146 struct composition
*cmp
= composition_table
[cmp_it
->id
];
1148 cmp_it
->to
= cmp_it
->nglyphs
;
1149 if (cmp_it
->nglyphs
== 0)
1153 for (i
= 0; i
< cmp
->glyph_len
; i
++)
1154 if ((c
= COMPOSITION_GLYPH (cmp
, i
)) != '\t')
1159 cmp_it
->width
= cmp
->width
;
1163 Lisp_Object gstring
= composition_gstring_from_id (cmp_it
->id
);
1165 if (cmp_it
->nglyphs
== 0)
1168 cmp_it
->nchars
= LGSTRING_CHAR_LEN (gstring
);
1173 Lisp_Object glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->from
);
1174 int from
= LGLYPH_FROM (glyph
);
1176 c
= XINT (LGSTRING_CHAR (gstring
, from
));
1177 cmp_it
->nchars
= LGLYPH_TO (glyph
) - from
+ 1;
1178 cmp_it
->width
= (LGLYPH_WIDTH (glyph
) > 0
1179 ? CHAR_WIDTH (LGLYPH_CHAR (glyph
)) : 0);
1180 for (cmp_it
->to
= cmp_it
->from
+ 1; cmp_it
->to
< cmp_it
->nglyphs
;
1183 glyph
= LGSTRING_GLYPH (gstring
, cmp_it
->to
);
1184 if (LGLYPH_FROM (glyph
) != from
)
1186 if (LGLYPH_WIDTH (glyph
) > 0)
1187 cmp_it
->width
+= CHAR_WIDTH (LGLYPH_CHAR (glyph
));
1192 charpos
+= cmp_it
->nchars
;
1193 if (STRINGP (string
))
1194 cmp_it
->nbytes
= string_char_to_byte (string
, charpos
) - bytepos
;
1196 cmp_it
->nbytes
= CHAR_TO_BYTE (charpos
) - bytepos
;
1201 struct position_record
1203 EMACS_INT pos
, pos_byte
;
1207 /* Update the members of POSTION to the next character boundary. */
1208 #define FORWARD_CHAR(POSITION, STOP) \
1211 if ((POSITION).pos == (STOP)) \
1213 (POSITION).p = GAP_END_ADDR; \
1214 (POSITION).pos_byte = GPT_BYTE; \
1218 (POSITION).pos_byte += BYTES_BY_CHAR_HEAD (*((POSITION).p)); \
1219 (POSITION).p += BYTES_BY_CHAR_HEAD (*((POSITION).p)); \
1223 /* Update the members of POSTION to the previous character boundary. */
1224 #define BACKWARD_CHAR(POSITION, STOP) \
1226 if ((POSITION).pos == STOP) \
1227 (POSITION).p = GPT_ADDR; \
1229 (POSITION).pos_byte--; \
1231 } while (! CHAR_HEAD_P (*((POSITION).p))); \
1235 static Lisp_Object _work_val
;
1236 static int _work_char
;
1238 /* 1 iff the character C is composable. */
1239 #define CHAR_COMPOSABLE_P(C) \
1240 (_work_val = CHAR_TABLE_REF (Vunicode_category_table, (C)), \
1241 (SYMBOLP (_work_val) \
1242 && (_work_char = SDATA (SYMBOL_NAME (_work_val))[0]) != 'C' \
1243 && _work_char != 'Z'))
1245 /* This is like find_composition, but find an automatic composition
1246 instead. If found, set *GSTRING to the glyph-string representing
1247 the composition, and return 1. Otherwise, return 0. */
1250 find_automatic_composition (pos
, limit
, start
, end
, gstring
, string
)
1251 EMACS_INT pos
, limit
, *start
, *end
;
1252 Lisp_Object
*gstring
, string
;
1254 EMACS_INT head
, tail
, stop
;
1255 struct position_record orig
, cur
, check
, prev
;
1256 Lisp_Object check_val
, val
, elt
;
1264 head
= BEGV
, tail
= ZV
, stop
= GPT
;
1265 orig
.pos_byte
= CHAR_TO_BYTE (orig
.pos
);
1266 orig
.p
= BYTE_POS_ADDR (orig
.pos_byte
);
1270 head
= 0, tail
= SCHARS (string
), stop
= -1;
1271 orig
.pos_byte
= string_char_to_byte (string
, orig
.pos
);
1272 orig
.p
= SDATA (string
) + orig
.pos_byte
;
1276 head
= max (head
, limit
);
1277 tail
= min (tail
, pos
+ 3);
1281 tail
= min (tail
, limit
+ 3);
1283 w
= XWINDOW (selected_window
);
1288 /* At first, check if POS is compoable. */
1289 c
= STRING_CHAR (cur
.p
, 0);
1290 if (! CHAR_COMPOSABLE_P (c
))
1294 if (limit
>= cur
.pos
)
1295 goto search_forward
;
1299 val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1301 check_val
= val
, check
= cur
;
1303 while (cur
.pos
+ 1 < tail
)
1305 FORWARD_CHAR (cur
, stop
);
1306 c
= STRING_CHAR (cur
.p
, 0);
1307 if (! CHAR_COMPOSABLE_P (c
))
1309 val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1312 check_val
= val
, check
= cur
;
1317 /* Rewind back to the position where we can safely search forward
1318 for compositions. */
1319 while (cur
.pos
> head
)
1321 BACKWARD_CHAR (cur
, stop
);
1322 c
= STRING_CHAR (cur
.p
, 0);
1323 if (! CHAR_COMPOSABLE_P (c
))
1325 val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1327 check_val
= val
, check
= cur
;
1330 /* Now search forward. */
1333 if (! NILP (check_val
) || limit
>= orig
.pos
)
1335 if (NILP (check_val
))
1339 while (cur
.pos
< tail
)
1341 int need_adjustment
= 0;
1343 if (NILP (check_val
))
1345 c
= STRING_CHAR (cur
.p
, 0);
1346 check_val
= CHAR_TABLE_REF (Vcomposition_function_table
, c
);
1348 for (; CONSP (check_val
); check_val
= XCDR (check_val
))
1350 elt
= XCAR (check_val
);
1351 if (VECTORP (elt
) && ASIZE (elt
) == 3 && NATNUMP (AREF (elt
, 1))
1352 && cur
.pos
- XFASTINT (AREF (elt
, 1)) >= head
)
1354 check
.pos
= cur
.pos
- XFASTINT (AREF (elt
, 1));
1355 if (check
.pos
== cur
.pos
)
1356 check
.pos_byte
= cur
.pos_byte
;
1358 check
.pos_byte
= CHAR_TO_BYTE (check
.pos
);
1359 val
= autocmp_chars (check_val
, check
.pos
, check
.pos_byte
,
1360 tail
, w
, NULL
, string
);
1361 need_adjustment
= 1;
1366 *end
= check
.pos
+ LGSTRING_CHAR_LEN (*gstring
);
1367 if (*start
<= orig
.pos
? *end
> orig
.pos
1368 : limit
>= orig
.pos
)
1371 cur
.pos_byte
= CHAR_TO_BYTE (cur
.pos
);
1376 if (need_adjustment
)
1378 /* As we have called Lisp, there's a possibilily that
1379 buffer/string is relocated. */
1381 cur
.p
= BYTE_POS_ADDR (cur
.pos_byte
);
1383 cur
.p
= SDATA (string
) + cur
.pos_byte
;
1385 if (! CONSP (check_val
))
1386 FORWARD_CHAR (cur
, stop
);
1390 if (! NILP (*gstring
))
1391 return (limit
>= 0 || (*start
<= orig
.pos
&& *end
> orig
.pos
));
1392 if (limit
>= 0 && limit
< orig
.pos
&& prev
.pos
> head
)
1395 BACKWARD_CHAR (cur
, stop
);
1404 composition_adjust_point (last_pt
)
1407 EMACS_INT charpos
, bytepos
, startpos
, beg
, end
, pos
;
1411 if (PT
== BEGV
|| PT
== ZV
)
1414 /* At first check the static composition. */
1415 if (get_property_and_range (PT
, Qcomposition
, &val
, &beg
, &end
, Qnil
)
1416 && COMPOSITION_VALID_P (beg
, end
, val
)
1417 && beg
< PT
/* && end > PT <- It's always the case. */
1418 && (last_pt
<= beg
|| last_pt
>= end
))
1419 return (PT
< last_pt
? beg
: end
);
1421 if (NILP (current_buffer
->enable_multibyte_characters
)
1422 || ! FUNCTIONP (Vauto_composition_function
))
1425 /* Next check the automatic composition. */
1426 if (! find_automatic_composition (PT
, -1, &beg
, &end
, &val
, Qnil
)
1429 for (i
= 0; i
< LGSTRING_GLYPH_LEN (val
); i
++)
1431 Lisp_Object glyph
= LGSTRING_GLYPH (val
, i
);
1435 if (beg
+ LGLYPH_FROM (glyph
) == PT
)
1437 if (beg
+ LGLYPH_TO (glyph
) >= PT
)
1438 return (PT
< last_pt
1439 ? beg
+ LGLYPH_FROM (glyph
)
1440 : beg
+ LGLYPH_TO (glyph
) + 1);
1445 DEFUN ("composition-get-gstring", Fcomposition_get_gstring
,
1446 Scomposition_get_gstring
, 4, 4, 0,
1447 doc
: /* Return a glyph-string for characters between FROM and TO.
1448 If the glhph string is for graphic display, FONT-OBJECT must be
1449 a font-object to use for those characters.
1450 Otherwise (for terminal display), FONT-OBJECT must be nil.
1452 If the optional 4th argument STRING is not nil, it is a string
1453 containing the target characters between indices FROM and TO.
1455 A glhph-string is a vector containing information about how to display
1456 specific character sequence. The format is:
1457 [HEADER ID GLYPH ...]
1459 HEADER is a vector of this form:
1460 [FONT-OBJECT CHAR ...]
1462 FONT-OBJECT is a font-object for all glyphs in the glyph-string,
1463 or nil if not yet decided.
1464 CHARs are characters to be composed by GLYPHs.
1466 ID is an identification number of the glyph-string. It may be nil if
1469 GLYPH is a vector whose elements has this form:
1470 [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT
1471 [ [X-OFF Y-OFF WADJUST] | nil] ]
1473 FROM-IDX and TO-IDX are used internally and should not be touched.
1474 C is the character of the glyph.
1475 CODE is the glyph-code of C in FONT-OBJECT.
1476 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
1477 X-OFF and Y-OFF are offests to the base position for the glyph.
1478 WADJUST is the adjustment to the normal width of the glyph.
1480 If GLYPH is nil, the remaining elements of the glhph-string vector
1482 (from
, to
, font_object
, string
)
1483 Lisp_Object font_object
, from
, to
, string
;
1485 Lisp_Object gstring
, header
;
1487 if (! NILP (font_object
))
1488 CHECK_FONT_OBJECT (font_object
);
1489 header
= fill_gstring_header (Qnil
, from
, to
, font_object
, string
);
1490 gstring
= gstring_lookup_cache (header
);
1491 if (! NILP (gstring
))
1493 LGSTRING_SET_HEADER (gstring_work
, header
);
1494 LGSTRING_SET_ID (gstring_work
, Qnil
);
1495 fill_gstring_body (gstring_work
);
1496 return gstring_work
;
1500 /* Emacs Lisp APIs. */
1502 DEFUN ("compose-region-internal", Fcompose_region_internal
,
1503 Scompose_region_internal
, 2, 4, 0,
1504 doc
: /* Internal use only.
1506 Compose text in the region between START and END.
1507 Optional 3rd and 4th arguments are COMPONENTS and MODIFICATION-FUNC
1508 for the composition. See `compose-region' for more detail. */)
1509 (start
, end
, components
, modification_func
)
1510 Lisp_Object start
, end
, components
, modification_func
;
1512 validate_region (&start
, &end
);
1513 if (!NILP (components
)
1514 && !INTEGERP (components
)
1515 && !CONSP (components
)
1516 && !STRINGP (components
))
1517 CHECK_VECTOR (components
);
1519 compose_text (XINT (start
), XINT (end
), components
, modification_func
, Qnil
);
1523 DEFUN ("compose-string-internal", Fcompose_string_internal
,
1524 Scompose_string_internal
, 3, 5, 0,
1525 doc
: /* Internal use only.
1527 Compose text between indices START and END of STRING.
1528 Optional 4th and 5th arguments are COMPONENTS and MODIFICATION-FUNC
1529 for the composition. See `compose-string' for more detail. */)
1530 (string
, start
, end
, components
, modification_func
)
1531 Lisp_Object string
, start
, end
, components
, modification_func
;
1533 CHECK_STRING (string
);
1534 CHECK_NUMBER (start
);
1537 if (XINT (start
) < 0 ||
1538 XINT (start
) > XINT (end
)
1539 || XINT (end
) > SCHARS (string
))
1540 args_out_of_range (start
, end
);
1542 compose_text (XINT (start
), XINT (end
), components
, modification_func
, string
);
1546 DEFUN ("find-composition-internal", Ffind_composition_internal
,
1547 Sfind_composition_internal
, 4, 4, 0,
1548 doc
: /* Internal use only.
1550 Return information about composition at or nearest to position POS.
1551 See `find-composition' for more detail. */)
1552 (pos
, limit
, string
, detail_p
)
1553 Lisp_Object pos
, limit
, string
, detail_p
;
1555 Lisp_Object prop
, tail
, gstring
;
1556 EMACS_INT start
, end
, from
, to
;
1559 CHECK_NUMBER_COERCE_MARKER (pos
);
1563 CHECK_NUMBER_COERCE_MARKER (limit
);
1571 CHECK_STRING (string
);
1572 if (XINT (pos
) < 0 || XINT (pos
) > SCHARS (string
))
1573 args_out_of_range (string
, pos
);
1577 if (XINT (pos
) < BEGV
|| XINT (pos
) > ZV
)
1578 args_out_of_range (Fcurrent_buffer (), pos
);
1581 if (!find_composition (from
, to
, &start
, &end
, &prop
, string
))
1583 if (!NILP (current_buffer
->enable_multibyte_characters
)
1584 && FUNCTIONP (Vauto_composition_function
)
1585 && find_automatic_composition (from
, to
, &start
, &end
, &gstring
,
1587 return list3 (make_number (start
), make_number (end
), gstring
);
1590 if ((end
<= XINT (pos
) || start
> XINT (pos
)))
1594 if (find_automatic_composition (from
, to
, &s
, &e
, &gstring
, string
)
1595 && (e
<= XINT (pos
) ? e
> end
: s
< start
))
1596 return list3 (make_number (start
), make_number (end
), gstring
);
1598 if (!COMPOSITION_VALID_P (start
, end
, prop
))
1599 return Fcons (make_number (start
), Fcons (make_number (end
),
1600 Fcons (Qnil
, Qnil
)));
1601 if (NILP (detail_p
))
1602 return Fcons (make_number (start
), Fcons (make_number (end
),
1605 if (COMPOSITION_REGISTERD_P (prop
))
1606 id
= COMPOSITION_ID (prop
);
1609 int start_byte
= (NILP (string
)
1610 ? CHAR_TO_BYTE (start
)
1611 : string_char_to_byte (string
, start
));
1612 id
= get_composition_id (start
, start_byte
, end
- start
, prop
, string
);
1617 Lisp_Object components
, relative_p
, mod_func
;
1618 enum composition_method method
= COMPOSITION_METHOD (prop
);
1619 int width
= composition_table
[id
]->width
;
1621 components
= Fcopy_sequence (COMPOSITION_COMPONENTS (prop
));
1622 relative_p
= (method
== COMPOSITION_WITH_RULE_ALTCHARS
1624 mod_func
= COMPOSITION_MODIFICATION_FUNC (prop
);
1625 tail
= Fcons (components
,
1628 Fcons (make_number (width
), Qnil
))));
1633 return Fcons (make_number (start
), Fcons (make_number (end
), tail
));
1638 syms_of_composite ()
1642 Qcomposition
= intern ("composition");
1643 staticpro (&Qcomposition
);
1645 /* Make a hash table for static composition. */
1647 Lisp_Object args
[6];
1648 extern Lisp_Object QCsize
;
1652 args
[2] = QCweakness
;
1653 /* We used to make the hash table weak so that unreferenced
1654 compositions can be garbage-collected. But, usually once
1655 created compositions are repeatedly used in an Emacs session,
1656 and thus it's not worth to save memory in such a way. So, we
1657 make the table not weak. */
1660 args
[5] = make_number (311);
1661 composition_hash_table
= Fmake_hash_table (6, args
);
1662 staticpro (&composition_hash_table
);
1665 /* Make a hash table for glyph-string. */
1667 Lisp_Object args
[6];
1668 extern Lisp_Object QCsize
;
1672 args
[2] = QCweakness
;
1675 args
[5] = make_number (311);
1676 gstring_hash_table
= Fmake_hash_table (6, args
);
1677 staticpro (&gstring_hash_table
);
1680 staticpro (&gstring_work_headers
);
1681 gstring_work_headers
= Fmake_vector (make_number (8), Qnil
);
1682 for (i
= 0; i
< 8; i
++)
1683 ASET (gstring_work_headers
, i
, Fmake_vector (make_number (i
+ 2), Qnil
));
1684 staticpro (&gstring_work
);
1685 gstring_work
= Fmake_vector (make_number (10), Qnil
);
1687 /* Text property `composition' should be nonsticky by default. */
1688 Vtext_property_default_nonsticky
1689 = Fcons (Fcons (Qcomposition
, Qt
), Vtext_property_default_nonsticky
);
1691 DEFVAR_LISP ("compose-chars-after-function", &Vcompose_chars_after_function
,
1692 doc
: /* Function to adjust composition of buffer text.
1694 The function is called with three arguments FROM, TO, and OBJECT.
1695 FROM and TO specify the range of text of which composition should be
1696 adjusted. OBJECT, if non-nil, is a string that contains the text.
1698 This function is called after a text with `composition' property is
1699 inserted or deleted to keep `composition' property of buffer text
1702 The default value is the function `compose-chars-after'. */);
1703 Vcompose_chars_after_function
= intern ("compose-chars-after");
1705 Qauto_composed
= intern ("auto-composed");
1706 staticpro (&Qauto_composed
);
1708 Qauto_composition_function
= intern ("auto-composition-function");
1709 staticpro (&Qauto_composition_function
);
1711 DEFVAR_LISP ("auto-composition-function", &Vauto_composition_function
,
1712 doc
: /* Function to call to compose characters automatically.
1713 The function is called from the display routine with four arguments,
1714 FROM, TO, WINDOW, and STRING.
1716 If STRING is nil, the function must compose characters in the region
1717 between FROM and TO in the current buffer.
1719 Otherwise, STRING is a string, and FROM and TO are indices into the
1720 string. In this case, the function must compose characters in the
1722 Vauto_composition_function
= Qnil
;
1724 DEFVAR_LISP ("composition-function-table", &Vcomposition_function_table
,
1725 doc
: /* Char-able of functions for automatic character composition.
1726 For each character that has to be composed automatically with
1727 preceding and/or following characters, this char-table contains
1728 a function to call to compose that character.
1730 The element at index C in the table, if non-nil, is a list of
1731 this form: ([PATTERN PREV-CHARS FUNC] ...)
1733 PATTERN is a regular expression with which C and the surrounding
1734 characters must match.
1736 PREV-CHARS is a number of characters before C to check the
1737 matching with PATTERN. If it is 0, PATTERN must match with C and
1738 the following characters. If it is 1, PATTERN must match with a
1739 character before C and the following characters.
1741 If PREV-CHARS is 0, PATTERN can be nil, which means that the
1742 single character C should be composed.
1744 FUNC is a function to return a glyph-string representing a
1745 composition of the characters matching with PATTERN. It is
1746 called with one argument GSTRING.
1748 GSTRING is a template of a glyph-string to return. It is already
1749 filled with a proper header for the characters to compose, and
1750 glyphs corresponding to those characters one by one. The
1751 function must return a new glyph-string of the same header as
1752 GSTRING, or modify GSTRING itself and return it.
1754 See also the documentation of `auto-composition-mode'. */);
1755 Vcomposition_function_table
= Fmake_char_table (Qnil
, Qnil
);
1757 defsubr (&Scompose_region_internal
);
1758 defsubr (&Scompose_string_internal
);
1759 defsubr (&Sfind_composition_internal
);
1760 defsubr (&Scomposition_get_gstring
);
1763 /* arch-tag: 79cefaf8-ca48-4eed-97e5-d5afb290d272
1764 (do not change this comment) */