if (NILP (frame))
frame = selected_frame;
- CHECK_LIVE_FRAME (frame, nparam);
+ CHECK_LIVE_FRAME (frame);
return XFRAME (frame);
}
{
struct frame *f;
- CHECK_FRAME (frame, 0);
- CHECK_STRING (color, 0);
+ CHECK_FRAME (frame);
+ CHECK_STRING (color);
f = XFRAME (frame);
return face_color_gray_p (f, XSTRING (color)->data) ? Qt : Qnil;
}
{
struct frame *f;
- CHECK_FRAME (frame, 0);
- CHECK_STRING (color, 0);
+ CHECK_FRAME (frame);
+ CHECK_STRING (color);
f = XFRAME (frame);
if (face_color_supported_p (f, XSTRING (color)->data, !NILP (background_p)))
return Qt;
struct face *face;
{
#ifdef HAVE_X_WINDOWS
+ if (face->colors_copied_bitwise_p)
+ return;
+
BLOCK_INPUT;
if (!face->foreground_defaulted_p)
struct gcpro gcpro1;
if (!NILP (family))
- CHECK_STRING (family, 1);
+ CHECK_STRING (family);
result = Qnil;
GCPRO1 (result);
int maxnames;
check_x ();
- CHECK_STRING (pattern, 0);
+ CHECK_STRING (pattern);
if (NILP (maximum))
maxnames = 2000;
else
{
- CHECK_NATNUM (maximum, 0);
+ CHECK_NATNUM (maximum);
maxnames = XINT (maximum);
}
if (!NILP (width))
- CHECK_NUMBER (width, 4);
+ CHECK_NUMBER (width);
/* We can't simply call check_x_frame because this function may be
called before any frame is created. */
/* Merges the face height FROM with the face height TO, and returns the
merged height. If FROM is an invalid height, then INVALID is
- returned instead. FROM may be a either an absolute face height or a
- `relative' height, and TO must be an absolute height. The returned
- value is always an absolute height. GCPRO is a lisp value that will
- be protected from garbage-collection if this function makes a call
- into lisp. */
+ returned instead. FROM and TO may be either absolute face heights or
+ `relative' heights; the returned value is always an absolute height
+ unless both FROM and TO are relative. GCPRO is a lisp value that
+ will be protected from garbage-collection if this function makes a
+ call into lisp. */
Lisp_Object
merge_face_heights (from, to, invalid, gcpro)
Lisp_Object from, to, invalid, gcpro;
{
- int result = 0;
+ Lisp_Object result = invalid;
if (INTEGERP (from))
- result = XINT (from);
- else if (NUMBERP (from))
- result = XFLOATINT (from) * XINT (to);
-#if 0 /* Probably not so useful. */
- else if (CONSP (from) && CONSP (XCDR (from)))
- {
- if (EQ (XCAR(from), Qplus) || EQ (XCAR(from), Qminus))
- {
- if (INTEGERP (XCAR (XCDR (from))))
- {
- int inc = XINT (XCAR (XCDR (from)));
- if (EQ (XCAR (from), Qminus))
- inc = -inc;
-
- result = XFASTINT (to);
- if (result + inc > 0)
- /* Note that `underflows' don't mean FROM is invalid, so
- we just pin the result at TO if it would otherwise be
- negative or 0. */
- result += inc;
- }
- }
+ /* FROM is absolute, just use it as is. */
+ result = from;
+ else if (FLOATP (from))
+ /* FROM is a scale, use it to adjust TO. */
+ {
+ if (INTEGERP (to))
+ /* relative X absolute => absolute */
+ result = make_number ((EMACS_INT)(XFLOAT_DATA (from) * XINT (to)));
+ else if (FLOATP (to))
+ /* relative X relative => relative */
+ result = make_float (XFLOAT_DATA (from) * XFLOAT_DATA (to));
}
-#endif
else if (FUNCTIONP (from))
+ /* FROM is a function, which use to adjust TO. */
{
/* Call function with current height as argument.
From is the new height. */
- Lisp_Object args[2], height;
+ Lisp_Object args[2];
struct gcpro gcpro1;
GCPRO1 (gcpro);
args[0] = from;
args[1] = to;
- height = safe_call (2, args);
+ result = safe_call (2, args);
UNGCPRO;
- if (NUMBERP (height))
- result = XFLOATINT (height);
+ /* Ensure that if TO was absolute, so is the result. */
+ if (INTEGERP (to) && !INTEGERP (result))
+ result = invalid;
}
- if (result > 0)
- return make_number (result);
- else
- return invalid;
+ return result;
}
for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
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);
- else
- to[i] = from[i];
+ {
+ if (i == LFACE_HEIGHT_INDEX && !INTEGERP (from[i]))
+ to[i] = merge_face_heights (from[i], to[i], to[i], cycle_check);
+ else
+ to[i] = from[i];
+ }
/* TO is always an absolute face, which should inherit from nothing.
We blindly copy the :inherit attribute above and fix it up here. */
struct frame *f;
int i;
- CHECK_SYMBOL (face, 0);
+ CHECK_SYMBOL (face);
global_lface = lface_from_face_name (NULL, face, 0);
if (!NILP (frame))
{
- CHECK_LIVE_FRAME (frame, 1);
+ CHECK_LIVE_FRAME (frame);
f = XFRAME (frame);
lface = lface_from_face_name (f, face, 0);
}
if (!NILP (frame))
{
- CHECK_LIVE_FRAME (frame, 1);
+ CHECK_LIVE_FRAME (frame);
lface = lface_from_face_name (XFRAME (frame), face, 0);
}
else
{
Lisp_Object lface, copy;
- CHECK_SYMBOL (from, 0);
- CHECK_SYMBOL (to, 1);
+ CHECK_SYMBOL (from);
+ CHECK_SYMBOL (to);
if (NILP (new_frame))
new_frame = frame;
else
{
/* Copy frame-local definition of FROM. */
- CHECK_LIVE_FRAME (frame, 2);
- CHECK_LIVE_FRAME (new_frame, 3);
+ CHECK_LIVE_FRAME (frame);
+ CHECK_LIVE_FRAME (new_frame);
lface = lface_from_face_name (XFRAME (frame), from, 1);
copy = Finternal_make_lisp_face (to, new_frame);
}
/* Set 1 if ATTR is one of font-related attributes other than QCfont. */
int font_related_attr_p = 0;
- CHECK_SYMBOL (face, 0);
- CHECK_SYMBOL (attr, 1);
+ CHECK_SYMBOL (face);
+ CHECK_SYMBOL (attr);
face = resolve_face_name (face);
if (NILP (frame))
frame = selected_frame;
- CHECK_LIVE_FRAME (frame, 3);
+ CHECK_LIVE_FRAME (frame);
lface = lface_from_face_name (XFRAME (frame), face, 0);
/* If a frame-local face doesn't exist yet, create one. */
{
if (!UNSPECIFIEDP (value))
{
- CHECK_STRING (value, 3);
+ CHECK_STRING (value);
if (XSTRING (value)->size == 0)
signal_error ("Invalid face family", value);
}
{
if (!UNSPECIFIEDP (value))
{
- CHECK_SYMBOL (value, 3);
+ CHECK_SYMBOL (value);
if (face_numeric_weight (value) < 0)
signal_error ("Invalid face weight", value);
}
{
if (!UNSPECIFIEDP (value))
{
- CHECK_SYMBOL (value, 3);
+ CHECK_SYMBOL (value);
if (face_numeric_slant (value) < 0)
signal_error ("Invalid face slant", value);
}
{
if (!UNSPECIFIEDP (value))
{
- CHECK_SYMBOL (value, 3);
+ CHECK_SYMBOL (value);
if (!EQ (value, Qt) && !NILP (value))
signal_error ("Invalid inverse-video face attribute value", value);
}
/* Don't check for valid color names here because it depends
on the frame (display) whether the color will be valid
when the face is realized. */
- CHECK_STRING (value, 3);
+ CHECK_STRING (value);
if (XSTRING (value)->size == 0)
signal_error ("Empty foreground color value", value);
}
/* Don't check for valid color names here because it depends
on the frame (display) whether the color will be valid
when the face is realized. */
- CHECK_STRING (value, 3);
+ CHECK_STRING (value);
if (XSTRING (value)->size == 0)
signal_error ("Empty background color value", value);
}
{
if (!UNSPECIFIEDP (value))
{
- CHECK_SYMBOL (value, 3);
+ CHECK_SYMBOL (value);
if (face_numeric_swidth (value) < 0)
signal_error ("Invalid face width", value);
}
else if (EQ (attr, QCfont))
{
#ifdef HAVE_WINDOW_SYSTEM
- /* Set font-related attributes of the Lisp face from an
- XLFD font name. */
- struct frame *f;
- Lisp_Object tmp;
-
- CHECK_STRING (value, 3);
- if (EQ (frame, Qt))
- f = SELECTED_FRAME ();
- else
- f = check_x_frame (frame);
+ if (FRAME_WINDOW_P (XFRAME (frame)))
+ {
+ /* Set font-related attributes of the Lisp face from an XLFD
+ font name. */
+ struct frame *f;
+ Lisp_Object tmp;
+
+ CHECK_STRING (value);
+ if (EQ (frame, Qt))
+ f = SELECTED_FRAME ();
+ else
+ f = check_x_frame (frame);
- /* VALUE may be a fontset name or an alias of fontset. In such
- a case, use the base fontset name. */
- tmp = Fquery_fontset (value, Qnil);
- if (!NILP (tmp))
- value = tmp;
+ /* VALUE may be a fontset name or an alias of fontset. In
+ such a case, use the base fontset name. */
+ tmp = Fquery_fontset (value, Qnil);
+ if (!NILP (tmp))
+ value = tmp;
- if (!set_lface_from_font_name (f, lface, value, 1, 1))
- signal_error ("Invalid font or fontset name", value);
+ if (!set_lface_from_font_name (f, lface, value, 1, 1))
+ signal_error ("Invalid font or fontset name", value);
- font_attr_p = 1;
+ font_attr_p = 1;
+ }
#endif /* HAVE_WINDOW_SYSTEM */
}
else if (EQ (attr, QCinherit))
}
if (!NILP (param))
- if (EQ (frame, Qt))
- /* Update `default-frame-alist', which is used for new frames. */
- {
- store_in_alist (&Vdefault_frame_alist, param, value);
- }
- else
- /* Update the current frame's parameters. */
- {
- Lisp_Object cons;
- cons = XCAR (Vparam_value_alist);
- XSETCAR (cons, param);
- XSETCDR (cons, value);
- Fmodify_frame_parameters (frame, Vparam_value_alist);
- }
+ {
+ if (EQ (frame, Qt))
+ /* Update `default-frame-alist', which is used for new frames. */
+ {
+ store_in_alist (&Vdefault_frame_alist, param, value);
+ }
+ else
+ /* Update the current frame's parameters. */
+ {
+ Lisp_Object cons;
+ cons = XCAR (Vparam_value_alist);
+ XSETCAR (cons, param);
+ XSETCDR (cons, value);
+ Fmodify_frame_parameters (frame, Vparam_value_alist);
+ }
+ }
}
return face;
Lisp_Object value = Qnil;
#ifndef WINDOWSNT
#ifndef macintosh
- CHECK_STRING (resource, 0);
- CHECK_STRING (class, 1);
- CHECK_LIVE_FRAME (frame, 2);
+ CHECK_STRING (resource);
+ CHECK_STRING (class);
+ CHECK_LIVE_FRAME (frame);
BLOCK_INPUT;
value = display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame)),
resource, class, Qnil, Qnil);
(face, attr, value, frame)
Lisp_Object face, attr, value, frame;
{
- CHECK_SYMBOL (face, 0);
- CHECK_SYMBOL (attr, 1);
- CHECK_STRING (value, 2);
+ CHECK_SYMBOL (face);
+ CHECK_SYMBOL (attr);
+ CHECK_STRING (value);
if (xstricmp (XSTRING (value)->data, "unspecified") == 0)
value = Qunspecified;
value = face_boolean_x_resource_value (value, 1);
else if (EQ (attr, QCunderline)
|| EQ (attr, QCoverline)
- || EQ (attr, QCstrike_through)
- || EQ (attr, QCbox))
+ || EQ (attr, QCstrike_through))
{
Lisp_Object boolean_value;
if (SYMBOLP (boolean_value))
value = boolean_value;
}
+ else if (EQ (attr, QCbox))
+ value = Fcar (Fread_from_string (value, Qnil, Qnil));
return Finternal_set_lisp_face_attribute (face, attr, value, frame);
}
#endif /* HAVE_X_WINDOWS && USE_X_TOOLKIT */
+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. */)
+ (attribute, value)
+ Lisp_Object attribute, value;
+{
+ if (EQ (value, Qunspecified))
+ return Qt;
+ else if (EQ (attribute, QCheight))
+ return INTEGERP (value) ? Qnil : Qt;
+ else
+ return Qnil;
+}
+
+DEFUN ("merge-face-attribute", Fmerge_face_attribute, Smerge_face_attribute,
+ 3, 3, 0,
+ doc: /* Return face ATTRIBUTE VALUE1 merged with VALUE2.
+If VALUE1 or VALUE2 are absolute (see `face-attribute-relative-p'), then
+the result will be absolute, otherwise it will be relative. */)
+ (attribute, value1, value2)
+ Lisp_Object attribute, value1, value2;
+{
+ if (EQ (value1, Qunspecified))
+ return value2;
+ else if (EQ (attribute, QCheight))
+ return merge_face_heights (value1, value2, value1, Qnil);
+ else
+ return value1;
+}
+
DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute,
Sinternal_get_lisp_face_attribute,
{
Lisp_Object lface, value = Qnil;
- CHECK_SYMBOL (symbol, 0);
- CHECK_SYMBOL (keyword, 1);
+ CHECK_SYMBOL (symbol);
+ CHECK_SYMBOL (keyword);
if (EQ (frame, Qt))
lface = lface_from_face_name (NULL, symbol, 1);
{
if (NILP (frame))
frame = selected_frame;
- CHECK_LIVE_FRAME (frame, 2);
+ CHECK_LIVE_FRAME (frame);
lface = lface_from_face_name (XFRAME (frame), symbol, 1);
}
{
Lisp_Object result = Qnil;
- CHECK_SYMBOL (attr, 0);
+ CHECK_SYMBOL (attr);
if (EQ (attr, QCweight)
|| EQ (attr, QCslant)
DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face,
Sinternal_merge_in_global_face, 2, 2, 0,
- doc: /* Add attributes from frame-default definition of FACE to FACE on FRAME.
+ doc: /* Add attributes from frame-default definition of FACE to FACE on FRAME.
Default face attributes override any local face attributes. */)
(face, frame)
Lisp_Object face, frame;
int i;
Lisp_Object global_lface, local_lface, *gvec, *lvec;
- CHECK_LIVE_FRAME (frame, 1);
+ CHECK_LIVE_FRAME (frame);
global_lface = lface_from_face_name (NULL, face, 1);
local_lface = lface_from_face_name (XFRAME (frame), face, 0);
if (NILP (local_lface))
done in fontset.el. */
DEFUN ("face-font", Fface_font, Sface_font, 1, 2, 0,
- doc: /* Return the font name of face FACE, or nil if it is unspecified.
+ doc: /* Return the font name of face FACE, or nil if it is unspecified.
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).
The font default for a face is either nil, or a list
&& !EQ (LFACE_WEIGHT (lface), Qnormal))
result = Fcons (Qbold, result);
- if (!NILP (LFACE_SLANT (lface))
+ if (!UNSPECIFIEDP (LFACE_SLANT (lface))
&& !EQ (LFACE_SLANT (lface), Qnormal))
result = Fcons (Qitalic, result);
if (NILP (frame))
frame = selected_frame;
- CHECK_LIVE_FRAME (frame, 0);
+ CHECK_LIVE_FRAME (frame);
f = XFRAME (frame);
if (EQ (frame, Qt))
return lookup_face (f, attrs, c, default_face);
}
+DEFUN ("face-attributes-as-vector", Fface_attributes_as_vector,
+ Sface_attributes_as_vector, 1, 1, 0,
+ doc: /* Return a vector of face attributes corresponding to PLIST. */)
+ (plist)
+ Lisp_Object plist;
+{
+ Lisp_Object lface;
+ lface = Fmake_vector (make_number (LFACE_VECTOR_SIZE),
+ Qunspecified);
+ merge_face_vector_with_property (XFRAME (selected_frame),
+ XVECTOR (lface)->contents,
+ plist);
+ return lface;
+}
+
\f
/***********************************************************************
int i;
int indices[DIM (font_sort_order)];
- CHECK_LIST (order, 0);
+ CHECK_LIST (order);
bzero (indices, sizeof indices);
i = 0;
DEFUN ("internal-set-alternative-font-family-alist",
Finternal_set_alternative_font_family_alist,
Sinternal_set_alternative_font_family_alist, 1, 1, 0,
- doc: /* Define alternative font families to try in face font selection.
+ doc: /* Define alternative font families to try in face font selection.
ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can
be found. Value is ALIST. */)
(alist)
Lisp_Object alist;
{
- CHECK_LIST (alist, 0);
+ CHECK_LIST (alist);
Vface_alternative_font_family_alist = alist;
free_all_realized_faces (Qnil);
return alist;
DEFUN ("internal-set-alternative-font-registry-alist",
Finternal_set_alternative_font_registry_alist,
Sinternal_set_alternative_font_registry_alist, 1, 1, 0,
- doc: /* Define alternative font registries to try in face font selection.
+ doc: /* Define alternative font registries to try in face font selection.
ALIST is an alist of (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
Each ALTERNATIVE is tried in order if no fonts of font registry REGISTRY can
be found. Value is ALIST. */)
(alist)
Lisp_Object alist;
{
- CHECK_LIST (alist, 0);
+ CHECK_LIST (alist);
Vface_alternative_font_registry_alist = alist;
free_all_realized_faces (Qnil);
return alist;
{
realize_named_face (f, Qmode_line, MODE_LINE_FACE_ID);
realize_named_face (f, Qtool_bar, TOOL_BAR_FACE_ID);
- realize_named_face (f, Qfringe, BITMAP_AREA_FACE_ID);
+ realize_named_face (f, Qfringe, FRINGE_FACE_ID);
realize_named_face (f, Qheader_line, HEADER_LINE_FACE_ID);
realize_named_face (f, Qscroll_bar, SCROLL_BAR_FACE_ID);
realize_named_face (f, Qborder, BORDER_FACE_ID);
face->gc = 0;
/* Don't try to free the colors copied bitwise from BASE_FACE. */
- face->foreground_defaulted_p = 1;
- face->background_defaulted_p = 1;
- face->underline_defaulted_p = 1;
- face->overline_color_defaulted_p = 1;
- face->strike_through_color_defaulted_p = 1;
- face->box_color_defaulted_p = 1;
+ face->colors_copied_bitwise_p = 1;
/* to force realize_face to load font */
face->font = NULL;
DEFUN ("tty-suppress-bold-inverse-default-colors",
Ftty_suppress_bold_inverse_default_colors,
Stty_suppress_bold_inverse_default_colors, 1, 1, 0,
- doc: /* Suppress/allow boldness of faces with inverse default colors.
+ doc: /* Suppress/allow boldness of faces with inverse default colors.
SUPPRESS non-nil means suppress it.
This affects bold faces on TTYs whose foreground is the default background
color of the display and whose background is the default foreground color.
return face_id;
}
-
/* Return the face ID associated with buffer position POS for
displaying ASCII characters. Return in *ENDPTR the position at
which a different face is needed, as far as text properties and
else
{
struct face *face;
- CHECK_NUMBER (n, 0);
+ CHECK_NUMBER (n);
face = FACE_FROM_ID (SELECTED_FRAME (), XINT (n));
if (face == NULL)
error ("Not a valid face");
#endif
defsubr (&Scolor_gray_p);
defsubr (&Scolor_supported_p);
+ defsubr (&Sface_attribute_relative_p);
+ defsubr (&Smerge_face_attribute);
defsubr (&Sinternal_get_lisp_face_attribute);
defsubr (&Sinternal_lisp_face_attribute_values);
defsubr (&Sinternal_lisp_face_equal_p);
defsubr (&Sinternal_set_font_selection_order);
defsubr (&Sinternal_set_alternative_font_family_alist);
defsubr (&Sinternal_set_alternative_font_registry_alist);
+ defsubr (&Sface_attributes_as_vector);
#if GLYPH_DEBUG
defsubr (&Sdump_face);
defsubr (&Sshow_face_resources);