Buffer-local faces

[Miles Bader <miles@gnu.org>]

[I'm resending this message as a previous version seems to have been eaten by
 the email system somewhere ... @#!$% anti-spam/virus filters no doubt...]

I hacked up the buffer-local face implementation I talked about before.

The user-interface is a variable called `face-remappings':

   Alist of face mappings.
   Each element is of the form:
      (FACE . NEW-FACE)
   or
      (FACE NEW-FACE MERGE-FACE...),
   which causes NEW-FACE to be used where FACE normally would.
   If present, MERGE-FACE... are merged during display with NEW-FACE.

For instance, try evaluating the following:

  (set (make-local-variable 'face-remappings) '((default . italic)))

It (should) work with other special faces like like mode-line, &c, too.


Here's the patch:


M  src/xfaces.c
M  src/dispextern.h
M  src/fontset.c
M  src/xdisp.c

* modified files

*** orig/src/dispextern.h
--- mod/src/dispextern.h
***************
*** 2838,2843 ****
--- 2838,2844 ----
  int xstricmp P_ ((const unsigned char *, const unsigned char *));
  int lookup_face P_ ((struct frame *, Lisp_Object *, int, struct face *));
  int lookup_named_face P_ ((struct frame *, Lisp_Object, int));
+ int lookup_basic_face P_ ((struct frame *, int));
  int smaller_face P_ ((struct frame *, int, int));
  int face_with_height P_ ((struct frame *, int, int));
  int lookup_derived_face P_ ((struct frame *, Lisp_Object, int, int));
***************
*** 2854,2859 ****
--- 2855,2862 ----
  extern char unspecified_fg[], unspecified_bg[];
  void free_realized_multibyte_face P_ ((struct frame *, int));
  
+ extern Lisp_Object Vface_remappings;
+ 
  /* Defined in xfns.c  */
  
  #ifdef HAVE_X_WINDOWS


*** orig/src/fontset.c
--- mod/src/fontset.c
***************
*** 1252,1258 ****
        CHECK_NATNUM (ch);
        c = XINT (ch);
        f = XFRAME (selected_frame);
!       face_id = DEFAULT_FACE_ID;
      }
    else
      {
--- 1252,1258 ----
        CHECK_NATNUM (ch);
        c = XINT (ch);
        f = XFRAME (selected_frame);
!       face_id = lookup_basic_face (f, DEFAULT_FACE_ID);
      }
    else
      {


*** orig/src/xdisp.c
--- mod/src/xdisp.c
***************
*** 2028,2033 ****
--- 2028,2034 ----
       enum face_id base_face_id;
  {
    int highlight_region_p;
+   enum face_id remapped_base_face_id = base_face_id;
  
    /* Some precondition checks.  */
    xassert (w != NULL && it != NULL);
***************
*** 2044,2049 ****
--- 2045,2054 ----
        free_all_realized_faces (Qnil);
      }
  
+   /* Perhaps remap BASE_FACE_ID to a user-specified alternative.  */
+   if (! NILP (Vface_remappings))
+     remapped_base_face_id = lookup_basic_face (XFRAME (w->frame), base_face_id);
+ 
    /* Use one of the mode line rows of W's desired matrix if
       appropriate.  */
    if (row == NULL)
***************
*** 2059,2065 ****
    bzero (it, sizeof *it);
    it->current.overlay_string_index = -1;
    it->current.dpvec_index = -1;
!   it->base_face_id = base_face_id;
    it->string = Qnil;
    IT_STRING_CHARPOS (*it) = IT_STRING_BYTEPOS (*it) = -1;
  
--- 2064,2070 ----
    bzero (it, sizeof *it);
    it->current.overlay_string_index = -1;
    it->current.dpvec_index = -1;
!   it->base_face_id = remapped_base_face_id;
    it->string = Qnil;
    IT_STRING_CHARPOS (*it) = IT_STRING_BYTEPOS (*it) = -1;
  
***************
*** 2243,2253 ****
      {
        struct face *face;
  
!       it->face_id = base_face_id;
  
        /* If we have a boxed mode line, make the first character appear
  	 with a left box line.  */
!       face = FACE_FROM_ID (it->f, base_face_id);
        if (face->box != FACE_NO_BOX)
  	it->start_of_box_run_p = 1;
  #ifdef HAVE_WINDOW_SYSTEM
--- 2248,2258 ----
      {
        struct face *face;
  
!       it->face_id = remapped_base_face_id;
  
        /* If we have a boxed mode line, make the first character appear
  	 with a left box line.  */
!       face = FACE_FROM_ID (it->f, remapped_base_face_id);
        if (face->box != FACE_NO_BOX)
  	it->start_of_box_run_p = 1;
  #ifdef HAVE_WINDOW_SYSTEM
***************
*** 3491,3497 ****
  	      /* Value is a multiple of the canonical char height.  */
  	      struct face *face;
  
! 	      face = FACE_FROM_ID (it->f, DEFAULT_FACE_ID);
  	      new_height = (XFLOATINT (it->font_height)
  			    * XINT (face->lface[LFACE_HEIGHT_INDEX]));
  	    }
--- 3496,3503 ----
  	      /* Value is a multiple of the canonical char height.  */
  	      struct face *face;
  
! 	      face = FACE_FROM_ID (it->f,
! 				   lookup_basic_face (it->f, DEFAULT_FACE_ID));
  	      new_height = (XFLOATINT (it->font_height)
  			    * XINT (face->lface[LFACE_HEIGHT_INDEX]));
  	    }
***************
*** 3591,3597 ****
  	      || EQ (XCAR (prop), Qright_fringe))
  	  && CONSP (XCDR (prop)))
  	{
! 	  unsigned face_id = DEFAULT_FACE_ID;
  
  	  /* Save current settings of IT so that we can restore them
  	     when we are finished with the glyph property value.  */
--- 3597,3603 ----
  	      || EQ (XCAR (prop), Qright_fringe))
  	  && CONSP (XCDR (prop)))
  	{
! 	  unsigned face_id = lookup_basic_face (it->f, DEFAULT_FACE_ID);
  
  	  /* Save current settings of IT so that we can restore them
  	     when we are finished with the glyph property value.  */


*** orig/src/xfaces.c
--- mod/src/xfaces.c
***************
*** 400,405 ****
--- 400,412 ----
  
  Lisp_Object Vface_new_frame_defaults;
  
+ /* Alist of face mappings.  Each element is either of the form
+    (FACE . NEW-FACE), or (FACE NEW-FACE MERGE-FACE...),
+    where FACE is the named used for lookups, and NEW-FACE is the name
+    that actually gets looked up.  If present, MERGE-FACE... are merged
+    during display of FACE, with NEW-FACE.  */
+ Lisp_Object Vface_remappings;
+ 
  /* The next ID to assign to Lisp faces.  */
  
  static int next_lface_id;
***************
*** 3196,3213 ****
     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;
  {
    Lisp_Object lface;
  
    face_name = resolve_face_name (face_name);
  
    if (f)
      lface = assq_no_quit (face_name, f->face_alist);
    else
--- 3203,3271 ----
     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.  If ATTRS is non-zero, then it is a lisp-face vector, and
!    successful lookups copy the lface vector into it, _along with any
!    merges from face mappings_ (so in that cases, the returned lisp
!    vector and the values in ATTRS may not be identical).  CYCLE_CHECK
!    is used internally to detect loops in face mapping; it can be Qnil
!    when called from other places that are not involved in mutual
!    recursion with this function.  */
  
  static INLINE Lisp_Object
! lface_from_face_name_with_attrs (f, face_name, attrs, signal_p, cycle_check)
       struct frame *f;
       Lisp_Object face_name;
+      Lisp_Object *attrs;
       int signal_p;
+      Lisp_Object cycle_check;
  {
    Lisp_Object lface;
+   Lisp_Object face_remapping;
  
    face_name = resolve_face_name (face_name);
  
+   /* See if SYMBOL has been remapped to some other face (usually this
+      is done buffer-locally).  */
+   face_remapping = assq_no_quit (face_name, Vface_remappings);
+   if (! NILP (face_remapping))
+     {
+       /* Make sure we're not in an mapping loop.  */
+       cycle_check = CYCLE_CHECK (cycle_check, face_name, 15);
+ 
+       if (! NILP (cycle_check))
+ 	{
+ 	  /* No cycle detected, lookup FACE_NAME's mapping instead.  */
+ 	  Lisp_Object merges;
+ 
+ 	  face_remapping = XCDR (face_remapping);
+ 
+ 	  /* A mapping may also contain a list of `merge faces', which
+ 	     we ignore in this function.  */
+ 	  if (CONSP (face_remapping) && SYMBOLP (XCAR (face_remapping)))
+ 	    {
+ 	      merges = XCDR (face_remapping);
+ 	      face_remapping = XCAR (face_remapping);
+ 	    }
+ 	  else
+ 	    merges = Qnil;
+ 
+ 	  /* Recursively lookup FACE_REMAPPING, if it's not obviously bogus.  */
+ 	  if (SYMBOLP (face_remapping)
+ 	      && !NILP (face_remapping)
+ 	      && !EQ (face_remapping, face_name))
+ 	    {
+ 	      lface = lface_from_face_name_with_attrs (f, face_remapping, attrs,
+ 						       signal_p, cycle_check);
+ 
+ 	      /* Merge in additional faces specified in the mapping.  */
+ 	      if (attrs && !NILP (lface) && !NILP (merges))
+ 		merge_face_inheritance (f, merges, attrs, cycle_check);
+ 
+ 	      return lface;
+ 	    }
+ 	}
+     }
+ 
    if (f)
      lface = assq_no_quit (face_name, f->face_alist);
    else
***************
*** 3219,3227 ****
--- 3277,3306 ----
      signal_error ("Invalid face", face_name);
  
    check_lface (lface);
+ 
+   if (attrs)
+     bcopy (XVECTOR (lface)->contents, attrs, LFACE_VECTOR_SIZE * sizeof *attrs);
+ 
    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;
+ {
+   return lface_from_face_name_with_attrs (f, face_name, 0, signal_p, Qnil);
+ }
+ 
  
  /* Get face attributes of face FACE_NAME from frame-local faces on
     frame F.  Store the resulting attributes in ATTRS which must point
***************
*** 3237,3255 ****
       int signal_p;
  {
    Lisp_Object lface;
!   int success_p;
! 
!   lface = lface_from_face_name (f, face_name, signal_p);
!   if (!NILP (lface))
!     {
!       bcopy (XVECTOR (lface)->contents, attrs,
! 	     LFACE_VECTOR_SIZE * sizeof *attrs);
!       success_p = 1;
!     }
!   else
!     success_p = 0;
! 
!   return success_p;
  }
  
  
--- 3316,3323 ----
       int signal_p;
  {
    Lisp_Object lface;
!   lface = lface_from_face_name_with_attrs (f, face_name, attrs, signal_p, Qnil);
!   return !NILP (lface);
  }
  
  
***************
*** 5779,5789 ****
     face couldn't be determined, which might happen if the default face
     isn't realized and cannot be realized.  */
  
! int
! lookup_named_face (f, symbol, c)
       struct frame *f;
       Lisp_Object symbol;
       int c;
  {
    Lisp_Object attrs[LFACE_VECTOR_SIZE];
    Lisp_Object symbol_attrs[LFACE_VECTOR_SIZE];
--- 5847,5858 ----
     face couldn't be determined, which might happen if the default face
     isn't realized and cannot be realized.  */
  
! static int
! lookup_named_face_1 (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];
***************
*** 5796,5807 ****
        default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
      }
  
!   get_lface_attributes (f, symbol, symbol_attrs, 1);
    bcopy (default_face->lface, attrs, sizeof attrs);
    merge_face_vectors (f, symbol_attrs, attrs, Qnil);
    return lookup_face (f, attrs, c, NULL);
  }
  
  
  /* 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.  */
--- 5865,5933 ----
        default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
      }
  
!   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, Qnil);
+ 
    return lookup_face (f, attrs, c, NULL);
  }
  
+ /* Return the face id of the realized face for named face SYMBOL on
+    frame F suitable for displaying character C.  Value is -1 if the
+    face couldn't be determined, which might happen if the default face
+    isn't realized and cannot be realized.  */
+ 
+ int
+ lookup_named_face (f, symbol, c)
+      struct frame *f;
+      Lisp_Object symbol;
+      int c;
+ {
+   return lookup_named_face_1 (f, symbol, c);
+ }
+ 
+ 
+ /* 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_remappings.  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_remappings))
+     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;
+ 
+     default:
+       return face_id;		/* Give up.  */
+     }
+ 
+   mapping = assq_no_quit (name, Vface_remappings);
+   if (NILP (mapping))
+     return face_id;		/* Give up.  */
+ 
+   remapped_face_id = lookup_named_face_1 (f, name, 0, 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.  */
***************
*** 7372,7384 ****
  
    *endptr = endpos;
  
!   default_face = FACE_FROM_ID (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;
  
    /* Begin with attributes from the default face.  */
    bcopy (default_face->lface, attrs, sizeof attrs);
--- 7498,7515 ----
  
    *endptr = endpos;
  
! 
!   /* Perhaps remap BASE_FACE_ID to a user-specified alternative.  */
!   if (NILP (Vface_remappings))
!     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;
  
    /* Begin with attributes from the default face.  */
    bcopy (default_face->lface, attrs, sizeof attrs);
***************
*** 7839,7844 ****
--- 7970,7985 ----
  ignore.  */);
    Vface_ignored_fonts = Qnil;
  
+   DEFVAR_LISP ("face-remappings", &Vface_remappings,
+ 	       doc: /* Alist of face mappings.
+ Each element is of the form:
+    (FACE . NEW-FACE)
+ or
+    (FACE NEW-FACE MERGE-FACE...),
+ which causes NEW-FACE to be used where FACE normally would.
+ If present, MERGE-FACE... are merged during display with NEW-FACE.  */);
+   Vface_remappings = 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



-Miles
-- 
We are all lying in the gutter, but some of us are looking at the stars.
-Oscar Wilde