where
VARIATION-SELECTOR is a character code of variation selector
(#xFE00..#xFE0F or #xE0100..#xE01EF).
- GLYPH-ID is a glyph code of the corresponding variation glyph,
-a fixnum, if it's small enough, otherwise a bignum. */)
+ GLYPH-ID is a glyph code of the corresponding variation glyph, an integer. */)
(Lisp_Object font_object, Lisp_Object character)
{
- unsigned variations[256];
- struct font *font;
- int i, n;
- Lisp_Object val;
+ unsigned variations[256];
+ struct font *font;
+ int i, n;
+ Lisp_Object val;
+
+ CHECK_FONT_OBJECT (font_object);
+ CHECK_CHARACTER (character);
+ font = XFONT_OBJECT (font_object);
+ if (! font->driver->get_variation_glyphs)
+ return Qnil;
+ n = font->driver->get_variation_glyphs (font, XFIXNUM (character), variations);
+ if (! n)
+ return Qnil;
+ val = Qnil;
+ for (i = 0; i < 255; i++)
+ if (variations[i])
+ {
+ int vs = (i < 16 ? 0xFE00 + i : 0xE0100 + (i - 16));
+ Lisp_Object code = INT_TO_INTEGER (variations[i]);
+ val = Fcons (Fcons (make_fixnum (vs), code), val);
+ }
+ return val;
+ }
+
+ /* Return a description of the font at POSITION in the current buffer.
+ If the 2nd optional arg CH is non-nil, it is a character to check
+ the font instead of the character at POSITION.
+
+ For a graphical display, return a cons (FONT-OBJECT . GLYPH-CODE).
+ FONT-OBJECT is the font for the character at POSITION in the current
+ buffer. This is computed from all the text properties and overlays
+ that apply to POSITION. POSITION may be nil, in which case,
+ FONT-SPEC is the font for displaying the character CH with the
+ default face. GLYPH-CODE is the glyph code in the font to use for
+ the character, it is a fixnum, if it is small enough, otherwise a
+ bignum.
+
+ For a text terminal, return a nonnegative integer glyph code for
+ the character, or a negative integer if the character is not
+ displayable. Terminal glyph codes are system-dependent integers
+ that represent displayable characters: for example, on a Linux x86
+ console they represent VGA code points.
+
+ It returns nil in the following cases:
+
+ (1) The window system doesn't have a font for the character (thus
+ it is displayed by an empty box).
+
+ (2) The character code is invalid.
+
+ (3) If POSITION is not nil, and the current buffer is not displayed
+ in any window.
+
+ (4) For a text terminal, the terminal does not report glyph codes.
+
+ In addition, the returned font name may not take into account of
+ such redisplay engine hooks as what used in jit-lock-mode if
+ POSITION is currently not visible. */
+
+
+ DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0,
+ doc: /* For internal use only. */)
+ (Lisp_Object position, Lisp_Object ch)
+ {
+ ptrdiff_t pos, pos_byte, dummy;
+ int face_id;
+ int c;
+ struct frame *f;
+
+ if (NILP (position))
+ {
+ CHECK_CHARACTER (ch);
+ c = XFIXNUM (ch);
+ f = XFRAME (selected_frame);
+ face_id = lookup_basic_face (NULL, f, DEFAULT_FACE_ID);
+ pos = -1;
+ }
+ else
+ {
+ Lisp_Object window;
+ struct window *w;
+
+ EMACS_INT fixed_pos = fix_position (position);
+ if (! (BEGV <= fixed_pos && fixed_pos < ZV))
+ args_out_of_range_3 (position, make_fixnum (BEGV), make_fixnum (ZV));
+ pos = fixed_pos;
+ pos_byte = CHAR_TO_BYTE (pos);
+ if (NILP (ch))
+ c = FETCH_CHAR (pos_byte);
+ else
+ {
+ CHECK_FIXNAT (ch);
+ c = XFIXNUM (ch);
+ }
+ window = Fget_buffer_window (Fcurrent_buffer (), Qnil);
+ if (NILP (window))
+ return Qnil;
+ w = XWINDOW (window);
+ f = XFRAME (w->frame);
+ face_id = face_at_buffer_position (w, pos, &dummy,
+ pos + 100, false, -1, 0);
+ }
+ if (! CHAR_VALID_P (c))
+ return Qnil;
+
+ if (! FRAME_WINDOW_P (f))
+ return terminal_glyph_code (FRAME_TERMINAL (f), c);
+
+ /* We need the basic faces to be valid below, so recompute them if
+ some code just happened to clear the face cache. */
+ if (FRAME_FACE_CACHE (f)->used == 0)
+ recompute_basic_faces (f);
+
+ face_id = FACE_FOR_CHAR (f, FACE_FROM_ID (f, face_id), c, pos, Qnil);
+ struct face *face = FACE_FROM_ID (f, face_id);
+ if (! face->font)
+ return Qnil;
+ unsigned code = face->font->driver->encode_char (face->font, c);
+ if (code == FONT_INVALID_CODE)
+ return Qnil;
+ Lisp_Object font_object;
+ XSETFONT (font_object, face->font);
+ return Fcons (font_object, INT_TO_INTEGER (code));
+ }
+
+ \f
+ /* This part (through the next ^L) is still experimental and not
+ tested much. We may drastically change codes. */
+
+ /* This code implements support for extracting OTF features of a font
+ and exposing them to Lisp, including application of those features
+ to arbitrary stretches of text. FIXME: it would be good to finish
+ this work and have this in Emacs. */
+
+ /* OTF handler. */
+
+ #if 0
+
+ #define LGSTRING_HEADER_SIZE 6
+ #define LGSTRING_GLYPH_SIZE 8
+
+ static int
+ check_gstring (Lisp_Object gstring)
+ {
+ Lisp_Object val;
+ ptrdiff_t i;
+ int j;
+
+ CHECK_VECTOR (gstring);
+ val = AREF (gstring, 0);
+ CHECK_VECTOR (val);
+ if (ASIZE (val) < LGSTRING_HEADER_SIZE)
+ goto err;
+ CHECK_FONT_OBJECT (LGSTRING_FONT (gstring));
+ if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_LBEARING)))
+ CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_LBEARING));
+ if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_RBEARING)))
+ CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_RBEARING));
+ if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_WIDTH)))
+ CHECK_FIXNAT (LGSTRING_SLOT (gstring, LGSTRING_IX_WIDTH));
+ if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT)))
+ CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT));
+ if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT)))
+ CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT));
+
+ for (i = 0; i < LGSTRING_GLYPH_LEN (gstring); i++)
+ {
+ val = LGSTRING_GLYPH (gstring, i);
+ CHECK_VECTOR (val);
+ if (ASIZE (val) < LGSTRING_GLYPH_SIZE)
+ goto err;
+ if (NILP (AREF (val, LGLYPH_IX_CHAR)))
+ break;
+ CHECK_FIXNAT (AREF (val, LGLYPH_IX_FROM));
+ CHECK_FIXNAT (AREF (val, LGLYPH_IX_TO));
+ CHECK_CHARACTER (AREF (val, LGLYPH_IX_CHAR));
+ if (!NILP (AREF (val, LGLYPH_IX_CODE)))
+ CHECK_FIXNAT (AREF (val, LGLYPH_IX_CODE));
+ if (!NILP (AREF (val, LGLYPH_IX_WIDTH)))
+ CHECK_FIXNAT (AREF (val, LGLYPH_IX_WIDTH));
+ if (!NILP (AREF (val, LGLYPH_IX_ADJUSTMENT)))
+ {
+ val = AREF (val, LGLYPH_IX_ADJUSTMENT);
+ CHECK_VECTOR (val);
+ if (ASIZE (val) < 3)
+ goto err;
+ for (j = 0; j < 3; j++)
+ CHECK_FIXNUM (AREF (val, j));
+ }
+ }
+ return i;
+ err:
+ error ("Invalid glyph-string format");
+ return -1;
+ }
+
+ static void
+ check_otf_features (Lisp_Object otf_features)
+ {
+ Lisp_Object val;
+
+ CHECK_CONS (otf_features);
+ CHECK_SYMBOL (XCAR (otf_features));
+ otf_features = XCDR (otf_features);
+ CHECK_CONS (otf_features);
+ CHECK_SYMBOL (XCAR (otf_features));
+ otf_features = XCDR (otf_features);
+ for (val = Fcar (otf_features); CONSP (val); val = XCDR (val))
+ {
+ CHECK_SYMBOL (XCAR (val));
+ if (SBYTES (SYMBOL_NAME (XCAR (val))) > 4)
+ error ("Invalid OTF GSUB feature: %s",
+ SDATA (SYMBOL_NAME (XCAR (val))));
+ }
+ otf_features = XCDR (otf_features);
+ for (val = Fcar (otf_features); CONSP (val); val = XCDR (val))
+ {
+ CHECK_SYMBOL (XCAR (val));
+ if (SBYTES (SYMBOL_NAME (XCAR (val))) > 4)
+ error ("Invalid OTF GPOS feature: %s",
+ SDATA (SYMBOL_NAME (XCAR (val))));
+ }
+ }
+
+ #ifdef HAVE_LIBOTF
+ #include <otf.h>
+
+ Lisp_Object otf_list;
+
+ static Lisp_Object
+ otf_tag_symbol (OTF_Tag tag)
+ {
+ char name[5];
+
+ OTF_tag_name (tag, name);
+ return Fintern (make_unibyte_string (name, 4), Qnil);
+ }
+
+ static OTF *
+ otf_open (Lisp_Object file)
+ {
+ Lisp_Object val = Fassoc (file, otf_list, Qnil);
+ OTF *otf;
- CHECK_FONT_OBJECT (font_object);
- CHECK_CHARACTER (character);
- font = XFONT_OBJECT (font_object);
- if (! font->driver->get_variation_glyphs)
- return Qnil;
- n = font->driver->get_variation_glyphs (font, XFIXNUM (character), variations);
- if (! n)
- return Qnil;
- val = Qnil;
- for (i = 0; i < 255; i++)
- if (variations[i])
- {
- int vs = (i < 16 ? 0xFE00 + i : 0xE0100 + (i - 16));
- Lisp_Object code = INT_TO_INTEGER (variations[i]);
- val = Fcons (Fcons (make_fixnum (vs), code), val);
- }
- return val;
+ if (! NILP (val))
+ otf = xmint_pointer (XCDR (val));
+ else
+ {
+ otf = STRINGP (file) ? OTF_open (SSDATA (file)) : NULL;
+ val = make_mint_ptr (otf);
+ otf_list = Fcons (Fcons (file, val), otf_list);
+ }
+ return otf;
}
- /* Return a description of the font at POSITION in the current buffer.
- If the 2nd optional arg CH is non-nil, it is a character to check
- the font instead of the character at POSITION.
- For a graphical display, return a cons (FONT-OBJECT . GLYPH-CODE).
- FONT-OBJECT is the font for the character at POSITION in the current
- buffer. This is computed from all the text properties and overlays
- that apply to POSITION. POSITION may be nil, in which case,
- FONT-SPEC is the font for displaying the character CH with the
- default face. GLYPH-CODE is the glyph code in the font to use for
- the character, as an integer.
+ /* Return a list describing which scripts/languages FONT supports by
+ which GSUB/GPOS features of OpenType tables. See the comment of
+ (struct font_driver).otf_capability. */
- For a text terminal, return a nonnegative integer glyph code for
- the character, or a negative integer if the character is not
- displayable. Terminal glyph codes are system-dependent integers
- that represent displayable characters: for example, on a Linux x86
- console they represent VGA code points.
+ Lisp_Object
+ font_otf_capability (struct font *font)
+ {
+ OTF *otf;
+ Lisp_Object capability = Fcons (Qnil, Qnil);
+ int i;
- It returns nil in the following cases:
+ otf = otf_open (font->props[FONT_FILE_INDEX]);
+ if (! otf)
+ return Qnil;
+ for (i = 0; i < 2; i++)
+ {
+ OTF_GSUB_GPOS *gsub_gpos;
+ Lisp_Object script_list = Qnil;
+ int j;
- (1) The window system doesn't have a font for the character (thus
- it is displayed by an empty box).
+ if (OTF_get_features (otf, i == 0) < 0)
+ continue;
+ gsub_gpos = i == 0 ? otf->gsub : otf->gpos;
+ for (j = gsub_gpos->ScriptList.ScriptCount - 1; j >= 0; j--)
+ {
+ OTF_Script *script = gsub_gpos->ScriptList.Script + j;
+ Lisp_Object langsys_list = Qnil;
+ Lisp_Object script_tag = otf_tag_symbol (script->ScriptTag);
+ int k;
- (2) The character code is invalid.
+ for (k = script->LangSysCount; k >= 0; k--)
+ {
+ OTF_LangSys *langsys;
+ Lisp_Object feature_list = Qnil;
+ Lisp_Object langsys_tag;
+ int l;
- (3) If POSITION is not nil, and the current buffer is not displayed
- in any window.
+ if (k == script->LangSysCount)
+ {
+ langsys = &script->DefaultLangSys;
+ langsys_tag = Qnil;
+ }
+ else
+ {
+ langsys = script->LangSys + k;
+ langsys_tag
+ = otf_tag_symbol (script->LangSysRecord[k].LangSysTag);
+ }
+ for (l = langsys->FeatureCount - 1; l >= 0; l--)
+ {
+ OTF_Feature *feature
+ = gsub_gpos->FeatureList.Feature + langsys->FeatureIndex[l];
+ Lisp_Object feature_tag
+ = otf_tag_symbol (feature->FeatureTag);
- (4) For a text terminal, the terminal does not report glyph codes.
+ feature_list = Fcons (feature_tag, feature_list);
+ }
+ langsys_list = Fcons (Fcons (langsys_tag, feature_list),
+ langsys_list);
+ }
+ script_list = Fcons (Fcons (script_tag, langsys_list),
+ script_list);
+ }
- In addition, the returned font name may not take into account of
- such redisplay engine hooks as what used in jit-lock-mode if
- POSITION is currently not visible. */
+ if (i == 0)
+ XSETCAR (capability, script_list);
+ else
+ XSETCDR (capability, script_list);
+ }
+ return capability;
+ }
- DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0,
- doc: /* For internal use only. */)
- (Lisp_Object position, Lisp_Object ch)
+ /* Parse OTF features in SPEC and write a proper features spec string
+ in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
+ assured that the sufficient memory has already allocated for
+ FEATURES. */
+
+ static void
+ generate_otf_features (Lisp_Object spec, char *features)
{
- ptrdiff_t pos, pos_byte, dummy;
- int face_id;
- int c;
- struct frame *f;
+ Lisp_Object val;
+ char *p;
+ bool asterisk;
- if (NILP (position))
- {
- CHECK_CHARACTER (ch);
- c = XFIXNUM (ch);
- f = XFRAME (selected_frame);
- face_id = lookup_basic_face (NULL, f, DEFAULT_FACE_ID);
- pos = -1;
- }
- else
+ p = features;
+ *p = '\0';
+ for (asterisk = 0; CONSP (spec); spec = XCDR (spec))
{
- Lisp_Object window;
- struct window *w;
-
- EMACS_INT fixed_pos = fix_position (position);
- if (! (BEGV <= fixed_pos && fixed_pos < ZV))
- args_out_of_range_3 (position, make_fixnum (BEGV), make_fixnum (ZV));
- pos = fixed_pos;
- pos_byte = CHAR_TO_BYTE (pos);
- if (NILP (ch))
- c = FETCH_CHAR (pos_byte);
+ val = XCAR (spec);
+ CHECK_SYMBOL (val);
+ if (p > features)
+ *p++ = ',';
+ if (SREF (SYMBOL_NAME (val), 0) == '*')
+ {
+ asterisk = 1;
+ *p++ = '*';
+ }
+ else if (! asterisk)
+ {
+ val = SYMBOL_NAME (val);
+ p += esprintf (p, "%s", SDATA (val));
+ }
else
{
- CHECK_FIXNAT (ch);
- c = XFIXNUM (ch);
+ val = SYMBOL_NAME (val);
+ p += esprintf (p, "~%s", SDATA (val));
}
- window = Fget_buffer_window (Fcurrent_buffer (), Qnil);
- if (NILP (window))
- return Qnil;
- w = XWINDOW (window);
- f = XFRAME (w->frame);
- face_id = face_at_buffer_position (w, pos, &dummy,
- pos + 100, false, -1, 0);
}
- if (! CHAR_VALID_P (c))
- return Qnil;
+ if (CONSP (spec))
+ error ("OTF spec too long");
+ }
- if (! FRAME_WINDOW_P (f))
- return terminal_glyph_code (FRAME_TERMINAL (f), c);
+ Lisp_Object
+ font_otf_DeviceTable (OTF_DeviceTable *device_table)
+ {
+ int len = device_table->StartSize - device_table->EndSize + 1;
- /* We need the basic faces to be valid below, so recompute them if
- some code just happened to clear the face cache. */
- if (FRAME_FACE_CACHE (f)->used == 0)
- recompute_basic_faces (f);
+ return Fcons (make_fixnum (len),
+ make_unibyte_string (device_table->DeltaValue, len));
+ }
- face_id = FACE_FOR_CHAR (f, FACE_FROM_ID (f, face_id), c, pos, Qnil);
- struct face *face = FACE_FROM_ID (f, face_id);
- if (! face->font)
- return Qnil;
- unsigned code = face->font->driver->encode_char (face->font, c);
- if (code == FONT_INVALID_CODE)
- return Qnil;
- Lisp_Object font_object;
- XSETFONT (font_object, face->font);
- return Fcons (font_object, INT_TO_INTEGER (code));
+ Lisp_Object
+ font_otf_ValueRecord (int value_format, OTF_ValueRecord *value_record)
+ {
+ Lisp_Object val = make_nil_vector (8);
+
+ if (value_format & OTF_XPlacement)
+ ASET (val, 0, make_fixnum (value_record->XPlacement));
+ if (value_format & OTF_YPlacement)
+ ASET (val, 1, make_fixnum (value_record->YPlacement));
+ if (value_format & OTF_XAdvance)
+ ASET (val, 2, make_fixnum (value_record->XAdvance));
+ if (value_format & OTF_YAdvance)
+ ASET (val, 3, make_fixnum (value_record->YAdvance));
+ if (value_format & OTF_XPlaDevice)
+ ASET (val, 4, font_otf_DeviceTable (&value_record->XPlaDevice));
+ if (value_format & OTF_YPlaDevice)
+ ASET (val, 4, font_otf_DeviceTable (&value_record->YPlaDevice));
+ if (value_format & OTF_XAdvDevice)
+ ASET (val, 4, font_otf_DeviceTable (&value_record->XAdvDevice));
+ if (value_format & OTF_YAdvDevice)
+ ASET (val, 4, font_otf_DeviceTable (&value_record->YAdvDevice));
+ return val;
}
- #if 0
+ Lisp_Object
+ font_otf_Anchor (OTF_Anchor *anchor)
+ {
+ Lisp_Object val = make_nil_vector (anchor->AnchorFormat + 1);
+ ASET (val, 0, make_fixnum (anchor->XCoordinate));
+ ASET (val, 1, make_fixnum (anchor->YCoordinate));
+ if (anchor->AnchorFormat == 2)
+ ASET (val, 2, make_fixnum (anchor->f.f1.AnchorPoint));
+ else
+ {
+ ASET (val, 3, font_otf_DeviceTable (&anchor->f.f2.XDeviceTable));
+ ASET (val, 4, font_otf_DeviceTable (&anchor->f.f2.YDeviceTable));
+ }
+ return val;
+ }
+ #endif /* HAVE_LIBOTF */
DEFUN ("font-drive-otf", Ffont_drive_otf, Sfont_drive_otf, 6, 6, 0,
doc: /* Apply OpenType features on glyph-string GSTRING-IN.
projects / emacs.git / commitdiff