* w32font.c (w32font_open): Set font type to gdi.
[bpt/emacs.git] / src / w32font.c
index 4ee6180..77e949a 100644 (file)
@@ -3,10 +3,10 @@
 
 This file is part of GNU Emacs.
 
-GNU Emacs is free software; you can redistribute it and/or modify
+GNU Emacs 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 3, or (at your option)
-any later version.
+the Free Software Foundation, either version 3 of the License, or
+(at your option) any later version.
 
 GNU Emacs is distributed in the hope that it will be useful,
 but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -14,15 +14,13 @@ 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 GNU Emacs; see the file COPYING.  If not, write to
-the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-Boston, MA 02110-1301, USA.  */
-
-#ifdef USE_FONT_BACKEND
+along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 
 #include <config.h>
 #include <windows.h>
 #include <math.h>
+#include <ctype.h>
+#include <commdlg.h>
 
 #include "lisp.h"
 #include "w32term.h"
@@ -45,6 +43,15 @@ Boston, MA 02110-1301, USA.  */
 #define CLEARTYPE_NATURAL_QUALITY 6
 #endif
 
+/* VIETNAMESE_CHARSET and JOHAB_CHARSET are not defined in some versions
+   of MSVC headers.  */
+#ifndef VIETNAMESE_CHARSET
+#define VIETNAMESE_CHARSET 163
+#endif
+#ifndef JOHAB_CHARSET
+#define JOHAB_CHARSET 130
+#endif
+
 extern struct font_driver w32font_driver;
 
 Lisp_Object Qgdi;
@@ -55,10 +62,13 @@ static Lisp_Object Qserif, Qscript, Qdecorative;
 static Lisp_Object Qraster, Qoutline, Qunknown;
 
 /* antialiasing  */
-extern Lisp_Object QCantialias, QCotf, QClanguage; /* defined in font.c  */
+extern Lisp_Object QCantialias, QCotf, QClang; /* defined in font.c  */
 extern Lisp_Object Qnone; /* reuse from w32fns.c  */
 static Lisp_Object Qstandard, Qsubpixel, Qnatural;
 
+/* languages */
+static Lisp_Object Qja, Qko, Qzh;
+
 /* scripts */
 static Lisp_Object Qlatin, Qgreek, Qcoptic, Qcyrillic, Qarmenian, Qhebrew;
 static Lisp_Object Qarabic, Qsyriac, Qnko, Qthaana, Qdevanagari, Qbengali;
@@ -79,21 +89,35 @@ static Lisp_Object Qtagalog, Qtagbanwa, Qtai_le, Qtifinagh, Qugaritic;
 /* Only defined here, but useful for distinguishing IPA capable fonts.  */
 static Lisp_Object Qphonetic;
 
+/* W32 charsets: for use in Vw32_charset_info_alist.  */
+static Lisp_Object Qw32_charset_ansi, Qw32_charset_default;
+static Lisp_Object Qw32_charset_symbol, Qw32_charset_shiftjis;
+static Lisp_Object Qw32_charset_hangeul, Qw32_charset_gb2312;
+static Lisp_Object Qw32_charset_chinesebig5, Qw32_charset_oem;
+static Lisp_Object Qw32_charset_easteurope, Qw32_charset_turkish;
+static Lisp_Object Qw32_charset_baltic, Qw32_charset_russian;
+static Lisp_Object Qw32_charset_arabic, Qw32_charset_greek;
+static Lisp_Object Qw32_charset_hebrew, Qw32_charset_vietnamese;
+static Lisp_Object Qw32_charset_thai, Qw32_charset_johab, Qw32_charset_mac;
+
+/* Associative list linking character set strings to Windows codepages. */
+static Lisp_Object Vw32_charset_info_alist;
+
 /* Font spacing symbols - defined in font.c.  */
 extern Lisp_Object Qc, Qp, Qm;
 
-static void fill_in_logfont P_ ((FRAME_PTR f, LOGFONT *logfont,
-                                 Lisp_Object font_spec));
+static void fill_in_logfont P_ ((FRAME_PTR, LOGFONT *, Lisp_Object));
 
-static BYTE w32_antialias_type P_ ((Lisp_Object type));
-static Lisp_Object lispy_antialias_type P_ ((BYTE type));
+static BYTE w32_antialias_type P_ ((Lisp_Object));
+static Lisp_Object lispy_antialias_type P_ ((BYTE));
 
-static Lisp_Object font_supported_scripts P_ ((FONTSIGNATURE * sig));
-static int w32font_full_name P_ ((LOGFONT * font, Lisp_Object font_obj,
-                                  int pixel_size, char *name, int nbytes));
-static void recompute_cached_metrics P_ ((HDC dc, struct w32font_info * font));
+static Lisp_Object font_supported_scripts P_ ((FONTSIGNATURE *));
+static int w32font_full_name P_ ((LOGFONT *, Lisp_Object, int, char *, int));
+static void compute_metrics P_ ((HDC, struct w32font_info *, unsigned int,
+                                struct w32_metric_cache *));
+static void clear_cached_metrics P_ ((struct w32font_info *));
 
-static Lisp_Object w32_registry P_ ((LONG w32_charset, DWORD font_type));
+static Lisp_Object w32_registry P_ ((LONG, DWORD));
 
 /* EnumFontFamiliesEx callbacks.  */
 static int CALLBACK add_font_entity_to_list P_ ((ENUMLOGFONTEX *,
@@ -126,10 +150,7 @@ struct font_callback_data
 
 /* Handles the problem that EnumFontFamiliesEx will not return all
    style variations if the font name is not specified.  */
-static void list_all_matching_fonts P_ ((struct font_callback_data *match));
-
-/* From old font code in w32fns.c */
-char * w32_to_x_charset P_ ((int charset, char * matching));
+static void list_all_matching_fonts P_ ((struct font_callback_data *));
 
 
 static int
@@ -161,7 +182,9 @@ static Lisp_Object
 w32font_list (frame, font_spec)
      Lisp_Object frame, font_spec;
 {
-  return w32font_list_internal (frame, font_spec, 0);
+  Lisp_Object fonts = w32font_list_internal (frame, font_spec, 0);
+  font_add_log ("w32font-list", font_spec, fonts);
+  return fonts;
 }
 
 /* w32 implementation of match for font backend.
@@ -172,7 +195,9 @@ static Lisp_Object
 w32font_match (frame, font_spec)
      Lisp_Object frame, font_spec;
 {
-  return w32font_match_internal (frame, font_spec, 0);
+  Lisp_Object entity = w32font_match_internal (frame, font_spec, 0);
+  font_add_log ("w32font-match", font_spec, entity);
+  return entity;
 }
 
 /* w32 implementation of list_family for font backend.
@@ -203,24 +228,24 @@ w32font_list_family (frame)
 /* w32 implementation of open for font backend.
    Open a font specified by FONT_ENTITY on frame F.
    If the font is scalable, open it with PIXEL_SIZE.  */
-static struct font *
+static Lisp_Object
 w32font_open (f, font_entity, pixel_size)
      FRAME_PTR f;
      Lisp_Object font_entity;
      int pixel_size;
 {
-  struct w32font_info *w32_font = xmalloc (sizeof (struct w32font_info));
+  Lisp_Object font_object;
 
-  if (w32_font == NULL)
-    return NULL;
+  font_object = font_make_object (VECSIZE (struct w32font_info),
+                                 font_entity, pixel_size);
+  ASET (font_object, FONT_TYPE_INDEX, Qgdi);
 
-  if (!w32font_open_internal (f, font_entity, pixel_size, w32_font))
+  if (!w32font_open_internal (f, font_entity, pixel_size, font_object))
     {
-      xfree (w32_font);
-      return NULL;
+      return Qnil;
     }
 
-  return (struct font *) w32_font;
+  return font_object;
 }
 
 /* w32 implementation of close for font_backend.
@@ -230,21 +255,23 @@ w32font_close (f, font)
      FRAME_PTR f;
      struct font *font;
 {
-  if (font->font.font)
-    {
-      W32FontStruct *old_w32_font = (W32FontStruct *)font->font.font;
-      DeleteObject (old_w32_font->hfont);
-      xfree (old_w32_font);
-      font->font.font = 0;
-    }
-
-  if (font->font.full_name && font->font.full_name != font->font.name)
-    xfree (font->font.full_name);
+  int i;
+  struct w32font_info *w32_font = (struct w32font_info *) font;
 
-  if (font->font.name)
-    xfree (font->font.name);
+  /* Delete the GDI font object.  */
+  DeleteObject (w32_font->hfont);
 
-  xfree (font);
+  /* Free all the cached metrics.  */
+  if (w32_font->cached_metrics)
+    {
+      for (i = 0; i < w32_font->n_cache_blocks; i++)
+        {
+          if (w32_font->cached_metrics[i])
+            xfree (w32_font->cached_metrics[i]);
+        }
+      xfree (w32_font->cached_metrics);
+      w32_font->cached_metrics = NULL;
+    }
 }
 
 /* w32 implementation of has_char for font backend.
@@ -317,8 +344,11 @@ w32font_encode_char (font, c)
   f = XFRAME (selected_frame);
 
   dc = get_frame_dc (f);
-  old_font = SelectObject (dc, ((W32FontStruct *) (font->font.font))->hfont);
+  old_font = SelectObject (dc, w32_font->hfont);
 
+  /* GetCharacterPlacement is used here rather than GetGlyphIndices because
+     it is supported on Windows NT 4 and 9x/ME.  But it cannot reliably report
+     missing glyphs, see below for workaround.  */
   retval = GetCharacterPlacementW (dc, in, len, 0, &result, 0);
 
   SelectObject (dc, old_font);
@@ -326,7 +356,11 @@ w32font_encode_char (font, c)
 
   if (retval)
     {
-      if (result.nGlyphs != 1 || !result.lpGlyphs[0])
+      if (result.nGlyphs != 1 || !result.lpGlyphs[0]
+          /* GetCharacterPlacementW seems to return 3, which seems to be
+             the space glyph in most/all truetype fonts, instead of 0
+             for unsupported glyphs.  */
+          || (result.lpGlyphs[0] == 3 && !iswspace (in[0])))
         return FONT_INVALID_CODE;
       return result.lpGlyphs[0];
     }
@@ -336,7 +370,8 @@ w32font_encode_char (font, c)
       /* Mark this font as not supporting glyph indices. This can happen
          on Windows9x, and maybe with non-Truetype fonts on NT etc.  */
       w32_font->glyph_idx = 0;
-      recompute_cached_metrics (dc, w32_font);
+      /* Clear metrics cache.  */
+      clear_cached_metrics (w32_font);
 
       return c;
     }
@@ -359,97 +394,79 @@ w32font_text_extents (font, code, nglyphs, metrics)
   HDC dc = NULL;
   struct frame * f;
   int total_width = 0;
-  WORD *wcode = alloca(nglyphs * sizeof (WORD));
+  WORD *wcode = NULL;
   SIZE size;
 
-  /* TODO: Frames can come and go, and their fonts outlive them. So we
-     can't cache the frame in the font structure.  Use selected_frame
-     until the API is updated to pass in a frame.  */
-  f = XFRAME (selected_frame);
+  struct w32font_info *w32_font = (struct w32font_info *) font;
 
   if (metrics)
     {
-      GLYPHMETRICS gm;
-      MAT2 transform;
-      struct w32font_info *w32_font = (struct w32font_info *) font;
-
-      /* Set transform to the identity matrix.  */
-      bzero (&transform, sizeof (transform));
-      transform.eM11.value = 1;
-      transform.eM22.value = 1;
-      metrics->width = 0;
-      metrics->ascent = 0;
-      metrics->descent = 0;
-      metrics->lbearing = 0;
+      bzero (metrics, sizeof (struct font_metrics));
+      metrics->ascent = font->ascent;
+      metrics->descent = font->descent;
 
       for (i = 0; i < nglyphs; i++)
         {
-          if (*(code + i) < 128)
-            {
-              /* Use cached metrics for ASCII.  */
-              struct font_metrics *char_metric
-                = &w32_font->ascii_metrics[*(code+i)];
-
-              /* If we couldn't get metrics when caching, use fallback.  */
-              if (char_metric->width == 0)
-                break;
-
-              metrics->lbearing = min (metrics->lbearing,
-                                       metrics->width + char_metric->lbearing);
-              metrics->rbearing = max (metrics->rbearing,
-                                       metrics->width + char_metric->rbearing);
-              metrics->width += char_metric->width;
-              metrics->ascent = max (metrics->ascent, char_metric->ascent);
-              metrics->descent = max (metrics->descent, char_metric->descent);
-            }
-          else
-            {
-              if (dc == NULL)
-                {
+         struct w32_metric_cache *char_metric;
+         int block = *(code + i) / CACHE_BLOCKSIZE;
+         int pos_in_block = *(code + i) % CACHE_BLOCKSIZE;
+
+         if (block >= w32_font->n_cache_blocks)
+           {
+             if (!w32_font->cached_metrics)
+               w32_font->cached_metrics
+                 = xmalloc ((block + 1)
+                            * sizeof (struct w32_cached_metric *));
+             else
+               w32_font->cached_metrics
+                 = xrealloc (w32_font->cached_metrics,
+                             (block + 1)
+                             * sizeof (struct w32_cached_metric *));
+             bzero (w32_font->cached_metrics + w32_font->n_cache_blocks,
+                    ((block + 1 - w32_font->n_cache_blocks)
+                     * sizeof (struct w32_cached_metric *)));
+             w32_font->n_cache_blocks = block + 1;
+           }
+
+         if (!w32_font->cached_metrics[block])
+           {
+             w32_font->cached_metrics[block]
+               = xmalloc (CACHE_BLOCKSIZE * sizeof (struct font_metrics));
+             bzero (w32_font->cached_metrics[block],
+                    CACHE_BLOCKSIZE * sizeof (struct font_metrics));
+           }
+
+         char_metric = w32_font->cached_metrics[block] + pos_in_block;
+
+         if (char_metric->status == W32METRIC_NO_ATTEMPT)
+           {
+             if (dc == NULL)
+               {
+                 /* TODO: Frames can come and go, and their fonts
+                    outlive them. So we can't cache the frame in the
+                    font structure.  Use selected_frame until the API
+                    is updated to pass in a frame.  */
+                 f = XFRAME (selected_frame);
+
                   dc = get_frame_dc (f);
-                  old_font = SelectObject (dc, ((W32FontStruct *)
-                                                (font->font.font))->hfont);
-                }
-              if (GetGlyphOutlineW (dc, *(code + i),
-                                    GGO_METRICS
-                                      | w32_font->glyph_idx
-                                        ? GGO_GLYPH_INDEX : 0,
-                                    &gm, 0, NULL, &transform) != GDI_ERROR)
-                {
-                  int new_val = metrics->width + gm.gmBlackBoxX
-                    + gm.gmptGlyphOrigin.x;
-                  metrics->rbearing = max (metrics->rbearing, new_val);
-                  new_val = metrics->width + gm.gmptGlyphOrigin.x;
-                  metrics->lbearing = min (metrics->lbearing, new_val);
-                  metrics->width += gm.gmCellIncX;
-                  new_val = gm.gmBlackBoxY;
-                  metrics->ascent = max (metrics->ascent, new_val);
-                  new_val = (gm.gmCellIncY - gm.gmptGlyphOrigin.y
-                            - gm.gmBlackBoxY);
-                  metrics->descent = max (metrics->descent, new_val);
-                }
-              else
-                {
-                  if (w32_font->glyph_idx)
-                    {
-                      /* Disable glyph indexing for this font, as we can't
-                         handle the metrics.  Abort this run, our recovery
-                         strategies rely on having unicode code points here.
-                         This will cause a glitch in display, but in practice,
-                         any problems should be caught when initialising the
-                         metrics cache.  */
-                      w32_font->glyph_idx = 0;
-                      recompute_cached_metrics (dc, w32_font);
-                      SelectObject (dc, old_font);
-                      release_frame_dc (f, dc);
-                      return 0;
-                    }
-                  /* Rely on an estimate based on the overall font metrics.  */
-                  break;
-                }
-            }
-        }
+                  old_font = SelectObject (dc, w32_font->hfont);
+               }
+             compute_metrics (dc, w32_font, *(code + i), char_metric);
+           }
 
+         if (char_metric->status == W32METRIC_SUCCESS)
+           {
+             metrics->lbearing = min (metrics->lbearing,
+                                      metrics->width + char_metric->lbearing);
+             metrics->rbearing = max (metrics->rbearing,
+                                      metrics->width + char_metric->rbearing);
+             metrics->width += char_metric->width;
+           }
+         else
+           /* If we couldn't get metrics for a char,
+              use alternative method.  */
+           break;
+       }
       /* If we got through everything, return.  */
       if (i == nglyphs)
         {
@@ -467,22 +484,29 @@ w32font_text_extents (font, code, nglyphs, metrics)
   /* For non-truetype fonts, GetGlyphOutlineW is not supported, so
      fallback on other methods that will at least give some of the metric
      information.  */
-  for (i = 0; i < nglyphs; i++)
-    {
-      if (code[i] < 0x10000)
-        wcode[i] = code[i];
-      else
-        {
-          /* TODO: Convert to surrogate, reallocating array if needed */
-          wcode[i] = 0xffff;
-        }
-    }
-
+  if (!wcode) {
+    wcode = alloca (nglyphs * sizeof (WORD));
+    for (i = 0; i < nglyphs; i++)
+      {
+       if (code[i] < 0x10000)
+         wcode[i] = code[i];
+       else
+         {
+           /* TODO: Convert to surrogate, reallocating array if needed */
+           wcode[i] = 0xffff;
+         }
+      }
+  }
   if (dc == NULL)
     {
+      /* TODO: Frames can come and go, and their fonts outlive
+        them. So we can't cache the frame in the font structure.  Use
+        selected_frame until the API is updated to pass in a
+        frame.  */
+      f = XFRAME (selected_frame);
+
       dc = get_frame_dc (f);
-      old_font = SelectObject (dc, ((W32FontStruct *)
-                                    (font->font.font))->hfont);
+      old_font = SelectObject (dc, w32_font->hfont);
     }
 
   if (GetTextExtentPoint32W (dc, wcode, nglyphs, &size))
@@ -495,7 +519,7 @@ w32font_text_extents (font, code, nglyphs, metrics)
   if (!total_width)
     {
       RECT rect;
-      rect.top = 0; rect.bottom = font->font.height; rect.left = 0; rect.right = 1;
+      rect.top = 0; rect.bottom = font->height; rect.left = 0; rect.right = 1;
       DrawTextW (dc, wcode, nglyphs, &rect,
                  DT_CALCRECT | DT_NOPREFIX | DT_SINGLELINE);
       total_width = rect.right;
@@ -504,12 +528,9 @@ w32font_text_extents (font, code, nglyphs, metrics)
   /* Give our best estimate of the metrics, based on what we know.  */
   if (metrics)
     {
-      metrics->width = total_width;
-      metrics->ascent = font->ascent;
-      metrics->descent = font->descent;
+      metrics->width = total_width - w32_font->metrics.tmOverhang;
       metrics->lbearing = 0;
-      metrics->rbearing = total_width
-        + ((struct w32font_info *) font)->metrics.tmOverhang;
+      metrics->rbearing = total_width;
     }
 
   /* Restore state and release DC.  */
@@ -539,7 +560,7 @@ w32font_draw (s, from, to, x, y, with_background)
 {
   UINT options;
   HRGN orig_clip;
-  struct w32font_info *w32font = (struct w32font_info *) s->face->font_info;
+  struct w32font_info *w32font = (struct w32font_info *) s->font;
 
   options = w32font->glyph_idx;
 
@@ -569,7 +590,7 @@ w32font_draw (s, from, to, x, y, with_background)
     {
       HBRUSH brush;
       RECT rect;
-      struct font *font = (struct font *) s->face->font_info;
+      struct font *font = s->font;
 
       brush = CreateSolidBrush (s->gc->background);
       rect.left = x;
@@ -725,7 +746,7 @@ w32font_list_internal (frame, font_spec, opentype_only)
       release_frame_dc (f, dc);
     }
 
-  return NILP (match_data.list) ? null_vector : Fvconcat (1, &match_data.list);
+  return NILP (match_data.list) ? Qnil : match_data.list;
 }
 
 /* Internal implementation of w32font_match.
@@ -762,27 +783,36 @@ w32font_match_internal (frame, font_spec, opentype_only)
 }
 
 int
-w32font_open_internal (f, font_entity, pixel_size, w32_font)
+w32font_open_internal (f, font_entity, pixel_size, font_object)
      FRAME_PTR f;
      Lisp_Object font_entity;
      int pixel_size;
-     struct w32font_info *w32_font;
+     Lisp_Object font_object;
 {
-  int len, size;
+  int len, size, i;
   LOGFONT logfont;
   HDC dc;
   HFONT hfont, old_font;
   Lisp_Object val, extra;
-  /* For backwards compatibility.  */
-  W32FontStruct *compat_w32_font;
+  struct w32font_info *w32_font;
+  struct font * font;
+  OUTLINETEXTMETRIC* metrics = NULL;
+
+  w32_font = (struct w32font_info *) XFONT_OBJECT (font_object);
+  font = (struct font *) w32_font;
 
-  struct font * font = (struct font *) w32_font;
   if (!font)
     return 0;
 
   bzero (&logfont, sizeof (logfont));
   fill_in_logfont (f, &logfont, font_entity);
 
+  /* Prefer truetype fonts, to avoid known problems with type1 fonts, and
+     limitations in bitmap fonts.  */
+  val = AREF (font_entity, FONT_FOUNDRY_INDEX);
+  if (!EQ (val, Qraster))
+    logfont.lfOutPrecision = OUT_TT_PRECIS;
+
   size = XINT (AREF (font_entity, FONT_SIZE_INDEX));
   if (!size)
     size = pixel_size;
@@ -797,30 +827,34 @@ w32font_open_internal (f, font_entity, pixel_size, w32_font)
   dc = get_frame_dc (f);
   old_font = SelectObject (dc, hfont);
 
-  GetTextMetrics (dc, &w32_font->metrics);
+  /* Try getting the outline metrics (only works for truetype fonts).  */
+  len = GetOutlineTextMetrics (dc, 0, NULL);
+  if (len)
+    {
+      metrics = (OUTLINETEXTMETRIC *) alloca (len);
+      if (GetOutlineTextMetrics (dc, len, metrics))
+        bcopy (&metrics->otmTextMetrics, &w32_font->metrics,
+               sizeof (TEXTMETRIC));
+      else
+        metrics = NULL;
+
+      /* If it supports outline metrics, it should support Glyph Indices.  */
+      w32_font->glyph_idx = ETO_GLYPH_INDEX;
+    }
 
-  w32_font->glyph_idx = ETO_GLYPH_INDEX;
+  if (!metrics)
+    {
+      GetTextMetrics (dc, &w32_font->metrics);
+      w32_font->glyph_idx = 0;
+    }
 
-  /* Cache ASCII metrics.  */
-  recompute_cached_metrics (dc, w32_font);
+  w32_font->cached_metrics = NULL;
+  w32_font->n_cache_blocks = 0;
 
   SelectObject (dc, old_font);
   release_frame_dc (f, dc);
 
-  /* W32FontStruct - we should get rid of this, and use the w32font_info
-     struct for any W32 specific fields. font->font.font can then be hfont.  */
-  font->font.font = xmalloc (sizeof (W32FontStruct));
-  compat_w32_font = (W32FontStruct *) font->font.font;
-  bzero (compat_w32_font, sizeof (W32FontStruct));
-  compat_w32_font->font_type = UNICODE_FONT;
-  /* Duplicate the text metrics.  */
-  bcopy (&w32_font->metrics,  &compat_w32_font->tm, sizeof (TEXTMETRIC));
-  compat_w32_font->hfont = hfont;
-
-  len = strlen (logfont.lfFaceName);
-  font->font.name = (char *) xmalloc (len + 1);
-  bcopy (logfont.lfFaceName, font->font.name, len);
-  font->font.name[len] = '\0';
+  w32_font->hfont = hfont;
 
   {
     char *name;
@@ -828,36 +862,32 @@ w32font_open_internal (f, font_entity, pixel_size, w32_font)
     /* We don't know how much space we need for the full name, so start with
        96 bytes and go up in steps of 32.  */
     len = 96;
-    name = xmalloc (len);
+    name = alloca (len);
     while (name && w32font_full_name (&logfont, font_entity, pixel_size,
                                       name, len) < 0)
       {
-        char *new = xrealloc (name, len += 32);
-
-        if (! new)
-          xfree (name);
-        name = new;
+        len += 32;
+        name = alloca (len);
       }
     if (name)
-      font->font.full_name = name;
+      font->props[FONT_FULLNAME_INDEX]
+        = make_unibyte_string (name, strlen (name));
     else
-      font->font.full_name = font->font.name;
+      font->props[FONT_FULLNAME_INDEX] =
+        make_unibyte_string (logfont.lfFaceName, len);
   }
-  font->font.charset = 0;
-  font->font.codepage = 0;
-  font->font.size = w32_font->metrics.tmMaxCharWidth;
-  font->font.height = w32_font->metrics.tmHeight
+
+  font->max_width = w32_font->metrics.tmMaxCharWidth;
+  font->height = w32_font->metrics.tmHeight
     + w32_font->metrics.tmExternalLeading;
-  font->font.space_width = font->font.average_width
-    = w32_font->metrics.tmAveCharWidth;
-
-  font->font.vertical_centering = 0;
-  font->font.encoding_type = 0;
-  font->font.baseline_offset = 0;
-  font->font.relative_compose = 0;
-  font->font.default_ascent = w32_font->metrics.tmAscent;
-  font->font.font_encoder = NULL;
-  font->entity = font_entity;
+  font->space_width = font->average_width = w32_font->metrics.tmAveCharWidth;
+
+  font->vertical_centering = 0;
+  font->encoding_type = 0;
+  font->baseline_offset = 0;
+  font->relative_compose = 0;
+  font->default_ascent = w32_font->metrics.tmAscent;
+  font->font_encoder = NULL;
   font->pixel_size = size;
   font->driver = &w32font_driver;
   /* Use format cached during list, as the information we have access to
@@ -867,50 +897,37 @@ w32font_open_internal (f, font_entity, pixel_size, w32_font)
     {
       val = assq_no_quit (QCformat, extra);
       if (CONSP (val))
-        font->format = XCDR (val);
+        font->props[FONT_FORMAT_INDEX] = XCDR (val);
       else
-        font->format = Qunknown;
+        font->props[FONT_FORMAT_INDEX] = Qunknown;
     }
   else
-    font->format = Qunknown;
+    font->props[FONT_FORMAT_INDEX] = Qunknown;
 
-  font->file_name = NULL;
+  font->props[FONT_FILE_INDEX] = Qnil;
   font->encoding_charset = -1;
   font->repertory_charset = -1;
   /* TODO: do we really want the minimum width here, which could be negative? */
-  font->min_width = font->font.space_width;
+  font->min_width = font->space_width;
   font->ascent = w32_font->metrics.tmAscent;
   font->descent = w32_font->metrics.tmDescent;
-  font->scalable = w32_font->metrics.tmPitchAndFamily & TMPF_VECTOR;
 
-  /* Set global flag fonts_changed_p to non-zero if the font loaded
-     has a character with a smaller width than any other character
-     before, or if the font loaded has a smaller height than any other
-     font loaded before.  If this happens, it will make a glyph matrix
-     reallocation necessary.  */
-  {
-    struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
-    dpyinfo->n_fonts++;
+  if (metrics)
+    {
+      font->underline_thickness = metrics->otmsUnderscoreSize;
+      font->underline_position = -metrics->otmsUnderscorePosition;
+    }
+  else
+    {
+      font->underline_thickness = 0;
+      font->underline_position = -1;
+    }
 
-    if (dpyinfo->n_fonts == 1)
-      {
-        dpyinfo->smallest_font_height = font->font.height;
-        dpyinfo->smallest_char_width = font->min_width;
-      }
-    else
-      {
-        if (dpyinfo->smallest_font_height > font->font.height)
-          {
-            dpyinfo->smallest_font_height = font->font.height;
-            fonts_changed_p |= 1;
-          }
-        if (dpyinfo->smallest_char_width > font->min_width)
-          {
-            dpyinfo->smallest_char_width = font->min_width;
-            fonts_changed_p |= 1;
-          }
-      }
-  }
+  /* For temporary compatibility with legacy code that expects the
+     name to be usable in x-list-fonts. Eventually we expect to change
+     x-list-fonts and other places that use fonts so that this can be
+     an fcname or similar.  */
+  font->props[FONT_NAME_INDEX] = Ffont_xlfd_name (font_object, Qnil);
 
   return 1;
 }
@@ -931,14 +948,17 @@ add_font_name_to_list (logical_font, physical_font, font_type, list_object)
   if (logical_font->elfLogFont.lfFaceName[0] == '@')
     return 1;
 
-  family = intern_downcase (logical_font->elfLogFont.lfFaceName,
-                            strlen (logical_font->elfLogFont.lfFaceName));
+  family = font_intern_prop (logical_font->elfLogFont.lfFaceName,
+                            strlen (logical_font->elfLogFont.lfFaceName), 1);
   if (! memq_no_quit (family, *list))
     *list = Fcons (family, *list);
 
   return 1;
 }
 
+static int w32_decode_weight P_ ((int));
+static int w32_encode_weight P_ ((int));
+
 /* Convert an enumerated Windows font to an Emacs font entity.  */
 static Lisp_Object
 w32_enumfont_pattern_entity (frame, logical_font, physical_font,
@@ -955,16 +975,15 @@ w32_enumfont_pattern_entity (frame, logical_font, physical_font,
   BYTE generic_type;
   DWORD full_type = physical_font->ntmTm.ntmFlags;
 
-  entity = Fmake_vector (make_number (FONT_ENTITY_MAX), Qnil);
+  entity = font_make_entity ();
 
   ASET (entity, FONT_TYPE_INDEX, backend);
-  ASET (entity, FONT_FRAME_INDEX, frame);
   ASET (entity, FONT_REGISTRY_INDEX, w32_registry (lf->lfCharSet, font_type));
   ASET (entity, FONT_OBJLIST_INDEX, Qnil);
 
   /* Foundry is difficult to get in readable form on Windows.
      But Emacs crashes if it is not set, so set it to something more
-     generic.  Thes values make xflds compatible with Emacs 22. */
+     generic.  These values make xlfds compatible with Emacs 22. */
   if (lf->lfOutPrecision == OUT_STRING_PRECIS)
     tem = Qraster;
   else if (lf->lfOutPrecision == OUT_STROKE_PRECIS)
@@ -988,14 +1007,14 @@ w32_enumfont_pattern_entity (frame, logical_font, physical_font,
   else if (generic_type == FF_SWISS)
     tem = Qsans;
   else
-    tem = null_string;
+    tem = Qnil;
 
   ASET (entity, FONT_ADSTYLE_INDEX, tem);
 
   if (physical_font->ntmTm.tmPitchAndFamily & 0x01)
-    font_put_extra (entity, QCspacing, make_number (FONT_SPACING_PROPORTIONAL));
+    ASET (entity, FONT_SPACING_INDEX, make_number (FONT_SPACING_PROPORTIONAL));
   else
-    font_put_extra (entity, QCspacing, make_number (FONT_SPACING_MONO));
+    ASET (entity, FONT_SPACING_INDEX, make_number (FONT_SPACING_CHARCELL));
 
   if (requested_font->lfQuality != DEFAULT_QUALITY)
     {
@@ -1003,16 +1022,20 @@ w32_enumfont_pattern_entity (frame, logical_font, physical_font,
                       lispy_antialias_type (requested_font->lfQuality));
     }
   ASET (entity, FONT_FAMILY_INDEX,
-        intern_downcase (lf->lfFaceName, strlen (lf->lfFaceName)));
+        font_intern_prop (lf->lfFaceName, strlen (lf->lfFaceName), 1));
 
-  ASET (entity, FONT_WEIGHT_INDEX, make_number (lf->lfWeight));
-  ASET (entity, FONT_SLANT_INDEX, make_number (lf->lfItalic ? 200 : 100));
+  FONT_SET_STYLE (entity, FONT_WEIGHT_INDEX,
+                 make_number (w32_decode_weight (lf->lfWeight)));
+  FONT_SET_STYLE (entity, FONT_SLANT_INDEX,
+                 make_number (lf->lfItalic ? 200 : 100));
   /* TODO: PANOSE struct has this info, but need to call GetOutlineTextMetrics
      to get it.  */
-  ASET (entity, FONT_WIDTH_INDEX, make_number (100));
+  FONT_SET_STYLE (entity, FONT_WIDTH_INDEX, make_number (100));
 
   if (font_type & RASTER_FONTTYPE)
-    ASET (entity, FONT_SIZE_INDEX, make_number (physical_font->ntmTm.tmHeight));
+    ASET (entity, FONT_SIZE_INDEX,
+          make_number (physical_font->ntmTm.tmHeight
+                       + physical_font->ntmTm.tmExternalLeading));
   else
     ASET (entity, FONT_SIZE_INDEX, make_number (0));
 
@@ -1020,8 +1043,9 @@ w32_enumfont_pattern_entity (frame, logical_font, physical_font,
      of getting this information easily.  */
   if (font_type & TRUETYPE_FONTTYPE)
     {
-      font_put_extra (entity, QCscript,
-                      font_supported_scripts (&physical_font->ntmFontSig));
+      tem = font_supported_scripts (&physical_font->ntmFontSig);
+      if (!NILP (tem))
+        font_put_extra (entity, QCscript, tem);
     }
 
   /* This information is not fully available when opening fonts, so
@@ -1087,6 +1111,11 @@ logfonts_match (font, pattern)
   return 1;
 }
 
+/* Codepage Bitfields in FONTSIGNATURE struct.  */
+#define CSB_JAPANESE (1 << 17)
+#define CSB_KOREAN ((1 << 19) | (1 << 21))
+#define CSB_CHINESE ((1 << 18) | (1 << 20))
+
 static int
 font_matches_spec (type, font, spec, backend, logfont)
      DWORD type;
@@ -1099,14 +1128,14 @@ font_matches_spec (type, font, spec, backend, logfont)
 
   /* Check italic. Can't check logfonts, since it is a boolean field,
      so there is no difference between "non-italic" and "don't care".  */
-  val = AREF (spec, FONT_SLANT_INDEX);
-  if (INTEGERP (val))
-    {
-      int slant = XINT (val);
-      if ((slant > 150 && !font->ntmTm.tmItalic)
-          || (slant <= 150 && font->ntmTm.tmItalic))
-        return 0;
-    }
+  {
+    int slant = FONT_SLANT_NUMERIC (spec);
+
+    if (slant >= 0
+       && ((slant > 150 && !font->ntmTm.tmItalic)
+           || (slant <= 150 && font->ntmTm.tmItalic)))
+         return 0;
+  }
 
   /* Check adstyle against generic family.  */
   val = AREF (spec, FONT_ADSTYLE_INDEX);
@@ -1118,6 +1147,18 @@ font_matches_spec (type, font, spec, backend, logfont)
         return 0;
     }
 
+  /* Check spacing */
+  val = AREF (spec, FONT_SPACING_INDEX);
+  if (INTEGERP (val))
+    {
+      int spacing = XINT (val);
+      int proportional = (spacing < FONT_SPACING_MONO);
+
+      if ((proportional && !(font->ntmTm.tmPitchAndFamily & 0x01))
+         || (!proportional && (font->ntmTm.tmPitchAndFamily & 0x01)))
+       return 0;
+    }
+
   /* Check extra parameters.  */
   for (extra = AREF (spec, FONT_EXTRA_INDEX);
        CONSP (extra); extra = XCDR (extra))
@@ -1127,27 +1168,9 @@ font_matches_spec (type, font, spec, backend, logfont)
       if (CONSP (extra_entry))
         {
           Lisp_Object key = XCAR (extra_entry);
-          val = XCDR (extra_entry);
-          if (EQ (key, QCspacing))
-            {
-              int proportional;
-              if (INTEGERP (val))
-                {
-                  int spacing = XINT (val);
-                  proportional = (spacing < FONT_SPACING_MONO);
-                }
-              else if (EQ (val, Qp))
-                proportional = 1;
-              else if (EQ (val, Qc) || EQ (val, Qm))
-                proportional = 0;
-              else
-                return 0; /* Bad font spec.  */
 
-              if ((proportional && !(font->ntmTm.tmPitchAndFamily & 0x01))
-                  || (!proportional && (font->ntmTm.tmPitchAndFamily & 0x01)))
-                return 0;
-            }
-          else if (EQ (key, QCscript) && SYMBOLP (val))
+          val = XCDR (extra_entry);
+          if (EQ (key, QCscript) && SYMBOLP (val))
             {
               /* Only truetype fonts will have information about what
                  scripts they support.  This probably means the user
@@ -1235,6 +1258,38 @@ font_matches_spec (type, font, spec, backend, logfont)
                     return 0;
                 }
             }
+         else if (EQ (key, QClang) && SYMBOLP (val))
+           {
+             /* Just handle the CJK languages here, as the lang
+                parameter is used to select a font with appropriate
+                glyphs in the cjk unified ideographs block. Other fonts
+                support for a language can be solely determined by
+                its character coverage.  */
+             if (EQ (val, Qja))
+               {
+                 if (!(font->ntmFontSig.fsCsb[0] & CSB_JAPANESE))
+                   return 0;
+               }
+             else if (EQ (val, Qko))
+               {
+                 if (!(font->ntmFontSig.fsCsb[0] & CSB_KOREAN))
+                   return 0;
+               }
+             else if (EQ (val, Qzh))
+               {
+                 if (!(font->ntmFontSig.fsCsb[0] & CSB_CHINESE))
+                    return 0;
+               }
+             else
+               /* Any other language, we don't recognize it. Only the above
+                   currently appear in fontset.el, so it isn't worth
+                   creating a mapping table of codepages/scripts to languages
+                   or opening the font to see if there are any language tags
+                   in it that the W32 API does not expose. Fontset
+                  spec should have a fallback, as some backends do
+                  not recognize language at all.  */
+               return 0;
+           }
           else if (EQ (key, QCotf) && CONSP (val))
            {
              /* OTF features only supported by the uniscribe backend.  */
@@ -1295,8 +1350,14 @@ add_font_entity_to_list (logical_font, physical_font, font_type, lParam)
   Lisp_Object backend = match_data->opentype_only ? Quniscribe : Qgdi;
 
   if ((!match_data->opentype_only
-       || (physical_font->ntmTm.ntmFlags & NTMFLAGS_OPENTYPE)
-       || (font_type & TRUETYPE_FONTTYPE))
+       || (((physical_font->ntmTm.ntmFlags & NTMFLAGS_OPENTYPE)
+            || (font_type & TRUETYPE_FONTTYPE))
+           /* For the uniscribe backend, only consider fonts that claim
+              to cover at least some part of Unicode.  */
+           && (physical_font->ntmFontSig.fsUsb[3]
+               || physical_font->ntmFontSig.fsUsb[2]
+               || physical_font->ntmFontSig.fsUsb[1]
+               || (physical_font->ntmFontSig.fsUsb[0] & 0x3fffffff))))
       && logfonts_match (&logical_font->elfLogFont, &match_data->pattern)
       && font_matches_spec (font_type, physical_font,
                             match_data->orig_font_spec, backend,
@@ -1320,7 +1381,48 @@ add_font_entity_to_list (logical_font, physical_font, font_type, lParam)
                                        &match_data->pattern,
                                        backend);
       if (!NILP (entity))
-        match_data->list = Fcons (entity, match_data->list);
+        {
+          Lisp_Object spec_charset = AREF (match_data->orig_font_spec,
+                                           FONT_REGISTRY_INDEX);
+
+          /* If registry was specified as iso10646-1, only report
+             ANSI and DEFAULT charsets, as most unicode fonts will
+             contain one of those plus others.  */
+          if ((EQ (spec_charset, Qiso10646_1)
+               || EQ (spec_charset, Qunicode_bmp)
+               || EQ (spec_charset, Qunicode_sip))
+              && logical_font->elfLogFont.lfCharSet != DEFAULT_CHARSET
+              && logical_font->elfLogFont.lfCharSet != ANSI_CHARSET)
+            return 1;
+          /* If registry was specified, but did not map to a windows
+             charset, only report fonts that have unknown charsets.
+             This will still report fonts that don't match, but at
+             least it eliminates known definite mismatches.  */
+          else if (!NILP (spec_charset)
+                   && !EQ (spec_charset, Qiso10646_1)
+                   && !EQ (spec_charset, Qunicode_bmp)
+                   && !EQ (spec_charset, Qunicode_sip)
+                   && match_data->pattern.lfCharSet == DEFAULT_CHARSET
+                   && logical_font->elfLogFont.lfCharSet != DEFAULT_CHARSET)
+            return 1;
+
+          /* If registry was specified, ensure it is reported as the same.  */
+          if (!NILP (spec_charset))
+            ASET (entity, FONT_REGISTRY_INDEX, spec_charset);
+
+          match_data->list = Fcons (entity, match_data->list);
+
+          /* If no registry specified, duplicate iso8859-1 truetype fonts
+             as iso10646-1.  */
+          if (NILP (spec_charset)
+              && font_type == TRUETYPE_FONTTYPE
+              && logical_font->elfLogFont.lfCharSet == ANSI_CHARSET)
+            {
+              Lisp_Object tem = Fcopy_font_spec (entity);
+              ASET (tem, FONT_REGISTRY_INDEX, Qiso10646_1);
+              match_data->list = Fcons (tem, match_data->list);
+            }
+        }
     }
   return 1;
 }
@@ -1342,6 +1444,89 @@ add_one_font_entity_to_list (logical_font, physical_font, font_type, lParam)
   return !NILP (match_data->list);
 }
 
+/* Old function to convert from x to w32 charset, from w32fns.c.  */
+static LONG
+x_to_w32_charset (lpcs)
+    char * lpcs;
+{
+  Lisp_Object this_entry, w32_charset;
+  char *charset;
+  int len = strlen (lpcs);
+
+  /* Support "*-#nnn" format for unknown charsets.  */
+  if (strncmp (lpcs, "*-#", 3) == 0)
+    return atoi (lpcs + 3);
+
+  /* All Windows fonts qualify as unicode.  */
+  if (!strncmp (lpcs, "iso10646", 8))
+    return DEFAULT_CHARSET;
+
+  /* Handle wildcards by ignoring them; eg. treat "big5*-*" as "big5".  */
+  charset = alloca (len + 1);
+  strcpy (charset, lpcs);
+  lpcs = strchr (charset, '*');
+  if (lpcs)
+    *lpcs = '\0';
+
+  /* Look through w32-charset-info-alist for the character set.
+     Format of each entry is
+       (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
+  */
+  this_entry = Fassoc (build_string (charset), Vw32_charset_info_alist);
+
+  if (NILP (this_entry))
+    {
+      /* At startup, we want iso8859-1 fonts to come up properly. */
+      if (xstrcasecmp (charset, "iso8859-1") == 0)
+        return ANSI_CHARSET;
+      else
+        return DEFAULT_CHARSET;
+    }
+
+  w32_charset = Fcar (Fcdr (this_entry));
+
+  /* Translate Lisp symbol to number.  */
+  if (EQ (w32_charset, Qw32_charset_ansi))
+    return ANSI_CHARSET;
+  if (EQ (w32_charset, Qw32_charset_symbol))
+    return SYMBOL_CHARSET;
+  if (EQ (w32_charset, Qw32_charset_shiftjis))
+    return SHIFTJIS_CHARSET;
+  if (EQ (w32_charset, Qw32_charset_hangeul))
+    return HANGEUL_CHARSET;
+  if (EQ (w32_charset, Qw32_charset_chinesebig5))
+    return CHINESEBIG5_CHARSET;
+  if (EQ (w32_charset, Qw32_charset_gb2312))
+    return GB2312_CHARSET;
+  if (EQ (w32_charset, Qw32_charset_oem))
+    return OEM_CHARSET;
+  if (EQ (w32_charset, Qw32_charset_johab))
+    return JOHAB_CHARSET;
+  if (EQ (w32_charset, Qw32_charset_easteurope))
+    return EASTEUROPE_CHARSET;
+  if (EQ (w32_charset, Qw32_charset_turkish))
+    return TURKISH_CHARSET;
+  if (EQ (w32_charset, Qw32_charset_baltic))
+    return BALTIC_CHARSET;
+  if (EQ (w32_charset, Qw32_charset_russian))
+    return RUSSIAN_CHARSET;
+  if (EQ (w32_charset, Qw32_charset_arabic))
+    return ARABIC_CHARSET;
+  if (EQ (w32_charset, Qw32_charset_greek))
+    return GREEK_CHARSET;
+  if (EQ (w32_charset, Qw32_charset_hebrew))
+    return HEBREW_CHARSET;
+  if (EQ (w32_charset, Qw32_charset_vietnamese))
+    return VIETNAMESE_CHARSET;
+  if (EQ (w32_charset, Qw32_charset_thai))
+    return THAI_CHARSET;
+  if (EQ (w32_charset, Qw32_charset_mac))
+    return MAC_CHARSET;
+
+  return DEFAULT_CHARSET;
+}
+
+
 /* Convert a Lisp font registry (symbol) to a windows charset.  */
 static LONG
 registry_to_w32_charset (charset)
@@ -1354,28 +1539,264 @@ registry_to_w32_charset (charset)
     return ANSI_CHARSET;
   else if (SYMBOLP (charset))
     return x_to_w32_charset (SDATA (SYMBOL_NAME (charset)));
-  else if (STRINGP (charset))
-    return x_to_w32_charset (SDATA (charset));
   else
     return DEFAULT_CHARSET;
 }
 
+/* Old function to convert from w32 to x charset, from w32fns.c.  */
+static char *
+w32_to_x_charset (fncharset, matching)
+    int fncharset;
+    char *matching;
+{
+  static char buf[32];
+  Lisp_Object charset_type;
+  int match_len = 0;
+
+  if (matching)
+    {
+      /* If fully specified, accept it as it is.  Otherwise use a
+        substring match. */
+      char *wildcard = strchr (matching, '*');
+      if (wildcard)
+       *wildcard = '\0';
+      else if (strchr (matching, '-'))
+       return matching;
+
+      match_len = strlen (matching);
+    }
+
+  switch (fncharset)
+    {
+    case ANSI_CHARSET:
+      /* Handle startup case of w32-charset-info-alist not
+         being set up yet. */
+      if (NILP (Vw32_charset_info_alist))
+        return "iso8859-1";
+      charset_type = Qw32_charset_ansi;
+      break;
+    case DEFAULT_CHARSET:
+      charset_type = Qw32_charset_default;
+      break;
+    case SYMBOL_CHARSET:
+      charset_type = Qw32_charset_symbol;
+      break;
+    case SHIFTJIS_CHARSET:
+      charset_type = Qw32_charset_shiftjis;
+      break;
+    case HANGEUL_CHARSET:
+      charset_type = Qw32_charset_hangeul;
+      break;
+    case GB2312_CHARSET:
+      charset_type = Qw32_charset_gb2312;
+      break;
+    case CHINESEBIG5_CHARSET:
+      charset_type = Qw32_charset_chinesebig5;
+      break;
+    case OEM_CHARSET:
+      charset_type = Qw32_charset_oem;
+      break;
+    case EASTEUROPE_CHARSET:
+      charset_type = Qw32_charset_easteurope;
+      break;
+    case TURKISH_CHARSET:
+      charset_type = Qw32_charset_turkish;
+      break;
+    case BALTIC_CHARSET:
+      charset_type = Qw32_charset_baltic;
+      break;
+    case RUSSIAN_CHARSET:
+      charset_type = Qw32_charset_russian;
+      break;
+    case ARABIC_CHARSET:
+      charset_type = Qw32_charset_arabic;
+      break;
+    case GREEK_CHARSET:
+      charset_type = Qw32_charset_greek;
+      break;
+    case HEBREW_CHARSET:
+      charset_type = Qw32_charset_hebrew;
+      break;
+    case VIETNAMESE_CHARSET:
+      charset_type = Qw32_charset_vietnamese;
+      break;
+    case THAI_CHARSET:
+      charset_type = Qw32_charset_thai;
+      break;
+    case MAC_CHARSET:
+      charset_type = Qw32_charset_mac;
+      break;
+    case JOHAB_CHARSET:
+      charset_type = Qw32_charset_johab;
+      break;
+
+    default:
+      /* Encode numerical value of unknown charset.  */
+      sprintf (buf, "*-#%u", fncharset);
+      return buf;
+    }
+
+  {
+    Lisp_Object rest;
+    char * best_match = NULL;
+    int matching_found = 0;
+
+    /* Look through w32-charset-info-alist for the character set.
+       Prefer ISO codepages, and prefer lower numbers in the ISO
+       range. Only return charsets for codepages which are installed.
+
+       Format of each entry is
+         (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
+    */
+    for (rest = Vw32_charset_info_alist; CONSP (rest); rest = XCDR (rest))
+      {
+        char * x_charset;
+        Lisp_Object w32_charset;
+        Lisp_Object codepage;
+
+        Lisp_Object this_entry = XCAR (rest);
+
+        /* Skip invalid entries in alist. */
+        if (!CONSP (this_entry) || !STRINGP (XCAR (this_entry))
+            || !CONSP (XCDR (this_entry))
+            || !SYMBOLP (XCAR (XCDR (this_entry))))
+          continue;
+
+        x_charset = SDATA (XCAR (this_entry));
+        w32_charset = XCAR (XCDR (this_entry));
+        codepage = XCDR (XCDR (this_entry));
+
+        /* Look for Same charset and a valid codepage (or non-int
+           which means ignore).  */
+        if (EQ (w32_charset, charset_type)
+            && (!INTEGERP (codepage) || XINT (codepage) == CP_DEFAULT
+                || IsValidCodePage (XINT (codepage))))
+          {
+            /* If we don't have a match already, then this is the
+               best.  */
+            if (!best_match)
+             {
+               best_match = x_charset;
+               if (matching && !strnicmp (x_charset, matching, match_len))
+                 matching_found = 1;
+             }
+           /* If we already found a match for MATCHING, then
+              only consider other matches.  */
+           else if (matching_found
+                    && strnicmp (x_charset, matching, match_len))
+             continue;
+           /* If this matches what we want, and the best so far doesn't,
+              then this is better.  */
+           else if (!matching_found && matching
+                    && !strnicmp (x_charset, matching, match_len))
+             {
+               best_match = x_charset;
+               matching_found = 1;
+             }
+           /* If this is fully specified, and the best so far isn't,
+              then this is better.  */
+           else if ((!strchr (best_match, '-') && strchr (x_charset, '-'))
+           /* If this is an ISO codepage, and the best so far isn't,
+              then this is better, but only if it fully specifies the
+              encoding.  */
+               || (strnicmp (best_match, "iso", 3) != 0
+                   && strnicmp (x_charset, "iso", 3) == 0
+                   && strchr (x_charset, '-')))
+               best_match = x_charset;
+            /* If both are ISO8859 codepages, choose the one with the
+               lowest number in the encoding field.  */
+            else if (strnicmp (best_match, "iso8859-", 8) == 0
+                     && strnicmp (x_charset, "iso8859-", 8) == 0)
+              {
+                int best_enc = atoi (best_match + 8);
+                int this_enc = atoi (x_charset + 8);
+                if (this_enc > 0 && this_enc < best_enc)
+                  best_match = x_charset;
+              }
+          }
+      }
+
+    /* If no match, encode the numeric value. */
+    if (!best_match)
+      {
+        sprintf (buf, "*-#%u", fncharset);
+        return buf;
+      }
+
+    strncpy (buf, best_match, 31);
+    /* If the charset is not fully specified, put -0 on the end.  */
+    if (!strchr (best_match, '-'))
+      {
+       int pos = strlen (best_match);
+       /* Charset specifiers shouldn't be very long.  If it is a made
+          up one, truncating it should not do any harm since it isn't
+          recognized anyway.  */
+       if (pos > 29)
+         pos = 29;
+       strcpy (buf + pos, "-0");
+      }
+    buf[31] = '\0';
+    return buf;
+  }
+}
+
 static Lisp_Object
 w32_registry (w32_charset, font_type)
      LONG w32_charset;
      DWORD font_type;
 {
-  /* If charset is defaulted, use ANSI (unicode for truetype fonts).  */
+  char *charset;
+
+  /* If charset is defaulted, charset is unicode or unknown, depending on
+     font type.  */
   if (w32_charset == DEFAULT_CHARSET)
-    w32_charset = ANSI_CHARSET;
+    return font_type == TRUETYPE_FONTTYPE ? Qiso10646_1 : Qunknown;
 
-  if (font_type == TRUETYPE_FONTTYPE && w32_charset == ANSI_CHARSET)
-    return Qiso10646_1;
-  else
-    {
-      char * charset = w32_to_x_charset (w32_charset, NULL);
-      return intern_downcase (charset, strlen(charset));
-    }
+  charset = w32_to_x_charset (w32_charset, NULL);
+  return font_intern_prop (charset, strlen(charset), 1);
+}
+
+static int
+w32_decode_weight (fnweight)
+     int fnweight;
+{
+  if (fnweight >= FW_HEAVY)      return 210;
+  if (fnweight >= FW_EXTRABOLD)  return 205;
+  if (fnweight >= FW_BOLD)       return 200;
+  if (fnweight >= FW_SEMIBOLD)   return 180;
+  if (fnweight >= FW_NORMAL)     return 100;
+  if (fnweight >= FW_LIGHT)      return 50;
+  if (fnweight >= FW_EXTRALIGHT) return 40;
+  if (fnweight > FW_THIN)        return 20;
+  return 0;
+}
+
+static int
+w32_encode_weight (n)
+     int n;
+{
+  if (n >= 210) return FW_HEAVY;
+  if (n >= 205) return FW_EXTRABOLD;
+  if (n >= 200) return FW_BOLD;
+  if (n >= 180) return FW_SEMIBOLD;
+  if (n >= 100) return FW_NORMAL;
+  if (n >= 50)  return FW_LIGHT;
+  if (n >= 40)  return FW_EXTRALIGHT;
+  if (n >= 20)  return  FW_THIN;
+  return 0;
+}
+
+/* Convert a Windows font weight into one of the weights supported
+   by fontconfig (see font.c:font_parse_fcname).  */
+static Lisp_Object
+w32_to_fc_weight (n)
+     int n;
+{
+  if (n >= FW_EXTRABOLD) return intern ("black");
+  if (n >= FW_BOLD) return intern ("bold");
+  if (n >= FW_SEMIBOLD) return intern ("demibold");
+  if (n >= FW_NORMAL) return intern ("medium");
+  return intern ("light");
 }
 
 /* Fill in all the available details of LOGFONT from FONT_SPEC.  */
@@ -1388,19 +1809,14 @@ fill_in_logfont (f, logfont, font_spec)
   Lisp_Object tmp, extra;
   int dpi = FRAME_W32_DISPLAY_INFO (f)->resy;
 
-  extra = AREF (font_spec, FONT_EXTRA_INDEX);
-  /* Allow user to override dpi settings.  */
-  if (CONSP (extra))
+  tmp = AREF (font_spec, FONT_DPI_INDEX);
+  if (INTEGERP (tmp))
     {
-      tmp = assq_no_quit (QCdpi, extra);
-      if (CONSP (tmp) && INTEGERP (XCDR (tmp)))
-        {
-          dpi = XINT (XCDR (tmp));
-        }
-      else if (CONSP (tmp) && FLOATP (XCDR (tmp)))
-        {
-          dpi = (int) (XFLOAT_DATA (XCDR (tmp)) + 0.5);
-        }
+      dpi = XINT (tmp);
+    }
+  else if (FLOATP (tmp))
+    {
+      dpi = (int) (XFLOAT_DATA (tmp) + 0.5);
     }
 
   /* Height  */
@@ -1417,13 +1833,13 @@ fill_in_logfont (f, logfont, font_spec)
   /* Weight  */
   tmp = AREF (font_spec, FONT_WEIGHT_INDEX);
   if (INTEGERP (tmp))
-    logfont->lfWeight = XINT (tmp);
+    logfont->lfWeight = w32_encode_weight (FONT_WEIGHT_NUMERIC (font_spec));
 
   /* Italic  */
   tmp = AREF (font_spec, FONT_SLANT_INDEX);
   if (INTEGERP (tmp))
     {
-      int slant = XINT (tmp);
+      int slant = FONT_SLANT_NUMERIC (font_spec);
       logfont->lfItalic = slant > 150 ? 1 : 0;
     }
 
@@ -1458,8 +1874,6 @@ fill_in_logfont (f, logfont, font_spec)
            user input.  */
       else if (SYMBOLP (tmp))
         strncpy (logfont->lfFaceName, SDATA (SYMBOL_NAME (tmp)), LF_FACESIZE);
-      else if (STRINGP (tmp))
-        strncpy (logfont->lfFaceName, SDATA (tmp), LF_FACESIZE);
     }
 
   tmp = AREF (font_spec, FONT_ADSTYLE_INDEX);
@@ -1471,41 +1885,36 @@ fill_in_logfont (f, logfont, font_spec)
         logfont->lfPitchAndFamily = family | DEFAULT_PITCH;
     }
 
+
+  /* Set pitch based on the spacing property.  */
+  tmp = AREF (font_spec, FONT_SPACING_INDEX);
+  if (INTEGERP (tmp))
+    {
+      int spacing = XINT (tmp);
+      if (spacing < FONT_SPACING_MONO)
+       logfont->lfPitchAndFamily
+         = logfont->lfPitchAndFamily & 0xF0 | VARIABLE_PITCH;
+      else
+       logfont->lfPitchAndFamily
+         = logfont->lfPitchAndFamily & 0xF0 | FIXED_PITCH;
+    }
+
   /* Process EXTRA info.  */
-  for ( ; CONSP (extra); extra = XCDR (extra))
+  for (extra = AREF (font_spec, FONT_EXTRA_INDEX);
+       CONSP (extra); extra = XCDR (extra))
     {
       tmp = XCAR (extra);
       if (CONSP (tmp))
         {
           Lisp_Object key, val;
           key = XCAR (tmp), val = XCDR (tmp);
-          if (EQ (key, QCspacing))
-            {
-              /* Set pitch based on the spacing property.  */
-              if (INTEGERP (val))
-                {
-                  int spacing = XINT (val);
-                  if (spacing < FONT_SPACING_MONO)
-                    logfont->lfPitchAndFamily
-                      = logfont->lfPitchAndFamily & 0xF0 | VARIABLE_PITCH;
-                  else
-                    logfont->lfPitchAndFamily
-                      = logfont->lfPitchAndFamily & 0xF0 | FIXED_PITCH;
-                }
-              else if (EQ (val, Qp))
-                logfont->lfPitchAndFamily
-                  = logfont->lfPitchAndFamily & 0xF0 | VARIABLE_PITCH;
-              else if (EQ (val, Qc) || EQ (val, Qm))
-                logfont->lfPitchAndFamily
-                  = logfont->lfPitchAndFamily & 0xF0 | FIXED_PITCH;
-            }
           /* Only use QCscript if charset is not provided, or is unicode
              and a single script is specified.  This is rather crude,
              and is only used to narrow down the fonts returned where
              there is a definite match.  Some scripts, such as latin, han,
              cjk-misc match multiple lfCharSet values, so we can't pre-filter
              them.  */
-          else if (EQ (key, QCscript)
+         if (EQ (key, QCscript)
                    && logfont->lfCharSet == DEFAULT_CHARSET
                    && SYMBOLP (val))
             {
@@ -1559,10 +1968,10 @@ list_all_matching_fonts (match_data)
       families = CDR (families);
       if (NILP (family))
         continue;
-      else if (STRINGP (family))
-        name = SDATA (family);
+      else if (SYMBOLP (family))
+        name = SDATA (SYMBOL_NAME (family));
       else
-        name = SDATA (SYMBOL_NAME (family)); 
+       continue;
 
       strncpy (match_data->pattern.lfFaceName, name, LF_FACESIZE);
       match_data->pattern.lfFaceName[LF_FACESIZE - 1] = '\0';
@@ -1765,15 +2174,15 @@ w32font_full_name (font, font_obj, pixel_size, name, nbytes)
   if (outline)
     len += 11; /* -SIZE */
   else
-    len = strlen (font->lfFaceName) + 21;
+    len += 21;
 
   if (font->lfItalic)
     len += 7; /* :italic */
 
   if (font->lfWeight && font->lfWeight != FW_NORMAL)
     {
-      weight = font_symbolic_weight (font_obj);
-      len += 8 + SBYTES (SYMBOL_NAME (weight)); /* :weight=NAME */
+      weight = w32_to_fc_weight (font->lfWeight);
+      len += 1 + SBYTES (SYMBOL_NAME (weight)); /* :WEIGHT */
     }
 
   antialiasing = lispy_antialias_type (font->lfQuality);
@@ -1803,57 +2212,178 @@ w32font_full_name (font, font_obj, pixel_size, name, nbytes)
         p += sprintf (p, ":pixelsize=%d", height);
     }
 
+  if (SYMBOLP (weight) && ! NILP (weight))
+    p += sprintf (p, ":%s", SDATA (SYMBOL_NAME (weight)));
+
   if (font->lfItalic)
     p += sprintf (p, ":italic");
 
-  if (SYMBOLP (weight) && ! NILP (weight))
-    p += sprintf (p, ":weight=%s", SDATA (SYMBOL_NAME (weight)));
-
   if (SYMBOLP (antialiasing) && ! NILP (antialiasing))
     p += sprintf (p, ":antialias=%s", SDATA (SYMBOL_NAME (antialiasing)));
 
   return (p - name);
 }
 
+/* Convert a logfont and point size into a fontconfig style font name.
+   POINTSIZE is in tenths of points.
+   If SIZE indicates the size of buffer FCNAME, into which the font name
+   is written.  If the buffer is not large enough to contain the name,
+   the function returns -1, otherwise it returns the number of bytes
+   written to FCNAME.  */
+static int logfont_to_fcname(font, pointsize, fcname, size)
+     LOGFONT* font;
+     int pointsize;
+     char *fcname;
+     int size;
+{
+  int len, height;
+  char *p = fcname;
+  Lisp_Object weight = Qnil;
+
+  len = strlen (font->lfFaceName) + 2;
+  height = pointsize / 10;
+  while (height /= 10)
+    len++;
+
+  if (pointsize % 10)
+    len += 2;
+
+  if (font->lfItalic)
+    len += 7; /* :italic */
+  if (font->lfWeight && font->lfWeight != FW_NORMAL)
+    {
+      weight = w32_to_fc_weight (font->lfWeight);
+      len += SBYTES (SYMBOL_NAME (weight)) + 1;
+    }
+
+  if (len > size)
+    return -1;
+
+  p += sprintf (p, "%s-%d", font->lfFaceName, pointsize / 10);
+  if (pointsize % 10)
+    p += sprintf (p, ".%d", pointsize % 10);
+
+  if (SYMBOLP (weight) && !NILP (weight))
+    p += sprintf (p, ":%s", SDATA (SYMBOL_NAME (weight)));
+
+  if (font->lfItalic)
+    p += sprintf (p, ":italic");
+
+  return (p - fcname);
+}
 
 static void
-recompute_cached_metrics (dc, w32_font)
+compute_metrics (dc, w32_font, code, metrics)
      HDC dc;
      struct w32font_info *w32_font;
+     unsigned int code;
+     struct w32_metric_cache *metrics;
 {
   GLYPHMETRICS gm;
   MAT2 transform;
-  unsigned int i;
+  unsigned int options = GGO_METRICS;
+
+  if (w32_font->glyph_idx)
+    options |= GGO_GLYPH_INDEX;
 
   bzero (&transform, sizeof (transform));
   transform.eM11.value = 1;
   transform.eM22.value = 1;
-  
-  for (i = 0; i < 128; i++)
+
+  if (GetGlyphOutlineW (dc, code, options, &gm, 0, NULL, &transform)
+      != GDI_ERROR)
+    {
+      metrics->lbearing = gm.gmptGlyphOrigin.x;
+      metrics->rbearing = gm.gmptGlyphOrigin.x + gm.gmBlackBoxX;
+      metrics->width = gm.gmCellIncX;
+      metrics->status = W32METRIC_SUCCESS;
+    }
+  else if (w32_font->glyph_idx)
     {
-      struct font_metrics* char_metric = &w32_font->ascii_metrics[i];
-      unsigned int options = GGO_METRICS;
-      if (w32_font->glyph_idx)
-        options |= GGO_GLYPH_INDEX;
+      /* Can't use glyph indexes after all.
+        Avoid it in future, and clear any metrics that were based on
+        glyph indexes.  */
+      w32_font->glyph_idx = 0;
+      clear_cached_metrics (w32_font);
+    }
+  else
+    metrics->status = W32METRIC_FAIL;
+}
 
-      if (GetGlyphOutlineW (dc, i, options, &gm, 0, NULL, &transform)
-          != GDI_ERROR)
-        {
-          char_metric->lbearing = gm.gmptGlyphOrigin.x;
-          char_metric->rbearing = gm.gmBlackBoxX + gm.gmptGlyphOrigin.x;
-          char_metric->width = gm.gmCellIncX;
-          char_metric->ascent = gm.gmBlackBoxY;
-          char_metric->descent = (gm.gmCellIncY - gm.gmptGlyphOrigin.y
-                                 - gm.gmBlackBoxY);
-        }
-      else
-        char_metric->width = 0;
+static void
+clear_cached_metrics (w32_font)
+     struct w32font_info *w32_font;
+{
+  int i;
+  for (i = 0; i < w32_font->n_cache_blocks; i++)
+    {
+      if (w32_font->cached_metrics[i])
+        bzero (w32_font->cached_metrics[i],
+               CACHE_BLOCKSIZE * sizeof (struct font_metrics));
     }
 }
 
+DEFUN ("x-select-font", Fx_select_font, Sx_select_font, 0, 2, 0,
+       doc: /* Read a font name using a W32 font selection dialog.
+Return fontconfig style font string corresponding to the selection.
+
+If FRAME is omitted or nil, it defaults to the selected frame.
+If INCLUDE-PROPORTIONAL is non-nil, include proportional fonts
+in the font selection dialog. */)
+  (frame, include_proportional)
+     Lisp_Object frame, include_proportional;
+{
+  FRAME_PTR f = check_x_frame (frame);
+  CHOOSEFONT cf;
+  LOGFONT lf;
+  TEXTMETRIC tm;
+  HDC hdc;
+  HANDLE oldobj;
+  char buf[100];
+
+  bzero (&cf, sizeof (cf));
+  bzero (&lf, sizeof (lf));
+
+  cf.lStructSize = sizeof (cf);
+  cf.hwndOwner = FRAME_W32_WINDOW (f);
+  cf.Flags = CF_FORCEFONTEXIST | CF_SCREENFONTS | CF_NOVERTFONTS;
+
+  /* Unless include_proportional is non-nil, limit the selection to
+     monospaced fonts.  */
+  if (NILP (include_proportional))
+    cf.Flags |= CF_FIXEDPITCHONLY;
+
+  cf.lpLogFont = &lf;
+
+  /* Initialize as much of the font details as we can from the current
+     default font.  */
+  hdc = GetDC (FRAME_W32_WINDOW (f));
+  oldobj = SelectObject (hdc, FONT_HANDLE (FRAME_FONT (f)));
+  GetTextFace (hdc, LF_FACESIZE, lf.lfFaceName);
+  if (GetTextMetrics (hdc, &tm))
+    {
+      lf.lfHeight = tm.tmInternalLeading - tm.tmHeight;
+      lf.lfWeight = tm.tmWeight;
+      lf.lfItalic = tm.tmItalic;
+      lf.lfUnderline = tm.tmUnderlined;
+      lf.lfStrikeOut = tm.tmStruckOut;
+      lf.lfCharSet = tm.tmCharSet;
+      cf.Flags |= CF_INITTOLOGFONTSTRUCT;
+    }
+  SelectObject (hdc, oldobj);
+  ReleaseDC (FRAME_W32_WINDOW (f), hdc);
+
+  if (!ChooseFont (&cf)
+      || logfont_to_fcname (&lf, cf.iPointSize, buf, 100) < 0)
+    return Qnil;
+
+  return build_string (buf);
+}
+
 struct font_driver w32font_driver =
   {
     0, /* Qgdi */
+    0, /* case insensitive */
     w32font_get_cache,
     w32font_list,
     w32font_match,
@@ -1910,6 +2440,11 @@ syms_of_w32font ()
   DEFSYM (Qsubpixel, "subpixel");
   DEFSYM (Qnatural, "natural");
 
+  /* Languages  */
+  DEFSYM (Qja, "ja");
+  DEFSYM (Qko, "ko");
+  DEFSYM (Qzh, "zh");
+
   /* Scripts  */
   DEFSYM (Qlatin, "latin");
   DEFSYM (Qgreek, "greek");
@@ -1982,10 +2517,56 @@ syms_of_w32font ()
   DEFSYM (Qtifinagh, "tifinagh");
   DEFSYM (Qugaritic, "ugaritic");
 
+  /* W32 font encodings.  */
+  DEFVAR_LISP ("w32-charset-info-alist",
+               &Vw32_charset_info_alist,
+               doc: /* Alist linking Emacs character sets to Windows fonts and codepages.
+Each entry should be of the form:
+
+   (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE))
+
+where CHARSET_NAME is a string used in font names to identify the charset,
+WINDOWS_CHARSET is a symbol that can be one of:
+
+  w32-charset-ansi, w32-charset-default, w32-charset-symbol,
+  w32-charset-shiftjis, w32-charset-hangeul, w32-charset-gb2312,
+  w32-charset-chinesebig5, w32-charset-johab, w32-charset-hebrew,
+  w32-charset-arabic, w32-charset-greek, w32-charset-turkish,
+  w32-charset-vietnamese, w32-charset-thai, w32-charset-easteurope,
+  w32-charset-russian, w32-charset-mac, w32-charset-baltic,
+  or w32-charset-oem.
+
+CODEPAGE should be an integer specifying the codepage that should be used
+to display the character set, t to do no translation and output as Unicode,
+or nil to do no translation and output as 8 bit (or multibyte on far-east
+versions of Windows) characters.  */);
+  Vw32_charset_info_alist = Qnil;
+
+  DEFSYM (Qw32_charset_ansi, "w32-charset-ansi");
+  DEFSYM (Qw32_charset_symbol, "w32-charset-symbol");
+  DEFSYM (Qw32_charset_default, "w32-charset-default");
+  DEFSYM (Qw32_charset_shiftjis, "w32-charset-shiftjis");
+  DEFSYM (Qw32_charset_hangeul, "w32-charset-hangeul");
+  DEFSYM (Qw32_charset_chinesebig5, "w32-charset-chinesebig5");
+  DEFSYM (Qw32_charset_gb2312, "w32-charset-gb2312");
+  DEFSYM (Qw32_charset_oem, "w32-charset-oem");
+  DEFSYM (Qw32_charset_johab, "w32-charset-johab");
+  DEFSYM (Qw32_charset_easteurope, "w32-charset-easteurope");
+  DEFSYM (Qw32_charset_turkish, "w32-charset-turkish");
+  DEFSYM (Qw32_charset_baltic, "w32-charset-baltic");
+  DEFSYM (Qw32_charset_russian, "w32-charset-russian");
+  DEFSYM (Qw32_charset_arabic, "w32-charset-arabic");
+  DEFSYM (Qw32_charset_greek, "w32-charset-greek");
+  DEFSYM (Qw32_charset_hebrew, "w32-charset-hebrew");
+  DEFSYM (Qw32_charset_vietnamese, "w32-charset-vietnamese");
+  DEFSYM (Qw32_charset_thai, "w32-charset-thai");
+  DEFSYM (Qw32_charset_mac, "w32-charset-mac");
+
+  defsubr (&Sx_select_font);
+
   w32font_driver.type = Qgdi;
   register_font_driver (&w32font_driver, NULL);
 }
-#endif /* USE_FONT_BACKEND  */
 
 /* arch-tag: 65b8a3cd-46aa-4c0d-a1f3-99e75b9c07ee
    (do not change this comment) */