Mercurial > hg > xemacs-beta
annotate src/objects-x.c @ 5008:cad59a0a3b19
Add license information from Marcus Thiessel.
See xemacs-beta message <20100208091453.25900@gmx.net>.
| author | Jerry James <james@xemacs.org> |
|---|---|
| date | Tue, 09 Feb 2010 09:50:49 -0700 |
| parents | 3c3c1d139863 |
| children |
| rev | line source |
|---|---|
| 428 | 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. | |
| 2367 | 5 Copyright (C) 1995, 1996, 2000, 2001, 2002, 2004 Ben Wing. |
| 428 | 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 | |
| 442 | 29 /* This file Mule-ized by Ben Wing, 7-10-00. */ |
| 30 | |
| 428 | 31 #include <config.h> |
| 32 #include "lisp.h" | |
| 33 | |
| 872 | 34 #include "charset.h" |
| 35 #include "device-impl.h" | |
| 36 #include "insdel.h" | |
| 428 | 37 |
| 872 | 38 #include "console-x-impl.h" |
| 39 #include "objects-x-impl.h" | |
| 3659 | 40 #include "elhash.h" |
| 428 | 41 |
|
4916
a6c778975d7d
split USE_XFT into HAVE_XFT/USE_XFT
Ben Wing <ben@xemacs.org>
parents:
4757
diff
changeset
|
42 #ifdef HAVE_XFT |
| 3354 | 43 #include "font-mgr.h" |
| 3094 | 44 #endif |
| 45 | |
| 428 | 46 int x_handle_non_fully_specified_fonts; |
| 47 | |
| 3659 | 48 #ifdef DEBUG_XEMACS |
| 49 Fixnum debug_x_objects; | |
| 50 #endif /* DEBUG_XEMACS */ | |
| 51 | |
| 428 | 52 |
| 53 /************************************************************************/ | |
| 54 /* color instances */ | |
| 55 /************************************************************************/ | |
| 56 | |
| 442 | 57 static int |
| 58 x_parse_nearest_color (struct device *d, XColor *color, Lisp_Object name, | |
| 578 | 59 Error_Behavior errb) |
| 428 | 60 { |
| 61 Display *dpy = DEVICE_X_DISPLAY (d); | |
| 62 Colormap cmap = DEVICE_X_COLORMAP (d); | |
| 63 Visual *visual = DEVICE_X_VISUAL (d); | |
| 64 int result; | |
| 65 | |
| 66 xzero (*color); | |
| 67 { | |
| 442 | 68 const Extbyte *extname; |
| 428 | 69 |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4969
diff
changeset
|
70 extname = LISP_STRING_TO_EXTERNAL (name, Qx_color_name_encoding); |
| 442 | 71 result = XParseColor (dpy, cmap, extname, color); |
| 428 | 72 } |
| 73 if (!result) | |
| 74 { | |
| 563 | 75 maybe_signal_error (Qgui_error, "Unrecognized color", |
| 76 name, Qcolor, errb); | |
| 428 | 77 return 0; |
| 78 } | |
| 3094 | 79 result = x_allocate_nearest_color (dpy, cmap, visual, color); |
| 428 | 80 if (!result) |
| 81 { | |
| 563 | 82 maybe_signal_error (Qgui_error, "Couldn't allocate color", |
| 83 name, Qcolor, errb); | |
| 428 | 84 return 0; |
| 85 } | |
| 86 | |
| 87 return result; | |
| 88 } | |
| 89 | |
| 90 static int | |
| 440 | 91 x_initialize_color_instance (Lisp_Color_Instance *c, Lisp_Object name, |
| 578 | 92 Lisp_Object device, Error_Behavior errb) |
| 428 | 93 { |
| 94 XColor color; | |
|
4916
a6c778975d7d
split USE_XFT into HAVE_XFT/USE_XFT
Ben Wing <ben@xemacs.org>
parents:
4757
diff
changeset
|
95 #ifdef HAVE_XFT |
| 3094 | 96 XftColor xftColor; |
| 97 #endif | |
| 428 | 98 int result; |
| 99 | |
| 442 | 100 result = x_parse_nearest_color (XDEVICE (device), &color, name, errb); |
| 428 | 101 |
| 102 if (!result) | |
| 103 return 0; | |
| 104 | |
| 105 /* Don't allocate the data until we're sure that we will succeed, | |
| 106 or the finalize method may get fucked. */ | |
| 107 c->data = xnew (struct x_color_instance_data); | |
| 108 if (result == 3) | |
| 109 COLOR_INSTANCE_X_DEALLOC (c) = 0; | |
| 110 else | |
| 111 COLOR_INSTANCE_X_DEALLOC (c) = 1; | |
| 112 COLOR_INSTANCE_X_COLOR (c) = color; | |
| 3094 | 113 |
|
4916
a6c778975d7d
split USE_XFT into HAVE_XFT/USE_XFT
Ben Wing <ben@xemacs.org>
parents:
4757
diff
changeset
|
114 #ifdef HAVE_XFT |
| 3094 | 115 xftColor.pixel = color.pixel; |
| 116 xftColor.color.red = color.red; | |
| 117 xftColor.color.green = color.green; | |
| 118 xftColor.color.blue = color.blue; | |
| 119 xftColor.color.alpha = 0xffff; | |
| 120 | |
| 121 COLOR_INSTANCE_X_XFTCOLOR (c) = xftColor; | |
| 122 #endif | |
| 123 | |
| 428 | 124 return 1; |
| 125 } | |
| 126 | |
| 127 static void | |
| 440 | 128 x_print_color_instance (Lisp_Color_Instance *c, |
| 428 | 129 Lisp_Object printcharfun, |
| 2286 | 130 int UNUSED (escapeflag)) |
| 428 | 131 { |
| 132 XColor color = COLOR_INSTANCE_X_COLOR (c); | |
| 800 | 133 write_fmt_string (printcharfun, " %ld=(%X,%X,%X)", |
| 134 color.pixel, color.red, color.green, color.blue); | |
| 428 | 135 } |
| 136 | |
| 137 static void | |
| 440 | 138 x_finalize_color_instance (Lisp_Color_Instance *c) |
| 428 | 139 { |
| 140 if (c->data) | |
| 141 { | |
| 142 if (DEVICE_LIVE_P (XDEVICE (c->device))) | |
| 143 { | |
| 144 if (COLOR_INSTANCE_X_DEALLOC (c)) | |
| 145 { | |
| 442 | 146 XFreeColors (DEVICE_X_DISPLAY (XDEVICE (c->device)), |
| 147 DEVICE_X_COLORMAP (XDEVICE (c->device)), | |
| 428 | 148 &COLOR_INSTANCE_X_COLOR (c).pixel, 1, 0); |
| 149 } | |
| 150 } | |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4969
diff
changeset
|
151 xfree (c->data); |
| 428 | 152 c->data = 0; |
| 153 } | |
| 154 } | |
| 155 | |
| 156 /* Color instances are equal if they resolve to the same color on the | |
| 157 screen (have the same RGB values). I imagine that | |
| 158 "same RGB values" == "same cell in the colormap." Arguably we should | |
| 159 be comparing their names or pixel values instead. */ | |
| 160 | |
| 161 static int | |
| 440 | 162 x_color_instance_equal (Lisp_Color_Instance *c1, |
| 163 Lisp_Color_Instance *c2, | |
| 2286 | 164 int UNUSED (depth)) |
| 428 | 165 { |
| 166 XColor color1 = COLOR_INSTANCE_X_COLOR (c1); | |
| 167 XColor color2 = COLOR_INSTANCE_X_COLOR (c2); | |
| 168 return ((color1.red == color2.red) && | |
| 169 (color1.green == color2.green) && | |
| 170 (color1.blue == color2.blue)); | |
| 171 } | |
| 172 | |
| 2515 | 173 static Hashcode |
| 2286 | 174 x_color_instance_hash (Lisp_Color_Instance *c, int UNUSED (depth)) |
| 428 | 175 { |
| 176 XColor color = COLOR_INSTANCE_X_COLOR (c); | |
| 177 return HASH3 (color.red, color.green, color.blue); | |
| 178 } | |
| 179 | |
| 180 static Lisp_Object | |
| 440 | 181 x_color_instance_rgb_components (Lisp_Color_Instance *c) |
| 428 | 182 { |
| 183 XColor color = COLOR_INSTANCE_X_COLOR (c); | |
| 184 return (list3 (make_int (color.red), | |
| 185 make_int (color.green), | |
| 186 make_int (color.blue))); | |
| 187 } | |
| 188 | |
| 189 static int | |
| 190 x_valid_color_name_p (struct device *d, Lisp_Object color) | |
| 191 { | |
| 192 XColor c; | |
| 193 Display *dpy = DEVICE_X_DISPLAY (d); | |
| 194 Colormap cmap = DEVICE_X_COLORMAP (d); | |
| 442 | 195 const Extbyte *extname; |
| 428 | 196 |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4969
diff
changeset
|
197 extname = LISP_STRING_TO_EXTERNAL (color, Qx_color_name_encoding); |
| 428 | 198 |
| 440 | 199 return XParseColor (dpy, cmap, extname, &c); |
| 428 | 200 } |
| 201 | |
| 2527 | 202 static Lisp_Object |
| 203 x_color_list (void) | |
| 204 { | |
| 205 return call0 (intern ("x-color-list-internal")); | |
| 206 } | |
| 207 | |
| 428 | 208 |
| 209 /************************************************************************/ | |
| 210 /* font instances */ | |
| 211 /************************************************************************/ | |
| 212 | |
| 3094 | 213 |
| 428 | 214 static int |
| 2286 | 215 x_initialize_font_instance (Lisp_Font_Instance *f, Lisp_Object UNUSED (name), |
| 578 | 216 Lisp_Object device, Error_Behavior errb) |
| 428 | 217 { |
| 440 | 218 Display *dpy = DEVICE_X_DISPLAY (XDEVICE (device)); |
| 3094 | 219 Extbyte *extname; |
| 220 XFontStruct *fs = NULL; /* _F_ont _S_truct */ | |
|
4916
a6c778975d7d
split USE_XFT into HAVE_XFT/USE_XFT
Ben Wing <ben@xemacs.org>
parents:
4757
diff
changeset
|
221 #ifdef HAVE_XFT |
| 3094 | 222 XftFont *rf = NULL; /* _R_ender _F_ont (X Render extension) */ |
| 223 #else | |
| 224 #define rf (0) | |
| 225 #endif | |
| 428 | 226 |
|
4916
a6c778975d7d
split USE_XFT into HAVE_XFT/USE_XFT
Ben Wing <ben@xemacs.org>
parents:
4757
diff
changeset
|
227 #ifdef HAVE_XFT |
| 3094 | 228 DEBUG_XFT1 (2, "attempting to initialize font spec %s\n", |
| 229 XSTRING_DATA(f->name)); | |
| 230 /* #### serialize (optimize) these later... */ | |
| 231 /* #### This function really needs to go away. | |
| 232 The problem is that the fontconfig/Xft functions work much too hard | |
| 233 to ensure that something is returned; but that something need not be | |
| 234 at all close to what we asked for. */ | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4969
diff
changeset
|
235 extname = LISP_STRING_TO_EXTERNAL (f->name, Qfc_font_name_encoding); |
| 3094 | 236 rf = xft_open_font_by_name (dpy, extname); |
| 237 #endif | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4969
diff
changeset
|
238 extname = LISP_STRING_TO_EXTERNAL (f->name, Qx_font_name_encoding); |
| 3659 | 239 /* With XFree86 4.0's fonts, XListFonts returns an entry for |
| 240 -isas-fangsong ti-medium-r-normal--16-160-72-72-c-160-gb2312.1980-0 but | |
| 241 an XLoadQueryFont on the corresponding XLFD returns NULL. | |
| 242 | |
| 243 XListFonts is not trustworthy (of course, this is news to exactly | |
| 244 no-one used to reading XEmacs source.) */ | |
| 3094 | 245 fs = XLoadQueryFont (dpy, extname); |
| 246 | |
| 247 if (!fs && !rf) | |
| 428 | 248 { |
| 3094 | 249 /* #### should this refer to X and/or Xft? */ |
| 250 maybe_signal_error (Qgui_error, "Couldn't load font", f->name, | |
| 251 Qfont, errb); | |
| 428 | 252 return 0; |
| 253 } | |
| 254 | |
| 3389 | 255 if (rf && fs) |
| 256 { | |
| 257 XFreeFont (dpy, fs); | |
| 258 fs = NULL; /* we don' need no steenkin' X font */ | |
| 259 } | |
| 260 | |
| 3094 | 261 if (fs && !fs->max_bounds.width) |
| 262 { | |
| 263 /* yes, this has been known to happen. */ | |
| 264 XFreeFont (dpy, fs); | |
| 265 fs = NULL; | |
| 266 maybe_signal_error (Qgui_error, "X font is too small", f->name, Qfont, | |
| 267 errb); | |
| 3389 | 268 return 0; |
| 3094 | 269 } |
| 270 | |
| 271 /* Now that we're sure that we will succeed, we can allocate data without | |
| 272 fear that the finalize method may get fucked. */ | |
| 428 | 273 f->data = xnew (struct x_font_instance_data); |
| 274 | |
|
4916
a6c778975d7d
split USE_XFT into HAVE_XFT/USE_XFT
Ben Wing <ben@xemacs.org>
parents:
4757
diff
changeset
|
275 #ifdef HAVE_XFT |
| 3094 | 276 FONT_INSTANCE_X_XFTFONT (f) = rf; |
| 277 if (rf) | |
| 278 /* Have an Xft font, initialize font info from it. */ | |
| 279 { | |
| 280 DEBUG_XFT4 (2, "pre-initial ascent %d descent %d width %d height %d\n", | |
| 281 f->ascent, f->descent, f->width, f->height); | |
| 428 | 282 |
| 3094 | 283 /* #### This shit is just plain wrong unless we have a character cell |
| 284 font. It really hoses us on large repertoire Unicode fonts with | |
| 285 "double-width" characters. */ | |
| 286 f->ascent = rf->ascent; | |
| 287 f->descent = rf->descent; | |
| 428 | 288 { |
| 3094 | 289 /* This is an approximation that AFAIK only gets used to compute |
| 290 cell size for estimating window dimensions. The test_string8 | |
| 291 is an ASCII string whose characters should approximate the | |
| 292 distribution of widths expected in real text. */ | |
| 3469 | 293 static const FcChar8 test_string8[] = "Mmneei"; |
| 3094 | 294 static const int len = sizeof (test_string8) - 1; |
| 295 XGlyphInfo glyphinfo; | |
| 296 | |
| 297 XftTextExtents8 (dpy, rf, test_string8, len, &glyphinfo); | |
| 298 /* #### maybe should be glyphinfo.xOff - glyphinfo.x? */ | |
| 299 f->width = (2*glyphinfo.width + len)/(2*len); | |
| 428 | 300 } |
| 3094 | 301 f->height = rf->height; |
| 302 f->proportional_p = 1; /* we can't recognize monospaced fonts! */ | |
| 303 | |
| 3389 | 304 /* #### This message appears wa-a-ay too often! |
| 305 We probably need to cache truenames or something? | |
| 306 Even if Xft does it for us, we cons too many font instances. */ | |
| 307 DEBUG_XFT4 (0, | |
| 308 "initialized metrics ascent %d descent %d width %d height %d\n", | |
| 309 f->ascent, f->descent, f->width, f->height); | |
| 3094 | 310 } |
| 311 else | |
| 312 { | |
| 313 DEBUG_XFT1 (0, "couldn't initialize Xft font %s\n", | |
| 314 XSTRING_DATA(f->name)); | |
| 315 } | |
| 316 #endif | |
| 317 | |
| 318 FONT_INSTANCE_X_FONT (f) = fs; | |
| 319 if (fs) | |
| 320 /* Have to use a core font, initialize font info from it. */ | |
| 321 { | |
| 322 f->ascent = fs->ascent; | |
| 323 f->descent = fs->descent; | |
| 324 f->height = fs->ascent + fs->descent; | |
| 325 { | |
| 326 /* following change suggested by Ted Phelps <phelps@dstc.edu.au> */ | |
| 327 int def_char = 'n'; /*fs->default_char;*/ | |
| 328 int byte1, byte2; | |
| 428 | 329 |
| 3094 | 330 once_more: |
| 331 byte1 = def_char >> 8; | |
| 332 byte2 = def_char & 0xFF; | |
| 333 | |
| 334 if (fs->per_char) | |
| 335 { | |
| 336 /* Old versions of the R5 font server have garbage (>63k) as | |
| 337 def_char. 'n' might not be a valid character. */ | |
| 338 if (byte1 < (int) fs->min_byte1 || | |
| 339 byte1 > (int) fs->max_byte1 || | |
| 340 byte2 < (int) fs->min_char_or_byte2 || | |
| 341 byte2 > (int) fs->max_char_or_byte2) | |
| 342 f->width = 0; | |
| 343 else | |
| 344 f->width = fs->per_char[(byte1 - fs->min_byte1) * | |
| 345 (fs->max_char_or_byte2 - | |
| 346 fs->min_char_or_byte2 + 1) + | |
| 347 (byte2 - fs->min_char_or_byte2)].width; | |
| 348 } | |
| 428 | 349 else |
| 3094 | 350 f->width = fs->max_bounds.width; |
| 351 | |
| 352 /* Some fonts have a default char whose width is 0. This is no good. | |
| 353 If that's the case, first try 'n' as the default char, and if n has | |
| 354 0 width too (unlikely) then just use the max width. */ | |
| 355 if (f->width == 0) | |
| 428 | 356 { |
| 3094 | 357 if (def_char == (int) fs->default_char) |
| 358 f->width = fs->max_bounds.width; | |
| 359 else | |
| 360 { | |
| 361 def_char = fs->default_char; | |
| 362 goto once_more; | |
| 363 } | |
| 428 | 364 } |
| 365 } | |
| 3094 | 366 |
| 367 /* If all characters don't exist then there could potentially be | |
| 368 0-width characters lurking out there. Not setting this flag | |
| 369 trips an optimization that would make them appear to have width | |
| 370 to redisplay. This is bad. So we set it if not all characters | |
| 371 have the same width or if not all characters are defined. */ | |
| 372 /* #### This sucks. There is a measurable performance increase | |
| 373 when using proportional width fonts if this flag is not set. | |
| 374 Unfortunately so many of the fucking X fonts are not fully | |
| 375 defined that we could almost just get rid of this damn flag and | |
| 376 make it an assertion. */ | |
| 377 f->proportional_p = (fs->min_bounds.width != fs->max_bounds.width || | |
| 378 (x_handle_non_fully_specified_fonts && | |
| 379 !fs->all_chars_exist)); | |
| 380 } | |
| 381 | |
|
4916
a6c778975d7d
split USE_XFT into HAVE_XFT/USE_XFT
Ben Wing <ben@xemacs.org>
parents:
4757
diff
changeset
|
382 #ifdef HAVE_XFT |
| 3094 | 383 if (debug_xft > 0) |
| 384 { | |
| 385 int n = 3, d = 5; | |
| 386 /* check for weirdness */ | |
| 387 if (n * f->height < d * f->width) | |
| 388 stderr_out ("font %s: width:height is %d:%d, larger than %d:%d\n", | |
| 389 XSTRING_DATA(f->name), f->width, f->height, n, d); | |
| 390 if (f->height <= 0 || f->width <= 0) | |
| 391 stderr_out ("bogus dimensions of font %s: width = %d, height = %d\n", | |
| 392 XSTRING_DATA(f->name), f->width, f->height); | |
| 393 stderr_out ("initialized font %s\n", XSTRING_DATA(f->name)); | |
| 394 } | |
| 395 #else | |
| 396 #undef rf | |
| 397 #endif | |
| 428 | 398 |
| 399 return 1; | |
| 400 } | |
| 401 | |
| 402 static void | |
| 440 | 403 x_print_font_instance (Lisp_Font_Instance *f, |
| 428 | 404 Lisp_Object printcharfun, |
| 2286 | 405 int UNUSED (escapeflag)) |
| 428 | 406 { |
| 3659 | 407 /* We should print information here about initial vs. final stages; we |
| 408 can't rely on the device charset stage cache for that, | |
| 409 unfortunately. */ | |
| 3094 | 410 if (FONT_INSTANCE_X_FONT (f)) |
| 3659 | 411 write_fmt_string (printcharfun, " font id: 0x%lx,", |
| 412 (unsigned long) FONT_INSTANCE_X_FONT (f)->fid); | |
| 413 | |
|
4916
a6c778975d7d
split USE_XFT into HAVE_XFT/USE_XFT
Ben Wing <ben@xemacs.org>
parents:
4757
diff
changeset
|
414 #ifdef HAVE_XFT |
| 3094 | 415 /* #### What should we do here? For now, print the address. */ |
| 416 if (FONT_INSTANCE_X_XFTFONT (f)) | |
| 417 write_fmt_string (printcharfun, " xft font: 0x%lx", | |
| 418 (unsigned long) FONT_INSTANCE_X_XFTFONT (f)); | |
| 419 #endif | |
| 428 | 420 } |
| 421 | |
| 422 static void | |
| 440 | 423 x_finalize_font_instance (Lisp_Font_Instance *f) |
| 428 | 424 { |
| 425 | |
|
4916
a6c778975d7d
split USE_XFT into HAVE_XFT/USE_XFT
Ben Wing <ben@xemacs.org>
parents:
4757
diff
changeset
|
426 #ifdef HAVE_XFT |
| 3094 | 427 DEBUG_XFT1 (0, "finalizing %s\n", (STRINGP (f->name) |
| 428 ? (char *) XSTRING_DATA (f->name) | |
| 429 : "(unnamed font)")); | |
| 430 #endif | |
| 431 | |
| 428 | 432 if (f->data) |
| 433 { | |
| 434 if (DEVICE_LIVE_P (XDEVICE (f->device))) | |
| 435 { | |
| 436 Display *dpy = DEVICE_X_DISPLAY (XDEVICE (f->device)); | |
| 437 | |
| 3094 | 438 if (FONT_INSTANCE_X_FONT (f)) |
| 439 XFreeFont (dpy, FONT_INSTANCE_X_FONT (f)); | |
|
4916
a6c778975d7d
split USE_XFT into HAVE_XFT/USE_XFT
Ben Wing <ben@xemacs.org>
parents:
4757
diff
changeset
|
440 #ifdef HAVE_XFT |
| 3094 | 441 if (FONT_INSTANCE_X_XFTFONT (f)) |
| 442 XftFontClose (dpy, FONT_INSTANCE_X_XFTFONT (f)); | |
| 443 #endif | |
| 428 | 444 } |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4969
diff
changeset
|
445 xfree (f->data); |
| 428 | 446 f->data = 0; |
| 447 } | |
| 448 } | |
| 449 | |
| 450 /* Determining the truename of a font is hard. (Big surprise.) | |
| 451 | |
| 3094 | 452 This is not true for fontconfig. Each font has a (nearly) canonical |
| 453 representation up to permutation of the order of properties. It is | |
| 454 possible to construct a name which exactly identifies the properties of | |
| 455 the current font. However, it is theoretically possible that there exists | |
| 456 another font with a super set of those properties that would happen to get | |
| 457 selected. -- sjt | |
| 458 | |
| 428 | 459 By "truename" we mean an XLFD-form name which contains no wildcards, yet |
| 460 which resolves to *exactly* the same font as the one which we already have | |
| 461 the (probably wildcarded) name and `XFontStruct' of. | |
| 462 | |
| 463 One might think that the first font returned by XListFonts would be the one | |
| 464 that XOpenFont would pick. Apparently this is the case on some servers, | |
| 465 but not on others. It would seem not to be specified. | |
| 466 | |
| 467 The MIT R5 server sometimes appears to be picking the lexicographically | |
| 468 smallest font which matches the name (thus picking "adobe" fonts before | |
| 469 "bitstream" fonts even if the bitstream fonts are earlier in the path, and | |
| 470 also picking 100dpi adobe fonts over 75dpi adobe fonts even though the | |
| 471 75dpi are in the path earlier) but sometimes appears to be doing something | |
| 442 | 472 else entirely (for example, removing the bitstream fonts from the path will |
| 428 | 473 cause the 75dpi adobe fonts to be used instead of the 100dpi, even though |
| 474 their relative positions in the path (and their names!) have not changed). | |
| 475 | |
| 476 The documentation for XSetFontPath() seems to indicate that the order of | |
| 442 | 477 entries in the font path means something, but it's pretty noncommittal about |
| 428 | 478 it, and the spirit of the law is apparently not being obeyed... |
| 479 | |
| 480 All the fonts I've seen have a property named `FONT' which contains the | |
| 481 truename of the font. However, there are two problems with using this: the | |
| 482 first is that the X Protocol Document is quite explicit that all properties | |
| 483 are optional, so we can't depend on it being there. The second is that | |
| 484 it's conceivable that this alleged truename isn't actually accessible as a | |
| 485 font, due to some difference of opinion between the font designers and | |
| 486 whoever installed the font on the system. | |
| 487 | |
| 488 So, our first attempt is to look for a FONT property, and then verify that | |
| 489 the name there is a valid name by running XListFonts on it. There's still | |
| 490 the potential that this could be true but we could still be being lied to, | |
| 491 but that seems pretty remote. | |
| 492 | |
| 493 Late breaking news: I've gotten reports that SunOS 4.1.3U1 | |
| 494 with OpenWound 3.0 has a font whose truename is really | |
| 495 "-Adobe-Courier-Medium-R-Normal--12-120-75-75-M-70-ISO8859-1" | |
| 496 but whose FONT property contains "Courier". | |
| 497 | |
| 498 So we disbelieve the FONT property unless it begins with a dash and | |
| 499 is more than 30 characters long. X Windows: The defacto substandard. | |
| 500 X Windows: Complex nonsolutions to simple nonproblems. X Windows: | |
| 501 Live the nightmare. | |
| 502 | |
| 503 If the FONT property doesn't exist, then we try and construct an XLFD name | |
| 504 out of the other font properties (FOUNDRY, FAMILY_NAME, WEIGHT_NAME, etc). | |
| 505 This is necessary at least for some versions of OpenWound. But who knows | |
| 506 what the future will bring. | |
| 507 | |
| 508 If that doesn't work, then we use XListFonts and either take the first font | |
| 509 (which I think is the most sensible thing) or we find the lexicographically | |
| 510 least, depending on whether the preprocessor constant `XOPENFONT_SORTS' is | |
| 511 defined. This sucks because the two behaviors are a property of the server | |
| 512 being used, not the architecture on which emacs has been compiled. Also, | |
| 513 as I described above, sorting isn't ALWAYS what the server does. Really it | |
| 514 does something seemingly random. There is no reliable way to win if the | |
| 515 FONT property isn't present. | |
| 516 | |
| 517 Another possibility which I haven't bothered to implement would be to map | |
| 518 over all of the matching fonts and find the first one that has the same | |
| 519 character metrics as the font we already have loaded. Even if this didn't | |
| 520 return exactly the same font, it would at least return one whose characters | |
| 521 were the same sizes, which would probably be good enough. | |
| 522 | |
| 523 More late-breaking news: on RS/6000 AIX 3.2.4, the expression | |
| 524 XLoadQueryFont (dpy, "-*-Fixed-Medium-R-*-*-*-130-75-75-*-*-ISO8859-1") | |
| 525 actually returns the font | |
| 526 -Misc-Fixed-Medium-R-Normal--13-120-75-75-C-80-ISO8859-1 | |
| 527 which is crazy, because that font doesn't even match that pattern! It is | |
| 528 also not included in the output produced by `xlsfonts' with that pattern. | |
| 529 | |
| 530 So this is yet another example of XListFonts() and XOpenFont() using | |
| 531 completely different algorithms. This, however, is a goofier example of | |
| 532 this bug, because in this case, it's not just the search order that is | |
| 533 different -- the sets don't even intersect. | |
| 534 | |
| 535 If anyone has any better ideas how to do this, or any insights on what it is | |
| 536 that the various servers are actually doing, please let me know! -- jwz. */ | |
| 537 | |
| 538 static int | |
| 442 | 539 valid_x_font_name_p (Display *dpy, Extbyte *name) |
| 428 | 540 { |
| 541 /* Maybe this should be implemented by calling XLoadFont and trapping | |
| 542 the error. That would be a lot of work, and wasteful as hell, but | |
| 543 might be more correct. | |
| 544 */ | |
| 545 int nnames = 0; | |
| 444 | 546 Extbyte **names = 0; |
| 428 | 547 if (! name) |
| 548 return 0; | |
| 549 names = XListFonts (dpy, name, 1, &nnames); | |
| 550 if (names) | |
| 551 XFreeFontNames (names); | |
| 552 return (nnames != 0); | |
| 553 } | |
| 554 | |
| 442 | 555 static Extbyte * |
| 428 | 556 truename_via_FONT_prop (Display *dpy, XFontStruct *font) |
| 557 { | |
| 558 unsigned long value = 0; | |
| 442 | 559 Extbyte *result = 0; |
| 428 | 560 if (XGetFontProperty (font, XA_FONT, &value)) |
| 561 result = XGetAtomName (dpy, value); | |
| 562 /* result is now 0, or the string value of the FONT property. */ | |
| 563 if (result) | |
| 564 { | |
| 565 /* Verify that result is an XLFD name (roughly...) */ | |
| 647 | 566 if (result [0] != '-' || strlen (result) < 30) |
| 428 | 567 { |
| 568 XFree (result); | |
| 569 result = 0; | |
| 570 } | |
| 571 } | |
| 572 return result; /* this must be freed by caller if non-0 */ | |
| 573 } | |
| 574 | |
| 442 | 575 static Extbyte * |
| 428 | 576 truename_via_random_props (Display *dpy, XFontStruct *font) |
| 577 { | |
| 578 struct device *d = get_device_from_display (dpy); | |
| 579 unsigned long value = 0; | |
| 442 | 580 Extbyte *foundry, *family, *weight, *slant, *setwidth, *add_style; |
| 428 | 581 unsigned long pixel, point, res_x, res_y; |
| 442 | 582 Extbyte *spacing; |
| 428 | 583 unsigned long avg_width; |
| 442 | 584 Extbyte *registry, *encoding; |
| 585 Extbyte composed_name [2048]; | |
| 428 | 586 int ok = 0; |
| 442 | 587 Extbyte *result; |
| 428 | 588 |
| 589 #define get_string(atom,var) \ | |
| 590 if (XGetFontProperty (font, (atom), &value)) \ | |
| 591 var = XGetAtomName (dpy, value); \ | |
| 592 else { \ | |
| 593 var = 0; \ | |
| 594 goto FAIL; } | |
| 595 #define get_number(atom,var) \ | |
| 596 if (!XGetFontProperty (font, (atom), &var) || \ | |
| 597 var > 999) \ | |
| 598 goto FAIL; | |
| 599 | |
| 600 foundry = family = weight = slant = setwidth = 0; | |
| 601 add_style = spacing = registry = encoding = 0; | |
| 602 | |
| 603 get_string (DEVICE_XATOM_FOUNDRY (d), foundry); | |
| 604 get_string (DEVICE_XATOM_FAMILY_NAME (d), family); | |
| 605 get_string (DEVICE_XATOM_WEIGHT_NAME (d), weight); | |
| 606 get_string (DEVICE_XATOM_SLANT (d), slant); | |
| 607 get_string (DEVICE_XATOM_SETWIDTH_NAME (d), setwidth); | |
| 608 get_string (DEVICE_XATOM_ADD_STYLE_NAME (d), add_style); | |
| 609 get_number (DEVICE_XATOM_PIXEL_SIZE (d), pixel); | |
| 610 get_number (DEVICE_XATOM_POINT_SIZE (d), point); | |
| 611 get_number (DEVICE_XATOM_RESOLUTION_X (d), res_x); | |
| 612 get_number (DEVICE_XATOM_RESOLUTION_Y (d), res_y); | |
| 613 get_string (DEVICE_XATOM_SPACING (d), spacing); | |
| 614 get_number (DEVICE_XATOM_AVERAGE_WIDTH (d), avg_width); | |
| 615 get_string (DEVICE_XATOM_CHARSET_REGISTRY (d), registry); | |
| 616 get_string (DEVICE_XATOM_CHARSET_ENCODING (d), encoding); | |
| 617 #undef get_number | |
| 618 #undef get_string | |
| 619 | |
| 620 sprintf (composed_name, | |
| 621 "-%s-%s-%s-%s-%s-%s-%ld-%ld-%ld-%ld-%s-%ld-%s-%s", | |
| 622 foundry, family, weight, slant, setwidth, add_style, pixel, | |
| 623 point, res_x, res_y, spacing, avg_width, registry, encoding); | |
| 624 ok = 1; | |
| 625 | |
| 626 FAIL: | |
| 627 if (ok) | |
| 628 { | |
| 629 int L = strlen (composed_name) + 1; | |
| 2367 | 630 result = xnew_extbytes (L); |
| 428 | 631 strncpy (result, composed_name, L); |
| 632 } | |
| 633 else | |
| 634 result = 0; | |
| 635 | |
| 636 if (foundry) XFree (foundry); | |
| 637 if (family) XFree (family); | |
| 638 if (weight) XFree (weight); | |
| 639 if (slant) XFree (slant); | |
| 640 if (setwidth) XFree (setwidth); | |
| 641 if (add_style) XFree (add_style); | |
| 642 if (spacing) XFree (spacing); | |
| 643 if (registry) XFree (registry); | |
| 644 if (encoding) XFree (encoding); | |
| 645 | |
| 646 return result; | |
| 647 } | |
| 648 | |
| 3169 | 649 /* XListFonts doesn't allocate memory unconditionally based on this. (For |
| 650 XFree86 in 2005, at least. */ | |
| 651 #define MAX_FONT_COUNT INT_MAX | |
| 428 | 652 |
| 442 | 653 static Extbyte * |
| 654 truename_via_XListFonts (Display *dpy, Extbyte *font_name) | |
| 428 | 655 { |
| 442 | 656 Extbyte *result = 0; |
| 444 | 657 Extbyte **names; |
| 428 | 658 int count = 0; |
| 659 | |
| 660 #ifndef XOPENFONT_SORTS | |
| 661 /* In a sensible world, the first font returned by XListFonts() | |
| 662 would be the font that XOpenFont() would use. */ | |
| 663 names = XListFonts (dpy, font_name, 1, &count); | |
| 664 if (count) result = names [0]; | |
| 665 #else | |
| 666 /* But the world I live in is much more perverse. */ | |
| 667 names = XListFonts (dpy, font_name, MAX_FONT_COUNT, &count); | |
| 3094 | 668 /* Find the lexicographic minimum of names[]. |
| 669 (#### Should we be comparing case-insensitively?) */ | |
| 428 | 670 while (count--) |
| 3094 | 671 /* [[ !!#### Not Mule-friendly ]] |
| 672 Doesn't matter, XLFDs are HPC (old) or Latin1 (modern). If they | |
| 673 aren't, who knows what they are? -- sjt */ | |
| 428 | 674 if (result == 0 || (strcmp (result, names [count]) < 0)) |
| 675 result = names [count]; | |
| 676 #endif | |
| 677 | |
| 678 if (result) | |
| 679 result = xstrdup (result); | |
| 680 if (names) | |
| 681 XFreeFontNames (names); | |
| 682 | |
| 683 return result; /* this must be freed by caller if non-0 */ | |
| 684 } | |
| 685 | |
| 686 static Lisp_Object | |
| 442 | 687 x_font_truename (Display *dpy, Extbyte *name, XFontStruct *font) |
| 428 | 688 { |
| 442 | 689 Extbyte *truename_FONT = 0; |
| 690 Extbyte *truename_random = 0; | |
| 691 Extbyte *truename = 0; | |
| 428 | 692 |
| 693 /* The search order is: | |
| 694 - if FONT property exists, and is a valid name, return it. | |
| 695 - if the other props exist, and add up to a valid name, return it. | |
| 696 - if we find a matching name with XListFonts, return it. | |
| 697 - if FONT property exists, return it regardless. | |
| 698 - if other props exist, return the resultant name regardless. | |
| 699 - else return 0. | |
| 700 */ | |
| 701 | |
| 702 truename = truename_FONT = truename_via_FONT_prop (dpy, font); | |
| 703 if (truename && !valid_x_font_name_p (dpy, truename)) | |
| 704 truename = 0; | |
| 705 if (!truename) | |
| 706 truename = truename_random = truename_via_random_props (dpy, font); | |
| 707 if (truename && !valid_x_font_name_p (dpy, truename)) | |
| 708 truename = 0; | |
| 709 if (!truename && name) | |
| 710 truename = truename_via_XListFonts (dpy, name); | |
| 711 | |
| 712 if (!truename) | |
| 713 { | |
| 714 /* Gag - we weren't able to find a seemingly-valid truename. | |
| 715 Well, maybe we're on one of those braindead systems where | |
| 716 XListFonts() and XLoadFont() are in violent disagreement. | |
| 717 If we were able to compute a truename, try using that even | |
| 718 if evidence suggests that it's not a valid name - because | |
| 719 maybe it is, really, and that's better than nothing. | |
| 720 X Windows: You'll envy the dead. | |
| 721 */ | |
| 722 if (truename_FONT) | |
| 723 truename = truename_FONT; | |
| 724 else if (truename_random) | |
| 725 truename = truename_random; | |
| 726 } | |
| 727 | |
| 728 /* One or both of these are not being used - free them. */ | |
| 729 if (truename_FONT && truename_FONT != truename) | |
| 730 XFree (truename_FONT); | |
| 731 if (truename_random && truename_random != truename) | |
| 732 XFree (truename_random); | |
| 733 | |
| 734 if (truename) | |
| 735 { | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4757
diff
changeset
|
736 Lisp_Object result = build_extstring (truename, Qx_font_name_encoding); |
| 428 | 737 XFree (truename); |
| 738 return result; | |
| 739 } | |
| 740 else | |
| 741 return Qnil; | |
| 742 } | |
| 743 | |
| 744 static Lisp_Object | |
| 578 | 745 x_font_instance_truename (Lisp_Font_Instance *f, Error_Behavior errb) |
| 428 | 746 { |
| 747 struct device *d = XDEVICE (f->device); | |
| 3094 | 748 Display *dpy = DEVICE_X_DISPLAY (d); |
| 749 Extbyte *nameext; | |
| 750 | |
| 751 /* #### restructure this so that we return a valid truename at the end, | |
| 752 and otherwise only return when we return something desperate that | |
| 753 doesn't get stored for future use. */ | |
| 754 | |
|
4916
a6c778975d7d
split USE_XFT into HAVE_XFT/USE_XFT
Ben Wing <ben@xemacs.org>
parents:
4757
diff
changeset
|
755 #ifdef HAVE_XFT |
| 3094 | 756 /* First, try an Xft font. */ |
| 757 if (NILP (FONT_INSTANCE_TRUENAME (f)) && FONT_INSTANCE_X_XFTFONT (f)) | |
| 758 { | |
| 759 /* The font is already open, we just unparse. */ | |
| 760 FcChar8 *res = FcNameUnparse (FONT_INSTANCE_X_XFTFONT (f)->pattern); | |
|
4757
a23ac8f90a49
Improve warning and error messages from Xft.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
3659
diff
changeset
|
761 if (! FONT_INSTANCE_X_XFTFONT (f)->pattern) |
|
a23ac8f90a49
Improve warning and error messages from Xft.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
3659
diff
changeset
|
762 { |
|
a23ac8f90a49
Improve warning and error messages from Xft.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
3659
diff
changeset
|
763 maybe_signal_error (Qgui_error, |
|
a23ac8f90a49
Improve warning and error messages from Xft.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
3659
diff
changeset
|
764 "Xft font present but lacks pattern", |
|
a23ac8f90a49
Improve warning and error messages from Xft.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
3659
diff
changeset
|
765 wrap_font_instance(f), Qfont, errb); |
|
a23ac8f90a49
Improve warning and error messages from Xft.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
3659
diff
changeset
|
766 } |
| 3094 | 767 if (res) |
| 768 { | |
| 3174 | 769 FONT_INSTANCE_TRUENAME (f) = |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4757
diff
changeset
|
770 build_extstring ((Extbyte *) res, Qfc_font_name_encoding); |
| 3094 | 771 free (res); |
| 772 return FONT_INSTANCE_TRUENAME (f); | |
| 773 } | |
| 774 else | |
| 775 { | |
| 776 maybe_signal_error (Qgui_error, | |
| 777 "Couldn't unparse Xft font to truename", | |
|
4757
a23ac8f90a49
Improve warning and error messages from Xft.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
3659
diff
changeset
|
778 wrap_font_instance(f), Qfont, errb); |
| 3094 | 779 /* used to return Qnil here */ |
| 780 } | |
| 781 } | |
|
4916
a6c778975d7d
split USE_XFT into HAVE_XFT/USE_XFT
Ben Wing <ben@xemacs.org>
parents:
4757
diff
changeset
|
782 #endif /* HAVE_XFT */ |
| 3094 | 783 |
| 784 /* OK, fall back to core font. */ | |
| 785 if (NILP (FONT_INSTANCE_TRUENAME (f)) | |
| 786 && FONT_INSTANCE_X_FONT (f)) | |
| 787 { | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4969
diff
changeset
|
788 nameext = LISP_STRING_TO_EXTERNAL (f->name, Qx_font_name_encoding); |
| 3094 | 789 FONT_INSTANCE_TRUENAME (f) = |
| 790 x_font_truename (dpy, nameext, FONT_INSTANCE_X_FONT (f)); | |
| 791 } | |
| 428 | 792 |
| 872 | 793 if (NILP (FONT_INSTANCE_TRUENAME (f))) |
| 428 | 794 { |
| 3094 | 795 /* Urk, no luck. Whine about our bad luck and exit. */ |
| 796 Lisp_Object font_instance = wrap_font_instance (f); | |
| 797 | |
| 798 | |
| 799 maybe_signal_error (Qgui_error, "Couldn't determine font truename", | |
| 800 font_instance, Qfont, errb); | |
| 801 /* Ok, just this once, return the font name as the truename. | |
| 802 (This is only used by Fequal() right now.) */ | |
| 803 return f->name; | |
| 804 } | |
| 442 | 805 |
| 3094 | 806 /* Return what we found. */ |
| 872 | 807 return FONT_INSTANCE_TRUENAME (f); |
| 428 | 808 } |
| 809 | |
| 810 static Lisp_Object | |
| 440 | 811 x_font_instance_properties (Lisp_Font_Instance *f) |
| 428 | 812 { |
| 813 struct device *d = XDEVICE (f->device); | |
| 814 int i; | |
| 815 Lisp_Object result = Qnil; | |
| 444 | 816 Display *dpy = DEVICE_X_DISPLAY (d); |
| 3094 | 817 XFontProp *props = NULL; |
| 428 | 818 |
| 3094 | 819 /* #### really should hack Xft fonts, too |
| 820 Strategy: fontconfig must have an iterator for this purpose. */ | |
| 821 if (! FONT_INSTANCE_X_FONT (f)) return result; | |
| 822 | |
| 823 props = FONT_INSTANCE_X_FONT (f)->properties; | |
| 428 | 824 for (i = FONT_INSTANCE_X_FONT (f)->n_properties - 1; i >= 0; i--) |
| 825 { | |
| 826 Lisp_Object name, value; | |
| 827 Atom atom = props [i].name; | |
| 867 | 828 Ibyte *name_str = 0; |
| 647 | 829 Bytecount name_len; |
| 442 | 830 Extbyte *namestrext = XGetAtomName (dpy, atom); |
| 831 | |
| 832 if (namestrext) | |
| 444 | 833 TO_INTERNAL_FORMAT (C_STRING, namestrext, |
| 834 ALLOCA, (name_str, name_len), | |
| 835 Qx_atom_name_encoding); | |
| 442 | 836 |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4757
diff
changeset
|
837 name = (name_str ? intern_istring (name_str) : Qnil); |
| 428 | 838 if (name_str && |
| 839 (atom == XA_FONT || | |
| 840 atom == DEVICE_XATOM_FOUNDRY (d) || | |
| 841 atom == DEVICE_XATOM_FAMILY_NAME (d) || | |
| 842 atom == DEVICE_XATOM_WEIGHT_NAME (d) || | |
| 843 atom == DEVICE_XATOM_SLANT (d) || | |
| 844 atom == DEVICE_XATOM_SETWIDTH_NAME (d) || | |
| 845 atom == DEVICE_XATOM_ADD_STYLE_NAME (d) || | |
| 846 atom == DEVICE_XATOM_SPACING (d) || | |
| 847 atom == DEVICE_XATOM_CHARSET_REGISTRY (d) || | |
| 848 atom == DEVICE_XATOM_CHARSET_ENCODING (d) || | |
| 2367 | 849 !qxestrcmp_ascii (name_str, "CHARSET_COLLECTIONS") || |
| 850 !qxestrcmp_ascii (name_str, "FONTNAME_REGISTRY") || | |
| 851 !qxestrcmp_ascii (name_str, "CLASSIFICATION") || | |
| 852 !qxestrcmp_ascii (name_str, "COPYRIGHT") || | |
| 853 !qxestrcmp_ascii (name_str, "DEVICE_FONT_NAME") || | |
| 854 !qxestrcmp_ascii (name_str, "FULL_NAME") || | |
| 855 !qxestrcmp_ascii (name_str, "MONOSPACED") || | |
| 856 !qxestrcmp_ascii (name_str, "QUALITY") || | |
| 857 !qxestrcmp_ascii (name_str, "RELATIVE_SET") || | |
| 858 !qxestrcmp_ascii (name_str, "RELATIVE_WEIGHT") || | |
| 859 !qxestrcmp_ascii (name_str, "STYLE"))) | |
| 428 | 860 { |
| 442 | 861 Extbyte *val_str = XGetAtomName (dpy, props [i].card32); |
| 862 | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4757
diff
changeset
|
863 value = (val_str ? build_extstring (val_str, Qx_atom_name_encoding) |
| 442 | 864 : Qnil); |
| 428 | 865 } |
| 866 else | |
| 867 value = make_int (props [i].card32); | |
| 442 | 868 if (namestrext) XFree (namestrext); |
| 428 | 869 result = Fcons (Fcons (name, value), result); |
| 870 } | |
| 871 return result; | |
| 872 } | |
| 873 | |
| 874 static Lisp_Object | |
| 2527 | 875 x_font_list (Lisp_Object pattern, Lisp_Object device, Lisp_Object maxnumber) |
| 428 | 876 { |
| 444 | 877 Extbyte **names; |
| 428 | 878 int count = 0; |
| 1701 | 879 int max_number = MAX_FONT_COUNT; |
| 428 | 880 Lisp_Object result = Qnil; |
| 442 | 881 const Extbyte *patternext; |
| 428 | 882 |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4969
diff
changeset
|
883 patternext = LISP_STRING_TO_EXTERNAL (pattern, Qx_font_name_encoding); |
| 428 | 884 |
| 1701 | 885 if (!NILP(maxnumber) && INTP(maxnumber)) |
| 886 { | |
| 887 max_number = XINT(maxnumber); | |
| 888 } | |
| 889 | |
| 428 | 890 names = XListFonts (DEVICE_X_DISPLAY (XDEVICE (device)), |
| 1701 | 891 patternext, max_number, &count); |
| 428 | 892 while (count--) |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4757
diff
changeset
|
893 result = Fcons (build_extstring (names[count], Qx_font_name_encoding), |
| 442 | 894 result); |
| 428 | 895 if (names) |
| 896 XFreeFontNames (names); | |
| 897 return result; | |
| 898 } | |
| 899 | |
| 3659 | 900 /* Include the charset support, shared, for the moment, with GTK. */ |
| 901 #define THIS_IS_X | |
| 902 #include "objects-xlike-inc.c" | |
| 428 | 903 |
| 904 | |
| 905 /************************************************************************/ | |
| 906 /* initialization */ | |
| 907 /************************************************************************/ | |
| 908 | |
| 909 void | |
| 910 syms_of_objects_x (void) | |
| 911 { | |
| 912 } | |
| 913 | |
| 914 void | |
| 915 console_type_create_objects_x (void) | |
| 916 { | |
| 917 /* object methods */ | |
| 918 | |
| 919 CONSOLE_HAS_METHOD (x, initialize_color_instance); | |
| 920 CONSOLE_HAS_METHOD (x, print_color_instance); | |
| 921 CONSOLE_HAS_METHOD (x, finalize_color_instance); | |
| 922 CONSOLE_HAS_METHOD (x, color_instance_equal); | |
| 923 CONSOLE_HAS_METHOD (x, color_instance_hash); | |
| 924 CONSOLE_HAS_METHOD (x, color_instance_rgb_components); | |
| 925 CONSOLE_HAS_METHOD (x, valid_color_name_p); | |
| 2527 | 926 CONSOLE_HAS_METHOD (x, color_list); |
| 428 | 927 |
| 928 CONSOLE_HAS_METHOD (x, initialize_font_instance); | |
| 929 CONSOLE_HAS_METHOD (x, print_font_instance); | |
| 930 CONSOLE_HAS_METHOD (x, finalize_font_instance); | |
| 931 CONSOLE_HAS_METHOD (x, font_instance_truename); | |
| 932 CONSOLE_HAS_METHOD (x, font_instance_properties); | |
| 2527 | 933 CONSOLE_HAS_METHOD (x, font_list); |
| 428 | 934 #ifdef MULE |
| 935 CONSOLE_HAS_METHOD (x, find_charset_font); | |
| 936 CONSOLE_HAS_METHOD (x, font_spec_matches_charset); | |
| 937 #endif | |
| 938 } | |
| 939 | |
| 940 void | |
| 941 vars_of_objects_x (void) | |
| 942 { | |
| 3659 | 943 #ifdef DEBUG_XEMACS |
| 944 DEFVAR_INT ("debug-x-objects", &debug_x_objects /* | |
| 945 If non-zero, display debug information about X objects | |
| 946 */ ); | |
| 947 debug_x_objects = 0; | |
| 948 #endif | |
| 949 | |
| 428 | 950 DEFVAR_BOOL ("x-handle-non-fully-specified-fonts", |
| 951 &x_handle_non_fully_specified_fonts /* | |
| 952 If this is true then fonts which do not have all characters specified | |
| 953 will be considered to be proportional width even if they are actually | |
| 954 fixed-width. If this is not done then characters which are supposed to | |
| 955 have 0 width may appear to actually have some width. | |
| 956 | |
| 957 Note: While setting this to t guarantees correct output in all | |
| 958 circumstances, it also causes a noticeable performance hit when using | |
| 959 fixed-width fonts. Since most people don't use characters which could | |
| 960 cause problems this is set to nil by default. | |
| 961 */ ); | |
| 962 x_handle_non_fully_specified_fonts = 0; | |
| 3094 | 963 |
|
4916
a6c778975d7d
split USE_XFT into HAVE_XFT/USE_XFT
Ben Wing <ben@xemacs.org>
parents:
4757
diff
changeset
|
964 #ifdef HAVE_XFT |
| 3094 | 965 Fprovide (intern ("xft-fonts")); |
| 966 #endif | |
| 428 | 967 } |
| 968 | |
| 969 void | |
| 970 Xatoms_of_objects_x (struct device *d) | |
| 971 { | |
| 972 Display *D = DEVICE_X_DISPLAY (d); | |
| 973 | |
| 974 DEVICE_XATOM_FOUNDRY (d) = XInternAtom (D, "FOUNDRY", False); | |
| 975 DEVICE_XATOM_FAMILY_NAME (d) = XInternAtom (D, "FAMILY_NAME", False); | |
| 976 DEVICE_XATOM_WEIGHT_NAME (d) = XInternAtom (D, "WEIGHT_NAME", False); | |
| 977 DEVICE_XATOM_SLANT (d) = XInternAtom (D, "SLANT", False); | |
| 978 DEVICE_XATOM_SETWIDTH_NAME (d) = XInternAtom (D, "SETWIDTH_NAME", False); | |
| 979 DEVICE_XATOM_ADD_STYLE_NAME (d) = XInternAtom (D, "ADD_STYLE_NAME", False); | |
| 980 DEVICE_XATOM_PIXEL_SIZE (d) = XInternAtom (D, "PIXEL_SIZE", False); | |
| 981 DEVICE_XATOM_POINT_SIZE (d) = XInternAtom (D, "POINT_SIZE", False); | |
| 982 DEVICE_XATOM_RESOLUTION_X (d) = XInternAtom (D, "RESOLUTION_X", False); | |
| 983 DEVICE_XATOM_RESOLUTION_Y (d) = XInternAtom (D, "RESOLUTION_Y", False); | |
| 984 DEVICE_XATOM_SPACING (d) = XInternAtom (D, "SPACING", False); | |
| 985 DEVICE_XATOM_AVERAGE_WIDTH (d) = XInternAtom (D, "AVERAGE_WIDTH", False); | |
| 986 DEVICE_XATOM_CHARSET_REGISTRY(d) = XInternAtom (D, "CHARSET_REGISTRY",False); | |
| 987 DEVICE_XATOM_CHARSET_ENCODING(d) = XInternAtom (D, "CHARSET_ENCODING",False); | |
| 988 } |