* looking for address@hidden/emacs--cvs-trunk--0--patch-276 to compare with * comparing to address@hidden/emacs--cvs-trunk--0--patch-276 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 @@ -2715,6 +2715,7 @@ 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)); @@ -2731,6 +2732,8 @@ 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,7 +1252,7 @@ CHECK_NATNUM (ch); c = XINT (ch); f = XFRAME (selected_frame); - face_id = DEFAULT_FACE_ID; + face_id = lookup_basic_face (f, DEFAULT_FACE_ID); } else { --- orig/src/xdisp.c +++ mod/src/xdisp.c @@ -2027,6 +2027,7 @@ 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); @@ -2043,6 +2044,10 @@ 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) @@ -2058,7 +2063,7 @@ bzero (it, sizeof *it); it->current.overlay_string_index = -1; it->current.dpvec_index = -1; - it->base_face_id = base_face_id; + it->base_face_id = remapped_base_face_id; it->string = Qnil; IT_STRING_CHARPOS (*it) = IT_STRING_BYTEPOS (*it) = -1; @@ -2242,11 +2247,11 @@ { struct face *face; - it->face_id = base_face_id; + 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, base_face_id); + face = FACE_FROM_ID (it->f, remapped_base_face_id); if (face->box != FACE_NO_BOX) it->start_of_box_run_p = 1; } @@ -3481,7 +3486,8 @@ /* Value is a multiple of the canonical char height. */ struct face *face; - face = FACE_FROM_ID (it->f, DEFAULT_FACE_ID); + 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])); } @@ -3581,7 +3587,7 @@ || EQ (XCAR (prop), Qright_fringe)) && CONSP (XCDR (prop))) { - unsigned face_id = DEFAULT_FACE_ID; + 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 @@ -396,6 +396,13 @@ 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; @@ -471,7 +478,7 @@ 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 get_lface_attributes P_ ((struct frame *, Lisp_Object, Lisp_Object *, int, Lisp_Object)); static int load_pixmap P_ ((struct frame *, Lisp_Object, unsigned *, unsigned *)); static unsigned char *xstrlwr P_ ((unsigned char *)); static void signal_error P_ ((char *, Lisp_Object)); @@ -3178,24 +3185,19 @@ /* 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. */ - + 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 (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); - if (f) lface = assq_no_quit (face_name, f->face_alist); else @@ -3207,9 +3209,27 @@ 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 @@ -3218,26 +3238,91 @@ 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)) - { - bcopy (XVECTOR (lface)->contents, attrs, - LFACE_VECTOR_SIZE * sizeof *attrs); - success_p = 1; + 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; + } + } } - else - success_p = 0; - return success_p; + /* Default case, no remapping. */ + return get_lface_attributes_no_remap (f, face_name, attrs, signal_p); } @@ -3479,11 +3564,29 @@ 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. - Returns true if any of the inherited attributes are `font-related'. */ + CYCLE_CHECK is used to detect loops in face inheritance. */ static void merge_face_inheritance (f, inherit, to, cycle_check) @@ -3495,17 +3598,13 @@ 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); + merge_named_face (f, inherit, to, cycle_check); } else if (CONSP (inherit)) /* Handle a list of inherited faces by calling ourselves recursively @@ -3736,11 +3835,8 @@ else { /* PROP ought to be a face name. */ - Lisp_Object lface = lface_from_face_name (f, prop, 0); - if (NILP (lface)) + if (! merge_named_face (f, prop, to, Qnil)) add_to_log ("Invalid face text property value: %s", prop, Qnil); - else - merge_face_vectors (f, XVECTOR (lface)->contents, to, Qnil); } } @@ -5734,11 +5830,12 @@ 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) +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]; @@ -5751,12 +5848,76 @@ 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, 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; + 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: + 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. */ @@ -5890,7 +6051,7 @@ if (!default_face) abort (); - get_lface_attributes (f, symbol, symbol_attrs, 1); + 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); @@ -6753,7 +6914,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)); @@ -6766,7 +6927,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, Qnil); /* Realize the face. */ @@ -7321,13 +7482,18 @@ *endptr = endpos; - default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID); + + /* 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); @@ -7356,8 +7522,7 @@ /* 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); + merge_named_face (f, Qregion, attrs); if (region_end < endpos) endpos = region_end; @@ -7459,10 +7624,7 @@ 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); - } + 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. */ @@ -7783,6 +7945,28 @@ 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