/* xfaces.c -- "Face" primitives.
- Copyright (C) 1993, 1994, 1998, 1999, 2000, 2001
+ Copyright (C) 1993, 1994, 1998, 1999, 2000, 2001, 2002, 2003
Free Software Foundation.
This file is part of GNU Emacs.
#define check_x check_w32
#define x_list_fonts w32_list_fonts
#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"
/* 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). */
#define FACE_CACHE_BUCKETS_SIZE 1001
-/* A definition of XColor for non-X frames. */
-
-#ifndef HAVE_X_WINDOWS
-
-typedef struct
-{
- unsigned long pixel;
- unsigned short red, green, blue;
- char flags;
- char pad;
-}
-XColor;
-
-#endif /* not HAVE_X_WINDOWS */
-
/* Keyword symbols used for face attribute names. */
Lisp_Object QCfamily, QCheight, QCweight, QCslant, QCunderline;
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
Lisp_Object Qface_alias;
-/* Names of frame parameters related to faces. */
-
-extern Lisp_Object Qscroll_bar_foreground, Qscroll_bar_background;
-extern Lisp_Object Qborder_color, Qcursor_color, Qmouse_color;
-
/* Default stipple pattern used on monochrome displays. This stipple
pattern is used on monochrome displays instead of shades of gray
for a face background color. See `set-face-stipple' for possible
Lisp_Object Vface_ignored_fonts;
+/* Alist of font name patterns vs the rescaling factor. */
+
+Lisp_Object Vface_font_rescale_alist;
+
/* Maximum number of fonts to consider in font_list. If not an
integer > 0, DEFAULT_FONT_LIST_LIMIT is used instead. */
/* 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. */
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 x_face_list_fonts P_ ((struct frame *, char *,
- struct font_name *, int, int));
+ struct font_name **, int, int));
static int font_scalable_p P_ ((struct font_name *));
static int get_lface_attributes P_ ((struct frame *, Lisp_Object, Lisp_Object *, int));
static int load_pixmap P_ ((struct frame *, Lisp_Object, unsigned *, unsigned *));
Lisp_Object, struct font_name **));
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 **));
+static int try_font_list P_ ((struct frame *, Lisp_Object *,
+ 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 *));
static int face_numeric_slant P_ ((Lisp_Object));
static int face_numeric_swidth P_ ((Lisp_Object));
static int face_fontset P_ ((Lisp_Object *));
-static char *choose_face_font P_ ((struct frame *, Lisp_Object *, int, int));
+static char *choose_face_font P_ ((struct frame *, Lisp_Object *, int, int, int*));
static void merge_face_vectors P_ ((struct frame *, Lisp_Object *, Lisp_Object*, Lisp_Object));
static void merge_face_inheritance P_ ((struct frame *f, Lisp_Object,
Lisp_Object *, Lisp_Object));
static struct face *make_realized_face P_ ((Lisp_Object *));
static void free_realized_faces P_ ((struct face_cache *));
static char *best_matching_font P_ ((struct frame *, Lisp_Object *,
- struct font_name *, int, int));
+ struct font_name *, int, int, int *));
static void cache_face P_ ((struct face_cache *, struct face *, unsigned));
static void uncache_face P_ ((struct face_cache *, struct face *));
static int xlfd_numeric_slant P_ ((struct font_name *));
#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)
{
#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 ();
|| ++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. */
if (font_info->name == NULL)
continue;
- /* Don't free a default font of some frame on this display. */
+ /* Don't free a default font of some frame. */
FOR_EACH_FRAME (tail, frame)
{
struct frame *f = XFRAME (frame);
if (FRAME_WINDOW_P (f)
- && FRAME_X_DISPLAY_INFO (f) == dpyinfo
&& font_info->font == FRAME_FONT (f))
break;
}
{
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
\f
-/***********************************************************************
- Minimum font bounds
- ***********************************************************************/
-
-#ifdef HAVE_WINDOW_SYSTEM
-
-/* Update the line_height of frame F. Return non-zero if line height
- changes. */
-
-int
-frame_update_line_height (f)
- struct frame *f;
-{
- int line_height, changed_p;
-
- line_height = FONT_HEIGHT (FRAME_FONT (f));
- changed_p = line_height != FRAME_LINE_HEIGHT (f);
- FRAME_LINE_HEIGHT (f) = line_height;
- return changed_p;
-}
-
-#endif /* HAVE_WINDOW_SYSTEM */
-
-\f
/***********************************************************************
Fonts
***********************************************************************/
{
struct font_info *font_info = NULL;
char *font_name;
+ int needs_overstrike;
face->font_info_id = -1;
face->font = NULL;
- font_name = choose_face_font (f, face->lface, face->fontset, c);
+ font_name = choose_face_font (f, face->lface, face->fontset, c,
+ &needs_overstrike);
if (!font_name)
return;
face->font_info_id = font_info->font_idx;
face->font = font_info->font;
face->font_name = font_info->full_name;
+ face->overstrike = needs_overstrike;
if (face->gc)
{
x_free_gc (f, face->gc);
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
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,
+ 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.
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);
split_font_name for which these are. */
int numeric[XLFD_LAST];
+ /* If the original name matches one of Vface_font_rescale_alist,
+ the value is the corresponding rescale ratio. Otherwise, the
+ value is 1.0. */
+ double rescale_ratio;
+
/* Lower value mean higher priority. */
int registry_priority;
};
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
};
}
else
pixel = atoi (pixel_field);
-
+
if (pixel == 0)
real_pt = 0;
else
}
+/* Return a rescaling ratio of a font of NAME. */
+
+static double
+font_rescale_ratio (name)
+ char *name;
+{
+ Lisp_Object tail, elt;
+
+ for (tail = Vface_font_rescale_alist; CONSP (tail); tail = XCDR (tail))
+ {
+ elt = XCAR (tail);
+ if (STRINGP (XCAR (elt)) && FLOATP (XCDR (elt))
+ && fast_c_string_match_ignore_case (XCAR (elt), name) >= 0)
+ return XFLOAT_DATA (XCDR (elt));
+ }
+ return 1.0;
+}
+
+
/* Split XLFD font name FONT->name destructively into NUL-terminated,
lower-case fields in FONT->fields. NUMERIC_P non-zero means
compute numeric values for fields XLFD_POINT_SIZE, XLFD_SWIDTH,
{
int i = 0;
int success_p;
+ double rescale_ratio;
+
+ if (numeric_p)
+ /* This must be done before splitting the font name. */
+ rescale_ratio = font_rescale_ratio (font->name);
if (*font->name == '-')
{
{
char *start, *end;
int j;
-
+
for (++p; *p && *p != ']'; ++p)
if (*p == '~')
*p = '-';
font->numeric[XLFD_WEIGHT] = xlfd_numeric_weight (font);
font->numeric[XLFD_SWIDTH] = xlfd_numeric_swidth (font);
font->numeric[XLFD_AVGWIDTH] = atoi (font->fields[XLFD_AVGWIDTH]);
+ font->rescale_ratio = rescale_ratio;
}
/* Initialize it to zero. It will be overridden by font_list while
fonts that we can't parse. Value is the number of fonts found. */
static int
-x_face_list_fonts (f, pattern, fonts, nfonts, try_alternatives_p)
+x_face_list_fonts (f, pattern, pfonts, nfonts, try_alternatives_p)
struct frame *f;
char *pattern;
- struct font_name *fonts;
+ struct font_name **pfonts;
int nfonts, try_alternatives_p;
{
int n, nignored;
better to do it the other way around. */
Lisp_Object lfonts;
Lisp_Object lpattern, tem;
+ struct font_name *fonts = 0;
+ int num_fonts = nfonts;
+ *pfonts = 0;
lpattern = build_string (pattern);
/* Get the list of fonts matching PATTERN. */
lfonts = x_list_fonts (f, lpattern, -1, nfonts);
#endif
+ if (nfonts < 0 && CONSP (lfonts))
+ num_fonts = XFASTINT (Flength (lfonts));
+
/* Make a copy of the font names we got from X, and
split them into fields. */
n = nignored = 0;
- for (tem = lfonts; CONSP (tem) && n < nfonts; tem = XCDR (tem))
+ for (tem = lfonts; CONSP (tem) && n < num_fonts; 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))
continue;
}
+ if (! fonts)
+ {
+ *pfonts = (struct font_name *) xmalloc (num_fonts * sizeof **pfonts);
+ fonts = *pfonts;
+ }
+
/* Make a copy of the font name. */
fonts[n].name = xstrdup (name);
{
Lisp_Object list = Valternate_fontname_alist;
+ if (*pfonts)
+ {
+ xfree (*pfonts);
+ *pfonts = 0;
+ }
+
while (CONSP (list))
{
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,
- fonts, nfonts, 0),
+ && (strcmp (SDATA (name), pattern) == 0
+ || (n = x_face_list_fonts (f, SDATA (name),
+ pfonts, nfonts, 0),
n == 0)))
patterns = XCDR (patterns);
}
/* Get the list of fonts matching pattern. 100 should suffice. */
nfonts = DEFAULT_FONT_LIST_LIMIT;
- if (INTEGERP (Vfont_list_limit) && XINT (Vfont_list_limit) > 0)
- nfonts = XFASTINT (Vfont_list_limit);
+ if (INTEGERP (Vfont_list_limit))
+ nfonts = XINT (Vfont_list_limit);
- *fonts = (struct font_name *) xmalloc (nfonts * sizeof **fonts);
- nfonts = x_face_list_fonts (f, pattern, *fonts, nfonts, 1);
+ *fonts = NULL;
+ nfonts = x_face_list_fonts (f, pattern, fonts, nfonts, 1);
/* Sort the resulting array and return it in *FONTS. If no
fonts were found, make sure to set *FONTS to null. */
if (nfonts)
sort_fonts (f, *fonts, nfonts, cmpfn);
- else
+ else if (*fonts)
{
xfree (*fonts);
*fonts = NULL;
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);
}
If REGISTRY is non-nil, return fonts with that registry and the
alternative registries from Vface_alternative_font_registry_alist.
-
+
If REGISTRY is nil return fonts of any registry.
Set *FONTS to a vector of font_name structures allocated from the
struct font_name **fonts;
{
int nfonts = font_list_1 (f, pattern, family, registry, fonts);
-
+
if (!NILP (registry)
&& CONSP (Vface_alternative_font_registry_alist))
{
struct font_name *fonts;
Lisp_Object result;
struct gcpro gcpro1;
- int count = specpdl_ptr - specpdl;
- int limit;
-
- /* Let's consider all fonts. Increase the limit for matching
- fonts until we have them all. */
- for (limit = 500;;)
- {
- specbind (intern ("font-list-limit"), make_number (limit));
- nfonts = font_list (f, Qnil, Qnil, Qnil, &fonts);
+ int count = SPECPDL_INDEX ();
- if (nfonts == limit)
- {
- free_font_names (fonts, nfonts);
- limit *= 2;
- }
- else
- break;
- }
+ /* Let's consider all fonts. */
+ specbind (intern ("font-list-limit"), make_number (-1));
+ nfonts = font_list (f, Qnil, Qnil, Qnil, &fonts);
result = Qnil;
GCPRO1 (result);
CHECK_STRING (pattern);
if (NILP (maximum))
- maxnames = 2000;
+ maxnames = -1;
else
{
CHECK_NATNUM (maximum);
? NULL
: FACE_FROM_ID (f, face_id));
+#ifdef WINDOWSNT
+/* 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
+
if (face && face->font)
size = FONT_WIDTH (face->font);
else
- size = FONT_WIDTH (FRAME_FONT (f));
+ size = FONT_WIDTH (FRAME_FONT (f)); /* FRAME_COLUMN_WIDTH (f) */
if (!NILP (width))
size *= XINT (width);
Lisp_Object aliased;
if (STRINGP (face_name))
- face_name = intern (XSTRING (face_name)->data);
+ face_name = intern (SDATA (face_name));
while (SYMBOLP (face_name))
{
for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
if (i != LFACE_FONT_INDEX && i != LFACE_INHERIT_INDEX
&& i != LFACE_AVGWIDTH_INDEX)
- if (UNSPECIFIEDP (attrs[i]))
+ if (UNSPECIFIEDP (attrs[i]))
break;
return i == LFACE_VECTOR_SIZE;
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
{
if (INTEGERP (to))
/* relative X absolute => absolute */
- result = make_number (XFLOAT_DATA (from) * XINT (to));
+ 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));
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)))
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;
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;
}
if (!UNSPECIFIEDP (value))
{
CHECK_STRING (value);
- if (XSTRING (value)->size == 0)
+ if (SCHARS (value) == 0)
signal_error ("Invalid face family", value);
}
old_value = LFACE_FAMILY (lface);
&& !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))
on the frame (display) whether the color will be valid
when the face is realized. */
CHECK_STRING (value);
- if (XSTRING (value)->size == 0)
+ if (SCHARS (value) == 0)
signal_error ("Empty foreground color value", value);
}
old_value = LFACE_FOREGROUND (lface);
on the frame (display) whether the color will be valid
when the face is realized. */
CHECK_STRING (value);
- if (XSTRING (value)->size == 0)
+ if (SCHARS (value) == 0)
signal_error ("Empty background color value", value);
}
old_value = LFACE_BACKGROUND (lface);
else if (EQ (attr, QCfont))
{
#ifdef HAVE_WINDOW_SYSTEM
- if (FRAME_WINDOW_P (XFRAME (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;
+ if (!UNSPECIFIEDP (value))
+ {
+ CHECK_STRING (value);
- if (!set_lface_from_font_name (f, lface, value, 1, 1))
- signal_error ("Invalid font or fontset name", value);
+ /* 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);
+ }
font_attr_p = 1;
}
{
Lisp_Object font_name;
char *font;
-
+
if (STRINGP (LFACE_FONT (lface)))
font_name = LFACE_FONT (lface);
else
/* Choose a font name that reflects LFACE's attributes and has
the registry and encoding pattern specified in the default
fontset (3rd arg: -1) for ASCII characters (4th arg: 0). */
- font = choose_face_font (f, XVECTOR (lface)->contents, -1, 0);
+ font = choose_face_font (f, XVECTOR (lface)->contents, -1, 0, 0);
if (!font)
error ("No font matches the specified attribute");
font_name = build_string (font);
xfree (font);
}
-
+
+ f->default_face_done_p = 0;
Fmodify_frame_parameters (frame, Fcons (Fcons (Qfont, font_name), Qnil));
}
}
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);
Lisp_Object resource, class, frame;
{
Lisp_Object value = Qnil;
-#ifndef WINDOWSNT
-#ifndef macintosh
CHECK_STRING (resource);
CHECK_STRING (class);
CHECK_LIVE_FRAME (frame);
value = display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame)),
resource, class, Qnil, Qnil);
UNBLOCK_INPUT;
-#endif /* not macintosh */
-#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);
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)
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";
#else
const char *popup_path = "menu.popup";
#endif
-
+
if (STRINGP (LFACE_FOREGROUND (lface)))
{
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 (face->font_name
&& (!UNSPECIFIEDP (LFACE_FAMILY (lface))
|| !UNSPECIFIEDP (LFACE_SWIDTH (lface))
#endif /* HAVE_X_WINDOWS && USE_X_TOOLKIT */
-DEFUN ("face-attribute-relative-p", Fface_attribute_relative_p,
+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. */)
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:
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
***********************************************************************/
if (compare_pt_p || xlfd_idx != XLFD_POINT_SIZE)
{
- int delta1 = abs (values[i] - font1->numeric[xlfd_idx]);
- int delta2 = abs (values[i] - font2->numeric[xlfd_idx]);
+ int delta1, delta2;
+
+ if (xlfd_idx == XLFD_POINT_SIZE)
+ {
+ delta1 = abs (values[i] - (font1->numeric[xlfd_idx]
+ / font1->rescale_ratio));
+ delta2 = abs (values[i] - (font2->numeric[xlfd_idx]
+ / font2->rescale_ratio));
+ if (abs (delta1 - delta2) < FONT_POINT_SIZE_QUANTUM)
+ continue;
+ }
+ else
+ {
+ delta1 = abs (values[i] - font1->numeric[xlfd_idx]);
+ delta2 = abs (values[i] - font2->numeric[xlfd_idx]);
+ }
- if (xlfd_idx == XLFD_POINT_SIZE
- && abs (delta1 - delta2) < FONT_POINT_SIZE_QUANTUM)
- continue;
if (delta1 > delta2)
return 0;
else if (delta1 < delta2)
return 1;
}
+ if (! compare_pt_p)
+ {
+ /* We prefer a real scalable font; i.e. not what autoscaled. */
+ int auto_scaled_1 = (font1->numeric[XLFD_POINT_SIZE] == 0
+ && font1->numeric[XLFD_RESY] > 0);
+ int auto_scaled_2 = (font2->numeric[XLFD_POINT_SIZE] == 0
+ && font2->numeric[XLFD_RESY] > 0);
+
+ if (auto_scaled_1 != auto_scaled_2)
+ return auto_scaled_2;
+ }
+
return font1->registry_priority < font2->registry_priority;
}
struct font_name *font;
int specified_pt;
{
- char point_size[20], pixel_size[20];
+ char pixel_size[20];
int pixel_value;
double resy = FRAME_X_DISPLAY_INFO (f)->resy;
double pt;
pt = specified_pt;
pixel_value = resy / (PT_PER_INCH * 10.0) * pt;
}
+ /* We may need a font of the different size. */
+ pixel_value *= font->rescale_ratio;
- /* Set point size of the font. */
- sprintf (point_size, "%d", (int) pt);
- font->fields[XLFD_POINT_SIZE] = point_size;
- font->numeric[XLFD_POINT_SIZE] = pt;
+ /* We should keep POINT_SIZE 0. Otherwise, X server can't open a
+ font of the specified PIXEL_SIZE. */
+#if 0
+ { /* Set point size of the font. */
+ char point_size[20];
+ sprintf (point_size, "%d", (int) pt);
+ font->fields[XLFD_POINT_SIZE] = point_size;
+ font->numeric[XLFD_POINT_SIZE] = pt;
+ }
+#endif
/* Set pixel size. */
sprintf (pixel_size, "%d", pixel_value);
static int
may_use_scalable_font_p (font)
- char *font;
+ const char *font;
{
if (EQ (Vscalable_fonts_allowed, Qt))
return 1;
widths if ATTRS specifies such a width.
Value is a font name which is allocated from the heap. FONTS is
- freed by this function. */
+ freed by this function.
+
+ If NEEDS_OVERSTRIKE is non-zero, a boolean is returned in it to
+ indicate whether the resulting font should be drawn using overstrike
+ to simulate bold-face. */
static char *
-best_matching_font (f, attrs, fonts, nfonts, width_ratio)
+best_matching_font (f, attrs, fonts, nfonts, width_ratio, needs_overstrike)
struct frame *f;
Lisp_Object *attrs;
struct font_name *fonts;
int nfonts;
int width_ratio;
+ int *needs_overstrike;
{
char *font_name;
struct font_name *best;
exact_p = 0;
+ if (needs_overstrike)
+ *needs_overstrike = 0;
+
/* Start with the first non-scalable font in the list. */
for (i = 0; i < nfonts; ++i)
if (!font_scalable_p (fonts + i))
if (exact_p)
break;
}
-
}
else
best = NULL;
|| better_font_p (specified, fonts + i, best, 0, 0)
|| (!non_scalable_has_exact_height_p
&& !better_font_p (specified, best, fonts + i, 0, 0)))
- best = fonts + i;
+ {
+ non_scalable_has_exact_height_p = 1;
+ best = fonts + i;
+ }
}
+
+ if (needs_overstrike)
+ {
+ enum xlfd_weight want_weight = specified[XLFD_WEIGHT];
+ enum xlfd_weight got_weight = best->numeric[XLFD_WEIGHT];
+
+ if (want_weight > XLFD_WEIGHT_MEDIUM && want_weight > got_weight)
+ {
+ /* We want a bold font, but didn't get one; try to use
+ overstriking instead to simulate bold-face. However,
+ don't overstrike an already-bold fontn unless the
+ desired weight grossly exceeds the available weight. */
+ if (got_weight > XLFD_WEIGHT_MEDIUM)
+ *needs_overstrike = (got_weight - want_weight) > 2;
+ else
+ *needs_overstrike = 1;
+ }
+ }
}
if (font_scalable_p (best))
REGISTRY, if a string, specifies a font registry and encoding to
match. A value of nil means include fonts of any registry and
encoding.
-
+
Return in *FONTS a pointer to a vector of font_name structures for
the fonts matched. Value is the number of fonts found. */
nfonts = font_list (f, Qnil, XCAR (alter), registry, fonts);
}
}
-
- /* Try scalable fonts before giving up. */
- if (nfonts == 0 && NILP (Vscalable_fonts_allowed))
+
+ /* Try all scalable fonts before giving up. */
+ if (nfonts == 0 && ! EQ (Vscalable_fonts_allowed, Qt))
{
- int count = BINDING_STACK_SIZE ();
+ int count = SPECPDL_INDEX ();
specbind (Qscalable_fonts_allowed, Qt);
nfonts = try_alternative_families (f, family, registry, fonts);
unbind_to (count, Qnil);
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 || NILP (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 (face_family))
- nfonts = try_alternative_families (f, face_family, registry, fonts);
+ if (EQ (try_family, family))
+ family = face_family;
- if (nfonts == 0 && !NILP (family))
+ if (nfonts == 0 && STRINGP (family))
nfonts = try_alternative_families (f, family, registry, fonts);
/* Try font family of the default face or "fixed". */
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);
+ nfonts = try_alternative_families (f, Qnil, registry, fonts);
return nfonts;
}
allocated from the heap and must be freed by the caller, or NULL if
we can get no information about the font name of C. It is assured
that we always get some information for a single byte
- character. */
+ character.
+
+ If NEEDS_OVERSTRIKE is non-zero, a boolean is returned in it to
+ indicate whether the resulting font should be drawn using overstrike
+ to simulate bold-face. */
static char *
-choose_face_font (f, attrs, fontset, c)
+choose_face_font (f, attrs, fontset, c, needs_overstrike)
struct frame *f;
Lisp_Object *attrs;
int fontset, c;
+ int *needs_overstrike;
{
Lisp_Object pattern;
char *font_name = NULL;
struct font_name *fonts;
int nfonts, width_ratio;
+ if (needs_overstrike)
+ *needs_overstrike = 0;
+
/* Get (foundry and) family name and registry (and encoding) name of
a font for C. */
pattern = fontset_font_pattern (f, fontset, c);
xassert (!SINGLE_BYTE_CHAR_P (c));
return NULL;
}
-
+
/* 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)));
- font_name = best_matching_font (f, attrs, fonts, nfonts, width_ratio);
+ font_name = best_matching_font (f, attrs, fonts, nfonts, width_ratio,
+ needs_overstrike);
return font_name;
}
struct frame *f;
{
int success_p = 0;
- int count = BINDING_STACK_SIZE ();
+ int count = SPECPDL_INDEX ();
/* Block input here so that we won't be surprised by an X expose
event, for instance, without having the faces set up. */
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, FRINGE_FACE_ID);
realize_named_face (f, Qheader_line, HEADER_LINE_FACE_ID);
x_update_menu_appearance (f);
#endif
}
-
+
success_p = 1;
}
/* If the `default' face is not yet known, create it. */
lface = lface_from_face_name (f, Qdefault, 0);
if (NILP (lface))
- {
- Lisp_Object frame;
- XSETFRAME (frame, f);
- lface = Finternal_make_lisp_face (Qdefault, frame);
- }
+ {
+ Lisp_Object frame;
+ XSETFRAME (frame, f);
+ lface = Finternal_make_lisp_face (Qdefault, frame);
+ }
+
#ifdef HAVE_WINDOW_SYSTEM
if (FRAME_WINDOW_P (f))
frame_font = Fassq (Qfont, f->param_alist);
xassert (CONSP (frame_font) && STRINGP (XCDR (frame_font)));
frame_font = XCDR (frame_font);
- set_lface_from_font_name (f, lface, frame_font, 1, 1);
+ set_lface_from_font_name (f, lface, frame_font,
+ f->default_face_done_p, 1);
+ f->default_face_done_p = 1;
}
#endif /* HAVE_WINDOW_SYSTEM */
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;
}
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. */
pixel = default_pixel = FACE_TTY_DEFAULT_BG_COLOR;
default_other_pixel = FACE_TTY_DEFAULT_FG_COLOR;
}
-
+
XSETFRAME (frame, f);
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)))
/* Map color names to color indices. */
map_tty_color (f, face, LFACE_FOREGROUND_INDEX, &face_colors_defaulted);
map_tty_color (f, face, LFACE_BACKGROUND_INDEX, &face_colors_defaulted);
-
+
/* Swap colors if face is inverse-video. If the colors are taken
from the frame colors, they are already inverted, since the
frame-creation function calls x-handle-reverse-video. */
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);
}
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");
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);
ignore. */);
Vface_ignored_fonts = Qnil;
+ DEFVAR_LISP ("face-font-rescale-alist", &Vface_font_rescale_alist,
+ doc: /* Alist of fonts vs the rescaling factors.
+Each element is a cons (FONT-NAME-PATTERN . RESCALE-RATIO), where
+FONT-NAME-PATTERN is a regular expression matching a font name, and
+RESCALE-RATIO is a floating point number to specify how much larger
+\(or smaller) font we should use. For instance, if a face requests
+a font of 10 point, we actually use a font of 10 * RESCALE-RATIO point. */);
+ Vface_font_rescale_alist = Qnil;
+
#ifdef HAVE_WINDOW_SYSTEM
defsubr (&Sbitmap_spec_p);
defsubr (&Sx_list_fonts);
HCoop / bpt / emacs.git / blobdiff