Mercurial > emacs
changeset 95457:415f68458e61
Implement face-remapping-alist feature
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-1195
author | Miles Bader <miles@gnu.org> |
---|---|
date | Sun, 01 Jun 2008 05:04:24 +0000 |
parents | b7c970f39dae |
children | 590265a51ebf |
files | doc/lispref/ChangeLog doc/lispref/display.texi src/ChangeLog src/dispextern.h src/fontset.c src/xdisp.c src/xfaces.c |
diffstat | 7 files changed, 331 insertions(+), 44 deletions(-) [+] |
line wrap: on
line diff
--- a/doc/lispref/ChangeLog Sun Jun 01 04:48:53 2008 +0000 +++ b/doc/lispref/ChangeLog Sun Jun 01 05:04:24 2008 +0000 @@ -1,3 +1,7 @@ +2008-06-01 Miles Bader <miles@gnu.org> + + * display.texi (Displaying Faces): Add face-remapping-alist. + 2008-05-30 Stefan Monnier <monnier@iro.umontreal.ca> * tips.texi (Coding Conventions): Do not encourage the use of "-flag"
--- a/doc/lispref/display.texi Sun Jun 01 04:48:53 2008 +0000 +++ b/doc/lispref/display.texi Sun Jun 01 05:04:24 2008 +0000 @@ -2365,6 +2365,61 @@ When multiple overlays cover one character, an overlay with higher priority overrides those with lower priority. @xref{Overlays}. +@defvar face-remapping-alist + This variable is used for buffer-local or global 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...})}. This causes Emacs to display +text using the face @var{face} using @var{remapping...} instead of +@var{face}'s global definition. @var{remapping...} 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}. + + To affect display only in a single buffer, +@code{face-remapping-alist} should be made buffer-local. + +Two points bear emphasizing: + +@enumerate +@item +The new definition @var{remapping...} 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...} 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...}, 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 +@noindent +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
--- a/src/ChangeLog Sun Jun 01 04:48:53 2008 +0000 +++ b/src/ChangeLog Sun Jun 01 05:04:24 2008 +0000 @@ -1,3 +1,37 @@ +2008-06-01 Miles Bader <miles@gnu.org> + + * 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_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. + 2008-06-01 Juanma Barranquero <lekktu@gmail.com> * textprop.c (syms_of_textprop) <text-property-default-nonsticky>:
--- a/src/dispextern.h Sun Jun 01 04:48:53 2008 +0000 +++ b/src/dispextern.h Sun Jun 01 05:04:24 2008 +0000 @@ -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
--- a/src/fontset.c Sun Jun 01 04:48:53 2008 +0000 +++ b/src/fontset.c Sun Jun 01 05:04:24 2008 +0000 @@ -1677,7 +1677,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; }
--- a/src/xdisp.c Sun Jun 01 04:48:53 2008 +0000 +++ b/src/xdisp.c Sun Jun 01 05:04:24 2008 +0000 @@ -2491,6 +2491,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); @@ -2507,6 +2508,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) @@ -2522,7 +2527,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; @@ -2707,11 +2712,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; } @@ -4077,7 +4082,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])); } @@ -4187,7 +4193,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))
--- a/src/xfaces.c Sun Jun 01 04:48:53 2008 +0000 +++ b/src/xfaces.c Sun Jun 01 05:04:24 2008 +0000 @@ -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)); @@ -2063,6 +2081,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 @@ -2072,27 +2096,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; @@ -2170,22 +2207,17 @@ /* 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. */ - + 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 @@ -2197,9 +2229,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 @@ -2208,26 +2259,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)) - { - bcopy (XVECTOR (lface)->contents, attrs, - LFACE_VECTOR_SIZE * sizeof *attrs); - success_p = 1; - } - else - success_p = 0; - - return success_p; + + 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)) + { + 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); + } + } + + /* Default case, no remapping. */ + return get_lface_attributes_no_remap (f, face_name, attrs, signal_p); } @@ -2383,8 +2473,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) @@ -2459,11 +2549,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) { @@ -3441,7 +3532,7 @@ /* 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. */ + Call frame-update-face-colors to do that. */ XSETFRAME (frame, f); call1 (Qframe_set_background_mode, frame); @@ -4647,7 +4738,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); @@ -4657,6 +4748,58 @@ } +/* 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: + abort (); /* the caller is supposed to pass us a basic face id */ + } + + /* Do a quick scan through Vface_remapping_alist, and return immediately + if there is no remapping for face NAME. This is just an optimization + for the very common no-remapping case. */ + mapping = assq_no_quit (name, Vface_remapping_alist); + if (NILP (mapping)) + return face_id; /* Give up. */ + + /* If there is a remapping entry, lookup the face using NAME, which will + handle the remapping too. */ + remapped_face_id = lookup_named_face (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. */ @@ -4789,7 +4932,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); @@ -5498,7 +5641,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)); @@ -5511,7 +5654,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. */ @@ -6068,13 +6211,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); @@ -6673,6 +6821,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