Mercurial > hg > xemacs-beta
annotate src/fontcolor-gtk.c @ 5750:66d2f63df75f
Correct some spelling and formatting in behavior.el.
Mentioned in tracker issue 826, the third thing mentioned there (the file
name at the bottom of the file) had already been fixed.
lisp/ChangeLog addition:
2013-08-05 Aidan Kehoe <kehoea@parhasard.net>
* behavior.el:
(override-behavior):
Correct some spelling and formatting here, thank you Steven
Mitchell in tracker issue 826.
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Mon, 05 Aug 2013 10:05:32 +0100 |
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 } |