orig = emacs@sv.gnu.org/emacs--devo--0--patch-1180 mod = emacs@sv.gnu.org/emacs--devo--0--patch-1180 A src/ChangeLog.face-remap M src/xfaces.c M src/dispextern.h M src/fontset.c M src/xdisp.c M doc/lispref/display.texi --- orig/doc/lispref/display.texi +++ mod/doc/lispref/display.texi @@ -2365,6 +2365,58 @@ When multiple overlays cover one character, an overlay with higher priority overrides those with lower priority. @xref{Overlays}. +@defvar face-remapping-alist +@tindex face-remapping-alist + This variable is used for buffer-local changes in the appearance of +a face, for instance making the @code{default} face a variable-pitch +face in a particular buffer. + + Its value should be an alist, whose elements have the form +@code{(@var{face} @var{remapping}@dots{})}; when the text specifies +face @var{face}, Emacs redisplay uses @var{remapping}@dots{} instead. +@var{remapping}@dots{} may be any face specification suitable for a +@code{face} text property, usually a face name, but also perhaps a +property list of face attribute/value pairs; @xref{Special +Properties}. + +Two points bear emphasizing: + +@enumerate +@item +The new definition @var{remapping}@dots{} is the complete +specification of how to display @var{face}---it entirely replaces, +rather than augmenting or modifying, the normal definition of that +face. + +@item +If @var{remapping}@dots{} recursively references the same face name +@var{face}, either directly remapping entry, or via the +@code{:inherit} attribute of some other face in +@var{remapping}@dots{}, then that reference uses normal frame-wide +definition of @var{face} instead of the `remapped' definition. + +For instance, if the @code{mode-line} face is remapped using this +entry in @code{face-remapping-alist}: +@example +(mode-line italic mode-line) +@end example +Then the new definition of the @code{mode-line} face inherits from the +@code{italic} face, and the @emph{normal} (non-remapped) definition of +@code{mode-line} face. +@end enumerate + + A typical use of the @code{face-remapping-alist} is to change a +buffer's @code{default} face; for example, the following changes a +buffer's @code{default} face to use the @code{variable-pitch} face, +with the height doubled: + +@example +(set (make-local-variable 'face-remapping-alist) + '((default variable-pitch :height 2.0))) +@end example + +@end defvar + @node Font Selection @subsection Font Selection --- orig/src/dispextern.h +++ mod/src/dispextern.h @@ -2852,6 +2852,7 @@ int lookup_face P_ ((struct frame *, Lisp_Object *)); int lookup_non_ascii_face P_ ((struct frame *, 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)); @@ -2880,6 +2881,8 @@ extern Lisp_Object split_font_name_into_vector P_ ((Lisp_Object)); extern Lisp_Object build_font_name_from_vector P_ ((Lisp_Object)); +extern Lisp_Object Vface_remapping_alist; + /* Defined in xfns.c */ #ifdef HAVE_X_WINDOWS --- orig/src/fontset.c +++ mod/src/fontset.c @@ -1727,7 +1727,7 @@ CHECK_CHARACTER (ch); c = XINT (ch); f = XFRAME (selected_frame); - face_id = DEFAULT_FACE_ID; + face_id = lookup_basic_face (f, DEFAULT_FACE_ID); pos = -1; cs_id = -1; } --- orig/src/xdisp.c +++ mod/src/xdisp.c @@ -2493,6 +2493,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); @@ -2509,6 +2510,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) @@ -2524,7 +2529,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; @@ -2709,11 +2714,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; } @@ -4079,7 +4084,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])); } @@ -4189,7 +4195,7 @@ || EQ (XCAR (spec), Qright_fringe)) && CONSP (XCDR (spec))) { - int face_id = DEFAULT_FACE_ID; + int face_id = lookup_basic_face (it->f, DEFAULT_FACE_ID); int fringe_bitmap; if (!FRAME_WINDOW_P (it->f)) --- orig/src/xfaces.c +++ mod/src/xfaces.c @@ -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)); @@ -2058,6 +2076,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 @@ -2067,27 +2091,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)) - return 0; + { + 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; @@ -2163,24 +2200,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, signal_p); - if (f) lface = assq_no_quit (face_name, f->face_alist); else @@ -2192,9 +2224,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 @@ -2203,26 +2254,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); + + 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)) { - bcopy (XVECTOR (lface)->contents, attrs, - LFACE_VECTOR_SIZE * sizeof *attrs); - success_p = 1; + 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); } @@ -2378,8 +2468,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) @@ -2454,11 +2544,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) { @@ -3435,8 +3526,8 @@ Lisp_Object frame; /* 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. */ + mode, so that we have to load new defface specs. Call + frame-update-face-colors to do that. */ XSETFRAME (frame, f); call1 (Qframe_set_background_mode, frame); @@ -4623,8 +4714,8 @@ 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, signal_p) +static int +lookup_named_face_1 (f, symbol, signal_p) struct frame *f; Lisp_Object symbol; int signal_p; @@ -4642,7 +4733,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); @@ -4651,6 +4742,67 @@ return lookup_face (f, attrs); } +/* 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, signal_p) + struct frame *f; + Lisp_Object symbol; + int signal_p; +{ + return lookup_named_face_1 (f, symbol, 0); +} + + +/* 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); + 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. */ @@ -4784,7 +4936,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); @@ -4810,7 +4962,6 @@ Face capability testing ***********************************************************************/ - /* If the distance (as returned by color_distance) between two colors is less than this, then they are considered the same, for determining whether a color is supported or not. The range of values is 0-65535. */ @@ -4943,7 +5094,6 @@ unsigned test_caps = 0; Lisp_Object *def_attrs = def_face->lface; - /* First check some easy-to-check stuff; ttys support none of the following attributes, so we can just return false if any are requested (even if `nominal' values are specified, we should still return false, @@ -5493,7 +5643,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)); @@ -5506,7 +5656,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. */ @@ -6063,13 +6213,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); @@ -6668,6 +6823,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 * added files --- /dev/null +++ mod/src/ChangeLog.face-remap @@ -0,0 +1,43 @@ +2005-05-03 Miles Bader + + * xfaces.c (get_lface_attributes): Pass SIGNAL_P to resolve_face_name. + +2004-05-25 Miles Bader + + * xfaces.c (Vface_remapping_alist): New variable. + (syms_of_xfaces): Initialize it. + (enum named_merge_point_kind): New type. + (struct named_merge_point): Add `named_merge_point_kind' field. + (push_named_merge_point): Make cycle detection respect different + named-merge-point kinds. + (lface_from_face_name_no_resolve): Renamed from `lface_from_face_name'. + Remove face-name alias resolution. + (lface_from_face_name): New definition using + `lface_from_face_name_no_resolve'. + (get_lface_attributes_no_remap): Renamed from `get_lface_attributes'. + Call lface_from_face_name_no_resolve instead of lface_from_face_name. + (get_lface_attributes): New definition that layers face-remapping on + top of get_lface_attributes_no_remap. New arg `named_merge_points'. + (lookup_named_face_1): Renamed from `lookup_named_face'. Add + `signal_p' argument. Pass new last arg to `get_lface_attributes', and + return -1 if it fails. + (lookup_named_face): Redefined in terms of `lookup_named_face_1'. + (lookup_basic_face): New function. + (lookup_derived_face): Pass new last arg to `get_lface_attributes'. + (realize_named_face): Call `get_lface_attributes_no_remap' instead of + `get_lface_attributes'. + (face_at_buffer_position): Use `lookup_basic_face' to lookup + DEFAULT_FACE_ID if necessary. When optimizing the default-face case, + return default_face's face-id instead of the constant DEFAULT_FACE_ID. + + * xdisp.c (init_iterator): Pass base_face_id through + `lookup_basic_face' when we actually use it as a face-id. + (handle_single_display_prop): Use `lookup_basic_face' to lookup + DEFAULT_FACE_ID. + + * fontset.c (Finternal_char_font): Use `lookup_basic_face' to + lookup the initial face-id. + + * dispextern.h (lookup_basic_face, Vface_remapping_alist): New decls. + +;; arch-tag: aded4c61-a649-4b57-9c93-5408933a7b40