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_remapping_alist; + /* 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_remapping_alist)) + 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_remapping_alist; + /* The next ID to assign to Lisp faces. */ static int next_lface_id; *************** *** 475,481 **** static int x_face_list_fonts P_ ((struct frame *, char *, struct font_name **, int, int)); static int font_scalable_p P_ ((struct font_name *)); ! static int get_lface_attributes P_ ((struct frame *, Lisp_Object, Lisp_Object *, int)); static int load_pixmap P_ ((struct frame *, Lisp_Object)); static unsigned char *xstrlwr P_ ((unsigned char *)); static void signal_error P_ ((char *, Lisp_Object)); --- 482,488 ---- static int x_face_list_fonts P_ ((struct frame *, char *, struct font_name **, int, int)); static int font_scalable_p P_ ((struct font_name *)); ! static int get_lface_attributes P_ ((struct frame *, Lisp_Object, Lisp_Object *, int, Lisp_Object)); static int load_pixmap P_ ((struct frame *, Lisp_Object)); static unsigned char *xstrlwr P_ ((unsigned char *)); static void signal_error P_ ((char *, Lisp_Object)); *************** *** 3190,3213 **** /* 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; { Lisp_Object lface; - face_name = resolve_face_name (face_name); - if (f) lface = assq_no_quit (face_name, f->face_alist); else --- 3197,3215 ---- /* 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 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_no_resolve (f, face_name, signal_p) struct frame *f; Lisp_Object face_name; int signal_p; { Lisp_Object lface; if (f) lface = assq_no_quit (face_name, f->face_alist); else *************** *** 3219,3227 **** --- 3221,3247 ---- 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; + { + 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 *************** *** 3230,3255 **** Otherwise, value is zero if FACE_NAME is not a face. */ static INLINE int ! get_lface_attributes (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)) ! { ! bcopy (XVECTOR (lface)->contents, attrs, ! LFACE_VECTOR_SIZE * sizeof *attrs); ! success_p = 1; } - else - success_p = 0; ! return success_p; } --- 3250,3340 ---- Otherwise, value is zero if FACE_NAME is not a face. */ static INLINE int ! 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; ! 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); ! ! 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, 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_remapping_alist); ! if (CONSP (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. */ ! ! 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)) ! { ! int first_ok; ! Lisp_Object first_face; ! ! first_face = XCAR (face_remapping); ! ! /* See if this is a trivial recursion, and handle it ! properly without incuring a cycle-check penalty. */ ! if (EQ (first_face, face_name) || NILP (first_face)) ! first_ok = get_lface_attributes_no_remap (f, face_name, attrs, ! signal_p); ! else ! first_ok = get_lface_attributes (f, first_face, attrs, ! signal_p, cycle_check); ! ! if (first_ok) ! { ! /* Merge in any remaining faces. */ ! ! face_remapping = XCDR (face_remapping); ! merge_face_inheritance (f, face_remapping, attrs, ! cycle_check); ! } ! ! return first_ok; ! } ! } } ! /* Default case, no remapping. */ ! return get_lface_attributes_no_remap (f, face_name, attrs, signal_p); } *************** *** 3491,3501 **** to[LFACE_INHERIT_INDEX] = Qnil; } /* Merge face attributes from the face on frame F whose name is INHERITS, into the vector of face attributes TO; INHERITS may also be a list of face names, in which case they are applied in order. ! CYCLE_CHECK is used to detect loops in face inheritance. ! Returns true if any of the inherited attributes are `font-related'. */ static void merge_face_inheritance (f, inherit, to, cycle_check) --- 3576,3604 ---- to[LFACE_INHERIT_INDEX] = Qnil; } + /* Merge the named face FACE_NAME on frame F, into the vector of face + attributes TO CYCLE_CHECK is used to detect loops in face + inheritance. Returns true if FACE_NAME is a valid face name, and + false otherwise. */ + + static int + merge_named_face (f, face_name, to, cycle_check) + struct frame *f; + Lisp_Object face_name; + Lisp_Object *to; + Lisp_Object cycle_check; + { + Lisp_Object from[LFACE_VECTOR_SIZE]; + int ok = get_lface_attributes (f, face_name, from, 0, cycle_check); + if (ok) + merge_face_vectors (f, from, to, cycle_check); + return ok; + } + /* Merge face attributes from the face on frame F whose name is INHERITS, into the vector of face attributes TO; INHERITS may also be a list of face names, in which case they are applied in order. ! CYCLE_CHECK is used to detect loops in face inheritance. */ static void merge_face_inheritance (f, inherit, to, cycle_check) *************** *** 3507,3523 **** if (SYMBOLP (inherit) && !EQ (inherit, Qunspecified)) /* Inherit from the named face INHERIT. */ { - Lisp_Object lface; - /* Make sure we're not in an inheritance loop. */ cycle_check = CYCLE_CHECK (cycle_check, inherit, 15); if (NILP (cycle_check)) /* Cycle detected, ignore any further inheritance. */ return; ! lface = lface_from_face_name (f, inherit, 0); ! if (!NILP (lface)) ! merge_face_vectors (f, XVECTOR (lface)->contents, to, cycle_check); } else if (CONSP (inherit)) /* Handle a list of inherited faces by calling ourselves recursively --- 3610,3622 ---- if (SYMBOLP (inherit) && !EQ (inherit, Qunspecified)) /* Inherit from the named face INHERIT. */ { /* Make sure we're not in an inheritance loop. */ cycle_check = CYCLE_CHECK (cycle_check, inherit, 15); if (NILP (cycle_check)) /* Cycle detected, ignore any further inheritance. */ return; ! merge_named_face (f, inherit, to, cycle_check); } else if (CONSP (inherit)) /* Handle a list of inherited faces by calling ourselves recursively *************** *** 3748,3758 **** else { /* PROP ought to be a face name. */ ! Lisp_Object lface = lface_from_face_name (f, prop, 0); ! if (NILP (lface)) add_to_log ("Invalid face text property value: %s", prop, Qnil); - else - merge_face_vectors (f, XVECTOR (lface)->contents, to, Qnil); } } --- 3847,3854 ---- else { /* PROP ought to be a face name. */ ! if (! merge_named_face (f, prop, to, Qnil)) add_to_log ("Invalid face text property value: %s", prop, Qnil); } } *************** *** 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]; --- 5875,5886 ---- 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. */ --- 5893,5961 ---- default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID); } ! if (! get_lface_attributes (f, symbol, symbol_attrs, signal_p, Qnil)) ! 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_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; + + default: + return face_id; /* Give up. */ + } + + mapping = assq_no_quit (name, Vface_remapping_alist); + 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. */ *************** *** 5935,5941 **** if (!default_face) abort (); ! 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, default_face); --- 6089,6095 ---- if (!default_face) abort (); ! get_lface_attributes (f, symbol, symbol_attrs, 1, Qnil); bcopy (default_face->lface, attrs, sizeof attrs); merge_face_vectors (f, symbol_attrs, attrs, Qnil); return lookup_face (f, attrs, c, default_face); *************** *** 6801,6807 **** struct face *new_face; /* The default face must exist and be fully specified. */ ! get_lface_attributes (f, Qdefault, attrs, 1); check_lface_attrs (attrs); xassert (lface_fully_specified_p (attrs)); --- 6955,6961 ---- struct face *new_face; /* The default face must exist and be fully specified. */ ! get_lface_attributes (f, Qdefault, attrs, 1, Qnil); check_lface_attrs (attrs); xassert (lface_fully_specified_p (attrs)); *************** *** 6814,6820 **** } /* Merge SYMBOL's face with the default face. */ ! get_lface_attributes (f, symbol, symbol_attrs, 1); merge_face_vectors (f, symbol_attrs, attrs, Qnil); /* Realize the face. */ --- 6968,6974 ---- } /* Merge SYMBOL's face with the default face. */ ! get_lface_attributes (f, symbol, symbol_attrs, 1, Qnil); merge_face_vectors (f, symbol_attrs, attrs, Qnil); /* Realize the face. */ *************** *** 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); --- 7526,7543 ---- *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; /* Begin with attributes from the default face. */ bcopy (default_face->lface, attrs, sizeof attrs); *************** *** 7407,7414 **** /* If in the region, merge in the region face. */ if (pos >= region_beg && pos < region_end) { ! Lisp_Object region_face = lface_from_face_name (f, Qregion, 0); ! merge_face_vectors (f, XVECTOR (region_face)->contents, attrs, Qnil); if (region_end < endpos) endpos = region_end; --- 7566,7572 ---- /* If in the region, merge in the region face. */ if (pos >= region_beg && pos < region_end) { ! merge_named_face (f, Qregion, attrs); if (region_end < endpos) endpos = region_end; *************** *** 7510,7519 **** if (bufpos && bufpos >= region_beg && bufpos < region_end) ! { ! Lisp_Object region_face = lface_from_face_name (f, Qregion, 0); ! merge_face_vectors (f, XVECTOR (region_face)->contents, attrs, Qnil); ! } /* Look up a realized face with the given face attributes, or realize a new one for ASCII characters. */ --- 7668,7674 ---- if (bufpos && bufpos >= region_beg && bufpos < region_end) ! merge_named_face (f, Qregion, attrs, Qnil); /* Look up a realized face with the given face attributes, or realize a new one for ASCII characters. */ *************** *** 7839,7844 **** --- 7994,8021 ---- ignore. */); Vface_ignored_fonts = Qnil; + DEFVAR_LISP ("face-remapping-alist", &Vface_remapping_alist, + doc: /* Alist of face remappings. + Each element is of the form: + (OLD-FACE REPLACEMENT-FACE...), + which causes uses of the face OLD-FACE to use + REPLACEMENT-FACE... instead. If more than one replacement face is + specified, they are merged together. + + Face-name remapping cycles are suppressed, causing the underlying face + to be used instead, so a remapping of the form: + (OLD-FACE OLD-FACE EXTRA-FACE...) + will cause EXTRA-FACE... to be _merged_ with the existing definition of + OLD-FACE. For conciseness, the form (OLD-FACE nil EXTRA-FACE....) is + treated the same way. 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