X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/f0d6207551d0776e05d975031d000b81530bd921..8acf0c0e204877d3c24fcbea6b9e2f84af23678a:/src/xfaces.c diff --git a/src/xfaces.c b/src/xfaces.c index b717570b38..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 - 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 . */ @@ -192,6 +192,7 @@ Boston, MA 02111-1307, USA. */ used to fill in unspecified attributes of the default face. */ #include +#include #include #include @@ -261,7 +262,6 @@ Boston, MA 02111-1307, USA. */ #endif /* HAVE_X_WINDOWS */ -#include #include #define abs(X) ((X) < 0 ? -(X) : (X)) @@ -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; @@ -1505,15 +1516,19 @@ face_color_supported_p (f, color_name, background_p) XColor not_used; XSETFRAME (frame, f); - return (FRAME_WINDOW_P (f) - ? (!NILP (Fxw_display_color_p (frame)) - || xstricmp (color_name, "black") == 0 - || xstricmp (color_name, "white") == 0 - || (background_p - && face_color_gray_p (f, color_name)) - || (!NILP (Fx_display_grayscale_p (frame)) - && face_color_gray_p (f, color_name))) - : tty_defined_color (f, color_name, ¬_used, 0)); + return +#ifdef HAVE_WINDOW_SYSTEM + FRAME_WINDOW_P (f) + ? (!NILP (Fxw_display_color_p (frame)) + || xstricmp (color_name, "black") == 0 + || xstricmp (color_name, "white") == 0 + || (background_p + && face_color_gray_p (f, color_name)) + || (!NILP (Fx_display_grayscale_p (frame)) + && face_color_gray_p (f, color_name))) + : +#endif + tty_defined_color (f, color_name, ¬_used, 0); } @@ -1526,8 +1541,11 @@ If FRAME is nil or omitted, use the selected frame. */) { struct frame *f; - CHECK_FRAME (frame); CHECK_STRING (color); + if (NILP (frame)) + frame = selected_frame; + else + CHECK_FRAME (frame); f = XFRAME (frame); return face_color_gray_p (f, SDATA (color)) ? Qt : Qnil; } @@ -1537,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) @@ -1544,8 +1563,11 @@ COLOR must be a valid color name. */) { struct frame *f; - CHECK_FRAME (frame); CHECK_STRING (color); + if (NILP (frame)) + frame = selected_frame; + else + CHECK_FRAME (frame); f = XFRAME (frame); if (face_color_supported_p (f, SDATA (color), !NILP (background_p))) return Qt; @@ -2252,7 +2274,7 @@ static double font_rescale_ratio (name) char *name; { - Lisp_Object tail, elt; + Lisp_Object tail, elt; for (tail = Vface_font_rescale_alist; CONSP (tail); tail = XCDR (tail)) { @@ -2465,7 +2487,7 @@ x_face_list_fonts (f, pattern, pfonts, nfonts, try_alternatives_p) if (nfonts < 0 && CONSP (lfonts)) num_fonts = XFASTINT (Flength (lfonts)); - + /* Make a copy of the font names we got from X, and split them into fields. */ n = nignored = 0; @@ -2556,6 +2578,69 @@ x_face_list_fonts (f, pattern, pfonts, nfonts, try_alternatives_p) } +/* Check if a font matching pattern_offset_t on frame F is available + or not. PATTERN may be a cons (FAMILY . REGISTRY), in which case, + a font name pattern is generated from FAMILY and REGISTRY. */ + +int +face_font_available_p (f, pattern) + struct frame *f; + Lisp_Object pattern; +{ + Lisp_Object fonts; + + if (! STRINGP (pattern)) + { + Lisp_Object family, registry; + char *family_str, *registry_str, *pattern_str; + + CHECK_CONS (pattern); + family = XCAR (pattern); + if (NILP (family)) + family_str = "*"; + else + { + CHECK_STRING (family); + family_str = (char *) SDATA (family); + } + registry = XCDR (pattern); + if (NILP (registry)) + registry_str = "*"; + else + { + CHECK_STRING (registry); + registry_str = (char *) SDATA (registry); + } + + pattern_str = (char *) alloca (strlen (family_str) + + strlen (registry_str) + + 10); + strcpy (pattern_str, index (family_str, '-') ? "-" : "-*-"); + strcat (pattern_str, family_str); + strcat (pattern_str, "-*-"); + strcat (pattern_str, registry_str); + if (!index (registry_str, '-')) + { + if (registry_str[strlen (registry_str) - 1] == '*') + strcat (pattern_str, "-*"); + else + strcat (pattern_str, "*-*"); + } + pattern = build_string (pattern_str); + } + + /* Get the list of fonts matching PATTERN. */ +#ifdef WINDOWSNT + BLOCK_INPUT; + fonts = w32_list_fonts (f, pattern, 0, 1); + UNBLOCK_INPUT; +#else + fonts = x_list_fonts (f, pattern, -1, 1); +#endif + return XINT (Flength (fonts)); +} + + /* Determine fonts matching PATTERN on frame F. Sort resulting fonts using comparison function CMPFN. Value is the number of fonts found. If value is non-zero, *FONTS is set to a vector of @@ -2931,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)); @@ -3009,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 @@ -3078,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; @@ -3121,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); @@ -3180,7 +3346,13 @@ 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. */ + && i != LFACE_STIPPLE_INDEX +#endif + ) break; return i == LFACE_VECTOR_SIZE; @@ -3305,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; @@ -3322,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. */ @@ -3329,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; @@ -3353,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; @@ -3371,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 @@ -3390,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]; } @@ -3400,87 +3570,50 @@ merge_face_vectors (f, from, to, cycle_check) to[LFACE_INHERIT_INDEX] = Qnil; } +/* 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. */ -/* Checks the `cycle check' variable CHECK to see if it indicates that - EL is part of a cycle; CHECK must be either Qnil or a value returned - by an earlier use of CYCLE_CHECK. SUSPICIOUS is the number of - elements after which a cycle might be suspected; after that many - elements, this macro begins consing in order to keep more precise - track of elements. - - Returns nil if a cycle was detected, otherwise a new value for CHECK - that includes EL. - - CHECK is evaluated multiple times, EL and SUSPICIOUS 0 or 1 times, so - the caller should make sure that's ok. */ - -#define CYCLE_CHECK(check, el, suspicious) \ - (NILP (check) \ - ? make_number (0) \ - : (INTEGERP (check) \ - ? (XFASTINT (check) < (suspicious) \ - ? make_number (XFASTINT (check) + 1) \ - : Fcons (el, Qnil)) \ - : (!NILP (Fmemq ((el), (check))) \ - ? Qnil \ - : Fcons ((el), (check))))) - - -/* 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'. */ - -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; - - /* 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; + struct named_merge_point named_merge_point; - 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. @@ -3495,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)) @@ -3521,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)) { @@ -3556,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)) { @@ -3564,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)) { @@ -3573,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)) { @@ -3582,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)) { @@ -3591,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)) { @@ -3603,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)) @@ -3611,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)) { @@ -3634,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)) @@ -3643,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; } @@ -3769,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); @@ -3781,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) @@ -3804,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 it 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; { @@ -3817,8 +3964,6 @@ Value is TO. */) CHECK_SYMBOL (from); CHECK_SYMBOL (to); - if (NILP (new_frame)) - new_frame = frame; if (EQ (frame, Qt)) { @@ -3830,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); @@ -3844,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; } @@ -3872,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. */ @@ -3887,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)) @@ -3903,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) @@ -3915,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; @@ -3924,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); @@ -3936,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) @@ -3948,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) @@ -3960,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)) @@ -3974,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)) @@ -3988,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)) @@ -4009,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; @@ -4040,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)) @@ -4066,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)) @@ -4077,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 @@ -4091,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 @@ -4106,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); @@ -4116,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) @@ -4141,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); @@ -4189,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 @@ -4202,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)))) { @@ -4209,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; @@ -4340,6 +4502,7 @@ set_font_frame_param (frame, lface) xfree (font); } + f->default_face_done_p = 0; Fmodify_frame_parameters (frame, Fcons (Fcons (Qfont, font_name), Qnil)); } } @@ -4353,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 @@ -4361,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); @@ -4381,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; + } } @@ -4422,8 +4595,6 @@ DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource, Lisp_Object resource, class, frame; { Lisp_Object value = Qnil; -#ifndef WINDOWSNT -#ifndef MAC_OS CHECK_STRING (resource); CHECK_STRING (class); CHECK_LIVE_FRAME (frame); @@ -4431,8 +4602,6 @@ DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource, value = display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame)), resource, class, Qnil, Qnil); UNBLOCK_INPUT; -#endif /* not MAC_OS */ -#endif /* not WINDOWSNT */ return value; } @@ -4503,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); @@ -4576,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) @@ -4599,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; @@ -4619,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; } @@ -4634,8 +4826,8 @@ DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute, doc: /* Return face attribute KEYWORD of face SYMBOL. If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid face attribute name, signal an error. -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 +If the optional argument FRAME is given, report on face SYMBOL in that +frame. If FRAME is t, report on the defaults for face SYMBOL (for new frames). If FRAME is omitted or nil, use the selected frame. */) (symbol, keyword, frame) Lisp_Object symbol, keyword, frame; @@ -4689,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; } @@ -4771,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; } @@ -4810,13 +5010,47 @@ 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; } } +/* Compare face-attribute values v1 and v2 for equality. Value is non-zero if + all attributes are `equal'. Tries to be fast because this function + is called quite often. */ + +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. */ + if (XTYPE (v1) != XTYPE (v2)) + return 0; + + if (EQ (v1, v2)) + return 1; + + switch (XTYPE (v1)) + { + case Lisp_String: + if (SBYTES (v1) != SBYTES (v2)) + return 0; + + return bcmp (SDATA (v1), SDATA (v2), SBYTES (v1)) == 0; + + case Lisp_Int: + case Lisp_Symbol: + return 0; + + default: + return !NILP (Fequal (v1, v2)); + } +} + + /* Compare face vectors V1 and V2 for equality. Value is non-zero if all attributes are `equal'. Tries to be fast because this function is called quite often. */ @@ -4828,38 +5062,7 @@ lface_equal_p (v1, v2) int i, equal_p = 1; for (i = 1; i < LFACE_VECTOR_SIZE && equal_p; ++i) - { - Lisp_Object a = v1[i]; - Lisp_Object b = v2[i]; - - /* Type can differ, e.g. when one attribute is unspecified, i.e. nil, - and the other is specified. */ - equal_p = XTYPE (a) == XTYPE (b); - if (!equal_p) - break; - - if (!EQ (a, b)) - { - switch (XTYPE (a)) - { - case Lisp_String: - equal_p = ((SBYTES (a) - == SBYTES (b)) - && bcmp (SDATA (a), SDATA (b), - SBYTES (a)) == 0); - break; - - case Lisp_Int: - case Lisp_Symbol: - equal_p = 0; - break; - - default: - equal_p = !NILP (Fequal (a, b)); - break; - } - } - } + equal_p = face_attr_equal_p (v1[i], v2[i]); return equal_p; } @@ -4868,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; @@ -4887,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; @@ -5159,220 +5362,34 @@ If FRAME is unspecified or nil, the current frame is used. */) /*********************************************************************** - Face capability testing for ttys + Face Cache ***********************************************************************/ +/* Return a new face cache for frame F. */ -/* If the distance (as returned by color_distance) between two colors is - less than this, then they are considered the same, for determining - whether a color is supported or not. The range of values is 0-65535. */ - -#define TTY_SAME_COLOR_THRESHOLD 10000 - +static struct face_cache * +make_face_cache (f) + struct frame *f; +{ + struct face_cache *c; + int size; -DEFUN ("tty-supports-face-attributes-p", - Ftty_supports_face_attributes_p, Stty_supports_face_attributes_p, - 1, 2, 0, - doc: /* Return non-nil if all the face attributes in ATTRIBUTES are supported. -The optional argument FRAME is the frame on which to test; if it is nil -or unspecified, then the current frame is used. If FRAME is not a tty -frame, then nil is returned. + c = (struct face_cache *) xmalloc (sizeof *c); + bzero (c, sizeof *c); + size = FACE_CACHE_BUCKETS_SIZE * sizeof *c->buckets; + c->buckets = (struct face **) xmalloc (size); + bzero (c->buckets, size); + c->size = 50; + c->faces_by_id = (struct face **) xmalloc (c->size * sizeof *c->faces_by_id); + c->f = f; + c->menu_face_changed_p = menu_face_changed_default; + return c; +} -The definition of `supported' is somewhat heuristic, but basically means -that a face containing all the attributes in ATTRIBUTES, when merged -with the 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. - -Point (2) implies that a `:weight black' attribute will be satisified -by any terminal that can display bold, and a `:foreground "yellow"' as -long as the terminal can display a yellowish color, but `:slant italic' -will _not_ be satisified by the tty display code's automatic -substitution of a `dim' face for italic. */) - (attributes, frame) - Lisp_Object attributes, frame; -{ - int weight, i; - struct frame *f; - Lisp_Object val, fg, bg; - XColor fg_tty_color, fg_std_color; - XColor bg_tty_color, bg_std_color; - Lisp_Object attrs[LFACE_VECTOR_SIZE]; - unsigned test_caps = 0; - - if (NILP (frame)) - frame = selected_frame; - CHECK_LIVE_FRAME (frame); - f = XFRAME (frame); - - for (i = 0; i < LFACE_VECTOR_SIZE; i++) - attrs[i] = Qunspecified; - merge_face_vector_with_property (f, attrs, attributes); - - /* This function only works on ttys. */ - if (!FRAME_TERMCAP_P (f) && !FRAME_MSDOS_P (f)) - return Qnil; - - /* 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 Qnil; - - /* font height */ - val = attrs[LFACE_HEIGHT_INDEX]; - if (!UNSPECIFIEDP (val) && !NILP (val)) - return Qnil; - - /* font width */ - val = attrs[LFACE_SWIDTH_INDEX]; - if (!UNSPECIFIEDP (val) && !NILP (val) - && face_numeric_swidth (val) != XLFD_SWIDTH_MEDIUM) - return Qnil; - - /* overline */ - val = attrs[LFACE_OVERLINE_INDEX]; - if (!UNSPECIFIEDP (val) && !NILP (val)) - return Qnil; - - /* strike-through */ - val = attrs[LFACE_STRIKE_THROUGH_INDEX]; - if (!UNSPECIFIEDP (val) && !NILP (val)) - return Qnil; - - /* boxes */ - val = attrs[LFACE_BOX_INDEX]; - if (!UNSPECIFIEDP (val) && !NILP (val)) - return Qnil; - - /* 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) - return Qnil; - - - /* Test for terminal `capabilities' (non-color character attributes). */ - - /* font weight (bold/dim) */ - weight = face_numeric_weight (attrs[LFACE_WEIGHT_INDEX]); - if (weight >= 0) - { - if (weight > XLFD_WEIGHT_MEDIUM) - test_caps = TTY_CAP_BOLD; - else if (weight < XLFD_WEIGHT_MEDIUM) - test_caps = TTY_CAP_DIM; - } - - /* underlining */ - val = attrs[LFACE_UNDERLINE_INDEX]; - if (!UNSPECIFIEDP (val) && !NILP (val)) - { - if (STRINGP (val)) - return Qnil; /* ttys don't support colored underlines */ - else - test_caps |= TTY_CAP_UNDERLINE; - } - - /* inverse video */ - val = attrs[LFACE_INVERSE_INDEX]; - if (!UNSPECIFIEDP (val) && !NILP (val)) - test_caps |= TTY_CAP_INVERSE; - - - /* Color testing. */ - - /* Default the color indices in FG_TTY_COLOR and BG_TTY_COLOR, since - we use them when calling `tty_capable_p' below, even if the face - specifies no colors. */ - fg_tty_color.pixel = FACE_TTY_DEFAULT_FG_COLOR; - bg_tty_color.pixel = FACE_TTY_DEFAULT_BG_COLOR; - - /* Check if foreground color is close enough. */ - fg = attrs[LFACE_FOREGROUND_INDEX]; - if (STRINGP (fg)) - { - if (! tty_lookup_color (f, fg, &fg_tty_color, &fg_std_color)) - return Qnil; - else if (color_distance (&fg_tty_color, &fg_std_color) - > TTY_SAME_COLOR_THRESHOLD) - return Qnil; - } - - /* 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 Qnil; - else if (color_distance (&bg_tty_color, &bg_std_color) - > TTY_SAME_COLOR_THRESHOLD) - return Qnil; - } - - /* If both foreground and background are requested, see if the - distance between them is OK. We just check to see if the distance - between the tty's foreground and background is close enough to the - distance between the standard foreground and background. */ - if (STRINGP (fg) && STRINGP (bg)) - { - int delta_delta - = (color_distance (&fg_std_color, &bg_std_color) - - color_distance (&fg_tty_color, &bg_tty_color)); - if (delta_delta > TTY_SAME_COLOR_THRESHOLD - || delta_delta < -TTY_SAME_COLOR_THRESHOLD) - return Qnil; - } - - - /* See if the capabilities we selected above are supported, with the - given colors. */ - if (test_caps != 0 && - ! tty_capable_p (f, test_caps, fg_tty_color.pixel, bg_tty_color.pixel)) - return Qnil; - - - /* Hmmm, everything checks out, this terminal must support this face. */ - return Qt; -} - - - -/*********************************************************************** - Face Cache - ***********************************************************************/ - -/* Return a new face cache for frame F. */ - -static struct face_cache * -make_face_cache (f) - struct frame *f; -{ - struct face_cache *c; - int size; - - c = (struct face_cache *) xmalloc (sizeof *c); - bzero (c, sizeof *c); - size = FACE_CACHE_BUCKETS_SIZE * sizeof *c->buckets; - c->buckets = (struct face **) xmalloc (size); - bzero (c->buckets, size); - c->size = 50; - c->faces_by_id = (struct face **) xmalloc (c->size * sizeof *c->faces_by_id); - c->f = f; - c->menu_face_changed_p = menu_face_changed_default; - return c; -} - - -/* Clear out all graphics contexts for all realized faces, except for - the basic faces. This should be done from time to time just to avoid - keeping too many graphics contexts that are no longer needed. */ +/* Clear out all graphics contexts for all realized faces, except for + the basic faces. This should be done from time to time just to avoid + keeping too many graphics contexts that are no longer needed. */ static void clear_face_gcs (c) @@ -5396,8 +5413,8 @@ clear_face_gcs (c) } -/* Free all realized faces in face cache C, including basic faces. C - may be null. If faces are freed, make sure the frame's current +/* Free all realized faces in face cache C, including basic faces. + C may be null. If faces are freed, make sure the frame's current matrix is marked invalid, so that a display caused by an expose event doesn't try to use faces we destroyed. */ @@ -5568,12 +5585,19 @@ cache_face (c, face, hash) face->id = i; /* Maybe enlarge C->faces_by_id. */ - if (i == c->used && c->used == c->size) + if (i == c->used) { - int new_size = 2 * c->size; - int sz = new_size * sizeof *c->faces_by_id; - c->faces_by_id = (struct face **) xrealloc (c->faces_by_id, sz); - c->size = new_size; + if (c->used == c->size) + { + int new_size, sz; + new_size = min (2 * c->size, MAX_FACE_ID); + if (new_size == c->size) + abort (); /* Alternatives? ++kfs */ + sz = new_size * sizeof *c->faces_by_id; + c->faces_by_id = (struct face **) xrealloc (c->faces_by_id, sz); + c->size = new_size; + } + c->used++; } #if GLYPH_DEBUG @@ -5592,8 +5616,6 @@ cache_face (c, face, hash) #endif /* GLYPH_DEBUG */ c->faces_by_id[i] = face; - if (i == c->used) - ++c->used; } @@ -5680,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]; @@ -5694,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); } @@ -5716,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; @@ -5822,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]; @@ -5835,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); } @@ -5850,13 +5879,365 @@ 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; } + +/*********************************************************************** + Face capability testing + ***********************************************************************/ + + +/* If the distance (as returned by color_distance) between two colors is + less than this, then they are considered the same, for determining + whether a color is supported or not. The range of values is 0-65535. */ + +#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. + + The definition of `supported' is somewhat heuristic, but basically means + that a face containing all the attributes in ATTRS, when merged with the + 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. */ + +static int +x_supports_face_attributes_p (f, attrs, def_face) + struct frame *f; + Lisp_Object *attrs; + struct face *def_face; +{ + Lisp_Object *def_attrs = def_face->lface; + + /* Check that other specified attributes are different that the default + face. */ + if ((!UNSPECIFIEDP (attrs[LFACE_UNDERLINE_INDEX]) + && face_attr_equal_p (attrs[LFACE_UNDERLINE_INDEX], + def_attrs[LFACE_UNDERLINE_INDEX])) + || (!UNSPECIFIEDP (attrs[LFACE_INVERSE_INDEX]) + && face_attr_equal_p (attrs[LFACE_INVERSE_INDEX], + def_attrs[LFACE_INVERSE_INDEX])) + || (!UNSPECIFIEDP (attrs[LFACE_FOREGROUND_INDEX]) + && face_attr_equal_p (attrs[LFACE_FOREGROUND_INDEX], + def_attrs[LFACE_FOREGROUND_INDEX])) + || (!UNSPECIFIEDP (attrs[LFACE_BACKGROUND_INDEX]) + && face_attr_equal_p (attrs[LFACE_BACKGROUND_INDEX], + def_attrs[LFACE_BACKGROUND_INDEX])) + || (!UNSPECIFIEDP (attrs[LFACE_STIPPLE_INDEX]) + && face_attr_equal_p (attrs[LFACE_STIPPLE_INDEX], + def_attrs[LFACE_STIPPLE_INDEX])) + || (!UNSPECIFIEDP (attrs[LFACE_OVERLINE_INDEX]) + && face_attr_equal_p (attrs[LFACE_OVERLINE_INDEX], + def_attrs[LFACE_OVERLINE_INDEX])) + || (!UNSPECIFIEDP (attrs[LFACE_STRIKE_THROUGH_INDEX]) + && face_attr_equal_p (attrs[LFACE_STRIKE_THROUGH_INDEX], + def_attrs[LFACE_STRIKE_THROUGH_INDEX])) + || (!UNSPECIFIEDP (attrs[LFACE_BOX_INDEX]) + && face_attr_equal_p (attrs[LFACE_BOX_INDEX], + def_attrs[LFACE_BOX_INDEX]))) + return 0; + + /* Check font-related attributes, as those are the most commonly + "unsupported" on a window-system (because of missing fonts). */ + if (!UNSPECIFIEDP (attrs[LFACE_FAMILY_INDEX]) + || !UNSPECIFIEDP (attrs[LFACE_HEIGHT_INDEX]) + || !UNSPECIFIEDP (attrs[LFACE_WEIGHT_INDEX]) + || !UNSPECIFIEDP (attrs[LFACE_SLANT_INDEX]) + || !UNSPECIFIEDP (attrs[LFACE_SWIDTH_INDEX]) + || !UNSPECIFIEDP (attrs[LFACE_AVGWIDTH_INDEX])) + { + struct face *face; + Lisp_Object merged_attrs[LFACE_VECTOR_SIZE]; + + bcopy (def_attrs, merged_attrs, sizeof merged_attrs); + + merge_face_vectors (f, attrs, merged_attrs, 0); + + face = FACE_FROM_ID (f, lookup_face (f, merged_attrs, 0, 0)); + + if (! face) + error ("Cannot make face"); + + /* If the font is the same, then not supported. */ + if (face->font == def_face->font) + return 0; + } + + /* Everything checks out, this face is supported. */ + return 1; +} + +#endif /* HAVE_WINDOW_SYSTEM */ + +/* Return non-zero if all the face attributes in ATTRS are supported + on the tty frame F. + + The definition of `supported' is somewhat heuristic, but basically means + that a face containing all the attributes in ATTRS, when merged + with the 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. + + Point (2) implies that a `:weight black' attribute will be satisfied + by any terminal that can display bold, and a `:foreground "yellow"' as + long as the terminal 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. */ + +static int +tty_supports_face_attributes_p (f, attrs, def_face) + struct frame *f; + Lisp_Object *attrs; + struct face *def_face; +{ + 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 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; + + + /* Test for terminal `capabilities' (non-color character attributes). */ + + /* font weight (bold/dim) */ + 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) + { + if (def_weight > XLFD_WEIGHT_MEDIUM) + return 0; /* same as default */ + test_caps = TTY_CAP_BOLD; + } + else if (weight < XLFD_WEIGHT_MEDIUM) + { + 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)) + { + if (STRINGP (val)) + 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)) + { + if (face_attr_equal_p (val, def_attrs[LFACE_UNDERLINE_INDEX])) + return 0; /* same as default */ + else + test_caps |= TTY_CAP_INVERSE; + } + + + /* Color testing. */ + + /* Default the color indices in FG_TTY_COLOR and BG_TTY_COLOR, since + we use them when calling `tty_capable_p' below, even if the face + specifies no colors. */ + fg_tty_color.pixel = FACE_TTY_DEFAULT_FG_COLOR; + bg_tty_color.pixel = FACE_TTY_DEFAULT_BG_COLOR; + + /* Check if foreground color is close enough. */ + fg = attrs[LFACE_FOREGROUND_INDEX]; + if (STRINGP (fg)) + { + 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; /* 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)) + { + 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; /* 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 + distance between them is OK. We just check to see if the distance + between the tty's foreground and background is close enough to the + distance between the standard foreground and background. */ + if (STRINGP (fg) && STRINGP (bg)) + { + int delta_delta + = (color_distance (&fg_std_color, &bg_std_color) + - color_distance (&fg_tty_color, &bg_tty_color)); + if (delta_delta > TTY_SAME_COLOR_THRESHOLD + || delta_delta < -TTY_SAME_COLOR_THRESHOLD) + return 0; + } + + + /* See if the capabilities we selected above are supported, with the + given colors. */ + if (test_caps != 0 && + ! tty_capable_p (f, test_caps, fg_tty_color.pixel, bg_tty_color.pixel)) + return 0; + + + /* Hmmm, everything checks out, this terminal must support this face. */ + return 1; +} + + +DEFUN ("display-supports-face-attributes-p", + Fdisplay_supports_face_attributes_p, Sdisplay_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). + +The definition of `supported' is somewhat heuristic, but basically means +that a face containing all the attributes in ATTRIBUTES, when merged +with the 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. + +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. */) + (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)) + frame = display; + else + { + /* Find any frame on DISPLAY. */ + Lisp_Object fl_tail; + + frame = Qnil; + for (fl_tail = Vframe_list; CONSP (fl_tail); fl_tail = XCDR (fl_tail)) + { + frame = XCAR (fl_tail); + if (!NILP (Fequal (Fcdr (Fassq (Qdisplay, + XFRAME (frame)->param_alist)), + display))) + break; + } + } + + CHECK_LIVE_FRAME (frame); + f = XFRAME (frame); + + for (i = 0; i < LFACE_VECTOR_SIZE; i++) + attrs[i] = Qunspecified; + 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, def_face); +#ifdef HAVE_WINDOW_SYSTEM + else + supports = x_supports_face_attributes_p (f, attrs, def_face); +#endif + + return supports ? Qt : Qnil; +} + /*********************************************************************** Font selection @@ -5998,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]; @@ -6048,6 +6435,18 @@ better_font_p (values, font1, font2, compare_pt_p, avgwidth) return 1; } + if (! compare_pt_p) + { + /* We prefer a real scalable font; i.e. not what autoscaled. */ + int auto_scaled_1 = (font1->numeric[XLFD_POINT_SIZE] == 0 + && font1->numeric[XLFD_RESY] > 0); + int auto_scaled_2 = (font2->numeric[XLFD_POINT_SIZE] == 0 + && font2->numeric[XLFD_RESY] > 0); + + if (auto_scaled_1 != auto_scaled_2) + return auto_scaled_2; + } + return font1->registry_priority < font2->registry_priority; } @@ -6096,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; @@ -6230,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. */ @@ -6276,29 +6665,35 @@ 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))) - best = fonts + i; + { + non_scalable_has_exact_height_p = 1; + 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; } } @@ -6398,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)) @@ -6427,7 +6831,7 @@ try_font_list (f, attrs, family, registry, fonts, prefer_face_family) /* Try any family with the given registry. */ if (nfonts == 0) - nfonts = font_list (f, Qnil, Qnil, registry, fonts); + nfonts = try_alternative_families (f, Qnil, registry, fonts); return nfonts; } @@ -6540,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) @@ -6590,9 +6995,9 @@ realize_default_face (f) frame_font = Fassq (Qfont, f->param_alist); xassert (CONSP (frame_font) && STRINGP (XCDR (frame_font))); frame_font = XCDR (frame_font); - /* Specify 0 for FORCE_P here, so that we don't override - a :family attribute specified for `default' for new frames. */ - set_lface_from_font_name (f, lface, frame_font, 0, 1); + set_lface_from_font_name (f, lface, frame_font, + f->default_face_done_p, 1); + f->default_face_done_p = 1; } #endif /* HAVE_WINDOW_SYSTEM */ @@ -6662,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; } @@ -6697,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); @@ -6766,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; @@ -6963,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; } @@ -7162,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); } @@ -7227,24 +7643,8 @@ face_at_buffer_position (w, pos, region_beg, region_end, /* Look at properties from overlays. */ { int next_overlay; - int len; - - /* First try with room for 40 overlays. */ - len = 40; - overlay_vec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object)); - noverlays = overlays_at (pos, 0, &overlay_vec, &len, - &next_overlay, NULL, 0); - - /* If there are more than 40, make enough space for all, and try - again. */ - if (noverlays > len) - { - len = noverlays; - overlay_vec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object)); - noverlays = overlays_at (pos, 0, &overlay_vec, &len, - &next_overlay, NULL, 0); - } + GET_OVERLAYS_AT (pos, overlay_vec, noverlays, &next_overlay, 0); if (next_overlay < endpos) endpos = next_overlay; } @@ -7264,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); @@ -7275,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); @@ -7286,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; @@ -7383,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)) { - Lisp_Object region_face = lface_from_face_name (f, Qregion, 0); - merge_face_vectors (f, XVECTOR (region_face)->contents, attrs, Qnil); + 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 + { + 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, @@ -7399,7 +7859,6 @@ face_at_string_position (w, string, pos, bufpos, region_beg, return lookup_face (f, attrs, 0, NULL); } - /*********************************************************************** Tests @@ -7415,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, @@ -7496,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"); @@ -7598,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); @@ -7623,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"); @@ -7659,7 +8124,7 @@ syms_of_xfaces () defsubr (&Sinternal_merge_in_global_face); defsubr (&Sface_font); defsubr (&Sframe_face_alist); - defsubr (&Stty_supports_face_attributes_p); + defsubr (&Sdisplay_supports_face_attributes_p); defsubr (&Scolor_distance); defsubr (&Sinternal_set_font_selection_order); defsubr (&Sinternal_set_alternative_font_family_alist); @@ -7730,3 +8195,6 @@ a font of 10 point, we actually use a font of 10 * RESCALE-RATIO point. */); defsubr (&Sx_font_family_list); #endif /* HAVE_WINDOW_SYSTEM */ } + +/* arch-tag: 8a0f7598-5517-408d-9ab3-1da6fcd4c749 + (do not change this comment) */