Mercurial > hg > xemacs-beta
annotate src/fontcolor-gtk.c @ 5697:40fbceabaafd
menubar-items.el (default-menubar): Reorganize.
Add PROBLEMS to toplevel.
New "More about XEmacs" submenu for NEWS, licensing, etc.
New "Recent History" menu for messages, lossage, etc.
Get rid of ugly and unexpressive ellipses.
| author | Stephen J. Turnbull <stephen@xemacs.org> |
|---|---|
| date | Mon, 24 Dec 2012 03:08:33 +0900 |
| parents | 56144c8593a8 |
| children |
| rev | line source |
|---|---|
| 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. | |
| 872 | 5 Copyright (C) 1995, 1996, 2002 Ben Wing. |
| 462 | 6 Copyright (C) 1995 Sun Microsystems, Inc. |
| 7 | |
| 8 This file is part of XEmacs. | |
| 9 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5191
diff
changeset
|
10 XEmacs is free software: you can redistribute it and/or modify it |
| 462 | 11 under the terms of the GNU General Public License as published by the |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5191
diff
changeset
|
12 Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5191
diff
changeset
|
13 option) any later version. |
| 462 | 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 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5191
diff
changeset
|
21 along with XEmacs. If not, see <http://www.gnu.org/licenses/>. */ |
| 462 | 22 |
| 23 /* Synched up with: Not in FSF. */ | |
| 24 | |
| 25 /* Authors: Jamie Zawinski, Chuck Thompson, Ben Wing */ | |
| 26 /* Gtk version by William Perry */ | |
| 27 | |
| 28 #include <config.h> | |
| 29 #include "lisp.h" | |
| 30 | |
| 872 | 31 #include "buffer.h" |
| 3676 | 32 #include "charset.h" |
| 872 | 33 #include "device-impl.h" |
| 34 #include "insdel.h" | |
| 462 | 35 |
| 872 | 36 #include "console-gtk-impl.h" |
|
5176
8b2f75cecb89
rename objects* (.c, .h and .el files) to fontcolor*
Ben Wing <ben@xemacs.org>
parents:
4982
diff
changeset
|
37 #include "fontcolor-gtk-impl.h" |
| 462 | 38 |
| 39 /* sigh */ | |
|
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
3676
diff
changeset
|
40 #include "sysgdkx.h" |
| 462 | 41 |
| 3659 | 42 /* XListFonts doesn't allocate memory unconditionally based on this. (For |
| 43 XFree86 in 2005, at least. */ | |
| 44 #define MAX_FONT_COUNT INT_MAX | |
| 45 | |
| 46 #ifdef DEBUG_XEMACS | |
| 47 Fixnum debug_x_objects; | |
| 48 #endif /* DEBUG_XEMACS */ | |
| 49 | |
| 462 | 50 |
| 51 /************************************************************************/ | |
| 52 /* color instances */ | |
| 53 /************************************************************************/ | |
| 54 | |
| 55 /* Replacement for XAllocColor() that tries to return the nearest | |
| 56 available color if the colormap is full. Original was from FSFmacs, | |
| 57 but rewritten by Jareth Hein <jareth@camelot-soft.com> 97/11/25 | |
| 58 Modified by Lee Kindness <lkindness@csl.co.uk> 31/08/99 to handle previous | |
| 59 total failure which was due to a read/write colorcell being the nearest | |
| 60 match - tries the next nearest... | |
| 61 | |
| 62 Gdk takes care of all this behind the scenes, so we don't need to | |
| 63 worry about it. | |
| 64 | |
| 65 Return value is 1 for normal success, 2 for nearest color success, | |
|
5384
3889ef128488
Fix misspelled words, and some grammar, across the entire source tree.
Jerry James <james@xemacs.org>
parents:
5191
diff
changeset
|
66 3 for Non-deallocable success. */ |
| 462 | 67 int |
| 2286 | 68 allocate_nearest_color (GdkColormap *colormap, GdkVisual *UNUSED (visual), |
| 462 | 69 GdkColor *color_def) |
| 70 { | |
| 71 int rc; | |
| 72 | |
| 73 rc = gdk_colormap_alloc_color (colormap, color_def, FALSE, TRUE); | |
| 74 | |
| 75 if (rc == TRUE) | |
| 76 return (1); | |
| 77 | |
| 78 return (0); | |
| 79 } | |
| 80 | |
| 81 int | |
| 867 | 82 gtk_parse_nearest_color (struct device *d, GdkColor *color, Ibyte *name, |
| 578 | 83 Bytecount len, Error_Behavior errb) |
| 462 | 84 { |
| 85 GdkColormap *cmap; | |
| 86 GdkVisual *visual; | |
| 87 int result; | |
| 88 | |
| 89 cmap = DEVICE_GTK_COLORMAP(d); | |
| 90 visual = DEVICE_GTK_VISUAL (d); | |
| 91 | |
| 92 xzero (*color); | |
| 93 { | |
| 94 const Extbyte *extname; | |
| 665 | 95 Bytecount extnamelen; |
| 462 | 96 |
| 97 TO_EXTERNAL_FORMAT (DATA, (name, len), ALLOCA, (extname, extnamelen), Qbinary); | |
| 98 | |
| 99 result = gdk_color_parse (extname, color); | |
| 100 } | |
| 101 | |
| 102 if (result == FALSE) | |
| 103 { | |
| 563 | 104 maybe_invalid_argument ("unrecognized color", make_string (name, len), |
| 105 Qcolor, errb); | |
| 462 | 106 return 0; |
| 107 } | |
| 108 result = allocate_nearest_color (cmap, visual, color); | |
| 109 if (!result) | |
| 110 { | |
| 563 | 111 maybe_signal_error (Qgui_error, "couldn't allocate color", |
| 112 make_string (name, len), Qcolor, errb); | |
| 462 | 113 return 0; |
| 114 } | |
| 115 | |
| 116 return result; | |
| 117 } | |
| 118 | |
| 119 static int | |
| 120 gtk_initialize_color_instance (struct Lisp_Color_Instance *c, Lisp_Object name, | |
| 578 | 121 Lisp_Object device, Error_Behavior errb) |
| 462 | 122 { |
| 123 GdkColor color; | |
| 124 int result; | |
| 125 | |
| 126 result = gtk_parse_nearest_color (XDEVICE (device), &color, | |
| 127 XSTRING_DATA (name), | |
| 128 XSTRING_LENGTH (name), | |
| 129 errb); | |
| 130 | |
| 131 if (!result) | |
| 132 return 0; | |
| 133 | |
| 134 /* Don't allocate the data until we're sure that we will succeed, | |
| 135 or the finalize method may get fucked. */ | |
| 136 c->data = xnew (struct gtk_color_instance_data); | |
| 137 if (result == 3) | |
| 138 COLOR_INSTANCE_GTK_DEALLOC (c) = 0; | |
| 139 else | |
| 140 COLOR_INSTANCE_GTK_DEALLOC (c) = 1; | |
| 141 COLOR_INSTANCE_GTK_COLOR (c) = gdk_color_copy (&color); | |
| 142 return 1; | |
| 143 } | |
| 144 | |
| 145 static void | |
| 146 gtk_print_color_instance (struct Lisp_Color_Instance *c, | |
| 147 Lisp_Object printcharfun, | |
| 2286 | 148 int UNUSED (escapeflag)) |
| 462 | 149 { |
| 150 GdkColor *color = COLOR_INSTANCE_GTK_COLOR (c); | |
| 800 | 151 write_fmt_string (printcharfun, " %ld=(%X,%X,%X)", |
| 152 color->pixel, color->red, color->green, color->blue); | |
| 462 | 153 } |
| 154 | |
| 155 static void | |
| 156 gtk_finalize_color_instance (struct Lisp_Color_Instance *c) | |
| 157 { | |
| 158 if (c->data) | |
| 159 { | |
| 160 if (DEVICE_LIVE_P (XDEVICE (c->device))) | |
| 161 { | |
| 162 if (COLOR_INSTANCE_GTK_DEALLOC (c)) | |
| 163 { | |
| 164 gdk_colormap_free_colors (DEVICE_GTK_COLORMAP (XDEVICE (c->device)), | |
| 165 COLOR_INSTANCE_GTK_COLOR (c), 1); | |
| 166 } | |
| 167 gdk_color_free (COLOR_INSTANCE_GTK_COLOR (c)); | |
| 168 } | |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
169 xfree (c->data); |
| 462 | 170 c->data = 0; |
| 171 } | |
| 172 } | |
| 173 | |
| 174 /* Color instances are equal if they resolve to the same color on the | |
| 175 screen (have the same RGB values). I imagine that | |
| 176 "same RGB values" == "same cell in the colormap." Arguably we should | |
| 177 be comparing their names or pixel values instead. */ | |
| 178 | |
| 179 static int | |
| 180 gtk_color_instance_equal (struct Lisp_Color_Instance *c1, | |
| 181 struct Lisp_Color_Instance *c2, | |
| 2286 | 182 int UNUSED (depth)) |
| 462 | 183 { |
| 184 return (gdk_color_equal (COLOR_INSTANCE_GTK_COLOR (c1), | |
| 185 COLOR_INSTANCE_GTK_COLOR (c2))); | |
| 186 } | |
| 187 | |
| 2515 | 188 static Hashcode |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5176
diff
changeset
|
189 gtk_color_instance_hash (struct Lisp_Color_Instance *c, int UNUSED (depth), |
|
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5176
diff
changeset
|
190 Boolint UNUSED (equalp)) |
| 462 | 191 { |
| 192 return (gdk_color_hash (COLOR_INSTANCE_GTK_COLOR (c), NULL)); | |
| 193 } | |
| 194 | |
| 195 static Lisp_Object | |
| 196 gtk_color_instance_rgb_components (struct Lisp_Color_Instance *c) | |
| 197 { | |
| 198 GdkColor *color = COLOR_INSTANCE_GTK_COLOR (c); | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
199 return (list3 (make_fixnum (color->red), |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
200 make_fixnum (color->green), |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5474
diff
changeset
|
201 make_fixnum (color->blue))); |
| 462 | 202 } |
| 203 | |
| 204 static int | |
| 2286 | 205 gtk_valid_color_name_p (struct device *UNUSED (d), Lisp_Object color) |
| 462 | 206 { |
| 207 GdkColor c; | |
| 208 const char *extname; | |
| 209 | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
210 extname = LISP_STRING_TO_EXTERNAL (color, Qctext); |
| 462 | 211 |
| 212 if (gdk_color_parse (extname, &c) != TRUE) | |
| 213 return(0); | |
| 214 return (1); | |
| 215 } | |
| 216 | |
| 2527 | 217 static Lisp_Object |
| 218 gtk_color_list (void) | |
| 219 { | |
| 220 /* #### BILL!!! | |
| 221 Is this correct? */ | |
| 222 return call0 (intern ("x-color-list-internal")); | |
| 223 } | |
| 224 | |
| 462 | 225 |
| 226 /************************************************************************/ | |
| 227 /* font instances */ | |
| 228 /************************************************************************/ | |
| 229 | |
| 230 static int | |
| 2286 | 231 gtk_initialize_font_instance (struct Lisp_Font_Instance *f, |
| 232 Lisp_Object UNUSED (name), | |
| 233 Lisp_Object UNUSED (device), Error_Behavior errb) | |
| 462 | 234 { |
| 235 GdkFont *gf; | |
| 236 XFontStruct *xf; | |
| 237 const char *extname; | |
| 238 | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
239 extname = LISP_STRING_TO_EXTERNAL (f->name, Qctext); |
| 462 | 240 |
| 241 gf = gdk_font_load (extname); | |
| 242 | |
| 243 if (!gf) | |
| 244 { | |
| 563 | 245 maybe_signal_error (Qgui_error, "couldn't load font", f->name, |
| 246 Qfont, errb); | |
| 462 | 247 return 0; |
| 248 } | |
| 249 | |
| 2054 | 250 xf = (XFontStruct*) GDK_FONT_XFONT (gf); |
| 462 | 251 |
| 252 /* Don't allocate the data until we're sure that we will succeed, | |
| 253 or the finalize method may get fucked. */ | |
| 254 f->data = xnew (struct gtk_font_instance_data); | |
| 255 FONT_INSTANCE_GTK_FONT (f) = gf; | |
| 256 f->ascent = gf->ascent; | |
| 257 f->descent = gf->descent; | |
| 258 f->height = gf->ascent + gf->descent; | |
| 259 | |
| 260 /* Now lets figure out the width of the font */ | |
| 261 { | |
| 262 /* following change suggested by Ted Phelps <phelps@dstc.edu.au> */ | |
| 263 unsigned int def_char = 'n'; /*xf->default_char;*/ | |
| 264 unsigned int byte1, byte2; | |
| 265 | |
| 266 once_more: | |
| 267 byte1 = def_char >> 8; | |
| 268 byte2 = def_char & 0xFF; | |
| 269 | |
| 270 if (xf->per_char) | |
| 271 { | |
| 272 /* Old versions of the R5 font server have garbage (>63k) as | |
| 273 def_char. 'n' might not be a valid character. */ | |
| 274 if (byte1 < xf->min_byte1 || | |
| 275 byte1 > xf->max_byte1 || | |
| 276 byte2 < xf->min_char_or_byte2 || | |
| 277 byte2 > xf->max_char_or_byte2) | |
| 278 f->width = 0; | |
| 279 else | |
| 280 f->width = xf->per_char[(byte1 - xf->min_byte1) * | |
| 281 (xf->max_char_or_byte2 - | |
| 282 xf->min_char_or_byte2 + 1) + | |
| 283 (byte2 - xf->min_char_or_byte2)].width; | |
| 284 } | |
| 285 else | |
| 286 f->width = xf->max_bounds.width; | |
| 287 | |
| 288 /* Some fonts have a default char whose width is 0. This is no good. | |
| 289 If that's the case, first try 'n' as the default char, and if n has | |
| 290 0 width too (unlikely) then just use the max width. */ | |
| 291 if (f->width == 0) | |
| 292 { | |
| 293 if (def_char == xf->default_char) | |
| 294 f->width = xf->max_bounds.width; | |
| 295 else | |
| 296 { | |
| 297 def_char = xf->default_char; | |
| 298 goto once_more; | |
| 299 } | |
| 300 } | |
| 301 } | |
| 302 | |
| 303 /* If all characters don't exist then there could potentially be | |
| 304 0-width characters lurking out there. Not setting this flag | |
| 305 trips an optimization that would make them appear to have width | |
| 306 to redisplay. This is bad. So we set it if not all characters | |
| 307 have the same width or if not all characters are defined. | |
| 308 */ | |
| 309 /* #### This sucks. There is a measurable performance increase | |
| 310 when using proportional width fonts if this flag is not set. | |
| 311 Unfortunately so many of the fucking X fonts are not fully | |
| 312 defined that we could almost just get rid of this damn flag and | |
| 313 make it an assertion. */ | |
| 314 f->proportional_p = (xf->min_bounds.width != xf->max_bounds.width || | |
| 315 (/* x_handle_non_fully_specified_fonts */ 0 && | |
| 316 !xf->all_chars_exist)); | |
| 317 #if 0 | |
| 318 f->width = gdk_char_width (gf, 'n'); | |
| 319 f->proportional_p = (gdk_char_width (gf, '|') != gdk_char_width (gf, 'W')) ? 1 : 0; | |
| 320 #endif | |
| 321 return 1; | |
| 322 } | |
| 323 | |
| 324 static void | |
| 325 gtk_print_font_instance (struct Lisp_Font_Instance *f, | |
| 326 Lisp_Object printcharfun, | |
| 2286 | 327 int UNUSED (escapeflag)) |
| 462 | 328 { |
| 800 | 329 write_fmt_string (printcharfun, " 0x%lx", |
| 330 (unsigned long) gdk_font_id (FONT_INSTANCE_GTK_FONT (f))); | |
| 462 | 331 } |
| 332 | |
| 333 static void | |
| 334 gtk_finalize_font_instance (struct Lisp_Font_Instance *f) | |
| 335 { | |
| 336 if (f->data) | |
| 337 { | |
| 338 if (DEVICE_LIVE_P (XDEVICE (f->device))) | |
| 339 { | |
| 340 gdk_font_unref (FONT_INSTANCE_GTK_FONT (f)); | |
| 341 } | |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
342 xfree (f->data); |
| 462 | 343 f->data = 0; |
| 344 } | |
| 345 } | |
| 346 | |
| 347 /* Forward declarations for X specific functions at the end of the file */ | |
| 348 Lisp_Object __get_gtk_font_truename (GdkFont *gdk_font, int expandp); | |
| 2527 | 349 static Lisp_Object __gtk_font_list_internal (const char *pattern); |
| 462 | 350 |
| 351 static Lisp_Object | |
| 2286 | 352 gtk_font_instance_truename (struct Lisp_Font_Instance *f, |
| 353 Error_Behavior UNUSED (errb)) | |
| 462 | 354 { |
| 872 | 355 if (NILP (FONT_INSTANCE_TRUENAME (f))) |
| 462 | 356 { |
| 872 | 357 FONT_INSTANCE_TRUENAME (f) = __get_gtk_font_truename (FONT_INSTANCE_GTK_FONT (f), 1); |
| 462 | 358 |
| 872 | 359 if (NILP (FONT_INSTANCE_TRUENAME (f))) |
| 462 | 360 { |
| 361 /* Ok, just this once, return the font name as the truename. | |
| 362 (This is only used by Fequal() right now.) */ | |
| 363 return f->name; | |
| 364 } | |
| 365 } | |
| 872 | 366 return (FONT_INSTANCE_TRUENAME (f)); |
| 462 | 367 } |
| 368 | |
| 369 static Lisp_Object | |
| 2286 | 370 gtk_font_instance_properties (struct Lisp_Font_Instance *UNUSED (f)) |
| 462 | 371 { |
| 372 Lisp_Object result = Qnil; | |
| 373 | |
| 374 /* #### BILL!!! */ | |
| 375 /* There seems to be no way to get this information under Gtk */ | |
| 376 return result; | |
| 377 } | |
| 378 | |
| 379 static Lisp_Object | |
| 2527 | 380 gtk_font_list (Lisp_Object pattern, Lisp_Object UNUSED (device), |
| 2286 | 381 Lisp_Object UNUSED (maxnumber)) |
| 462 | 382 { |
| 383 const char *patternext; | |
| 384 | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
385 patternext = LISP_STRING_TO_EXTERNAL (pattern, Qbinary); |
| 462 | 386 |
| 2527 | 387 return (__gtk_font_list_internal (patternext)); |
| 462 | 388 } |
| 389 | |
| 3659 | 390 /* Include the charset support, shared, for the moment, with X11. */ |
| 391 #define THIS_IS_GTK | |
|
5176
8b2f75cecb89
rename objects* (.c, .h and .el files) to fontcolor*
Ben Wing <ben@xemacs.org>
parents:
4982
diff
changeset
|
392 #include "fontcolor-xlike-inc.c" |
| 462 | 393 |
| 394 | |
| 395 /************************************************************************/ | |
| 396 /* initialization */ | |
| 397 /************************************************************************/ | |
| 398 | |
| 399 void | |
|
5176
8b2f75cecb89
rename objects* (.c, .h and .el files) to fontcolor*
Ben Wing <ben@xemacs.org>
parents:
4982
diff
changeset
|
400 syms_of_fontcolor_gtk (void) |
| 462 | 401 { |
| 402 } | |
| 403 | |
| 404 void | |
|
5176
8b2f75cecb89
rename objects* (.c, .h and .el files) to fontcolor*
Ben Wing <ben@xemacs.org>
parents:
4982
diff
changeset
|
405 console_type_create_fontcolor_gtk (void) |
| 462 | 406 { |
| 407 /* object methods */ | |
| 408 | |
| 409 CONSOLE_HAS_METHOD (gtk, initialize_color_instance); | |
| 410 CONSOLE_HAS_METHOD (gtk, print_color_instance); | |
| 411 CONSOLE_HAS_METHOD (gtk, finalize_color_instance); | |
| 412 CONSOLE_HAS_METHOD (gtk, color_instance_equal); | |
| 413 CONSOLE_HAS_METHOD (gtk, color_instance_hash); | |
| 414 CONSOLE_HAS_METHOD (gtk, color_instance_rgb_components); | |
| 415 CONSOLE_HAS_METHOD (gtk, valid_color_name_p); | |
| 2527 | 416 CONSOLE_HAS_METHOD (gtk, color_list); |
| 462 | 417 |
| 418 CONSOLE_HAS_METHOD (gtk, initialize_font_instance); | |
| 419 CONSOLE_HAS_METHOD (gtk, print_font_instance); | |
| 420 CONSOLE_HAS_METHOD (gtk, finalize_font_instance); | |
| 421 CONSOLE_HAS_METHOD (gtk, font_instance_truename); | |
| 422 CONSOLE_HAS_METHOD (gtk, font_instance_properties); | |
| 2527 | 423 CONSOLE_HAS_METHOD (gtk, font_list); |
| 462 | 424 #ifdef MULE |
| 425 CONSOLE_HAS_METHOD (gtk, find_charset_font); | |
| 426 CONSOLE_HAS_METHOD (gtk, font_spec_matches_charset); | |
| 427 #endif | |
| 428 } | |
| 429 | |
| 430 void | |
|
5176
8b2f75cecb89
rename objects* (.c, .h and .el files) to fontcolor*
Ben Wing <ben@xemacs.org>
parents:
4982
diff
changeset
|
431 vars_of_fontcolor_gtk (void) |
| 462 | 432 { |
| 3659 | 433 #ifdef DEBUG_XEMACS |
| 434 DEFVAR_INT ("debug-x-objects", &debug_x_objects /* | |
| 435 If non-zero, display debug information about X objects | |
| 436 */ ); | |
| 437 debug_x_objects = 0; | |
| 438 #endif | |
| 462 | 439 } |
| 440 | |
| 441 static int | |
| 442 valid_font_name_p (Display *dpy, char *name) | |
| 443 { | |
| 444 /* Maybe this should be implemented by callign XLoadFont and trapping | |
| 445 the error. That would be a lot of work, and wasteful as hell, but | |
| 446 might be more correct. | |
| 447 */ | |
| 448 int nnames = 0; | |
| 449 char **names = 0; | |
| 450 if (! name) | |
| 451 return 0; | |
| 452 names = XListFonts (dpy, name, 1, &nnames); | |
| 453 if (names) | |
| 454 XFreeFontNames (names); | |
| 455 return (nnames != 0); | |
| 456 } | |
| 457 | |
| 458 Lisp_Object | |
| 459 __get_gtk_font_truename (GdkFont *gdk_font, int expandp) | |
| 460 { | |
| 461 Display *dpy = GDK_FONT_XDISPLAY (gdk_font); | |
| 462 GSList *names = ((GdkFontPrivate *) gdk_font)->names; | |
| 463 Lisp_Object font_name = Qnil; | |
| 464 | |
| 465 while (names) | |
| 466 { | |
| 467 if (names->data) | |
| 468 { | |
| 2054 | 469 if (valid_font_name_p (dpy, (char*) names->data)) |
| 462 | 470 { |
| 471 if (!expandp) | |
| 472 { | |
| 473 /* They want the wildcarded version */ | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
3676
diff
changeset
|
474 font_name = build_cistring ((char*) names->data); |
| 462 | 475 } |
| 476 else | |
| 477 { | |
| 478 /* Need to expand out */ | |
| 479 int nnames = 0; | |
| 480 char **x_font_names = 0; | |
| 481 | |
| 2054 | 482 x_font_names = XListFonts (dpy, (char*) names->data, 1, &nnames); |
| 462 | 483 if (x_font_names) |
| 484 { | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
3676
diff
changeset
|
485 font_name = build_cistring (x_font_names[0]); |
| 462 | 486 XFreeFontNames (x_font_names); |
| 487 } | |
| 488 } | |
| 489 break; | |
| 490 } | |
| 491 } | |
| 492 names = names->next; | |
| 493 } | |
| 494 return (font_name); | |
| 495 } | |
| 496 | |
| 2527 | 497 static Lisp_Object __gtk_font_list_internal (const char *pattern) |
| 462 | 498 { |
| 499 char **names; | |
| 500 int count = 0; | |
| 501 Lisp_Object result = Qnil; | |
| 502 | |
| 503 names = XListFonts (GDK_DISPLAY (), pattern, MAX_FONT_COUNT, &count); | |
| 504 while (count--) | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
3676
diff
changeset
|
505 result = Fcons (build_extstring (names [count], Qbinary), result); |
| 462 | 506 if (names) |
| 507 XFreeFontNames (names); | |
| 508 | |
| 509 return result; | |
| 510 } |