]> code.delx.au - gnu-emacs/blobdiff - src/xfaces.c
(main) [MAC_OS8 || MAC_OSX && HAVE_CARBON]: Call syms_of_macselect.
[gnu-emacs] / src / xfaces.c
index afe352267d3638cdf7bc84f9d76fe3171cc1f435..5c865be3000898ba451ff511cccd1a7099b379ef 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.
@@ -385,6 +385,10 @@ Lisp_Object Qforeground_color, Qbackground_color;
 Lisp_Object Qface;
 extern Lisp_Object Qmouse_face;
 
+/* Property for basic faces which other faces cannot inherit.  */
+
+Lisp_Object Qface_no_inherit;
+
 /* Error symbol for wrong_type_argument in load_pixmap.  */
 
 Lisp_Object Qbitmap_spec_p;
@@ -734,7 +738,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;
 }
@@ -767,7 +771,7 @@ x_free_gc (f, gc)
      GC gc;
 {
   BLOCK_INPUT;
-  xassert (--ngcs >= 0);
+  IF_DEBUG (xassert (--ngcs >= 0));
   xfree (gc);
   UNBLOCK_INPUT;
 }
@@ -1067,6 +1071,9 @@ clear_font_table (dpyinfo)
 #endif
 #ifdef WINDOWSNT
       w32_unload_font (dpyinfo, font_info->font);
+#endif
+#ifdef MAC_OS
+      mac_unload_font (dpyinfo, font_info->font);
 #endif
       UNBLOCK_INPUT;
 
@@ -1506,7 +1513,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
@@ -1544,6 +1551,7 @@ DEFUN ("color-supported-p", Fcolor_supported_p,
        Scolor_supported_p, 1, 3, 0,
        doc: /* Return non-nil if COLOR can be displayed on FRAME.
 BACKGROUND-P non-nil means COLOR is used as a background.
+Otherwise, this function tells whether it can be used as a foreground.
 If FRAME is nil or omitted, use the selected frame.
 COLOR must be a valid color name.  */)
      (color, frame, background_p)
@@ -3004,7 +3012,7 @@ the WIDTH times as wide as FACE on FRAME.  */)
     {
       /* This is of limited utility since it works with character
         widths.  Keep it for compatibility.  --gerd.  */
-      int face_id = lookup_named_face (f, face, 0);
+      int face_id = lookup_named_face (f, face, 0, 0);
       struct face *face = (face_id < 0
                           ? NULL
                           : FACE_FROM_ID (f, face_id));
@@ -3169,8 +3177,8 @@ struct named_merge_point
 
 /* If a face merging cycle is detected for FACE_NAME, return 0,
    otherwise add NEW_NAMED_MERGE_POINT, which is initialized using
-   FACE_NAME, as the head of the linked list
-   pointed to by NAMED_MERGE_POINTS, and return 1.  */
+   FACE_NAME, as the head of the linked list pointed to by
+   NAMED_MERGE_POINTS, and return 1.  */
 
 static INLINE int
 push_named_merge_point (struct named_merge_point *new_named_merge_point,
@@ -3181,7 +3189,7 @@ push_named_merge_point (struct named_merge_point *new_named_merge_point,
 
   for (prev = *named_merge_points; prev; prev = prev->prev)
     if (EQ (face_name, prev->face_name))
-       break;
+      return 0;
 
   new_named_merge_point->face_name = face_name;
   new_named_merge_point->prev = *named_merge_points;
@@ -3203,6 +3211,7 @@ resolve_face_name (face_name)
      Lisp_Object face_name;
 {
   Lisp_Object aliased;
+  int alias_loop_max = 10;
 
   if (STRINGP (face_name))
     face_name = intern (SDATA (face_name));
@@ -3212,8 +3221,9 @@ resolve_face_name (face_name)
       aliased = Fget (face_name, Qface_alias);
       if (NILP (aliased))
        break;
-      else
-       face_name = aliased;
+      if (--alias_loop_max == 0)
+       break;
+      face_name = aliased;
     }
 
   return face_name;
@@ -3427,8 +3437,8 @@ set_lface_from_font_name (f, lface, fontname, force_p, may_fail_p)
    call into lisp.  */
 
 Lisp_Object
-merge_face_heights (from, to, invalid, gcpro)
-     Lisp_Object from, to, invalid, gcpro;
+merge_face_heights (from, to, invalid)
+     Lisp_Object from, to, invalid;
 {
   Lisp_Object result = invalid;
 
@@ -3453,16 +3463,11 @@ merge_face_heights (from, to, invalid, gcpro)
       /* Call function with current height as argument.
         From is the new height.  */
       Lisp_Object args[2];
-      struct gcpro gcpro1;
-
-      GCPRO1 (gcpro);
 
       args[0] = from;
       args[1] = to;
       result = safe_call (2, args);
 
-      UNGCPRO;
-
       /* Ensure that if TO was absolute, so is the result.  */
       if (INTEGERP (to) && !INTEGERP (result))
        result = invalid;
@@ -3515,8 +3520,7 @@ merge_face_vectors (f, from, to, named_merge_points)
     if (!UNSPECIFIEDP (from[i]))
       {
        if (i == LFACE_HEIGHT_INDEX && !INTEGERP (from[i]))
-         to[i] = merge_face_heights (from[i], to[i], to[i],
-                                     named_merge_points);
+         to[i] = merge_face_heights (from[i], to[i], to[i]);
        else
          to[i] = from[i];
       }
@@ -3543,11 +3547,16 @@ merge_named_face (f, face_name, to, named_merge_points)
   if (push_named_merge_point (&named_merge_point,
                              face_name, &named_merge_points))
     {
+      struct gcpro gcpro1;
       Lisp_Object from[LFACE_VECTOR_SIZE];
       int ok = get_lface_attributes (f, face_name, from, 0);
 
       if (ok)
-       merge_face_vectors (f, from, to, named_merge_points);
+       {
+         GCPRO1 (named_merge_point.face_name);
+         merge_face_vectors (f, from, to, named_merge_points);
+         UNGCPRO;
+       }
 
       return ok;
     }
@@ -3625,7 +3634,10 @@ merge_face_ref (f, face_ref, to, err_msgs, named_merge_points)
              Lisp_Object value = XCAR (XCDR (face_ref));
              int err = 0;
 
-             if (EQ (keyword, QCfamily))
+             /* Specifying `unspecified' is a no-op.  */
+             if (EQ (value, Qunspecified))
+               ;
+             else if (EQ (keyword, QCfamily))
                {
                  if (STRINGP (value))
                    to[LFACE_FAMILY_INDEX] = value;
@@ -3635,8 +3647,7 @@ merge_face_ref (f, face_ref, to, err_msgs, named_merge_points)
              else if (EQ (keyword, QCheight))
                {
                  Lisp_Object new_height =
-                   merge_face_heights (value, to[LFACE_HEIGHT_INDEX],
-                                       Qnil, Qnil);
+                   merge_face_heights (value, to[LFACE_HEIGHT_INDEX], Qnil);
 
                  if (! NILP (new_height))
                    to[LFACE_HEIGHT_INDEX] = new_height;
@@ -3861,8 +3872,11 @@ Value is a vector of face attributes.  */)
      depend on the face, make sure they are all removed.  This is done
      by incrementing face_change_count.  The next call to
      init_iterator will then free realized faces.  */
-  ++face_change_count;
-  ++windows_or_buffers_changed;
+  if (NILP (Fget (face, Qface_no_inherit)))
+    {
+      ++face_change_count;
+      ++windows_or_buffers_changed;
+    }
 
   xassert (LFACEP (lface));
   check_lface (lface);
@@ -3896,12 +3910,13 @@ Otherwise check for the existence of a global face.  */)
 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face,
        Sinternal_copy_lisp_face, 4, 4, 0,
        doc: /* Copy face FROM to TO.
-If FRAME is t, copy the global face definition of FROM to the
-global face definition of TO.  Otherwise, copy the frame-local
-definition of FROM on FRAME to the frame-local definition of TO
-on NEW-FRAME, or FRAME if NEW-FRAME is nil.
+If FRAME is t, copy the global face definition of FROM.
+Otherwise, copy the frame-local definition of FROM on FRAME.
+If NEW-FRAME is a frame, copy that data into the frame-local
+definition of TO on NEW-FRAME.  If NEW-FRAME is nil.
+FRAME controls where the data is copied to.
 
-Value is TO.  */)
+The value is TO.  */)
      (from, to, frame, new_frame)
      Lisp_Object from, to, frame, new_frame;
 {
@@ -3909,8 +3924,6 @@ Value is TO.  */)
 
   CHECK_SYMBOL (from);
   CHECK_SYMBOL (to);
-  if (NILP (new_frame))
-    new_frame = frame;
 
   if (EQ (frame, Qt))
     {
@@ -3922,6 +3935,8 @@ Value is TO.  */)
   else
     {
       /* Copy frame-local definition of FROM.  */
+      if (NILP (new_frame))
+       new_frame = frame;
       CHECK_LIVE_FRAME (frame);
       CHECK_LIVE_FRAME (new_frame);
       lface = lface_from_face_name (XFRAME (frame), from, 1);
@@ -3936,8 +3951,11 @@ Value is TO.  */)
      depend on the face, make sure they are all removed.  This is done
      by incrementing face_change_count.  The next call to
      init_iterator will then free realized faces.  */
-  ++face_change_count;
-  ++windows_or_buffers_changed;
+  if (NILP (Fget (to, Qface_no_inherit)))
+    {
+      ++face_change_count;
+      ++windows_or_buffers_changed;
+    }
 
   return to;
 }
@@ -4016,7 +4034,7 @@ FRAME 0 means change the face on all frames, and change the default
                  /* The default face must have an absolute size,
                     otherwise, we do a test merge with a random
                     height to see if VALUE's ok. */
-                 : merge_face_heights (value, make_number (10), Qnil, Qnil));
+                 : merge_face_heights (value, make_number (10), Qnil));
 
          if (!INTEGERP (test) || XINT (test) <= 0)
            signal_error ("Invalid face height", value);
@@ -4132,7 +4150,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))
@@ -4294,6 +4312,7 @@ FRAME 0 means change the face on all frames, and change the default
      by incrementing face_change_count.  The next call to
      init_iterator will then free realized faces.  */
   if (!EQ (frame, Qt)
+      && NILP (Fget (face, Qface_no_inherit))
       && (EQ (attr, QCfont)
          || NILP (Fequal (old_value, value))))
     {
@@ -4446,6 +4465,7 @@ update_face_from_frame_parameter (f, param, new_value)
      struct frame *f;
      Lisp_Object param, new_value;
 {
+  Lisp_Object face = Qnil;
   Lisp_Object lface;
 
   /* If there are no faces yet, give up.  This is the case when called
@@ -4454,17 +4474,10 @@ update_face_from_frame_parameter (f, param, new_value)
   if (NILP (f->face_alist))
     return;
 
-  /* Changing a named face means that all realized faces depending on
-     that face are invalid.  Since we cannot tell which realized faces
-     depend on the face, make sure they are all removed.  This is done
-     by incrementing face_change_count.  The next call to
-     init_iterator will then free realized faces.  */
-  ++face_change_count;
-  ++windows_or_buffers_changed;
-
   if (EQ (param, Qforeground_color))
     {
-      lface = lface_from_face_name (f, Qdefault, 1);
+      face = Qdefault;
+      lface = lface_from_face_name (f, face, 1);
       LFACE_FOREGROUND (lface) = (STRINGP (new_value)
                                  ? new_value : Qunspecified);
       realize_basic_faces (f);
@@ -4479,29 +4492,45 @@ update_face_from_frame_parameter (f, param, new_value)
       XSETFRAME (frame, f);
       call1 (Qframe_update_face_colors, frame);
 
-      lface = lface_from_face_name (f, Qdefault, 1);
+      face = Qdefault;
+      lface = lface_from_face_name (f, face, 1);
       LFACE_BACKGROUND (lface) = (STRINGP (new_value)
                                  ? new_value : Qunspecified);
       realize_basic_faces (f);
     }
-  if (EQ (param, Qborder_color))
+  else if (EQ (param, Qborder_color))
     {
-      lface = lface_from_face_name (f, Qborder, 1);
+      face = Qborder;
+      lface = lface_from_face_name (f, face, 1);
       LFACE_BACKGROUND (lface) = (STRINGP (new_value)
                                  ? new_value : Qunspecified);
     }
   else if (EQ (param, Qcursor_color))
     {
-      lface = lface_from_face_name (f, Qcursor, 1);
+      face = Qcursor;
+      lface = lface_from_face_name (f, face, 1);
       LFACE_BACKGROUND (lface) = (STRINGP (new_value)
                                  ? new_value : Qunspecified);
     }
   else if (EQ (param, Qmouse_color))
     {
-      lface = lface_from_face_name (f, Qmouse, 1);
+      face = Qmouse;
+      lface = lface_from_face_name (f, face, 1);
       LFACE_BACKGROUND (lface) = (STRINGP (new_value)
                                  ? new_value : Qunspecified);
     }
+
+  /* Changing a named face means that all realized faces depending on
+     that face are invalid.  Since we cannot tell which realized faces
+     depend on the face, make sure they are all removed.  This is done
+     by incrementing face_change_count.  The next call to
+     init_iterator will then free realized faces.  */
+  if (!NILP (face)
+      && NILP (Fget (face, Qface_no_inherit)))
+    {
+      ++face_change_count;
+      ++windows_or_buffers_changed;
+    }
 }
 
 
@@ -4665,16 +4694,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)
@@ -4711,7 +4751,7 @@ the result will be absolute, otherwise it will be relative.  */)
   if (EQ (value1, Qunspecified))
     return value2;
   else if (EQ (attribute, QCheight))
-    return merge_face_heights (value1, value2, value1, Qnil);
+    return merge_face_heights (value1, value2, value1);
   else
     return value1;
 }
@@ -4899,7 +4939,7 @@ If FRAME is omitted or nil, use the selected frame.  */)
   else
     {
       struct frame *f = frame_or_selected_frame (frame, 1);
-      int face_id = lookup_named_face (f, face, 0);
+      int face_id = lookup_named_face (f, face, 0, 1);
       struct face *face = FACE_FROM_ID (f, face_id);
       return face ? build_string (face->font_name) : Qnil;
     }
@@ -4912,6 +4952,7 @@ If FRAME is omitted or nil, use the selected frame.  */)
 
 static INLINE int
 face_attr_equal_p (v1, v2)
+     Lisp_Object v1, v2;
 {
   /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
      and the other is specified.  */
@@ -5590,10 +5631,11 @@ lookup_face (f, attr, c, base_face)
    isn't realized and cannot be realized.  */
 
 int
-lookup_named_face (f, symbol, c)
+lookup_named_face (f, symbol, c, signal_p)
      struct frame *f;
      Lisp_Object symbol;
      int c;
+     int signal_p;
 {
   Lisp_Object attrs[LFACE_VECTOR_SIZE];
   Lisp_Object symbol_attrs[LFACE_VECTOR_SIZE];
@@ -5606,7 +5648,9 @@ lookup_named_face (f, symbol, c)
       default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
     }
 
-  get_lface_attributes (f, symbol, symbol_attrs, 1);
+  if (!get_lface_attributes (f, symbol, symbol_attrs, signal_p))
+    return -1;
+
   bcopy (default_face->lface, attrs, sizeof attrs);
   merge_face_vectors (f, symbol_attrs, attrs, 0);
 
@@ -5627,7 +5671,7 @@ ascii_face_of_lisp_face (f, lface_id)
   if (lface_id >= 0 && lface_id < lface_id_to_name_size)
     {
       Lisp_Object face_name = lface_id_to_name[lface_id];
-      face_id = lookup_named_face (f, face_name, 0);
+      face_id = lookup_named_face (f, face_name, 0, 1);
     }
   else
     face_id = -1;
@@ -5733,7 +5777,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;
@@ -5746,7 +5790,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);
@@ -5846,7 +5890,7 @@ x_supports_face_attributes_p (f, attrs, def_face)
       face = FACE_FROM_ID (f, lookup_face (f, merged_attrs, 0, 0));
 
       if (! face)
-       signal_error ("cannot make face", 0);
+       error ("cannot make face");
 
       /* If the font is the same, then not supported.  */
       if (face->font == def_face->font)
@@ -5881,7 +5925,7 @@ tty_supports_face_attributes_p (f, attrs, def_face)
      Lisp_Object *attrs;
      struct face *def_face;
 {
-  int weight, i;
+  int weight;
   Lisp_Object val, fg, bg;
   XColor fg_tty_color, fg_std_color;
   XColor bg_tty_color, bg_std_color;
@@ -6103,7 +6147,7 @@ face for italic. */)
   if (def_face == NULL)
     {
       if (! realize_basic_faces (f))
-       signal_error ("Cannot realize default face", 0);
+       error ("Cannot realize default face");
       def_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
     }
 
@@ -7042,8 +7086,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;
 
@@ -7239,8 +7284,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;
 }
 
 
@@ -7656,6 +7701,69 @@ face_at_string_position (w, string, pos, bufpos, region_beg,
 }
 
 
+/* Merge a face into a realized face.
+
+   F is frame where faces are (to be) realized.
+
+   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 id.
+*/
+
+int
+merge_faces (f, face_name, face_id, base_face_id)
+     struct frame *f;
+     Lisp_Object face_name;
+     int face_id, base_face_id;
+{
+  Lisp_Object attrs[LFACE_VECTOR_SIZE];
+  struct face *base_face;
+
+  base_face = FACE_FROM_ID (f, 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);
+
+  if (!NILP (face_name))
+    {
+      if (!merge_named_face (f, face_name, attrs, 0))
+       return 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;
+      merge_face_vectors (f, face->lface, attrs, 0);
+    }
+
+  /* Look up a realized face with the given face attributes,
+     or realize a new one for ASCII characters.  */
+  return lookup_face (f, attrs, 0, NULL);
+}
+
 \f
 /***********************************************************************
                                Tests
@@ -7671,7 +7779,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,
@@ -7752,6 +7860,8 @@ syms_of_xfaces ()
 {
   Qface = intern ("face");
   staticpro (&Qface);
+  Qface_no_inherit = intern ("face-no-inherit");
+  staticpro (&Qface_no_inherit);
   Qbitmap_spec_p = intern ("bitmap-spec-p");
   staticpro (&Qbitmap_spec_p);
   Qframe_update_face_colors = intern ("frame-update-face-colors");