procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge from origin/emacs-28

Browse source 
72aac80184 ; Fix typo
c54a64491f Add .mailmap for proper git log output
f9a072c592 ; Fix typo
3d056f6947 * doc/emacs/ack.texi (Acknowledgments): Update maintainers.
00159c086c ; Add commentary to disabled OTF support code in font.c

# Conflicts:
#	src/font.c
This commit is contained in:
Stefan Kangas 2022-09-28 15:35:06 +02:00
commit d1d0f03a58
3 changed files with 446 additions and 294 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

146
.mailmap Normal file
View file

@ -0,0 +1,146 @@
#
# This list is used to fix a few misspelled names in various git
# listings (e.g., "git log"). This can be used to fix incorrect
# attribution, poor display, or names showing up more than once.
# It also allows updating an old email addresses to a new one.
#
# See "man git-shortlog" for more information on the format.
#
# Keep file sorted using `M-x sort-lines'.
#
Alan Third <alan@idiocy.org>
Alan Third <alan@idiocy.org> <alan@breton-build.holly.idiocy.org>
Alexander Gramiak <agrambot@gmail.com>
Amin Bandali <bandali@gnu.org> <mab@gnu.org>
Andrea Corallo <akrl@sdf.org>
Andrea Corallo <akrl@sdf.org> <akrl@sdf.com>
Andrea Corallo <akrl@sdf.org> <andcor03@e112547.nice.arm.com>
Andrea Corallo <akrl@sdf.org> <andrea_corallo@yahoo.it>
Andrew G Cohen <cohen@andy.bu.edu>
Andrew G Cohen <cohen@andy.bu.edu> <cohen@bu.edu>
Arash Esbati <arash@gnu.org> <arash.esbati@gmail.com>
Arash Esbati <arash@gnu.org> <esbati@gmx.de>
Artur Malabarba <bruce.connor.am@gmail.com> <am12548@it055607.users.bris.ac.uk>
Bastien Guerry <bzg@gnu.org>
Carlos Pita <carlosjosepita@gmail.com>
Chong Yidong <cyd@gnu.org> <cyd@stupidchicken.com>
Christoph Scholtes <cschol2112@gmail.com>
Christoph Scholtes <cschol2112@gmail.com> <cschol2112@googlemail.com>
Clément Pit-Claudel <clement.pitclaudel@live.com>
Clément Pit-Claudel <clement.pitclaudel@live.com> <clement.pit@gmail.com>
Courtney Bane <emacs-bugs-7626@cbane.org>
Dan Nicolaescu <dann@ics.uci.edu> <dann@gnu.org>
Dan Nicolaescu <dann@ics.uci.edu> <done@ece.arizona.edu>
Daniel Colascione <dancol@dancol.org> <dan.colascione@gmail.com>
David Abrahams <dave@boostpro.com>
David M. Koppelman <koppel@ece.lsu.edu>
Deniz Dogan <deniz@dogan.se> <deniz.a.m.dogan@gmail.com>
Dick R. Chiang <dick.r.chiang@gmail.com>
Earl Hyatt <ej32u@protonmail.com>
Earl Hyatt <ej32u@protonmail.com> <okamsn@protonmail.com>
Edward M. Reingold <reingold@emr.cs.iit.edu>
Eli Zaretskii <eliz@gnu.org> <eliz@is.elta.co.il>
Emilio C. Lopes <eclig@gmx.net>
Enami Tsugutomo <tsugutomo.enami@jp.sony.com>
Era Eriksson <era+emacs@iki.fi> <era+emacsbugs@iki.fi>
Eric S. Raymond <esr@thyrsus.com> <esr@snark.thyrsus.com>
Etienne Prud’homme <e.e.f.prudhomme@gmail.com>
Fabián Ezequiel Gallina <fgallina@gnu.org> <fgallina@cuca>
Francis Litterio <flitterio@gmail.com>
Gabor Vida <vidagabor@gmail.com>
Gerd Möllmann <gerd@gnu.org>
Gerd Möllmann <gerd@gnu.org> <gerd.moellmann@gmail.com>
Glenn Morris <rgm@gnu.org>
Glenn Morris <rgm@gnu.org> <rgm@fencepost>
Glenn Morris <rgm@gnu.org> <rgm@stanford.edu>
Gnus developers <ding@gnus.org> <ding@gnus.org.noreply>
Gregory Heytings <gregory@heytings.org> <ghe@sdf.org>
Grégoire Jadi <daimrod@gmail.com>
Ian Dunn <dunni@gnu.org>
Jan Djärv <jan.h.d@swipnet.se>
Jan Djärv <jan.h.d@swipnet.se> <jhd@f20.localdomain>
Jason Rumney <jasonr@gnu.org> <jasonr@wanchan>
Jens Lechtenbörger <jens.lechtenboerger@fsfe.org>
Jim Blandy <jimb@red-bean.com> <jimb@redhat.com>
Jimmy Aguilar Mena <spacibba@aol.com>
Joakim Verona <joakim@verona.se>
Joakim Verona <joakim@verona.se> <root@exodia.verona.se>
John Wiegley <johnw@newartisans.com> <jwiegley@gmail.com>
Jose A. Ortega Ruiz <jao@gnu.org>
João Távora <joaotavora@gmail.com>
Juri Linkov <juri@linkov.net> <juri@jurta.org>
Jérémy Compostella <jeremy.compostella@gmail.com>
Jürgen Hötzel <juergen@archlinux.org>
Karl Fogel <kfogel@red-bean.com> <karl.fogel@canonical.com>
Kaushal Modi <kaushal.modi@gmail.com>
Kelvin White <kwhite@gnu.org>
Kenichi Handa <handa@gnu.org>
Kenichi Handa <handa@gnu.org> <handa@etlken>
Kenichi Handa <handa@gnu.org> <handa@m17n.org>
Kenjiro Nakayama <nakayamakenjiro@gmail.com>
Károly Lőrentey <lorentey@elte.hu>
Lars Ingebrigtsen <larsi@gnus.org>
Lars Ingebrigtsen <larsi@gnus.org> <larsi@emkay.local>
Lars Ingebrigtsen <larsi@gnus.org> <larsi@openbsd6.gnus.org>
Lars Ingebrigtsen <larsi@gnus.org> <larsi@quimbies.gnus.org>
Lars Ingebrigtsen <larsi@gnus.org> <larsi@stories.gnus.org>
Lin Sun <lin.sun@zoom.us>
Ludovic Courtès <ludo@gnu.org>
Martin Rudalics <rudalics@gmx.at>
Martin Rudalics <rudalics@gmx.at> <“rudalics@gmx.at”>
Matt Armstrong <matt@rfc20.org> <marmstrong@google.com>
Matt Armstrong <matt@rfc20.org> <matt@mdeb>
Mattias Engdegård <mattiase@acm.org>
Maxim Nikulin <manikulin@gmail.com>
Michael Albinus <michael.albinus@gmx.de> <albinus@detlef>
Michalis V <mvar.40k@gmail.com>
Miha Rihtaršič <miha@kamnitnik.top>
Nick Drozd <nicholasdrozd@gmail.com>
Nicolas Petton <nicolas@petton.fr> <petton.nicolas@gmail.com>
Nitish Chandra <nitishchandrachinta@gmail.com>
Noam Postavsky <npostavs@gmail.com> <npostavs@users.sourceforge.net>
Noam Postavsky <npostavs@gmail.com> <npostavs@users.sourceforget.net>
Paul Eggert <eggert@cs.ucla.edu> <eggert@Penguin.CS.UCLA.EDU>
Paul Eggert <eggert@cs.ucla.edu> <eggert@day>
Paul Eggert <eggert@cs.ucla.edu> <eggert@twinsun.com>
Paul Eggert <eggert@cs.ucla.edu> <eggert@union>
Peter J. Weisberg <pj@irregularexpressions.net>
Peter Oliver <p.d.oliver@mavit.org.uk> <bzr@mavit.org.uk>
Peter Oliver <p.d.oliver@mavit.org.uk> <git@mavit.org.uk>
Philip Kaludercic <philipk@posteo.net>
Philip Kaludercic <philipk@posteo.net> <philip.kaludercic@fau.de>
Philip Kaludercic <philipk@posteo.net> <philip@warpmail.net>
Philipp Stephani <phst@google.com>
Philipp Stephani <phst@google.com> Philipp Stephani <p.stephani2@gmail.com>
Phillip Lord <phillip.lord@russet.org.uk> <phillip.lord@newcastle.ac.uk>
Pierre Lorenzon <devel@pollock-nageoire.net>
Pieter van Oostrum <pieter@vanoostrum.org> <pieter-l@vanoostrum.org>
Pip Cet <pipcet@gmail.com>
Przemysław Wojnowski <esperanto@cumego.com>
Rasmus <rasmus@gmx.us>
Richard M. Stallman <rms@gnu.org>
Robert J. Chassell <bob@gnu.org> <bob@rattlesnake.com>
Ronnie Schnell <ronnie@driver-aces.com>
Ryan C. Thompson <rct@thompsonclan.org>
Simen Heggestøyl <simenheg@gmail.com>
Simen Heggestøyl <simenheg@gmail.com> <simenheg@ifi.uio.no>
Simon Josefsson <simon@josefsson.org> <jas@extundo.com>
Stefan Kangas <stefankangas@gmail.com> <stefan@marxist.se>
Stefan Monnier <monnier@iro.umontreal.ca> <monnier@IRO.UMontreal.CA>
Tassilo Horn <tsdh@gnu.org> <tassilo@member.fsf.org>
Ted Zlatanov <tzz@lifelogs.com>
Thien-Thi Nguyen <ttn@gnu.org> <ttn@gnuvola.org>
Thierry Volpiatto <thievol@posteo.net> <thierry.volpiatto@gmail.com>
Tino Calancha <ccalancha@suse.com> <f92capac@gmail.com>
Tino Calancha <ccalancha@suse.com> <tino.calancha@gmail.com>
Tom Tromey <tom@tromey.com> <tromey@redhat.com>
Ulf Jasper <ulf.jasper@web.de> <ulf@uthinkpad>
Ulrich Müller <ulm@gentoo.org>
Werner Lemberg <wl@gnu.org>
Wolfgang Scherer <wolfgang.scherer@gmx.de> <Wolfgang.Scherer@gmx.de>
Xi Lu <lx@shellcodes.org>
Xue Fuqiao <xfq.free@gmail.com> <xfq@gnu.org>
Óscar Fuentes <ofv@wanadoo.es>
İ. Göktuğ Kayaalp <self@gkayaalp.com>
Łukasz Stelmach <stlman@poczta.fm> <l.stelmach@samsung.com>
Łukasz Stelmach <stlman@poczta.fm> <lukasz.stelmach@iem.pw.edu.pl>

8
doc/emacs/ack.texi
View file

@ -524,8 +524,9 @@ Denis Howe wrote @file{browse-url.el}, a package for invoking a WWW
browser to display a URL.
@item
Lars Magne Ingebrigtsen did a major redesign of the Gnus news-reader and
wrote many of its parts. Several of these are now general components of
Lars Magne Ingebrigtsen was the Emacs (co-)maintainer from Emacs 27.2
onwards. He did a major redesign of the Gnus news-reader and wrote
many of its parts. Several of these are now general components of
Emacs, including: @file{dns.el} for Domain Name Service lookups;
@file{format-spec.el} for formatting arbitrary format strings;
@file{netrc.el} for parsing of @file{.netrc} files; and
@ -1440,7 +1441,8 @@ Victor Zandy wrote @file{zone.el}, a package for people who like to
zone out in front of Emacs.
@item
Eli Zaretskii made many standard Emacs features work on MS-DOS and
Eli Zaretskii was the the Emacs (co-)maintainer from Emacs 25
onwards. He made many standard Emacs features work on MS-DOS and
Microsoft Windows. He also wrote @file{tty-colors.el}, which
implements transparent mapping of X colors to tty colors; and
@file{rxvt.el}. He implemented support for bidirectional text, menus

586
src/font.c
View file

@ -1835,296 +1835,6 @@ font_parse_family_registry (Lisp_Object family, Lisp_Object registry, Lisp_Objec
}
}
/* This part (through the next ^L) is still experimental and not
tested much. We may drastically change codes. */
/* 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;
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 list describing which scripts/languages FONT supports by
which GSUB/GPOS features of OpenType tables. See the comment of
(struct font_driver).otf_capability. */
Lisp_Object
font_otf_capability (struct font *font)
{
OTF *otf;
Lisp_Object capability = Fcons (Qnil, Qnil);
int i;
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;
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;
for (k = script->LangSysCount; k >= 0; k--)
{
OTF_LangSys *langsys;
Lisp_Object feature_list = Qnil;
Lisp_Object langsys_tag;
int l;
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);
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);
}
if (i == 0)
XSETCAR (capability, script_list);
else
XSETCDR (capability, script_list);
}
return capability;
}
/* 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)
{
Lisp_Object val;
char *p;
bool asterisk;
p = features;
*p = '\0';
for (asterisk = 0; CONSP (spec); spec = XCDR (spec))
{
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
{
val = SYMBOL_NAME (val);
p += esprintf (p, "~%s", SDATA (val));
}
}
if (CONSP (spec))
error ("OTF spec too long");
}
Lisp_Object
font_otf_DeviceTable (OTF_DeviceTable *device_table)
{
int len = device_table->StartSize - device_table->EndSize + 1;
return Fcons (make_fixnum (len),
make_unibyte_string (device_table->DeltaValue, len));
}
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;
}
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 */
#endif /* 0 */
/* Font sorting. */
@ -4729,7 +4439,8 @@ where
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.
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
@ -4819,8 +4530,300 @@ DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0,
return Fcons (font_object, INT_TO_INTEGER (code));
}
/* 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;
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 list describing which scripts/languages FONT supports by
which GSUB/GPOS features of OpenType tables. See the comment of
(struct font_driver).otf_capability. */
Lisp_Object
font_otf_capability (struct font *font)
{
OTF *otf;
Lisp_Object capability = Fcons (Qnil, Qnil);
int i;
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;
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;
for (k = script->LangSysCount; k >= 0; k--)
{
OTF_LangSys *langsys;
Lisp_Object feature_list = Qnil;
Lisp_Object langsys_tag;
int l;
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);
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);
}
if (i == 0)
XSETCAR (capability, script_list);
else
XSETCDR (capability, script_list);
}
return capability;
}
/* 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)
{
Lisp_Object val;
char *p;
bool asterisk;
p = features;
*p = '\0';
for (asterisk = 0; CONSP (spec); spec = XCDR (spec))
{
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
{
val = SYMBOL_NAME (val);
p += esprintf (p, "~%s", SDATA (val));
}
}
if (CONSP (spec))
error ("OTF spec too long");
}
Lisp_Object
font_otf_DeviceTable (OTF_DeviceTable *device_table)
{
int len = device_table->StartSize - device_table->EndSize + 1;
return Fcons (make_fixnum (len),
make_unibyte_string (device_table->DeltaValue, len));
}
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;
}
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.
OTF-FEATURES specifies which features to apply in this format:
@ -4939,6 +4942,7 @@ corresponding character. */)
}
#endif /* 0 */
#ifdef FONT_DEBUG
DEFUN ("open-font", Fopen_font, Sopen_font, 1, 3, 0,