(-windowDidResize:): Avoid inf-loop under GNUStep.
[bpt/emacs.git] / src / w32font.c
index 4cfa8a2..7d9db3a 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.
 
@@ -28,6 +28,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"
@@ -67,7 +68,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;
@@ -113,7 +114,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));
 
@@ -160,6 +160,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.  */
@@ -287,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;
 
@@ -312,8 +338,11 @@ w32font_has_char (entity, c)
     return -1;
 
   /* Font reports what scripts it supports, and none of them are the script
-     the character is from, so it is a definite no.  */
-  return 0;
+     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.
@@ -701,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;
@@ -721,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.
@@ -840,10 +882,10 @@ w32font_open_internal (f, font_entity, pixel_size, font_object)
       }
     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;
@@ -922,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);
 
@@ -996,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)));
@@ -1332,6 +1373,14 @@ check_face_name (font, full_name)
       _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.  */
@@ -1357,90 +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;
+
+  /* Skip non matching fonts.  */
 
-  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))
+  /* 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.  */
-      && (match_data->pattern.lfFaceName[0]
-         && check_face_name (&logical_font->elfLogFont,
-                             logical_font->elfFullName)))
+      || (!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))
-              && logical_font->elfLogFont.lfCharSet != DEFAULT_CHARSET
-              && logical_font->elfLogFont.lfCharSet != ANSI_CHARSET)
-            return 1;
-         /* unicode-sip fonts must contain characters beyond the BMP,
-            so look for bit 57 (surrogates) in the Unicode subranges.  */
-         else if (EQ (spec_charset, Qunicode_sip)
-                  && !(physical_font->ntmFontSig.fsUsb[1] & 0x02000000))
+      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;
-          /* 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);
-            }
-        }
+       }
+      /* 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;
 }
@@ -1459,7 +1521,7 @@ 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.  */
@@ -1891,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);
@@ -1977,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;
 
@@ -2324,19 +2389,6 @@ compute_metrics (dc, w32_font, code, metrics)
     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.
@@ -2391,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 =
@@ -2455,8 +2507,6 @@ syms_of_w32font ()
   DEFSYM (Qnatural, "natural");
 
   /* Languages  */
-  DEFSYM (Qja, "ja");
-  DEFSYM (Qko, "ko");
   DEFSYM (Qzh, "zh");
 
   /* Scripts  */