diff src/fontset.c @ 17052:d0d7b244b1d0

Initial revision
author Karl Heuer <kwzh@gnu.org>
date Thu, 20 Feb 1997 07:02:49 +0000
parents
children 70194012fb3a
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/fontset.c	Thu Feb 20 07:02:49 1997 +0000
@@ -0,0 +1,819 @@
+/* Fontset handler.
+   Ver.1.0
+
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU General Public License as published by
+   the Free Software Foundation; either version 2, or (at your option)
+   any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   along with this program; if not, write to the Free Software
+   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.  */
+
+#include <config.h>
+#if HAVE_ALLOCA_H
+#include <alloca.h>
+#endif /* HAVE_ALLOCA_H */ 
+#include "lisp.h"
+#include "charset.h"
+#include "ccl.h"
+#include "fontset.h"
+#include "frame.h"
+
+Lisp_Object Vglobal_fontset_alist;
+
+Lisp_Object Vfont_encoding_alist;
+
+/* We had better have our own strcasecmp function because some system
+   doesn't have it.  */
+static char my_strcasetbl[256];
+
+/* Compare two strings S0 and S1 while ignoring differences in case.
+   Return 1 if they differ, else return 0.  */
+static int
+my_strcasecmp (s0, s1)
+     unsigned char *s0, *s1;
+{
+  while (*s0)
+    if (my_strcasetbl[*s0++] != my_strcasetbl[*s1++]) return 1;
+  return (int) *s1;
+}
+
+/* The following six are window system dependent functions.  See
+   the comments in src/fontset.h for more detail.  */
+
+/* Return a pointer to struct font_info of font FONT_IDX of frame F.  */
+struct font_info *(*get_font_info_func) (/* FRAME_PTR f; int font_idx */);
+
+/* Return a list of font names which matches PATTERN.  See the document of
+   `x-list-fonts' for more detail.  */
+Lisp_Object (*list_fonts_func) (/* Lisp_Object pattern, face, frame, width */);
+
+/* Load a font named NAME for frame F and return a pointer to the
+   information of the loaded font.  If loading is failed, return 0.  */
+struct font_info *(*load_font_func) (/* FRAME_PTR f; char *name */);
+
+/* Return a pointer to struct font_info of a font named NAME for frame F.  */
+struct font_info *(*query_font_func) (/* FRAME_PTR f; char *name */);
+
+/* Additional function for setting fontset or changing fontset
+   contents of frame F.  */
+void (*set_frame_fontset_func) (/* FRAME_PTR f; Lisp_Object arg, oldval */);
+
+/* Check if any window system is used now.  */
+void (*check_window_system_func) ();
+
+struct fontset_data *
+alloc_fontset_data ()
+{
+  struct fontset_data *fontset_data
+    = (struct fontset_data *) xmalloc (sizeof (struct fontset_data));
+
+  bzero (fontset_data, sizeof (struct fontset_data));
+
+  return fontset_data;
+}
+
+void
+free_fontset_data (fontset_data)
+     struct fontset_data *fontset_data;
+{
+  int i;
+
+  for (i = 0; i < fontset_data->n_fontsets; i++)
+    {
+      int j;
+
+      xfree (fontset_data->fontset_table[i]->name);
+      for (j = 0; j < MAX_CHARSET; j++)
+	if (fontset_data->fontset_table[i]->fontname[j])
+	  xfree (fontset_data->fontset_table[i]->fontname[j]);
+      xfree (fontset_data->fontset_table[i]);
+    }
+  xfree (fontset_data->fontset_table);
+
+  xfree (fontset_data);
+}
+
+/* Load a font named FONTNAME for displaying CHARSET on frame F.
+   All fonts for frame F is stored in a table pointed by FONT_TABLE.
+   Return a pointer to the struct font_info of the loaded font.
+   If loading fails, return 0;
+   If FONTNAME is NULL, the name is taken from the information of FONTSET.
+   If FONTSET is given, try to load a font whose size matches that of
+   FONTSET, and, the font index is stored in the table for FONTSET.  */
+
+struct font_info *
+fs_load_font (f, font_table, charset, fontname, fontset)
+     FRAME_PTR f;
+     struct font_info *font_table;
+     int charset, fontset;
+     char *fontname;
+{
+  Lisp_Object font_list;
+  Lisp_Object list, elt;
+  int font_idx;
+  int size = 0;
+  struct fontset_info *fontsetp = 0;
+  struct font_info *fontp;
+
+  if (fontset >= 0 && fontset < FRAME_FONTSET_DATA (f)->n_fontsets)
+    {
+      fontsetp = FRAME_FONTSET_DATA (f)->fontset_table[fontset];
+      font_idx = fontsetp->font_indexes[charset];
+      if (font_idx >= 0)
+	/* We have already loaded a font.  */
+	return font_table + font_idx;
+      else if (font_idx == FONT_NOT_FOUND)
+	/* We have already tried loading a font and failed.  */
+	return 0;
+      if (!fontname)
+	fontname = fontsetp->fontname[charset];
+    }
+
+  if (!fontname)
+    /* No way to get fontname.  */
+    return 0;
+
+  /* If a fontset is specified and we have already loaded some fonts
+     in the fontset, we need a font of appropriate size to be used
+     with the fonts.  */
+  if (fontsetp && fontsetp->size)
+    size = fontsetp->size * CHARSET_WIDTH (charset);
+
+  fontp = (*load_font_func) (f, fontname, size);
+
+  if (!fontp)
+    {
+      if (fontsetp)
+	fontsetp->font_indexes[charset] = FONT_NOT_FOUND;
+      return 0;
+    }
+
+  /* Fill in fields (CHARSET, ENCODING, and FONT_ENCODER) which are
+     not set by (*load_font_func).  */
+  fontp->charset = charset;
+
+  if (fontp->encoding[1] >= 0)
+    {
+      /* The font itself tells which code points to be used.  Use this
+	 encoding for all other charsets.  */
+      int i;
+
+      fontp->encoding[0] = fontp->encoding[1];
+      for (i = MIN_CHARSET_OFFICIAL_DIMENSION1; i < MAX_CHARSET; i++)
+	fontp->encoding[i] = fontp->encoding[1];
+    }
+  else
+    {
+      /* The font itself doesn't tell which code points to be used.  */
+      int i;
+
+      /* At first, set 1 (means 0xA0..0xFF) as the default.  */
+      fontp->encoding[0] = 1;
+      for (i = MIN_CHARSET_OFFICIAL_DIMENSION1; i < MAX_CHARSET; i++)
+	fontp->encoding[i] = 1;
+      /* Then override them by a specification in Vfont_encoding_alist.  */
+      for (list = Vfont_encoding_alist; CONSP (list); list = XCONS (list)->cdr)
+	{
+	  elt = XCONS (list)->car;
+	  if (CONSP (elt)
+	      && STRINGP (XCONS (elt)->car) && CONSP (XCONS (elt)->cdr)
+	      && (fast_string_match_ignore_case (XCONS (elt)->car, fontname)
+		  >= 0))
+	    {
+	      Lisp_Object tmp;
+
+	      for (tmp = XCONS (elt)->cdr; CONSP (tmp); tmp = XCONS (tmp)->cdr)
+		if (CONSP (XCONS (tmp)->car)
+		    && INTEGERP (XCONS (XCONS (tmp)->car)->car)
+		    && ((i = get_charset_id (XCONS (XCONS (tmp)->car)->car))
+			>= 0)
+		    && INTEGERP (XCONS (XCONS (tmp)->car)->cdr)
+		    && XFASTINT (XCONS (XCONS (tmp)->car)->cdr) < 4)
+		  fontp->encoding[i]
+		    = XFASTINT (XCONS (XCONS (tmp)->car)->cdr);
+	    }
+	}
+    }
+
+  fontp->font_encoder = (struct ccl_program *) 0;
+  for (list = Vfont_ccl_encoder_alist; CONSP (list); list = XCONS (list)->cdr)
+    {
+      elt = XCONS (list)->car;
+      if (CONSP (elt)
+	  && STRINGP (XCONS (elt)->car) && VECTORP (XCONS (elt)->cdr)
+	  && fast_string_match_ignore_case (XCONS (elt)->car, fontname) >= 0)
+	{
+	  fontp->font_encoder
+	    = (struct ccl_program *) xmalloc (sizeof (struct ccl_program));
+	  setup_ccl_program (fontp->font_encoder, XCONS (elt)->cdr);
+	  break;
+	}
+    }
+
+  if (fontsetp)
+    {
+      fontsetp->font_indexes[charset] = fontp->font_idx;
+      if (fontsetp->size == 0)
+	fontsetp->size = fontp->size / CHARSET_WIDTH (charset);
+
+      if (charset == CHARSET_ASCII
+	  && fontsetp->size != fontp->size)
+	{
+	  /* When loading ASCII font of the different size from the
+	     size of FONTSET, we have to update the size of FONTSET.
+	     Since changing the size of FONTSET may make some fonts
+	     already loaded inappropriate to be used in FONTSET, we
+	     must delete the record of such fonts.  In that case, we
+	     also have to calculate the height of FONTSET from the
+	     remaining fonts.  */
+	  int i;
+
+	  fontsetp->size = fontp->size;
+	  fontsetp->height = fontp->height;
+	  for (i = CHARSET_ASCII + 1; i < MAX_CHARSET; i++)
+	    {
+	      font_idx = fontsetp->font_indexes[i];
+	      if (font_idx >= 0)
+		{
+		  struct font_info *fontp2 = font_table + font_idx;
+
+		  if (fontp2->size != fontp->size * CHARSET_WIDTH (i))
+		    fontsetp->font_indexes[i] = FONT_NOT_OPENED;
+		  else if (fontsetp->height < fontp->height)
+		    fontsetp->height = fontp->height;
+		}
+	    }
+	}
+      else if (fontsetp->height < fontp->height)
+	fontsetp->height = fontp->height;
+    }
+
+  return fontp;
+}
+
+/* Return ID of the fontset named NAME on frame F.  */
+
+int
+fs_query_fontset (f, name)
+     FRAME_PTR f;
+     char *name;
+{
+  struct fontset_data *fontset_data = FRAME_FONTSET_DATA (f);
+  int i;
+
+  for (i = 0; i < fontset_data->n_fontsets; i++)
+    if (!my_strcasecmp(name, fontset_data->fontset_table[i]->name))
+      return i;
+  return -1;
+}
+
+/* Register a fontset specified by FONTSET_INFO for frame FRAME.
+   Return the fontset ID if successfully registered, else return -1.
+   FONTSET_INFO is a cons of name of the fontset and FONTLIST, where
+   FONTLIST is an alist of charsets vs fontnames.  */
+
+int
+fs_register_fontset (f, fontset_info)
+     FRAME_PTR f;
+     Lisp_Object fontset_info;
+{
+  struct fontset_data *fontset_data = FRAME_FONTSET_DATA (f);
+  Lisp_Object name, fontlist;
+  int fontset;
+  struct fontset_info *fontsetp;
+  int i;
+
+  if (!CONSP (fontset_info)
+      || !STRINGP (XCONS (fontset_info)->car)
+      || !CONSP (XCONS (fontset_info)->cdr))
+    /* Invalid data in FONTSET_INFO.  */
+    return -1;
+
+  name = XCONS (fontset_info)->car;
+  if ((fontset = fs_query_fontset (f, XSTRING (name)->data)) >= 0)
+    /* This fontset already exists on frame F.  */
+    return fontset;
+
+  fontsetp = (struct fontset_info *) xmalloc (sizeof (struct fontset_info));
+
+  fontsetp->name = (char *) xmalloc (XSTRING (name)->size + 1);
+  bcopy(XSTRING (name)->data, fontsetp->name, XSTRING (name)->size + 1);
+
+  fontsetp->size = fontsetp->height = 0;
+
+  for (i = 0; i < MAX_CHARSET; i++)
+    {
+      fontsetp->fontname[i] = (char *) 0;
+      fontsetp->font_indexes[i] = FONT_NOT_OPENED;
+    }
+
+  for (fontlist = XCONS (fontset_info)->cdr; CONSP (fontlist);
+       fontlist = XCONS (fontlist)->cdr)
+    {
+      Lisp_Object tem = Fcar (fontlist);
+      int charset;
+
+      if (CONSP (tem)
+	  && (charset = get_charset_id (XCONS (tem)->car)) >= 0
+	  && STRINGP (XCONS (tem)->cdr))
+	{
+	  fontsetp->fontname[charset]
+	     = (char *) xmalloc (XSTRING (XCONS (tem)->cdr)->size + 1);
+	  bcopy (XSTRING (XCONS (tem)->cdr)->data,
+		 fontsetp->fontname[charset],
+		 XSTRING (XCONS (tem)->cdr)->size + 1);
+	}
+      else
+	/* Broken or invalid data structure.  */
+	return -1;
+    }
+
+  /* Do we need to create the table?  */
+  if (fontset_data->fontset_table_size == 0)
+    {
+      fontset_data->fontset_table_size = 8;
+      fontset_data->fontset_table
+	= (struct fontset_info **) xmalloc (fontset_data->fontset_table_size
+					    * sizeof (struct fontset_info *));
+    }
+  /* Do we need to grow the table?  */
+  else if (fontset_data->n_fontsets >= fontset_data->fontset_table_size)
+    {
+      fontset_data->fontset_table_size += 8;
+      fontset_data->fontset_table
+	= (struct fontset_info **) xrealloc (fontset_data->fontset_table,
+					     fontset_data->fontset_table_size
+					     * sizeof (struct fontset_info *));
+    }
+  fontset = fontset_data->n_fontsets++;
+  fontset_data->fontset_table[fontset] = fontsetp;
+
+  return fontset;
+}
+
+/* Cache data used by fontset_pattern_regexp.  The car part is a
+   pattern string containing at least one wild card, the cdr part is
+   the corresponding regular expression.  */
+static Lisp_Object Vcached_fontset_data;
+
+#define CACHED_FONTSET_NAME (XSTRING (XCONS (Vcached_fontset_data)->car)->data)
+#define CACHED_FONTSET_REGEX (XCONS (Vcached_fontset_data)->cdr)
+
+/* If fontset name PATTERN contains any wild card, return regular
+   expression corresponding to PATTERN.  */
+
+Lisp_Object
+fontset_pattern_regexp (pattern)
+     Lisp_Object pattern;
+{
+  int nickname = 0;
+
+  if (!index (XSTRING (pattern)->data, '*')
+      && !index (XSTRING (pattern)->data, '?'))
+    /* PATTERN does not contain any wild cards.  */
+    {
+      if (XSTRING (pattern)->size > 8
+	  && ! bcmp (XSTRING (pattern)->data, "fontset-", 8))
+	/* Just a nickname of a fontset is specified.  */
+	nickname = 1;
+      else
+	return Qnil;
+    }
+
+  if (!CONSP (Vcached_fontset_data)
+      || strcmp (XSTRING (pattern)->data, CACHED_FONTSET_NAME))
+    {
+      /* We must at first update the cached data.  */
+      char *regex = (char *) alloca (XSTRING (pattern)->size * 2 + 3);
+      char *p0, *p1 = regex;
+
+      if (nickname)
+	{
+	  /* Just prepend ".*-" to PATTERN.  */
+	  *p1++= '.'; *p1++= '*', *p1++= '-';
+	  bcopy (XSTRING (pattern)->data, p1, XSTRING (pattern)->size);
+	  p1 += XSTRING (pattern)->size;
+	}
+      else
+	{
+	  /* Convert "*" to ".*", "?" to ".".  */
+	  *p1++ = '^';
+	  for (p0 = XSTRING (pattern)->data; *p0; p0++)
+	    {
+	      if (*p0 == '*')
+		{
+		  *p1++ = '.';
+		  *p1++ = '*';
+		}
+	      else if (*p0 == '?')
+		*p1++ == '.';
+	      else
+		*p1++ = *p0;
+	    }
+	}
+      *p1++ = '$';
+      *p1++ = 0;
+
+      Vcached_fontset_data = Fcons (build_string (XSTRING (pattern)->data),
+				    build_string (regex));
+    }
+
+  return CACHED_FONTSET_REGEX;
+}
+
+DEFUN ("query-fontset", Fquery_fontset, Squery_fontset, 1, 1, 0,
+  "Return a fontset name which matches PATTERN, nil if no matching fontset.\n\
+PATTERN can contain `*' or `?' as a wild card\n\
+just like X's font name matching algorithm allows.")
+  (pattern)
+     Lisp_Object pattern;
+{
+  Lisp_Object regexp, tem;
+
+  (*check_window_system_func) ();
+
+  CHECK_STRING (pattern, 0);
+
+  if (XSTRING (pattern)->size == 0)
+    return Qnil;
+
+  regexp = fontset_pattern_regexp (pattern);
+
+  for (tem = Vglobal_fontset_alist; CONSP (tem); tem = XCONS (tem)->cdr)
+    {
+      Lisp_Object fontset_name = XCONS (XCONS (tem)->car)->car;
+      if (!NILP (regexp))
+	{
+	  if (fast_string_match_ignore_case (regexp,
+					     XSTRING (fontset_name)->data)
+	      >= 0)
+	    return fontset_name;
+	}
+      else
+	{
+	  if (!my_strcasecmp (XSTRING (pattern)->data,
+			      XSTRING (fontset_name)->data))
+	    return fontset_name;
+	}
+    }
+
+  return Qnil;
+}
+
+Lisp_Object Fframe_char_width ();
+
+/* Return a list of names of available fontsets matching PATTERN on
+   frame F.  If SIZE is not 0, it is the size (maximum bound width) of
+   fontsets to be listed. */
+
+Lisp_Object
+list_fontsets (f, pattern, size)
+     FRAME_PTR f;
+     Lisp_Object pattern;
+     int size;
+{
+  int i;
+  Lisp_Object regexp, val;
+
+  regexp = fontset_pattern_regexp (pattern);
+
+  val = Qnil;
+  for (i = 0; i < FRAME_FONTSET_DATA (f)->n_fontsets; i++)
+    {
+      struct fontset_info *fontsetp = FRAME_FONTSET_DATA (f)->fontset_table[i];
+      int name_matched = 0;
+      int size_matched = 0;
+
+      if (!NILP (regexp))
+	{
+	  if (fast_string_match_ignore_case (regexp, fontsetp->name) >= 0)
+	    name_matched = 1;
+	}
+      else
+	{
+	  if (!my_strcasecmp (XSTRING (pattern)->data, fontsetp->name))
+	    name_matched = 1;	  
+	}
+
+      if (name_matched)
+	{
+	  if (!size || fontsetp->size == size)
+	    size_matched = 1;
+	  else if (fontsetp->size == 0)
+	    {
+	      /* No font of this fontset has loaded yet.  Try loading
+		 one with SIZE.  */
+	      int j;
+
+	      for (j = 0; j < MAX_CHARSET; j++)
+		if (fontsetp->fontname[j])
+		  {
+		    if ((*load_font_func) (f, fontsetp->fontname[j], size))
+		      size_matched = 1;
+		    break;
+		  }
+	    }
+
+	  if (size_matched)
+	    val = Fcons (build_string (fontsetp->name), val);
+	}
+    }
+
+  return val;
+}
+
+DEFUN ("new-fontset", Fnew_fontset, Snew_fontset, 2, 2, 0,
+  "Create a new fontset NAME which contains fonts in FONTLIST.\n\
+FONTLIST is an alist of charsets vs corresponding font names.")
+  (name, fontlist)
+     Lisp_Object name, fontlist;
+{
+  Lisp_Object fullname, fontset_info;
+  Lisp_Object tail;
+
+  (*check_window_system_func) ();
+
+  CHECK_STRING (name, 0);
+  CHECK_LIST (fontlist, 1);
+
+  fullname = Fquery_fontset (name);
+  if (!NILP (fullname))
+    error ("Fontset \"%s\" matches the existing fontset \"%s\"",
+	   XSTRING (name)->data, XSTRING (fullname)->data);
+
+  /* Check the validity of FONTLIST.  */
+  for (tail = fontlist; CONSP (tail); tail = XCONS (tail)->cdr)
+    {
+      Lisp_Object tem = XCONS (tail)->car;
+      int charset;
+
+      if (!CONSP (tem)
+	  || (charset = get_charset_id (XCONS (tem)->car)) < 0
+	  || !STRINGP (XCONS (tem)->cdr))
+	error ("Elements of fontlist must be a cons of charset and font name");
+    }
+
+  fontset_info = Fcons (name, fontlist);
+  Vglobal_fontset_alist  = Fcons (fontset_info, Vglobal_fontset_alist);
+
+  /* Register this fontset for all existing frames.  */
+  {
+    Lisp_Object framelist, frame;
+    
+    FOR_EACH_FRAME (framelist, frame)
+      if (!FRAME_TERMCAP_P (XFRAME (frame)))
+	fs_register_fontset (XFRAME (frame), fontset_info);
+  }
+
+  return Qnil;
+}
+
+extern Lisp_Object Fframe_parameters ();
+extern Lisp_Object Qfont;
+Lisp_Object Qfontset;
+
+DEFUN ("set-fontset-font", Fset_fontset_font, Sset_fontset_font, 3, 4, 0,
+  "Set FONTNAME for a font of CHARSET in fontset NAME on frame FRAME.\n\
+If FRAME is omitted or nil, all frames are affected.")
+  (name, charset_symbol, fontname, frame)
+     Lisp_Object name, charset_symbol, fontname, frame;
+{
+  int charset;
+  Lisp_Object fullname, fontlist;
+
+  (*check_window_system_func) ();
+
+  CHECK_STRING (name, 0);
+  CHECK_SYMBOL (charset_symbol, 1);
+  CHECK_STRING (fontname, 2);
+  if (!NILP (frame))
+    CHECK_LIVE_FRAME (frame, 3);
+
+  if ((charset = get_charset_id (charset_symbol)) < 0)
+    error ("Invalid charset: %s", XSYMBOL (charset_symbol)->name->data);
+
+  fullname = Fquery_fontset (name);
+  if (NILP (fullname))
+    error ("Fontset \"%s\" does not exist", XSTRING (name)->data);
+
+  /* If FRAME is not specified, we must, at first, update contents of
+     `global-fontset-alist' for a frame created in the future.  */
+  if (NILP (frame))
+    {
+      Lisp_Object fontset_info = Fassoc (fullname, Vglobal_fontset_alist);
+      Lisp_Object tem = Fassq (charset, XCONS (fontset_info)->cdr);
+
+      if (NILP (tem))
+	XCONS (fontset_info)->cdr
+	  = Fcons (Fcons (charset, fontname), XCONS (fontset_info)->cdr);
+      else
+	XCONS (tem)->cdr = fontname;
+    }
+
+  /* Then, update information in the specified frame or all existing
+     frames.  */
+  {
+    Lisp_Object framelist, tem;
+
+    FOR_EACH_FRAME (framelist, tem)
+      if (!FRAME_TERMCAP_P (XFRAME (tem))
+	  && (NILP (frame) || EQ (frame, tem)))
+	{
+	  FRAME_PTR f = XFRAME (tem);
+	  int fontset = fs_query_fontset (f, XSTRING (fullname)->data);
+	  struct fontset_info *fontsetp
+	    = FRAME_FONTSET_DATA (f)->fontset_table[fontset];
+
+	  if (fontsetp->fontname[XINT (charset)])
+	    xfree (fontsetp->fontname[XINT (charset)]);
+	  fontsetp->fontname[XINT (charset)]
+	    = (char *) xmalloc (XSTRING (fontname)->size + 1);
+	  bcopy (XSTRING (fontname)->data, fontsetp->fontname[XINT (charset)],
+		 XSTRING (fontname)->size + 1);
+	  fontsetp->font_indexes[XINT (charset)] = FONT_NOT_OPENED;
+
+	  if (charset == CHARSET_ASCII)
+	    {
+	      Lisp_Object font_param = Fassq (Qfont, Fframe_parameters (tem));
+
+	      if (set_frame_fontset_func
+		  && !NILP (font_param)
+		  && !strcmp (XSTRING (fullname)->data,
+			      XSTRING (XCONS (font_param)->cdr)->data))
+		/* This fontset is the default fontset on frame TEM.
+		   We may have to resize this frame because of new
+		   ASCII font.  */
+		(*set_frame_fontset_func) (f, fullname, Qnil);
+	    }
+	}
+  }
+
+  return Qnil;
+}
+
+DEFUN ("font-info", Ffont_info, Sfont_info, 1, 2, 0,
+  "Return information about a font named NAME on frame FRAME.\n\
+If FRAME is omitted or nil, use the selected frame.\n\
+The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,\n\
+  HEIGHT, BASELINE-OFFSET, and RELATIVE-COMPOSE,\n\
+where\n\
+  OPENED-NAME is the name used for opening the font,\n\
+  FULL-NAME is the full name of the font,\n\
+  CHARSET is the charset displayed by the font,\n\
+  SIZE is the minimum bound width of the font,\n\
+  HEIGHT is the height of the font,\n\
+  BASELINE-OFFSET is the upward offset pixels from ASCII baseline,\n\
+  RELATIVE-COMPOSE is the number controlling how to compose characters.\n\
+If the named font is not yet loaded, return nil.")
+  (name, frame)
+     Lisp_Object name, frame;
+{
+  FRAME_PTR f;
+  struct font_info *fontp;
+  Lisp_Object info;
+
+  (*check_window_system_func) ();
+
+  CHECK_STRING (name, 0);
+  if (NILP (frame))
+    f = selected_frame;
+  else
+    {
+      CHECK_LIVE_FRAME (frame, 1);
+      f = XFRAME (frame);
+    }
+
+  if (!query_font_func)
+    error ("Font query function is not supported");
+
+  fontp = (*query_font_func) (f, XSTRING (name)->data);
+  if (!fontp)
+    return Qnil;
+
+  info = Fmake_vector (make_number (6), Qnil);
+
+  XVECTOR (info)->contents[0] = build_string (fontp->name);
+  XVECTOR (info)->contents[1] = build_string (fontp->full_name);
+  XVECTOR (info)->contents[2] = CHARSET_SYMBOL (fontp->charset);
+  XVECTOR (info)->contents[3] = make_number (fontp->size);
+  XVECTOR (info)->contents[4] = make_number (fontp->height);
+  XVECTOR (info)->contents[5] = make_number (fontp->baseline_offset);
+  XVECTOR (info)->contents[6] = make_number (fontp->relative_compose);
+
+  return info;
+}
+
+DEFUN ("fontset-info", Ffontset_info, Sfontset_info, 1, 2, 0,
+  "Return information about a fontset named NAME on frame FRAME.\n\
+If FRAME is omitted or nil, use the selected frame.\n\
+The returned value is a vector of SIZE, HEIGHT, and FONT-LIST,\n\
+where\n\
+  SIZE is the minimum bound width of ASCII font of the fontset,\n\
+  HEIGHT is the height of the tallest font in the fontset, and\n\
+  FONT-LIST is an alist of the format:\n\
+    (CHARSET REQUESTED-FONT-NAME LOADED-FONT-NAME).\n\
+LOADED-FONT-NAME t means the font is not yet loaded, nil means the\n\
+loading failed.")
+  (name, frame)
+     Lisp_Object name, frame;
+{
+  FRAME_PTR f;
+  int fontset;
+  struct fontset_info *fontsetp;
+  Lisp_Object info, val;
+  int i;
+  
+  (*check_window_system_func) ();
+
+  CHECK_STRING(name, 0);
+  if (NILP (frame))
+    f = selected_frame;
+  else
+    {
+      CHECK_LIVE_FRAME (frame, 1);
+      f = XFRAME (frame);
+    }
+
+  fontset = fs_query_fontset (f, XSTRING (name)->data);
+  if (fontset < 0)
+    error ("Fontset \"%s\" does not exist", XSTRING (name)->data);
+
+  info = Fmake_vector (make_number (3), Qnil);
+
+  fontsetp = FRAME_FONTSET_DATA (f)->fontset_table[fontset];
+
+  XVECTOR (info)->contents[0] = make_number (fontsetp->size);
+  XVECTOR (info)->contents[1] = make_number (fontsetp->height);
+  val = Qnil;
+  for (i = 0; i < MAX_CHARSET; i++)
+    if (fontsetp->fontname[i])
+      {
+	int font_idx = fontsetp->font_indexes[i];
+	Lisp_Object loaded;
+
+	if (font_idx == FONT_NOT_OPENED)
+	  loaded = Qt;
+	else if (font_idx == FONT_NOT_FOUND)
+	  loaded = Qnil;
+	else
+	  loaded
+	    = build_string ((*get_font_info_func) (f, font_idx)->full_name);
+	val = Fcons (Fcons (CHARSET_SYMBOL (i),
+			    Fcons (build_string (fontsetp->fontname[i]),
+				   Fcons (loaded, Qnil))),
+		     val);
+      }
+  XVECTOR (info)->contents[2] = val;
+  return info;
+}
+
+syms_of_fontset ()
+{
+  int i;
+
+  for (i = 0; i < 256; i++)
+    my_strcasetbl[i] = (i >= 'A' && i <= 'Z') ? i + 'a' - 'A' : i;
+
+  if (!load_font_func)
+    /* Window system initializer should have set proper functions.  */
+    abort ();
+
+  staticpro (&Qfontset);
+
+  Vcached_fontset_data = Qnil;
+  staticpro (&Vcached_fontset_data);
+
+  DEFVAR_LISP ("global-fontset-alist", &Vglobal_fontset_alist,
+    "Internal data for fontset.  Not for external use.\n\
+This is an alist associating fontset names with the lists of fonts\n\
+ contained in them.\n\
+Newly created frames make their own fontset database from here.");
+  Vglobal_fontset_alist = Qnil;
+
+  DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist,
+    "Alist of fontname patterns vs corresponding encoding info.\n\
+Each element looks like (REGEXP . ENCODING-INFO),\n\
+ where ENCODING-INFO is an alist of CHARSET vs ENCODING.\n\
+ENCODING is one of the following integer values:\n\
+	0: code points 0x20..0x7F or 0x2020..0x7F7F are used,\n\
+	1: code points 0xA0..0xFF or 0xA0A0..0xFFFF are used,\n\
+	2: code points 0x20A0..0x7FFF are used,\n\
+	3: code points 0xA020..0xFF7F are used.");
+  Vfont_encoding_alist = Qnil;
+
+  defsubr (&Squery_fontset);
+  defsubr (&Snew_fontset);
+  defsubr (&Sset_fontset_font);
+  defsubr (&Sfont_info);
+  defsubr (&Sfontset_info);
+}