[Emacs-diffs] Changes to emacs/src/xfaces.c,v

[Miles Bader]

CVSROOT:        /cvsroot/emacs
Module name:    emacs
Changes by:     Miles Bader <miles>     08/06/01 05:04:25

Index: src/xfaces.c
===================================================================
RCS file: /cvsroot/emacs/emacs/src/xfaces.c,v
retrieving revision 1.392
retrieving revision 1.393
diff -u -b -r1.392 -r1.393
--- src/xfaces.c        29 May 2008 04:46:59 -0000      1.392
+++ src/xfaces.c        1 Jun 2008 05:04:21 -0000       1.393
@@ -422,6 +422,23 @@
 
 Lisp_Object Vface_new_frame_defaults;
 
+/* Alist of face remappings.  Each element is of the form:
+   (FACE REPLACEMENT...) which causes display of the face FACE to use
+   REPLACEMENT... instead.  REPLACEMENT... is interpreted the same way
+   the value of a `face' text property is: it may be (1) A face name,
+   (2) A list of face names, (3) A property-list of face attribute/value
+   pairs, or (4) A list of face names intermixed with lists containing
+   face attribute/value pairs.
+
+   Multiple entries in REPLACEMENT... are merged together to form the final
+   result, with faces or attributes earlier in the list taking precedence
+   over those that are later.
+
+   Face-name remapping cycles are suppressed; recursive references use
+   the underlying face instead of the remapped face.  */
+
+Lisp_Object Vface_remapping_alist;
+
 /* The next ID to assign to Lisp faces.  */
 
 static int next_lface_id;
@@ -493,7 +510,8 @@
 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 get_lface_attributes P_ ((struct frame *, Lisp_Object, Lisp_Object 
*, int));
+static int get_lface_attributes P_ ((struct frame *, Lisp_Object, Lisp_Object 
*,
+                                    int, struct named_merge_point *));
 static int load_pixmap P_ ((struct frame *, Lisp_Object, unsigned *, unsigned 
*));
 static unsigned char *xstrlwr P_ ((unsigned char *));
 static struct frame *frame_or_selected_frame P_ ((Lisp_Object, int));
@@ -2063,6 +2081,12 @@
 
 /* Face-merge cycle checking.  */
 
+enum named_merge_point_kind
+{
+  NAMED_MERGE_POINT_NORMAL,
+  NAMED_MERGE_POINT_REMAP
+};
+
 /* A `named merge point' is simply a point during face-merging where we
    look up a face by name.  We keep a stack of which named lookups we're
    currently processing so that we can easily detect cycles, using a
@@ -2072,27 +2096,40 @@
 struct named_merge_point
 {
   Lisp_Object face_name;
+  enum named_merge_point_kind named_merge_point_kind;
   struct named_merge_point *prev;
 };
 
 
 /* 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 and NAMED_MERGE_POINT_KIND, 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,
                        Lisp_Object face_name,
+                       enum named_merge_point_kind named_merge_point_kind,
                        struct named_merge_point **named_merge_points)
 {
   struct named_merge_point *prev;
 
   for (prev = *named_merge_points; prev; prev = prev->prev)
     if (EQ (face_name, prev->face_name))
+      {
+       if (prev->named_merge_point_kind == named_merge_point_kind)
+         /* A cycle, so fail.  */
       return 0;
+       else if (prev->named_merge_point_kind == NAMED_MERGE_POINT_REMAP)
+         /* A remap `hides ' any previous normal merge points
+            (because the remap means that it's actually different face),
+            so as we know the current merge point must be normal, we
+            can just assume it's OK.  */
+         break;
+      }
 
   new_named_merge_point->face_name = face_name;
+  new_named_merge_point->named_merge_point_kind = named_merge_point_kind;
   new_named_merge_point->prev = *named_merge_points;
 
   *named_merge_points = new_named_merge_point;
@@ -2170,22 +2207,17 @@
 /* Return the face definition of FACE_NAME on frame F.  F null means
    return the definition for new frames.  FACE_NAME may be a string or
    a symbol (apparently Emacs 20.2 allowed strings as face names in
-   face text properties; Ediff uses that).  If FACE_NAME is an alias
-   for another face, return that face's definition.  If SIGNAL_P is
-   non-zero, signal an error if FACE_NAME is not a valid face name.
-   If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
-   name.  */
-
+   face text properties; Ediff uses that).  If SIGNAL_P is non-zero,
+   signal an error if FACE_NAME is not a valid face name.  If SIGNAL_P
+   is zero, value is nil if FACE_NAME is not a valid face name.  */
 static INLINE Lisp_Object
-lface_from_face_name (f, face_name, signal_p)
+lface_from_face_name_no_resolve (f, face_name, signal_p)
      struct frame *f;
      Lisp_Object face_name;
      int signal_p;
 {
   Lisp_Object lface;
 
-  face_name = resolve_face_name (face_name, signal_p);
-
   if (f)
     lface = assq_no_quit (face_name, f->face_alist);
   else
@@ -2197,9 +2229,28 @@
     signal_error ("Invalid face", face_name);
 
   check_lface (lface);
+
   return lface;
 }
 
+/* Return the face definition of FACE_NAME on frame F.  F null means
+   return the definition for new frames.  FACE_NAME may be a string or
+   a symbol (apparently Emacs 20.2 allowed strings as face names in
+   face text properties; Ediff uses that).  If FACE_NAME is an alias
+   for another face, return that face's definition.  If SIGNAL_P is
+   non-zero, signal an error if FACE_NAME is not a valid face name.
+   If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
+   name.  */
+static INLINE Lisp_Object
+lface_from_face_name (f, face_name, signal_p)
+     struct frame *f;
+     Lisp_Object face_name;
+     int signal_p;
+{
+  face_name = resolve_face_name (face_name, signal_p);
+  return lface_from_face_name_no_resolve (f, face_name, signal_p);
+}
+
 
 /* Get face attributes of face FACE_NAME from frame-local faces on
    frame F.  Store the resulting attributes in ATTRS which must point
@@ -2208,26 +2259,65 @@
    Otherwise, value is zero if FACE_NAME is not a face.  */
 
 static INLINE int
-get_lface_attributes (f, face_name, attrs, signal_p)
+get_lface_attributes_no_remap (f, face_name, attrs, signal_p)
      struct frame *f;
      Lisp_Object face_name;
      Lisp_Object *attrs;
      int signal_p;
 {
   Lisp_Object lface;
-  int success_p;
 
-  lface = lface_from_face_name (f, face_name, signal_p);
-  if (!NILP (lface))
-    {
+  lface = lface_from_face_name_no_resolve (f, face_name, signal_p);
+
+  if (! NILP (lface))
       bcopy (XVECTOR (lface)->contents, attrs,
             LFACE_VECTOR_SIZE * sizeof *attrs);
-      success_p = 1;
+
+  return !NILP (lface);
+}
+
+/* Get face attributes of face FACE_NAME from frame-local faces on frame
+   F.  Store the resulting attributes in ATTRS which must point to a
+   vector of Lisp_Objects of size LFACE_VECTOR_SIZE.  If FACE_NAME is an
+   alias for another face, use that face's definition.  If SIGNAL_P is
+   non-zero, signal an error if FACE_NAME does not name a face.
+   Otherwise, value is zero if FACE_NAME is not a face.  */
+
+static INLINE int
+get_lface_attributes (f, face_name, attrs, signal_p, named_merge_points)
+     struct frame *f;
+     Lisp_Object face_name;
+     Lisp_Object *attrs;
+     int signal_p;
+     struct named_merge_point *named_merge_points;
+{
+  Lisp_Object face_remapping;
+
+  face_name = resolve_face_name (face_name, signal_p);
+
+  /* See if SYMBOL has been remapped to some other face (usually this
+     is done buffer-locally).  */
+  face_remapping = assq_no_quit (face_name, Vface_remapping_alist);
+  if (CONSP (face_remapping))
+    {
+      struct named_merge_point named_merge_point;
+
+      if (push_named_merge_point (&named_merge_point,
+                                 face_name, NAMED_MERGE_POINT_REMAP,
+                                 &named_merge_points))
+       {
+         int i;
+
+         for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
+           attrs[i] = Qunspecified;
+
+         return merge_face_ref (f, XCDR (face_remapping), attrs,
+                                signal_p, named_merge_points);
+       }
     }
-  else
-    success_p = 0;
 
-  return success_p;
+  /* Default case, no remapping.  */
+  return get_lface_attributes_no_remap (f, face_name, attrs, signal_p);
 }
 
 
@@ -2383,8 +2473,8 @@
    specified attribute of FROM overrides the corresponding attribute of
    TO; relative attributes in FROM are merged with the absolute value in
    TO and replace it.  NAMED_MERGE_POINTS is used internally to detect
-   loops in face inheritance; it should be 0 when called from other
-   places.  */
+   loops in face inheritance/remapping; it should be 0 when called from
+   other places.  */
 
 static INLINE void
 merge_face_vectors (f, from, to, named_merge_points)
@@ -2459,11 +2549,12 @@
   struct named_merge_point named_merge_point;
 
   if (push_named_merge_point (&named_merge_point,
-                             face_name, &named_merge_points))
+                             face_name, NAMED_MERGE_POINT_NORMAL,
+                             &named_merge_points))
     {
       struct gcpro gcpro1;
       Lisp_Object from[LFACE_VECTOR_SIZE];
-      int ok = get_lface_attributes (f, face_name, from, 0);
+      int ok = get_lface_attributes (f, face_name, from, 0, 
named_merge_points);
 
       if (ok)
        {
@@ -3441,7 +3532,7 @@
 
       /* Changing the background color might change the background
         mode, so that we have to load new defface specs.
-        Call frame-set-background-mode to do that.  */
+        Call frame-update-face-colors to do that.  */
       XSETFRAME (frame, f);
       call1 (Qframe_set_background_mode, frame);
 
@@ -4647,7 +4738,7 @@
        abort ();  /* realize_basic_faces must have set it up  */
     }
 
-  if (!get_lface_attributes (f, symbol, symbol_attrs, signal_p))
+  if (! get_lface_attributes (f, symbol, symbol_attrs, signal_p, 0))
     return -1;
 
   bcopy (default_face->lface, attrs, sizeof attrs);
@@ -4657,6 +4748,58 @@
 }
 
 
+/* Return the display face-id of the basic face who's canonical face-id
+   is FACE_ID.  The return value will usually simply be FACE_ID, unless that
+   basic face has bee remapped via Vface_remapping_alist.  This function is
+   conservative: if something goes wrong, it will simply return FACE_ID
+   rather than signal an error.   */
+
+int
+lookup_basic_face (f, face_id)
+     struct frame *f;
+     int face_id;
+{
+  Lisp_Object name, mapping;
+  int remapped_face_id;
+
+  if (NILP (Vface_remapping_alist))
+    return face_id;            /* Nothing to do.  */
+
+  switch (face_id)
+    {
+    case DEFAULT_FACE_ID:              name = Qdefault;                break;
+    case MODE_LINE_FACE_ID:            name = Qmode_line;              break;
+    case MODE_LINE_INACTIVE_FACE_ID:   name = Qmode_line_inactive;     break;
+    case HEADER_LINE_FACE_ID:          name = Qheader_line;            break;
+    case TOOL_BAR_FACE_ID:             name = Qtool_bar;               break;
+    case FRINGE_FACE_ID:               name = Qfringe;                 break;
+    case SCROLL_BAR_FACE_ID:           name = Qscroll_bar;             break;
+    case BORDER_FACE_ID:               name = Qborder;                 break;
+    case CURSOR_FACE_ID:               name = Qcursor;                 break;
+    case MOUSE_FACE_ID:                        name = Qmouse;                  
break;
+    case MENU_FACE_ID:                 name = Qmenu;                   break;
+
+    default:
+      abort ();            /* the caller is supposed to pass us a basic face 
id */
+    }
+
+  /* Do a quick scan through Vface_remapping_alist, and return immediately
+     if there is no remapping for face NAME.  This is just an optimization
+     for the very common no-remapping case.  */
+  mapping = assq_no_quit (name, Vface_remapping_alist);
+  if (NILP (mapping))
+    return face_id;            /* Give up.  */
+
+  /* If there is a remapping entry, lookup the face using NAME, which will
+     handle the remapping too.  */
+  remapped_face_id = lookup_named_face (f, name, 0);
+  if (remapped_face_id < 0)
+    return face_id;            /* Give up. */
+
+  return remapped_face_id;
+}
+
+
 /* Return the ID of the realized ASCII face of Lisp face with ID
    LFACE_ID on frame F.  Value is -1 if LFACE_ID isn't valid.  */
 
@@ -4789,7 +4932,7 @@
   if (!default_face)
     abort ();
 
-  get_lface_attributes (f, symbol, symbol_attrs, signal_p);
+  get_lface_attributes (f, symbol, symbol_attrs, signal_p, 0);
   bcopy (default_face->lface, attrs, sizeof attrs);
   merge_face_vectors (f, symbol_attrs, attrs, 0);
   return lookup_face (f, attrs);
@@ -5498,7 +5641,7 @@
   struct face *new_face;
 
   /* The default face must exist and be fully specified.  */
-  get_lface_attributes (f, Qdefault, attrs, 1);
+  get_lface_attributes_no_remap (f, Qdefault, attrs, 1);
   check_lface_attrs (attrs);
   xassert (lface_fully_specified_p (attrs));
 
@@ -5511,7 +5654,7 @@
     }
 
   /* Merge SYMBOL's face with the default face.  */
-  get_lface_attributes (f, symbol, symbol_attrs, 1);
+  get_lface_attributes_no_remap (f, symbol, symbol_attrs, 1);
   merge_face_vectors (f, symbol_attrs, attrs, 0);
 
   /* Realize the face.  */
@@ -6068,13 +6211,18 @@
 
   *endptr = endpos;
 
+
+  /* Perhaps remap BASE_FACE_ID to a user-specified alternative.  */
+  if (NILP (Vface_remapping_alist))
   default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
+  else
+    default_face = FACE_FROM_ID (f, lookup_basic_face (f, DEFAULT_FACE_ID));
 
   /* Optimize common cases where we can use the default face.  */
   if (noverlays == 0
       && NILP (prop)
       && !(pos >= region_beg && pos < region_end))
-    return DEFAULT_FACE_ID;
+    return default_face->id;
 
   /* Begin with attributes from the default face.  */
   bcopy (default_face->lface, attrs, sizeof attrs);
@@ -6673,6 +6821,43 @@
 ignore.  */);
   Vface_ignored_fonts = Qnil;
 
+  DEFVAR_LISP ("face-remapping-alist", &Vface_remapping_alist,
+              doc: /* Alist of face remappings.
+Each element is of the form:
+
+   (FACE REPLACEMENT...),
+
+which causes display of the face FACE to use REPLACEMENT... instead.
+REPLACEMENT... is interpreted the same way the value of a `face' text
+property is: it may be (1) A face name, (2) A list of face names, (3) A
+property-list of face attribute/value pairs, or (4) A list of face names
+intermixed with lists containing face attribute/value pairs.
+
+Multiple entries in REPLACEMENT... are merged together to form the final
+result, with faces or attributes earlier in the list taking precedence
+over those that are later.
+
+Face-name remapping cycles are suppressed; recursive references use the
+underlying face instead of the remapped face.  So a remapping of the form:
+
+   (FACE EXTRA-FACE... FACE)
+
+or:
+
+   (FACE (FACE-ATTR VAL ...) FACE)
+
+will cause EXTRA-FACE... or (FACE-ATTR VAL ...) to be _merged_ with the
+existing definition of FACE.  Note that for the default face, this isn't
+necessary, as every face inherits from the default face.
+
+Making this variable buffer-local is a good way to allow buffer-specific
+face definitions.  For instance, the mode my-mode could define a face
+`my-mode-default', and then in the mode setup function, do:
+
+   (set (make-local-variable 'face-remapping-alist)
+        '((default my-mode-default)))).  */);
+  Vface_remapping_alist = 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