| 1 | /* Composite sequence support. |
| 2 | Copyright (C) 1999 Electrotechnical Laboratory, JAPAN. |
| 3 | Licensed to the Free Software Foundation. |
| 4 | Copyright (C) 2001 Free Software Foundation, Inc. |
| 5 | |
| 6 | This file is part of GNU Emacs. |
| 7 | |
| 8 | GNU Emacs is free software; you can redistribute it and/or modify |
| 9 | it under the terms of the GNU General Public License as published by |
| 10 | the Free Software Foundation; either version 2, or (at your option) |
| 11 | any later version. |
| 12 | |
| 13 | GNU Emacs is distributed in the hope that it will be useful, |
| 14 | but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 15 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 16 | GNU General Public License for more details. |
| 17 | |
| 18 | You should have received a copy of the GNU General Public License |
| 19 | along with GNU Emacs; see the file COPYING. If not, write to |
| 20 | the Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
| 21 | Boston, MA 02111-1307, USA. */ |
| 22 | |
| 23 | #include <config.h> |
| 24 | #include "lisp.h" |
| 25 | #include "buffer.h" |
| 26 | #include "charset.h" |
| 27 | #include "intervals.h" |
| 28 | |
| 29 | /* Emacs uses special text property `composition' to support character |
| 30 | composition. A sequence of characters that have the same (i.e. eq) |
| 31 | `composition' property value is treated as a single composite |
| 32 | sequence (we call it just `composition' here after). Characters in |
| 33 | a composition are all composed somehow on the screen. |
| 34 | |
| 35 | The property value has this form when the composition is made: |
| 36 | ((LENGTH . COMPONENTS) . MODIFICATION-FUNC) |
| 37 | then turns to this form: |
| 38 | (COMPOSITION-ID . (LENGTH COMPONENTS-VEC . MODIFICATION-FUNC)) |
| 39 | when the composition is registered in composition_hash_table and |
| 40 | composition_table. These rather peculiar structures were designed |
| 41 | to make it easy to distinguish them quickly (we can do that by |
| 42 | checking only the first element) and to extract LENGTH (from the |
| 43 | former form) and COMPOSITION-ID (from the latter form). |
| 44 | |
| 45 | We register a composition when it is displayed, or when the width |
| 46 | is required (for instance, to calculate columns). |
| 47 | |
| 48 | LENGTH -- Length of the composition. This information is used to |
| 49 | check the validity of the composition. |
| 50 | |
| 51 | COMPONENTS -- Character, string, vector, list, or nil. |
| 52 | |
| 53 | If it is nil, characters in the text are composed relatively |
| 54 | according to their metrics in font glyphs. |
| 55 | |
| 56 | If it is a character or a string, the character or characters |
| 57 | in the string are composed relatively. |
| 58 | |
| 59 | If it is a vector or list of integers, the element is a |
| 60 | character or an encoded composition rule. The characters are |
| 61 | composed according to the rules. (2N)th elements are |
| 62 | characters to be composed and (2N+1)th elements are |
| 63 | composition rules to tell how to compose (2N+2)th element with |
| 64 | the previously composed 2N glyphs. |
| 65 | |
| 66 | COMPONENTS-VEC -- Vector of integers. In relative composition, the |
| 67 | elements are characters to be composed. In rule-base |
| 68 | composition, the elements are characters or encoded |
| 69 | composition rules. |
| 70 | |
| 71 | MODIFICATION-FUNC -- If non nil, it is a function to call when the |
| 72 | composition gets invalid after a modification in a buffer. If |
| 73 | it is nil, a function in `composition-function-table' of the |
| 74 | first character in the sequence is called. |
| 75 | |
| 76 | COMPOSITION-ID --Identification number of the composition. It is |
| 77 | used as an index to composition_table for the composition. |
| 78 | |
| 79 | When Emacs has to display a composition or has to know its |
| 80 | displaying width, the function get_composition_id is called. It |
| 81 | returns COMPOSITION-ID so that the caller can access the |
| 82 | information about the composition through composition_table. If a |
| 83 | COMPOSITION-ID has not yet been assigned to the composition, |
| 84 | get_composition_id checks the validity of `composition' property, |
| 85 | and, if valid, assigns a new ID, registers the information in |
| 86 | composition_hash_table and composition_table, and changes the form |
| 87 | of the property value. If the property is invalid, return -1 |
| 88 | without changing the property value. |
| 89 | |
| 90 | We use two tables to keep information about composition; |
| 91 | composition_hash_table and composition_table. |
| 92 | |
| 93 | The former is a hash table in which keys are COMPONENTS-VECs and |
| 94 | values are the corresponding COMPOSITION-IDs. This hash table is |
| 95 | weak, but as each key (COMPONENTS-VEC) is also kept as a value of |
| 96 | `composition' property, it won't be collected as garbage until all |
| 97 | text that have the same COMPONENTS-VEC are deleted. |
| 98 | |
| 99 | The latter is a table of pointers to `struct composition' indexed |
| 100 | by COMPOSITION-ID. This structure keep the other information (see |
| 101 | composite.h). |
| 102 | |
| 103 | In general, a text property holds information about individual |
| 104 | characters. But, a `composition' property holds information about |
| 105 | a sequence of characters (in this sense, it is like `intangible' |
| 106 | property). That means that we should not share the property value |
| 107 | in adjacent compositions we can't distinguish them if they have the |
| 108 | same property. So, after any changes, we call |
| 109 | `update_compositions' and change a property of one of adjacent |
| 110 | compositions to a copy of it. This function also runs a proper |
| 111 | composition modification function to make a composition that gets |
| 112 | invalid by the change valid again. |
| 113 | |
| 114 | As a value of `composition' property holds information about a |
| 115 | specific range of text, the value gets invalid if we change the |
| 116 | text in the range. We treat `composition' property always |
| 117 | rear-nonsticky (currently by setting default-text-properties to |
| 118 | (rear-nonsticky (composition))) and we never make properties of |
| 119 | adjacent compositions identical. Thus, any such changes make the |
| 120 | range just shorter. So, we can check the validity of `composition' |
| 121 | property by comparing LENGTH information with the actual length of |
| 122 | the composition. |
| 123 | |
| 124 | */ |
| 125 | |
| 126 | |
| 127 | Lisp_Object Qcomposition; |
| 128 | |
| 129 | /* Table of pointers to the structure `composition' indexed by |
| 130 | COMPOSITION-ID. This structure is for storing information about |
| 131 | each composition except for COMPONENTS-VEC. */ |
| 132 | struct composition **composition_table; |
| 133 | |
| 134 | /* The current size of `composition_table'. */ |
| 135 | static int composition_table_size; |
| 136 | |
| 137 | /* Number of compositions currently made. */ |
| 138 | int n_compositions; |
| 139 | |
| 140 | /* Hash table for compositions. The key is COMPONENTS-VEC of |
| 141 | `composition' property. The value is the corresponding |
| 142 | COMPOSITION-ID. */ |
| 143 | Lisp_Object composition_hash_table; |
| 144 | |
| 145 | /* Function to call to adjust composition. */ |
| 146 | Lisp_Object Vcompose_chars_after_function; |
| 147 | |
| 148 | /* Char-table of patterns and functions to make a composition. */ |
| 149 | Lisp_Object Vcomposition_function_table; |
| 150 | Lisp_Object Qcomposition_function_table; |
| 151 | |
| 152 | /* Temporary variable used in macros COMPOSITION_XXX. */ |
| 153 | Lisp_Object composition_temp; |
| 154 | \f |
| 155 | /* Return how many columns C will occupy on the screen. It always |
| 156 | returns 1 for control characters and 8-bit characters because those |
| 157 | are just ignored in a composition. */ |
| 158 | #define CHAR_WIDTH(c) \ |
| 159 | (SINGLE_BYTE_CHAR_P (c) ? 1 : CHARSET_WIDTH (CHAR_CHARSET (c))) |
| 160 | |
| 161 | /* Return COMPOSITION-ID of a composition at buffer position |
| 162 | CHARPOS/BYTEPOS and length NCHARS. The `composition' property of |
| 163 | the sequence is PROP. STRING, if non-nil, is a string that |
| 164 | contains the composition instead of the current buffer. |
| 165 | |
| 166 | If the composition is invalid, return -1. */ |
| 167 | |
| 168 | int |
| 169 | get_composition_id (charpos, bytepos, nchars, prop, string) |
| 170 | int charpos, bytepos, nchars; |
| 171 | Lisp_Object prop, string; |
| 172 | { |
| 173 | Lisp_Object id, length, components, key, *key_contents; |
| 174 | int glyph_len; |
| 175 | struct Lisp_Hash_Table *hash_table = XHASH_TABLE (composition_hash_table); |
| 176 | int hash_index; |
| 177 | unsigned hash_code; |
| 178 | struct composition *cmp; |
| 179 | int i, ch; |
| 180 | |
| 181 | /* PROP should be |
| 182 | Form-A: ((LENGTH . COMPONENTS) . MODIFICATION-FUNC) |
| 183 | or |
| 184 | Form-B: (COMPOSITION-ID . (LENGTH COMPONENTS-VEC . MODIFICATION-FUNC)) |
| 185 | */ |
| 186 | if (nchars == 0 || !CONSP (prop)) |
| 187 | goto invalid_composition; |
| 188 | |
| 189 | id = XCAR (prop); |
| 190 | if (INTEGERP (id)) |
| 191 | { |
| 192 | /* PROP should be Form-B. */ |
| 193 | if (XINT (id) < 0 || XINT (id) >= n_compositions) |
| 194 | goto invalid_composition; |
| 195 | return XINT (id); |
| 196 | } |
| 197 | |
| 198 | /* PROP should be Form-A. |
| 199 | Thus, ID should be (LENGTH . COMPONENTS). */ |
| 200 | if (!CONSP (id)) |
| 201 | goto invalid_composition; |
| 202 | length = XCAR (id); |
| 203 | if (!INTEGERP (length) || XINT (length) != nchars) |
| 204 | goto invalid_composition; |
| 205 | |
| 206 | components = XCDR (id); |
| 207 | |
| 208 | /* Check if the same composition has already been registered or not |
| 209 | by consulting composition_hash_table. The key for this table is |
| 210 | COMPONENTS (converted to a vector COMPONENTS-VEC) or, if it is |
| 211 | nil, vector of characters in the composition range. */ |
| 212 | if (INTEGERP (components)) |
| 213 | key = Fmake_vector (make_number (1), components); |
| 214 | else if (STRINGP (components) || CONSP (components)) |
| 215 | key = Fvconcat (1, &components); |
| 216 | else if (VECTORP (components)) |
| 217 | key = components; |
| 218 | else if (NILP (components)) |
| 219 | { |
| 220 | key = Fmake_vector (make_number (nchars), Qnil); |
| 221 | if (STRINGP (string)) |
| 222 | for (i = 0; i < nchars; i++) |
| 223 | { |
| 224 | FETCH_STRING_CHAR_ADVANCE (ch, string, charpos, bytepos); |
| 225 | XVECTOR (key)->contents[i] = make_number (ch); |
| 226 | } |
| 227 | else |
| 228 | for (i = 0; i < nchars; i++) |
| 229 | { |
| 230 | FETCH_CHAR_ADVANCE (ch, charpos, bytepos); |
| 231 | XVECTOR (key)->contents[i] = make_number (ch); |
| 232 | } |
| 233 | } |
| 234 | else |
| 235 | goto invalid_composition; |
| 236 | |
| 237 | hash_index = hash_lookup (hash_table, key, &hash_code); |
| 238 | if (hash_index >= 0) |
| 239 | { |
| 240 | /* We have already registered the same composition. Change PROP |
| 241 | from Form-A above to Form-B while replacing COMPONENTS with |
| 242 | COMPONENTS-VEC stored in the hash table. We can directly |
| 243 | modify the cons cell of PROP because it is not shared. */ |
| 244 | key = HASH_KEY (hash_table, hash_index); |
| 245 | id = HASH_VALUE (hash_table, hash_index); |
| 246 | XSETCAR (prop, id); |
| 247 | XSETCDR (prop, Fcons (make_number (nchars), Fcons (key, XCDR (prop)))); |
| 248 | return XINT (id); |
| 249 | } |
| 250 | |
| 251 | /* This composition is a new one. We must register it. */ |
| 252 | |
| 253 | /* Check if we have sufficient memory to store this information. */ |
| 254 | if (composition_table_size == 0) |
| 255 | { |
| 256 | composition_table_size = 256; |
| 257 | composition_table |
| 258 | = (struct composition **) xmalloc (sizeof (composition_table[0]) |
| 259 | * composition_table_size); |
| 260 | } |
| 261 | else if (composition_table_size <= n_compositions) |
| 262 | { |
| 263 | composition_table_size += 256; |
| 264 | composition_table |
| 265 | = (struct composition **) xrealloc (composition_table, |
| 266 | sizeof (composition_table[0]) |
| 267 | * composition_table_size); |
| 268 | } |
| 269 | |
| 270 | key_contents = XVECTOR (key)->contents; |
| 271 | |
| 272 | /* Check if the contents of COMPONENTS are valid if COMPONENTS is a |
| 273 | vector or a list. It should be a sequence of: |
| 274 | char1 rule1 char2 rule2 char3 ... ruleN charN+1 */ |
| 275 | if (VECTORP (components) || CONSP (components)) |
| 276 | { |
| 277 | int len = XVECTOR (key)->size; |
| 278 | |
| 279 | /* The number of elements should be odd. */ |
| 280 | if ((len % 2) == 0) |
| 281 | goto invalid_composition; |
| 282 | /* All elements should be integers (character or encoded |
| 283 | composition rule). */ |
| 284 | for (i = 0; i < len; i++) |
| 285 | { |
| 286 | if (!INTEGERP (key_contents[i])) |
| 287 | goto invalid_composition; |
| 288 | } |
| 289 | } |
| 290 | |
| 291 | /* Change PROP from Form-A above to Form-B. We can directly modify |
| 292 | the cons cell of PROP because it is not shared. */ |
| 293 | XSETFASTINT (id, n_compositions); |
| 294 | XSETCAR (prop, id); |
| 295 | XSETCDR (prop, Fcons (make_number (nchars), Fcons (key, XCDR (prop)))); |
| 296 | |
| 297 | /* Register the composition in composition_hash_table. */ |
| 298 | hash_index = hash_put (hash_table, key, id, hash_code); |
| 299 | |
| 300 | /* Register the composition in composition_table. */ |
| 301 | cmp = (struct composition *) xmalloc (sizeof (struct composition)); |
| 302 | |
| 303 | cmp->method = (NILP (components) |
| 304 | ? COMPOSITION_RELATIVE |
| 305 | : ((INTEGERP (components) || STRINGP (components)) |
| 306 | ? COMPOSITION_WITH_ALTCHARS |
| 307 | : COMPOSITION_WITH_RULE_ALTCHARS)); |
| 308 | cmp->hash_index = hash_index; |
| 309 | glyph_len = (cmp->method == COMPOSITION_WITH_RULE_ALTCHARS |
| 310 | ? (XVECTOR (key)->size + 1) / 2 |
| 311 | : XVECTOR (key)->size); |
| 312 | cmp->glyph_len = glyph_len; |
| 313 | cmp->offsets = (short *) xmalloc (sizeof (short) * glyph_len * 2); |
| 314 | cmp->font = NULL; |
| 315 | |
| 316 | /* Calculate the width of overall glyphs of the composition. */ |
| 317 | if (cmp->method != COMPOSITION_WITH_RULE_ALTCHARS) |
| 318 | { |
| 319 | /* Relative composition. */ |
| 320 | cmp->width = 0; |
| 321 | for (i = 0; i < glyph_len; i++) |
| 322 | { |
| 323 | int this_width; |
| 324 | ch = XINT (key_contents[i]); |
| 325 | this_width = CHAR_WIDTH (ch); |
| 326 | if (cmp->width < this_width) |
| 327 | cmp->width = this_width; |
| 328 | } |
| 329 | } |
| 330 | else |
| 331 | { |
| 332 | /* Rule-base composition. */ |
| 333 | float leftmost = 0.0, rightmost; |
| 334 | |
| 335 | ch = XINT (key_contents[0]); |
| 336 | rightmost = CHAR_WIDTH (ch); |
| 337 | |
| 338 | for (i = 1; i < glyph_len; i += 2) |
| 339 | { |
| 340 | int rule, gref, nref; |
| 341 | int this_width; |
| 342 | float this_left; |
| 343 | |
| 344 | rule = XINT (key_contents[i]); |
| 345 | ch = XINT (key_contents[i + 1]); |
| 346 | this_width = CHAR_WIDTH (ch); |
| 347 | |
| 348 | /* A composition rule is specified by an integer value |
| 349 | that encodes global and new reference points (GREF and |
| 350 | NREF). GREF and NREF are specified by numbers as |
| 351 | below: |
| 352 | 0---1---2 -- ascent |
| 353 | | | |
| 354 | | | |
| 355 | | | |
| 356 | 9--10--11 -- center |
| 357 | | | |
| 358 | ---3---4---5--- baseline |
| 359 | | | |
| 360 | 6---7---8 -- descent |
| 361 | */ |
| 362 | COMPOSITION_DECODE_RULE (rule, gref, nref); |
| 363 | this_left = (leftmost |
| 364 | + (gref % 3) * (rightmost - leftmost) / 2.0 |
| 365 | - (nref % 3) * this_width / 2.0); |
| 366 | |
| 367 | if (this_left < leftmost) |
| 368 | leftmost = this_left; |
| 369 | if (this_left + this_width > rightmost) |
| 370 | rightmost = this_left + this_width; |
| 371 | } |
| 372 | |
| 373 | cmp->width = rightmost - leftmost; |
| 374 | if (cmp->width < (rightmost - leftmost)) |
| 375 | /* To get a ceiling integer value. */ |
| 376 | cmp->width++; |
| 377 | } |
| 378 | |
| 379 | composition_table[n_compositions] = cmp; |
| 380 | |
| 381 | return n_compositions++; |
| 382 | |
| 383 | invalid_composition: |
| 384 | /* Would it be better to remove this `composition' property? */ |
| 385 | return -1; |
| 386 | } |
| 387 | |
| 388 | \f |
| 389 | /* Find a composition at or nearest to position POS of OBJECT (buffer |
| 390 | or string). |
| 391 | |
| 392 | OBJECT defaults to the current buffer. If there's a composition at |
| 393 | POS, set *START and *END to the start and end of the sequence, |
| 394 | *PROP to the `composition' property, and return 1. |
| 395 | |
| 396 | If there's no composition at POS and LIMIT is negative, return 0. |
| 397 | |
| 398 | Otherwise, search for a composition forward (LIMIT > POS) or |
| 399 | backward (LIMIT < POS). In this case, LIMIT bounds the search. |
| 400 | |
| 401 | If a composition is found, set *START, *END, and *PROP as above, |
| 402 | and return 1, else return 0. |
| 403 | |
| 404 | This doesn't check the validity of composition. */ |
| 405 | |
| 406 | int |
| 407 | find_composition (pos, limit, start, end, prop, object) |
| 408 | int pos, limit, *start, *end; |
| 409 | Lisp_Object *prop, object; |
| 410 | { |
| 411 | Lisp_Object val; |
| 412 | |
| 413 | if (get_property_and_range (pos, Qcomposition, prop, start, end, object)) |
| 414 | return 1; |
| 415 | |
| 416 | if (limit < 0 || limit == pos) |
| 417 | return 0; |
| 418 | |
| 419 | if (limit > pos) /* search forward */ |
| 420 | { |
| 421 | val = Fnext_single_property_change (make_number (pos), Qcomposition, |
| 422 | object, make_number (limit)); |
| 423 | pos = XINT (val); |
| 424 | if (pos == limit) |
| 425 | return 0; |
| 426 | } |
| 427 | else /* search backward */ |
| 428 | { |
| 429 | if (get_property_and_range (pos - 1, Qcomposition, prop, start, end, |
| 430 | object)) |
| 431 | return 1; |
| 432 | val = Fprevious_single_property_change (make_number (pos), Qcomposition, |
| 433 | object, make_number (limit)); |
| 434 | pos = XINT (val); |
| 435 | if (pos == limit) |
| 436 | return 0; |
| 437 | pos--; |
| 438 | } |
| 439 | get_property_and_range (pos, Qcomposition, prop, start, end, object); |
| 440 | return 1; |
| 441 | } |
| 442 | |
| 443 | /* Run a proper function to adjust the composition sitting between |
| 444 | FROM and TO with property PROP. */ |
| 445 | |
| 446 | static void |
| 447 | run_composition_function (from, to, prop) |
| 448 | int from, to; |
| 449 | Lisp_Object prop; |
| 450 | { |
| 451 | Lisp_Object func; |
| 452 | int start, end; |
| 453 | |
| 454 | func = COMPOSITION_MODIFICATION_FUNC (prop); |
| 455 | /* If an invalid composition precedes or follows, try to make them |
| 456 | valid too. */ |
| 457 | if (from > BEGV |
| 458 | && find_composition (from - 1, -1, &start, &end, &prop, Qnil) |
| 459 | && !COMPOSITION_VALID_P (start, end, prop)) |
| 460 | from = start; |
| 461 | if (to < ZV |
| 462 | && find_composition (to, -1, &start, &end, &prop, Qnil) |
| 463 | && !COMPOSITION_VALID_P (start, end, prop)) |
| 464 | to = end; |
| 465 | if (!NILP (Ffboundp (func))) |
| 466 | call2 (func, make_number (from), make_number (to)); |
| 467 | else if (!NILP (Ffboundp (Vcompose_chars_after_function))) |
| 468 | call3 (Vcompose_chars_after_function, |
| 469 | make_number (from), make_number (to), Qnil); |
| 470 | } |
| 471 | |
| 472 | /* Make invalid compositions adjacent to or inside FROM and TO valid. |
| 473 | CHECK_MASK is bitwise `or' of mask bits defined by macros |
| 474 | CHECK_XXX (see the comment in composite.h). |
| 475 | |
| 476 | This function is called when a buffer text is changed. If the |
| 477 | change is deletion, FROM == TO. Otherwise, FROM < TO. */ |
| 478 | |
| 479 | void |
| 480 | update_compositions (from, to, check_mask) |
| 481 | int from, to; |
| 482 | { |
| 483 | Lisp_Object prop; |
| 484 | int start, end; |
| 485 | |
| 486 | if (inhibit_modification_hooks) |
| 487 | return; |
| 488 | |
| 489 | /* If FROM and TO are not in a valid range, do nothing. */ |
| 490 | if (! (BEGV <= from && from <= to && to <= ZV)) |
| 491 | return; |
| 492 | |
| 493 | if (check_mask & CHECK_HEAD) |
| 494 | { |
| 495 | /* FROM should be at composition boundary. But, insertion or |
| 496 | deletion will make two compositions adjacent and |
| 497 | indistinguishable when they have same (eq) property. To |
| 498 | avoid it, in such a case, we change the property of the |
| 499 | latter to the copy of it. */ |
| 500 | if (from > BEGV |
| 501 | && find_composition (from - 1, -1, &start, &end, &prop, Qnil)) |
| 502 | { |
| 503 | if (from < end) |
| 504 | Fput_text_property (make_number (from), make_number (end), |
| 505 | Qcomposition, |
| 506 | Fcons (XCAR (prop), XCDR (prop)), Qnil); |
| 507 | run_composition_function (start, end, prop); |
| 508 | from = end; |
| 509 | } |
| 510 | else if (from < ZV |
| 511 | && find_composition (from, -1, &start, &from, &prop, Qnil)) |
| 512 | run_composition_function (start, from, prop); |
| 513 | } |
| 514 | |
| 515 | if (check_mask & CHECK_INSIDE) |
| 516 | { |
| 517 | /* In this case, we are sure that (check & CHECK_TAIL) is also |
| 518 | nonzero. Thus, here we should check only compositions before |
| 519 | (to - 1). */ |
| 520 | while (from < to - 1 |
| 521 | && find_composition (from, to, &start, &from, &prop, Qnil) |
| 522 | && from < to - 1) |
| 523 | run_composition_function (start, from, prop); |
| 524 | } |
| 525 | |
| 526 | if (check_mask & CHECK_TAIL) |
| 527 | { |
| 528 | if (from < to |
| 529 | && find_composition (to - 1, -1, &start, &end, &prop, Qnil)) |
| 530 | { |
| 531 | /* TO should be also at composition boundary. But, |
| 532 | insertion or deletion will make two compositions adjacent |
| 533 | and indistinguishable when they have same (eq) property. |
| 534 | To avoid it, in such a case, we change the property of |
| 535 | the former to the copy of it. */ |
| 536 | if (to < end) |
| 537 | Fput_text_property (make_number (start), make_number (to), |
| 538 | Qcomposition, |
| 539 | Fcons (XCAR (prop), XCDR (prop)), Qnil); |
| 540 | run_composition_function (start, end, prop); |
| 541 | } |
| 542 | else if (to < ZV |
| 543 | && find_composition (to, -1, &start, &end, &prop, Qnil)) |
| 544 | run_composition_function (start, end, prop); |
| 545 | } |
| 546 | } |
| 547 | |
| 548 | |
| 549 | /* Modify composition property values in LIST destructively. LIST is |
| 550 | a list as returned from text_property_list. Change values to the |
| 551 | top-level copies of them so that none of them are `eq'. */ |
| 552 | |
| 553 | void |
| 554 | make_composition_value_copy (list) |
| 555 | Lisp_Object list; |
| 556 | { |
| 557 | Lisp_Object plist, val; |
| 558 | |
| 559 | for (; CONSP (list); list = XCDR (list)) |
| 560 | { |
| 561 | plist = XCAR (XCDR (XCDR (XCAR (list)))); |
| 562 | while (CONSP (plist) && CONSP (XCDR (plist))) |
| 563 | { |
| 564 | if (EQ (XCAR (plist), Qcomposition) |
| 565 | && (val = XCAR (XCDR (plist)), CONSP (val))) |
| 566 | XSETCAR (XCDR (plist), Fcons (XCAR (val), XCDR (val))); |
| 567 | plist = XCDR (XCDR (plist)); |
| 568 | } |
| 569 | } |
| 570 | } |
| 571 | |
| 572 | |
| 573 | /* Make text in the region between START and END a composition that |
| 574 | has COMPONENTS and MODIFICATION-FUNC. |
| 575 | |
| 576 | If STRING is non-nil, then operate on characters contained between |
| 577 | indices START and END in STRING. */ |
| 578 | |
| 579 | void |
| 580 | compose_text (start, end, components, modification_func, string) |
| 581 | int start, end; |
| 582 | Lisp_Object components, modification_func, string; |
| 583 | { |
| 584 | Lisp_Object prop; |
| 585 | |
| 586 | prop = Fcons (Fcons (make_number (end - start), components), |
| 587 | modification_func); |
| 588 | Fput_text_property (make_number (start), make_number (end), |
| 589 | Qcomposition, prop, string); |
| 590 | } |
| 591 | |
| 592 | /* Compose sequences of characters in the region between START and END |
| 593 | by functions registered in Vcomposition_function_table. If STRING |
| 594 | is non-nil, operate on characters contained between indices START |
| 595 | and END in STRING. */ |
| 596 | |
| 597 | void |
| 598 | compose_chars_in_text (start, end, string) |
| 599 | int start, end; |
| 600 | Lisp_Object string; |
| 601 | { |
| 602 | int count = 0; |
| 603 | struct gcpro gcpro1; |
| 604 | Lisp_Object tail, elt, val, to; |
| 605 | /* Set to nonzero if we don't have to compose ASCII characters. */ |
| 606 | int skip_ascii; |
| 607 | int i, len, stop, c; |
| 608 | const unsigned char *ptr, *pend; |
| 609 | |
| 610 | if (! CHAR_TABLE_P (Vcomposition_function_table)) |
| 611 | return; |
| 612 | |
| 613 | if (STRINGP (string)) |
| 614 | { |
| 615 | count = SPECPDL_INDEX (); |
| 616 | GCPRO1 (string); |
| 617 | stop = end; |
| 618 | ptr = SDATA (string) + string_char_to_byte (string, start); |
| 619 | pend = ptr + SBYTES (string); |
| 620 | } |
| 621 | else |
| 622 | { |
| 623 | record_unwind_protect (save_excursion_restore, save_excursion_save ()); |
| 624 | TEMP_SET_PT (start); |
| 625 | stop = (start < GPT && GPT < end ? GPT : end); |
| 626 | ptr = CHAR_POS_ADDR (start); |
| 627 | pend = CHAR_POS_ADDR (end); |
| 628 | } |
| 629 | |
| 630 | /* Preserve the match data. */ |
| 631 | record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil)); |
| 632 | |
| 633 | /* If none of ASCII characters have composition functions, we can |
| 634 | skip them quickly. */ |
| 635 | for (i = 0; i < 128; i++) |
| 636 | if (!NILP (CHAR_TABLE_REF (Vcomposition_function_table, i))) |
| 637 | break; |
| 638 | skip_ascii = (i == 128); |
| 639 | |
| 640 | |
| 641 | while (1) |
| 642 | { |
| 643 | if (skip_ascii) |
| 644 | while (start < stop && ASCII_BYTE_P (*ptr)) |
| 645 | start++, ptr++; |
| 646 | |
| 647 | if (start >= stop) |
| 648 | { |
| 649 | if (stop == end || start >= end) |
| 650 | break; |
| 651 | stop = end; |
| 652 | if (STRINGP (string)) |
| 653 | ptr = SDATA (string) + string_char_to_byte (string, start); |
| 654 | else |
| 655 | ptr = CHAR_POS_ADDR (start); |
| 656 | } |
| 657 | |
| 658 | c = STRING_CHAR_AND_LENGTH (ptr, pend - ptr, len); |
| 659 | tail = CHAR_TABLE_REF (Vcomposition_function_table, c); |
| 660 | while (CONSP (tail)) |
| 661 | { |
| 662 | elt = XCAR (tail); |
| 663 | if (CONSP (elt) |
| 664 | && STRINGP (XCAR (elt)) |
| 665 | && !NILP (Ffboundp (XCDR (elt)))) |
| 666 | { |
| 667 | if (STRINGP (string)) |
| 668 | val = Fstring_match (XCAR (elt), string, make_number (start)); |
| 669 | else |
| 670 | { |
| 671 | val = Flooking_at (XCAR (elt)); |
| 672 | if (!NILP (val)) |
| 673 | val = make_number (start); |
| 674 | } |
| 675 | if (INTEGERP (val) && XFASTINT (val) == start) |
| 676 | { |
| 677 | to = Fmatch_end (make_number (0)); |
| 678 | val = call4 (XCDR (elt), val, to, XCAR (elt), string); |
| 679 | if (INTEGERP (val) && XINT (val) > 1) |
| 680 | { |
| 681 | start += XINT (val); |
| 682 | if (STRINGP (string)) |
| 683 | ptr = SDATA (string) + string_char_to_byte (string, start); |
| 684 | else |
| 685 | ptr = CHAR_POS_ADDR (start); |
| 686 | } |
| 687 | else |
| 688 | { |
| 689 | start++; |
| 690 | ptr += len; |
| 691 | } |
| 692 | break; |
| 693 | } |
| 694 | } |
| 695 | tail = XCDR (tail); |
| 696 | } |
| 697 | if (!CONSP (tail)) |
| 698 | { |
| 699 | /* No composition done. Try the next character. */ |
| 700 | start++; |
| 701 | ptr += len; |
| 702 | } |
| 703 | } |
| 704 | |
| 705 | unbind_to (count, Qnil); |
| 706 | if (STRINGP (string)) |
| 707 | UNGCPRO; |
| 708 | } |
| 709 | \f |
| 710 | /* Emacs Lisp APIs. */ |
| 711 | |
| 712 | DEFUN ("compose-region-internal", Fcompose_region_internal, |
| 713 | Scompose_region_internal, 2, 4, 0, |
| 714 | doc: /* Internal use only. |
| 715 | |
| 716 | Compose text in the region between START and END. |
| 717 | Optional 3rd and 4th arguments are COMPONENTS and MODIFICATION-FUNC |
| 718 | for the composition. See `compose-region' for more detail. */) |
| 719 | (start, end, components, mod_func) |
| 720 | Lisp_Object start, end, components, mod_func; |
| 721 | { |
| 722 | validate_region (&start, &end); |
| 723 | if (!NILP (components) |
| 724 | && !INTEGERP (components) |
| 725 | && !CONSP (components) |
| 726 | && !STRINGP (components)) |
| 727 | CHECK_VECTOR (components); |
| 728 | |
| 729 | compose_text (XINT (start), XINT (end), components, mod_func, Qnil); |
| 730 | return Qnil; |
| 731 | } |
| 732 | |
| 733 | DEFUN ("compose-string-internal", Fcompose_string_internal, |
| 734 | Scompose_string_internal, 3, 5, 0, |
| 735 | doc: /* Internal use only. |
| 736 | |
| 737 | Compose text between indices START and END of STRING. |
| 738 | Optional 4th and 5th arguments are COMPONENTS and MODIFICATION-FUNC |
| 739 | for the composition. See `compose-string' for more detail. */) |
| 740 | (string, start, end, components, mod_func) |
| 741 | Lisp_Object string, start, end, components, mod_func; |
| 742 | { |
| 743 | CHECK_STRING (string); |
| 744 | CHECK_NUMBER (start); |
| 745 | CHECK_NUMBER (end); |
| 746 | |
| 747 | if (XINT (start) < 0 || |
| 748 | XINT (start) > XINT (end) |
| 749 | || XINT (end) > SCHARS (string)) |
| 750 | args_out_of_range (start, end); |
| 751 | |
| 752 | compose_text (XINT (start), XINT (end), components, mod_func, string); |
| 753 | return string; |
| 754 | } |
| 755 | |
| 756 | DEFUN ("find-composition-internal", Ffind_composition_internal, |
| 757 | Sfind_composition_internal, 4, 4, 0, |
| 758 | doc: /* Internal use only. |
| 759 | |
| 760 | Return information about composition at or nearest to position POS. |
| 761 | See `find-composition' for more detail. */) |
| 762 | (pos, limit, string, detail_p) |
| 763 | Lisp_Object pos, limit, string, detail_p; |
| 764 | { |
| 765 | Lisp_Object prop, tail; |
| 766 | int start, end; |
| 767 | int id; |
| 768 | |
| 769 | CHECK_NUMBER_COERCE_MARKER (pos); |
| 770 | start = XINT (pos); |
| 771 | if (!NILP (limit)) |
| 772 | { |
| 773 | CHECK_NUMBER_COERCE_MARKER (limit); |
| 774 | end = XINT (limit); |
| 775 | } |
| 776 | else |
| 777 | end = -1; |
| 778 | |
| 779 | if (!NILP (string)) |
| 780 | { |
| 781 | CHECK_STRING (string); |
| 782 | if (XINT (pos) < 0 || XINT (pos) > SCHARS (string)) |
| 783 | args_out_of_range (string, pos); |
| 784 | } |
| 785 | else |
| 786 | { |
| 787 | if (XINT (pos) < BEGV || XINT (pos) > ZV) |
| 788 | args_out_of_range (Fcurrent_buffer (), pos); |
| 789 | } |
| 790 | |
| 791 | if (!find_composition (start, end, &start, &end, &prop, string)) |
| 792 | return Qnil; |
| 793 | if (!COMPOSITION_VALID_P (start, end, prop)) |
| 794 | return Fcons (make_number (start), Fcons (make_number (end), |
| 795 | Fcons (Qnil, Qnil))); |
| 796 | if (NILP (detail_p)) |
| 797 | return Fcons (make_number (start), Fcons (make_number (end), |
| 798 | Fcons (Qt, Qnil))); |
| 799 | |
| 800 | if (COMPOSITION_REGISTERD_P (prop)) |
| 801 | id = COMPOSITION_ID (prop); |
| 802 | else |
| 803 | { |
| 804 | int start_byte = (NILP (string) |
| 805 | ? CHAR_TO_BYTE (start) |
| 806 | : string_char_to_byte (string, start)); |
| 807 | id = get_composition_id (start, start_byte, end - start, prop, string); |
| 808 | } |
| 809 | |
| 810 | if (id >= 0) |
| 811 | { |
| 812 | Lisp_Object components, relative_p, mod_func; |
| 813 | enum composition_method method = COMPOSITION_METHOD (prop); |
| 814 | int width = composition_table[id]->width; |
| 815 | |
| 816 | components = Fcopy_sequence (COMPOSITION_COMPONENTS (prop)); |
| 817 | relative_p = (method == COMPOSITION_WITH_RULE_ALTCHARS |
| 818 | ? Qnil : Qt); |
| 819 | mod_func = COMPOSITION_MODIFICATION_FUNC (prop); |
| 820 | tail = Fcons (components, |
| 821 | Fcons (relative_p, |
| 822 | Fcons (mod_func, |
| 823 | Fcons (make_number (width), Qnil)))); |
| 824 | } |
| 825 | else |
| 826 | tail = Qnil; |
| 827 | |
| 828 | return Fcons (make_number (start), Fcons (make_number (end), tail)); |
| 829 | } |
| 830 | |
| 831 | \f |
| 832 | void |
| 833 | syms_of_composite () |
| 834 | { |
| 835 | Qcomposition = intern ("composition"); |
| 836 | staticpro (&Qcomposition); |
| 837 | |
| 838 | /* Make a hash table for composition. */ |
| 839 | { |
| 840 | Lisp_Object args[6]; |
| 841 | extern Lisp_Object QCsize; |
| 842 | |
| 843 | args[0] = QCtest; |
| 844 | args[1] = Qequal; |
| 845 | args[2] = QCweakness; |
| 846 | args[3] = Qnil; |
| 847 | args[4] = QCsize; |
| 848 | args[5] = make_number (311); |
| 849 | composition_hash_table = Fmake_hash_table (6, args); |
| 850 | staticpro (&composition_hash_table); |
| 851 | } |
| 852 | |
| 853 | /* Text property `composition' should be nonsticky by default. */ |
| 854 | Vtext_property_default_nonsticky |
| 855 | = Fcons (Fcons (Qcomposition, Qt), Vtext_property_default_nonsticky); |
| 856 | |
| 857 | DEFVAR_LISP ("compose-chars-after-function", &Vcompose_chars_after_function, |
| 858 | doc: /* Function to adjust composition of buffer text. |
| 859 | |
| 860 | The function is called with three arguments FROM, TO, and OBJECT. |
| 861 | FROM and TO specify the range of text of which composition should be |
| 862 | adjusted. OBJECT, if non-nil, is a string that contains the text. |
| 863 | |
| 864 | This function is called after a text with `composition' property is |
| 865 | inserted or deleted to keep `composition' property of buffer text |
| 866 | valid. |
| 867 | |
| 868 | The default value is the function `compose-chars-after'. */); |
| 869 | Vcompose_chars_after_function = intern ("compose-chars-after"); |
| 870 | |
| 871 | Qcomposition_function_table = intern ("composition-function-table"); |
| 872 | staticpro (&Qcomposition_function_table); |
| 873 | |
| 874 | /* Intern this now in case it isn't already done. |
| 875 | Setting this variable twice is harmless. |
| 876 | But don't staticpro it here--that is done in alloc.c. */ |
| 877 | Qchar_table_extra_slots = intern ("char-table-extra-slots"); |
| 878 | |
| 879 | Fput (Qcomposition_function_table, Qchar_table_extra_slots, make_number (0)); |
| 880 | |
| 881 | DEFVAR_LISP ("composition-function-table", &Vcomposition_function_table, |
| 882 | doc: /* Char table of patterns and functions to make a composition. |
| 883 | |
| 884 | Each element is nil or an alist of PATTERNs vs FUNCs, where PATTERNs |
| 885 | are regular expressions and FUNCs are functions. FUNC is responsible |
| 886 | for composing text matching the corresponding PATTERN. FUNC is called |
| 887 | with three arguments FROM, TO, and PATTERN. See the function |
| 888 | `compose-chars-after' for more detail. |
| 889 | |
| 890 | This table is looked up by the first character of a composition when |
| 891 | the composition gets invalid after a change in a buffer. */); |
| 892 | Vcomposition_function_table |
| 893 | = Fmake_char_table (Qcomposition_function_table, Qnil); |
| 894 | |
| 895 | defsubr (&Scompose_region_internal); |
| 896 | defsubr (&Scompose_string_internal); |
| 897 | defsubr (&Sfind_composition_internal); |
| 898 | } |