462
+ − 1 /* X-specific Lisp objects.
+ − 2 Copyright (C) 1993, 1994 Free Software Foundation, Inc.
+ − 3 Copyright (C) 1995 Board of Trustees, University of Illinois.
+ − 4 Copyright (C) 1995 Tinker Systems.
+ − 5 Copyright (C) 1995, 1996 Ben Wing.
+ − 6 Copyright (C) 1995 Sun Microsystems, Inc.
+ − 7
+ − 8 This file is part of XEmacs.
+ − 9
+ − 10 XEmacs is free software; you can redistribute it and/or modify it
+ − 11 under the terms of the GNU General Public License as published by the
+ − 12 Free Software Foundation; either version 2, or (at your option) any
+ − 13 later version.
+ − 14
+ − 15 XEmacs is distributed in the hope that it will be useful, but WITHOUT
+ − 16 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+ − 17 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+ − 18 for more details.
+ − 19
+ − 20 You should have received a copy of the GNU General Public License
+ − 21 along with XEmacs; see the file COPYING. If not, write to
+ − 22 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+ − 23 Boston, MA 02111-1307, USA. */
+ − 24
+ − 25 /* Synched up with: Not in FSF. */
+ − 26
+ − 27 /* Authors: Jamie Zawinski, Chuck Thompson, Ben Wing */
+ − 28 /* Gtk version by William Perry */
+ − 29
+ − 30 #include <config.h>
+ − 31 #include "lisp.h"
+ − 32
+ − 33 #include "console-gtk.h"
+ − 34 #include "objects-gtk.h"
+ − 35
+ − 36 #include "buffer.h"
+ − 37 #include "device.h"
+ − 38 #include "insdel.h"
+ − 39
+ − 40 /* sigh */
+ − 41 #include <gdk/gdkx.h>
+ − 42
+ − 43
+ − 44 /************************************************************************/
+ − 45 /* color instances */
+ − 46 /************************************************************************/
+ − 47
+ − 48 /* Replacement for XAllocColor() that tries to return the nearest
+ − 49 available color if the colormap is full. Original was from FSFmacs,
+ − 50 but rewritten by Jareth Hein <jareth@camelot-soft.com> 97/11/25
+ − 51 Modified by Lee Kindness <lkindness@csl.co.uk> 31/08/99 to handle previous
+ − 52 total failure which was due to a read/write colorcell being the nearest
+ − 53 match - tries the next nearest...
+ − 54
+ − 55 Gdk takes care of all this behind the scenes, so we don't need to
+ − 56 worry about it.
+ − 57
+ − 58 Return value is 1 for normal success, 2 for nearest color success,
+ − 59 3 for Non-deallocable sucess. */
+ − 60 int
+ − 61 allocate_nearest_color (GdkColormap *colormap, GdkVisual *visual,
+ − 62 GdkColor *color_def)
+ − 63 {
+ − 64 int rc;
+ − 65
+ − 66 rc = gdk_colormap_alloc_color (colormap, color_def, FALSE, TRUE);
+ − 67
+ − 68 if (rc == TRUE)
+ − 69 return (1);
+ − 70
+ − 71 return (0);
+ − 72 }
+ − 73
+ − 74 int
665
+ − 75 gtk_parse_nearest_color (struct device *d, GdkColor *color, Intbyte *name,
578
+ − 76 Bytecount len, Error_Behavior errb)
462
+ − 77 {
+ − 78 GdkColormap *cmap;
+ − 79 GdkVisual *visual;
+ − 80 int result;
+ − 81
+ − 82 cmap = DEVICE_GTK_COLORMAP(d);
+ − 83 visual = DEVICE_GTK_VISUAL (d);
+ − 84
+ − 85 xzero (*color);
+ − 86 {
+ − 87 const Extbyte *extname;
665
+ − 88 Bytecount extnamelen;
462
+ − 89
+ − 90 TO_EXTERNAL_FORMAT (DATA, (name, len), ALLOCA, (extname, extnamelen), Qbinary);
+ − 91
+ − 92 result = gdk_color_parse (extname, color);
+ − 93 }
+ − 94
+ − 95 if (result == FALSE)
+ − 96 {
563
+ − 97 maybe_invalid_argument ("unrecognized color", make_string (name, len),
+ − 98 Qcolor, errb);
462
+ − 99 return 0;
+ − 100 }
+ − 101 result = allocate_nearest_color (cmap, visual, color);
+ − 102 if (!result)
+ − 103 {
563
+ − 104 maybe_signal_error (Qgui_error, "couldn't allocate color",
+ − 105 make_string (name, len), Qcolor, errb);
462
+ − 106 return 0;
+ − 107 }
+ − 108
+ − 109 return result;
+ − 110 }
+ − 111
+ − 112 static int
+ − 113 gtk_initialize_color_instance (struct Lisp_Color_Instance *c, Lisp_Object name,
578
+ − 114 Lisp_Object device, Error_Behavior errb)
462
+ − 115 {
+ − 116 GdkColor color;
+ − 117 int result;
+ − 118
+ − 119 result = gtk_parse_nearest_color (XDEVICE (device), &color,
+ − 120 XSTRING_DATA (name),
+ − 121 XSTRING_LENGTH (name),
+ − 122 errb);
+ − 123
+ − 124 if (!result)
+ − 125 return 0;
+ − 126
+ − 127 /* Don't allocate the data until we're sure that we will succeed,
+ − 128 or the finalize method may get fucked. */
+ − 129 c->data = xnew (struct gtk_color_instance_data);
+ − 130 if (result == 3)
+ − 131 COLOR_INSTANCE_GTK_DEALLOC (c) = 0;
+ − 132 else
+ − 133 COLOR_INSTANCE_GTK_DEALLOC (c) = 1;
+ − 134 COLOR_INSTANCE_GTK_COLOR (c) = gdk_color_copy (&color);
+ − 135 return 1;
+ − 136 }
+ − 137
+ − 138 static void
+ − 139 gtk_print_color_instance (struct Lisp_Color_Instance *c,
+ − 140 Lisp_Object printcharfun,
+ − 141 int escapeflag)
+ − 142 {
+ − 143 char buf[100];
+ − 144 GdkColor *color = COLOR_INSTANCE_GTK_COLOR (c);
+ − 145 sprintf (buf, " %ld=(%X,%X,%X)",
+ − 146 color->pixel, color->red, color->green, color->blue);
+ − 147 write_c_string (buf, printcharfun);
+ − 148 }
+ − 149
+ − 150 static void
+ − 151 gtk_finalize_color_instance (struct Lisp_Color_Instance *c)
+ − 152 {
+ − 153 if (c->data)
+ − 154 {
+ − 155 if (DEVICE_LIVE_P (XDEVICE (c->device)))
+ − 156 {
+ − 157 if (COLOR_INSTANCE_GTK_DEALLOC (c))
+ − 158 {
+ − 159 gdk_colormap_free_colors (DEVICE_GTK_COLORMAP (XDEVICE (c->device)),
+ − 160 COLOR_INSTANCE_GTK_COLOR (c), 1);
+ − 161 }
+ − 162 gdk_color_free (COLOR_INSTANCE_GTK_COLOR (c));
+ − 163 }
+ − 164 xfree (c->data);
+ − 165 c->data = 0;
+ − 166 }
+ − 167 }
+ − 168
+ − 169 /* Color instances are equal if they resolve to the same color on the
+ − 170 screen (have the same RGB values). I imagine that
+ − 171 "same RGB values" == "same cell in the colormap." Arguably we should
+ − 172 be comparing their names or pixel values instead. */
+ − 173
+ − 174 static int
+ − 175 gtk_color_instance_equal (struct Lisp_Color_Instance *c1,
+ − 176 struct Lisp_Color_Instance *c2,
+ − 177 int depth)
+ − 178 {
+ − 179 return (gdk_color_equal (COLOR_INSTANCE_GTK_COLOR (c1),
+ − 180 COLOR_INSTANCE_GTK_COLOR (c2)));
+ − 181 }
+ − 182
+ − 183 static unsigned long
+ − 184 gtk_color_instance_hash (struct Lisp_Color_Instance *c, int depth)
+ − 185 {
+ − 186 return (gdk_color_hash (COLOR_INSTANCE_GTK_COLOR (c), NULL));
+ − 187 }
+ − 188
+ − 189 static Lisp_Object
+ − 190 gtk_color_instance_rgb_components (struct Lisp_Color_Instance *c)
+ − 191 {
+ − 192 GdkColor *color = COLOR_INSTANCE_GTK_COLOR (c);
+ − 193 return (list3 (make_int (color->red),
+ − 194 make_int (color->green),
+ − 195 make_int (color->blue)));
+ − 196 }
+ − 197
+ − 198 static int
+ − 199 gtk_valid_color_name_p (struct device *d, Lisp_Object color)
+ − 200 {
+ − 201 GdkColor c;
+ − 202 const char *extname;
+ − 203
+ − 204 TO_EXTERNAL_FORMAT (LISP_STRING, color, C_STRING_ALLOCA, extname, Qctext);
+ − 205
+ − 206 if (gdk_color_parse (extname, &c) != TRUE)
+ − 207 return(0);
+ − 208 return (1);
+ − 209 }
+ − 210
+ − 211
+ − 212 /************************************************************************/
+ − 213 /* font instances */
+ − 214 /************************************************************************/
+ − 215
+ − 216 static int
+ − 217 gtk_initialize_font_instance (struct Lisp_Font_Instance *f, Lisp_Object name,
578
+ − 218 Lisp_Object device, Error_Behavior errb)
462
+ − 219 {
+ − 220 GdkFont *gf;
+ − 221 XFontStruct *xf;
+ − 222 const char *extname;
+ − 223
+ − 224 TO_EXTERNAL_FORMAT (LISP_STRING, f->name, C_STRING_ALLOCA, extname, Qctext);
+ − 225
+ − 226 gf = gdk_font_load (extname);
+ − 227
+ − 228 if (!gf)
+ − 229 {
563
+ − 230 maybe_signal_error (Qgui_error, "couldn't load font", f->name,
+ − 231 Qfont, errb);
462
+ − 232 return 0;
+ − 233 }
+ − 234
+ − 235 xf = GDK_FONT_XFONT (gf);
+ − 236
+ − 237 /* Don't allocate the data until we're sure that we will succeed,
+ − 238 or the finalize method may get fucked. */
+ − 239 f->data = xnew (struct gtk_font_instance_data);
+ − 240 FONT_INSTANCE_GTK_TRUENAME (f) = Qnil;
+ − 241 FONT_INSTANCE_GTK_FONT (f) = gf;
+ − 242 f->ascent = gf->ascent;
+ − 243 f->descent = gf->descent;
+ − 244 f->height = gf->ascent + gf->descent;
+ − 245
+ − 246 /* Now lets figure out the width of the font */
+ − 247 {
+ − 248 /* following change suggested by Ted Phelps <phelps@dstc.edu.au> */
+ − 249 unsigned int def_char = 'n'; /*xf->default_char;*/
+ − 250 unsigned int byte1, byte2;
+ − 251
+ − 252 once_more:
+ − 253 byte1 = def_char >> 8;
+ − 254 byte2 = def_char & 0xFF;
+ − 255
+ − 256 if (xf->per_char)
+ − 257 {
+ − 258 /* Old versions of the R5 font server have garbage (>63k) as
+ − 259 def_char. 'n' might not be a valid character. */
+ − 260 if (byte1 < xf->min_byte1 ||
+ − 261 byte1 > xf->max_byte1 ||
+ − 262 byte2 < xf->min_char_or_byte2 ||
+ − 263 byte2 > xf->max_char_or_byte2)
+ − 264 f->width = 0;
+ − 265 else
+ − 266 f->width = xf->per_char[(byte1 - xf->min_byte1) *
+ − 267 (xf->max_char_or_byte2 -
+ − 268 xf->min_char_or_byte2 + 1) +
+ − 269 (byte2 - xf->min_char_or_byte2)].width;
+ − 270 }
+ − 271 else
+ − 272 f->width = xf->max_bounds.width;
+ − 273
+ − 274 /* Some fonts have a default char whose width is 0. This is no good.
+ − 275 If that's the case, first try 'n' as the default char, and if n has
+ − 276 0 width too (unlikely) then just use the max width. */
+ − 277 if (f->width == 0)
+ − 278 {
+ − 279 if (def_char == xf->default_char)
+ − 280 f->width = xf->max_bounds.width;
+ − 281 else
+ − 282 {
+ − 283 def_char = xf->default_char;
+ − 284 goto once_more;
+ − 285 }
+ − 286 }
+ − 287 }
+ − 288
+ − 289 /* If all characters don't exist then there could potentially be
+ − 290 0-width characters lurking out there. Not setting this flag
+ − 291 trips an optimization that would make them appear to have width
+ − 292 to redisplay. This is bad. So we set it if not all characters
+ − 293 have the same width or if not all characters are defined.
+ − 294 */
+ − 295 /* #### This sucks. There is a measurable performance increase
+ − 296 when using proportional width fonts if this flag is not set.
+ − 297 Unfortunately so many of the fucking X fonts are not fully
+ − 298 defined that we could almost just get rid of this damn flag and
+ − 299 make it an assertion. */
+ − 300 f->proportional_p = (xf->min_bounds.width != xf->max_bounds.width ||
+ − 301 (/* x_handle_non_fully_specified_fonts */ 0 &&
+ − 302 !xf->all_chars_exist));
+ − 303 #if 0
+ − 304 f->width = gdk_char_width (gf, 'n');
+ − 305 f->proportional_p = (gdk_char_width (gf, '|') != gdk_char_width (gf, 'W')) ? 1 : 0;
+ − 306 #endif
+ − 307 return 1;
+ − 308 }
+ − 309
+ − 310 static void
+ − 311 gtk_mark_font_instance (struct Lisp_Font_Instance *f)
+ − 312 {
+ − 313 mark_object (FONT_INSTANCE_GTK_TRUENAME (f));
+ − 314 }
+ − 315
+ − 316 static void
+ − 317 gtk_print_font_instance (struct Lisp_Font_Instance *f,
+ − 318 Lisp_Object printcharfun,
+ − 319 int escapeflag)
+ − 320 {
+ − 321 char buf[200];
+ − 322 sprintf (buf, " 0x%lx", (unsigned long) gdk_font_id (FONT_INSTANCE_GTK_FONT (f)));
+ − 323 write_c_string (buf, printcharfun);
+ − 324 }
+ − 325
+ − 326 static void
+ − 327 gtk_finalize_font_instance (struct Lisp_Font_Instance *f)
+ − 328 {
+ − 329 if (f->data)
+ − 330 {
+ − 331 if (DEVICE_LIVE_P (XDEVICE (f->device)))
+ − 332 {
+ − 333 gdk_font_unref (FONT_INSTANCE_GTK_FONT (f));
+ − 334 }
+ − 335 xfree (f->data);
+ − 336 f->data = 0;
+ − 337 }
+ − 338 }
+ − 339
+ − 340 /* Forward declarations for X specific functions at the end of the file */
+ − 341 Lisp_Object __get_gtk_font_truename (GdkFont *gdk_font, int expandp);
+ − 342 static Lisp_Object __gtk_list_fonts_internal (const char *pattern);
+ − 343
+ − 344 static Lisp_Object
578
+ − 345 gtk_font_instance_truename (struct Lisp_Font_Instance *f, Error_Behavior errb)
462
+ − 346 {
+ − 347 if (NILP (FONT_INSTANCE_GTK_TRUENAME (f)))
+ − 348 {
+ − 349 FONT_INSTANCE_GTK_TRUENAME (f) = __get_gtk_font_truename (FONT_INSTANCE_GTK_FONT (f), 1);
+ − 350
+ − 351 if (NILP (FONT_INSTANCE_GTK_TRUENAME (f)))
+ − 352 {
+ − 353 /* Ok, just this once, return the font name as the truename.
+ − 354 (This is only used by Fequal() right now.) */
+ − 355 return f->name;
+ − 356 }
+ − 357 }
+ − 358 return (FONT_INSTANCE_GTK_TRUENAME (f));
+ − 359 }
+ − 360
+ − 361 static Lisp_Object
+ − 362 gtk_font_instance_properties (struct Lisp_Font_Instance *f)
+ − 363 {
+ − 364 Lisp_Object result = Qnil;
+ − 365
+ − 366 /* #### BILL!!! */
+ − 367 /* There seems to be no way to get this information under Gtk */
+ − 368 return result;
+ − 369 }
+ − 370
+ − 371 static Lisp_Object
+ − 372 gtk_list_fonts (Lisp_Object pattern, Lisp_Object device)
+ − 373 {
+ − 374 const char *patternext;
+ − 375
+ − 376 TO_EXTERNAL_FORMAT (LISP_STRING, pattern, C_STRING_ALLOCA, patternext, Qbinary);
+ − 377
+ − 378 return (__gtk_list_fonts_internal (patternext));
+ − 379 }
+ − 380
+ − 381 #ifdef MULE
+ − 382
+ − 383 static int
+ − 384 gtk_font_spec_matches_charset (struct device *d, Lisp_Object charset,
665
+ − 385 const Intbyte *nonreloc, Lisp_Object reloc,
462
+ − 386 Bytecount offset, Bytecount length)
+ − 387 {
+ − 388 if (UNBOUNDP (charset))
+ − 389 return 1;
+ − 390 /* Hack! Short font names don't have the registry in them,
+ − 391 so we just assume the user knows what they're doing in the
+ − 392 case of ASCII. For other charsets, you gotta give the
+ − 393 long form; sorry buster.
+ − 394 */
+ − 395 if (EQ (charset, Vcharset_ascii))
+ − 396 {
665
+ − 397 const Intbyte *the_nonreloc = nonreloc;
462
+ − 398 int i;
+ − 399 Bytecount the_length = length;
+ − 400
+ − 401 if (!the_nonreloc)
+ − 402 the_nonreloc = XSTRING_DATA (reloc);
+ − 403 fixup_internal_substring (nonreloc, reloc, offset, &the_length);
+ − 404 the_nonreloc += offset;
+ − 405 if (!memchr (the_nonreloc, '*', the_length))
+ − 406 {
+ − 407 for (i = 0;; i++)
+ − 408 {
665
+ − 409 const Intbyte *new_nonreloc = (const Intbyte *)
462
+ − 410 memchr (the_nonreloc, '-', the_length);
+ − 411 if (!new_nonreloc)
+ − 412 break;
+ − 413 new_nonreloc++;
+ − 414 the_length -= new_nonreloc - the_nonreloc;
+ − 415 the_nonreloc = new_nonreloc;
+ − 416 }
+ − 417
+ − 418 /* If it has less than 5 dashes, it's a short font.
+ − 419 Of course, long fonts always have 14 dashes or so, but short
+ − 420 fonts never have more than 1 or 2 dashes, so this is some
+ − 421 sort of reasonable heuristic. */
+ − 422 if (i < 5)
+ − 423 return 1;
+ − 424 }
+ − 425 }
+ − 426
+ − 427 return (fast_string_match (XCHARSET_REGISTRY (charset),
+ − 428 nonreloc, reloc, offset, length, 1,
+ − 429 ERROR_ME, 0) >= 0);
+ − 430 }
+ − 431
+ − 432 /* find a font spec that matches font spec FONT and also matches
+ − 433 (the registry of) CHARSET. */
+ − 434 static Lisp_Object gtk_find_charset_font (Lisp_Object device, Lisp_Object font, Lisp_Object charset);
+ − 435
+ − 436 #endif /* MULE */
+ − 437
+ − 438
+ − 439 /************************************************************************/
+ − 440 /* initialization */
+ − 441 /************************************************************************/
+ − 442
+ − 443 void
+ − 444 syms_of_objects_gtk (void)
+ − 445 {
+ − 446 }
+ − 447
+ − 448 void
+ − 449 console_type_create_objects_gtk (void)
+ − 450 {
+ − 451 /* object methods */
+ − 452
+ − 453 CONSOLE_HAS_METHOD (gtk, initialize_color_instance);
+ − 454 CONSOLE_HAS_METHOD (gtk, print_color_instance);
+ − 455 CONSOLE_HAS_METHOD (gtk, finalize_color_instance);
+ − 456 CONSOLE_HAS_METHOD (gtk, color_instance_equal);
+ − 457 CONSOLE_HAS_METHOD (gtk, color_instance_hash);
+ − 458 CONSOLE_HAS_METHOD (gtk, color_instance_rgb_components);
+ − 459 CONSOLE_HAS_METHOD (gtk, valid_color_name_p);
+ − 460
+ − 461 CONSOLE_HAS_METHOD (gtk, initialize_font_instance);
+ − 462 CONSOLE_HAS_METHOD (gtk, mark_font_instance);
+ − 463 CONSOLE_HAS_METHOD (gtk, print_font_instance);
+ − 464 CONSOLE_HAS_METHOD (gtk, finalize_font_instance);
+ − 465 CONSOLE_HAS_METHOD (gtk, font_instance_truename);
+ − 466 CONSOLE_HAS_METHOD (gtk, font_instance_properties);
+ − 467 CONSOLE_HAS_METHOD (gtk, list_fonts);
+ − 468 #ifdef MULE
+ − 469 CONSOLE_HAS_METHOD (gtk, find_charset_font);
+ − 470 CONSOLE_HAS_METHOD (gtk, font_spec_matches_charset);
+ − 471 #endif
+ − 472 }
+ − 473
+ − 474 void
+ − 475 vars_of_objects_gtk (void)
+ − 476 {
+ − 477 }
+ − 478
+ − 479 /* #### BILL!!! Try to make this go away eventually */
+ − 480 /* X Specific stuff */
+ − 481 #include <X11/Xatom.h>
+ − 482
+ − 483 /* Unbounded, for sufficiently small values of infinity... */
+ − 484 #define MAX_FONT_COUNT 5000
+ − 485
+ − 486 #ifdef MULE
+ − 487 /* find a font spec that matches font spec FONT and also matches
+ − 488 (the registry of) CHARSET. */
+ − 489 static Lisp_Object
+ − 490 gtk_find_charset_font (Lisp_Object device, Lisp_Object font, Lisp_Object charset)
+ − 491 {
+ − 492 char **names;
+ − 493 int count = 0;
+ − 494 Lisp_Object result = Qnil;
+ − 495 const char *patternext;
+ − 496 int i;
+ − 497
+ − 498 TO_EXTERNAL_FORMAT (LISP_STRING, font, C_STRING_ALLOCA, patternext, Qbinary);
+ − 499
+ − 500 names = XListFonts (GDK_DISPLAY (),
+ − 501 patternext, MAX_FONT_COUNT, &count);
+ − 502 /* ### This code seems awfully bogus -- mrb */
+ − 503 for (i = 0; i < count; i ++)
+ − 504 {
665
+ − 505 const Intbyte *intname;
462
+ − 506 Bytecount intlen;
+ − 507
+ − 508 TO_INTERNAL_FORMAT (C_STRING, names[i], ALLOCA, (intname, intlen),
+ − 509 Qctext);
+ − 510 if (gtk_font_spec_matches_charset (XDEVICE (device), charset,
+ − 511 intname, Qnil, 0, -1))
+ − 512 {
+ − 513 result = make_string ((char *) intname, intlen);
+ − 514 break;
+ − 515 }
+ − 516 }
+ − 517
+ − 518 if (names)
+ − 519 XFreeFontNames (names);
+ − 520
+ − 521 /* Check for a short font name. */
+ − 522 if (NILP (result)
+ − 523 && gtk_font_spec_matches_charset (XDEVICE (device), charset, 0,
+ − 524 font, 0, -1))
+ − 525 return font;
+ − 526
+ − 527 return result;
+ − 528 }
+ − 529 #endif /* MULE */
+ − 530
+ − 531 /* Unbounded, for sufficiently small values of infinity... */
+ − 532 #define MAX_FONT_COUNT 5000
+ − 533
+ − 534 static int
+ − 535 valid_font_name_p (Display *dpy, char *name)
+ − 536 {
+ − 537 /* Maybe this should be implemented by callign XLoadFont and trapping
+ − 538 the error. That would be a lot of work, and wasteful as hell, but
+ − 539 might be more correct.
+ − 540 */
+ − 541 int nnames = 0;
+ − 542 char **names = 0;
+ − 543 if (! name)
+ − 544 return 0;
+ − 545 names = XListFonts (dpy, name, 1, &nnames);
+ − 546 if (names)
+ − 547 XFreeFontNames (names);
+ − 548 return (nnames != 0);
+ − 549 }
+ − 550
+ − 551 Lisp_Object
+ − 552 __get_gtk_font_truename (GdkFont *gdk_font, int expandp)
+ − 553 {
+ − 554 Display *dpy = GDK_FONT_XDISPLAY (gdk_font);
+ − 555 GSList *names = ((GdkFontPrivate *) gdk_font)->names;
+ − 556 Lisp_Object font_name = Qnil;
+ − 557
+ − 558 while (names)
+ − 559 {
+ − 560 if (names->data)
+ − 561 {
+ − 562 if (valid_font_name_p (dpy, names->data))
+ − 563 {
+ − 564 if (!expandp)
+ − 565 {
+ − 566 /* They want the wildcarded version */
+ − 567 font_name = build_string (names->data);
+ − 568 }
+ − 569 else
+ − 570 {
+ − 571 /* Need to expand out */
+ − 572 int nnames = 0;
+ − 573 char **x_font_names = 0;
+ − 574
+ − 575 x_font_names = XListFonts (dpy, names->data, 1, &nnames);
+ − 576 if (x_font_names)
+ − 577 {
+ − 578 font_name = build_string (x_font_names[0]);
+ − 579 XFreeFontNames (x_font_names);
+ − 580 }
+ − 581 }
+ − 582 break;
+ − 583 }
+ − 584 }
+ − 585 names = names->next;
+ − 586 }
+ − 587 return (font_name);
+ − 588 }
+ − 589
+ − 590 static Lisp_Object __gtk_list_fonts_internal (const char *pattern)
+ − 591 {
+ − 592 char **names;
+ − 593 int count = 0;
+ − 594 Lisp_Object result = Qnil;
+ − 595
+ − 596 names = XListFonts (GDK_DISPLAY (), pattern, MAX_FONT_COUNT, &count);
+ − 597 while (count--)
+ − 598 result = Fcons (build_ext_string (names [count], Qbinary), result);
+ − 599 if (names)
+ − 600 XFreeFontNames (names);
+ − 601
+ − 602 return result;
+ − 603 }
