Mercurial > hg > xemacs-beta
diff src/objects.c @ 412:697ef44129c6 r21-2-14
Import from CVS: tag r21-2-14
author | cvs |
---|---|
date | Mon, 13 Aug 2007 11:20:41 +0200 |
parents | 501cfd01ee6d |
children | 41dbb7a9d5f2 |
line wrap: on
line diff
--- a/src/objects.c Mon Aug 13 11:19:22 2007 +0200 +++ b/src/objects.c Mon Aug 13 11:20:41 2007 +0200 @@ -57,12 +57,12 @@ Lisp_Object Qcolor_instancep; static Lisp_Object -mark_color_instance (Lisp_Object obj) +mark_color_instance (Lisp_Object obj, void (*markobj) (Lisp_Object)) { - Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj); - mark_object (c->name); + struct Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj); + markobj (c->name); if (!NILP (c->device)) /* Vthe_null_color_instance */ - MAYBE_DEVMETH (XDEVICE (c->device), mark_color_instance, (c)); + MAYBE_DEVMETH (XDEVICE (c->device), mark_color_instance, (c, markobj)); return c->device; } @@ -72,7 +72,7 @@ int escapeflag) { char buf[100]; - Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj); + struct Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj); if (print_readably) error ("printing unreadable object #<color-instance 0x%x>", c->header.uid); @@ -90,7 +90,7 @@ static void finalize_color_instance (void *header, int for_disksave) { - Lisp_Color_Instance *c = (Lisp_Color_Instance *) header; + struct Lisp_Color_Instance *c = (struct Lisp_Color_Instance *) header; if (!NILP (c->device)) { @@ -102,11 +102,11 @@ static int color_instance_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) { - Lisp_Color_Instance *c1 = XCOLOR_INSTANCE (obj1); - Lisp_Color_Instance *c2 = XCOLOR_INSTANCE (obj2); + struct Lisp_Color_Instance *c1 = XCOLOR_INSTANCE (obj1); + struct 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))); @@ -115,7 +115,7 @@ static unsigned long color_instance_hash (Lisp_Object obj, int depth) { - Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj); + struct Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj); struct device *d = DEVICEP (c->device) ? XDEVICE (c->device) : 0; return HASH2 ((unsigned long) d, @@ -127,8 +127,8 @@ DEFINE_LRECORD_IMPLEMENTATION ("color-instance", color_instance, mark_color_instance, print_color_instance, finalize_color_instance, color_instance_equal, - color_instance_hash, 0, - Lisp_Color_Instance); + color_instance_hash, + struct Lisp_Color_Instance); DEFUN ("make-color-instance", Fmake_color_instance, 1, 3, 0, /* Return a new `color-instance' object named NAME (a string). @@ -149,14 +149,14 @@ */ (name, device, no_error)) { - Lisp_Color_Instance *c; + struct Lisp_Color_Instance *c; Lisp_Object val; int retval; CHECK_STRING (name); XSETDEVICE (device, decode_device (device)); - c = alloc_lcrecord_type (Lisp_Color_Instance, &lrecord_color_instance); + c = alloc_lcrecord_type (struct Lisp_Color_Instance, &lrecord_color_instance); c->name = name; c->device = device; c->data = 0; @@ -195,7 +195,7 @@ */ (color_instance)) { - Lisp_Color_Instance *c; + struct Lisp_Color_Instance *c; CHECK_COLOR_INSTANCE (color_instance); c = XCOLOR_INSTANCE (color_instance); @@ -237,13 +237,13 @@ Error_behavior errb); static Lisp_Object -mark_font_instance (Lisp_Object obj) +mark_font_instance (Lisp_Object obj, void (*markobj) (Lisp_Object)) { - Lisp_Font_Instance *f = XFONT_INSTANCE (obj); + struct Lisp_Font_Instance *f = XFONT_INSTANCE (obj); - mark_object (f->name); + markobj (f->name); if (!NILP (f->device)) /* Vthe_null_font_instance */ - MAYBE_DEVMETH (XDEVICE (f->device), mark_font_instance, (f)); + MAYBE_DEVMETH (XDEVICE (f->device), mark_font_instance, (f, markobj)); return f->device; } @@ -252,7 +252,7 @@ print_font_instance (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) { char buf[200]; - Lisp_Font_Instance *f = XFONT_INSTANCE (obj); + struct 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); @@ -269,7 +269,7 @@ static void finalize_font_instance (void *header, int for_disksave) { - Lisp_Font_Instance *f = (Lisp_Font_Instance *) header; + struct Lisp_Font_Instance *f = (struct Lisp_Font_Instance *) header; if (!NILP (f->device)) { @@ -301,7 +301,7 @@ DEFINE_LRECORD_IMPLEMENTATION ("font-instance", font_instance, mark_font_instance, print_font_instance, finalize_font_instance, font_instance_equal, - font_instance_hash, 0, Lisp_Font_Instance); + font_instance_hash, struct Lisp_Font_Instance); DEFUN ("make-font-instance", Fmake_font_instance, 1, 3, 0, /* Return a new `font-instance' object named NAME. @@ -317,7 +317,7 @@ */ (name, device, no_error)) { - Lisp_Font_Instance *f; + struct Lisp_Font_Instance *f; Lisp_Object val; int retval = 0; Error_behavior errb = decode_error_behavior_flag (no_error); @@ -329,7 +329,7 @@ XSETDEVICE (device, decode_device (device)); - f = alloc_lcrecord_type (Lisp_Font_Instance, &lrecord_font_instance); + f = alloc_lcrecord_type (struct Lisp_Font_Instance, &lrecord_font_instance); f->name = name; f->device = device; @@ -417,15 +417,15 @@ font_instance_truename_internal (Lisp_Object font_instance, Error_behavior errb) { - Lisp_Font_Instance *f = XFONT_INSTANCE (font_instance); - + struct 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); } @@ -447,7 +447,7 @@ */ (font_instance)) { - Lisp_Font_Instance *f; + struct Lisp_Font_Instance *f; CHECK_FONT_INSTANCE (font_instance); f = XFONT_INSTANCE (font_instance); @@ -482,19 +482,19 @@ static void color_create (Lisp_Object obj) { - Lisp_Specifier *color = XCOLOR_SPECIFIER (obj); + struct Lisp_Specifier *color = XCOLOR_SPECIFIER (obj); COLOR_SPECIFIER_FACE (color) = Qnil; COLOR_SPECIFIER_FACE_PROPERTY (color) = Qnil; } static void -color_mark (Lisp_Object obj) +color_mark (Lisp_Object obj, void (*markobj) (Lisp_Object)) { - Lisp_Specifier *color = XCOLOR_SPECIFIER (obj); + struct Lisp_Specifier *color = XCOLOR_SPECIFIER (obj); - mark_object (COLOR_SPECIFIER_FACE (color)); - mark_object (COLOR_SPECIFIER_FACE_PROPERTY (color)); + markobj (COLOR_SPECIFIER_FACE (color)); + markobj (COLOR_SPECIFIER_FACE_PROPERTY (color)); } /* No equal or hash methods; ignore the face the color is based off @@ -507,7 +507,7 @@ { /* When called, we're inside of call_with_suspended_errors(), so we can freely error. */ - Lisp_Object device = DOMAIN_DEVICE (domain); + Lisp_Object device = DFW_DEVICE (domain); struct device *d = XDEVICE (device); if (COLOR_INSTANCEP (instantiator)) @@ -622,7 +622,7 @@ void set_color_attached_to (Lisp_Object obj, Lisp_Object face, Lisp_Object property) { - Lisp_Specifier *color = XCOLOR_SPECIFIER (obj); + struct Lisp_Specifier *color = XCOLOR_SPECIFIER (obj); COLOR_SPECIFIER_FACE (color) = face; COLOR_SPECIFIER_FACE_PROPERTY (color) = property; @@ -631,7 +631,19 @@ DEFUN ("color-specifier-p", Fcolor_specifier_p, 1, 1, 0, /* Return t if OBJECT is a color specifier. -See `make-color-specifier' for a description of possible color instantiators. +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) */ (object)) { @@ -648,19 +660,19 @@ static void font_create (Lisp_Object obj) { - Lisp_Specifier *font = XFONT_SPECIFIER (obj); + struct Lisp_Specifier *font = XFONT_SPECIFIER (obj); FONT_SPECIFIER_FACE (font) = Qnil; FONT_SPECIFIER_FACE_PROPERTY (font) = Qnil; } static void -font_mark (Lisp_Object obj) +font_mark (Lisp_Object obj, void (*markobj) (Lisp_Object)) { - Lisp_Specifier *font = XFONT_SPECIFIER (obj); + struct Lisp_Specifier *font = XFONT_SPECIFIER (obj); - mark_object (FONT_SPECIFIER_FACE (font)); - mark_object (FONT_SPECIFIER_FACE_PROPERTY (font)); + markobj (FONT_SPECIFIER_FACE (font)); + markobj (FONT_SPECIFIER_FACE_PROPERTY (font)); } /* No equal or hash methods; ignore the face the font is based off @@ -670,7 +682,7 @@ 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, @@ -694,7 +706,7 @@ { /* When called, we're inside of call_with_suspended_errors(), so we can freely error. */ - Lisp_Object device = DOMAIN_DEVICE (domain); + Lisp_Object device = DFW_DEVICE (domain); struct device *d = XDEVICE (device); Lisp_Object instance; @@ -820,7 +832,7 @@ void set_font_attached_to (Lisp_Object obj, Lisp_Object face, Lisp_Object property) { - Lisp_Specifier *font = XFONT_SPECIFIER (obj); + struct Lisp_Specifier *font = XFONT_SPECIFIER (obj); FONT_SPECIFIER_FACE (font) = face; FONT_SPECIFIER_FACE_PROPERTY (font) = property; @@ -829,7 +841,16 @@ DEFUN ("font-specifier-p", Ffont_specifier_p, 1, 1, 0, /* Return non-nil if OBJECT is a font specifier. -See `make-font-specifier' for a description of possible font instantiators. +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) */ (object)) { @@ -846,19 +867,19 @@ static void face_boolean_create (Lisp_Object obj) { - Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj); + struct 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) +face_boolean_mark (Lisp_Object obj, void (*markobj) (Lisp_Object)) { - Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj); + struct Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj); - mark_object (FACE_BOOLEAN_SPECIFIER_FACE (face_boolean)); - mark_object (FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (face_boolean)); + markobj (FACE_BOOLEAN_SPECIFIER_FACE (face_boolean)); + markobj (FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (face_boolean)); } /* No equal or hash methods; ignore the face the face-boolean is based off @@ -956,7 +977,7 @@ set_face_boolean_attached_to (Lisp_Object obj, Lisp_Object face, Lisp_Object property) { - Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj); + struct Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj); FACE_BOOLEAN_SPECIFIER_FACE (face_boolean) = face; FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (face_boolean) = property; @@ -965,8 +986,15 @@ DEFUN ("face-boolean-specifier-p", Fface_boolean_specifier_p, 1, 1, 0, /* Return non-nil if OBJECT is a face-boolean specifier. -See `make-face-boolean-specifier' for a description of possible -face-boolean instantiators. +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. */ (object)) { @@ -981,9 +1009,6 @@ 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); @@ -1011,24 +1036,6 @@ 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) { @@ -1063,20 +1070,12 @@ } void -reinit_specifier_type_create_objects (void) +vars_of_objects (void) { - REINITIALIZE_SPECIFIER_TYPE (color); - REINITIALIZE_SPECIFIER_TYPE (font); - REINITIALIZE_SPECIFIER_TYPE (face_boolean); -} - -void -reinit_vars_of_objects (void) -{ - staticpro_nodump (&Vthe_null_color_instance); + staticpro (&Vthe_null_color_instance); { - Lisp_Color_Instance *c = - alloc_lcrecord_type (Lisp_Color_Instance, &lrecord_color_instance); + struct Lisp_Color_Instance *c = + alloc_lcrecord_type (struct Lisp_Color_Instance, &lrecord_color_instance); c->name = Qnil; c->device = Qnil; c->data = 0; @@ -1084,10 +1083,10 @@ XSETCOLOR_INSTANCE (Vthe_null_color_instance, c); } - staticpro_nodump (&Vthe_null_font_instance); + staticpro (&Vthe_null_font_instance); { - Lisp_Font_Instance *f = - alloc_lcrecord_type (Lisp_Font_Instance, &lrecord_font_instance); + struct Lisp_Font_Instance *f = + alloc_lcrecord_type (struct Lisp_Font_Instance, &lrecord_font_instance); f->name = Qnil; f->device = Qnil; f->data = 0; @@ -1100,9 +1099,3 @@ XSETFONT_INSTANCE (Vthe_null_font_instance, f); } } - -void -vars_of_objects (void) -{ - reinit_vars_of_objects (); -}