Mercurial > hg > xemacs-beta

comparison src/objects.c @ 5117:3742ea8250b5 ben-lisp-object ben-lisp-object-final-ws-year-2005

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Checking in final CVS version of workspace 'ben-lisp-object'
author Ben Wing <ben@xemacs.org>
date Sat, 26 Dec 2009 00:20:27 -0600
parents 1e7cc382eb16
children e0db3c197671
comparison
equal deleted inserted replaced
5116:e56f73345619 5117:3742ea8250b5
143 !d ? LISP_HASH (obj) 143 !d ? LISP_HASH (obj)
144 : DEVMETH_OR_GIVEN (d, color_instance_hash, (c, depth), 144 : DEVMETH_OR_GIVEN (d, color_instance_hash, (c, depth),
145 LISP_HASH (obj))); 145 LISP_HASH (obj)));
146 } 146 }
147 147
148 DEFINE_LRECORD_IMPLEMENTATION ("color-instance", color_instance, 148 DEFINE_NONDUMPABLE_LISP_OBJECT ("color-instance", color_instance,
149 0, /*dumpable-flag*/ 149 mark_color_instance, print_color_instance,
150 mark_color_instance, print_color_instance, 150 finalize_color_instance, color_instance_equal,
151 finalize_color_instance, color_instance_equal, 151 color_instance_hash,
152 color_instance_hash, 152 color_instance_description,
153 color_instance_description, 153 Lisp_Color_Instance);
154 Lisp_Color_Instance);
155 154
156 DEFUN ("make-color-instance", Fmake_color_instance, 1, 3, 0, /* 155 DEFUN ("make-color-instance", Fmake_color_instance, 1, 3, 0, /*
157 Return a new `color-instance' object named NAME (a string). 156 Return a new `color-instance' object named NAME (a string).
158 157
159 Optional argument DEVICE specifies the device this object applies to 158 Optional argument DEVICE specifies the device this object applies to
170 these objects are GCed, the underlying window-system data (e.g. X object) 169 these objects are GCed, the underlying window-system data (e.g. X object)
171 is deallocated as well. 170 is deallocated as well.
172 */ 171 */
173 (name, device, noerror)) 172 (name, device, noerror))
174 { 173 {
174 Lisp_Object obj;
175 Lisp_Color_Instance *c; 175 Lisp_Color_Instance *c;
176 int retval; 176 int retval;
177 177
178 CHECK_STRING (name); 178 CHECK_STRING (name);
179 device = wrap_device (decode_device (device)); 179 device = wrap_device (decode_device (device));
180 180
181 c = ALLOC_LCRECORD_TYPE (Lisp_Color_Instance, &lrecord_color_instance); 181 obj = ALLOC_LISP_OBJECT (color_instance);
182 c = XCOLOR_INSTANCE (obj);
182 c->name = name; 183 c->name = name;
183 c->device = device; 184 c->device = device;
184 c->data = 0; 185 c->data = 0;
185 c->color_instance_type = get_console_variant (XDEVICE_TYPE (c->device)); 186 c->color_instance_type = get_console_variant (XDEVICE_TYPE (c->device));
186 187
188 (c, name, device, 189 (c, name, device,
189 decode_error_behavior_flag (noerror))); 190 decode_error_behavior_flag (noerror)));
190 if (!retval) 191 if (!retval)
191 return Qnil; 192 return Qnil;
192 193
193 return wrap_color_instance (c); 194 return obj;
194 } 195 }
195 196
196 DEFUN ("color-instance-p", Fcolor_instance_p, 1, 1, 0, /* 197 DEFUN ("color-instance-p", Fcolor_instance_p, 1, 1, 0, /*
197 Return non-nil if OBJECT is a color instance. 198 Return non-nil if OBJECT is a color instance.
198 */ 199 */
352 return internal_hash (font_instance_truename_internal 353 return internal_hash (font_instance_truename_internal
353 (obj, ERROR_ME_DEBUG_WARN), 354 (obj, ERROR_ME_DEBUG_WARN),
354 depth + 1); 355 depth + 1);
355 } 356 }
356 357
357 DEFINE_LRECORD_IMPLEMENTATION ("font-instance", font_instance, 358 DEFINE_NONDUMPABLE_LISP_OBJECT ("font-instance", font_instance,
358 0, /*dumpable-flag*/ 359 mark_font_instance, print_font_instance,
359 mark_font_instance, print_font_instance, 360 finalize_font_instance, font_instance_equal,
360 finalize_font_instance, font_instance_equal, 361 font_instance_hash, font_instance_description,
361 font_instance_hash, font_instance_description, 362 Lisp_Font_Instance);
362 Lisp_Font_Instance);
363 363
364 364
365 DEFUN ("make-font-instance", Fmake_font_instance, 1, 3, 0, /* 365 DEFUN ("make-font-instance", Fmake_font_instance, 1, 3, 0, /*
366 Return a new `font-instance' object named NAME. 366 Return a new `font-instance' object named NAME.
367 DEVICE specifies the device this object applies to and defaults to the 367 DEVICE specifies the device this object applies to and defaults to the
374 you drop all pointers to it and allow it to be garbage collected. When 374 you drop all pointers to it and allow it to be garbage collected. When
375 these objects are GCed, the underlying X data is deallocated as well. 375 these objects are GCed, the underlying X data is deallocated as well.
376 */ 376 */
377 (name, device, noerror)) 377 (name, device, noerror))
378 { 378 {
379 Lisp_Object obj;
379 Lisp_Font_Instance *f; 380 Lisp_Font_Instance *f;
380 int retval = 0; 381 int retval = 0;
381 Error_Behavior errb = decode_error_behavior_flag (noerror); 382 Error_Behavior errb = decode_error_behavior_flag (noerror);
382 383
383 if (ERRB_EQ (errb, ERROR_ME)) 384 if (ERRB_EQ (errb, ERROR_ME))
385 else if (!STRINGP (name)) 386 else if (!STRINGP (name))
386 return Qnil; 387 return Qnil;
387 388
388 device = wrap_device (decode_device (device)); 389 device = wrap_device (decode_device (device));
389 390
390 f = ALLOC_LCRECORD_TYPE (Lisp_Font_Instance, &lrecord_font_instance); 391 obj = ALLOC_LISP_OBJECT (font_instance);
392 f = XFONT_INSTANCE (obj);
391 f->name = name; 393 f->name = name;
392 f->truename = Qnil; 394 f->truename = Qnil;
393 f->device = device; 395 f->device = device;
394 396
395 f->data = 0; 397 f->data = 0;
405 (f, name, device, errb)); 407 (f, name, device, errb));
406 408
407 if (!retval) 409 if (!retval)
408 return Qnil; 410 return Qnil;
409 411
410 return wrap_font_instance (f); 412 return obj;
411 } 413 }
412 414
413 DEFUN ("font-instance-p", Ffont_instance_p, 1, 1, 0, /* 415 DEFUN ("font-instance-p", Ffont_instance_p, 1, 1, 0, /*
414 Return non-nil if OBJECT is a font instance. 416 Return non-nil if OBJECT is a font instance.
415 */ 417 */
1118 /************************************************************************/ 1120 /************************************************************************/
1119 1121
1120 void 1122 void
1121 syms_of_objects (void) 1123 syms_of_objects (void)
1122 { 1124 {
1123 INIT_LRECORD_IMPLEMENTATION (color_instance); 1125 INIT_LISP_OBJECT (color_instance);
1124 INIT_LRECORD_IMPLEMENTATION (font_instance); 1126 INIT_LISP_OBJECT (font_instance);
1125 1127
1126 DEFSUBR (Fcolor_specifier_p); 1128 DEFSUBR (Fcolor_specifier_p);
1127 DEFSUBR (Ffont_specifier_p); 1129 DEFSUBR (Ffont_specifier_p);
1128 DEFSUBR (Fface_boolean_specifier_p); 1130 DEFSUBR (Fface_boolean_specifier_p);
1129 1131
1193 } 1195 }
1194 1196
1195 void 1197 void
1196 reinit_vars_of_objects (void) 1198 reinit_vars_of_objects (void)
1197 { 1199 {
1198 staticpro_nodump (&Vthe_null_color_instance);
1199 { 1200 {
1200 Lisp_Color_Instance *c = 1201 Lisp_Object obj = ALLOC_LISP_OBJECT (color_instance);
1201 ALLOC_LCRECORD_TYPE (Lisp_Color_Instance, &lrecord_color_instance); 1202 Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj);
1202 c->name = Qnil; 1203 c->name = Qnil;
1203 c->device = Qnil; 1204 c->device = Qnil;
1204 c->data = 0; 1205 c->data = 0;
1205 1206
1206 Vthe_null_color_instance = wrap_color_instance (c); 1207 Vthe_null_color_instance = obj;
1208 staticpro_nodump (&Vthe_null_color_instance);
1207 } 1209 }
1208 1210
1209 staticpro_nodump (&Vthe_null_font_instance);
1210 { 1211 {
1211 Lisp_Font_Instance *f = 1212 Lisp_Object obj = ALLOC_LISP_OBJECT (font_instance);
1212 ALLOC_LCRECORD_TYPE (Lisp_Font_Instance, &lrecord_font_instance); 1213 Lisp_Font_Instance *f = XFONT_INSTANCE (obj);
1213 f->name = Qnil; 1214 f->name = Qnil;
1214 f->truename = Qnil; 1215 f->truename = Qnil;
1215 f->device = Qnil; 1216 f->device = Qnil;
1216 f->data = 0; 1217 f->data = 0;
1217 1218
1218 f->ascent = f->height = 0; 1219 f->ascent = f->height = 0;
1219 f->descent = 0; 1220 f->descent = 0;
1220 f->width = 0; 1221 f->width = 0;
1221 f->proportional_p = 0; 1222 f->proportional_p = 0;
1222 1223
1223 Vthe_null_font_instance = wrap_font_instance (f); 1224 Vthe_null_font_instance = obj;
1225 staticpro_nodump (&Vthe_null_font_instance);
1224 } 1226 }
1225 } 1227 }
1226 1228
1227 void 1229 void
1228 vars_of_objects (void) 1230 vars_of_objects (void)