X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/9717e36cff1ceda0bbebb2209c9fbbbd420af6d0..ee6bb6939fe507dc98986bfc23794da6110f61ef:/src/xfaces.c diff --git a/src/xfaces.c b/src/xfaces.c index bd19d32c99..c408a7d368 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -1,6 +1,6 @@ /* xfaces.c -- "Face" primitives. - Copyright (C) 1993, 1994, 1998, 1999, 2000, 2001, 2002, 2003, 2004 - Free Software Foundation. + Copyright (C) 1993, 1994, 1998, 1999, 2000, 2001, 2002, 2003, 2004, + 2005, 2006 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -16,8 +16,8 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU Emacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +Boston, MA 02110-1301, USA. */ /* New face implementation by Gerd Moellmann . */ @@ -274,6 +274,10 @@ Boston, MA 02111-1307, USA. */ #define UNSPECIFIEDP(ATTR) EQ ((ATTR), Qunspecified) +/* Non-zero if face attribute ATTR is `ignore-defface'. */ + +#define IGNORE_DEFFACE_P(ATTR) EQ ((ATTR), Qignore_defface) + /* Value is the number of elements of VECTOR. */ #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR)) @@ -312,19 +316,20 @@ Lisp_Object Qultra_expanded; Lisp_Object Qreleased_button, Qpressed_button; Lisp_Object QCstyle, QCcolor, QCline_width; Lisp_Object Qunspecified; +Lisp_Object Qignore_defface; char unspecified_fg[] = "unspecified-fg", unspecified_bg[] = "unspecified-bg"; /* The name of the function to call when the background of the frame - has changed, frame_update_face_colors. */ + has changed, frame_set_background_mode. */ -Lisp_Object Qframe_update_face_colors; +Lisp_Object Qframe_set_background_mode; /* Names of basic faces. */ Lisp_Object Qdefault, Qtool_bar, Qregion, Qfringe; Lisp_Object Qheader_line, Qscroll_bar, Qcursor, Qborder, Qmouse, Qmenu; -Lisp_Object Qmode_line_inactive; +Lisp_Object Qmode_line_inactive, Qvertical_border; extern Lisp_Object Qmode_line; /* The symbol `face-alias'. A symbols having that property is an @@ -333,6 +338,8 @@ extern Lisp_Object Qmode_line; Lisp_Object Qface_alias; +extern Lisp_Object Qcircular_list; + /* Default stipple pattern used on monochrome displays. This stipple pattern is used on monochrome displays instead of shades of gray for a face background color. See `set-face-stipple' for possible @@ -385,6 +392,10 @@ Lisp_Object Qforeground_color, Qbackground_color; Lisp_Object Qface; extern Lisp_Object Qmouse_face; +/* Property for basic faces which other faces cannot inherit. */ + +Lisp_Object Qface_no_inherit; + /* Error symbol for wrong_type_argument in load_pixmap. */ Lisp_Object Qbitmap_spec_p; @@ -460,10 +471,11 @@ int menu_face_changed_default; struct font_name; struct table_entry; +struct named_merge_point; static void map_tty_color P_ ((struct frame *, struct face *, enum lface_attribute_index, int *)); -static Lisp_Object resolve_face_name P_ ((Lisp_Object)); +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 better_font_p P_ ((int *, struct font_name *, struct font_name *, @@ -474,7 +486,6 @@ 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, unsigned *, unsigned *)); static unsigned char *xstrlwr P_ ((unsigned char *)); -static void signal_error P_ ((char *, Lisp_Object)); static struct frame *frame_or_selected_frame P_ ((Lisp_Object, int)); static void load_face_font P_ ((struct frame *, struct face *, int)); static void load_face_colors P_ ((struct frame *, struct face *, Lisp_Object *)); @@ -518,11 +529,10 @@ static int face_numeric_slant P_ ((Lisp_Object)); static int face_numeric_swidth P_ ((Lisp_Object)); static int face_fontset P_ ((Lisp_Object *)); static char *choose_face_font P_ ((struct frame *, Lisp_Object *, int, int, int*)); -static void merge_face_vectors P_ ((struct frame *, Lisp_Object *, Lisp_Object*, Lisp_Object)); -static void merge_face_inheritance P_ ((struct frame *f, Lisp_Object, - Lisp_Object *, Lisp_Object)); -static void merge_face_vector_with_property P_ ((struct frame *, Lisp_Object *, - Lisp_Object)); +static void merge_face_vectors P_ ((struct frame *, Lisp_Object *, Lisp_Object*, + struct named_merge_point *)); +static int merge_face_ref P_ ((struct frame *, Lisp_Object, Lisp_Object *, + int, struct named_merge_point *)); static int set_lface_from_font_name P_ ((struct frame *, Lisp_Object, Lisp_Object, int, int)); static Lisp_Object lface_from_face_name P_ ((struct frame *, Lisp_Object, int)); @@ -734,7 +744,7 @@ x_free_gc (f, gc) GC gc; { BLOCK_INPUT; - xassert (--ngcs >= 0); + IF_DEBUG (xassert (--ngcs >= 0)); XFreeGC (FRAME_X_DISPLAY (f), gc); UNBLOCK_INPUT; } @@ -767,7 +777,7 @@ x_free_gc (f, gc) GC gc; { BLOCK_INPUT; - xassert (--ngcs >= 0); + IF_DEBUG (xassert (--ngcs >= 0)); xfree (gc); UNBLOCK_INPUT; } @@ -777,8 +787,6 @@ x_free_gc (f, gc) #ifdef MAC_OS /* Mac OS emulation of GCs */ -extern XGCValues *XCreateGC (void *, Window, unsigned long, XGCValues *); - static INLINE GC x_create_gc (f, mask, xgcv) struct frame *f; @@ -786,7 +794,10 @@ x_create_gc (f, mask, xgcv) XGCValues *xgcv; { GC gc; + BLOCK_INPUT; gc = XCreateGC (FRAME_MAC_DISPLAY (f), FRAME_MAC_WINDOW (f), mask, xgcv); + UNBLOCK_INPUT; + IF_DEBUG (++ngcs); return gc; } @@ -795,7 +806,10 @@ x_free_gc (f, gc) struct frame *f; GC gc; { + BLOCK_INPUT; + IF_DEBUG (xassert (--ngcs >= 0)); XFreeGC (FRAME_MAC_DISPLAY (f), gc); + UNBLOCK_INPUT; } #endif /* MAC_OS */ @@ -831,23 +845,15 @@ xstrlwr (s) unsigned char *p = s; for (p = s; *p; ++p) - *p = tolower (*p); + /* On Mac OS X 10.3, tolower also converts non-ASCII characters + for some locales. */ + if (isascii (*p)) + *p = tolower (*p); return s; } -/* Signal `error' with message S, and additional argument ARG. */ - -static void -signal_error (s, arg) - char *s; - Lisp_Object arg; -{ - Fsignal (Qerror, Fcons (build_string (s), Fcons (arg, Qnil))); -} - - /* If FRAME is nil, return a pointer to the selected frame. Otherwise, check that FRAME is a live frame, and return a pointer to it. NPARAM is the parameter number of FRAME, for @@ -1067,6 +1073,9 @@ clear_font_table (dpyinfo) #endif #ifdef WINDOWSNT w32_unload_font (dpyinfo, font_info->font); +#endif +#ifdef MAC_OS + mac_unload_font (dpyinfo, font_info->font); #endif UNBLOCK_INPUT; @@ -1150,14 +1159,11 @@ load_pixmap (f, name, w_ptr, h_ptr) unsigned int *w_ptr, *h_ptr; { int bitmap_id; - Lisp_Object tem; if (NILP (name)) return 0; - tem = Fbitmap_spec_p (name); - if (NILP (tem)) - wrong_type_argument (Qbitmap_spec_p, name); + CHECK_TYPE (!NILP (Fbitmap_spec_p (name)), Qbitmap_spec_p, name); BLOCK_INPUT; if (CONSP (name)) @@ -1183,7 +1189,7 @@ load_pixmap (f, name, w_ptr, h_ptr) if (bitmap_id < 0) { - add_to_log ("Invalid or undefined bitmap %s", name, Qnil); + add_to_log ("Invalid or undefined bitmap `%s'", name, Qnil); bitmap_id = 0; if (w_ptr) @@ -1467,7 +1473,9 @@ tty_color_name (f, idx) /* Return non-zero if COLOR_NAME is a shade of gray (or white or - black) on frame F. The algorithm is taken from 20.2 faces.el. */ + black) on frame F. + + The criterion implemented here is not a terribly sophisticated one. */ static int face_color_gray_p (f, color_name) @@ -1478,12 +1486,15 @@ face_color_gray_p (f, color_name) int gray_p; if (defined_color (f, color_name, &color, 0)) - gray_p = ((abs (color.red - color.green) - < max (color.red, color.green) / 20) - && (abs (color.green - color.blue) - < max (color.green, color.blue) / 20) - && (abs (color.blue - color.red) - < max (color.blue, color.red) / 20)); + gray_p = (/* Any color sufficiently close to black counts as grey. */ + (color.red < 5000 && color.green < 5000 && color.blue < 5000) + || + ((abs (color.red - color.green) + < max (color.red, color.green) / 20) + && (abs (color.green - color.blue) + < max (color.green, color.blue) / 20) + && (abs (color.blue - color.red) + < max (color.blue, color.red) / 20))); else gray_p = 0; @@ -1506,7 +1517,7 @@ face_color_supported_p (f, color_name, background_p) XSETFRAME (frame, f); return -#ifdef HAVE_X_WINDOWS +#ifdef HAVE_WINDOW_SYSTEM FRAME_WINDOW_P (f) ? (!NILP (Fxw_display_color_p (frame)) || xstricmp (color_name, "black") == 0 @@ -1544,6 +1555,7 @@ DEFUN ("color-supported-p", Fcolor_supported_p, Scolor_supported_p, 1, 3, 0, doc: /* Return non-nil if COLOR can be displayed on FRAME. BACKGROUND-P non-nil means COLOR is used as a background. +Otherwise, this function tells whether it can be used as a foreground. If FRAME is nil or omitted, use the selected frame. COLOR must be a valid color name. */) (color, frame, background_p) @@ -3004,7 +3016,7 @@ the WIDTH times as wide as FACE on FRAME. */) { /* This is of limited utility since it works with character widths. Keep it for compatibility. --gerd. */ - int face_id = lookup_named_face (f, face, 0); + int face_id = lookup_named_face (f, face, 0, 0); struct face *face = (face_id < 0 ? NULL : FACE_FROM_ID (f, face_id)); @@ -3082,48 +3094,64 @@ check_lface_attrs (attrs) Lisp_Object *attrs; { xassert (UNSPECIFIEDP (attrs[LFACE_FAMILY_INDEX]) + || IGNORE_DEFFACE_P (attrs[LFACE_FAMILY_INDEX]) || STRINGP (attrs[LFACE_FAMILY_INDEX])); xassert (UNSPECIFIEDP (attrs[LFACE_SWIDTH_INDEX]) + || IGNORE_DEFFACE_P (attrs[LFACE_SWIDTH_INDEX]) || SYMBOLP (attrs[LFACE_SWIDTH_INDEX])); xassert (UNSPECIFIEDP (attrs[LFACE_AVGWIDTH_INDEX]) + || IGNORE_DEFFACE_P (attrs[LFACE_AVGWIDTH_INDEX]) || INTEGERP (attrs[LFACE_AVGWIDTH_INDEX])); xassert (UNSPECIFIEDP (attrs[LFACE_HEIGHT_INDEX]) + || IGNORE_DEFFACE_P (attrs[LFACE_HEIGHT_INDEX]) || INTEGERP (attrs[LFACE_HEIGHT_INDEX]) || FLOATP (attrs[LFACE_HEIGHT_INDEX]) || FUNCTIONP (attrs[LFACE_HEIGHT_INDEX])); xassert (UNSPECIFIEDP (attrs[LFACE_WEIGHT_INDEX]) + || IGNORE_DEFFACE_P (attrs[LFACE_WEIGHT_INDEX]) || SYMBOLP (attrs[LFACE_WEIGHT_INDEX])); xassert (UNSPECIFIEDP (attrs[LFACE_SLANT_INDEX]) + || IGNORE_DEFFACE_P (attrs[LFACE_SLANT_INDEX]) || SYMBOLP (attrs[LFACE_SLANT_INDEX])); xassert (UNSPECIFIEDP (attrs[LFACE_UNDERLINE_INDEX]) + || IGNORE_DEFFACE_P (attrs[LFACE_UNDERLINE_INDEX]) || SYMBOLP (attrs[LFACE_UNDERLINE_INDEX]) || STRINGP (attrs[LFACE_UNDERLINE_INDEX])); xassert (UNSPECIFIEDP (attrs[LFACE_OVERLINE_INDEX]) + || IGNORE_DEFFACE_P (attrs[LFACE_OVERLINE_INDEX]) || SYMBOLP (attrs[LFACE_OVERLINE_INDEX]) || STRINGP (attrs[LFACE_OVERLINE_INDEX])); xassert (UNSPECIFIEDP (attrs[LFACE_STRIKE_THROUGH_INDEX]) + || IGNORE_DEFFACE_P (attrs[LFACE_STRIKE_THROUGH_INDEX]) || SYMBOLP (attrs[LFACE_STRIKE_THROUGH_INDEX]) || STRINGP (attrs[LFACE_STRIKE_THROUGH_INDEX])); xassert (UNSPECIFIEDP (attrs[LFACE_BOX_INDEX]) + || IGNORE_DEFFACE_P (attrs[LFACE_BOX_INDEX]) || SYMBOLP (attrs[LFACE_BOX_INDEX]) || STRINGP (attrs[LFACE_BOX_INDEX]) || INTEGERP (attrs[LFACE_BOX_INDEX]) || CONSP (attrs[LFACE_BOX_INDEX])); xassert (UNSPECIFIEDP (attrs[LFACE_INVERSE_INDEX]) + || IGNORE_DEFFACE_P (attrs[LFACE_INVERSE_INDEX]) || SYMBOLP (attrs[LFACE_INVERSE_INDEX])); xassert (UNSPECIFIEDP (attrs[LFACE_FOREGROUND_INDEX]) + || IGNORE_DEFFACE_P (attrs[LFACE_FOREGROUND_INDEX]) || STRINGP (attrs[LFACE_FOREGROUND_INDEX])); xassert (UNSPECIFIEDP (attrs[LFACE_BACKGROUND_INDEX]) + || IGNORE_DEFFACE_P (attrs[LFACE_BACKGROUND_INDEX]) || STRINGP (attrs[LFACE_BACKGROUND_INDEX])); xassert (UNSPECIFIEDP (attrs[LFACE_INHERIT_INDEX]) + || IGNORE_DEFFACE_P (attrs[LFACE_INHERIT_INDEX]) || NILP (attrs[LFACE_INHERIT_INDEX]) || SYMBOLP (attrs[LFACE_INHERIT_INDEX]) || CONSP (attrs[LFACE_INHERIT_INDEX])); #ifdef HAVE_WINDOW_SYSTEM xassert (UNSPECIFIEDP (attrs[LFACE_STIPPLE_INDEX]) + || IGNORE_DEFFACE_P (attrs[LFACE_STIPPLE_INDEX]) || SYMBOLP (attrs[LFACE_STIPPLE_INDEX]) || !NILP (Fbitmap_spec_p (attrs[LFACE_STIPPLE_INDEX]))); xassert (UNSPECIFIEDP (attrs[LFACE_FONT_INDEX]) + || IGNORE_DEFFACE_P (attrs[LFACE_FONT_INDEX]) || NILP (attrs[LFACE_FONT_INDEX]) || STRINGP (attrs[LFACE_FONT_INDEX])); #endif @@ -3151,26 +3179,91 @@ check_lface (lface) #endif /* GLYPH_DEBUG == 0 */ + +/* Face-merge cycle checking. */ + +/* 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 + linked- list of struct named_merge_point structures, typically + allocated on the stack frame of the named lookup functions which are + active (so no consing is required). */ +struct named_merge_point +{ + Lisp_Object face_name; + 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. */ + +static INLINE int +push_named_merge_point (struct named_merge_point *new_named_merge_point, + Lisp_Object face_name, + 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; + + new_named_merge_point->face_name = face_name; + new_named_merge_point->prev = *named_merge_points; + + *named_merge_points = new_named_merge_point; + + return 1; +} + + + + /* Resolve face name FACE_NAME. If FACE_NAME is a string, intern it - to make it a symvol. If FACE_NAME is an alias for another face, - return that face's name. */ + to make it a symbol. If FACE_NAME is an alias for another face, + return that face's name. + + Return default face in case of errors. */ static Lisp_Object -resolve_face_name (face_name) +resolve_face_name (face_name, signal_p) Lisp_Object face_name; + int signal_p; { - Lisp_Object aliased; + Lisp_Object orig_face; + Lisp_Object tortoise, hare; if (STRINGP (face_name)) face_name = intern (SDATA (face_name)); - while (SYMBOLP (face_name)) + if (NILP (face_name) || !SYMBOLP (face_name)) + return face_name; + + orig_face = face_name; + tortoise = hare = face_name; + + while (1) { - aliased = Fget (face_name, Qface_alias); - if (NILP (aliased)) + face_name = hare; + hare = Fget (hare, Qface_alias); + if (NILP (hare) || !SYMBOLP (hare)) break; - else - face_name = aliased; + + face_name = hare; + hare = Fget (hare, Qface_alias); + if (NILP (hare) || !SYMBOLP (hare)) + break; + + tortoise = Fget (tortoise, Qface_alias); + if (EQ (hare, tortoise)) + { + if (signal_p) + xsignal1 (Qcircular_list, orig_face); + return Qdefault; + } } return face_name; @@ -3194,7 +3287,7 @@ lface_from_face_name (f, face_name, signal_p) { Lisp_Object lface; - face_name = resolve_face_name (face_name); + face_name = resolve_face_name (face_name, signal_p); if (f) lface = assq_no_quit (face_name, f->face_alist); @@ -3253,7 +3346,7 @@ lface_fully_specified_p (attrs) for (i = 1; i < LFACE_VECTOR_SIZE; ++i) if (i != LFACE_FONT_INDEX && i != LFACE_INHERIT_INDEX && i != LFACE_AVGWIDTH_INDEX) - if (UNSPECIFIEDP (attrs[i]) + if ((UNSPECIFIEDP (attrs[i]) || IGNORE_DEFFACE_P (attrs[i])) #ifdef MAC_OS /* MAC_TODO: No stipple support on Mac OS yet, this index is always unspecified. */ @@ -3384,8 +3477,8 @@ set_lface_from_font_name (f, lface, fontname, force_p, may_fail_p) call into lisp. */ Lisp_Object -merge_face_heights (from, to, invalid, gcpro) - Lisp_Object from, to, invalid, gcpro; +merge_face_heights (from, to, invalid) + Lisp_Object from, to, invalid; { Lisp_Object result = invalid; @@ -3401,6 +3494,8 @@ merge_face_heights (from, to, invalid, gcpro) else if (FLOATP (to)) /* relative X relative => relative */ result = make_float (XFLOAT_DATA (from) * XFLOAT_DATA (to)); + else if (UNSPECIFIEDP (to)) + result = from; } else if (FUNCTIONP (from)) /* FROM is a function, which use to adjust TO. */ @@ -3408,16 +3503,11 @@ merge_face_heights (from, to, invalid, gcpro) /* Call function with current height as argument. From is the new height. */ Lisp_Object args[2]; - struct gcpro gcpro1; - - GCPRO1 (gcpro); args[0] = from; args[1] = to; result = safe_call (2, args); - UNGCPRO; - /* Ensure that if TO was absolute, so is the result. */ if (INTEGERP (to) && !INTEGERP (result)) result = invalid; @@ -3432,14 +3522,15 @@ merge_face_heights (from, to, invalid, gcpro) completely specified and contain only absolute attributes. Every 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. CYCLE_CHECK is used internally to detect loops in - face inheritance; it should be Qnil when called from other places. */ + 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. */ static INLINE void -merge_face_vectors (f, from, to, cycle_check) +merge_face_vectors (f, from, to, named_merge_points) struct frame *f; Lisp_Object *from, *to; - Lisp_Object cycle_check; + struct named_merge_point *named_merge_points; { int i; @@ -3450,7 +3541,7 @@ merge_face_vectors (f, from, to, cycle_check) other code uses `unspecified' as a generic value for face attributes. */ if (!UNSPECIFIEDP (from[LFACE_INHERIT_INDEX]) && !NILP (from[LFACE_INHERIT_INDEX])) - merge_face_inheritance (f, from[LFACE_INHERIT_INDEX], to, cycle_check); + merge_face_ref (f, from[LFACE_INHERIT_INDEX], to, 0, named_merge_points); /* If TO specifies a :font attribute, and FROM specifies some font-related attribute, we need to clear TO's :font attribute @@ -3469,7 +3560,7 @@ merge_face_vectors (f, from, to, cycle_check) if (!UNSPECIFIEDP (from[i])) { if (i == LFACE_HEIGHT_INDEX && !INTEGERP (from[i])) - to[i] = merge_face_heights (from[i], to[i], to[i], cycle_check); + to[i] = merge_face_heights (from[i], to[i], to[i]); else to[i] = from[i]; } @@ -3479,61 +3570,50 @@ merge_face_vectors (f, from, to, cycle_check) 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'. */ +/* Merge the named face FACE_NAME on frame F, into the vector of face + attributes TO. NAMED_MERGE_POINTS is used to detect loops in face + inheritance. Returns true if FACE_NAME is a valid face name and + merging succeeded. */ -static void -merge_face_inheritance (f, inherit, to, cycle_check) +static int +merge_named_face (f, face_name, to, named_merge_points) struct frame *f; - Lisp_Object inherit; + Lisp_Object face_name; Lisp_Object *to; - Lisp_Object cycle_check; + struct named_merge_point *named_merge_points; { - if (SYMBOLP (inherit) && !EQ (inherit, Qunspecified)) - /* Inherit from the named face INHERIT. */ - { - Lisp_Object lface; + struct named_merge_point named_merge_point; - /* 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 - on each element. Note that we only do so for symbol elements, so - it's not possible to infinitely recurse. */ + if (push_named_merge_point (&named_merge_point, + face_name, &named_merge_points)) { - while (CONSP (inherit)) - { - if (SYMBOLP (XCAR (inherit))) - merge_face_inheritance (f, XCAR (inherit), to, cycle_check); - - /* Check for a circular inheritance list. */ - cycle_check = CYCLE_CHECK (cycle_check, inherit, 15); - if (NILP (cycle_check)) - /* Cycle detected. */ - break; + struct gcpro gcpro1; + Lisp_Object from[LFACE_VECTOR_SIZE]; + int ok = get_lface_attributes (f, face_name, from, 0); - inherit = XCDR (inherit); + if (ok) + { + GCPRO1 (named_merge_point.face_name); + merge_face_vectors (f, from, to, named_merge_points); + UNGCPRO; } + + return ok; } + else + return 0; } -/* Given a Lisp face attribute vector TO and a Lisp object PROP that - is a face property, determine the resulting face attributes on - frame F, and store them in TO. PROP may be a single face - specification or a list of such specifications. Each face - specification can be +/* Merge face attributes from the lisp `face reference' FACE_REF on + frame F into the face attribute vector TO. If ERR_MSGS is non-zero, + problems with FACE_REF cause an error message to be shown. Return + non-zero if no errors occurred (regardless of the value of ERR_MSGS). + NAMED_MERGE_POINTS is used to detect loops in face inheritance or + list structure; it may be 0 for most callers. + + FACE_REF may be a single face specification or a list of such + specifications. Each face specification can be: 1. A symbol or string naming a Lisp face. @@ -3548,22 +3628,26 @@ merge_face_inheritance (f, inherit, to, cycle_check) Face specifications earlier in lists take precedence over later specifications. */ -static void -merge_face_vector_with_property (f, to, prop) +static int +merge_face_ref (f, face_ref, to, err_msgs, named_merge_points) struct frame *f; + Lisp_Object face_ref; Lisp_Object *to; - Lisp_Object prop; + int err_msgs; + struct named_merge_point *named_merge_points; { - if (CONSP (prop)) + int ok = 1; /* Succeed without an error? */ + + if (CONSP (face_ref)) { - Lisp_Object first = XCAR (prop); + Lisp_Object first = XCAR (face_ref); if (EQ (first, Qforeground_color) || EQ (first, Qbackground_color)) { /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR . COLOR). COLOR must be a string. */ - Lisp_Object color_name = XCDR (prop); + Lisp_Object color_name = XCDR (face_ref); Lisp_Object color = first; if (STRINGP (color_name)) @@ -3574,34 +3658,41 @@ merge_face_vector_with_property (f, to, prop) to[LFACE_BACKGROUND_INDEX] = color_name; } else - add_to_log ("Invalid face color", color_name, Qnil); + { + if (err_msgs) + add_to_log ("Invalid face color", color_name, Qnil); + ok = 0; + } } else if (SYMBOLP (first) && *SDATA (SYMBOL_NAME (first)) == ':') { /* Assume this is the property list form. */ - while (CONSP (prop) && CONSP (XCDR (prop))) + while (CONSP (face_ref) && CONSP (XCDR (face_ref))) { - Lisp_Object keyword = XCAR (prop); - Lisp_Object value = XCAR (XCDR (prop)); - - if (EQ (keyword, QCfamily)) + Lisp_Object keyword = XCAR (face_ref); + Lisp_Object value = XCAR (XCDR (face_ref)); + int err = 0; + + /* Specifying `unspecified' is a no-op. */ + if (EQ (value, Qunspecified)) + ; + else if (EQ (keyword, QCfamily)) { if (STRINGP (value)) to[LFACE_FAMILY_INDEX] = value; else - add_to_log ("Invalid face font family", value, Qnil); + err = 1; } else if (EQ (keyword, QCheight)) { Lisp_Object new_height = - merge_face_heights (value, to[LFACE_HEIGHT_INDEX], - Qnil, Qnil); + merge_face_heights (value, to[LFACE_HEIGHT_INDEX], Qnil); - if (NILP (new_height)) - add_to_log ("Invalid face font height", value, Qnil); - else + if (! NILP (new_height)) to[LFACE_HEIGHT_INDEX] = new_height; + else + err = 1; } else if (EQ (keyword, QCweight)) { @@ -3609,7 +3700,7 @@ merge_face_vector_with_property (f, to, prop) && face_numeric_weight (value) >= 0) to[LFACE_WEIGHT_INDEX] = value; else - add_to_log ("Invalid face weight", value, Qnil); + err = 1; } else if (EQ (keyword, QCslant)) { @@ -3617,7 +3708,7 @@ merge_face_vector_with_property (f, to, prop) && face_numeric_slant (value) >= 0) to[LFACE_SLANT_INDEX] = value; else - add_to_log ("Invalid face slant", value, Qnil); + err = 1; } else if (EQ (keyword, QCunderline)) { @@ -3626,7 +3717,7 @@ merge_face_vector_with_property (f, to, prop) || STRINGP (value)) to[LFACE_UNDERLINE_INDEX] = value; else - add_to_log ("Invalid face underline", value, Qnil); + err = 1; } else if (EQ (keyword, QCoverline)) { @@ -3635,7 +3726,7 @@ merge_face_vector_with_property (f, to, prop) || STRINGP (value)) to[LFACE_OVERLINE_INDEX] = value; else - add_to_log ("Invalid face overline", value, Qnil); + err = 1; } else if (EQ (keyword, QCstrike_through)) { @@ -3644,7 +3735,7 @@ merge_face_vector_with_property (f, to, prop) || STRINGP (value)) to[LFACE_STRIKE_THROUGH_INDEX] = value; else - add_to_log ("Invalid face strike-through", value, Qnil); + err = 1; } else if (EQ (keyword, QCbox)) { @@ -3656,7 +3747,7 @@ merge_face_vector_with_property (f, to, prop) || NILP (value)) to[LFACE_BOX_INDEX] = value; else - add_to_log ("Invalid face box", value, Qnil); + err = 1; } else if (EQ (keyword, QCinverse_video) || EQ (keyword, QCreverse_video)) @@ -3664,21 +3755,21 @@ merge_face_vector_with_property (f, to, prop) if (EQ (value, Qt) || NILP (value)) to[LFACE_INVERSE_INDEX] = value; else - add_to_log ("Invalid face inverse-video", value, Qnil); + err = 1; } else if (EQ (keyword, QCforeground)) { if (STRINGP (value)) to[LFACE_FOREGROUND_INDEX] = value; else - add_to_log ("Invalid face foreground", value, Qnil); + err = 1; } else if (EQ (keyword, QCbackground)) { if (STRINGP (value)) to[LFACE_BACKGROUND_INDEX] = value; else - add_to_log ("Invalid face background", value, Qnil); + err = 1; } else if (EQ (keyword, QCstipple)) { @@ -3687,7 +3778,7 @@ merge_face_vector_with_property (f, to, prop) if (!NILP (pixmap_p)) to[LFACE_STIPPLE_INDEX] = value; else - add_to_log ("Invalid face stipple", value, Qnil); + err = 1; #endif } else if (EQ (keyword, QCwidth)) @@ -3696,52 +3787,51 @@ merge_face_vector_with_property (f, to, prop) && face_numeric_swidth (value) >= 0) to[LFACE_SWIDTH_INDEX] = value; else - add_to_log ("Invalid face width", value, Qnil); + err = 1; } else if (EQ (keyword, QCinherit)) { - if (SYMBOLP (value)) - to[LFACE_INHERIT_INDEX] = value; - else - { - Lisp_Object tail; - for (tail = value; CONSP (tail); tail = XCDR (tail)) - if (!SYMBOLP (XCAR (tail))) - break; - if (NILP (tail)) - to[LFACE_INHERIT_INDEX] = value; - else - add_to_log ("Invalid face inherit", value, Qnil); - } + /* This is not really very useful; it's just like a + normal face reference. */ + if (! merge_face_ref (f, value, to, + err_msgs, named_merge_points)) + err = 1; } else - add_to_log ("Invalid attribute %s in face property", - keyword, Qnil); + err = 1; + + if (err) + { + add_to_log ("Invalid face attribute %S %S", keyword, value); + ok = 0; + } - prop = XCDR (XCDR (prop)); + face_ref = XCDR (XCDR (face_ref)); } } else { - /* This is a list of face specs. Specifications at the - beginning of the list take precedence over later - specifications, so we have to merge starting with the - last specification. */ - Lisp_Object next = XCDR (prop); - if (!NILP (next)) - merge_face_vector_with_property (f, to, next); - merge_face_vector_with_property (f, to, first); + /* This is a list of face refs. Those at the beginning of the + list take precedence over what follows, so we have to merge + from the end backwards. */ + Lisp_Object next = XCDR (face_ref); + + if (! NILP (next)) + ok = merge_face_ref (f, next, to, err_msgs, named_merge_points); + + if (! merge_face_ref (f, first, to, err_msgs, named_merge_points)) + ok = 0; } } 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); + /* FACE_REF ought to be a face name. */ + ok = merge_named_face (f, face_ref, to, named_merge_points); + if (!ok && err_msgs) + add_to_log ("Invalid face reference: %s", face_ref, Qnil); } + + return ok; } @@ -3822,8 +3912,11 @@ Value is a vector of face attributes. */) depend on the face, make sure they are all removed. This is done by incrementing face_change_count. The next call to init_iterator will then free realized faces. */ - ++face_change_count; - ++windows_or_buffers_changed; + if (NILP (Fget (face, Qface_no_inherit))) + { + ++face_change_count; + ++windows_or_buffers_changed; + } xassert (LFACEP (lface)); check_lface (lface); @@ -3834,7 +3927,7 @@ Value is a vector of face attributes. */) DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p, Sinternal_lisp_face_p, 1, 2, 0, doc: /* Return non-nil if FACE names a face. -If optional second parameter FRAME is non-nil, check for the +If optional second argument FRAME is non-nil, check for the existence of a frame-local face with name FACE on that frame. Otherwise check for the existence of a global face. */) (face, frame) @@ -3857,12 +3950,13 @@ Otherwise check for the existence of a global face. */) DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face, Sinternal_copy_lisp_face, 4, 4, 0, doc: /* Copy face FROM to TO. -If FRAME is t, copy the global face definition of FROM to the -global face definition of TO. Otherwise, copy the frame-local -definition of FROM on FRAME to the frame-local definition of TO -on NEW-FRAME, or FRAME if NEW-FRAME is nil. +If FRAME is t, copy the global face definition of FROM. +Otherwise, copy the frame-local definition of FROM on FRAME. +If NEW-FRAME is a frame, copy that data into the frame-local +definition of TO on NEW-FRAME. If NEW-FRAME is nil. +FRAME controls where the data is copied to. -Value is TO. */) +The value is TO. */) (from, to, frame, new_frame) Lisp_Object from, to, frame, new_frame; { @@ -3870,8 +3964,6 @@ Value is TO. */) CHECK_SYMBOL (from); CHECK_SYMBOL (to); - if (NILP (new_frame)) - new_frame = frame; if (EQ (frame, Qt)) { @@ -3883,6 +3975,8 @@ Value is TO. */) else { /* Copy frame-local definition of FROM. */ + if (NILP (new_frame)) + new_frame = frame; CHECK_LIVE_FRAME (frame); CHECK_LIVE_FRAME (new_frame); lface = lface_from_face_name (XFRAME (frame), from, 1); @@ -3897,8 +3991,11 @@ Value is TO. */) depend on the face, make sure they are all removed. This is done by incrementing face_change_count. The next call to init_iterator will then free realized faces. */ - ++face_change_count; - ++windows_or_buffers_changed; + if (NILP (Fget (to, Qface_no_inherit))) + { + ++face_change_count; + ++windows_or_buffers_changed; + } return to; } @@ -3925,7 +4022,7 @@ FRAME 0 means change the face on all frames, and change the default CHECK_SYMBOL (face); CHECK_SYMBOL (attr); - face = resolve_face_name (face); + face = resolve_face_name (face, 1); /* If FRAME is 0, change face on all frames, and change the default for new frames. */ @@ -3940,7 +4037,18 @@ FRAME 0 means change the face on all frames, and change the default /* Set lface to the Lisp attribute vector of FACE. */ if (EQ (frame, Qt)) - lface = lface_from_face_name (NULL, face, 1); + { + lface = lface_from_face_name (NULL, face, 1); + + /* When updating face-new-frame-defaults, we put :ignore-defface + where the caller wants `unspecified'. This forces the frame + defaults to ignore the defface value. Otherwise, the defface + will take effect, which is generally not what is intended. + The value of that attribute will be inherited from some other + face during face merging. See internal_merge_in_global_face. */ + if (UNSPECIFIEDP (value)) + value = Qignore_defface; + } else { if (NILP (frame)) @@ -3956,7 +4064,7 @@ FRAME 0 means change the face on all frames, and change the default if (EQ (attr, QCfamily)) { - if (!UNSPECIFIEDP (value)) + if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value)) { CHECK_STRING (value); if (SCHARS (value) == 0) @@ -3968,7 +4076,7 @@ FRAME 0 means change the face on all frames, and change the default } else if (EQ (attr, QCheight)) { - if (!UNSPECIFIEDP (value)) + if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value)) { Lisp_Object test; @@ -3977,7 +4085,7 @@ FRAME 0 means change the face on all frames, and change the default /* The default face must have an absolute size, otherwise, we do a test merge with a random height to see if VALUE's ok. */ - : merge_face_heights (value, make_number (10), Qnil, Qnil)); + : merge_face_heights (value, make_number (10), Qnil)); if (!INTEGERP (test) || XINT (test) <= 0) signal_error ("Invalid face height", value); @@ -3989,7 +4097,7 @@ FRAME 0 means change the face on all frames, and change the default } else if (EQ (attr, QCweight)) { - if (!UNSPECIFIEDP (value)) + if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value)) { CHECK_SYMBOL (value); if (face_numeric_weight (value) < 0) @@ -4001,7 +4109,7 @@ FRAME 0 means change the face on all frames, and change the default } else if (EQ (attr, QCslant)) { - if (!UNSPECIFIEDP (value)) + if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value)) { CHECK_SYMBOL (value); if (face_numeric_slant (value) < 0) @@ -4013,7 +4121,7 @@ FRAME 0 means change the face on all frames, and change the default } else if (EQ (attr, QCunderline)) { - if (!UNSPECIFIEDP (value)) + if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value)) if ((SYMBOLP (value) && !EQ (value, Qt) && !EQ (value, Qnil)) @@ -4027,7 +4135,7 @@ FRAME 0 means change the face on all frames, and change the default } else if (EQ (attr, QCoverline)) { - if (!UNSPECIFIEDP (value)) + if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value)) if ((SYMBOLP (value) && !EQ (value, Qt) && !EQ (value, Qnil)) @@ -4041,7 +4149,7 @@ FRAME 0 means change the face on all frames, and change the default } else if (EQ (attr, QCstrike_through)) { - if (!UNSPECIFIEDP (value)) + if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value)) if ((SYMBOLP (value) && !EQ (value, Qt) && !EQ (value, Qnil)) @@ -4062,7 +4170,7 @@ FRAME 0 means change the face on all frames, and change the default if (EQ (value, Qt)) value = make_number (1); - if (UNSPECIFIEDP (value)) + if (UNSPECIFIEDP (value) || IGNORE_DEFFACE_P (value)) valid_p = 1; else if (NILP (value)) valid_p = 1; @@ -4093,7 +4201,7 @@ FRAME 0 means change the face on all frames, and change the default } else if (EQ (k, QCcolor)) { - if (!STRINGP (v) || SCHARS (v) == 0) + if (!NILP (v) && (!STRINGP (v) || SCHARS (v) == 0)) break; } else if (EQ (k, QCstyle)) @@ -4119,7 +4227,7 @@ FRAME 0 means change the face on all frames, and change the default else if (EQ (attr, QCinverse_video) || EQ (attr, QCreverse_video)) { - if (!UNSPECIFIEDP (value)) + if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value)) { CHECK_SYMBOL (value); if (!EQ (value, Qt) && !NILP (value)) @@ -4130,7 +4238,7 @@ FRAME 0 means change the face on all frames, and change the default } else if (EQ (attr, QCforeground)) { - if (!UNSPECIFIEDP (value)) + if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value)) { /* Don't check for valid color names here because it depends on the frame (display) whether the color will be valid @@ -4144,7 +4252,7 @@ FRAME 0 means change the face on all frames, and change the default } else if (EQ (attr, QCbackground)) { - if (!UNSPECIFIEDP (value)) + if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value)) { /* Don't check for valid color names here because it depends on the frame (display) whether the color will be valid @@ -4159,7 +4267,7 @@ FRAME 0 means change the face on all frames, and change the default else if (EQ (attr, QCstipple)) { #ifdef HAVE_X_WINDOWS - if (!UNSPECIFIEDP (value) + if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value) && !NILP (value) && NILP (Fbitmap_spec_p (value))) signal_error ("Invalid stipple attribute", value); @@ -4169,7 +4277,7 @@ FRAME 0 means change the face on all frames, and change the default } else if (EQ (attr, QCwidth)) { - if (!UNSPECIFIEDP (value)) + if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value)) { CHECK_SYMBOL (value); if (face_numeric_swidth (value) < 0) @@ -4194,7 +4302,7 @@ FRAME 0 means change the face on all frames, and change the default else f = check_x_frame (frame); - if (!UNSPECIFIEDP (value)) + if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value)) { CHECK_STRING (value); @@ -4242,7 +4350,7 @@ FRAME 0 means change the face on all frames, and change the default signal_error ("Invalid face attribute name", attr); if (font_related_attr_p - && !UNSPECIFIEDP (value)) + && !UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value)) /* If a font-related attribute other than QCfont is specified, the original `font' attribute nor that of default face is useless to determine a new font. Thus, we set it to nil so that font @@ -4255,6 +4363,7 @@ FRAME 0 means change the face on all frames, and change the default by incrementing face_change_count. The next call to init_iterator will then free realized faces. */ if (!EQ (frame, Qt) + && NILP (Fget (face, Qface_no_inherit)) && (EQ (attr, QCfont) || NILP (Fequal (old_value, value)))) { @@ -4262,7 +4371,7 @@ FRAME 0 means change the face on all frames, and change the default ++windows_or_buffers_changed; } - if (!UNSPECIFIEDP (value) + if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value) && NILP (Fequal (old_value, value))) { Lisp_Object param; @@ -4407,6 +4516,7 @@ update_face_from_frame_parameter (f, param, new_value) struct frame *f; Lisp_Object param, new_value; { + Lisp_Object face = Qnil; Lisp_Object lface; /* If there are no faces yet, give up. This is the case when called @@ -4415,17 +4525,10 @@ update_face_from_frame_parameter (f, param, new_value) if (NILP (f->face_alist)) return; - /* Changing a named face means that all realized faces depending on - that face are invalid. Since we cannot tell which realized faces - depend on the face, make sure they are all removed. This is done - by incrementing face_change_count. The next call to - init_iterator will then free realized faces. */ - ++face_change_count; - ++windows_or_buffers_changed; - if (EQ (param, Qforeground_color)) { - lface = lface_from_face_name (f, Qdefault, 1); + face = Qdefault; + lface = lface_from_face_name (f, face, 1); LFACE_FOREGROUND (lface) = (STRINGP (new_value) ? new_value : Qunspecified); realize_basic_faces (f); @@ -4435,34 +4538,50 @@ update_face_from_frame_parameter (f, param, new_value) Lisp_Object frame; /* Changing the background color might change the background - mode, so that we have to load new defface specs. Call - frame-update-face-colors to do that. */ + mode, so that we have to load new defface specs. + Call frame-set-background-mode to do that. */ XSETFRAME (frame, f); - call1 (Qframe_update_face_colors, frame); + call1 (Qframe_set_background_mode, frame); - lface = lface_from_face_name (f, Qdefault, 1); + face = Qdefault; + lface = lface_from_face_name (f, face, 1); LFACE_BACKGROUND (lface) = (STRINGP (new_value) ? new_value : Qunspecified); realize_basic_faces (f); } - if (EQ (param, Qborder_color)) + else if (EQ (param, Qborder_color)) { - lface = lface_from_face_name (f, Qborder, 1); + face = Qborder; + lface = lface_from_face_name (f, face, 1); LFACE_BACKGROUND (lface) = (STRINGP (new_value) ? new_value : Qunspecified); } else if (EQ (param, Qcursor_color)) { - lface = lface_from_face_name (f, Qcursor, 1); + face = Qcursor; + lface = lface_from_face_name (f, face, 1); LFACE_BACKGROUND (lface) = (STRINGP (new_value) ? new_value : Qunspecified); } else if (EQ (param, Qmouse_color)) { - lface = lface_from_face_name (f, Qmouse, 1); + face = Qmouse; + lface = lface_from_face_name (f, face, 1); LFACE_BACKGROUND (lface) = (STRINGP (new_value) ? new_value : Qunspecified); } + + /* Changing a named face means that all realized faces depending on + that face are invalid. Since we cannot tell which realized faces + depend on the face, make sure they are all removed. This is done + by incrementing face_change_count. The next call to + init_iterator will then free realized faces. */ + if (!NILP (face) + && NILP (Fget (face, Qface_no_inherit))) + { + ++face_change_count; + ++windows_or_buffers_changed; + } } @@ -4553,7 +4672,7 @@ DEFUN ("internal-set-lisp-face-attribute-from-resource", if (SYMBOLP (boolean_value)) value = boolean_value; } - else if (EQ (attr, QCbox)) + else if (EQ (attr, QCbox) || EQ (attr, QCinherit)) value = Fcar (Fread_from_string (value, Qnil, Qnil)); return Finternal_set_lisp_face_attribute (face, attr, value, frame); @@ -4626,16 +4745,32 @@ x_update_menu_appearance (f) { #ifdef USE_MOTIF const char *suffix = "List"; + Bool motif = True; +#else +#if defined HAVE_X_I18N + + const char *suffix = "Set"; #else const char *suffix = ""; +#endif + Bool motif = False; +#endif +#if defined HAVE_X_I18N + extern char *xic_create_fontsetname + P_ ((char *base_fontname, Bool motif)); + char *fontsetname = xic_create_fontsetname (face->font_name, motif); +#else + char *fontsetname = face->font_name; #endif sprintf (line, "%s.pane.menubar*font%s: %s", - myname, suffix, face->font_name); + myname, suffix, fontsetname); XrmPutLineResource (&rdb, line); sprintf (line, "%s.%s*font%s: %s", - myname, popup_path, suffix, face->font_name); + myname, popup_path, suffix, fontsetname); XrmPutLineResource (&rdb, line); changed_p = 1; + if (fontsetname != face->font_name) + xfree (fontsetname); } if (changed_p && f->output_data.x->menubar_widget) @@ -4649,11 +4784,18 @@ x_update_menu_appearance (f) DEFUN ("face-attribute-relative-p", Fface_attribute_relative_p, Sface_attribute_relative_p, 2, 2, 0, - doc: /* Return non-nil if face ATTRIBUTE VALUE is relative. */) + doc: /* Check whether a face attribute value is relative. +Specifically, this function returns t if the attribute ATTRIBUTE +with the value VALUE is relative. + +A relative value is one that doesn't entirely override whatever is +inherited from another face. For most possible attributes, +the only relative value that users see is `unspecified'. +However, for :height, floating point values are also relative. */) (attribute, value) Lisp_Object attribute, value; { - if (EQ (value, Qunspecified)) + if (EQ (value, Qunspecified) || (EQ (value, Qignore_defface))) return Qt; else if (EQ (attribute, QCheight)) return INTEGERP (value) ? Qnil : Qt; @@ -4669,10 +4811,10 @@ the result will be absolute, otherwise it will be relative. */) (attribute, value1, value2) Lisp_Object attribute, value1, value2; { - if (EQ (value1, Qunspecified)) + if (EQ (value1, Qunspecified) || EQ (value1, Qignore_defface)) return value2; else if (EQ (attribute, QCheight)) - return merge_face_heights (value1, value2, value1, Qnil); + return merge_face_heights (value1, value2, value1); else return value1; } @@ -4739,6 +4881,9 @@ frames). If FRAME is omitted or nil, use the selected frame. */) else signal_error ("Invalid face attribute name", keyword); + if (IGNORE_DEFFACE_P (value)) + return Qunspecified; + return value; } @@ -4821,7 +4966,12 @@ Default face attributes override any local face attributes. */) gvec = XVECTOR (global_lface)->contents; for (i = 1; i < LFACE_VECTOR_SIZE; ++i) if (! UNSPECIFIEDP (gvec[i])) - lvec[i] = gvec[i]; + { + if (IGNORE_DEFFACE_P (gvec[i])) + lvec[i] = Qunspecified; + else + lvec[i] = gvec[i]; + } return Qnil; } @@ -4860,7 +5010,7 @@ If FRAME is omitted or nil, use the selected frame. */) else { struct frame *f = frame_or_selected_frame (frame, 1); - int face_id = lookup_named_face (f, face, 0); + int face_id = lookup_named_face (f, face, 0, 1); struct face *face = FACE_FROM_ID (f, face_id); return face ? build_string (face->font_name) : Qnil; } @@ -4873,6 +5023,7 @@ If FRAME is omitted or nil, use the selected frame. */) static INLINE int face_attr_equal_p (v1, v2) + Lisp_Object v1, v2; { /* Type can differ, e.g. when one attribute is unspecified, i.e. nil, and the other is specified. */ @@ -4920,8 +5071,8 @@ lface_equal_p (v1, v2) DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p, Sinternal_lisp_face_equal_p, 2, 3, 0, doc: /* True if FACE1 and FACE2 are equal. -If the optional argument FRAME is given, report on face FACE in that frame. -If FRAME is t, report on the defaults for face FACE (for new frames). +If the optional argument FRAME is given, report on FACE1 and FACE2 in that frame. +If FRAME is t, report on the defaults for FACE1 and FACE2 (for new frames). If FRAME is omitted or nil, use the selected frame. */) (face1, face2, frame) Lisp_Object face1, face2, frame; @@ -4939,8 +5090,8 @@ If FRAME is omitted or nil, use the selected frame. */) Emacs. That frame is not an X frame. */ f = frame_or_selected_frame (frame, 2); - lface1 = lface_from_face_name (NULL, face1, 1); - lface2 = lface_from_face_name (NULL, face2, 1); + lface1 = lface_from_face_name (f, face1, 1); + lface2 = lface_from_face_name (f, face2, 1); equal_p = lface_equal_p (XVECTOR (lface1)->contents, XVECTOR (lface2)->contents); return equal_p ? Qt : Qnil; @@ -5551,10 +5702,11 @@ lookup_face (f, attr, c, base_face) isn't realized and cannot be realized. */ int -lookup_named_face (f, symbol, c) +lookup_named_face (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]; @@ -5565,11 +5717,16 @@ lookup_named_face (f, symbol, c) if (!realize_basic_faces (f)) return -1; default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID); + if (default_face == NULL) + abort (); /* realize_basic_faces must have set it up */ } - get_lface_attributes (f, symbol, symbol_attrs, 1); + if (!get_lface_attributes (f, symbol, symbol_attrs, signal_p)) + return -1; + bcopy (default_face->lface, attrs, sizeof attrs); - merge_face_vectors (f, symbol_attrs, attrs, Qnil); + merge_face_vectors (f, symbol_attrs, attrs, 0); + return lookup_face (f, attrs, c, NULL); } @@ -5587,7 +5744,7 @@ ascii_face_of_lisp_face (f, lface_id) if (lface_id >= 0 && lface_id < lface_id_to_name_size) { Lisp_Object face_name = lface_id_to_name[lface_id]; - face_id = lookup_named_face (f, face_name, 0); + face_id = lookup_named_face (f, face_name, 0, 1); } else face_id = -1; @@ -5693,11 +5850,12 @@ face_with_height (f, face_id, height) is assumed to be already realized. */ int -lookup_derived_face (f, symbol, c, face_id) +lookup_derived_face (f, symbol, c, face_id, signal_p) struct frame *f; Lisp_Object symbol; int c; int face_id; + int signal_p; { Lisp_Object attrs[LFACE_VECTOR_SIZE]; Lisp_Object symbol_attrs[LFACE_VECTOR_SIZE]; @@ -5706,9 +5864,9 @@ lookup_derived_face (f, symbol, c, face_id) if (!default_face) abort (); - get_lface_attributes (f, symbol, symbol_attrs, 1); + get_lface_attributes (f, symbol, symbol_attrs, signal_p); bcopy (default_face->lface, attrs, sizeof attrs); - merge_face_vectors (f, symbol_attrs, attrs, Qnil); + merge_face_vectors (f, symbol_attrs, attrs, 0); return lookup_face (f, attrs, c, default_face); } @@ -5721,9 +5879,8 @@ DEFUN ("face-attributes-as-vector", Fface_attributes_as_vector, Lisp_Object lface; lface = Fmake_vector (make_number (LFACE_VECTOR_SIZE), Qunspecified); - merge_face_vector_with_property (XFRAME (selected_frame), - XVECTOR (lface)->contents, - plist); + merge_face_ref (XFRAME (selected_frame), plist, XVECTOR (lface)->contents, + 1, 0); return lface; } @@ -5740,6 +5897,7 @@ DEFUN ("face-attributes-as-vector", Fface_attributes_as_vector, #define TTY_SAME_COLOR_THRESHOLD 10000 +#ifdef HAVE_WINDOW_SYSTEM /* Return non-zero if all the face attributes in ATTRS are supported on the window-system frame F. @@ -5749,26 +5907,15 @@ DEFUN ("face-attributes-as-vector", Fface_attributes_as_vector, default face for display, can be represented in a way that's \(1) different in appearance than the default face, and - \(2) `close in spirit' to what the attributes specify, if not exact. - - This function modifies ATTRS by merging from the default face. */ + \(2) `close in spirit' to what the attributes specify, if not exact. */ static int -x_supports_face_attributes_p (f, attrs) +x_supports_face_attributes_p (f, attrs, def_face) struct frame *f; Lisp_Object *attrs; + struct face *def_face; { - Lisp_Object *def_attrs; - struct face *def_face = FACE_FROM_ID (f, DEFAULT_FACE_ID); - - if (def_face == NULL) - { - if (! realize_basic_faces (f)) - signal_error ("Cannot realize default face", 0); - def_face = FACE_FROM_ID (f, DEFAULT_FACE_ID); - } - - def_attrs = def_face->lface; + Lisp_Object *def_attrs = def_face->lface; /* Check that other specified attributes are different that the default face. */ @@ -5812,12 +5959,12 @@ x_supports_face_attributes_p (f, attrs) bcopy (def_attrs, merged_attrs, sizeof merged_attrs); - merge_face_vectors (f, attrs, merged_attrs, Qnil); + merge_face_vectors (f, attrs, merged_attrs, 0); face = FACE_FROM_ID (f, lookup_face (f, merged_attrs, 0, 0)); if (! face) - signal_error ("cannot make face", 0); + error ("Cannot make face"); /* If the font is the same, then not supported. */ if (face->font == def_face->font) @@ -5828,6 +5975,7 @@ x_supports_face_attributes_p (f, attrs) return 1; } +#endif /* HAVE_WINDOW_SYSTEM */ /* Return non-zero if all the face attributes in ATTRS are supported on the tty frame F. @@ -5846,57 +5994,35 @@ x_supports_face_attributes_p (f, attrs) substitution of a `dim' face for italic. */ static int -tty_supports_face_attributes_p (f, attrs) +tty_supports_face_attributes_p (f, attrs, def_face) struct frame *f; Lisp_Object *attrs; + struct face *def_face; { - int weight, i; + int weight; Lisp_Object val, fg, bg; XColor fg_tty_color, fg_std_color; XColor bg_tty_color, bg_std_color; 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 nil if any are requested. */ - /* stipple */ - val = attrs[LFACE_STIPPLE_INDEX]; - if (!UNSPECIFIEDP (val) && !NILP (val)) - return 0; - - /* font height */ - val = attrs[LFACE_HEIGHT_INDEX]; - if (!UNSPECIFIEDP (val) && !NILP (val)) - return 0; - - /* font width */ - val = attrs[LFACE_SWIDTH_INDEX]; - if (!UNSPECIFIEDP (val) && !NILP (val) - && face_numeric_swidth (val) != XLFD_SWIDTH_MEDIUM) - return 0; - - /* overline */ - val = attrs[LFACE_OVERLINE_INDEX]; - if (!UNSPECIFIEDP (val) && !NILP (val)) - return 0; - - /* strike-through */ - val = attrs[LFACE_STRIKE_THROUGH_INDEX]; - if (!UNSPECIFIEDP (val) && !NILP (val)) - return 0; - - /* boxes */ - val = attrs[LFACE_BOX_INDEX]; - if (!UNSPECIFIEDP (val) && !NILP (val)) - return 0; - - /* slant (italics/oblique); We consider any non-default value - unsupportable on ttys, even though the face code actually `fakes' - them using a dim attribute if possible. This is because the faked - result is too different from what the face specifies. */ - val = attrs[LFACE_SLANT_INDEX]; - if (!UNSPECIFIEDP (val) && !NILP (val) - && face_numeric_slant (val) != XLFD_SLANT_ROMAN) + /* 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, + as that will be the same value that the default face uses). We + consider :slant unsupportable on ttys, even though the face code + actually `fakes' them using a dim attribute if possible. This is + because the faked result is too different from what the face + specifies. */ + if (!UNSPECIFIEDP (attrs[LFACE_FAMILY_INDEX]) + || !UNSPECIFIEDP (attrs[LFACE_STIPPLE_INDEX]) + || !UNSPECIFIEDP (attrs[LFACE_HEIGHT_INDEX]) + || !UNSPECIFIEDP (attrs[LFACE_SWIDTH_INDEX]) + || !UNSPECIFIEDP (attrs[LFACE_OVERLINE_INDEX]) + || !UNSPECIFIEDP (attrs[LFACE_STRIKE_THROUGH_INDEX]) + || !UNSPECIFIEDP (attrs[LFACE_BOX_INDEX]) + || !UNSPECIFIEDP (attrs[LFACE_SLANT_INDEX])) return 0; @@ -5906,26 +6032,45 @@ tty_supports_face_attributes_p (f, attrs) weight = face_numeric_weight (attrs[LFACE_WEIGHT_INDEX]); if (weight >= 0) { + int def_weight = face_numeric_weight (def_attrs[LFACE_WEIGHT_INDEX]); + if (weight > XLFD_WEIGHT_MEDIUM) - test_caps = TTY_CAP_BOLD; + { + if (def_weight > XLFD_WEIGHT_MEDIUM) + return 0; /* same as default */ + test_caps = TTY_CAP_BOLD; + } else if (weight < XLFD_WEIGHT_MEDIUM) - test_caps = TTY_CAP_DIM; + { + if (def_weight < XLFD_WEIGHT_MEDIUM) + return 0; /* same as default */ + test_caps = TTY_CAP_DIM; + } + else if (def_weight == XLFD_WEIGHT_MEDIUM) + return 0; /* same as default */ } /* underlining */ val = attrs[LFACE_UNDERLINE_INDEX]; - if (!UNSPECIFIEDP (val) && !NILP (val)) + if (!UNSPECIFIEDP (val)) { if (STRINGP (val)) - return 0; /* ttys don't support colored underlines */ + return 0; /* ttys can't use colored underlines */ + else if (face_attr_equal_p (val, def_attrs[LFACE_UNDERLINE_INDEX])) + return 0; /* same as default */ else test_caps |= TTY_CAP_UNDERLINE; } /* inverse video */ val = attrs[LFACE_INVERSE_INDEX]; - if (!UNSPECIFIEDP (val) && !NILP (val)) - test_caps |= TTY_CAP_INVERSE; + if (!UNSPECIFIEDP (val)) + { + if (face_attr_equal_p (val, def_attrs[LFACE_UNDERLINE_INDEX])) + return 0; /* same as default */ + else + test_caps |= TTY_CAP_INVERSE; + } /* Color testing. */ @@ -5940,22 +6085,48 @@ tty_supports_face_attributes_p (f, attrs) fg = attrs[LFACE_FOREGROUND_INDEX]; if (STRINGP (fg)) { - if (! tty_lookup_color (f, fg, &fg_tty_color, &fg_std_color)) - return 0; + Lisp_Object def_fg = def_attrs[LFACE_FOREGROUND_INDEX]; + + if (face_attr_equal_p (fg, def_fg)) + return 0; /* same as default */ + else if (! tty_lookup_color (f, fg, &fg_tty_color, &fg_std_color)) + return 0; /* not a valid color */ else if (color_distance (&fg_tty_color, &fg_std_color) > TTY_SAME_COLOR_THRESHOLD) - return 0; + return 0; /* displayed color is too different */ + else + /* Make sure the color is really different than the default. */ + { + XColor def_fg_color; + if (tty_lookup_color (f, def_fg, &def_fg_color, 0) + && (color_distance (&fg_tty_color, &def_fg_color) + <= TTY_SAME_COLOR_THRESHOLD)) + return 0; + } } /* Check if background color is close enough. */ bg = attrs[LFACE_BACKGROUND_INDEX]; if (STRINGP (bg)) { - if (! tty_lookup_color (f, bg, &bg_tty_color, &bg_std_color)) - return 0; + Lisp_Object def_bg = def_attrs[LFACE_FOREGROUND_INDEX]; + + if (face_attr_equal_p (bg, def_bg)) + return 0; /* same as default */ + else if (! tty_lookup_color (f, bg, &bg_tty_color, &bg_std_color)) + return 0; /* not a valid color */ else if (color_distance (&bg_tty_color, &bg_std_color) > TTY_SAME_COLOR_THRESHOLD) - return 0; + return 0; /* displayed color is too different */ + else + /* Make sure the color is really different than the default. */ + { + XColor def_bg_color; + if (tty_lookup_color (f, def_bg, &def_bg_color, 0) + && (color_distance (&bg_tty_color, &def_bg_color) + <= TTY_SAME_COLOR_THRESHOLD)) + return 0; + } } /* If both foreground and background are requested, see if the @@ -5990,7 +6161,7 @@ DEFUN ("display-supports-face-attributes-p", 1, 2, 0, doc: /* Return non-nil if all the face attributes in ATTRIBUTES are supported. The optional argument DISPLAY can be a display name, a frame, or -nil (meaning the selected frame's display) +nil (meaning the selected frame's display). The definition of `supported' is somewhat heuristic, but basically means that a face containing all the attributes in ATTRIBUTES, when merged @@ -6003,15 +6174,22 @@ Point (2) implies that a `:weight black' attribute will be satisfied by any display that can display bold, and a `:foreground \"yellow\"' as long as it can display a yellowish color, but `:slant italic' will _not_ be satisfied by the tty display code's automatic substitution of a `dim' -face for italic. */) +face for italic. */) (attributes, display) Lisp_Object attributes, display; { int supports, i; Lisp_Object frame; struct frame *f; + struct face *def_face; Lisp_Object attrs[LFACE_VECTOR_SIZE]; + if (noninteractive || !initialized) + /* We may not be able to access low-level face information in batch + mode, or before being dumped, and this function is not going to + be very useful in those cases anyway, so just give up. */ + return Qnil; + if (NILP (display)) frame = selected_frame; else if (FRAMEP (display)) @@ -6037,13 +6215,25 @@ face for italic. */) for (i = 0; i < LFACE_VECTOR_SIZE; i++) attrs[i] = Qunspecified; - merge_face_vector_with_property (f, attrs, attributes); + merge_face_ref (f, attributes, attrs, 1, 0); + + def_face = FACE_FROM_ID (f, DEFAULT_FACE_ID); + if (def_face == NULL) + { + if (! realize_basic_faces (f)) + error ("Cannot realize default face"); + def_face = FACE_FROM_ID (f, DEFAULT_FACE_ID); + if (def_face == NULL) + abort (); /* realize_basic_faces must have set it up */ + } /* Dispatch to the appropriate handler. */ if (FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f)) - supports = tty_supports_face_attributes_p (f, attrs); + supports = tty_supports_face_attributes_p (f, attrs, def_face); +#ifdef HAVE_WINDOW_SYSTEM else - supports = x_supports_face_attributes_p (f, attrs); + supports = x_supports_face_attributes_p (f, attrs, def_face); +#endif return supports ? Qt : Qnil; } @@ -6189,6 +6379,12 @@ better_font_p (values, font1, font2, compare_pt_p, avgwidth) { int i; + /* Any font is better than no font. */ + if (! font1) + return 0; + if (! font2) + return 1; + for (i = 0; i < DIM (font_sort_order); ++i) { int xlfd_idx = font_sort_order[i]; @@ -6299,12 +6495,12 @@ build_scalable_font_name (f, font, specified_pt) if (font->numeric[XLFD_RESY] != 0) { pt = resy / font->numeric[XLFD_RESY] * specified_pt + 0.5; - pixel_value = font->numeric[XLFD_RESY] / (PT_PER_INCH * 10.0) * pt; + pixel_value = font->numeric[XLFD_RESY] / (PT_PER_INCH * 10.0) * pt + 0.5; } else { pt = specified_pt; - pixel_value = resy / (PT_PER_INCH * 10.0) * pt; + pixel_value = resy / (PT_PER_INCH * 10.0) * pt + 0.5; } /* We may need a font of the different size. */ pixel_value *= font->rescale_ratio; @@ -6433,29 +6629,19 @@ best_matching_font (f, attrs, fonts, nfonts, width_ratio, needs_overstrike) if (needs_overstrike) *needs_overstrike = 0; - /* Start with the first non-scalable font in the list. */ - for (i = 0; i < nfonts; ++i) - if (!font_scalable_p (fonts + i)) - break; + best = NULL; /* Find the best match among the non-scalable fonts. */ - if (i < nfonts) - { - best = fonts + i; - - for (i = 1; i < nfonts; ++i) - if (!font_scalable_p (fonts + i) - && better_font_p (specified, fonts + i, best, 1, avgwidth)) - { - best = fonts + i; + for (i = 0; i < nfonts; ++i) + if (!font_scalable_p (fonts + i) + && better_font_p (specified, fonts + i, best, 1, avgwidth)) + { + best = fonts + i; - exact_p = exact_face_match_p (specified, best, avgwidth); - if (exact_p) - break; - } - } - else - best = NULL; + exact_p = exact_face_match_p (specified, best, avgwidth); + if (exact_p) + break; + } /* Unless we found an exact match among non-scalable fonts, see if we can find a better match among scalable fonts. */ @@ -6479,8 +6665,7 @@ best_matching_font (f, attrs, fonts, nfonts, width_ratio, needs_overstrike) for (i = 0; i < nfonts; ++i) if (font_scalable_p (fonts + i)) { - if (best == NULL - || better_font_p (specified, fonts + i, best, 0, 0) + if (better_font_p (specified, fonts + i, best, 0, 0) || (!non_scalable_has_exact_height_p && !better_font_p (specified, best, fonts + i, 0, 0))) { @@ -6488,23 +6673,27 @@ best_matching_font (f, attrs, fonts, nfonts, width_ratio, needs_overstrike) best = fonts + i; } } + } - if (needs_overstrike) - { - enum xlfd_weight want_weight = specified[XLFD_WEIGHT]; - enum xlfd_weight got_weight = best->numeric[XLFD_WEIGHT]; + /* We should have found SOME font. */ + if (best == NULL) + abort (); - if (want_weight > XLFD_WEIGHT_MEDIUM && want_weight > got_weight) - { - /* We want a bold font, but didn't get one; try to use - overstriking instead to simulate bold-face. However, - don't overstrike an already-bold fontn unless the - desired weight grossly exceeds the available weight. */ - if (got_weight > XLFD_WEIGHT_MEDIUM) - *needs_overstrike = (got_weight - want_weight) > 2; - else - *needs_overstrike = 1; - } + if (! exact_p && needs_overstrike) + { + enum xlfd_weight want_weight = specified[XLFD_WEIGHT]; + enum xlfd_weight got_weight = best->numeric[XLFD_WEIGHT]; + + if (want_weight > XLFD_WEIGHT_MEDIUM && want_weight > got_weight) + { + /* We want a bold font, but didn't get one; try to use + overstriking instead to simulate bold-face. However, + don't overstrike an already-bold font unless the + desired weight grossly exceeds the available weight. */ + if (got_weight > XLFD_WEIGHT_MEDIUM) + *needs_overstrike = (want_weight - got_weight) > 2; + else + *needs_overstrike = 1; } } @@ -6604,14 +6793,23 @@ try_font_list (f, attrs, family, registry, fonts, prefer_face_family) nfonts = try_alternative_families (f, try_family, registry, fonts); #ifdef MAC_OS - /* When realizing the default face and a font spec does not matched - exactly, Emacs looks for ones with the same registry as the - default font. On the Mac, this is mac-roman, which does not work - if the family is -etl-fixed, e.g. The following widens the - choices and fixes that problem. */ - if (nfonts == 0 && STRINGP (try_family) && STRINGP (registry) - && xstricmp (SDATA (registry), "mac-roman") == 0) - nfonts = try_alternative_families (f, try_family, Qnil, fonts); + if (nfonts == 0 && STRINGP (try_family) && STRINGP (registry)) + { + if (xstricmp (SDATA (registry), "mac-roman") == 0) + /* When realizing the default face and a font spec does not + matched exactly, Emacs looks for ones with the same registry + as the default font. On the Mac, this is mac-roman, which + does not work if the family is -etl-fixed, e.g. The + following widens the choices and fixes that problem. */ + nfonts = try_alternative_families (f, try_family, Qnil, fonts); + else if (SBYTES (try_family) > 0 + && SREF (try_family, SBYTES (try_family) - 1) != '*') + /* Some Central European/Cyrillic font family names have the + Roman counterpart name as their prefix. */ + nfonts = try_alternative_families (f, concat2 (try_family, + build_string ("*")), + registry, fonts); + } #endif if (EQ (try_family, family)) @@ -6746,6 +6944,7 @@ realize_basic_faces (f) realize_named_face (f, Qcursor, CURSOR_FACE_ID); realize_named_face (f, Qmouse, MOUSE_FACE_ID); realize_named_face (f, Qmenu, MENU_FACE_ID); + realize_named_face (f, Qvertical_border, VERTICAL_BORDER_FACE_ID); /* Reflect changes in the `menu' face in menu bars. */ if (FRAME_FACE_CACHE (f)->menu_face_changed_p) @@ -6868,6 +7067,16 @@ realize_default_face (f) check_lface (lface); bcopy (XVECTOR (lface)->contents, attrs, sizeof attrs); face = realize_face (c, attrs, 0, NULL, DEFAULT_FACE_ID); + +#ifdef HAVE_WINDOW_SYSTEM +#ifdef HAVE_X_WINDOWS + if (face->font != FRAME_FONT (f)) + /* As the font specified for the frame was not acceptable as a + font for the default face (perhaps because auto-scaled fonts + are rejected), we must adjust the frame font. */ + x_set_font (f, build_string (face->font_name), Qnil); +#endif /* HAVE_X_WINDOWS */ +#endif /* HAVE_WINDOW_SYSTEM */ return 1; } @@ -6903,7 +7112,7 @@ realize_named_face (f, symbol, id) /* Merge SYMBOL's face with the default face. */ get_lface_attributes (f, symbol, symbol_attrs, 1); - merge_face_vectors (f, symbol_attrs, attrs, Qnil); + merge_face_vectors (f, symbol_attrs, attrs, 0); /* Realize the face. */ new_face = realize_face (c, attrs, 0, NULL, id); @@ -6972,8 +7181,9 @@ realize_x_face (cache, attrs, c, base_face) int c; struct face *base_face; { + struct face *face = NULL; #ifdef HAVE_WINDOW_SYSTEM - struct face *face, *default_face; + struct face *default_face; struct frame *f; Lisp_Object stipple, overline, strike_through, box; @@ -7169,8 +7379,8 @@ realize_x_face (cache, attrs, c, base_face) face->stipple = load_pixmap (f, stipple, &face->pixmap_w, &face->pixmap_h); xassert (FACE_SUITABLE_FOR_CHAR_P (face, c)); - return face; #endif /* HAVE_WINDOW_SYSTEM */ + return face; } @@ -7368,7 +7578,7 @@ compute_char_face (f, ch, prop) Lisp_Object attrs[LFACE_VECTOR_SIZE]; struct face *default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID); bcopy (default_face->lface, attrs, sizeof attrs); - merge_face_vector_with_property (f, attrs, prop); + merge_face_ref (f, prop, attrs, 1, 0); face_id = lookup_face (f, attrs, ch, NULL); } @@ -7454,7 +7664,7 @@ face_at_buffer_position (w, pos, region_beg, region_end, /* Merge in attributes specified via text properties. */ if (!NILP (prop)) - merge_face_vector_with_property (f, attrs, prop); + merge_face_ref (f, prop, attrs, 1, 0); /* Now merge the overlay data. */ noverlays = sort_overlays (overlay_vec, noverlays, w); @@ -7465,7 +7675,7 @@ face_at_buffer_position (w, pos, region_beg, region_end, prop = Foverlay_get (overlay_vec[i], propname); if (!NILP (prop)) - merge_face_vector_with_property (f, attrs, prop); + merge_face_ref (f, prop, attrs, 1, 0); oend = OVERLAY_END (overlay_vec[i]); oendpos = OVERLAY_POSITION (oend); @@ -7476,8 +7686,7 @@ face_at_buffer_position (w, pos, region_beg, region_end, /* 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, 0); if (region_end < endpos) endpos = region_end; @@ -7573,15 +7782,76 @@ face_at_string_position (w, string, pos, bufpos, region_beg, /* Merge in attributes specified via text properties. */ if (!NILP (prop)) - merge_face_vector_with_property (f, attrs, prop); + merge_face_ref (f, prop, attrs, 1, 0); /* If in the region, merge in the region face. */ if (bufpos && bufpos >= region_beg && bufpos < region_end) + merge_named_face (f, Qregion, attrs, 0); + + /* Look up a realized face with the given face attributes, + or realize a new one for ASCII characters. */ + return lookup_face (f, attrs, 0, NULL); +} + + +/* Merge a face into a realized face. + + F is frame where faces are (to be) realized. + + FACE_NAME is named face to merge. + + If FACE_NAME is nil, FACE_ID is face_id of realized face to merge. + + If FACE_NAME is t, FACE_ID is lface_id of face to merge. + + BASE_FACE_ID is realized face to merge into. + + Return new face id. +*/ + +int +merge_faces (f, face_name, face_id, base_face_id) + struct frame *f; + Lisp_Object face_name; + int face_id, base_face_id; +{ + Lisp_Object attrs[LFACE_VECTOR_SIZE]; + struct face *base_face; + + base_face = FACE_FROM_ID (f, base_face_id); + if (!base_face) + return base_face_id; + + if (EQ (face_name, Qt)) + { + if (face_id < 0 || face_id >= lface_id_to_name_size) + return base_face_id; + face_name = lface_id_to_name[face_id]; + face_id = lookup_derived_face (f, face_name, 0, base_face_id, 1); + if (face_id >= 0) + return face_id; + return base_face_id; + } + + /* Begin with attributes from the base face. */ + bcopy (base_face->lface, attrs, sizeof attrs); + + if (!NILP (face_name)) + { + if (!merge_named_face (f, face_name, attrs, 0)) + return base_face_id; + } + else { - Lisp_Object region_face = lface_from_face_name (f, Qregion, 0); - merge_face_vectors (f, XVECTOR (region_face)->contents, attrs, Qnil); + struct face *face; + if (face_id < 0) + return base_face_id; + face = FACE_FROM_ID (f, face_id); + if (!face) + return base_face_id; + merge_face_vectors (f, face->lface, attrs, 0); } /* Look up a realized face with the given face attributes, @@ -7589,7 +7859,6 @@ face_at_string_position (w, string, pos, bufpos, region_beg, return lookup_face (f, attrs, 0, NULL); } - /*********************************************************************** Tests @@ -7605,7 +7874,7 @@ dump_realized_face (face) { fprintf (stderr, "ID: %d\n", face->id); #ifdef HAVE_X_WINDOWS - fprintf (stderr, "gc: %d\n", (int) face->gc); + fprintf (stderr, "gc: %ld\n", (long) face->gc); #endif fprintf (stderr, "foreground: 0x%lx (%s)\n", face->foreground, @@ -7686,10 +7955,12 @@ syms_of_xfaces () { Qface = intern ("face"); staticpro (&Qface); + Qface_no_inherit = intern ("face-no-inherit"); + staticpro (&Qface_no_inherit); Qbitmap_spec_p = intern ("bitmap-spec-p"); staticpro (&Qbitmap_spec_p); - Qframe_update_face_colors = intern ("frame-update-face-colors"); - staticpro (&Qframe_update_face_colors); + Qframe_set_background_mode = intern ("frame-set-background-mode"); + staticpro (&Qframe_set_background_mode); /* Lisp face attribute keywords. */ QCfamily = intern (":family"); @@ -7788,6 +8059,8 @@ syms_of_xfaces () staticpro (&Qforeground_color); Qunspecified = intern ("unspecified"); staticpro (&Qunspecified); + Qignore_defface = intern (":ignore-defface"); + staticpro (&Qignore_defface); Qface_alias = intern ("face-alias"); staticpro (&Qface_alias); @@ -7813,6 +8086,8 @@ syms_of_xfaces () staticpro (&Qmouse); Qmode_line_inactive = intern ("mode-line-inactive"); staticpro (&Qmode_line_inactive); + Qvertical_border = intern ("vertical-border"); + staticpro (&Qvertical_border); Qtty_color_desc = intern ("tty-color-desc"); staticpro (&Qtty_color_desc); Qtty_color_standard_values = intern ("tty-color-standard-values");