/* 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 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 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.
+ 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
#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 "frame.h"
#include "termhooks.h"
-#ifdef HAVE_WINDOW_SYSTEM
-#include "fontset.h"
-#endif /* HAVE_WINDOW_SYSTEM */
-
#ifdef HAVE_X_WINDOWS
#include "xterm.h"
#ifdef USE_MOTIF
#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 "intervals.h"
#include "termchar.h"
-#ifdef HAVE_WINDOW_SYSTEM
#include "font.h"
-#endif /* HAVE_WINDOW_SYSTEM */
+#ifdef HAVE_WINDOW_SYSTEM
+#include "fontset.h"
+#endif /* HAVE_WINDOW_SYSTEM */
#ifdef HAVE_X_WINDOWS
Lisp_Object QCoverline, QCstrike_through, QCbox, QCinherit;
Lisp_Object QCfontset;
+/* Keywords symbols used for font properties. */
+extern Lisp_Object QCfoundry, QCadstyle, QCregistry;
+extern Lisp_Object QCspacing, QCsize, QCavgwidth;
+extern Lisp_Object Qp;
+
/* Symbols used for attribute values. */
Lisp_Object Qnormal, Qbold, Qultra_light, Qextra_light, Qlight;
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 *));
-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 **));
-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));
-static struct face *realize_non_ascii_face P_ ((struct frame *, int,
- struct face *));
-static struct face *realize_x_face P_ ((struct face_cache *, Lisp_Object *));
-static struct face *realize_tty_face P_ ((struct face_cache *, Lisp_Object *));
-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 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 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 void set_lface_from_font_and_fontset 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 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 int may_use_scalable_font_p (const char *);
+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 *, 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 */
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)
{
eassert (interrupt_input_blocked);
IF_DEBUG (xassert (--ngcs >= 0));
#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)
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;
}
struct frame *f;
GC gc;
{
- eassert (interrupt_input_blocked);
- IF_DEBUG (xassert (--ngcs >= 0));
- XFreeGC (FRAME_MAC_DISPLAY (f), gc);
+ 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))
{
+ /* 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)
- /* Is that ever possible?? --Stef */
FRAME_IMAGE_CACHE (f) = make_image_cache ();
++FRAME_IMAGE_CACHE (f)->refcount;
}
#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);
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;
-
-#ifdef USE_FONT_BACKEND
- if (! enable_font_backend)
-#endif /* USE_FONT_BACKEND */
- /* 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
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
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 ASCII
- characters. The name of the font to load is determined by lface. */
-
-static void
-load_face_font (f, face)
- struct frame *f;
- struct face *face;
-{
- struct font_info *font_info = NULL;
- char *font_name;
- int needs_overstrike;
-
-#ifdef USE_FONT_BACKEND
- if (enable_font_backend)
- abort ();
-#endif /* USE_FONT_BACKEND */
- face->font_info_id = -1;
- face->font = NULL;
- face->font_name = NULL;
-
- font_name = choose_face_font (f, face->lface, Qnil, &needs_overstrike);
- if (!font_name)
- return;
-
- BLOCK_INPUT;
- font_info = FS_LOAD_FONT (f, font_name);
- 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)
- {
- BLOCK_INPUT;
- x_free_gc (f, face->gc);
- face->gc = 0;
- UNBLOCK_INPUT;
- }
- }
- 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, char *color_name, XColor *color_def, int alloc)
{
int status = 1;
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, 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)))
{
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, char *color_name)
{
XColor color;
int gray_p;
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, 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))
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. */)
+ (family, frame)
+ Lisp_Object family, 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. */)
+ (pattern, face, frame, maximum, width)
+ Lisp_Object pattern, face, frame, maximum, 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);
-}
-
-
-/* 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;
- size_t 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
-
-#ifdef USE_FONT_BACKEND
-static INLINE Lisp_Object
-face_symbolic_value (table, dim, font_prop)
- struct table_entry *table;
- int dim;
- Lisp_Object font_prop;
-{
- struct table_entry *p;
- char *s = SDATA (SYMBOL_NAME (font_prop));
- int low, mid, high, cmp;
-
- low = 0;
- high = dim - 1;
-
- while (low <= high)
- {
- mid = (low + high) / 2;
- cmp = strcmp (table[mid].name, s);
-
- if (cmp < 0)
- low = mid + 1;
- else if (cmp > 0)
- high = mid - 1;
- else
- return *table[mid].symbol;
- }
-
- return Qnil;
-}
-
-static INLINE Lisp_Object
-face_symbolic_weight (weight)
- Lisp_Object weight;
-{
- return face_symbolic_value (weight_table, DIM (weight_table), weight);
-}
-
-static INLINE Lisp_Object
-face_symbolic_slant (slant)
- Lisp_Object slant;
-{
- return face_symbolic_value (slant_table, DIM (slant_table), slant);
-}
-
-static INLINE Lisp_Object
-face_symbolic_swidth (width)
- Lisp_Object width;
-{
- return face_symbolic_value (swidth_table, DIM (swidth_table), width);
-}
-#endif /* USE_FONT_BACKEND */
-
-Lisp_Object
-split_font_name_into_vector (fontname)
- Lisp_Object fontname;
-{
- struct font_name font;
- Lisp_Object vec;
- int i;
-
- font.name = LSTRDUPA (fontname);
- if (! split_font_name (NULL, &font, 0))
- return Qnil;
- vec = Fmake_vector (make_number (XLFD_LAST), Qnil);
- for (i = 0; i < XLFD_LAST; i++)
- if (font.fields[i][0] != '*')
- ASET (vec, i, build_string (font.fields[i]));
- return vec;
-}
-
-Lisp_Object
-build_font_name_from_vector (vec)
- Lisp_Object vec;
-{
- struct font_name font;
- Lisp_Object fontname;
- char *p;
- int i;
-
- for (i = 0; i < XLFD_LAST; i++)
- {
- font.fields[i] = (NILP (AREF (vec, i))
- ? "*" : (char *) SDATA (AREF (vec, i)));
- if ((i == XLFD_FAMILY || i == XLFD_REGISTRY)
- && (p = strchr (font.fields[i], '-')))
- {
- char *p1 = STRDUPA (font.fields[i]);
-
- p1[p - font.fields[i]] = '\0';
- if (i == XLFD_FAMILY)
- {
- font.fields[XLFD_FOUNDRY] = p1;
- font.fields[XLFD_FAMILY] = p + 1;
- }
- else
- {
- font.fields[XLFD_REGISTRY] = p1;
- font.fields[XLFD_ENCODING] = p + 1;
- break;
- }
- }
- }
-
- p = build_font_name (&font);
- fontname = build_string (p);
- xfree (p);
- return fontname;
-}
-
-/* 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.
-
- By side effect, set FONT->numeric[XLFD_PIXEL_SIZE]. */
-
-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);
-
- font->numeric[XLFD_PIXEL_SIZE] = pixel;
- 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 = eabs (resy - x_resy) - eabs (resy - y_resy);
- }
- }
-
- return cmp;
-}
-
-
-/* Get a sorted list of fonts matching PATTERN on frame F. If PATTERN
- is nil, list fonts matching FAMILY and REGISTRY. FAMILY is a
- family name string or nil. REGISTRY is a registry name string.
- 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, it is a list of registry (and encoding)
- names. Return fonts with those registries 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;
- int reg_prio;
- int i;
-
- if (NILP (registry))
- return font_list_1 (f, pattern, family, registry, fonts);
-
- for (reg_prio = 0, nfonts = 0; CONSP (registry); registry = XCDR (registry))
- {
- Lisp_Object elt, alter;
- int nfonts2;
- struct font_name *fonts2;
-
- elt = XCAR (registry);
- alter = Fassoc (elt, Vface_alternative_font_registry_alist);
- if (NILP (alter))
- alter = Fcons (elt, Qnil);
- for (; CONSP (alter); alter = XCDR (alter), reg_prio++)
- {
- nfonts2 = font_list_1 (f, pattern, family, XCAR (alter), &fonts2);
- if (nfonts2 > 0)
- {
- if (reg_prio > 0)
- for (i = 0; i < nfonts2; i++)
- fonts2[i].registry_priority = reg_prio;
- if (nfonts > 0)
- *fonts = concat_font_list (*fonts, nfonts, fonts2, nfonts2);
- else
- *fonts = 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);
+ 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))
+ if (! FRAME_WINDOW_P (f))
{
/* Perhaps we have not yet created any frame. */
f = NULL;
+ frame = Qnil;
face = Qnil;
}
: FACE_FROM_ID (f, face_id));
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);
+
+ 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;
- args[0] = x_list_fonts (f, pattern, size, maxnames);
- if (f == NULL)
+ 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
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])
-#ifdef USE_FONT_BACKEND
- || FONT_OBJECT_P (attrs[LFACE_FONT_INDEX])
-#endif /* USE_FONT_BACKEND */
- || 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;
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))
- {
- bcopy (XVECTOR (lface)->contents, attrs,
- LFACE_VECTOR_SIZE * sizeof *attrs);
- success_p = 1;
- }
- else
- success_p = 0;
- return success_p;
-}
-
-
-/* Non-zero if all attributes in face attribute vector ATTRS are
- specified, i.e. are non-nil. */
-
-static int
-lface_fully_specified_p (attrs)
- Lisp_Object *attrs;
-{
- int i;
+ lface = lface_from_face_name_no_resolve (f, face_name, signal_p);
- for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
- if (i != LFACE_FONT_INDEX && i != LFACE_INHERIT_INDEX
- && i != LFACE_AVGWIDTH_INDEX && i != LFACE_FONTSET_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
- )
- break;
+ if (! NILP (lface))
+ memcpy (attrs, XVECTOR (lface)->contents,
+ LFACE_VECTOR_SIZE * sizeof *attrs);
- return i == LFACE_VECTOR_SIZE;
+ return !NILP (lface);
}
-#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. */
+/* 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 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;
+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)
{
- 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);
+ Lisp_Object face_remapping;
- if (fontset > 0)
- font_name = SDATA (fontset_ascii (fontset));
- else if (fontset == 0)
- {
- if (may_fail_p)
- return 0;
- abort ();
- }
-
- /* 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, font_name);
- UNBLOCK_INPUT;
+ face_name = resolve_face_name (face_name, signal_p);
- if (!font_info)
+ /* 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))
{
- if (may_fail_p)
- return 0;
- abort ();
- }
+ struct named_merge_point named_merge_point;
- font.name = STRDUPA (font_info->full_name);
- have_xlfd_p = split_font_name (f, &font, 1);
+ if (push_named_merge_point (&named_merge_point,
+ face_name, NAMED_MERGE_POINT_REMAP,
+ &named_merge_points))
+ {
+ int i;
- /* 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. */
+ for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
+ attrs[i] = Qunspecified;
- 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);
+ return merge_face_ref (f, XCDR (face_remapping), attrs,
+ signal_p, named_merge_points);
}
- else
- val = build_string ("*");
- LFACE_FAMILY (lface) = val;
}
- 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);
- xassert (pt > 0);
- LFACE_HEIGHT (lface) = make_number (pt);
- }
+ /* Default case, no remapping. */
+ return get_lface_attributes_no_remap (f, face_name, attrs, signal_p);
+}
- 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);
+/* Non-zero if all attributes in face attribute vector ATTRS are
+ specified, i.e. are non-nil. */
- if (force_p || UNSPECIFIEDP (LFACE_WEIGHT (lface)))
- LFACE_WEIGHT (lface)
- = have_xlfd_p ? xlfd_symbolic_weight (&font) : Qnormal;
+static int
+lface_fully_specified_p (Lisp_Object *attrs)
+{
+ int i;
- if (force_p || UNSPECIFIEDP (LFACE_SLANT (lface)))
- LFACE_SLANT (lface)
- = have_xlfd_p ? xlfd_symbolic_slant (&font) : Qnormal;
+ for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
+ if (i != LFACE_FONT_INDEX && i != LFACE_INHERIT_INDEX)
+ if ((UNSPECIFIEDP (attrs[i]) || IGNORE_DEFFACE_P (attrs[i])))
+ break;
- if (fontset > 0)
- {
- LFACE_FONT (lface) = build_string (font_info->full_name);
- LFACE_FONTSET (lface) = fontset_name (fontset);
- }
- else
- {
- LFACE_FONT (lface) = fontname;
- fontset
- = new_fontset_from_font_name (build_string (font_info->full_name));
- LFACE_FONTSET (lface) = fontset_name (fontset);
- }
- return 1;
+ return i == LFACE_VECTOR_SIZE;
}
-#ifdef USE_FONT_BACKEND
-/* Set font-related attributes of Lisp face LFACE from FONT-OBJECT and
- FONTSET. If FORCE_P is zero, set only unspecified attributes of
- LFACE. The exceptions are `font' and `fontset' attributes. They
- are set regardless of FORCE_P. */
+#ifdef HAVE_WINDOW_SYSTEM
+
+/* 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 void
-set_lface_from_font_and_fontset (f, lface, font_object, fontset, force_p)
- struct frame *f;
- Lisp_Object lface, font_object;
- int fontset;
- int force_p;
+static int
+set_lface_from_font (struct frame *f, Lisp_Object lface, Lisp_Object font_object, int force_p)
{
- struct font *font = XSAVE_VALUE (font_object)->pointer;
- Lisp_Object entity = font->entity;
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 the font doesn't have a
if (force_p || UNSPECIFIEDP (LFACE_FAMILY (lface)))
{
- Lisp_Object foundry = AREF (entity, FONT_FOUNDRY_INDEX);
- Lisp_Object family = AREF (entity, FONT_FAMILY_INDEX);
+ Lisp_Object family = AREF (font_object, FONT_FAMILY_INDEX);
- if (! NILP (foundry))
- {
- if (! NILP (family))
- val = concat3 (SYMBOL_NAME (foundry), build_string ("-"),
- SYMBOL_NAME (family));
- else
- val = concat2 (SYMBOL_NAME (foundry), build_string ("-*"));
- }
- else
- {
- if (! NILP (family))
- val = SYMBOL_NAME (family);
- else
- val = build_string ("*");
- }
- LFACE_FAMILY (lface) = val;
+ 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)))
{
- int pt = pixel_point_size (f, font->pixel_size * 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_AVGWIDTH (lface)))
- LFACE_AVGWIDTH (lface) = make_number (font->font.average_width);
-
if (force_p || UNSPECIFIEDP (LFACE_WEIGHT (lface)))
{
- Lisp_Object weight = font_symbolic_weight (entity);
-
- val = NILP (weight) ? Qnormal : face_symbolic_weight (weight);
- LFACE_WEIGHT (lface) = ! NILP (val) ? val : weight;
+ val = FONT_WEIGHT_FOR_FACE (font_object);
+ LFACE_WEIGHT (lface) = ! NILP (val) ? val :Qnormal;
}
if (force_p || UNSPECIFIEDP (LFACE_SLANT (lface)))
{
- Lisp_Object slant = font_symbolic_slant (entity);
-
- val = NILP (slant) ? Qnormal : face_symbolic_slant (slant);
- LFACE_SLANT (lface) = ! NILP (val) ? val : slant;
+ val = FONT_SLANT_FOR_FACE (font_object);
+ LFACE_SLANT (lface) = ! NILP (val) ? val : Qnormal;
}
if (force_p || UNSPECIFIEDP (LFACE_SWIDTH (lface)))
{
- Lisp_Object width = font_symbolic_width (entity);
-
- val = NILP (width) ? Qnormal : face_symbolic_swidth (width);
- LFACE_SWIDTH (lface) = ! NILP (val) ? val : width;
+ val = FONT_WIDTH_FOR_FACE (font_object);
+ LFACE_SWIDTH (lface) = ! NILP (val) ? val : Qnormal;
}
- LFACE_FONT (lface) = make_unibyte_string (font->font.full_name,
- strlen (font->font.full_name));
- LFACE_FONTSET (lface) = fontset_name (fontset);
+ LFACE_FONT (lface) = font_object;
+ return 1;
}
-#endif /* USE_FONT_BACKEND */
#endif /* HAVE_WINDOW_SYSTEM */
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;
}
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. */)
If FRAME is t, copy the global face definition of FROM.
Otherwise, copy the frame-local definition of FROM on FRAME.
If NEW-FRAME is a frame, copy that data into the frame-local
-definition of TO on NEW-FRAME. If NEW-FRAME is nil.
+definition of TO on NEW-FRAME. If NEW-FRAME is nil,
FRAME controls where the data is copied to.
The value is TO. */)
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
{
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) || EQ (attr, QCfontset))
+ 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);
-
-#ifdef USE_FONT_BACKEND
- if (enable_font_backend
- && !UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value))
+ if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value))
{
- tmp = Fquery_fontset (value, Qnil);
- if (EQ (attr, QCfontset))
+ FRAME_PTR f;
+
+ old_value = LFACE_FONT (lface);
+ if (! FONTP (value))
{
- if (NILP (tmp))
- signal_error ("Invalid fontset name", value);
- LFACE_FONTSET (lface) = tmp;
+ 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))
{
- int fontset;
+ Lisp_Object *attrs = XVECTOR (lface)->contents;
Lisp_Object font_object;
- if (! NILP (tmp))
- {
- fontset = fs_query_fontset (tmp, 0);
- value = fontset_ascii (fontset);
- }
- else
- {
- fontset = FRAME_FONTSET (f);
- }
- font_object = font_open_by_name (f, SDATA (value));
+ font_object = font_load_for_lface (f, attrs, value);
if (NILP (font_object))
- signal_error ("Invalid font", value);
- set_lface_from_font_and_fontset (f, lface, font_object,
- fontset, 1);
+ signal_error ("Font not available", value);
+ value = font_object;
}
+ set_lface_from_font (f, lface, value, 1);
}
else
-#endif /* USE_FONT_BACKEND */
- if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value))
- {
- CHECK_STRING (value);
-
- /* VALUE may be a fontset name or an alias of fontset. In
- such a case, use the base fontset name. */
- tmp = Fquery_fontset (value, Qnil);
- if (!NILP (tmp))
- value = tmp;
- else if (EQ (attr, QCfontset))
- signal_error ("Invalid fontset name", value);
-
- if (EQ (attr, QCfont))
- {
- if (!set_lface_from_font_name (f, lface, value, 1, 1))
- signal_error ("Invalid font or fontset name", value);
- }
- else
- LFACE_FONTSET (lface) = value;
- }
+ 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)
- || EQ (attr, QCfontset)
- || 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 font 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);
-#ifdef USE_FONT_BACKEND
- else if (enable_font_backend)
- {
- /* We set FONT_NAME to a font-object. */
- if (FONT_OBJECT_P (LFACE_FONT (lface)))
- font_name = LFACE_FONT (lface);
- else
- {
- font_name = font_find_for_lface (f, &AREF (lface, 0), Qnil, -1);
- if (NILP (font_name))
- error ("No font matches the specified attribute");
- font_name = font_open_for_lface (f, font_name, &AREF (lface, 0),
- Qnil);
- if (NILP (font_name))
- error ("No font matches the specified attribute");
- }
- }
-#endif
- 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, Qnil, NULL);
- 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. */
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);
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))
{
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);
+ extern char *xic_create_fontsetname
+ (char *base_fontname, Bool 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)
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))
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));
{
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;
}
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_name
- ? build_string (face->font_name)
- : Qnil);
}
+ 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
- return build_string (face->font_name);
}
}
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;
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])
^ XHASH (v[LFACE_WEIGHT_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, font, and fontset. Both
+ 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])
- && ! xstricmp (SDATA (lface1[LFACE_FONTSET_INDEX]),
- SDATA (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;
}
be null. */
void
-free_realized_face (f, face)
- struct frame *f;
- struct face *face;
+free_realized_face (struct frame *f, struct face *face)
{
if (face)
{
if (face->gc)
{
BLOCK_INPUT;
-#ifdef USE_FONT_BACKEND
- if (enable_font_backend && face->font_info)
+ if (face->font)
font_done_for_face (f, face);
-#endif /* USE_FONT_BACKEND */
x_free_gc (f, face->gc);
face->gc = 0;
UNBLOCK_INPUT;
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
-#ifdef USE_FONT_BACKEND
- if (enable_font_backend)
- xgcv.font = FRAME_X_DISPLAY_INFO (f)->font->fid;
- else
-#endif
- 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);
-#ifdef USE_FONT_BACKEND
- if (enable_font_backend && face->font)
+ if (face->font)
font_prepare_for_face (f, face);
-#endif /* USE_FONT_BACKEND */
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:
/* 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))
{
if (face && face->gc)
{
BLOCK_INPUT;
-#ifdef USE_FONT_BACKEND
- if (enable_font_backend && face->font_info)
+ if (face->font)
font_done_for_face (c->f, face);
-#endif /* USE_FONT_BACKEND */
x_free_gc (c->f, face->gc);
face->gc = 0;
UNBLOCK_INPUT;
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 realized faces that are using FONTSET on frame F. */
void
-free_realized_faces_for_fontset (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;
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)
{
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;
/* 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;
realize a new one. */
INLINE int
-lookup_face (f, attr)
- struct frame *f;
- Lisp_Object *attr;
+lookup_face (struct frame *f, Lisp_Object *attr)
{
struct face_cache *cache = FRAME_FACE_CACHE (f);
unsigned hash;
#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_ID is
- not negative, it is an ID number of an already opened font that is
- used by the face. If FONT_ID is negative, the face has no font.
- Value is the ID of the face found. If no suitable face is found,
- realize a new one. */
-
-int
-lookup_non_ascii_face (f, font_id, base_face)
- struct frame *f;
- int font_id;
- 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;
-
- for (face = cache->buckets[i]; face; face = face->next)
- {
- if (face->ascii_face == face)
- continue;
- if (face->ascii_face == base_face
- && face->font_info_id == font_id)
- break;
- }
-
- /* If not found, realize a new face. */
- if (face == NULL)
- face = realize_non_ascii_face (f, font_id, base_face);
-
-#if GLYPH_DEBUG
- xassert (face == FACE_FROM_ID (f, face->id));
-#endif /* GLYPH_DEBUG */
-
- return face->id;
-}
+ 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. */
-#ifdef USE_FONT_BACKEND
int
-face_for_font (f, font, base_face)
- struct frame *f;
- struct font *font;
- struct face *base_face;
+face_for_font (struct frame *f, Lisp_Object font_object, struct face *base_face)
{
struct face_cache *cache = FRAME_FACE_CACHE (f);
unsigned hash;
if (face->ascii_face == face)
continue;
if (face->ascii_face == base_face
- && face->font == font->font.font
- && face->font_info == (struct font_info *) font)
+ && 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, -1, base_face);
- face->font = font->font.font;
- face->font_info = (struct font_info *) font;
- face->font_info_id = 0;
- face->font_name = font->font.full_name;
+ face = realize_non_ascii_face (f, font_object, base_face);
return face->id;
}
-#endif /* USE_FONT_BACKEND */
-
#endif /* HAVE_WINDOW_SYSTEM */
/* Return the face id of the realized face for named face SYMBOL on
face isn't realized and cannot be realized. */
int
-lookup_named_face (f, symbol, signal_p)
- struct frame *f;
- Lisp_Object symbol;
- 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);
- merge_face_vectors (f, symbol_attrs, attrs, 0);
+ memcpy (attrs, default_face->lface, sizeof attrs);
+ merge_face_vectors (f, symbol_attrs, attrs, 0);
+
+ 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 lookup_face (f, attrs);
+ 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;
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;
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);
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);
+ font_clear_prop (attrs, FONT_SIZE_INDEX);
face_id = lookup_face (f, attrs);
#endif /* HAVE_WINDOW_SYSTEM */
default face. FACE_ID is assumed to be already realized. */
int
-lookup_derived_face (f, symbol, face_id, signal_p)
- struct frame *f;
- Lisp_Object symbol;
- 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);
}
\(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);
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 */
}
}
}
- 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);
- }
-
-#ifdef USE_FONT_BACKEND
- if (enable_font_backend)
- font_update_sort_order (font_sort_order);
-#endif /* USE_FONT_BACKEND */
-
- 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 = eabs (values[i] - (font1->numeric[xlfd_idx]
- / font1->rescale_ratio));
- delta2 = eabs (values[i] - (font2->numeric[xlfd_idx]
- / font2->rescale_ratio));
- if (eabs (delta1 - delta2) < FONT_POINT_SIZE_QUANTUM)
- continue;
- }
- else
- {
- delta1 = eabs (values[i] - font1->numeric[xlfd_idx]);
- delta2 = eabs (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 = eabs (avgwidth - font1->numeric[XLFD_AVGWIDTH]);
- int delta2 = eabs (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 (font->numeric[XLFD_PIXEL_SIZE] != 0
- || font->numeric[XLFD_POINT_SIZE] != 0)
- /* This is a scalable font but is requested for a specific size.
- We should not change that size. */
- return build_font_name (font);
-
- /* 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;
- }
- }
-
- 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.
-
- If NEEDS_OVERSTRIKE is non-zero, a boolean is returned in it to
- indicate whether the resulting font should be drawn using overstrike
- to simulate bold-face. */
-
-static char *
-best_matching_font (f, attrs, fonts, nfonts, width_ratio, 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)
- {
- 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 ();
- }
-
- avgwidth = (UNSPECIFIEDP (attrs[LFACE_AVGWIDTH_INDEX])
- ? 0
- : XFASTINT (attrs[LFACE_AVGWIDTH_INDEX]) * width_ratio);
-
- exact_p = 0;
+ CHECK_LIVE_FRAME (frame);
+ f = XFRAME (frame);
- if (needs_overstrike)
- *needs_overstrike = 0;
+ for (i = 0; i < LFACE_VECTOR_SIZE; i++)
+ attrs[i] = Qunspecified;
+ merge_face_ref (f, attributes, attrs, 1, 0);
- best = NULL;
+ 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 */
+ }
- /* 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;
+ /* 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
- exact_p = exact_face_match_p (specified, best, avgwidth);
- if (exact_p)
- break;
- }
+ return supports ? Qt : Qnil;
+}
- /* Unless we found an exact match among non-scalable fonts, see if
- we can find a better match among scalable fonts. */
- if (!exact_p)
- {
- /* A scalable font is better if
+\f
+/***********************************************************************
+ Font selection
+ ***********************************************************************/
- 1. its weight, slant, swidth attributes are better, or.
+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)];
- 2. the best non-scalable font doesn't have the required
- point size, and the scalable fonts weight, slant, swidth
- isn't worse. */
+ CHECK_LIST (order);
+ memset (indices, 0, sizeof indices);
+ i = 0;
- int non_scalable_has_exact_height_p;
+ for (list = order;
+ CONSP (list) && i < DIM (indices);
+ list = XCDR (list), ++i)
+ {
+ 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. */)
+ (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.
- PATTERN, if a string, specifies a font name pattern to match while
- ignoring FAMILY and REGISTRY.
-
- FAMILY, if a list, specifies a list of font families to try.
-
- REGISTRY, if a list, specifies a list of font registries and
- encodinging to try.
+ Vface_alternative_font_family_alist = alist;
+ free_all_realized_faces (Qnil);
+ return alist;
+}
- 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, pattern, family, registry, fonts)
- struct frame *f;
- Lisp_Object pattern, family, registry;
- struct font_name **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. */)
+ (alist)
+ Lisp_Object alist;
{
- int nfonts = 0;
+ Lisp_Object entry, tail, tail2;
- if (STRINGP (pattern))
+ CHECK_LIST (alist);
+ alist = Fcopy_sequence (alist);
+ for (tail = alist; CONSP (tail); tail = XCDR (tail))
{
- nfonts = font_list (f, pattern, Qnil, Qnil, fonts);
- if (nfonts == 0 && ! EQ (Vscalable_fonts_allowed, Qt))
- {
- int count = SPECPDL_INDEX ();
- specbind (Qscalable_fonts_allowed, Qt);
- nfonts = font_list (f, pattern, Qnil, Qnil, 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, Fdowncase (XCAR (tail2)));
}
- else
- {
- Lisp_Object tail;
-
- if (NILP (family))
- nfonts = font_list (f, Qnil, Qnil, registry, fonts);
- else
- for (tail = family; ! nfonts && CONSP (tail); tail = XCDR (tail))
- nfonts = try_alternative_families (f, XCAR (tail), registry, fonts);
+ Vface_alternative_font_registry_alist = alist;
+ free_all_realized_faces (Qnil);
+ return alist;
+}
- /* Try font family of the default face or "fixed". */
- if (nfonts == 0 && !NILP (family))
- {
- 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 = try_alternative_families (f, family, registry, fonts);
- }
- /* Try any family with the given registry. */
- if (nfonts == 0 && !NILP (family))
- nfonts = try_alternative_families (f, Qnil, registry, fonts);
- }
+#ifdef HAVE_WINDOW_SYSTEM
- return nfonts;
-}
+/* 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;
return fs_query_fontset (name, 0);
}
-
-/* Choose a name of font to use on frame F to display characters with
- Lisp face attributes specified by ATTRS. The font name is
- determined by the font-related attributes in ATTRS and FONT-SPEC
- (if specified).
-
- When we are choosing a font for ASCII characters, FONT-SPEC is
- always nil. Otherwise FONT-SPEC is an object created by
- `font-spec' or a string specifying a font name pattern.
-
- If NEEDS_OVERSTRIKE is not NULL, a boolean is returned in it to
- indicate whether the resulting font should be drawn using
- overstrike to simulate bold-face.
-
- Value is the font name which is allocated from the heap and must be
- freed by the caller. */
-
-char *
-choose_face_font (f, attrs, font_spec, needs_overstrike)
- struct frame *f;
- Lisp_Object *attrs;
- Lisp_Object font_spec;
- int *needs_overstrike;
-{
- Lisp_Object pattern, family, adstyle, registry;
- char *font_name = NULL;
- struct font_name *fonts;
- int nfonts;
-
- if (needs_overstrike)
- *needs_overstrike = 0;
-
- /* If we are choosing an ASCII font and a font name is explicitly
- specified in ATTRS, return it. */
- if (NILP (font_spec) && STRINGP (attrs[LFACE_FONT_INDEX]))
- return xstrdup (SDATA (attrs[LFACE_FONT_INDEX]));
-
- if (NILP (attrs[LFACE_FAMILY_INDEX]))
- family = Qnil;
- else
- family = Fcons (attrs[LFACE_FAMILY_INDEX], Qnil);
-
- /* Decide FAMILY, ADSTYLE, and REGISTRY from FONT_SPEC. But,
- ADSTYLE is not used in the font selector for the moment. */
- if (VECTORP (font_spec))
- {
- pattern = Qnil;
- if (! NILP (AREF (font_spec, FONT_FAMILY_INDEX)))
- family = Fcons (SYMBOL_NAME (AREF (font_spec, FONT_FAMILY_INDEX)),
- family);
- adstyle = AREF (font_spec, FONT_ADSTYLE_INDEX);
- registry = Fcons (SYMBOL_NAME (AREF (font_spec, FONT_REGISTRY_INDEX)),
- Qnil);
- }
- else if (STRINGP (font_spec))
- {
- pattern = font_spec;
- family = Qnil;
- adstyle = Qnil;
- registry = Qnil;
- }
- else
- {
- /* We are choosing an ASCII font. By default, use the registry
- name "iso8859-1". But, if the registry name of the ASCII
- font specified in the fontset of ATTRS is not "iso8859-1"
- (e.g "iso10646-1"), use also that name with higher
- priority. */
- int fontset = face_fontset (attrs);
- Lisp_Object ascii;
- int len;
- struct font_name font;
-
- pattern = Qnil;
- adstyle = Qnil;
- registry = Fcons (build_string ("iso8859-1"), Qnil);
-
- ascii = fontset_ascii (fontset);
- len = SBYTES (ascii);
- if (len < 9
- || strcmp (SDATA (ascii) + len - 9, "iso8859-1"))
- {
- font.name = LSTRDUPA (ascii);
- /* Check if the name is in XLFD. */
- if (split_font_name (f, &font, 0))
- {
- font.fields[XLFD_ENCODING][-1] = '-';
- registry = Fcons (build_string (font.fields[XLFD_REGISTRY]),
- registry);
- }
- }
- }
-
- /* 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, pattern, family, registry, &fonts);
- font_name = best_matching_font (f, attrs, fonts, nfonts, NILP (font_spec),
- 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 ();
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))
{
-#ifdef USE_FONT_BACKEND
- if (enable_font_backend)
- {
- frame_font = font_find_object (FRAME_FONT_OBJECT (f));
- xassert (FONT_OBJECT_P (frame_font));
- set_lface_from_font_and_fontset (f, lface, frame_font,
- FRAME_FONTSET (f),
- f->default_face_done_p);
- }
- else
- {
-#endif /* USE_FONT_BACKEND */
- /* 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);
-#ifdef USE_FONT_BACKEND
- }
-#endif /* USE_FONT_BACKEND */
+ 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)))
/* 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);
+ memcpy (attrs, XVECTOR (lface)->contents, sizeof attrs);
face = realize_face (c, attrs, DEFAULT_FACE_ID);
#ifdef HAVE_WINDOW_SYSTEM
not support the default font. */
if (!face->font)
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);
+ 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. */
face. Value is a pointer to the newly created realized face. */
static struct face *
-realize_face (cache, attrs, former_face_id)
- struct face_cache *cache;
- Lisp_Object *attrs;
- int former_face_id;
+realize_face (struct face_cache *cache, Lisp_Object *attrs, int former_face_id)
{
struct face *face;
#ifdef HAVE_WINDOW_SYSTEM
-/* Realize the fully-specified face that has the same attributes as
- BASE_FACE except for the font on frame F. If FONT_ID is not
- negative, it is an ID number of an already opened font that should
- be used by the face. If FONT_ID is negative, the face has no font,
- i.e., characters are displayed by empty boxes. */
+/* 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 (f, font_id, base_face)
- struct frame *f;
- int font_id;
- struct face *base_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;
- struct font_info *font_info;
face = (struct face *) xmalloc (sizeof *face);
*face = *base_face;
face->gc = 0;
-#ifdef USE_FONT_BACKEND
face->extra = NULL;
-#endif /* USE_FONT_BACKEND */
+ 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_info_id = font_id;
- if (font_id >= 0)
- {
- font_info = FONT_INFO_FROM_ID (f, font_id);
- face->font = font_info->font;
- face->font_name = font_info->full_name;
- }
- else
- {
- face->font = NULL;
- face->font_name = NULL;
- }
-
+ face->font = NILP (font_object) ? NULL : XFONT_OBJECT (font_object);
face->gc = 0;
cache_face (cache, face, face->hash);
created realized face. */
static struct face *
-realize_x_face (cache, attrs)
- struct face_cache *cache;
- Lisp_Object *attrs;
+realize_x_face (struct face_cache *cache, Lisp_Object *attrs)
{
struct face *face = NULL;
#ifdef HAVE_WINDOW_SYSTEM
&& lface_same_font_attributes_p (default_face->lface, attrs))
{
face->font = default_face->font;
- face->font_info_id = default_face->font_info_id;
-#ifdef USE_FONT_BACKEND
- if (enable_font_backend)
- face->font_info = default_face->font_info;
-#endif /* USE_FONT_BACKEND */
- face->font_name = default_face->font_name;
face->fontset
= make_fontset_for_ascii_face (f, default_face->fontset, face);
}
realizing the default face, thus the default face should have
already been realized. */
if (fontset == -1)
- fontset = default_face->fontset;
- if (fontset == -1)
- abort ();
-#ifdef USE_FONT_BACKEND
- if (enable_font_backend)
- font_load_for_face (f, face);
- else
-#endif /* USE_FONT_BACKEND */
- load_face_font (f, face);
- if (face->font)
- face->fontset = make_fontset_for_ascii_face (f, fontset, face);
+ {
+ 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->fontset = -1;
+ {
+ 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);
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;
Value is a pointer to the newly created realized face. */
static struct face *
-realize_tty_face (cache, attrs)
- struct face_cache *cache;
- Lisp_Object *attrs;
+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;
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;
{
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);
}
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)
+ endptr, limit, mouse, base_face_id)
struct window *w;
EMACS_INT pos;
EMACS_INT region_beg, 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];
*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))
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))
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))
*/
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, 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))
{
}
\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. */)
+ (filename)
+ 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
/***********************************************************************
Tests
***********************************************************************/
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,
***********************************************************************/
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);
- QCfontset = intern (":fontset");
+ QCfontset = intern_c_string (":fontset");
staticpro (&QCfontset);
- QCbold = intern (":bold");
+ 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. */);
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 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. 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)))). */);
+ 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
HCoop / bpt / emacs.git / blobdiff