/* 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.
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 <gerd@gnu.org>. */
#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))
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
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
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;
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 *,
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 *));
GC gc;
{
BLOCK_INPUT;
- xassert (--ngcs >= 0);
+ IF_DEBUG (xassert (--ngcs >= 0));
XFreeGC (FRAME_X_DISPLAY (f), gc);
UNBLOCK_INPUT;
}
GC gc;
{
BLOCK_INPUT;
- xassert (--ngcs >= 0);
+ IF_DEBUG (xassert (--ngcs >= 0));
xfree (gc);
UNBLOCK_INPUT;
}
#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;
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;
}
struct frame *f;
GC gc;
{
+ BLOCK_INPUT;
+ IF_DEBUG (xassert (--ngcs >= 0));
XFreeGC (FRAME_MAC_DISPLAY (f), gc);
+ UNBLOCK_INPUT;
}
#endif /* MAC_OS */
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
#endif
#ifdef WINDOWSNT
w32_unload_font (dpyinfo, font_info->font);
+#endif
+#ifdef MAC_OS
+ mac_unload_font (dpyinfo, font_info->font);
#endif
UNBLOCK_INPUT;
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))
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)
/* 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)
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;
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
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)
{
/* 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));
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
/* 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;
{
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);
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. */
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;
/* 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;
if (!UNSPECIFIEDP (from[i]))
{
if (i == LFACE_HEIGHT_INDEX && !INTEGERP (from[i]))
- to[i] = merge_face_heights (from[i], to[i], to[i],
- named_merge_points);
+ to[i] = merge_face_heights (from[i], to[i], to[i]);
else
to[i] = from[i];
}
if (push_named_merge_point (&named_merge_point,
face_name, &named_merge_points))
{
+ struct gcpro gcpro1;
Lisp_Object from[LFACE_VECTOR_SIZE];
int ok = get_lface_attributes (f, face_name, from, 0);
if (ok)
- merge_face_vectors (f, from, to, named_merge_points);
+ {
+ GCPRO1 (named_merge_point.face_name);
+ merge_face_vectors (f, from, to, named_merge_points);
+ UNGCPRO;
+ }
return ok;
}
Lisp_Object value = XCAR (XCDR (face_ref));
int err = 0;
- if (EQ (keyword, QCfamily))
+ /* Specifying `unspecified' is a no-op. */
+ if (EQ (value, Qunspecified))
+ ;
+ else if (EQ (keyword, QCfamily))
{
if (STRINGP (value))
to[LFACE_FAMILY_INDEX] = value;
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))
to[LFACE_HEIGHT_INDEX] = new_height;
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);
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)
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;
{
CHECK_SYMBOL (from);
CHECK_SYMBOL (to);
- if (NILP (new_frame))
- new_frame = frame;
if (EQ (frame, Qt))
{
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);
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;
}
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. */
/* 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))
if (EQ (attr, QCfamily))
{
- if (!UNSPECIFIEDP (value))
+ if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value))
{
CHECK_STRING (value);
if (SCHARS (value) == 0)
}
else if (EQ (attr, QCheight))
{
- if (!UNSPECIFIEDP (value))
+ if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value))
{
Lisp_Object test;
/* 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);
}
else if (EQ (attr, QCweight))
{
- if (!UNSPECIFIEDP (value))
+ if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value))
{
CHECK_SYMBOL (value);
if (face_numeric_weight (value) < 0)
}
else if (EQ (attr, QCslant))
{
- if (!UNSPECIFIEDP (value))
+ if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value))
{
CHECK_SYMBOL (value);
if (face_numeric_slant (value) < 0)
}
else if (EQ (attr, QCunderline))
{
- if (!UNSPECIFIEDP (value))
+ if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value))
if ((SYMBOLP (value)
&& !EQ (value, Qt)
&& !EQ (value, Qnil))
}
else if (EQ (attr, QCoverline))
{
- if (!UNSPECIFIEDP (value))
+ if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value))
if ((SYMBOLP (value)
&& !EQ (value, Qt)
&& !EQ (value, Qnil))
}
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))
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;
}
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))
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))
}
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
}
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
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);
}
else if (EQ (attr, QCwidth))
{
- if (!UNSPECIFIEDP (value))
+ if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value))
{
CHECK_SYMBOL (value);
if (face_numeric_swidth (value) < 0)
else
f = check_x_frame (frame);
- if (!UNSPECIFIEDP (value))
+ if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value))
{
CHECK_STRING (value);
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
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))))
{
++windows_or_buffers_changed;
}
- if (!UNSPECIFIEDP (value)
+ if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value)
&& NILP (Fequal (old_value, value)))
{
Lisp_Object param;
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
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);
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;
+ }
}
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);
{
#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)
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;
(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;
}
else
signal_error ("Invalid face attribute name", keyword);
+ if (IGNORE_DEFFACE_P (value))
+ return Qunspecified;
+
return value;
}
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;
}
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;
}
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;
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;
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];
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, 0);
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;
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];
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, 0);
return lookup_face (f, attrs, c, default_face);
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)
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;
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
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;
{
if (def_face == NULL)
{
if (! realize_basic_faces (f))
- signal_error ("Cannot realize default face", 0);
+ 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. */
{
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];
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;
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. */
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;
}
}
+ }
- 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;
}
}
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))
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)
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;
}
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;
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;
}
}
+/* 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
+ {
+ 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,
+ or realize a new one for ASCII characters. */
+ return lookup_face (f, attrs, 0, NULL);
+}
+
\f
/***********************************************************************
Tests
{
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,
{
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");
staticpro (&Qforeground_color);
Qunspecified = intern ("unspecified");
staticpro (&Qunspecified);
+ Qignore_defface = intern (":ignore-defface");
+ staticpro (&Qignore_defface);
Qface_alias = intern ("face-alias");
staticpro (&Qface_alias);
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");