]> code.delx.au - gnu-emacs/blob - src/composite.c
Ignore a static composition that starts before the current checking position in redis...
[gnu-emacs] / src / composite.c
1 /* Composite sequence support.
2 Copyright (C) 2001, 2002, 2003, 2004, 2005,
3 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
4 Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
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 <setjmp.h>
28 #include "lisp.h"
29 #include "buffer.h"
30 #include "character.h"
31 #include "coding.h"
32 #include "intervals.h"
33 #include "window.h"
34 #include "frame.h"
35 #include "dispextern.h"
36 #include "font.h"
37 #include "termhooks.h"
38
39
40 /* Emacs uses special text property `composition' to support character
41 composition. A sequence of characters that have the same (i.e. eq)
42 `composition' property value is treated as a single composite
43 sequence (we call it just `composition' here after). Characters in
44 a composition are all composed somehow on the screen.
45
46 The property value has this form when the composition is made:
47 ((LENGTH . COMPONENTS) . MODIFICATION-FUNC)
48 then turns to this form:
49 (COMPOSITION-ID . (LENGTH COMPONENTS-VEC . MODIFICATION-FUNC))
50 when the composition is registered in composition_hash_table and
51 composition_table. These rather peculiar structures were designed
52 to make it easy to distinguish them quickly (we can do that by
53 checking only the first element) and to extract LENGTH (from the
54 former form) and COMPOSITION-ID (from the latter form).
55
56 We register a composition when it is displayed, or when the width
57 is required (for instance, to calculate columns).
58
59 LENGTH -- Length of the composition. This information is used to
60 check the validity of the composition.
61
62 COMPONENTS -- Character, string, vector, list, or nil.
63
64 If it is nil, characters in the text are composed relatively
65 according to their metrics in font glyphs.
66
67 If it is a character or a string, the character or characters
68 in the string are composed relatively.
69
70 If it is a vector or list of integers, the element is a
71 character or an encoded composition rule. The characters are
72 composed according to the rules. (2N)th elements are
73 characters to be composed and (2N+1)th elements are
74 composition rules to tell how to compose (2N+2)th element with
75 the previously composed 2N glyphs.
76
77 COMPONENTS-VEC -- Vector of integers. In relative composition, the
78 elements are characters to be composed. In rule-base
79 composition, the elements are characters or encoded
80 composition rules.
81
82 MODIFICATION-FUNC -- If non nil, it is a function to call when the
83 composition gets invalid after a modification in a buffer. If
84 it is nil, a function in `composition-function-table' of the
85 first character in the sequence is called.
86
87 COMPOSITION-ID --Identification number of the composition. It is
88 used as an index to composition_table for the composition.
89
90 When Emacs has to display a composition or has to know its
91 displaying width, the function get_composition_id is called. It
92 returns COMPOSITION-ID so that the caller can access the
93 information about the composition through composition_table. If a
94 COMPOSITION-ID has not yet been assigned to the composition,
95 get_composition_id checks the validity of `composition' property,
96 and, if valid, assigns a new ID, registers the information in
97 composition_hash_table and composition_table, and changes the form
98 of the property value. If the property is invalid, return -1
99 without changing the property value.
100
101 We use two tables to keep information about composition;
102 composition_hash_table and composition_table.
103
104 The former is a hash table in which keys are COMPONENTS-VECs and
105 values are the corresponding COMPOSITION-IDs. This hash table is
106 weak, but as each key (COMPONENTS-VEC) is also kept as a value of the
107 `composition' property, it won't be collected as garbage until all
108 bits of text that have the same COMPONENTS-VEC are deleted.
109
110 The latter is a table of pointers to `struct composition' indexed
111 by COMPOSITION-ID. This structure keeps the other information (see
112 composite.h).
113
114 In general, a text property holds information about individual
115 characters. But, a `composition' property holds information about
116 a sequence of characters (in this sense, it is like the `intangible'
117 property). That means that we should not share the property value
118 in adjacent compositions -- we can't distinguish them if they have the
119 same property. So, after any changes, we call
120 `update_compositions' and change a property of one of adjacent
121 compositions to a copy of it. This function also runs a proper
122 composition modification function to make a composition that gets
123 invalid by the change valid again.
124
125 As the value of the `composition' property holds information about a
126 specific range of text, the value gets invalid if we change the
127 text in the range. We treat the `composition' property as always
128 rear-nonsticky (currently by setting default-text-properties to
129 (rear-nonsticky (composition))) and we never make properties of
130 adjacent compositions identical. Thus, any such changes make the
131 range just shorter. So, we can check the validity of the `composition'
132 property by comparing LENGTH information with the actual length of
133 the composition.
134
135 */
136
137
138 Lisp_Object Qcomposition;
139
140 /* Table of pointers to the structure `composition' indexed by
141 COMPOSITION-ID. This structure is for storing information about
142 each composition except for COMPONENTS-VEC. */
143 struct composition **composition_table;
144
145 /* The current size of `composition_table'. */
146 static int composition_table_size;
147
148 /* Number of compositions currently made. */
149 int n_compositions;
150
151 /* Hash table for compositions. The key is COMPONENTS-VEC of
152 `composition' property. The value is the corresponding
153 COMPOSITION-ID. */
154 Lisp_Object composition_hash_table;
155
156 /* Function to call to adjust composition. */
157 Lisp_Object Vcompose_chars_after_function;
158
159 Lisp_Object Qauto_composed;
160 Lisp_Object Vauto_composition_mode;
161 Lisp_Object Vauto_composition_function;
162 Lisp_Object Qauto_composition_function;
163 Lisp_Object Vcomposition_function_table;
164
165 /* Maxinum number of characters to lookback to check
166 auto-composition. */
167 #define MAX_AUTO_COMPOSITION_LOOKBACK 3
168
169 EXFUN (Fremove_list_of_text_properties, 4);
170
171 /* Temporary variable used in macros COMPOSITION_XXX. */
172 Lisp_Object composition_temp;
173
174 \f
175 /* Return COMPOSITION-ID of a composition at buffer position
176 CHARPOS/BYTEPOS and length NCHARS. The `composition' property of
177 the sequence is PROP. STRING, if non-nil, is a string that
178 contains the composition instead of the current buffer.
179
180 If the composition is invalid, return -1. */
181
182 int
183 get_composition_id (charpos, bytepos, nchars, prop, string)
184 int charpos, bytepos, nchars;
185 Lisp_Object prop, string;
186 {
187 Lisp_Object id, length, components, key, *key_contents;
188 int glyph_len;
189 struct Lisp_Hash_Table *hash_table = XHASH_TABLE (composition_hash_table);
190 int hash_index;
191 unsigned hash_code;
192 struct composition *cmp;
193 int i, ch;
194
195 /* PROP should be
196 Form-A: ((LENGTH . COMPONENTS) . MODIFICATION-FUNC)
197 or
198 Form-B: (COMPOSITION-ID . (LENGTH COMPONENTS-VEC . MODIFICATION-FUNC))
199 */
200 if (nchars == 0 || !CONSP (prop))
201 goto invalid_composition;
202
203 id = XCAR (prop);
204 if (INTEGERP (id))
205 {
206 /* PROP should be Form-B. */
207 if (XINT (id) < 0 || XINT (id) >= n_compositions)
208 goto invalid_composition;
209 return XINT (id);
210 }
211
212 /* PROP should be Form-A.
213 Thus, ID should be (LENGTH . COMPONENTS). */
214 if (!CONSP (id))
215 goto invalid_composition;
216 length = XCAR (id);
217 if (!INTEGERP (length) || XINT (length) != nchars)
218 goto invalid_composition;
219
220 components = XCDR (id);
221
222 /* Check if the same composition has already been registered or not
223 by consulting composition_hash_table. The key for this table is
224 COMPONENTS (converted to a vector COMPONENTS-VEC) or, if it is
225 nil, vector of characters in the composition range. */
226 if (INTEGERP (components))
227 key = Fmake_vector (make_number (1), components);
228 else if (STRINGP (components) || CONSP (components))
229 key = Fvconcat (1, &components);
230 else if (VECTORP (components))
231 key = components;
232 else if (NILP (components))
233 {
234 key = Fmake_vector (make_number (nchars), Qnil);
235 if (STRINGP (string))
236 for (i = 0; i < nchars; i++)
237 {
238 FETCH_STRING_CHAR_ADVANCE (ch, string, charpos, bytepos);
239 XVECTOR (key)->contents[i] = make_number (ch);
240 }
241 else
242 for (i = 0; i < nchars; i++)
243 {
244 FETCH_CHAR_ADVANCE (ch, charpos, bytepos);
245 XVECTOR (key)->contents[i] = make_number (ch);
246 }
247 }
248 else
249 goto invalid_composition;
250
251 hash_index = hash_lookup (hash_table, key, &hash_code);
252 if (hash_index >= 0)
253 {
254 /* We have already registered the same composition. Change PROP
255 from Form-A above to Form-B while replacing COMPONENTS with
256 COMPONENTS-VEC stored in the hash table. We can directly
257 modify the cons cell of PROP because it is not shared. */
258 key = HASH_KEY (hash_table, hash_index);
259 id = HASH_VALUE (hash_table, hash_index);
260 XSETCAR (prop, id);
261 XSETCDR (prop, Fcons (make_number (nchars), Fcons (key, XCDR (prop))));
262 return XINT (id);
263 }
264
265 /* This composition is a new one. We must register it. */
266
267 /* Check if we have sufficient memory to store this information. */
268 if (composition_table_size == 0)
269 {
270 composition_table_size = 256;
271 composition_table
272 = (struct composition **) xmalloc (sizeof (composition_table[0])
273 * composition_table_size);
274 }
275 else if (composition_table_size <= n_compositions)
276 {
277 composition_table_size += 256;
278 composition_table
279 = (struct composition **) xrealloc (composition_table,
280 sizeof (composition_table[0])
281 * composition_table_size);
282 }
283
284 key_contents = XVECTOR (key)->contents;
285
286 /* Check if the contents of COMPONENTS are valid if COMPONENTS is a
287 vector or a list. It should be a sequence of:
288 char1 rule1 char2 rule2 char3 ... ruleN charN+1 */
289
290 if (VECTORP (components)
291 && ASIZE (components) >= 2
292 && VECTORP (AREF (components, 0)))
293 {
294 /* COMPONENTS is a glyph-string. */
295 int len = ASIZE (key);
296
297 for (i = 1; i < len; i++)
298 if (! VECTORP (AREF (key, i)))
299 goto invalid_composition;
300 }
301 else if (VECTORP (components) || CONSP (components))
302 {
303 EMACS_UINT len = XVECTOR_SIZE (key);
304
305 /* The number of elements should be odd. */
306 if ((len % 2) == 0)
307 goto invalid_composition;
308 /* All elements should be integers (character or encoded
309 composition rule). */
310 for (i = 0; i < len; i++)
311 {
312 if (!INTEGERP (key_contents[i]))
313 goto invalid_composition;
314 }
315 }
316
317 /* Change PROP from Form-A above to Form-B. We can directly modify
318 the cons cell of PROP because it is not shared. */
319 XSETFASTINT (id, n_compositions);
320 XSETCAR (prop, id);
321 XSETCDR (prop, Fcons (make_number (nchars), Fcons (key, XCDR (prop))));
322
323 /* Register the composition in composition_hash_table. */
324 hash_index = hash_put (hash_table, key, id, hash_code);
325
326 /* Register the composition in composition_table. */
327 cmp = (struct composition *) xmalloc (sizeof (struct composition));
328
329 cmp->method = (NILP (components)
330 ? COMPOSITION_RELATIVE
331 : ((INTEGERP (components) || STRINGP (components))
332 ? COMPOSITION_WITH_ALTCHARS
333 : COMPOSITION_WITH_RULE_ALTCHARS));
334 cmp->hash_index = hash_index;
335 glyph_len = (cmp->method == COMPOSITION_WITH_RULE_ALTCHARS
336 ? (XVECTOR_SIZE (key) + 1) / 2
337 : XVECTOR_SIZE (key));
338 cmp->glyph_len = glyph_len;
339 cmp->offsets = (short *) xmalloc (sizeof (short) * glyph_len * 2);
340 cmp->font = NULL;
341
342 if (cmp->method != COMPOSITION_WITH_RULE_ALTCHARS)
343 {
344 /* Relative composition. */
345 cmp->width = 0;
346 for (i = 0; i < glyph_len; i++)
347 {
348 int this_width;
349 ch = XINT (key_contents[i]);
350 this_width = (ch == '\t' ? 1 : CHAR_WIDTH (ch));
351 if (cmp->width < this_width)
352 cmp->width = this_width;
353 }
354 }
355 else
356 {
357 /* Rule-base composition. */
358 float leftmost = 0.0, rightmost;
359
360 ch = XINT (key_contents[0]);
361 rightmost = ch != '\t' ? CHAR_WIDTH (ch) : 1;
362
363 for (i = 1; i < glyph_len; i += 2)
364 {
365 int rule, gref, nref, xoff, yoff;
366 int this_width;
367 float this_left;
368
369 rule = XINT (key_contents[i]);
370 ch = XINT (key_contents[i + 1]);
371 this_width = ch != '\t' ? CHAR_WIDTH (ch) : 1;
372
373 /* A composition rule is specified by an integer value
374 that encodes global and new reference points (GREF and
375 NREF). GREF and NREF are specified by numbers as
376 below:
377 0---1---2 -- ascent
378 | |
379 | |
380 | |
381 9--10--11 -- center
382 | |
383 ---3---4---5--- baseline
384 | |
385 6---7---8 -- descent
386 */
387 COMPOSITION_DECODE_RULE (rule, gref, nref, xoff, yoff);
388 this_left = (leftmost
389 + (gref % 3) * (rightmost - leftmost) / 2.0
390 - (nref % 3) * this_width / 2.0);
391
392 if (this_left < leftmost)
393 leftmost = this_left;
394 if (this_left + this_width > rightmost)
395 rightmost = this_left + this_width;
396 }
397
398 cmp->width = rightmost - leftmost;
399 if (cmp->width < (rightmost - leftmost))
400 /* To get a ceiling integer value. */
401 cmp->width++;
402 }
403
404 composition_table[n_compositions] = cmp;
405
406 return n_compositions++;
407
408 invalid_composition:
409 /* Would it be better to remove this `composition' property? */
410 return -1;
411 }
412
413 \f
414 /* Find a static composition at or nearest to position POS of OBJECT
415 (buffer or string).
416
417 OBJECT defaults to the current buffer. If there's a composition at
418 POS, set *START and *END to the start and end of the sequence,
419 *PROP to the `composition' property, and return 1.
420
421 If there's no composition at POS and LIMIT is negative, return 0.
422
423 Otherwise, search for a composition forward (LIMIT > POS) or
424 backward (LIMIT < POS). In this case, LIMIT bounds the search.
425
426 If a composition is found, set *START, *END, and *PROP as above,
427 and return 1, else return 0.
428
429 This doesn't check the validity of composition. */
430
431 int
432 find_composition (pos, limit, start, end, prop, object)
433 int pos, limit;
434 EMACS_INT *start, *end;
435 Lisp_Object *prop, object;
436 {
437 Lisp_Object val;
438
439 if (get_property_and_range (pos, Qcomposition, prop, start, end, object))
440 return 1;
441
442 if (limit < 0 || limit == pos)
443 return 0;
444
445 if (limit > pos) /* search forward */
446 {
447 val = Fnext_single_property_change (make_number (pos), Qcomposition,
448 object, make_number (limit));
449 pos = XINT (val);
450 if (pos == limit)
451 return 0;
452 }
453 else /* search backward */
454 {
455 if (get_property_and_range (pos - 1, Qcomposition, prop, start, end,
456 object))
457 return 1;
458 val = Fprevious_single_property_change (make_number (pos), Qcomposition,
459 object, make_number (limit));
460 pos = XINT (val);
461 if (pos == limit)
462 return 0;
463 pos--;
464 }
465 get_property_and_range (pos, Qcomposition, prop, start, end, object);
466 return 1;
467 }
468
469 /* Run a proper function to adjust the composition sitting between
470 FROM and TO with property PROP. */
471
472 static void
473 run_composition_function (from, to, prop)
474 int from, to;
475 Lisp_Object prop;
476 {
477 Lisp_Object func;
478 EMACS_INT start, end;
479
480 func = COMPOSITION_MODIFICATION_FUNC (prop);
481 /* If an invalid composition precedes or follows, try to make them
482 valid too. */
483 if (from > BEGV
484 && find_composition (from - 1, -1, &start, &end, &prop, Qnil)
485 && !COMPOSITION_VALID_P (start, end, prop))
486 from = start;
487 if (to < ZV
488 && find_composition (to, -1, &start, &end, &prop, Qnil)
489 && !COMPOSITION_VALID_P (start, end, prop))
490 to = end;
491 if (!NILP (Ffboundp (func)))
492 call2 (func, make_number (from), make_number (to));
493 }
494
495 /* Make invalid compositions adjacent to or inside FROM and TO valid.
496 CHECK_MASK is bitwise `or' of mask bits defined by macros
497 CHECK_XXX (see the comment in composite.h).
498
499 It also resets the text-property `auto-composed' to a proper region
500 so that automatic character composition works correctly later while
501 displaying the region.
502
503 This function is called when a buffer text is changed. If the
504 change is deletion, FROM == TO. Otherwise, FROM < TO. */
505
506 void
507 update_compositions (from, to, check_mask)
508 EMACS_INT from, to;
509 int check_mask;
510 {
511 Lisp_Object prop;
512 EMACS_INT start, end;
513 /* The beginning and end of the region to set the property
514 `auto-composed' to nil. */
515 EMACS_INT min_pos = from, max_pos = to;
516
517 if (inhibit_modification_hooks)
518 return;
519
520 /* If FROM and TO are not in a valid range, do nothing. */
521 if (! (BEGV <= from && from <= to && to <= ZV))
522 return;
523
524 if (check_mask & CHECK_HEAD)
525 {
526 /* FROM should be at composition boundary. But, insertion or
527 deletion will make two compositions adjacent and
528 indistinguishable when they have same (eq) property. To
529 avoid it, in such a case, we change the property of the
530 latter to the copy of it. */
531 if (from > BEGV
532 && find_composition (from - 1, -1, &start, &end, &prop, Qnil)
533 && COMPOSITION_VALID_P (start, end, prop))
534 {
535 min_pos = start;
536 if (end > to)
537 max_pos = end;
538 if (from < end)
539 Fput_text_property (make_number (from), make_number (end),
540 Qcomposition,
541 Fcons (XCAR (prop), XCDR (prop)), Qnil);
542 run_composition_function (start, end, prop);
543 from = end;
544 }
545 else if (from < ZV
546 && find_composition (from, -1, &start, &from, &prop, Qnil)
547 && COMPOSITION_VALID_P (start, from, prop))
548 {
549 if (from > to)
550 max_pos = from;
551 run_composition_function (start, from, prop);
552 }
553 }
554
555 if (check_mask & CHECK_INSIDE)
556 {
557 /* In this case, we are sure that (check & CHECK_TAIL) is also
558 nonzero. Thus, here we should check only compositions before
559 (to - 1). */
560 while (from < to - 1
561 && find_composition (from, to, &start, &from, &prop, Qnil)
562 && COMPOSITION_VALID_P (start, from, prop)
563 && from < to - 1)
564 run_composition_function (start, from, prop);
565 }
566
567 if (check_mask & CHECK_TAIL)
568 {
569 if (from < to
570 && find_composition (to - 1, -1, &start, &end, &prop, Qnil)
571 && COMPOSITION_VALID_P (start, end, prop))
572 {
573 /* TO should be also at composition boundary. But,
574 insertion or deletion will make two compositions adjacent
575 and indistinguishable when they have same (eq) property.
576 To avoid it, in such a case, we change the property of
577 the former to the copy of it. */
578 if (to < end)
579 {
580 Fput_text_property (make_number (start), make_number (to),
581 Qcomposition,
582 Fcons (XCAR (prop), XCDR (prop)), Qnil);
583 max_pos = end;
584 }
585 run_composition_function (start, end, prop);
586 }
587 else if (to < ZV
588 && find_composition (to, -1, &start, &end, &prop, Qnil)
589 && COMPOSITION_VALID_P (start, end, prop))
590 {
591 run_composition_function (start, end, prop);
592 max_pos = end;
593 }
594 }
595 if (min_pos < max_pos)
596 {
597 int count = SPECPDL_INDEX ();
598
599 specbind (Qinhibit_read_only, Qt);
600 specbind (Qinhibit_modification_hooks, Qt);
601 specbind (Qinhibit_point_motion_hooks, Qt);
602 Fremove_list_of_text_properties (make_number (min_pos),
603 make_number (max_pos),
604 Fcons (Qauto_composed, Qnil), Qnil);
605 unbind_to (count, Qnil);
606 }
607 }
608
609
610 /* Modify composition property values in LIST destructively. LIST is
611 a list as returned from text_property_list. Change values to the
612 top-level copies of them so that none of them are `eq'. */
613
614 void
615 make_composition_value_copy (list)
616 Lisp_Object list;
617 {
618 Lisp_Object plist, val;
619
620 for (; CONSP (list); list = XCDR (list))
621 {
622 plist = XCAR (XCDR (XCDR (XCAR (list))));
623 while (CONSP (plist) && CONSP (XCDR (plist)))
624 {
625 if (EQ (XCAR (plist), Qcomposition)
626 && (val = XCAR (XCDR (plist)), CONSP (val)))
627 XSETCAR (XCDR (plist), Fcons (XCAR (val), XCDR (val)));
628 plist = XCDR (XCDR (plist));
629 }
630 }
631 }
632
633
634 /* Make text in the region between START and END a composition that
635 has COMPONENTS and MODIFICATION-FUNC.
636
637 If STRING is non-nil, then operate on characters contained between
638 indices START and END in STRING. */
639
640 void
641 compose_text (start, end, components, modification_func, string)
642 int start, end;
643 Lisp_Object components, modification_func, string;
644 {
645 Lisp_Object prop;
646
647 prop = Fcons (Fcons (make_number (end - start), components),
648 modification_func);
649 Fput_text_property (make_number (start), make_number (end),
650 Qcomposition, prop, string);
651 }
652
653
654 static Lisp_Object autocmp_chars P_ ((Lisp_Object, EMACS_INT, EMACS_INT,
655 EMACS_INT, struct window *,
656 struct face *, Lisp_Object));
657
658 \f
659 /* Lisp glyph-string handlers */
660
661 /* Hash table for automatic composition. The key is a header of a
662 lgstring (Lispy glyph-string), and the value is a body of a
663 lgstring. */
664
665 static Lisp_Object gstring_hash_table;
666
667 static Lisp_Object gstring_lookup_cache P_ ((Lisp_Object));
668
669 static Lisp_Object
670 gstring_lookup_cache (header)
671 Lisp_Object header;
672 {
673 struct Lisp_Hash_Table *h = XHASH_TABLE (gstring_hash_table);
674 int i = hash_lookup (h, header, NULL);
675
676 return (i >= 0 ? HASH_VALUE (h, i) : Qnil);
677 }
678
679 Lisp_Object
680 composition_gstring_put_cache (gstring, len)
681 Lisp_Object gstring;
682 int len;
683 {
684 struct Lisp_Hash_Table *h = XHASH_TABLE (gstring_hash_table);
685 unsigned hash;
686 Lisp_Object header, copy;
687 int i;
688
689 header = LGSTRING_HEADER (gstring);
690 hash = h->hashfn (h, header);
691 if (len < 0)
692 {
693 len = LGSTRING_GLYPH_LEN (gstring);
694 for (i = 0; i < len; i++)
695 if (NILP (LGSTRING_GLYPH (gstring, i)))
696 break;
697 len = i;
698 }
699
700 copy = Fmake_vector (make_number (len + 2), Qnil);
701 LGSTRING_SET_HEADER (copy, Fcopy_sequence (header));
702 for (i = 0; i < len; i++)
703 LGSTRING_SET_GLYPH (copy, i, Fcopy_sequence (LGSTRING_GLYPH (gstring, i)));
704 i = hash_put (h, LGSTRING_HEADER (copy), copy, hash);
705 LGSTRING_SET_ID (copy, make_number (i));
706 return copy;
707 }
708
709 Lisp_Object
710 composition_gstring_from_id (id)
711 int id;
712 {
713 struct Lisp_Hash_Table *h = XHASH_TABLE (gstring_hash_table);
714
715 return HASH_VALUE (h, id);
716 }
717
718 static Lisp_Object fill_gstring_header P_ ((Lisp_Object, Lisp_Object,
719 Lisp_Object, Lisp_Object,
720 Lisp_Object));
721
722 int
723 composition_gstring_p (gstring)
724 Lisp_Object gstring;
725 {
726 Lisp_Object header;
727 int i;
728
729 if (! VECTORP (gstring) || ASIZE (gstring) < 2)
730 return 0;
731 header = LGSTRING_HEADER (gstring);
732 if (! VECTORP (header) || ASIZE (header) < 2)
733 return 0;
734 if (! NILP (LGSTRING_FONT (gstring))
735 && (! FONT_OBJECT_P (LGSTRING_FONT (gstring))
736 && ! CODING_SYSTEM_P (LGSTRING_FONT (gstring))))
737 return 0;
738 for (i = 1; i < ASIZE (LGSTRING_HEADER (gstring)); i++)
739 if (! NATNUMP (AREF (LGSTRING_HEADER (gstring), i)))
740 return 0;
741 if (! NILP (LGSTRING_ID (gstring)) && ! NATNUMP (LGSTRING_ID (gstring)))
742 return 0;
743 for (i = 0; i < LGSTRING_GLYPH_LEN (gstring); i++)
744 {
745 Lisp_Object glyph = LGSTRING_GLYPH (gstring, i);
746 if (NILP (glyph))
747 break;
748 if (! VECTORP (glyph) || ASIZE (glyph) != LGLYPH_SIZE)
749 return 0;
750 }
751 return 1;
752 }
753
754 int
755 composition_gstring_width (gstring, from, to, metrics)
756 Lisp_Object gstring;
757 int from, to;
758 struct font_metrics *metrics;
759 {
760 Lisp_Object *glyph;
761 int width = 0;
762
763 if (metrics)
764 {
765 Lisp_Object font_object = LGSTRING_FONT (gstring);
766
767 if (FONT_OBJECT_P (font_object))
768 {
769 struct font *font = XFONT_OBJECT (font_object);
770
771 metrics->ascent = font->ascent;
772 metrics->descent = font->descent;
773 }
774 else
775 {
776 metrics->ascent = 1;
777 metrics->descent = 0;
778 }
779 metrics->width = metrics->lbearing = metrics->rbearing = 0;
780 }
781 for (glyph = &LGSTRING_GLYPH (gstring, from); from < to; from++, glyph++)
782 {
783 int x;
784
785 if (NILP (LGLYPH_ADJUSTMENT (*glyph)))
786 width += LGLYPH_WIDTH (*glyph);
787 else
788 width += LGLYPH_WADJUST (*glyph);
789 if (metrics)
790 {
791 x = metrics->width + LGLYPH_LBEARING (*glyph) + LGLYPH_XOFF (*glyph);
792 if (metrics->lbearing > x)
793 metrics->lbearing = x;
794 x = metrics->width + LGLYPH_RBEARING (*glyph) + LGLYPH_XOFF (*glyph);
795 if (metrics->rbearing < x)
796 metrics->rbearing = x;
797 metrics->width = width;
798 x = LGLYPH_ASCENT (*glyph) - LGLYPH_YOFF (*glyph);
799 if (metrics->ascent < x)
800 metrics->ascent = x;
801 x = LGLYPH_DESCENT (*glyph) + LGLYPH_YOFF (*glyph);
802 if (metrics->descent < x)
803 metrics->descent = x;
804 }
805 }
806 return width;
807 }
808
809
810 static Lisp_Object gstring_work;
811 static Lisp_Object gstring_work_headers;
812
813 static Lisp_Object
814 fill_gstring_header (header, start, end, font_object, string)
815 Lisp_Object header, start, end, font_object, string;
816 {
817 EMACS_INT from, to, from_byte;
818 EMACS_INT len, i;
819
820 if (NILP (string))
821 {
822 if (NILP (current_buffer->enable_multibyte_characters))
823 error ("Attempt to shape unibyte text");
824 validate_region (&start, &end);
825 from = XFASTINT (start);
826 to = XFASTINT (end);
827 from_byte = CHAR_TO_BYTE (from);
828 }
829 else
830 {
831 CHECK_STRING (string);
832 if (! STRING_MULTIBYTE (string))
833 error ("Attempt to shape unibyte text");
834 /* FROM and TO are checked by the caller. */
835 from = XINT (start);
836 to = XINT (end);
837 if (from < 0 || from > to || to > SCHARS (string))
838 args_out_of_range_3 (string, start, end);
839 from_byte = string_char_to_byte (string, from);
840 }
841
842 len = to - from;
843 if (len == 0)
844 error ("Attempt to shape zero-length text");
845 if (VECTORP (header))
846 {
847 if (ASIZE (header) != len + 1)
848 args_out_of_range (header, make_number (len + 1));
849 }
850 else
851 {
852 if (len <= 8)
853 header = AREF (gstring_work_headers, len - 1);
854 else
855 header = Fmake_vector (make_number (len + 1), Qnil);
856 }
857
858 ASET (header, 0, font_object);
859 for (i = 0; i < len; i++)
860 {
861 int c;
862
863 if (NILP (string))
864 FETCH_CHAR_ADVANCE_NO_CHECK (c, from, from_byte);
865 else
866 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, from, from_byte);
867 ASET (header, i + 1, make_number (c));
868 }
869 return header;
870 }
871
872 extern void font_fill_lglyph_metrics P_ ((Lisp_Object, Lisp_Object));
873
874 static void
875 fill_gstring_body (gstring)
876 Lisp_Object gstring;
877 {
878 Lisp_Object font_object = LGSTRING_FONT (gstring);
879 Lisp_Object header = AREF (gstring, 0);
880 EMACS_INT len = LGSTRING_CHAR_LEN (gstring);
881 EMACS_INT i;
882
883 for (i = 0; i < len; i++)
884 {
885 Lisp_Object g = LGSTRING_GLYPH (gstring, i);
886 EMACS_INT c = XINT (AREF (header, i + 1));
887
888 if (NILP (g))
889 {
890 g = LGLYPH_NEW ();
891 LGSTRING_SET_GLYPH (gstring, i, g);
892 }
893 LGLYPH_SET_FROM (g, i);
894 LGLYPH_SET_TO (g, i);
895 LGLYPH_SET_CHAR (g, c);
896 if (FONT_OBJECT_P (font_object))
897 {
898 font_fill_lglyph_metrics (g, font_object);
899 }
900 else
901 {
902 int width = XFASTINT (CHAR_TABLE_REF (Vchar_width_table, c));
903
904 LGLYPH_SET_CODE (g, c);
905 LGLYPH_SET_LBEARING (g, 0);
906 LGLYPH_SET_RBEARING (g, width);
907 LGLYPH_SET_WIDTH (g, width);
908 LGLYPH_SET_ASCENT (g, 1);
909 LGLYPH_SET_DESCENT (g, 0);
910 }
911 LGLYPH_SET_ADJUSTMENT (g, Qnil);
912 }
913 if (i < LGSTRING_GLYPH_LEN (gstring))
914 LGSTRING_SET_GLYPH (gstring, i, Qnil);
915 }
916
917
918 /* Try to compose the characters at CHARPOS according to CFT_ELEMENT
919 which is an element of composition-function-table (which see).
920 LIMIT limits the characters to compose. STRING, if not nil, is a
921 target string. WIN is a window where the characters are being
922 displayed. */
923
924 static Lisp_Object
925 autocmp_chars (cft_element, charpos, bytepos, limit, win, face, string)
926 Lisp_Object cft_element;
927 EMACS_INT charpos, bytepos, limit;
928 struct window *win;
929 struct face *face;
930 Lisp_Object string;
931 {
932 int count = SPECPDL_INDEX ();
933 FRAME_PTR f = XFRAME (win->frame);
934 Lisp_Object pos = make_number (charpos);
935 EMACS_INT pt = PT, pt_byte = PT_BYTE;
936 int lookback;
937
938 record_unwind_save_match_data ();
939 for (lookback = -1; CONSP (cft_element); cft_element = XCDR (cft_element))
940 {
941 Lisp_Object elt = XCAR (cft_element);
942 Lisp_Object re;
943 Lisp_Object font_object = Qnil, gstring;
944 EMACS_INT len, to;
945
946 if (! VECTORP (elt) || ASIZE (elt) != 3)
947 continue;
948 if (lookback < 0)
949 {
950 lookback = XFASTINT (AREF (elt, 1));
951 if (limit > charpos + MAX_COMPOSITION_COMPONENTS)
952 limit = charpos + MAX_COMPOSITION_COMPONENTS;
953 }
954 else if (lookback != XFASTINT (AREF (elt, 1)))
955 break;
956 re = AREF (elt, 0);
957 if (NILP (re))
958 len = 1;
959 else if ((len = fast_looking_at (re, charpos, bytepos, limit, -1, string))
960 > 0)
961 {
962 if (NILP (string))
963 len = BYTE_TO_CHAR (bytepos + len) - charpos;
964 else
965 len = string_byte_to_char (string, bytepos + len) - charpos;
966 }
967 if (len > 0)
968 {
969 limit = to = charpos + len;
970 #ifdef HAVE_WINDOW_SYSTEM
971 if (FRAME_WINDOW_P (f))
972 {
973 font_object = font_range (charpos, &to, win, face, string);
974 if (! FONT_OBJECT_P (font_object)
975 || (! NILP (re)
976 && to < limit
977 && (fast_looking_at (re, charpos, bytepos, to, -1, string) <= 0)))
978 {
979 if (NILP (string))
980 TEMP_SET_PT_BOTH (pt, pt_byte);
981 return unbind_to (count, Qnil);
982 }
983 }
984 else
985 #endif /* not HAVE_WINDOW_SYSTEM */
986 font_object = win->frame;
987 gstring = Fcomposition_get_gstring (pos, make_number (to),
988 font_object, string);
989 if (NILP (LGSTRING_ID (gstring)))
990 {
991 Lisp_Object args[6];
992
993 /* Save point as marker before calling out to lisp. */
994 if (NILP (string))
995 {
996 Lisp_Object m = Fmake_marker ();
997 set_marker_both (m, Qnil, pt, pt_byte);
998 record_unwind_protect (restore_point_unwind, m);
999 }
1000
1001 args[0] = Vauto_composition_function;
1002 args[1] = AREF (elt, 2);
1003 args[2] = pos;
1004 args[3] = make_number (to);
1005 args[4] = font_object;
1006 args[5] = string;
1007 gstring = safe_call (6, args);
1008 }
1009 else if (NILP (string))
1010 {
1011 TEMP_SET_PT_BOTH (pt, pt_byte);
1012 }
1013 return unbind_to (count, gstring);
1014 }
1015 }
1016 if (NILP (string))
1017 TEMP_SET_PT_BOTH (pt, pt_byte);
1018 return unbind_to (count, Qnil);
1019 }
1020
1021
1022 /* Update cmp_it->stop_pos to the next position after CHARPOS (and
1023 BYTEPOS) where character composition may happen. If BYTEPOS is
1024 negative, compoute it. If it is a static composition, set
1025 cmp_it->ch to -1. Otherwise, set cmp_it->ch to the character that
1026 triggers a automatic composition. */
1027
1028 void
1029 composition_compute_stop_pos (cmp_it, charpos, bytepos, endpos, string)
1030 struct composition_it *cmp_it;
1031 EMACS_INT charpos, bytepos, endpos;
1032 Lisp_Object string;
1033 {
1034 EMACS_INT start, end, c;
1035 Lisp_Object prop, val;
1036 /* This is from forward_to_next_line_start in xdisp.c. */
1037 const int MAX_NEWLINE_DISTANCE = 500;
1038
1039 if (endpos > charpos + MAX_NEWLINE_DISTANCE)
1040 endpos = charpos + MAX_NEWLINE_DISTANCE;
1041 cmp_it->stop_pos = endpos;
1042 cmp_it->id = -1;
1043 cmp_it->ch = -2;
1044 if (find_composition (charpos, endpos, &start, &end, &prop, string)
1045 && start >= charpos
1046 && COMPOSITION_VALID_P (start, end, prop))
1047 {
1048 cmp_it->stop_pos = endpos = start;
1049 cmp_it->ch = -1;
1050 }
1051 if (NILP (string) && PT > charpos && PT < endpos)
1052 cmp_it->stop_pos = PT;
1053 if (NILP (current_buffer->enable_multibyte_characters)
1054 || NILP (Vauto_composition_mode))
1055 return;
1056 if (bytepos < 0)
1057 {
1058 if (STRINGP (string))
1059 bytepos = string_char_to_byte (string, charpos);
1060 else
1061 bytepos = CHAR_TO_BYTE (charpos);
1062 }
1063
1064 start = charpos;
1065 while (charpos < endpos)
1066 {
1067 if (STRINGP (string))
1068 FETCH_STRING_CHAR_ADVANCE (c, string, charpos, bytepos);
1069 else
1070 FETCH_CHAR_ADVANCE (c, charpos, bytepos);
1071 if (c == '\n')
1072 {
1073 cmp_it->ch = -2;
1074 break;
1075 }
1076 val = CHAR_TABLE_REF (Vcomposition_function_table, c);
1077 if (! NILP (val))
1078 {
1079 Lisp_Object elt;
1080
1081 for (; CONSP (val); val = XCDR (val))
1082 {
1083 elt = XCAR (val);
1084 if (VECTORP (elt) && ASIZE (elt) == 3 && NATNUMP (AREF (elt, 1))
1085 && charpos - 1 - XFASTINT (AREF (elt, 1)) >= start)
1086 break;
1087 }
1088 if (CONSP (val))
1089 {
1090 cmp_it->lookback = XFASTINT (AREF (elt, 1));
1091 cmp_it->stop_pos = charpos - 1 - cmp_it->lookback;
1092 cmp_it->ch = c;
1093 return;
1094 }
1095 }
1096 }
1097 cmp_it->stop_pos = charpos;
1098 }
1099
1100 /* Check if the character at CHARPOS (and BYTEPOS) is composed
1101 (possibly with the following characters) on window W. ENDPOS limits
1102 characters to be composed. FACE, in non-NULL, is a base face of
1103 the character. If STRING is not nil, it is a string containing the
1104 character to check, and CHARPOS and BYTEPOS are indices in the
1105 string. In that case, FACE must not be NULL.
1106
1107 If the character is composed, setup members of CMP_IT (id, nglyphs,
1108 and from), and return 1. Otherwise, update CMP_IT->stop_pos, and
1109 return 0. */
1110
1111 int
1112 composition_reseat_it (cmp_it, charpos, bytepos, endpos, w, face, string)
1113 struct composition_it *cmp_it;
1114 EMACS_INT charpos, bytepos, endpos;
1115 struct window *w;
1116 struct face *face;
1117 Lisp_Object string;
1118 {
1119 if (NILP (string) && charpos < PT && PT < endpos)
1120 endpos = PT;
1121
1122 if (cmp_it->ch == -2)
1123 {
1124 composition_compute_stop_pos (cmp_it, charpos, bytepos, endpos, string);
1125 if (cmp_it->ch == -2)
1126 return 0;
1127 }
1128
1129 if (cmp_it->ch < 0)
1130 {
1131 /* We are looking at a static composition. */
1132 EMACS_INT start, end;
1133 Lisp_Object prop;
1134
1135 find_composition (charpos, -1, &start, &end, &prop, string);
1136 cmp_it->id = get_composition_id (charpos, bytepos, end - start,
1137 prop, string);
1138 if (cmp_it->id < 0)
1139 goto no_composition;
1140 cmp_it->nchars = end - start;
1141 cmp_it->nglyphs = composition_table[cmp_it->id]->glyph_len;
1142 }
1143 else if (w)
1144 {
1145 Lisp_Object val, elt;
1146 int i;
1147
1148 val = CHAR_TABLE_REF (Vcomposition_function_table, cmp_it->ch);
1149 for (; CONSP (val); val = XCDR (val))
1150 {
1151 elt = XCAR (val);
1152 if (cmp_it->lookback == XFASTINT (AREF (elt, 1)))
1153 break;
1154 }
1155 if (NILP (val))
1156 goto no_composition;
1157
1158 val = autocmp_chars (val, charpos, bytepos, endpos, w, face, string);
1159 if (! composition_gstring_p (val))
1160 goto no_composition;
1161 if (NILP (LGSTRING_ID (val)))
1162 val = composition_gstring_put_cache (val, -1);
1163 cmp_it->id = XINT (LGSTRING_ID (val));
1164 for (i = 0; i < LGSTRING_GLYPH_LEN (val); i++)
1165 if (NILP (LGSTRING_GLYPH (val, i)))
1166 break;
1167 cmp_it->nglyphs = i;
1168 }
1169 else
1170 goto no_composition;
1171 cmp_it->from = 0;
1172 return 1;
1173
1174 no_composition:
1175 charpos++;
1176 if (STRINGP (string))
1177 bytepos += MULTIBYTE_LENGTH_NO_CHECK (SDATA (string) + bytepos);
1178 else
1179 INC_POS (bytepos);
1180 composition_compute_stop_pos (cmp_it, charpos, bytepos, endpos, string);
1181 return 0;
1182 }
1183
1184 int
1185 composition_update_it (cmp_it, charpos, bytepos, string)
1186 struct composition_it *cmp_it;
1187 EMACS_INT charpos, bytepos;
1188 Lisp_Object string;
1189 {
1190 int i, c;
1191
1192 if (cmp_it->ch < 0)
1193 {
1194 struct composition *cmp = composition_table[cmp_it->id];
1195
1196 cmp_it->to = cmp_it->nglyphs;
1197 if (cmp_it->nglyphs == 0)
1198 c = -1;
1199 else
1200 {
1201 for (i = 0; i < cmp->glyph_len; i++)
1202 if ((c = COMPOSITION_GLYPH (cmp, i)) != '\t')
1203 break;
1204 if (c == '\t')
1205 c = ' ';
1206 }
1207 cmp_it->width = cmp->width;
1208 }
1209 else
1210 {
1211 Lisp_Object gstring = composition_gstring_from_id (cmp_it->id);
1212
1213 if (cmp_it->nglyphs == 0)
1214 {
1215 c = -1;
1216 cmp_it->nchars = LGSTRING_CHAR_LEN (gstring);
1217 cmp_it->width = 0;
1218 }
1219 else
1220 {
1221 Lisp_Object glyph = LGSTRING_GLYPH (gstring, cmp_it->from);
1222 int from = LGLYPH_FROM (glyph);
1223
1224 c = XINT (LGSTRING_CHAR (gstring, from));
1225 cmp_it->nchars = LGLYPH_TO (glyph) - from + 1;
1226 cmp_it->width = (LGLYPH_WIDTH (glyph) > 0
1227 ? CHAR_WIDTH (LGLYPH_CHAR (glyph)) : 0);
1228 for (cmp_it->to = cmp_it->from + 1; cmp_it->to < cmp_it->nglyphs;
1229 cmp_it->to++)
1230 {
1231 glyph = LGSTRING_GLYPH (gstring, cmp_it->to);
1232 if (LGLYPH_FROM (glyph) != from)
1233 break;
1234 if (LGLYPH_WIDTH (glyph) > 0)
1235 cmp_it->width += CHAR_WIDTH (LGLYPH_CHAR (glyph));
1236 }
1237 }
1238 }
1239
1240 charpos += cmp_it->nchars;
1241 if (STRINGP (string))
1242 cmp_it->nbytes = string_char_to_byte (string, charpos) - bytepos;
1243 else
1244 cmp_it->nbytes = CHAR_TO_BYTE (charpos) - bytepos;
1245 return c;
1246 }
1247
1248
1249 struct position_record
1250 {
1251 EMACS_INT pos, pos_byte;
1252 unsigned char *p;
1253 };
1254
1255 /* Update the members of POSTION to the next character boundary. */
1256 #define FORWARD_CHAR(POSITION, STOP) \
1257 do { \
1258 (POSITION).pos++; \
1259 if ((POSITION).pos == (STOP)) \
1260 { \
1261 (POSITION).p = GAP_END_ADDR; \
1262 (POSITION).pos_byte = GPT_BYTE; \
1263 } \
1264 else \
1265 { \
1266 (POSITION).pos_byte += BYTES_BY_CHAR_HEAD (*((POSITION).p)); \
1267 (POSITION).p += BYTES_BY_CHAR_HEAD (*((POSITION).p)); \
1268 } \
1269 } while (0)
1270
1271 /* Update the members of POSTION to the previous character boundary. */
1272 #define BACKWARD_CHAR(POSITION, STOP) \
1273 do { \
1274 if ((POSITION).pos == STOP) \
1275 (POSITION).p = GPT_ADDR; \
1276 do { \
1277 (POSITION).pos_byte--; \
1278 (POSITION).p--; \
1279 } while (! CHAR_HEAD_P (*((POSITION).p))); \
1280 (POSITION).pos--; \
1281 } while (0)
1282
1283 static Lisp_Object _work_val;
1284 static int _work_char;
1285
1286 /* 1 iff the character C is composable. */
1287 #define CHAR_COMPOSABLE_P(C) \
1288 ((C) == 0x200C || (C) == 0x200D \
1289 || (_work_val = CHAR_TABLE_REF (Vunicode_category_table, (C)), \
1290 (SYMBOLP (_work_val) \
1291 && (_work_char = SDATA (SYMBOL_NAME (_work_val))[0]) != 'C' \
1292 && _work_char != 'Z')))
1293
1294 /* This is like find_composition, but find an automatic composition
1295 instead. If found, set *GSTRING to the glyph-string representing
1296 the composition, and return 1. Otherwise, return 0. */
1297
1298 static int
1299 find_automatic_composition (pos, limit, start, end, gstring, string)
1300 EMACS_INT pos, limit, *start, *end;
1301 Lisp_Object *gstring, string;
1302 {
1303 EMACS_INT head, tail, stop;
1304 /* Limit to check a composition after POS. */
1305 EMACS_INT fore_check_limit;
1306 struct position_record orig, cur, check, prev;
1307 Lisp_Object check_val, val, elt;
1308 int check_lookback;
1309 int c;
1310 Lisp_Object window;
1311 struct window *w;
1312
1313 window = Fget_buffer_window (Fcurrent_buffer (), Qnil);
1314 if (NILP (window))
1315 return 0;
1316 w = XWINDOW (window);
1317
1318 orig.pos = pos;
1319 if (NILP (string))
1320 {
1321 head = BEGV, tail = ZV, stop = GPT;
1322 orig.pos_byte = CHAR_TO_BYTE (orig.pos);
1323 orig.p = BYTE_POS_ADDR (orig.pos_byte);
1324 }
1325 else
1326 {
1327 head = 0, tail = SCHARS (string), stop = -1;
1328 orig.pos_byte = string_char_to_byte (string, orig.pos);
1329 orig.p = SDATA (string) + orig.pos_byte;
1330 }
1331 if (limit < pos)
1332 fore_check_limit = min (tail, pos + MAX_AUTO_COMPOSITION_LOOKBACK);
1333 else
1334 fore_check_limit = min (tail, limit + MAX_AUTO_COMPOSITION_LOOKBACK);
1335 cur = orig;
1336
1337 retry:
1338 check_val = Qnil;
1339 /* At first, check if POS is composable. */
1340 c = STRING_CHAR (cur.p);
1341 if (! CHAR_COMPOSABLE_P (c))
1342 {
1343 if (limit < 0)
1344 return 0;
1345 if (limit >= cur.pos)
1346 goto search_forward;
1347 }
1348 else
1349 {
1350 val = CHAR_TABLE_REF (Vcomposition_function_table, c);
1351 if (! NILP (val))
1352 check_val = val, check = cur;
1353 else
1354 while (cur.pos + 1 < fore_check_limit)
1355 {
1356 EMACS_INT b, e;
1357
1358 FORWARD_CHAR (cur, stop);
1359 if (get_property_and_range (cur.pos, Qcomposition, &val, &b, &e,
1360 Qnil)
1361 && COMPOSITION_VALID_P (b, e, val))
1362 {
1363 fore_check_limit = cur.pos;
1364 break;
1365 }
1366 c = STRING_CHAR (cur.p);
1367 if (! CHAR_COMPOSABLE_P (c))
1368 break;
1369 val = CHAR_TABLE_REF (Vcomposition_function_table, c);
1370 if (NILP (val))
1371 continue;
1372 check_val = val, check = cur;
1373 break;
1374 }
1375 cur = orig;
1376 }
1377 /* Rewind back to the position where we can safely search forward
1378 for compositions. */
1379 while (cur.pos > head)
1380 {
1381 EMACS_INT b, e;
1382
1383 BACKWARD_CHAR (cur, stop);
1384 if (get_property_and_range (cur.pos, Qcomposition, &val, &b, &e, Qnil)
1385 && COMPOSITION_VALID_P (b, e, val))
1386 break;
1387 c = STRING_CHAR (cur.p);
1388 if (! CHAR_COMPOSABLE_P (c))
1389 break;
1390 val = CHAR_TABLE_REF (Vcomposition_function_table, c);
1391 if (! NILP (val))
1392 check_val = val, check = cur;
1393 }
1394 prev = cur;
1395 /* Now search forward. */
1396 search_forward:
1397 *gstring = Qnil;
1398 if (! NILP (check_val) || limit >= orig.pos)
1399 {
1400 if (NILP (check_val))
1401 cur = orig;
1402 else
1403 cur = check;
1404 while (cur.pos < fore_check_limit)
1405 {
1406 int need_adjustment = 0;
1407
1408 if (NILP (check_val))
1409 {
1410 c = STRING_CHAR (cur.p);
1411 check_val = CHAR_TABLE_REF (Vcomposition_function_table, c);
1412 }
1413 for (; CONSP (check_val); check_val = XCDR (check_val))
1414 {
1415 elt = XCAR (check_val);
1416 if (VECTORP (elt) && ASIZE (elt) == 3 && NATNUMP (AREF (elt, 1))
1417 && cur.pos - XFASTINT (AREF (elt, 1)) >= head)
1418 {
1419 check.pos = cur.pos - XFASTINT (AREF (elt, 1));
1420 if (check.pos == cur.pos)
1421 check.pos_byte = cur.pos_byte;
1422 else
1423 check.pos_byte = CHAR_TO_BYTE (check.pos);
1424 val = autocmp_chars (check_val, check.pos, check.pos_byte,
1425 tail, w, NULL, string);
1426 need_adjustment = 1;
1427 if (! NILP (val))
1428 {
1429 *gstring = val;
1430 *start = check.pos;
1431 *end = check.pos + LGSTRING_CHAR_LEN (*gstring);
1432 if (*start <= orig.pos ? *end > orig.pos
1433 : limit >= orig.pos)
1434 return 1;
1435 cur.pos = *end;
1436 cur.pos_byte = CHAR_TO_BYTE (cur.pos);
1437 break;
1438 }
1439 }
1440 }
1441 if (need_adjustment)
1442 {
1443 /* As we have called Lisp, there's a possibilily that
1444 buffer/string is relocated. */
1445 if (NILP (string))
1446 cur.p = BYTE_POS_ADDR (cur.pos_byte);
1447 else
1448 cur.p = SDATA (string) + cur.pos_byte;
1449 }
1450 if (! CONSP (check_val))
1451 FORWARD_CHAR (cur, stop);
1452 check_val = Qnil;
1453 }
1454 }
1455 if (! NILP (*gstring))
1456 return (limit >= 0 || (*start <= orig.pos && *end > orig.pos));
1457 if (limit >= 0 && limit < orig.pos && prev.pos > head)
1458 {
1459 cur = prev;
1460 BACKWARD_CHAR (cur, stop);
1461 orig = cur;
1462 fore_check_limit = orig.pos;
1463 goto retry;
1464 }
1465 return 0;
1466 }
1467
1468 /* Return the adjusted point provided that point is moved from LAST_PT
1469 to NEW_PT. */
1470
1471 int
1472 composition_adjust_point (last_pt, new_pt)
1473 EMACS_INT last_pt, new_pt;
1474 {
1475 EMACS_INT charpos, bytepos, startpos, beg, end, pos;
1476 Lisp_Object val;
1477 int i;
1478
1479 if (new_pt == BEGV || new_pt == ZV)
1480 return new_pt;
1481
1482 /* At first check the static composition. */
1483 if (get_property_and_range (new_pt, Qcomposition, &val, &beg, &end, Qnil)
1484 && COMPOSITION_VALID_P (beg, end, val))
1485 {
1486 if (beg < new_pt /* && end > new_pt <- It's always the case. */
1487 && (last_pt <= beg || last_pt >= end))
1488 return (new_pt < last_pt ? beg : end);
1489 return new_pt;
1490 }
1491
1492 if (NILP (current_buffer->enable_multibyte_characters)
1493 || NILP (Vauto_composition_mode))
1494 return new_pt;
1495
1496 /* Next check the automatic composition. */
1497 if (! find_automatic_composition (new_pt, (EMACS_INT) -1, &beg, &end, &val,
1498 Qnil)
1499 || beg == new_pt)
1500 return new_pt;
1501 for (i = 0; i < LGSTRING_GLYPH_LEN (val); i++)
1502 {
1503 Lisp_Object glyph = LGSTRING_GLYPH (val, i);
1504
1505 if (NILP (glyph))
1506 break;
1507 if (beg + LGLYPH_FROM (glyph) == new_pt)
1508 return new_pt;
1509 if (beg + LGLYPH_TO (glyph) >= new_pt)
1510 return (new_pt < last_pt
1511 ? beg + LGLYPH_FROM (glyph)
1512 : beg + LGLYPH_TO (glyph) + 1);
1513 }
1514 return new_pt;
1515 }
1516
1517 DEFUN ("composition-get-gstring", Fcomposition_get_gstring,
1518 Scomposition_get_gstring, 4, 4, 0,
1519 doc: /* Return a glyph-string for characters between FROM and TO.
1520 If the glyph string is for graphic display, FONT-OBJECT must be
1521 a font-object to use for those characters.
1522 Otherwise (for terminal display), FONT-OBJECT must be a terminal ID, a
1523 frame, or nil for the selected frame's terminal device.
1524
1525 If the optional 4th argument STRING is not nil, it is a string
1526 containing the target characters between indices FROM and TO.
1527
1528 A glyph-string is a vector containing information about how to display
1529 a specific character sequence. The format is:
1530 [HEADER ID GLYPH ...]
1531
1532 HEADER is a vector of this form:
1533 [FONT-OBJECT CHAR ...]
1534 where
1535 FONT-OBJECT is a font-object for all glyphs in the glyph-string,
1536 or the terminal coding system of the specified terminal.
1537 CHARs are characters to be composed by GLYPHs.
1538
1539 ID is an identification number of the glyph-string. It may be nil if
1540 not yet shaped.
1541
1542 GLYPH is a vector whose elements have this form:
1543 [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT
1544 [ [X-OFF Y-OFF WADJUST] | nil] ]
1545 where
1546 FROM-IDX and TO-IDX are used internally and should not be touched.
1547 C is the character of the glyph.
1548 CODE is the glyph-code of C in FONT-OBJECT.
1549 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
1550 X-OFF and Y-OFF are offsets to the base position for the glyph.
1551 WADJUST is the adjustment to the normal width of the glyph.
1552
1553 If GLYPH is nil, the remaining elements of the glyph-string vector
1554 should be ignored. */)
1555 (from, to, font_object, string)
1556 Lisp_Object font_object, from, to, string;
1557 {
1558 Lisp_Object gstring, header;
1559 EMACS_INT frompos, topos;
1560
1561 CHECK_NATNUM (from);
1562 CHECK_NATNUM (to);
1563 if (XINT (to) > XINT (from) + MAX_COMPOSITION_COMPONENTS)
1564 to = make_number (XINT (from) + MAX_COMPOSITION_COMPONENTS);
1565 if (! FONT_OBJECT_P (font_object))
1566 {
1567 struct coding_system *coding;
1568 struct terminal *terminal = get_terminal (font_object, 1);
1569
1570 coding = ((TERMINAL_TERMINAL_CODING (terminal)->common_flags
1571 & CODING_REQUIRE_ENCODING_MASK)
1572 ? TERMINAL_TERMINAL_CODING (terminal) : &safe_terminal_coding);
1573 font_object = CODING_ID_NAME (coding->id);
1574 }
1575
1576 header = fill_gstring_header (Qnil, from, to, font_object, string);
1577 gstring = gstring_lookup_cache (header);
1578 if (! NILP (gstring))
1579 return gstring;
1580
1581 frompos = XINT (from);
1582 topos = XINT (to);
1583 if (LGSTRING_GLYPH_LEN (gstring_work) < topos - frompos)
1584 gstring_work = Fmake_vector (make_number (topos - frompos + 2), Qnil);
1585 LGSTRING_SET_HEADER (gstring_work, header);
1586 LGSTRING_SET_ID (gstring_work, Qnil);
1587 fill_gstring_body (gstring_work);
1588 return gstring_work;
1589 }
1590
1591 \f
1592 /* Emacs Lisp APIs. */
1593
1594 DEFUN ("compose-region-internal", Fcompose_region_internal,
1595 Scompose_region_internal, 2, 4, 0,
1596 doc: /* Internal use only.
1597
1598 Compose text in the region between START and END.
1599 Optional 3rd and 4th arguments are COMPONENTS and MODIFICATION-FUNC
1600 for the composition. See `compose-region' for more details. */)
1601 (start, end, components, modification_func)
1602 Lisp_Object start, end, components, modification_func;
1603 {
1604 validate_region (&start, &end);
1605 if (!NILP (components)
1606 && !INTEGERP (components)
1607 && !CONSP (components)
1608 && !STRINGP (components))
1609 CHECK_VECTOR (components);
1610
1611 compose_text (XINT (start), XINT (end), components, modification_func, Qnil);
1612 return Qnil;
1613 }
1614
1615 DEFUN ("compose-string-internal", Fcompose_string_internal,
1616 Scompose_string_internal, 3, 5, 0,
1617 doc: /* Internal use only.
1618
1619 Compose text between indices START and END of STRING.
1620 Optional 4th and 5th arguments are COMPONENTS and MODIFICATION-FUNC
1621 for the composition. See `compose-string' for more details. */)
1622 (string, start, end, components, modification_func)
1623 Lisp_Object string, start, end, components, modification_func;
1624 {
1625 CHECK_STRING (string);
1626 CHECK_NUMBER (start);
1627 CHECK_NUMBER (end);
1628
1629 if (XINT (start) < 0 ||
1630 XINT (start) > XINT (end)
1631 || XINT (end) > SCHARS (string))
1632 args_out_of_range (start, end);
1633
1634 compose_text (XINT (start), XINT (end), components, modification_func, string);
1635 return string;
1636 }
1637
1638 DEFUN ("find-composition-internal", Ffind_composition_internal,
1639 Sfind_composition_internal, 4, 4, 0,
1640 doc: /* Internal use only.
1641
1642 Return information about composition at or nearest to position POS.
1643 See `find-composition' for more details. */)
1644 (pos, limit, string, detail_p)
1645 Lisp_Object pos, limit, string, detail_p;
1646 {
1647 Lisp_Object prop, tail, gstring;
1648 EMACS_INT start, end, from, to;
1649 int id;
1650
1651 CHECK_NUMBER_COERCE_MARKER (pos);
1652 from = XINT (pos);
1653 if (!NILP (limit))
1654 {
1655 CHECK_NUMBER_COERCE_MARKER (limit);
1656 to = XINT (limit);
1657 }
1658 else
1659 to = -1;
1660
1661 if (!NILP (string))
1662 {
1663 CHECK_STRING (string);
1664 if (XINT (pos) < 0 || XINT (pos) > SCHARS (string))
1665 args_out_of_range (string, pos);
1666 }
1667 else
1668 {
1669 if (XINT (pos) < BEGV || XINT (pos) > ZV)
1670 args_out_of_range (Fcurrent_buffer (), pos);
1671 }
1672
1673 if (!find_composition (from, to, &start, &end, &prop, string))
1674 {
1675 if (!NILP (current_buffer->enable_multibyte_characters)
1676 && ! NILP (Vauto_composition_mode)
1677 && find_automatic_composition (from, to, &start, &end, &gstring,
1678 string))
1679 return list3 (make_number (start), make_number (end), gstring);
1680 return Qnil;
1681 }
1682 if ((end <= XINT (pos) || start > XINT (pos)))
1683 {
1684 EMACS_INT s, e;
1685
1686 if (find_automatic_composition (from, to, &s, &e, &gstring, string)
1687 && (e <= XINT (pos) ? e > end : s < start))
1688 return list3 (make_number (start), make_number (end), gstring);
1689 }
1690 if (!COMPOSITION_VALID_P (start, end, prop))
1691 return Fcons (make_number (start), Fcons (make_number (end),
1692 Fcons (Qnil, Qnil)));
1693 if (NILP (detail_p))
1694 return Fcons (make_number (start), Fcons (make_number (end),
1695 Fcons (Qt, Qnil)));
1696
1697 if (COMPOSITION_REGISTERD_P (prop))
1698 id = COMPOSITION_ID (prop);
1699 else
1700 {
1701 int start_byte = (NILP (string)
1702 ? CHAR_TO_BYTE (start)
1703 : string_char_to_byte (string, start));
1704 id = get_composition_id (start, start_byte, end - start, prop, string);
1705 }
1706
1707 if (id >= 0)
1708 {
1709 Lisp_Object components, relative_p, mod_func;
1710 enum composition_method method = COMPOSITION_METHOD (prop);
1711 int width = composition_table[id]->width;
1712
1713 components = Fcopy_sequence (COMPOSITION_COMPONENTS (prop));
1714 relative_p = (method == COMPOSITION_WITH_RULE_ALTCHARS
1715 ? Qnil : Qt);
1716 mod_func = COMPOSITION_MODIFICATION_FUNC (prop);
1717 tail = Fcons (components,
1718 Fcons (relative_p,
1719 Fcons (mod_func,
1720 Fcons (make_number (width), Qnil))));
1721 }
1722 else
1723 tail = Qnil;
1724
1725 return Fcons (make_number (start), Fcons (make_number (end), tail));
1726 }
1727
1728 \f
1729 void
1730 syms_of_composite ()
1731 {
1732 int i;
1733
1734 Qcomposition = intern_c_string ("composition");
1735 staticpro (&Qcomposition);
1736
1737 /* Make a hash table for static composition. */
1738 {
1739 Lisp_Object args[6];
1740 extern Lisp_Object QCsize;
1741
1742 args[0] = QCtest;
1743 args[1] = Qequal;
1744 args[2] = QCweakness;
1745 /* We used to make the hash table weak so that unreferenced
1746 compositions can be garbage-collected. But, usually once
1747 created compositions are repeatedly used in an Emacs session,
1748 and thus it's not worth to save memory in such a way. So, we
1749 make the table not weak. */
1750 args[3] = Qnil;
1751 args[4] = QCsize;
1752 args[5] = make_number (311);
1753 composition_hash_table = Fmake_hash_table (6, args);
1754 staticpro (&composition_hash_table);
1755 }
1756
1757 /* Make a hash table for glyph-string. */
1758 {
1759 Lisp_Object args[6];
1760 extern Lisp_Object QCsize;
1761
1762 args[0] = QCtest;
1763 args[1] = Qequal;
1764 args[2] = QCweakness;
1765 args[3] = Qnil;
1766 args[4] = QCsize;
1767 args[5] = make_number (311);
1768 gstring_hash_table = Fmake_hash_table (6, args);
1769 staticpro (&gstring_hash_table);
1770 }
1771
1772 staticpro (&gstring_work_headers);
1773 gstring_work_headers = Fmake_vector (make_number (8), Qnil);
1774 for (i = 0; i < 8; i++)
1775 ASET (gstring_work_headers, i, Fmake_vector (make_number (i + 2), Qnil));
1776 staticpro (&gstring_work);
1777 gstring_work = Fmake_vector (make_number (10), Qnil);
1778
1779 /* Text property `composition' should be nonsticky by default. */
1780 Vtext_property_default_nonsticky
1781 = Fcons (Fcons (Qcomposition, Qt), Vtext_property_default_nonsticky);
1782
1783 DEFVAR_LISP ("compose-chars-after-function", &Vcompose_chars_after_function,
1784 doc: /* Function to adjust composition of buffer text.
1785
1786 This function is called with three arguments: FROM, TO, and OBJECT.
1787 FROM and TO specify the range of text whose composition should be
1788 adjusted. OBJECT, if non-nil, is a string that contains the text.
1789
1790 This function is called after a text with `composition' property is
1791 inserted or deleted to keep `composition' property of buffer text
1792 valid.
1793
1794 The default value is the function `compose-chars-after'. */);
1795 Vcompose_chars_after_function = intern_c_string ("compose-chars-after");
1796
1797 Qauto_composed = intern_c_string ("auto-composed");
1798 staticpro (&Qauto_composed);
1799
1800 Qauto_composition_function = intern_c_string ("auto-composition-function");
1801 staticpro (&Qauto_composition_function);
1802
1803 DEFVAR_LISP ("auto-composition-mode", &Vauto_composition_mode,
1804 doc: /* Non-nil if Auto-Composition mode is enabled.
1805 Use the command `auto-composition-mode' to change this variable. */);
1806 Vauto_composition_mode = Qt;
1807
1808 DEFVAR_LISP ("auto-composition-function", &Vauto_composition_function,
1809 doc: /* Function to call to compose characters automatically.
1810 This function is called from the display routine with four arguments:
1811 FROM, TO, WINDOW, and STRING.
1812
1813 If STRING is nil, the function must compose characters in the region
1814 between FROM and TO in the current buffer.
1815
1816 Otherwise, STRING is a string, and FROM and TO are indices into the
1817 string. In this case, the function must compose characters in the
1818 string. */);
1819 Vauto_composition_function = Qnil;
1820
1821 DEFVAR_LISP ("composition-function-table", &Vcomposition_function_table,
1822 doc: /* Char-table of functions for automatic character composition.
1823 For each character that has to be composed automatically with
1824 preceding and/or following characters, this char-table contains
1825 a function to call to compose that character.
1826
1827 The element at index C in the table, if non-nil, is a list of
1828 this form: ([PATTERN PREV-CHARS FUNC] ...)
1829
1830 PATTERN is a regular expression which C and the surrounding
1831 characters must match.
1832
1833 PREV-CHARS is a non-negative integer (less than 4) specifying how many
1834 characters before C to check the matching with PATTERN. If it is 0,
1835 PATTERN must match C and the following characters. If it is 1,
1836 PATTERN must match a character before C and the following characters.
1837
1838 If PREV-CHARS is 0, PATTERN can be nil, which means that the
1839 single character C should be composed.
1840
1841 FUNC is a function to return a glyph-string representing a
1842 composition of the characters that match PATTERN. It is
1843 called with one argument GSTRING.
1844
1845 GSTRING is a template of a glyph-string to return. It is already
1846 filled with a proper header for the characters to compose, and
1847 glyphs corresponding to those characters one by one. The
1848 function must return a new glyph-string with the same header as
1849 GSTRING, or modify GSTRING itself and return it.
1850
1851 See also the documentation of `auto-composition-mode'. */);
1852 Vcomposition_function_table = Fmake_char_table (Qnil, Qnil);
1853
1854 defsubr (&Scompose_region_internal);
1855 defsubr (&Scompose_string_internal);
1856 defsubr (&Sfind_composition_internal);
1857 defsubr (&Scomposition_get_gstring);
1858 }
1859
1860 /* arch-tag: 79cefaf8-ca48-4eed-97e5-d5afb290d272
1861 (do not change this comment) */