cgit.sxemacs.org Git - sxemacs/blob - src/ui/X11/objects-x.c

   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, 2000 Ben Wing.
   6    Copyright (C) 1995 Sun Microsystems, Inc.
   7
   8 This file is part of SXEmacs
   9
  10 SXEmacs is free software: you can redistribute it and/or modify
  11 it under the terms of the GNU General Public License as published by
  12 the Free Software Foundation, either version 3 of the License, or
  13 (at your option) any later version.
  14
  15 SXEmacs is distributed in the hope that it will be useful,
  16 but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 GNU General Public License for more details.
  19
  20 You should have received a copy of the GNU General Public License
  21 along with this program.  If not, see <http://www.gnu.org/licenses/>. */
  22
  23
  24 /* Synched up with: Not in FSF. */
  25
  26 /* Authors: Jamie Zawinski, Chuck Thompson, Ben Wing */
  27
  28 /* This file Mule-ized by Ben Wing, 7-10-00. */
  29
  30 #include <config.h>
  31 #include "lisp.h"
  32
  33 #include "console-x.h"
  34 #include "objects-x.h"
  35
  36 #include "buffer.h"
  37 #include "ui/device.h"
  38 #include "ui/insdel.h"
  39
  40 int x_handle_non_fully_specified_fonts;
  41 \f
  42 /************************************************************************/
  43 /*                          color instances                             */
  44 /************************************************************************/
  45
  46 /* Replacement for XAllocColor() that tries to return the nearest
  47    available color if the colormap is full.  Original was from FSFmacs,
  48    but rewritten by Jareth Hein <jareth@camelot-soft.com> 97/11/25
  49    Modified by Lee Kindness <lkindness@csl.co.uk> 31/08/99 to handle previous
  50    total failure which was due to a read/write colorcell being the nearest
  51    match - tries the next nearest...
  52
  53    Return value is 1 for normal success, 2 for nearest color success,
  54    3 for Non-deallocable success. */
  55 int
  56 allocate_nearest_color(Display * display, Colormap colormap, Visual * visual,
  57                        XColor * color_def)
  58 {
  59         int status;
  60
  61         if (visual->class == DirectColor || visual->class == TrueColor) {
  62                 if (XAllocColor(display, colormap, color_def) != 0) {
  63                         status = 1;
  64                 } else {
  65                         /* We're dealing with a TrueColor/DirectColor visual, so play games
  66                            with the RGB values in the XColor struct. */
  67                         /* #### JH: I'm not sure how a call to XAllocColor can fail in a
  68                            TrueColor or DirectColor visual, so I will just reformat the
  69                            request to match the requirements of the visual, and re-issue
  70                            the request.  If this fails for anybody, I wanna know about it
  71                            so I can come up with a better plan */
  72
  73                         unsigned long rshift, gshift, bshift, rbits, gbits,
  74                             bbits, junk;
  75                         junk = visual->red_mask;
  76                         rshift = 0;
  77                         while ((junk & 0x1) == 0) {
  78                                 junk = junk >> 1;
  79                                 rshift++;
  80                         }
  81                         rbits = 0;
  82                         while (junk != 0) {
  83                                 junk = junk >> 1;
  84                                 rbits++;
  85                         }
  86                         junk = visual->green_mask;
  87                         gshift = 0;
  88                         while ((junk & 0x1) == 0) {
  89                                 junk = junk >> 1;
  90                                 gshift++;
  91                         }
  92                         gbits = 0;
  93                         while (junk != 0) {
  94                                 junk = junk >> 1;
  95                                 gbits++;
  96                         }
  97                         junk = visual->blue_mask;
  98                         bshift = 0;
  99                         while ((junk & 0x1) == 0) {
 100                                 junk = junk >> 1;
 101                                 bshift++;
 102                         }
 103                         bbits = 0;
 104                         while (junk != 0) {
 105                                 junk = junk >> 1;
 106                                 bbits++;
 107                         }
 108
 109                         color_def->red = color_def->red >> (16 - rbits);
 110                         color_def->green = color_def->green >> (16 - gbits);
 111                         color_def->blue = color_def->blue >> (16 - bbits);
 112                         if (XAllocColor(display, colormap, color_def) != 0)
 113                                 status = 1;
 114                         else {
 115                                 int rd, gr, bl;
 116                                 /* #### JH: I'm punting here, knowing that doing this will at
 117                                    least draw the color correctly.  However, unless we convert
 118                                    all of the functions that allocate colors (graphics
 119                                    libraries, etc) to use this function doing this is very
 120                                    likely to cause problems later... */
 121
 122                                 if (rbits > 8)
 123                                         rd = color_def->red << (rbits - 8);
 124                                 else
 125                                         rd = color_def->red >> (8 - rbits);
 126                                 if (gbits > 8)
 127                                         gr = color_def->green << (gbits - 8);
 128                                 else
 129                                         gr = color_def->green >> (8 - gbits);
 130                                 if (bbits > 8)
 131                                         bl = color_def->blue << (bbits - 8);
 132                                 else
 133                                         bl = color_def->blue >> (8 - bbits);
 134                                 color_def->pixel =
 135                                     (rd << rshift) | (gr << gshift) | (bl <<
 136                                                                        bshift);
 137                                 status = 3;
 138                         }
 139                 }
 140         } else {
 141                 XColor *cells = NULL;
 142                 /* JH: I can't believe there's no way to go backwards from a
 143                    colormap ID and get its visual and number of entries, but X
 144                    apparently isn't built that way... */
 145                 int no_cells = visual->map_entries;
 146                 status = 0;
 147
 148                 if (XAllocColor(display, colormap, color_def) != 0)
 149                         status = 1;
 150                 else
 151                         while (status != 2) {
 152                                 /* If we got to this point, the colormap is full, so we're
 153                                    going to try and get the next closest color.  The algorithm used
 154                                    is a least-squares matching, which is what X uses for closest
 155                                    color matching with StaticColor visuals. */
 156                                 int nearest;
 157                                 long nearest_delta, trial_delta;
 158                                 int x;
 159
 160                                 if (cells == NULL) {
 161                                         cells = alloca_array(XColor, no_cells);
 162                                         for (x = 0; x < no_cells; x++)
 163                                                 cells[x].pixel = x;
 164
 165                                         /* read the current colormap */
 166                                         XQueryColors(display, colormap, cells,
 167                                                      no_cells);
 168                                 }
 169
 170                                 nearest = 0;
 171                                 /* I'm assuming CSE so I'm not going to condense this. */
 172                                 nearest_delta =
 173                                     ((((color_def->red >> 8) -
 174                                        (cells[0].red >> 8))
 175                                       * ((color_def->red >> 8) -
 176                                          (cells[0].red >> 8)))
 177                                      +
 178                                      (((color_def->green >> 8) -
 179                                        (cells[0].green >> 8))
 180                                       * ((color_def->green >> 8) -
 181                                          (cells[0].green >> 8)))
 182                                      +
 183                                      (((color_def->blue >> 8) -
 184                                        (cells[0].blue >> 8))
 185                                       * ((color_def->blue >> 8) -
 186                                          (cells[0].blue >> 8))));
 187                                 for (x = 1; x < no_cells; x++) {
 188                                         trial_delta =
 189                                             ((((color_def->red >> 8) -
 190                                                (cells[x].red >> 8))
 191                                               * ((color_def->red >> 8) -
 192                                                  (cells[x].red >> 8)))
 193                                              +
 194                                              (((color_def->green >> 8) -
 195                                                (cells[x].green >> 8))
 196                                               * ((color_def->green >> 8) -
 197                                                  (cells[x].green >> 8)))
 198                                              +
 199                                              (((color_def->blue >> 8) -
 200                                                (cells[x].blue >> 8))
 201                                               * ((color_def->blue >> 8) -
 202                                                  (cells[x].blue >> 8))));
 203
 204                                         /* less? Ignore cells marked as previously failing */
 205                                         if ((trial_delta < nearest_delta) &&
 206                                             (cells[x].pixel != ULONG_MAX)) {
 207                                                 nearest = x;
 208                                                 nearest_delta = trial_delta;
 209                                         }
 210                                 }
 211                                 color_def->red = cells[nearest].red;
 212                                 color_def->green = cells[nearest].green;
 213                                 color_def->blue = cells[nearest].blue;
 214                                 if (XAllocColor(display, colormap, color_def) !=
 215                                     0)
 216                                         status = 2;
 217                                 else
 218                                         /* LSK: Either the colour map has changed since
 219                                          * we read it, or the colour is allocated
 220                                          * read/write... Mark this cmap entry so it's
 221                                          * ignored in the next iteration.
 222                                          */
 223                                         cells[nearest].pixel = ULONG_MAX;
 224                         }
 225         }
 226         return status;
 227 }
 228
 229 static int
 230 x_parse_nearest_color(struct device *d, XColor * color, Lisp_Object name,
 231                       Error_behavior errb)
 232 {
 233         Display *dpy = DEVICE_X_DISPLAY(d);
 234         Colormap cmap = DEVICE_X_COLORMAP(d);
 235         Visual *visual = DEVICE_X_VISUAL(d);
 236         int result;
 237
 238         xzero(*color);
 239         {
 240                 const Extbyte *extname;
 241
 242                 LISP_STRING_TO_EXTERNAL(name, extname, Qx_color_name_encoding);
 243                 result = XParseColor(dpy, cmap, extname, color);
 244         }
 245         if (!result) {
 246                 maybe_signal_simple_error("Unrecognized color", name, Qcolor,
 247                                           errb);
 248                 return 0;
 249         }
 250         result = allocate_nearest_color(dpy, cmap, visual, color);
 251         if (!result) {
 252                 maybe_signal_simple_error("Couldn't allocate color", name,
 253                                           Qcolor, errb);
 254                 return 0;
 255         }
 256
 257         return result;
 258 }
 259
 260 static int
 261 x_initialize_color_instance(Lisp_Color_Instance * c, Lisp_Object name,
 262                             Lisp_Object device, Error_behavior errb)
 263 {
 264         XColor color;
 265         int result;
 266
 267         result = x_parse_nearest_color(XDEVICE(device), &color, name, errb);
 268
 269         if (!result)
 270                 return 0;
 271
 272         /* Don't allocate the data until we're sure that we will succeed,
 273            or the finalize method may get fucked. */
 274         c->data = xnew(struct x_color_instance_data);
 275         if (result == 3)
 276                 COLOR_INSTANCE_X_DEALLOC(c) = 0;
 277         else
 278                 COLOR_INSTANCE_X_DEALLOC(c) = 1;
 279         COLOR_INSTANCE_X_COLOR(c) = color;
 280         return 1;
 281 }
 282
 283 static void
 284 x_print_color_instance(Lisp_Color_Instance * c,
 285                        Lisp_Object printcharfun, int escapeflag)
 286 {
 287         XColor color = COLOR_INSTANCE_X_COLOR(c);
 288         write_fmt_str(printcharfun, " %ld=(%X,%X,%X)",
 289                       color.pixel, color.red, color.green, color.blue);
 290 }
 291
 292 static void x_finalize_color_instance(Lisp_Color_Instance * c)
 293 {
 294         if (c->data) {
 295                 if (DEVICE_LIVE_P(XDEVICE(c->device))) {
 296                         if (COLOR_INSTANCE_X_DEALLOC(c)) {
 297                                 XFreeColors(DEVICE_X_DISPLAY
 298                                             (XDEVICE(c->device)),
 299                                             DEVICE_X_COLORMAP(XDEVICE
 300                                                               (c->device)),
 301                                             &COLOR_INSTANCE_X_COLOR(c).pixel, 1,
 302                                             0);
 303                         }
 304                 }
 305                 xfree(c->data);
 306                 c->data = 0;
 307         }
 308 }
 309
 310 /* Color instances are equal if they resolve to the same color on the
 311    screen (have the same RGB values).  I imagine that
 312    "same RGB values" == "same cell in the colormap."  Arguably we should
 313    be comparing their names or pixel values instead. */
 314
 315 static int
 316 x_color_instance_equal(Lisp_Color_Instance * c1,
 317                        Lisp_Color_Instance * c2, int depth)
 318 {
 319         XColor color1 = COLOR_INSTANCE_X_COLOR(c1);
 320         XColor color2 = COLOR_INSTANCE_X_COLOR(c2);
 321         return ((color1.red == color2.red) &&
 322                 (color1.green == color2.green) && (color1.blue == color2.blue));
 323 }
 324
 325 static unsigned long x_color_instance_hash(Lisp_Color_Instance * c, int depth)
 326 {
 327         XColor color = COLOR_INSTANCE_X_COLOR(c);
 328         return HASH3(color.red, color.green, color.blue);
 329 }
 330
 331 static Lisp_Object x_color_instance_rgb_components(Lisp_Color_Instance * c)
 332 {
 333         XColor color = COLOR_INSTANCE_X_COLOR(c);
 334         return (list3(make_int(color.red),
 335                       make_int(color.green), make_int(color.blue)));
 336 }
 337
 338 static int x_valid_color_name_p(struct device *d, Lisp_Object color)
 339 {
 340         XColor c;
 341         Display *dpy = DEVICE_X_DISPLAY(d);
 342         Colormap cmap = DEVICE_X_COLORMAP(d);
 343         const Extbyte *extname;
 344
 345         LISP_STRING_TO_EXTERNAL(color, extname, Qx_color_name_encoding);
 346
 347         return XParseColor(dpy, cmap, extname, &c);
 348 }
 349 \f
 350 /************************************************************************/
 351 /*                           font instances                             */
 352 /************************************************************************/
 353
 354 static int
 355 x_initialize_font_instance(Lisp_Font_Instance * f, Lisp_Object name,
 356                            Lisp_Object device, Error_behavior errb)
 357 {
 358         Display *dpy = DEVICE_X_DISPLAY(XDEVICE(device));
 359         XFontStruct *xf;
 360         const Extbyte *extname;
 361
 362         LISP_STRING_TO_EXTERNAL(f->name, extname, Qx_font_name_encoding);
 363         xf = XLoadQueryFont(dpy, extname);
 364
 365         if (!xf) {
 366                 maybe_signal_simple_error("Couldn't load font", f->name,
 367                                           Qfont, errb);
 368                 return 0;
 369         }
 370
 371         if (!xf->max_bounds.width) {
 372                 /* yes, this has been known to happen. */
 373                 XFreeFont(dpy, xf);
 374                 maybe_signal_simple_error("X font is too small", f->name,
 375                                           Qfont, errb);
 376                 return 0;
 377         }
 378
 379         /* Don't allocate the data until we're sure that we will succeed,
 380            or the finalize method may get fucked. */
 381         f->data = xnew(struct x_font_instance_data);
 382         FONT_INSTANCE_X_TRUENAME(f) = Qnil;
 383         FONT_INSTANCE_X_FONT(f) = xf;
 384         f->ascent = xf->ascent;
 385         f->descent = xf->descent;
 386         f->height = xf->ascent + xf->descent;
 387         {
 388                 /* following change suggested by Ted Phelps <phelps@dstc.edu.au> */
 389                 unsigned int def_char = 'n';    /*xf->default_char; */
 390                 unsigned int byte1, byte2;
 391
 392               once_more:
 393                 byte1 = def_char >> 8;
 394                 byte2 = def_char & 0xFF;
 395
 396                 if (xf->per_char) {
 397                         /* Old versions of the R5 font server have garbage (>63k) as
 398                            def_char. 'n' might not be a valid character. */
 399                         if (byte1 < xf->min_byte1 ||
 400                             byte1 > xf->max_byte1 ||
 401                             byte2 < xf->min_char_or_byte2 ||
 402                             byte2 > xf->max_char_or_byte2)
 403                                 f->width = 0;
 404                         else
 405                                 f->width =
 406                                     xf->per_char[(byte1 - xf->min_byte1) *
 407                                                  (xf->max_char_or_byte2 -
 408                                                   xf->min_char_or_byte2 + 1) +
 409                                                  (byte2 -
 410                                                   xf->min_char_or_byte2)].width;
 411                 } else
 412                         f->width = xf->max_bounds.width;
 413
 414                 /* Some fonts have a default char whose width is 0.  This is no good.
 415                    If that's the case, first try 'n' as the default char, and if n has
 416                    0 width too (unlikely) then just use the max width. */
 417                 if (f->width == 0) {
 418                         if (def_char == xf->default_char)
 419                                 f->width = xf->max_bounds.width;
 420                         else {
 421                                 def_char = xf->default_char;
 422                                 goto once_more;
 423                         }
 424                 }
 425         }
 426         /* If all characters don't exist then there could potentially be
 427            0-width characters lurking out there.  Not setting this flag
 428            trips an optimization that would make them appear to have width
 429            to redisplay.  This is bad.  So we set it if not all characters
 430            have the same width or if not all characters are defined.
 431          */
 432         /* #### This sucks.  There is a measurable performance increase
 433            when using proportional width fonts if this flag is not set.
 434            Unfortunately so many of the fucking X fonts are not fully
 435            defined that we could almost just get rid of this damn flag and
 436            make it an assertion. */
 437         f->proportional_p = (xf->min_bounds.width != xf->max_bounds.width ||
 438                              (x_handle_non_fully_specified_fonts &&
 439                               !xf->all_chars_exist));
 440
 441         return 1;
 442 }
 443
 444 static void x_mark_font_instance(Lisp_Font_Instance * f)
 445 {
 446         mark_object(FONT_INSTANCE_X_TRUENAME(f));
 447 }
 448
 449 static void
 450 x_print_font_instance(Lisp_Font_Instance * f,
 451                       Lisp_Object printcharfun, int escapeflag)
 452 {
 453         write_fmt_str(printcharfun, " 0x%lx", (unsigned long)FONT_INSTANCE_X_FONT(f)->fid);
 454 }
 455
 456 static void x_finalize_font_instance(Lisp_Font_Instance * f)
 457 {
 458
 459         if (f->data) {
 460                 if (DEVICE_LIVE_P(XDEVICE(f->device))) {
 461                         Display *dpy = DEVICE_X_DISPLAY(XDEVICE(f->device));
 462
 463                         XFreeFont(dpy, FONT_INSTANCE_X_FONT(f));
 464                 }
 465                 xfree(f->data);
 466                 f->data = 0;
 467         }
 468 }
 469
 470 /* Determining the truename of a font is hard.  (Big surprise.)
 471
 472    By "truename" we mean an XLFD-form name which contains no wildcards, yet
 473    which resolves to *exactly* the same font as the one which we already have
 474    the (probably wildcarded) name and `XFontStruct' of.
 475
 476    One might think that the first font returned by XListFonts would be the one
 477    that XOpenFont would pick.  Apparently this is the case on some servers,
 478    but not on others.  It would seem not to be specified.
 479
 480    The MIT R5 server sometimes appears to be picking the lexicographically
 481    smallest font which matches the name (thus picking "adobe" fonts before
 482    "bitstream" fonts even if the bitstream fonts are earlier in the path, and
 483    also picking 100dpi adobe fonts over 75dpi adobe fonts even though the
 484    75dpi are in the path earlier) but sometimes appears to be doing something
 485    else entirely (for example, removing the bitstream fonts from the path will
 486    cause the 75dpi adobe fonts to be used instead of the 100dpi, even though
 487    their relative positions in the path (and their names!) have not changed).
 488
 489    The documentation for XSetFontPath() seems to indicate that the order of
 490    entries in the font path means something, but it's pretty noncommittal about
 491    it, and the spirit of the law is apparently not being obeyed...
 492
 493    All the fonts I've seen have a property named `FONT' which contains the
 494    truename of the font.  However, there are two problems with using this: the
 495    first is that the X Protocol Document is quite explicit that all properties
 496    are optional, so we can't depend on it being there.  The second is that
 497    it's conceivable that this alleged truename isn't actually accessible as a
 498    font, due to some difference of opinion between the font designers and
 499    whoever installed the font on the system.
 500
 501    So, our first attempt is to look for a FONT property, and then verify that
 502    the name there is a valid name by running XListFonts on it.  There's still
 503    the potential that this could be true but we could still be being lied to,
 504    but that seems pretty remote.
 505
 506      Late breaking news: I've gotten reports that SunOS 4.1.3U1
 507      with OpenWound 3.0 has a font whose truename is really
 508      "-Adobe-Courier-Medium-R-Normal--12-120-75-75-M-70-ISO8859-1"
 509      but whose FONT property contains "Courier".
 510
 511      So we disbelieve the FONT property unless it begins with a dash and
 512      is more than 30 characters long.  X Windows: The defacto substandard.
 513      X Windows: Complex nonsolutions to simple nonproblems.  X Windows:
 514      Live the nightmare.
 515
 516    If the FONT property doesn't exist, then we try and construct an XLFD name
 517    out of the other font properties (FOUNDRY, FAMILY_NAME, WEIGHT_NAME, etc).
 518    This is necessary at least for some versions of OpenWound.  But who knows
 519    what the future will bring.
 520
 521    If that doesn't work, then we use XListFonts and either take the first font
 522    (which I think is the most sensible thing) or we find the lexicographically
 523    least, depending on whether the preprocessor constant `XOPENFONT_SORTS' is
 524    defined.  This sucks because the two behaviors are a property of the server
 525    being used, not the architecture on which emacs has been compiled.  Also,
 526    as I described above, sorting isn't ALWAYS what the server does.  Really it
 527    does something seemingly random.  There is no reliable way to win if the
 528    FONT property isn't present.
 529
 530    Another possibility which I haven't bothered to implement would be to map
 531    over all of the matching fonts and find the first one that has the same
 532    character metrics as the font we already have loaded.  Even if this didn't
 533    return exactly the same font, it would at least return one whose characters
 534    were the same sizes, which would probably be good enough.
 535
 536    More late-breaking news: on RS/6000 AIX 3.2.4, the expression
 537         XLoadQueryFont (dpy, "-*-Fixed-Medium-R-*-*-*-130-75-75-*-*-ISO8859-1")
 538    actually returns the font
 539         -Misc-Fixed-Medium-R-Normal--13-120-75-75-C-80-ISO8859-1
 540    which is crazy, because that font doesn't even match that pattern!  It is
 541    also not included in the output produced by `xlsfonts' with that pattern.
 542
 543    So this is yet another example of XListFonts() and XOpenFont() using
 544    completely different algorithms.  This, however, is a goofier example of
 545    this bug, because in this case, it's not just the search order that is
 546    different -- the sets don't even intersect.
 547
 548    If anyone has any better ideas how to do this, or any insights on what it is
 549    that the various servers are actually doing, please let me know!  -- jwz. */
 550
 551 static int valid_x_font_name_p(Display * dpy, Extbyte * name)
 552 {
 553         /* Maybe this should be implemented by calling XLoadFont and trapping
 554            the error.  That would be a lot of work, and wasteful as hell, but
 555            might be more correct.
 556          */
 557         int nnames = 0;
 558         Extbyte **names = 0;
 559         if (!name)
 560                 return 0;
 561         names = XListFonts(dpy, name, 1, &nnames);
 562         if (names)
 563                 XFreeFontNames(names);
 564         return (nnames != 0);
 565 }
 566
 567 static Extbyte *truename_via_FONT_prop(Display * dpy, XFontStruct * font)
 568 {
 569         unsigned long value = 0;
 570         Extbyte *result = 0;
 571         if (XGetFontProperty(font, XA_FONT, &value))
 572                 result = XGetAtomName(dpy, value);
 573         /* result is now 0, or the string value of the FONT property. */
 574         if (result) {
 575                 /* Verify that result is an XLFD name (roughly...) */
 576                 if (result[0] != '-' || strlen(result) < (unsigned int)30) {
 577                         XFree(result);
 578                         result = 0;
 579                 }
 580         }
 581         return result;          /* this must be freed by caller if non-0 */
 582 }
 583
 584 static Extbyte *truename_via_random_props(Display * dpy, XFontStruct * font)
 585 {
 586         struct device *d = get_device_from_display(dpy);
 587         unsigned long value = 0;
 588         Extbyte *foundry, *family, *weight, *slant, *setwidth, *add_style;
 589         unsigned long pixel, point, res_x, res_y;
 590         Extbyte *spacing;
 591         unsigned long avg_width;
 592         Extbyte *registry, *encoding;
 593         Extbyte composed_name[2048];
 594         int ok = 0, sz;
 595         Extbyte *result;
 596
 597 #define get_string(atom,var)                            \
 598   if (XGetFontProperty (font, (atom), &value))          \
 599     var = XGetAtomName (dpy, value);                    \
 600   else  {                                               \
 601     var = 0;                                            \
 602     goto FAIL; }
 603 #define get_number(atom,var)                            \
 604   if (!XGetFontProperty (font, (atom), &var) ||         \
 605       var > 999)                                        \
 606     goto FAIL;
 607
 608         foundry = family = weight = slant = setwidth = 0;
 609         add_style = spacing = registry = encoding = 0;
 610
 611         get_string(DEVICE_XATOM_FOUNDRY(d), foundry);
 612         get_string(DEVICE_XATOM_FAMILY_NAME(d), family);
 613         get_string(DEVICE_XATOM_WEIGHT_NAME(d), weight);
 614         get_string(DEVICE_XATOM_SLANT(d), slant);
 615         get_string(DEVICE_XATOM_SETWIDTH_NAME(d), setwidth);
 616         get_string(DEVICE_XATOM_ADD_STYLE_NAME(d), add_style);
 617         get_number(DEVICE_XATOM_PIXEL_SIZE(d), pixel);
 618         get_number(DEVICE_XATOM_POINT_SIZE(d), point);
 619         get_number(DEVICE_XATOM_RESOLUTION_X(d), res_x);
 620         get_number(DEVICE_XATOM_RESOLUTION_Y(d), res_y);
 621         get_string(DEVICE_XATOM_SPACING(d), spacing);
 622         get_number(DEVICE_XATOM_AVERAGE_WIDTH(d), avg_width);
 623         get_string(DEVICE_XATOM_CHARSET_REGISTRY(d), registry);
 624         get_string(DEVICE_XATOM_CHARSET_ENCODING(d), encoding);
 625 #undef get_number
 626 #undef get_string
 627
 628         sz = snprintf(composed_name,sizeof(composed_name),
 629                       "-%s-%s-%s-%s-%s-%s-%ld-%ld-%ld-%ld-%s-%ld-%s-%s",
 630                       foundry, family, weight, slant, setwidth, add_style, pixel,
 631                       point, res_x, res_y, spacing, avg_width, registry, encoding);
 632         assert(sz>=0 && sz < sizeof(composed_name));
 633         ok = 1;
 634
 635       FAIL:
 636         if (ok) {
 637                 int L = strlen(composed_name) + 1;
 638                 result = (Extbyte *)xmalloc_atomic(L);
 639                 strncpy(result, composed_name, L);
 640         } else
 641                 result = 0;
 642
 643         if (foundry)
 644                 XFree(foundry);
 645         if (family)
 646                 XFree(family);
 647         if (weight)
 648                 XFree(weight);
 649         if (slant)
 650                 XFree(slant);
 651         if (setwidth)
 652                 XFree(setwidth);
 653         if (add_style)
 654                 XFree(add_style);
 655         if (spacing)
 656                 XFree(spacing);
 657         if (registry)
 658                 XFree(registry);
 659         if (encoding)
 660                 XFree(encoding);
 661
 662         return result;
 663 }
 664
 665 /* Unbounded, for sufficiently small values of infinity... */
 666 #define MAX_FONT_COUNT 5000
 667
 668 static Extbyte *truename_via_XListFonts(Display * dpy, Extbyte * font_name)
 669 {
 670         Extbyte *result = 0;
 671         Extbyte **names;
 672         int count = 0;
 673
 674 #ifndef XOPENFONT_SORTS
 675         /* In a sensible world, the first font returned by XListFonts()
 676            would be the font that XOpenFont() would use.  */
 677         names = XListFonts(dpy, font_name, 1, &count);
 678         if (count)
 679                 result = names[0];
 680 #else
 681         /* But the world I live in is much more perverse. */
 682         names = XListFonts(dpy, font_name, MAX_FONT_COUNT, &count);
 683         while (count--)
 684                 /* !!#### Not Mule-friendly */
 685                 /* If names[count] is lexicographically less than result, use it.
 686                    (#### Should we be comparing case-insensitively?) */
 687                 if (result == 0 || (strcmp(result, names[count]) < 0))
 688                         result = names[count];
 689 #endif
 690
 691         if (result)
 692                 result = xstrdup(result);
 693         if (names)
 694                 XFreeFontNames(names);
 695
 696         return result;          /* this must be freed by caller if non-0 */
 697 }
 698
 699 static Lisp_Object
 700 x_font_truename(Display * dpy, Extbyte * name, XFontStruct * font)
 701 {
 702         Extbyte *truename_FONT = 0;
 703         Extbyte *truename_random = 0;
 704         Extbyte *truename = 0;
 705
 706         /* The search order is:
 707            - if FONT property exists, and is a valid name, return it.
 708            - if the other props exist, and add up to a valid name, return it.
 709            - if we find a matching name with XListFonts, return it.
 710            - if FONT property exists, return it regardless.
 711            - if other props exist, return the resultant name regardless.
 712            - else return 0.
 713          */
 714
 715         truename = truename_FONT = truename_via_FONT_prop(dpy, font);
 716         if (truename && !valid_x_font_name_p(dpy, truename))
 717                 truename = 0;
 718         if (!truename)
 719                 truename = truename_random =
 720                     truename_via_random_props(dpy, font);
 721         if (truename && !valid_x_font_name_p(dpy, truename))
 722                 truename = 0;
 723         if (!truename && name)
 724                 truename = truename_via_XListFonts(dpy, name);
 725
 726         if (!truename) {
 727                 /* Gag - we weren't able to find a seemingly-valid truename.
 728                    Well, maybe we're on one of those braindead systems where
 729                    XListFonts() and XLoadFont() are in violent disagreement.
 730                    If we were able to compute a truename, try using that even
 731                    if evidence suggests that it's not a valid name - because
 732                    maybe it is, really, and that's better than nothing.
 733                    X Windows: You'll envy the dead.
 734                  */
 735                 if (truename_FONT)
 736                         truename = truename_FONT;
 737                 else if (truename_random)
 738                         truename = truename_random;
 739         }
 740
 741         /* One or both of these are not being used - free them. */
 742         if (truename_FONT && truename_FONT != truename)
 743                 XFree(truename_FONT);
 744         if (truename_random && truename_random != truename)
 745                 XFree(truename_random);
 746
 747         if (truename) {
 748                 Lisp_Object result =
 749                     build_ext_string(truename, Qx_font_name_encoding);
 750                 XFree(truename);
 751                 return result;
 752         } else
 753                 return Qnil;
 754 }
 755
 756 static Lisp_Object
 757 x_font_instance_truename(Lisp_Font_Instance * f, Error_behavior errb)
 758 {
 759         struct device *d = XDEVICE(f->device);
 760
 761         if (NILP(FONT_INSTANCE_X_TRUENAME(f))) {
 762                 Display *dpy = DEVICE_X_DISPLAY(d);
 763                 {
 764                         Extbyte *nameext;
 765
 766                         LISP_STRING_TO_EXTERNAL(f->name, nameext,
 767                                                 Qx_font_name_encoding);
 768                         FONT_INSTANCE_X_TRUENAME(f) =
 769                             x_font_truename(dpy, nameext,
 770                                             FONT_INSTANCE_X_FONT(f));
 771                 }
 772                 if (NILP(FONT_INSTANCE_X_TRUENAME(f))) {
 773                         Lisp_Object font_instance;
 774                         XSETFONT_INSTANCE(font_instance, f);
 775
 776                         maybe_signal_simple_error
 777                             ("Couldn't determine font truename", font_instance,
 778                              Qfont, errb);
 779                         /* Ok, just this once, return the font name as the truename.
 780                            (This is only used by Fequal() right now.) */
 781                         return f->name;
 782                 }
 783         }
 784         return FONT_INSTANCE_X_TRUENAME(f);
 785 }
 786
 787 static Lisp_Object x_font_instance_properties(Lisp_Font_Instance * f)
 788 {
 789         struct device *d = XDEVICE(f->device);
 790         int i;
 791         Lisp_Object result = Qnil;
 792         Display *dpy = DEVICE_X_DISPLAY(d);
 793         XFontProp *props = FONT_INSTANCE_X_FONT(f)->properties;
 794
 795         for (i = FONT_INSTANCE_X_FONT(f)->n_properties - 1; i >= 0; i--) {
 796                 Lisp_Object name, value;
 797                 Atom atom = props[i].name;
 798                 Bufbyte *name_str = 0;
 799                 size_t name_len;
 800                 Extbyte *namestrext = XGetAtomName(dpy, atom);
 801
 802                 if (namestrext)
 803                         TO_INTERNAL_FORMAT(C_STRING, namestrext,
 804                                            ALLOCA, (name_str, name_len),
 805                                            Qx_atom_name_encoding);
 806
 807                 name = (name_str ? intern((char *)name_str) : Qnil);
 808                 if (name_str &&
 809                     (atom == XA_FONT ||
 810                      atom == DEVICE_XATOM_FOUNDRY(d) ||
 811                      atom == DEVICE_XATOM_FAMILY_NAME(d) ||
 812                      atom == DEVICE_XATOM_WEIGHT_NAME(d) ||
 813                      atom == DEVICE_XATOM_SLANT(d) ||
 814                      atom == DEVICE_XATOM_SETWIDTH_NAME(d) ||
 815                      atom == DEVICE_XATOM_ADD_STYLE_NAME(d) ||
 816                      atom == DEVICE_XATOM_SPACING(d) ||
 817                      atom == DEVICE_XATOM_CHARSET_REGISTRY(d) ||
 818                      atom == DEVICE_XATOM_CHARSET_ENCODING(d) ||
 819                      !bufbyte_strcmp(name_str, "CHARSET_COLLECTIONS") ||
 820                      !bufbyte_strcmp(name_str, "FONTNAME_REGISTRY") ||
 821                      !bufbyte_strcmp(name_str, "CLASSIFICATION") ||
 822                      !bufbyte_strcmp(name_str, "COPYRIGHT") ||
 823                      !bufbyte_strcmp(name_str, "DEVICE_FONT_NAME") ||
 824                      !bufbyte_strcmp(name_str, "FULL_NAME") ||
 825                      !bufbyte_strcmp(name_str, "MONOSPACED") ||
 826                      !bufbyte_strcmp(name_str, "QUALITY") ||
 827                      !bufbyte_strcmp(name_str, "RELATIVE_SET") ||
 828                      !bufbyte_strcmp(name_str, "RELATIVE_WEIGHT") ||
 829                      !bufbyte_strcmp(name_str, "STYLE"))) {
 830                         Extbyte *val_str = XGetAtomName(dpy, props[i].card32);
 831
 832                         value =
 833                             (val_str ?
 834                              build_ext_string(val_str, Qx_atom_name_encoding)
 835                              : Qnil);
 836                 } else
 837                         value = make_int(props[i].card32);
 838                 if (namestrext)
 839                         XFree(namestrext);
 840                 result = Fcons(Fcons(name, value), result);
 841         }
 842         return result;
 843 }
 844
 845 static Lisp_Object x_list_fonts(Lisp_Object pattern, Lisp_Object device)
 846 {
 847         Extbyte **names;
 848         int count = 0;
 849         Lisp_Object result = Qnil;
 850         const Extbyte *patternext;
 851
 852         LISP_STRING_TO_EXTERNAL(pattern, patternext, Qx_font_name_encoding);
 853
 854         names = XListFonts(DEVICE_X_DISPLAY(XDEVICE(device)),
 855                            patternext, MAX_FONT_COUNT, &count);
 856         while (count--)
 857                 result =
 858                     Fcons(build_ext_string(names[count], Qx_font_name_encoding),
 859                           result);
 860         if (names)
 861                 XFreeFontNames(names);
 862         return result;
 863 }
 864
 865 #ifdef MULE
 866
 867 static int
 868 x_font_spec_matches_charset(struct device *d, Lisp_Object charset,
 869                             const Bufbyte * nonreloc, Lisp_Object reloc,
 870                             Bytecount offset, Bytecount length)
 871 {
 872         if (UNBOUNDP(charset))
 873                 return 1;
 874         /* Hack! Short font names don't have the registry in them,
 875            so we just assume the user knows what they're doing in the
 876            case of ASCII.  For other charsets, you gotta give the
 877            long form; sorry buster.
 878          */
 879         if (EQ(charset, Vcharset_ascii)) {
 880                 const Bufbyte *the_nonreloc = nonreloc;
 881                 int i;
 882                 Bytecount the_length = length;
 883
 884                 if (!the_nonreloc)
 885                         the_nonreloc = XSTRING_DATA(reloc);
 886                 fixup_internal_substring(nonreloc, reloc, offset, &the_length);
 887                 the_nonreloc += offset;
 888                 assert(the_length>=0);
 889                 if (!memchr(the_nonreloc, '*', the_length)) {
 890                         for (i = 0;; i++) {
 891                                 const Bufbyte *new_nonreloc = (const Bufbyte *)
 892                                     memchr(the_nonreloc, '-', the_length);
 893                                 if (!new_nonreloc)
 894                                         break;
 895                                 new_nonreloc++;
 896                                 the_length -= new_nonreloc - the_nonreloc;
 897                                 the_nonreloc = new_nonreloc;
 898                         }
 899
 900                         /* If it has less than 5 dashes, it's a short font.
 901                            Of course, long fonts always have 14 dashes or so, but short
 902                            fonts never have more than 1 or 2 dashes, so this is some
 903                            sort of reasonable heuristic. */
 904                         if (i < 5)
 905                                 return 1;
 906                 }
 907         }
 908
 909         return (fast_string_match(XCHARSET_REGISTRY(charset),
 910                                   nonreloc, reloc, offset, length, 1,
 911                                   ERROR_ME, 0) >= 0);
 912 }
 913
 914 /* find a font spec that matches font spec FONT and also matches
 915    (the registry of) CHARSET. */
 916 static Lisp_Object
 917 x_find_charset_font(Lisp_Object device, Lisp_Object font, Lisp_Object charset)
 918 {
 919         Extbyte **names;
 920         int count = 0;
 921         Lisp_Object result = Qnil;
 922         const Extbyte *patternext;
 923         int i;
 924
 925         LISP_STRING_TO_EXTERNAL(font, patternext, Qx_font_name_encoding);
 926
 927         names = XListFonts(DEVICE_X_DISPLAY(XDEVICE(device)),
 928                            patternext, MAX_FONT_COUNT, &count);
 929         /* #### This code seems awfully bogus -- mrb */
 930         for (i = 0; i < count; i++) {
 931                 const Bufbyte *intname;
 932                 Bytecount intlen;
 933
 934                 TO_INTERNAL_FORMAT(C_STRING, names[i],
 935                                    ALLOCA, (intname, intlen),
 936                                    Qx_font_name_encoding);
 937                 if (x_font_spec_matches_charset(XDEVICE(device), charset,
 938                                                 intname, Qnil, 0, -1)) {
 939                         result = make_string(intname, intlen);
 940                         break;
 941                 }
 942         }
 943
 944         if (names)
 945                 XFreeFontNames(names);
 946
 947         /* Check for a short font name. */
 948         if (NILP(result)
 949             && x_font_spec_matches_charset(XDEVICE(device), charset, 0,
 950                                            font, 0, -1))
 951                 return font;
 952
 953         return result;
 954 }
 955
 956 #endif                          /* MULE */
 957 \f
 958 /************************************************************************/
 959 /*                            initialization                            */
 960 /************************************************************************/
 961
 962 void syms_of_objects_x(void)
 963 {
 964 }
 965
 966 void console_type_create_objects_x(void)
 967 {
 968         /* object methods */
 969
 970         CONSOLE_HAS_METHOD(x, initialize_color_instance);
 971         CONSOLE_HAS_METHOD(x, print_color_instance);
 972         CONSOLE_HAS_METHOD(x, finalize_color_instance);
 973         CONSOLE_HAS_METHOD(x, color_instance_equal);
 974         CONSOLE_HAS_METHOD(x, color_instance_hash);
 975         CONSOLE_HAS_METHOD(x, color_instance_rgb_components);
 976         CONSOLE_HAS_METHOD(x, valid_color_name_p);
 977
 978         CONSOLE_HAS_METHOD(x, initialize_font_instance);
 979         CONSOLE_HAS_METHOD(x, mark_font_instance);
 980         CONSOLE_HAS_METHOD(x, print_font_instance);
 981         CONSOLE_HAS_METHOD(x, finalize_font_instance);
 982         CONSOLE_HAS_METHOD(x, font_instance_truename);
 983         CONSOLE_HAS_METHOD(x, font_instance_properties);
 984         CONSOLE_HAS_METHOD(x, list_fonts);
 985 #ifdef MULE
 986         CONSOLE_HAS_METHOD(x, find_charset_font);
 987         CONSOLE_HAS_METHOD(x, font_spec_matches_charset);
 988 #endif
 989 }
 990
 991 void vars_of_objects_x(void)
 992 {
 993         DEFVAR_BOOL("x-handle-non-fully-specified-fonts", &x_handle_non_fully_specified_fonts   /*
 994 If this is true then fonts which do not have all characters specified
 995 will be considered to be proportional width even if they are actually
 996 fixed-width.  If this is not done then characters which are supposed to
 997 have 0 width may appear to actually have some width.
 998
 999 Note:  While setting this to t guarantees correct output in all
1000 circumstances, it also causes a noticeable performance hit when using
1001 fixed-width fonts.  Since most people don't use characters which could
1002 cause problems this is set to nil by default.
1003                                                                                                  */ );
1004         x_handle_non_fully_specified_fonts = 0;
1005 }
1006
1007 void Xatoms_of_objects_x(struct device *d)
1008 {
1009         Display *D = DEVICE_X_DISPLAY(d);
1010
1011         DEVICE_XATOM_FOUNDRY(d) = XInternAtom(D, "FOUNDRY", False);
1012         DEVICE_XATOM_FAMILY_NAME(d) = XInternAtom(D, "FAMILY_NAME", False);
1013         DEVICE_XATOM_WEIGHT_NAME(d) = XInternAtom(D, "WEIGHT_NAME", False);
1014         DEVICE_XATOM_SLANT(d) = XInternAtom(D, "SLANT", False);
1015         DEVICE_XATOM_SETWIDTH_NAME(d) = XInternAtom(D, "SETWIDTH_NAME", False);
1016         DEVICE_XATOM_ADD_STYLE_NAME(d) =
1017             XInternAtom(D, "ADD_STYLE_NAME", False);
1018         DEVICE_XATOM_PIXEL_SIZE(d) = XInternAtom(D, "PIXEL_SIZE", False);
1019         DEVICE_XATOM_POINT_SIZE(d) = XInternAtom(D, "POINT_SIZE", False);
1020         DEVICE_XATOM_RESOLUTION_X(d) = XInternAtom(D, "RESOLUTION_X", False);
1021         DEVICE_XATOM_RESOLUTION_Y(d) = XInternAtom(D, "RESOLUTION_Y", False);
1022         DEVICE_XATOM_SPACING(d) = XInternAtom(D, "SPACING", False);
1023         DEVICE_XATOM_AVERAGE_WIDTH(d) = XInternAtom(D, "AVERAGE_WIDTH", False);
1024         DEVICE_XATOM_CHARSET_REGISTRY(d) =
1025             XInternAtom(D, "CHARSET_REGISTRY", False);
1026         DEVICE_XATOM_CHARSET_ENCODING(d) =
1027             XInternAtom(D, "CHARSET_ENCODING", False);
1028 }