* alloc.c: Do not define struct catchtag.
[bpt/emacs.git] / src / w32font.c
index f7b4059..6946251 100644 (file)
@@ -1,5 +1,5 @@
 /* Font backend for the Microsoft W32 API.
-   Copyright (C) 2007, 2008 Free Software Foundation, Inc.
+   Copyright (C) 2007, 2008, 2009 Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -21,6 +21,7 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include <math.h>
 #include <ctype.h>
 #include <commdlg.h>
+#include <setjmp.h>
 
 #include "lisp.h"
 #include "w32term.h"
@@ -28,6 +29,7 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include "dispextern.h"
 #include "character.h"
 #include "charset.h"
+#include "coding.h"
 #include "fontset.h"
 #include "font.h"
 #include "w32font.h"
@@ -43,6 +45,15 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #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;
@@ -58,7 +69,7 @@ extern Lisp_Object Qnone; /* reuse from w32fns.c  */
 static Lisp_Object Qstandard, Qsubpixel, Qnatural;
 
 /* languages */
-static Lisp_Object Qja, Qko, Qzh;
+static Lisp_Object Qzh;
 
 /* scripts */
 static Lisp_Object Qlatin, Qgreek, Qcoptic, Qcyrillic, Qarmenian, Qhebrew;
@@ -70,15 +81,27 @@ static Lisp_Object Qcherokee, Qcanadian_aboriginal, Qogham, Qrunic;
 static Lisp_Object Qkhmer, Qmongolian, Qsymbol, Qbraille, Qhan;
 static Lisp_Object Qideographic_description, Qcjk_misc, Qkana, Qbopomofo;
 static Lisp_Object Qkanbun, Qyi, Qbyzantine_musical_symbol;
-static Lisp_Object Qmusical_symbol, Qmathematical;
+static Lisp_Object Qmusical_symbol, Qmathematical, Qcham, Qphonetic;
 /* Not defined in characters.el, but referenced in fontset.el.  */
 static Lisp_Object Qbalinese, Qbuginese, Qbuhid, Qcuneiform, Qcypriot;
 static Lisp_Object Qdeseret, Qglagolitic, Qgothic, Qhanunoo, Qkharoshthi;
 static Lisp_Object Qlimbu, Qlinear_b, Qold_italic, Qold_persian, Qosmanya;
 static Lisp_Object Qphags_pa, Qphoenician, Qshavian, Qsyloti_nagri;
 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;
@@ -92,7 +115,6 @@ 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, DWORD));
 
@@ -129,9 +151,6 @@ struct font_callback_data
    style variations if the font name is not specified.  */
 static void list_all_matching_fonts P_ ((struct font_callback_data *));
 
-/* From old font code in w32fns.c */
-char * w32_to_x_charset P_ ((int, char *));
-
 
 static int
 memq_no_quit (elt, list)
@@ -142,6 +161,26 @@ memq_no_quit (elt, list)
   return (CONSP (list));
 }
 
+Lisp_Object
+intern_font_name (string)
+     char * string;
+{
+  Lisp_Object obarray, tem, str;
+  int len;
+
+  str = DECODE_SYSTEM (build_string (string));
+  len = SCHARS (str);
+
+  /* The following code is copied from the function intern (in lread.c).  */
+  obarray = Vobarray;
+  if (!VECTORP (obarray) || XVECTOR (obarray)->size == 0)
+    obarray = check_obarray (obarray);
+  tem = oblookup (obarray, SDATA (str), len, len);
+  if (SYMBOLP (tem))
+    return tem;
+  return Fintern (str, obarray);
+}
+
 /* w32 implementation of get_cache for font backend.
    Return a cache of font-entities on FRAME.  The cache must be a
    cons whose cdr part is the actual cache area.  */
@@ -163,7 +202,7 @@ w32font_list (frame, font_spec)
      Lisp_Object frame, font_spec;
 {
   Lisp_Object fonts = w32font_list_internal (frame, font_spec, 0);
-  font_add_log ("w32font-list", font_spec, fonts);
+  FONT_ADD_LOG ("w32font-list", font_spec, fonts);
   return fonts;
 }
 
@@ -176,7 +215,7 @@ w32font_match (frame, font_spec)
      Lisp_Object frame, font_spec;
 {
   Lisp_Object entity = w32font_match_internal (frame, font_spec, 0);
-  font_add_log ("w32font-match", font_spec, entity);
+  FONT_ADD_LOG ("w32font-match", font_spec, entity);
   return entity;
 }
 
@@ -214,15 +253,22 @@ w32font_open (f, font_entity, pixel_size)
      Lisp_Object font_entity;
      int pixel_size;
 {
-  Lisp_Object font_object;
+  Lisp_Object font_object
+    = font_make_object (VECSIZE (struct w32font_info),
+                        font_entity, pixel_size);
+  struct w32font_info *w32_font
+    = (struct w32font_info *) XFONT_OBJECT (font_object);
 
-  font_object = font_make_object (VECSIZE (struct w32font_info));
+  ASET (font_object, FONT_TYPE_INDEX, Qgdi);
 
   if (!w32font_open_internal (f, font_entity, pixel_size, font_object))
     {
       return Qnil;
     }
 
+  /* GDI backend does not use glyph indices.  */
+  w32_font->glyph_idx = 0;
+
   return font_object;
 }
 
@@ -233,14 +279,21 @@ w32font_close (f, font)
      FRAME_PTR f;
      struct font *font;
 {
+  int i;
   struct w32font_info *w32_font = (struct w32font_info *) font;
 
-  if (w32_font->compat_w32_font)
+  /* Delete the GDI font object.  */
+  DeleteObject (w32_font->hfont);
+
+  /* Free all the cached metrics.  */
+  if (w32_font->cached_metrics)
     {
-      W32FontStruct *old_w32_font = w32_font->compat_w32_font;
-      DeleteObject (old_w32_font->hfont);
-      xfree (old_w32_font);
-      w32_font->compat_w32_font = 0;
+      for (i = 0; i < w32_font->n_cache_blocks; i++)
+        {
+          xfree (w32_font->cached_metrics[i]);
+        }
+      xfree (w32_font->cached_metrics);
+      w32_font->cached_metrics = NULL;
     }
 }
 
@@ -254,6 +307,12 @@ w32font_has_char (entity, c)
      Lisp_Object entity;
      int c;
 {
+  /* We can't be certain about which characters a font will support until
+     we open it.  Checking the scripts that the font supports turns out
+     to not be reliable.  */
+  return -1;
+
+#if 0
   Lisp_Object supported_scripts, extra, script;
   DWORD mask;
 
@@ -262,6 +321,8 @@ w32font_has_char (entity, c)
     return -1;
 
   supported_scripts = assq_no_quit (QCscript, extra);
+  /* If font doesn't claim to support any scripts, then we can't be certain
+     until we open it.  */
   if (!CONSP (supported_scripts))
     return -1;
 
@@ -269,82 +330,41 @@ w32font_has_char (entity, c)
 
   script = CHAR_TABLE_REF (Vchar_script_table, c);
 
-  return (memq_no_quit (script, supported_scripts)) ? -1 : 0;
+  /* If we don't know what script the character is from, then we can't be
+     certain until we open it.  Also if the font claims support for the script
+     the character is from, it may only have partial coverage, so we still
+     can't be certain until we open the font.  */
+  if (NILP (script) || memq_no_quit (script, supported_scripts))
+    return -1;
+
+  /* Font reports what scripts it supports, and none of them are the script
+     the character is from. But we still can't be certain, as some fonts
+     will contain some/most/all of the characters in that script without
+     claiming support for it.  */
+  return -1;
+#endif
 }
 
 /* w32 implementation of encode_char for font backend.
    Return a glyph code of FONT for characer C (Unicode code point).
-   If FONT doesn't have such a glyph, return FONT_INVALID_CODE.  */
+   If FONT doesn't have such a glyph, return FONT_INVALID_CODE.
+
+   For speed, the gdi backend uses unicode (Emacs calls encode_char
+   far too often for it to be efficient). But we still need to detect
+   which characters are not supported by the font.
+  */
 static unsigned
 w32font_encode_char (font, c)
      struct font *font;
      int c;
 {
-  struct frame *f;
-  HDC dc;
-  HFONT old_font;
-  DWORD retval;
-  GCP_RESULTSW result;
-  wchar_t in[2];
-  wchar_t out[2];
-  int len;
-  struct w32font_info *w32_font = (struct w32font_info *) font;
+  struct w32font_info * w32_font = (struct w32font_info *)font;
 
-  /* If glyph indexing is not working for this font, just return the
-     unicode code-point.  */
-  if (!w32_font->glyph_idx)
-    return c;
-
-  if (c > 0xFFFF)
-    {
-      /* TODO: Encode as surrogate pair and lookup the glyph.  */
-      return FONT_INVALID_CODE;
-    }
+  if (c < w32_font->metrics.tmFirstChar
+      || c > w32_font->metrics.tmLastChar)
+    return FONT_INVALID_CODE;
   else
-    {
-      in[0] = (wchar_t) c;
-      len = 1;
-    }
-
-  bzero (&result, sizeof (result));
-  result.lStructSize = sizeof (result);
-  result.lpGlyphs = out;
-  result.nGlyphs = 2;
-
-  f = XFRAME (selected_frame);
-
-  dc = get_frame_dc (f);
-  old_font = SelectObject (dc, w32_font->compat_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);
-  release_frame_dc (f, dc);
-
-  if (retval)
-    {
-      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];
-    }
-  else
-    {
-      int i;
-      /* 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;
-      /* Clear metrics cache.  */
-      clear_cached_metrics (w32_font);
-
-      return c;
-    }
+    return c;
 }
 
 /* w32 implementation of text_extents for font backend.
@@ -364,13 +384,13 @@ w32font_text_extents (font, code, nglyphs, metrics)
   HDC dc = NULL;
   struct frame * f;
   int total_width = 0;
-  WORD *wcode = NULL;
+  WORD *wcode;
   SIZE size;
 
+  struct w32font_info *w32_font = (struct w32font_info *) font;
+
   if (metrics)
     {
-      struct w32font_info *w32_font = (struct w32font_info *) font;
-
       bzero (metrics, sizeof (struct font_metrics));
       metrics->ascent = font->ascent;
       metrics->descent = font->descent;
@@ -386,24 +406,24 @@ w32font_text_extents (font, code, nglyphs, metrics)
              if (!w32_font->cached_metrics)
                w32_font->cached_metrics
                  = xmalloc ((block + 1)
-                            * sizeof (struct w32_cached_metric *));
+                            * sizeof (struct w32_metric_cache *));
              else
                w32_font->cached_metrics
                  = xrealloc (w32_font->cached_metrics,
                              (block + 1)
-                             * sizeof (struct w32_cached_metric *));
+                             * sizeof (struct w32_metric_cache *));
              bzero (w32_font->cached_metrics + w32_font->n_cache_blocks,
                     ((block + 1 - w32_font->n_cache_blocks)
-                     * sizeof (struct w32_cached_metric *)));
+                     * sizeof (struct w32_metric_cache *)));
              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));
+               = xmalloc (CACHE_BLOCKSIZE * sizeof (struct w32_metric_cache));
              bzero (w32_font->cached_metrics[block],
-                    CACHE_BLOCKSIZE * sizeof (struct font_metrics));
+                    CACHE_BLOCKSIZE * sizeof (struct w32_metric_cache));
            }
 
          char_metric = w32_font->cached_metrics[block] + pos_in_block;
@@ -419,7 +439,7 @@ w32font_text_extents (font, code, nglyphs, metrics)
                  f = XFRAME (selected_frame);
 
                   dc = get_frame_dc (f);
-                  old_font = SelectObject (dc, FONT_COMPAT (font)->hfont);
+                  old_font = SelectObject (dc, w32_font->hfont);
                }
              compute_metrics (dc, w32_font, *(code + i), char_metric);
            }
@@ -454,19 +474,27 @@ 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.  */
-  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;
-         }
-      }
-  }
+
+  /* Make array big enough to hold surrogates.  */
+  wcode = alloca (nglyphs * sizeof (WORD) * 2);
+  for (i = 0; i < nglyphs; i++)
+    {
+      if (code[i] < 0x10000)
+        wcode[i] = code[i];
+      else
+        {
+          DWORD surrogate = code[i] - 0x10000;
+
+          /* High surrogate: U+D800 - U+DBFF.  */
+          wcode[i++] = 0xD800 + ((surrogate >> 10) & 0x03FF);
+          /* Low surrogate: U+DC00 - U+DFFF.  */
+          wcode[i] = 0xDC00 + (surrogate & 0x03FF);
+          /* An extra glyph. wcode is already double the size of code to
+             cope with this.  */
+          nglyphs++;
+        }
+    }
+
   if (dc == NULL)
     {
       /* TODO: Frames can come and go, and their fonts outlive
@@ -476,7 +504,7 @@ w32font_text_extents (font, code, nglyphs, metrics)
       f = XFRAME (selected_frame);
 
       dc = get_frame_dc (f);
-      old_font = SelectObject (dc, FONT_COMPAT (font)->hfont);
+      old_font = SelectObject (dc, w32_font->hfont);
     }
 
   if (GetTextExtentPoint32W (dc, wcode, nglyphs, &size))
@@ -498,10 +526,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->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.  */
@@ -530,18 +557,23 @@ w32font_draw (s, from, to, x, y, with_background)
      int from, to, x, y, with_background;
 {
   UINT options;
-  HRGN orig_clip;
+  HRGN orig_clip = NULL;
   struct w32font_info *w32font = (struct w32font_info *) s->font;
 
   options = w32font->glyph_idx;
 
-  /* Save clip region for later restoration.  */
-  GetClipRgn(s->hdc, orig_clip);
-
   if (s->num_clips > 0)
     {
       HRGN new_clip = CreateRectRgnIndirect (s->clip);
 
+      /* Save clip region for later restoration.  */
+      orig_clip = CreateRectRgn (0, 0, 0, 0);
+      if (!GetClipRgn(s->hdc, orig_clip))
+       {
+         DeleteObject (orig_clip);
+         orig_clip = NULL;
+       }
+
       if (s->num_clips > 1)
         {
           HRGN clip2 = CreateRectRgnIndirect (s->clip + 1);
@@ -585,9 +617,10 @@ w32font_draw (s, from, to, x, y, with_background)
 
   /* Restore clip region.  */
   if (s->num_clips > 0)
-    {
-      SelectClipRgn (s->hdc, orig_clip);
-    }
+    SelectClipRgn (s->hdc, orig_clip);
+
+  if (orig_clip)
+    DeleteObject (orig_clip);
 }
 
 /* w32 implementation of free_entity for font backend.
@@ -697,6 +730,19 @@ w32font_list_internal (frame, font_spec, opentype_only)
   bzero (&match_data.pattern, sizeof (LOGFONT));
   fill_in_logfont (f, &match_data.pattern, font_spec);
 
+  /* If the charset is unrecognized, then we won't find a font, so don't
+     waste time looking for one.  */
+  if (match_data.pattern.lfCharSet == DEFAULT_CHARSET)
+    {
+      Lisp_Object spec_charset = AREF (font_spec, FONT_REGISTRY_INDEX);
+      if (!NILP (spec_charset)
+         && !EQ (spec_charset, Qiso10646_1)
+         && !EQ (spec_charset, Qunicode_bmp)
+         && !EQ (spec_charset, Qunicode_sip)
+         && !EQ (spec_charset, Qunknown))
+       return Qnil;
+    }
+
   match_data.opentype_only = opentype_only;
   if (opentype_only)
     match_data.pattern.lfOutPrecision = OUT_OUTLINE_PRECIS;
@@ -717,7 +763,7 @@ w32font_list_internal (frame, font_spec, opentype_only)
       release_frame_dc (f, dc);
     }
 
-  return NILP (match_data.list) ? Qnil : match_data.list;
+  return match_data.list;
 }
 
 /* Internal implementation of w32font_match.
@@ -765,11 +811,9 @@ w32font_open_internal (f, font_entity, pixel_size, font_object)
   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;
+  OUTLINETEXTMETRICW* metrics = NULL;
 
   w32_font = (struct w32font_info *) XFONT_OBJECT (font_object);
   font = (struct font *) w32_font;
@@ -777,11 +821,6 @@ w32font_open_internal (f, font_entity, pixel_size, font_object)
   if (!font)
     return 0;
 
-  /* Copy from font entity.  */
-  for (i = 0; i < FONT_ENTITY_MAX; i++)
-    ASET (font_object, i, AREF (font_entity, i));
-  ASET (font_object, FONT_SIZE_INDEX, make_number (pixel_size));
-
   bzero (&logfont, sizeof (logfont));
   fill_in_logfont (f, &logfont, font_entity);
 
@@ -806,25 +845,19 @@ w32font_open_internal (f, font_entity, pixel_size, font_object)
   old_font = SelectObject (dc, hfont);
 
   /* Try getting the outline metrics (only works for truetype fonts).  */
-  len = GetOutlineTextMetrics (dc, 0, NULL);
+  len = GetOutlineTextMetricsW (dc, 0, NULL);
   if (len)
     {
-      metrics = (OUTLINETEXTMETRIC *) alloca (len);
-      if (GetOutlineTextMetrics (dc, len, metrics))
+      metrics = (OUTLINETEXTMETRICW *) alloca (len);
+      if (GetOutlineTextMetricsW (dc, len, metrics))
         bcopy (&metrics->otmTextMetrics, &w32_font->metrics,
-               sizeof (TEXTMETRIC));
+               sizeof (TEXTMETRICW));
       else
         metrics = NULL;
-
-      /* If it supports outline metrics, it should support Glyph Indices.  */
-      w32_font->glyph_idx = ETO_GLYPH_INDEX;
     }
 
   if (!metrics)
-    {
-      GetTextMetrics (dc, &w32_font->metrics);
-      w32_font->glyph_idx = 0;
-    }
+    GetTextMetricsW (dc, &w32_font->metrics);
 
   w32_font->cached_metrics = NULL;
   w32_font->n_cache_blocks = 0;
@@ -832,15 +865,7 @@ w32font_open_internal (f, font_entity, pixel_size, font_object)
   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.  */
-  w32_font->compat_w32_font = xmalloc (sizeof (W32FontStruct));
-  compat_w32_font = w32_font->compat_w32_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;
+  w32_font->hfont = hfont;
 
   {
     char *name;
@@ -848,27 +873,28 @@ w32font_open_internal (f, font_entity, pixel_size, font_object)
     /* 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->props[FONT_FULLNAME_INDEX]
-        = make_unibyte_string (name, strlen (name));
+        = DECODE_SYSTEM (build_string (name));
     else
-      font->props[FONT_FULLNAME_INDEX] =
-        make_unibyte_string (logfont.lfFaceName, len);
+      font->props[FONT_FULLNAME_INDEX]
+       = DECODE_SYSTEM (build_string (logfont.lfFaceName));
   }
 
   font->max_width = w32_font->metrics.tmMaxCharWidth;
+  /* Parts of Emacs display assume that height = ascent + descent...
+     so height is defined later, after ascent and descent.
   font->height = w32_font->metrics.tmHeight
     + w32_font->metrics.tmExternalLeading;
+  */
+
   font->space_width = font->average_width = w32_font->metrics.tmAveCharWidth;
 
   font->vertical_centering = 0;
@@ -900,6 +926,7 @@ w32font_open_internal (f, font_entity, pixel_size, font_object)
   font->min_width = font->space_width;
   font->ascent = w32_font->metrics.tmAscent;
   font->descent = w32_font->metrics.tmDescent;
+  font->height = font->ascent + font->descent;
 
   if (metrics)
     {
@@ -912,11 +939,6 @@ w32font_open_internal (f, font_entity, pixel_size, font_object)
       font->underline_position = -1;
     }
 
-  /* max_descent is used for underlining in w32term.c.  Hopefully this
-     is temporary, as we'll want to get rid of the old compatibility
-     stuff later.  */
-  compat_w32_font->max_bounds.descent = font->descent;
-
   /* 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
@@ -942,8 +964,7 @@ add_font_name_to_list (logical_font, physical_font, font_type, list_object)
   if (logical_font->elfLogFont.lfFaceName[0] == '@')
     return 1;
 
-  family = font_intern_prop (logical_font->elfLogFont.lfFaceName,
-                            strlen (logical_font->elfLogFont.lfFaceName), 1);
+  family = intern_font_name (logical_font->elfLogFont.lfFaceName);
   if (! memq_no_quit (family, *list))
     *list = Fcons (family, *list);
 
@@ -1016,7 +1037,7 @@ w32_enumfont_pattern_entity (frame, logical_font, physical_font,
                       lispy_antialias_type (requested_font->lfQuality));
     }
   ASET (entity, FONT_FAMILY_INDEX,
-        font_intern_prop (lf->lfFaceName, strlen (lf->lfFaceName), 1));
+       intern_font_name (lf->lfFaceName));
 
   FONT_SET_STYLE (entity, FONT_WEIGHT_INDEX,
                  make_number (w32_decode_weight (lf->lfWeight)));
@@ -1027,7 +1048,9 @@ w32_enumfont_pattern_entity (frame, logical_font, physical_font,
   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));
 
@@ -1325,6 +1348,49 @@ w32font_coverage_ok (coverage, charset)
   return 1;
 }
 
+
+static int
+check_face_name (font, full_name)
+     LOGFONT *font;
+     char *full_name;
+{
+  char full_iname[LF_FULLFACESIZE+1];
+
+  /* Just check for names known to cause problems, since the full name
+     can contain expanded abbreviations, prefixed foundry, postfixed
+     style, the latter of which sometimes differs from the style indicated
+     in the shorter name (eg Lt becomes Light or even Extra Light)  */
+
+  /* Helvetica is mapped to Arial in Windows, but if a Type-1 Helvetica is
+     installed, we run into problems with the Uniscribe backend which tries
+     to avoid non-truetype fonts, and ends up mixing the Type-1 Helvetica
+     with Arial's characteristics, since that attempt to use Truetype works
+     some places, but not others.  */
+  if (!xstrcasecmp (font->lfFaceName, "helvetica"))
+    {
+      strncpy (full_iname, full_name, LF_FULLFACESIZE);
+      full_iname[LF_FULLFACESIZE] = 0;
+      _strlwr (full_iname);
+      return strstr ("helvetica", full_iname) != NULL;
+    }
+  /* Same for Helv.  */
+  if (!xstrcasecmp (font->lfFaceName, "helv"))
+    {
+      strncpy (full_iname, full_name, LF_FULLFACESIZE);
+      full_iname[LF_FULLFACESIZE] = 0;
+      _strlwr (full_iname);
+      return strstr ("helv", full_iname) != NULL;
+    }
+
+  /* Since Times is mapped to Times New Roman, a substring
+     match is not sufficient to filter out the bogus match.  */
+  else if (!xstrcasecmp (font->lfFaceName, "times"))
+    return xstrcasecmp (full_name, "times") == 0;
+
+  return 1;
+}
+
+
 /* Callback function for EnumFontFamiliesEx.
  * Checks if a font matches everything we are trying to check agaist,
  * and if so, adds it to a list. Both the data we are checking against
@@ -1340,81 +1406,103 @@ add_font_entity_to_list (logical_font, physical_font, font_type, lParam)
   struct font_callback_data *match_data
     = (struct font_callback_data *) lParam;
   Lisp_Object backend = match_data->opentype_only ? Quniscribe : Qgdi;
+  Lisp_Object entity;
+
+  int is_unicode = physical_font->ntmFontSig.fsUsb[3]
+    || physical_font->ntmFontSig.fsUsb[2]
+    || physical_font->ntmFontSig.fsUsb[1]
+    || physical_font->ntmFontSig.fsUsb[0] & 0x3fffffff;
 
-  if ((!match_data->opentype_only
-       || (((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,
-                           &logical_font->elfLogFont)
-      && w32font_coverage_ok (&physical_font->ntmFontSig,
-                              match_data->pattern.lfCharSet)
-      /* Avoid substitutions involving raster fonts (eg Helv -> MS Sans Serif)
-         We limit this to raster fonts, because the test can catch some
-         genuine fonts (eg the full name of DejaVu Sans Mono Light is actually
-         DejaVu Sans Mono ExtraLight). Helvetica -> Arial substitution will
-         therefore get through this test.  Since full names can be prefixed
-         by a foundry, we accept raster fonts if the font name is found
-         anywhere within the full name.  */
-      && (logical_font->elfLogFont.lfOutPrecision != OUT_STRING_PRECIS
-          || strstr (logical_font->elfFullName,
-                     logical_font->elfLogFont.lfFaceName)))
+  /* Skip non matching fonts.  */
+
+  /* For uniscribe backend, consider only truetype or opentype fonts
+     that have some unicode coverage.  */
+  if (match_data->opentype_only
+      && ((!physical_font->ntmTm.ntmFlags & NTMFLAGS_OPENTYPE
+          && !(font_type & TRUETYPE_FONTTYPE))
+         || !is_unicode))
+    return 1;
+
+  /* Ensure a match.  */
+  if (!logfonts_match (&logical_font->elfLogFont, &match_data->pattern)
+      || !font_matches_spec (font_type, physical_font,
+                            match_data->orig_font_spec, backend,
+                            &logical_font->elfLogFont)
+      || !w32font_coverage_ok (&physical_font->ntmFontSig,
+                              match_data->pattern.lfCharSet))
+    return 1;
+
+  /* Avoid substitutions involving raster fonts (eg Helv -> MS Sans Serif)
+     We limit this to raster fonts, because the test can catch some
+     genuine fonts (eg the full name of DejaVu Sans Mono Light is actually
+     DejaVu Sans Mono ExtraLight). Helvetica -> Arial substitution will
+     therefore get through this test.  Since full names can be prefixed
+     by a foundry, we accept raster fonts if the font name is found
+     anywhere within the full name.  */
+  if ((logical_font->elfLogFont.lfOutPrecision == OUT_STRING_PRECIS
+       && !strstr (logical_font->elfFullName,
+                  logical_font->elfLogFont.lfFaceName))
+      /* Check for well known substitutions that mess things up in the
+        presence of Type-1 fonts of the same name.  */
+      || (!check_face_name (&logical_font->elfLogFont,
+                           logical_font->elfFullName)))
+    return 1;
+
+  /* Make a font entity for the font.  */
+  entity = w32_enumfont_pattern_entity (match_data->frame, logical_font,
+                                       physical_font, font_type,
+                                       &match_data->pattern,
+                                       backend);
+
+  if (!NILP (entity))
     {
-      Lisp_Object entity
-        = w32_enumfont_pattern_entity (match_data->frame, logical_font,
-                                       physical_font, font_type,
-                                       &match_data->pattern,
-                                       backend);
-      if (!NILP (entity))
-        {
-          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);
-            }
-        }
+      Lisp_Object spec_charset = AREF (match_data->orig_font_spec,
+                                      FONT_REGISTRY_INDEX);
+
+      /* iso10646-1 fonts must contain unicode mapping tables.  */
+      if (EQ (spec_charset, Qiso10646_1))
+       {
+         if (!is_unicode)
+           return 1;
+       }
+      /* unicode-bmp fonts must contain characters from the BMP.  */
+      else if (EQ (spec_charset, Qunicode_bmp))
+       {
+         if (!physical_font->ntmFontSig.fsUsb[3]
+             && !(physical_font->ntmFontSig.fsUsb[2] & 0xFFFFFF9E)
+             && !(physical_font->ntmFontSig.fsUsb[1] & 0xE81FFFFF)
+             && !(physical_font->ntmFontSig.fsUsb[0] & 0x007F001F))
+           return 1;
+       }
+      /* unicode-sip fonts must contain characters in unicode plane 2.
+        so look for bit 57 (surrogates) in the Unicode subranges, plus
+        the bits for CJK ranges that include those characters.  */
+      else if (EQ (spec_charset, Qunicode_sip))
+       {
+         if (!physical_font->ntmFontSig.fsUsb[1] & 0x02000000
+             || !physical_font->ntmFontSig.fsUsb[1] & 0x28000000)
+           return 1;
+       }
+
+      /* This font matches.  */
+
+      /* If registry was specified, ensure it is reported as the same.  */
+      if (!NILP (spec_charset))
+       ASET (entity, FONT_REGISTRY_INDEX, spec_charset);
+
+      /* Otherwise if using the uniscribe backend, report ANSI and DEFAULT
+        fonts as unicode and skip other charsets.  */
+      else if (match_data->opentype_only)
+       {
+         if (logical_font->elfLogFont.lfCharSet == ANSI_CHARSET
+             || logical_font->elfLogFont.lfCharSet == DEFAULT_CHARSET)
+           ASET (entity, FONT_REGISTRY_INDEX, Qiso10646_1);
+         else
+           return 1;
+       }
+
+      /* Add this font to the list.  */
+      match_data->list = Fcons (entity, match_data->list);
     }
   return 1;
 }
@@ -1433,9 +1521,92 @@ add_one_font_entity_to_list (logical_font, physical_font, font_type, lParam)
   add_font_entity_to_list (logical_font, physical_font, font_type, lParam);
 
   /* If we have a font in the list, terminate the search.  */
-  return !NILP (match_data->list);
+  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)
@@ -1452,6 +1623,203 @@ registry_to_w32_charset (charset)
     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;
@@ -1585,7 +1953,8 @@ fill_in_logfont (f, logfont, font_spec)
         /* Font families are interned, but allow for strings also in case of
            user input.  */
       else if (SYMBOLP (tmp))
-        strncpy (logfont->lfFaceName, SDATA (SYMBOL_NAME (tmp)), LF_FACESIZE);
+        strncpy (logfont->lfFaceName,
+                SDATA (ENCODE_SYSTEM (SYMBOL_NAME (tmp))), LF_FACESIZE);
     }
 
   tmp = AREF (font_spec, FONT_ADSTYLE_INDEX);
@@ -1650,8 +2019,6 @@ fill_in_logfont (f, logfont, font_spec)
                 logfont->lfCharSet = ARABIC_CHARSET;
               else if (EQ (val, Qthai))
                 logfont->lfCharSet = THAI_CHARSET;
-              else if (EQ (val, Qsymbol))
-                logfont->lfCharSet = SYMBOL_CHARSET;
             }
           else if (EQ (key, QCantialias) && SYMBOLP (val))
             {
@@ -1673,15 +2040,17 @@ list_all_matching_fonts (match_data)
 
   while (!NILP (families))
     {
-      /* TODO: Use the Unicode versions of the W32 APIs, so we can
-         handle non-ASCII font names.  */
+      /* Only fonts from the current locale are given localized names
+        on Windows, so we can keep backwards compatibility with
+        Windows 9x/ME by using non-Unicode font enumeration without
+        sacrificing internationalization here.  */
       char *name;
       Lisp_Object family = CAR (families);
       families = CDR (families);
       if (NILP (family))
         continue;
       else if (SYMBOLP (family))
-        name = SDATA (SYMBOL_NAME (family));
+        name = SDATA (ENCODE_SYSTEM (SYMBOL_NAME (family)));
       else
        continue;
 
@@ -1770,6 +2139,7 @@ font_supported_scripts (FONTSIGNATURE * sig)
   SUBRANGE (9, Qcyrillic);
   SUBRANGE (10, Qarmenian);
   SUBRANGE (11, Qhebrew);
+  /* 12: Vai.  */
   SUBRANGE (13, Qarabic);
   SUBRANGE (14, Qnko);
   SUBRANGE (15, Qdevanagari);
@@ -1849,13 +2219,18 @@ font_supported_scripts (FONTSIGNATURE * sig)
   SUBRANGE (108, Qkharoshthi);
   /* 109: Tai Xuan Jing.  */
   SUBRANGE (110, Qcuneiform);
-  /* 111: Counting Rods.  */
+  /* 111: Counting Rods, 112: Sundanese, 113: Lepcha, 114: Ol Chiki.  */
+  /* 115: Saurashtra, 116: Kayah Li, 117: Rejang.  */
+  SUBRANGE (118, Qcham);
+  /* 119: Ancient symbols, 120: Phaistos Disc.  */
+  /* 121: Carian, Lycian, Lydian, 122: Dominos, Mah Jong tiles.  */
+  /* 123-127: Reserved.  */
 
   /* There isn't really a main symbol range, so include symbol if any
      relevant range is set.  */
   MASK_ANY (0x8000000, 0x0000FFFF, 0, 0, Qsymbol);
 
-  /* Missing: Tai Viet (U+AA80) and Cham (U+AA00) .  */
+  /* Missing: Tai Viet (U+AA80-U+AADF).  */
 #undef SUBRANGE
 #undef MASK_ANY
 
@@ -2010,40 +2385,19 @@ compute_metrics (dc, w32_font, code, metrics)
       metrics->width = gm.gmCellIncX;
       metrics->status = W32METRIC_SUCCESS;
     }
-  else if (w32_font->glyph_idx)
-    {
-      /* 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;
 }
 
-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
+If EXCLUDE-PROPORTIONAL is non-nil, exclude proportional fonts
 in the font selection dialog. */)
-  (frame, include_proportional)
-     Lisp_Object frame, include_proportional;
+  (frame, exclude_proportional)
+     Lisp_Object frame, exclude_proportional;
 {
   FRAME_PTR f = check_x_frame (frame);
   CHOOSEFONT cf;
@@ -2060,9 +2414,9 @@ in the font selection dialog. */)
   cf.hwndOwner = FRAME_W32_WINDOW (f);
   cf.Flags = CF_FORCEFONTEXIST | CF_SCREENFONTS | CF_NOVERTFONTS;
 
-  /* Unless include_proportional is non-nil, limit the selection to
+  /* If exclude_proportional is non-nil, limit the selection to
      monospaced fonts.  */
-  if (NILP (include_proportional))
+  if (!NILP (exclude_proportional))
     cf.Flags |= CF_FIXEDPITCHONLY;
 
   cf.lpLogFont = &lf;
@@ -2070,7 +2424,7 @@ in the font selection dialog. */)
   /* 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_COMPAT (FRAME_FONT (f))->hfont);
+  oldobj = SelectObject (hdc, FONT_HANDLE (FRAME_FONT (f)));
   GetTextFace (hdc, LF_FACESIZE, lf.lfFaceName);
   if (GetTextMetrics (hdc, &tm))
     {
@@ -2089,7 +2443,7 @@ in the font selection dialog. */)
       || logfont_to_fcname (&lf, cf.iPointSize, buf, 100) < 0)
     return Qnil;
 
-  return build_string (buf);
+  return DECODE_SYSTEM (build_string (buf));
 }
 
 struct font_driver w32font_driver =
@@ -2153,8 +2507,6 @@ syms_of_w32font ()
   DEFSYM (Qnatural, "natural");
 
   /* Languages  */
-  DEFSYM (Qja, "ja");
-  DEFSYM (Qko, "ko");
   DEFSYM (Qzh, "zh");
 
   /* Scripts  */
@@ -2203,6 +2555,7 @@ syms_of_w32font ()
   DEFSYM (Qbyzantine_musical_symbol, "byzantine-musical-symbol");
   DEFSYM (Qmusical_symbol, "musical-symbol");
   DEFSYM (Qmathematical, "mathematical");
+  DEFSYM (Qcham, "cham");
   DEFSYM (Qphonetic, "phonetic");
   DEFSYM (Qbalinese, "balinese");
   DEFSYM (Qbuginese, "buginese");
@@ -2229,6 +2582,51 @@ 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;