finalose (void *ptr)
{
Lisp_Object obj;
- XSETOBJ (obj, Lisp_Type_Record, ptr);
+ XSETOBJ (obj, ptr);
signal_simple_error
("Can't dump an emacs containing window system objects", obj);
Lisp_Object Qcolor_instancep;
static Lisp_Object
-mark_color_instance (Lisp_Object obj, void (*markobj) (Lisp_Object))
+mark_color_instance (Lisp_Object obj)
{
- struct Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj);
- markobj (c->name);
+ Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj);
+ mark_object (c->name);
if (!NILP (c->device)) /* Vthe_null_color_instance */
- MAYBE_DEVMETH (XDEVICE (c->device), mark_color_instance, (c, markobj));
+ MAYBE_DEVMETH (XDEVICE (c->device), mark_color_instance, (c));
return c->device;
}
int escapeflag)
{
char buf[100];
- struct Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj);
+ Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj);
if (print_readably)
error ("printing unreadable object #<color-instance 0x%x>",
c->header.uid);
static void
finalize_color_instance (void *header, int for_disksave)
{
- struct Lisp_Color_Instance *c = (struct Lisp_Color_Instance *) header;
+ Lisp_Color_Instance *c = (Lisp_Color_Instance *) header;
if (!NILP (c->device))
{
static int
color_instance_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
{
- struct Lisp_Color_Instance *c1 = XCOLOR_INSTANCE (obj1);
- struct Lisp_Color_Instance *c2 = XCOLOR_INSTANCE (obj2);
+ Lisp_Color_Instance *c1 = XCOLOR_INSTANCE (obj1);
+ Lisp_Color_Instance *c2 = XCOLOR_INSTANCE (obj2);
return (c1 == c2) ||
- ((EQ (c1->device, c2->device)) &&
+ (EQ (c1->device, c2->device) &&
DEVICEP (c1->device) &&
HAS_DEVMETH_P (XDEVICE (c1->device), color_instance_equal) &&
DEVMETH (XDEVICE (c1->device), color_instance_equal, (c1, c2, depth)));
static unsigned long
color_instance_hash (Lisp_Object obj, int depth)
{
- struct Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj);
+ Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj);
struct device *d = DEVICEP (c->device) ? XDEVICE (c->device) : 0;
return HASH2 ((unsigned long) d,
DEFINE_LRECORD_IMPLEMENTATION ("color-instance", color_instance,
mark_color_instance, print_color_instance,
finalize_color_instance, color_instance_equal,
- color_instance_hash,
- struct Lisp_Color_Instance);
+ color_instance_hash, 0,
+ Lisp_Color_Instance);
\f
DEFUN ("make-color-instance", Fmake_color_instance, 1, 3, 0, /*
Return a new `color-instance' object named NAME (a string).
and defaults to the selected device.
An error is signaled if the color is unknown or cannot be allocated;
-however, if optional argument NO-ERROR is non-nil, nil is simply
-returned in this case. (And if NO-ERROR is other than t, a warning may
+however, if optional argument NOERROR is non-nil, nil is simply
+returned in this case. (And if NOERROR is other than t, a warning may
be issued.)
The returned object is a normal, first-class lisp object. The way you
these objects are GCed, the underlying window-system data (e.g. X object)
is deallocated as well.
*/
- (name, device, no_error))
+ (name, device, noerror))
{
- struct Lisp_Color_Instance *c;
+ Lisp_Color_Instance *c;
Lisp_Object val;
int retval;
CHECK_STRING (name);
XSETDEVICE (device, decode_device (device));
- c = alloc_lcrecord_type (struct Lisp_Color_Instance, lrecord_color_instance);
+ c = alloc_lcrecord_type (Lisp_Color_Instance, &lrecord_color_instance);
c->name = name;
c->device = device;
c->data = 0;
retval = MAYBE_INT_DEVMETH (XDEVICE (device), initialize_color_instance,
(c, name, device,
- decode_error_behavior_flag (no_error)));
+ decode_error_behavior_flag (noerror)));
if (!retval)
return Qnil;
*/
(color_instance))
{
- struct Lisp_Color_Instance *c;
+ Lisp_Color_Instance *c;
CHECK_COLOR_INSTANCE (color_instance);
c = XCOLOR_INSTANCE (color_instance);
Error_behavior errb);
static Lisp_Object
-mark_font_instance (Lisp_Object obj, void (*markobj) (Lisp_Object))
+mark_font_instance (Lisp_Object obj)
{
- struct Lisp_Font_Instance *f = XFONT_INSTANCE (obj);
+ Lisp_Font_Instance *f = XFONT_INSTANCE (obj);
- markobj (f->name);
+ mark_object (f->name);
if (!NILP (f->device)) /* Vthe_null_font_instance */
- MAYBE_DEVMETH (XDEVICE (f->device), mark_font_instance, (f, markobj));
+ MAYBE_DEVMETH (XDEVICE (f->device), mark_font_instance, (f));
return f->device;
}
print_font_instance (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
{
char buf[200];
- struct Lisp_Font_Instance *f = XFONT_INSTANCE (obj);
+ Lisp_Font_Instance *f = XFONT_INSTANCE (obj);
if (print_readably)
error ("printing unreadable object #<font-instance 0x%x>", f->header.uid);
write_c_string ("#<font-instance ", printcharfun);
print_internal (f->name, printcharfun, 1);
write_c_string (" on ", printcharfun);
print_internal (f->device, printcharfun, 0);
- MAYBE_DEVMETH (XDEVICE (f->device), print_font_instance,
- (f, printcharfun, escapeflag));
+ if (!NILP (f->device))
+ MAYBE_DEVMETH (XDEVICE (f->device), print_font_instance,
+ (f, printcharfun, escapeflag));
sprintf (buf, " 0x%x>", f->header.uid);
write_c_string (buf, printcharfun);
}
static void
finalize_font_instance (void *header, int for_disksave)
{
- struct Lisp_Font_Instance *f = (struct Lisp_Font_Instance *) header;
+ Lisp_Font_Instance *f = (Lisp_Font_Instance *) header;
if (!NILP (f->device))
{
DEFINE_LRECORD_IMPLEMENTATION ("font-instance", font_instance,
mark_font_instance, print_font_instance,
finalize_font_instance, font_instance_equal,
- font_instance_hash, struct Lisp_Font_Instance);
+ font_instance_hash, 0, Lisp_Font_Instance);
\f
DEFUN ("make-font-instance", Fmake_font_instance, 1, 3, 0, /*
Return a new `font-instance' object named NAME.
you drop all pointers to it and allow it to be garbage collected. When
these objects are GCed, the underlying X data is deallocated as well.
*/
- (name, device, no_error))
+ (name, device, noerror))
{
- struct Lisp_Font_Instance *f;
+ Lisp_Font_Instance *f;
Lisp_Object val;
int retval = 0;
- Error_behavior errb = decode_error_behavior_flag (no_error);
+ Error_behavior errb = decode_error_behavior_flag (noerror);
if (ERRB_EQ (errb, ERROR_ME))
CHECK_STRING (name);
XSETDEVICE (device, decode_device (device));
- f = alloc_lcrecord_type (struct Lisp_Font_Instance, lrecord_font_instance);
+ f = alloc_lcrecord_type (Lisp_Font_Instance, &lrecord_font_instance);
f->name = name;
f->device = device;
font_instance_truename_internal (Lisp_Object font_instance,
Error_behavior errb)
{
- struct Lisp_Font_Instance *f = XFONT_INSTANCE (font_instance);
- struct device *d = XDEVICE (f->device);
- return DEVMETH_OR_GIVEN (d, font_instance_truename, (f, errb), f->name);
+ Lisp_Font_Instance *f = XFONT_INSTANCE (font_instance);
+
+ if (NILP (f->device))
+ {
+ maybe_signal_simple_error ("Couldn't determine font truename",
+ font_instance, Qfont, errb);
+ return Qnil;
+ }
+
+ return DEVMETH_OR_GIVEN (XDEVICE (f->device),
+ font_instance_truename, (f, errb), f->name);
}
DEFUN ("font-instance-truename", Ffont_instance_truename, 1, 1, 0, /*
*/
(font_instance))
{
- struct Lisp_Font_Instance *f;
+ Lisp_Font_Instance *f;
CHECK_FONT_INSTANCE (font_instance);
f = XFONT_INSTANCE (font_instance);
+ if (NILP (f->device))
+ return Qnil;
+
return MAYBE_LISP_DEVMETH (XDEVICE (f->device),
font_instance_properties, (f));
}
static void
color_create (Lisp_Object obj)
{
- struct Lisp_Specifier *color = XCOLOR_SPECIFIER (obj);
+ Lisp_Specifier *color = XCOLOR_SPECIFIER (obj);
COLOR_SPECIFIER_FACE (color) = Qnil;
COLOR_SPECIFIER_FACE_PROPERTY (color) = Qnil;
}
static void
-color_mark (Lisp_Object obj, void (*markobj) (Lisp_Object))
+color_mark (Lisp_Object obj)
{
- struct Lisp_Specifier *color = XCOLOR_SPECIFIER (obj);
+ Lisp_Specifier *color = XCOLOR_SPECIFIER (obj);
- markobj (COLOR_SPECIFIER_FACE (color));
- markobj (COLOR_SPECIFIER_FACE_PROPERTY (color));
+ mark_object (COLOR_SPECIFIER_FACE (color));
+ mark_object (COLOR_SPECIFIER_FACE_PROPERTY (color));
}
/* No equal or hash methods; ignore the face the color is based off
{
/* When called, we're inside of call_with_suspended_errors(),
so we can freely error. */
- Lisp_Object device = DFW_DEVICE (domain);
+ Lisp_Object device = DOMAIN_DEVICE (domain);
struct device *d = XDEVICE (device);
if (COLOR_INSTANCEP (instantiator))
XVECTOR_DATA (instantiator)[1], domain, ERROR_ME, 0, depth));
default:
- abort ();
+ ABORT ();
}
}
else if (NILP (instantiator))
device);
}
else
- abort (); /* The spec validation routines are screwed up. */
+ ABORT (); /* The spec validation routines are screwed up. */
return Qunbound;
}
Lisp_Object property =
COLOR_SPECIFIER_FACE_PROPERTY (XCOLOR_SPECIFIER (specifier));
if (!NILP (face))
- face_property_was_changed (face, property, locale);
+ {
+ face_property_was_changed (face, property, locale);
+ if (BUFFERP (locale))
+ XBUFFER (locale)->buffer_local_face_property = 1;
+ }
}
void
set_color_attached_to (Lisp_Object obj, Lisp_Object face, Lisp_Object property)
{
- struct Lisp_Specifier *color = XCOLOR_SPECIFIER (obj);
+ Lisp_Specifier *color = XCOLOR_SPECIFIER (obj);
COLOR_SPECIFIER_FACE (color) = face;
COLOR_SPECIFIER_FACE_PROPERTY (color) = property;
DEFUN ("color-specifier-p", Fcolor_specifier_p, 1, 1, 0, /*
Return t if OBJECT is a color specifier.
-Valid instantiators for color specifiers are:
-
--- a string naming a color (e.g. under X this might be "lightseagreen2"
- or "#F534B2")
--- a color instance (use that instance directly if the device matches,
- or use the string that generated it)
--- a vector of no elements (only on TTY's; this means to set no color
- at all, thus using the "natural" color of the terminal's text)
--- a vector of one or two elements: a face to inherit from, and
- optionally a symbol naming which property of that face to inherit,
- either `foreground' or `background' (if omitted, defaults to the same
- property that this color specifier is used for; if this specifier is
- not part of a face, the instantiator would not be valid)
+See `make-color-specifier' for a description of possible color instantiators.
*/
(object))
{
static void
font_create (Lisp_Object obj)
{
- struct Lisp_Specifier *font = XFONT_SPECIFIER (obj);
+ Lisp_Specifier *font = XFONT_SPECIFIER (obj);
FONT_SPECIFIER_FACE (font) = Qnil;
FONT_SPECIFIER_FACE_PROPERTY (font) = Qnil;
}
static void
-font_mark (Lisp_Object obj, void (*markobj) (Lisp_Object))
+font_mark (Lisp_Object obj)
{
- struct Lisp_Specifier *font = XFONT_SPECIFIER (obj);
+ Lisp_Specifier *font = XFONT_SPECIFIER (obj);
- markobj (FONT_SPECIFIER_FACE (font));
- markobj (FONT_SPECIFIER_FACE_PROPERTY (font));
+ mark_object (FONT_SPECIFIER_FACE (font));
+ mark_object (FONT_SPECIFIER_FACE_PROPERTY (font));
}
/* No equal or hash methods; ignore the face the font is based off
int
font_spec_matches_charset (struct device *d, Lisp_Object charset,
- CONST Bufbyte *nonreloc, Lisp_Object reloc,
+ const Bufbyte *nonreloc, Lisp_Object reloc,
Bytecount offset, Bytecount length)
{
return DEVMETH_OR_GIVEN (d, font_spec_matches_charset,
{
/* When called, we're inside of call_with_suspended_errors(),
so we can freely error. */
- Lisp_Object device = DFW_DEVICE (domain);
+ Lisp_Object device = DOMAIN_DEVICE (domain);
struct device *d = XDEVICE (device);
Lisp_Object instance;
else if (NILP (instantiator))
return Qunbound;
else
- abort (); /* Eh? */
+ ABORT (); /* Eh? */
return Qunbound;
}
Lisp_Object property =
FONT_SPECIFIER_FACE_PROPERTY (XFONT_SPECIFIER (specifier));
if (!NILP (face))
- face_property_was_changed (face, property, locale);
+ {
+ face_property_was_changed (face, property, locale);
+ if (BUFFERP (locale))
+ XBUFFER (locale)->buffer_local_face_property = 1;
+ }
}
void
set_font_attached_to (Lisp_Object obj, Lisp_Object face, Lisp_Object property)
{
- struct Lisp_Specifier *font = XFONT_SPECIFIER (obj);
+ Lisp_Specifier *font = XFONT_SPECIFIER (obj);
FONT_SPECIFIER_FACE (font) = face;
FONT_SPECIFIER_FACE_PROPERTY (font) = property;
DEFUN ("font-specifier-p", Ffont_specifier_p, 1, 1, 0, /*
Return non-nil if OBJECT is a font specifier.
-Valid instantiators for font specifiers are:
-
--- a string naming a font (e.g. under X this might be
- "-*-courier-medium-r-*-*-*-140-*-*-*-*-iso8859-*" for a 14-point
- upright medium-weight Courier font)
--- a font instance (use that instance directly if the device matches,
- or use the string that generated it)
--- a vector of no elements (only on TTY's; this means to set no font
- at all, thus using the "natural" font of the terminal's text)
--- a vector of one element (a face to inherit from)
+See `make-font-specifier' for a description of possible font instantiators.
*/
(object))
{
static void
face_boolean_create (Lisp_Object obj)
{
- struct Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj);
+ Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj);
FACE_BOOLEAN_SPECIFIER_FACE (face_boolean) = Qnil;
FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (face_boolean) = Qnil;
}
static void
-face_boolean_mark (Lisp_Object obj, void (*markobj) (Lisp_Object))
+face_boolean_mark (Lisp_Object obj)
{
- struct Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj);
+ Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj);
- markobj (FACE_BOOLEAN_SPECIFIER_FACE (face_boolean));
- markobj (FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (face_boolean));
+ mark_object (FACE_BOOLEAN_SPECIFIER_FACE (face_boolean));
+ mark_object (FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (face_boolean));
}
/* No equal or hash methods; ignore the face the face-boolean is based off
return retval;
}
else
- abort (); /* Eh? */
+ ABORT (); /* Eh? */
return Qunbound;
}
Lisp_Object property =
FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (XFACE_BOOLEAN_SPECIFIER (specifier));
if (!NILP (face))
- face_property_was_changed (face, property, locale);
+ {
+ face_property_was_changed (face, property, locale);
+ if (BUFFERP (locale))
+ XBUFFER (locale)->buffer_local_face_property = 1;
+ }
}
void
set_face_boolean_attached_to (Lisp_Object obj, Lisp_Object face,
Lisp_Object property)
{
- struct Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj);
+ Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj);
FACE_BOOLEAN_SPECIFIER_FACE (face_boolean) = face;
FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (face_boolean) = property;
DEFUN ("face-boolean-specifier-p", Fface_boolean_specifier_p, 1, 1, 0, /*
Return non-nil if OBJECT is a face-boolean specifier.
-Valid instantiators for face-boolean specifiers are
-
--- t or nil
--- a vector of two or three elements: a face to inherit from,
- optionally a symbol naming the property of that face to inherit from
- (if omitted, defaults to the same property that this face-boolean
- specifier is used for; if this specifier is not part of a face,
- the instantiator would not be valid), and optionally a value which,
- if non-nil, means to invert the sense of the inherited property.
+See `make-face-boolean-specifier' for a description of possible
+face-boolean instantiators.
*/
(object))
{
void
syms_of_objects (void)
{
+ INIT_LRECORD_IMPLEMENTATION (color_instance);
+ INIT_LRECORD_IMPLEMENTATION (font_instance);
+
DEFSUBR (Fcolor_specifier_p);
DEFSUBR (Ffont_specifier_p);
DEFSUBR (Fface_boolean_specifier_p);
defsymbol (&Qface_boolean, "face-boolean");
}
+static const struct lrecord_description color_specifier_description[] = {
+ { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct color_specifier, face) },
+ { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct color_specifier, face_property) },
+ { XD_END }
+};
+
+static const struct lrecord_description font_specifier_description[] = {
+ { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct font_specifier, face) },
+ { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct font_specifier, face_property) },
+ { XD_END }
+};
+
+static const struct lrecord_description face_boolean_specifier_description[] = {
+ { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct face_boolean_specifier, face) },
+ { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct face_boolean_specifier, face_property) },
+ { XD_END }
+};
+
void
specifier_type_create_objects (void)
{
}
void
-vars_of_objects (void)
+reinit_specifier_type_create_objects (void)
+{
+ REINITIALIZE_SPECIFIER_TYPE (color);
+ REINITIALIZE_SPECIFIER_TYPE (font);
+ REINITIALIZE_SPECIFIER_TYPE (face_boolean);
+}
+
+void
+reinit_vars_of_objects (void)
{
- staticpro (&Vthe_null_color_instance);
+ staticpro_nodump (&Vthe_null_color_instance);
{
- struct Lisp_Color_Instance *c =
- alloc_lcrecord_type (struct Lisp_Color_Instance, lrecord_color_instance);
+ Lisp_Color_Instance *c =
+ alloc_lcrecord_type (Lisp_Color_Instance, &lrecord_color_instance);
c->name = Qnil;
c->device = Qnil;
c->data = 0;
XSETCOLOR_INSTANCE (Vthe_null_color_instance, c);
}
- staticpro (&Vthe_null_font_instance);
+ staticpro_nodump (&Vthe_null_font_instance);
{
- struct Lisp_Font_Instance *f =
- alloc_lcrecord_type (struct Lisp_Font_Instance, lrecord_font_instance);
+ Lisp_Font_Instance *f =
+ alloc_lcrecord_type (Lisp_Font_Instance, &lrecord_font_instance);
f->name = Qnil;
f->device = Qnil;
f->data = 0;
XSETFONT_INSTANCE (Vthe_null_font_instance, f);
}
}
+
+void
+vars_of_objects (void)
+{
+ reinit_vars_of_objects ();
+}