Mercurial > hg > xemacs-beta

comparison src/fontcolor-gtk.c @ 5176:8b2f75cecb89

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
rename objects* (.c, .h and .el files) to fontcolor* -------------------- ChangeLog entries follow: -------------------- etc/ChangeLog addition: 2010-02-22 Ben Wing <ben@xemacs.org> * dbxrc.in: Rename objects.c -> fontcolor.c. lisp/ChangeLog addition: 2010-02-22 Ben Wing <ben@xemacs.org> * dumped-lisp.el (preloaded-file-list): * font.el (font-tty-find-closest-color): * fontcolor.el: * fontcolor.el (ws-object-property-1): Removed. * fontcolor.el (fontcolor-property-1): New. * fontcolor.el (font-name): * fontcolor.el (font-ascent): * fontcolor.el (font-descent): * fontcolor.el (font-width): * fontcolor.el (font-height): * fontcolor.el (font-proportional-p): * fontcolor.el (font-properties): * fontcolor.el (font-truename): * fontcolor.el (color-name): * fontcolor.el (color-rgb-components): * x-faces.el: Rename objects.el -> fontcolor.el. lwlib/ChangeLog addition: 2010-02-22 Ben Wing <ben@xemacs.org> * lwlib-colors.h: objects*.h -> fontcolor*.h. man/ChangeLog addition: 2010-02-22 Ben Wing <ben@xemacs.org> * internals/internals.texi (A Summary of the Various XEmacs Modules): * internals/internals.texi (Modules for other Display-Related Lisp Objects): objects*.[ch] -> fontcolor*.[ch]. nt/ChangeLog addition: 2010-02-22 Ben Wing <ben@xemacs.org> * xemacs.dsp: * xemacs.mak: * xemacs.mak (OPT_OBJS): objects*.[ch] -> fontcolor*.[ch]. src/ChangeLog addition: 2010-02-22 Ben Wing <ben@xemacs.org> * EmacsFrame.c: * Makefile.in.in (x_objs): * Makefile.in.in (mswindows_objs): * Makefile.in.in (tty_objs): * Makefile.in.in (gtk_objs): * Makefile.in.in (objs): * console-tty.h: * console-x-impl.h: * console-x-impl.h (struct x_device): * console-x.h: * console-xlike-inc.h: * depend: * device-gtk.c: * device-msw.c: * device-x.c: * device-x.c (x_init_device): * device-x.c (x_finish_init_device): * device.c: * devslots.h (MARKED_SLOT): * emacs.c (main_1): * event-Xt.c: * event-gtk.c: * event-msw.c: * faces.c: * font-mgr.c: * fontcolor-gtk-impl.h: * fontcolor-gtk.c: * fontcolor-gtk.c (syms_of_fontcolor_gtk): * fontcolor-gtk.c (console_type_create_fontcolor_gtk): * fontcolor-gtk.c (vars_of_fontcolor_gtk): * fontcolor-gtk.h: * fontcolor-impl.h: * fontcolor-msw-impl.h: * fontcolor-msw.c: * fontcolor-msw.c (syms_of_fontcolor_mswindows): * fontcolor-msw.c (console_type_create_fontcolor_mswindows): * fontcolor-msw.c (reinit_vars_of_fontcolor_mswindows): * fontcolor-msw.c (vars_of_fontcolor_mswindows): * fontcolor-msw.h: * fontcolor-msw.h (mswindows_color_to_string): * fontcolor-tty-impl.h: * fontcolor-tty.c: * fontcolor-tty.c (syms_of_fontcolor_tty): * fontcolor-tty.c (console_type_create_fontcolor_tty): * fontcolor-tty.c (vars_of_fontcolor_tty): * fontcolor-tty.h: * fontcolor-x-impl.h: * fontcolor-x.c: * fontcolor-x.c (syms_of_fontcolor_x): * fontcolor-x.c (console_type_create_fontcolor_x): * fontcolor-x.c (vars_of_fontcolor_x): * fontcolor-x.c (Xatoms_of_fontcolor_x): * fontcolor-x.h: * fontcolor.c: * fontcolor.c (syms_of_fontcolor): * fontcolor.c (specifier_type_create_fontcolor): * fontcolor.c (reinit_specifier_type_create_fontcolor): * fontcolor.c (reinit_vars_of_fontcolor): * fontcolor.c (vars_of_fontcolor): * fontcolor.h: * fontcolor.h (set_face_boolean_attached_to): * frame-gtk.c: * frame-x.c: * glyphs-eimage.c: * glyphs-gtk.c: * glyphs-msw.c: * glyphs-widget.c: * glyphs-x.c: * glyphs.c: * gtk-glue.c: * gtk-glue.c (xemacs_type_register): * gtk-xemacs.c: * inline.c: * intl-win32.c: * lisp.h: * lrecord.h: * mule-charset.c: * native-gtk-toolbar.c: * redisplay-msw.c: * redisplay-tty.c: * redisplay.c: * select-x.c: * select.c: * symsinit.h: * toolbar-msw.c: * toolbar-msw.c (TOOLBAR_ITEM_ID_BITS): * toolbar-x.c: * ui-gtk.c: * window.c: Rename objects*.[ch] -> fontcolor*.[ch]. Fix up all references to the old files (e.g. in #include statements, Makefiles, functions like syms_of_objects_x(), etc.). tests/ChangeLog addition: 2010-02-22 Ben Wing <ben@xemacs.org> * reproduce-crashes.el (8): objects*.[ch] -> fontcolor*.[ch].
author Ben Wing <ben@xemacs.org>
date Mon, 22 Feb 2010 06:49:30 -0600
parents src/objects-gtk.c@3c3c1d139863
children 71ee43b8a74d
comparison
equal deleted inserted replaced
5175:dc94bf0afa37 5176:8b2f75cecb89
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, 2002 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 "buffer.h"
34 #include "charset.h"
35 #include "device-impl.h"
36 #include "insdel.h"
37
38 #include "console-gtk-impl.h"
39 #include "fontcolor-gtk-impl.h"
40
41 /* sigh */
42 #include "sysgdkx.h"
43
44 /* XListFonts doesn't allocate memory unconditionally based on this. (For
45 XFree86 in 2005, at least. */
46 #define MAX_FONT_COUNT INT_MAX
47
48 #ifdef DEBUG_XEMACS
49 Fixnum debug_x_objects;
50 #endif /* DEBUG_XEMACS */
51
52
53 /************************************************************************/
54 /* color instances */
55 /************************************************************************/
56
57 /* Replacement for XAllocColor() that tries to return the nearest
58 available color if the colormap is full. Original was from FSFmacs,
59 but rewritten by Jareth Hein <jareth@camelot-soft.com> 97/11/25
60 Modified by Lee Kindness <lkindness@csl.co.uk> 31/08/99 to handle previous
61 total failure which was due to a read/write colorcell being the nearest
62 match - tries the next nearest...
63
64 Gdk takes care of all this behind the scenes, so we don't need to
65 worry about it.
66
67 Return value is 1 for normal success, 2 for nearest color success,
68 3 for Non-deallocable sucess. */
69 int
70 allocate_nearest_color (GdkColormap *colormap, GdkVisual *UNUSED (visual),
71 GdkColor *color_def)
72 {
73 int rc;
74
75 rc = gdk_colormap_alloc_color (colormap, color_def, FALSE, TRUE);
76
77 if (rc == TRUE)
78 return (1);
79
80 return (0);
81 }
82
83 int
84 gtk_parse_nearest_color (struct device *d, GdkColor *color, Ibyte *name,
85 Bytecount len, Error_Behavior errb)
86 {
87 GdkColormap *cmap;
88 GdkVisual *visual;
89 int result;
90
91 cmap = DEVICE_GTK_COLORMAP(d);
92 visual = DEVICE_GTK_VISUAL (d);
93
94 xzero (*color);
95 {
96 const Extbyte *extname;
97 Bytecount extnamelen;
98
99 TO_EXTERNAL_FORMAT (DATA, (name, len), ALLOCA, (extname, extnamelen), Qbinary);
100
101 result = gdk_color_parse (extname, color);
102 }
103
104 if (result == FALSE)
105 {
106 maybe_invalid_argument ("unrecognized color", make_string (name, len),
107 Qcolor, errb);
108 return 0;
109 }
110 result = allocate_nearest_color (cmap, visual, color);
111 if (!result)
112 {
113 maybe_signal_error (Qgui_error, "couldn't allocate color",
114 make_string (name, len), Qcolor, errb);
115 return 0;
116 }
117
118 return result;
119 }
120
121 static int
122 gtk_initialize_color_instance (struct Lisp_Color_Instance *c, Lisp_Object name,
123 Lisp_Object device, Error_Behavior errb)
124 {
125 GdkColor color;
126 int result;
127
128 result = gtk_parse_nearest_color (XDEVICE (device), &color,
129 XSTRING_DATA (name),
130 XSTRING_LENGTH (name),
131 errb);
132
133 if (!result)
134 return 0;
135
136 /* Don't allocate the data until we're sure that we will succeed,
137 or the finalize method may get fucked. */
138 c->data = xnew (struct gtk_color_instance_data);
139 if (result == 3)
140 COLOR_INSTANCE_GTK_DEALLOC (c) = 0;
141 else
142 COLOR_INSTANCE_GTK_DEALLOC (c) = 1;
143 COLOR_INSTANCE_GTK_COLOR (c) = gdk_color_copy (&color);
144 return 1;
145 }
146
147 static void
148 gtk_print_color_instance (struct Lisp_Color_Instance *c,
149 Lisp_Object printcharfun,
150 int UNUSED (escapeflag))
151 {
152 GdkColor *color = COLOR_INSTANCE_GTK_COLOR (c);
153 write_fmt_string (printcharfun, " %ld=(%X,%X,%X)",
154 color->pixel, color->red, color->green, color->blue);
155 }
156
157 static void
158 gtk_finalize_color_instance (struct Lisp_Color_Instance *c)
159 {
160 if (c->data)
161 {
162 if (DEVICE_LIVE_P (XDEVICE (c->device)))
163 {
164 if (COLOR_INSTANCE_GTK_DEALLOC (c))
165 {
166 gdk_colormap_free_colors (DEVICE_GTK_COLORMAP (XDEVICE (c->device)),
167 COLOR_INSTANCE_GTK_COLOR (c), 1);
168 }
169 gdk_color_free (COLOR_INSTANCE_GTK_COLOR (c));
170 }
171 xfree (c->data);
172 c->data = 0;
173 }
174 }
175
176 /* Color instances are equal if they resolve to the same color on the
177 screen (have the same RGB values). I imagine that
178 "same RGB values" == "same cell in the colormap." Arguably we should
179 be comparing their names or pixel values instead. */
180
181 static int
182 gtk_color_instance_equal (struct Lisp_Color_Instance *c1,
183 struct Lisp_Color_Instance *c2,
184 int UNUSED (depth))
185 {
186 return (gdk_color_equal (COLOR_INSTANCE_GTK_COLOR (c1),
187 COLOR_INSTANCE_GTK_COLOR (c2)));
188 }
189
190 static Hashcode
191 gtk_color_instance_hash (struct Lisp_Color_Instance *c, int UNUSED (depth))
192 {
193 return (gdk_color_hash (COLOR_INSTANCE_GTK_COLOR (c), NULL));
194 }
195
196 static Lisp_Object
197 gtk_color_instance_rgb_components (struct Lisp_Color_Instance *c)
198 {
199 GdkColor *color = COLOR_INSTANCE_GTK_COLOR (c);
200 return (list3 (make_int (color->red),
201 make_int (color->green),
202 make_int (color->blue)));
203 }
204
205 static int
206 gtk_valid_color_name_p (struct device *UNUSED (d), Lisp_Object color)
207 {
208 GdkColor c;
209 const char *extname;
210
211 extname = LISP_STRING_TO_EXTERNAL (color, Qctext);
212
213 if (gdk_color_parse (extname, &c) != TRUE)
214 return(0);
215 return (1);
216 }
217
218 static Lisp_Object
219 gtk_color_list (void)
220 {
221 /* #### BILL!!!
222 Is this correct? */
223 return call0 (intern ("x-color-list-internal"));
224 }
225
226
227 /************************************************************************/
228 /* font instances */
229 /************************************************************************/
230
231 static int
232 gtk_initialize_font_instance (struct Lisp_Font_Instance *f,
233 Lisp_Object UNUSED (name),
234 Lisp_Object UNUSED (device), Error_Behavior errb)
235 {
236 GdkFont *gf;
237 XFontStruct *xf;
238 const char *extname;
239
240 extname = LISP_STRING_TO_EXTERNAL (f->name, Qctext);
241
242 gf = gdk_font_load (extname);
243
244 if (!gf)
245 {
246 maybe_signal_error (Qgui_error, "couldn't load font", f->name,
247 Qfont, errb);
248 return 0;
249 }
250
251 xf = (XFontStruct*) GDK_FONT_XFONT (gf);
252
253 /* Don't allocate the data until we're sure that we will succeed,
254 or the finalize method may get fucked. */
255 f->data = xnew (struct gtk_font_instance_data);
256 FONT_INSTANCE_GTK_FONT (f) = gf;
257 f->ascent = gf->ascent;
258 f->descent = gf->descent;
259 f->height = gf->ascent + gf->descent;
260
261 /* Now lets figure out the width of the font */
262 {
263 /* following change suggested by Ted Phelps <phelps@dstc.edu.au> */
264 unsigned int def_char = 'n'; /*xf->default_char;*/
265 unsigned int byte1, byte2;
266
267 once_more:
268 byte1 = def_char >> 8;
269 byte2 = def_char & 0xFF;
270
271 if (xf->per_char)
272 {
273 /* Old versions of the R5 font server have garbage (>63k) as
274 def_char. 'n' might not be a valid character. */
275 if (byte1 < xf->min_byte1 ||
276 byte1 > xf->max_byte1 ||
277 byte2 < xf->min_char_or_byte2 ||
278 byte2 > xf->max_char_or_byte2)
279 f->width = 0;
280 else
281 f->width = xf->per_char[(byte1 - xf->min_byte1) *
282 (xf->max_char_or_byte2 -
283 xf->min_char_or_byte2 + 1) +
284 (byte2 - xf->min_char_or_byte2)].width;
285 }
286 else
287 f->width = xf->max_bounds.width;
288
289 /* Some fonts have a default char whose width is 0. This is no good.
290 If that's the case, first try 'n' as the default char, and if n has
291 0 width too (unlikely) then just use the max width. */
292 if (f->width == 0)
293 {
294 if (def_char == xf->default_char)
295 f->width = xf->max_bounds.width;
296 else
297 {
298 def_char = xf->default_char;
299 goto once_more;
300 }
301 }
302 }
303
304 /* If all characters don't exist then there could potentially be
305 0-width characters lurking out there. Not setting this flag
306 trips an optimization that would make them appear to have width
307 to redisplay. This is bad. So we set it if not all characters
308 have the same width or if not all characters are defined.
309 */
310 /* #### This sucks. There is a measurable performance increase
311 when using proportional width fonts if this flag is not set.
312 Unfortunately so many of the fucking X fonts are not fully
313 defined that we could almost just get rid of this damn flag and
314 make it an assertion. */
315 f->proportional_p = (xf->min_bounds.width != xf->max_bounds.width ||
316 (/* x_handle_non_fully_specified_fonts */ 0 &&
317 !xf->all_chars_exist));
318 #if 0
319 f->width = gdk_char_width (gf, 'n');
320 f->proportional_p = (gdk_char_width (gf, '|') != gdk_char_width (gf, 'W')) ? 1 : 0;
321 #endif
322 return 1;
323 }
324
325 static void
326 gtk_print_font_instance (struct Lisp_Font_Instance *f,
327 Lisp_Object printcharfun,
328 int UNUSED (escapeflag))
329 {
330 write_fmt_string (printcharfun, " 0x%lx",
331 (unsigned long) gdk_font_id (FONT_INSTANCE_GTK_FONT (f)));
332 }
333
334 static void
335 gtk_finalize_font_instance (struct Lisp_Font_Instance *f)
336 {
337 if (f->data)
338 {
339 if (DEVICE_LIVE_P (XDEVICE (f->device)))
340 {
341 gdk_font_unref (FONT_INSTANCE_GTK_FONT (f));
342 }
343 xfree (f->data);
344 f->data = 0;
345 }
346 }
347
348 /* Forward declarations for X specific functions at the end of the file */
349 Lisp_Object __get_gtk_font_truename (GdkFont *gdk_font, int expandp);
350 static Lisp_Object __gtk_font_list_internal (const char *pattern);
351
352 static Lisp_Object
353 gtk_font_instance_truename (struct Lisp_Font_Instance *f,
354 Error_Behavior UNUSED (errb))
355 {
356 if (NILP (FONT_INSTANCE_TRUENAME (f)))
357 {
358 FONT_INSTANCE_TRUENAME (f) = __get_gtk_font_truename (FONT_INSTANCE_GTK_FONT (f), 1);
359
360 if (NILP (FONT_INSTANCE_TRUENAME (f)))
361 {
362 /* Ok, just this once, return the font name as the truename.
363 (This is only used by Fequal() right now.) */
364 return f->name;
365 }
366 }
367 return (FONT_INSTANCE_TRUENAME (f));
368 }
369
370 static Lisp_Object
371 gtk_font_instance_properties (struct Lisp_Font_Instance *UNUSED (f))
372 {
373 Lisp_Object result = Qnil;
374
375 /* #### BILL!!! */
376 /* There seems to be no way to get this information under Gtk */
377 return result;
378 }
379
380 static Lisp_Object
381 gtk_font_list (Lisp_Object pattern, Lisp_Object UNUSED (device),
382 Lisp_Object UNUSED (maxnumber))
383 {
384 const char *patternext;
385
386 patternext = LISP_STRING_TO_EXTERNAL (pattern, Qbinary);
387
388 return (__gtk_font_list_internal (patternext));
389 }
390
391 /* Include the charset support, shared, for the moment, with X11. */
392 #define THIS_IS_GTK
393 #include "fontcolor-xlike-inc.c"
394
395
396 /************************************************************************/
397 /* initialization */
398 /************************************************************************/
399
400 void
401 syms_of_fontcolor_gtk (void)
402 {
403 }
404
405 void
406 console_type_create_fontcolor_gtk (void)
407 {
408 /* object methods */
409
410 CONSOLE_HAS_METHOD (gtk, initialize_color_instance);
411 CONSOLE_HAS_METHOD (gtk, print_color_instance);
412 CONSOLE_HAS_METHOD (gtk, finalize_color_instance);
413 CONSOLE_HAS_METHOD (gtk, color_instance_equal);
414 CONSOLE_HAS_METHOD (gtk, color_instance_hash);
415 CONSOLE_HAS_METHOD (gtk, color_instance_rgb_components);
416 CONSOLE_HAS_METHOD (gtk, valid_color_name_p);
417 CONSOLE_HAS_METHOD (gtk, color_list);
418
419 CONSOLE_HAS_METHOD (gtk, initialize_font_instance);
420 CONSOLE_HAS_METHOD (gtk, print_font_instance);
421 CONSOLE_HAS_METHOD (gtk, finalize_font_instance);
422 CONSOLE_HAS_METHOD (gtk, font_instance_truename);
423 CONSOLE_HAS_METHOD (gtk, font_instance_properties);
424 CONSOLE_HAS_METHOD (gtk, font_list);
425 #ifdef MULE
426 CONSOLE_HAS_METHOD (gtk, find_charset_font);
427 CONSOLE_HAS_METHOD (gtk, font_spec_matches_charset);
428 #endif
429 }
430
431 void
432 vars_of_fontcolor_gtk (void)
433 {
434 #ifdef DEBUG_XEMACS
435 DEFVAR_INT ("debug-x-objects", &debug_x_objects /*
436 If non-zero, display debug information about X objects
437 */ );
438 debug_x_objects = 0;
439 #endif
440 }
441
442 static int
443 valid_font_name_p (Display *dpy, char *name)
444 {
445 /* Maybe this should be implemented by callign XLoadFont and trapping
446 the error. That would be a lot of work, and wasteful as hell, but
447 might be more correct.
448 */
449 int nnames = 0;
450 char **names = 0;
451 if (! name)
452 return 0;
453 names = XListFonts (dpy, name, 1, &nnames);
454 if (names)
455 XFreeFontNames (names);
456 return (nnames != 0);
457 }
458
459 Lisp_Object
460 __get_gtk_font_truename (GdkFont *gdk_font, int expandp)
461 {
462 Display *dpy = GDK_FONT_XDISPLAY (gdk_font);
463 GSList *names = ((GdkFontPrivate *) gdk_font)->names;
464 Lisp_Object font_name = Qnil;
465
466 while (names)
467 {
468 if (names->data)
469 {
470 if (valid_font_name_p (dpy, (char*) names->data))
471 {
472 if (!expandp)
473 {
474 /* They want the wildcarded version */
475 font_name = build_cistring ((char*) names->data);
476 }
477 else
478 {
479 /* Need to expand out */
480 int nnames = 0;
481 char **x_font_names = 0;
482
483 x_font_names = XListFonts (dpy, (char*) names->data, 1, &nnames);
484 if (x_font_names)
485 {
486 font_name = build_cistring (x_font_names[0]);
487 XFreeFontNames (x_font_names);
488 }
489 }
490 break;
491 }
492 }
493 names = names->next;
494 }
495 return (font_name);
496 }
497
498 static Lisp_Object __gtk_font_list_internal (const char *pattern)
499 {
500 char **names;
501 int count = 0;
502 Lisp_Object result = Qnil;
503
504 names = XListFonts (GDK_DISPLAY (), pattern, MAX_FONT_COUNT, &count);
505 while (count--)
506 result = Fcons (build_extstring (names [count], Qbinary), result);
507 if (names)
508 XFreeFontNames (names);
509
510 return result;
511 }