428
+ − 1 /* Generic Objects and Functions.
+ − 2 Copyright (C) 1995 Free Software Foundation, Inc.
+ − 3 Copyright (C) 1995 Board of Trustees, University of Illinois.
+ − 4 Copyright (C) 1995, 1996 Ben Wing.
+ − 5
+ − 6 This file is part of XEmacs.
+ − 7
+ − 8 XEmacs is free software; you can redistribute it and/or modify it
+ − 9 under the terms of the GNU General Public License as published by the
+ − 10 Free Software Foundation; either version 2, or (at your option) any
+ − 11 later version.
+ − 12
+ − 13 XEmacs is distributed in the hope that it will be useful, but WITHOUT
+ − 14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+ − 15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+ − 16 for more details.
+ − 17
+ − 18 You should have received a copy of the GNU General Public License
+ − 19 along with XEmacs; see the file COPYING. If not, write to
+ − 20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+ − 21 Boston, MA 02111-1307, USA. */
+ − 22
+ − 23 /* Synched up with: Not in FSF. */
+ − 24
+ − 25 #include <config.h>
+ − 26 #include "lisp.h"
+ − 27
+ − 28 #include "device.h"
+ − 29 #include "elhash.h"
+ − 30 #include "faces.h"
+ − 31 #include "frame.h"
+ − 32 #include "objects.h"
+ − 33 #include "specifier.h"
+ − 34 #include "window.h"
+ − 35
+ − 36 /* Objects that are substituted when an instantiation fails.
+ − 37 If we leave in the Qunbound value, we will probably get crashes. */
+ − 38 Lisp_Object Vthe_null_color_instance, Vthe_null_font_instance;
+ − 39
+ − 40 /* Authors: Ben Wing, Chuck Thompson */
+ − 41
+ − 42 void
+ − 43 finalose (void *ptr)
+ − 44 {
+ − 45 Lisp_Object obj;
442
+ − 46 XSETOBJ (obj, ptr);
428
+ − 47
563
+ − 48 invalid_operation
428
+ − 49 ("Can't dump an emacs containing window system objects", obj);
+ − 50 }
+ − 51
+ − 52
+ − 53 /****************************************************************************
+ − 54 * Color-Instance Object *
+ − 55 ****************************************************************************/
+ − 56
+ − 57 Lisp_Object Qcolor_instancep;
+ − 58
+ − 59 static Lisp_Object
+ − 60 mark_color_instance (Lisp_Object obj)
+ − 61 {
440
+ − 62 Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj);
428
+ − 63 mark_object (c->name);
+ − 64 if (!NILP (c->device)) /* Vthe_null_color_instance */
+ − 65 MAYBE_DEVMETH (XDEVICE (c->device), mark_color_instance, (c));
+ − 66
+ − 67 return c->device;
+ − 68 }
+ − 69
+ − 70 static void
+ − 71 print_color_instance (Lisp_Object obj, Lisp_Object printcharfun,
+ − 72 int escapeflag)
+ − 73 {
+ − 74 char buf[100];
440
+ − 75 Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj);
428
+ − 76 if (print_readably)
563
+ − 77 printing_unreadable_object ("#<color-instance 0x%x>",
428
+ − 78 c->header.uid);
+ − 79 write_c_string ("#<color-instance ", printcharfun);
+ − 80 print_internal (c->name, printcharfun, 0);
+ − 81 write_c_string (" on ", printcharfun);
+ − 82 print_internal (c->device, printcharfun, 0);
+ − 83 if (!NILP (c->device)) /* Vthe_null_color_instance */
+ − 84 MAYBE_DEVMETH (XDEVICE (c->device), print_color_instance,
+ − 85 (c, printcharfun, escapeflag));
+ − 86 sprintf (buf, " 0x%x>", c->header.uid);
+ − 87 write_c_string (buf, printcharfun);
+ − 88 }
+ − 89
+ − 90 static void
+ − 91 finalize_color_instance (void *header, int for_disksave)
+ − 92 {
440
+ − 93 Lisp_Color_Instance *c = (Lisp_Color_Instance *) header;
428
+ − 94
+ − 95 if (!NILP (c->device))
+ − 96 {
+ − 97 if (for_disksave) finalose (c);
+ − 98 MAYBE_DEVMETH (XDEVICE (c->device), finalize_color_instance, (c));
+ − 99 }
+ − 100 }
+ − 101
+ − 102 static int
+ − 103 color_instance_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
+ − 104 {
440
+ − 105 Lisp_Color_Instance *c1 = XCOLOR_INSTANCE (obj1);
+ − 106 Lisp_Color_Instance *c2 = XCOLOR_INSTANCE (obj2);
428
+ − 107
+ − 108 return (c1 == c2) ||
+ − 109 (EQ (c1->device, c2->device) &&
+ − 110 DEVICEP (c1->device) &&
+ − 111 HAS_DEVMETH_P (XDEVICE (c1->device), color_instance_equal) &&
+ − 112 DEVMETH (XDEVICE (c1->device), color_instance_equal, (c1, c2, depth)));
+ − 113 }
+ − 114
+ − 115 static unsigned long
+ − 116 color_instance_hash (Lisp_Object obj, int depth)
+ − 117 {
440
+ − 118 Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj);
428
+ − 119 struct device *d = DEVICEP (c->device) ? XDEVICE (c->device) : 0;
+ − 120
+ − 121 return HASH2 ((unsigned long) d,
+ − 122 !d ? LISP_HASH (obj)
+ − 123 : DEVMETH_OR_GIVEN (d, color_instance_hash, (c, depth),
+ − 124 LISP_HASH (obj)));
+ − 125 }
+ − 126
+ − 127 DEFINE_LRECORD_IMPLEMENTATION ("color-instance", color_instance,
+ − 128 mark_color_instance, print_color_instance,
+ − 129 finalize_color_instance, color_instance_equal,
+ − 130 color_instance_hash, 0,
440
+ − 131 Lisp_Color_Instance);
428
+ − 132
+ − 133 DEFUN ("make-color-instance", Fmake_color_instance, 1, 3, 0, /*
+ − 134 Return a new `color-instance' object named NAME (a string).
+ − 135
+ − 136 Optional argument DEVICE specifies the device this object applies to
+ − 137 and defaults to the selected device.
+ − 138
+ − 139 An error is signaled if the color is unknown or cannot be allocated;
444
+ − 140 however, if optional argument NOERROR is non-nil, nil is simply
+ − 141 returned in this case. (And if NOERROR is other than t, a warning may
428
+ − 142 be issued.)
+ − 143
+ − 144 The returned object is a normal, first-class lisp object. The way you
+ − 145 `deallocate' the color is the way you deallocate any other lisp object:
+ − 146 you drop all pointers to it and allow it to be garbage collected. When
+ − 147 these objects are GCed, the underlying window-system data (e.g. X object)
+ − 148 is deallocated as well.
+ − 149 */
444
+ − 150 (name, device, noerror))
428
+ − 151 {
440
+ − 152 Lisp_Color_Instance *c;
428
+ − 153 Lisp_Object val;
+ − 154 int retval;
+ − 155
+ − 156 CHECK_STRING (name);
+ − 157 XSETDEVICE (device, decode_device (device));
+ − 158
440
+ − 159 c = alloc_lcrecord_type (Lisp_Color_Instance, &lrecord_color_instance);
428
+ − 160 c->name = name;
+ − 161 c->device = device;
+ − 162 c->data = 0;
+ − 163
+ − 164 retval = MAYBE_INT_DEVMETH (XDEVICE (device), initialize_color_instance,
+ − 165 (c, name, device,
444
+ − 166 decode_error_behavior_flag (noerror)));
428
+ − 167 if (!retval)
+ − 168 return Qnil;
+ − 169
+ − 170 XSETCOLOR_INSTANCE (val, c);
+ − 171 return val;
+ − 172 }
+ − 173
+ − 174 DEFUN ("color-instance-p", Fcolor_instance_p, 1, 1, 0, /*
+ − 175 Return non-nil if OBJECT is a color instance.
+ − 176 */
+ − 177 (object))
+ − 178 {
+ − 179 return COLOR_INSTANCEP (object) ? Qt : Qnil;
+ − 180 }
+ − 181
+ − 182 DEFUN ("color-instance-name", Fcolor_instance_name, 1, 1, 0, /*
+ − 183 Return the name used to allocate COLOR-INSTANCE.
+ − 184 */
+ − 185 (color_instance))
+ − 186 {
+ − 187 CHECK_COLOR_INSTANCE (color_instance);
+ − 188 return XCOLOR_INSTANCE (color_instance)->name;
+ − 189 }
+ − 190
+ − 191 DEFUN ("color-instance-rgb-components", Fcolor_instance_rgb_components, 1, 1, 0, /*
+ − 192 Return a three element list containing the red, green, and blue
+ − 193 color components of COLOR-INSTANCE, or nil if unknown.
+ − 194 Component values range from 0 to 65535.
+ − 195 */
+ − 196 (color_instance))
+ − 197 {
440
+ − 198 Lisp_Color_Instance *c;
428
+ − 199
+ − 200 CHECK_COLOR_INSTANCE (color_instance);
+ − 201 c = XCOLOR_INSTANCE (color_instance);
+ − 202
+ − 203 if (NILP (c->device))
+ − 204 return Qnil;
+ − 205
+ − 206 return MAYBE_LISP_DEVMETH (XDEVICE (c->device),
+ − 207 color_instance_rgb_components,
+ − 208 (c));
+ − 209 }
+ − 210
+ − 211 DEFUN ("valid-color-name-p", Fvalid_color_name_p, 1, 2, 0, /*
+ − 212 Return true if COLOR names a valid color for the current device.
+ − 213
+ − 214 Valid color names for X are listed in the file /usr/lib/X11/rgb.txt, or
+ − 215 whatever the equivalent is on your system.
+ − 216
+ − 217 Valid color names for TTY are those which have an ISO 6429 (ANSI) sequence.
+ − 218 In addition to being a color this may be one of a number of attributes
+ − 219 such as `blink'.
+ − 220 */
+ − 221 (color, device))
+ − 222 {
+ − 223 struct device *d = decode_device (device);
+ − 224
+ − 225 CHECK_STRING (color);
+ − 226 return MAYBE_INT_DEVMETH (d, valid_color_name_p, (d, color)) ? Qt : Qnil;
+ − 227 }
+ − 228
+ − 229
+ − 230 /***************************************************************************
+ − 231 * Font-Instance Object *
+ − 232 ***************************************************************************/
+ − 233
+ − 234 Lisp_Object Qfont_instancep;
+ − 235
+ − 236 static Lisp_Object font_instance_truename_internal (Lisp_Object xfont,
578
+ − 237 Error_Behavior errb);
428
+ − 238
+ − 239 static Lisp_Object
+ − 240 mark_font_instance (Lisp_Object obj)
+ − 241 {
440
+ − 242 Lisp_Font_Instance *f = XFONT_INSTANCE (obj);
428
+ − 243
+ − 244 mark_object (f->name);
+ − 245 if (!NILP (f->device)) /* Vthe_null_font_instance */
+ − 246 MAYBE_DEVMETH (XDEVICE (f->device), mark_font_instance, (f));
+ − 247
+ − 248 return f->device;
+ − 249 }
+ − 250
+ − 251 static void
+ − 252 print_font_instance (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
+ − 253 {
+ − 254 char buf[200];
440
+ − 255 Lisp_Font_Instance *f = XFONT_INSTANCE (obj);
428
+ − 256 if (print_readably)
563
+ − 257 printing_unreadable_object ("#<font-instance 0x%x>", f->header.uid);
428
+ − 258 write_c_string ("#<font-instance ", printcharfun);
+ − 259 print_internal (f->name, printcharfun, 1);
+ − 260 write_c_string (" on ", printcharfun);
+ − 261 print_internal (f->device, printcharfun, 0);
+ − 262 if (!NILP (f->device))
+ − 263 MAYBE_DEVMETH (XDEVICE (f->device), print_font_instance,
+ − 264 (f, printcharfun, escapeflag));
+ − 265 sprintf (buf, " 0x%x>", f->header.uid);
+ − 266 write_c_string (buf, printcharfun);
+ − 267 }
+ − 268
+ − 269 static void
+ − 270 finalize_font_instance (void *header, int for_disksave)
+ − 271 {
440
+ − 272 Lisp_Font_Instance *f = (Lisp_Font_Instance *) header;
428
+ − 273
+ − 274 if (!NILP (f->device))
+ − 275 {
+ − 276 if (for_disksave) finalose (f);
+ − 277 MAYBE_DEVMETH (XDEVICE (f->device), finalize_font_instance, (f));
+ − 278 }
+ − 279 }
+ − 280
+ − 281 /* Fonts are equal if they resolve to the same name.
+ − 282 Since we call `font-truename' to do this, and since font-truename is lazy,
+ − 283 this means the `equal' could cause XListFonts to be run the first time.
+ − 284 */
+ − 285 static int
+ − 286 font_instance_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
+ − 287 {
+ − 288 /* #### should this be moved into a device method? */
+ − 289 return internal_equal (font_instance_truename_internal (obj1, ERROR_ME_NOT),
+ − 290 font_instance_truename_internal (obj2, ERROR_ME_NOT),
+ − 291 depth + 1);
+ − 292 }
+ − 293
+ − 294 static unsigned long
+ − 295 font_instance_hash (Lisp_Object obj, int depth)
+ − 296 {
+ − 297 return internal_hash (font_instance_truename_internal (obj, ERROR_ME_NOT),
+ − 298 depth + 1);
+ − 299 }
+ − 300
+ − 301 DEFINE_LRECORD_IMPLEMENTATION ("font-instance", font_instance,
+ − 302 mark_font_instance, print_font_instance,
+ − 303 finalize_font_instance, font_instance_equal,
440
+ − 304 font_instance_hash, 0, Lisp_Font_Instance);
428
+ − 305
+ − 306 DEFUN ("make-font-instance", Fmake_font_instance, 1, 3, 0, /*
+ − 307 Return a new `font-instance' object named NAME.
+ − 308 DEVICE specifies the device this object applies to and defaults to the
+ − 309 selected device. An error is signalled if the font is unknown or cannot
+ − 310 be allocated; however, if NOERROR is non-nil, nil is simply returned in
+ − 311 this case.
+ − 312
+ − 313 The returned object is a normal, first-class lisp object. The way you
+ − 314 `deallocate' the font is the way you deallocate any other lisp object:
+ − 315 you drop all pointers to it and allow it to be garbage collected. When
+ − 316 these objects are GCed, the underlying X data is deallocated as well.
+ − 317 */
444
+ − 318 (name, device, noerror))
428
+ − 319 {
440
+ − 320 Lisp_Font_Instance *f;
428
+ − 321 Lisp_Object val;
+ − 322 int retval = 0;
578
+ − 323 Error_Behavior errb = decode_error_behavior_flag (noerror);
428
+ − 324
+ − 325 if (ERRB_EQ (errb, ERROR_ME))
+ − 326 CHECK_STRING (name);
+ − 327 else if (!STRINGP (name))
+ − 328 return Qnil;
+ − 329
+ − 330 XSETDEVICE (device, decode_device (device));
+ − 331
440
+ − 332 f = alloc_lcrecord_type (Lisp_Font_Instance, &lrecord_font_instance);
428
+ − 333 f->name = name;
+ − 334 f->device = device;
+ − 335
+ − 336 f->data = 0;
+ − 337
+ − 338 /* Stick some default values here ... */
+ − 339 f->ascent = f->height = 1;
+ − 340 f->descent = 0;
+ − 341 f->width = 1;
+ − 342 f->proportional_p = 0;
+ − 343
+ − 344 retval = MAYBE_INT_DEVMETH (XDEVICE (device), initialize_font_instance,
+ − 345 (f, name, device, errb));
+ − 346
+ − 347 if (!retval)
+ − 348 return Qnil;
+ − 349
+ − 350 XSETFONT_INSTANCE (val, f);
+ − 351 return val;
+ − 352 }
+ − 353
+ − 354 DEFUN ("font-instance-p", Ffont_instance_p, 1, 1, 0, /*
+ − 355 Return non-nil if OBJECT is a font instance.
+ − 356 */
+ − 357 (object))
+ − 358 {
+ − 359 return FONT_INSTANCEP (object) ? Qt : Qnil;
+ − 360 }
+ − 361
+ − 362 DEFUN ("font-instance-name", Ffont_instance_name, 1, 1, 0, /*
+ − 363 Return the name used to allocate FONT-INSTANCE.
+ − 364 */
+ − 365 (font_instance))
+ − 366 {
+ − 367 CHECK_FONT_INSTANCE (font_instance);
+ − 368 return XFONT_INSTANCE (font_instance)->name;
+ − 369 }
+ − 370
+ − 371 DEFUN ("font-instance-ascent", Ffont_instance_ascent, 1, 1, 0, /*
+ − 372 Return the ascent in pixels of FONT-INSTANCE.
+ − 373 The returned value is the maximum ascent for all characters in the font,
+ − 374 where a character's ascent is the number of pixels above (and including)
+ − 375 the baseline.
+ − 376 */
+ − 377 (font_instance))
+ − 378 {
+ − 379 CHECK_FONT_INSTANCE (font_instance);
+ − 380 return make_int (XFONT_INSTANCE (font_instance)->ascent);
+ − 381 }
+ − 382
+ − 383 DEFUN ("font-instance-descent", Ffont_instance_descent, 1, 1, 0, /*
+ − 384 Return the descent in pixels of FONT-INSTANCE.
+ − 385 The returned value is the maximum descent for all characters in the font,
+ − 386 where a character's descent is the number of pixels below the baseline.
+ − 387 \(Many characters to do not have any descent. Typical characters with a
+ − 388 descent are lowercase p and lowercase g.)
+ − 389 */
+ − 390 (font_instance))
+ − 391 {
+ − 392 CHECK_FONT_INSTANCE (font_instance);
+ − 393 return make_int (XFONT_INSTANCE (font_instance)->descent);
+ − 394 }
+ − 395
+ − 396 DEFUN ("font-instance-width", Ffont_instance_width, 1, 1, 0, /*
+ − 397 Return the width in pixels of FONT-INSTANCE.
+ − 398 The returned value is the average width for all characters in the font.
+ − 399 */
+ − 400 (font_instance))
+ − 401 {
+ − 402 CHECK_FONT_INSTANCE (font_instance);
+ − 403 return make_int (XFONT_INSTANCE (font_instance)->width);
+ − 404 }
+ − 405
+ − 406 DEFUN ("font-instance-proportional-p", Ffont_instance_proportional_p, 1, 1, 0, /*
+ − 407 Return whether FONT-INSTANCE is proportional.
+ − 408 This means that different characters in the font have different widths.
+ − 409 */
+ − 410 (font_instance))
+ − 411 {
+ − 412 CHECK_FONT_INSTANCE (font_instance);
+ − 413 return XFONT_INSTANCE (font_instance)->proportional_p ? Qt : Qnil;
+ − 414 }
+ − 415
+ − 416 static Lisp_Object
+ − 417 font_instance_truename_internal (Lisp_Object font_instance,
578
+ − 418 Error_Behavior errb)
428
+ − 419 {
440
+ − 420 Lisp_Font_Instance *f = XFONT_INSTANCE (font_instance);
+ − 421
428
+ − 422 if (NILP (f->device))
+ − 423 {
563
+ − 424 maybe_signal_error (Qgui_error, "Couldn't determine font truename",
+ − 425 font_instance, Qfont, errb);
428
+ − 426 return Qnil;
+ − 427 }
440
+ − 428
428
+ − 429 return DEVMETH_OR_GIVEN (XDEVICE (f->device),
+ − 430 font_instance_truename, (f, errb), f->name);
+ − 431 }
+ − 432
+ − 433 DEFUN ("font-instance-truename", Ffont_instance_truename, 1, 1, 0, /*
+ − 434 Return the canonical name of FONT-INSTANCE.
+ − 435 Font names are patterns which may match any number of fonts, of which
+ − 436 the first found is used. This returns an unambiguous name for that font
+ − 437 \(but not necessarily its only unambiguous name).
+ − 438 */
+ − 439 (font_instance))
+ − 440 {
+ − 441 CHECK_FONT_INSTANCE (font_instance);
+ − 442 return font_instance_truename_internal (font_instance, ERROR_ME);
+ − 443 }
+ − 444
+ − 445 DEFUN ("font-instance-properties", Ffont_instance_properties, 1, 1, 0, /*
+ − 446 Return the properties (an alist or nil) of FONT-INSTANCE.
+ − 447 */
+ − 448 (font_instance))
+ − 449 {
440
+ − 450 Lisp_Font_Instance *f;
428
+ − 451
+ − 452 CHECK_FONT_INSTANCE (font_instance);
+ − 453 f = XFONT_INSTANCE (font_instance);
+ − 454
+ − 455 if (NILP (f->device))
+ − 456 return Qnil;
+ − 457
+ − 458 return MAYBE_LISP_DEVMETH (XDEVICE (f->device),
+ − 459 font_instance_properties, (f));
+ − 460 }
+ − 461
+ − 462 DEFUN ("list-fonts", Flist_fonts, 1, 2, 0, /*
+ − 463 Return a list of font names matching the given pattern.
+ − 464 DEVICE specifies which device to search for names, and defaults to the
+ − 465 currently selected device.
+ − 466 */
+ − 467 (pattern, device))
+ − 468 {
+ − 469 CHECK_STRING (pattern);
+ − 470 XSETDEVICE (device, decode_device (device));
+ − 471
+ − 472 return MAYBE_LISP_DEVMETH (XDEVICE (device), list_fonts, (pattern, device));
+ − 473 }
+ − 474
+ − 475
+ − 476 /****************************************************************************
+ − 477 Color Object
+ − 478 ***************************************************************************/
+ − 479 DEFINE_SPECIFIER_TYPE (color);
+ − 480 /* Qcolor defined in general.c */
+ − 481
+ − 482 static void
+ − 483 color_create (Lisp_Object obj)
+ − 484 {
440
+ − 485 Lisp_Specifier *color = XCOLOR_SPECIFIER (obj);
428
+ − 486
+ − 487 COLOR_SPECIFIER_FACE (color) = Qnil;
+ − 488 COLOR_SPECIFIER_FACE_PROPERTY (color) = Qnil;
+ − 489 }
+ − 490
+ − 491 static void
+ − 492 color_mark (Lisp_Object obj)
+ − 493 {
440
+ − 494 Lisp_Specifier *color = XCOLOR_SPECIFIER (obj);
428
+ − 495
+ − 496 mark_object (COLOR_SPECIFIER_FACE (color));
+ − 497 mark_object (COLOR_SPECIFIER_FACE_PROPERTY (color));
+ − 498 }
+ − 499
+ − 500 /* No equal or hash methods; ignore the face the color is based off
+ − 501 of for `equal' */
+ − 502
+ − 503 static Lisp_Object
+ − 504 color_instantiate (Lisp_Object specifier, Lisp_Object matchspec,
+ − 505 Lisp_Object domain, Lisp_Object instantiator,
+ − 506 Lisp_Object depth)
+ − 507 {
+ − 508 /* When called, we're inside of call_with_suspended_errors(),
+ − 509 so we can freely error. */
442
+ − 510 Lisp_Object device = DOMAIN_DEVICE (domain);
428
+ − 511 struct device *d = XDEVICE (device);
+ − 512
+ − 513 if (COLOR_INSTANCEP (instantiator))
+ − 514 {
+ − 515 /* If we are on the same device then we're done. Otherwise change
+ − 516 the instantiator to the name used to generate the pixel and let the
+ − 517 STRINGP case deal with it. */
+ − 518 if (NILP (device) /* Vthe_null_color_instance */
+ − 519 || EQ (device, XCOLOR_INSTANCE (instantiator)->device))
+ − 520 return instantiator;
+ − 521 else
+ − 522 instantiator = Fcolor_instance_name (instantiator);
+ − 523 }
+ − 524
+ − 525 if (STRINGP (instantiator))
+ − 526 {
+ − 527 /* First, look to see if we can retrieve a cached value. */
+ − 528 Lisp_Object instance =
+ − 529 Fgethash (instantiator, d->color_instance_cache, Qunbound);
+ − 530 /* Otherwise, make a new one. */
+ − 531 if (UNBOUNDP (instance))
+ − 532 {
+ − 533 /* make sure we cache the failures, too. */
+ − 534 instance = Fmake_color_instance (instantiator, device, Qt);
+ − 535 Fputhash (instantiator, instance, d->color_instance_cache);
+ − 536 }
+ − 537
+ − 538 return NILP (instance) ? Qunbound : instance;
+ − 539 }
+ − 540 else if (VECTORP (instantiator))
+ − 541 {
+ − 542 switch (XVECTOR_LENGTH (instantiator))
+ − 543 {
+ − 544 case 0:
+ − 545 if (DEVICE_TTY_P (d))
+ − 546 return Vthe_null_color_instance;
+ − 547 else
563
+ − 548 gui_error ("Color instantiator [] only valid on TTY's",
428
+ − 549 device);
+ − 550
+ − 551 case 1:
+ − 552 if (NILP (COLOR_SPECIFIER_FACE (XCOLOR_SPECIFIER (specifier))))
563
+ − 553 gui_error ("Color specifier not attached to a face",
428
+ − 554 instantiator);
+ − 555 return (FACE_PROPERTY_INSTANCE_1
+ − 556 (Fget_face (XVECTOR_DATA (instantiator)[0]),
+ − 557 COLOR_SPECIFIER_FACE_PROPERTY (XCOLOR_SPECIFIER (specifier)),
+ − 558 domain, ERROR_ME, 0, depth));
+ − 559
+ − 560 case 2:
+ − 561 return (FACE_PROPERTY_INSTANCE_1
+ − 562 (Fget_face (XVECTOR_DATA (instantiator)[0]),
+ − 563 XVECTOR_DATA (instantiator)[1], domain, ERROR_ME, 0, depth));
+ − 564
+ − 565 default:
+ − 566 abort ();
+ − 567 }
+ − 568 }
+ − 569 else if (NILP (instantiator))
+ − 570 {
+ − 571 if (DEVICE_TTY_P (d))
+ − 572 return Vthe_null_color_instance;
+ − 573 else
563
+ − 574 gui_error ("Color instantiator [] only valid on TTY's",
428
+ − 575 device);
+ − 576 }
+ − 577 else
+ − 578 abort (); /* The spec validation routines are screwed up. */
+ − 579
+ − 580 return Qunbound;
+ − 581 }
+ − 582
+ − 583 static void
+ − 584 color_validate (Lisp_Object instantiator)
+ − 585 {
+ − 586 if (COLOR_INSTANCEP (instantiator) || STRINGP (instantiator))
+ − 587 return;
+ − 588 if (VECTORP (instantiator))
+ − 589 {
+ − 590 if (XVECTOR_LENGTH (instantiator) > 2)
563
+ − 591 sferror ("Inheritance vector must be of size 0 - 2",
428
+ − 592 instantiator);
+ − 593 else if (XVECTOR_LENGTH (instantiator) > 0)
+ − 594 {
+ − 595 Lisp_Object face = XVECTOR_DATA (instantiator)[0];
+ − 596
+ − 597 Fget_face (face);
+ − 598 if (XVECTOR_LENGTH (instantiator) == 2)
+ − 599 {
+ − 600 Lisp_Object field = XVECTOR_DATA (instantiator)[1];
+ − 601 if (!EQ (field, Qforeground) && !EQ (field, Qbackground))
563
+ − 602 invalid_constant
428
+ − 603 ("Inheritance field must be `foreground' or `background'",
+ − 604 field);
+ − 605 }
+ − 606 }
+ − 607 }
+ − 608 else
563
+ − 609 invalid_argument ("Invalid color instantiator", instantiator);
428
+ − 610 }
+ − 611
+ − 612 static void
+ − 613 color_after_change (Lisp_Object specifier, Lisp_Object locale)
+ − 614 {
+ − 615 Lisp_Object face = COLOR_SPECIFIER_FACE (XCOLOR_SPECIFIER (specifier));
+ − 616 Lisp_Object property =
+ − 617 COLOR_SPECIFIER_FACE_PROPERTY (XCOLOR_SPECIFIER (specifier));
+ − 618 if (!NILP (face))
448
+ − 619 {
+ − 620 face_property_was_changed (face, property, locale);
+ − 621 if (BUFFERP (locale))
+ − 622 XBUFFER (locale)->buffer_local_face_property = 1;
+ − 623 }
428
+ − 624 }
+ − 625
+ − 626 void
+ − 627 set_color_attached_to (Lisp_Object obj, Lisp_Object face, Lisp_Object property)
+ − 628 {
440
+ − 629 Lisp_Specifier *color = XCOLOR_SPECIFIER (obj);
428
+ − 630
+ − 631 COLOR_SPECIFIER_FACE (color) = face;
+ − 632 COLOR_SPECIFIER_FACE_PROPERTY (color) = property;
+ − 633 }
+ − 634
+ − 635 DEFUN ("color-specifier-p", Fcolor_specifier_p, 1, 1, 0, /*
+ − 636 Return t if OBJECT is a color specifier.
+ − 637
442
+ − 638 See `make-color-specifier' for a description of possible color instantiators.
428
+ − 639 */
+ − 640 (object))
+ − 641 {
+ − 642 return COLOR_SPECIFIERP (object) ? Qt : Qnil;
+ − 643 }
+ − 644
+ − 645
+ − 646 /****************************************************************************
+ − 647 Font Object
+ − 648 ***************************************************************************/
+ − 649 DEFINE_SPECIFIER_TYPE (font);
+ − 650 /* Qfont defined in general.c */
+ − 651
+ − 652 static void
+ − 653 font_create (Lisp_Object obj)
+ − 654 {
440
+ − 655 Lisp_Specifier *font = XFONT_SPECIFIER (obj);
428
+ − 656
+ − 657 FONT_SPECIFIER_FACE (font) = Qnil;
+ − 658 FONT_SPECIFIER_FACE_PROPERTY (font) = Qnil;
+ − 659 }
+ − 660
+ − 661 static void
+ − 662 font_mark (Lisp_Object obj)
+ − 663 {
440
+ − 664 Lisp_Specifier *font = XFONT_SPECIFIER (obj);
428
+ − 665
+ − 666 mark_object (FONT_SPECIFIER_FACE (font));
+ − 667 mark_object (FONT_SPECIFIER_FACE_PROPERTY (font));
+ − 668 }
+ − 669
+ − 670 /* No equal or hash methods; ignore the face the font is based off
+ − 671 of for `equal' */
+ − 672
+ − 673 #ifdef MULE
+ − 674
+ − 675 int
+ − 676 font_spec_matches_charset (struct device *d, Lisp_Object charset,
442
+ − 677 const Bufbyte *nonreloc, Lisp_Object reloc,
428
+ − 678 Bytecount offset, Bytecount length)
+ − 679 {
+ − 680 return DEVMETH_OR_GIVEN (d, font_spec_matches_charset,
+ − 681 (d, charset, nonreloc, reloc, offset, length),
+ − 682 1);
+ − 683 }
+ − 684
+ − 685 static void
+ − 686 font_validate_matchspec (Lisp_Object matchspec)
+ − 687 {
+ − 688 Fget_charset (matchspec);
+ − 689 }
+ − 690
+ − 691 #endif /* MULE */
+ − 692
+ − 693
+ − 694 static Lisp_Object
+ − 695 font_instantiate (Lisp_Object specifier, Lisp_Object matchspec,
+ − 696 Lisp_Object domain, Lisp_Object instantiator,
+ − 697 Lisp_Object depth)
+ − 698 {
+ − 699 /* When called, we're inside of call_with_suspended_errors(),
+ − 700 so we can freely error. */
442
+ − 701 Lisp_Object device = DOMAIN_DEVICE (domain);
428
+ − 702 struct device *d = XDEVICE (device);
+ − 703 Lisp_Object instance;
+ − 704
+ − 705 #ifdef MULE
+ − 706 if (!UNBOUNDP (matchspec))
+ − 707 matchspec = Fget_charset (matchspec);
+ − 708 #endif
+ − 709
+ − 710 if (FONT_INSTANCEP (instantiator))
+ − 711 {
+ − 712 if (NILP (device)
+ − 713 || EQ (device, XFONT_INSTANCE (instantiator)->device))
+ − 714 {
+ − 715 #ifdef MULE
+ − 716 if (font_spec_matches_charset (d, matchspec, 0,
+ − 717 Ffont_instance_truename
+ − 718 (instantiator),
+ − 719 0, -1))
+ − 720 return instantiator;
+ − 721 #else
+ − 722 return instantiator;
+ − 723 #endif
+ − 724 }
+ − 725 instantiator = Ffont_instance_name (instantiator);
+ − 726 }
+ − 727
+ − 728 if (STRINGP (instantiator))
+ − 729 {
+ − 730 #ifdef MULE
+ − 731 if (!UNBOUNDP (matchspec))
+ − 732 {
+ − 733 /* The instantiator is a font spec that could match many
+ − 734 different fonts. We need to find one of those fonts
+ − 735 whose registry matches the registry of the charset in
+ − 736 MATCHSPEC. This is potentially a very slow operation,
+ − 737 as it involves doing an XListFonts() or equivalent to
+ − 738 iterate over all possible fonts, and a regexp match
+ − 739 on each one. So we cache the results. */
+ − 740 Lisp_Object matching_font = Qunbound;
+ − 741 Lisp_Object hash_table = Fgethash (matchspec, d->charset_font_cache,
+ − 742 Qunbound);
+ − 743 if (UNBOUNDP (hash_table))
+ − 744 {
+ − 745 /* need to make a sub hash table. */
+ − 746 hash_table = make_lisp_hash_table (20, HASH_TABLE_KEY_WEAK,
+ − 747 HASH_TABLE_EQUAL);
+ − 748 Fputhash (matchspec, hash_table, d->charset_font_cache);
+ − 749 }
+ − 750 else
+ − 751 matching_font = Fgethash (instantiator, hash_table, Qunbound);
+ − 752
+ − 753 if (UNBOUNDP (matching_font))
+ − 754 {
+ − 755 /* make sure we cache the failures, too. */
+ − 756 matching_font =
+ − 757 DEVMETH_OR_GIVEN (d, find_charset_font,
+ − 758 (device, instantiator, matchspec),
+ − 759 instantiator);
+ − 760 Fputhash (instantiator, matching_font, hash_table);
+ − 761 }
+ − 762 if (NILP (matching_font))
+ − 763 return Qunbound;
+ − 764 instantiator = matching_font;
+ − 765 }
+ − 766 #endif /* MULE */
+ − 767
+ − 768 /* First, look to see if we can retrieve a cached value. */
+ − 769 instance = Fgethash (instantiator, d->font_instance_cache, Qunbound);
+ − 770 /* Otherwise, make a new one. */
+ − 771 if (UNBOUNDP (instance))
+ − 772 {
+ − 773 /* make sure we cache the failures, too. */
+ − 774 instance = Fmake_font_instance (instantiator, device, Qt);
+ − 775 Fputhash (instantiator, instance, d->font_instance_cache);
+ − 776 }
+ − 777
+ − 778 return NILP (instance) ? Qunbound : instance;
+ − 779 }
+ − 780 else if (VECTORP (instantiator))
+ − 781 {
+ − 782 assert (XVECTOR_LENGTH (instantiator) == 1);
+ − 783 return (face_property_matching_instance
+ − 784 (Fget_face (XVECTOR_DATA (instantiator)[0]), Qfont,
+ − 785 matchspec, domain, ERROR_ME, 0, depth));
+ − 786 }
+ − 787 else if (NILP (instantiator))
+ − 788 return Qunbound;
+ − 789 else
+ − 790 abort (); /* Eh? */
+ − 791
+ − 792 return Qunbound;
+ − 793 }
+ − 794
+ − 795 static void
+ − 796 font_validate (Lisp_Object instantiator)
+ − 797 {
+ − 798 if (FONT_INSTANCEP (instantiator) || STRINGP (instantiator))
+ − 799 return;
+ − 800 if (VECTORP (instantiator))
+ − 801 {
+ − 802 if (XVECTOR_LENGTH (instantiator) != 1)
+ − 803 {
563
+ − 804 sferror
428
+ − 805 ("Vector length must be one for font inheritance", instantiator);
+ − 806 }
+ − 807 Fget_face (XVECTOR_DATA (instantiator)[0]);
+ − 808 }
+ − 809 else
563
+ − 810 invalid_argument ("Must be string, vector, or font-instance",
428
+ − 811 instantiator);
+ − 812 }
+ − 813
+ − 814 static void
+ − 815 font_after_change (Lisp_Object specifier, Lisp_Object locale)
+ − 816 {
+ − 817 Lisp_Object face = FONT_SPECIFIER_FACE (XFONT_SPECIFIER (specifier));
+ − 818 Lisp_Object property =
+ − 819 FONT_SPECIFIER_FACE_PROPERTY (XFONT_SPECIFIER (specifier));
+ − 820 if (!NILP (face))
448
+ − 821 {
+ − 822 face_property_was_changed (face, property, locale);
+ − 823 if (BUFFERP (locale))
+ − 824 XBUFFER (locale)->buffer_local_face_property = 1;
+ − 825 }
428
+ − 826 }
+ − 827
+ − 828 void
+ − 829 set_font_attached_to (Lisp_Object obj, Lisp_Object face, Lisp_Object property)
+ − 830 {
440
+ − 831 Lisp_Specifier *font = XFONT_SPECIFIER (obj);
428
+ − 832
+ − 833 FONT_SPECIFIER_FACE (font) = face;
+ − 834 FONT_SPECIFIER_FACE_PROPERTY (font) = property;
+ − 835 }
+ − 836
+ − 837 DEFUN ("font-specifier-p", Ffont_specifier_p, 1, 1, 0, /*
+ − 838 Return non-nil if OBJECT is a font specifier.
+ − 839
442
+ − 840 See `make-font-specifier' for a description of possible font instantiators.
428
+ − 841 */
+ − 842 (object))
+ − 843 {
+ − 844 return FONT_SPECIFIERP (object) ? Qt : Qnil;
+ − 845 }
+ − 846
+ − 847
+ − 848 /*****************************************************************************
+ − 849 Face Boolean Object
+ − 850 ****************************************************************************/
+ − 851 DEFINE_SPECIFIER_TYPE (face_boolean);
+ − 852 Lisp_Object Qface_boolean;
+ − 853
+ − 854 static void
+ − 855 face_boolean_create (Lisp_Object obj)
+ − 856 {
440
+ − 857 Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj);
428
+ − 858
+ − 859 FACE_BOOLEAN_SPECIFIER_FACE (face_boolean) = Qnil;
+ − 860 FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (face_boolean) = Qnil;
+ − 861 }
+ − 862
+ − 863 static void
+ − 864 face_boolean_mark (Lisp_Object obj)
+ − 865 {
440
+ − 866 Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj);
428
+ − 867
+ − 868 mark_object (FACE_BOOLEAN_SPECIFIER_FACE (face_boolean));
+ − 869 mark_object (FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (face_boolean));
+ − 870 }
+ − 871
+ − 872 /* No equal or hash methods; ignore the face the face-boolean is based off
+ − 873 of for `equal' */
+ − 874
+ − 875 static Lisp_Object
+ − 876 face_boolean_instantiate (Lisp_Object specifier, Lisp_Object matchspec,
+ − 877 Lisp_Object domain, Lisp_Object instantiator,
+ − 878 Lisp_Object depth)
+ − 879 {
+ − 880 /* When called, we're inside of call_with_suspended_errors(),
+ − 881 so we can freely error. */
+ − 882 if (NILP (instantiator) || EQ (instantiator, Qt))
+ − 883 return instantiator;
+ − 884 else if (VECTORP (instantiator))
+ − 885 {
+ − 886 Lisp_Object retval;
+ − 887 Lisp_Object prop;
+ − 888 int instantiator_len = XVECTOR_LENGTH (instantiator);
+ − 889
+ − 890 assert (instantiator_len >= 1 && instantiator_len <= 3);
+ − 891 if (instantiator_len > 1)
+ − 892 prop = XVECTOR_DATA (instantiator)[1];
+ − 893 else
+ − 894 {
+ − 895 if (NILP (FACE_BOOLEAN_SPECIFIER_FACE
+ − 896 (XFACE_BOOLEAN_SPECIFIER (specifier))))
563
+ − 897 gui_error
428
+ − 898 ("Face-boolean specifier not attached to a face", instantiator);
+ − 899 prop = FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY
+ − 900 (XFACE_BOOLEAN_SPECIFIER (specifier));
+ − 901 }
+ − 902
+ − 903 retval = (FACE_PROPERTY_INSTANCE_1
+ − 904 (Fget_face (XVECTOR_DATA (instantiator)[0]),
+ − 905 prop, domain, ERROR_ME, 0, depth));
+ − 906
+ − 907 if (instantiator_len == 3 && !NILP (XVECTOR_DATA (instantiator)[2]))
+ − 908 retval = NILP (retval) ? Qt : Qnil;
+ − 909
+ − 910 return retval;
+ − 911 }
+ − 912 else
+ − 913 abort (); /* Eh? */
+ − 914
+ − 915 return Qunbound;
+ − 916 }
+ − 917
+ − 918 static void
+ − 919 face_boolean_validate (Lisp_Object instantiator)
+ − 920 {
+ − 921 if (NILP (instantiator) || EQ (instantiator, Qt))
+ − 922 return;
+ − 923 else if (VECTORP (instantiator) &&
+ − 924 (XVECTOR_LENGTH (instantiator) >= 1 &&
+ − 925 XVECTOR_LENGTH (instantiator) <= 3))
+ − 926 {
+ − 927 Lisp_Object face = XVECTOR_DATA (instantiator)[0];
+ − 928
+ − 929 Fget_face (face);
+ − 930
+ − 931 if (XVECTOR_LENGTH (instantiator) > 1)
+ − 932 {
+ − 933 Lisp_Object field = XVECTOR_DATA (instantiator)[1];
+ − 934 if (!EQ (field, Qunderline)
+ − 935 && !EQ (field, Qstrikethru)
+ − 936 && !EQ (field, Qhighlight)
+ − 937 && !EQ (field, Qdim)
+ − 938 && !EQ (field, Qblinking)
+ − 939 && !EQ (field, Qreverse))
563
+ − 940 invalid_constant ("Invalid face-boolean inheritance field",
428
+ − 941 field);
+ − 942 }
+ − 943 }
+ − 944 else if (VECTORP (instantiator))
563
+ − 945 sferror ("Wrong length for face-boolean inheritance spec",
428
+ − 946 instantiator);
+ − 947 else
563
+ − 948 invalid_argument ("Face-boolean instantiator must be nil, t, or vector",
428
+ − 949 instantiator);
+ − 950 }
+ − 951
+ − 952 static void
+ − 953 face_boolean_after_change (Lisp_Object specifier, Lisp_Object locale)
+ − 954 {
+ − 955 Lisp_Object face =
+ − 956 FACE_BOOLEAN_SPECIFIER_FACE (XFACE_BOOLEAN_SPECIFIER (specifier));
+ − 957 Lisp_Object property =
+ − 958 FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (XFACE_BOOLEAN_SPECIFIER (specifier));
+ − 959 if (!NILP (face))
448
+ − 960 {
+ − 961 face_property_was_changed (face, property, locale);
+ − 962 if (BUFFERP (locale))
+ − 963 XBUFFER (locale)->buffer_local_face_property = 1;
+ − 964 }
428
+ − 965 }
+ − 966
+ − 967 void
+ − 968 set_face_boolean_attached_to (Lisp_Object obj, Lisp_Object face,
+ − 969 Lisp_Object property)
+ − 970 {
440
+ − 971 Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj);
428
+ − 972
+ − 973 FACE_BOOLEAN_SPECIFIER_FACE (face_boolean) = face;
+ − 974 FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (face_boolean) = property;
+ − 975 }
+ − 976
+ − 977 DEFUN ("face-boolean-specifier-p", Fface_boolean_specifier_p, 1, 1, 0, /*
+ − 978 Return non-nil if OBJECT is a face-boolean specifier.
+ − 979
442
+ − 980 See `make-face-boolean-specifier' for a description of possible
+ − 981 face-boolean instantiators.
428
+ − 982 */
+ − 983 (object))
+ − 984 {
+ − 985 return FACE_BOOLEAN_SPECIFIERP (object) ? Qt : Qnil;
+ − 986 }
+ − 987
+ − 988
+ − 989 /************************************************************************/
+ − 990 /* initialization */
+ − 991 /************************************************************************/
+ − 992
+ − 993 void
+ − 994 syms_of_objects (void)
+ − 995 {
442
+ − 996 INIT_LRECORD_IMPLEMENTATION (color_instance);
+ − 997 INIT_LRECORD_IMPLEMENTATION (font_instance);
+ − 998
428
+ − 999 DEFSUBR (Fcolor_specifier_p);
+ − 1000 DEFSUBR (Ffont_specifier_p);
+ − 1001 DEFSUBR (Fface_boolean_specifier_p);
+ − 1002
563
+ − 1003 DEFSYMBOL_MULTIWORD_PREDICATE (Qcolor_instancep);
428
+ − 1004 DEFSUBR (Fmake_color_instance);
+ − 1005 DEFSUBR (Fcolor_instance_p);
+ − 1006 DEFSUBR (Fcolor_instance_name);
+ − 1007 DEFSUBR (Fcolor_instance_rgb_components);
+ − 1008 DEFSUBR (Fvalid_color_name_p);
+ − 1009
563
+ − 1010 DEFSYMBOL_MULTIWORD_PREDICATE (Qfont_instancep);
428
+ − 1011 DEFSUBR (Fmake_font_instance);
+ − 1012 DEFSUBR (Ffont_instance_p);
+ − 1013 DEFSUBR (Ffont_instance_name);
+ − 1014 DEFSUBR (Ffont_instance_ascent);
+ − 1015 DEFSUBR (Ffont_instance_descent);
+ − 1016 DEFSUBR (Ffont_instance_width);
+ − 1017 DEFSUBR (Ffont_instance_proportional_p);
+ − 1018 DEFSUBR (Ffont_instance_truename);
+ − 1019 DEFSUBR (Ffont_instance_properties);
+ − 1020 DEFSUBR (Flist_fonts);
+ − 1021
+ − 1022 /* Qcolor, Qfont defined in general.c */
563
+ − 1023 DEFSYMBOL (Qface_boolean);
428
+ − 1024 }
+ − 1025
+ − 1026 static const struct lrecord_description color_specifier_description[] = {
440
+ − 1027 { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct color_specifier, face) },
+ − 1028 { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct color_specifier, face_property) },
428
+ − 1029 { XD_END }
+ − 1030 };
+ − 1031
+ − 1032 static const struct lrecord_description font_specifier_description[] = {
440
+ − 1033 { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct font_specifier, face) },
+ − 1034 { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct font_specifier, face_property) },
428
+ − 1035 { XD_END }
+ − 1036 };
+ − 1037
+ − 1038 static const struct lrecord_description face_boolean_specifier_description[] = {
440
+ − 1039 { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct face_boolean_specifier, face) },
+ − 1040 { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct face_boolean_specifier, face_property) },
428
+ − 1041 { XD_END }
+ − 1042 };
+ − 1043
+ − 1044 void
+ − 1045 specifier_type_create_objects (void)
+ − 1046 {
+ − 1047 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (color, "color", "color-specifier-p");
+ − 1048 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (font, "font", "font-specifier-p");
+ − 1049 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (face_boolean, "face-boolean",
+ − 1050 "face-boolean-specifier-p");
+ − 1051
+ − 1052 SPECIFIER_HAS_METHOD (color, instantiate);
+ − 1053 SPECIFIER_HAS_METHOD (font, instantiate);
+ − 1054 SPECIFIER_HAS_METHOD (face_boolean, instantiate);
+ − 1055
+ − 1056 SPECIFIER_HAS_METHOD (color, validate);
+ − 1057 SPECIFIER_HAS_METHOD (font, validate);
+ − 1058 SPECIFIER_HAS_METHOD (face_boolean, validate);
+ − 1059
+ − 1060 SPECIFIER_HAS_METHOD (color, create);
+ − 1061 SPECIFIER_HAS_METHOD (font, create);
+ − 1062 SPECIFIER_HAS_METHOD (face_boolean, create);
+ − 1063
+ − 1064 SPECIFIER_HAS_METHOD (color, mark);
+ − 1065 SPECIFIER_HAS_METHOD (font, mark);
+ − 1066 SPECIFIER_HAS_METHOD (face_boolean, mark);
+ − 1067
+ − 1068 SPECIFIER_HAS_METHOD (color, after_change);
+ − 1069 SPECIFIER_HAS_METHOD (font, after_change);
+ − 1070 SPECIFIER_HAS_METHOD (face_boolean, after_change);
+ − 1071
+ − 1072 #ifdef MULE
+ − 1073 SPECIFIER_HAS_METHOD (font, validate_matchspec);
+ − 1074 #endif
+ − 1075 }
+ − 1076
+ − 1077 void
+ − 1078 reinit_specifier_type_create_objects (void)
+ − 1079 {
+ − 1080 REINITIALIZE_SPECIFIER_TYPE (color);
+ − 1081 REINITIALIZE_SPECIFIER_TYPE (font);
+ − 1082 REINITIALIZE_SPECIFIER_TYPE (face_boolean);
+ − 1083 }
+ − 1084
+ − 1085 void
+ − 1086 reinit_vars_of_objects (void)
+ − 1087 {
+ − 1088 staticpro_nodump (&Vthe_null_color_instance);
+ − 1089 {
440
+ − 1090 Lisp_Color_Instance *c =
+ − 1091 alloc_lcrecord_type (Lisp_Color_Instance, &lrecord_color_instance);
428
+ − 1092 c->name = Qnil;
+ − 1093 c->device = Qnil;
+ − 1094 c->data = 0;
+ − 1095
+ − 1096 XSETCOLOR_INSTANCE (Vthe_null_color_instance, c);
+ − 1097 }
+ − 1098
+ − 1099 staticpro_nodump (&Vthe_null_font_instance);
+ − 1100 {
440
+ − 1101 Lisp_Font_Instance *f =
+ − 1102 alloc_lcrecord_type (Lisp_Font_Instance, &lrecord_font_instance);
428
+ − 1103 f->name = Qnil;
+ − 1104 f->device = Qnil;
+ − 1105 f->data = 0;
+ − 1106
+ − 1107 f->ascent = f->height = 0;
+ − 1108 f->descent = 0;
+ − 1109 f->width = 0;
+ − 1110 f->proportional_p = 0;
+ − 1111
+ − 1112 XSETFONT_INSTANCE (Vthe_null_font_instance, f);
+ − 1113 }
+ − 1114 }
+ − 1115
+ − 1116 void
+ − 1117 vars_of_objects (void)
+ − 1118 {
+ − 1119 reinit_vars_of_objects ();
+ − 1120 }
