comparison src/w32fns.c @ 24147:c83b0bc4e8b9

(Vw32_bdf_filename_alist): New variable. (x_destroy_bitmap): Returns void not int. (x_set_border_pixel): Returns void. (w32_load_bdf_font): New function. (w32_load_system_font): New function, was w32_load_font. List fonts before loading. Explicitly set encoding for SJIS fonts. Set default_ascent to 0 as comment indicates. (w32_load_font): Call w32_load_system_font and w32_load_bdf_font. (w32_unload_font): Support BDF fonts. (w32_to_x_charset): Fix mappings to avoid wildcard mismatches. Autodetect whether to use koi8-r instead of iso8859-5. Associate "ksc5601.1987" with HANGUEL_CHARSET. Associate "ksc5601.1992" with JOHAB_CHARSET. (x_to_w32_charset): Make consistent with w32_to_x_charset. (w32_to_x_font): Add resolution. (x_to_w32_font): Use font resolution to calculate height if supplied. (w32_font_match): Handle wildcards anywhere within field. (enumfont_t): Remove unused head pointer. (enum_font_cb2): Dereference elfLogFont. (w32_list_bdf_fonts): New function. (w32_list_fonts): Use one_w32_dispay_info instead of insisting on valid frame. Remove MessageBox. Support BDF fonts. (Fw32_find_bdf_fonts): New function. (syms_of_w32fns): Add Vw32_bdf_filename_alist and Sw32_find_bdf_fonts.

24146:9ed2245a9b79

/* Search path for bitmap files.  */
Lisp_Object Vx_bitmap_file_path;

/* Regexp matching a font name whose width is the same as `PIXEL_SIZE'.  */
Lisp_Object Vx_pixel_size_width_font_regexp;

/* A flag to control how to display unibyte 8-bit character.  */
int unibyte_display_via_language_environment;

/* Evaluate this expression to rebuild the section of syms_of_w32fns

#endif
}

/* Remove reference to bitmap with id number ID.  */

int
x_destroy_bitmap (f, id)
     FRAME_PTR f;
     int id;
{
  struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);

	  x_display_cursor (f, 1);
	}
    }
}

/* Set the border-color of frame F to value described by ARG.
   ARG can be a string naming a color.
   The border-color is used for the border that is drawn by the server.
   Note that this does not fully take effect if done before
   F has a window; it must be redone when the window is created.  */

  str = XSTRING (arg)->data;

  pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));

  x_set_border_pixel (f, pix);
}

/* Set the border-color of frame F to pixel value PIX.
   Note that this does not fully take effect if done before
   F has an window.  */

x_set_border_pixel (f, pix)
     struct frame *f;
     int pix;
{
  f->output_data.w32->border_pixel = pix;

  if (FRAME_W32_WINDOW (f) != 0 && f->output_data.w32->border_width > 0)
    {
      if (FRAME_VISIBLE_P (f))
        redraw_frame (f);
    }
}

void
x_set_cursor_type (f, arg, oldval)
     FRAME_PTR f;

  x_focus_on_frame (check_x_frame (frame));
  return Qnil;
}


/* Load font named FONTNAME of size SIZE for frame F, and return a
   pointer to the structure font_info while allocating it dynamically.
   If loading fails, return NULL. */
struct font_info *
w32_load_font (f,fontname,size)
struct frame *f;
char * fontname;
int size;
{
  struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
  Lisp_Object font_names;

#if 0   /* x_load_font attempts to get a list of fonts - presumably to
           allow a fuzzier fontname to be specified. w32_list_fonts
           appears to be a bit too fuzzy for this purpose. */

  /* Get a list of all the fonts that match this name.  Once we
     have a list of matching fonts, we compare them against the fonts
     we already have loaded by comparing names.  */
  font_names = w32_list_fonts (f, build_string (fontname), size, 100);

  if (!NILP (font_names))
  {
      Lisp_Object tail;
      int i;

#if 0 /* This code has nasty side effects that cause Emacs to crash.  */

      /* First check if any are already loaded, as that is cheaper
         than loading another one. */
      for (i = 0; i < dpyinfo->n_fonts; i++)

		       XSTRING (XCONS (tail)->car)->data)
	      || !strcmp (dpyinfo->font_table[i].full_name,
			  XSTRING (XCONS (tail)->car)->data))
	    return (dpyinfo->font_table + i);
#endif

      fontname = (char *) XSTRING (XCONS (font_names)->car)->data;
    }
  else
    return NULL;
#endif

  /* Load the font and add it to the table. */
  {
    char *full_name;
    XFontStruct *font;
    struct font_info *fontp;
    LOGFONT lf;
    BOOL ok;

           ended up with. */
      return NULL;

    font = (XFontStruct *) xmalloc (sizeof (XFontStruct));

    if (!font) return (NULL);

    BLOCK_INPUT;

    font->hfont = CreateFontIndirect (&lf);

       0:0x2020..0x7F7F, 1:0xA0A0..0xFFFF, 3:0x20A0..0x7FFF, or
       2:0xA020..0xFF7F).  For the moment, we don't know which charset
       uses this font.  So, we set informatoin in fontp->encoding[1]
       which is never used by any charset.  If mapping can't be
       decided, set FONT_ENCODING_NOT_DECIDED.  */
    fontp->encoding[1] = FONT_ENCODING_NOT_DECIDED;

    /* The following three values are set to 0 under W32, which is
       what they get set to if XGetFontProperty fails under X.  */
    fontp->baseline_offset = 0;
    fontp->relative_compose = 0;
    fontp->default_ascent = FONT_BASE (font);

    UNBLOCK_INPUT;
    dpyinfo->n_fonts++;

    return fontp;
  }
}

void 
w32_unload_font (dpyinfo, font)
     struct w32_display_info *dpyinfo;
     XFontStruct * font;
{
  if (font) 
    {
      if (font->hfont) DeleteObject(font->hfont);
      xfree (font);
    }
}

{
  if (!lpcs) return (0);

  if (stricmp (lpcs,"ansi") == 0)                return ANSI_CHARSET;
  else if (stricmp (lpcs,"iso8859-1") == 0)      return ANSI_CHARSET;
  else if (stricmp (lpcs, "symbol") == 0)        return SYMBOL_CHARSET;
  else if (stricmp (lpcs, "jis") == 0)           return SHIFTJIS_CHARSET;
  else if (stricmp (lpcs, "ksc5601") == 0)       return HANGEUL_CHARSET;
  else if (stricmp (lpcs, "gb2312") == 0)        return GB2312_CHARSET;
  else if (stricmp (lpcs, "big5") == 0)          return CHINESEBIG5_CHARSET;
  else if (stricmp (lpcs, "oem") == 0)	         return OEM_CHARSET;

#ifdef EASTEUROPE_CHARSET
  else if (stricmp (lpcs, "iso8859-2") == 0)     return EASTEUROPE_CHARSET;
  else if (stricmp (lpcs, "iso8859-3") == 0)     return TURKISH_CHARSET;
  else if (stricmp (lpcs, "iso8859-4") == 0)     return BALTIC_CHARSET;

  else if (stricmp (lpcs, "iso8859-9") == 0)     return TURKISH_CHARSET;
  else if (stricmp (lpcs, "viscii") == 0)        return VIETNAMESE_CHARSET;
  else if (stricmp (lpcs, "vscii") == 0)         return VIETNAMESE_CHARSET;
  else if (stricmp (lpcs, "tis620") == 0)        return THAI_CHARSET;
  else if (stricmp (lpcs, "mac") == 0)           return MAC_CHARSET;
#endif

#ifdef UNICODE_CHARSET
  else if (stricmp (lpcs,"iso10646") == 0)       return UNICODE_CHARSET;
  else if (stricmp (lpcs, "unicode") == 0)       return UNICODE_CHARSET;

  switch (fncharset)
    {
      /* ansi is considered iso8859-1, as most modern ansi fonts are.  */
    case ANSI_CHARSET:        return "iso8859-1";
    case DEFAULT_CHARSET:     return "ascii-*";
    case SYMBOL_CHARSET:      return "*-symbol";
    case SHIFTJIS_CHARSET:    return "jisx0208-sjis";
    case HANGEUL_CHARSET:     return "ksc5601-*";
    case GB2312_CHARSET:      return "gb2312-*";
    case CHINESEBIG5_CHARSET: return "big5-*";
    case OEM_CHARSET:         return "*-oem";

      /* More recent versions of Windows (95 and NT4.0) define more
         character sets.  */
#ifdef EASTEUROPE_CHARSET
    case EASTEUROPE_CHARSET: return "iso8859-2";
    case TURKISH_CHARSET:    return "iso8859-9";
    case BALTIC_CHARSET:     return "iso8859-4";
    case RUSSIAN_CHARSET:    return "koi8-r";
    case ARABIC_CHARSET:     return "iso8859-6";
    case GREEK_CHARSET:      return "iso8859-7";
    case HEBREW_CHARSET:     return "iso8859-8";
    case VIETNAMESE_CHARSET: return "viscii1.1-*";
    case THAI_CHARSET:       return "tis620-*";
    case MAC_CHARSET:        return "*-mac";
      /* Johab is Korean, but Hangeul is the standard - what is this? */
    case JOHAB_CHARSET:      return "*-johab";

#endif

#ifdef UNICODE_CHARSET
    case UNICODE_CHARSET:  return "iso10646-unicode";

  char fontname[50];
  char height_pixels[8];
  char height_dpi[8];
  char width_pixels[8];
  char *fontname_dash;

  if (!lpxstr) abort ();

  if (!lplogfont)
    return FALSE;

  if (lplogfont->lfHeight)
    {
      sprintf (height_pixels, "%u", abs (lplogfont->lfHeight));
      sprintf (height_dpi, "%u",
	       (abs (lplogfont->lfHeight) * 720) / one_w32_display_info.height_in);
    }
  else
    {
      strcpy (height_pixels, "*");
      strcpy (height_dpi, "*");

    sprintf (width_pixels, "%u", lplogfont->lfWidth * 10);
  else
    strcpy (width_pixels, "*");

  _snprintf (lpxstr, len - 1,
	     "-*-%s-%s-%c-*-*-%s-%s-*-*-%c-%s-%s",
                                                     /* foundry */
	     fontname,                               /* family */
	     w32_to_x_weight (lplogfont->lfWeight),  /* weight */
	     lplogfont->lfItalic?'i':'r',            /* slant */
                                                     /* setwidth name */
                                                     /* add style name */
	     height_pixels,                          /* pixel size */
	     height_dpi,                             /* point size */
                                                     /* resx */
                                                     /* resy */
	     ((lplogfont->lfPitchAndFamily & 0x3) == VARIABLE_PITCH)
             ? 'p' : 'c',                            /* spacing */
	     width_pixels,                           /* avg width */
	     w32_to_x_charset (lplogfont->lfCharSet) /* charset registry
                                                        and encoding*/

   *   "<font name>[:height in pixels[:width in pixels[:weight]]]"
   */
  
  if (*lpxstr == '-')
    {
      int fields;
      char name[50], weight[20], slant, pitch, pixels[10], height[10], width[10], remainder[20];
      char * encoding;

      fields = sscanf (lpxstr,
		       "-%*[^-]-%49[^-]-%19[^-]-%c-%*[^-]-%*[^-]-%9[^-]-%9[^-]-%*[^-]-%*[^-]-%c-%9[^-]-%19s",
		       name, weight, &slant, pixels, height, &pitch, width, remainder);

      if (fields == EOF) return (FALSE);

      if (fields > 0 && name[0] != '*')
        {
	  strncpy (lplogfont->lfFaceName,name, LF_FACESIZE);

      if (fields > 0 && pixels[0] != '*')
	lplogfont->lfHeight = atoi (pixels);

      fields--;

      if (fields > 0 && lplogfont->lfHeight == 0 && height[0] != '*')
	lplogfont->lfHeight = (atoi (height)
			       * one_w32_display_info.height_in) / 720;

      fields--;

      lplogfont->lfPitchAndFamily =
	(fields > 0 && pitch == 'p') ? VARIABLE_PITCH : FIXED_PITCH;

      fields--;

BOOL 
w32_font_match (lpszfont1, lpszfont2)
    char * lpszfont1;
    char * lpszfont2;
{
  char * s1 = lpszfont1, *e1;
  char * s2 = lpszfont2, *e2;
  
  if (s1 == NULL || s2 == NULL) return (FALSE);
  
  if (*s1 == '-') s1++;
  if (*s2 == '-') s2++;
  
  while (1) 
    {
      int len1, len2;

      e1 = strchr (s1, '-');
      e2 = strchr (s2, '-');

      if (e1 == NULL || e2 == NULL) return (TRUE);

      len1 = e1 - s1;
      len2 = e2 - s2;

      if (*s1 != '*' && *s2 != '*'
	  && (len1 != len2 || strnicmp (s1, s2, len1) != 0))
	return (FALSE);

      s1 = e1 + 1;
      s2 = e2 + 1;
    }
}

  HDC hdc;
  int numFonts;
  LOGFONT logfont;
  XFontStruct *size_ref;
  Lisp_Object *pattern;
  Lisp_Object *head;
  Lisp_Object *tail;
} enumfont_t;

int CALLBACK 
enum_font_cb2 (lplf, lptm, FontType, lpef)

    /* The MaxCharWidth is not valid at this stage for scalable fonts. */
    if (FontType == RASTER_FONTTYPE)
        width = make_number (lptm->tmMaxCharWidth);

    if (!w32_to_x_font (lplf, buf, 100)) return (0);

    if (NILP (*(lpef->pattern)) || w32_font_match (buf, XSTRING (*(lpef->pattern))->data))
      {
	*lpef->tail = Fcons (Fcons (build_string (buf), width), Qnil);
	lpef->tail = &(XCONS (*lpef->tail)->cdr);
	lpef->numFonts++;
      }

/* Interface to fontset handler. (adapted from mw32font.c in Meadow
   and xterm.c in Emacs 20.3) */

/* Return a list of names of available fonts matching PATTERN on frame
   F.  If SIZE is not 0, it is the size (maximum bound width) of fonts
   to be listed.  Frame F NULL means we have not yet created any
   frame, which means we can't get proper size info, as we don't have
   a device context to use for GetTextMetrics.
   MAXNAMES sets a limit on how many fonts to match.  */

Lisp_Object
w32_list_fonts (FRAME_PTR f, Lisp_Object pattern, int size, int maxnames )
{
  Lisp_Object patterns, key, tem;
  Lisp_Object list = Qnil, newlist = Qnil, second_best = Qnil;

  /* If we don't have a frame, we can't use the Windows API to list
     fonts, as it requires a device context for the Window.  This will
     only happen during startup if the user specifies a font on the
     command line.  Print a message on stderr and return nil.  */
  if (!f)
    {
      char buffer[256];

      sprintf (buffer, 
	       "Emacs cannot get a list of fonts before the initial frame "
	       "is created.\nThe font specified on the command line may not "
	       "be found.\n");
      MessageBox (NULL, buffer, "Emacs Warning Dialog",
		  MB_OK | MB_ICONEXCLAMATION | MB_TASKMODAL);
      return Qnil;
    }


  patterns = Fassoc (pattern, Valternate_fontname_alist);
  if (NILP (patterns))
    patterns = Fcons (pattern, Qnil);

  for (; CONSP (patterns); patterns = XCONS (patterns)->cdr)
    {
      enumfont_t ef;

      pattern = XCONS (patterns)->car;

      /* See if we cached the result for this particular query.
         The cache is an alist of the form:
           ((PATTERN (FONTNAME . WIDTH) ...) ...)
      */
      if ( f &&
           (tem = XCONS (FRAME_W32_DISPLAY_INFO (f)->name_list_element)->cdr,
            !NILP (list = Fassoc (pattern, tem))))
        {
          list = Fcdr_safe (list);
          /* We have a cached list. Don't have to get the list again.  */
          goto label_cached;
        }

      BLOCK_INPUT;
      /* At first, put PATTERN in the cache.  */
      list = Qnil;
      ef.pattern = &pattern;
      ef.tail = ef.head = &list;
      ef.numFonts = 0;
      x_to_w32_font (STRINGP (pattern) ? XSTRING (pattern)->data :
                     NULL, &ef.logfont);
      {
        ef.hdc = GetDC (FRAME_W32_WINDOW (f));

        EnumFontFamilies (ef.hdc, NULL, (FONTENUMPROC) enum_font_cb1,
                          (LPARAM)&ef);

        ReleaseDC (FRAME_W32_WINDOW (f), ef.hdc);
      }

      UNBLOCK_INPUT;

      /* Make a list of the fonts we got back.
         Store that in the font cache for the display. */
      if (f != NULL)
        XCONS (FRAME_W32_DISPLAY_INFO (f)->name_list_element)->cdr
          = Fcons (Fcons (pattern, list),
                   XCONS (FRAME_W32_DISPLAY_INFO (f)->name_list_element)->cdr);

    label_cached:
      if (NILP (list)) continue; /* Try the remaining alternatives.  */

      newlist = second_best = Qnil;

            }
          if (!INTEGERP (XCONS (tem)->cdr))
            {
              /* Since we don't yet know the size of the font, we must
                 load it and try GetTextMetrics.  */
              struct w32_display_info *dpyinfo
                = FRAME_W32_DISPLAY_INFO (f);
              W32FontStruct thisinfo;
              LOGFONT lf;
              HDC hdc;
              HANDLE oldobj;

              if (!x_to_w32_font (XSTRING (XCONS (tem)->car)->data, &lf))
                continue;

              BLOCK_INPUT;
              thisinfo.hfont = CreateFontIndirect (&lf);
              if (thisinfo.hfont == NULL)
                continue;

              hdc = GetDC (dpyinfo->root_window);

        {
          newlist = Fcons (XCONS (second_best)->car, Qnil);
          break;
        }
    }

  return newlist;
}

/* Return a pointer to struct font_info of font FONT_IDX of frame F.  */

  BLOCK_INPUT;

  namelist = Qnil;
  ef.pattern = &pattern;
  ef.tail = ef.head = &namelist;
  ef.numFonts = 0;
  x_to_w32_font (STRINGP (pattern) ? XSTRING (pattern)->data : NULL, &ef.logfont);

  {
    ef.hdc = GetDC (FRAME_W32_WINDOW (f));

    }

  return list;
}
#endif

DEFUN ("x-color-defined-p", Fx_color_defined_p, Sx_color_defined_p, 1, 2, 0,
       "Return non-nil if color COLOR is supported on frame FRAME.\n\
If FRAME is omitted or nil, use the selected frame.")
  (color, frame)

are displayed by converting them to the equivalent multibyte characters\n\
according to the current language environment.  As a result, they are\n\
displayed according to the current fontset.");
  unibyte_display_via_language_environment = 0;

  defsubr (&Sx_get_resource);
  defsubr (&Sx_list_fonts);
  defsubr (&Sx_display_color_p);
  defsubr (&Sx_display_grayscale_p);
  defsubr (&Sx_color_defined_p);

  defsubr (&Sw32_register_hot_key);
  defsubr (&Sw32_unregister_hot_key);
  defsubr (&Sw32_registered_hot_keys);
  defsubr (&Sw32_reconstruct_hot_key);
  defsubr (&Sw32_toggle_lock_key);

  /* Setting callback functions for fontset handler.  */
  get_font_info_func = w32_get_font_info;
  list_fonts_func = w32_list_fonts;
  load_font_func = w32_load_font;

24147:c83b0bc4e8b9

/* Search path for bitmap files.  */
Lisp_Object Vx_bitmap_file_path;

/* Regexp matching a font name whose width is the same as `PIXEL_SIZE'.  */
Lisp_Object Vx_pixel_size_width_font_regexp;

/* Alist of bdf fonts and the files that define them.  */
Lisp_Object Vw32_bdf_filename_alist;

/* A flag to control how to display unibyte 8-bit character.  */
int unibyte_display_via_language_environment;

/* Evaluate this expression to rebuild the section of syms_of_w32fns

#endif
}

/* Remove reference to bitmap with id number ID.  */

void
x_destroy_bitmap (f, id)
     FRAME_PTR f;
     int id;
{
  struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);

	  x_display_cursor (f, 1);
	}
    }
}

/* Set the border-color of frame F to pixel value PIX.
   Note that this does not fully take effect if done before
   F has an window.  */
void
x_set_border_pixel (f, pix)
     struct frame *f;
     int pix;
{
  f->output_data.w32->border_pixel = pix;

  if (FRAME_W32_WINDOW (f) != 0 && f->output_data.w32->border_width > 0)
    {
      if (FRAME_VISIBLE_P (f))
        redraw_frame (f);
    }
}

/* Set the border-color of frame F to value described by ARG.
   ARG can be a string naming a color.
   The border-color is used for the border that is drawn by the server.
   Note that this does not fully take effect if done before
   F has a window; it must be redone when the window is created.  */

  str = XSTRING (arg)->data;

  pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));

  x_set_border_pixel (f, pix);
}

void
x_set_cursor_type (f, arg, oldval)
     FRAME_PTR f;

  x_focus_on_frame (check_x_frame (frame));
  return Qnil;
}


struct font_info *w32_load_bdf_font (struct frame *f, char *fontname,
                                     int size, char* filename);

struct font_info *
w32_load_system_font (f,fontname,size)
struct frame *f;
char * fontname;
int size;
{
  struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
  Lisp_Object font_names;

  /* Get a list of all the fonts that match this name.  Once we
     have a list of matching fonts, we compare them against the fonts
     we already have loaded by comparing names.  */
  font_names = w32_list_fonts (f, build_string (fontname), size, 100);

  if (!NILP (font_names))
  {
      Lisp_Object tail;
      int i;
#if 0 /* This code has nasty side effects that cause Emacs to crash.  */

      /* First check if any are already loaded, as that is cheaper
         than loading another one. */
      for (i = 0; i < dpyinfo->n_fonts; i++)

		       XSTRING (XCONS (tail)->car)->data)
	      || !strcmp (dpyinfo->font_table[i].full_name,
			  XSTRING (XCONS (tail)->car)->data))
	    return (dpyinfo->font_table + i);
#endif
      fontname = (char *) XSTRING (XCONS (font_names)->car)->data;
    }
  /* Because we need to support NT 3.x, we can't use EnumFontFamiliesEx
     so if fonts of the same name are available with several
     alternative character sets, the w32_list_fonts can fail to find a
     match even if the font exists. Try loading it anyway.
  */
#if 0
  else
    return NULL;
#endif

  /* Load the font and add it to the table. */
  {
    char *full_name, *encoding;
    XFontStruct *font;
    struct font_info *fontp;
    LOGFONT lf;
    BOOL ok;

           ended up with. */
      return NULL;

    font = (XFontStruct *) xmalloc (sizeof (XFontStruct));

    /* Set bdf to NULL to indicate that this is a Windows font.  */
    font->bdf = NULL;

    BLOCK_INPUT;

    font->hfont = CreateFontIndirect (&lf);

       0:0x2020..0x7F7F, 1:0xA0A0..0xFFFF, 3:0x20A0..0x7FFF, or
       2:0xA020..0xFF7F).  For the moment, we don't know which charset
       uses this font.  So, we set informatoin in fontp->encoding[1]
       which is never used by any charset.  If mapping can't be
       decided, set FONT_ENCODING_NOT_DECIDED.  */

    /* SJIS fonts need to be set to type 4, all others seem to work as
       type FONT_ENCODING_NOT_DECIDED.  */
    encoding = strrchr (fontp->name, '-');
    if (encoding && stricmp (encoding+1, "sjis") == 0)
        fontp->encoding[1] = 4;
    else
    fontp->encoding[1] = FONT_ENCODING_NOT_DECIDED;

    /* The following three values are set to 0 under W32, which is
       what they get set to if XGetFontProperty fails under X.  */
    fontp->baseline_offset = 0;
    fontp->relative_compose = 0;
    fontp->default_ascent = 0;

    UNBLOCK_INPUT;
    dpyinfo->n_fonts++;

    return fontp;
  }
}

/* Load font named FONTNAME of size SIZE for frame F, and return a
   pointer to the structure font_info while allocating it dynamically.
   If loading fails, return NULL. */
struct font_info *
w32_load_font (f,fontname,size)
struct frame *f;
char * fontname;
int size;
{
  Lisp_Object bdf_fonts;
  struct font_info *retval = NULL;

  bdf_fonts = w32_list_bdf_fonts (build_string (fontname));

  while (!retval && CONSP (bdf_fonts))
    {
      char *bdf_name, *bdf_file;
      Lisp_Object bdf_pair;

      bdf_name = XSTRING (XCONS (bdf_fonts)->car)->data;
      bdf_pair = Fassoc (XCONS (bdf_fonts)->car, Vw32_bdf_filename_alist);
      bdf_file = XSTRING (XCONS (bdf_pair)->cdr)->data;

      retval = w32_load_bdf_font (f, bdf_name, size, bdf_file);

      bdf_fonts = XCONS (bdf_fonts)->cdr;
    }

  if (retval)
    return retval;

  return w32_load_system_font(f, fontname, size);
}


void 
w32_unload_font (dpyinfo, font)
     struct w32_display_info *dpyinfo;
     XFontStruct * font;
{
  if (font) 
    {
      if (font->bdf) w32_free_bdf_font (font->bdf);

      if (font->hfont) DeleteObject(font->hfont);
      xfree (font);
    }
}

{
  if (!lpcs) return (0);

  if (stricmp (lpcs,"ansi") == 0)                return ANSI_CHARSET;
  else if (stricmp (lpcs,"iso8859-1") == 0)      return ANSI_CHARSET;
  else if (stricmp (lpcs, "ms-symbol") == 0)     return SYMBOL_CHARSET;
  else if (stricmp (lpcs, "jis") == 0)           return SHIFTJIS_CHARSET;
  else if (stricmp (lpcs, "ksc5601.1987") == 0)  return HANGEUL_CHARSET;
  else if (stricmp (lpcs, "gb2312") == 0)        return GB2312_CHARSET;
  else if (stricmp (lpcs, "big5") == 0)          return CHINESEBIG5_CHARSET;
  else if (stricmp (lpcs, "ms-oem") == 0)	 return OEM_CHARSET;

#ifdef EASTEUROPE_CHARSET
  else if (stricmp (lpcs, "iso8859-2") == 0)     return EASTEUROPE_CHARSET;
  else if (stricmp (lpcs, "iso8859-3") == 0)     return TURKISH_CHARSET;
  else if (stricmp (lpcs, "iso8859-4") == 0)     return BALTIC_CHARSET;

  else if (stricmp (lpcs, "iso8859-9") == 0)     return TURKISH_CHARSET;
  else if (stricmp (lpcs, "viscii") == 0)        return VIETNAMESE_CHARSET;
  else if (stricmp (lpcs, "vscii") == 0)         return VIETNAMESE_CHARSET;
  else if (stricmp (lpcs, "tis620") == 0)        return THAI_CHARSET;
  else if (stricmp (lpcs, "mac") == 0)           return MAC_CHARSET;
  else if (stricmp (lpcs, "ksc5601.1992") == 0)  return JOHAB_CHARSET;
  /* For backwards compatibility with previous 20.4 pretests.  */
  else if (stricmp (lpcs, "ksc5601") == 0)       return HANGEUL_CHARSET;
  else if (stricmp (lpcs, "johab") == 0)         return JOHAB_CHARSET;
#endif

#ifdef UNICODE_CHARSET
  else if (stricmp (lpcs,"iso10646") == 0)       return UNICODE_CHARSET;
  else if (stricmp (lpcs, "unicode") == 0)       return UNICODE_CHARSET;

  switch (fncharset)
    {
      /* ansi is considered iso8859-1, as most modern ansi fonts are.  */
    case ANSI_CHARSET:        return "iso8859-1";
    case DEFAULT_CHARSET:     return "ascii-*";
    case SYMBOL_CHARSET:      return "ms-symbol";
    case SHIFTJIS_CHARSET:    return "jisx0208-sjis";
    case HANGEUL_CHARSET:     return "ksc5601.1987-*";
    case GB2312_CHARSET:      return "gb2312-*";
    case CHINESEBIG5_CHARSET: return "big5-*";
    case OEM_CHARSET:         return "ms-oem";

      /* More recent versions of Windows (95 and NT4.0) define more
         character sets.  */
#ifdef EASTEUROPE_CHARSET
    case EASTEUROPE_CHARSET: return "iso8859-2";
    case TURKISH_CHARSET:    return "iso8859-9";
    case BALTIC_CHARSET:     return "iso8859-4";

      /* W95 with international support but not IE4 often has the
         KOI8-R codepage but not ISO8859-5.  */
    case RUSSIAN_CHARSET:
      if (!IsValidCodePage(28595) && IsValidCodePage(20886))
        return "koi8-r";
      else
        return "iso8859-5";
    case ARABIC_CHARSET:     return "iso8859-6";
    case GREEK_CHARSET:      return "iso8859-7";
    case HEBREW_CHARSET:     return "iso8859-8";
    case VIETNAMESE_CHARSET: return "viscii1.1-*";
    case THAI_CHARSET:       return "tis620-*";
    case MAC_CHARSET:        return "mac-*";
    case JOHAB_CHARSET:      return "ksc5601.1992-*";

#endif

#ifdef UNICODE_CHARSET
    case UNICODE_CHARSET:  return "iso10646-unicode";

  char fontname[50];
  char height_pixels[8];
  char height_dpi[8];
  char width_pixels[8];
  char *fontname_dash;
  int display_resy = one_w32_display_info.height_in;
  int display_resx = one_w32_display_info.width_in;

  if (!lpxstr) abort ();

  if (!lplogfont)
    return FALSE;

  if (lplogfont->lfHeight)
    {
      sprintf (height_pixels, "%u", abs (lplogfont->lfHeight));
      sprintf (height_dpi, "%u",
	       abs (lplogfont->lfHeight) * 720 / display_resy);
    }
  else
    {
      strcpy (height_pixels, "*");
      strcpy (height_dpi, "*");

    sprintf (width_pixels, "%u", lplogfont->lfWidth * 10);
  else
    strcpy (width_pixels, "*");

  _snprintf (lpxstr, len - 1,
	     "-*-%s-%s-%c-*-*-%s-%s-%d-%d-%c-%s-%s",
                                                     /* foundry */
	     fontname,                               /* family */
	     w32_to_x_weight (lplogfont->lfWeight),  /* weight */
	     lplogfont->lfItalic?'i':'r',            /* slant */
                                                     /* setwidth name */
                                                     /* add style name */
	     height_pixels,                          /* pixel size */
	     height_dpi,                             /* point size */
             display_resx,                           /* resx */
             display_resy,                           /* resy */
	     ((lplogfont->lfPitchAndFamily & 0x3) == VARIABLE_PITCH)
             ? 'p' : 'c',                            /* spacing */
	     width_pixels,                           /* avg width */
	     w32_to_x_charset (lplogfont->lfCharSet) /* charset registry
                                                        and encoding*/

   *   "<font name>[:height in pixels[:width in pixels[:weight]]]"
   */
  
  if (*lpxstr == '-')
    {
      int fields, tem;
      char name[50], weight[20], slant, pitch, pixels[10], height[10],
        width[10], resy[10], remainder[20];
      char * encoding;
      int dpi = one_w32_display_info.height_in;

      fields = sscanf (lpxstr,
		       "-%*[^-]-%49[^-]-%19[^-]-%c-%*[^-]-%*[^-]-%9[^-]-%9[^-]-%*[^-]-%9[^-]-%c-%9[^-]-%19s",
		       name, weight, &slant, pixels, height, resy, &pitch, width, remainder);
      if (fields == EOF) return (FALSE);

      if (fields > 0 && name[0] != '*')
        {
	  strncpy (lplogfont->lfFaceName,name, LF_FACESIZE);

      if (fields > 0 && pixels[0] != '*')
	lplogfont->lfHeight = atoi (pixels);

      fields--;
      fields--;
      if (fields > 0 && resy[0] != '*')
        {
          tem = atoi (pixels);
          if (tem > 0) dpi = tem;
        }

      if (fields > -1 && lplogfont->lfHeight == 0 && height[0] != '*')
	lplogfont->lfHeight = atoi (height) * dpi / 720;

      if (fields > 0)
      lplogfont->lfPitchAndFamily =
	(fields > 0 && pitch == 'p') ? VARIABLE_PITCH : FIXED_PITCH;

      fields--;

BOOL 
w32_font_match (lpszfont1, lpszfont2)
    char * lpszfont1;
    char * lpszfont2;
{
  char * s1 = lpszfont1, *e1, *w1;
  char * s2 = lpszfont2, *e2, *w2;
  
  if (s1 == NULL || s2 == NULL) return (FALSE);
  
  if (*s1 == '-') s1++;
  if (*s2 == '-') s2++;
  
  while (1) 
    {
      int len1, len2, len3=0;

      e1 = strchr (s1, '-');
      e2 = strchr (s2, '-');
      w1 = strchr (s1, '*');
      w2 = strchr (s2, '*');

      if (e1 == NULL)
        len1 = strlen (s1);
      else
      len1 = e1 - s1;
      if (e2 == NULL)
        len2 = strlen (s1);
      else
      len2 = e2 - s2;

      if (w1 && w1 < e1)
        len3 = w1 - s1;
      if (w2 && w2 < e2 && ( len3 == 0 || (w2 - s2) < len3))
        len3 = w2 - s2;

      /* Whole field is not a wildcard, and ...*/
      if (*s1 != '*' && *s2 != '*' && *s1 != '-' && *s2 != '-'
          /* Lengths are different and there are no wildcards, or ... */
	  && ((len1 != len2 && len3 == 0) ||
              /* strings don't match up until first wildcard or end.  */
              strnicmp (s1, s2, len3 > 0 ? len3 : len1) != 0))
	return (FALSE);

      if (e1 == NULL || e2 == NULL)
        return (TRUE);

      s1 = e1 + 1;
      s2 = e2 + 1;
    }
}

  HDC hdc;
  int numFonts;
  LOGFONT logfont;
  XFontStruct *size_ref;
  Lisp_Object *pattern;
  Lisp_Object *tail;
} enumfont_t;

int CALLBACK 
enum_font_cb2 (lplf, lptm, FontType, lpef)

    /* The MaxCharWidth is not valid at this stage for scalable fonts. */
    if (FontType == RASTER_FONTTYPE)
        width = make_number (lptm->tmMaxCharWidth);

    if (!w32_to_x_font (&(lplf->elfLogFont), buf, 100))
      return (0);

    if (NILP (*(lpef->pattern)) ||
        w32_font_match (buf, XSTRING (*(lpef->pattern))->data))
      {
	*lpef->tail = Fcons (Fcons (build_string (buf), width), Qnil);
	lpef->tail = &(XCONS (*lpef->tail)->cdr);
	lpef->numFonts++;
      }

/* Interface to fontset handler. (adapted from mw32font.c in Meadow
   and xterm.c in Emacs 20.3) */

Lisp_Object w32_list_bdf_fonts (Lisp_Object pattern)
{
  char *fontname, *ptnstr;
  Lisp_Object list, tem, newlist = Qnil;

  list = Vw32_bdf_filename_alist;
  ptnstr = XSTRING (pattern)->data;

  for ( ; CONSP (list); list = XCONS (list)->cdr)
    {
      tem = XCONS (list)->car;
      if (CONSP (tem))
        fontname = XSTRING (XCONS (tem)->car)->data;
      else if (STRINGP (tem))
        fontname = XSTRING (tem)->data;
      else
        continue;

      if (w32_font_match (fontname, ptnstr))
        newlist = Fcons (XCONS (tem)->car, newlist);
    }

  return newlist;
}

/* Return a list of names of available fonts matching PATTERN on frame
   F.  If SIZE is not 0, it is the size (maximum bound width) of fonts
   to be listed.  Frame F NULL means we have not yet created any
   frame, which means we can't get proper size info, as we don't have
   a device context to use for GetTextMetrics.
   MAXNAMES sets a limit on how many fonts to match.  */

Lisp_Object
w32_list_fonts (FRAME_PTR f, Lisp_Object pattern, int size, int maxnames )
{
  Lisp_Object patterns, key, tem, tpat;
  Lisp_Object list = Qnil, newlist = Qnil, second_best = Qnil;
  struct w32_display_info *dpyinfo = &one_w32_display_info;

  patterns = Fassoc (pattern, Valternate_fontname_alist);
  if (NILP (patterns))
    patterns = Fcons (pattern, Qnil);

  for (; CONSP (patterns); patterns = XCONS (patterns)->cdr)
    {
      enumfont_t ef;

      tpat = XCONS (patterns)->car;

      /* See if we cached the result for this particular query.
         The cache is an alist of the form:
           ((PATTERN (FONTNAME . WIDTH) ...) ...)
      */
      if (tem = XCONS (dpyinfo->name_list_element)->cdr,
          !NILP (list = Fassoc (tpat, tem)))
        {
          list = Fcdr_safe (list);
          /* We have a cached list. Don't have to get the list again.  */
          goto label_cached;
        }

      BLOCK_INPUT;
      /* At first, put PATTERN in the cache.  */
      list = Qnil;
      ef.pattern = &tpat;
      ef.tail = &list;
      ef.numFonts = 0;

      x_to_w32_font (STRINGP (tpat) ? XSTRING (tpat)->data :
                     NULL, &ef.logfont);
      {
        ef.hdc = GetDC (dpyinfo->root_window);

        EnumFontFamilies (ef.hdc, NULL, (FONTENUMPROC) enum_font_cb1,
                          (LPARAM)&ef);

        ReleaseDC (dpyinfo->root_window, ef.hdc);
      }

      UNBLOCK_INPUT;

      /* Make a list of the fonts we got back.
         Store that in the font cache for the display. */
      XCONS (dpyinfo->name_list_element)->cdr
        = Fcons (Fcons (tpat, list),
                 XCONS (dpyinfo->name_list_element)->cdr);

    label_cached:
      if (NILP (list)) continue; /* Try the remaining alternatives.  */

      newlist = second_best = Qnil;

            }
          if (!INTEGERP (XCONS (tem)->cdr))
            {
              /* Since we don't yet know the size of the font, we must
                 load it and try GetTextMetrics.  */
              W32FontStruct thisinfo;
              LOGFONT lf;
              HDC hdc;
              HANDLE oldobj;

              if (!x_to_w32_font (XSTRING (XCONS (tem)->car)->data, &lf))
                continue;

              BLOCK_INPUT;
              thisinfo.bdf = NULL;
              thisinfo.hfont = CreateFontIndirect (&lf);
              if (thisinfo.hfont == NULL)
                continue;

              hdc = GetDC (dpyinfo->root_window);

        {
          newlist = Fcons (XCONS (second_best)->car, Qnil);
          break;
        }
    }

  /* Include any bdf fonts.  */
  {
    Lisp_Object combined[2];
    combined[0] = w32_list_bdf_fonts (pattern);
    combined[1] = newlist;
    newlist = Fnconc(2, combined);
  }

  return newlist;
}

/* Return a pointer to struct font_info of font FONT_IDX of frame F.  */

  BLOCK_INPUT;

  namelist = Qnil;
  ef.pattern = &pattern;
  ef.tail &namelist;
  ef.numFonts = 0;
  x_to_w32_font (STRINGP (pattern) ? XSTRING (pattern)->data : NULL, &ef.logfont);

  {
    ef.hdc = GetDC (FRAME_W32_WINDOW (f));

    }

  return list;
}
#endif

DEFUN ("w32-find-bdf-fonts", Fw32_find_bdf_fonts, Sw32_find_bdf_fonts,
       1, 1, 0,
       "Return a list of BDF fonts in DIR, suitable for appending to\n\
w32-bdf-filename-alist.  Fonts which do not contain an xfld description\n\
will not be included in the list. DIR may be a list of directories.")
     (directory)
     Lisp_Object directory;
{
  Lisp_Object list = Qnil;
  struct gcpro gcpro1, gcpro2;

  if (!CONSP (directory))
    return w32_find_bdf_fonts_in_dir (directory);

  for ( ; CONSP (directory); directory = XCONS (directory)->cdr)
    {
      Lisp_Object pair[2];
      pair[0] = list;
      pair[1] = Qnil;
      GCPRO2 (directory, list);
      pair[1] = w32_find_bdf_fonts_in_dir( XCONS (directory)->car );
      list = Fnconc( 2, pair );
      UNGCPRO;
    }
  return list;
}

/* Find BDF files in a specified directory.  (use GCPRO when calling,
   as this calls lisp to get a directory listing).  */
Lisp_Object w32_find_bdf_fonts_in_dir( Lisp_Object directory )
{
  Lisp_Object filelist, list = Qnil;
  char fontname[100];

  if (!STRINGP(directory))
    return Qnil;

  filelist = Fdirectory_files (directory, Qt,
                              build_string (".*\\.[bB][dD][fF]"), Qt);

  for ( ; CONSP(filelist); filelist = XCONS (filelist)->cdr)
    {
      Lisp_Object filename = XCONS (filelist)->car;
      if (w32_BDF_to_x_font (XSTRING (filename)->data, fontname, 100))
          store_in_alist (&list, build_string (fontname), filename);
    }
  return list;
}


DEFUN ("x-color-defined-p", Fx_color_defined_p, Sx_color_defined_p, 1, 2, 0,
       "Return non-nil if color COLOR is supported on frame FRAME.\n\
If FRAME is omitted or nil, use the selected frame.")
  (color, frame)

are displayed by converting them to the equivalent multibyte characters\n\
according to the current language environment.  As a result, they are\n\
displayed according to the current fontset.");
  unibyte_display_via_language_environment = 0;

  DEFVAR_LISP ("w32-bdf-filename-alist",
               &Vw32_bdf_filename_alist,
               "List of bdf fonts and their corresponding filenames.");
  Vw32_bdf_filename_alist = Qnil;

  defsubr (&Sx_get_resource);
  defsubr (&Sx_list_fonts);
  defsubr (&Sx_display_color_p);
  defsubr (&Sx_display_grayscale_p);
  defsubr (&Sx_color_defined_p);

  defsubr (&Sw32_register_hot_key);
  defsubr (&Sw32_unregister_hot_key);
  defsubr (&Sw32_registered_hot_keys);
  defsubr (&Sw32_reconstruct_hot_key);
  defsubr (&Sw32_toggle_lock_key);
  defsubr (&Sw32_find_bdf_fonts);

  /* Setting callback functions for fontset handler.  */
  get_font_info_func = w32_get_font_info;
  list_fonts_func = w32_list_fonts;
  load_font_func = w32_load_font;