aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorPaul Eggert2019-04-23 13:29:42 -0700
committerPaul Eggert2019-04-23 13:30:14 -0700
commit64d0cd9810af6bd0c378fc6bc666c76ddfa97e40 (patch)
treec5b111ffa19ada121d7a16a4771c6cd36526eab7
parent259dfd20b9f835e701edef569795198ff7cf68cb (diff)
downloademacs-64d0cd9810af6bd0c378fc6bc666c76ddfa97e40.tar.gz
emacs-64d0cd9810af6bd0c378fc6bc666c76ddfa97e40.zip
Remove font.c code commented out for a decade
* src/font.c (LSTRING_HEADER_SIZE, LSTRING_GLYPH_SIZE, check_gstring) (check_otf_features, otf_list, otf_tag_symbol, otf_open) (font_otf_capability, generate_otf_features) (font_otf_DeviceTable, font_otf_ValueRecord) (font_otf_Anchor, Ffont_drive_otf, Ffont_otf_alternates) (Fdraw_string, syms_of_font): Remove "experimental and not tested much" code that has been "#if 0"-ed out for more than a decade and which was getting in the way of maintenance.
-rw-r--r--src/font.c465
1 files changed, 0 insertions, 465 deletions
diff --git a/src/font.c b/src/font.c
index 5ca89c97dcf..e7686cf4bb3 100644
--- a/src/font.c
+++ b/src/font.c
@@ -1786,296 +1786,6 @@ font_parse_family_registry (Lisp_Object family, Lisp_Object registry, Lisp_Objec
1786} 1786}
1787 1787
1788 1788
1789/* This part (through the next ^L) is still experimental and not
1790 tested much. We may drastically change codes. */
1791
1792/* OTF handler. */
1793
1794#if 0
1795
1796#define LGSTRING_HEADER_SIZE 6
1797#define LGSTRING_GLYPH_SIZE 8
1798
1799static int
1800check_gstring (Lisp_Object gstring)
1801{
1802 Lisp_Object val;
1803 ptrdiff_t i;
1804 int j;
1805
1806 CHECK_VECTOR (gstring);
1807 val = AREF (gstring, 0);
1808 CHECK_VECTOR (val);
1809 if (ASIZE (val) < LGSTRING_HEADER_SIZE)
1810 goto err;
1811 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring));
1812 if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_LBEARING)))
1813 CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_LBEARING));
1814 if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_RBEARING)))
1815 CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_RBEARING));
1816 if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_WIDTH)))
1817 CHECK_FIXNAT (LGSTRING_SLOT (gstring, LGSTRING_IX_WIDTH));
1818 if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT)))
1819 CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT));
1820 if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT)))
1821 CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT));
1822
1823 for (i = 0; i < LGSTRING_GLYPH_LEN (gstring); i++)
1824 {
1825 val = LGSTRING_GLYPH (gstring, i);
1826 CHECK_VECTOR (val);
1827 if (ASIZE (val) < LGSTRING_GLYPH_SIZE)
1828 goto err;
1829 if (NILP (AREF (val, LGLYPH_IX_CHAR)))
1830 break;
1831 CHECK_FIXNAT (AREF (val, LGLYPH_IX_FROM));
1832 CHECK_FIXNAT (AREF (val, LGLYPH_IX_TO));
1833 CHECK_CHARACTER (AREF (val, LGLYPH_IX_CHAR));
1834 if (!NILP (AREF (val, LGLYPH_IX_CODE)))
1835 CHECK_FIXNAT (AREF (val, LGLYPH_IX_CODE));
1836 if (!NILP (AREF (val, LGLYPH_IX_WIDTH)))
1837 CHECK_FIXNAT (AREF (val, LGLYPH_IX_WIDTH));
1838 if (!NILP (AREF (val, LGLYPH_IX_ADJUSTMENT)))
1839 {
1840 val = AREF (val, LGLYPH_IX_ADJUSTMENT);
1841 CHECK_VECTOR (val);
1842 if (ASIZE (val) < 3)
1843 goto err;
1844 for (j = 0; j < 3; j++)
1845 CHECK_FIXNUM (AREF (val, j));
1846 }
1847 }
1848 return i;
1849 err:
1850 error ("Invalid glyph-string format");
1851 return -1;
1852}
1853
1854static void
1855check_otf_features (Lisp_Object otf_features)
1856{
1857 Lisp_Object val;
1858
1859 CHECK_CONS (otf_features);
1860 CHECK_SYMBOL (XCAR (otf_features));
1861 otf_features = XCDR (otf_features);
1862 CHECK_CONS (otf_features);
1863 CHECK_SYMBOL (XCAR (otf_features));
1864 otf_features = XCDR (otf_features);
1865 for (val = Fcar (otf_features); CONSP (val); val = XCDR (val))
1866 {
1867 CHECK_SYMBOL (XCAR (val));
1868 if (SBYTES (SYMBOL_NAME (XCAR (val))) > 4)
1869 error ("Invalid OTF GSUB feature: %s",
1870 SDATA (SYMBOL_NAME (XCAR (val))));
1871 }
1872 otf_features = XCDR (otf_features);
1873 for (val = Fcar (otf_features); CONSP (val); val = XCDR (val))
1874 {
1875 CHECK_SYMBOL (XCAR (val));
1876 if (SBYTES (SYMBOL_NAME (XCAR (val))) > 4)
1877 error ("Invalid OTF GPOS feature: %s",
1878 SDATA (SYMBOL_NAME (XCAR (val))));
1879 }
1880}
1881
1882#ifdef HAVE_LIBOTF
1883#include <otf.h>
1884
1885Lisp_Object otf_list;
1886
1887static Lisp_Object
1888otf_tag_symbol (OTF_Tag tag)
1889{
1890 char name[5];
1891
1892 OTF_tag_name (tag, name);
1893 return Fintern (make_unibyte_string (name, 4), Qnil);
1894}
1895
1896static OTF *
1897otf_open (Lisp_Object file)
1898{
1899 Lisp_Object val = Fassoc (file, otf_list, Qnil);
1900 OTF *otf;
1901
1902 if (! NILP (val))
1903 otf = xmint_pointer (XCDR (val));
1904 else
1905 {
1906 otf = STRINGP (file) ? OTF_open (SSDATA (file)) : NULL;
1907 val = make_mint_ptr (otf);
1908 otf_list = Fcons (Fcons (file, val), otf_list);
1909 }
1910 return otf;
1911}
1912
1913
1914/* Return a list describing which scripts/languages FONT supports by
1915 which GSUB/GPOS features of OpenType tables. See the comment of
1916 (struct font_driver).otf_capability. */
1917
1918Lisp_Object
1919font_otf_capability (struct font *font)
1920{
1921 OTF *otf;
1922 Lisp_Object capability = Fcons (Qnil, Qnil);
1923 int i;
1924
1925 otf = otf_open (font->props[FONT_FILE_INDEX]);
1926 if (! otf)
1927 return Qnil;
1928 for (i = 0; i < 2; i++)
1929 {
1930 OTF_GSUB_GPOS *gsub_gpos;
1931 Lisp_Object script_list = Qnil;
1932 int j;
1933
1934 if (OTF_get_features (otf, i == 0) < 0)
1935 continue;
1936 gsub_gpos = i == 0 ? otf->gsub : otf->gpos;
1937 for (j = gsub_gpos->ScriptList.ScriptCount - 1; j >= 0; j--)
1938 {
1939 OTF_Script *script = gsub_gpos->ScriptList.Script + j;
1940 Lisp_Object langsys_list = Qnil;
1941 Lisp_Object script_tag = otf_tag_symbol (script->ScriptTag);
1942 int k;
1943
1944 for (k = script->LangSysCount; k >= 0; k--)
1945 {
1946 OTF_LangSys *langsys;
1947 Lisp_Object feature_list = Qnil;
1948 Lisp_Object langsys_tag;
1949 int l;
1950
1951 if (k == script->LangSysCount)
1952 {
1953 langsys = &script->DefaultLangSys;
1954 langsys_tag = Qnil;
1955 }
1956 else
1957 {
1958 langsys = script->LangSys + k;
1959 langsys_tag
1960 = otf_tag_symbol (script->LangSysRecord[k].LangSysTag);
1961 }
1962 for (l = langsys->FeatureCount - 1; l >= 0; l--)
1963 {
1964 OTF_Feature *feature
1965 = gsub_gpos->FeatureList.Feature + langsys->FeatureIndex[l];
1966 Lisp_Object feature_tag
1967 = otf_tag_symbol (feature->FeatureTag);
1968
1969 feature_list = Fcons (feature_tag, feature_list);
1970 }
1971 langsys_list = Fcons (Fcons (langsys_tag, feature_list),
1972 langsys_list);
1973 }
1974 script_list = Fcons (Fcons (script_tag, langsys_list),
1975 script_list);
1976 }
1977
1978 if (i == 0)
1979 XSETCAR (capability, script_list);
1980 else
1981 XSETCDR (capability, script_list);
1982 }
1983
1984 return capability;
1985}
1986
1987/* Parse OTF features in SPEC and write a proper features spec string
1988 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
1989 assured that the sufficient memory has already allocated for
1990 FEATURES. */
1991
1992static void
1993generate_otf_features (Lisp_Object spec, char *features)
1994{
1995 Lisp_Object val;
1996 char *p;
1997 bool asterisk;
1998
1999 p = features;
2000 *p = '\0';
2001 for (asterisk = 0; CONSP (spec); spec = XCDR (spec))
2002 {
2003 val = XCAR (spec);
2004 CHECK_SYMBOL (val);
2005 if (p > features)
2006 *p++ = ',';
2007 if (SREF (SYMBOL_NAME (val), 0) == '*')
2008 {
2009 asterisk = 1;
2010 *p++ = '*';
2011 }
2012 else if (! asterisk)
2013 {
2014 val = SYMBOL_NAME (val);
2015 p += esprintf (p, "%s", SDATA (val));
2016 }
2017 else
2018 {
2019 val = SYMBOL_NAME (val);
2020 p += esprintf (p, "~%s", SDATA (val));
2021 }
2022 }
2023 if (CONSP (spec))
2024 error ("OTF spec too long");
2025}
2026
2027Lisp_Object
2028font_otf_DeviceTable (OTF_DeviceTable *device_table)
2029{
2030 int len = device_table->StartSize - device_table->EndSize + 1;
2031
2032 return Fcons (make_fixnum (len),
2033 make_unibyte_string (device_table->DeltaValue, len));
2034}
2035
2036Lisp_Object
2037font_otf_ValueRecord (int value_format, OTF_ValueRecord *value_record)
2038{
2039 Lisp_Object val = make_nil_vector (8);
2040
2041 if (value_format & OTF_XPlacement)
2042 ASET (val, 0, make_fixnum (value_record->XPlacement));
2043 if (value_format & OTF_YPlacement)
2044 ASET (val, 1, make_fixnum (value_record->YPlacement));
2045 if (value_format & OTF_XAdvance)
2046 ASET (val, 2, make_fixnum (value_record->XAdvance));
2047 if (value_format & OTF_YAdvance)
2048 ASET (val, 3, make_fixnum (value_record->YAdvance));
2049 if (value_format & OTF_XPlaDevice)
2050 ASET (val, 4, font_otf_DeviceTable (&value_record->XPlaDevice));
2051 if (value_format & OTF_YPlaDevice)
2052 ASET (val, 4, font_otf_DeviceTable (&value_record->YPlaDevice));
2053 if (value_format & OTF_XAdvDevice)
2054 ASET (val, 4, font_otf_DeviceTable (&value_record->XAdvDevice));
2055 if (value_format & OTF_YAdvDevice)
2056 ASET (val, 4, font_otf_DeviceTable (&value_record->YAdvDevice));
2057 return val;
2058}
2059
2060Lisp_Object
2061font_otf_Anchor (OTF_Anchor *anchor)
2062{
2063 Lisp_Object val = make_nil_vector (anchor->AnchorFormat + 1);
2064 ASET (val, 0, make_fixnum (anchor->XCoordinate));
2065 ASET (val, 1, make_fixnum (anchor->YCoordinate));
2066 if (anchor->AnchorFormat == 2)
2067 ASET (val, 2, make_fixnum (anchor->f.f1.AnchorPoint));
2068 else
2069 {
2070 ASET (val, 3, font_otf_DeviceTable (&anchor->f.f2.XDeviceTable));
2071 ASET (val, 4, font_otf_DeviceTable (&anchor->f.f2.YDeviceTable));
2072 }
2073 return val;
2074}
2075#endif /* HAVE_LIBOTF */
2076#endif /* 0 */
2077
2078
2079/* Font sorting. */ 1789/* Font sorting. */
2080 1790
2081static double 1791static double
@@ -4612,126 +4322,6 @@ DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0,
4612 return Fcons (font_object, INT_TO_INTEGER (code)); 4322 return Fcons (font_object, INT_TO_INTEGER (code));
4613} 4323}
4614 4324
4615#if 0
4616
4617DEFUN ("font-drive-otf", Ffont_drive_otf, Sfont_drive_otf, 6, 6, 0,
4618 doc: /* Apply OpenType features on glyph-string GSTRING-IN.
4619OTF-FEATURES specifies which features to apply in this format:
4620 (SCRIPT LANGSYS GSUB GPOS)
4621where
4622 SCRIPT is a symbol specifying a script tag of OpenType,
4623 LANGSYS is a symbol specifying a langsys tag of OpenType,
4624 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4625
4626If LANGSYS is nil, the default langsys is selected.
4627
4628The features are applied in the order they appear in the list. The
4629symbol `*' means to apply all available features not present in this
4630list, and the remaining features are ignored. For instance, (vatu
4631pstf * haln) is to apply vatu and pstf in this order, then to apply
4632all available features other than vatu, pstf, and haln.
4633
4634The features are applied to the glyphs in the range FROM and TO of
4635the glyph-string GSTRING-IN.
4636
4637If some feature is actually applicable, the resulting glyphs are
4638produced in the glyph-string GSTRING-OUT from the index INDEX. In
4639this case, the value is the number of produced glyphs.
4640
4641If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4642the value is 0.
4643
4644If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4645produced in GSTRING-OUT, and the value is nil.
4646
4647See the documentation of `composition-get-gstring' for the format of
4648glyph-string. */)
4649 (Lisp_Object otf_features, Lisp_Object gstring_in, Lisp_Object from, Lisp_Object to, Lisp_Object gstring_out, Lisp_Object index)
4650{
4651 Lisp_Object font_object = LGSTRING_FONT (gstring_in);
4652 Lisp_Object val;
4653 struct font *font;
4654 int len, num;
4655
4656 check_otf_features (otf_features);
4657 CHECK_FONT_OBJECT (font_object);
4658 font = XFONT_OBJECT (font_object);
4659 if (! font->driver->otf_drive)
4660 error ("Font backend %s can't drive OpenType GSUB table",
4661 SDATA (SYMBOL_NAME (font->driver->type)));
4662 CHECK_CONS (otf_features);
4663 CHECK_SYMBOL (XCAR (otf_features));
4664 val = XCDR (otf_features);
4665 CHECK_SYMBOL (XCAR (val));
4666 val = XCDR (otf_features);
4667 if (! NILP (val))
4668 CHECK_CONS (val);
4669 len = check_gstring (gstring_in);
4670 CHECK_VECTOR (gstring_out);
4671 CHECK_FIXNAT (from);
4672 CHECK_FIXNAT (to);
4673 CHECK_FIXNAT (index);
4674
4675 if (XFIXNUM (from) >= XFIXNUM (to) || XFIXNUM (to) > len)
4676 args_out_of_range_3 (from, to, make_fixnum (len));
4677 if (XFIXNUM (index) >= ASIZE (gstring_out))
4678 args_out_of_range (index, make_fixnum (ASIZE (gstring_out)));
4679 num = font->driver->otf_drive (font, otf_features,
4680 gstring_in, XFIXNUM (from), XFIXNUM (to),
4681 gstring_out, XFIXNUM (index), 0);
4682 if (num < 0)
4683 return Qnil;
4684 return make_fixnum (num);
4685}
4686
4687DEFUN ("font-otf-alternates", Ffont_otf_alternates, Sfont_otf_alternates,
4688 3, 3, 0,
4689 doc: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4690OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4691in this format:
4692 (SCRIPT LANGSYS FEATURE ...)
4693See the documentation of `font-drive-otf' for more detail.
4694
4695The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4696where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4697character code corresponding to the glyph or nil if there's no
4698corresponding character. */)
4699 (Lisp_Object font_object, Lisp_Object character, Lisp_Object otf_features)
4700{
4701 struct font *font = CHECK_FONT_GET_OBJECT (font_object);
4702 Lisp_Object gstring_in, gstring_out, g;
4703 Lisp_Object alternates;
4704 int i, num;
4705
4706 if (! font->driver->otf_drive)
4707 error ("Font backend %s can't drive OpenType GSUB table",
4708 SDATA (SYMBOL_NAME (font->driver->type)));
4709 CHECK_CHARACTER (character);
4710 CHECK_CONS (otf_features);
4711
4712 gstring_in = Ffont_make_gstring (font_object, make_fixnum (1));
4713 g = LGSTRING_GLYPH (gstring_in, 0);
4714 LGLYPH_SET_CHAR (g, XFIXNUM (character));
4715 gstring_out = Ffont_make_gstring (font_object, make_fixnum (10));
4716 while ((num = font->driver->otf_drive (font, otf_features, gstring_in, 0, 1,
4717 gstring_out, 0, 1)) < 0)
4718 gstring_out = Ffont_make_gstring (font_object,
4719 make_fixnum (ASIZE (gstring_out) * 2));
4720 alternates = Qnil;
4721 for (i = 0; i < num; i++)
4722 {
4723 Lisp_Object g = LGSTRING_GLYPH (gstring_out, i);
4724 int c = LGLYPH_CHAR (g);
4725 unsigned code = LGLYPH_CODE (g);
4726
4727 alternates = Fcons (Fcons (make_fixnum (code),
4728 c > 0 ? make_fixnum (c) : Qnil),
4729 alternates);
4730 }
4731 return Fnreverse (alternates);
4732}
4733#endif /* 0 */
4734
4735#ifdef FONT_DEBUG 4325#ifdef FONT_DEBUG
4736 4326
4737DEFUN ("open-font", Fopen_font, Sopen_font, 1, 3, 0, 4327DEFUN ("open-font", Fopen_font, Sopen_font, 1, 3, 0,
@@ -4996,47 +4586,6 @@ character at index specified by POSITION. */)
4996 return font_at (-1, XFIXNUM (position), NULL, w, string); 4586 return font_at (-1, XFIXNUM (position), NULL, w, string);
4997} 4587}
4998 4588
4999#if 0
5000DEFUN ("draw-string", Fdraw_string, Sdraw_string, 2, 2, 0,
5001 doc: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
5002The value is a number of glyphs drawn.
5003Type C-l to recover what previously shown. */)
5004 (Lisp_Object font_object, Lisp_Object string)
5005{
5006 Lisp_Object frame = selected_frame;
5007 struct frame *f = XFRAME (frame);
5008 struct font *font;
5009 struct face *face;
5010 int i, len, width;
5011 unsigned *code;
5012
5013 CHECK_FONT_GET_OBJECT (font_object, font);
5014 CHECK_STRING (string);
5015 len = SCHARS (string);
5016 code = alloca (sizeof (unsigned) * len);
5017 for (i = 0; i < len; i++)
5018 {
5019 Lisp_Object ch = Faref (string, make_fixnum (i));
5020 Lisp_Object val;
5021 int c = XFIXNUM (ch);
5022
5023 code[i] = font->driver->encode_char (font, c);
5024 if (code[i] == FONT_INVALID_CODE)
5025 break;
5026 }
5027 face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
5028 face->fontp = font;
5029 if (font->driver->prepare_face)
5030 font->driver->prepare_face (f, face);
5031 width = font->driver->text_extents (font, code, i, NULL);
5032 len = font->driver->draw_text (f, face, 0, font->ascent, code, i, width);
5033 if (font->driver->done_face)
5034 font->driver->done_face (f, face);
5035 face->fontp = NULL;
5036 return make_fixnum (len);
5037}
5038#endif
5039
5040DEFUN ("frame-font-cache", Fframe_font_cache, Sframe_font_cache, 0, 1, 0, 4589DEFUN ("frame-font-cache", Fframe_font_cache, Sframe_font_cache, 0, 1, 0,
5041 doc: /* Return FRAME's font cache. Mainly used for debugging. 4590 doc: /* Return FRAME's font cache. Mainly used for debugging.
5042If FRAME is omitted or nil, use the selected frame. */) 4591If FRAME is omitted or nil, use the selected frame. */)
@@ -5359,13 +4908,6 @@ syms_of_font (void)
5359 Vfont_log_deferred = make_nil_vector (3); 4908 Vfont_log_deferred = make_nil_vector (3);
5360 staticpro (&Vfont_log_deferred); 4909 staticpro (&Vfont_log_deferred);
5361 4910
5362#if 0
5363#ifdef HAVE_LIBOTF
5364 staticpro (&otf_list);
5365 otf_list = Qnil;
5366#endif /* HAVE_LIBOTF */
5367#endif /* 0 */
5368
5369 defsubr (&Sfontp); 4911 defsubr (&Sfontp);
5370 defsubr (&Sfont_spec); 4912 defsubr (&Sfont_spec);
5371 defsubr (&Sfont_get); 4913 defsubr (&Sfont_get);
@@ -5381,10 +4923,6 @@ syms_of_font (void)
5381 defsubr (&Sfont_shape_gstring); 4923 defsubr (&Sfont_shape_gstring);
5382 defsubr (&Sfont_variation_glyphs); 4924 defsubr (&Sfont_variation_glyphs);
5383 defsubr (&Sinternal_char_font); 4925 defsubr (&Sinternal_char_font);
5384#if 0
5385 defsubr (&Sfont_drive_otf);
5386 defsubr (&Sfont_otf_alternates);
5387#endif /* 0 */
5388 4926
5389#ifdef FONT_DEBUG 4927#ifdef FONT_DEBUG
5390 defsubr (&Sopen_font); 4928 defsubr (&Sopen_font);
@@ -5393,9 +4931,6 @@ syms_of_font (void)
5393 defsubr (&Sfont_get_glyphs); 4931 defsubr (&Sfont_get_glyphs);
5394 defsubr (&Sfont_match_p); 4932 defsubr (&Sfont_match_p);
5395 defsubr (&Sfont_at); 4933 defsubr (&Sfont_at);
5396#if 0
5397 defsubr (&Sdraw_string);
5398#endif
5399 defsubr (&Sframe_font_cache); 4934 defsubr (&Sframe_font_cache);
5400#endif /* FONT_DEBUG */ 4935#endif /* FONT_DEBUG */
5401#ifdef HAVE_WINDOW_SYSTEM 4936#ifdef HAVE_WINDOW_SYSTEM