/* xfaces.c -- "Face" primitives.
- Copyright (C) 1993, 1994, 1998, 1999, 2000, 2001
+ Copyright (C) 1993, 1994, 1998, 1999, 2000, 2001, 2002
Free Software Foundation.
This file is part of GNU Emacs.
#include <config.h>
#include <sys/types.h>
#include <sys/stat.h>
+
#include "lisp.h"
#include "charset.h"
+#include "keyboard.h"
#include "frame.h"
#ifdef HAVE_WINDOW_SYSTEM
#include "fontset.h"
/* Redefine X specifics to W32 equivalents to avoid cluttering the
code with #ifdef blocks. */
+#undef FRAME_X_DISPLAY_INFO
#define FRAME_X_DISPLAY_INFO FRAME_W32_DISPLAY_INFO
#define x_display_info w32_display_info
#define FRAME_X_FONT_TABLE FRAME_W32_FONT_TABLE
#define GCGraphicsExposures 0
/* For historic reasons, FONT_WIDTH refers to average width on W32,
not maximum as on X. Redefine here. */
+#undef FONT_WIDTH
#define FONT_WIDTH FONT_MAX_WIDTH
#endif /* WINDOWSNT */
-#ifdef macintosh
+#ifdef MAC_OS
#include "macterm.h"
#define x_display_info mac_display_info
#define check_x check_mac
-
-extern XGCValues *XCreateGC (void *, WindowPtr, unsigned long, XGCValues *);
-
-static INLINE GC
-x_create_gc (f, mask, xgcv)
- struct frame *f;
- unsigned long mask;
- XGCValues *xgcv;
-{
- GC gc;
- gc = XCreateGC (FRAME_MAC_DISPLAY (f), FRAME_MAC_WINDOW (f), mask, xgcv);
- return gc;
-}
-
-static INLINE void
-x_free_gc (f, gc)
- struct frame *f;
- GC gc;
-{
- XFreeGC (FRAME_MAC_DISPLAY (f), gc);
-}
-#endif
+#endif /* MAC_OS */
#include "buffer.h"
#include "dispextern.h"
#include <stdio.h>
#include <ctype.h>
-#include "keyboard.h"
-#ifndef max
-#define max(A, B) ((A) > (B) ? (A) : (B))
-#define min(A, B) ((A) < (B) ? (A) : (B))
#define abs(X) ((X) < 0 ? -(X) : (X))
-#endif
/* Number of pt per inch (from the TeXbook). */
/* Make a copy of the contents of Lisp string S on the stack using
alloca. Value is a pointer to the copy. */
-#define LSTRDUPA(S) STRDUPA (XSTRING ((S))->data)
+#define LSTRDUPA(S) STRDUPA (SDATA ((S)))
/* Size of hash table of realized faces in face caches (should be a
prime number). */
Lisp_Object Qdefault, Qtool_bar, Qregion, Qfringe;
Lisp_Object Qheader_line, Qscroll_bar, Qcursor, Qborder, Qmouse, Qmenu;
+Lisp_Object Qmode_line_inactive;
extern Lisp_Object Qmode_line;
/* The symbol `face-alias'. A symbols having that property is an
/* TTY color-related functions (defined in tty-colors.el). */
-Lisp_Object Qtty_color_desc, Qtty_color_by_index;
+Lisp_Object Qtty_color_desc, Qtty_color_by_index, Qtty_color_standard_values;
/* The name of the function used to compute colors on TTYs. */
int face_change_count;
-/* Incremented for every change in the `menu' face. */
-
-int menu_face_change_count;
-
/* Non-zero means don't display bold text if a face's foreground
and background colors are the inverse of the default colors of the
display. This is a kluge to suppress `bold black' foreground text
static int ngcs;
#endif
+/* Non-zero means the definition of the `menu' face for new frames has
+ been changed. */
+
+int menu_face_changed_default;
\f
/* Function prototypes. */
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 int may_use_scalable_font_p P_ ((char *));
+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 *,
int, int));
static int font_list P_ ((struct frame *, Lisp_Object, Lisp_Object,
Lisp_Object, struct font_name **));
static int try_font_list P_ ((struct frame *, Lisp_Object *,
- Lisp_Object, Lisp_Object, struct font_name **));
+ Lisp_Object, Lisp_Object, struct font_name **,
+ int));
static int try_alternative_families P_ ((struct frame *f, Lisp_Object,
Lisp_Object, struct font_name **));
static int cmp_font_names P_ ((const void *, const void *));
int (*cmpfn) P_ ((const void *, const void *))));
static GC x_create_gc P_ ((struct frame *, unsigned long, XGCValues *));
static void x_free_gc P_ ((struct frame *, GC));
-static void clear_font_table P_ ((struct frame *));
+static void clear_font_table P_ ((struct x_display_info *));
#ifdef WINDOWSNT
extern Lisp_Object w32_list_fonts P_ ((struct frame *, Lisp_Object, int, int));
#ifdef USE_X_TOOLKIT
static void x_update_menu_appearance P_ ((struct frame *));
+
+extern void free_frame_menubar P_ ((struct frame *));
#endif /* USE_X_TOOLKIT */
#endif /* HAVE_WINDOW_SYSTEM */
DEFUN ("dump-colors", Fdump_colors, Sdump_colors, 0, 0, 0,
- "Dump currently allocated colors and their reference counts to stderr.")
- ()
+ doc: /* Dump currently allocated colors to stderr. */)
+ ()
{
int i, n;
#endif /* WINDOWSNT */
+#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;
+ unsigned long mask;
+ XGCValues *xgcv;
+{
+ GC gc;
+ gc = XCreateGC (FRAME_MAC_DISPLAY (f), FRAME_MAC_WINDOW (f), mask, xgcv);
+ return gc;
+}
+
+static INLINE void
+x_free_gc (f, gc)
+ struct frame *f;
+ GC gc;
+{
+ XFreeGC (FRAME_MAC_DISPLAY (f), gc);
+}
+
+#endif /* MAC_OS */
+
/* Like stricmp. Used to compare parts of font names which are in
ISO8859-1. */
int
xstricmp (s1, s2)
- unsigned char *s1, *s2;
+ const unsigned char *s1, *s2;
{
while (*s1 && *s2)
{
if (NILP (frame))
frame = selected_frame;
- CHECK_LIVE_FRAME (frame, nparam);
+ CHECK_LIVE_FRAME (frame);
return XFRAME (frame);
}
#endif
#ifdef WINDOWSNT
if (!FRAME_WINDOW_P (f) || FRAME_W32_WINDOW (f))
+#endif
+#ifdef MAC_OS
+ if (!FRAME_MAC_P (f) || FRAME_MAC_WINDOW (f))
#endif
if (!realize_basic_faces (f))
abort ();
if (clear_fonts_p
|| ++clear_font_table_count == CLEAR_FONT_TABLE_COUNT)
{
+ struct x_display_info *dpyinfo;
+
+ /* Fonts are common for frames on one display, i.e. on
+ one X screen. */
+ for (dpyinfo = x_display_list; dpyinfo; dpyinfo = dpyinfo->next)
+ if (dpyinfo->n_fonts > CLEAR_FONT_TABLE_NFONTS)
+ clear_font_table (dpyinfo);
+
/* From time to time see if we can unload some fonts. This also
frees all realized faces on all frames. Fonts needed by
faces will be loaded again when faces are realized again. */
FOR_EACH_FRAME (tail, frame)
{
- f = XFRAME (frame);
+ struct frame *f = XFRAME (frame);
if (FRAME_WINDOW_P (f)
&& FRAME_X_DISPLAY_INFO (f)->n_fonts > CLEAR_FONT_TABLE_NFONTS)
- {
- free_all_realized_faces (frame);
- clear_font_table (f);
- }
+ free_all_realized_faces (frame);
}
}
else
DEFUN ("clear-face-cache", Fclear_face_cache, Sclear_face_cache, 0, 1, 0,
- "Clear face caches on all frames.\n\
-Optional THOROUGHLY non-nil means try to free unused fonts, too.")
- (thoroughly)
+ doc: /* Clear face caches on all frames.
+Optional THOROUGHLY non-nil means try to free unused fonts, too. */)
+ (thoroughly)
Lisp_Object thoroughly;
{
clear_face_cache (!NILP (thoroughly));
#ifdef HAVE_WINDOW_SYSTEM
-/* Remove those fonts from the font table of frame F exept for the
- default ASCII font for the frame. Called from clear_face_cache
+/* Remove fonts from the font table of DPYINFO except for the default
+ ASCII fonts of frames on that display. Called from clear_face_cache
from time to time. */
static void
-clear_font_table (f)
- struct frame *f;
+clear_font_table (dpyinfo)
+ struct x_display_info *dpyinfo;
{
- struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
int i;
- xassert (FRAME_WINDOW_P (f));
-
- /* Free those fonts that are not used by the frame F as the default. */
+ /* Free those fonts that are not used by frames on DPYINFO. */
for (i = 0; i < dpyinfo->n_fonts; ++i)
{
struct font_info *font_info = dpyinfo->font_table + i;
+ Lisp_Object tail, frame;
+
+ /* Check if slot is already free. */
+ if (font_info->name == NULL)
+ continue;
+
+ /* Don't free a default font of some frame. */
+ FOR_EACH_FRAME (tail, frame)
+ {
+ struct frame *f = XFRAME (frame);
+ if (FRAME_WINDOW_P (f)
+ && font_info->font == FRAME_FONT (f))
+ break;
+ }
- if (!font_info->name
- || font_info->font == FRAME_FONT (f))
+ if (!NILP (tail))
continue;
/* Free names. */
#ifdef HAVE_WINDOW_SYSTEM
DEFUN ("bitmap-spec-p", Fbitmap_spec_p, Sbitmap_spec_p, 1, 1, 0,
- "Value is non-nil if OBJECT is a valid bitmap specification.\n\
-A bitmap specification is either a string, a file name, or a list\n\
-(WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,\n\
-HEIGHT is its height, and DATA is a string containing the bits of\n\
-the pixmap. Bits are stored row by row, each row occupies\n\
-(WIDTH + 7)/8 bytes.")
- (object)
+ doc: /* Value is non-nil if OBJECT is a valid bitmap specification.
+A bitmap specification is either a string, a file name, or a list
+\(WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,
+HEIGHT is its height, and DATA is a string containing the bits of
+the pixmap. Bits are stored row by row, each row occupies
+\(WIDTH + 7)/8 bytes. */)
+ (object)
Lisp_Object object;
{
int pixmap_p = 0;
{
int bytes_per_row = ((XFASTINT (width) + BITS_PER_CHAR - 1)
/ BITS_PER_CHAR);
- if (STRING_BYTES (XSTRING (data)) >= bytes_per_row * XINT (height))
+ if (SBYTES (data) >= bytes_per_row * XINT (height))
pixmap_p = 1;
}
}
h = XINT (Fcar (Fcdr (name)));
bits = Fcar (Fcdr (Fcdr (name)));
- bitmap_id = x_create_bitmap_from_data (f, XSTRING (bits)->data,
+ bitmap_id = x_create_bitmap_from_data (f, SDATA (bits),
w, h);
}
else
X Colors
***********************************************************************/
+/* Parse RGB_LIST, and fill in the RGB fields of COLOR.
+ RGB_LIST should contain (at least) 3 lisp integers.
+ Return 0 if there's a problem with RGB_LIST, otherwise return 1. */
+
+static int
+parse_rgb_list (rgb_list, color)
+ Lisp_Object rgb_list;
+ XColor *color;
+{
+#define PARSE_RGB_LIST_FIELD(field) \
+ if (CONSP (rgb_list) && INTEGERP (XCAR (rgb_list))) \
+ { \
+ color->field = XINT (XCAR (rgb_list)); \
+ rgb_list = XCDR (rgb_list); \
+ } \
+ else \
+ return 0;
+
+ PARSE_RGB_LIST_FIELD (red);
+ PARSE_RGB_LIST_FIELD (green);
+ PARSE_RGB_LIST_FIELD (blue);
+
+ return 1;
+}
+
+
+/* Lookup on frame F the color described by the lisp string COLOR.
+ The resulting tty color is returned in TTY_COLOR; if STD_COLOR is
+ non-zero, then the `standard' definition of the same color is
+ returned in it. */
+
+static int
+tty_lookup_color (f, color, tty_color, std_color)
+ struct frame *f;
+ Lisp_Object color;
+ XColor *tty_color, *std_color;
+{
+ Lisp_Object frame, color_desc;
+
+ if (!STRINGP (color) || NILP (Ffboundp (Qtty_color_desc)))
+ return 0;
+
+ XSETFRAME (frame, f);
+
+ color_desc = call2 (Qtty_color_desc, color, frame);
+ if (CONSP (color_desc) && CONSP (XCDR (color_desc)))
+ {
+ Lisp_Object rgb;
+
+ if (! INTEGERP (XCAR (XCDR (color_desc))))
+ return 0;
+
+ tty_color->pixel = XINT (XCAR (XCDR (color_desc)));
+
+ rgb = XCDR (XCDR (color_desc));
+ if (! parse_rgb_list (rgb, tty_color))
+ return 0;
+
+ /* Should we fill in STD_COLOR too? */
+ if (std_color)
+ {
+ /* Default STD_COLOR to the same as TTY_COLOR. */
+ *std_color = *tty_color;
+
+ /* Do a quick check to see if the returned descriptor is
+ actually _exactly_ equal to COLOR, otherwise we have to
+ lookup STD_COLOR separately. If it's impossible to lookup
+ a standard color, we just give up and use TTY_COLOR. */
+ if ((!STRINGP (XCAR (color_desc))
+ || NILP (Fstring_equal (color, XCAR (color_desc))))
+ && !NILP (Ffboundp (Qtty_color_standard_values)))
+ {
+ /* Look up STD_COLOR separately. */
+ rgb = call1 (Qtty_color_standard_values, color);
+ if (! parse_rgb_list (rgb, std_color))
+ return 0;
+ }
+ }
+
+ return 1;
+ }
+ else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist"))))
+ /* We were called early during startup, and the colors are not
+ yet set up in tty-defined-color-alist. Don't return a failure
+ indication, since this produces the annoying "Unable to
+ load color" messages in the *Messages* buffer. */
+ return 1;
+ else
+ /* tty-color-desc seems to have returned a bad value. */
+ return 0;
+}
+
/* A version of defined_color for non-X frames. */
int
XColor *color_def;
int alloc;
{
- Lisp_Object color_desc;
- unsigned long color_idx = FACE_TTY_DEFAULT_COLOR;
- unsigned long red = 0, green = 0, blue = 0;
int status = 1;
- if (*color_name && !NILP (Ffboundp (Qtty_color_desc)))
- {
- Lisp_Object frame;
+ /* Defaults. */
+ color_def->pixel = FACE_TTY_DEFAULT_COLOR;
+ color_def->red = 0;
+ color_def->blue = 0;
+ color_def->green = 0;
- XSETFRAME (frame, f);
- status = 0;
- color_desc = call2 (Qtty_color_desc, build_string (color_name), frame);
- if (CONSP (color_desc) && CONSP (XCDR (color_desc)))
- {
- color_idx = XINT (XCAR (XCDR (color_desc)));
- if (CONSP (XCDR (XCDR (color_desc))))
- {
- red = XINT (XCAR (XCDR (XCDR (color_desc))));
- green = XINT (XCAR (XCDR (XCDR (XCDR (color_desc)))));
- blue = XINT (XCAR (XCDR (XCDR (XCDR (XCDR (color_desc))))));
- }
- status = 1;
- }
- else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist"))))
- /* We were called early during startup, and the colors are not
- yet set up in tty-defined-color-alist. Don't return a failure
- indication, since this produces the annoying "Unable to
- load color" messages in the *Messages* buffer. */
- status = 1;
- }
- if (color_idx == FACE_TTY_DEFAULT_COLOR && *color_name)
+ if (*color_name)
+ status = tty_lookup_color (f, build_string (color_name), color_def, 0);
+
+ if (color_def->pixel == FACE_TTY_DEFAULT_COLOR && *color_name)
{
if (strcmp (color_name, "unspecified-fg") == 0)
- color_idx = FACE_TTY_DEFAULT_FG_COLOR;
+ color_def->pixel = FACE_TTY_DEFAULT_FG_COLOR;
else if (strcmp (color_name, "unspecified-bg") == 0)
- color_idx = FACE_TTY_DEFAULT_BG_COLOR;
+ color_def->pixel = FACE_TTY_DEFAULT_BG_COLOR;
}
- if (color_idx != FACE_TTY_DEFAULT_COLOR)
+ if (color_def->pixel != FACE_TTY_DEFAULT_COLOR)
status = 1;
- color_def->pixel = color_idx;
- color_def->red = red;
- color_def->green = green;
- color_def->blue = blue;
-
return status;
}
else if (FRAME_W32_P (f))
return w32_defined_color (f, color_name, color_def, alloc);
#endif
-#ifdef macintosh
+#ifdef MAC_OS
else if (FRAME_MAC_P (f))
return mac_defined_color (f, color_name, color_def, alloc);
#endif
DEFUN ("color-gray-p", Fcolor_gray_p, Scolor_gray_p, 1, 2, 0,
- "Return non-nil if COLOR is a shade of gray (or white or black).\n\
-FRAME specifies the frame and thus the display for interpreting COLOR.\n\
-If FRAME is nil or omitted, use the selected frame.")
- (color, frame)
+ doc: /* Return non-nil if COLOR is a shade of gray (or white or black).
+FRAME specifies the frame and thus the display for interpreting COLOR.
+If FRAME is nil or omitted, use the selected frame. */)
+ (color, frame)
Lisp_Object color, 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;
+ return face_color_gray_p (f, SDATA (color)) ? Qt : Qnil;
}
DEFUN ("color-supported-p", Fcolor_supported_p,
- Scolor_supported_p, 2, 3, 0,
- "Return non-nil if COLOR can be displayed on FRAME.\n\
-BACKGROUND-P non-nil means COLOR is used as a background.\n\
-If FRAME is nil or omitted, use the selected frame.\n\
-COLOR must be a valid color name.")
- (color, frame, background_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.
+If FRAME is nil or omitted, use the selected frame.
+COLOR must be a valid color name. */)
+ (color, frame, background_p)
Lisp_Object frame, color, background_p;
{
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)))
+ if (face_color_supported_p (f, SDATA (color), !NILP (background_p)))
return Qt;
return Qnil;
}
/* if the color map is full, defined_color will return a best match
to the values in an existing cell. */
- if (!defined_color (f, XSTRING (name)->data, &color, 1))
+ if (!defined_color (f, SDATA (name), &color, 1))
{
add_to_log ("Unable to load color \"%s\"", name, Qnil);
face_color_supported_p is smart enough to know that grays are
"supported" as background because we are supposed to use stipple
for them. */
- if (!face_color_supported_p (f, XSTRING (bg)->data, 0)
+ if (!face_color_supported_p (f, SDATA (bg), 0)
&& !NILP (Fbitmap_spec_p (Vface_default_stipple)))
{
x_destroy_bitmap (f, face->stipple);
unsigned long pixel;
{
#ifdef HAVE_X_WINDOWS
- BLOCK_INPUT;
- x_free_colors (f, &pixel, 1);
- UNBLOCK_INPUT;
+ if (pixel != -1)
+ {
+ BLOCK_INPUT;
+ x_free_colors (f, &pixel, 1);
+ UNBLOCK_INPUT;
+ }
#endif
}
struct face *face;
{
#ifdef HAVE_X_WINDOWS
+ if (face->colors_copied_bitwise_p)
+ return;
+
BLOCK_INPUT;
if (!face->foreground_defaulted_p)
font height, then for weight, then for slant.' This variable can be
set via set-face-font-sort-order. */
-#ifdef macintosh
+#ifdef MAC_OS
static int font_sort_order[4] = {
XLFD_SWIDTH, XLFD_POINT_SIZE, XLFD_WEIGHT, XLFD_SLANT
};
struct font_name *font;
{
double resy = FRAME_X_DISPLAY_INFO (f)->resy;
- double font_pixel = atoi (font->fields[XLFD_PIXEL_SIZE]);
+ char *pixel_field = font->fields[XLFD_PIXEL_SIZE];
+ double pixel;
int real_pt;
- if (font_pixel == 0)
+ if (*pixel_field == '[')
+ {
+ /* The pixel size field is `[A B C D]' which specifies
+ a transformation matrix.
+
+ A B 0
+ C D 0
+ 0 0 1
+
+ by which all glyphs of the font are transformed. The spec
+ says that s scalar value N for the pixel size is equivalent
+ to A = N * resx/resy, B = C = 0, D = N. */
+ char *start = pixel_field + 1, *end;
+ double matrix[4];
+ int i;
+
+ for (i = 0; i < 4; ++i)
+ {
+ matrix[i] = strtod (start, &end);
+ start = end;
+ }
+
+ pixel = matrix[3];
+ }
+ else
+ pixel = atoi (pixel_field);
+
+ if (pixel == 0)
real_pt = 0;
else
- real_pt = PT_PER_INCH * 10.0 * font_pixel / resy + 0.5;
+ real_pt = PT_PER_INCH * 10.0 * pixel / resy + 0.5;
return real_pt;
}
XLFD_RESY, XLFD_SLANT, and XLFD_WEIGHT in FONT->numeric. Value is
zero if the font name doesn't have the format we expect. The
expected format is a font name that starts with a `-' and has
- XLFD_LAST fields separated by `-'. (The XLFD specification allows
- forms of font names where certain field contents are enclosed in
- square brackets. We don't support that, for now. */
+ XLFD_LAST fields separated by `-'. */
static int
split_font_name (f, font, numeric_p)
font->fields[i] = p;
++i;
+ /* Pixel and point size may be of the form `[....]'. For
+ BNF, see XLFD spec, chapter 4. Negative values are
+ indicated by tilde characters which we replace with
+ `-' characters, here. */
+ if (*p == '['
+ && (i - 1 == XLFD_PIXEL_SIZE
+ || i - 1 == XLFD_POINT_SIZE))
+ {
+ char *start, *end;
+ int j;
+
+ for (++p; *p && *p != ']'; ++p)
+ if (*p == '~')
+ *p = '-';
+
+ /* Check that the matrix contains 4 floating point
+ numbers. */
+ for (j = 0, start = font->fields[i - 1] + 1;
+ j < 4;
+ ++j, start = end)
+ if (strtod (start, &end) == 0 && start == end)
+ break;
+
+ if (j < 4)
+ break;
+ }
+
while (*p && *p != '-')
++p;
for (tem = lfonts; CONSP (tem) && n < nfonts; tem = XCDR (tem))
{
Lisp_Object elt, tail;
- char *name = XSTRING (XCAR (tem))->data;
+ const char *name = SDATA (XCAR (tem));
/* Ignore fonts matching a pattern from face-ignored-fonts. */
for (tail = Vface_ignored_fonts; CONSP (tail); tail = XCDR (tail))
Lisp_Object entry = XCAR (list);
if (CONSP (entry)
&& STRINGP (XCAR (entry))
- && strcmp (XSTRING (XCAR (entry))->data, pattern) == 0)
+ && strcmp (SDATA (XCAR (entry)), pattern) == 0)
break;
list = XCDR (list);
}
STRINGP (name))
/* Ignore patterns equal to PATTERN because we tried that
already with no success. */
- && (strcmp (XSTRING (name)->data, pattern) == 0
- || (n = x_face_list_fonts (f, XSTRING (name)->data,
+ && (strcmp (SDATA (name), pattern) == 0
+ || (n = x_face_list_fonts (f, SDATA (name),
fonts, nfonts, 0),
n == 0)))
patterns = XCDR (patterns);
if (NILP (pattern))
{
- family_str = (NILP (family) ? "*" : (char *) XSTRING (family)->data);
- registry_str = (NILP (registry) ? "*" : (char *) XSTRING (registry)->data);
+ family_str = (NILP (family) ? "*" : (char *) SDATA (family));
+ registry_str = (NILP (registry) ? "*" : (char *) SDATA (registry));
pattern_str = (char *) alloca (strlen (family_str)
+ strlen (registry_str)
}
}
else
- pattern_str = (char *) XSTRING (pattern)->data;
+ pattern_str = (char *) SDATA (pattern);
return sorted_font_list (f, pattern_str, cmp_font_names, fonts);
}
{
Lisp_Object next = XCDR (tail);
if (!NILP (Fequal (XCAR (next), XCAR (tail))))
- XCDR (tail) = XCDR (next);
+ XSETCDR (tail, XCDR (next));
else
tail = XCDR (tail);
}
DEFUN ("x-family-fonts", Fx_family_fonts, Sx_family_fonts, 0, 2, 0,
- "Return a list of available fonts of family FAMILY on FRAME.\n\
-If FAMILY is omitted or nil, list all families.\n\
-Otherwise, FAMILY must be a string, possibly containing wildcards\n\
-`?' and `*'.\n\
-If FRAME is omitted or nil, use the selected frame.\n\
-Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT\n\
-SLANT FIXED-P FULL REGISTRY-AND-ENCODING].\n\
-FAMILY is the font family name. POINT-SIZE is the size of the\n\
-font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the\n\
-width, weight and slant of the font. These symbols are the same as for\n\
-face attributes. FIXED-P is non-nil if the font is fixed-pitch.\n\
-FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string\n\
-giving the registry and encoding of the font.\n\
-The result list is sorted according to the current setting of\n\
-the face font sort order.")
- (family, frame)
+ doc: /* Return a list of available fonts of family FAMILY on FRAME.
+If FAMILY is omitted or nil, list all families.
+Otherwise, FAMILY must be a string, possibly containing wildcards
+`?' and `*'.
+If FRAME is omitted or nil, use the selected frame.
+Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT
+SLANT FIXED-P FULL REGISTRY-AND-ENCODING].
+FAMILY is the font family name. POINT-SIZE is the size of the
+font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the
+width, weight and slant of the font. These symbols are the same as for
+face attributes. FIXED-P is non-nil if the font is fixed-pitch.
+FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string
+giving the registry and encoding of the font.
+The result list is sorted according to the current setting of
+the face font sort order. */)
+ (family, frame)
Lisp_Object family, frame;
{
struct frame *f = check_x_frame (frame);
struct gcpro gcpro1;
if (!NILP (family))
- CHECK_STRING (family, 1);
+ CHECK_STRING (family);
result = Qnil;
GCPRO1 (result);
DEFUN ("x-font-family-list", Fx_font_family_list, Sx_font_family_list,
0, 1, 0,
- "Return a list of available font families on FRAME.\n\
-If FRAME is omitted or nil, use the selected frame.\n\
-Value is a list of conses (FAMILY . FIXED-P) where FAMILY\n\
-is a font family, and FIXED-P is non-nil if fonts of that family\n\
-are fixed-pitch.")
- (frame)
+ doc: /* Return a list of available font families on FRAME.
+If FRAME is omitted or nil, use the selected frame.
+Value is a list of conses (FAMILY . FIXED-P) where FAMILY
+is a font family, and FIXED-P is non-nil if fonts of that family
+are fixed-pitch. */)
+ (frame)
Lisp_Object frame;
{
struct frame *f = check_x_frame (frame);
struct font_name *fonts;
Lisp_Object result;
struct gcpro gcpro1;
- int count = specpdl_ptr - specpdl;
+ int count = SPECPDL_INDEX ();
int limit;
/* Let's consider all fonts. Increase the limit for matching
DEFUN ("x-list-fonts", Fx_list_fonts, Sx_list_fonts, 1, 5, 0,
- "Return a list of the names of available fonts matching PATTERN.\n\
-If optional arguments FACE and FRAME are specified, return only fonts\n\
-the same size as FACE on FRAME.\n\
-PATTERN is a string, perhaps with wildcard characters;\n\
- the * character matches any substring, and\n\
- the ? character matches any single character.\n\
- PATTERN is case-insensitive.\n\
-FACE is a face name--a symbol.\n\
-\n\
-The return value is a list of strings, suitable as arguments to\n\
-set-face-font.\n\
-\n\
-Fonts Emacs can't use may or may not be excluded\n\
-even if they match PATTERN and FACE.\n\
-The optional fourth argument MAXIMUM sets a limit on how many\n\
-fonts to match. The first MAXIMUM fonts are reported.\n\
-The optional fifth argument WIDTH, if specified, is a number of columns\n\
-occupied by a character of a font. In that case, return only fonts\n\
-the WIDTH times as wide as FACE on FRAME.")
- (pattern, face, frame, maximum, width)
+ doc: /* Return a list of the names of available fonts matching PATTERN.
+If optional arguments FACE and FRAME are specified, return only fonts
+the same size as FACE on FRAME.
+PATTERN is a string, perhaps with wildcard characters;
+ the * character matches any substring, and
+ the ? character matches any single character.
+ PATTERN is case-insensitive.
+FACE is a face name--a symbol.
+
+The return value is a list of strings, suitable as arguments to
+set-face-font.
+
+Fonts Emacs can't use may or may not be excluded
+even if they match PATTERN and FACE.
+The optional fourth argument MAXIMUM sets a limit on how many
+fonts to match. The first MAXIMUM fonts are reported.
+The optional fifth argument WIDTH, if specified, is a number of columns
+occupied by a character of a font. In that case, return only fonts
+the WIDTH times as wide as FACE on FRAME. */)
+ (pattern, face, frame, maximum, width)
Lisp_Object pattern, face, frame, maximum, width;
{
struct frame *f;
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. */
Lisp_Object aliased;
if (STRINGP (face_name))
- face_name = intern (XSTRING (face_name)->data);
+ face_name = intern (SDATA (face_name));
while (SYMBOLP (face_name))
{
int pt;
int have_xlfd_p;
int fontset;
- char *font_name = XSTRING (fontname)->data;
+ char *font_name = SDATA (fontname);
struct font_info *font_info;
/* If FONTNAME is actually a fontset name, get ASCII font name of it. */
fontset = fs_query_fontset (fontname, 0);
if (fontset >= 0)
- font_name = XSTRING (fontset_ascii (fontset))->data;
+ font_name = SDATA (fontset_ascii (fontset));
/* Check if FONT_NAME is surely available on the system. Usually
FONT_NAME is already cached for the frame F and FS_LOAD_FONT
/* 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. */
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
+ 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
add_to_log ("Invalid face color", color_name, Qnil);
}
else if (SYMBOLP (first)
- && *XSYMBOL (first)->name->data == ':')
+ && *SDATA (SYMBOL_NAME (first)) == ':')
{
/* Assume this is the property list form. */
while (CONSP (prop) && CONSP (XCDR (prop)))
DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face,
Sinternal_make_lisp_face, 1, 2, 0,
- "Make FACE, a symbol, a Lisp face with all attributes nil.\n\
-If FACE was not known as a face before, create a new one.\n\
-If optional argument FRAME is specified, make a frame-local face\n\
-for that frame. Otherwise operate on the global face definition.\n\
-Value is a vector of face attributes.")
- (face, frame)
+ doc: /* Make FACE, a symbol, a Lisp face with all attributes nil.
+If FACE was not known as a face before, create a new one.
+If optional argument FRAME is specified, make a frame-local face
+for that frame. Otherwise operate on the global face definition.
+Value is a vector of face attributes. */)
+ (face, frame)
Lisp_Object face, frame;
{
Lisp_Object global_lface, lface;
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);
}
else
lface = global_lface;
+ /* 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;
+
xassert (LFACEP (lface));
check_lface (lface);
return lface;
DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p,
Sinternal_lisp_face_p, 1, 2, 0,
- "Return non-nil if FACE names a face.\n\
-If optional second parameter FRAME is non-nil, check for the\n\
-existence of a frame-local face with name FACE on that frame.\n\
-Otherwise check for the existence of a global face.")
- (face, frame)
+ doc: /* Return non-nil if FACE names a face.
+If optional second parameter 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)
Lisp_Object face, frame;
{
Lisp_Object lface;
if (!NILP (frame))
{
- CHECK_LIVE_FRAME (frame, 1);
+ CHECK_LIVE_FRAME (frame);
lface = lface_from_face_name (XFRAME (frame), face, 0);
}
else
DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face,
Sinternal_copy_lisp_face, 4, 4, 0,
- "Copy face FROM to TO.\n\
-If FRAME it t, copy the global face definition of FROM to the\n\
-global face definition of TO. Otherwise, copy the frame-local\n\
-definition of FROM on FRAME to the frame-local definition of TO\n\
-on NEW-FRAME, or FRAME if NEW-FRAME is nil.\n\
-\n\
-Value is TO.")
- (from, to, frame, new_frame)
+ 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.
+
+Value is TO. */)
+ (from, to, frame, new_frame)
Lisp_Object from, to, frame, new_frame;
{
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);
}
bcopy (XVECTOR (lface)->contents, XVECTOR (copy)->contents,
LFACE_VECTOR_SIZE * sizeof (Lisp_Object));
+ /* 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;
+
return to;
}
DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute,
Sinternal_set_lisp_face_attribute, 3, 4, 0,
- "Set attribute ATTR of FACE to VALUE.\n\
-FRAME being a frame means change the face on that frame.\n\
-FRAME nil means change change the face of the selected frame.\n\
-FRAME t means change the default for new frames.\n\
-FRAME 0 means change the face on all frames, and change the default\n\
- for new frames.")
- (face, attr, value, frame)
+ doc: /* Set attribute ATTR of FACE to VALUE.
+FRAME being a frame means change the face on that frame.
+FRAME nil means change the face of the selected frame.
+FRAME t means change the default for new frames.
+FRAME 0 means change the face on all frames, and change the default
+ for new frames. */)
+ (face, attr, value, frame)
Lisp_Object face, attr, value, frame;
{
Lisp_Object lface;
/* 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);
- if (XSTRING (value)->size == 0)
+ CHECK_STRING (value);
+ if (SCHARS (value) == 0)
signal_error ("Invalid face family", value);
}
old_value = LFACE_FAMILY (lface);
{
if (!UNSPECIFIEDP (value))
{
- Lisp_Object test =
- (EQ (face, Qdefault) ? value :
- /* 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));
+ Lisp_Object test;
- if (!INTEGERP(test) || XINT(test) <= 0)
+ test = (EQ (face, Qdefault)
+ ? value
+ /* 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));
+
+ if (!INTEGERP (test) || XINT (test) <= 0)
signal_error ("Invalid face height", 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);
}
&& !EQ (value, Qnil))
/* Underline color. */
|| (STRINGP (value)
- && XSTRING (value)->size == 0))
+ && SCHARS (value) == 0))
signal_error ("Invalid face underline", value);
old_value = LFACE_UNDERLINE (lface);
&& !EQ (value, Qnil))
/* Overline color. */
|| (STRINGP (value)
- && XSTRING (value)->size == 0))
+ && SCHARS (value) == 0))
signal_error ("Invalid face overline", value);
old_value = LFACE_OVERLINE (lface);
&& !EQ (value, Qnil))
/* Strike-through color. */
|| (STRINGP (value)
- && XSTRING (value)->size == 0))
+ && SCHARS (value) == 0))
signal_error ("Invalid face strike-through", value);
old_value = LFACE_STRIKE_THROUGH (lface);
else if (INTEGERP (value))
valid_p = XINT (value) != 0;
else if (STRINGP (value))
- valid_p = XSTRING (value)->size > 0;
+ valid_p = SCHARS (value) > 0;
else if (CONSP (value))
{
Lisp_Object tem;
}
else if (EQ (k, QCcolor))
{
- if (!STRINGP (v) || XSTRING (v)->size == 0)
+ if (!STRINGP (v) || SCHARS (v) == 0)
break;
}
else if (EQ (k, QCstyle))
{
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);
- if (XSTRING (value)->size == 0)
+ CHECK_STRING (value);
+ if (SCHARS (value) == 0)
signal_error ("Empty foreground color value", value);
}
old_value = LFACE_FOREGROUND (lface);
/* 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);
- if (XSTRING (value)->size == 0)
+ CHECK_STRING (value);
+ if (SCHARS (value) == 0)
signal_error ("Empty background color value", value);
}
old_value = LFACE_BACKGROUND (lface);
{
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 (EQ (frame, Qt) || 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))
#ifdef HAVE_WINDOW_SYSTEM
/* Changed font-related attributes of the `default' face are
reflected in changed `font' frame parameters. */
- if ((font_related_attr_p || font_attr_p)
+ if (FRAMEP (frame)
+ && (font_related_attr_p || font_attr_p)
&& lface_fully_specified_p (XVECTOR (lface)->contents))
set_font_frame_param (frame, lface);
else
}
#endif /* HAVE_WINDOW_SYSTEM */
else if (EQ (face, Qmenu))
- ++menu_face_change_count;
+ {
+ /* Indicate that we have to update the menu bar when
+ realizing faces on FRAME. FRAME t change the
+ default for new frames. We do this by setting
+ setting the flag in new face caches */
+ if (FRAMEP (frame))
+ {
+ struct frame *f = XFRAME (frame);
+ if (FRAME_FACE_CACHE (f) == NULL)
+ FRAME_FACE_CACHE (f) = make_face_cache (f);
+ FRAME_FACE_CACHE (f)->menu_face_changed_p = 1;
+ }
+ else
+ menu_face_changed_default = 1;
+ }
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);
- XCAR (cons) = param;
- XCDR (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;
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);
doesn't take a frame argument. */
DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource,
- Sinternal_face_x_get_resource, 3, 3, 0, "")
- (resource, class, frame)
+ Sinternal_face_x_get_resource, 3, 3, 0, doc: /* */)
+ (resource, class, frame)
Lisp_Object resource, class, frame;
{
Lisp_Object value = Qnil;
#ifndef WINDOWSNT
-#ifndef macintosh
- CHECK_STRING (resource, 0);
- CHECK_STRING (class, 1);
- CHECK_LIVE_FRAME (frame, 2);
+#ifndef MAC_OS
+ 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);
UNBLOCK_INPUT;
-#endif /* not macintosh */
+#endif /* not MAC_OS */
#endif /* not WINDOWSNT */
return value;
}
xassert (STRINGP (value));
- if (xstricmp (XSTRING (value)->data, "on") == 0
- || xstricmp (XSTRING (value)->data, "true") == 0)
+ if (xstricmp (SDATA (value), "on") == 0
+ || xstricmp (SDATA (value), "true") == 0)
result = Qt;
- else if (xstricmp (XSTRING (value)->data, "off") == 0
- || xstricmp (XSTRING (value)->data, "false") == 0)
+ else if (xstricmp (SDATA (value), "off") == 0
+ || xstricmp (SDATA (value), "false") == 0)
result = Qnil;
- else if (xstricmp (XSTRING (value)->data, "unspecified") == 0)
+ else if (xstricmp (SDATA (value), "unspecified") == 0)
result = Qunspecified;
else if (signal_p)
signal_error ("Invalid face attribute value from X resource", value);
DEFUN ("internal-set-lisp-face-attribute-from-resource",
Finternal_set_lisp_face_attribute_from_resource,
Sinternal_set_lisp_face_attribute_from_resource,
- 3, 4, 0, "")
- (face, attr, value, frame)
+ 3, 4, 0, doc: /* */)
+ (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)
+ if (xstricmp (SDATA (value), "unspecified") == 0)
value = Qunspecified;
else if (EQ (attr, QCheight))
{
else if (EQ (attr, QCbold) || EQ (attr, QCitalic))
value = face_boolean_x_resource_value (value, 1);
else if (EQ (attr, QCweight) || EQ (attr, QCslant) || EQ (attr, QCwidth))
- value = intern (XSTRING (value)->data);
+ value = intern (SDATA (value));
else if (EQ (attr, QCreverse_video) || EQ (attr, QCinverse_video))
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);
}
char line[512];
Lisp_Object lface = lface_from_face_name (f, Qmenu, 1);
struct face *face = FACE_FROM_ID (f, MENU_FACE_ID);
- char *myname = XSTRING (Vx_resource_name)->data;
+ const char *myname = SDATA (Vx_resource_name);
int changed_p = 0;
#ifdef USE_MOTIF
const char *popup_path = "popup_menu";
{
sprintf (line, "%s.%s*foreground: %s",
myname, popup_path,
- XSTRING (LFACE_FOREGROUND (lface))->data);
+ SDATA (LFACE_FOREGROUND (lface)));
XrmPutLineResource (&rdb, line);
sprintf (line, "%s.pane.menubar*foreground: %s",
- myname, XSTRING (LFACE_FOREGROUND (lface))->data);
+ myname, SDATA (LFACE_FOREGROUND (lface)));
XrmPutLineResource (&rdb, line);
changed_p = 1;
}
{
sprintf (line, "%s.%s*background: %s",
myname, popup_path,
- XSTRING (LFACE_BACKGROUND (lface))->data);
+ SDATA (LFACE_BACKGROUND (lface)));
XrmPutLineResource (&rdb, line);
sprintf (line, "%s.pane.menubar*background: %s",
- myname, XSTRING (LFACE_BACKGROUND (lface))->data);
+ myname, SDATA (LFACE_BACKGROUND (lface)));
XrmPutLineResource (&rdb, line);
changed_p = 1;
}
}
if (changed_p && f->output_data.x->menubar_widget)
- {
- free_frame_menubar (f);
- set_frame_menubar (f, 1, 1);
- }
+ free_frame_menubar (f);
}
}
#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,
2, 3, 0,
- "Return face attribute KEYWORD of face SYMBOL.\n\
-If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid\n\
-face attribute name, signal an error.\n\
-If the optional argument FRAME is given, report on face FACE in that\n\
-frame. If FRAME is t, report on the defaults for face FACE (for new\n\
-frames). If FRAME is omitted or nil, use the selected frame.")
- (symbol, keyword, frame)
+ 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
+frames). If FRAME is omitted or nil, use the selected frame. */)
+ (symbol, keyword, frame)
Lisp_Object symbol, keyword, frame;
{
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);
}
DEFUN ("internal-lisp-face-attribute-values",
Finternal_lisp_face_attribute_values,
Sinternal_lisp_face_attribute_values, 1, 1, 0,
- "Return a list of valid discrete values for face attribute ATTR.\n\
-Value is nil if ATTR doesn't have a discrete set of valid values.")
- (attr)
+ doc: /* Return a list of valid discrete values for face attribute ATTR.
+Value is nil if ATTR doesn't have a discrete set of valid values. */)
+ (attr)
Lisp_Object attr;
{
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,
- "Add attributes from frame-default definition of FACE to FACE on FRAME.\n\
-Default face attributes override any local face attributes.")
- (face, 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,
- "Return the font name of face FACE, or nil if it is unspecified.\n\
-If the optional argument FRAME is given, report on face FACE in that frame.\n\
-If FRAME is t, report on the defaults for face FACE (for new frames).\n\
- The font default for a face is either nil, or a list\n\
- of the form (bold), (italic) or (bold italic).\n\
-If FRAME is omitted or nil, use the selected frame.")
- (face, frame)
+ 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
+ of the form (bold), (italic) or (bold italic).
+If FRAME is omitted or nil, use the selected frame. */)
+ (face, frame)
Lisp_Object face, frame;
{
if (EQ (frame, Qt))
&& !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);
switch (XTYPE (a))
{
case Lisp_String:
- equal_p = ((STRING_BYTES (XSTRING (a))
- == STRING_BYTES (XSTRING (b)))
- && bcmp (XSTRING (a)->data, XSTRING (b)->data,
- STRING_BYTES (XSTRING (a))) == 0);
+ equal_p = ((SBYTES (a)
+ == SBYTES (b))
+ && bcmp (SDATA (a), SDATA (b),
+ SBYTES (a)) == 0);
break;
case Lisp_Int:
DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p,
Sinternal_lisp_face_equal_p, 2, 3, 0,
- "True if FACE1 and FACE2 are equal.\n\
-If the optional argument FRAME is given, report on face FACE in that frame.\n\
-If FRAME is t, report on the defaults for face FACE (for new frames).\n\
-If FRAME is omitted or nil, use the selected frame.")
- (face1, face2, frame)
+ 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 FRAME is omitted or nil, use the selected frame. */)
+ (face1, face2, frame)
Lisp_Object face1, face2, frame;
{
int equal_p;
DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p,
Sinternal_lisp_face_empty_p, 1, 2, 0,
- "True if FACE has no attribute specified.\n\
-If the optional argument FRAME is given, report on face FACE in that frame.\n\
-If FRAME is t, report on the defaults for face FACE (for new frames).\n\
-If FRAME is omitted or nil, use the selected frame.")
- (face, frame)
+ doc: /* True if FACE has no attribute specified.
+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 FRAME is omitted or nil, use the selected frame. */)
+ (face, frame)
Lisp_Object face, frame;
{
struct frame *f;
if (NILP (frame))
frame = selected_frame;
- CHECK_LIVE_FRAME (frame, 0);
+ CHECK_LIVE_FRAME (frame);
f = XFRAME (frame);
if (EQ (frame, Qt))
DEFUN ("frame-face-alist", Fframe_face_alist, Sframe_face_alist,
0, 1, 0,
- "Return an alist of frame-local faces defined on FRAME.\n\
-For internal use only.")
- (frame)
+ doc: /* Return an alist of frame-local faces defined on FRAME.
+For internal use only. */)
+ (frame)
Lisp_Object frame;
{
struct frame *f = frame_or_selected_frame (frame, 0);
hash_string_case_insensitive (string)
Lisp_Object string;
{
- unsigned char *s;
+ const unsigned char *s;
unsigned hash = 0;
xassert (STRINGP (string));
- for (s = XSTRING (string)->data; *s; ++s)
+ for (s = SDATA (string); *s; ++s)
hash = (hash << 1) ^ tolower (*s);
return hash;
}
{
xassert (lface_fully_specified_p (lface1)
&& lface_fully_specified_p (lface2));
- return (xstricmp (XSTRING (lface1[LFACE_FAMILY_INDEX])->data,
- XSTRING (lface2[LFACE_FAMILY_INDEX])->data) == 0
+ return (xstricmp (SDATA (lface1[LFACE_FAMILY_INDEX]),
+ SDATA (lface2[LFACE_FAMILY_INDEX])) == 0
&& EQ (lface1[LFACE_HEIGHT_INDEX], lface2[LFACE_HEIGHT_INDEX])
&& EQ (lface1[LFACE_SWIDTH_INDEX], lface2[LFACE_SWIDTH_INDEX])
&& EQ (lface1[LFACE_AVGWIDTH_INDEX], lface2[LFACE_AVGWIDTH_INDEX])
&& (EQ (lface1[LFACE_FONT_INDEX], lface2[LFACE_FONT_INDEX])
|| (STRINGP (lface1[LFACE_FONT_INDEX])
&& STRINGP (lface2[LFACE_FONT_INDEX])
- && xstricmp (XSTRING (lface1[LFACE_FONT_INDEX])->data,
- XSTRING (lface2[LFACE_FONT_INDEX])->data))));
+ && xstricmp (SDATA (lface1[LFACE_FONT_INDEX]),
+ SDATA (lface2[LFACE_FONT_INDEX])))));
}
#ifdef WINDOWSNT
xgcv.font = face->font;
#endif
-#ifdef macintosh
+#ifdef MAC_OS
xgcv.font = face->font;
#endif
mask |= GCFont;
}
\f
+/* Returns the `distance' between the colors X and Y. */
+
+static int
+color_distance (x, y)
+ XColor *x, *y;
+{
+ /* This formula is from a paper title `Colour metric' by Thiadmer Riemersma.
+ Quoting from that paper:
+
+ This formula has results that are very close to L*u*v* (with the
+ modified lightness curve) and, more importantly, it is a more even
+ algorithm: it does not have a range of colours where it suddenly
+ gives far from optimal results.
+
+ See <http://www.compuphase.com/cmetric.htm> for more info. */
+
+ long r = (x->red - y->red) >> 8;
+ long g = (x->green - y->green) >> 8;
+ long b = (x->blue - y->blue) >> 8;
+ long r_mean = (x->red + y->red) >> 9;
+
+ return
+ (((512 + r_mean) * r * r) >> 8)
+ + 4 * g * g
+ + (((767 - r_mean) * b * b) >> 8);
+}
+
+
+DEFUN ("color-distance", Fcolor_distance, Scolor_distance, 2, 3, 0,
+ doc: /* Return an integer distance between COLOR1 and COLOR2 on FRAME.
+COLOR1 and COLOR2 may be either strings containing the color name,
+or lists of the form (RED GREEN BLUE).
+If FRAME is unspecified or nil, the current frame is used. */)
+ (color1, color2, frame)
+ Lisp_Object color1, color2, frame;
+{
+ struct frame *f;
+ XColor cdef1, cdef2;
+
+ if (NILP (frame))
+ frame = selected_frame;
+ CHECK_LIVE_FRAME (frame);
+ f = XFRAME (frame);
+
+ if ((CONSP (color1) && !parse_rgb_list (color1, &cdef1))
+ || !STRINGP (color1)
+ || !defined_color (f, SDATA (color1), &cdef1, 0))
+ signal_error ("Invalid color", color1);
+ if ((CONSP (color2) && !parse_rgb_list (color2, &cdef2))
+ || !STRINGP (color2)
+ || !defined_color (f, SDATA (color2), &cdef2, 0))
+ signal_error ("Invalid color", color2);
+
+ return make_number (color_distance (&cdef1, &cdef2));
+}
+
+\f
+/***********************************************************************
+ Face capability testing for ttys
+ ***********************************************************************/
+
+
+/* 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
+
+
+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.
+
+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;
+}
+
+
+\f
/***********************************************************************
Face Cache
***********************************************************************/
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;
}
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
/***********************************************************************
DEFUN ("internal-set-font-selection-order",
Finternal_set_font_selection_order,
Sinternal_set_font_selection_order, 1, 1, 0,
- "Set font selection order for face font selection to ORDER.\n\
-ORDER must be a list of length 4 containing the symbols `:width',\n\
-`:height', `:weight', and `:slant'. Face attributes appearing\n\
-first in ORDER are matched first, e.g. if `:height' appears before\n\
-`:weight' in ORDER, font selection first tries to find a font with\n\
-a suitable height, and then tries to match the font weight.\n\
-Value is ORDER.")
- (order)
- Lisp_Object order;
+ doc: /* Set font selection order for face font selection to ORDER.
+ORDER must be a list of length 4 containing the symbols `:width',
+`:height', `:weight', and `:slant'. Face attributes appearing
+first in ORDER are matched first, e.g. if `:height' appears before
+`:weight' in ORDER, font selection first tries to find a font with
+a suitable height, and then tries to match the font weight.
+Value is ORDER. */)
+ (order)
+ Lisp_Object order;
{
Lisp_Object list;
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,
- "Define alternative font families to try in face font selection.\n\
-ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.\n\
-Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can\n\
-be found. Value is ALIST.")
- (alist)
+ 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,
- "Define alternative font registries to try in face font selection.\n\
-ALIST is an alist of (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...) entries.\n\
-Each ALTERNATIVE is tried in order if no fonts of font registry REGISTRY can\n\
-be found. Value is ALIST.")
- (alist)
+ 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;
static int
may_use_scalable_font_p (font)
- char *font;
+ const char *font;
{
if (EQ (Vscalable_fonts_allowed, Qt))
return 1;
}
-/* Get a list of matching fonts on frame F, considering alterntive
- font families from Vface_alternative_font_registry_alist.
+/* Get a list of matching fonts on frame F, considering FAMILY
+ and alternative font families from Vface_alternative_font_registry_alist.
FAMILY is the font family whose alternatives are considered.
Lisp_Object alter;
int nfonts = 0;
- /* Try alternative font families. */
- alter = Fassoc (family, Vface_alternative_font_family_alist);
- if (CONSP (alter))
+ nfonts = font_list (f, Qnil, family, registry, fonts);
+ if (nfonts == 0)
{
- for (alter = XCDR (alter);
- CONSP (alter) && nfonts == 0;
- alter = XCDR (alter))
+ /* Try alternative font families. */
+ alter = Fassoc (family, Vface_alternative_font_family_alist);
+ if (CONSP (alter))
+ {
+ for (alter = XCDR (alter);
+ CONSP (alter) && nfonts == 0;
+ alter = XCDR (alter))
+ {
+ if (STRINGP (XCAR (alter)))
+ nfonts = font_list (f, Qnil, XCAR (alter), registry, fonts);
+ }
+ }
+
+ /* Try scalable fonts before giving up. */
+ if (nfonts == 0 && NILP (Vscalable_fonts_allowed))
{
- if (STRINGP (XCAR (alter)))
- nfonts = font_list (f, Qnil, XCAR (alter), registry, fonts);
+ int count = SPECPDL_INDEX ();
+ specbind (Qscalable_fonts_allowed, Qt);
+ nfonts = try_alternative_families (f, family, registry, fonts);
+ unbind_to (count, Qnil);
}
}
-
return nfonts;
}
/* Get a list of matching fonts on frame F.
- FAMILY, if a string, specifies a font family. If nil, use
- the family specified in Lisp face attributes ATTRS instead.
+ FAMILY, if a string, specifies a font family derived from the fontset.
+ It is only used if the face does not specify any family in ATTRS or
+ if we cannot find any font of the face's family.
REGISTRY, if a string, specifies a font registry and encoding to
match. A value of nil means include fonts of any registry and
encoding.
+ If PREFER_FACE_FAMILY is nonzero, perfer face's family to FAMILY.
+ Otherwise, prefer FAMILY.
+
Return in *FONTS a pointer to a vector of font_name structures for
the fonts matched. Value is the number of fonts found. */
static int
-try_font_list (f, attrs, family, registry, fonts)
+try_font_list (f, attrs, family, registry, fonts, prefer_face_family)
struct frame *f;
Lisp_Object *attrs;
Lisp_Object family, registry;
struct font_name **fonts;
+ int prefer_face_family;
{
int nfonts = 0;
+ Lisp_Object face_family = attrs[LFACE_FAMILY_INDEX];
+ Lisp_Object try_family;
+
+ try_family = prefer_face_family ? face_family : family;
+
+ if (STRINGP (try_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);
+#endif
- if (STRINGP (attrs[LFACE_FAMILY_INDEX]))
- {
- Lisp_Object face_family;
- face_family = attrs[LFACE_FAMILY_INDEX];
- nfonts = font_list (f, Qnil, face_family, registry, fonts);
- if (nfonts == 0)
- nfonts = try_alternative_families (f, face_family, registry, fonts);
- }
+ if (! prefer_face_family)
+ family = face_family;
+
+ if (nfonts == 0 && STRINGP (family))
+ nfonts = try_alternative_families (f, family, registry, fonts);
+ /* Try font family of the default face or "fixed". */
if (nfonts == 0)
{
+ struct face *default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
+ if (default_face)
+ family = default_face->lface[LFACE_FAMILY_INDEX];
+ else
+ family = build_string ("fixed");
nfonts = font_list (f, Qnil, family, registry, fonts);
- if (nfonts == 0 && !NILP (family))
- {
- nfonts = try_alternative_families (f, family, registry, fonts);
-
- /* Try font family of the default face or "fixed". */
- if (nfonts == 0)
- {
- struct face *default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
- if (default_face)
- family = default_face->lface[LFACE_FAMILY_INDEX];
- else
- family = build_string ("fixed");
- nfonts = font_list (f, Qnil, family, registry, fonts);
- }
-
- /* Try any family with the given registry. */
- if (nfonts == 0)
- nfonts = font_list (f, Qnil, Qnil, registry, fonts);
- }
}
+
+ /* Try any family with the given registry. */
+ if (nfonts == 0)
+ nfonts = font_list (f, Qnil, Qnil, registry, fonts);
return nfonts;
}
/* If what we got is a name pattern, return it. */
if (STRINGP (pattern))
- return xstrdup (XSTRING (pattern)->data);
+ return xstrdup (SDATA (pattern));
/* Get a list of fonts matching that pattern and choose the
best match for the specified face attributes from it. */
- nfonts = try_font_list (f, attrs, XCAR (pattern), XCDR (pattern), &fonts);
+ nfonts = try_font_list (f, attrs, XCAR (pattern), XCDR (pattern), &fonts,
+ (SINGLE_BYTE_CHAR_P (c)
+ || CHAR_CHARSET (c) == charset_latin_iso8859_1));
width_ratio = (SINGLE_BYTE_CHAR_P (c)
? 1
: CHARSET_WIDTH (CHAR_CHARSET (c)));
struct frame *f;
{
int success_p = 0;
- int count = BINDING_STACK_SIZE ();
+ int count = SPECPDL_INDEX ();
- /* Block input there so that we won't be surprised by an X expose
- event, for instance without having the faces set up. */
+ /* Block input here so that we won't be surprised by an X expose
+ event, for instance, without having the faces set up. */
BLOCK_INPUT;
specbind (Qscalable_fonts_allowed, Qt);
if (realize_default_face (f))
{
realize_named_face (f, Qmode_line, MODE_LINE_FACE_ID);
+ realize_named_face (f, Qmode_line_inactive, MODE_LINE_INACTIVE_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);
realize_named_face (f, Qmenu, MENU_FACE_ID);
/* Reflect changes in the `menu' face in menu bars. */
- if (menu_face_change_count)
+ if (FRAME_FACE_CACHE (f)->menu_face_changed_p)
{
- --menu_face_change_count;
+ FRAME_FACE_CACHE (f)->menu_face_changed_p = 0;
#ifdef USE_X_TOOLKIT
x_update_menu_appearance (f);
#endif
LFACE_FAMILY (lface) = build_string ("default");
LFACE_SWIDTH (lface) = Qnormal;
LFACE_HEIGHT (lface) = make_number (1);
- LFACE_WEIGHT (lface) = Qnormal;
- LFACE_SLANT (lface) = Qnormal;
+ if (UNSPECIFIEDP (LFACE_WEIGHT (lface)))
+ LFACE_WEIGHT (lface) = Qnormal;
+ if (UNSPECIFIEDP (LFACE_SLANT (lface)))
+ LFACE_SLANT (lface) = Qnormal;
LFACE_AVGWIDTH (lface) = Qunspecified;
}
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;
fontset = default_face->fontset;
face->fontset = make_fontset_for_ascii_face (f, fontset);
face->font = NULL; /* to force realize_face to load font */
-
-#ifdef macintosh
- /* Load the font if it is specified in ATTRS. This fixes
- changing frame font on the Mac. */
- if (STRINGP (attrs[LFACE_FONT_INDEX]))
- {
- struct font_info *font_info =
- FS_LOAD_FONT (f, 0, XSTRING (attrs[LFACE_FONT_INDEX])->data, -1);
- if (font_info)
- face->font = font_info->font;
- }
-#endif
}
/* Load colors, and set remaining attributes. */
color = face->lface[idx];
if (STRINGP (color)
- && XSTRING (color)->size
+ && SCHARS (color)
&& CONSP (Vtty_defined_color_alist)
&& (def = assq_no_quit (color, call1 (Qtty_color_alist, frame)),
CONSP (def)))
DEFUN ("tty-suppress-bold-inverse-default-colors",
Ftty_suppress_bold_inverse_default_colors,
Stty_suppress_bold_inverse_default_colors, 1, 1, 0,
- "Suppress/allow boldness of faces with inverse default colors.\n\
-SUPPRESS non-nil means suppress it.\n\
-This affects bold faces on TTYs whose foreground is the default background\n\
-color of the display and whose background is the default foreground color.\n\
-For such faces, the bold face attribute is ignored if this variable\n\
-is non-nil.")
- (suppress)
+ 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.
+For such faces, the bold face attribute is ignored if this variable
+is non-nil. */)
+ (suppress)
Lisp_Object suppress;
{
tty_suppress_bold_inverse_default_colors_p = !NILP (suppress);
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
Limit is the maximum position up to which to check for property
changes in Fnext_single_property_change. Strings are usually
short, so set the limit to the end of the string. */
- XSETFASTINT (limit, XSTRING (string)->size);
+ XSETFASTINT (limit, SCHARS (string));
end = Fnext_single_property_change (position, prop_name, string, limit);
if (INTEGERP (end))
*endptr = XFASTINT (end);
#endif
fprintf (stderr, "foreground: 0x%lx (%s)\n",
face->foreground,
- XSTRING (face->lface[LFACE_FOREGROUND_INDEX])->data);
+ SDATA (face->lface[LFACE_FOREGROUND_INDEX]));
fprintf (stderr, "background: 0x%lx (%s)\n",
face->background,
- XSTRING (face->lface[LFACE_BACKGROUND_INDEX])->data);
+ SDATA (face->lface[LFACE_BACKGROUND_INDEX]));
fprintf (stderr, "font_name: %s (%s)\n",
face->font_name,
- XSTRING (face->lface[LFACE_FAMILY_INDEX])->data);
+ SDATA (face->lface[LFACE_FAMILY_INDEX]));
#ifdef HAVE_X_WINDOWS
fprintf (stderr, "font = %p\n", face->font);
#endif
fprintf (stderr, "fontset: %d\n", face->fontset);
fprintf (stderr, "underline: %d (%s)\n",
face->underline_p,
- XSTRING (Fsymbol_name (face->lface[LFACE_UNDERLINE_INDEX]))->data);
+ SDATA (Fsymbol_name (face->lface[LFACE_UNDERLINE_INDEX])));
fprintf (stderr, "hash: %d\n", face->hash);
fprintf (stderr, "charset: %d\n", face->charset);
}
-DEFUN ("dump-face", Fdump_face, Sdump_face, 0, 1, 0, "")
- (n)
+DEFUN ("dump-face", Fdump_face, Sdump_face, 0, 1, 0, doc: /* */)
+ (n)
Lisp_Object n;
{
if (NILP (n))
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");
DEFUN ("show-face-resources", Fshow_face_resources, Sshow_face_resources,
- 0, 0, 0, "")
- ()
+ 0, 0, 0, doc: /* */)
+ ()
{
fprintf (stderr, "number of colors = %d\n", ncolors_allocated);
fprintf (stderr, "number of pixmaps = %d\n", npixmaps_allocated);
staticpro (&Qborder);
Qmouse = intern ("mouse");
staticpro (&Qmouse);
+ Qmode_line_inactive = intern ("mode-line-inactive");
+ staticpro (&Qmode_line_inactive);
Qtty_color_desc = intern ("tty-color-desc");
staticpro (&Qtty_color_desc);
+ Qtty_color_standard_values = intern ("tty-color-standard-values");
+ staticpro (&Qtty_color_standard_values);
Qtty_color_by_index = intern ("tty-color-by-index");
staticpro (&Qtty_color_by_index);
Qtty_color_alist = intern ("tty-color-alist");
#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_merge_in_global_face);
defsubr (&Sface_font);
defsubr (&Sframe_face_alist);
+ defsubr (&Stty_supports_face_attributes_p);
+ defsubr (&Scolor_distance);
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);
#endif
DEFVAR_LISP ("font-list-limit", &Vfont_list_limit,
- "*Limit for font matching.\n\
-If an integer > 0, font matching functions won't load more than\n\
-that number of fonts when searching for a matching font.");
+ doc: /* *Limit for font matching.
+If an integer > 0, font matching functions won't load more than
+that number of fonts when searching for a matching font. */);
Vfont_list_limit = make_number (DEFAULT_FONT_LIST_LIMIT);
DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults,
- "List of global face definitions (for internal use only.)");
+ doc: /* List of global face definitions (for internal use only.) */);
Vface_new_frame_defaults = Qnil;
DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple,
- "*Default stipple pattern used on monochrome displays.\n\
-This stipple pattern is used on monochrome displays\n\
-instead of shades of gray for a face background color.\n\
-See `set-face-stipple' for possible values for this variable.");
+ doc: /* *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 values for this variable. */);
Vface_default_stipple = build_string ("gray3");
DEFVAR_LISP ("tty-defined-color-alist", &Vtty_defined_color_alist,
- "An alist of defined terminal colors and their RGB values.");
+ doc: /* An alist of defined terminal colors and their RGB values. */);
Vtty_defined_color_alist = Qnil;
DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed,
- "Allowed scalable fonts.\n\
-A value of nil means don't allow any scalable fonts.\n\
-A value of t means allow any scalable font.\n\
-Otherwise, value must be a list of regular expressions. A font may be\n\
-scaled if its name matches a regular expression in the list.");
- Vscalable_fonts_allowed = Qt;
+ doc: /* Allowed scalable fonts.
+A value of nil means don't allow any scalable fonts.
+A value of t means allow any scalable font.
+Otherwise, value must be a list of regular expressions. A font may be
+scaled if its name matches a regular expression in the list.
+Note that if value is nil, a scalable font might still be used, if no
+other font of the appropriate family and registry is available. */);
+ Vscalable_fonts_allowed = Qnil;
DEFVAR_LISP ("face-ignored-fonts", &Vface_ignored_fonts,
- "List of ignored fonts.\n\
-Each element is a regular expression that matches names of fonts to ignore.");
+ doc: /* List of ignored fonts.
+Each element is a regular expression that matches names of fonts to
+ignore. */);
Vface_ignored_fonts = Qnil;
#ifdef HAVE_WINDOW_SYSTEM
HCoop / bpt / emacs.git / blobdiff