/* xfaces.c -- "Face" primitives.
+
Copyright (C) 1993, 1994, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+ 2005, 2006, 2007, 2008, 2009, 2010, 2011
+ Free Software Foundation, Inc.
This file is part of GNU Emacs.
-GNU Emacs is free software; you can redistribute it and/or modify
+GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 3, or (at your option)
-any later version.
+the Free Software Foundation, either version 3 of the License, or
+(at your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
-along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-Boston, MA 02110-1301, USA. */
+along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* New face implementation by Gerd Moellmann <gerd@gnu.org>. */
1. Font family name.
- 2. Relative proportionate width, aka character set width or set
+ 2. Font foundary name.
+
+ 3. Relative proportionate width, aka character set width or set
width (swidth), e.g. `semi-compressed'.
- 3. Font height in 1/10pt.
+ 4. Font height in 1/10pt.
- 4. Font weight, e.g. `bold'.
+ 5. Font weight, e.g. `bold'.
- 5. Font slant, e.g. `italic'.
+ 6. Font slant, e.g. `italic'.
- 6. Foreground color.
+ 7. Foreground color.
- 7. Background color.
+ 8. Background color.
- 8. Whether or not characters should be underlined, and in what color.
+ 9. Whether or not characters should be underlined, and in what color.
- 9. Whether or not characters should be displayed in inverse video.
+ 10. Whether or not characters should be displayed in inverse video.
- 10. A background stipple, a bitmap.
+ 11. A background stipple, a bitmap.
- 11. Whether or not characters should be overlined, and in what color.
+ 12. Whether or not characters should be overlined, and in what color.
- 12. Whether or not characters should be strike-through, and in what
+ 13. Whether or not characters should be strike-through, and in what
color.
- 13. Whether or not a box should be drawn around characters, the box
+ 14. Whether or not a box should be drawn around characters, the box
type, and, for simple boxes, in what color.
- 14. Font or fontset pattern, or nil. This is a special attribute.
- When this attribute is specified, the face uses a font opened by
- that pattern as is. In addition, all the other font-related
- attributes (1st thru 5th) are generated from the opened font name.
+ 15. Font-spec, or nil. This is a special attribute.
+
+ A font-spec is a collection of font attributes (specs).
+
+ When this attribute is specified, the face uses a font matching
+ with the specs as is except for what overwritten by the specs in
+ the fontset (see below). In addition, the other font-related
+ attributes (1st thru 5th) are updated from the spec.
+
On the other hand, if one of the other font-related attributes are
- specified, this attribute is set to nil. In that case, the face
- doesn't inherit this attribute from the `default' face, and uses a
- font determined by the other attributes (those may be inherited
- from the `default' face).
+ specified, the correspoinding specs in this attribute is set to nil.
15. A face name or list of face names from which to inherit attributes.
and is used to ensure that a font specified on the command line,
for example, can be matched exactly.
+ 17. A fontset name. This is another special attribute.
+
+ A fontset is a mappings from characters to font-specs, and the
+ specs overwrite the font-spec in the 14th attribute.
+
+
Faces are frame-local by nature because Emacs allows to define the
same named face (face names are symbols) differently for different
frames. Each frame has an alist of face definitions for all named
is realized, it inherits (thus shares) a fontset of an ASCII face
that has the same attributes other than font-related ones.
- Thus, all realized face have a realized fontset.
+ Thus, all realized faces have a realized fontset.
Unibyte text.
#include <stdio.h>
#include <sys/types.h>
#include <sys/stat.h>
+#include <stdio.h> /* This needs to be before termchar.h */
+#include <setjmp.h>
#include "lisp.h"
+#include "character.h"
#include "charset.h"
#include "keyboard.h"
#include "frame.h"
-
-#ifdef HAVE_WINDOW_SYSTEM
-#include "fontset.h"
-#endif /* HAVE_WINDOW_SYSTEM */
+#include "termhooks.h"
#ifdef HAVE_X_WINDOWS
#include "xterm.h"
#define x_display_info w32_display_info
#define FRAME_X_FONT_TABLE FRAME_W32_FONT_TABLE
#define check_x check_w32
-#define x_list_fonts w32_list_fonts
#define GCGraphicsExposures 0
#endif /* WINDOWSNT */
-#ifdef MAC_OS
-#include "macterm.h"
-#define x_display_info mac_display_info
-#define check_x check_mac
-#endif /* MAC_OS */
+#ifdef HAVE_NS
+#include "nsterm.h"
+#undef FRAME_X_DISPLAY_INFO
+#define FRAME_X_DISPLAY_INFO FRAME_NS_DISPLAY_INFO
+#define x_display_info ns_display_info
+#define FRAME_X_FONT_TABLE FRAME_NS_FONT_TABLE
+#define check_x check_ns
+#define GCGraphicsExposures 0
+#endif /* HAVE_NS */
#include "buffer.h"
#include "dispextern.h"
#include "blockinput.h"
#include "window.h"
#include "intervals.h"
+#include "termchar.h"
+
+#include "font.h"
+#ifdef HAVE_WINDOW_SYSTEM
+#include "fontset.h"
+#endif /* HAVE_WINDOW_SYSTEM */
#ifdef HAVE_X_WINDOWS
#include <ctype.h>
-#undef abs
-#define abs(X) ((X) < 0 ? -(X) : (X))
-
/* Number of pt per inch (from the TeXbook). */
#define PT_PER_INCH 72.27
Lisp_Object QCwidth, QCfont, QCbold, QCitalic;
Lisp_Object QCreverse_video;
Lisp_Object QCoverline, QCstrike_through, QCbox, QCinherit;
+Lisp_Object QCfontset;
/* Symbols used for attribute values. */
Lisp_Object Qdefault, Qtool_bar, Qregion, Qfringe;
Lisp_Object Qheader_line, Qscroll_bar, Qcursor, Qborder, Qmouse, Qmenu;
Lisp_Object Qmode_line_inactive, Qvertical_border;
-extern Lisp_Object Qmode_line;
/* The symbol `face-alias'. A symbols having that property is an
alias for another face. Value of the property is the name of
Lisp_Object Qface_alias;
-extern Lisp_Object Qcircular_list;
-
/* Default stipple pattern used on monochrome displays. This stipple
pattern is used on monochrome displays instead of shades of gray
for a face background color. See `set-face-stipple' for possible
/* The symbols `face' and `mouse-face' used as text properties. */
Lisp_Object Qface;
-extern Lisp_Object Qmouse_face;
/* Property for basic faces which other faces cannot inherit. */
Lisp_Object Vface_new_frame_defaults;
+/* Alist of face remappings. Each element is of the form:
+ (FACE REPLACEMENT...) which causes display of the face FACE to use
+ REPLACEMENT... instead. REPLACEMENT... is interpreted the same way
+ the value of a `face' text property is: it may be (1) A face name,
+ (2) A list of face names, (3) A property-list of face attribute/value
+ pairs, or (4) A list of face names intermixed with lists containing
+ face attribute/value pairs.
+
+ Multiple entries in REPLACEMENT... are merged together to form the final
+ result, with faces or attributes earlier in the list taking precedence
+ over those that are later.
+
+ Face-name remapping cycles are suppressed; recursive references use
+ the underlying face instead of the remapped face. */
+
+Lisp_Object Vface_remapping_alist;
+
/* The next ID to assign to Lisp faces. */
static int next_lface_id;
\f
/* Function prototypes. */
-struct font_name;
struct table_entry;
struct named_merge_point;
-static void map_tty_color P_ ((struct frame *, struct face *,
- enum lface_attribute_index, int *));
-static Lisp_Object resolve_face_name P_ ((Lisp_Object, int));
-static int may_use_scalable_font_p P_ ((const char *));
-static void set_font_frame_param P_ ((Lisp_Object, Lisp_Object));
-static int better_font_p P_ ((int *, struct font_name *, struct font_name *,
- int, int));
-static int x_face_list_fonts P_ ((struct frame *, char *,
- 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 *));
-static unsigned char *xstrlwr P_ ((unsigned char *));
-static struct frame *frame_or_selected_frame P_ ((Lisp_Object, int));
-static void load_face_font P_ ((struct frame *, struct face *, int));
-static void load_face_colors P_ ((struct frame *, struct face *, Lisp_Object *));
-static void free_face_colors P_ ((struct frame *, struct face *));
-static int face_color_gray_p P_ ((struct frame *, char *));
-static char *build_font_name P_ ((struct font_name *));
-static void free_font_names P_ ((struct font_name *, int));
-static int sorted_font_list P_ ((struct frame *, char *,
- int (*cmpfn) P_ ((const void *, const void *)),
- struct font_name **));
-static int font_list_1 P_ ((struct frame *, Lisp_Object, Lisp_Object,
- 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 **,
- 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 struct face *realize_face P_ ((struct face_cache *, Lisp_Object *, int,
- struct face *, int));
-static struct face *realize_x_face P_ ((struct face_cache *,
- Lisp_Object *, int, struct face *));
-static struct face *realize_tty_face P_ ((struct face_cache *,
- Lisp_Object *, int));
-static int realize_basic_faces P_ ((struct frame *));
-static int realize_default_face P_ ((struct frame *));
-static void realize_named_face P_ ((struct frame *, Lisp_Object, int));
-static int lface_fully_specified_p P_ ((Lisp_Object *));
-static int lface_equal_p P_ ((Lisp_Object *, Lisp_Object *));
-static unsigned hash_string_case_insensitive P_ ((Lisp_Object));
-static unsigned lface_hash P_ ((Lisp_Object *));
-static int lface_same_font_attributes_p P_ ((Lisp_Object *, Lisp_Object *));
-static struct face_cache *make_face_cache P_ ((struct frame *));
-static void free_realized_face P_ ((struct frame *, struct face *));
-static void clear_face_gcs P_ ((struct face_cache *));
-static void free_face_cache P_ ((struct face_cache *));
-static int face_numeric_weight P_ ((Lisp_Object));
-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, int*));
-static void merge_face_vectors P_ ((struct frame *, Lisp_Object *, Lisp_Object*,
- struct named_merge_point *));
-static int merge_face_ref P_ ((struct frame *, Lisp_Object, Lisp_Object *,
- int, struct named_merge_point *));
-static int set_lface_from_font_name P_ ((struct frame *, Lisp_Object,
- Lisp_Object, int, int));
-static Lisp_Object lface_from_face_name P_ ((struct frame *, Lisp_Object, int));
-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, 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 *));
-static int xlfd_numeric_weight P_ ((struct font_name *));
-static int xlfd_numeric_swidth P_ ((struct font_name *));
-static Lisp_Object xlfd_symbolic_slant P_ ((struct font_name *));
-static Lisp_Object xlfd_symbolic_weight P_ ((struct font_name *));
-static Lisp_Object xlfd_symbolic_swidth P_ ((struct font_name *));
-static int xlfd_fixed_p P_ ((struct font_name *));
-static int xlfd_numeric_value P_ ((struct table_entry *, int, struct font_name *,
- int, int));
-static Lisp_Object xlfd_symbolic_value P_ ((struct table_entry *, int,
- struct font_name *, int,
- Lisp_Object));
-static struct table_entry *xlfd_lookup_field_contents P_ ((struct table_entry *, int,
- struct font_name *, int));
+static void map_tty_color (struct frame *, struct face *,
+ enum lface_attribute_index, int *);
+static Lisp_Object resolve_face_name (Lisp_Object, int);
+static void set_font_frame_param (Lisp_Object, Lisp_Object);
+static int get_lface_attributes (struct frame *, Lisp_Object, Lisp_Object *,
+ int, struct named_merge_point *);
+static int load_pixmap (struct frame *, Lisp_Object, unsigned *, unsigned *);
+static struct frame *frame_or_selected_frame (Lisp_Object, int);
+static void load_face_colors (struct frame *, struct face *, Lisp_Object *);
+static void free_face_colors (struct frame *, struct face *);
+static int face_color_gray_p (struct frame *, const char *);
+static struct face *realize_face (struct face_cache *, Lisp_Object *,
+ int);
+static struct face *realize_non_ascii_face (struct frame *, Lisp_Object,
+ struct face *);
+static struct face *realize_x_face (struct face_cache *, Lisp_Object *);
+static struct face *realize_tty_face (struct face_cache *, Lisp_Object *);
+static int realize_basic_faces (struct frame *);
+static int realize_default_face (struct frame *);
+static void realize_named_face (struct frame *, Lisp_Object, int);
+static int lface_fully_specified_p (Lisp_Object *);
+static int lface_equal_p (Lisp_Object *, Lisp_Object *);
+static unsigned hash_string_case_insensitive (Lisp_Object);
+static unsigned lface_hash (Lisp_Object *);
+static int lface_same_font_attributes_p (Lisp_Object *, Lisp_Object *);
+static struct face_cache *make_face_cache (struct frame *);
+static void clear_face_gcs (struct face_cache *);
+static void free_face_cache (struct face_cache *);
+static int face_fontset (Lisp_Object *);
+static void merge_face_vectors (struct frame *, Lisp_Object *, Lisp_Object*,
+ struct named_merge_point *);
+static int merge_face_ref (struct frame *, Lisp_Object, Lisp_Object *,
+ int, struct named_merge_point *);
+static int set_lface_from_font (struct frame *, Lisp_Object, Lisp_Object,
+ int);
+static Lisp_Object lface_from_face_name (struct frame *, Lisp_Object, int);
+static struct face *make_realized_face (Lisp_Object *);
+static void cache_face (struct face_cache *, struct face *, unsigned);
+static void uncache_face (struct face_cache *, struct face *);
#ifdef HAVE_WINDOW_SYSTEM
-static int split_font_name P_ ((struct frame *, struct font_name *, int));
-static int xlfd_point_size P_ ((struct frame *, struct font_name *));
-static void sort_fonts P_ ((struct frame *, struct font_name *, int,
- 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 x_display_info *));
-
-#ifdef WINDOWSNT
-extern Lisp_Object w32_list_fonts P_ ((struct frame *, Lisp_Object, int, int));
-#endif /* WINDOWSNT */
+static GC x_create_gc (struct frame *, unsigned long, XGCValues *);
+static void x_free_gc (struct frame *, GC);
#ifdef USE_X_TOOLKIT
-static void x_update_menu_appearance P_ ((struct frame *));
+static void x_update_menu_appearance (struct frame *);
-extern void free_frame_menubar P_ ((struct frame *));
+extern void free_frame_menubar (struct frame *);
#endif /* USE_X_TOOLKIT */
#endif /* HAVE_WINDOW_SYSTEM */
DEFUN ("dump-colors", Fdump_colors, Sdump_colors, 0, 0, 0,
doc: /* Dump currently allocated colors to stderr. */)
- ()
+ (void)
{
int i, n;
is called. */
void
-x_free_colors (f, pixels, npixels)
- struct frame *f;
- unsigned long *pixels;
- int npixels;
+x_free_colors (struct frame *f, long unsigned int *pixels, int npixels)
{
int class = FRAME_X_DISPLAY_INFO (f)->visual->class;
is called. */
void
-x_free_dpy_colors (dpy, screen, cmap, pixels, npixels)
- Display *dpy;
- Screen *screen;
- Colormap cmap;
- unsigned long *pixels;
- int npixels;
+x_free_dpy_colors (Display *dpy, Screen *screen, Colormap cmap, long unsigned int *pixels, int npixels)
{
struct x_display_info *dpyinfo = x_display_info_for_display (dpy);
int class = dpyinfo->visual->class;
are given by XGCV and MASK. */
static INLINE GC
-x_create_gc (f, mask, xgcv)
- struct frame *f;
- unsigned long mask;
- XGCValues *xgcv;
+x_create_gc (struct frame *f, long unsigned int mask, XGCValues *xgcv)
{
GC gc;
BLOCK_INPUT;
/* Free GC which was used on frame F. */
static INLINE void
-x_free_gc (f, gc)
- struct frame *f;
- GC gc;
+x_free_gc (struct frame *f, GC gc)
{
- BLOCK_INPUT;
+ eassert (interrupt_input_blocked);
IF_DEBUG (xassert (--ngcs >= 0));
XFreeGC (FRAME_X_DISPLAY (f), gc);
- UNBLOCK_INPUT;
}
#endif /* HAVE_X_WINDOWS */
/* W32 emulation of GCs */
static INLINE GC
-x_create_gc (f, mask, xgcv)
- struct frame *f;
- unsigned long mask;
- XGCValues *xgcv;
+x_create_gc (struct frame *f, unsigned long mask, XGCValues *xgcv)
{
GC gc;
BLOCK_INPUT;
/* Free GC which was used on frame F. */
static INLINE void
-x_free_gc (f, gc)
- struct frame *f;
- GC gc;
+x_free_gc (struct frame *f, GC gc)
{
- BLOCK_INPUT;
IF_DEBUG (xassert (--ngcs >= 0));
xfree (gc);
- UNBLOCK_INPUT;
}
#endif /* WINDOWSNT */
-#ifdef MAC_OS
-/* Mac OS emulation of GCs */
+#ifdef HAVE_NS
+/* NS emulation of GCs */
static INLINE GC
-x_create_gc (f, mask, xgcv)
- struct frame *f;
- unsigned long mask;
- XGCValues *xgcv;
+x_create_gc (struct frame *f,
+ unsigned long mask,
+ XGCValues *xgcv)
{
- GC gc;
- BLOCK_INPUT;
- gc = XCreateGC (FRAME_MAC_DISPLAY (f), FRAME_MAC_WINDOW (f), mask, xgcv);
- UNBLOCK_INPUT;
- IF_DEBUG (++ngcs);
+ GC gc = xmalloc (sizeof (*gc));
+ if (gc)
+ memcpy (gc, xgcv, sizeof (XGCValues));
return gc;
}
static INLINE void
-x_free_gc (f, gc)
- struct frame *f;
- GC gc;
+x_free_gc (struct frame *f, GC gc)
{
- BLOCK_INPUT;
- IF_DEBUG (xassert (--ngcs >= 0));
- XFreeGC (FRAME_MAC_DISPLAY (f), gc);
- UNBLOCK_INPUT;
+ xfree (gc);
}
+#endif /* HAVE_NS */
-#endif /* MAC_OS */
-
-/* Like stricmp. Used to compare parts of font names which are in
- ISO8859-1. */
+/* Like strcasecmp/stricmp. Used to compare parts of font names which
+ are in ISO8859-1. */
int
-xstricmp (s1, s2)
- const unsigned char *s1, *s2;
+xstrcasecmp (const unsigned char *s1, const unsigned char *s2)
{
while (*s1 && *s2)
{
}
-/* Like strlwr, which might not always be available. */
-
-static unsigned char *
-xstrlwr (s)
- unsigned char *s;
-{
- unsigned char *p = s;
-
- for (p = s; *p; ++p)
- /* On Mac OS X 10.3, tolower also converts non-ASCII characters
- for some locales. */
- if (isascii (*p))
- *p = tolower (*p);
-
- return s;
-}
-
-
/* If FRAME is nil, return a pointer to the selected frame.
Otherwise, check that FRAME is a live frame, and return a pointer
to it. NPARAM is the parameter number of FRAME, for
Lisp function definitions. */
static INLINE struct frame *
-frame_or_selected_frame (frame, nparam)
- Lisp_Object frame;
- int nparam;
+frame_or_selected_frame (Lisp_Object frame, int nparam)
{
if (NILP (frame))
frame = selected_frame;
/* Initialize face cache and basic faces for frame F. */
void
-init_frame_faces (f)
- struct frame *f;
+init_frame_faces (struct frame *f)
{
/* Make a face cache, if F doesn't have one. */
if (FRAME_FACE_CACHE (f) == NULL)
/* Make the image cache. */
if (FRAME_WINDOW_P (f))
{
- if (FRAME_X_IMAGE_CACHE (f) == NULL)
- FRAME_X_IMAGE_CACHE (f) = make_image_cache ();
- ++FRAME_X_IMAGE_CACHE (f)->refcount;
+ /* We initialize the image cache when creating the first frame
+ on a terminal, and not during terminal creation. This way,
+ `x-open-connection' on a tty won't create an image cache. */
+ if (FRAME_IMAGE_CACHE (f) == NULL)
+ FRAME_IMAGE_CACHE (f) = make_image_cache ();
+ ++FRAME_IMAGE_CACHE (f)->refcount;
}
#endif /* HAVE_WINDOW_SYSTEM */
#ifdef WINDOWSNT
if (!FRAME_WINDOW_P (f) || FRAME_W32_WINDOW (f))
#endif
-#ifdef MAC_OS
- if (!FRAME_MAC_P (f) || FRAME_MAC_WINDOW (f))
+#ifdef HAVE_NS
+ if (!FRAME_NS_P (f) || FRAME_NS_WINDOW (f))
#endif
if (!realize_basic_faces (f))
- abort ();
+ abort ();
}
-/* Free face cache of frame F. Called from Fdelete_frame. */
+/* Free face cache of frame F. Called from delete_frame. */
void
-free_frame_faces (f)
- struct frame *f;
+free_frame_faces (struct frame *f)
{
struct face_cache *face_cache = FRAME_FACE_CACHE (f);
#ifdef HAVE_WINDOW_SYSTEM
if (FRAME_WINDOW_P (f))
{
- struct image_cache *image_cache = FRAME_X_IMAGE_CACHE (f);
+ struct image_cache *image_cache = FRAME_IMAGE_CACHE (f);
if (image_cache)
{
--image_cache->refcount;
of named faces. */
void
-recompute_basic_faces (f)
- struct frame *f;
+recompute_basic_faces (struct frame *f)
{
if (FRAME_FACE_CACHE (f))
{
try to free unused fonts, too. */
void
-clear_face_cache (clear_fonts_p)
- int clear_fonts_p;
+clear_face_cache (int clear_fonts_p)
{
#ifdef HAVE_WINDOW_SYSTEM
Lisp_Object tail, frame;
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);
+#if 0
+ /* Not yet implemented. */
+ clear_font_cache (frame);
+#endif
/* From time to time see if we can unload some fonts. This also
frees all realized faces on all frames. Fonts needed by
{
f = XFRAME (frame);
if (FRAME_WINDOW_P (f))
- {
clear_face_gcs (FRAME_FACE_CACHE (f));
- clear_image_cache (f, 0);
- }
}
+ clear_image_caches (Qnil);
}
#endif /* HAVE_WINDOW_SYSTEM */
}
DEFUN ("clear-face-cache", Fclear_face_cache, Sclear_face_cache, 0, 1, 0,
doc: /* Clear face caches on all frames.
Optional THOROUGHLY non-nil means try to free unused fonts, too. */)
- (thoroughly)
- Lisp_Object thoroughly;
+ (Lisp_Object thoroughly)
{
clear_face_cache (!NILP (thoroughly));
++face_change_count;
return Qnil;
}
-
-
-#ifdef HAVE_WINDOW_SYSTEM
-
-
-/* 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 (dpyinfo)
- struct x_display_info *dpyinfo;
-{
- int i;
-
- /* 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 (!NILP (tail))
- continue;
-
- /* Free names. */
- if (font_info->full_name != font_info->name)
- xfree (font_info->full_name);
- xfree (font_info->name);
-
- /* Free the font. */
- BLOCK_INPUT;
-#ifdef HAVE_X_WINDOWS
- XFreeFont (dpyinfo->display, font_info->font);
-#endif
-#ifdef WINDOWSNT
- w32_unload_font (dpyinfo, font_info->font);
-#endif
-#ifdef MAC_OS
- mac_unload_font (dpyinfo, font_info->font);
-#endif
- UNBLOCK_INPUT;
-
- /* Mark font table slot free. */
- font_info->font = NULL;
- font_info->name = font_info->full_name = NULL;
- }
-}
-
-#endif /* HAVE_WINDOW_SYSTEM */
-
-
\f
/***********************************************************************
X Pixmaps
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;
+ (Lisp_Object object)
{
int pixmap_p = 0;
if these pointers are not null. */
static int
-load_pixmap (f, name, w_ptr, h_ptr)
- FRAME_PTR f;
- Lisp_Object name;
- unsigned int *w_ptr, *h_ptr;
+load_pixmap (FRAME_PTR f, Lisp_Object name, unsigned int *w_ptr, unsigned int *h_ptr)
{
int bitmap_id;
\f
-/***********************************************************************
- Fonts
- ***********************************************************************/
-
-#ifdef HAVE_WINDOW_SYSTEM
-
-/* Load font of face FACE which is used on frame F to display
- character C. The name of the font to load is determined by lface
- and fontset of FACE. */
-
-static void
-load_face_font (f, face, c)
- struct frame *f;
- struct face *face;
- int c;
-{
- 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,
- &needs_overstrike);
- if (!font_name)
- return;
-
- BLOCK_INPUT;
- font_info = FS_LOAD_FACE_FONT (f, c, font_name, face);
- UNBLOCK_INPUT;
-
- if (font_info)
- {
- 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);
- face->gc = 0;
- }
- }
- else
- add_to_log ("Unable to load font %s",
- build_string (font_name), Qnil);
- xfree (font_name);
-}
-
-#endif /* HAVE_WINDOW_SYSTEM */
-
-
-\f
/***********************************************************************
X Colors
***********************************************************************/
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;
+parse_rgb_list (Lisp_Object rgb_list, XColor *color)
{
#define PARSE_RGB_LIST_FIELD(field) \
if (CONSP (rgb_list) && INTEGERP (XCAR (rgb_list))) \
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;
+tty_lookup_color (struct frame *f, Lisp_Object color, XColor *tty_color, XColor *std_color)
{
Lisp_Object frame, color_desc;
/* A version of defined_color for non-X frames. */
int
-tty_defined_color (f, color_name, color_def, alloc)
- struct frame *f;
- char *color_name;
- XColor *color_def;
- int alloc;
+tty_defined_color (struct frame *f, const char *color_name,
+ XColor *color_def, int alloc)
{
int status = 1;
color_def->green = 0;
if (*color_name)
- status = tty_lookup_color (f, build_string (color_name), color_def, 0);
+ status = tty_lookup_color (f, build_string (color_name), color_def, NULL);
if (color_def->pixel == FACE_TTY_DEFAULT_COLOR && *color_name)
{
This does the right thing for any type of frame. */
int
-defined_color (f, color_name, color_def, alloc)
- struct frame *f;
- char *color_name;
- XColor *color_def;
- int alloc;
+defined_color (struct frame *f, const char *color_name, XColor *color_def, int alloc)
{
if (!FRAME_WINDOW_P (f))
return tty_defined_color (f, color_name, color_def, alloc);
else if (FRAME_W32_P (f))
return w32_defined_color (f, color_name, color_def, alloc);
#endif
-#ifdef MAC_OS
- else if (FRAME_MAC_P (f))
- return mac_defined_color (f, color_name, color_def, alloc);
+#ifdef HAVE_NS
+ else if (FRAME_NS_P (f))
+ return ns_defined_color (f, color_name, color_def, alloc, 1);
#endif
else
abort ();
Lisp string. */
Lisp_Object
-tty_color_name (f, idx)
- struct frame *f;
- int idx;
+tty_color_name (struct frame *f, int idx)
{
if (idx >= 0 && !NILP (Ffboundp (Qtty_color_by_index)))
{
if (idx == FACE_TTY_DEFAULT_BG_COLOR)
return build_string (unspecified_bg);
-#ifdef WINDOWSNT
- return vga_stdcolor_name (idx);
-#endif
-
return Qunspecified;
}
The criterion implemented here is not a terribly sophisticated one. */
static int
-face_color_gray_p (f, color_name)
- struct frame *f;
- char *color_name;
+face_color_gray_p (struct frame *f, const char *color_name)
{
XColor color;
int gray_p;
gray_p = (/* Any color sufficiently close to black counts as grey. */
(color.red < 5000 && color.green < 5000 && color.blue < 5000)
||
- ((abs (color.red - color.green)
+ ((eabs (color.red - color.green)
< max (color.red, color.green) / 20)
- && (abs (color.green - color.blue)
+ && (eabs (color.green - color.blue)
< max (color.green, color.blue) / 20)
- && (abs (color.blue - color.red)
+ && (eabs (color.blue - color.red)
< max (color.blue, color.red) / 20)));
else
gray_p = 0;
color. */
static int
-face_color_supported_p (f, color_name, background_p)
- struct frame *f;
- char *color_name;
- int background_p;
+face_color_supported_p (struct frame *f, const char *color_name, int background_p)
{
Lisp_Object frame;
XColor not_used;
#ifdef HAVE_WINDOW_SYSTEM
FRAME_WINDOW_P (f)
? (!NILP (Fxw_display_color_p (frame))
- || xstricmp (color_name, "black") == 0
- || xstricmp (color_name, "white") == 0
+ || xstrcasecmp (color_name, "black") == 0
+ || xstrcasecmp (color_name, "white") == 0
|| (background_p
&& face_color_gray_p (f, color_name))
|| (!NILP (Fx_display_grayscale_p (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;
+ (Lisp_Object color, Lisp_Object frame)
{
struct frame *f;
Otherwise, this function tells whether it can be used as a foreground.
If FRAME is nil or omitted, use the selected frame.
COLOR must be a valid color name. */)
- (color, frame, background_p)
- Lisp_Object frame, color, background_p;
+ (Lisp_Object color, Lisp_Object frame, Lisp_Object background_p)
{
struct frame *f;
these colors. */
unsigned long
-load_color (f, face, name, target_index)
- struct frame *f;
- struct face *face;
- Lisp_Object name;
- enum lface_attribute_index target_index;
+load_color (struct frame *f, struct face *face, Lisp_Object name, enum lface_attribute_index target_index)
{
XColor color;
try to emulate gray colors with a stipple from Vface_default_stipple. */
static void
-load_face_colors (f, face, attrs)
- struct frame *f;
- struct face *face;
- Lisp_Object *attrs;
+load_face_colors (struct frame *f, struct face *face, Lisp_Object *attrs)
{
Lisp_Object fg, bg;
/* Free color PIXEL on frame F. */
void
-unload_color (f, pixel)
- struct frame *f;
- unsigned long pixel;
+unload_color (struct frame *f, long unsigned int pixel)
{
#ifdef HAVE_X_WINDOWS
if (pixel != -1)
/* Free colors allocated for FACE. */
static void
-free_face_colors (f, face)
- struct frame *f;
- struct face *face;
+free_face_colors (struct frame *f, struct face *face)
{
+/* PENDING(NS): need to do something here? */
#ifdef HAVE_X_WINDOWS
if (face->colors_copied_bitwise_p)
return;
XLFD_SWIDTH_ULTRA_EXPANDED /* 90: UltraExpanded... */
};
-/* Structure used for tables mapping XLFD weight, slant, and width
- names to numeric and symbolic values. */
-
-struct table_entry
-{
- char *name;
- int numeric;
- Lisp_Object *symbol;
-};
-
-/* Table of XLFD slant names and their numeric and symbolic
- representations. This table must be sorted by slant names in
- ascending order. */
-
-static struct table_entry slant_table[] =
-{
- {"i", XLFD_SLANT_ITALIC, &Qitalic},
- {"o", XLFD_SLANT_OBLIQUE, &Qoblique},
- {"ot", XLFD_SLANT_OTHER, &Qitalic},
- {"r", XLFD_SLANT_ROMAN, &Qnormal},
- {"ri", XLFD_SLANT_REVERSE_ITALIC, &Qreverse_italic},
- {"ro", XLFD_SLANT_REVERSE_OBLIQUE, &Qreverse_oblique}
-};
-
-/* Table of XLFD weight names. This table must be sorted by weight
- names in ascending order. */
-
-static struct table_entry weight_table[] =
-{
- {"black", XLFD_WEIGHT_ULTRA_BOLD, &Qultra_bold},
- {"bold", XLFD_WEIGHT_BOLD, &Qbold},
- {"book", XLFD_WEIGHT_SEMI_LIGHT, &Qsemi_light},
- {"demi", XLFD_WEIGHT_SEMI_BOLD, &Qsemi_bold},
- {"demibold", XLFD_WEIGHT_SEMI_BOLD, &Qsemi_bold},
- {"extralight", XLFD_WEIGHT_EXTRA_LIGHT, &Qextra_light},
- {"extrabold", XLFD_WEIGHT_EXTRA_BOLD, &Qextra_bold},
- {"heavy", XLFD_WEIGHT_EXTRA_BOLD, &Qextra_bold},
- {"light", XLFD_WEIGHT_LIGHT, &Qlight},
- {"medium", XLFD_WEIGHT_MEDIUM, &Qnormal},
- {"normal", XLFD_WEIGHT_MEDIUM, &Qnormal},
- {"regular", XLFD_WEIGHT_MEDIUM, &Qnormal},
- {"semibold", XLFD_WEIGHT_SEMI_BOLD, &Qsemi_bold},
- {"semilight", XLFD_WEIGHT_SEMI_LIGHT, &Qsemi_light},
- {"ultralight", XLFD_WEIGHT_ULTRA_LIGHT, &Qultra_light},
- {"ultrabold", XLFD_WEIGHT_ULTRA_BOLD, &Qultra_bold}
-};
-
-/* Table of XLFD width names. This table must be sorted by width
- names in ascending order. */
-
-static struct table_entry swidth_table[] =
-{
- {"compressed", XLFD_SWIDTH_CONDENSED, &Qcondensed},
- {"condensed", XLFD_SWIDTH_CONDENSED, &Qcondensed},
- {"demiexpanded", XLFD_SWIDTH_SEMI_EXPANDED, &Qsemi_expanded},
- {"expanded", XLFD_SWIDTH_EXPANDED, &Qexpanded},
- {"extracondensed", XLFD_SWIDTH_EXTRA_CONDENSED, &Qextra_condensed},
- {"extraexpanded", XLFD_SWIDTH_EXTRA_EXPANDED, &Qextra_expanded},
- {"medium", XLFD_SWIDTH_MEDIUM, &Qnormal},
- {"narrow", XLFD_SWIDTH_CONDENSED, &Qcondensed},
- {"normal", XLFD_SWIDTH_MEDIUM, &Qnormal},
- {"regular", XLFD_SWIDTH_MEDIUM, &Qnormal},
- {"semicondensed", XLFD_SWIDTH_SEMI_CONDENSED, &Qsemi_condensed},
- {"semiexpanded", XLFD_SWIDTH_SEMI_EXPANDED, &Qsemi_expanded},
- {"ultracondensed", XLFD_SWIDTH_ULTRA_CONDENSED, &Qultra_condensed},
- {"ultraexpanded", XLFD_SWIDTH_ULTRA_EXPANDED, &Qultra_expanded},
- {"wide", XLFD_SWIDTH_EXTRA_EXPANDED, &Qextra_expanded}
-};
-
-/* Structure used to hold the result of splitting font names in XLFD
- format into their fields. */
-
-struct font_name
-{
- /* The original name which is modified destructively by
- split_font_name. The pointer is kept here to be able to free it
- if it was allocated from the heap. */
- char *name;
-
- /* Font name fields. Each vector element points into `name' above.
- Fields are NUL-terminated. */
- char *fields[XLFD_LAST];
-
- /* Numeric values for those fields that interest us. See
- 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;
-};
-
-/* The frame in effect when sorting font names. Set temporarily in
- sort_fonts so that it is available in font comparison functions. */
-
-static struct frame *font_frame;
-
/* Order by which font selection chooses fonts. The default values
mean `first, find a best match for the font width, then for the
font height, then for weight, then for slant.' This variable can be
set via set-face-font-sort-order. */
-#ifdef MAC_OS
-static int font_sort_order[4] = {
- XLFD_SWIDTH, XLFD_POINT_SIZE, XLFD_WEIGHT, XLFD_SLANT
-};
-#else
static int font_sort_order[4];
-#endif
-/* Look up FONT.fields[FIELD_INDEX] in TABLE which has DIM entries.
- TABLE must be sorted by TABLE[i]->name in ascending order. Value
- is a pointer to the matching table entry or null if no table entry
- matches. */
+#ifdef HAVE_WINDOW_SYSTEM
-static struct table_entry *
-xlfd_lookup_field_contents (table, dim, font, field_index)
- struct table_entry *table;
- int dim;
- struct font_name *font;
- int field_index;
-{
- /* Function split_font_name converts fields to lower-case, so there
- is no need to use xstrlwr or xstricmp here. */
- char *s = font->fields[field_index];
- int low, mid, high, cmp;
+static enum font_property_index font_props_for_sorting[FONT_SIZE_INDEX];
- low = 0;
- high = dim - 1;
+static int
+compare_fonts_by_sort_order (const void *v1, const void *v2)
+{
+ Lisp_Object font1 = *(Lisp_Object *) v1;
+ Lisp_Object font2 = *(Lisp_Object *) v2;
+ int i;
- while (low <= high)
+ for (i = 0; i < FONT_SIZE_INDEX; i++)
{
- mid = (low + high) / 2;
- cmp = strcmp (table[mid].name, s);
+ enum font_property_index idx = font_props_for_sorting[i];
+ Lisp_Object val1 = AREF (font1, idx), val2 = AREF (font2, idx);
+ int result;
- if (cmp < 0)
- low = mid + 1;
- else if (cmp > 0)
- high = mid - 1;
+ if (idx <= FONT_REGISTRY_INDEX)
+ {
+ if (STRINGP (val1))
+ result = STRINGP (val2) ? strcmp (SDATA (val1), SDATA (val2)) : -1;
+ else
+ result = STRINGP (val2) ? 1 : 0;
+ }
else
- return table + mid;
+ {
+ if (INTEGERP (val1))
+ result = INTEGERP (val2) ? XINT (val1) - XINT (val2) : -1;
+ else
+ result = INTEGERP (val2) ? 1 : 0;
+ }
+ if (result)
+ return result;
}
-
- return NULL;
+ return 0;
}
+DEFUN ("x-family-fonts", Fx_family_fonts, Sx_family_fonts, 0, 2, 0,
+ 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. */)
+ (Lisp_Object family, Lisp_Object frame)
+{
+ Lisp_Object font_spec, list, *drivers, vec;
+ int i, nfonts, ndrivers;
+ Lisp_Object result;
-/* Return a numeric representation for font name field
- FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
- has DIM entries. Value is the numeric value found or DFLT if no
- table entry matches. This function is used to translate weight,
- slant, and swidth names of XLFD font names to numeric values. */
-
-static INLINE int
-xlfd_numeric_value (table, dim, font, field_index, dflt)
- struct table_entry *table;
- int dim;
- struct font_name *font;
- int field_index;
- int dflt;
-{
- struct table_entry *p;
- p = xlfd_lookup_field_contents (table, dim, font, field_index);
- return p ? p->numeric : dflt;
-}
-
+ if (NILP (frame))
+ frame = selected_frame;
+ CHECK_LIVE_FRAME (frame);
-/* Return a symbolic representation for font name field
- FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
- has DIM entries. Value is the symbolic value found or DFLT if no
- table entry matches. This function is used to translate weight,
- slant, and swidth names of XLFD font names to symbols. */
+ font_spec = Ffont_spec (0, NULL);
+ if (!NILP (family))
+ {
+ CHECK_STRING (family);
+ font_parse_family_registry (family, Qnil, font_spec);
+ }
-static INLINE Lisp_Object
-xlfd_symbolic_value (table, dim, font, field_index, dflt)
- struct table_entry *table;
- int dim;
- struct font_name *font;
- int field_index;
- Lisp_Object dflt;
-{
- struct table_entry *p;
- p = xlfd_lookup_field_contents (table, dim, font, field_index);
- return p ? *p->symbol : dflt;
-}
+ list = font_list_entities (frame, font_spec);
+ if (NILP (list))
+ return Qnil;
+ /* Sort the font entities. */
+ for (i = 0; i < 4; i++)
+ switch (font_sort_order[i])
+ {
+ case XLFD_SWIDTH:
+ font_props_for_sorting[i] = FONT_WIDTH_INDEX; break;
+ case XLFD_POINT_SIZE:
+ font_props_for_sorting[i] = FONT_SIZE_INDEX; break;
+ case XLFD_WEIGHT:
+ font_props_for_sorting[i] = FONT_WEIGHT_INDEX; break;
+ default:
+ font_props_for_sorting[i] = FONT_SLANT_INDEX; break;
+ }
+ font_props_for_sorting[i++] = FONT_FAMILY_INDEX;
+ font_props_for_sorting[i++] = FONT_FOUNDRY_INDEX;
+ font_props_for_sorting[i++] = FONT_ADSTYLE_INDEX;
+ font_props_for_sorting[i++] = FONT_REGISTRY_INDEX;
-/* Return a numeric value for the slant of the font given by FONT. */
+ ndrivers = XINT (Flength (list));
+ drivers = alloca (sizeof (Lisp_Object) * ndrivers);
+ for (i = 0; i < ndrivers; i++, list = XCDR (list))
+ drivers[i] = XCAR (list);
+ vec = Fvconcat (ndrivers, drivers);
+ nfonts = ASIZE (vec);
-static INLINE int
-xlfd_numeric_slant (font)
- struct font_name *font;
-{
- return xlfd_numeric_value (slant_table, DIM (slant_table),
- font, XLFD_SLANT, XLFD_SLANT_ROMAN);
-}
+ qsort (XVECTOR (vec)->contents, nfonts, sizeof (Lisp_Object),
+ compare_fonts_by_sort_order);
+ result = Qnil;
+ for (i = nfonts - 1; i >= 0; --i)
+ {
+ Lisp_Object font = AREF (vec, i);
+ Lisp_Object v = Fmake_vector (make_number (8), Qnil);
+ int point;
+ Lisp_Object spacing;
+
+ ASET (v, 0, AREF (font, FONT_FAMILY_INDEX));
+ ASET (v, 1, FONT_WIDTH_SYMBOLIC (font));
+ point = PIXEL_TO_POINT (XINT (AREF (font, FONT_SIZE_INDEX)) * 10,
+ XFRAME (frame)->resy);
+ ASET (v, 2, make_number (point));
+ ASET (v, 3, FONT_WEIGHT_SYMBOLIC (font));
+ ASET (v, 4, FONT_SLANT_SYMBOLIC (font));
+ spacing = Ffont_get (font, QCspacing);
+ ASET (v, 5, (NILP (spacing) || EQ (spacing, Qp)) ? Qnil : Qt);
+ ASET (v, 6, Ffont_xlfd_name (font, Qnil));
+ ASET (v, 7, AREF (font, FONT_REGISTRY_INDEX));
-/* Return a symbol representing the weight of the font given by FONT. */
+ result = Fcons (v, result);
+ }
-static INLINE Lisp_Object
-xlfd_symbolic_slant (font)
- struct font_name *font;
-{
- return xlfd_symbolic_value (slant_table, DIM (slant_table),
- font, XLFD_SLANT, Qnormal);
+ return result;
}
+DEFUN ("x-list-fonts", Fx_list_fonts, Sx_list_fonts, 1, 5, 0,
+ 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.
-/* Return a numeric value for the weight of the font given by FONT. */
-
-static INLINE int
-xlfd_numeric_weight (font)
- struct font_name *font;
-{
- return xlfd_numeric_value (weight_table, DIM (weight_table),
- font, XLFD_WEIGHT, XLFD_WEIGHT_MEDIUM);
-}
-
+PATTERN should be a string containing a font name in the XLFD,
+Fontconfig, or GTK format. A font name given in the XLFD format may
+contain wildcard characters:
+ the * character matches any substring, and
+ the ? character matches any single character.
+ PATTERN is case-insensitive.
-/* Return a symbol representing the slant of the font given by FONT. */
+The return value is a list of strings, suitable as arguments to
+`set-face-font'.
-static INLINE Lisp_Object
-xlfd_symbolic_weight (font)
- struct font_name *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. */)
+ (Lisp_Object pattern, Lisp_Object face, Lisp_Object frame, Lisp_Object maximum, Lisp_Object width)
{
- return xlfd_symbolic_value (weight_table, DIM (weight_table),
- font, XLFD_WEIGHT, Qnormal);
-}
+ struct frame *f;
+ int size, avgwidth;
+ check_x ();
+ CHECK_STRING (pattern);
-/* Return a numeric value for the swidth of the font whose XLFD font
- name fields are found in FONT. */
+ if (! NILP (maximum))
+ CHECK_NATNUM (maximum);
-static INLINE int
-xlfd_numeric_swidth (font)
- struct font_name *font;
-{
- return xlfd_numeric_value (swidth_table, DIM (swidth_table),
- font, XLFD_SWIDTH, XLFD_SWIDTH_MEDIUM);
-}
+ if (!NILP (width))
+ CHECK_NUMBER (width);
+ /* We can't simply call check_x_frame because this function may be
+ called before any frame is created. */
+ if (NILP (frame))
+ frame = selected_frame;
+ f = frame_or_selected_frame (frame, 2);
+ if (! FRAME_WINDOW_P (f))
+ {
+ /* Perhaps we have not yet created any frame. */
+ f = NULL;
+ frame = Qnil;
+ face = Qnil;
+ }
-/* Return a symbolic value for the swidth of FONT. */
-
-static INLINE Lisp_Object
-xlfd_symbolic_swidth (font)
- struct font_name *font;
-{
- return xlfd_symbolic_value (swidth_table, DIM (swidth_table),
- font, XLFD_SWIDTH, Qnormal);
-}
-
-
-/* Look up the entry of SYMBOL in the vector TABLE which has DIM
- entries. Value is a pointer to the matching table entry or null if
- no element of TABLE contains SYMBOL. */
-
-static struct table_entry *
-face_value (table, dim, symbol)
- struct table_entry *table;
- int dim;
- Lisp_Object symbol;
-{
- int i;
-
- xassert (SYMBOLP (symbol));
-
- for (i = 0; i < dim; ++i)
- if (EQ (*table[i].symbol, symbol))
- break;
-
- return i < dim ? table + i : NULL;
-}
-
-
-/* Return a numeric value for SYMBOL in the vector TABLE which has DIM
- entries. Value is -1 if SYMBOL is not found in TABLE. */
-
-static INLINE int
-face_numeric_value (table, dim, symbol)
- struct table_entry *table;
- int dim;
- Lisp_Object symbol;
-{
- struct table_entry *p = face_value (table, dim, symbol);
- return p ? p->numeric : -1;
-}
-
-
-/* Return a numeric value representing the weight specified by Lisp
- symbol WEIGHT. Value is one of the enumerators of enum
- xlfd_weight. */
-
-static INLINE int
-face_numeric_weight (weight)
- Lisp_Object weight;
-{
- return face_numeric_value (weight_table, DIM (weight_table), weight);
-}
-
-
-/* Return a numeric value representing the slant specified by Lisp
- symbol SLANT. Value is one of the enumerators of enum xlfd_slant. */
-
-static INLINE int
-face_numeric_slant (slant)
- Lisp_Object slant;
-{
- return face_numeric_value (slant_table, DIM (slant_table), slant);
-}
-
-
-/* Return a numeric value representing the swidth specified by Lisp
- symbol WIDTH. Value is one of the enumerators of enum xlfd_swidth. */
-
-static int
-face_numeric_swidth (width)
- Lisp_Object width;
-{
- return face_numeric_value (swidth_table, DIM (swidth_table), width);
-}
-
-
-#ifdef HAVE_WINDOW_SYSTEM
-
-/* Return non-zero if FONT is the name of a fixed-pitch font. */
-
-static INLINE int
-xlfd_fixed_p (font)
- struct font_name *font;
-{
- /* Function split_font_name converts fields to lower-case, so there
- is no need to use tolower here. */
- return *font->fields[XLFD_SPACING] != 'p';
-}
-
-
-/* Return the point size of FONT on frame F, measured in 1/10 pt.
-
- The actual height of the font when displayed on F depends on the
- resolution of both the font and frame. For example, a 10pt font
- designed for a 100dpi display will display larger than 10pt on a
- 75dpi display. (It's not unusual to use fonts not designed for the
- display one is using. For example, some intlfonts are available in
- 72dpi versions, only.)
-
- Value is the real point size of FONT on frame F, or 0 if it cannot
- be determined. */
-
-static INLINE int
-xlfd_point_size (f, font)
- struct frame *f;
- struct font_name *font;
-{
- double resy = FRAME_X_DISPLAY_INFO (f)->resy;
- char *pixel_field = font->fields[XLFD_PIXEL_SIZE];
- double pixel;
- int real_pt;
-
- 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 * pixel / resy + 0.5;
-
- return real_pt;
-}
-
-
-/* Return point size of PIXEL dots while considering Y-resultion (DPI)
- of frame F. This function is used to guess a point size of font
- when only the pixel height of the font is available. */
-
-static INLINE int
-pixel_point_size (f, pixel)
- struct frame *f;
- int pixel;
-{
- double resy = FRAME_X_DISPLAY_INFO (f)->resy;
- double real_pt;
- int int_pt;
-
- /* As one inch is PT_PER_INCH points, PT_PER_INCH/RESY gives the
- point size of one dot. */
- real_pt = pixel * PT_PER_INCH / resy;
- int_pt = real_pt + 0.5;
-
- return int_pt;
-}
-
-
-/* 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,
- 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 `-'. */
-
-static int
-split_font_name (f, font, numeric_p)
- struct frame *f;
- struct font_name *font;
- int numeric_p;
-{
- 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 *p = xstrlwr (font->name) + 1;
-
- while (i < XLFD_LAST)
- {
- 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;
-
- if (*p != '-')
- break;
-
- *p++ = 0;
- }
- }
-
- success_p = i == XLFD_LAST;
-
- /* If requested, and font name was in the expected format,
- compute numeric values for some fields. */
- if (numeric_p && success_p)
- {
- font->numeric[XLFD_POINT_SIZE] = xlfd_point_size (f, font);
- font->numeric[XLFD_RESY] = atoi (font->fields[XLFD_RESY]);
- font->numeric[XLFD_SLANT] = xlfd_numeric_slant (font);
- 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
- trying alternate registries. */
- font->registry_priority = 0;
-
- return success_p;
-}
-
-
-/* Build an XLFD font name from font name fields in FONT. Value is a
- pointer to the font name, which is allocated via xmalloc. */
-
-static char *
-build_font_name (font)
- struct font_name *font;
-{
- int i;
- int size = 100;
- char *font_name = (char *) xmalloc (size);
- int total_length = 0;
-
- for (i = 0; i < XLFD_LAST; ++i)
- {
- /* Add 1 because of the leading `-'. */
- int len = strlen (font->fields[i]) + 1;
-
- /* Reallocate font_name if necessary. Add 1 for the final
- NUL-byte. */
- if (total_length + len + 1 >= size)
- {
- int new_size = max (2 * size, size + len + 1);
- int sz = new_size * sizeof *font_name;
- font_name = (char *) xrealloc (font_name, sz);
- size = new_size;
- }
-
- font_name[total_length] = '-';
- bcopy (font->fields[i], font_name + total_length + 1, len - 1);
- total_length += len;
- }
-
- font_name[total_length] = 0;
- return font_name;
-}
-
-
-/* Free an array FONTS of N font_name structures. This frees FONTS
- itself and all `name' fields in its elements. */
-
-static INLINE void
-free_font_names (fonts, n)
- struct font_name *fonts;
- int n;
-{
- while (n)
- xfree (fonts[--n].name);
- xfree (fonts);
-}
-
-
-/* Sort vector FONTS of font_name structures which contains NFONTS
- elements using qsort and comparison function CMPFN. F is the frame
- on which the fonts will be used. The global variable font_frame
- is temporarily set to F to make it available in CMPFN. */
-
-static INLINE void
-sort_fonts (f, fonts, nfonts, cmpfn)
- struct frame *f;
- struct font_name *fonts;
- int nfonts;
- int (*cmpfn) P_ ((const void *, const void *));
-{
- font_frame = f;
- qsort (fonts, nfonts, sizeof *fonts, cmpfn);
- font_frame = NULL;
-}
-
-
-/* Get fonts matching PATTERN on frame F. If F is null, use the first
- display in x_display_list. FONTS is a pointer to a vector of
- NFONTS font_name structures. TRY_ALTERNATIVES_P non-zero means try
- alternative patterns from Valternate_fontname_alist if no fonts are
- found matching PATTERN.
-
- For all fonts found, set FONTS[i].name to the name of the font,
- allocated via xmalloc, and split font names into fields. Ignore
- fonts that we can't parse. Value is the number of fonts found. */
-
-static int
-x_face_list_fonts (f, pattern, pfonts, nfonts, try_alternatives_p)
- struct frame *f;
- char *pattern;
- struct font_name **pfonts;
- int nfonts, try_alternatives_p;
-{
- int n, nignored;
-
- /* NTEMACS_TODO : currently this uses w32_list_fonts, but it may be
- 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. */
-#ifdef WINDOWSNT
- BLOCK_INPUT;
- lfonts = w32_list_fonts (f, lpattern, 0, nfonts);
- UNBLOCK_INPUT;
-#else
- 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 < num_fonts; tem = XCDR (tem))
- {
- Lisp_Object elt, tail;
- 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))
- {
- elt = XCAR (tail);
- if (STRINGP (elt)
- && fast_c_string_match_ignore_case (elt, name) >= 0)
- break;
- }
- if (!NILP (tail))
- {
- ++nignored;
- 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);
-
- if (split_font_name (f, fonts + n, 1))
- {
- if (font_scalable_p (fonts + n)
- && !may_use_scalable_font_p (name))
- {
- ++nignored;
- xfree (fonts[n].name);
- }
- else
- ++n;
- }
- else
- xfree (fonts[n].name);
- }
-
- /* If no fonts found, try patterns from Valternate_fontname_alist. */
- if (n == 0 && try_alternatives_p)
- {
- 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 (SDATA (XCAR (entry)), pattern) == 0)
- break;
- list = XCDR (list);
- }
-
- if (CONSP (list))
- {
- Lisp_Object patterns = XCAR (list);
- Lisp_Object name;
-
- while (CONSP (patterns)
- /* If list is screwed up, give up. */
- && (name = XCAR (patterns),
- STRINGP (name))
- /* Ignore patterns equal to PATTERN because we tried that
- already with no success. */
- && (strcmp (SDATA (name), pattern) == 0
- || (n = x_face_list_fonts (f, SDATA (name),
- pfonts, nfonts, 0),
- n == 0)))
- patterns = XCDR (patterns);
- }
- }
-
- return n;
-}
-
-
-/* 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
- font_name structures allocated from the heap containing matching
- fonts. Each element of *FONTS contains a name member that is also
- allocated from the heap. Font names in these structures are split
- into fields. Use free_font_names to free such an array. */
-
-static int
-sorted_font_list (f, pattern, cmpfn, fonts)
- struct frame *f;
- char *pattern;
- int (*cmpfn) P_ ((const void *, const void *));
- struct font_name **fonts;
-{
- int nfonts;
-
- /* Get the list of fonts matching pattern. 100 should suffice. */
- nfonts = DEFAULT_FONT_LIST_LIMIT;
- if (INTEGERP (Vfont_list_limit))
- nfonts = XINT (Vfont_list_limit);
-
- *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 if (*fonts)
- {
- xfree (*fonts);
- *fonts = NULL;
- }
-
- return nfonts;
-}
-
-
-/* Compare two font_name structures *A and *B. Value is analogous to
- strcmp. Sort order is given by the global variable
- font_sort_order. Font names are sorted so that, everything else
- being equal, fonts with a resolution closer to that of the frame on
- which they are used are listed first. The global variable
- font_frame is the frame on which we operate. */
-
-static int
-cmp_font_names (a, b)
- const void *a, *b;
-{
- struct font_name *x = (struct font_name *) a;
- struct font_name *y = (struct font_name *) b;
- int cmp;
-
- /* All strings have been converted to lower-case by split_font_name,
- so we can use strcmp here. */
- cmp = strcmp (x->fields[XLFD_FAMILY], y->fields[XLFD_FAMILY]);
- if (cmp == 0)
- {
- int i;
-
- for (i = 0; i < DIM (font_sort_order) && cmp == 0; ++i)
- {
- int j = font_sort_order[i];
- cmp = x->numeric[j] - y->numeric[j];
- }
-
- if (cmp == 0)
- {
- /* Everything else being equal, we prefer fonts with an
- y-resolution closer to that of the frame. */
- int resy = FRAME_X_DISPLAY_INFO (font_frame)->resy;
- int x_resy = x->numeric[XLFD_RESY];
- int y_resy = y->numeric[XLFD_RESY];
- cmp = abs (resy - x_resy) - abs (resy - y_resy);
- }
- }
-
- return cmp;
-}
-
-
-/* Get a sorted list of fonts of family FAMILY on frame F. If PATTERN
- is non-nil list fonts matching that pattern. Otherwise, if
- REGISTRY is non-nil return only fonts with that registry, otherwise
- return fonts of any registry. Set *FONTS to a vector of font_name
- structures allocated from the heap containing the fonts found.
- Value is the number of fonts found. */
-
-static int
-font_list_1 (f, pattern, family, registry, fonts)
- struct frame *f;
- Lisp_Object pattern, family, registry;
- struct font_name **fonts;
-{
- char *pattern_str, *family_str, *registry_str;
-
- if (NILP (pattern))
- {
- family_str = (NILP (family) ? "*" : (char *) SDATA (family));
- registry_str = (NILP (registry) ? "*" : (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, "*-*");
- }
- }
- else
- pattern_str = (char *) SDATA (pattern);
-
- return sorted_font_list (f, pattern_str, cmp_font_names, fonts);
-}
-
-
-/* Concatenate font list FONTS1 and FONTS2. FONTS1 and FONTS2
- contains NFONTS1 fonts and NFONTS2 fonts respectively. Return a
- pointer to a newly allocated font list. FONTS1 and FONTS2 are
- freed. */
-
-static struct font_name *
-concat_font_list (fonts1, nfonts1, fonts2, nfonts2)
- struct font_name *fonts1, *fonts2;
- int nfonts1, nfonts2;
-{
- int new_nfonts = nfonts1 + nfonts2;
- struct font_name *new_fonts;
-
- new_fonts = (struct font_name *) xmalloc (sizeof *new_fonts * new_nfonts);
- bcopy (fonts1, new_fonts, sizeof *new_fonts * nfonts1);
- bcopy (fonts2, new_fonts + nfonts1, sizeof *new_fonts * nfonts2);
- xfree (fonts1);
- xfree (fonts2);
- return new_fonts;
-}
-
-
-/* Get a sorted list of fonts of family FAMILY on frame F.
-
- If PATTERN is non-nil list fonts matching that pattern.
-
- 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
- heap containing the fonts found. Value is the number of fonts
- found. */
-
-static int
-font_list (f, pattern, family, registry, fonts)
- struct frame *f;
- Lisp_Object pattern, family, registry;
- struct font_name **fonts;
-{
- int nfonts = font_list_1 (f, pattern, family, registry, fonts);
-
- if (!NILP (registry)
- && CONSP (Vface_alternative_font_registry_alist))
- {
- Lisp_Object alter;
-
- alter = Fassoc (registry, Vface_alternative_font_registry_alist);
- if (CONSP (alter))
- {
- int reg_prio, i;
-
- for (alter = XCDR (alter), reg_prio = 1;
- CONSP (alter);
- alter = XCDR (alter), reg_prio++)
- if (STRINGP (XCAR (alter)))
- {
- int nfonts2;
- struct font_name *fonts2;
-
- nfonts2 = font_list_1 (f, pattern, family, XCAR (alter),
- &fonts2);
- for (i = 0; i < nfonts2; i++)
- fonts2[i].registry_priority = reg_prio;
- *fonts = (nfonts > 0
- ? concat_font_list (*fonts, nfonts, fonts2, nfonts2)
- : fonts2);
- nfonts += nfonts2;
- }
- }
- }
-
- return nfonts;
-}
-
-
-/* Remove elements from LIST whose cars are `equal'. Called from
- x-family-fonts and x-font-family-list to remove duplicate font
- entries. */
-
-static void
-remove_duplicates (list)
- Lisp_Object list;
-{
- Lisp_Object tail = list;
-
- while (!NILP (tail) && !NILP (XCDR (tail)))
- {
- Lisp_Object next = XCDR (tail);
- if (!NILP (Fequal (XCAR (next), XCAR (tail))))
- XSETCDR (tail, XCDR (next));
- else
- tail = XCDR (tail);
- }
-}
-
-
-DEFUN ("x-family-fonts", Fx_family_fonts, Sx_family_fonts, 0, 2, 0,
- 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 font_name *fonts;
- int i, nfonts;
- Lisp_Object result;
- struct gcpro gcpro1;
-
- if (!NILP (family))
- CHECK_STRING (family);
-
- result = Qnil;
- GCPRO1 (result);
- nfonts = font_list (f, Qnil, family, Qnil, &fonts);
- for (i = nfonts - 1; i >= 0; --i)
- {
- Lisp_Object v = Fmake_vector (make_number (8), Qnil);
- char *tem;
-
- ASET (v, 0, build_string (fonts[i].fields[XLFD_FAMILY]));
- ASET (v, 1, xlfd_symbolic_swidth (fonts + i));
- ASET (v, 2, make_number (xlfd_point_size (f, fonts + i)));
- ASET (v, 3, xlfd_symbolic_weight (fonts + i));
- ASET (v, 4, xlfd_symbolic_slant (fonts + i));
- ASET (v, 5, xlfd_fixed_p (fonts + i) ? Qt : Qnil);
- tem = build_font_name (fonts + i);
- ASET (v, 6, build_string (tem));
- sprintf (tem, "%s-%s", fonts[i].fields[XLFD_REGISTRY],
- fonts[i].fields[XLFD_ENCODING]);
- ASET (v, 7, build_string (tem));
- xfree (tem);
-
- result = Fcons (v, result);
- }
-
- remove_duplicates (result);
- free_font_names (fonts, nfonts);
- UNGCPRO;
- return result;
-}
-
-
-DEFUN ("x-font-family-list", Fx_font_family_list, Sx_font_family_list,
- 0, 1, 0,
- 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);
- int nfonts, i;
- struct font_name *fonts;
- Lisp_Object result;
- struct gcpro gcpro1;
- int count = SPECPDL_INDEX ();
-
- /* 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);
- for (i = nfonts - 1; i >= 0; --i)
- result = Fcons (Fcons (build_string (fonts[i].fields[XLFD_FAMILY]),
- xlfd_fixed_p (fonts + i) ? Qt : Qnil),
- result);
-
- remove_duplicates (result);
- free_font_names (fonts, nfonts);
- UNGCPRO;
- return unbind_to (count, result);
-}
-
-
-DEFUN ("x-list-fonts", Fx_list_fonts, Sx_list_fonts, 1, 5, 0,
- 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 size;
- int maxnames;
-
- check_x ();
- CHECK_STRING (pattern);
-
- if (NILP (maximum))
- maxnames = -1;
- else
- {
- CHECK_NATNUM (maximum);
- maxnames = XINT (maximum);
- }
-
- if (!NILP (width))
- CHECK_NUMBER (width);
-
- /* We can't simply call check_x_frame because this function may be
- called before any frame is created. */
- f = frame_or_selected_frame (frame, 2);
- if (!FRAME_WINDOW_P (f))
- {
- /* Perhaps we have not yet created any frame. */
- f = NULL;
- face = Qnil;
- }
-
- /* Determine the width standard for comparison with the fonts we find. */
+ /* Determine the width standard for comparison with the fonts we find. */
if (NILP (face))
size = 0;
{
/* This is of limited utility since it works with character
widths. Keep it for compatibility. --gerd. */
- int face_id = lookup_named_face (f, face, 0, 0);
+ int face_id = lookup_named_face (f, face, 0);
struct face *face = (face_id < 0
? 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);
+ {
+ size = face->font->pixel_size;
+ avgwidth = face->font->average_width;
+ }
else
- size = FONT_WIDTH (FRAME_FONT (f)); /* FRAME_COLUMN_WIDTH (f) */
-
+ {
+ size = FRAME_FONT (f)->pixel_size;
+ avgwidth = FRAME_FONT (f)->average_width;
+ }
if (!NILP (width))
- size *= XINT (width);
+ avgwidth *= XINT (width);
}
{
- Lisp_Object args[2];
+ Lisp_Object font_spec;
+ Lisp_Object args[2], tail;
+
+ font_spec = font_spec_from_name (pattern);
+ if (!FONTP (font_spec))
+ signal_error ("Invalid font name", pattern);
- args[0] = x_list_fonts (f, pattern, size, maxnames);
- if (f == NULL)
+ if (size)
+ {
+ Ffont_put (font_spec, QCsize, make_number (size));
+ Ffont_put (font_spec, QCavgwidth, make_number (avgwidth));
+ }
+ args[0] = Flist_fonts (font_spec, frame, maximum, font_spec);
+ for (tail = args[0]; CONSP (tail); tail = XCDR (tail))
+ {
+ Lisp_Object font_entity;
+
+ font_entity = XCAR (tail);
+ if ((NILP (AREF (font_entity, FONT_SIZE_INDEX))
+ || XINT (AREF (font_entity, FONT_SIZE_INDEX)) == 0)
+ && ! NILP (AREF (font_spec, FONT_SIZE_INDEX)))
+ {
+ /* This is a scalable font. For backward compatibility,
+ we set the specified size. */
+ font_entity = Fcopy_font_spec (font_entity);
+ ASET (font_entity, FONT_SIZE_INDEX,
+ AREF (font_spec, FONT_SIZE_INDEX));
+ }
+ XSETCAR (tail, Ffont_xlfd_name (font_entity, Qnil));
+ }
+ if (NILP (frame))
/* We don't have to check fontsets. */
return args[0];
args[1] = list_fontsets (f, pattern, size);
#endif /* HAVE_WINDOW_SYSTEM */
-
\f
/***********************************************************************
Lisp Faces
/* Access face attributes of face LFACE, a Lisp vector. */
#define LFACE_FAMILY(LFACE) AREF ((LFACE), LFACE_FAMILY_INDEX)
+#define LFACE_FOUNDRY(LFACE) AREF ((LFACE), LFACE_FOUNDRY_INDEX)
#define LFACE_HEIGHT(LFACE) AREF ((LFACE), LFACE_HEIGHT_INDEX)
#define LFACE_WEIGHT(LFACE) AREF ((LFACE), LFACE_WEIGHT_INDEX)
#define LFACE_SLANT(LFACE) AREF ((LFACE), LFACE_SLANT_INDEX)
#define LFACE_BOX(LFACE) AREF ((LFACE), LFACE_BOX_INDEX)
#define LFACE_FONT(LFACE) AREF ((LFACE), LFACE_FONT_INDEX)
#define LFACE_INHERIT(LFACE) AREF ((LFACE), LFACE_INHERIT_INDEX)
-#define LFACE_AVGWIDTH(LFACE) AREF ((LFACE), LFACE_AVGWIDTH_INDEX)
+#define LFACE_FONTSET(LFACE) AREF ((LFACE), LFACE_FONTSET_INDEX)
/* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
xassert (UNSPECIFIEDP (attrs[LFACE_FAMILY_INDEX])
|| IGNORE_DEFFACE_P (attrs[LFACE_FAMILY_INDEX])
|| STRINGP (attrs[LFACE_FAMILY_INDEX]));
+ xassert (UNSPECIFIEDP (attrs[LFACE_FOUNDRY_INDEX])
+ || IGNORE_DEFFACE_P (attrs[LFACE_FOUNDRY_INDEX])
+ || STRINGP (attrs[LFACE_FOUNDRY_INDEX]));
xassert (UNSPECIFIEDP (attrs[LFACE_SWIDTH_INDEX])
|| IGNORE_DEFFACE_P (attrs[LFACE_SWIDTH_INDEX])
|| SYMBOLP (attrs[LFACE_SWIDTH_INDEX]));
- xassert (UNSPECIFIEDP (attrs[LFACE_AVGWIDTH_INDEX])
- || IGNORE_DEFFACE_P (attrs[LFACE_AVGWIDTH_INDEX])
- || INTEGERP (attrs[LFACE_AVGWIDTH_INDEX]));
xassert (UNSPECIFIEDP (attrs[LFACE_HEIGHT_INDEX])
|| IGNORE_DEFFACE_P (attrs[LFACE_HEIGHT_INDEX])
|| INTEGERP (attrs[LFACE_HEIGHT_INDEX])
|| !NILP (Fbitmap_spec_p (attrs[LFACE_STIPPLE_INDEX])));
xassert (UNSPECIFIEDP (attrs[LFACE_FONT_INDEX])
|| IGNORE_DEFFACE_P (attrs[LFACE_FONT_INDEX])
- || NILP (attrs[LFACE_FONT_INDEX])
- || STRINGP (attrs[LFACE_FONT_INDEX]));
+ || FONTP (attrs[LFACE_FONT_INDEX]));
+ xassert (UNSPECIFIEDP (attrs[LFACE_FONTSET_INDEX])
+ || STRINGP (attrs[LFACE_FONTSET_INDEX]));
#endif
}
\f
/* Face-merge cycle checking. */
+enum named_merge_point_kind
+{
+ NAMED_MERGE_POINT_NORMAL,
+ NAMED_MERGE_POINT_REMAP
+};
+
/* A `named merge point' is simply a point during face-merging where we
look up a face by name. We keep a stack of which named lookups we're
currently processing so that we can easily detect cycles, using a
struct named_merge_point
{
Lisp_Object face_name;
+ enum named_merge_point_kind named_merge_point_kind;
struct named_merge_point *prev;
};
/* If a face merging cycle is detected for FACE_NAME, return 0,
otherwise add NEW_NAMED_MERGE_POINT, which is initialized using
- FACE_NAME, as the head of the linked list pointed to by
- NAMED_MERGE_POINTS, and return 1. */
+ FACE_NAME and NAMED_MERGE_POINT_KIND, as the head of the linked list
+ pointed to by NAMED_MERGE_POINTS, and return 1. */
static INLINE int
push_named_merge_point (struct named_merge_point *new_named_merge_point,
Lisp_Object face_name,
+ enum named_merge_point_kind named_merge_point_kind,
struct named_merge_point **named_merge_points)
{
struct named_merge_point *prev;
for (prev = *named_merge_points; prev; prev = prev->prev)
if (EQ (face_name, prev->face_name))
- return 0;
+ {
+ if (prev->named_merge_point_kind == named_merge_point_kind)
+ /* A cycle, so fail. */
+ return 0;
+ else if (prev->named_merge_point_kind == NAMED_MERGE_POINT_REMAP)
+ /* A remap `hides ' any previous normal merge points
+ (because the remap means that it's actually different face),
+ so as we know the current merge point must be normal, we
+ can just assume it's OK. */
+ break;
+ }
new_named_merge_point->face_name = face_name;
+ new_named_merge_point->named_merge_point_kind = named_merge_point_kind;
new_named_merge_point->prev = *named_merge_points;
*named_merge_points = new_named_merge_point;
\f
+#if 0 /* Seems to be unused. */
+static Lisp_Object
+internal_resolve_face_name (nargs, args)
+ int nargs;
+ Lisp_Object *args;
+{
+ return Fget (args[0], args[1]);
+}
+
+static Lisp_Object
+resolve_face_name_error (ignore)
+ Lisp_Object ignore;
+{
+ return Qnil;
+}
+#endif
/* Resolve face name FACE_NAME. If FACE_NAME is a string, intern it
to make it a symbol. If FACE_NAME is an alias for another face,
Return default face in case of errors. */
static Lisp_Object
-resolve_face_name (face_name, signal_p)
- Lisp_Object face_name;
- int signal_p;
+resolve_face_name (Lisp_Object face_name, int signal_p)
{
Lisp_Object orig_face;
Lisp_Object tortoise, hare;
/* Return the face definition of FACE_NAME on frame F. F null means
return the definition for new frames. FACE_NAME may be a string or
a symbol (apparently Emacs 20.2 allowed strings as face names in
- face text properties; Ediff uses that). If FACE_NAME is an alias
- for another face, return that face's definition. If SIGNAL_P is
- non-zero, signal an error if FACE_NAME is not a valid face name.
- If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
- name. */
-
+ face text properties; Ediff uses that). If SIGNAL_P is non-zero,
+ signal an error if FACE_NAME is not a valid face name. If SIGNAL_P
+ is zero, value is nil if FACE_NAME is not a valid face name. */
static INLINE Lisp_Object
-lface_from_face_name (f, face_name, signal_p)
- struct frame *f;
- Lisp_Object face_name;
- int signal_p;
+lface_from_face_name_no_resolve (struct frame *f, Lisp_Object face_name, int signal_p)
{
Lisp_Object lface;
- face_name = resolve_face_name (face_name, signal_p);
-
if (f)
lface = assq_no_quit (face_name, f->face_alist);
else
signal_error ("Invalid face", face_name);
check_lface (lface);
+
return lface;
}
+/* Return the face definition of FACE_NAME on frame F. F null means
+ return the definition for new frames. FACE_NAME may be a string or
+ a symbol (apparently Emacs 20.2 allowed strings as face names in
+ face text properties; Ediff uses that). If FACE_NAME is an alias
+ for another face, return that face's definition. If SIGNAL_P is
+ non-zero, signal an error if FACE_NAME is not a valid face name.
+ If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
+ name. */
+static INLINE Lisp_Object
+lface_from_face_name (struct frame *f, Lisp_Object face_name, int signal_p)
+{
+ face_name = resolve_face_name (face_name, signal_p);
+ return lface_from_face_name_no_resolve (f, face_name, signal_p);
+}
+
/* Get face attributes of face FACE_NAME from frame-local faces on
frame F. Store the resulting attributes in ATTRS which must point
Otherwise, value is zero if FACE_NAME is not a face. */
static INLINE int
-get_lface_attributes (f, face_name, attrs, signal_p)
- struct frame *f;
- Lisp_Object face_name;
- Lisp_Object *attrs;
- int signal_p;
+get_lface_attributes_no_remap (struct frame *f, Lisp_Object face_name, Lisp_Object *attrs, int signal_p)
{
Lisp_Object lface;
- int success_p;
- lface = lface_from_face_name (f, face_name, signal_p);
- if (!NILP (lface))
+ lface = lface_from_face_name_no_resolve (f, face_name, signal_p);
+
+ if (! NILP (lface))
+ memcpy (attrs, XVECTOR (lface)->contents,
+ LFACE_VECTOR_SIZE * sizeof *attrs);
+
+ return !NILP (lface);
+}
+
+/* Get face attributes of face FACE_NAME from frame-local faces on frame
+ F. Store the resulting attributes in ATTRS which must point to a
+ vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If FACE_NAME is an
+ alias for another face, use that face's definition. If SIGNAL_P is
+ non-zero, signal an error if FACE_NAME does not name a face.
+ Otherwise, value is zero if FACE_NAME is not a face. */
+
+static INLINE int
+get_lface_attributes (struct frame *f, Lisp_Object face_name, Lisp_Object *attrs, int signal_p, struct named_merge_point *named_merge_points)
+{
+ Lisp_Object face_remapping;
+
+ face_name = resolve_face_name (face_name, signal_p);
+
+ /* See if SYMBOL has been remapped to some other face (usually this
+ is done buffer-locally). */
+ face_remapping = assq_no_quit (face_name, Vface_remapping_alist);
+ if (CONSP (face_remapping))
{
- bcopy (XVECTOR (lface)->contents, attrs,
- LFACE_VECTOR_SIZE * sizeof *attrs);
- success_p = 1;
+ struct named_merge_point named_merge_point;
+
+ if (push_named_merge_point (&named_merge_point,
+ face_name, NAMED_MERGE_POINT_REMAP,
+ &named_merge_points))
+ {
+ int i;
+
+ for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
+ attrs[i] = Qunspecified;
+
+ return merge_face_ref (f, XCDR (face_remapping), attrs,
+ signal_p, named_merge_points);
+ }
}
- else
- success_p = 0;
- return success_p;
+ /* Default case, no remapping. */
+ return get_lface_attributes_no_remap (f, face_name, attrs, signal_p);
}
specified, i.e. are non-nil. */
static int
-lface_fully_specified_p (attrs)
- Lisp_Object *attrs;
+lface_fully_specified_p (Lisp_Object *attrs)
{
int i;
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]) || IGNORE_DEFFACE_P (attrs[i]))
-#ifdef MAC_OS
- /* MAC_TODO: No stipple support on Mac OS yet, this index is
- always unspecified. */
- && i != LFACE_STIPPLE_INDEX
-#endif
- )
+ if (i != LFACE_FONT_INDEX && i != LFACE_INHERIT_INDEX)
+ if ((UNSPECIFIEDP (attrs[i]) || IGNORE_DEFFACE_P (attrs[i])))
break;
return i == LFACE_VECTOR_SIZE;
#ifdef HAVE_WINDOW_SYSTEM
-/* Set font-related attributes of Lisp face LFACE from the fullname of
- the font opened by FONTNAME. If FORCE_P is zero, set only
- unspecified attributes of LFACE. The exception is `font'
- attribute. It is set to FONTNAME as is regardless of FORCE_P.
-
- If FONTNAME is not available on frame F,
- return 0 if MAY_FAIL_P is non-zero, otherwise abort.
- If the fullname is not in a valid XLFD format,
- return 0 if MAY_FAIL_P is non-zero, otherwise set normal values
- in LFACE and return 1.
- Otherwise, return 1. */
+/* Set font-related attributes of Lisp face LFACE from FONT-OBJECT.
+ If FORCE_P is zero, set only unspecified attributes of LFACE. The
+ exception is `font' attribute. It is set to FONT_OBJECT regardless
+ of FORCE_P. */
static int
-set_lface_from_font_name (f, lface, fontname, force_p, may_fail_p)
- struct frame *f;
- Lisp_Object lface;
- Lisp_Object fontname;
- int force_p, may_fail_p;
-{
- struct font_name font;
- char *buffer;
- int pt;
- int have_xlfd_p;
- int fontset;
- 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 = 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
- returns quickly. But, even if FONT_NAME is not yet cached,
- caching it now is not futail because we anyway load the font
- later. */
- BLOCK_INPUT;
- font_info = FS_LOAD_FONT (f, 0, font_name, -1);
- UNBLOCK_INPUT;
-
- if (!font_info)
- {
- if (may_fail_p)
- return 0;
- abort ();
- }
-
- font.name = STRDUPA (font_info->full_name);
- have_xlfd_p = split_font_name (f, &font, 1);
+set_lface_from_font (struct frame *f, Lisp_Object lface, Lisp_Object font_object, int force_p)
+{
+ Lisp_Object val;
+ struct font *font = XFONT_OBJECT (font_object);
/* Set attributes only if unspecified, otherwise face defaults for
- new frames would never take effect. If we couldn't get a font
- name conforming to XLFD, set normal values. */
+ new frames would never take effect. If the font doesn't have a
+ specific property, set a normal value for that. */
if (force_p || UNSPECIFIEDP (LFACE_FAMILY (lface)))
{
- Lisp_Object val;
- if (have_xlfd_p)
- {
- buffer = (char *) alloca (strlen (font.fields[XLFD_FAMILY])
- + strlen (font.fields[XLFD_FOUNDRY])
- + 2);
- sprintf (buffer, "%s-%s", font.fields[XLFD_FOUNDRY],
- font.fields[XLFD_FAMILY]);
- val = build_string (buffer);
- }
- else
- val = build_string ("*");
- LFACE_FAMILY (lface) = val;
+ Lisp_Object family = AREF (font_object, FONT_FAMILY_INDEX);
+
+ LFACE_FAMILY (lface) = SYMBOL_NAME (family);
+ }
+
+ if (force_p || UNSPECIFIEDP (LFACE_FOUNDRY (lface)))
+ {
+ Lisp_Object foundry = AREF (font_object, FONT_FOUNDRY_INDEX);
+
+ LFACE_FOUNDRY (lface) = SYMBOL_NAME (foundry);
}
if (force_p || UNSPECIFIEDP (LFACE_HEIGHT (lface)))
{
- if (have_xlfd_p)
- pt = xlfd_point_size (f, &font);
- else
- pt = pixel_point_size (f, font_info->height * 10);
+ int pt = PIXEL_TO_POINT (font->pixel_size * 10, f->resy);
+
xassert (pt > 0);
LFACE_HEIGHT (lface) = make_number (pt);
}
- if (force_p || UNSPECIFIEDP (LFACE_SWIDTH (lface)))
- LFACE_SWIDTH (lface)
- = have_xlfd_p ? xlfd_symbolic_swidth (&font) : Qnormal;
-
- if (force_p || UNSPECIFIEDP (LFACE_AVGWIDTH (lface)))
- LFACE_AVGWIDTH (lface)
- = (have_xlfd_p
- ? make_number (font.numeric[XLFD_AVGWIDTH])
- : Qunspecified);
-
if (force_p || UNSPECIFIEDP (LFACE_WEIGHT (lface)))
- LFACE_WEIGHT (lface)
- = have_xlfd_p ? xlfd_symbolic_weight (&font) : Qnormal;
-
+ {
+ val = FONT_WEIGHT_FOR_FACE (font_object);
+ LFACE_WEIGHT (lface) = ! NILP (val) ? val :Qnormal;
+ }
if (force_p || UNSPECIFIEDP (LFACE_SLANT (lface)))
- LFACE_SLANT (lface)
- = have_xlfd_p ? xlfd_symbolic_slant (&font) : Qnormal;
-
- LFACE_FONT (lface) = fontname;
+ {
+ val = FONT_SLANT_FOR_FACE (font_object);
+ LFACE_SLANT (lface) = ! NILP (val) ? val : Qnormal;
+ }
+ if (force_p || UNSPECIFIEDP (LFACE_SWIDTH (lface)))
+ {
+ val = FONT_WIDTH_FOR_FACE (font_object);
+ LFACE_SWIDTH (lface) = ! NILP (val) ? val : Qnormal;
+ }
+ LFACE_FONT (lface) = font_object;
return 1;
}
merged height. If FROM is an invalid height, then INVALID is
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. */
+ unless both FROM and TO are relative. */
Lisp_Object
-merge_face_heights (from, to, invalid)
- Lisp_Object from, to, invalid;
+merge_face_heights (Lisp_Object from, Lisp_Object to, Lisp_Object invalid)
{
Lisp_Object result = invalid;
specified attribute of FROM overrides the corresponding attribute of
TO; relative attributes in FROM are merged with the absolute value in
TO and replace it. NAMED_MERGE_POINTS is used internally to detect
- loops in face inheritance; it should be 0 when called from other
- places. */
+ loops in face inheritance/remapping; it should be 0 when called from
+ other places. */
static INLINE void
-merge_face_vectors (f, from, to, named_merge_points)
- struct frame *f;
- Lisp_Object *from, *to;
- struct named_merge_point *named_merge_points;
+merge_face_vectors (struct frame *f, Lisp_Object *from, Lisp_Object *to, struct named_merge_point *named_merge_points)
{
int i;
&& !NILP (from[LFACE_INHERIT_INDEX]))
merge_face_ref (f, from[LFACE_INHERIT_INDEX], to, 0, named_merge_points);
- /* If TO specifies a :font attribute, and FROM specifies some
- font-related attribute, we need to clear TO's :font attribute
- (because it will be inconsistent with whatever FROM specifies, and
- FROM takes precedence). */
- if (!NILP (to[LFACE_FONT_INDEX])
- && (!UNSPECIFIEDP (from[LFACE_FAMILY_INDEX])
- || !UNSPECIFIEDP (from[LFACE_HEIGHT_INDEX])
- || !UNSPECIFIEDP (from[LFACE_WEIGHT_INDEX])
- || !UNSPECIFIEDP (from[LFACE_SLANT_INDEX])
- || !UNSPECIFIEDP (from[LFACE_SWIDTH_INDEX])
- || !UNSPECIFIEDP (from[LFACE_AVGWIDTH_INDEX])))
- to[LFACE_FONT_INDEX] = Qnil;
+ i = LFACE_FONT_INDEX;
+ if (!UNSPECIFIEDP (from[i]))
+ {
+ if (!UNSPECIFIEDP (to[i]))
+ to[i] = Fmerge_font_spec (from[i], to[i]);
+ else
+ to[i] = Fcopy_font_spec (from[i]);
+ if (! NILP (AREF (to[i], FONT_FOUNDRY_INDEX)))
+ to[LFACE_FOUNDRY_INDEX] = SYMBOL_NAME (AREF (to[i], FONT_FOUNDRY_INDEX));
+ if (! NILP (AREF (to[i], FONT_FAMILY_INDEX)))
+ to[LFACE_FAMILY_INDEX] = SYMBOL_NAME (AREF (to[i], FONT_FAMILY_INDEX));
+ if (! NILP (AREF (to[i], FONT_WEIGHT_INDEX)))
+ to[LFACE_WEIGHT_INDEX] = FONT_WEIGHT_FOR_FACE (to[i]);
+ if (! NILP (AREF (to[i], FONT_SLANT_INDEX)))
+ to[LFACE_SLANT_INDEX] = FONT_SLANT_FOR_FACE (to[i]);
+ if (! NILP (AREF (to[i], FONT_WIDTH_INDEX)))
+ to[LFACE_SWIDTH_INDEX] = FONT_WIDTH_FOR_FACE (to[i]);
+ ASET (to[i], FONT_SIZE_INDEX, Qnil);
+ }
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]);
- else
- to[i] = from[i];
+ {
+ to[i] = merge_face_heights (from[i], to[i], to[i]);
+ font_clear_prop (to, FONT_SIZE_INDEX);
+ }
+ else if (i != LFACE_FONT_INDEX
+ && ! EQ (to[i], from[i]))
+ {
+ to[i] = from[i];
+ if (i >= LFACE_FAMILY_INDEX && i <=LFACE_SLANT_INDEX)
+ font_clear_prop (to,
+ (i == LFACE_FAMILY_INDEX ? FONT_FAMILY_INDEX
+ : i == LFACE_FOUNDRY_INDEX ? FONT_FOUNDRY_INDEX
+ : i == LFACE_SWIDTH_INDEX ? FONT_WIDTH_INDEX
+ : i == LFACE_HEIGHT_INDEX ? FONT_SIZE_INDEX
+ : i == LFACE_WEIGHT_INDEX ? FONT_WEIGHT_INDEX
+ : FONT_SLANT_INDEX));
+ }
}
/* TO is always an absolute face, which should inherit from nothing.
merging succeeded. */
static int
-merge_named_face (f, face_name, to, named_merge_points)
- struct frame *f;
- Lisp_Object face_name;
- Lisp_Object *to;
- struct named_merge_point *named_merge_points;
+merge_named_face (struct frame *f, Lisp_Object face_name, Lisp_Object *to, struct named_merge_point *named_merge_points)
{
struct named_merge_point named_merge_point;
if (push_named_merge_point (&named_merge_point,
- face_name, &named_merge_points))
+ face_name, NAMED_MERGE_POINT_NORMAL,
+ &named_merge_points))
{
struct gcpro gcpro1;
Lisp_Object from[LFACE_VECTOR_SIZE];
- int ok = get_lface_attributes (f, face_name, from, 0);
+ int ok = get_lface_attributes (f, face_name, from, 0, named_merge_points);
if (ok)
{
specifications. */
static int
-merge_face_ref (f, face_ref, to, err_msgs, named_merge_points)
- struct frame *f;
- Lisp_Object face_ref;
- Lisp_Object *to;
- int err_msgs;
- struct named_merge_point *named_merge_points;
+merge_face_ref (struct frame *f, Lisp_Object face_ref, Lisp_Object *to, int err_msgs, struct named_merge_point *named_merge_points)
{
int ok = 1; /* Succeed without an error? */
else if (EQ (keyword, QCfamily))
{
if (STRINGP (value))
- to[LFACE_FAMILY_INDEX] = value;
+ {
+ to[LFACE_FAMILY_INDEX] = value;
+ font_clear_prop (to, FONT_FAMILY_INDEX);
+ }
+ else
+ err = 1;
+ }
+ else if (EQ (keyword, QCfoundry))
+ {
+ if (STRINGP (value))
+ {
+ to[LFACE_FOUNDRY_INDEX] = value;
+ font_clear_prop (to, FONT_FOUNDRY_INDEX);
+ }
else
err = 1;
}
merge_face_heights (value, to[LFACE_HEIGHT_INDEX], Qnil);
if (! NILP (new_height))
- to[LFACE_HEIGHT_INDEX] = new_height;
+ {
+ to[LFACE_HEIGHT_INDEX] = new_height;
+ font_clear_prop (to, FONT_SIZE_INDEX);
+ }
else
err = 1;
}
else if (EQ (keyword, QCweight))
{
- if (SYMBOLP (value)
- && face_numeric_weight (value) >= 0)
- to[LFACE_WEIGHT_INDEX] = value;
+ if (SYMBOLP (value) && FONT_WEIGHT_NAME_NUMERIC (value) >= 0)
+ {
+ to[LFACE_WEIGHT_INDEX] = value;
+ font_clear_prop (to, FONT_WEIGHT_INDEX);
+ }
else
err = 1;
}
else if (EQ (keyword, QCslant))
{
- if (SYMBOLP (value)
- && face_numeric_slant (value) >= 0)
- to[LFACE_SLANT_INDEX] = value;
+ if (SYMBOLP (value) && FONT_SLANT_NAME_NUMERIC (value) >= 0)
+ {
+ to[LFACE_SLANT_INDEX] = value;
+ font_clear_prop (to, FONT_SLANT_INDEX);
+ }
else
err = 1;
}
}
else if (EQ (keyword, QCstipple))
{
-#ifdef HAVE_X_WINDOWS
+#if defined(HAVE_X_WINDOWS) || defined(HAVE_NS)
Lisp_Object pixmap_p = Fbitmap_spec_p (value);
if (!NILP (pixmap_p))
to[LFACE_STIPPLE_INDEX] = value;
}
else if (EQ (keyword, QCwidth))
{
- if (SYMBOLP (value)
- && face_numeric_swidth (value) >= 0)
- to[LFACE_SWIDTH_INDEX] = value;
+ if (SYMBOLP (value) && FONT_WIDTH_NAME_NUMERIC (value) >= 0)
+ {
+ to[LFACE_SWIDTH_INDEX] = value;
+ font_clear_prop (to, FONT_WIDTH_INDEX);
+ }
else
err = 1;
}
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 face, Lisp_Object frame)
{
Lisp_Object global_lface, lface;
struct frame *f;
{
global_lface = Fmake_vector (make_number (LFACE_VECTOR_SIZE),
Qunspecified);
- AREF (global_lface, 0) = Qface;
+ ASET (global_lface, 0, Qface);
Vface_new_frame_defaults = Fcons (Fcons (face, global_lface),
Vface_new_frame_defaults);
}
else if (f == NULL)
for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
- AREF (global_lface, i) = Qunspecified;
+ ASET (global_lface, i, Qunspecified);
/* Add a frame-local definition. */
if (f)
{
lface = Fmake_vector (make_number (LFACE_VECTOR_SIZE),
Qunspecified);
- AREF (lface, 0) = Qface;
+ ASET (lface, 0, Qface);
f->face_alist = Fcons (Fcons (face, lface), f->face_alist);
}
else
for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
- AREF (lface, i) = Qunspecified;
+ ASET (lface, i, Qunspecified);
}
else
lface = global_lface;
DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p,
Sinternal_lisp_face_p, 1, 2, 0,
doc: /* Return non-nil if FACE names a face.
+FACE should be a symbol or string.
If optional second argument FRAME is non-nil, check for the
existence of a frame-local face with name FACE on that frame.
Otherwise check for the existence of a global face. */)
- (face, frame)
- Lisp_Object face, frame;
+ (Lisp_Object face, Lisp_Object frame)
{
Lisp_Object lface;
+ face = resolve_face_name (face, 1);
+
if (!NILP (frame))
{
CHECK_LIVE_FRAME (frame);
FRAME controls where the data is copied to.
The value is TO. */)
- (from, to, frame, new_frame)
- Lisp_Object from, to, frame, new_frame;
+ (Lisp_Object from, Lisp_Object to, Lisp_Object frame, Lisp_Object new_frame)
{
Lisp_Object lface, copy;
copy = Finternal_make_lisp_face (to, new_frame);
}
- bcopy (XVECTOR (lface)->contents, XVECTOR (copy)->contents,
- LFACE_VECTOR_SIZE * sizeof (Lisp_Object));
+ memcpy (XVECTOR (copy)->contents, XVECTOR (lface)->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
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 face, Lisp_Object attr, Lisp_Object value, Lisp_Object frame)
{
Lisp_Object lface;
Lisp_Object old_value = Qnil;
- /* Set 1 if ATTR is QCfont. */
- int font_attr_p = 0;
- /* Set 1 if ATTR is one of font-related attributes other than QCfont. */
- int font_related_attr_p = 0;
+ /* Set one of enum font_property_index (> 0) if ATTR is one of
+ font-related attributes other than QCfont and QCfontset. */
+ enum font_property_index prop_index = 0;
CHECK_SYMBOL (face);
CHECK_SYMBOL (attr);
}
old_value = LFACE_FAMILY (lface);
LFACE_FAMILY (lface) = value;
- font_related_attr_p = 1;
+ prop_index = FONT_FAMILY_INDEX;
+ }
+ else if (EQ (attr, QCfoundry))
+ {
+ if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value))
+ {
+ CHECK_STRING (value);
+ if (SCHARS (value) == 0)
+ signal_error ("Invalid face foundry", value);
+ }
+ old_value = LFACE_FOUNDRY (lface);
+ LFACE_FOUNDRY (lface) = value;
+ prop_index = FONT_FOUNDRY_INDEX;
}
else if (EQ (attr, QCheight))
{
if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value))
{
- Lisp_Object test;
-
- 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));
-
- if (!INTEGERP (test) || XINT (test) <= 0)
- signal_error ("Invalid face height", value);
+ if (EQ (face, Qdefault))
+ {
+ /* The default face must have an absolute size. */
+ if (!INTEGERP (value) || XINT (value) <= 0)
+ signal_error ("Invalid default face height", value);
+ }
+ else
+ {
+ /* For non-default faces, do a test merge with a random
+ height to see if VALUE's ok. */
+ Lisp_Object test = merge_face_heights (value,
+ make_number (10),
+ Qnil);
+ if (!INTEGERP (test) || XINT (test) <= 0)
+ signal_error ("Invalid face height", value);
+ }
}
old_value = LFACE_HEIGHT (lface);
LFACE_HEIGHT (lface) = value;
- font_related_attr_p = 1;
+ prop_index = FONT_SIZE_INDEX;
}
else if (EQ (attr, QCweight))
{
if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value))
{
CHECK_SYMBOL (value);
- if (face_numeric_weight (value) < 0)
+ if (FONT_WEIGHT_NAME_NUMERIC (value) < 0)
signal_error ("Invalid face weight", value);
}
old_value = LFACE_WEIGHT (lface);
LFACE_WEIGHT (lface) = value;
- font_related_attr_p = 1;
+ prop_index = FONT_WEIGHT_INDEX;
}
else if (EQ (attr, QCslant))
{
if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value))
{
CHECK_SYMBOL (value);
- if (face_numeric_slant (value) < 0)
+ if (FONT_SLANT_NAME_NUMERIC (value) < 0)
signal_error ("Invalid face slant", value);
}
old_value = LFACE_SLANT (lface);
LFACE_SLANT (lface) = value;
- font_related_attr_p = 1;
+ prop_index = FONT_SLANT_INDEX;
}
else if (EQ (attr, QCunderline))
{
}
else if (EQ (attr, QCforeground))
{
+ /* Compatibility with 20.x. */
+ if (NILP (value))
+ value = Qunspecified;
if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value))
{
/* Don't check for valid color names here because it depends
}
else if (EQ (attr, QCbackground))
{
+ /* Compatibility with 20.x. */
+ if (NILP (value))
+ value = Qunspecified;
if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value))
{
/* Don't check for valid color names here because it depends
}
else if (EQ (attr, QCstipple))
{
-#ifdef HAVE_X_WINDOWS
+#if defined(HAVE_X_WINDOWS) || defined(HAVE_NS)
if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value)
&& !NILP (value)
&& NILP (Fbitmap_spec_p (value)))
signal_error ("Invalid stipple attribute", value);
old_value = LFACE_STIPPLE (lface);
LFACE_STIPPLE (lface) = value;
-#endif /* HAVE_X_WINDOWS */
+#endif /* HAVE_X_WINDOWS || HAVE_NS */
}
else if (EQ (attr, QCwidth))
{
if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value))
{
CHECK_SYMBOL (value);
- if (face_numeric_swidth (value) < 0)
+ if (FONT_WIDTH_NAME_NUMERIC (value) < 0)
signal_error ("Invalid face width", value);
}
old_value = LFACE_SWIDTH (lface);
LFACE_SWIDTH (lface) = value;
- font_related_attr_p = 1;
+ prop_index = FONT_WIDTH_INDEX;
}
else if (EQ (attr, QCfont))
{
#ifdef HAVE_WINDOW_SYSTEM
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;
-
- if (EQ (frame, Qt))
- f = SELECTED_FRAME ();
- else
- f = check_x_frame (frame);
-
if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value))
{
- CHECK_STRING (value);
+ FRAME_PTR f;
- /* 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;
+ old_value = LFACE_FONT (lface);
+ if (! FONTP (value))
+ {
+ if (STRINGP (value))
+ {
+ Lisp_Object name = value;
+ int fontset = fs_query_fontset (name, 0);
+
+ if (fontset >= 0)
+ name = fontset_ascii (fontset);
+ value = font_spec_from_name (name);
+ if (!FONTP (value))
+ signal_error ("Invalid font name", name);
+ }
+ else
+ signal_error ("Invalid font or font-spec", value);
+ }
+ if (EQ (frame, Qt))
+ f = XFRAME (selected_frame);
+ else
+ f = XFRAME (frame);
+ if (! FONT_OBJECT_P (value))
+ {
+ Lisp_Object *attrs = XVECTOR (lface)->contents;
+ Lisp_Object font_object;
- if (!set_lface_from_font_name (f, lface, value, 1, 1))
- signal_error ("Invalid font or fontset name", value);
+ font_object = font_load_for_lface (f, attrs, value);
+ if (NILP (font_object))
+ signal_error ("Font not available", value);
+ value = font_object;
+ }
+ set_lface_from_font (f, lface, value, 1);
}
+ else
+ LFACE_FONT (lface) = value;
+ }
+#endif /* HAVE_WINDOW_SYSTEM */
+ }
+ else if (EQ (attr, QCfontset))
+ {
+#ifdef HAVE_WINDOW_SYSTEM
+ if (EQ (frame, Qt) || FRAME_WINDOW_P (XFRAME (frame)))
+ {
+ Lisp_Object tmp;
- font_attr_p = 1;
+ old_value = LFACE_FONTSET (lface);
+ tmp = Fquery_fontset (value, Qnil);
+ if (NILP (tmp))
+ signal_error ("Invalid fontset name", value);
+ LFACE_FONTSET (lface) = value = tmp;
}
#endif /* HAVE_WINDOW_SYSTEM */
}
{
old_value = LFACE_WEIGHT (lface);
LFACE_WEIGHT (lface) = NILP (value) ? Qnormal : Qbold;
- font_related_attr_p = 1;
+ prop_index = FONT_WEIGHT_INDEX;
}
else if (EQ (attr, QCitalic))
{
+ attr = QCslant;
old_value = LFACE_SLANT (lface);
LFACE_SLANT (lface) = NILP (value) ? Qnormal : Qitalic;
- font_related_attr_p = 1;
+ prop_index = FONT_SLANT_INDEX;
}
else
signal_error ("Invalid face attribute name", attr);
- if (font_related_attr_p
- && !UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value))
- /* If a font-related attribute other than QCfont is specified, the
- original `font' attribute nor that of default face is useless
- to determine a new font. Thus, we set it to nil so that font
- selection mechanism doesn't use it. */
- LFACE_FONT (lface) = Qnil;
+ if (prop_index)
+ {
+ /* If a font-related attribute other than QCfont and QCfontset
+ is specified, and if the original QCfont attribute has a font
+ (font-spec or font-object), set the corresponding property in
+ the font to nil so that the font selector doesn't think that
+ the attribute is mandatory. Also, clear the average
+ width. */
+ font_clear_prop (XVECTOR (lface)->contents, prop_index);
+ }
/* Changing a named face means that all realized faces depending on
that face are invalid. Since we cannot tell which realized faces
init_iterator will then free realized faces. */
if (!EQ (frame, Qt)
&& NILP (Fget (face, Qface_no_inherit))
- && (EQ (attr, QCfont)
- || NILP (Fequal (old_value, value))))
+ && NILP (Fequal (old_value, value)))
{
++face_change_count;
++windows_or_buffers_changed;
/* Changed font-related attributes of the `default' face are
reflected in changed `font' frame parameters. */
if (FRAMEP (frame)
- && (font_related_attr_p || font_attr_p)
+ && (prop_index || EQ (attr, QCfont))
&& lface_fully_specified_p (XVECTOR (lface)->contents))
set_font_frame_param (frame, lface);
else
}
-#ifdef HAVE_WINDOW_SYSTEM
-
-/* Set the `font' frame parameter of FRAME determined from `default'
- face attributes LFACE. If a face or fontset name is explicitely
- specfied in LFACE, use it as is. Otherwise, determine a font name
- from the other font-related atrributes of LFACE. In that case, if
- there's no matching font, signals an error. */
-
-static void
-set_font_frame_param (frame, lface)
- Lisp_Object frame, lface;
-{
- struct frame *f = XFRAME (frame);
-
- if (FRAME_WINDOW_P (f))
- {
- 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, 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));
- }
-}
-
-
/* Update the corresponding face when frame parameter PARAM on frame F
has been assigned the value NEW_VALUE. */
void
-update_face_from_frame_parameter (f, param, new_value)
- struct frame *f;
- Lisp_Object param, new_value;
+update_face_from_frame_parameter (struct frame *f, Lisp_Object param, Lisp_Object new_value)
{
Lisp_Object face = Qnil;
Lisp_Object lface;
/* Changing the background color might change the background
mode, so that we have to load new defface specs.
- Call frame-set-background-mode to do that. */
+ Call frame-update-face-colors to do that. */
XSETFRAME (frame, f);
call1 (Qframe_set_background_mode, frame);
? new_value : Qunspecified);
realize_basic_faces (f);
}
+#ifdef HAVE_WINDOW_SYSTEM
else if (EQ (param, Qborder_color))
{
face = Qborder;
LFACE_BACKGROUND (lface) = (STRINGP (new_value)
? new_value : Qunspecified);
}
+#endif
/* Changing a named face means that all realized faces depending on
that face are invalid. Since we cannot tell which realized faces
}
+#ifdef HAVE_WINDOW_SYSTEM
+
+/* Set the `font' frame parameter of FRAME determined from the
+ font-object set in `default' face attributes LFACE. */
+
+static void
+set_font_frame_param (Lisp_Object frame, Lisp_Object lface)
+{
+ struct frame *f = XFRAME (frame);
+ Lisp_Object font;
+
+ if (FRAME_WINDOW_P (f)
+ /* Don't do anything if the font is `unspecified'. This can
+ happen during frame creation. */
+ && (font = LFACE_FONT (lface),
+ ! UNSPECIFIEDP (font)))
+ {
+ if (FONT_SPEC_P (font))
+ {
+ font = font_load_for_lface (f, XVECTOR (lface)->contents, font);
+ if (NILP (font))
+ return;
+ LFACE_FONT (lface) = font;
+ }
+ f->default_face_done_p = 0;
+ Fmodify_frame_parameters (frame, Fcons (Fcons (Qfont, font), Qnil));
+ }
+}
+
+
/* Get the value of X resource RESOURCE, class CLASS for the display
of frame FRAME. This is here because ordinary `x-get-resource'
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, doc: /* */)
- (resource, class, frame)
- Lisp_Object resource, class, frame;
+ (Lisp_Object resource, Lisp_Object class, Lisp_Object frame)
{
Lisp_Object value = Qnil;
CHECK_STRING (resource);
error; if SIGNAL_P is zero, return 0. */
static Lisp_Object
-face_boolean_x_resource_value (value, signal_p)
- Lisp_Object value;
- int signal_p;
+face_boolean_x_resource_value (Lisp_Object value, int signal_p)
{
Lisp_Object result = make_number (0);
xassert (STRINGP (value));
- if (xstricmp (SDATA (value), "on") == 0
- || xstricmp (SDATA (value), "true") == 0)
+ if (xstrcasecmp (SDATA (value), "on") == 0
+ || xstrcasecmp (SDATA (value), "true") == 0)
result = Qt;
- else if (xstricmp (SDATA (value), "off") == 0
- || xstricmp (SDATA (value), "false") == 0)
+ else if (xstrcasecmp (SDATA (value), "off") == 0
+ || xstrcasecmp (SDATA (value), "false") == 0)
result = Qnil;
- else if (xstricmp (SDATA (value), "unspecified") == 0)
+ else if (xstrcasecmp (SDATA (value), "unspecified") == 0)
result = Qunspecified;
else if (signal_p)
signal_error ("Invalid face attribute value from X resource", value);
Finternal_set_lisp_face_attribute_from_resource,
Sinternal_set_lisp_face_attribute_from_resource,
3, 4, 0, doc: /* */)
- (face, attr, value, frame)
- Lisp_Object face, attr, value, frame;
+ (Lisp_Object face, Lisp_Object attr, Lisp_Object value, Lisp_Object frame)
{
CHECK_SYMBOL (face);
CHECK_SYMBOL (attr);
CHECK_STRING (value);
- if (xstricmp (SDATA (value), "unspecified") == 0)
+ if (xstrcasecmp (SDATA (value), "unspecified") == 0)
value = Qunspecified;
else if (EQ (attr, QCheight))
{
/* Make menus on frame F appear as specified by the `menu' face. */
static void
-x_update_menu_appearance (f)
- struct frame *f;
+x_update_menu_appearance (struct frame *f)
{
struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
XrmDatabase rdb;
changed_p = 1;
}
- if (face->font_name
+ if (face->font
+ /* On Solaris 5.8, it's been reported that the `menu' face
+ can be unspecified here, during startup. Why this
+ happens remains unknown. -- cyd */
+ && FONTP (LFACE_FONT (lface))
&& (!UNSPECIFIEDP (LFACE_FAMILY (lface))
+ || !UNSPECIFIEDP (LFACE_FOUNDRY (lface))
|| !UNSPECIFIEDP (LFACE_SWIDTH (lface))
- || !UNSPECIFIEDP (LFACE_AVGWIDTH (lface))
|| !UNSPECIFIEDP (LFACE_WEIGHT (lface))
|| !UNSPECIFIEDP (LFACE_SLANT (lface))
|| !UNSPECIFIEDP (LFACE_HEIGHT (lface))))
{
+ Lisp_Object xlfd = Ffont_xlfd_name (LFACE_FONT (lface), Qnil);
#ifdef USE_MOTIF
const char *suffix = "List";
Bool motif = True;
#endif
Bool motif = False;
#endif
+
+ if (! NILP (xlfd))
+ {
#if defined HAVE_X_I18N
- extern char *xic_create_fontsetname
- P_ ((char *base_fontname, Bool motif));
- char *fontsetname = xic_create_fontsetname (face->font_name, motif);
+ char *fontsetname = xic_create_fontsetname (SDATA (xlfd), motif);
#else
- char *fontsetname = face->font_name;
+ char *fontsetname = (char *) SDATA (xlfd);
#endif
- sprintf (line, "%s.pane.menubar*font%s: %s",
- myname, suffix, fontsetname);
- XrmPutLineResource (&rdb, line);
- sprintf (line, "%s.%s*font%s: %s",
- myname, popup_path, suffix, fontsetname);
- XrmPutLineResource (&rdb, line);
- changed_p = 1;
- if (fontsetname != face->font_name)
- xfree (fontsetname);
+ sprintf (line, "%s.pane.menubar*font%s: %s",
+ myname, suffix, fontsetname);
+ XrmPutLineResource (&rdb, line);
+ sprintf (line, "%s.%s*font%s: %s",
+ myname, popup_path, suffix, fontsetname);
+ XrmPutLineResource (&rdb, line);
+ changed_p = 1;
+ if (fontsetname != (char *) SDATA (xlfd))
+ xfree (fontsetname);
+ }
}
if (changed_p && f->output_data.x->menubar_widget)
inherited from another face. For most possible attributes,
the only relative value that users see is `unspecified'.
However, for :height, floating point values are also relative. */)
- (attribute, value)
- Lisp_Object attribute, value;
+ (Lisp_Object attribute, Lisp_Object value)
{
if (EQ (value, Qunspecified) || (EQ (value, Qignore_defface)))
return Qt;
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;
+ (Lisp_Object attribute, Lisp_Object value1, Lisp_Object value2)
{
if (EQ (value1, Qunspecified) || EQ (value1, Qignore_defface))
return value2;
If the optional argument FRAME is given, report on face SYMBOL in that
frame. If FRAME is t, report on the defaults for face SYMBOL (for new
frames). If FRAME is omitted or nil, use the selected frame. */)
- (symbol, keyword, frame)
- Lisp_Object symbol, keyword, frame;
+ (Lisp_Object symbol, Lisp_Object keyword, Lisp_Object frame)
{
Lisp_Object lface, value = Qnil;
if (EQ (keyword, QCfamily))
value = LFACE_FAMILY (lface);
+ else if (EQ (keyword, QCfoundry))
+ value = LFACE_FOUNDRY (lface);
else if (EQ (keyword, QCheight))
value = LFACE_HEIGHT (lface);
else if (EQ (keyword, QCweight))
value = LFACE_INHERIT (lface);
else if (EQ (keyword, QCfont))
value = LFACE_FONT (lface);
+ else if (EQ (keyword, QCfontset))
+ value = LFACE_FONTSET (lface);
else
signal_error ("Invalid face attribute name", keyword);
Sinternal_lisp_face_attribute_values, 1, 1, 0,
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 attr)
{
Lisp_Object result = Qnil;
CHECK_SYMBOL (attr);
- if (EQ (attr, QCweight)
- || EQ (attr, QCslant)
- || EQ (attr, QCwidth))
- {
- /* Extract permissible symbols from tables. */
- struct table_entry *table;
- int i, dim;
-
- if (EQ (attr, QCweight))
- table = weight_table, dim = DIM (weight_table);
- else if (EQ (attr, QCslant))
- table = slant_table, dim = DIM (slant_table);
- else
- table = swidth_table, dim = DIM (swidth_table);
-
- for (i = 0; i < dim; ++i)
- {
- Lisp_Object symbol = *table[i].symbol;
- Lisp_Object tail = result;
-
- while (!NILP (tail)
- && !EQ (XCAR (tail), symbol))
- tail = XCDR (tail);
-
- if (NILP (tail))
- result = Fcons (symbol, result);
- }
- }
- else if (EQ (attr, QCunderline))
+ if (EQ (attr, QCunderline))
result = Fcons (Qt, Fcons (Qnil, Qnil));
else if (EQ (attr, QCoverline))
result = Fcons (Qt, Fcons (Qnil, Qnil));
Sinternal_merge_in_global_face, 2, 2, 0,
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;
+ (Lisp_Object face, Lisp_Object frame)
{
int i;
Lisp_Object global_lface, local_lface, *gvec, *lvec;
+ struct frame *f = XFRAME (frame);
CHECK_LIVE_FRAME (frame);
global_lface = lface_from_face_name (NULL, face, 1);
- local_lface = lface_from_face_name (XFRAME (frame), face, 0);
+ local_lface = lface_from_face_name (f, face, 0);
if (NILP (local_lface))
local_lface = Finternal_make_lisp_face (face, frame);
lvec = XVECTOR (local_lface)->contents;
gvec = XVECTOR (global_lface)->contents;
for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
- if (! UNSPECIFIEDP (gvec[i]))
- {
- if (IGNORE_DEFFACE_P (gvec[i]))
- lvec[i] = Qunspecified;
- else
- lvec[i] = gvec[i];
- }
+ if (IGNORE_DEFFACE_P (gvec[i]))
+ lvec[i] = Qunspecified;
+ else if (! UNSPECIFIEDP (gvec[i]))
+ lvec[i] = gvec[i];
+
+ /* If the default face was changed, update the face cache and the
+ `font' frame parameter. */
+ if (EQ (face, Qdefault))
+ {
+ struct face_cache *c = FRAME_FACE_CACHE (f);
+ struct face *newface, *oldface = FACE_FROM_ID (f, DEFAULT_FACE_ID);
+ Lisp_Object attrs[LFACE_VECTOR_SIZE];
+
+ /* This can be NULL (e.g., in batch mode). */
+ if (oldface)
+ {
+ /* Ensure that the face vector is fully specified by merging
+ the previously-cached vector. */
+ memcpy (attrs, oldface->lface, sizeof attrs);
+ merge_face_vectors (f, lvec, attrs, 0);
+ memcpy (lvec, attrs, sizeof attrs);
+ newface = realize_face (c, lvec, DEFAULT_FACE_ID);
+
+ if ((! UNSPECIFIEDP (gvec[LFACE_FAMILY_INDEX])
+ || ! UNSPECIFIEDP (gvec[LFACE_FOUNDRY_INDEX])
+ || ! UNSPECIFIEDP (gvec[LFACE_HEIGHT_INDEX])
+ || ! UNSPECIFIEDP (gvec[LFACE_WEIGHT_INDEX])
+ || ! UNSPECIFIEDP (gvec[LFACE_SLANT_INDEX])
+ || ! UNSPECIFIEDP (gvec[LFACE_SWIDTH_INDEX])
+ || ! UNSPECIFIEDP (gvec[LFACE_FONT_INDEX]))
+ && newface->font)
+ {
+ Lisp_Object name = newface->font->props[FONT_NAME_INDEX];
+ Fmodify_frame_parameters (frame, Fcons (Fcons (Qfont, name),
+ Qnil));
+ }
+ }
+ }
return Qnil;
}
return fonts with the same size as the font of a face. This is
done in fontset.el. */
-DEFUN ("face-font", Fface_font, Sface_font, 1, 2, 0,
+DEFUN ("face-font", Fface_font, Sface_font, 1, 3, 0,
doc: /* Return the font name of face FACE, or nil if it is unspecified.
+The font name is, by default, for ASCII characters.
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 FRAME is omitted or nil, use the selected frame. And, in this case,
+if the optional third argument CHARACTER is given,
+return the font name used for CHARACTER. */)
+ (Lisp_Object face, Lisp_Object frame, Lisp_Object character)
{
if (EQ (frame, Qt))
{
else
{
struct frame *f = frame_or_selected_frame (frame, 1);
- int face_id = lookup_named_face (f, face, 0, 1);
+ int face_id = lookup_named_face (f, face, 1);
struct face *face = FACE_FROM_ID (f, face_id);
- return face ? build_string (face->font_name) : Qnil;
+
+ if (! face)
+ return Qnil;
+#ifdef HAVE_WINDOW_SYSTEM
+ if (FRAME_WINDOW_P (f) && !NILP (character))
+ {
+ CHECK_CHARACTER (character);
+ face_id = FACE_FOR_CHAR (f, face, XINT (character), -1, Qnil);
+ face = FACE_FROM_ID (f, face_id);
+ }
+ return (face->font
+ ? face->font->props[FONT_NAME_INDEX]
+ : Qnil);
+#else /* !HAVE_WINDOW_SYSTEM */
+ return build_string (FRAME_MSDOS_P (f)
+ ? "ms-dos"
+ : FRAME_W32_P (f) ? "w32term"
+ :"tty");
+#endif
}
}
is called quite often. */
static INLINE int
-face_attr_equal_p (v1, v2)
- Lisp_Object v1, v2;
+face_attr_equal_p (Lisp_Object v1, Lisp_Object v2)
{
/* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
and the other is specified. */
if (SBYTES (v1) != SBYTES (v2))
return 0;
- return bcmp (SDATA (v1), SDATA (v2), SBYTES (v1)) == 0;
+ return memcmp (SDATA (v1), SDATA (v2), SBYTES (v1)) == 0;
- case Lisp_Int:
+ case_Lisp_Int:
case Lisp_Symbol:
return 0;
is called quite often. */
static INLINE int
-lface_equal_p (v1, v2)
- Lisp_Object *v1, *v2;
+lface_equal_p (Lisp_Object *v1, Lisp_Object *v2)
{
int i, equal_p = 1;
If the optional argument FRAME is given, report on FACE1 and FACE2 in that frame.
If FRAME is t, report on the defaults for FACE1 and FACE2 (for new frames).
If FRAME is omitted or nil, use the selected frame. */)
- (face1, face2, frame)
- Lisp_Object face1, face2, frame;
+ (Lisp_Object face1, Lisp_Object face2, Lisp_Object frame)
{
int equal_p;
struct frame *f;
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;
+ (Lisp_Object face, Lisp_Object frame)
{
struct frame *f;
Lisp_Object lface;
0, 1, 0,
doc: /* Return an alist of frame-local faces defined on FRAME.
For internal use only. */)
- (frame)
- Lisp_Object frame;
+ (Lisp_Object frame)
{
struct frame *f = frame_or_selected_frame (frame, 0);
return f->face_alist;
below in computing a hash value for a Lisp face. */
static INLINE unsigned
-hash_string_case_insensitive (string)
- Lisp_Object string;
+hash_string_case_insensitive (Lisp_Object string)
{
const unsigned char *s;
unsigned hash = 0;
/* Return a hash code for face attribute vector V. */
static INLINE unsigned
-lface_hash (v)
- Lisp_Object *v;
+lface_hash (Lisp_Object *v)
{
return (hash_string_case_insensitive (v[LFACE_FAMILY_INDEX])
+ ^ hash_string_case_insensitive (v[LFACE_FOUNDRY_INDEX])
^ hash_string_case_insensitive (v[LFACE_FOREGROUND_INDEX])
^ hash_string_case_insensitive (v[LFACE_BACKGROUND_INDEX])
- ^ XFASTINT (v[LFACE_WEIGHT_INDEX])
- ^ XFASTINT (v[LFACE_SLANT_INDEX])
- ^ XFASTINT (v[LFACE_SWIDTH_INDEX])
- ^ XFASTINT (v[LFACE_HEIGHT_INDEX]));
+ ^ XHASH (v[LFACE_WEIGHT_INDEX])
+ ^ XHASH (v[LFACE_SLANT_INDEX])
+ ^ XHASH (v[LFACE_SWIDTH_INDEX])
+ ^ XHASH (v[LFACE_HEIGHT_INDEX]));
}
/* Return non-zero if LFACE1 and LFACE2 specify the same font (without
considering charsets/registries). They do if they specify the same
- family, point size, weight, width, slant, and fontset. Both LFACE1
- and LFACE2 must be fully-specified. */
+ family, point size, weight, width, slant, and font. Both
+ LFACE1 and LFACE2 must be fully-specified. */
static INLINE int
-lface_same_font_attributes_p (lface1, lface2)
- Lisp_Object *lface1, *lface2;
+lface_same_font_attributes_p (Lisp_Object *lface1, Lisp_Object *lface2)
{
xassert (lface_fully_specified_p (lface1)
&& lface_fully_specified_p (lface2));
- return (xstricmp (SDATA (lface1[LFACE_FAMILY_INDEX]),
- SDATA (lface2[LFACE_FAMILY_INDEX])) == 0
+ return (xstrcasecmp (SDATA (lface1[LFACE_FAMILY_INDEX]),
+ SDATA (lface2[LFACE_FAMILY_INDEX])) == 0
+ && xstrcasecmp (SDATA (lface1[LFACE_FOUNDRY_INDEX]),
+ SDATA (lface2[LFACE_FOUNDRY_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_WEIGHT_INDEX], lface2[LFACE_WEIGHT_INDEX])
&& EQ (lface1[LFACE_SLANT_INDEX], lface2[LFACE_SLANT_INDEX])
- && (EQ (lface1[LFACE_FONT_INDEX], lface2[LFACE_FONT_INDEX])
- || (STRINGP (lface1[LFACE_FONT_INDEX])
- && STRINGP (lface2[LFACE_FONT_INDEX])
- && xstricmp (SDATA (lface1[LFACE_FONT_INDEX]),
- SDATA (lface2[LFACE_FONT_INDEX])))));
+ && EQ (lface1[LFACE_FONT_INDEX], lface2[LFACE_FONT_INDEX])
+ && (EQ (lface1[LFACE_FONTSET_INDEX], lface2[LFACE_FONTSET_INDEX])
+ || (STRINGP (lface1[LFACE_FONTSET_INDEX])
+ && STRINGP (lface2[LFACE_FONTSET_INDEX])
+ && ! xstrcasecmp (SDATA (lface1[LFACE_FONTSET_INDEX]),
+ SDATA (lface2[LFACE_FONTSET_INDEX]))))
+ );
}
vector ATTR. */
static struct face *
-make_realized_face (attr)
- Lisp_Object *attr;
+make_realized_face (Lisp_Object *attr)
{
struct face *face = (struct face *) xmalloc (sizeof *face);
- bzero (face, sizeof *face);
+ memset (face, 0, sizeof *face);
face->ascii_face = face;
- bcopy (attr, face->lface, sizeof face->lface);
+ memcpy (face->lface, attr, sizeof face->lface);
return face;
}
/* Free realized face FACE, including its X resources. FACE may
be null. */
-static void
-free_realized_face (f, face)
- struct frame *f;
- struct face *face;
+void
+free_realized_face (struct frame *f, struct face *face)
{
if (face)
{
free_face_fontset (f, face);
if (face->gc)
{
+ BLOCK_INPUT;
+ if (face->font)
+ font_done_for_face (f, face);
x_free_gc (f, face->gc);
face->gc = 0;
+ UNBLOCK_INPUT;
}
free_face_colors (f, face);
by clearing the face cache. */
void
-prepare_face_for_display (f, face)
- struct frame *f;
- struct face *face;
+prepare_face_for_display (struct frame *f, struct face *face)
{
#ifdef HAVE_WINDOW_SYSTEM
xassert (FRAME_WINDOW_P (f));
#ifdef HAVE_X_WINDOWS
xgcv.graphics_exposures = False;
#endif
- /* The font of FACE may be null if we couldn't load it. */
- if (face->font)
- {
-#ifdef HAVE_X_WINDOWS
- xgcv.font = face->font->fid;
-#endif
-#ifdef WINDOWSNT
- xgcv.font = face->font;
-#endif
-#ifdef MAC_OS
- xgcv.font = face->font;
-#endif
- mask |= GCFont;
- }
BLOCK_INPUT;
#ifdef HAVE_X_WINDOWS
}
#endif
face->gc = x_create_gc (f, mask, &xgcv);
+ if (face->font)
+ font_prepare_for_face (f, face);
UNBLOCK_INPUT;
}
#endif /* HAVE_WINDOW_SYSTEM */
/* Returns the `distance' between the colors X and Y. */
static int
-color_distance (x, y)
- XColor *x, *y;
+color_distance (XColor *x, XColor *y)
{
/* This formula is from a paper title `Colour metric' by Thiadmer Riemersma.
Quoting from that paper:
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;
+ (Lisp_Object color1, Lisp_Object color2, Lisp_Object frame)
{
struct frame *f;
XColor cdef1, cdef2;
/* Return a new face cache for frame F. */
static struct face_cache *
-make_face_cache (f)
- struct frame *f;
+make_face_cache (struct frame *f)
{
struct face_cache *c;
int size;
c = (struct face_cache *) xmalloc (sizeof *c);
- bzero (c, sizeof *c);
+ memset (c, 0, sizeof *c);
size = FACE_CACHE_BUCKETS_SIZE * sizeof *c->buckets;
c->buckets = (struct face **) xmalloc (size);
- bzero (c->buckets, size);
+ memset (c->buckets, 0, size);
c->size = 50;
c->faces_by_id = (struct face **) xmalloc (c->size * sizeof *c->faces_by_id);
c->f = f;
keeping too many graphics contexts that are no longer needed. */
static void
-clear_face_gcs (c)
- struct face_cache *c;
+clear_face_gcs (struct face_cache *c)
{
if (c && FRAME_WINDOW_P (c->f))
{
struct face *face = c->faces_by_id[i];
if (face && face->gc)
{
+ BLOCK_INPUT;
+ if (face->font)
+ font_done_for_face (c->f, face);
x_free_gc (c->f, face->gc);
face->gc = 0;
+ UNBLOCK_INPUT;
}
}
#endif /* HAVE_WINDOW_SYSTEM */
event doesn't try to use faces we destroyed. */
static void
-free_realized_faces (c)
- struct face_cache *c;
+free_realized_faces (struct face_cache *c)
{
if (c && c->used)
{
c->used = 0;
size = FACE_CACHE_BUCKETS_SIZE * sizeof *c->buckets;
- bzero (c->buckets, size);
+ memset (c->buckets, 0, size);
/* Must do a thorough redisplay the next time. Mark current
matrices as invalid because they will reference faces freed
}
-/* Free all faces realized for multibyte characters on frame F that
- has FONTSET. */
+/* Free all realized faces that are using FONTSET on frame F. */
void
-free_realized_multibyte_face (f, fontset)
- struct frame *f;
- int fontset;
+free_realized_faces_for_fontset (struct frame *f, int fontset)
{
struct face_cache *cache = FRAME_FACE_CACHE (f);
struct face *face;
{
face = cache->faces_by_id[i];
if (face
- && face != face->ascii_face
&& face->fontset == fontset)
{
uncache_face (cache, face);
because we can't tell which realized faces depend on that face. */
void
-free_all_realized_faces (frame)
- Lisp_Object frame;
+free_all_realized_faces (Lisp_Object frame)
{
if (NILP (frame))
{
/* Free face cache C and faces in it, including their X resources. */
static void
-free_face_cache (c)
- struct face_cache *c;
+free_face_cache (struct face_cache *c)
{
if (c)
{
/* Cache realized face FACE in face cache C. HASH is the hash value
- of FACE. If FACE->fontset >= 0, add the new face to the end of the
- collision list of the face hash table of C. This is done because
- otherwise lookup_face would find FACE for every character, even if
- faces with the same attributes but for specific characters exist. */
+ of FACE. If FACE is for ASCII characters (i.e. FACE->ascii_face ==
+ FACE), insert the new face to the beginning of the collision list
+ of the face hash table of C. Otherwise, add the new face to the
+ end of the collision list. This way, lookup_face can quickly find
+ that a requested face is not cached. */
static void
-cache_face (c, face, hash)
- struct face_cache *c;
- struct face *face;
- unsigned hash;
+cache_face (struct face_cache *c, struct face *face, unsigned int hash)
{
int i = hash % FACE_CACHE_BUCKETS_SIZE;
face->hash = hash;
- if (face->fontset >= 0)
+ if (face->ascii_face != face)
{
struct face *last = c->buckets[i];
if (last)
/* Remove face FACE from cache C. */
static void
-uncache_face (c, face)
- struct face_cache *c;
- struct face *face;
+uncache_face (struct face_cache *c, struct face *face)
{
int i = face->hash % FACE_CACHE_BUCKETS_SIZE;
/* Look up a realized face with face attributes ATTR in the face cache
- of frame F. The face will be used to display character C. Value
- is the ID of the face found. If no suitable face is found, realize
- a new one. In that case, if C is a multibyte character, BASE_FACE
- is a face that has the same attributes. */
-
-INLINE int
-lookup_face (f, attr, c, base_face)
- struct frame *f;
- Lisp_Object *attr;
- int c;
- struct face *base_face;
+ of frame F. The face will be used to display ASCII characters.
+ Value is the ID of the face found. If no suitable face is found,
+ realize a new one. */
+
+static INLINE int
+lookup_face (struct frame *f, Lisp_Object *attr)
{
struct face_cache *cache = FRAME_FACE_CACHE (f);
unsigned hash;
i = hash % FACE_CACHE_BUCKETS_SIZE;
for (face = cache->buckets[i]; face; face = face->next)
- if (face->hash == hash
- && (!FRAME_WINDOW_P (f)
- || FACE_SUITABLE_FOR_CHAR_P (face, c))
- && lface_equal_p (face->lface, attr))
- break;
+ {
+ if (face->ascii_face != face)
+ {
+ /* There's no more ASCII face. */
+ face = NULL;
+ break;
+ }
+ if (face->hash == hash
+ && lface_equal_p (face->lface, attr))
+ break;
+ }
/* If not found, realize a new face. */
if (face == NULL)
- face = realize_face (cache, attr, c, base_face, -1);
+ face = realize_face (cache, attr, -1);
#if GLYPH_DEBUG
xassert (face == FACE_FROM_ID (f, face->id));
+#endif /* GLYPH_DEBUG */
+
+ return face->id;
+}
+
+#ifdef HAVE_WINDOW_SYSTEM
+/* Look up a realized face that has the same attributes as BASE_FACE
+ except for the font in the face cache of frame F. If FONT-OBJECT
+ is not nil, it is an already opened font. If FONT-OBJECT is nil,
+ the face has no font. Value is the ID of the face found. If no
+ suitable face is found, realize a new one. */
+
+int
+face_for_font (struct frame *f, Lisp_Object font_object, struct face *base_face)
+{
+ struct face_cache *cache = FRAME_FACE_CACHE (f);
+ unsigned hash;
+ int i;
+ struct face *face;
+
+ xassert (cache != NULL);
+ base_face = base_face->ascii_face;
+ hash = lface_hash (base_face->lface);
+ i = hash % FACE_CACHE_BUCKETS_SIZE;
-/* When this function is called from face_for_char (in this case, C is
- a multibyte character), a fontset of a face returned by
- realize_face is not yet set, i.e. FACE_SUITABLE_FOR_CHAR_P (FACE,
- C) is not sutisfied. The fontset is set for this face by
- face_for_char later. */
-#if 0
- if (FRAME_WINDOW_P (f))
- xassert (FACE_SUITABLE_FOR_CHAR_P (face, c));
-#endif
-#endif /* GLYPH_DEBUG */
+ for (face = cache->buckets[i]; face; face = face->next)
+ {
+ if (face->ascii_face == face)
+ continue;
+ if (face->ascii_face == base_face
+ && face->font == (NILP (font_object) ? NULL
+ : XFONT_OBJECT (font_object))
+ && lface_equal_p (face->lface, base_face->lface))
+ return face->id;
+ }
+ /* If not found, realize a new face. */
+ face = realize_non_ascii_face (f, font_object, base_face);
return face->id;
}
-
+#endif /* HAVE_WINDOW_SYSTEM */
/* Return the face id of the realized face for named face SYMBOL on
- frame F suitable for displaying character C. Value is -1 if the
- face couldn't be determined, which might happen if the default face
- isn't realized and cannot be realized. */
+ frame F suitable for displaying ASCII characters. Value is -1 if
+ the face couldn't be determined, which might happen if the default
+ face isn't realized and cannot be realized. */
int
-lookup_named_face (f, symbol, c, signal_p)
- struct frame *f;
- Lisp_Object symbol;
- int c;
- int signal_p;
+lookup_named_face (struct frame *f, Lisp_Object symbol, int signal_p)
{
Lisp_Object attrs[LFACE_VECTOR_SIZE];
Lisp_Object symbol_attrs[LFACE_VECTOR_SIZE];
abort (); /* realize_basic_faces must have set it up */
}
- if (!get_lface_attributes (f, symbol, symbol_attrs, signal_p))
+ if (! get_lface_attributes (f, symbol, symbol_attrs, signal_p, 0))
return -1;
- bcopy (default_face->lface, attrs, sizeof attrs);
+ memcpy (attrs, default_face->lface, sizeof attrs);
merge_face_vectors (f, symbol_attrs, attrs, 0);
- return lookup_face (f, attrs, c, NULL);
+ return lookup_face (f, attrs);
+}
+
+
+/* Return the display face-id of the basic face who's canonical face-id
+ is FACE_ID. The return value will usually simply be FACE_ID, unless that
+ basic face has bee remapped via Vface_remapping_alist. This function is
+ conservative: if something goes wrong, it will simply return FACE_ID
+ rather than signal an error. */
+
+int
+lookup_basic_face (struct frame *f, int face_id)
+{
+ Lisp_Object name, mapping;
+ int remapped_face_id;
+
+ if (NILP (Vface_remapping_alist))
+ return face_id; /* Nothing to do. */
+
+ switch (face_id)
+ {
+ case DEFAULT_FACE_ID: name = Qdefault; break;
+ case MODE_LINE_FACE_ID: name = Qmode_line; break;
+ case MODE_LINE_INACTIVE_FACE_ID: name = Qmode_line_inactive; break;
+ case HEADER_LINE_FACE_ID: name = Qheader_line; break;
+ case TOOL_BAR_FACE_ID: name = Qtool_bar; break;
+ case FRINGE_FACE_ID: name = Qfringe; break;
+ case SCROLL_BAR_FACE_ID: name = Qscroll_bar; break;
+ case BORDER_FACE_ID: name = Qborder; break;
+ case CURSOR_FACE_ID: name = Qcursor; break;
+ case MOUSE_FACE_ID: name = Qmouse; break;
+ case MENU_FACE_ID: name = Qmenu; break;
+
+ default:
+ abort (); /* the caller is supposed to pass us a basic face id */
+ }
+
+ /* Do a quick scan through Vface_remapping_alist, and return immediately
+ if there is no remapping for face NAME. This is just an optimization
+ for the very common no-remapping case. */
+ mapping = assq_no_quit (name, Vface_remapping_alist);
+ if (NILP (mapping))
+ return face_id; /* Give up. */
+
+ /* If there is a remapping entry, lookup the face using NAME, which will
+ handle the remapping too. */
+ remapped_face_id = lookup_named_face (f, name, 0);
+ if (remapped_face_id < 0)
+ return face_id; /* Give up. */
+
+ return remapped_face_id;
}
LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
int
-ascii_face_of_lisp_face (f, lface_id)
- struct frame *f;
- int lface_id;
+ascii_face_of_lisp_face (struct frame *f, int lface_id)
{
int face_id;
if (lface_id >= 0 && lface_id < lface_id_to_name_size)
{
Lisp_Object face_name = lface_id_to_name[lface_id];
- face_id = lookup_named_face (f, face_name, 0, 1);
+ face_id = lookup_named_face (f, face_name, 1);
}
else
face_id = -1;
STEPS < 0 means larger. Value is the id of the face. */
int
-smaller_face (f, face_id, steps)
- struct frame *f;
- int face_id, steps;
+smaller_face (struct frame *f, int face_id, int steps)
{
#ifdef HAVE_WINDOW_SYSTEM
struct face *face;
/* Try in increments of 1/2 pt. */
delta = steps < 0 ? 5 : -5;
- steps = abs (steps);
+ steps = eabs (steps);
face = FACE_FROM_ID (f, face_id);
- bcopy (face->lface, attrs, sizeof attrs);
+ memcpy (attrs, face->lface, sizeof attrs);
pt = last_pt = XFASTINT (attrs[LFACE_HEIGHT_INDEX]);
new_face_id = face_id;
last_height = FONT_HEIGHT (face->font);
while (steps
&& pt + delta > 0
/* Give up if we cannot find a font within 10pt. */
- && abs (last_pt - pt) < 100)
+ && eabs (last_pt - pt) < 100)
{
/* Look up a face for a slightly smaller/larger font. */
pt += delta;
attrs[LFACE_HEIGHT_INDEX] = make_number (pt);
- new_face_id = lookup_face (f, attrs, 0, NULL);
+ new_face_id = lookup_face (f, attrs);
new_face = FACE_FROM_ID (f, new_face_id);
/* If height changes, count that as one step. */
FACE_ID on frame F, but has height HEIGHT. */
int
-face_with_height (f, face_id, height)
- struct frame *f;
- int face_id;
- int height;
+face_with_height (struct frame *f, int face_id, int height)
{
#ifdef HAVE_WINDOW_SYSTEM
struct face *face;
return face_id;
face = FACE_FROM_ID (f, face_id);
- bcopy (face->lface, attrs, sizeof attrs);
+ memcpy (attrs, face->lface, sizeof attrs);
attrs[LFACE_HEIGHT_INDEX] = make_number (height);
- face_id = lookup_face (f, attrs, 0, NULL);
+ font_clear_prop (attrs, FONT_SIZE_INDEX);
+ face_id = lookup_face (f, attrs);
#endif /* HAVE_WINDOW_SYSTEM */
return face_id;
/* Return the face id of the realized face for named face SYMBOL on
- frame F suitable for displaying character C, and use attributes of
- the face FACE_ID for attributes that aren't completely specified by
- SYMBOL. This is like lookup_named_face, except that the default
- attributes come from FACE_ID, not from the default face. FACE_ID
- is assumed to be already realized. */
+ frame F suitable for displaying ASCII characters, and use
+ attributes of the face FACE_ID for attributes that aren't
+ completely specified by SYMBOL. This is like lookup_named_face,
+ except that the default attributes come from FACE_ID, not from the
+ default face. FACE_ID is assumed to be already realized. */
int
-lookup_derived_face (f, symbol, c, face_id, signal_p)
- struct frame *f;
- Lisp_Object symbol;
- int c;
- int face_id;
- int signal_p;
+lookup_derived_face (struct frame *f, Lisp_Object symbol, int face_id, int signal_p)
{
Lisp_Object attrs[LFACE_VECTOR_SIZE];
Lisp_Object symbol_attrs[LFACE_VECTOR_SIZE];
if (!default_face)
abort ();
- get_lface_attributes (f, symbol, symbol_attrs, signal_p);
- bcopy (default_face->lface, attrs, sizeof attrs);
+ if (!get_lface_attributes (f, symbol, symbol_attrs, signal_p, 0))
+ return -1;
+
+ memcpy (attrs, default_face->lface, sizeof attrs);
merge_face_vectors (f, symbol_attrs, attrs, 0);
- return lookup_face (f, attrs, c, default_face);
+ return lookup_face (f, attrs);
}
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 plist)
{
Lisp_Object lface;
lface = Fmake_vector (make_number (LFACE_VECTOR_SIZE),
\(2) `close in spirit' to what the attributes specify, if not exact. */
static int
-x_supports_face_attributes_p (f, attrs, def_face)
- struct frame *f;
- Lisp_Object *attrs;
- struct face *def_face;
+x_supports_face_attributes_p (struct frame *f, Lisp_Object *attrs, struct face *def_face)
{
Lisp_Object *def_attrs = def_face->lface;
/* Check font-related attributes, as those are the most commonly
"unsupported" on a window-system (because of missing fonts). */
if (!UNSPECIFIEDP (attrs[LFACE_FAMILY_INDEX])
+ || !UNSPECIFIEDP (attrs[LFACE_FOUNDRY_INDEX])
|| !UNSPECIFIEDP (attrs[LFACE_HEIGHT_INDEX])
|| !UNSPECIFIEDP (attrs[LFACE_WEIGHT_INDEX])
|| !UNSPECIFIEDP (attrs[LFACE_SLANT_INDEX])
- || !UNSPECIFIEDP (attrs[LFACE_SWIDTH_INDEX])
- || !UNSPECIFIEDP (attrs[LFACE_AVGWIDTH_INDEX]))
+ || !UNSPECIFIEDP (attrs[LFACE_SWIDTH_INDEX]))
{
+ int face_id;
struct face *face;
Lisp_Object merged_attrs[LFACE_VECTOR_SIZE];
+ int i;
- bcopy (def_attrs, merged_attrs, sizeof merged_attrs);
+ memcpy (merged_attrs, def_attrs, sizeof merged_attrs);
merge_face_vectors (f, attrs, merged_attrs, 0);
- face = FACE_FROM_ID (f, lookup_face (f, merged_attrs, 0, 0));
+ face_id = lookup_face (f, merged_attrs);
+ face = FACE_FROM_ID (f, face_id);
if (! face)
error ("Cannot make face");
- /* If the font is the same, then not supported. */
- if (face->font == def_face->font)
+ /* If the font is the same, or no font is found, then not
+ supported. */
+ if (face->font == def_face->font
+ || ! face->font)
return 0;
+ for (i = FONT_TYPE_INDEX; i <= FONT_SIZE_INDEX; i++)
+ if (! EQ (face->font->props[i], def_face->font->props[i]))
+ {
+ Lisp_Object s1, s2;
+
+ if (i < FONT_FOUNDRY_INDEX || i > FONT_REGISTRY_INDEX
+ || face->font->driver->case_sensitive)
+ return 1;
+ s1 = SYMBOL_NAME (face->font->props[i]);
+ s2 = SYMBOL_NAME (def_face->font->props[i]);
+ if (! EQ (Fcompare_strings (s1, make_number (0), Qnil,
+ s2, make_number (0), Qnil, Qt), Qt))
+ return 1;
+ }
+ return 0;
}
/* Everything checks out, this face is supported. */
substitution of a `dim' face for italic. */
static int
-tty_supports_face_attributes_p (f, attrs, def_face)
- struct frame *f;
- Lisp_Object *attrs;
- struct face *def_face;
+tty_supports_face_attributes_p (struct frame *f, Lisp_Object *attrs, struct face *def_face)
{
int weight;
Lisp_Object val, fg, bg;
because the faked result is too different from what the face
specifies. */
if (!UNSPECIFIEDP (attrs[LFACE_FAMILY_INDEX])
+ || !UNSPECIFIEDP (attrs[LFACE_FOUNDRY_INDEX])
|| !UNSPECIFIEDP (attrs[LFACE_STIPPLE_INDEX])
|| !UNSPECIFIEDP (attrs[LFACE_HEIGHT_INDEX])
|| !UNSPECIFIEDP (attrs[LFACE_SWIDTH_INDEX])
/* Test for terminal `capabilities' (non-color character attributes). */
/* font weight (bold/dim) */
- weight = face_numeric_weight (attrs[LFACE_WEIGHT_INDEX]);
- if (weight >= 0)
+ val = attrs[LFACE_WEIGHT_INDEX];
+ if (!UNSPECIFIEDP (val)
+ && (weight = FONT_WEIGHT_NAME_NUMERIC (val), weight >= 0))
{
- int def_weight = face_numeric_weight (def_attrs[LFACE_WEIGHT_INDEX]);
+ int def_weight = FONT_WEIGHT_NAME_NUMERIC (def_attrs[LFACE_WEIGHT_INDEX]);
- if (weight > XLFD_WEIGHT_MEDIUM)
+ if (weight > 100)
{
- if (def_weight > XLFD_WEIGHT_MEDIUM)
+ if (def_weight > 100)
return 0; /* same as default */
test_caps = TTY_CAP_BOLD;
}
- else if (weight < XLFD_WEIGHT_MEDIUM)
+ else if (weight < 100)
{
- if (def_weight < XLFD_WEIGHT_MEDIUM)
+ if (def_weight < 100)
return 0; /* same as default */
test_caps = TTY_CAP_DIM;
}
- else if (def_weight == XLFD_WEIGHT_MEDIUM)
+ else if (def_weight == 100)
return 0; /* same as default */
}
/* 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))
+ ! tty_capable_p (FRAME_TTY (f), test_caps, fg_tty_color.pixel, bg_tty_color.pixel))
return 0;
as it can display a yellowish color, but `:slant italic' will _not_ be
satisfied by the tty display code's automatic substitution of a `dim'
face for italic. */)
- (attributes, display)
- Lisp_Object attributes, display;
+ (Lisp_Object attributes, Lisp_Object display)
{
int supports = 0, i;
Lisp_Object frame;
frame = Qnil;
for (fl_tail = Vframe_list; CONSP (fl_tail); fl_tail = XCDR (fl_tail))
{
- frame = XCAR (fl_tail);
- if (!NILP (Fequal (Fcdr (Fassq (Qdisplay,
- XFRAME (frame)->param_alist)),
- display)))
- break;
- }
- }
-
- CHECK_LIVE_FRAME (frame);
- f = XFRAME (frame);
-
- for (i = 0; i < LFACE_VECTOR_SIZE; i++)
- attrs[i] = Qunspecified;
- merge_face_ref (f, attributes, attrs, 1, 0);
-
- def_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
- if (def_face == NULL)
- {
- if (! realize_basic_faces (f))
- error ("Cannot realize default face");
- def_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
- if (def_face == NULL)
- abort (); /* realize_basic_faces must have set it up */
- }
-
- /* Dispatch to the appropriate handler. */
- if (FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f))
- supports = tty_supports_face_attributes_p (f, attrs, def_face);
-#ifdef HAVE_WINDOW_SYSTEM
- else
- supports = x_supports_face_attributes_p (f, attrs, def_face);
-#endif
-
- return supports ? Qt : Qnil;
-}
-
-\f
-/***********************************************************************
- Font selection
- ***********************************************************************/
-
-DEFUN ("internal-set-font-selection-order",
- Finternal_set_font_selection_order,
- Sinternal_set_font_selection_order, 1, 1, 0,
- 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);
- bzero (indices, sizeof indices);
- i = 0;
-
- for (list = order;
- CONSP (list) && i < DIM (indices);
- list = XCDR (list), ++i)
- {
- Lisp_Object attr = XCAR (list);
- int xlfd;
-
- if (EQ (attr, QCwidth))
- xlfd = XLFD_SWIDTH;
- else if (EQ (attr, QCheight))
- xlfd = XLFD_POINT_SIZE;
- else if (EQ (attr, QCweight))
- xlfd = XLFD_WEIGHT;
- else if (EQ (attr, QCslant))
- xlfd = XLFD_SLANT;
- else
- break;
-
- if (indices[i] != 0)
- break;
- indices[i] = xlfd;
- }
-
- if (!NILP (list) || i != DIM (indices))
- signal_error ("Invalid font sort order", order);
- for (i = 0; i < DIM (font_sort_order); ++i)
- if (indices[i] == 0)
- signal_error ("Invalid font sort order", order);
-
- if (bcmp (indices, font_sort_order, sizeof indices) != 0)
- {
- bcopy (indices, font_sort_order, sizeof font_sort_order);
- free_all_realized_faces (Qnil);
- }
-
- return Qnil;
-}
-
-
-DEFUN ("internal-set-alternative-font-family-alist",
- Finternal_set_alternative_font_family_alist,
- Sinternal_set_alternative_font_family_alist, 1, 1, 0,
- doc: /* Define alternative font families to try in face font selection.
-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);
- Vface_alternative_font_family_alist = alist;
- free_all_realized_faces (Qnil);
- return alist;
-}
-
-
-DEFUN ("internal-set-alternative-font-registry-alist",
- Finternal_set_alternative_font_registry_alist,
- Sinternal_set_alternative_font_registry_alist, 1, 1, 0,
- doc: /* Define alternative font registries to try in face font selection.
-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);
- Vface_alternative_font_registry_alist = alist;
- free_all_realized_faces (Qnil);
- return alist;
-}
-
-
-#ifdef HAVE_WINDOW_SYSTEM
-
-/* Value is non-zero if FONT is the name of a scalable font. The
- X11R6 XLFD spec says that point size, pixel size, and average width
- are zero for scalable fonts. Intlfonts contain at least one
- scalable font ("*-muleindian-1") for which this isn't true, so we
- just test average width. */
-
-static int
-font_scalable_p (font)
- struct font_name *font;
-{
- char *s = font->fields[XLFD_AVGWIDTH];
- return (*s == '0' && *(s + 1) == '\0')
-#ifdef WINDOWSNT
- /* Windows implementation of XLFD is slightly broken for backward
- compatibility with previous broken versions, so test for
- wildcards as well as 0. */
- || *s == '*'
-#endif
- ;
-}
-
-
-/* Ignore the difference of font point size less than this value. */
-
-#define FONT_POINT_SIZE_QUANTUM 5
-
-/* Value is non-zero if FONT1 is a better match for font attributes
- VALUES than FONT2. VALUES is an array of face attribute values in
- font sort order. COMPARE_PT_P zero means don't compare point
- sizes. AVGWIDTH, if not zero, is a specified font average width
- to compare with. */
-
-static int
-better_font_p (values, font1, font2, compare_pt_p, avgwidth)
- int *values;
- struct font_name *font1, *font2;
- int compare_pt_p, avgwidth;
-{
- int i;
-
- /* Any font is better than no font. */
- if (! font1)
- return 0;
- if (! font2)
- return 1;
-
- for (i = 0; i < DIM (font_sort_order); ++i)
- {
- int xlfd_idx = font_sort_order[i];
-
- if (compare_pt_p || xlfd_idx != XLFD_POINT_SIZE)
- {
- 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 (delta1 > delta2)
- return 0;
- else if (delta1 < delta2)
- return 1;
- else
- {
- /* The difference may be equal because, e.g., the face
- specifies `italic' but we have only `regular' and
- `oblique'. Prefer `oblique' in this case. */
- if ((xlfd_idx == XLFD_WEIGHT || xlfd_idx == XLFD_SLANT)
- && font1->numeric[xlfd_idx] > values[i]
- && font2->numeric[xlfd_idx] < values[i])
- return 1;
- }
- }
- }
-
- if (avgwidth)
- {
- int delta1 = abs (avgwidth - font1->numeric[XLFD_AVGWIDTH]);
- int delta2 = abs (avgwidth - font2->numeric[XLFD_AVGWIDTH]);
- 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;
-}
-
-
-/* Value is non-zero if FONT is an exact match for face attributes in
- SPECIFIED. SPECIFIED is an array of face attribute values in font
- sort order. AVGWIDTH, if non-zero, is an average width to compare
- with. */
-
-static int
-exact_face_match_p (specified, font, avgwidth)
- int *specified;
- struct font_name *font;
- int avgwidth;
-{
- int i;
-
- for (i = 0; i < DIM (font_sort_order); ++i)
- if (specified[i] != font->numeric[font_sort_order[i]])
- break;
-
- return (i == DIM (font_sort_order)
- && (avgwidth <= 0
- || avgwidth == font->numeric[XLFD_AVGWIDTH]));
-}
-
-
-/* Value is the name of a scaled font, generated from scalable font
- FONT on frame F. SPECIFIED_PT is the point-size to scale FONT to.
- Value is allocated from heap. */
-
-static char *
-build_scalable_font_name (f, font, specified_pt)
- struct frame *f;
- struct font_name *font;
- int specified_pt;
-{
- char pixel_size[20];
- int pixel_value;
- double resy = FRAME_X_DISPLAY_INFO (f)->resy;
- double pt;
-
- /* If scalable font is for a specific resolution, compute
- the point size we must specify from the resolution of
- the display and the specified resolution of the font. */
- if (font->numeric[XLFD_RESY] != 0)
- {
- pt = resy / font->numeric[XLFD_RESY] * specified_pt + 0.5;
- pixel_value = font->numeric[XLFD_RESY] / (PT_PER_INCH * 10.0) * pt + 0.5;
- }
- else
- {
- pt = specified_pt;
- pixel_value = resy / (PT_PER_INCH * 10.0) * pt + 0.5;
- }
- /* We may need a font of the different size. */
- pixel_value *= font->rescale_ratio;
-
- /* 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);
- font->fields[XLFD_PIXEL_SIZE] = pixel_size;
- font->numeric[XLFD_PIXEL_SIZE] = pixel_value;
-
- /* If font doesn't specify its resolution, use the
- resolution of the display. */
- if (font->numeric[XLFD_RESY] == 0)
- {
- char buffer[20];
- sprintf (buffer, "%d", (int) resy);
- font->fields[XLFD_RESY] = buffer;
- font->numeric[XLFD_RESY] = resy;
- }
-
- if (strcmp (font->fields[XLFD_RESX], "0") == 0)
- {
- char buffer[20];
- int resx = FRAME_X_DISPLAY_INFO (f)->resx;
- sprintf (buffer, "%d", resx);
- font->fields[XLFD_RESX] = buffer;
- font->numeric[XLFD_RESX] = resx;
- }
-
- return build_font_name (font);
-}
-
-
-/* Value is non-zero if we are allowed to use scalable font FONT. We
- can't run a Lisp function here since this function may be called
- with input blocked. */
-
-static int
-may_use_scalable_font_p (font)
- const char *font;
-{
- if (EQ (Vscalable_fonts_allowed, Qt))
- return 1;
- else if (CONSP (Vscalable_fonts_allowed))
- {
- Lisp_Object tail, regexp;
-
- for (tail = Vscalable_fonts_allowed; CONSP (tail); tail = XCDR (tail))
- {
- regexp = XCAR (tail);
- if (STRINGP (regexp)
- && fast_c_string_match_ignore_case (regexp, font) >= 0)
- return 1;
+ frame = XCAR (fl_tail);
+ if (!NILP (Fequal (Fcdr (Fassq (Qdisplay,
+ XFRAME (frame)->param_alist)),
+ display)))
+ break;
}
}
- return 0;
-}
-
-
-
-/* Return the name of the best matching font for face attributes ATTRS
- in the array of font_name structures FONTS which contains NFONTS
- elements. WIDTH_RATIO is a factor with which to multiply average
- widths if ATTRS specifies such a width.
-
- Value is a font name which is allocated from the heap. FONTS is
- freed by this function.
+ CHECK_LIVE_FRAME (frame);
+ f = XFRAME (frame);
- 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. */
+ for (i = 0; i < LFACE_VECTOR_SIZE; i++)
+ attrs[i] = Qunspecified;
+ merge_face_ref (f, attributes, attrs, 1, 0);
-static char *
-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;
- int i, pt = 0;
- int specified[5];
- int exact_p, avgwidth;
-
- if (nfonts == 0)
- return NULL;
-
- /* Make specified font attributes available in `specified',
- indexed by sort order. */
- for (i = 0; i < DIM (font_sort_order); ++i)
+ def_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
+ if (def_face == NULL)
{
- int xlfd_idx = font_sort_order[i];
-
- if (xlfd_idx == XLFD_SWIDTH)
- specified[i] = face_numeric_swidth (attrs[LFACE_SWIDTH_INDEX]);
- else if (xlfd_idx == XLFD_POINT_SIZE)
- specified[i] = pt = XFASTINT (attrs[LFACE_HEIGHT_INDEX]);
- else if (xlfd_idx == XLFD_WEIGHT)
- specified[i] = face_numeric_weight (attrs[LFACE_WEIGHT_INDEX]);
- else if (xlfd_idx == XLFD_SLANT)
- specified[i] = face_numeric_slant (attrs[LFACE_SLANT_INDEX]);
- else
- abort ();
+ if (! realize_basic_faces (f))
+ error ("Cannot realize default face");
+ def_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
+ if (def_face == NULL)
+ abort (); /* realize_basic_faces must have set it up */
}
- avgwidth = (UNSPECIFIEDP (attrs[LFACE_AVGWIDTH_INDEX])
- ? 0
- : XFASTINT (attrs[LFACE_AVGWIDTH_INDEX]) * width_ratio);
-
- exact_p = 0;
+ /* Dispatch to the appropriate handler. */
+ if (FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f))
+ supports = tty_supports_face_attributes_p (f, attrs, def_face);
+#ifdef HAVE_WINDOW_SYSTEM
+ else
+ supports = x_supports_face_attributes_p (f, attrs, def_face);
+#endif
- if (needs_overstrike)
- *needs_overstrike = 0;
+ return supports ? Qt : Qnil;
+}
- best = NULL;
+\f
+/***********************************************************************
+ Font selection
+ ***********************************************************************/
- /* Find the best match among the non-scalable fonts. */
- for (i = 0; i < nfonts; ++i)
- if (!font_scalable_p (fonts + i)
- && better_font_p (specified, fonts + i, best, 1, avgwidth))
- {
- best = fonts + i;
+DEFUN ("internal-set-font-selection-order",
+ Finternal_set_font_selection_order,
+ Sinternal_set_font_selection_order, 1, 1, 0,
+ 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. */)
+ (Lisp_Object order)
+{
+ Lisp_Object list;
+ int i;
+ int indices[DIM (font_sort_order)];
- exact_p = exact_face_match_p (specified, best, avgwidth);
- if (exact_p)
- break;
- }
+ CHECK_LIST (order);
+ memset (indices, 0, sizeof indices);
+ i = 0;
- /* Unless we found an exact match among non-scalable fonts, see if
- we can find a better match among scalable fonts. */
- if (!exact_p)
+ for (list = order;
+ CONSP (list) && i < DIM (indices);
+ list = XCDR (list), ++i)
{
- /* A scalable font is better if
-
- 1. its weight, slant, swidth attributes are better, or.
-
- 2. the best non-scalable font doesn't have the required
- point size, and the scalable fonts weight, slant, swidth
- isn't worse. */
-
- int non_scalable_has_exact_height_p;
+ Lisp_Object attr = XCAR (list);
+ int xlfd;
- if (best && best->numeric[XLFD_POINT_SIZE] == pt)
- non_scalable_has_exact_height_p = 1;
+ if (EQ (attr, QCwidth))
+ xlfd = XLFD_SWIDTH;
+ else if (EQ (attr, QCheight))
+ xlfd = XLFD_POINT_SIZE;
+ else if (EQ (attr, QCweight))
+ xlfd = XLFD_WEIGHT;
+ else if (EQ (attr, QCslant))
+ xlfd = XLFD_SLANT;
else
- non_scalable_has_exact_height_p = 0;
+ break;
- for (i = 0; i < nfonts; ++i)
- if (font_scalable_p (fonts + i))
- {
- if (better_font_p (specified, fonts + i, best, 0, 0)
- || (!non_scalable_has_exact_height_p
- && !better_font_p (specified, best, fonts + i, 0, 0)))
- {
- non_scalable_has_exact_height_p = 1;
- best = fonts + i;
- }
- }
+ if (indices[i] != 0)
+ break;
+ indices[i] = xlfd;
}
- /* We should have found SOME font. */
- if (best == NULL)
- abort ();
+ if (!NILP (list) || i != DIM (indices))
+ signal_error ("Invalid font sort order", order);
+ for (i = 0; i < DIM (font_sort_order); ++i)
+ if (indices[i] == 0)
+ signal_error ("Invalid font sort order", order);
- if (! exact_p && needs_overstrike)
+ if (memcmp (indices, font_sort_order, sizeof indices) != 0)
{
- enum xlfd_weight want_weight = specified[XLFD_WEIGHT];
- enum xlfd_weight got_weight = best->numeric[XLFD_WEIGHT];
-
- if (want_weight > XLFD_WEIGHT_MEDIUM && want_weight > got_weight)
- {
- /* We want a bold font, but didn't get one; try to use
- overstriking instead to simulate bold-face. However,
- don't overstrike an already-bold font unless the
- desired weight grossly exceeds the available weight. */
- if (got_weight > XLFD_WEIGHT_MEDIUM)
- *needs_overstrike = (want_weight - got_weight) > 2;
- else
- *needs_overstrike = 1;
- }
+ memcpy (font_sort_order, indices, sizeof font_sort_order);
+ free_all_realized_faces (Qnil);
}
- if (font_scalable_p (best))
- font_name = build_scalable_font_name (f, best, pt);
- else
- font_name = build_font_name (best);
-
- /* Free font_name structures. */
- free_font_names (fonts, nfonts);
+ font_update_sort_order (font_sort_order);
- return font_name;
+ return Qnil;
}
-/* 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.
-
- 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. */
-
-static int
-try_alternative_families (f, family, registry, fonts)
- struct frame *f;
- Lisp_Object family, registry;
- struct font_name **fonts;
+DEFUN ("internal-set-alternative-font-family-alist",
+ Finternal_set_alternative_font_family_alist,
+ Sinternal_set_alternative_font_family_alist, 1, 1, 0,
+ doc: /* Define alternative font families to try in face font selection.
+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. */)
+ (Lisp_Object alist)
{
- Lisp_Object alter;
- int nfonts = 0;
+ Lisp_Object entry, tail, tail2;
- nfonts = font_list (f, Qnil, family, registry, fonts);
- if (nfonts == 0)
+ CHECK_LIST (alist);
+ alist = Fcopy_sequence (alist);
+ for (tail = alist; CONSP (tail); tail = XCDR (tail))
{
- /* 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 all scalable fonts before giving up. */
- if (nfonts == 0 && ! EQ (Vscalable_fonts_allowed, Qt))
- {
- int count = SPECPDL_INDEX ();
- specbind (Qscalable_fonts_allowed, Qt);
- nfonts = try_alternative_families (f, family, registry, fonts);
- unbind_to (count, Qnil);
- }
+ entry = XCAR (tail);
+ CHECK_LIST (entry);
+ entry = Fcopy_sequence (entry);
+ XSETCAR (tail, entry);
+ for (tail2 = entry; CONSP (tail2); tail2 = XCDR (tail2))
+ XSETCAR (tail2, Fintern (XCAR (tail2), Qnil));
}
- return nfonts;
-}
-
-
-/* Get a list of matching fonts on frame F.
- 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, 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
- if (nfonts == 0 && STRINGP (try_family) && STRINGP (registry))
- {
- if (xstricmp (SDATA (registry), "mac-roman") == 0)
- /* When realizing the default face and a font spec does not
- matched exactly, Emacs looks for ones with the same registry
- as the default font. On the Mac, this is mac-roman, which
- does not work if the family is -etl-fixed, e.g. The
- following widens the choices and fixes that problem. */
- nfonts = try_alternative_families (f, try_family, Qnil, fonts);
- else if (SBYTES (try_family) > 0
- && SREF (try_family, SBYTES (try_family) - 1) != '*')
- /* Some Central European/Cyrillic font family names have the
- Roman counterpart name as their prefix. */
- nfonts = try_alternative_families (f, concat2 (try_family,
- build_string ("*")),
- registry, fonts);
- }
-#endif
+ Vface_alternative_font_family_alist = alist;
+ free_all_realized_faces (Qnil);
+ return alist;
+}
- if (EQ (try_family, family))
- family = face_family;
- if (nfonts == 0 && STRINGP (family))
- nfonts = try_alternative_families (f, family, registry, fonts);
+DEFUN ("internal-set-alternative-font-registry-alist",
+ Finternal_set_alternative_font_registry_alist,
+ Sinternal_set_alternative_font_registry_alist, 1, 1, 0,
+ doc: /* Define alternative font registries to try in face font selection.
+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. */)
+ (Lisp_Object alist)
+{
+ Lisp_Object entry, tail, tail2;
- /* Try font family of the default face or "fixed". */
- if (nfonts == 0)
+ CHECK_LIST (alist);
+ alist = Fcopy_sequence (alist);
+ for (tail = alist; CONSP (tail); tail = XCDR (tail))
{
- 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);
+ entry = XCAR (tail);
+ CHECK_LIST (entry);
+ entry = Fcopy_sequence (entry);
+ XSETCAR (tail, entry);
+ for (tail2 = entry; CONSP (tail2); tail2 = XCDR (tail2))
+ XSETCAR (tail2, Fdowncase (XCAR (tail2)));
}
+ Vface_alternative_font_registry_alist = alist;
+ free_all_realized_faces (Qnil);
+ return alist;
+}
- /* Try any family with the given registry. */
- if (nfonts == 0)
- nfonts = try_alternative_families (f, Qnil, registry, fonts);
- return nfonts;
-}
+#ifdef HAVE_WINDOW_SYSTEM
+
+/* Ignore the difference of font point size less than this value. */
+#define FONT_POINT_SIZE_QUANTUM 5
/* Return the fontset id of the base fontset name or alias name given
by the fontset attribute of ATTRS. Value is -1 if the fontset
attribute of ATTRS doesn't name a fontset. */
static int
-face_fontset (attrs)
- Lisp_Object *attrs;
+face_fontset (Lisp_Object *attrs)
{
Lisp_Object name;
- name = attrs[LFACE_FONT_INDEX];
+ name = attrs[LFACE_FONTSET_INDEX];
if (!STRINGP (name))
return -1;
return fs_query_fontset (name, 0);
}
-
-/* Choose a name of font to use on frame F to display character C with
- Lisp face attributes specified by ATTRS. The font name is
- determined by the font-related attributes in ATTRS and the name
- pattern for C in FONTSET. Value is the font name which is
- 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.
-
- 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, 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);
- if (NILP (pattern))
- {
- xassert (!SINGLE_BYTE_CHAR_P (c));
- return NULL;
- }
-
- /* If what we got is a name pattern, return it. */
- if (STRINGP (pattern))
- 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,
- (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,
- needs_overstrike);
- return font_name;
-}
-
#endif /* HAVE_WINDOW_SYSTEM */
face. */
static int
-realize_basic_faces (f)
- struct frame *f;
+realize_basic_faces (struct frame *f)
{
int success_p = 0;
int count = SPECPDL_INDEX ();
{
FRAME_FACE_CACHE (f)->menu_face_changed_p = 0;
#ifdef USE_X_TOOLKIT
- x_update_menu_appearance (f);
+ if (FRAME_WINDOW_P (f))
+ x_update_menu_appearance (f);
#endif
}
that are not explicitly specified are taken from frame parameters. */
static int
-realize_default_face (f)
- struct frame *f;
+realize_default_face (struct frame *f)
{
struct face_cache *c = FRAME_FACE_CACHE (f);
Lisp_Object lface;
Lisp_Object attrs[LFACE_VECTOR_SIZE];
- Lisp_Object frame_font;
struct face *face;
/* If the `default' face is not yet known, create it. */
lface = Finternal_make_lisp_face (Qdefault, frame);
}
-
#ifdef HAVE_WINDOW_SYSTEM
if (FRAME_WINDOW_P (f))
{
- /* Set frame_font to the value of the `font' frame parameter. */
- 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,
- f->default_face_done_p, 1);
+ Lisp_Object font_object;
+
+ XSETFONT (font_object, FRAME_FONT (f));
+ set_lface_from_font (f, lface, font_object, f->default_face_done_p);
+ LFACE_FONTSET (lface) = fontset_name (FRAME_FONTSET (f));
f->default_face_done_p = 1;
}
#endif /* HAVE_WINDOW_SYSTEM */
if (!FRAME_WINDOW_P (f))
{
LFACE_FAMILY (lface) = build_string ("default");
+ LFACE_FOUNDRY (lface) = LFACE_FAMILY (lface);
LFACE_SWIDTH (lface) = Qnormal;
LFACE_HEIGHT (lface) = make_number (1);
if (UNSPECIFIEDP (LFACE_WEIGHT (lface)))
LFACE_WEIGHT (lface) = Qnormal;
if (UNSPECIFIEDP (LFACE_SLANT (lface)))
LFACE_SLANT (lface) = Qnormal;
- LFACE_AVGWIDTH (lface) = Qunspecified;
+ if (UNSPECIFIEDP (LFACE_FONTSET (lface)))
+ LFACE_FONTSET (lface) = Qnil;
}
if (UNSPECIFIEDP (LFACE_UNDERLINE (lface)))
LFACE_FOREGROUND (lface) = XCDR (color);
else if (FRAME_WINDOW_P (f))
return 0;
- else if (FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f))
+ else if (FRAME_INITIAL_P (f) || FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f))
LFACE_FOREGROUND (lface) = build_string (unspecified_fg);
else
abort ();
LFACE_BACKGROUND (lface) = XCDR (color);
else if (FRAME_WINDOW_P (f))
return 0;
- else if (FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f))
+ else if (FRAME_INITIAL_P (f) || FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f))
LFACE_BACKGROUND (lface) = build_string (unspecified_bg);
else
abort ();
/* Realize the face; it must be fully-specified now. */
xassert (lface_fully_specified_p (XVECTOR (lface)->contents));
check_lface (lface);
- bcopy (XVECTOR (lface)->contents, attrs, sizeof attrs);
- face = realize_face (c, attrs, 0, NULL, DEFAULT_FACE_ID);
+ memcpy (attrs, XVECTOR (lface)->contents, sizeof attrs);
+ face = realize_face (c, attrs, DEFAULT_FACE_ID);
#ifdef HAVE_WINDOW_SYSTEM
#ifdef HAVE_X_WINDOWS
- if (face->font != FRAME_FONT (f))
+ if (FRAME_X_P (f) && face->font != FRAME_FONT (f))
{
/* This can happen when making a frame on a display that does
- not support the default font. */
+ not support the default font. */
if (!face->font)
- return 0;
+ return 0;
/* Otherwise, the font specified for the frame was not
- acceptable as a font for the default face (perhaps because
- auto-scaled fonts are rejected), so we must adjust the frame
- font. */
- x_set_font (f, build_string (face->font_name), Qnil);
+ acceptable as a font for the default face (perhaps because
+ auto-scaled fonts are rejected), so we must adjust the frame
+ font. */
+ x_set_font (f, LFACE_FONT (lface), Qnil);
}
#endif /* HAVE_X_WINDOWS */
#endif /* HAVE_WINDOW_SYSTEM */
have. The default face must have been realized already. */
static void
-realize_named_face (f, symbol, id)
- struct frame *f;
- Lisp_Object symbol;
- int id;
+realize_named_face (struct frame *f, Lisp_Object symbol, int id)
{
struct face_cache *c = FRAME_FACE_CACHE (f);
Lisp_Object lface = lface_from_face_name (f, symbol, 0);
struct face *new_face;
/* The default face must exist and be fully specified. */
- get_lface_attributes (f, Qdefault, attrs, 1);
+ get_lface_attributes_no_remap (f, Qdefault, attrs, 1);
check_lface_attrs (attrs);
xassert (lface_fully_specified_p (attrs));
}
/* Merge SYMBOL's face with the default face. */
- get_lface_attributes (f, symbol, symbol_attrs, 1);
+ get_lface_attributes_no_remap (f, symbol, symbol_attrs, 1);
merge_face_vectors (f, symbol_attrs, attrs, 0);
/* Realize the face. */
- new_face = realize_face (c, attrs, 0, NULL, id);
+ new_face = realize_face (c, attrs, id);
}
/* Realize the fully-specified face with attributes ATTRS in face
- cache CACHE for character C. If C is a multibyte character,
- BASE_FACE is a face that has the same attributes. Otherwise,
- BASE_FACE is ignored. If FORMER_FACE_ID is non-negative, it is an
- ID of face to remove before caching the new face. Value is a
- pointer to the newly created realized face. */
+ cache CACHE for ASCII characters. If FORMER_FACE_ID is
+ non-negative, it is an ID of face to remove before caching the new
+ face. Value is a pointer to the newly created realized face. */
static struct face *
-realize_face (cache, attrs, c, base_face, former_face_id)
- struct face_cache *cache;
- Lisp_Object *attrs;
- int c;
- struct face *base_face;
- int former_face_id;
+realize_face (struct face_cache *cache, Lisp_Object *attrs, int former_face_id)
{
struct face *face;
struct face *former_face = cache->faces_by_id[former_face_id];
uncache_face (cache, former_face);
free_realized_face (cache->f, former_face);
+ SET_FRAME_GARBAGED (cache->f);
}
if (FRAME_WINDOW_P (cache->f))
- face = realize_x_face (cache, attrs, c, base_face);
+ face = realize_x_face (cache, attrs);
else if (FRAME_TERMCAP_P (cache->f) || FRAME_MSDOS_P (cache->f))
- face = realize_tty_face (cache, attrs, c);
+ face = realize_tty_face (cache, attrs);
+ else if (FRAME_INITIAL_P (cache->f))
+ {
+ /* Create a dummy face. */
+ face = make_realized_face (attrs);
+ }
else
abort ();
/* Insert the new face. */
cache_face (cache, face, lface_hash (attrs));
+ return face;
+}
+
+
#ifdef HAVE_WINDOW_SYSTEM
- if (FRAME_WINDOW_P (cache->f) && face->font == NULL)
- load_face_font (cache->f, face, c);
-#endif /* HAVE_WINDOW_SYSTEM */
+/* Realize the fully-specified face that uses FONT-OBJECT and has the
+ same attributes as BASE_FACE except for the font on frame F.
+ FONT-OBJECT may be nil, in which case, realized a face of
+ no-font. */
+
+static struct face *
+realize_non_ascii_face (struct frame *f, Lisp_Object font_object, struct face *base_face)
+{
+ struct face_cache *cache = FRAME_FACE_CACHE (f);
+ struct face *face;
+
+ face = (struct face *) xmalloc (sizeof *face);
+ *face = *base_face;
+ face->gc = 0;
+ face->extra = NULL;
+ face->overstrike
+ = (! NILP (font_object)
+ && FONT_WEIGHT_NAME_NUMERIC (face->lface[LFACE_WEIGHT_INDEX]) > 100
+ && FONT_WEIGHT_NUMERIC (font_object) <= 100);
+
+ /* Don't try to free the colors copied bitwise from BASE_FACE. */
+ face->colors_copied_bitwise_p = 1;
+ face->font = NILP (font_object) ? NULL : XFONT_OBJECT (font_object);
+ face->gc = 0;
+
+ cache_face (cache, face, face->hash);
+
return face;
}
+#endif /* HAVE_WINDOW_SYSTEM */
/* Realize the fully-specified face with attributes ATTRS in face
- cache CACHE for character C. Do it for X frame CACHE->f. If C is
- a multibyte character, BASE_FACE is a face that has the same
- attributes. Otherwise, BASE_FACE is ignored. If the new face
- doesn't share font with the default face, a fontname is allocated
- from the heap and set in `font_name' of the new face, but it is not
- yet loaded here. Value is a pointer to the newly created realized
- face. */
+ cache CACHE for ASCII characters. Do it for X frame CACHE->f. If
+ the new face doesn't share font with the default face, a fontname
+ is allocated from the heap and set in `font_name' of the new face,
+ but it is not yet loaded here. Value is a pointer to the newly
+ created realized face. */
static struct face *
-realize_x_face (cache, attrs, c, base_face)
- struct face_cache *cache;
- Lisp_Object *attrs;
- int c;
- struct face *base_face;
+realize_x_face (struct face_cache *cache, Lisp_Object *attrs)
{
struct face *face = NULL;
#ifdef HAVE_WINDOW_SYSTEM
Lisp_Object stipple, overline, strike_through, box;
xassert (FRAME_WINDOW_P (cache->f));
- xassert (SINGLE_BYTE_CHAR_P (c)
- || base_face);
/* Allocate a new realized face. */
face = make_realized_face (attrs);
+ face->ascii_face = face;
f = cache->f;
- /* If C is a multibyte character, we share all face attirbutes with
- BASE_FACE including the realized fontset. But, we must load a
- different font. */
- if (!SINGLE_BYTE_CHAR_P (c))
- {
- bcopy (base_face, face, sizeof *face);
- face->gc = 0;
-
- /* Don't try to free the colors copied bitwise from BASE_FACE. */
- face->colors_copied_bitwise_p = 1;
-
- /* to force realize_face to load font */
- face->font = NULL;
- return face;
- }
-
- /* Now we are realizing a face for ASCII (and unibyte) characters. */
-
/* Determine the font to use. Most of the time, the font will be
the same as the font of the default face, so try that first. */
default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
if (default_face
- && FACE_SUITABLE_FOR_CHAR_P (default_face, c)
&& lface_same_font_attributes_p (default_face->lface, attrs))
{
face->font = default_face->font;
- face->fontset = default_face->fontset;
- face->font_info_id = default_face->font_info_id;
- face->font_name = default_face->font_name;
- face->ascii_face = face;
-
- /* But, as we can't share the fontset, make a new realized
- fontset that has the same base fontset as of the default
- face. */
face->fontset
- = make_fontset_for_ascii_face (f, default_face->fontset);
+ = make_fontset_for_ascii_face (f, default_face->fontset, face);
}
else
{
are constructed from ATTRS. */
int fontset = face_fontset (attrs);
- if ((fontset == -1) && default_face)
- fontset = default_face->fontset;
- face->fontset = make_fontset_for_ascii_face (f, fontset);
- face->font = NULL; /* to force realize_face to load font */
+ /* If we are realizing the default face, ATTRS should specify a
+ fontset. In other words, if FONTSET is -1, we are not
+ realizing the default face, thus the default face should have
+ already been realized. */
+ if (fontset == -1)
+ {
+ if (default_face)
+ fontset = default_face->fontset;
+ if (fontset == -1)
+ abort ();
+ }
+ if (! FONT_OBJECT_P (attrs[LFACE_FONT_INDEX]))
+ attrs[LFACE_FONT_INDEX]
+ = font_load_for_lface (f, attrs, attrs[LFACE_FONT_INDEX]);
+ if (FONT_OBJECT_P (attrs[LFACE_FONT_INDEX]))
+ {
+ face->font = XFONT_OBJECT (attrs[LFACE_FONT_INDEX]);
+ face->fontset = make_fontset_for_ascii_face (f, fontset, face);
+ }
+ else
+ {
+ face->font = NULL;
+ face->fontset = -1;
+ }
}
+ if (face->font
+ && FONT_WEIGHT_NAME_NUMERIC (attrs[LFACE_WEIGHT_INDEX]) > 100
+ && FONT_WEIGHT_NUMERIC (attrs[LFACE_FONT_INDEX]) <= 100)
+ face->overstrike = 1;
+
/* Load colors, and set remaining attributes. */
load_face_colors (f, face, attrs);
stipple = attrs[LFACE_STIPPLE_INDEX];
if (!NILP (stipple))
face->stipple = load_pixmap (f, stipple, &face->pixmap_w, &face->pixmap_h);
-
- xassert (FACE_SUITABLE_FOR_CHAR_P (face, c));
#endif /* HAVE_WINDOW_SYSTEM */
+
return face;
}
default foreground/background colors. */
static void
-map_tty_color (f, face, idx, defaulted)
- struct frame *f;
- struct face *face;
- enum lface_attribute_index idx;
- int *defaulted;
+map_tty_color (struct frame *f, struct face *face, enum lface_attribute_index idx, int *defaulted)
{
Lisp_Object frame, color, def;
int foreground_p = idx == LFACE_FOREGROUND_INDEX;
{
pixel = load_color (f, face, color, idx);
-#if defined (MSDOS) || defined (WINDOWSNT)
+#ifdef MSDOS
/* If the foreground of the default face is the default color,
use the foreground color defined by the frame. */
-#ifdef MSDOS
if (FRAME_MSDOS_P (f))
{
-#endif /* MSDOS */
if (pixel == default_pixel
|| pixel == FACE_TTY_DEFAULT_COLOR)
{
face->lface[idx] = tty_color_name (f, pixel);
*defaulted = 1;
}
-#ifdef MSDOS
- }
-#endif
-#endif /* MSDOS or WINDOWSNT */
+ }
+#endif /* MSDOS */
}
if (foreground_p)
/* Realize the fully-specified face with attributes ATTRS in face
- cache CACHE for character C. Do it for TTY frame CACHE->f. Value is a
- pointer to the newly created realized face. */
+ cache CACHE for ASCII characters. Do it for TTY frame CACHE->f.
+ Value is a pointer to the newly created realized face. */
static struct face *
-realize_tty_face (cache, attrs, c)
- struct face_cache *cache;
- Lisp_Object *attrs;
- int c;
+realize_tty_face (struct face_cache *cache, Lisp_Object *attrs)
{
struct face *face;
int weight, slant;
/* Allocate a new realized face. */
face = make_realized_face (attrs);
+#if 0
face->font_name = FRAME_MSDOS_P (cache->f) ? "ms-dos" : "tty";
+#endif
/* Map face attributes to TTY appearances. We map slant to
dimmed text because we want italic text to appear differently
and because dimmed text is probably used infrequently. */
- weight = face_numeric_weight (attrs[LFACE_WEIGHT_INDEX]);
- slant = face_numeric_slant (attrs[LFACE_SLANT_INDEX]);
-
- if (weight > XLFD_WEIGHT_MEDIUM)
+ weight = FONT_WEIGHT_NAME_NUMERIC (attrs[LFACE_WEIGHT_INDEX]);
+ slant = FONT_SLANT_NAME_NUMERIC (attrs[LFACE_SLANT_INDEX]);
+ if (weight > 100)
face->tty_bold_p = 1;
- if (weight < XLFD_WEIGHT_MEDIUM || slant != XLFD_SLANT_ROMAN)
+ if (weight < 100 || slant != 100)
face->tty_dim_p = 1;
if (!NILP (attrs[LFACE_UNDERLINE_INDEX]))
face->tty_underline_p = 1;
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;
+ (Lisp_Object suppress)
{
tty_suppress_bold_inverse_default_colors_p = !NILP (suppress);
++face_change_count;
property PROP on frame F in current_buffer. */
int
-compute_char_face (f, ch, prop)
- struct frame *f;
- int ch;
- Lisp_Object prop;
+compute_char_face (struct frame *f, int ch, Lisp_Object prop)
{
int face_id;
if (NILP (prop))
{
struct face *face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
- face_id = FACE_FOR_CHAR (f, face, ch);
+ face_id = FACE_FOR_CHAR (f, face, ch, -1, Qnil);
}
else
{
Lisp_Object attrs[LFACE_VECTOR_SIZE];
struct face *default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
- bcopy (default_face->lface, attrs, sizeof attrs);
+ memcpy (attrs, default_face->lface, sizeof attrs);
merge_face_ref (f, prop, attrs, 1, 0);
- face_id = lookup_face (f, attrs, ch, NULL);
+ face_id = lookup_face (f, attrs);
}
return face_id;
If MOUSE is non-zero, use the character's mouse-face, not its face.
+ BASE_FACE_ID, if non-negative, specifies a base face id to use
+ instead of DEFAULT_FACE_ID.
+
The face returned is suitable for displaying ASCII characters. */
int
-face_at_buffer_position (w, pos, region_beg, region_end,
- endptr, limit, mouse)
- struct window *w;
- int pos;
- int region_beg, region_end;
- int *endptr;
- int limit;
- int mouse;
+face_at_buffer_position (struct window *w, EMACS_INT pos,
+ EMACS_INT region_beg, EMACS_INT region_end,
+ EMACS_INT *endptr, EMACS_INT limit,
+ int mouse, int base_face_id)
{
struct frame *f = XFRAME (w->frame);
Lisp_Object attrs[LFACE_VECTOR_SIZE];
int i, noverlays;
Lisp_Object *overlay_vec;
Lisp_Object frame;
- int endpos;
+ EMACS_INT endpos;
Lisp_Object propname = mouse ? Qmouse_face : Qface;
Lisp_Object limit1, end;
struct face *default_face;
/* Look at properties from overlays. */
{
- int next_overlay;
+ EMACS_INT next_overlay;
GET_OVERLAYS_AT (pos, overlay_vec, noverlays, &next_overlay, 0);
if (next_overlay < endpos)
*endptr = endpos;
- default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
+ default_face = FACE_FROM_ID (f, base_face_id >= 0 ? base_face_id
+ : NILP (Vface_remapping_alist) ? DEFAULT_FACE_ID
+ : lookup_basic_face (f, DEFAULT_FACE_ID));
/* Optimize common cases where we can use the default face. */
if (noverlays == 0
&& NILP (prop)
&& !(pos >= region_beg && pos < region_end))
- return DEFAULT_FACE_ID;
+ return default_face->id;
/* Begin with attributes from the default face. */
- bcopy (default_face->lface, attrs, sizeof attrs);
+ memcpy (attrs, default_face->lface, sizeof attrs);
/* Merge in attributes specified via text properties. */
if (!NILP (prop))
/* Look up a realized face with the given face attributes,
or realize a new one for ASCII characters. */
- return lookup_face (f, attrs, 0, NULL);
+ return lookup_face (f, attrs);
}
/* Return the face ID at buffer position POS for displaying ASCII
simply disregards the `face' properties of all overlays. */
int
-face_for_overlay_string (w, pos, region_beg, region_end,
- endptr, limit, mouse, overlay)
- struct window *w;
- int pos;
- int region_beg, region_end;
- int *endptr;
- int limit;
- int mouse;
- Lisp_Object overlay;
+face_for_overlay_string (struct window *w, EMACS_INT pos,
+ EMACS_INT region_beg, EMACS_INT region_end,
+ EMACS_INT *endptr, EMACS_INT limit,
+ int mouse, Lisp_Object overlay)
{
struct frame *f = XFRAME (w->frame);
Lisp_Object attrs[LFACE_VECTOR_SIZE];
Lisp_Object prop, position;
- int i, noverlays;
- Lisp_Object *overlay_vec;
Lisp_Object frame;
int endpos;
Lisp_Object propname = mouse ? Qmouse_face : Qface;
return DEFAULT_FACE_ID;
/* Begin with attributes from the default face. */
- bcopy (default_face->lface, attrs, sizeof attrs);
+ memcpy (attrs, default_face->lface, sizeof attrs);
/* Merge in attributes specified via text properties. */
if (!NILP (prop))
/* Look up a realized face with the given face attributes,
or realize a new one for ASCII characters. */
- return lookup_face (f, attrs, 0, NULL);
+ return lookup_face (f, attrs);
}
for displaying ASCII characters. */
int
-face_at_string_position (w, string, pos, bufpos, region_beg,
- region_end, endptr, base_face_id, mouse_p)
- struct window *w;
- Lisp_Object string;
- int pos, bufpos;
- int region_beg, region_end;
- int *endptr;
- enum face_id base_face_id;
- int mouse_p;
+face_at_string_position (struct window *w, Lisp_Object string,
+ EMACS_INT pos, EMACS_INT bufpos,
+ EMACS_INT region_beg, EMACS_INT region_end,
+ EMACS_INT *endptr, enum face_id base_face_id,
+ int mouse_p)
{
Lisp_Object prop, position, end, limit;
struct frame *f = XFRAME (WINDOW_FRAME (w));
return base_face->id;
/* Begin with attributes from the base face. */
- bcopy (base_face->lface, attrs, sizeof attrs);
+ memcpy (attrs, base_face->lface, sizeof attrs);
/* Merge in attributes specified via text properties. */
if (!NILP (prop))
/* Look up a realized face with the given face attributes,
or realize a new one for ASCII characters. */
- return lookup_face (f, attrs, 0, NULL);
+ return lookup_face (f, attrs);
}
*/
int
-merge_faces (f, face_name, face_id, base_face_id)
- struct frame *f;
- Lisp_Object face_name;
- int face_id, base_face_id;
+merge_faces (struct frame *f, Lisp_Object face_name, int face_id, int base_face_id)
{
Lisp_Object attrs[LFACE_VECTOR_SIZE];
struct face *base_face;
if (face_id < 0 || face_id >= lface_id_to_name_size)
return base_face_id;
face_name = lface_id_to_name[face_id];
- face_id = lookup_derived_face (f, face_name, 0, base_face_id, 1);
- if (face_id >= 0)
- return face_id;
- return base_face_id;
+ /* When called during make-frame, lookup_derived_face may fail
+ if the faces are uninitialized. Don't signal an error. */
+ face_id = lookup_derived_face (f, face_name, base_face_id, 0);
+ return (face_id >= 0 ? face_id : base_face_id);
}
/* Begin with attributes from the base face. */
- bcopy (base_face->lface, attrs, sizeof attrs);
+ memcpy (attrs, base_face->lface, sizeof attrs);
if (!NILP (face_name))
{
/* Look up a realized face with the given face attributes,
or realize a new one for ASCII characters. */
- return lookup_face (f, attrs, 0, NULL);
+ return lookup_face (f, attrs);
+}
+
+\f
+
+#ifndef HAVE_X_WINDOWS
+DEFUN ("x-load-color-file", Fx_load_color_file,
+ Sx_load_color_file, 1, 1, 0,
+ doc: /* Create an alist of color entries from an external file.
+
+The file should define one named RGB color per line like so:
+ R G B name
+where R,G,B are numbers between 0 and 255 and name is an arbitrary string. */)
+ (Lisp_Object filename)
+{
+ FILE *fp;
+ Lisp_Object cmap = Qnil;
+ Lisp_Object abspath;
+
+ CHECK_STRING (filename);
+ abspath = Fexpand_file_name (filename, Qnil);
+
+ fp = fopen (SDATA (filename), "rt");
+ if (fp)
+ {
+ char buf[512];
+ int red, green, blue;
+ int num;
+
+ BLOCK_INPUT;
+
+ while (fgets (buf, sizeof (buf), fp) != NULL) {
+ if (sscanf (buf, "%u %u %u %n", &red, &green, &blue, &num) == 3)
+ {
+ char *name = buf + num;
+ num = strlen (name) - 1;
+ if (num >= 0 && name[num] == '\n')
+ name[num] = 0;
+ cmap = Fcons (Fcons (build_string (name),
+#ifdef WINDOWSNT
+ make_number (RGB (red, green, blue))),
+#else
+ make_number ((red << 16) | (green << 8) | blue)),
+#endif
+ cmap);
+ }
+ }
+ fclose (fp);
+
+ UNBLOCK_INPUT;
+ }
+
+ return cmap;
}
+#endif
\f
/***********************************************************************
fprintf (stderr, "background: 0x%lx (%s)\n",
face->background,
SDATA (face->lface[LFACE_BACKGROUND_INDEX]));
- fprintf (stderr, "font_name: %s (%s)\n",
- face->font_name,
- SDATA (face->lface[LFACE_FAMILY_INDEX]));
+ if (face->font)
+ fprintf (stderr, "font_name: %s (%s)\n",
+ SDATA (face->font->props[FONT_NAME_INDEX]),
+ SDATA (face->lface[LFACE_FAMILY_INDEX]));
#ifdef HAVE_X_WINDOWS
fprintf (stderr, "font = %p\n", face->font);
#endif
- fprintf (stderr, "font_info_id = %d\n", face->font_info_id);
fprintf (stderr, "fontset: %d\n", face->fontset);
fprintf (stderr, "underline: %d (%s)\n",
face->underline_p,
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, doc: /* */)
- (n)
- Lisp_Object n;
+ (Lisp_Object n)
{
if (NILP (n))
{
DEFUN ("show-face-resources", Fshow_face_resources, Sshow_face_resources,
0, 0, 0, doc: /* */)
- ()
+ (void)
{
fprintf (stderr, "number of colors = %d\n", ncolors_allocated);
fprintf (stderr, "number of pixmaps = %d\n", npixmaps_allocated);
***********************************************************************/
void
-syms_of_xfaces ()
+syms_of_xfaces (void)
{
- Qface = intern ("face");
+ Qface = intern_c_string ("face");
staticpro (&Qface);
- Qface_no_inherit = intern ("face-no-inherit");
+ Qface_no_inherit = intern_c_string ("face-no-inherit");
staticpro (&Qface_no_inherit);
- Qbitmap_spec_p = intern ("bitmap-spec-p");
+ Qbitmap_spec_p = intern_c_string ("bitmap-spec-p");
staticpro (&Qbitmap_spec_p);
- Qframe_set_background_mode = intern ("frame-set-background-mode");
+ Qframe_set_background_mode = intern_c_string ("frame-set-background-mode");
staticpro (&Qframe_set_background_mode);
/* Lisp face attribute keywords. */
- QCfamily = intern (":family");
+ QCfamily = intern_c_string (":family");
staticpro (&QCfamily);
- QCheight = intern (":height");
+ QCheight = intern_c_string (":height");
staticpro (&QCheight);
- QCweight = intern (":weight");
+ QCweight = intern_c_string (":weight");
staticpro (&QCweight);
- QCslant = intern (":slant");
+ QCslant = intern_c_string (":slant");
staticpro (&QCslant);
- QCunderline = intern (":underline");
+ QCunderline = intern_c_string (":underline");
staticpro (&QCunderline);
- QCinverse_video = intern (":inverse-video");
+ QCinverse_video = intern_c_string (":inverse-video");
staticpro (&QCinverse_video);
- QCreverse_video = intern (":reverse-video");
+ QCreverse_video = intern_c_string (":reverse-video");
staticpro (&QCreverse_video);
- QCforeground = intern (":foreground");
+ QCforeground = intern_c_string (":foreground");
staticpro (&QCforeground);
- QCbackground = intern (":background");
+ QCbackground = intern_c_string (":background");
staticpro (&QCbackground);
- QCstipple = intern (":stipple");
+ QCstipple = intern_c_string (":stipple");
staticpro (&QCstipple);
- QCwidth = intern (":width");
+ QCwidth = intern_c_string (":width");
staticpro (&QCwidth);
- QCfont = intern (":font");
+ QCfont = intern_c_string (":font");
staticpro (&QCfont);
- QCbold = intern (":bold");
+ QCfontset = intern_c_string (":fontset");
+ staticpro (&QCfontset);
+ QCbold = intern_c_string (":bold");
staticpro (&QCbold);
- QCitalic = intern (":italic");
+ QCitalic = intern_c_string (":italic");
staticpro (&QCitalic);
- QCoverline = intern (":overline");
+ QCoverline = intern_c_string (":overline");
staticpro (&QCoverline);
- QCstrike_through = intern (":strike-through");
+ QCstrike_through = intern_c_string (":strike-through");
staticpro (&QCstrike_through);
- QCbox = intern (":box");
+ QCbox = intern_c_string (":box");
staticpro (&QCbox);
- QCinherit = intern (":inherit");
+ QCinherit = intern_c_string (":inherit");
staticpro (&QCinherit);
/* Symbols used for Lisp face attribute values. */
- QCcolor = intern (":color");
+ QCcolor = intern_c_string (":color");
staticpro (&QCcolor);
- QCline_width = intern (":line-width");
+ QCline_width = intern_c_string (":line-width");
staticpro (&QCline_width);
- QCstyle = intern (":style");
+ QCstyle = intern_c_string (":style");
staticpro (&QCstyle);
- Qreleased_button = intern ("released-button");
+ Qreleased_button = intern_c_string ("released-button");
staticpro (&Qreleased_button);
- Qpressed_button = intern ("pressed-button");
+ Qpressed_button = intern_c_string ("pressed-button");
staticpro (&Qpressed_button);
- Qnormal = intern ("normal");
+ Qnormal = intern_c_string ("normal");
staticpro (&Qnormal);
- Qultra_light = intern ("ultra-light");
+ Qultra_light = intern_c_string ("ultra-light");
staticpro (&Qultra_light);
- Qextra_light = intern ("extra-light");
+ Qextra_light = intern_c_string ("extra-light");
staticpro (&Qextra_light);
- Qlight = intern ("light");
+ Qlight = intern_c_string ("light");
staticpro (&Qlight);
- Qsemi_light = intern ("semi-light");
+ Qsemi_light = intern_c_string ("semi-light");
staticpro (&Qsemi_light);
- Qsemi_bold = intern ("semi-bold");
+ Qsemi_bold = intern_c_string ("semi-bold");
staticpro (&Qsemi_bold);
- Qbold = intern ("bold");
+ Qbold = intern_c_string ("bold");
staticpro (&Qbold);
- Qextra_bold = intern ("extra-bold");
+ Qextra_bold = intern_c_string ("extra-bold");
staticpro (&Qextra_bold);
- Qultra_bold = intern ("ultra-bold");
+ Qultra_bold = intern_c_string ("ultra-bold");
staticpro (&Qultra_bold);
- Qoblique = intern ("oblique");
+ Qoblique = intern_c_string ("oblique");
staticpro (&Qoblique);
- Qitalic = intern ("italic");
+ Qitalic = intern_c_string ("italic");
staticpro (&Qitalic);
- Qreverse_oblique = intern ("reverse-oblique");
+ Qreverse_oblique = intern_c_string ("reverse-oblique");
staticpro (&Qreverse_oblique);
- Qreverse_italic = intern ("reverse-italic");
+ Qreverse_italic = intern_c_string ("reverse-italic");
staticpro (&Qreverse_italic);
- Qultra_condensed = intern ("ultra-condensed");
+ Qultra_condensed = intern_c_string ("ultra-condensed");
staticpro (&Qultra_condensed);
- Qextra_condensed = intern ("extra-condensed");
+ Qextra_condensed = intern_c_string ("extra-condensed");
staticpro (&Qextra_condensed);
- Qcondensed = intern ("condensed");
+ Qcondensed = intern_c_string ("condensed");
staticpro (&Qcondensed);
- Qsemi_condensed = intern ("semi-condensed");
+ Qsemi_condensed = intern_c_string ("semi-condensed");
staticpro (&Qsemi_condensed);
- Qsemi_expanded = intern ("semi-expanded");
+ Qsemi_expanded = intern_c_string ("semi-expanded");
staticpro (&Qsemi_expanded);
- Qexpanded = intern ("expanded");
+ Qexpanded = intern_c_string ("expanded");
staticpro (&Qexpanded);
- Qextra_expanded = intern ("extra-expanded");
+ Qextra_expanded = intern_c_string ("extra-expanded");
staticpro (&Qextra_expanded);
- Qultra_expanded = intern ("ultra-expanded");
+ Qultra_expanded = intern_c_string ("ultra-expanded");
staticpro (&Qultra_expanded);
- Qbackground_color = intern ("background-color");
+ Qbackground_color = intern_c_string ("background-color");
staticpro (&Qbackground_color);
- Qforeground_color = intern ("foreground-color");
+ Qforeground_color = intern_c_string ("foreground-color");
staticpro (&Qforeground_color);
- Qunspecified = intern ("unspecified");
+ Qunspecified = intern_c_string ("unspecified");
staticpro (&Qunspecified);
- Qignore_defface = intern (":ignore-defface");
+ Qignore_defface = intern_c_string (":ignore-defface");
staticpro (&Qignore_defface);
- Qface_alias = intern ("face-alias");
+ Qface_alias = intern_c_string ("face-alias");
staticpro (&Qface_alias);
- Qdefault = intern ("default");
+ Qdefault = intern_c_string ("default");
staticpro (&Qdefault);
- Qtool_bar = intern ("tool-bar");
+ Qtool_bar = intern_c_string ("tool-bar");
staticpro (&Qtool_bar);
- Qregion = intern ("region");
+ Qregion = intern_c_string ("region");
staticpro (&Qregion);
- Qfringe = intern ("fringe");
+ Qfringe = intern_c_string ("fringe");
staticpro (&Qfringe);
- Qheader_line = intern ("header-line");
+ Qheader_line = intern_c_string ("header-line");
staticpro (&Qheader_line);
- Qscroll_bar = intern ("scroll-bar");
+ Qscroll_bar = intern_c_string ("scroll-bar");
staticpro (&Qscroll_bar);
- Qmenu = intern ("menu");
+ Qmenu = intern_c_string ("menu");
staticpro (&Qmenu);
- Qcursor = intern ("cursor");
+ Qcursor = intern_c_string ("cursor");
staticpro (&Qcursor);
- Qborder = intern ("border");
+ Qborder = intern_c_string ("border");
staticpro (&Qborder);
- Qmouse = intern ("mouse");
+ Qmouse = intern_c_string ("mouse");
staticpro (&Qmouse);
- Qmode_line_inactive = intern ("mode-line-inactive");
+ Qmode_line_inactive = intern_c_string ("mode-line-inactive");
staticpro (&Qmode_line_inactive);
- Qvertical_border = intern ("vertical-border");
+ Qvertical_border = intern_c_string ("vertical-border");
staticpro (&Qvertical_border);
- Qtty_color_desc = intern ("tty-color-desc");
+ Qtty_color_desc = intern_c_string ("tty-color-desc");
staticpro (&Qtty_color_desc);
- Qtty_color_standard_values = intern ("tty-color-standard-values");
+ Qtty_color_standard_values = intern_c_string ("tty-color-standard-values");
staticpro (&Qtty_color_standard_values);
- Qtty_color_by_index = intern ("tty-color-by-index");
+ Qtty_color_by_index = intern_c_string ("tty-color-by-index");
staticpro (&Qtty_color_by_index);
- Qtty_color_alist = intern ("tty-color-alist");
+ Qtty_color_alist = intern_c_string ("tty-color-alist");
staticpro (&Qtty_color_alist);
- Qscalable_fonts_allowed = intern ("scalable-fonts-allowed");
+ Qscalable_fonts_allowed = intern_c_string ("scalable-fonts-allowed");
staticpro (&Qscalable_fonts_allowed);
Vparam_value_alist = Fcons (Fcons (Qnil, Qnil), Qnil);
#endif
defsubr (&Scolor_gray_p);
defsubr (&Scolor_supported_p);
+#ifndef HAVE_X_WINDOWS
+ defsubr (&Sx_load_color_file);
+#endif
defsubr (&Sface_attribute_relative_p);
defsubr (&Smerge_face_attribute);
defsubr (&Sinternal_get_lisp_face_attribute);
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");
+ Vface_default_stipple = make_pure_c_string ("gray3");
DEFVAR_LISP ("tty-defined-color-alist", &Vtty_defined_color_alist,
- doc: /* An alist of defined terminal colors and their RGB values. */);
+ doc: /* An alist of defined terminal colors and their RGB values.
+See the docstring of `tty-color-alist' for the details. */);
Vtty_defined_color_alist = Qnil;
DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed,
ignore. */);
Vface_ignored_fonts = Qnil;
+ DEFVAR_LISP ("face-remapping-alist", &Vface_remapping_alist,
+ doc: /* Alist of face remappings.
+Each element is of the form:
+
+ (FACE REPLACEMENT...),
+
+which causes display of the face FACE to use REPLACEMENT... instead.
+REPLACEMENT... is interpreted the same way as the value of a `face'
+text property: it may be (1) A face name, (2) A list of face names,
+(3) A property-list of face attribute/value pairs, or (4) A list of
+face names or lists containing face attribute/value pairs.
+
+Multiple entries in REPLACEMENT... are merged together to form the final
+result, with faces or attributes earlier in the list taking precedence
+over those that are later.
+
+Face-name remapping cycles are suppressed; recursive references use the
+underlying face instead of the remapped face. So a remapping of the form:
+
+ (FACE EXTRA-FACE... FACE)
+
+or:
+
+ (FACE (FACE-ATTR VAL ...) FACE)
+
+will cause EXTRA-FACE... or (FACE-ATTR VAL ...) to be _merged_ with the
+existing definition of FACE. Note that for the default face, this isn't
+necessary, as every face inherits from the default face.
+
+Making this variable buffer-local is a good way to allow buffer-specific
+face definitions. For instance, the mode my-mode could define a face
+`my-mode-default', and then in the mode setup function, do:
+
+ (set (make-local-variable 'face-remapping-alist)
+ '((default my-mode-default)))).
+
+Because Emacs normally only redraws screen areas when the underlying
+buffer contents change, you may need to call `redraw-display' after
+changing this variable for it to take effect. */);
+ Vface_remapping_alist = 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
+Each element is a cons (FONT-PATTERN . RESCALE-RATIO), where
+FONT-PATTERN is a font-spec or 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. */);
defsubr (&Sx_list_fonts);
defsubr (&Sinternal_face_x_get_resource);
defsubr (&Sx_family_fonts);
- defsubr (&Sx_font_family_list);
-#endif /* HAVE_WINDOW_SYSTEM */
+#endif
}
-/* arch-tag: 8a0f7598-5517-408d-9ab3-1da6fcd4c749
- (do not change this comment) */
HCoop / bpt / emacs.git / blobdiff