/* 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 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#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"
static GC x_create_gc P_ ((struct frame *, unsigned long, XGCValues *));
static void x_free_gc P_ ((struct frame *, GC));
-#ifdef WINDOWSNT
-extern Lisp_Object w32_list_fonts P_ ((struct frame *, Lisp_Object, int, int));
-#endif /* WINDOWSNT */
-
#ifdef USE_X_TOOLKIT
static void x_update_menu_appearance P_ ((struct frame *));
#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)
+ bcopy(xgcv, gc, sizeof(XGCValues));
return gc;
}
struct frame *f;
GC gc;
{
- eassert (interrupt_input_blocked);
- IF_DEBUG (xassert (--ngcs >= 0));
- XFreeGC (FRAME_MAC_DISPLAY (f), gc);
+ if (gc)
+ xfree (gc);
}
-
-#endif /* MAC_OS */
+#endif /* HAVE_NS */
/* Like strcasecmp/stricmp. Used to compare parts of font names which
are in ISO8859-1. */
/* 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)
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 ();
struct frame *f;
struct face *face;
{
+/* PENDING(NS): need to do something here? */
#ifdef HAVE_X_WINDOWS
if (face->colors_copied_bitwise_p)
return;
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
-
#ifdef HAVE_WINDOW_SYSTEM
-/* 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;
-}
-
static enum font_property_index font_props_for_sorting[FONT_SIZE_INDEX];
static int
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;
-{
- return Ffont_family_list (frame);
-}
-
-
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;
+
+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.
-FACE is a face name--a symbol.
The return value is a list of strings, suitable as arguments to
`set-face-font'.
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));
#endif /* HAVE_WINDOW_SYSTEM */
-
\f
/***********************************************************************
Lisp Faces
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]))
-#ifdef MAC_OS
- /* MAC_TODO: No stipple support on Mac OS yet, this index is
- always unspecified. */
- && i != LFACE_STIPPLE_INDEX
-#endif
- )
+ if ((UNSPECIFIEDP (attrs[i]) || IGNORE_DEFFACE_P (attrs[i])))
break;
return i == LFACE_VECTOR_SIZE;
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)
}
}
- /* If `font' attribute is specified, reflect the font properties in
- it to the other attributes. */
- if (0 && !UNSPECIFIEDP (to[LFACE_FONT_INDEX]))
- font_update_lface (f, to);
-
/* TO is always an absolute face, which should inherit from nothing.
We blindly copy the :inherit attribute above and fix it up here. */
to[LFACE_INHERIT_INDEX] = Qnil;
}
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;
{
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);
}
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 (STRINGP (value))
{
- int fontset = fs_query_fontset (value, 0);
+ Lisp_Object name = value;
+ int fontset = fs_query_fontset (name, 0);
if (fontset >= 0)
- value = fontset_ascii (fontset);
- value = font_spec_from_name (value);
+ 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);
signal_error ("Invalid face attribute name", attr);
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. */
- font_clear_prop (XVECTOR (lface)->contents, 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
Lisp_Object frame, lface;
{
struct frame *f = XFRAME (frame);
+ Lisp_Object font;
- if (FRAME_WINDOW_P (f))
+ 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)))
{
- Lisp_Object font = LFACE_FONT (lface);
-
if (FONT_SPEC_P (font))
{
font = font_load_for_lface (f, XVECTOR (lface)->contents, font);
}
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))
else if (! UNSPECIFIEDP (gvec[i]))
lvec[i] = gvec[i];
- /* If the default face was changed, realize it again, and update the
- `font' face parameter. */
+ /* 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];
- bcopy (oldface->lface, attrs, sizeof attrs);
- merge_face_vectors (f, lvec, attrs, 0);
- newface = realize_face (c, attrs, 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)
+ /* This can be NULL (e.g., in batch mode). */
+ if (oldface)
{
- Lisp_Object name = newface->font->props[FONT_NAME_INDEX];
- Fmodify_frame_parameters (frame, Fcons (Fcons (Qfont, name),
- Qnil));
+ /* Ensure that the face vector is fully specified by merging
+ the previously-cached vector. */
+ bcopy (oldface->lface, attrs, sizeof attrs);
+ merge_face_vectors (f, lvec, attrs, 0);
+ bcopy (attrs, lvec, 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));
+ }
}
}
if (!default_face)
abort ();
- get_lface_attributes (f, symbol, symbol_attrs, signal_p, 0);
+ 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);
return lookup_face (f, attrs);
Font selection
***********************************************************************/
- DEFUN ("internal-set-font-selection-order",
+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.
(alist)
Lisp_Object alist;
{
- Lisp_Object tail, tail2;
+ Lisp_Object entry, tail, tail2;
CHECK_LIST (alist);
alist = Fcopy_sequence (alist);
for (tail = alist; CONSP (tail); tail = XCDR (tail))
- for (tail2 = XCAR (tail); CONSP (tail2); tail2 = XCDR (tail2))
- XSETCAR (tail2, Fintern (XCAR (tail2), 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));
+ }
+
Vface_alternative_font_family_alist = alist;
free_all_realized_faces (Qnil);
return alist;
(alist)
Lisp_Object alist;
{
- Lisp_Object tail, tail2;
+ Lisp_Object entry, tail, tail2;
CHECK_LIST (alist);
alist = Fcopy_sequence (alist);
for (tail = alist; CONSP (tail); tail = XCDR (tail))
- for (tail2 = XCAR (tail); CONSP (tail2); tail2 = XCDR (tail2))
- XSETCAR (tail2, Fdowncase (XCAR (tail2)));
+ {
+ entry = XCAR (tail);
+ CHECK_LIST (entry);
+ entry = Fcopy_sequence (entry);
+ XSETCAR (tail, entry);
+ for (tail2 = entry; CONSP (tail2); tail2 = XCDR (tail2))
+ XSETCAR (tail2, Fdowncase (XCAR (tail2)));
+ }
Vface_alternative_font_registry_alist = alist;
free_all_realized_faces (Qnil);
return alist;
realizing the default face, thus the default face should have
already been realized. */
if (fontset == -1)
- fontset = default_face->fontset;
- if (fontset == -1)
- abort ();
+ {
+ 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 (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. */
return lookup_face (f, attrs);
}
+\f
+
+#ifndef HAVE_X_WINDOWS
+DEFUN ("x-load-color-file", Fx_load_color_file,
+ Sx_load_color_file, 1, 1, 0,
+ doc: /* Create an alist of color entries from an external file.
+
+The file should define one named RGB color per line like so:
+ R G B name
+where R,G,B are numbers between 0 and 255 and name is an arbitrary string. */)
+ (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 (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
#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);
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