unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
From: Miles Bader <miles@gnu.org>
Subject: Buffer-local faces
Date: Mon, 3 May 2004 09:03:50 -0400	[thread overview]
Message-ID: <20040503130350.GA1929@fencepost> (raw)

[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

             reply	other threads:[~2004-05-03 13:03 UTC|newest]

Thread overview: 26+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2004-05-03 13:03 Miles Bader [this message]
2004-05-03 13:33 ` Buffer-local faces Miles Bader
2004-05-03 22:20 ` Richard Stallman
2004-05-03 23:19   ` Miles Bader
2004-05-04  5:56     ` Eli Zaretskii
2004-05-04 13:27     ` Stefan Monnier
2004-05-04 20:07     ` Richard Stallman
2004-05-03 22:42 ` Stefan Monnier
2004-05-03 23:27   ` Miles Bader
2004-05-04  5:45     ` Juri Linkov
2004-05-04  8:22       ` Miles Bader
2004-05-04 13:37         ` Stefan Monnier
2004-05-04 14:02           ` Miles Bader
2004-05-04 14:10             ` Stefan Monnier
2004-05-05 20:20               ` Richard Stallman
2004-05-05 20:20             ` Richard Stallman
2004-05-06 13:55               ` Miles Bader
2004-05-05 20:20           ` Richard Stallman
2004-05-05 20:43             ` Stefan Monnier
2004-05-05  8:09         ` Richard Stallman
2004-05-04 20:08       ` Richard Stallman
2004-05-04  9:18     ` David Kastrup
2004-05-04  9:57       ` Miles Bader
2004-05-04  8:40         ` Kim F. Storm
2004-05-04  9:59       ` Juri Linkov
2004-05-05 20:20         ` Richard Stallman

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/emacs/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=20040503130350.GA1929@fencepost \
    --to=miles@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).