(Fsubr_name): New fun.
[bpt/emacs.git] / src / xfaces.c
index e8a878d..41a3290 100644 (file)
@@ -1,5 +1,5 @@
 /* xfaces.c -- "Face" primitives.
-   Copyright (C) 1993, 1994, 1998, 1999, 2000, 2001, 2002
+   Copyright (C) 1993, 1994, 1998, 1999, 2000, 2001, 2002, 2003, 2004
    Free Software Foundation.
 
 This file is part of GNU Emacs.
@@ -192,6 +192,7 @@ Boston, MA 02111-1307, USA.  */
    used to fill in unspecified attributes of the default face.  */
 
 #include <config.h>
+#include <stdio.h>
 #include <sys/types.h>
 #include <sys/stat.h>
 
@@ -228,10 +229,6 @@ Boston, MA 02111-1307, USA.  */
 #define check_x check_w32
 #define x_list_fonts w32_list_fonts
 #define GCGraphicsExposures 0
-/* For historic reasons, FONT_WIDTH refers to average width on W32,
-   not maximum as on X. Redefine here. */
-#undef FONT_WIDTH
-#define FONT_WIDTH FONT_MAX_WIDTH
 #endif /* WINDOWSNT */
 
 #ifdef MAC_OS
@@ -265,7 +262,6 @@ Boston, MA 02111-1307, USA.  */
 
 #endif /* HAVE_X_WINDOWS */
 
-#include <stdio.h>
 #include <ctype.h>
 
 #define abs(X)         ((X) < 0 ? -(X) : (X))
@@ -297,21 +293,6 @@ Boston, MA 02111-1307, USA.  */
 
 #define FACE_CACHE_BUCKETS_SIZE 1001
 
-/* A definition of XColor for non-X frames.  */
-
-#ifndef HAVE_X_WINDOWS
-
-typedef struct
-{
-  unsigned long pixel;
-  unsigned short red, green, blue;
-  char flags;
-  char pad;
-}
-XColor;
-
-#endif /* not HAVE_X_WINDOWS */
-
 /* Keyword symbols used for face attribute names.  */
 
 Lisp_Object QCfamily, QCheight, QCweight, QCslant, QCunderline;
@@ -352,11 +333,6 @@ extern Lisp_Object Qmode_line;
 
 Lisp_Object Qface_alias;
 
-/* Names of frame parameters related to faces.  */
-
-extern Lisp_Object Qscroll_bar_foreground, Qscroll_bar_background;
-extern Lisp_Object Qborder_color, Qcursor_color, Qmouse_color;
-
 /* Default stipple pattern used on monochrome displays.  This stipple
    pattern is used on monochrome displays instead of shades of gray
    for a face background color.  See `set-face-stipple' for possible
@@ -388,6 +364,10 @@ Lisp_Object Vscalable_fonts_allowed, Qscalable_fonts_allowed;
 
 Lisp_Object Vface_ignored_fonts;
 
+/* Alist of font name patterns vs the rescaling factor.  */
+
+Lisp_Object Vface_font_rescale_alist;
+
 /* Maximum number of fonts to consider in font_list.  If not an
    integer > 0, DEFAULT_FONT_LIST_LIMIT is used instead.  */
 
@@ -489,7 +469,7 @@ static void set_font_frame_param P_ ((Lisp_Object, Lisp_Object));
 static int better_font_p P_ ((int *, struct font_name *, struct font_name *,
                              int, int));
 static int x_face_list_fonts P_ ((struct frame *, char *,
-                                 struct font_name *, int, int));
+                                 struct font_name **, int, int));
 static int font_scalable_p P_ ((struct font_name *));
 static int get_lface_attributes P_ ((struct frame *, Lisp_Object, Lisp_Object *, int));
 static int load_pixmap P_ ((struct frame *, Lisp_Object, unsigned *, unsigned *));
@@ -509,8 +489,9 @@ static int font_list_1 P_ ((struct frame *, Lisp_Object, Lisp_Object,
                            Lisp_Object, struct font_name **));
 static int font_list P_ ((struct frame *, Lisp_Object, Lisp_Object,
                          Lisp_Object, struct font_name **));
-static int try_font_list P_ ((struct frame *, Lisp_Object *, 
-                             Lisp_Object, Lisp_Object, struct font_name **));
+static int try_font_list P_ ((struct frame *, Lisp_Object *,
+                             Lisp_Object, Lisp_Object, struct font_name **,
+                             int));
 static int try_alternative_families P_ ((struct frame *f, Lisp_Object,
                                         Lisp_Object, struct font_name **));
 static int cmp_font_names P_ ((const void *, const void *));
@@ -536,7 +517,7 @@ static int face_numeric_weight P_ ((Lisp_Object));
 static int face_numeric_slant P_ ((Lisp_Object));
 static int face_numeric_swidth P_ ((Lisp_Object));
 static int face_fontset P_ ((Lisp_Object *));
-static char *choose_face_font P_ ((struct frame *, Lisp_Object *, int, int));
+static char *choose_face_font P_ ((struct frame *, Lisp_Object *, int, int, int*));
 static void merge_face_vectors P_ ((struct frame *, Lisp_Object *, Lisp_Object*, Lisp_Object));
 static void merge_face_inheritance P_ ((struct frame *f, Lisp_Object,
                                        Lisp_Object *, Lisp_Object));
@@ -548,7 +529,7 @@ static Lisp_Object lface_from_face_name P_ ((struct frame *, Lisp_Object, int));
 static struct face *make_realized_face P_ ((Lisp_Object *));
 static void free_realized_faces P_ ((struct face_cache *));
 static char *best_matching_font P_ ((struct frame *, Lisp_Object *,
-                                    struct font_name *, int, int));
+                                    struct font_name *, int, int, int *));
 static void cache_face P_ ((struct face_cache *, struct face *, unsigned));
 static void uncache_face P_ ((struct face_cache *, struct face *));
 static int xlfd_numeric_slant P_ ((struct font_name *));
@@ -988,13 +969,13 @@ clear_face_cache (clear_fonts_p)
       || ++clear_font_table_count == CLEAR_FONT_TABLE_COUNT)
     {
       struct x_display_info *dpyinfo;
-      
+
       /* Fonts are common for frames on one display, i.e. on
         one X screen.  */
       for (dpyinfo = x_display_list; dpyinfo; dpyinfo = dpyinfo->next)
        if (dpyinfo->n_fonts > CLEAR_FONT_TABLE_NFONTS)
          clear_font_table (dpyinfo);
-      
+
       /* From time to time see if we can unload some fonts.  This also
         frees all realized faces on all frames.  Fonts needed by
         faces will be loaded again when faces are realized again.  */
@@ -1229,30 +1210,6 @@ load_pixmap (f, name, w_ptr, h_ptr)
 
 
 \f
-/***********************************************************************
-                        Minimum font bounds
- ***********************************************************************/
-
-#ifdef HAVE_WINDOW_SYSTEM
-
-/* Update the line_height of frame F.  Return non-zero if line height
-   changes.  */
-
-int
-frame_update_line_height (f)
-     struct frame *f;
-{
-  int line_height, changed_p;
-
-  line_height = FONT_HEIGHT (FRAME_FONT (f));
-  changed_p = line_height != FRAME_LINE_HEIGHT (f);
-  FRAME_LINE_HEIGHT (f) = line_height;
-  return changed_p;
-}
-
-#endif /* HAVE_WINDOW_SYSTEM */
-
-\f
 /***********************************************************************
                                Fonts
  ***********************************************************************/
@@ -1271,11 +1228,13 @@ load_face_font (f, face, c)
 {
   struct font_info *font_info = NULL;
   char *font_name;
+  int needs_overstrike;
 
   face->font_info_id = -1;
   face->font = NULL;
 
-  font_name = choose_face_font (f, face->lface, face->fontset, c);
+  font_name = choose_face_font (f, face->lface, face->fontset, c,
+                               &needs_overstrike);
   if (!font_name)
     return;
 
@@ -1288,6 +1247,7 @@ load_face_font (f, face, c)
       face->font_info_id = font_info->font_idx;
       face->font = font_info->font;
       face->font_name = font_info->full_name;
+      face->overstrike = needs_overstrike;
       if (face->gc)
        {
          x_free_gc (f, face->gc);
@@ -1412,7 +1372,7 @@ tty_defined_color (f, color_name, color_def, alloc)
   int status = 1;
 
   /* Defaults.  */
-  color_def->pixel = FACE_TTY_DEFAULT_COLOR; 
+  color_def->pixel = FACE_TTY_DEFAULT_COLOR;
   color_def->red = 0;
   color_def->blue = 0;
   color_def->green = 0;
@@ -1545,15 +1505,19 @@ face_color_supported_p (f, color_name, background_p)
   XColor not_used;
 
   XSETFRAME (frame, f);
-  return (FRAME_WINDOW_P (f)
-         ? (!NILP (Fxw_display_color_p (frame))
-            || xstricmp (color_name, "black") == 0
-            || xstricmp (color_name, "white") == 0
-            || (background_p
-                && face_color_gray_p (f, color_name))
-            || (!NILP (Fx_display_grayscale_p (frame))
-                && face_color_gray_p (f, color_name)))
-         : tty_defined_color (f, color_name, &not_used, 0));
+  return
+#ifdef HAVE_X_WINDOWS
+    FRAME_WINDOW_P (f)
+    ? (!NILP (Fxw_display_color_p (frame))
+       || xstricmp (color_name, "black") == 0
+       || xstricmp (color_name, "white") == 0
+       || (background_p
+          && face_color_gray_p (f, color_name))
+       || (!NILP (Fx_display_grayscale_p (frame))
+          && face_color_gray_p (f, color_name)))
+    :
+#endif
+    tty_defined_color (f, color_name, &not_used, 0);
 }
 
 
@@ -1566,8 +1530,11 @@ If FRAME is nil or omitted, use the selected frame.  */)
 {
   struct frame *f;
 
-  CHECK_FRAME (frame);
   CHECK_STRING (color);
+  if (NILP (frame))
+    frame = selected_frame;
+  else
+    CHECK_FRAME (frame);
   f = XFRAME (frame);
   return face_color_gray_p (f, SDATA (color)) ? Qt : Qnil;
 }
@@ -1584,8 +1551,11 @@ COLOR must be a valid color name.  */)
 {
   struct frame *f;
 
-  CHECK_FRAME (frame);
   CHECK_STRING (color);
+  if (NILP (frame))
+    frame = selected_frame;
+  else
+    CHECK_FRAME (frame);
   f = XFRAME (frame);
   if (face_color_supported_p (f, SDATA (color), !NILP (background_p)))
     return Qt;
@@ -1951,6 +1921,11 @@ struct font_name
      split_font_name for which these are.  */
   int numeric[XLFD_LAST];
 
+  /* If the original name matches one of Vface_font_rescale_alist,
+     the value is the corresponding rescale ratio.  Otherwise, the
+     value is 1.0.  */
+  double rescale_ratio;
+
   /* Lower value mean higher priority.  */
   int registry_priority;
 };
@@ -2249,7 +2224,7 @@ xlfd_point_size (f, font)
     }
   else
     pixel = atoi (pixel_field);
-  
+
   if (pixel == 0)
     real_pt = 0;
   else
@@ -2281,6 +2256,25 @@ pixel_point_size (f, pixel)
 }
 
 
+/* Return a rescaling ratio of a font of NAME.  */
+
+static double
+font_rescale_ratio (name)
+     char *name;
+{
+  Lisp_Object tail, elt;
+
+  for (tail = Vface_font_rescale_alist; CONSP (tail); tail = XCDR (tail))
+    {
+      elt = XCAR (tail);
+      if (STRINGP (XCAR (elt)) && FLOATP (XCDR (elt))
+         && fast_c_string_match_ignore_case (XCAR (elt), name) >= 0)
+       return XFLOAT_DATA (XCDR (elt));
+    }
+  return 1.0;
+}
+
+
 /* Split XLFD font name FONT->name destructively into NUL-terminated,
    lower-case fields in FONT->fields.  NUMERIC_P non-zero means
    compute numeric values for fields XLFD_POINT_SIZE, XLFD_SWIDTH,
@@ -2297,6 +2291,11 @@ split_font_name (f, font, numeric_p)
 {
   int i = 0;
   int success_p;
+  double rescale_ratio;
+
+  if (numeric_p)
+    /* This must be done before splitting the font name.  */
+    rescale_ratio = font_rescale_ratio (font->name);
 
   if (*font->name == '-')
     {
@@ -2317,7 +2316,7 @@ split_font_name (f, font, numeric_p)
            {
              char *start, *end;
              int j;
-             
+
              for (++p; *p && *p != ']'; ++p)
                if (*p == '~')
                  *p = '-';
@@ -2356,6 +2355,7 @@ split_font_name (f, font, numeric_p)
       font->numeric[XLFD_WEIGHT] = xlfd_numeric_weight (font);
       font->numeric[XLFD_SWIDTH] = xlfd_numeric_swidth (font);
       font->numeric[XLFD_AVGWIDTH] = atoi (font->fields[XLFD_AVGWIDTH]);
+      font->rescale_ratio = rescale_ratio;
     }
 
   /* Initialize it to zero.  It will be overridden by font_list while
@@ -2446,10 +2446,10 @@ sort_fonts (f, fonts, nfonts, cmpfn)
    fonts that we can't parse.  Value is the number of fonts found.  */
 
 static int
-x_face_list_fonts (f, pattern, fonts, nfonts, try_alternatives_p)
+x_face_list_fonts (f, pattern, pfonts, nfonts, try_alternatives_p)
      struct frame *f;
      char *pattern;
-     struct font_name *fonts;
+     struct font_name **pfonts;
      int nfonts, try_alternatives_p;
 {
   int n, nignored;
@@ -2458,7 +2458,10 @@ x_face_list_fonts (f, pattern, fonts, nfonts, try_alternatives_p)
      better to do it the other way around. */
   Lisp_Object lfonts;
   Lisp_Object lpattern, tem;
+  struct font_name *fonts = 0;
+  int num_fonts = nfonts;
 
+  *pfonts = 0;
   lpattern = build_string (pattern);
 
   /* Get the list of fonts matching PATTERN.  */
@@ -2470,10 +2473,13 @@ x_face_list_fonts (f, pattern, fonts, nfonts, try_alternatives_p)
   lfonts = x_list_fonts (f, lpattern, -1, nfonts);
 #endif
 
+  if (nfonts < 0 && CONSP (lfonts))
+    num_fonts = XFASTINT (Flength (lfonts));
+
   /* Make a copy of the font names we got from X, and
      split them into fields.  */
   n = nignored = 0;
-  for (tem = lfonts; CONSP (tem) && n < nfonts; tem = XCDR (tem))
+  for (tem = lfonts; CONSP (tem) && n < num_fonts; tem = XCDR (tem))
     {
       Lisp_Object elt, tail;
       const char *name = SDATA (XCAR (tem));
@@ -2492,6 +2498,12 @@ x_face_list_fonts (f, pattern, fonts, nfonts, try_alternatives_p)
          continue;
        }
 
+      if (! fonts)
+        {
+          *pfonts = (struct font_name *) xmalloc (num_fonts * sizeof **pfonts);
+          fonts = *pfonts;
+        }
+
       /* Make a copy of the font name.  */
       fonts[n].name = xstrdup (name);
 
@@ -2515,6 +2527,12 @@ x_face_list_fonts (f, pattern, fonts, nfonts, try_alternatives_p)
     {
       Lisp_Object list = Valternate_fontname_alist;
 
+      if (*pfonts)
+        {
+          xfree (*pfonts);
+          *pfonts = 0;
+        }
+
       while (CONSP (list))
        {
          Lisp_Object entry = XCAR (list);
@@ -2538,7 +2556,7 @@ x_face_list_fonts (f, pattern, fonts, nfonts, try_alternatives_p)
                    already with no success.  */
                 && (strcmp (SDATA (name), pattern) == 0
                     || (n = x_face_list_fonts (f, SDATA (name),
-                                               fonts, nfonts, 0),
+                                               pfonts, nfonts, 0),
                         n == 0)))
            patterns = XCDR (patterns);
        }
@@ -2548,6 +2566,69 @@ x_face_list_fonts (f, pattern, fonts, nfonts, try_alternatives_p)
 }
 
 
+/* Check if a font matching pattern_offset_t on frame F is available
+   or not.  PATTERN may be a cons (FAMILY . REGISTRY), in which case,
+   a font name pattern is generated from FAMILY and REGISTRY.  */
+
+int
+face_font_available_p (f, pattern)
+     struct frame *f;
+     Lisp_Object pattern;
+{
+  Lisp_Object fonts;
+
+  if (! STRINGP (pattern))
+    {
+      Lisp_Object family, registry;
+      char *family_str, *registry_str, *pattern_str;
+
+      CHECK_CONS (pattern);
+      family = XCAR (pattern);
+      if (NILP (family))
+       family_str = "*";
+      else
+       {
+         CHECK_STRING (family);
+         family_str = (char *) SDATA (family);
+       }
+      registry = XCDR (pattern);
+      if (NILP (registry))
+       registry_str = "*";
+      else
+       {
+         CHECK_STRING (registry);
+         registry_str = (char *) SDATA (registry);
+       }
+
+      pattern_str = (char *) alloca (strlen (family_str)
+                                    + strlen (registry_str)
+                                    + 10);
+      strcpy (pattern_str, index (family_str, '-') ? "-" : "-*-");
+      strcat (pattern_str, family_str);
+      strcat (pattern_str, "-*-");
+      strcat (pattern_str, registry_str);
+      if (!index (registry_str, '-'))
+       {
+         if (registry_str[strlen (registry_str) - 1] == '*')
+           strcat (pattern_str, "-*");
+         else
+           strcat (pattern_str, "*-*");
+       }
+      pattern = build_string (pattern_str);
+    }
+
+  /* Get the list of fonts matching PATTERN.  */
+#ifdef WINDOWSNT
+  BLOCK_INPUT;
+  fonts = w32_list_fonts (f, pattern, 0, 1);
+  UNBLOCK_INPUT;
+#else
+  fonts = x_list_fonts (f, pattern, -1, 1);
+#endif
+  return XINT (Flength (fonts));
+}
+
+
 /* Determine fonts matching PATTERN on frame F.  Sort resulting fonts
    using comparison function CMPFN.  Value is the number of fonts
    found.  If value is non-zero, *FONTS is set to a vector of
@@ -2567,17 +2648,17 @@ sorted_font_list (f, pattern, cmpfn, fonts)
 
   /* Get the list of fonts matching pattern.  100 should suffice.  */
   nfonts = DEFAULT_FONT_LIST_LIMIT;
-  if (INTEGERP (Vfont_list_limit) && XINT (Vfont_list_limit) > 0)
-    nfonts = XFASTINT (Vfont_list_limit);
+  if (INTEGERP (Vfont_list_limit))
+    nfonts = XINT (Vfont_list_limit);
 
-  *fonts = (struct font_name *) xmalloc (nfonts * sizeof **fonts);
-  nfonts = x_face_list_fonts (f, pattern, *fonts, nfonts, 1);
+  *fonts = NULL;
+  nfonts = x_face_list_fonts (f, pattern, fonts, nfonts, 1);
 
   /* Sort the resulting array and return it in *FONTS.  If no
      fonts were found, make sure to set *FONTS to null.  */
   if (nfonts)
     sort_fonts (f, *fonts, nfonts, cmpfn);
-  else
+  else if (*fonts)
     {
       xfree (*fonts);
       *fonts = NULL;
@@ -2700,7 +2781,7 @@ concat_font_list (fonts1, nfonts1, fonts2, nfonts2)
 
    If REGISTRY is non-nil, return fonts with that registry and the
    alternative registries from Vface_alternative_font_registry_alist.
-   
+
    If REGISTRY is nil return fonts of any registry.
 
    Set *FONTS to a vector of font_name structures allocated from the
@@ -2714,7 +2795,7 @@ font_list (f, pattern, family, registry, fonts)
      struct font_name **fonts;
 {
   int nfonts = font_list_1 (f, pattern, family, registry, fonts);
-  
+
   if (!NILP (registry)
       && CONSP (Vface_alternative_font_registry_alist))
     {
@@ -2845,23 +2926,10 @@ are fixed-pitch.  */)
   Lisp_Object result;
   struct gcpro gcpro1;
   int count = SPECPDL_INDEX ();
-  int limit;
 
-  /* Let's consider all fonts.  Increase the limit for matching
-     fonts until we have them all.  */
-  for (limit = 500;;)
-    {
-      specbind (intern ("font-list-limit"), make_number (limit));
-      nfonts = font_list (f, Qnil, Qnil, Qnil, &fonts);
-
-      if (nfonts == limit)
-       {
-         free_font_names (fonts, nfonts);
-         limit *= 2;
-       }
-      else
-       break;
-    }
+  /* Let's consider all fonts.  */
+  specbind (intern ("font-list-limit"), make_number (-1));
+  nfonts = font_list (f, Qnil, Qnil, Qnil, &fonts);
 
   result = Qnil;
   GCPRO1 (result);
@@ -2908,7 +2976,7 @@ the WIDTH times as wide as FACE on FRAME.  */)
   CHECK_STRING (pattern);
 
   if (NILP (maximum))
-    maxnames = 2000;
+    maxnames = -1;
   else
     {
       CHECK_NATNUM (maximum);
@@ -2941,10 +3009,17 @@ the WIDTH times as wide as FACE on FRAME.  */)
                           ? NULL
                           : FACE_FROM_ID (f, face_id));
 
+#ifdef WINDOWSNT
+/* For historic reasons, FONT_WIDTH refers to average width on W32,
+   not maximum as on X.  Redefine here. */
+#undef FONT_WIDTH
+#define FONT_WIDTH FONT_MAX_WIDTH
+#endif
+
       if (face && face->font)
        size = FONT_WIDTH (face->font);
       else
-       size = FONT_WIDTH (FRAME_FONT (f));
+       size = FONT_WIDTH (FRAME_FONT (f));  /* FRAME_COLUMN_WIDTH (f) */
 
       if (!NILP (width))
        size *= XINT (width);
@@ -3178,7 +3253,13 @@ lface_fully_specified_p (attrs)
   for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
     if (i != LFACE_FONT_INDEX && i != LFACE_INHERIT_INDEX
        && i != LFACE_AVGWIDTH_INDEX)
-      if (UNSPECIFIEDP (attrs[i])) 
+      if (UNSPECIFIEDP (attrs[i])
+#ifdef MAC_OS
+        /* MAC_TODO: No stipple support on Mac OS yet, this index is
+           always unspecified.  */
+          && i != LFACE_STIPPLE_INDEX
+#endif
+          )
         break;
 
   return i == LFACE_VECTOR_SIZE;
@@ -3398,32 +3479,6 @@ merge_face_vectors (f, from, to, cycle_check)
   to[LFACE_INHERIT_INDEX] = Qnil;
 }
 
-
-/* Checks the `cycle check' variable CHECK to see if it indicates that
-   EL is part of a cycle; CHECK must be either Qnil or a value returned
-   by an earlier use of CYCLE_CHECK.  SUSPICIOUS is the number of
-   elements after which a cycle might be suspected; after that many
-   elements, this macro begins consing in order to keep more precise
-   track of elements.
-
-   Returns nil if a cycle was detected, otherwise a new value for CHECK
-   that includes EL.
-
-   CHECK is evaluated multiple times, EL and SUSPICIOUS 0 or 1 times, so
-   the caller should make sure that's ok.  */
-
-#define CYCLE_CHECK(check, el, suspicious)     \
-  (NILP (check)                                        \
-   ? make_number (0)                           \
-   : (INTEGERP (check)                         \
-      ? (XFASTINT (check) < (suspicious)       \
-        ? make_number (XFASTINT (check) + 1)   \
-        : Fcons (el, Qnil))                    \
-      : (!NILP (Fmemq ((el), (check)))         \
-        ? Qnil                                 \
-        : Fcons ((el), (check)))))
-
-
 /* Merge face attributes from the face on frame F whose name is
    INHERITS, into the vector of face attributes TO; INHERITS may also be
    a list of face names, in which case they are applied in order.
@@ -4134,20 +4189,24 @@ FRAME 0 means change the face on all frames, and change the default
          struct frame *f;
          Lisp_Object tmp;
 
-         CHECK_STRING (value);
          if (EQ (frame, Qt))
            f = SELECTED_FRAME ();
          else
            f = check_x_frame (frame);
 
-         /* VALUE may be a fontset name or an alias of fontset.  In
-            such a case, use the base fontset name.  */
-         tmp = Fquery_fontset (value, Qnil);
-         if (!NILP (tmp))
-           value = tmp;
+         if (!UNSPECIFIEDP (value))
+           {
+             CHECK_STRING (value);
+
+             /* VALUE may be a fontset name or an alias of fontset.  In
+                such a case, use the base fontset name.  */
+             tmp = Fquery_fontset (value, Qnil);
+             if (!NILP (tmp))
+               value = tmp;
 
-         if (!set_lface_from_font_name (f, lface, value, 1, 1))
-           signal_error ("Invalid font or fontset name", value);
+             if (!set_lface_from_font_name (f, lface, value, 1, 1))
+               signal_error ("Invalid font or fontset name", value);
+           }
 
          font_attr_p = 1;
        }
@@ -4319,7 +4378,7 @@ set_font_frame_param (frame, lface)
     {
       Lisp_Object font_name;
       char *font;
-      
+
       if (STRINGP (LFACE_FONT (lface)))
        font_name = LFACE_FONT (lface);
       else
@@ -4327,13 +4386,14 @@ set_font_frame_param (frame, lface)
          /* Choose a font name that reflects LFACE's attributes and has
             the registry and encoding pattern specified in the default
             fontset (3rd arg: -1) for ASCII characters (4th arg: 0).  */
-         font = choose_face_font (f, XVECTOR (lface)->contents, -1, 0);
+         font = choose_face_font (f, XVECTOR (lface)->contents, -1, 0, 0);
          if (!font)
            error ("No font matches the specified attribute");
          font_name = build_string (font);
          xfree (font);
        }
-  
+
+      f->default_face_done_p = 0;
       Fmodify_frame_parameters (frame, Fcons (Fcons (Qfont, font_name), Qnil));
     }
 }
@@ -4416,8 +4476,6 @@ DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource,
      Lisp_Object resource, class, frame;
 {
   Lisp_Object value = Qnil;
-#ifndef WINDOWSNT
-#ifndef MAC_OS
   CHECK_STRING (resource);
   CHECK_STRING (class);
   CHECK_LIVE_FRAME (frame);
@@ -4425,8 +4483,6 @@ DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource,
   value = display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame)),
                                  resource, class, Qnil, Qnil);
   UNBLOCK_INPUT;
-#endif /* not MAC_OS */
-#endif /* not WINDOWSNT */
   return value;
 }
 
@@ -4535,7 +4591,7 @@ x_update_menu_appearance (f)
 #else
       const char *popup_path = "menu.popup";
 #endif
-      
+
       if (STRINGP (LFACE_FOREGROUND (lface)))
        {
          sprintf (line, "%s.%s*foreground: %s",
@@ -4559,7 +4615,7 @@ x_update_menu_appearance (f)
          XrmPutLineResource (&rdb, line);
          changed_p = 1;
        }
-         
+
       if (face->font_name
          && (!UNSPECIFIEDP (LFACE_FAMILY (lface))
              || !UNSPECIFIEDP (LFACE_SWIDTH (lface))
@@ -4590,7 +4646,7 @@ x_update_menu_appearance (f)
 #endif /* HAVE_X_WINDOWS && USE_X_TOOLKIT */
 
 
-DEFUN ("face-attribute-relative-p", Fface_attribute_relative_p, 
+DEFUN ("face-attribute-relative-p", Fface_attribute_relative_p,
        Sface_attribute_relative_p,
        2, 2, 0,
        doc: /* Return non-nil if face ATTRIBUTE VALUE is relative.  */)
@@ -5263,7 +5319,7 @@ substitution of a `dim' face for italic.  */)
       else if (weight < XLFD_WEIGHT_MEDIUM)
        test_caps = TTY_CAP_DIM;
     }
-      
+
   /* underlining */
   val = attrs[LFACE_UNDERLINE_INDEX];
   if (!UNSPECIFIEDP (val) && !NILP (val))
@@ -5562,12 +5618,19 @@ cache_face (c, face, hash)
   face->id = i;
 
   /* Maybe enlarge C->faces_by_id.  */
-  if (i == c->used && c->used == c->size)
+  if (i == c->used)
     {
-      int new_size = 2 * c->size;
-      int sz = new_size * sizeof *c->faces_by_id;
-      c->faces_by_id = (struct face **) xrealloc (c->faces_by_id, sz);
-      c->size = new_size;
+      if (c->used == c->size)
+       {
+         int new_size, sz;
+         new_size = min (2 * c->size, MAX_FACE_ID);
+         if (new_size == c->size)
+           abort ();  /* Alternatives?  ++kfs */
+         sz = new_size * sizeof *c->faces_by_id;
+         c->faces_by_id = (struct face **) xrealloc (c->faces_by_id, sz);
+         c->size = new_size;
+       }
+      c->used++;
     }
 
 #if GLYPH_DEBUG
@@ -5586,8 +5649,6 @@ cache_face (c, face, hash)
 #endif /* GLYPH_DEBUG */
 
   c->faces_by_id[i] = face;
-  if (i == c->used)
-    ++c->used;
 }
 
 
@@ -5998,12 +6059,23 @@ better_font_p (values, font1, font2, compare_pt_p, avgwidth)
 
       if (compare_pt_p || xlfd_idx != XLFD_POINT_SIZE)
        {
-         int delta1 = abs (values[i] - font1->numeric[xlfd_idx]);
-         int delta2 = abs (values[i] - font2->numeric[xlfd_idx]);
+         int delta1, delta2;
+
+         if (xlfd_idx == XLFD_POINT_SIZE)
+           {
+             delta1 = abs (values[i] - (font1->numeric[xlfd_idx]
+                                        / font1->rescale_ratio));
+             delta2 = abs (values[i] - (font2->numeric[xlfd_idx]
+                                        / font2->rescale_ratio));
+             if (abs (delta1 - delta2) < FONT_POINT_SIZE_QUANTUM)
+               continue;
+           }
+         else
+           {
+             delta1 = abs (values[i] - font1->numeric[xlfd_idx]);
+             delta2 = abs (values[i] - font2->numeric[xlfd_idx]);
+           }
 
-         if (xlfd_idx == XLFD_POINT_SIZE
-             && abs (delta1 - delta2) < FONT_POINT_SIZE_QUANTUM)
-           continue;
          if (delta1 > delta2)
            return 0;
          else if (delta1 < delta2)
@@ -6031,6 +6103,18 @@ better_font_p (values, font1, font2, compare_pt_p, avgwidth)
        return 1;
     }
 
+  if (! compare_pt_p)
+    {
+      /* We prefer a real scalable font; i.e. not what autoscaled.  */
+      int auto_scaled_1 = (font1->numeric[XLFD_POINT_SIZE] == 0
+                          && font1->numeric[XLFD_RESY] > 0);
+      int auto_scaled_2 = (font2->numeric[XLFD_POINT_SIZE] == 0
+                          && font2->numeric[XLFD_RESY] > 0);
+
+      if (auto_scaled_1 != auto_scaled_2)
+       return auto_scaled_2;
+    }
+
   return font1->registry_priority < font2->registry_priority;
 }
 
@@ -6068,7 +6152,7 @@ build_scalable_font_name (f, font, specified_pt)
      struct font_name *font;
      int specified_pt;
 {
-  char point_size[20], pixel_size[20];
+  char pixel_size[20];
   int pixel_value;
   double resy = FRAME_X_DISPLAY_INFO (f)->resy;
   double pt;
@@ -6086,11 +6170,19 @@ build_scalable_font_name (f, font, specified_pt)
       pt = specified_pt;
       pixel_value = resy / (PT_PER_INCH * 10.0) * pt;
     }
+  /* We may need a font of the different size.  */
+  pixel_value *= font->rescale_ratio;
 
-  /* Set point size of the font.  */
-  sprintf (point_size, "%d", (int) pt);
-  font->fields[XLFD_POINT_SIZE] = point_size;
-  font->numeric[XLFD_POINT_SIZE] = pt;
+  /* We should keep POINT_SIZE 0.  Otherwise, X server can't open a
+     font of the specified PIXEL_SIZE.  */
+#if 0
+  { /* Set point size of the font.  */
+    char point_size[20];
+    sprintf (point_size, "%d", (int) pt);
+    font->fields[XLFD_POINT_SIZE] = point_size;
+    font->numeric[XLFD_POINT_SIZE] = pt;
+  }
+#endif
 
   /* Set pixel size.  */
   sprintf (pixel_size, "%d", pixel_value);
@@ -6154,15 +6246,20 @@ may_use_scalable_font_p (font)
    widths if ATTRS specifies such a width.
 
    Value is a font name which is allocated from the heap.  FONTS is
-   freed by this function.  */
+   freed by this function.
+
+   If NEEDS_OVERSTRIKE is non-zero, a boolean is returned in it to
+   indicate whether the resulting font should be drawn using overstrike
+   to simulate bold-face.  */
 
 static char *
-best_matching_font (f, attrs, fonts, nfonts, width_ratio)
+best_matching_font (f, attrs, fonts, nfonts, width_ratio, needs_overstrike)
      struct frame *f;
      Lisp_Object *attrs;
      struct font_name *fonts;
      int nfonts;
      int width_ratio;
+     int *needs_overstrike;
 {
   char *font_name;
   struct font_name *best;
@@ -6197,6 +6294,9 @@ best_matching_font (f, attrs, fonts, nfonts, width_ratio)
 
   exact_p = 0;
 
+  if (needs_overstrike)
+    *needs_overstrike = 0;
+
   /* Start with the first non-scalable font in the list.  */
   for (i = 0; i < nfonts; ++i)
     if (!font_scalable_p (fonts + i))
@@ -6217,7 +6317,6 @@ best_matching_font (f, attrs, fonts, nfonts, width_ratio)
            if (exact_p)
              break;
          }
-
     }
   else
     best = NULL;
@@ -6248,8 +6347,29 @@ best_matching_font (f, attrs, fonts, nfonts, width_ratio)
                || better_font_p (specified, fonts + i, best, 0, 0)
                || (!non_scalable_has_exact_height_p
                    && !better_font_p (specified, best, fonts + i, 0, 0)))
-             best = fonts + i;
+             {
+               non_scalable_has_exact_height_p = 1;
+               best = fonts + i;
+             }
          }
+
+      if (needs_overstrike)
+       {
+         enum xlfd_weight want_weight = specified[XLFD_WEIGHT];
+         enum xlfd_weight got_weight = best->numeric[XLFD_WEIGHT];
+
+         if (want_weight > XLFD_WEIGHT_MEDIUM && want_weight > got_weight)
+           {
+             /* We want a bold font, but didn't get one; try to use
+                overstriking instead to simulate bold-face.  However,
+                don't overstrike an already-bold fontn unless the
+                desired weight grossly exceeds the available weight.  */
+             if (got_weight > XLFD_WEIGHT_MEDIUM)
+               *needs_overstrike = (got_weight - want_weight) > 2;
+             else
+               *needs_overstrike = 1;
+           }
+       }
     }
 
   if (font_scalable_p (best))
@@ -6272,7 +6392,7 @@ best_matching_font (f, attrs, fonts, nfonts, width_ratio)
    REGISTRY, if a string, specifies a font registry and encoding to
    match.  A value of nil means include fonts of any registry and
    encoding.
-   
+
    Return in *FONTS a pointer to a vector of font_name structures for
    the fonts matched.  Value is the number of fonts found.  */
 
@@ -6300,9 +6420,9 @@ try_alternative_families (f, family, registry, fonts)
                nfonts = font_list (f, Qnil, XCAR (alter), registry, fonts);
            }
        }
-      
-      /* Try scalable fonts before giving up.  */
-      if (nfonts == 0 && NILP (Vscalable_fonts_allowed))
+
+      /* Try all scalable fonts before giving up.  */
+      if (nfonts == 0 && ! EQ (Vscalable_fonts_allowed, Qt))
        {
          int count = SPECPDL_INDEX ();
          specbind (Qscalable_fonts_allowed, Qt);
@@ -6323,22 +6443,29 @@ try_alternative_families (f, family, registry, fonts)
    REGISTRY, if a string, specifies a font registry and encoding to
    match.  A value of nil means include fonts of any registry and
    encoding.
-   
+
+   If PREFER_FACE_FAMILY is nonzero, perfer face's family to FAMILY.
+   Otherwise, prefer FAMILY.
+
    Return in *FONTS a pointer to a vector of font_name structures for
    the fonts matched.  Value is the number of fonts found.  */
 
 static int
-try_font_list (f, attrs, family, registry, fonts)
+try_font_list (f, attrs, family, registry, fonts, prefer_face_family)
      struct frame *f;
      Lisp_Object *attrs;
      Lisp_Object family, registry;
      struct font_name **fonts;
+     int prefer_face_family;
 {
   int nfonts = 0;
   Lisp_Object face_family = attrs[LFACE_FAMILY_INDEX];
+  Lisp_Object try_family;
 
-  if (STRINGP (face_family))
-    nfonts = try_alternative_families (f, face_family, registry, fonts);
+  try_family = (prefer_face_family || NILP (family)) ? face_family : family;
+
+  if (STRINGP (try_family))
+    nfonts = try_alternative_families (f, try_family, registry, fonts);
 
 #ifdef MAC_OS
   /* When realizing the default face and a font spec does not matched
@@ -6346,12 +6473,15 @@ try_font_list (f, attrs, family, registry, fonts)
      default font.  On the Mac, this is mac-roman, which does not work
      if the family is -etl-fixed, e.g.  The following widens the
      choices and fixes that problem.  */
-  if (nfonts == 0 && STRINGP (face_family) && STRINGP (registry)
+  if (nfonts == 0 && STRINGP (try_family) && STRINGP (registry)
       && xstricmp (SDATA (registry), "mac-roman") == 0)
-    nfonts = try_alternative_families (f, face_family, Qnil, fonts);
+    nfonts = try_alternative_families (f, try_family, Qnil, fonts);
 #endif
 
-  if (nfonts == 0 && !NILP (family))
+  if (EQ (try_family, family))
+    family = face_family;
+
+  if (nfonts == 0 && STRINGP (family))
     nfonts = try_alternative_families (f, family, registry, fonts);
 
   /* Try font family of the default face or "fixed".  */
@@ -6364,10 +6494,10 @@ try_font_list (f, attrs, family, registry, fonts)
        family = build_string ("fixed");
       nfonts = font_list (f, Qnil, family, registry, fonts);
     }
-      
+
   /* Try any family with the given registry.  */
   if (nfonts == 0)
-    nfonts = font_list (f, Qnil, Qnil, registry, fonts);
+    nfonts = try_alternative_families (f, Qnil, registry, fonts);
 
   return nfonts;
 }
@@ -6397,19 +6527,27 @@ face_fontset (attrs)
    allocated from the heap and must be freed by the caller, or NULL if
    we can get no information about the font name of C.  It is assured
    that we always get some information for a single byte
-   character.  */
+   character.
+
+   If NEEDS_OVERSTRIKE is non-zero, a boolean is returned in it to
+   indicate whether the resulting font should be drawn using overstrike
+   to simulate bold-face.  */
 
 static char *
-choose_face_font (f, attrs, fontset, c)
+choose_face_font (f, attrs, fontset, c, needs_overstrike)
      struct frame *f;
      Lisp_Object *attrs;
      int fontset, c;
+     int *needs_overstrike;
 {
   Lisp_Object pattern;
   char *font_name = NULL;
   struct font_name *fonts;
   int nfonts, width_ratio;
 
+  if (needs_overstrike)
+    *needs_overstrike = 0;
+
   /* Get (foundry and) family name and registry (and encoding) name of
      a font for C.  */
   pattern = fontset_font_pattern (f, fontset, c);
@@ -6418,18 +6556,21 @@ choose_face_font (f, attrs, fontset, c)
       xassert (!SINGLE_BYTE_CHAR_P (c));
       return NULL;
     }
-  
+
   /* If what we got is a name pattern, return it.  */
   if (STRINGP (pattern))
     return xstrdup (SDATA (pattern));
 
   /* Get a list of fonts matching that pattern and choose the
      best match for the specified face attributes from it.  */
-  nfonts = try_font_list (f, attrs, XCAR (pattern), XCDR (pattern), &fonts);
+  nfonts = try_font_list (f, attrs, XCAR (pattern), XCDR (pattern), &fonts,
+                         (SINGLE_BYTE_CHAR_P (c)
+                          || CHAR_CHARSET (c) == charset_latin_iso8859_1));
   width_ratio = (SINGLE_BYTE_CHAR_P (c)
                 ? 1
                 : CHARSET_WIDTH (CHAR_CHARSET (c)));
-  font_name = best_matching_font (f, attrs, fonts, nfonts, width_ratio);
+  font_name = best_matching_font (f, attrs, fonts, nfonts, width_ratio,
+                                 needs_overstrike);
   return font_name;
 }
 
@@ -6478,7 +6619,7 @@ realize_basic_faces (f)
          x_update_menu_appearance (f);
 #endif
        }
-      
+
       success_p = 1;
     }
 
@@ -6505,11 +6646,12 @@ realize_default_face (f)
   /* If the `default' face is not yet known, create it.  */
   lface = lface_from_face_name (f, Qdefault, 0);
   if (NILP (lface))
-    {
-      Lisp_Object frame;
-      XSETFRAME (frame, f);
-      lface = Finternal_make_lisp_face (Qdefault, frame);
-    }
+  {
+       Lisp_Object frame;
+       XSETFRAME (frame, f);
+       lface = Finternal_make_lisp_face (Qdefault, frame);
+  }
+
 
 #ifdef HAVE_WINDOW_SYSTEM
   if (FRAME_WINDOW_P (f))
@@ -6518,7 +6660,9 @@ realize_default_face (f)
       frame_font = Fassq (Qfont, f->param_alist);
       xassert (CONSP (frame_font) && STRINGP (XCDR (frame_font)));
       frame_font = XCDR (frame_font);
-      set_lface_from_font_name (f, lface, frame_font, 1, 1);
+      set_lface_from_font_name (f, lface, frame_font,
+                                f->default_face_done_p, 1);
+      f->default_face_done_p = 1;
     }
 #endif /* HAVE_WINDOW_SYSTEM */
 
@@ -6922,10 +7066,10 @@ map_tty_color (f, face, idx, defaulted)
       pixel = default_pixel = FACE_TTY_DEFAULT_BG_COLOR;
       default_other_pixel = FACE_TTY_DEFAULT_FG_COLOR;
     }
-  
+
   XSETFRAME (frame, f);
   color = face->lface[idx];
-  
+
   if (STRINGP (color)
       && SCHARS (color)
       && CONSP (Vtty_defined_color_alist)
@@ -7020,7 +7164,7 @@ realize_tty_face (cache, attrs, c)
   /* Map color names to color indices.  */
   map_tty_color (f, face, LFACE_FOREGROUND_INDEX, &face_colors_defaulted);
   map_tty_color (f, face, LFACE_BACKGROUND_INDEX, &face_colors_defaulted);
-  
+
   /* Swap colors if face is inverse-video.  If the colors are taken
      from the frame colors, they are already inverted, since the
      frame-creation function calls x-handle-reverse-video.  */
@@ -7639,6 +7783,15 @@ Each element is a regular expression that matches names of fonts to
 ignore.  */);
   Vface_ignored_fonts = Qnil;
 
+  DEFVAR_LISP ("face-font-rescale-alist", &Vface_font_rescale_alist,
+              doc: /* Alist of fonts vs the rescaling factors.
+Each element is a cons (FONT-NAME-PATTERN . RESCALE-RATIO), where
+FONT-NAME-PATTERN is a regular expression matching a font name, and
+RESCALE-RATIO is a floating point number to specify how much larger
+\(or smaller) font we should use.  For instance, if a face requests
+a font of 10 point, we actually use a font of 10 * RESCALE-RATIO point.  */);
+  Vface_font_rescale_alist = Qnil;
+
 #ifdef HAVE_WINDOW_SYSTEM
   defsubr (&Sbitmap_spec_p);
   defsubr (&Sx_list_fonts);
@@ -7647,3 +7800,6 @@ ignore.  */);
   defsubr (&Sx_font_family_list);
 #endif /* HAVE_WINDOW_SYSTEM */
 }
+
+/* arch-tag: 8a0f7598-5517-408d-9ab3-1da6fcd4c749
+   (do not change this comment) */