Include window.h, frame.h, dispextern.h font.h.
[bpt/emacs.git] / src / composite.c
CommitLineData
ca4c9455 1/* Composite sequence support.
aaef169d 2 Copyright (C) 2001, 2002, 2003, 2004, 2005,
8cabe764
GM
3 2006, 2007, 2008 Free Software Foundation, Inc.
4 Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
ce03bf76
KH
5 National Institute of Advanced Industrial Science and Technology (AIST)
6 Registration Number H14PRO021
f30d8d94 7 Copyright (C) 2003, 2006
1527c36e
KH
8 National Institute of Advanced Industrial Science and Technology (AIST)
9 Registration Number H13PRO009
ca4c9455
KH
10
11This file is part of GNU Emacs.
12
9ec0b715 13GNU Emacs is free software: you can redistribute it and/or modify
ca4c9455 14it under the terms of the GNU General Public License as published by
9ec0b715
GM
15the Free Software Foundation, either version 3 of the License, or
16(at your option) any later version.
ca4c9455
KH
17
18GNU Emacs is distributed in the hope that it will be useful,
19but WITHOUT ANY WARRANTY; without even the implied warranty of
20MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21GNU General Public License for more details.
22
23You should have received a copy of the GNU General Public License
9ec0b715 24along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
ca4c9455
KH
25
26#include <config.h>
27#include "lisp.h"
28#include "buffer.h"
1527c36e 29#include "character.h"
ca4c9455 30#include "intervals.h"
58753d74
KH
31#include "window.h"
32#include "frame.h"
33#include "dispextern.h"
34#include "font.h"
ca4c9455
KH
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
4abc7470 102 weak, but as each key (COMPONENTS-VEC) is also kept as a value of the
ca4c9455 103 `composition' property, it won't be collected as garbage until all
4abc7470 104 bits of text that have the same COMPONENTS-VEC are deleted.
ca4c9455
KH
105
106 The latter is a table of pointers to `struct composition' indexed
4abc7470 107 by COMPOSITION-ID. This structure keeps the other information (see
ca4c9455
KH
108 composite.h).
109
110 In general, a text property holds information about individual
111 characters. But, a `composition' property holds information about
4abc7470 112 a sequence of characters (in this sense, it is like the `intangible'
ca4c9455 113 property). That means that we should not share the property value
4abc7470 114 in adjacent compositions -- we can't distinguish them if they have the
ca4c9455
KH
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
4abc7470 121 As the value of the `composition' property holds information about a
ca4c9455 122 specific range of text, the value gets invalid if we change the
4abc7470 123 text in the range. We treat the `composition' property as always
ca4c9455
KH
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
4abc7470 127 range just shorter. So, we can check the validity of the `composition'
ca4c9455
KH
128 property by comparing LENGTH information with the actual length of
129 the composition.
130
131*/
132
133
134Lisp_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. */
139struct composition **composition_table;
140
141/* The current size of `composition_table'. */
142static int composition_table_size;
143
144/* Number of compositions currently made. */
145int 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. */
150Lisp_Object composition_hash_table;
151
152/* Function to call to adjust composition. */
153Lisp_Object Vcompose_chars_after_function;
154
f96ba4c1
KH
155Lisp_Object Qauto_composed;
156Lisp_Object Vauto_composition_function;
157Lisp_Object Qauto_composition_function;
58753d74 158Lisp_Object Vcomposition_function_table;
40add26d 159
ea058d2c
DL
160EXFUN (Fremove_list_of_text_properties, 4);
161
ca4c9455
KH
162/* Temporary variable used in macros COMPOSITION_XXX. */
163Lisp_Object composition_temp;
f30d8d94 164
ca4c9455 165\f
ca4c9455
KH
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
173int
174get_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);
f3fbd155
KR
251 XSETCAR (prop, id);
252 XSETCDR (prop, Fcons (make_number (nchars), Fcons (key, XCDR (prop))));
ca4c9455
KH
253 return XINT (id);
254 }
255
256 /* This composition is a new one. We must register it. */
177c0ea7 257
ca4c9455
KH
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 */
f30d8d94 280
dd5e1ed4 281 if (VECTORP (components)
f30d8d94
KH
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 }
dd5e1ed4 292 else if (VECTORP (components) || CONSP (components))
ca4c9455
KH
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);
f3fbd155
KR
311 XSETCAR (prop, id);
312 XSETCDR (prop, Fcons (make_number (nchars), Fcons (key, XCDR (prop))));
ca4c9455
KH
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
58753d74 333 if (cmp->method != COMPOSITION_WITH_RULE_ALTCHARS)
ca4c9455
KH
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]);
8e86803c 341 this_width = (ch == '\t' ? 1 : CHAR_WIDTH (ch));
ca4c9455
KH
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]);
69df789a 352 rightmost = ch != '\t' ? CHAR_WIDTH (ch) : 1;
ca4c9455
KH
353
354 for (i = 1; i < glyph_len; i += 2)
355 {
464f8566 356 int rule, gref, nref, xoff, yoff;
ca4c9455
KH
357 int this_width;
358 float this_left;
359
360 rule = XINT (key_contents[i]);
361 ch = XINT (key_contents[i + 1]);
69df789a 362 this_width = ch != '\t' ? CHAR_WIDTH (ch) : 1;
ca4c9455
KH
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 */
464f8566 378 COMPOSITION_DECODE_RULE (rule, gref, nref, xoff, yoff);
ca4c9455
KH
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
422int
423find_composition (pos, limit, start, end, prop, object)
aaefca97
DL
424 int pos, limit;
425 EMACS_INT *start, *end;
ca4c9455
KH
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 */
d279f620
KH
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 }
ca4c9455 444 else /* search backward */
d279f620
KH
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 }
ca4c9455
KH
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
463static void
464run_composition_function (from, to, prop)
465 int from, to;
466 Lisp_Object prop;
467{
7d019510 468 Lisp_Object func;
aaefca97 469 EMACS_INT start, end;
ca4c9455
KH
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;
775b3d2d 482 if (!NILP (Ffboundp (func)))
ca4c9455 483 call2 (func, make_number (from), make_number (to));
ca4c9455
KH
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
b418f8a6 490 It also resets the text-property `auto-composed' to a proper region
f96ba4c1
KH
491 so that automatic character composition works correctly later while
492 displaying the region.
8f924df7 493
ca4c9455
KH
494 This function is called when a buffer text is changed. If the
495 change is deletion, FROM == TO. Otherwise, FROM < TO. */
496
497void
498update_compositions (from, to, check_mask)
aaefca97
DL
499 EMACS_INT from, to;
500 int check_mask;
ca4c9455 501{
7d019510 502 Lisp_Object prop;
aaefca97 503 EMACS_INT start, end;
f96ba4c1
KH
504 /* The beginning and end of the region to set the property
505 `auto-composed' to nil. */
aaefca97 506 EMACS_INT min_pos = from, max_pos = to;
ca4c9455 507
6c1aa7f1
GM
508 if (inhibit_modification_hooks)
509 return;
177c0ea7 510
d3f40cbd
KH
511 /* If FROM and TO are not in a valid range, do nothing. */
512 if (! (BEGV <= from && from <= to && to <= ZV))
513 return;
514
ca4c9455
KH
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
553d3164
KH
523 && find_composition (from - 1, -1, &start, &end, &prop, Qnil)
524 && COMPOSITION_VALID_P (start, end, prop))
ca4c9455 525 {
f96ba4c1
KH
526 min_pos = start;
527 if (end > to)
528 max_pos = end;
ca4c9455
KH
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 }
dd33cc56 536 else if (from < ZV
553d3164 537 && find_composition (from, -1, &start, &from, &prop, Qnil)
9657d668 538 && COMPOSITION_VALID_P (start, from, prop))
f96ba4c1
KH
539 {
540 if (from > to)
541 max_pos = from;
542 run_composition_function (start, from, prop);
543 }
ca4c9455
KH
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)
9657d668 553 && COMPOSITION_VALID_P (start, from, prop)
ca4c9455
KH
554 && from < to - 1)
555 run_composition_function (start, from, prop);
556 }
557
558 if (check_mask & CHECK_TAIL)
559 {
560 if (from < to
553d3164
KH
561 && find_composition (to - 1, -1, &start, &end, &prop, Qnil)
562 && COMPOSITION_VALID_P (start, end, prop))
ca4c9455
KH
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)
f96ba4c1
KH
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 }
ca4c9455
KH
576 run_composition_function (start, end, prop);
577 }
578 else if (to < ZV
553d3164
KH
579 && find_composition (to, -1, &start, &end, &prop, Qnil)
580 && COMPOSITION_VALID_P (start, end, prop))
f96ba4c1
KH
581 {
582 run_composition_function (start, end, prop);
583 max_pos = end;
584 }
ca4c9455 585 }
f96ba4c1 586 if (min_pos < max_pos)
9d440521
KH
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 }
ca4c9455
KH
598}
599
c1361885
KH
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
605void
606make_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)))
f3fbd155 618 XSETCAR (XCDR (plist), Fcons (XCAR (val), XCDR (val)));
c1361885
KH
619 plist = XCDR (XCDR (plist));
620 }
621 }
622}
623
624
ca4c9455
KH
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
631void
632compose_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}
58753d74
KH
643
644
645static 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
656static Lisp_Object gstring_hash_table;
657
658static Lisp_Object gstring_lookup_cache P_ ((Lisp_Object));
659
660static Lisp_Object
661gstring_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
670Lisp_Object
671composition_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
700Lisp_Object
701composition_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
709static Lisp_Object fill_gstring_header P_ ((Lisp_Object, Lisp_Object,
710 Lisp_Object, Lisp_Object,
711 Lisp_Object));
712
713int
714composition_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
744int
745composition_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
791static Lisp_Object gstring_work;
792static Lisp_Object gstring_work_headers;
793
794static Lisp_Object
795fill_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
854extern void font_fill_lglyph_metrics P_ ((Lisp_Object, Lisp_Object));
855
856static void
857fill_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 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
899EXFUN (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
907static Lisp_Object
908autocmp_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
984void
985composition_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
1051int
1052composition_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
1105int
1106composition_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 = 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
1170int
1171composition_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
1288DEFUN ("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.
1291If the glhph string is for graphic display, FONT-OBJECT must be
1292a font-object to use for those characters.
1293Otherwise (for terminal display), FONT-OBJECT must be nil.
1294
1295If the optional 4th argument STRING is not nil, it is a string
1296containing the target characters between indices FROM and TO.
1297
1298A glhph-string is a vector containing information about how to display
1299specific character sequence. The format is:
1300 [HEADER ID GLYPH ...]
1301
1302HEADER is a vector of this form:
1303 [FONT-OBJECT CHAR ...]
1304where
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
1309ID is an identification number of the glyph-string. It may be nil if
1310not yet shaped.
1311
1312GLYPH 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] ]
1315where
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
1323If GLYPH is nil, the remaining elements of the glhph-string vector
1324must 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
ca4c9455
KH
1342\f
1343/* Emacs Lisp APIs. */
1344
1345DEFUN ("compose-region-internal", Fcompose_region_internal,
1346 Scompose_region_internal, 2, 4, 0,
335c5470
PJ
1347 doc: /* Internal use only.
1348
1349Compose text in the region between START and END.
1350Optional 3rd and 4th arguments are COMPONENTS and MODIFICATION-FUNC
9baf7418 1351for the composition. See `compose-region' for more detail. */)
d562f8ab
JB
1352 (start, end, components, modification_func)
1353 Lisp_Object start, end, components, modification_func;
ca4c9455
KH
1354{
1355 validate_region (&start, &end);
1356 if (!NILP (components)
1357 && !INTEGERP (components)
1358 && !CONSP (components)
1359 && !STRINGP (components))
b7826503 1360 CHECK_VECTOR (components);
ca4c9455 1361
d562f8ab 1362 compose_text (XINT (start), XINT (end), components, modification_func, Qnil);
ca4c9455
KH
1363 return Qnil;
1364}
1365
1366DEFUN ("compose-string-internal", Fcompose_string_internal,
1367 Scompose_string_internal, 3, 5, 0,
335c5470
PJ
1368 doc: /* Internal use only.
1369
1370Compose text between indices START and END of STRING.
1371Optional 4th and 5th arguments are COMPONENTS and MODIFICATION-FUNC
9baf7418 1372for the composition. See `compose-string' for more detail. */)
d562f8ab
JB
1373 (string, start, end, components, modification_func)
1374 Lisp_Object string, start, end, components, modification_func;
ca4c9455 1375{
b7826503
PJ
1376 CHECK_STRING (string);
1377 CHECK_NUMBER (start);
1378 CHECK_NUMBER (end);
ca4c9455
KH
1379
1380 if (XINT (start) < 0 ||
1381 XINT (start) > XINT (end)
d5db4077 1382 || XINT (end) > SCHARS (string))
ca4c9455
KH
1383 args_out_of_range (start, end);
1384
d562f8ab 1385 compose_text (XINT (start), XINT (end), components, modification_func, string);
ca4c9455
KH
1386 return string;
1387}
1388
1389DEFUN ("find-composition-internal", Ffind_composition_internal,
177c0ea7 1390 Sfind_composition_internal, 4, 4, 0,
335c5470
PJ
1391 doc: /* Internal use only.
1392
1393Return information about composition at or nearest to position POS.
1394See `find-composition' for more detail. */)
1395 (pos, limit, string, detail_p)
ca4c9455
KH
1396 Lisp_Object pos, limit, string, detail_p;
1397{
1398 Lisp_Object prop, tail;
aaefca97 1399 EMACS_INT start, end;
ca4c9455
KH
1400 int id;
1401
b7826503 1402 CHECK_NUMBER_COERCE_MARKER (pos);
ca4c9455
KH
1403 start = XINT (pos);
1404 if (!NILP (limit))
1405 {
b7826503 1406 CHECK_NUMBER_COERCE_MARKER (limit);
ca4c9455
KH
1407 end = XINT (limit);
1408 }
1409 else
1410 end = -1;
177c0ea7 1411
ca4c9455 1412 if (!NILP (string))
e3b3e327 1413 {
b7826503 1414 CHECK_STRING (string);
d5db4077 1415 if (XINT (pos) < 0 || XINT (pos) > SCHARS (string))
e3b3e327
GM
1416 args_out_of_range (string, pos);
1417 }
1418 else
1419 {
fa9090b8 1420 if (XINT (pos) < BEGV || XINT (pos) > ZV)
e3b3e327
GM
1421 args_out_of_range (Fcurrent_buffer (), pos);
1422 }
ca4c9455
KH
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
1465void
1466syms_of_composite ()
1467{
58753d74
KH
1468 int i;
1469
ca4c9455
KH
1470 Qcomposition = intern ("composition");
1471 staticpro (&Qcomposition);
1472
58753d74 1473 /* Make a hash table for static composition. */
ca4c9455 1474 {
09654086 1475 Lisp_Object args[6];
ca4c9455 1476 extern Lisp_Object QCsize;
177c0ea7 1477
ca4c9455
KH
1478 args[0] = QCtest;
1479 args[1] = Qequal;
1480 args[2] = QCweakness;
dc47eccc 1481 /* We used to make the hash table weak so that unreferenced
ca101cff 1482 compositions can be garbage-collected. But, usually once
dc47eccc
KH
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. */
6a83ee8a 1486 args[3] = Qnil;
ca4c9455
KH
1487 args[4] = QCsize;
1488 args[5] = make_number (311);
09654086 1489 composition_hash_table = Fmake_hash_table (6, args);
ca4c9455
KH
1490 staticpro (&composition_hash_table);
1491 }
1492
58753d74
KH
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
ca4c9455
KH
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,
335c5470
PJ
1520 doc: /* Function to adjust composition of buffer text.
1521
1522The function is called with three arguments FROM, TO, and OBJECT.
1523FROM and TO specify the range of text of which composition should be
1524adjusted. OBJECT, if non-nil, is a string that contains the text.
1525
1526This function is called after a text with `composition' property is
1527inserted or deleted to keep `composition' property of buffer text
1528valid.
1529
1530The default value is the function `compose-chars-after'. */);
ca4c9455
KH
1531 Vcompose_chars_after_function = intern ("compose-chars-after");
1532
f96ba4c1
KH
1533 Qauto_composed = intern ("auto-composed");
1534 staticpro (&Qauto_composed);
40add26d 1535
f96ba4c1
KH
1536 Qauto_composition_function = intern ("auto-composition-function");
1537 staticpro (&Qauto_composition_function);
40add26d 1538
f96ba4c1
KH
1539 DEFVAR_LISP ("auto-composition-function", &Vauto_composition_function,
1540 doc: /* Function to call to compose characters automatically.
ddc872ba
KH
1541The function is called from the display routine with four arguments,
1542FROM, TO, WINDOW, and STRING.
335c5470 1543
ddc872ba
KH
1544If STRING is nil, the function must compose characters in the region
1545between FROM and TO in the current buffer.
335c5470 1546
ddc872ba
KH
1547Otherwise, STRING is a string, and FROM and TO are indices into the
1548string. In this case, the function must compose characters in the
1549string. */);
f96ba4c1 1550 Vauto_composition_function = Qnil;
40add26d 1551
58753d74
KH
1552 DEFVAR_LISP ("composition-function-table", &Vcomposition_function_table,
1553 doc: /* Char-able of functions for automatic character composition.
1554For each character that has to be composed automatically with
1555preceding and/or following characters, this char-table contains
1556a function to call to compose that character.
1557
1558The element at index C in the table, if non-nil, is a list of
1559this form: ([PATTERN PREV-CHARS FUNC] ...)
1560
1561PATTERN is a regular expression with which C and the surrounding
1562characters must match.
1563
1564PREV-CHARS is a number of characters before C to check the
1565matching with PATTERN. If it is 0, PATTERN must match with C and
1566the following characters. If it is 1, PATTERN must match with a
1567character before C and the following characters.
1568
1569If PREV-CHARS is 0, PATTERN can be nil, which means that the
1570single character C should be composed.
1571
1572FUNC is a function to return a glyph-string representing a
1573composition of the characters matching with PATTERN. It is
1574called with one argument GSTRING.
1575
1576GSTRING is a template of a glyph-string to return. It is already
1577filled with a proper header for the characters to compose, and
1578glyphs corresponding to those characters one by one. The
1579function must return a new glyph-string of the same header as
1580GSTRING, or modify GSTRING itself and return it.
1581
1582See also the documentation of `auto-composition-mode'. */);
1583 Vcomposition_function_table = Fmake_char_table (Qnil, Qnil);
1584
ca4c9455
KH
1585 defsubr (&Scompose_region_internal);
1586 defsubr (&Scompose_string_internal);
1587 defsubr (&Sfind_composition_internal);
58753d74 1588 defsubr (&Scomposition_get_gstring);
ca4c9455 1589}
ee6f9c59
KH
1590
1591/* arch-tag: 79cefaf8-ca48-4eed-97e5-d5afb290d272
1592 (do not change this comment) */