]> code.delx.au - gnu-emacs/blobdiff - src/xfaces.c
Merged from miles@gnu.org--gnu-2005 (patch 438-440)
[gnu-emacs] / src / xfaces.c
index c6dff0bae7f3802bad7dd2157260ebb9215f8422..78dc41116e4d2908b0464f92ce3dcb5e8b35ded7 100644 (file)
@@ -1,5 +1,5 @@
 /* xfaces.c -- "Face" primitives.
-   Copyright (C) 1993, 1994, 1998, 1999, 2000, 2001, 2002, 2003, 2004
+   Copyright (C) 1993, 1994, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005
    Free Software Foundation.
 
 This file is part of GNU Emacs.
@@ -195,11 +195,13 @@ Boston, MA 02111-1307, USA.  */
 #include <stdio.h>
 #include <sys/types.h>
 #include <sys/stat.h>
+#include <stdio.h>              /* This needs to be before termchar.h */
 
 #include "lisp.h"
 #include "charset.h"
 #include "keyboard.h"
 #include "frame.h"
+#include "termhooks.h"
 
 #ifdef HAVE_WINDOW_SYSTEM
 #include "fontset.h"
@@ -242,6 +244,7 @@ Boston, MA 02111-1307, USA.  */
 #include "blockinput.h"
 #include "window.h"
 #include "intervals.h"
+#include "termchar.h"
 
 #ifdef HAVE_X_WINDOWS
 
@@ -316,15 +319,15 @@ Lisp_Object Qunspecified;
 char unspecified_fg[] = "unspecified-fg", unspecified_bg[] = "unspecified-bg";
 
 /* The name of the function to call when the background of the frame
-   has changed, frame_update_face_colors.  */
+   has changed, frame_set_background_mode.  */
 
-Lisp_Object Qframe_update_face_colors;
+Lisp_Object Qframe_set_background_mode;
 
 /* Names of basic faces.  */
 
 Lisp_Object Qdefault, Qtool_bar, Qregion, Qfringe;
 Lisp_Object Qheader_line, Qscroll_bar, Qcursor, Qborder, Qmouse, Qmenu;
-Lisp_Object Qmode_line_inactive;
+Lisp_Object Qmode_line_inactive, Qvertical_border;
 extern Lisp_Object Qmode_line;
 
 /* The symbol `face-alias'.  A symbols having that property is an
@@ -333,6 +336,8 @@ extern Lisp_Object Qmode_line;
 
 Lisp_Object Qface_alias;
 
+extern Lisp_Object Qcircular_list;
+
 /* 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
@@ -468,7 +473,7 @@ struct named_merge_point;
 
 static void map_tty_color P_ ((struct frame *, struct face *,
                               enum lface_attribute_index, int *));
-static Lisp_Object resolve_face_name P_ ((Lisp_Object));
+static Lisp_Object resolve_face_name P_ ((Lisp_Object, int));
 static int may_use_scalable_font_p P_ ((const char *));
 static void set_font_frame_param P_ ((Lisp_Object, Lisp_Object));
 static int better_font_p P_ ((int *, struct font_name *, struct font_name *,
@@ -738,7 +743,7 @@ x_free_gc (f, gc)
      GC gc;
 {
   BLOCK_INPUT;
-  xassert (--ngcs >= 0);
+  IF_DEBUG (xassert (--ngcs >= 0));
   XFreeGC (FRAME_X_DISPLAY (f), gc);
   UNBLOCK_INPUT;
 }
@@ -771,7 +776,7 @@ x_free_gc (f, gc)
      GC gc;
 {
   BLOCK_INPUT;
-  xassert (--ngcs >= 0);
+  IF_DEBUG (xassert (--ngcs >= 0));
   xfree (gc);
   UNBLOCK_INPUT;
 }
@@ -1513,7 +1518,7 @@ face_color_supported_p (f, color_name, background_p)
 
   XSETFRAME (frame, f);
   return
-#ifdef HAVE_X_WINDOWS
+#ifdef HAVE_WINDOW_SYSTEM
     FRAME_WINDOW_P (f)
     ? (!NILP (Fxw_display_color_p (frame))
        || xstricmp (color_name, "black") == 0
@@ -3201,27 +3206,63 @@ push_named_merge_point (struct named_merge_point *new_named_merge_point,
 
 \f
 
+static Lisp_Object
+internal_resolve_face_name (nargs, args)
+     int nargs;
+     Lisp_Object *args;
+{
+  Fget (args[0], args[1]);
+}
+
+static Lisp_Object
+resolve_face_name_error (ignore)
+     Lisp_Object ignore;
+{
+  return Qnil;
+}
 
 /* Resolve face name FACE_NAME.  If FACE_NAME is a string, intern it
-   to make it a symvol.  If FACE_NAME is an alias for another face,
-   return that face's name.  */
+   to make it a symbol.  If FACE_NAME is an alias for another face,
+   return that face's name.
+
+   Return default face in case of errors.  */
 
 static Lisp_Object
-resolve_face_name (face_name)
+resolve_face_name (face_name, signal_p)
      Lisp_Object face_name;
+     int signal_p;
 {
-  Lisp_Object aliased;
+  Lisp_Object orig_face;
+  Lisp_Object tortoise, hare;
 
   if (STRINGP (face_name))
     face_name = intern (SDATA (face_name));
 
-  while (SYMBOLP (face_name))
+  if (NILP (face_name) || !SYMBOLP (face_name))
+    return face_name;
+
+  orig_face = face_name;
+  tortoise = hare = face_name;
+
+  while (1)
     {
-      aliased = Fget (face_name, Qface_alias);
-      if (NILP (aliased))
+      face_name = hare;
+      hare = Fget (hare, Qface_alias);
+      if (NILP (hare) || !SYMBOLP (hare))
        break;
-      else
-       face_name = aliased;
+
+      face_name = hare;
+      hare = Fget (hare, Qface_alias);
+      if (NILP (hare) || !SYMBOLP (hare))
+       break;
+
+      tortoise = Fget (tortoise, Qface_alias);
+      if (EQ (hare, tortoise))
+       {
+         if (signal_p)
+           Fsignal (Qcircular_list, Fcons (orig_face, Qnil));
+         return Qdefault;
+       }
     }
 
   return face_name;
@@ -3245,7 +3286,7 @@ lface_from_face_name (f, face_name, signal_p)
 {
   Lisp_Object lface;
 
-  face_name = resolve_face_name (face_name);
+  face_name = resolve_face_name (face_name, signal_p);
 
   if (f)
     lface = assq_no_quit (face_name, f->face_alist);
@@ -3980,7 +4021,7 @@ FRAME 0 means change the face on all frames, and change the default
   CHECK_SYMBOL (face);
   CHECK_SYMBOL (attr);
 
-  face = resolve_face_name (face);
+  face = resolve_face_name (face, 1);
 
   /* If FRAME is 0, change face on all frames, and change the
      default for new frames.  */
@@ -4148,7 +4189,7 @@ FRAME 0 means change the face on all frames, and change the default
                }
              else if (EQ (k, QCcolor))
                {
-                 if (!STRINGP (v) || SCHARS (v) == 0)
+                 if (!NILP (v) && (!STRINGP (v) || SCHARS (v) == 0))
                    break;
                }
              else if (EQ (k, QCstyle))
@@ -4485,10 +4526,10 @@ update_face_from_frame_parameter (f, param, new_value)
       Lisp_Object frame;
 
       /* Changing the background color might change the background
-        mode, so that we have to load new defface specs.  Call
-        frame-update-face-colors to do that.  */
+        mode, so that we have to load new defface specs.
+        Call frame-set-background-mode to do that.  */
       XSETFRAME (frame, f);
-      call1 (Qframe_update_face_colors, frame);
+      call1 (Qframe_set_background_mode, frame);
 
       face = Qdefault;
       lface = lface_from_face_name (f, face, 1);
@@ -4692,16 +4733,27 @@ x_update_menu_appearance (f)
        {
 #ifdef USE_MOTIF
          const char *suffix = "List";
+         Bool motif = True;
 #else
          const char *suffix = "";
+         Bool motif = False;
+#endif
+#if defined HAVE_X_I18N
+         extern char *xic_create_fontsetname
+           P_ ((char *base_fontname, Bool motif));
+         char *fontsetname = xic_create_fontsetname (face->font_name, motif);
+#else
+         char *fontsetname = face->font_name;
 #endif
          sprintf (line, "%s.pane.menubar*font%s: %s",
-                  myname, suffix, face->font_name);
+                  myname, suffix, fontsetname);
          XrmPutLineResource (&rdb, line);
          sprintf (line, "%s.%s*font%s: %s",
-                  myname, popup_path, suffix, face->font_name);
+                  myname, popup_path, suffix, fontsetname);
          XrmPutLineResource (&rdb, line);
          changed_p = 1;
+         if (fontsetname != face->font_name)
+           xfree (fontsetname);
        }
 
       if (changed_p && f->output_data.x->menubar_widget)
@@ -4987,8 +5039,8 @@ lface_equal_p (v1, v2)
 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p,
        Sinternal_lisp_face_equal_p, 2, 3, 0,
        doc: /* True if FACE1 and FACE2 are equal.
-If the optional argument FRAME is given, report on face FACE in that frame.
-If FRAME is t, report on the defaults for face FACE (for new frames).
+If the optional argument FRAME is given, report on FACE1 and FACE2 in that frame.
+If FRAME is t, report on the defaults for FACE1 and FACE2 (for new frames).
 If FRAME is omitted or nil, use the selected frame.  */)
      (face1, face2, frame)
      Lisp_Object face1, face2, frame;
@@ -5006,8 +5058,8 @@ If FRAME is omitted or nil, use the selected frame.  */)
        Emacs.  That frame is not an X frame.  */
     f = frame_or_selected_frame (frame, 2);
 
-  lface1 = lface_from_face_name (NULL, face1, 1);
-  lface2 = lface_from_face_name (NULL, face2, 1);
+  lface1 = lface_from_face_name (f, face1, 1);
+  lface2 = lface_from_face_name (f, face2, 1);
   equal_p = lface_equal_p (XVECTOR (lface1)->contents,
                           XVECTOR (lface2)->contents);
   return equal_p ? Qt : Qnil;
@@ -5764,7 +5816,7 @@ face_with_height (f, face_id, height)
    is assumed to be already realized.  */
 
 int
-lookup_derived_face (f, symbol, c, face_id)
+lookup_derived_face (f, symbol, c, face_id, signal_p)
      struct frame *f;
      Lisp_Object symbol;
      int c;
@@ -5777,7 +5829,7 @@ lookup_derived_face (f, symbol, c, face_id)
   if (!default_face)
     abort ();
 
-  get_lface_attributes (f, symbol, symbol_attrs, 1);
+  get_lface_attributes (f, symbol, symbol_attrs, signal_p);
   bcopy (default_face->lface, attrs, sizeof attrs);
   merge_face_vectors (f, symbol_attrs, attrs, 0);
   return lookup_face (f, attrs, c, default_face);
@@ -6060,7 +6112,7 @@ tty_supports_face_attributes_p (f, attrs, def_face)
   /* See if the capabilities we selected above are supported, with the
      given colors.  */
   if (test_caps != 0 &&
-      ! tty_capable_p (f, test_caps, fg_tty_color.pixel, bg_tty_color.pixel))
+      ! tty_capable_p (FRAME_TTY (f), test_caps, fg_tty_color.pixel, bg_tty_color.pixel))
     return 0;
 
 
@@ -6074,7 +6126,7 @@ DEFUN ("display-supports-face-attributes-p",
        1, 2, 0,
        doc: /* Return non-nil if all the face attributes in ATTRIBUTES are supported.
 The optional argument DISPLAY can be a display name, a frame, or
-nil (meaning the selected frame's display)
+nil (meaning the selected frame's display).
 
 The definition of `supported' is somewhat heuristic, but basically means
 that a face containing all the attributes in ATTRIBUTES, when merged
@@ -6087,7 +6139,7 @@ Point (2) implies that a `:weight black' attribute will be satisfied by
 any display that can display bold, and a `:foreground \"yellow\"' as long
 as it can display a yellowish color, but `:slant italic' will _not_ be
 satisfied by the tty display code's automatic substitution of a `dim'
-face for italic. */)
+face for italic.  */)
   (attributes, display)
      Lisp_Object attributes, display;
 {
@@ -6400,12 +6452,12 @@ build_scalable_font_name (f, font, specified_pt)
   if (font->numeric[XLFD_RESY] != 0)
     {
       pt = resy / font->numeric[XLFD_RESY] * specified_pt + 0.5;
-      pixel_value = font->numeric[XLFD_RESY] / (PT_PER_INCH * 10.0) * pt;
+      pixel_value = font->numeric[XLFD_RESY] / (PT_PER_INCH * 10.0) * pt + 0.5;
     }
   else
     {
       pt = specified_pt;
-      pixel_value = resy / (PT_PER_INCH * 10.0) * pt;
+      pixel_value = resy / (PT_PER_INCH * 10.0) * pt + 0.5;
     }
   /* We may need a font of the different size.  */
   pixel_value *= font->rescale_ratio;
@@ -6847,13 +6899,15 @@ realize_basic_faces (f)
       realize_named_face (f, Qcursor, CURSOR_FACE_ID);
       realize_named_face (f, Qmouse, MOUSE_FACE_ID);
       realize_named_face (f, Qmenu, MENU_FACE_ID);
+      realize_named_face (f, Qvertical_border, VERTICAL_BORDER_FACE_ID);
 
       /* Reflect changes in the `menu' face in menu bars.  */
       if (FRAME_FACE_CACHE (f)->menu_face_changed_p)
        {
          FRAME_FACE_CACHE (f)->menu_face_changed_p = 0;
 #ifdef USE_X_TOOLKIT
-         x_update_menu_appearance (f);
+          if (FRAME_WINDOW_P (f))
+            x_update_menu_appearance (f);
 #endif
        }
 
@@ -6940,7 +6994,7 @@ realize_default_face (f)
        LFACE_FOREGROUND (lface) = XCDR (color);
       else if (FRAME_WINDOW_P (f))
        return 0;
-      else if (FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f))
+      else if (FRAME_INITIAL_P (f) || FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f))
        LFACE_FOREGROUND (lface) = build_string (unspecified_fg);
       else
        abort ();
@@ -6955,7 +7009,7 @@ realize_default_face (f)
        LFACE_BACKGROUND (lface) = XCDR (color);
       else if (FRAME_WINDOW_P (f))
        return 0;
-      else if (FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f))
+      else if (FRAME_INITIAL_P (f) || FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f))
        LFACE_BACKGROUND (lface) = build_string (unspecified_bg);
       else
        abort ();
@@ -7044,6 +7098,11 @@ realize_face (cache, attrs, c, base_face, former_face_id)
     face = realize_x_face (cache, attrs, c, base_face);
   else if (FRAME_TERMCAP_P (cache->f) || FRAME_MSDOS_P (cache->f))
     face = realize_tty_face (cache, attrs, c);
+  else if (FRAME_INITIAL_P (cache->f))
+    {
+      /* Create a dummy face. */
+      face = make_realized_face (attrs);
+    }
   else
     abort ();
 
@@ -7073,8 +7132,9 @@ realize_x_face (cache, attrs, c, base_face)
      int c;
      struct face *base_face;
 {
+  struct face *face = NULL;
 #ifdef HAVE_WINDOW_SYSTEM
-  struct face *face, *default_face;
+  struct face *default_face;
   struct frame *f;
   Lisp_Object stipple, overline, strike_through, box;
 
@@ -7270,8 +7330,8 @@ realize_x_face (cache, attrs, c, base_face)
     face->stipple = load_pixmap (f, stipple, &face->pixmap_w, &face->pixmap_h);
 
   xassert (FACE_SUITABLE_FOR_CHAR_P (face, c));
-  return face;
 #endif /* HAVE_WINDOW_SYSTEM */
+  return face;
 }
 
 
@@ -7691,16 +7751,19 @@ face_at_string_position (w, string, pos, bufpos, region_beg,
 
    F is frame where faces are (to be) realized.
 
-   FACE_NAME is named face to merge, or if nil,
-   FACE_ID is face_id of realized face to merge.
+   FACE_NAME is named face to merge.
+
+   If FACE_NAME is nil, FACE_ID is face_id of realized face to merge.
+
+   If FACE_NAME is t, FACE_ID is lface_id of face to merge.
 
    BASE_FACE_ID is realized face to merge into.
 
-   Return new face.
+   Return new face id.
 */
 
 int
-merge_into_realized_face (f, face_name, face_id, base_face_id)
+merge_faces (f, face_name, face_id, base_face_id)
      struct frame *f;
      Lisp_Object face_name;
      int face_id, base_face_id;
@@ -7712,6 +7775,17 @@ merge_into_realized_face (f, face_name, face_id, base_face_id)
   if (!base_face)
     return base_face_id;
 
+  if (EQ (face_name, Qt))
+    {
+      if (face_id < 0 || face_id >= lface_id_to_name_size)
+       return base_face_id;
+      face_name = lface_id_to_name[face_id];
+      face_id = lookup_derived_face (f, face_name, 0, base_face_id, 1);
+      if (face_id >= 0)
+       return face_id;
+      return base_face_id;
+    }
+
   /* Begin with attributes from the base face.  */
   bcopy (base_face->lface, attrs, sizeof attrs);
 
@@ -7723,6 +7797,8 @@ merge_into_realized_face (f, face_name, face_id, base_face_id)
   else
     {
       struct face *face;
+      if (face_id < 0)
+       return base_face_id;
       face = FACE_FROM_ID (f, face_id);
       if (!face)
        return base_face_id;
@@ -7749,7 +7825,7 @@ dump_realized_face (face)
 {
   fprintf (stderr, "ID: %d\n", face->id);
 #ifdef HAVE_X_WINDOWS
-  fprintf (stderr, "gc: %d\n", (int) face->gc);
+  fprintf (stderr, "gc: %ld\n", (long) face->gc);
 #endif
   fprintf (stderr, "foreground: 0x%lx (%s)\n",
           face->foreground,
@@ -7834,8 +7910,8 @@ syms_of_xfaces ()
   staticpro (&Qface_no_inherit);
   Qbitmap_spec_p = intern ("bitmap-spec-p");
   staticpro (&Qbitmap_spec_p);
-  Qframe_update_face_colors = intern ("frame-update-face-colors");
-  staticpro (&Qframe_update_face_colors);
+  Qframe_set_background_mode = intern ("frame-set-background-mode");
+  staticpro (&Qframe_set_background_mode);
 
   /* Lisp face attribute keywords.  */
   QCfamily = intern (":family");
@@ -7959,6 +8035,8 @@ syms_of_xfaces ()
   staticpro (&Qmouse);
   Qmode_line_inactive = intern ("mode-line-inactive");
   staticpro (&Qmode_line_inactive);
+  Qvertical_border = intern ("vertical-border");
+  staticpro (&Qvertical_border);
   Qtty_color_desc = intern ("tty-color-desc");
   staticpro (&Qtty_color_desc);
   Qtty_color_standard_values = intern ("tty-color-standard-values");