# HG changeset patch # User Kenichi Handa # Date 1278901896 -32400 # Node ID 92a95ad5c098e1287604e27c5d61ece21e861a1d # Parent 02b388bb2a4b7854e0d777b6ca59aea50bdae0c8# Parent d43e7dfda4f17ebd3a541cdefec97e2be067c955 Make font-get to get :otf value dynamically from a font-object. diff -r 02b388bb2a4b -r 92a95ad5c098 src/ChangeLog --- a/src/ChangeLog Sun Jul 11 18:14:53 2010 -0400 +++ b/src/ChangeLog Mon Jul 12 11:31:36 2010 +0900 @@ -1,3 +1,16 @@ +2010-07-12 Kenichi Handa + + * font.h (enum font_property_index): New member FONT_ENTITY_INDEX. + + * font.c (font_open_entity): Record ENTITY in FONT_OBJECT's slot + of FONT_ENTITY_INDEX. + (Ffont_get): If KEY is :otf and the font-object doesn't have the + property, get the property value dynamically. + (Ffont_put): Accept font-entity and font-object too. + (Ffont_get_glyhphs): Renamed from Fget_font_glyphs. Arguments and + return value changed. + (syms_of_font): Adjusted for the above change. + 2010-07-11 Andreas Schwab * blockinput.h: Remove obsolete comment. diff -r 02b388bb2a4b -r 92a95ad5c098 src/font.c --- a/src/font.c Sun Jul 11 18:14:53 2010 -0400 +++ b/src/font.c Mon Jul 12 11:31:36 2010 +0900 @@ -3005,7 +3005,7 @@ return Qnil; ASET (entity, FONT_OBJLIST_INDEX, Fcons (font_object, AREF (entity, FONT_OBJLIST_INDEX))); - ASET (font_object, FONT_OBJLIST_INDEX, Qnil); + ASET (font_object, FONT_ENTITY_INDEX, entity); num_fonts++; font = XFONT_OBJECT (font_object); @@ -4100,15 +4100,24 @@ DEFUN ("font-get", Ffont_get, Sfont_get, 2, 2, 0, doc: /* Return the value of FONT's property KEY. FONT is a font-spec, a font-entity, or a font-object. -KEY must be one of these symbols: +KEY is any symbol, but these are reserved for specific meanings: :family, :weight, :slant, :width, :foundry, :adstyle, :registry, - :size, :name, :script + :size, :name, :script, :otf See the documentation of `font-spec' for their meanings. -If FONT is a font-entity or font-object, the value of :script may be -a list of scripts that are supported by the font. */) +In addition, if FONT is a font-entity or a font-object, values of +:script and :otf are different from those of a font-spec as below: + +The value of :script may be a list of scripts that are supported by the font. + +The value of :otf is a cons (GSUB . GPOS) where GSUB and GPOS are lists +representing the OpenType features supported by the font by this form: + ((SCRIPT (LANGSYS FEATURE ...) ...) ...) +SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType +Layout tags. */) (Lisp_Object font, Lisp_Object key) { int idx; + Lisp_Object val; CHECK_FONT (font); CHECK_SYMBOL (key); @@ -4118,7 +4127,28 @@ return font_style_symbolic (font, idx, 0); if (idx >= 0 && idx < FONT_EXTRA_INDEX) return AREF (font, idx); - return Fcdr (Fassq (key, AREF (font, FONT_EXTRA_INDEX))); + val = Fassq (key, AREF (font, FONT_EXTRA_INDEX)); + if (NILP (val) && EQ (key, QCotf) && FONT_OBJECT_P (font)) + { + struct font *fontp = XFONT_OBJECT (font); + Lisp_Object entity = AREF (font, FONT_ENTITY_INDEX); + + val = Fassq (key, AREF (entity, FONT_EXTRA_INDEX)); + if (NILP (val)) + { + if (fontp->driver->otf_capability) + val = fontp->driver->otf_capability (fontp); + else + val = Fcons (Qnil, Qnil); + font_put_extra (font, QCotf, val); + font_put_extra (entity, QCotf, val); + } + else + val = Fcdr (val); + } + else + val = Fcdr (val); + return val; } #ifdef HAVE_WINDOW_SYSTEM @@ -4209,17 +4239,36 @@ #endif DEFUN ("font-put", Ffont_put, Sfont_put, 3, 3, 0, - doc: /* Set one property of FONT-SPEC: give property PROP value VAL. */) - (Lisp_Object font_spec, Lisp_Object prop, Lisp_Object val) + doc: /* Set one property of FONT: give property KEY value VAL. +FONT is a font-spec, a font-entity, or a font-object. + +If FONT is a font-spec, KEY can be any symbol. But if KEY is the one +accepted by the function `font-spec' (which see), VAL must be what +allowed in `font-spec'. + +If FONT is a font-entity or a font-object, KEY must not be the one +accepted by `font-spec'. */) + (Lisp_Object font, Lisp_Object prop, Lisp_Object val) { int idx; - CHECK_FONT_SPEC (font_spec); idx = get_font_prop_index (prop); if (idx >= 0 && idx < FONT_EXTRA_INDEX) - ASET (font_spec, idx, font_prop_validate (idx, Qnil, val)); + { + CHECK_FONT_SPEC (font); + ASET (font, idx, font_prop_validate (idx, Qnil, val)); + } else - font_put_extra (font_spec, prop, font_prop_validate (0, prop, val)); + { + if (EQ (prop, QCname) + || EQ (prop, QCscript) + || EQ (prop, QClang) + || EQ (prop, QCotf)) + CHECK_FONT_SPEC (font); + else + CHECK_FONT (font); + font_put_extra (font, prop, font_prop_validate (0, prop, val)); + } return val; } @@ -4758,24 +4807,99 @@ return val; } -DEFUN ("get-font-glyphs", Fget_font_glyphs, Sget_font_glyphs, 2, 2, 0, - doc: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING. -Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */) - (Lisp_Object font_object, Lisp_Object string) +DEFUN ("font-get-glyphs", Ffont_get_glyphs, Sfont_get_glyphs, 3, 4, 0, + doc: + /* Return a vector of FONT-OBJECT's glyphs for the specified characters. +FROM and TO are positions (integers or markers) specifying a region +of the current buffer. +If the optional fourth arg OBJECT is not nil, it is a string or a +vector containing the target characters. + +Each element is a vector containing information of a glyph in this format: + [FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT ADJUSTMENT] +where + FROM is an index numbers of a character the glyph corresponds to. + TO is the same as FROM. + 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. + ADJUSTMENT is always nil. +If FONT-OBJECT doesn't have a glyph for a character, +the corresponding element is nil. */) + (Lisp_Object font_object, Lisp_Object from, Lisp_Object to, + Lisp_Object object) { struct font *font; - int i, len; - Lisp_Object vec; + int i, len, c; + Lisp_Object *chars, vec; + USE_SAFE_ALLOCA; CHECK_FONT_GET_OBJECT (font_object, font); - CHECK_STRING (string); - len = SCHARS (string); + if (NILP (object)) + { + EMACS_INT charpos, bytepos; + + validate_region (&from, &to); + if (EQ (from, to)) + return Qnil; + len = XFASTINT (to) - XFASTINT (from); + SAFE_ALLOCA_LISP (chars, len); + charpos = XFASTINT (from); + bytepos = CHAR_TO_BYTE (charpos); + for (i = 0; charpos < XFASTINT (to); i++) + { + FETCH_CHAR_ADVANCE (c, charpos, bytepos); + chars[i] = make_number (c); + } + } + else if (STRINGP (object)) + { + const unsigned char *p; + + CHECK_NUMBER (from); + CHECK_NUMBER (to); + if (XINT (from) < 0 || XINT (from) > XINT (to) + || XINT (to) > SCHARS (object)) + args_out_of_range_3 (object, from, to); + if (EQ (from, to)) + return Qnil; + len = XFASTINT (to) - XFASTINT (from); + SAFE_ALLOCA_LISP (chars, len); + p = SDATA (object); + if (STRING_MULTIBYTE (object)) + for (i = 0; i < len; i++) + { + c = STRING_CHAR_ADVANCE (p); + chars[i] = make_number (c); + } + else + for (i = 0; i < len; i++) + chars[i] = make_number (p[i]); + } + else + { + CHECK_VECTOR (object); + CHECK_NUMBER (from); + CHECK_NUMBER (to); + if (XINT (from) < 0 || XINT (from) > XINT (to) + || XINT (to) > ASIZE (object)) + args_out_of_range_3 (object, from, to); + if (EQ (from, to)) + return Qnil; + len = XFASTINT (to) - XFASTINT (from); + for (i = 0; i < len; i++) + { + Lisp_Object elt = AREF (object, XFASTINT (from) + i); + CHECK_CHARACTER (elt); + } + chars = &(AREF (object, XFASTINT (from))); + } + vec = Fmake_vector (make_number (len), Qnil); for (i = 0; i < len; i++) { - Lisp_Object ch = Faref (string, make_number (i)); - Lisp_Object val; - int c = XINT (ch); + Lisp_Object g; + int c = XFASTINT (chars[i]); unsigned code; EMACS_INT cod; struct font_metrics metrics; @@ -4783,20 +4907,21 @@ cod = code = font->driver->encode_char (font, c); if (code == FONT_INVALID_CODE) continue; - val = Fmake_vector (make_number (6), Qnil); - if (cod <= MOST_POSITIVE_FIXNUM) - ASET (val, 0, make_number (code)); - else - ASET (val, 0, Fcons (make_number (code >> 16), - make_number (code & 0xFFFF))); + g = Fmake_vector (make_number (LGLYPH_SIZE), Qnil); + LGLYPH_SET_FROM (g, i); + LGLYPH_SET_TO (g, i); + LGLYPH_SET_CHAR (g, c); + LGLYPH_SET_CODE (g, code); font->driver->text_extents (font, &code, 1, &metrics); - ASET (val, 1, make_number (metrics.lbearing)); - ASET (val, 2, make_number (metrics.rbearing)); - ASET (val, 3, make_number (metrics.width)); - ASET (val, 4, make_number (metrics.ascent)); - ASET (val, 5, make_number (metrics.descent)); - ASET (vec, i, val); + LGLYPH_SET_WIDTH (g, metrics.width); + LGLYPH_SET_LBEARING (g, metrics.lbearing); + LGLYPH_SET_RBEARING (g, metrics.rbearing); + LGLYPH_SET_ASCENT (g, metrics.ascent); + LGLYPH_SET_DESCENT (g, metrics.descent); + ASET (vec, i, g); } + if (! VECTORP (object)) + SAFE_FREE (); return vec; } @@ -5188,7 +5313,7 @@ defsubr (&Sopen_font); defsubr (&Sclose_font); defsubr (&Squery_font); - defsubr (&Sget_font_glyphs); + defsubr (&Sfont_get_glyphs); defsubr (&Sfont_match_p); defsubr (&Sfont_at); #if 0 diff -r 02b388bb2a4b -r 92a95ad5c098 src/font.h --- a/src/font.h Sun Jul 11 18:14:53 2010 -0400 +++ b/src/font.h Mon Jul 12 11:31:36 2010 +0900 @@ -159,14 +159,19 @@ /* This value is the length of font-spec vector. */ FONT_SPEC_MAX, - /* The followings are used only for a font-entity. */ + /* The followings are used only for a font-entity and a font-object. */ /* List of font-objects opened from the font-entity. */ FONT_OBJLIST_INDEX = FONT_SPEC_MAX, + /* Font-entity from which the font-object is opened. */ + FONT_ENTITY_INDEX = FONT_SPEC_MAX, + /* This value is the length of font-entity vector. */ FONT_ENTITY_MAX, + /* The followings are used only for a font-object. */ + /* XLFD name of the font (string). */ FONT_NAME_INDEX = FONT_ENTITY_MAX,