# HG changeset patch # User Kenichi Handa # Date 1219996407 0 # Node ID 23390849e8b8909981cae7a9ae15916febae2311 # Parent a4677d55715f6676079ea931f94a63fbb51c233c Include window.h, frame.h, dispextern.h font.h. (Vcomposition_function_table) (get_composition_id): Don't handle COMPOSITION_WITH_GLYPH_STRING. (gstring_hash_table, gstring_work, gstring_work_headers): New variables. (gstring_lookup_cache, composition_gstring_put_cache) (composition_gstring_from_id, composition_gstring_p) (composition_gstring_width, fill_gstring_header) (fill_gstring_body, autocmp_chars, composition_compute_stop_pos) (composition_reseat_it, composition_update_it) (composition_adjust_point, Fcomposition_get_gstring): New functions. (syms_of_composite): Initialize gstring_hash_table, gstrint_work, and gstring_work_headers. DEFVAR_LISP composition-function-table. Defsubr compostion_get_gstring. diff -r a4677d55715f -r 23390849e8b8 src/composite.c --- a/src/composite.c Fri Aug 29 07:53:11 2008 +0000 +++ b/src/composite.c Fri Aug 29 07:53:27 2008 +0000 @@ -28,6 +28,10 @@ #include "buffer.h" #include "character.h" #include "intervals.h" +#include "window.h" +#include "frame.h" +#include "dispextern.h" +#include "font.h" /* Emacs uses special text property `composition' to support character composition. A sequence of characters that have the same (i.e. eq) @@ -151,6 +155,7 @@ Lisp_Object Qauto_composed; Lisp_Object Vauto_composition_function; Lisp_Object Qauto_composition_function; +Lisp_Object Vcomposition_function_table; EXFUN (Fremove_list_of_text_properties, 4); @@ -317,10 +322,6 @@ : ((INTEGERP (components) || STRINGP (components)) ? COMPOSITION_WITH_ALTCHARS : COMPOSITION_WITH_RULE_ALTCHARS)); - if (cmp->method == COMPOSITION_WITH_RULE_ALTCHARS - && VECTORP (components) - && ! INTEGERP (AREF (components, 0))) - cmp->method = COMPOSITION_WITH_GLYPH_STRING; cmp->hash_index = hash_index; glyph_len = (cmp->method == COMPOSITION_WITH_RULE_ALTCHARS ? (XVECTOR (key)->size + 1) / 2 @@ -329,13 +330,7 @@ cmp->offsets = (short *) xmalloc (sizeof (short) * glyph_len * 2); cmp->font = NULL; - /* Calculate the width of overall glyphs of the composition. */ - if (cmp->method == COMPOSITION_WITH_GLYPH_STRING) - { - cmp->width = 1; /* Should be fixed later. */ - cmp->glyph_len--; - } - else if (cmp->method != COMPOSITION_WITH_RULE_ALTCHARS) + if (cmp->method != COMPOSITION_WITH_RULE_ALTCHARS) { /* Relative composition. */ cmp->width = 0; @@ -645,6 +640,705 @@ Fput_text_property (make_number (start), make_number (end), Qcomposition, prop, string); } + + +static Lisp_Object autocmp_chars P_ ((Lisp_Object, EMACS_INT, EMACS_INT, + EMACS_INT, struct window *, + struct face *, Lisp_Object)); + + +/* Lisp glyph-string handlers */ + +/* Hash table for automatic composition. The key is a header of a + lgstring (Lispy glyph-string), and the value is a body of a + lgstring. */ + +static Lisp_Object gstring_hash_table; + +static Lisp_Object gstring_lookup_cache P_ ((Lisp_Object)); + +static Lisp_Object +gstring_lookup_cache (header) + Lisp_Object header; +{ + struct Lisp_Hash_Table *h = XHASH_TABLE (gstring_hash_table); + int i = hash_lookup (h, header, NULL); + + return (i >= 0 ? HASH_VALUE (h, i) : Qnil); +} + +Lisp_Object +composition_gstring_put_cache (gstring, len) + Lisp_Object gstring; + int len; +{ + struct Lisp_Hash_Table *h = XHASH_TABLE (gstring_hash_table); + unsigned hash; + Lisp_Object header, copy; + int i; + + header = LGSTRING_HEADER (gstring); + hash = h->hashfn (h, header); + if (len < 0) + { + len = LGSTRING_GLYPH_LEN (gstring); + for (i = 0; i < len; i++) + if (NILP (LGSTRING_GLYPH (gstring, i))) + break; + len = i; + } + + copy = Fmake_vector (make_number (len + 2), Qnil); + LGSTRING_SET_HEADER (copy, Fcopy_sequence (header)); + for (i = 0; i < len; i++) + LGSTRING_SET_GLYPH (copy, i, Fcopy_sequence (LGSTRING_GLYPH (gstring, i))); + i = hash_put (h, LGSTRING_HEADER (copy), copy, hash); + LGSTRING_SET_ID (copy, make_number (i)); + return copy; +} + +Lisp_Object +composition_gstring_from_id (id) + int id; +{ + struct Lisp_Hash_Table *h = XHASH_TABLE (gstring_hash_table); + + return HASH_VALUE (h, id); +} + +static Lisp_Object fill_gstring_header P_ ((Lisp_Object, Lisp_Object, + Lisp_Object, Lisp_Object, + Lisp_Object)); + +int +composition_gstring_p (gstring) + Lisp_Object gstring; +{ + Lisp_Object header; + int i; + + if (! VECTORP (gstring) || ASIZE (gstring) < 2) + return 0; + header = LGSTRING_HEADER (gstring); + if (! VECTORP (header) || ASIZE (header) < 2) + return 0; + if (! NILP (LGSTRING_FONT (gstring)) + && ! FONT_OBJECT_P (LGSTRING_FONT (gstring))) + return 0; + for (i = 1; i < ASIZE (LGSTRING_HEADER (gstring)); i++) + if (! NATNUMP (AREF (LGSTRING_HEADER (gstring), i))) + return 0; + if (! NILP (LGSTRING_ID (gstring)) && ! NATNUMP (LGSTRING_ID (gstring))) + return 0; + for (i = 0; i < LGSTRING_GLYPH_LEN (gstring); i++) + { + Lisp_Object glyph = LGSTRING_GLYPH (gstring, i); + if (NILP (glyph)) + break; + if (! VECTORP (glyph) || ASIZE (glyph) != LGLYPH_SIZE) + return 0; + } + return 1; +} + +int +composition_gstring_width (gstring, from, to, metrics) + Lisp_Object gstring; + int from, to; + struct font_metrics *metrics; +{ + Lisp_Object *glyph; + int width = 0; + + if (metrics) + { + Lisp_Object font_object = LGSTRING_FONT (gstring); + struct font *font = XFONT_OBJECT (font_object); + + metrics->ascent = font->ascent; + metrics->descent = font->descent; + metrics->width = metrics->lbearing = metrics->rbearing = 0; + } + for (glyph = &LGSTRING_GLYPH (gstring, from); from < to; from++, glyph++) + { + int x; + + if (NILP (LGLYPH_ADJUSTMENT (*glyph))) + width += LGLYPH_WIDTH (*glyph); + else + width += LGLYPH_WADJUST (*glyph); + if (metrics) + { + x = metrics->width + LGLYPH_LBEARING (*glyph) + LGLYPH_XOFF (*glyph); + if (metrics->lbearing > x) + metrics->lbearing = x; + x = metrics->width + LGLYPH_RBEARING (*glyph) + LGLYPH_XOFF (*glyph); + if (metrics->rbearing < x) + metrics->rbearing = x; + metrics->width = width; + x = LGLYPH_ASCENT (*glyph) - LGLYPH_YOFF (*glyph); + if (metrics->ascent < x) + metrics->ascent = x; + x = LGLYPH_DESCENT (*glyph) - LGLYPH_YOFF (*glyph); + if (metrics->descent < x) + metrics->descent = x; + } + } + return width; +} + + +static Lisp_Object gstring_work; +static Lisp_Object gstring_work_headers; + +static Lisp_Object +fill_gstring_header (header, start, end, font_object, string) + Lisp_Object header, start, end, font_object, string; +{ + EMACS_INT from, to, from_byte; + EMACS_INT len, i; + + if (NILP (string)) + { + if (NILP (current_buffer->enable_multibyte_characters)) + error ("Attempt to shape unibyte text"); + validate_region (&start, &end); + from = XFASTINT (start); + to = XFASTINT (end); + from_byte = CHAR_TO_BYTE (from); + } + else + { + CHECK_STRING (string); + if (! STRING_MULTIBYTE (current_buffer->enable_multibyte_characters)) + error ("Attempt to shape unibyte text"); + CHECK_NATNUM (start); + from = XINT (start); + CHECK_NATNUM (end); + to = XINT (end); + if (from < 0 || from > to || to > SCHARS (string)) + args_out_of_range_3 (string, start, end); + from_byte = string_char_to_byte (string, from); + } + + len = to - from; + if (len == 0) + error ("Attempt to shape zero-length text"); + if (VECTORP (header)) + { + if (ASIZE (header) != len + 1) + args_out_of_range (header, make_number (len + 1)); + } + else + { + if (len <= 8) + header = AREF (gstring_work_headers, len - 1); + else + header = Fmake_vector (make_number (len + 1), Qnil); + } + + ASET (header, 0, font_object); + for (i = 0; i < len; i++) + { + int c; + + if (NILP (string)) + FETCH_CHAR_ADVANCE_NO_CHECK (c, from, from_byte); + else + FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, from, from_byte); + ASET (header, i + 1, make_number (c)); + } + return header; +} + +extern void font_fill_lglyph_metrics P_ ((Lisp_Object, Lisp_Object)); + +static void +fill_gstring_body (gstring) + Lisp_Object gstring; +{ + Lisp_Object font_object = LGSTRING_FONT (gstring); + Lisp_Object header = AREF (gstring, 0); + EMACS_INT len = LGSTRING_CHAR_LEN (gstring); + EMACS_INT i; + + for (i = 0; i < len; i++) + { + Lisp_Object g = LGSTRING_GLYPH (gstring, i); + int c = XINT (AREF (header, i + 1)); + + if (NILP (g)) + { + g = LGLYPH_NEW (); + LGSTRING_SET_GLYPH (gstring, i, g); + } + LGLYPH_SET_FROM (g, i); + LGLYPH_SET_TO (g, i); + LGLYPH_SET_CHAR (g, c); + if (! NILP (font_object)) + { + font_fill_lglyph_metrics (g, font_object); + } + else + { + int width = XFASTINT (CHAR_TABLE_REF (Vchar_width_table, c)); + + LGLYPH_SET_CODE (g, c); + LGLYPH_SET_LBEARING (g, 0); + LGLYPH_SET_RBEARING (g, width); + LGLYPH_SET_WIDTH (g, width); + LGLYPH_SET_ASCENT (g, 1); + LGLYPH_SET_DESCENT (g, 0); + } + LGLYPH_SET_ADJUSTMENT (g, Qnil); + } + if (i < LGSTRING_GLYPH_LEN (gstring)) + LGSTRING_SET_GLYPH (gstring, i, Qnil); +} + +EXFUN (Fre_search_forward, 4); + +/* Try to compose the characters at CHARPOS according to CFT_ELEMENT + which is an element of composition-fucntion-table (which see). + LIMIT limits the characters to compose. STRING, if not nil, is a + target string. WIN is a window where the characters are being + displayed. */ + +static Lisp_Object +autocmp_chars (cft_element, charpos, bytepos, limit, win, face, string) + Lisp_Object cft_element; + EMACS_INT charpos, bytepos, limit; + struct window *win; + struct face *face; + Lisp_Object string; +{ + int count = SPECPDL_INDEX (); + FRAME_PTR f = XFRAME (win->frame); + Lisp_Object pos = make_number (charpos); + EMACS_INT pt = PT, pt_byte = PT_BYTE; + + record_unwind_save_match_data (); + for (; CONSP (cft_element); cft_element = XCDR (cft_element)) + { + Lisp_Object elt = XCAR (cft_element); + Lisp_Object re; + Lisp_Object font_object = Qnil, gstring; + EMACS_INT to; + + if (! VECTORP (elt) || ASIZE (elt) != 3) + continue; + re = AREF (elt, 0); + if (NILP (string)) + TEMP_SET_PT_BOTH (charpos, bytepos); + if (NILP (re) + || (STRINGP (re) + && (STRINGP (string) + ? EQ (Fstring_match (re, string, pos), pos) + : (! NILP (Fre_search_forward (re, make_number (limit), Qt, Qnil)) + && EQ (Fmatch_beginning (make_number (0)), pos))))) + { + to = (NILP (re) ? charpos + 1 : XINT (Fmatch_end (make_number (0)))); +#ifdef HAVE_WINDOW_SYSTEM + if (FRAME_WINDOW_P (f)) + { + font_object = font_range (charpos, &to, win, face, string); + if (! FONT_OBJECT_P (font_object)) + { + if (NILP (string)) + TEMP_SET_PT_BOTH (pt, pt_byte); + return unbind_to (count, Qnil); + } + } +#endif /* not HAVE_WINDOW_SYSTEM */ + gstring = Fcomposition_get_gstring (pos, make_number (to), + font_object, string); + if (NILP (LGSTRING_ID (gstring))) + { + Lisp_Object args[6]; + + args[0] = Vauto_composition_function; + args[1] = AREF (elt, 2); + args[2] = pos; + args[3] = make_number (to); + args[4] = font_object; + args[5] = string; + gstring = safe_call (6, args); + } + if (NILP (string)) + TEMP_SET_PT_BOTH (pt, pt_byte); + return unbind_to (count, gstring); + } + } + if (NILP (string)) + TEMP_SET_PT_BOTH (pt, pt_byte); + return unbind_to (count, Qnil); +} + + +/* Update cmp_it->stop_pos to the next position after CHARPOS (and + BYTEPOS) where character composition may happen. If BYTEPOS is + negative, compoute it. If it is a static composition, set + cmp_it->ch to -1. Otherwise, set cmp_it->ch to the character that + triggers a automatic composition. */ + +void +composition_compute_stop_pos (cmp_it, charpos, bytepos, endpos, string) + struct composition_it *cmp_it; + EMACS_INT charpos, bytepos, endpos; + Lisp_Object string; +{ + EMACS_INT start, end, c; + Lisp_Object prop, val; + + cmp_it->stop_pos = endpos; + if (find_composition (charpos, endpos, &start, &end, &prop, string) + && COMPOSITION_VALID_P (start, end, prop)) + { + cmp_it->stop_pos = endpos = start; + cmp_it->ch = -1; + } + if (NILP (current_buffer->enable_multibyte_characters) + || ! FUNCTIONP (Vauto_composition_function)) + return; + if (bytepos < 0) + { + if (STRINGP (string)) + bytepos = string_char_to_byte (string, charpos); + else + bytepos = CHAR_TO_BYTE (charpos); + } + + start = charpos; + while (charpos < endpos) + { + if (STRINGP (string)) + FETCH_STRING_CHAR_ADVANCE (c, string, charpos, bytepos); + else + FETCH_CHAR_ADVANCE (c, charpos, bytepos); + val = CHAR_TABLE_REF (Vcomposition_function_table, c); + if (! NILP (val)) + { + Lisp_Object elt; + + for (; CONSP (val); val = XCDR (val)) + { + elt = XCAR (val); + if (VECTORP (elt) && ASIZE (elt) == 3 && NATNUMP (AREF (elt, 1)) + && charpos - 1 - XFASTINT (AREF (elt, 1)) >= start) + break; + } + if (CONSP (val)) + { + cmp_it->stop_pos = charpos - 1 - XFASTINT (AREF (elt, 1)); + cmp_it->ch = c; + break; + } + } + } +} + +/* Check if the character at CHARPOS (and BYTEPOS) is composed + (possibly with the following charaters) on window W. ENDPOS limits + characters to be composed. FACE, in non-NULL, is a base face of + the character. If STRING is not nil, it is a string containing the + character to check, and CHARPOS and BYTEPOS are indices in the + string. In that case, FACE must not be NULL. + + If the character is composed, setup members of CMP_IT (id, nglyphs, + and from), and return 1. Otherwise, update CMP_IT->stop_pos, and + return 0. */ + +int +composition_reseat_it (cmp_it, charpos, bytepos, endpos, w, face, string) + struct composition_it *cmp_it; + EMACS_INT charpos, bytepos, endpos; + struct window *w; + struct face *face; + Lisp_Object string; +{ + if (cmp_it->ch < 0) + { + /* We are looking at a static composition. */ + EMACS_INT start, end; + Lisp_Object prop; + + find_composition (charpos, -1, &start, &end, &prop, string); + cmp_it->id = get_composition_id (charpos, bytepos, end - start, + prop, string); + if (cmp_it->id < 0) + goto no_composition; + cmp_it->nchars = end - start; + cmp_it->nglyphs = composition_table[cmp_it->id]->glyph_len; + } + else + { + Lisp_Object val; + int i; + + val = CHAR_TABLE_REF (Vcomposition_function_table, cmp_it->ch); + if (NILP (val)) + goto no_composition; + val = autocmp_chars (val, charpos, bytepos, endpos, w, face, string); + if (! composition_gstring_p (val)) + goto no_composition; + if (NILP (LGSTRING_ID (val))) + val = composition_gstring_put_cache (val, -1); + cmp_it->id = XINT (LGSTRING_ID (val)); + for (i = 0; i < LGSTRING_GLYPH_LEN (val); i++) + if (NILP (LGSTRING_GLYPH (val, i))) + break; + cmp_it->nglyphs = i; + } + cmp_it->from = 0; + return 1; + + no_composition: + charpos++; + if (STRINGP (string)) + bytepos += MULTIBYTE_LENGTH_NO_CHECK (SDATA (string) + bytepos); + else + INC_POS (bytepos); + composition_compute_stop_pos (cmp_it, charpos, bytepos, endpos, string); + return 0; +} + +int +composition_update_it (cmp_it, charpos, bytepos, string) + struct composition_it *cmp_it; + EMACS_INT charpos, bytepos; + Lisp_Object string; +{ + int i, c; + + if (cmp_it->ch < 0) + { + struct composition *cmp = composition_table[cmp_it->id]; + + cmp_it->to = cmp_it->nglyphs; + if (cmp_it->nglyphs == 0) + c = -1; + else + { + for (i = 0; i < cmp->glyph_len; i++) + if ((c = COMPOSITION_GLYPH (cmp, i)) != '\t') + break; + if (c == '\t') + c = ' '; + } + cmp_it->width = cmp->width; + } + else + { + Lisp_Object gstring = composition_gstring_from_id (cmp_it->id); + + if (cmp_it->nglyphs == 0) + { + c = -1; + cmp_it->nchars = LGSTRING_CHAR_LEN (gstring); + cmp_it->width = 0; + } + else + { + Lisp_Object glyph = LGSTRING_GLYPH (gstring, cmp_it->from); + int from = LGLYPH_FROM (glyph); + + c = LGSTRING_CHAR (gstring, from); + cmp_it->nchars = LGLYPH_TO (glyph) - from + 1; + cmp_it->width = (LGLYPH_WIDTH (glyph) > 0 + ? CHAR_WIDTH (LGLYPH_CHAR (glyph)) : 0); + for (cmp_it->to = cmp_it->from + 1; cmp_it->to < cmp_it->nglyphs; + cmp_it->to++) + { + glyph = LGSTRING_GLYPH (gstring, cmp_it->to); + if (LGLYPH_FROM (glyph) != from) + break; + if (LGLYPH_WIDTH (glyph) > 0) + cmp_it->width += CHAR_WIDTH (LGLYPH_CHAR (glyph)); + } + } + } + + charpos += cmp_it->nchars; + if (STRINGP (string)) + cmp_it->nbytes = string_char_to_byte (string, charpos) - bytepos; + else + cmp_it->nbytes = CHAR_TO_BYTE (charpos) - bytepos; + return c; +} + + +int +composition_adjust_point (last_pt) + EMACS_INT last_pt; +{ + /* Now check the automatic composition. */ + EMACS_INT charpos, bytepos, startpos, beg, end, pos; + Lisp_Object val, cat; + EMACS_INT limit; + int c; + + if (PT == BEGV || PT == ZV) + return PT; + + if (get_property_and_range (PT, Qcomposition, &val, &beg, &end, Qnil) + && COMPOSITION_VALID_P (beg, end, val) + && beg < PT /* && end > PT <- It's always the case. */ + && (last_pt <= beg || last_pt >= end)) + return (PT < last_pt ? beg : end); + + if (NILP (current_buffer->enable_multibyte_characters) + || ! FUNCTIONP (Vauto_composition_function)) + return PT; + + c = FETCH_MULTIBYTE_CHAR (PT_BYTE); + cat = CHAR_TABLE_REF (Vunicode_category_table, c); + if (SYMBOLP (cat) + && ((c = SDATA (SYMBOL_NAME (cat))[0]) == 'C' || c == 'Z')) + /* A control character is never composed. */ + return PT; + + charpos = PT; + bytepos = PT_BYTE; + limit = (last_pt < PT ? last_pt : BEGV); + do { + DEC_BOTH (charpos, bytepos); + c = FETCH_MULTIBYTE_CHAR (bytepos); + cat = CHAR_TABLE_REF (Vunicode_category_table, c); + if (SYMBOLP (cat) + && ((c = SDATA (SYMBOL_NAME (cat))[0]) == 'C' || c == 'Z')) + { + INC_BOTH (charpos, bytepos); + break; + } + } while (charpos > limit); + + + limit = (last_pt < PT ? ZV : last_pt); + if (limit > PT + 3) + limit = PT + 3; + startpos = charpos; + while (charpos < limit) + { + c = FETCH_MULTIBYTE_CHAR (bytepos); + if (charpos > PT) + { + int ch; + + cat = CHAR_TABLE_REF (Vunicode_category_table, c); + if (SYMBOLP (cat) + && ((ch = SDATA (SYMBOL_NAME (cat))[0]) == 'C' || ch == 'Z')) + return PT; + } + val = CHAR_TABLE_REF (Vcomposition_function_table, c); + if (! CONSP (val)) + { + INC_BOTH (charpos, bytepos); + continue; + } + for (; CONSP (val); val = XCDR (val)) + { + Lisp_Object elt = XCAR (val); + + if (VECTORP (elt) && ASIZE (elt) == 3 && NATNUMP (AREF (elt, 1)) + && (pos = charpos - XFASTINT (AREF (elt, 1))) < PT + && pos >= startpos) + { + Lisp_Object gstring; + EMACS_INT pos_byte; + + if (XFASTINT (AREF (elt, 1)) == 0) + pos_byte = bytepos; + else + pos_byte = CHAR_TO_BYTE (pos); + gstring = autocmp_chars (val, pos, pos_byte, Z, + XWINDOW (selected_window), NULL, Qnil); + if (composition_gstring_p (gstring)) + { + if (pos + LGSTRING_CHAR_LEN (gstring) > PT) + { + int i; + + for (i = 0; i < LGSTRING_GLYPH_LEN (gstring); i++) + { + Lisp_Object glyph = LGSTRING_GLYPH (gstring, i); + + if (NILP (glyph)) + break; + if (pos + LGLYPH_FROM (glyph) == PT) + return PT; + if (pos + LGLYPH_TO (glyph) + 1 > PT) + return (PT < last_pt + ? pos + LGLYPH_FROM (glyph) + : pos + LGLYPH_TO (glyph) + 1); + } + return PT; + } + charpos = startpos = pos + LGSTRING_CHAR_LEN (gstring); + bytepos = CHAR_TO_BYTE (charpos); + break; + } + } + } + if (! CONSP (val)) + INC_BOTH (charpos, bytepos); + } + return PT; +} + +DEFUN ("composition-get-gstring", Fcomposition_get_gstring, + Scomposition_get_gstring, 4, 4, 0, + doc: /* Return a glyph-string for characters between FROM and TO. +If the glhph string is for graphic display, FONT-OBJECT must be +a font-object to use for those characters. +Otherwise (for terminal display), FONT-OBJECT must be nil. + +If the optional 4th argument STRING is not nil, it is a string +containing the target characters between indices FROM and TO. + +A glhph-string is a vector containing information about how to display +specific character sequence. The format is: + [HEADER ID GLYPH ...] + +HEADER is a vector of this form: + [FONT-OBJECT CHAR ...] +where + FONT-OBJECT is a font-object for all glyphs in the glyph-string, + or nil if not yet decided. + CHARs are characters to be composed by GLYPHs. + +ID is an identification number of the glyph-string. It may be nil if +not yet shaped. + +GLYPH is a vector whose elements has this form: + [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT + [ [X-OFF Y-OFF WADJUST] | nil] ] +where + FROM-IDX and TO-IDX are used internally and should not be touched. + C is the character of the glyph. + CODE is the glyph-code of C in FONT-OBJECT. + WIDTH thru DESCENT are the metrics (in pixels) of the glyph. + X-OFF and Y-OFF are offests to the base position for the glyph. + WADJUST is the adjustment to the normal width of the glyph. + +If GLYPH is nil, the remaining elements of the glhph-string vector +must be ignore. */) + (from, to, font_object, string) + Lisp_Object font_object, from, to, string; +{ + Lisp_Object gstring, header; + + if (! NILP (font_object)) + CHECK_FONT_OBJECT (font_object); + header = fill_gstring_header (Qnil, from, to, font_object, string); + gstring = gstring_lookup_cache (header); + if (! NILP (gstring)) + return gstring; + LGSTRING_SET_HEADER (gstring_work, header); + LGSTRING_SET_ID (gstring_work, Qnil); + fill_gstring_body (gstring_work); + return gstring_work; +} + /* Emacs Lisp APIs. */ @@ -771,10 +1465,12 @@ void syms_of_composite () { + int i; + Qcomposition = intern ("composition"); staticpro (&Qcomposition); - /* Make a hash table for composition. */ + /* Make a hash table for static composition. */ { Lisp_Object args[6]; extern Lisp_Object QCsize; @@ -794,6 +1490,28 @@ staticpro (&composition_hash_table); } + /* Make a hash table for glyph-string. */ + { + Lisp_Object args[6]; + extern Lisp_Object QCsize; + + args[0] = QCtest; + args[1] = Qequal; + args[2] = QCweakness; + args[3] = Qnil; + args[4] = QCsize; + args[5] = make_number (311); + gstring_hash_table = Fmake_hash_table (6, args); + staticpro (&gstring_hash_table); + } + + staticpro (&gstring_work_headers); + gstring_work_headers = Fmake_vector (make_number (8), Qnil); + for (i = 0; i < 8; i++) + ASET (gstring_work_headers, i, Fmake_vector (make_number (i + 2), Qnil)); + staticpro (&gstring_work); + gstring_work = Fmake_vector (make_number (10), Qnil); + /* Text property `composition' should be nonsticky by default. */ Vtext_property_default_nonsticky = Fcons (Fcons (Qcomposition, Qt), Vtext_property_default_nonsticky); @@ -831,9 +1549,43 @@ string. */); Vauto_composition_function = Qnil; + DEFVAR_LISP ("composition-function-table", &Vcomposition_function_table, + doc: /* Char-able of functions for automatic character composition. +For each character that has to be composed automatically with +preceding and/or following characters, this char-table contains +a function to call to compose that character. + +The element at index C in the table, if non-nil, is a list of +this form: ([PATTERN PREV-CHARS FUNC] ...) + +PATTERN is a regular expression with which C and the surrounding +characters must match. + +PREV-CHARS is a number of characters before C to check the +matching with PATTERN. If it is 0, PATTERN must match with C and +the following characters. If it is 1, PATTERN must match with a +character before C and the following characters. + +If PREV-CHARS is 0, PATTERN can be nil, which means that the +single character C should be composed. + +FUNC is a function to return a glyph-string representing a +composition of the characters matching with PATTERN. It is +called with one argument GSTRING. + +GSTRING is a template of a glyph-string to return. It is already +filled with a proper header for the characters to compose, and +glyphs corresponding to those characters one by one. The +function must return a new glyph-string of the same header as +GSTRING, or modify GSTRING itself and return it. + +See also the documentation of `auto-composition-mode'. */); + Vcomposition_function_table = Fmake_char_table (Qnil, Qnil); + defsubr (&Scompose_region_internal); defsubr (&Scompose_string_internal); defsubr (&Sfind_composition_internal); + defsubr (&Scomposition_get_gstring); } /* arch-tag: 79cefaf8-ca48-4eed-97e5-d5afb290d272