* font.h (font_range):
[bpt/emacs.git] / src / composite.c
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
10
11 This file is part of GNU Emacs.
12
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.
17
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.
22
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/>. */
25
26 #include <config.h>
27 #include "lisp.h"
28 #include "buffer.h"
29 #include "character.h"
30 #include "intervals.h"
31 #include "window.h"
32 #include "frame.h"
33 #include "dispextern.h"
34 #include "font.h"
35
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.
41
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).
51
52 We register a composition when it is displayed, or when the width
53 is required (for instance, to calculate columns).
54
55 LENGTH -- Length of the composition. This information is used to
56 check the validity of the composition.
57
58 COMPONENTS -- Character, string, vector, list, or nil.
59
60 If it is nil, characters in the text are composed relatively
61 according to their metrics in font glyphs.
62
63 If it is a character or a string, the character or characters
64 in the string are composed relatively.
65
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.
72
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
76 composition rules.
77
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.
82
83 COMPOSITION-ID --Identification number of the composition. It is
84 used as an index to composition_table for the composition.
85
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.
96
97 We use two tables to keep information about composition;
98 composition_hash_table and composition_table.
99
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.
105
106 The latter is a table of pointers to `struct composition' indexed
107 by COMPOSITION-ID. This structure keeps the other information (see
108 composite.h).
109
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.
120
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
129 the composition.
130
131 */
132
133
134 Lisp_Object Qcomposition;
135
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;
140
141 /* The current size of `composition_table'. */
142 static int composition_table_size;
143
144 /* Number of compositions currently made. */
145 int n_compositions;
146
147 /* Hash table for compositions. The key is COMPONENTS-VEC of
148 `composition' property. The value is the corresponding
149 COMPOSITION-ID. */
150 Lisp_Object composition_hash_table;
151
152 /* Function to call to adjust composition. */
153 Lisp_Object Vcompose_chars_after_function;
154
155 Lisp_Object Qauto_composed;
156 Lisp_Object Vauto_composition_function;
157 Lisp_Object Qauto_composition_function;
158 Lisp_Object Vcomposition_function_table;
159
160 EXFUN (Fremove_list_of_text_properties, 4);
161
162 /* Temporary variable used in macros COMPOSITION_XXX. */
163 Lisp_Object composition_temp;
164
165 \f
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.
170
171 If the composition is invalid, return -1. */
172
173 int
174 get_composition_id (charpos, bytepos, nchars, prop, string)
175 int charpos, bytepos, nchars;
176 Lisp_Object prop, string;
177 {
178 Lisp_Object id, length, components, key, *key_contents;
179 int glyph_len;
180 struct Lisp_Hash_Table *hash_table = XHASH_TABLE (composition_hash_table);
181 int hash_index;
182 unsigned hash_code;
183 struct composition *cmp;
184 int i, ch;
185
186 /* PROP should be
187 Form-A: ((LENGTH . COMPONENTS) . MODIFICATION-FUNC)
188 or
189 Form-B: (COMPOSITION-ID . (LENGTH COMPONENTS-VEC . MODIFICATION-FUNC))
190 */
191 if (nchars == 0 || !CONSP (prop))
192 goto invalid_composition;
193
194 id = XCAR (prop);
195 if (INTEGERP (id))
196 {
197 /* PROP should be Form-B. */
198 if (XINT (id) < 0 || XINT (id) >= n_compositions)
199 goto invalid_composition;
200 return XINT (id);
201 }
202
203 /* PROP should be Form-A.
204 Thus, ID should be (LENGTH . COMPONENTS). */
205 if (!CONSP (id))
206 goto invalid_composition;
207 length = XCAR (id);
208 if (!INTEGERP (length) || XINT (length) != nchars)
209 goto invalid_composition;
210
211 components = XCDR (id);
212
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))
222 key = components;
223 else if (NILP (components))
224 {
225 key = Fmake_vector (make_number (nchars), Qnil);
226 if (STRINGP (string))
227 for (i = 0; i < nchars; i++)
228 {
229 FETCH_STRING_CHAR_ADVANCE (ch, string, charpos, bytepos);
230 XVECTOR (key)->contents[i] = make_number (ch);
231 }
232 else
233 for (i = 0; i < nchars; i++)
234 {
235 FETCH_CHAR_ADVANCE (ch, charpos, bytepos);
236 XVECTOR (key)->contents[i] = make_number (ch);
237 }
238 }
239 else
240 goto invalid_composition;
241
242 hash_index = hash_lookup (hash_table, key, &hash_code);
243 if (hash_index >= 0)
244 {
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);
251 XSETCAR (prop, id);
252 XSETCDR (prop, Fcons (make_number (nchars), Fcons (key, XCDR (prop))));
253 return XINT (id);
254 }
255
256 /* This composition is a new one. We must register it. */
257
258 /* Check if we have sufficient memory to store this information. */
259 if (composition_table_size == 0)
260 {
261 composition_table_size = 256;
262 composition_table
263 = (struct composition **) xmalloc (sizeof (composition_table[0])
264 * composition_table_size);
265 }
266 else if (composition_table_size <= n_compositions)
267 {
268 composition_table_size += 256;
269 composition_table
270 = (struct composition **) xrealloc (composition_table,
271 sizeof (composition_table[0])
272 * composition_table_size);
273 }
274
275 key_contents = XVECTOR (key)->contents;
276
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 */
280
281 if (VECTORP (components)
282 && ASIZE (components) >= 2
283 && VECTORP (AREF (components, 0)))
284 {
285 /* COMPONENTS is a glyph-string. */
286 int len = ASIZE (key);
287
288 for (i = 1; i < len; i++)
289 if (! VECTORP (AREF (key, i)))
290 goto invalid_composition;
291 }
292 else if (VECTORP (components) || CONSP (components))
293 {
294 int len = XVECTOR (key)->size;
295
296 /* The number of elements should be odd. */
297 if ((len % 2) == 0)
298 goto invalid_composition;
299 /* All elements should be integers (character or encoded
300 composition rule). */
301 for (i = 0; i < len; i++)
302 {
303 if (!INTEGERP (key_contents[i]))
304 goto invalid_composition;
305 }
306 }
307
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);
311 XSETCAR (prop, id);
312 XSETCDR (prop, Fcons (make_number (nchars), Fcons (key, XCDR (prop))));
313
314 /* Register the composition in composition_hash_table. */
315 hash_index = hash_put (hash_table, key, id, hash_code);
316
317 /* Register the composition in composition_table. */
318 cmp = (struct composition *) xmalloc (sizeof (struct composition));
319
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);
331 cmp->font = NULL;
332
333 if (cmp->method != COMPOSITION_WITH_RULE_ALTCHARS)
334 {
335 /* Relative composition. */
336 cmp->width = 0;
337 for (i = 0; i < glyph_len; i++)
338 {
339 int this_width;
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;
344 }
345 }
346 else
347 {
348 /* Rule-base composition. */
349 float leftmost = 0.0, rightmost;
350
351 ch = XINT (key_contents[0]);
352 rightmost = ch != '\t' ? CHAR_WIDTH (ch) : 1;
353
354 for (i = 1; i < glyph_len; i += 2)
355 {
356 int rule, gref, nref, xoff, yoff;
357 int this_width;
358 float this_left;
359
360 rule = XINT (key_contents[i]);
361 ch = XINT (key_contents[i + 1]);
362 this_width = ch != '\t' ? CHAR_WIDTH (ch) : 1;
363
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
367 below:
368 0---1---2 -- ascent
369 | |
370 | |
371 | |
372 9--10--11 -- center
373 | |
374 ---3---4---5--- baseline
375 | |
376 6---7---8 -- descent
377 */
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);
382
383 if (this_left < leftmost)
384 leftmost = this_left;
385 if (this_left + this_width > rightmost)
386 rightmost = this_left + this_width;
387 }
388
389 cmp->width = rightmost - leftmost;
390 if (cmp->width < (rightmost - leftmost))
391 /* To get a ceiling integer value. */
392 cmp->width++;
393 }
394
395 composition_table[n_compositions] = cmp;
396
397 return n_compositions++;
398
399 invalid_composition:
400 /* Would it be better to remove this `composition' property? */
401 return -1;
402 }
403
404 \f
405 /* Find a composition at or nearest to position POS of OBJECT (buffer
406 or string).
407
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.
411
412 If there's no composition at POS and LIMIT is negative, return 0.
413
414 Otherwise, search for a composition forward (LIMIT > POS) or
415 backward (LIMIT < POS). In this case, LIMIT bounds the search.
416
417 If a composition is found, set *START, *END, and *PROP as above,
418 and return 1, else return 0.
419
420 This doesn't check the validity of composition. */
421
422 int
423 find_composition (pos, limit, start, end, prop, object)
424 int pos, limit;
425 EMACS_INT *start, *end;
426 Lisp_Object *prop, object;
427 {
428 Lisp_Object val;
429
430 if (get_property_and_range (pos, Qcomposition, prop, start, end, object))
431 return 1;
432
433 if (limit < 0 || limit == pos)
434 return 0;
435
436 if (limit > pos) /* search forward */
437 {
438 val = Fnext_single_property_change (make_number (pos), Qcomposition,
439 object, make_number (limit));
440 pos = XINT (val);
441 if (pos == limit)
442 return 0;
443 }
444 else /* search backward */
445 {
446 if (get_property_and_range (pos - 1, Qcomposition, prop, start, end,
447 object))
448 return 1;
449 val = Fprevious_single_property_change (make_number (pos), Qcomposition,
450 object, make_number (limit));
451 pos = XINT (val);
452 if (pos == limit)
453 return 0;
454 pos--;
455 }
456 get_property_and_range (pos, Qcomposition, prop, start, end, object);
457 return 1;
458 }
459
460 /* Run a proper function to adjust the composition sitting between
461 FROM and TO with property PROP. */
462
463 static void
464 run_composition_function (from, to, prop)
465 int from, to;
466 Lisp_Object prop;
467 {
468 Lisp_Object func;
469 EMACS_INT start, end;
470
471 func = COMPOSITION_MODIFICATION_FUNC (prop);
472 /* If an invalid composition precedes or follows, try to make them
473 valid too. */
474 if (from > BEGV
475 && find_composition (from - 1, -1, &start, &end, &prop, Qnil)
476 && !COMPOSITION_VALID_P (start, end, prop))
477 from = start;
478 if (to < ZV
479 && find_composition (to, -1, &start, &end, &prop, Qnil)
480 && !COMPOSITION_VALID_P (start, end, prop))
481 to = end;
482 if (!NILP (Ffboundp (func)))
483 call2 (func, make_number (from), make_number (to));
484 }
485
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).
489
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.
493
494 This function is called when a buffer text is changed. If the
495 change is deletion, FROM == TO. Otherwise, FROM < TO. */
496
497 void
498 update_compositions (from, to, check_mask)
499 EMACS_INT from, to;
500 int check_mask;
501 {
502 Lisp_Object prop;
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;
507
508 if (inhibit_modification_hooks)
509 return;
510
511 /* If FROM and TO are not in a valid range, do nothing. */
512 if (! (BEGV <= from && from <= to && to <= ZV))
513 return;
514
515 if (check_mask & CHECK_HEAD)
516 {
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. */
522 if (from > BEGV
523 && find_composition (from - 1, -1, &start, &end, &prop, Qnil)
524 && COMPOSITION_VALID_P (start, end, prop))
525 {
526 min_pos = start;
527 if (end > to)
528 max_pos = end;
529 if (from < end)
530 Fput_text_property (make_number (from), make_number (end),
531 Qcomposition,
532 Fcons (XCAR (prop), XCDR (prop)), Qnil);
533 run_composition_function (start, end, prop);
534 from = end;
535 }
536 else if (from < ZV
537 && find_composition (from, -1, &start, &from, &prop, Qnil)
538 && COMPOSITION_VALID_P (start, from, prop))
539 {
540 if (from > to)
541 max_pos = from;
542 run_composition_function (start, from, prop);
543 }
544 }
545
546 if (check_mask & CHECK_INSIDE)
547 {
548 /* In this case, we are sure that (check & CHECK_TAIL) is also
549 nonzero. Thus, here we should check only compositions before
550 (to - 1). */
551 while (from < to - 1
552 && find_composition (from, to, &start, &from, &prop, Qnil)
553 && COMPOSITION_VALID_P (start, from, prop)
554 && from < to - 1)
555 run_composition_function (start, from, prop);
556 }
557
558 if (check_mask & CHECK_TAIL)
559 {
560 if (from < to
561 && find_composition (to - 1, -1, &start, &end, &prop, Qnil)
562 && COMPOSITION_VALID_P (start, end, prop))
563 {
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. */
569 if (to < end)
570 {
571 Fput_text_property (make_number (start), make_number (to),
572 Qcomposition,
573 Fcons (XCAR (prop), XCDR (prop)), Qnil);
574 max_pos = end;
575 }
576 run_composition_function (start, end, prop);
577 }
578 else if (to < ZV
579 && find_composition (to, -1, &start, &end, &prop, Qnil)
580 && COMPOSITION_VALID_P (start, end, prop))
581 {
582 run_composition_function (start, end, prop);
583 max_pos = end;
584 }
585 }
586 if (min_pos < max_pos)
587 {
588 int count = SPECPDL_INDEX ();
589
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);
597 }
598 }
599
600
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'. */
604
605 void
606 make_composition_value_copy (list)
607 Lisp_Object list;
608 {
609 Lisp_Object plist, val;
610
611 for (; CONSP (list); list = XCDR (list))
612 {
613 plist = XCAR (XCDR (XCDR (XCAR (list))));
614 while (CONSP (plist) && CONSP (XCDR (plist)))
615 {
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));
620 }
621 }
622 }
623
624
625 /* Make text in the region between START and END a composition that
626 has COMPONENTS and MODIFICATION-FUNC.
627
628 If STRING is non-nil, then operate on characters contained between
629 indices START and END in STRING. */
630
631 void
632 compose_text (start, end, components, modification_func, string)
633 int start, end;
634 Lisp_Object components, modification_func, string;
635 {
636 Lisp_Object prop;
637
638 prop = Fcons (Fcons (make_number (end - start), components),
639 modification_func);
640 Fput_text_property (make_number (start), make_number (end),
641 Qcomposition, prop, string);
642 }
643
644
645 static Lisp_Object autocmp_chars P_ ((Lisp_Object, EMACS_INT, EMACS_INT,
646 EMACS_INT, struct window *,
647 struct face *, Lisp_Object));
648
649 \f
650 /* Lisp glyph-string handlers */
651
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
654 lgstring. */
655
656 static Lisp_Object gstring_hash_table;
657
658 static Lisp_Object gstring_lookup_cache P_ ((Lisp_Object));
659
660 static Lisp_Object
661 gstring_lookup_cache (header)
662 Lisp_Object header;
663 {
664 struct Lisp_Hash_Table *h = XHASH_TABLE (gstring_hash_table);
665 int i = hash_lookup (h, header, NULL);
666
667 return (i >= 0 ? HASH_VALUE (h, i) : Qnil);
668 }
669
670 Lisp_Object
671 composition_gstring_put_cache (gstring, len)
672 Lisp_Object gstring;
673 int len;
674 {
675 struct Lisp_Hash_Table *h = XHASH_TABLE (gstring_hash_table);
676 unsigned hash;
677 Lisp_Object header, copy;
678 int i;
679
680 header = LGSTRING_HEADER (gstring);
681 hash = h->hashfn (h, header);
682 if (len < 0)
683 {
684 len = LGSTRING_GLYPH_LEN (gstring);
685 for (i = 0; i < len; i++)
686 if (NILP (LGSTRING_GLYPH (gstring, i)))
687 break;
688 len = i;
689 }
690
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));
697 return copy;
698 }
699
700 Lisp_Object
701 composition_gstring_from_id (id)
702 int id;
703 {
704 struct Lisp_Hash_Table *h = XHASH_TABLE (gstring_hash_table);
705
706 return HASH_VALUE (h, id);
707 }
708
709 static Lisp_Object fill_gstring_header P_ ((Lisp_Object, Lisp_Object,
710 Lisp_Object, Lisp_Object,
711 Lisp_Object));
712
713 int
714 composition_gstring_p (gstring)
715 Lisp_Object gstring;
716 {
717 Lisp_Object header;
718 int i;
719
720 if (! VECTORP (gstring) || ASIZE (gstring) < 2)
721 return 0;
722 header = LGSTRING_HEADER (gstring);
723 if (! VECTORP (header) || ASIZE (header) < 2)
724 return 0;
725 if (! NILP (LGSTRING_FONT (gstring))
726 && ! FONT_OBJECT_P (LGSTRING_FONT (gstring)))
727 return 0;
728 for (i = 1; i < ASIZE (LGSTRING_HEADER (gstring)); i++)
729 if (! NATNUMP (AREF (LGSTRING_HEADER (gstring), i)))
730 return 0;
731 if (! NILP (LGSTRING_ID (gstring)) && ! NATNUMP (LGSTRING_ID (gstring)))
732 return 0;
733 for (i = 0; i < LGSTRING_GLYPH_LEN (gstring); i++)
734 {
735 Lisp_Object glyph = LGSTRING_GLYPH (gstring, i);
736 if (NILP (glyph))
737 break;
738 if (! VECTORP (glyph) || ASIZE (glyph) != LGLYPH_SIZE)
739 return 0;
740 }
741 return 1;
742 }
743
744 int
745 composition_gstring_width (gstring, from, to, metrics)
746 Lisp_Object gstring;
747 int from, to;
748 struct font_metrics *metrics;
749 {
750 Lisp_Object *glyph;
751 int width = 0;
752
753 if (metrics)
754 {
755 Lisp_Object font_object = LGSTRING_FONT (gstring);
756 struct font *font = XFONT_OBJECT (font_object);
757
758 metrics->ascent = font->ascent;
759 metrics->descent = font->descent;
760 metrics->width = metrics->lbearing = metrics->rbearing = 0;
761 }
762 for (glyph = &LGSTRING_GLYPH (gstring, from); from < to; from++, glyph++)
763 {
764 int x;
765
766 if (NILP (LGLYPH_ADJUSTMENT (*glyph)))
767 width += LGLYPH_WIDTH (*glyph);
768 else
769 width += LGLYPH_WADJUST (*glyph);
770 if (metrics)
771 {
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)
781 metrics->ascent = x;
782 x = LGLYPH_DESCENT (*glyph) - LGLYPH_YOFF (*glyph);
783 if (metrics->descent < x)
784 metrics->descent = x;
785 }
786 }
787 return width;
788 }
789
790
791 static Lisp_Object gstring_work;
792 static Lisp_Object gstring_work_headers;
793
794 static Lisp_Object
795 fill_gstring_header (header, start, end, font_object, string)
796 Lisp_Object header, start, end, font_object, string;
797 {
798 EMACS_INT from, to, from_byte;
799 EMACS_INT len, i;
800
801 if (NILP (string))
802 {
803 if (NILP (current_buffer->enable_multibyte_characters))
804 error ("Attempt to shape unibyte text");
805 validate_region (&start, &end);
806 from = XFASTINT (start);
807 to = XFASTINT (end);
808 from_byte = CHAR_TO_BYTE (from);
809 }
810 else
811 {
812 CHECK_STRING (string);
813 if (! STRING_MULTIBYTE (current_buffer->enable_multibyte_characters))
814 error ("Attempt to shape unibyte text");
815 CHECK_NATNUM (start);
816 from = XINT (start);
817 CHECK_NATNUM (end);
818 to = XINT (end);
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);
822 }
823
824 len = to - from;
825 if (len == 0)
826 error ("Attempt to shape zero-length text");
827 if (VECTORP (header))
828 {
829 if (ASIZE (header) != len + 1)
830 args_out_of_range (header, make_number (len + 1));
831 }
832 else
833 {
834 if (len <= 8)
835 header = AREF (gstring_work_headers, len - 1);
836 else
837 header = Fmake_vector (make_number (len + 1), Qnil);
838 }
839
840 ASET (header, 0, font_object);
841 for (i = 0; i < len; i++)
842 {
843 int c;
844
845 if (NILP (string))
846 FETCH_CHAR_ADVANCE_NO_CHECK (c, from, from_byte);
847 else
848 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, from, from_byte);
849 ASET (header, i + 1, make_number (c));
850 }
851 return header;
852 }
853
854 extern void font_fill_lglyph_metrics P_ ((Lisp_Object, Lisp_Object));
855
856 static void
857 fill_gstring_body (gstring)
858 Lisp_Object gstring;
859 {
860 Lisp_Object font_object = LGSTRING_FONT (gstring);
861 Lisp_Object header = AREF (gstring, 0);
862 EMACS_INT len = LGSTRING_CHAR_LEN (gstring);
863 EMACS_INT i;
864
865 for (i = 0; i < len; i++)
866 {
867 Lisp_Object g = LGSTRING_GLYPH (gstring, i);
868 EMACS_INT c = XINT (AREF (header, i + 1));
869
870 if (NILP (g))
871 {
872 g = LGLYPH_NEW ();
873 LGSTRING_SET_GLYPH (gstring, i, g);
874 }
875 LGLYPH_SET_FROM (g, i);
876 LGLYPH_SET_TO (g, i);
877 LGLYPH_SET_CHAR (g, c);
878 if (! NILP (font_object))
879 {
880 font_fill_lglyph_metrics (g, font_object);
881 }
882 else
883 {
884 int width = XFASTINT (CHAR_TABLE_REF (Vchar_width_table, c));
885
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);
892 }
893 LGLYPH_SET_ADJUSTMENT (g, Qnil);
894 }
895 if (i < LGSTRING_GLYPH_LEN (gstring))
896 LGSTRING_SET_GLYPH (gstring, i, Qnil);
897 }
898
899 EXFUN (Fre_search_forward, 4);
900
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
905 displayed. */
906
907 static Lisp_Object
908 autocmp_chars (cft_element, charpos, bytepos, limit, win, face, string)
909 Lisp_Object cft_element;
910 EMACS_INT charpos, bytepos, limit;
911 struct window *win;
912 struct face *face;
913 Lisp_Object string;
914 {
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;
919
920 record_unwind_save_match_data ();
921 for (; CONSP (cft_element); cft_element = XCDR (cft_element))
922 {
923 Lisp_Object elt = XCAR (cft_element);
924 Lisp_Object re;
925 Lisp_Object font_object = Qnil, gstring;
926 EMACS_INT to;
927
928 if (! VECTORP (elt) || ASIZE (elt) != 3)
929 continue;
930 re = AREF (elt, 0);
931 if (NILP (string))
932 TEMP_SET_PT_BOTH (charpos, bytepos);
933 if (NILP (re)
934 || (STRINGP (re)
935 && (STRINGP (string)
936 ? EQ (Fstring_match (re, string, pos), pos)
937 : (! NILP (Fre_search_forward (re, make_number (limit), Qt, Qnil))
938 && EQ (Fmatch_beginning (make_number (0)), pos)))))
939 {
940 to = (NILP (re) ? charpos + 1 : XINT (Fmatch_end (make_number (0))));
941 #ifdef HAVE_WINDOW_SYSTEM
942 if (FRAME_WINDOW_P (f))
943 {
944 font_object = font_range (charpos, &to, win, face, string);
945 if (! FONT_OBJECT_P (font_object))
946 {
947 if (NILP (string))
948 TEMP_SET_PT_BOTH (pt, pt_byte);
949 return unbind_to (count, Qnil);
950 }
951 }
952 #endif /* not HAVE_WINDOW_SYSTEM */
953 gstring = Fcomposition_get_gstring (pos, make_number (to),
954 font_object, string);
955 if (NILP (LGSTRING_ID (gstring)))
956 {
957 Lisp_Object args[6];
958
959 args[0] = Vauto_composition_function;
960 args[1] = AREF (elt, 2);
961 args[2] = pos;
962 args[3] = make_number (to);
963 args[4] = font_object;
964 args[5] = string;
965 gstring = safe_call (6, args);
966 }
967 if (NILP (string))
968 TEMP_SET_PT_BOTH (pt, pt_byte);
969 return unbind_to (count, gstring);
970 }
971 }
972 if (NILP (string))
973 TEMP_SET_PT_BOTH (pt, pt_byte);
974 return unbind_to (count, Qnil);
975 }
976
977
978 /* Update cmp_it->stop_pos to the next position after CHARPOS (and
979 BYTEPOS) where character composition may happen. If BYTEPOS is
980 negative, compoute it. If it is a static composition, set
981 cmp_it->ch to -1. Otherwise, set cmp_it->ch to the character that
982 triggers a automatic composition. */
983
984 void
985 composition_compute_stop_pos (cmp_it, charpos, bytepos, endpos, string)
986 struct composition_it *cmp_it;
987 EMACS_INT charpos, bytepos, endpos;
988 Lisp_Object string;
989 {
990 EMACS_INT start, end, c;
991 Lisp_Object prop, val;
992
993 cmp_it->stop_pos = endpos;
994 if (find_composition (charpos, endpos, &start, &end, &prop, string)
995 && COMPOSITION_VALID_P (start, end, prop))
996 {
997 cmp_it->stop_pos = endpos = start;
998 cmp_it->ch = -1;
999 }
1000 if (NILP (current_buffer->enable_multibyte_characters)
1001 || ! FUNCTIONP (Vauto_composition_function))
1002 return;
1003 if (bytepos < 0)
1004 {
1005 if (STRINGP (string))
1006 bytepos = string_char_to_byte (string, charpos);
1007 else
1008 bytepos = CHAR_TO_BYTE (charpos);
1009 }
1010
1011 start = charpos;
1012 while (charpos < endpos)
1013 {
1014 if (STRINGP (string))
1015 FETCH_STRING_CHAR_ADVANCE (c, string, charpos, bytepos);
1016 else
1017 FETCH_CHAR_ADVANCE (c, charpos, bytepos);
1018 val = CHAR_TABLE_REF (Vcomposition_function_table, c);
1019 if (! NILP (val))
1020 {
1021 Lisp_Object elt;
1022
1023 for (; CONSP (val); val = XCDR (val))
1024 {
1025 elt = XCAR (val);
1026 if (VECTORP (elt) && ASIZE (elt) == 3 && NATNUMP (AREF (elt, 1))
1027 && charpos - 1 - XFASTINT (AREF (elt, 1)) >= start)
1028 break;
1029 }
1030 if (CONSP (val))
1031 {
1032 cmp_it->stop_pos = charpos - 1 - XFASTINT (AREF (elt, 1));
1033 cmp_it->ch = c;
1034 break;
1035 }
1036 }
1037 }
1038 }
1039
1040 /* Check if the character at CHARPOS (and BYTEPOS) is composed
1041 (possibly with the following charaters) on window W. ENDPOS limits
1042 characters to be composed. FACE, in non-NULL, is a base face of
1043 the character. If STRING is not nil, it is a string containing the
1044 character to check, and CHARPOS and BYTEPOS are indices in the
1045 string. In that case, FACE must not be NULL.
1046
1047 If the character is composed, setup members of CMP_IT (id, nglyphs,
1048 and from), and return 1. Otherwise, update CMP_IT->stop_pos, and
1049 return 0. */
1050
1051 int
1052 composition_reseat_it (cmp_it, charpos, bytepos, endpos, w, face, string)
1053 struct composition_it *cmp_it;
1054 EMACS_INT charpos, bytepos, endpos;
1055 struct window *w;
1056 struct face *face;
1057 Lisp_Object string;
1058 {
1059 if (cmp_it->ch < 0)
1060 {
1061 /* We are looking at a static composition. */
1062 EMACS_INT start, end;
1063 Lisp_Object prop;
1064
1065 find_composition (charpos, -1, &start, &end, &prop, string);
1066 cmp_it->id = get_composition_id (charpos, bytepos, end - start,
1067 prop, string);
1068 if (cmp_it->id < 0)
1069 goto no_composition;
1070 cmp_it->nchars = end - start;
1071 cmp_it->nglyphs = composition_table[cmp_it->id]->glyph_len;
1072 }
1073 else
1074 {
1075 Lisp_Object val;
1076 int i;
1077
1078 val = CHAR_TABLE_REF (Vcomposition_function_table, cmp_it->ch);
1079 if (NILP (val))
1080 goto no_composition;
1081 val = autocmp_chars (val, charpos, bytepos, endpos, w, face, string);
1082 if (! composition_gstring_p (val))
1083 goto no_composition;
1084 if (NILP (LGSTRING_ID (val)))
1085 val = composition_gstring_put_cache (val, -1);
1086 cmp_it->id = XINT (LGSTRING_ID (val));
1087 for (i = 0; i < LGSTRING_GLYPH_LEN (val); i++)
1088 if (NILP (LGSTRING_GLYPH (val, i)))
1089 break;
1090 cmp_it->nglyphs = i;
1091 }
1092 cmp_it->from = 0;
1093 return 1;
1094
1095 no_composition:
1096 charpos++;
1097 if (STRINGP (string))
1098 bytepos += MULTIBYTE_LENGTH_NO_CHECK (SDATA (string) + bytepos);
1099 else
1100 INC_POS (bytepos);
1101 composition_compute_stop_pos (cmp_it, charpos, bytepos, endpos, string);
1102 return 0;
1103 }
1104
1105 int
1106 composition_update_it (cmp_it, charpos, bytepos, string)
1107 struct composition_it *cmp_it;
1108 EMACS_INT charpos, bytepos;
1109 Lisp_Object string;
1110 {
1111 int i, c;
1112
1113 if (cmp_it->ch < 0)
1114 {
1115 struct composition *cmp = composition_table[cmp_it->id];
1116
1117 cmp_it->to = cmp_it->nglyphs;
1118 if (cmp_it->nglyphs == 0)
1119 c = -1;
1120 else
1121 {
1122 for (i = 0; i < cmp->glyph_len; i++)
1123 if ((c = COMPOSITION_GLYPH (cmp, i)) != '\t')
1124 break;
1125 if (c == '\t')
1126 c = ' ';
1127 }
1128 cmp_it->width = cmp->width;
1129 }
1130 else
1131 {
1132 Lisp_Object gstring = composition_gstring_from_id (cmp_it->id);
1133
1134 if (cmp_it->nglyphs == 0)
1135 {
1136 c = -1;
1137 cmp_it->nchars = LGSTRING_CHAR_LEN (gstring);
1138 cmp_it->width = 0;
1139 }
1140 else
1141 {
1142 Lisp_Object glyph = LGSTRING_GLYPH (gstring, cmp_it->from);
1143 int from = LGLYPH_FROM (glyph);
1144
1145 c = XINT (LGSTRING_CHAR (gstring, from));
1146 cmp_it->nchars = LGLYPH_TO (glyph) - from + 1;
1147 cmp_it->width = (LGLYPH_WIDTH (glyph) > 0
1148 ? CHAR_WIDTH (LGLYPH_CHAR (glyph)) : 0);
1149 for (cmp_it->to = cmp_it->from + 1; cmp_it->to < cmp_it->nglyphs;
1150 cmp_it->to++)
1151 {
1152 glyph = LGSTRING_GLYPH (gstring, cmp_it->to);
1153 if (LGLYPH_FROM (glyph) != from)
1154 break;
1155 if (LGLYPH_WIDTH (glyph) > 0)
1156 cmp_it->width += CHAR_WIDTH (LGLYPH_CHAR (glyph));
1157 }
1158 }
1159 }
1160
1161 charpos += cmp_it->nchars;
1162 if (STRINGP (string))
1163 cmp_it->nbytes = string_char_to_byte (string, charpos) - bytepos;
1164 else
1165 cmp_it->nbytes = CHAR_TO_BYTE (charpos) - bytepos;
1166 return c;
1167 }
1168
1169
1170 int
1171 composition_adjust_point (last_pt)
1172 EMACS_INT last_pt;
1173 {
1174 /* Now check the automatic composition. */
1175 EMACS_INT charpos, bytepos, startpos, beg, end, pos;
1176 Lisp_Object val, cat;
1177 EMACS_INT limit;
1178 int c;
1179
1180 if (PT == BEGV || PT == ZV)
1181 return PT;
1182
1183 if (get_property_and_range (PT, Qcomposition, &val, &beg, &end, Qnil)
1184 && COMPOSITION_VALID_P (beg, end, val)
1185 && beg < PT /* && end > PT <- It's always the case. */
1186 && (last_pt <= beg || last_pt >= end))
1187 return (PT < last_pt ? beg : end);
1188
1189 if (NILP (current_buffer->enable_multibyte_characters)
1190 || ! FUNCTIONP (Vauto_composition_function))
1191 return PT;
1192
1193 c = FETCH_MULTIBYTE_CHAR (PT_BYTE);
1194 cat = CHAR_TABLE_REF (Vunicode_category_table, c);
1195 if (SYMBOLP (cat)
1196 && ((c = SDATA (SYMBOL_NAME (cat))[0]) == 'C' || c == 'Z'))
1197 /* A control character is never composed. */
1198 return PT;
1199
1200 charpos = PT;
1201 bytepos = PT_BYTE;
1202 limit = (last_pt < PT ? last_pt : BEGV);
1203 do {
1204 DEC_BOTH (charpos, bytepos);
1205 c = FETCH_MULTIBYTE_CHAR (bytepos);
1206 cat = CHAR_TABLE_REF (Vunicode_category_table, c);
1207 if (SYMBOLP (cat)
1208 && ((c = SDATA (SYMBOL_NAME (cat))[0]) == 'C' || c == 'Z'))
1209 {
1210 INC_BOTH (charpos, bytepos);
1211 break;
1212 }
1213 } while (charpos > limit);
1214
1215
1216 limit = (last_pt < PT ? ZV : last_pt);
1217 if (limit > PT + 3)
1218 limit = PT + 3;
1219 startpos = charpos;
1220 while (charpos < limit)
1221 {
1222 c = FETCH_MULTIBYTE_CHAR (bytepos);
1223 if (charpos > PT)
1224 {
1225 int ch;
1226
1227 cat = CHAR_TABLE_REF (Vunicode_category_table, c);
1228 if (SYMBOLP (cat)
1229 && ((ch = SDATA (SYMBOL_NAME (cat))[0]) == 'C' || ch == 'Z'))
1230 return PT;
1231 }
1232 val = CHAR_TABLE_REF (Vcomposition_function_table, c);
1233 if (! CONSP (val))
1234 {
1235 INC_BOTH (charpos, bytepos);
1236 continue;
1237 }
1238 for (; CONSP (val); val = XCDR (val))
1239 {
1240 Lisp_Object elt = XCAR (val);
1241
1242 if (VECTORP (elt) && ASIZE (elt) == 3 && NATNUMP (AREF (elt, 1))
1243 && (pos = charpos - XFASTINT (AREF (elt, 1))) < PT
1244 && pos >= startpos)
1245 {
1246 Lisp_Object gstring;
1247 EMACS_INT pos_byte;
1248
1249 if (XFASTINT (AREF (elt, 1)) == 0)
1250 pos_byte = bytepos;
1251 else
1252 pos_byte = CHAR_TO_BYTE (pos);
1253 gstring = autocmp_chars (val, pos, pos_byte, Z,
1254 XWINDOW (selected_window), NULL, Qnil);
1255 if (composition_gstring_p (gstring))
1256 {
1257 if (pos + LGSTRING_CHAR_LEN (gstring) > PT)
1258 {
1259 int i;
1260
1261 for (i = 0; i < LGSTRING_GLYPH_LEN (gstring); i++)
1262 {
1263 Lisp_Object glyph = LGSTRING_GLYPH (gstring, i);
1264
1265 if (NILP (glyph))
1266 break;
1267 if (pos + LGLYPH_FROM (glyph) == PT)
1268 return PT;
1269 if (pos + LGLYPH_TO (glyph) + 1 > PT)
1270 return (PT < last_pt
1271 ? pos + LGLYPH_FROM (glyph)
1272 : pos + LGLYPH_TO (glyph) + 1);
1273 }
1274 return PT;
1275 }
1276 charpos = startpos = pos + LGSTRING_CHAR_LEN (gstring);
1277 bytepos = CHAR_TO_BYTE (charpos);
1278 break;
1279 }
1280 }
1281 }
1282 if (! CONSP (val))
1283 INC_BOTH (charpos, bytepos);
1284 }
1285 return PT;
1286 }
1287
1288 DEFUN ("composition-get-gstring", Fcomposition_get_gstring,
1289 Scomposition_get_gstring, 4, 4, 0,
1290 doc: /* Return a glyph-string for characters between FROM and TO.
1291 If the glhph string is for graphic display, FONT-OBJECT must be
1292 a font-object to use for those characters.
1293 Otherwise (for terminal display), FONT-OBJECT must be nil.
1294
1295 If the optional 4th argument STRING is not nil, it is a string
1296 containing the target characters between indices FROM and TO.
1297
1298 A glhph-string is a vector containing information about how to display
1299 specific character sequence. The format is:
1300 [HEADER ID GLYPH ...]
1301
1302 HEADER is a vector of this form:
1303 [FONT-OBJECT CHAR ...]
1304 where
1305 FONT-OBJECT is a font-object for all glyphs in the glyph-string,
1306 or nil if not yet decided.
1307 CHARs are characters to be composed by GLYPHs.
1308
1309 ID is an identification number of the glyph-string. It may be nil if
1310 not yet shaped.
1311
1312 GLYPH is a vector whose elements has this form:
1313 [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT
1314 [ [X-OFF Y-OFF WADJUST] | nil] ]
1315 where
1316 FROM-IDX and TO-IDX are used internally and should not be touched.
1317 C is the character of the glyph.
1318 CODE is the glyph-code of C in FONT-OBJECT.
1319 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
1320 X-OFF and Y-OFF are offests to the base position for the glyph.
1321 WADJUST is the adjustment to the normal width of the glyph.
1322
1323 If GLYPH is nil, the remaining elements of the glhph-string vector
1324 must be ignore. */)
1325 (from, to, font_object, string)
1326 Lisp_Object font_object, from, to, string;
1327 {
1328 Lisp_Object gstring, header;
1329
1330 if (! NILP (font_object))
1331 CHECK_FONT_OBJECT (font_object);
1332 header = fill_gstring_header (Qnil, from, to, font_object, string);
1333 gstring = gstring_lookup_cache (header);
1334 if (! NILP (gstring))
1335 return gstring;
1336 LGSTRING_SET_HEADER (gstring_work, header);
1337 LGSTRING_SET_ID (gstring_work, Qnil);
1338 fill_gstring_body (gstring_work);
1339 return gstring_work;
1340 }
1341
1342 \f
1343 /* Emacs Lisp APIs. */
1344
1345 DEFUN ("compose-region-internal", Fcompose_region_internal,
1346 Scompose_region_internal, 2, 4, 0,
1347 doc: /* Internal use only.
1348
1349 Compose text in the region between START and END.
1350 Optional 3rd and 4th arguments are COMPONENTS and MODIFICATION-FUNC
1351 for the composition. See `compose-region' for more detail. */)
1352 (start, end, components, modification_func)
1353 Lisp_Object start, end, components, modification_func;
1354 {
1355 validate_region (&start, &end);
1356 if (!NILP (components)
1357 && !INTEGERP (components)
1358 && !CONSP (components)
1359 && !STRINGP (components))
1360 CHECK_VECTOR (components);
1361
1362 compose_text (XINT (start), XINT (end), components, modification_func, Qnil);
1363 return Qnil;
1364 }
1365
1366 DEFUN ("compose-string-internal", Fcompose_string_internal,
1367 Scompose_string_internal, 3, 5, 0,
1368 doc: /* Internal use only.
1369
1370 Compose text between indices START and END of STRING.
1371 Optional 4th and 5th arguments are COMPONENTS and MODIFICATION-FUNC
1372 for the composition. See `compose-string' for more detail. */)
1373 (string, start, end, components, modification_func)
1374 Lisp_Object string, start, end, components, modification_func;
1375 {
1376 CHECK_STRING (string);
1377 CHECK_NUMBER (start);
1378 CHECK_NUMBER (end);
1379
1380 if (XINT (start) < 0 ||
1381 XINT (start) > XINT (end)
1382 || XINT (end) > SCHARS (string))
1383 args_out_of_range (start, end);
1384
1385 compose_text (XINT (start), XINT (end), components, modification_func, string);
1386 return string;
1387 }
1388
1389 DEFUN ("find-composition-internal", Ffind_composition_internal,
1390 Sfind_composition_internal, 4, 4, 0,
1391 doc: /* Internal use only.
1392
1393 Return information about composition at or nearest to position POS.
1394 See `find-composition' for more detail. */)
1395 (pos, limit, string, detail_p)
1396 Lisp_Object pos, limit, string, detail_p;
1397 {
1398 Lisp_Object prop, tail;
1399 EMACS_INT start, end;
1400 int id;
1401
1402 CHECK_NUMBER_COERCE_MARKER (pos);
1403 start = XINT (pos);
1404 if (!NILP (limit))
1405 {
1406 CHECK_NUMBER_COERCE_MARKER (limit);
1407 end = XINT (limit);
1408 }
1409 else
1410 end = -1;
1411
1412 if (!NILP (string))
1413 {
1414 CHECK_STRING (string);
1415 if (XINT (pos) < 0 || XINT (pos) > SCHARS (string))
1416 args_out_of_range (string, pos);
1417 }
1418 else
1419 {
1420 if (XINT (pos) < BEGV || XINT (pos) > ZV)
1421 args_out_of_range (Fcurrent_buffer (), pos);
1422 }
1423
1424 if (!find_composition (start, end, &start, &end, &prop, string))
1425 return Qnil;
1426 if (!COMPOSITION_VALID_P (start, end, prop))
1427 return Fcons (make_number (start), Fcons (make_number (end),
1428 Fcons (Qnil, Qnil)));
1429 if (NILP (detail_p))
1430 return Fcons (make_number (start), Fcons (make_number (end),
1431 Fcons (Qt, Qnil)));
1432
1433 if (COMPOSITION_REGISTERD_P (prop))
1434 id = COMPOSITION_ID (prop);
1435 else
1436 {
1437 int start_byte = (NILP (string)
1438 ? CHAR_TO_BYTE (start)
1439 : string_char_to_byte (string, start));
1440 id = get_composition_id (start, start_byte, end - start, prop, string);
1441 }
1442
1443 if (id >= 0)
1444 {
1445 Lisp_Object components, relative_p, mod_func;
1446 enum composition_method method = COMPOSITION_METHOD (prop);
1447 int width = composition_table[id]->width;
1448
1449 components = Fcopy_sequence (COMPOSITION_COMPONENTS (prop));
1450 relative_p = (method == COMPOSITION_WITH_RULE_ALTCHARS
1451 ? Qnil : Qt);
1452 mod_func = COMPOSITION_MODIFICATION_FUNC (prop);
1453 tail = Fcons (components,
1454 Fcons (relative_p,
1455 Fcons (mod_func,
1456 Fcons (make_number (width), Qnil))));
1457 }
1458 else
1459 tail = Qnil;
1460
1461 return Fcons (make_number (start), Fcons (make_number (end), tail));
1462 }
1463
1464 \f
1465 void
1466 syms_of_composite ()
1467 {
1468 int i;
1469
1470 Qcomposition = intern ("composition");
1471 staticpro (&Qcomposition);
1472
1473 /* Make a hash table for static composition. */
1474 {
1475 Lisp_Object args[6];
1476 extern Lisp_Object QCsize;
1477
1478 args[0] = QCtest;
1479 args[1] = Qequal;
1480 args[2] = QCweakness;
1481 /* We used to make the hash table weak so that unreferenced
1482 compositions can be garbage-collected. But, usually once
1483 created compositions are repeatedly used in an Emacs session,
1484 and thus it's not worth to save memory in such a way. So, we
1485 make the table not weak. */
1486 args[3] = Qnil;
1487 args[4] = QCsize;
1488 args[5] = make_number (311);
1489 composition_hash_table = Fmake_hash_table (6, args);
1490 staticpro (&composition_hash_table);
1491 }
1492
1493 /* Make a hash table for glyph-string. */
1494 {
1495 Lisp_Object args[6];
1496 extern Lisp_Object QCsize;
1497
1498 args[0] = QCtest;
1499 args[1] = Qequal;
1500 args[2] = QCweakness;
1501 args[3] = Qnil;
1502 args[4] = QCsize;
1503 args[5] = make_number (311);
1504 gstring_hash_table = Fmake_hash_table (6, args);
1505 staticpro (&gstring_hash_table);
1506 }
1507
1508 staticpro (&gstring_work_headers);
1509 gstring_work_headers = Fmake_vector (make_number (8), Qnil);
1510 for (i = 0; i < 8; i++)
1511 ASET (gstring_work_headers, i, Fmake_vector (make_number (i + 2), Qnil));
1512 staticpro (&gstring_work);
1513 gstring_work = Fmake_vector (make_number (10), Qnil);
1514
1515 /* Text property `composition' should be nonsticky by default. */
1516 Vtext_property_default_nonsticky
1517 = Fcons (Fcons (Qcomposition, Qt), Vtext_property_default_nonsticky);
1518
1519 DEFVAR_LISP ("compose-chars-after-function", &Vcompose_chars_after_function,
1520 doc: /* Function to adjust composition of buffer text.
1521
1522 The function is called with three arguments FROM, TO, and OBJECT.
1523 FROM and TO specify the range of text of which composition should be
1524 adjusted. OBJECT, if non-nil, is a string that contains the text.
1525
1526 This function is called after a text with `composition' property is
1527 inserted or deleted to keep `composition' property of buffer text
1528 valid.
1529
1530 The default value is the function `compose-chars-after'. */);
1531 Vcompose_chars_after_function = intern ("compose-chars-after");
1532
1533 Qauto_composed = intern ("auto-composed");
1534 staticpro (&Qauto_composed);
1535
1536 Qauto_composition_function = intern ("auto-composition-function");
1537 staticpro (&Qauto_composition_function);
1538
1539 DEFVAR_LISP ("auto-composition-function", &Vauto_composition_function,
1540 doc: /* Function to call to compose characters automatically.
1541 The function is called from the display routine with four arguments,
1542 FROM, TO, WINDOW, and STRING.
1543
1544 If STRING is nil, the function must compose characters in the region
1545 between FROM and TO in the current buffer.
1546
1547 Otherwise, STRING is a string, and FROM and TO are indices into the
1548 string. In this case, the function must compose characters in the
1549 string. */);
1550 Vauto_composition_function = Qnil;
1551
1552 DEFVAR_LISP ("composition-function-table", &Vcomposition_function_table,
1553 doc: /* Char-able of functions for automatic character composition.
1554 For each character that has to be composed automatically with
1555 preceding and/or following characters, this char-table contains
1556 a function to call to compose that character.
1557
1558 The element at index C in the table, if non-nil, is a list of
1559 this form: ([PATTERN PREV-CHARS FUNC] ...)
1560
1561 PATTERN is a regular expression with which C and the surrounding
1562 characters must match.
1563
1564 PREV-CHARS is a number of characters before C to check the
1565 matching with PATTERN. If it is 0, PATTERN must match with C and
1566 the following characters. If it is 1, PATTERN must match with a
1567 character before C and the following characters.
1568
1569 If PREV-CHARS is 0, PATTERN can be nil, which means that the
1570 single character C should be composed.
1571
1572 FUNC is a function to return a glyph-string representing a
1573 composition of the characters matching with PATTERN. It is
1574 called with one argument GSTRING.
1575
1576 GSTRING is a template of a glyph-string to return. It is already
1577 filled with a proper header for the characters to compose, and
1578 glyphs corresponding to those characters one by one. The
1579 function must return a new glyph-string of the same header as
1580 GSTRING, or modify GSTRING itself and return it.
1581
1582 See also the documentation of `auto-composition-mode'. */);
1583 Vcomposition_function_table = Fmake_char_table (Qnil, Qnil);
1584
1585 defsubr (&Scompose_region_internal);
1586 defsubr (&Scompose_string_internal);
1587 defsubr (&Sfind_composition_internal);
1588 defsubr (&Scomposition_get_gstring);
1589 }
1590
1591 /* arch-tag: 79cefaf8-ca48-4eed-97e5-d5afb290d272
1592 (do not change this comment) */