|
2586
|
1 /* Include file for common code, X and GTK colors and fonts.
|
|
|
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, 2000, 2001, 2002, 2003, 2004, 2005 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
|
|
|
29 /* Extracted from objects-x.c, objects-gtk.c 2-13-05.
|
|
|
30 NOTE: There is an advantage to having the code coalesced this way
|
|
|
31 even when there is a fair amount of difference between the two versions,
|
|
|
32 provided that they are still parallel -- having them side by side ensures
|
|
|
33 that logic changes in one are propagated to the other, preventing bit-rot
|
|
|
34 --ben
|
|
|
35 */
|
|
|
36
|
|
|
37 #ifndef THIS_IS_GTK
|
|
|
38 #define ZZCOLOR_TYPE XColor
|
|
|
39 #define ZZCOLOR_INSTANCE(name) COLOR_INSTANCE_X_##name
|
|
|
40 #define ZZ(z) x_##z
|
|
|
41 #define ZZEND(z) z##_x
|
|
|
42 #define ZZCONSOLE_HAS_METHOD(name) CONSOLE_HAS_METHOD (x, name)
|
|
|
43 #define UNUSED_IF_GTK(arg) arg
|
|
|
44 #else
|
|
|
45 #define ZZCOLOR_TYPE GdkColor
|
|
|
46 #define ZZCOLOR_INSTANCE(name) COLOR_INSTANCE_GTK_##name
|
|
|
47 #define ZZ(z) gtk_##z
|
|
|
48 #define ZZEND(z) z##_gtk
|
|
|
49 #define ZZCONSOLE_HAS_METHOD(name) CONSOLE_HAS_METHOD (gtk, name)
|
|
|
50 #define UNUSED_IF_GTK(arg) UNUSED (arg)
|
|
|
51 #endif
|
|
|
52
|
|
|
53
|
|
|
54 /************************************************************************/
|
|
|
55 /* color instances */
|
|
|
56 /************************************************************************/
|
|
|
57
|
|
|
58 static int
|
|
|
59 ZZ (parse_nearest_color) (struct device *d, ZZCOLOR_TYPE *color,
|
|
|
60 Lisp_Object name, Error_Behavior errb)
|
|
|
61 {
|
|
|
62 #ifndef THIS_IS_GTK
|
|
|
63 Display *dpy = DEVICE_X_DISPLAY (d);
|
|
|
64 Colormap cmap = DEVICE_X_COLORMAP (d);
|
|
|
65 Visual *visual = DEVICE_X_VISUAL (d);
|
|
|
66 #else /* THIS_IS_GTK */
|
|
|
67 GdkColormap *cmap = DEVICE_GTK_COLORMAP (d);
|
|
|
68 GdkVisual *visual = DEVICE_GTK_VISUAL (d);
|
|
|
69 #endif /* THIS_IS_GTK */
|
|
|
70 int result;
|
|
|
71
|
|
|
72 xzero (*color);
|
|
|
73
|
|
|
74 #ifndef THIS_IS_GTK
|
|
|
75 result =
|
|
|
76 XParseColor (dpy, cmap,
|
|
|
77 NEW_LISP_STRING_TO_EXTERNAL (name, Qx_color_name_encoding),
|
|
|
78 color);
|
|
|
79 #else /* THIS_IS_GTK */
|
|
|
80 result = gdk_color_parse (LISP_STRING_TO_GTK_TEXT (name), color);
|
|
|
81 #endif /* THIS_IS_GTK */
|
|
|
82 if (!result)
|
|
|
83 {
|
|
|
84 maybe_signal_error (Qgui_error, "Unrecognized color",
|
|
|
85 name, Qcolor, errb);
|
|
|
86 return 0;
|
|
|
87 }
|
|
|
88 #ifndef THIS_IS_GTK
|
|
|
89 result = ZZ (allocate_nearest_color) (dpy, cmap, visual, color);
|
|
|
90 #else /* THIS_IS_GTK */
|
|
|
91 result = ZZ (allocate_nearest_color) (cmap, visual, color);
|
|
|
92 #endif /* THIS_IS_GTK */
|
|
|
93 if (!result)
|
|
|
94 {
|
|
|
95 maybe_signal_error (Qgui_error, "Couldn't allocate color",
|
|
|
96 name, Qcolor, errb);
|
|
|
97 return 0;
|
|
|
98 }
|
|
|
99
|
|
|
100 return result;
|
|
|
101 }
|
|
|
102
|
|
|
103 static int
|
|
|
104 ZZ (initialize_color_instance) (Lisp_Color_Instance *c, Lisp_Object name,
|
|
|
105 Lisp_Object device, Error_Behavior errb)
|
|
|
106 {
|
|
|
107 ZZCOLOR_TYPE color;
|
|
|
108 int result;
|
|
|
109
|
|
|
110 result = ZZ (parse_nearest_color) (XDEVICE (device), &color, name, errb);
|
|
|
111
|
|
|
112 if (!result)
|
|
|
113 return 0;
|
|
|
114
|
|
|
115 /* Don't allocate the data until we're sure that we will succeed,
|
|
|
116 or the finalize method may get fucked. */
|
|
|
117 c->data = xnew (struct ZZ (color_instance_data));
|
|
|
118 if (result == 3)
|
|
|
119 ZZCOLOR_INSTANCE (DEALLOC) (c) = 0;
|
|
|
120 else
|
|
|
121 ZZCOLOR_INSTANCE (DEALLOC) (c) = 1;
|
|
|
122 #ifndef THIS_IS_GTK
|
|
|
123 ZZCOLOR_INSTANCE (COLOR) (c) = color;
|
|
|
124 #else /* THIS_IS_GTK */
|
|
|
125 ZZCOLOR_INSTANCE (COLOR) (c) = gdk_color_copy (&color);
|
|
|
126 #endif /* THIS_IS_GTK */
|
|
|
127 return 1;
|
|
|
128 }
|
|
|
129
|
|
|
130 static void
|
|
|
131 ZZ (print_color_instance) (Lisp_Color_Instance *c,
|
|
|
132 Lisp_Object printcharfun,
|
|
|
133 int UNUSED (escapeflag))
|
|
|
134 {
|
|
|
135 #ifndef THIS_IS_GTK
|
|
|
136 XColor color = COLOR_INSTANCE_X_COLOR (c);
|
|
|
137 write_fmt_string (printcharfun, " %ld=(%X,%X,%X)",
|
|
|
138 color.pixel, color.red, color.green, color.blue);
|
|
|
139 #else /* THIS_IS_GTK */
|
|
|
140 GdkColor *color = COLOR_INSTANCE_GTK_COLOR (c);
|
|
|
141 write_fmt_string (printcharfun, " %ld=(%X,%X,%X)",
|
|
|
142 color->pixel, color->red, color->green, color->blue);
|
|
|
143 #endif /* THIS_IS_GTK */
|
|
|
144 }
|
|
|
145
|
|
|
146 static void
|
|
|
147 ZZ (finalize_color_instance) (Lisp_Color_Instance *c)
|
|
|
148 {
|
|
|
149 if (c->data)
|
|
|
150 {
|
|
|
151 if (DEVICE_LIVE_P (XDEVICE (c->device)))
|
|
|
152 {
|
|
|
153 if (ZZCOLOR_INSTANCE (DEALLOC) (c))
|
|
|
154 {
|
|
|
155 #ifndef THIS_IS_GTK
|
|
|
156 XFreeColors (DEVICE_X_DISPLAY (XDEVICE (c->device)),
|
|
|
157 DEVICE_X_COLORMAP (XDEVICE (c->device)),
|
|
|
158 &COLOR_INSTANCE_X_COLOR (c).pixel, 1, 0);
|
|
|
159 #else /* THIS_IS_GTK */
|
|
|
160 gdk_colormap_free_colors (DEVICE_GTK_COLORMAP
|
|
|
161 (XDEVICE (c->device)),
|
|
|
162 COLOR_INSTANCE_GTK_COLOR (c), 1);
|
|
|
163 #endif /* THIS_IS_GTK */
|
|
|
164 }
|
|
|
165 #ifdef THIS_IS_GTK
|
|
|
166 gdk_color_free (COLOR_INSTANCE_GTK_COLOR (c));
|
|
|
167 #endif /* THIS_IS_GTK */
|
|
|
168 }
|
|
|
169 xfree (c->data, void *);
|
|
|
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 ZZ (color_instance_equal) (Lisp_Color_Instance *c1,
|
|
|
181 Lisp_Color_Instance *c2,
|
|
|
182 int UNUSED (depth))
|
|
|
183 {
|
|
|
184 #ifndef THIS_IS_GTK
|
|
|
185 XColor color1 = COLOR_INSTANCE_X_COLOR (c1);
|
|
|
186 XColor color2 = COLOR_INSTANCE_X_COLOR (c2);
|
|
|
187 return ((color1.red == color2.red) &&
|
|
|
188 (color1.green == color2.green) &&
|
|
|
189 (color1.blue == color2.blue));
|
|
|
190 #else /* THIS_IS_GTK */
|
|
|
191 return (gdk_color_equal (COLOR_INSTANCE_GTK_COLOR (c1),
|
|
|
192 COLOR_INSTANCE_GTK_COLOR (c2)));
|
|
|
193 #endif /* THIS_IS_GTK */
|
|
|
194 }
|
|
|
195
|
|
|
196 static Hashcode
|
|
|
197 ZZ (color_instance_hash) (Lisp_Color_Instance *c, int UNUSED (depth))
|
|
|
198 {
|
|
|
199 #ifndef THIS_IS_GTK
|
|
|
200 XColor color = COLOR_INSTANCE_X_COLOR (c);
|
|
|
201 return HASH3 (color.red, color.green, color.blue);
|
|
|
202 #else /* THIS_IS_GTK */
|
|
|
203 return (gdk_color_hash (COLOR_INSTANCE_GTK_COLOR (c), NULL));
|
|
|
204 #endif /* THIS_IS_GTK */
|
|
|
205 }
|
|
|
206
|
|
|
207 static Lisp_Object
|
|
|
208 ZZ (color_instance_rgb_components) (Lisp_Color_Instance *c)
|
|
|
209 {
|
|
|
210 #ifndef THIS_IS_GTK
|
|
|
211 XColor color = COLOR_INSTANCE_X_COLOR (c);
|
|
|
212 return (list3 (make_int (color.red),
|
|
|
213 make_int (color.green),
|
|
|
214 make_int (color.blue)));
|
|
|
215 #else /* THIS_IS_GTK */
|
|
|
216 GdkColor *color = COLOR_INSTANCE_GTK_COLOR (c);
|
|
|
217 return (list3 (make_int (color->red),
|
|
|
218 make_int (color->green),
|
|
|
219 make_int (color->blue)));
|
|
|
220 #endif /* THIS_IS_GTK */
|
|
|
221 }
|
|
|
222
|
|
|
223 static int
|
|
|
224 ZZ (valid_color_name_p) (struct device *UNUSED_IF_GTK (d), Lisp_Object color)
|
|
|
225 {
|
|
|
226 #ifndef THIS_IS_GTK
|
|
|
227 XColor c;
|
|
|
228 Display *dpy = DEVICE_X_DISPLAY (d);
|
|
|
229 Colormap cmap = DEVICE_X_COLORMAP (d);
|
|
|
230 const Extbyte *extname;
|
|
|
231
|
|
|
232 LISP_STRING_TO_EXTERNAL (color, extname, Qx_color_name_encoding);
|
|
|
233
|
|
|
234 return XParseColor (dpy, cmap, extname, &c);
|
|
|
235 #else /* THIS_IS_GTK */
|
|
|
236 GdkColor c;
|
|
|
237 const Extbyte *extname;
|
|
|
238
|
|
|
239 LISP_STRING_TO_EXTERNAL (color, extname, Vgtk_text_encoding);
|
|
|
240
|
|
|
241 if (gdk_color_parse (extname, &c) != TRUE)
|
|
|
242 return 0;
|
|
|
243 return 1;
|
|
|
244 #endif /* THIS_IS_GTK */
|
|
|
245 }
|
|
|
246
|
|
|
247 static Lisp_Object
|
|
|
248 ZZ (color_list) (void)
|
|
|
249 {
|
|
|
250 #ifdef THIS_IS_GTK
|
|
|
251 /* #### BILL!!!
|
|
|
252 Is this correct? */
|
|
|
253 #endif /* THIS_IS_GTK */
|
|
|
254 return call0 (intern ("x-color-list-internal"));
|
|
|
255 }
|
|
|
256
|
|
|
257
|
|
|
258 /************************************************************************/
|
|
|
259 /* font instances */
|
|
|
260 /************************************************************************/
|
|
|
261
|
|
|
262 static int
|
|
|
263 ZZ (initialize_font_instance) (Lisp_Font_Instance *f,
|
|
|
264 Lisp_Object UNUSED (name),
|
|
|
265 Lisp_Object UNUSED_IF_GTK (device),
|
|
|
266 Error_Behavior errb)
|
|
|
267 {
|
|
|
268 XFontStruct *xf;
|
|
|
269 const Extbyte *extname;
|
|
|
270
|
|
|
271 #ifndef THIS_IS_GTK
|
|
|
272 Display *dpy = DEVICE_X_DISPLAY (XDEVICE (device));
|
|
|
273
|
|
|
274 LISP_STRING_TO_EXTERNAL (f->name, extname, Qx_font_name_encoding);
|
|
|
275 xf = XLoadQueryFont (dpy, extname);
|
|
|
276
|
|
|
277 if (!xf)
|
|
|
278 {
|
|
|
279 maybe_signal_error (Qgui_error, "Couldn't load font", f->name,
|
|
|
280 Qfont, errb);
|
|
|
281 return 0;
|
|
|
282 }
|
|
|
283
|
|
|
284 if (!xf->max_bounds.width)
|
|
|
285 {
|
|
|
286 /* yes, this has been known to happen. */
|
|
|
287 XFreeFont (dpy, xf);
|
|
|
288 maybe_signal_error (Qgui_error, "X font is too small", f->name, Qfont,
|
|
|
289 errb);
|
|
|
290
|
|
|
291 return 0;
|
|
|
292 }
|
|
|
293
|
|
|
294 #else /* THIS_IS_GTK */
|
|
|
295 GdkFont *gf;
|
|
|
296
|
|
|
297 LISP_STRING_TO_EXTERNAL (f->name, extname, Vgtk_text_encoding);
|
|
|
298 gf = gdk_font_load (extname);
|
|
|
299
|
|
|
300 if (!gf)
|
|
|
301 {
|
|
|
302 maybe_signal_error (Qgui_error, "Couldn't load font", f->name,
|
|
|
303 Qfont, errb);
|
|
|
304 return 0;
|
|
|
305 }
|
|
|
306
|
|
|
307 xf = (XFontStruct *) GDK_FONT_XFONT (gf);
|
|
|
308
|
|
|
309 #endif /* THIS_IS_GTK */
|
|
|
310
|
|
|
311 /* Don't allocate the data until we're sure that we will succeed,
|
|
|
312 or the finalize method may get fucked. */
|
|
|
313
|
|
|
314 #ifndef THIS_IS_GTK
|
|
|
315 f->data = xnew (struct x_font_instance_data);
|
|
|
316 FONT_INSTANCE_X_FONT (f) = xf;
|
|
|
317 f->ascent = xf->ascent;
|
|
|
318 f->descent = xf->descent;
|
|
|
319 f->height = xf->ascent + xf->descent;
|
|
|
320 #else /* THIS_IS_GTK */
|
|
|
321 f->data = xnew (struct gtk_font_instance_data);
|
|
|
322 FONT_INSTANCE_GTK_FONT (f) = gf;
|
|
|
323 f->ascent = gf->ascent;
|
|
|
324 f->descent = gf->descent;
|
|
|
325 f->height = gf->ascent + gf->descent;
|
|
|
326 #endif /* THIS_IS_GTK */
|
|
|
327
|
|
|
328 /* Now let's figure out the width of the font */
|
|
|
329
|
|
|
330 {
|
|
|
331 /* following change suggested by Ted Phelps <phelps@dstc.edu.au> */
|
|
|
332 int def_char = 'n'; /*xf->default_char;*/
|
|
|
333 int byte1, byte2;
|
|
|
334
|
|
|
335 once_more:
|
|
|
336 byte1 = def_char >> 8;
|
|
|
337 byte2 = def_char & 0xFF;
|
|
|
338
|
|
|
339 if (xf->per_char)
|
|
|
340 {
|
|
|
341 /* Old versions of the R5 font server have garbage (>63k) as
|
|
|
342 def_char. 'n' might not be a valid character. */
|
|
|
343 if (byte1 < (int) xf->min_byte1 ||
|
|
|
344 byte1 > (int) xf->max_byte1 ||
|
|
|
345 byte2 < (int) xf->min_char_or_byte2 ||
|
|
|
346 byte2 > (int) xf->max_char_or_byte2)
|
|
|
347 f->width = 0;
|
|
|
348 else
|
|
|
349 f->width = xf->per_char[(byte1 - xf->min_byte1) *
|
|
|
350 (xf->max_char_or_byte2 -
|
|
|
351 xf->min_char_or_byte2 + 1) +
|
|
|
352 (byte2 - xf->min_char_or_byte2)].width;
|
|
|
353 }
|
|
|
354 else
|
|
|
355 f->width = xf->max_bounds.width;
|
|
|
356
|
|
|
357 /* Some fonts have a default char whose width is 0. This is no good.
|
|
|
358 If that's the case, first try 'n' as the default char, and if n has
|
|
|
359 0 width too (unlikely) then just use the max width. */
|
|
|
360 if (f->width == 0)
|
|
|
361 {
|
|
|
362 if (def_char == (int) xf->default_char)
|
|
|
363 f->width = xf->max_bounds.width;
|
|
|
364 else
|
|
|
365 {
|
|
|
366 def_char = xf->default_char;
|
|
|
367 goto once_more;
|
|
|
368 }
|
|
|
369 }
|
|
|
370 }
|
|
|
371 /* If all characters don't exist then there could potentially be
|
|
|
372 0-width characters lurking out there. Not setting this flag
|
|
|
373 trips an optimization that would make them appear to have width
|
|
|
374 to redisplay. This is bad. So we set it if not all characters
|
|
|
375 have the same width or if not all characters are defined.
|
|
|
376 */
|
|
|
377 /* #### This sucks. There is a measurable performance increase
|
|
|
378 when using proportional width fonts if this flag is not set.
|
|
|
379 Unfortunately so many of the fucking X fonts are not fully
|
|
|
380 defined that we could almost just get rid of this damn flag and
|
|
|
381 make it an assertion. */
|
|
|
382 f->proportional_p = (xf->min_bounds.width != xf->max_bounds.width ||
|
|
|
383 (
|
|
|
384 #ifndef THIS_IS_GTK
|
|
|
385 x_handle_non_fully_specified_fonts &&
|
|
|
386 #else /* THIS_IS_GTK */
|
|
|
387 /* x_handle_non_fully_specified_fonts */ 0 &&
|
|
|
388 #endif /* THIS_IS_GTK */
|
|
|
389 !xf->all_chars_exist));
|
|
|
390
|
|
|
391 #if 0 /* THIS_IS_GTK */
|
|
|
392 f->width = gdk_char_width (gf, 'n');
|
|
|
393 f->proportional_p = (gdk_char_width (gf, '|') != gdk_char_width (gf, 'W'));
|
|
|
394 #endif
|
|
|
395 return 1;
|
|
|
396 }
|
|
|
397
|
|
|
398 static void
|
|
|
399 ZZ (print_font_instance) (Lisp_Font_Instance *f,
|
|
|
400 Lisp_Object printcharfun,
|
|
|
401 int UNUSED (escapeflag))
|
|
|
402 {
|
|
|
403 write_fmt_string (printcharfun, " 0x%lx",
|
|
|
404 #ifndef THIS_IS_GTK
|
|
|
405 (unsigned long) FONT_INSTANCE_X_FONT (f)->fid);
|
|
|
406 #else /* THIS_IS_GTK */
|
|
|
407 (unsigned long) gdk_font_id (FONT_INSTANCE_GTK_FONT (f)));
|
|
|
408 #endif /* THIS_IS_GTK */
|
|
|
409 }
|
|
|
410
|
|
|
411 static void
|
|
|
412 ZZ (finalize_font_instance) (Lisp_Font_Instance *f)
|
|
|
413 {
|
|
|
414 if (f->data)
|
|
|
415 {
|
|
|
416 if (DEVICE_LIVE_P (XDEVICE (f->device)))
|
|
|
417 {
|
|
|
418 #ifndef THIS_IS_GTK
|
|
|
419 XFreeFont (DEVICE_X_DISPLAY (XDEVICE (f->device)),
|
|
|
420 FONT_INSTANCE_X_FONT (f));
|
|
|
421 #else /* THIS_IS_GTK */
|
|
|
422 gdk_font_unref (FONT_INSTANCE_GTK_FONT (f));
|
|
|
423 #endif /* THIS_IS_GTK */
|
|
|
424 }
|
|
|
425 xfree (f->data, void *);
|
|
|
426 f->data = 0;
|
|
|
427 }
|
|
|
428 }
|
|
|
429
|
|
|
430 /* Unbounded, for sufficiently small values of infinity... */
|
|
|
431 #define MAX_FONT_COUNT 5000
|
|
|
432
|
|
|
433 #ifndef THIS_IS_GTK
|
|
|
434 static Lisp_Object x_font_truename (Display *dpy, Extbyte *name,
|
|
|
435 XFontStruct *font);
|
|
|
436 #else
|
|
|
437 Lisp_Object __get_gtk_font_truename (GdkFont *gdk_font, int expandp);
|
|
|
438 #endif
|
|
|
439
|
|
|
440 static Lisp_Object
|
|
|
441 ZZ (font_instance_truename) (Lisp_Font_Instance *f, Error_Behavior errb)
|
|
|
442 {
|
|
|
443 if (NILP (FONT_INSTANCE_TRUENAME (f)))
|
|
|
444 {
|
|
|
445 #ifndef THIS_IS_GTK
|
|
|
446 FONT_INSTANCE_TRUENAME (f) =
|
|
|
447 x_font_truename (DEVICE_X_DISPLAY (XDEVICE (f->device)),
|
|
|
448 NEW_LISP_STRING_TO_EXTERNAL
|
|
|
449 (f->name, Qx_font_name_encoding),
|
|
|
450 FONT_INSTANCE_X_FONT (f));
|
|
|
451 #else
|
|
|
452 FONT_INSTANCE_TRUENAME (f) =
|
|
|
453 __get_gtk_font_truename (FONT_INSTANCE_GTK_FONT (f), 1);
|
|
|
454 #endif /* THIS_IS_GTK */
|
|
|
455
|
|
|
456 if (NILP (FONT_INSTANCE_TRUENAME (f)))
|
|
|
457 {
|
|
|
458 Lisp_Object font_instance = wrap_font_instance (f);
|
|
|
459
|
|
|
460
|
|
|
461 maybe_signal_error (Qgui_error, "Couldn't determine font truename",
|
|
|
462 font_instance, Qfont, errb);
|
|
|
463 /* Ok, just this once, return the font name as the truename.
|
|
|
464 (This is only used by Fequal() right now.) */
|
|
|
465 return f->name;
|
|
|
466 }
|
|
|
467 }
|
|
|
468 return FONT_INSTANCE_TRUENAME (f);
|
|
|
469 }
|
|
|
470
|
|
|
471 #ifdef MULE
|
|
|
472
|
|
|
473 static int
|
|
|
474 ZZ (font_spec_matches_charset) (struct device *UNUSED (d), Lisp_Object charset,
|
|
|
475 const Ibyte *nonreloc, Lisp_Object reloc,
|
|
|
476 Bytecount offset, Bytecount length,
|
|
|
477 int stage)
|
|
|
478 {
|
|
|
479 if (stage)
|
|
|
480 return 0;
|
|
|
481
|
|
|
482 if (UNBOUNDP (charset))
|
|
|
483 return 1;
|
|
|
484 /* Hack! Short font names don't have the registry in them,
|
|
|
485 so we just assume the user knows what they're doing in the
|
|
|
486 case of ASCII. For other charsets, you gotta give the
|
|
|
487 long form; sorry buster.
|
|
|
488 */
|
|
|
489 if (EQ (charset, Vcharset_ascii))
|
|
|
490 {
|
|
|
491 const Ibyte *the_nonreloc = nonreloc;
|
|
|
492 int i;
|
|
|
493 Bytecount the_length = length;
|
|
|
494
|
|
|
495 if (!the_nonreloc)
|
|
|
496 the_nonreloc = XSTRING_DATA (reloc);
|
|
|
497 fixup_internal_substring (nonreloc, reloc, offset, &the_length);
|
|
|
498 the_nonreloc += offset;
|
|
|
499 if (!memchr (the_nonreloc, '*', the_length))
|
|
|
500 {
|
|
|
501 for (i = 0;; i++)
|
|
|
502 {
|
|
|
503 const Ibyte *new_nonreloc = (const Ibyte *)
|
|
|
504 memchr (the_nonreloc, '-', the_length);
|
|
|
505 if (!new_nonreloc)
|
|
|
506 break;
|
|
|
507 new_nonreloc++;
|
|
|
508 the_length -= new_nonreloc - the_nonreloc;
|
|
|
509 the_nonreloc = new_nonreloc;
|
|
|
510 }
|
|
|
511
|
|
|
512 /* If it has less than 5 dashes, it's a short font.
|
|
|
513 Of course, long fonts always have 14 dashes or so, but short
|
|
|
514 fonts never have more than 1 or 2 dashes, so this is some
|
|
|
515 sort of reasonable heuristic. */
|
|
|
516 if (i < 5)
|
|
|
517 return 1;
|
|
|
518 }
|
|
|
519 }
|
|
|
520
|
|
|
521 return (fast_string_match (XCHARSET_REGISTRY (charset),
|
|
|
522 nonreloc, reloc, offset, length, 1,
|
|
|
523 ERROR_ME, 0) >= 0);
|
|
|
524 }
|
|
|
525
|
|
|
526 /* find a font spec that matches font spec FONT and also matches
|
|
|
527 (the registry of) CHARSET. */
|
|
|
528 static Lisp_Object
|
|
|
529 ZZ (find_charset_font) (Lisp_Object device, Lisp_Object font,
|
|
|
530 Lisp_Object charset, int stage)
|
|
|
531 {
|
|
|
532 #ifdef THIS_IS_GTK
|
|
|
533 /* #### copied from x_find_charset_font */
|
|
|
534 /* #### BILL!!! Try to make this go away eventually */
|
|
|
535 #endif /* THIS_IS_GTK */
|
|
|
536 Extbyte **names;
|
|
|
537 int count = 0;
|
|
|
538 Lisp_Object result = Qnil;
|
|
|
539 const Extbyte *patternext;
|
|
|
540 int i;
|
|
|
541
|
|
|
542 if (stage)
|
|
|
543 return Qnil;
|
|
|
544
|
|
|
545 LISP_STRING_TO_EXTERNAL (font, patternext, Qx_font_name_encoding);
|
|
|
546
|
|
|
547 names = XListFonts (
|
|
|
548 #ifndef THIS_IS_GTK
|
|
|
549 DEVICE_X_DISPLAY (XDEVICE (device)),
|
|
|
550 #else
|
|
|
551 GDK_DISPLAY (),
|
|
|
552 #endif
|
|
|
553 patternext, MAX_FONT_COUNT, &count);
|
|
|
554 /* #### This code seems awfully bogus -- mrb */
|
|
|
555 for (i = 0; i < count; i ++)
|
|
|
556 {
|
|
|
557 const Ibyte *intname;
|
|
|
558 Bytecount intlen;
|
|
|
559
|
|
|
560 EXTERNAL_TO_SIZED_C_STRING (names[i], intname, intlen,
|
|
|
561 Qx_font_name_encoding);
|
|
|
562 if (ZZ (font_spec_matches_charset) (XDEVICE (device), charset,
|
|
|
563 intname, Qnil, 0, -1, stage))
|
|
|
564 {
|
|
|
565 result = make_string (intname, intlen);
|
|
|
566 break;
|
|
|
567 }
|
|
|
568 }
|
|
|
569
|
|
|
570 if (names)
|
|
|
571 XFreeFontNames (names);
|
|
|
572
|
|
|
573 /* Check for a short font name. */
|
|
|
574 if (NILP (result)
|
|
|
575 && ZZ (font_spec_matches_charset) (XDEVICE (device), charset, 0,
|
|
|
576 font, 0, -1, stage))
|
|
|
577 return font;
|
|
|
578
|
|
|
579 return result;
|
|
|
580 }
|
|
|
581
|
|
|
582 #endif /* MULE */
|
|
|
583
|
|
|
584
|
|
|
585 /************************************************************************/
|
|
|
586 /* initialization */
|
|
|
587 /************************************************************************/
|
|
|
588
|
|
|
589 void
|
|
|
590 ZZEND (console_type_create_objects) (void)
|
|
|
591 {
|
|
|
592 /* object methods */
|
|
|
593
|
|
|
594 ZZCONSOLE_HAS_METHOD (initialize_color_instance);
|
|
|
595 ZZCONSOLE_HAS_METHOD (print_color_instance);
|
|
|
596 ZZCONSOLE_HAS_METHOD (finalize_color_instance);
|
|
|
597 ZZCONSOLE_HAS_METHOD (color_instance_equal);
|
|
|
598 ZZCONSOLE_HAS_METHOD (color_instance_hash);
|
|
|
599 ZZCONSOLE_HAS_METHOD (color_instance_rgb_components);
|
|
|
600 ZZCONSOLE_HAS_METHOD (valid_color_name_p);
|
|
|
601 ZZCONSOLE_HAS_METHOD (color_list);
|
|
|
602
|
|
|
603 ZZCONSOLE_HAS_METHOD (initialize_font_instance);
|
|
|
604 ZZCONSOLE_HAS_METHOD (print_font_instance);
|
|
|
605 ZZCONSOLE_HAS_METHOD (finalize_font_instance);
|
|
|
606 ZZCONSOLE_HAS_METHOD (font_instance_truename);
|
|
|
607 ZZCONSOLE_HAS_METHOD (font_instance_properties);
|
|
|
608 ZZCONSOLE_HAS_METHOD (font_list);
|
|
|
609 #ifdef MULE
|
|
|
610 ZZCONSOLE_HAS_METHOD (find_charset_font);
|
|
|
611 ZZCONSOLE_HAS_METHOD (font_spec_matches_charset);
|
|
|
612 #endif
|
|
|
613 }
|
