procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Implement face-remapping-alist feature

Browse source 
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-1195
This commit is contained in:
Miles Bader 2008-06-01 05:04:24 +00:00
parent 70583cb569
commit f2cec7a990
7 changed files with 328 additions and 41 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
doc/lispref/ChangeLog
View file

@ -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"

55
doc/lispref/display.texi
View file

@ -2365,6 +2365,61 @@ line or a header line), and last the @code{default} face.
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

34
src/ChangeLog
View file

@ -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>:

3
src/dispextern.h
View file

@ -2852,6 +2852,7 @@ int xstrcasecmp P_ ((const unsigned char *, const unsigned char *));
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 char unspecified_fg[], unspecified_bg[];
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

2
src/fontset.c
View file

@ -1677,7 +1677,7 @@ DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0,
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;
}

16
src/xdisp.c
View file

@ -2491,6 +2491,7 @@ init_iterator (it, w, charpos, bytepos, row, base_face_id)
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 @@ init_iterator (it, w, charpos, bytepos, row, base_face_id)
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 @@ init_iterator (it, w, charpos, bytepos, row, base_face_id)
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 @@ init_iterator (it, w, charpos, bytepos, row, base_face_id)
{
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 @@ handle_single_display_spec (it, spec, object, overlay, position,
/* 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 @@ handle_single_display_spec (it, spec, object, overlay, position,
|| 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))

255
src/xfaces.c
View file

@ -422,6 +422,23 @@ Lisp_Object Qbitmap_spec_p;
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 void map_tty_color P_ ((struct frame *, struct face *,
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 @@ check_lface (lface)
/* 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 @@ check_lface (lface)
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 @@ resolve_face_name (face_name, signal_p)
/* 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 @@ lface_from_face_name (f, face_name, signal_p)
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 @@ lface_from_face_name (f, face_name, signal_p)
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;
}
else
success_p = 0;
struct named_merge_point named_merge_point;
return success_p;
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 @@ merge_face_heights (from, to, invalid)
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 @@ merge_named_face (f, face_name, to, named_merge_points)
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 @@ update_face_from_frame_parameter (f, param, new_value)
/* 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 @@ lookup_named_face (f, symbol, signal_p)
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 @@ lookup_named_face (f, symbol, signal_p)
}
/* 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 @@ lookup_derived_face (f, symbol, face_id, signal_p)
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 @@ realize_named_face (f, symbol, id)
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 @@ realize_named_face (f, symbol, id)
}
/* 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 @@ face_at_buffer_position (w, pos, region_beg, region_end,
*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 @@ Each element is a regular expression that matches names of fonts to
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