/* xfaces.c -- "Face" primitives.
- Copyright (C) 1993, 1994, 1998, 1999, 2000, 2001, 2002
+ Copyright (C) 1993, 1994, 1998, 1999, 2000, 2001, 2002, 2003, 2004
Free Software Foundation.
This file is part of GNU Emacs.
used to fill in unspecified attributes of the default face. */
#include <config.h>
+#include <stdio.h>
#include <sys/types.h>
#include <sys/stat.h>
#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 MAC_OS
#endif /* HAVE_X_WINDOWS */
-#include <stdio.h>
#include <ctype.h>
#define abs(X) ((X) < 0 ? -(X) : (X))
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. */
\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
***********************************************************************/
XColor not_used;
XSETFRAME (frame, f);
- return (FRAME_WINDOW_P (f)
- ? (!NILP (Fxw_display_color_p (frame))
- || xstricmp (color_name, "black") == 0
- || xstricmp (color_name, "white") == 0
- || (background_p
- && face_color_gray_p (f, color_name))
- || (!NILP (Fx_display_grayscale_p (frame))
- && face_color_gray_p (f, color_name)))
- : tty_defined_color (f, color_name, ¬_used, 0));
+ return
+#ifdef HAVE_X_WINDOWS
+ FRAME_WINDOW_P (f)
+ ? (!NILP (Fxw_display_color_p (frame))
+ || xstricmp (color_name, "black") == 0
+ || xstricmp (color_name, "white") == 0
+ || (background_p
+ && face_color_gray_p (f, color_name))
+ || (!NILP (Fx_display_grayscale_p (frame))
+ && face_color_gray_p (f, color_name)))
+ :
+#endif
+ tty_defined_color (f, color_name, ¬_used, 0);
}
{
struct frame *f;
- CHECK_FRAME (frame);
CHECK_STRING (color);
+ if (NILP (frame))
+ frame = selected_frame;
+ else
+ CHECK_FRAME (frame);
f = XFRAME (frame);
return face_color_gray_p (f, SDATA (color)) ? Qt : Qnil;
}
{
struct frame *f;
- CHECK_FRAME (frame);
CHECK_STRING (color);
+ if (NILP (frame))
+ frame = selected_frame;
+ else
+ CHECK_FRAME (frame);
f = XFRAME (frame);
if (face_color_supported_p (f, SDATA (color), !NILP (background_p)))
return Qt;
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;
};
}
+/* 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 == '-')
{
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
#endif
if (nfonts < 0 && CONSP (lfonts))
- num_fonts = Flength (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;
}
+/* Check if a font matching pattern_offset_t on frame F is available
+ or not. PATTERN may be a cons (FAMILY . REGISTRY), in which case,
+ a font name pattern is generated from FAMILY and REGISTRY. */
+
+int
+face_font_available_p (f, pattern)
+ struct frame *f;
+ Lisp_Object pattern;
+{
+ Lisp_Object fonts;
+
+ if (! STRINGP (pattern))
+ {
+ Lisp_Object family, registry;
+ char *family_str, *registry_str, *pattern_str;
+
+ CHECK_CONS (pattern);
+ family = XCAR (pattern);
+ if (NILP (family))
+ family_str = "*";
+ else
+ {
+ CHECK_STRING (family);
+ family_str = (char *) SDATA (family);
+ }
+ registry = XCDR (pattern);
+ if (NILP (registry))
+ registry_str = "*";
+ else
+ {
+ CHECK_STRING (registry);
+ registry_str = (char *) SDATA (registry);
+ }
+
+ pattern_str = (char *) alloca (strlen (family_str)
+ + strlen (registry_str)
+ + 10);
+ strcpy (pattern_str, index (family_str, '-') ? "-" : "-*-");
+ strcat (pattern_str, family_str);
+ strcat (pattern_str, "-*-");
+ strcat (pattern_str, registry_str);
+ if (!index (registry_str, '-'))
+ {
+ if (registry_str[strlen (registry_str) - 1] == '*')
+ strcat (pattern_str, "-*");
+ else
+ strcat (pattern_str, "*-*");
+ }
+ pattern = build_string (pattern_str);
+ }
+
+ /* Get the list of fonts matching PATTERN. */
+#ifdef WINDOWSNT
+ BLOCK_INPUT;
+ fonts = w32_list_fonts (f, pattern, 0, 1);
+ UNBLOCK_INPUT;
+#else
+ fonts = x_list_fonts (f, pattern, -1, 1);
+#endif
+ return XINT (Flength (fonts));
+}
+
+
/* Determine fonts matching PATTERN on frame F. Sort resulting fonts
using comparison function CMPFN. Value is the number of fonts
found. If value is non-zero, *FONTS is set to a vector of
? 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);
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])
+#ifdef MAC_OS
+ /* MAC_TODO: No stipple support on Mac OS yet, this index is
+ always unspecified. */
+ && i != LFACE_STIPPLE_INDEX
+#endif
+ )
break;
return i == LFACE_VECTOR_SIZE;
to[LFACE_INHERIT_INDEX] = Qnil;
}
-
-/* Checks the `cycle check' variable CHECK to see if it indicates that
- EL is part of a cycle; CHECK must be either Qnil or a value returned
- by an earlier use of CYCLE_CHECK. SUSPICIOUS is the number of
- elements after which a cycle might be suspected; after that many
- elements, this macro begins consing in order to keep more precise
- track of elements.
-
- Returns nil if a cycle was detected, otherwise a new value for CHECK
- that includes EL.
-
- CHECK is evaluated multiple times, EL and SUSPICIOUS 0 or 1 times, so
- the caller should make sure that's ok. */
-
-#define CYCLE_CHECK(check, el, suspicious) \
- (NILP (check) \
- ? make_number (0) \
- : (INTEGERP (check) \
- ? (XFASTINT (check) < (suspicious) \
- ? make_number (XFASTINT (check) + 1) \
- : Fcons (el, Qnil)) \
- : (!NILP (Fmemq ((el), (check))) \
- ? Qnil \
- : Fcons ((el), (check)))))
-
-
/* Merge face attributes from the face on frame F whose name is
INHERITS, into the vector of face attributes TO; INHERITS may also be
a list of face names, in which case they are applied in order.
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);
+
+ /* 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;
}
xfree (font);
}
+ f->default_face_done_p = 0;
Fmodify_frame_parameters (frame, Fcons (Fcons (Qfont, font_name), Qnil));
}
}
Lisp_Object resource, class, frame;
{
Lisp_Object value = Qnil;
-#ifndef WINDOWSNT
-#ifndef MAC_OS
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 MAC_OS */
-#endif /* not WINDOWSNT */
return value;
}
face->id = i;
/* Maybe enlarge C->faces_by_id. */
- if (i == c->used && c->used == c->size)
+ if (i == c->used)
{
- int new_size = 2 * c->size;
- int sz = new_size * sizeof *c->faces_by_id;
- c->faces_by_id = (struct face **) xrealloc (c->faces_by_id, sz);
- c->size = new_size;
+ if (c->used == c->size)
+ {
+ int new_size, sz;
+ new_size = min (2 * c->size, MAX_FACE_ID);
+ if (new_size == c->size)
+ abort (); /* Alternatives? ++kfs */
+ sz = new_size * sizeof *c->faces_by_id;
+ c->faces_by_id = (struct face **) xrealloc (c->faces_by_id, sz);
+ c->size = new_size;
+ }
+ c->used++;
}
#if GLYPH_DEBUG
#endif /* GLYPH_DEBUG */
c->faces_by_id[i] = face;
- if (i == c->used)
- ++c->used;
}
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);
|| 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)
}
}
- /* 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 = SPECPDL_INDEX ();
specbind (Qscalable_fonts_allowed, Qt);
/* 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;
}
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);
/* 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 */
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);
defsubr (&Sx_font_family_list);
#endif /* HAVE_WINDOW_SYSTEM */
}
+
+/* arch-tag: 8a0f7598-5517-408d-9ab3-1da6fcd4c749
+ (do not change this comment) */
HCoop / bpt / emacs.git / blobdiff