Mercurial > hg > xemacs-beta
annotate src/fontcolor-gtk.c @ 5197:ce8ffb95bbe3
finish up CHANGES-beta -- all changes thru Apr 9, 2010
-------------------- ChangeLog entries follow: --------------------
ChangeLog addition:
2010-04-09 Ben Wing <ben@xemacs.org>
* CHANGES-beta:
Update with my changes to the trunk since the release of 21.5.29
in 2009 up through April 9, 2010.
author | Ben Wing <ben@xemacs.org> |
---|---|
date | Fri, 09 Apr 2010 02:33:11 -0500 |
parents | 71ee43b8a74d |
children | 3889ef128488 308d34e9f07d |
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 | |
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 | |
872 | 33 #include "buffer.h" |
3676 | 34 #include "charset.h" |
872 | 35 #include "device-impl.h" |
36 #include "insdel.h" | |
462 | 37 |
872 | 38 #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
|
39 #include "fontcolor-gtk-impl.h" |
462 | 40 |
41 /* sigh */ | |
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
3676
diff
changeset
|
42 #include "sysgdkx.h" |
462 | 43 |
3659 | 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 | |
462 | 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 | |
2286 | 70 allocate_nearest_color (GdkColormap *colormap, GdkVisual *UNUSED (visual), |
462 | 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 | |
867 | 84 gtk_parse_nearest_color (struct device *d, GdkColor *color, Ibyte *name, |
578 | 85 Bytecount len, Error_Behavior errb) |
462 | 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; | |
665 | 97 Bytecount extnamelen; |
462 | 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 { | |
563 | 106 maybe_invalid_argument ("unrecognized color", make_string (name, len), |
107 Qcolor, errb); | |
462 | 108 return 0; |
109 } | |
110 result = allocate_nearest_color (cmap, visual, color); | |
111 if (!result) | |
112 { | |
563 | 113 maybe_signal_error (Qgui_error, "couldn't allocate color", |
114 make_string (name, len), Qcolor, errb); | |
462 | 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, | |
578 | 123 Lisp_Object device, Error_Behavior errb) |
462 | 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, | |
2286 | 150 int UNUSED (escapeflag)) |
462 | 151 { |
152 GdkColor *color = COLOR_INSTANCE_GTK_COLOR (c); | |
800 | 153 write_fmt_string (printcharfun, " %ld=(%X,%X,%X)", |
154 color->pixel, color->red, color->green, color->blue); | |
462 | 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 } | |
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
171 xfree (c->data); |
462 | 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, | |
2286 | 184 int UNUSED (depth)) |
462 | 185 { |
186 return (gdk_color_equal (COLOR_INSTANCE_GTK_COLOR (c1), | |
187 COLOR_INSTANCE_GTK_COLOR (c2))); | |
188 } | |
189 | |
2515 | 190 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
|
191 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
|
192 Boolint UNUSED (equalp)) |
462 | 193 { |
194 return (gdk_color_hash (COLOR_INSTANCE_GTK_COLOR (c), NULL)); | |
195 } | |
196 | |
197 static Lisp_Object | |
198 gtk_color_instance_rgb_components (struct Lisp_Color_Instance *c) | |
199 { | |
200 GdkColor *color = COLOR_INSTANCE_GTK_COLOR (c); | |
201 return (list3 (make_int (color->red), | |
202 make_int (color->green), | |
203 make_int (color->blue))); | |
204 } | |
205 | |
206 static int | |
2286 | 207 gtk_valid_color_name_p (struct device *UNUSED (d), Lisp_Object color) |
462 | 208 { |
209 GdkColor c; | |
210 const char *extname; | |
211 | |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
212 extname = LISP_STRING_TO_EXTERNAL (color, Qctext); |
462 | 213 |
214 if (gdk_color_parse (extname, &c) != TRUE) | |
215 return(0); | |
216 return (1); | |
217 } | |
218 | |
2527 | 219 static Lisp_Object |
220 gtk_color_list (void) | |
221 { | |
222 /* #### BILL!!! | |
223 Is this correct? */ | |
224 return call0 (intern ("x-color-list-internal")); | |
225 } | |
226 | |
462 | 227 |
228 /************************************************************************/ | |
229 /* font instances */ | |
230 /************************************************************************/ | |
231 | |
232 static int | |
2286 | 233 gtk_initialize_font_instance (struct Lisp_Font_Instance *f, |
234 Lisp_Object UNUSED (name), | |
235 Lisp_Object UNUSED (device), Error_Behavior errb) | |
462 | 236 { |
237 GdkFont *gf; | |
238 XFontStruct *xf; | |
239 const char *extname; | |
240 | |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
241 extname = LISP_STRING_TO_EXTERNAL (f->name, Qctext); |
462 | 242 |
243 gf = gdk_font_load (extname); | |
244 | |
245 if (!gf) | |
246 { | |
563 | 247 maybe_signal_error (Qgui_error, "couldn't load font", f->name, |
248 Qfont, errb); | |
462 | 249 return 0; |
250 } | |
251 | |
2054 | 252 xf = (XFontStruct*) GDK_FONT_XFONT (gf); |
462 | 253 |
254 /* Don't allocate the data until we're sure that we will succeed, | |
255 or the finalize method may get fucked. */ | |
256 f->data = xnew (struct gtk_font_instance_data); | |
257 FONT_INSTANCE_GTK_FONT (f) = gf; | |
258 f->ascent = gf->ascent; | |
259 f->descent = gf->descent; | |
260 f->height = gf->ascent + gf->descent; | |
261 | |
262 /* Now lets figure out the width of the font */ | |
263 { | |
264 /* following change suggested by Ted Phelps <phelps@dstc.edu.au> */ | |
265 unsigned int def_char = 'n'; /*xf->default_char;*/ | |
266 unsigned int byte1, byte2; | |
267 | |
268 once_more: | |
269 byte1 = def_char >> 8; | |
270 byte2 = def_char & 0xFF; | |
271 | |
272 if (xf->per_char) | |
273 { | |
274 /* Old versions of the R5 font server have garbage (>63k) as | |
275 def_char. 'n' might not be a valid character. */ | |
276 if (byte1 < xf->min_byte1 || | |
277 byte1 > xf->max_byte1 || | |
278 byte2 < xf->min_char_or_byte2 || | |
279 byte2 > xf->max_char_or_byte2) | |
280 f->width = 0; | |
281 else | |
282 f->width = xf->per_char[(byte1 - xf->min_byte1) * | |
283 (xf->max_char_or_byte2 - | |
284 xf->min_char_or_byte2 + 1) + | |
285 (byte2 - xf->min_char_or_byte2)].width; | |
286 } | |
287 else | |
288 f->width = xf->max_bounds.width; | |
289 | |
290 /* Some fonts have a default char whose width is 0. This is no good. | |
291 If that's the case, first try 'n' as the default char, and if n has | |
292 0 width too (unlikely) then just use the max width. */ | |
293 if (f->width == 0) | |
294 { | |
295 if (def_char == xf->default_char) | |
296 f->width = xf->max_bounds.width; | |
297 else | |
298 { | |
299 def_char = xf->default_char; | |
300 goto once_more; | |
301 } | |
302 } | |
303 } | |
304 | |
305 /* If all characters don't exist then there could potentially be | |
306 0-width characters lurking out there. Not setting this flag | |
307 trips an optimization that would make them appear to have width | |
308 to redisplay. This is bad. So we set it if not all characters | |
309 have the same width or if not all characters are defined. | |
310 */ | |
311 /* #### This sucks. There is a measurable performance increase | |
312 when using proportional width fonts if this flag is not set. | |
313 Unfortunately so many of the fucking X fonts are not fully | |
314 defined that we could almost just get rid of this damn flag and | |
315 make it an assertion. */ | |
316 f->proportional_p = (xf->min_bounds.width != xf->max_bounds.width || | |
317 (/* x_handle_non_fully_specified_fonts */ 0 && | |
318 !xf->all_chars_exist)); | |
319 #if 0 | |
320 f->width = gdk_char_width (gf, 'n'); | |
321 f->proportional_p = (gdk_char_width (gf, '|') != gdk_char_width (gf, 'W')) ? 1 : 0; | |
322 #endif | |
323 return 1; | |
324 } | |
325 | |
326 static void | |
327 gtk_print_font_instance (struct Lisp_Font_Instance *f, | |
328 Lisp_Object printcharfun, | |
2286 | 329 int UNUSED (escapeflag)) |
462 | 330 { |
800 | 331 write_fmt_string (printcharfun, " 0x%lx", |
332 (unsigned long) gdk_font_id (FONT_INSTANCE_GTK_FONT (f))); | |
462 | 333 } |
334 | |
335 static void | |
336 gtk_finalize_font_instance (struct Lisp_Font_Instance *f) | |
337 { | |
338 if (f->data) | |
339 { | |
340 if (DEVICE_LIVE_P (XDEVICE (f->device))) | |
341 { | |
342 gdk_font_unref (FONT_INSTANCE_GTK_FONT (f)); | |
343 } | |
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
344 xfree (f->data); |
462 | 345 f->data = 0; |
346 } | |
347 } | |
348 | |
349 /* Forward declarations for X specific functions at the end of the file */ | |
350 Lisp_Object __get_gtk_font_truename (GdkFont *gdk_font, int expandp); | |
2527 | 351 static Lisp_Object __gtk_font_list_internal (const char *pattern); |
462 | 352 |
353 static Lisp_Object | |
2286 | 354 gtk_font_instance_truename (struct Lisp_Font_Instance *f, |
355 Error_Behavior UNUSED (errb)) | |
462 | 356 { |
872 | 357 if (NILP (FONT_INSTANCE_TRUENAME (f))) |
462 | 358 { |
872 | 359 FONT_INSTANCE_TRUENAME (f) = __get_gtk_font_truename (FONT_INSTANCE_GTK_FONT (f), 1); |
462 | 360 |
872 | 361 if (NILP (FONT_INSTANCE_TRUENAME (f))) |
462 | 362 { |
363 /* Ok, just this once, return the font name as the truename. | |
364 (This is only used by Fequal() right now.) */ | |
365 return f->name; | |
366 } | |
367 } | |
872 | 368 return (FONT_INSTANCE_TRUENAME (f)); |
462 | 369 } |
370 | |
371 static Lisp_Object | |
2286 | 372 gtk_font_instance_properties (struct Lisp_Font_Instance *UNUSED (f)) |
462 | 373 { |
374 Lisp_Object result = Qnil; | |
375 | |
376 /* #### BILL!!! */ | |
377 /* There seems to be no way to get this information under Gtk */ | |
378 return result; | |
379 } | |
380 | |
381 static Lisp_Object | |
2527 | 382 gtk_font_list (Lisp_Object pattern, Lisp_Object UNUSED (device), |
2286 | 383 Lisp_Object UNUSED (maxnumber)) |
462 | 384 { |
385 const char *patternext; | |
386 | |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
387 patternext = LISP_STRING_TO_EXTERNAL (pattern, Qbinary); |
462 | 388 |
2527 | 389 return (__gtk_font_list_internal (patternext)); |
462 | 390 } |
391 | |
3659 | 392 /* Include the charset support, shared, for the moment, with X11. */ |
393 #define THIS_IS_GTK | |
5176
8b2f75cecb89
rename objects* (.c, .h and .el files) to fontcolor*
Ben Wing <ben@xemacs.org>
parents:
4982
diff
changeset
|
394 #include "fontcolor-xlike-inc.c" |
462 | 395 |
396 | |
397 /************************************************************************/ | |
398 /* initialization */ | |
399 /************************************************************************/ | |
400 | |
401 void | |
5176
8b2f75cecb89
rename objects* (.c, .h and .el files) to fontcolor*
Ben Wing <ben@xemacs.org>
parents:
4982
diff
changeset
|
402 syms_of_fontcolor_gtk (void) |
462 | 403 { |
404 } | |
405 | |
406 void | |
5176
8b2f75cecb89
rename objects* (.c, .h and .el files) to fontcolor*
Ben Wing <ben@xemacs.org>
parents:
4982
diff
changeset
|
407 console_type_create_fontcolor_gtk (void) |
462 | 408 { |
409 /* object methods */ | |
410 | |
411 CONSOLE_HAS_METHOD (gtk, initialize_color_instance); | |
412 CONSOLE_HAS_METHOD (gtk, print_color_instance); | |
413 CONSOLE_HAS_METHOD (gtk, finalize_color_instance); | |
414 CONSOLE_HAS_METHOD (gtk, color_instance_equal); | |
415 CONSOLE_HAS_METHOD (gtk, color_instance_hash); | |
416 CONSOLE_HAS_METHOD (gtk, color_instance_rgb_components); | |
417 CONSOLE_HAS_METHOD (gtk, valid_color_name_p); | |
2527 | 418 CONSOLE_HAS_METHOD (gtk, color_list); |
462 | 419 |
420 CONSOLE_HAS_METHOD (gtk, initialize_font_instance); | |
421 CONSOLE_HAS_METHOD (gtk, print_font_instance); | |
422 CONSOLE_HAS_METHOD (gtk, finalize_font_instance); | |
423 CONSOLE_HAS_METHOD (gtk, font_instance_truename); | |
424 CONSOLE_HAS_METHOD (gtk, font_instance_properties); | |
2527 | 425 CONSOLE_HAS_METHOD (gtk, font_list); |
462 | 426 #ifdef MULE |
427 CONSOLE_HAS_METHOD (gtk, find_charset_font); | |
428 CONSOLE_HAS_METHOD (gtk, font_spec_matches_charset); | |
429 #endif | |
430 } | |
431 | |
432 void | |
5176
8b2f75cecb89
rename objects* (.c, .h and .el files) to fontcolor*
Ben Wing <ben@xemacs.org>
parents:
4982
diff
changeset
|
433 vars_of_fontcolor_gtk (void) |
462 | 434 { |
3659 | 435 #ifdef DEBUG_XEMACS |
436 DEFVAR_INT ("debug-x-objects", &debug_x_objects /* | |
437 If non-zero, display debug information about X objects | |
438 */ ); | |
439 debug_x_objects = 0; | |
440 #endif | |
462 | 441 } |
442 | |
443 static int | |
444 valid_font_name_p (Display *dpy, char *name) | |
445 { | |
446 /* Maybe this should be implemented by callign XLoadFont and trapping | |
447 the error. That would be a lot of work, and wasteful as hell, but | |
448 might be more correct. | |
449 */ | |
450 int nnames = 0; | |
451 char **names = 0; | |
452 if (! name) | |
453 return 0; | |
454 names = XListFonts (dpy, name, 1, &nnames); | |
455 if (names) | |
456 XFreeFontNames (names); | |
457 return (nnames != 0); | |
458 } | |
459 | |
460 Lisp_Object | |
461 __get_gtk_font_truename (GdkFont *gdk_font, int expandp) | |
462 { | |
463 Display *dpy = GDK_FONT_XDISPLAY (gdk_font); | |
464 GSList *names = ((GdkFontPrivate *) gdk_font)->names; | |
465 Lisp_Object font_name = Qnil; | |
466 | |
467 while (names) | |
468 { | |
469 if (names->data) | |
470 { | |
2054 | 471 if (valid_font_name_p (dpy, (char*) names->data)) |
462 | 472 { |
473 if (!expandp) | |
474 { | |
475 /* They want the wildcarded version */ | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
3676
diff
changeset
|
476 font_name = build_cistring ((char*) names->data); |
462 | 477 } |
478 else | |
479 { | |
480 /* Need to expand out */ | |
481 int nnames = 0; | |
482 char **x_font_names = 0; | |
483 | |
2054 | 484 x_font_names = XListFonts (dpy, (char*) names->data, 1, &nnames); |
462 | 485 if (x_font_names) |
486 { | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
3676
diff
changeset
|
487 font_name = build_cistring (x_font_names[0]); |
462 | 488 XFreeFontNames (x_font_names); |
489 } | |
490 } | |
491 break; | |
492 } | |
493 } | |
494 names = names->next; | |
495 } | |
496 return (font_name); | |
497 } | |
498 | |
2527 | 499 static Lisp_Object __gtk_font_list_internal (const char *pattern) |
462 | 500 { |
501 char **names; | |
502 int count = 0; | |
503 Lisp_Object result = Qnil; | |
504 | |
505 names = XListFonts (GDK_DISPLAY (), pattern, MAX_FONT_COUNT, &count); | |
506 while (count--) | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
3676
diff
changeset
|
507 result = Fcons (build_extstring (names [count], Qbinary), result); |
462 | 508 if (names) |
509 XFreeFontNames (names); | |
510 | |
511 return result; | |
512 } |