home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / gnu / lucid / lemacs-19.6 / src / faces.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-02-16  |  31.0 KB  |  1,192 lines
  1. /* "Face" primitives
  2. This file is part of GNU Emacs.
  3.  
  4. GNU Emacs is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 1, or (at your option)
  7. any later version.
  8.  
  9. GNU Emacs is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12. GNU General Public License for more details.
  13.  
  14. You should have received a copy of the GNU General Public License
  15. along with GNU Emacs; see the file COPYING.  If not, write to
  16. the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  17.  
  18. #include <sys/types.h>
  19. #include <sys/stat.h>
  20.  
  21. #include "config.h"
  22. #include "lisp.h"
  23.  
  24. #include "xterm.h"
  25. #include "buffer.h"
  26. #include "extents.h"
  27. #include "screen.h"
  28. #include "window.h"
  29. #include "indent.h"
  30.  
  31. /* Display Context for the icons */ 
  32. #include <X11/Intrinsic.h>
  33. #include <X11/IntrinsicP.h>
  34. #include <X11/CoreP.h>
  35. #include <X11/StringDefs.h>
  36. #include <X11/Xmu/Drawing.h>
  37. #include <X11/Xos.h>
  38.  
  39. /*#include "extents-data.h"*/
  40. #include "faces.h"
  41. #include "hash.h"
  42.  
  43. #ifndef ENERGIZE
  44. #include "hash.h"
  45. #endif
  46.  
  47. #ifdef HAVE_XPM
  48. #include <X11/xpm.h>
  49. #endif
  50.  
  51. /* The prioirty of the mouse-highlighting attributes, for extent-merging.
  52.  */
  53. int mouse_highlight_priority;
  54.  
  55.  
  56. #define FACE_DEFAULT (~0)
  57.  
  58. extern int extent_cache_invalid;
  59.  
  60. void ensure_face_ready (struct screen* s, int f);
  61. static void build_face (struct screen* s, struct face* face);
  62. static void compute_screen_line_height (struct screen *s);
  63.  
  64.  
  65. /* Caching functions for faces */
  66. static c_hashtable face_cache;
  67. static c_hashtable face_cache_pending_flush;
  68.  
  69. static int face_cache_inited;
  70. int face_cache_invalid;
  71.  
  72. static struct face *allocate_face ();
  73.  
  74. static unsigned long
  75. face_hash_function (void *arg)
  76. {
  77.   struct face* face = (struct face*) arg;
  78.  
  79.   return
  80.     (((unsigned long) face->font) ^ 
  81.      (((unsigned long) face->foreground) ^
  82.       (((unsigned long) face->background) ^ 
  83.        (((unsigned long) face->back_pixmap) ^
  84.     ((unsigned long) face->underline)))));
  85. }
  86.  
  87. static int
  88. face_eql (void *arg1, void *arg2)
  89. {
  90.   if (arg1 == arg2) 
  91.     return 1;
  92.   else
  93.     {
  94.       struct face* face1 = (struct face*) arg1;
  95.       struct face* face2 = (struct face*) arg2;
  96.  
  97.       if ((face1->font == face2->font) &&
  98.           (face1->foreground == face2->foreground) &&
  99.           (face1->background == face2->background) &&
  100.           (face1->back_pixmap == face2->back_pixmap) &&
  101.           (face1->underline == face2->underline))
  102.         return 1;
  103.       else
  104.         return 0;
  105.     }
  106. }
  107.  
  108. static void 
  109. init_face_cache ()
  110. {
  111.   face_cache_inited = 1;
  112.   face_cache = make_general_hashtable (30, face_hash_function, face_eql);
  113. }
  114.  
  115. static struct face*
  116. get_cached_face (struct face* face)
  117. {
  118.   struct face *result;
  119.  
  120.   if (!face_cache_inited)
  121.     init_face_cache ();
  122.  
  123.   if (gethash (face, face_cache, (void **)&result))
  124.     return result;
  125.   else
  126.     return 0;
  127. }
  128.  
  129. static void
  130. cache_face (struct face *face)
  131. {
  132.   if (!face_cache_inited)
  133.     init_face_cache ();
  134.  
  135.   puthash ((void *)face, (void *)face, face_cache);
  136. }
  137.  
  138.  
  139. /* flush_face_cache is called from redisplay when face_cache_invalid is true.
  140.    we set face_cache_invalid when we change a font or color of some face,
  141.    meaning that the GCs need to be recomputed.  We don't just flush the
  142.    cache at the time that we change a face because the redisplay structures
  143.    still have pointers to the faces we want to free.
  144.  */
  145.  
  146. static void
  147. flush_face_cache_mapper (void *hash_key, void *hash_contents, void *closure)
  148. {
  149.   struct face *face = (struct face *) hash_contents;
  150.   Display *dpy = (Display *) closure;
  151.   if (face->facegc)
  152.     XFreeGC (dpy, face->facegc);
  153.   xfree (face);
  154. }
  155.  
  156. void
  157. flush_face_cache ()
  158. {
  159.   Lisp_Object rest;
  160.   Display *dpy = x_current_display;
  161.   if (! face_cache_inited)
  162.     return;
  163.   if (! face_cache_pending_flush)
  164.     return;
  165.  
  166.   BLOCK_INPUT;
  167.   maphash (flush_face_cache_mapper, (void *)
  168.        face_cache_pending_flush,
  169.        (void *) dpy);
  170.   UNBLOCK_INPUT;
  171.   clrhash (face_cache_pending_flush);
  172.   free_hashtable (face_cache_pending_flush);
  173.   face_cache_pending_flush = 0;
  174.  
  175.   /* We need to compute the GCs for the normal and modeline faces of all
  176.      screens right away.
  177.    */
  178.   for (rest = Vscreen_list; !NILP (rest); rest = XCONS (rest)->cdr)
  179.     {
  180.       struct screen *s = XSCREEN (XCONS (rest)->car);
  181.       if (!SCREEN_IS_X (s))
  182.     continue;
  183.       if (! SCREEN_NORMAL_FACE (s).facegc)
  184.     abort ();
  185.       if (! SCREEN_MODELINE_FACE (s).facegc)
  186.     abort ();
  187.       XFreeGC (dpy, SCREEN_NORMAL_FACE (s).facegc);
  188.       XFreeGC (dpy, SCREEN_MODELINE_FACE (s).facegc);
  189.       build_face (s, &SCREEN_NORMAL_FACE (s));
  190.       build_face (s, &SCREEN_MODELINE_FACE (s));
  191.     }
  192.   face_cache_invalid = 0;
  193. }
  194.  
  195. static void
  196. invalidate_face_cache (struct screen *s, int deleting_screen_p)
  197. {
  198.   Lisp_Object tail;
  199.   face_cache_invalid = 1;
  200.   extent_cache_invalid = 1;
  201.  
  202.   for (tail = Vscreen_list; CONSP (tail); tail = XCONS (tail)->cdr)
  203.     SET_SCREEN_GARBAGED (XSCREEN (XCONS (tail)->car));
  204.  
  205.   if (! deleting_screen_p)
  206.     compute_screen_line_height (s);
  207.   if (face_cache_pending_flush)
  208.     return;
  209.   face_cache_pending_flush = face_cache;
  210.   init_face_cache ();
  211. }
  212.  
  213.  
  214. /* Utility functions for faces */
  215.  
  216. static XFontStruct *
  217. verify_font (struct screen* s, XFontStruct *font)
  218. {
  219. #if 0
  220.   if (font == (XFontStruct *) FACE_DEFAULT)
  221.     return font;
  222.   else
  223.     {
  224.       XFontStruct *default_font = SCREEN_NORMAL_FACE (s).font;
  225.       
  226.       if (default_font->ascent + default_font->descent
  227.       != font->ascent + font->descent)
  228.         return default_font;
  229.       else
  230.         return font;
  231.     }
  232. #else
  233.   return font;
  234. #endif
  235. }
  236.  
  237. #define MAX(x,y) (((x)>(y))?(x):(y))
  238.  
  239. extern void EmacsScreenResize (Widget);
  240.  
  241. static void
  242. compute_screen_line_height (struct screen *s)
  243. {
  244.   int ascent = 0;
  245.   int descent = 0;
  246.   int old, i;
  247.   if (! SCREEN_IS_X (s))
  248.     return;
  249.   for (i = 0; i < s->n_faces; i++)
  250.     if (s->faces [i]->font &&
  251.     s->faces [i]->font != (XFontStruct *) FACE_DEFAULT)
  252.       {
  253.     ascent = MAX (ascent, s->faces [i]->font->ascent);
  254.     descent = MAX (descent, s->faces [i]->font->descent);
  255.       }
  256.   old = s->display.x->text_height;
  257.   s->display.x->text_height = ascent + descent;
  258.   if (old != s->display.x->text_height)
  259.     EmacsScreenResize (s->display.x->edit_widget);
  260. }
  261.  
  262. static void
  263. reset_face (struct screen* s, struct face* face)
  264. {
  265.   struct face* normal_face = &SCREEN_NORMAL_FACE (s);
  266.   memset ((void*)face, 0, sizeof (struct face));
  267.   face->foreground = normal_face->foreground;
  268.   face->background = normal_face->background;
  269.   face->back_pixmap = normal_face->back_pixmap;
  270.   face->underline = normal_face->underline;
  271.   face->font = normal_face->font;
  272. #if 0
  273.   face->font_name = 0;
  274. #endif
  275. }
  276.  
  277. static void 
  278. merge_faces (struct face* from, struct face* to)
  279. {
  280.   if (from->font != (XFontStruct *)FACE_DEFAULT)
  281.     {
  282.       to->font = from->font;
  283. #if 0
  284.       to->font_name = 0;
  285. #endif
  286.     }
  287.   if (from->foreground != FACE_DEFAULT)
  288.     to->foreground = from->foreground;
  289.   if (from->background != FACE_DEFAULT)
  290.     to->background = from->background;
  291.   if (from->back_pixmap != FACE_DEFAULT)
  292.     to->back_pixmap = from->back_pixmap;
  293.   if (from->underline)
  294.     to->underline = from->underline;
  295. }
  296.  
  297.  
  298. static void
  299. merge_extent_face (struct screen* s, EXTENT extent, struct face* face)
  300. {
  301.   int index = extent->attr_index;
  302.   
  303.   /* no attribute: do not change anything */
  304.   if (index <= 0)
  305.     return;
  306.     ensure_face_ready (s, index);
  307.  
  308.   /* do the merge */
  309.   merge_faces (s->faces [index], face);
  310. }
  311.  
  312. static void
  313. build_face (struct screen* s, struct face* face)
  314. {
  315.   GC gc;
  316.   XGCValues xgcv;
  317.   unsigned long mask;
  318.  
  319.   xgcv.foreground = face->foreground;
  320.   xgcv.background = face->background;
  321.   xgcv.font = face->font->fid;
  322.   xgcv.graphics_exposures = 0;
  323.   mask = GCForeground | GCBackground | GCFont | GCGraphicsExposures;
  324.   gc = XCreateGC (XtDisplay (s->display.x->widget),
  325.           XtWindow (s->display.x->widget),
  326.           mask, &xgcv);
  327.   if (face->back_pixmap && face->back_pixmap != FACE_DEFAULT)
  328.     XSetStipple (XtDisplay (s->display.x->widget), gc, face->back_pixmap);
  329.   face->facegc = gc;
  330. }
  331.  
  332.  
  333. /* Get a face suitable for display (ie which has a GC) for a given
  334.    set of attributes. */
  335.  
  336. static struct face *
  337. get_display_face (struct screen* s, struct face* face)
  338. {
  339.   struct face *result;
  340.  
  341.   /* Does the face have a GC already */
  342.   if (face->facegc)
  343.     return face;
  344.   
  345.   /* cache the default face */
  346.   if (face->font == SCREEN_NORMAL_FACE (s).font
  347.       && face->foreground == SCREEN_NORMAL_FACE (s).foreground
  348.       && face->background == SCREEN_NORMAL_FACE (s).background
  349.       && face->back_pixmap == SCREEN_NORMAL_FACE (s).back_pixmap
  350.       && face->underline == SCREEN_NORMAL_FACE (s).underline)
  351.     return &SCREEN_NORMAL_FACE (s);
  352.  
  353.   /* cache the modeline face */
  354.   if (face->font == SCREEN_MODELINE_FACE (s).font
  355.       && face->foreground == SCREEN_MODELINE_FACE (s).foreground
  356.       && face->background == SCREEN_MODELINE_FACE (s).background
  357.       && face->back_pixmap == SCREEN_MODELINE_FACE (s).back_pixmap
  358.       && face->underline == SCREEN_MODELINE_FACE (s).underline)
  359.     return &SCREEN_MODELINE_FACE (s);
  360.  
  361.   /* Is it cached */
  362.   result = get_cached_face (face);
  363.   if (result)
  364.     return result;
  365.  
  366.   /* Add one to the cache */
  367.   result = allocate_face ();
  368.  
  369.   result->font = face->font;
  370.   result->foreground = face->foreground;
  371.   result->background = face->background;
  372.   result->back_pixmap = face->back_pixmap;
  373.   result->underline = face->underline;
  374.   
  375.   build_face (s, result);
  376.   cache_face (result);
  377.  
  378.   return result;
  379. }
  380.  
  381.  
  382. /* External entry points */
  383.  
  384. extern Lisp_Object Vlast_highlighted_extent;
  385.  
  386. /* Computes the face associated with an overlapping set of extents */
  387. void 
  388. setup_extent_fragment_face_ptr (struct screen *s, EXTENT_FRAGMENT extfrag)
  389. {
  390.   struct face face;
  391.   EXTENT *vec = extfrag->extents_stack;
  392.   int len = extfrag->number_of_extents;
  393.   int i;
  394.   
  395.   /* optimize the default case. */
  396.   if (len == 0)
  397.     extfrag->fp = &SCREEN_NORMAL_FACE (s);
  398.   else
  399.     {
  400.       EXTENT ebuf [200];
  401.       EXTENT *extents;
  402.       struct extent dummy_extent;
  403.  
  404.       /* Make a copy of the vector of extents... */
  405.       if (len < (sizeof(ebuf) / (sizeof(EXTENT)) - 1))
  406.     extents = ebuf; /* use a static buffer if it's small, for speed */
  407.       else
  408.     extents = (EXTENT *) alloca ((len * sizeof(EXTENT)) + 1);
  409.       memcpy (extents, vec, len * sizeof(EXTENT));
  410.  
  411.       /* determine whether the last-highlighted-extent is present... */
  412.       if (EXTENTP (Vlast_highlighted_extent))
  413.     {
  414.       EXTENT lhe = XEXTENT (Vlast_highlighted_extent);
  415.       int lhe_index = -1;
  416.       for (i = 0; i < len; i++)
  417.         if (extents [i] == lhe)
  418.           {
  419.         lhe_index = i;
  420.         break;
  421.           }
  422.       /* ...and if it is, make up a dummy extent of the appropriate
  423.          priority, and add it to the list to be sorted with the rest.
  424.        */
  425.       if (lhe_index != -1)
  426.         {
  427.           /* memset isn't really necessary; we only deref `priority' */
  428.           memset (&dummy_extent, 0, sizeof (dummy_extent));
  429.           dummy_extent.priority = mouse_highlight_priority;
  430.           /* put the dummy extent just after the lhe in the stack,
  431.          as they're already sorted by size/starting point. */
  432.           for (i = len; i > lhe_index; i--)
  433.         extents [i] = extents [i-1];
  434.           extents [lhe_index + 1] = &dummy_extent;
  435.           len++;
  436.         }
  437.     }
  438.  
  439.       /* sort our copy of the stack by extent->priority... */
  440.       for (i = 1; i < len; i++)
  441.     {
  442.       int j = i - 1;
  443.       while (j >= 0 && extents[j]->priority > extents[j+1]->priority)
  444.         {
  445.           EXTENT tmp = extents [j];
  446.           extents [j] = extents [j+1];
  447.           extents [j+1] = tmp;
  448.           j--;
  449.         }
  450.     }
  451.  
  452.       /* Now merge the faces of the extents together in order.
  453.  
  454.      Remember that one of the extents in the list might be our dummy
  455.      extent representing the highlighting that is attached to some other
  456.      extent that is currently mouse-highlighted.  When an extent is
  457.      mouse-highlighted, it is as if there are two extents there, of
  458.      potentially different priorities: the extent being highlighted, with
  459.      whatever face and priority it has; and an ephemeral extent in the
  460.      `highlight' face with `mouse-highlight-priority'.
  461.        */
  462.       reset_face (s, &face);
  463.       for (i = 0; i < len; i++)
  464.     {
  465.       EXTENT current = extents [i];
  466.       if (current == &dummy_extent)
  467.         /* this isn't a real extent; use the highlight face. */
  468.         merge_faces (&SCREEN_HIGHLIGHT_FACE (s), &face);
  469.       else if (current->end != current->start)
  470.         /* Skip 0-length extents from the merge (is this necessary?) */
  471.         merge_extent_face (s, current, &face);
  472.     }
  473.  
  474.       face.font = verify_font (s, face.font);
  475.       extfrag->fp = get_display_face (s, &face);
  476.     }
  477. }
  478.  
  479.  
  480. /* Allocate a new face */
  481. static struct face *
  482. allocate_face ()
  483. {
  484.   struct face* result = (struct face*)xmalloc (sizeof (struct face));
  485.   memset ((void*)result, 0, sizeof (struct face));
  486.   result->font = (XFontStruct *) FACE_DEFAULT;
  487.   result->foreground = FACE_DEFAULT;
  488.   result->background = FACE_DEFAULT;
  489.   result->back_pixmap = FACE_DEFAULT;
  490.   result->underline = 0;
  491.   return result;
  492. }
  493.  
  494.  
  495. void
  496. ensure_face_ready (struct screen* s, int f)
  497. {
  498.   if (s->n_faces <= f)
  499.     {
  500.       int n = f + 10;
  501.       int i;
  502.       int start;
  503.       if (!s->n_faces)
  504.     {
  505.       s->faces = (struct face**)xmalloc (sizeof (struct face*) * n);
  506.       start = 0;
  507.     }
  508.       else
  509.     {
  510.       s->faces =
  511.         (struct face**)xrealloc (s->faces, sizeof (struct face*) * n);
  512.       start = s->n_faces;
  513.     }
  514.  
  515.       s->n_faces = n;
  516.  
  517.       for (i = start; i < n; i++)
  518.     s->faces [i] = allocate_face ();
  519.     }
  520. /*
  521.   if (!s->faces [f]->resourced)
  522.     {
  523.       BLOCK_INPUT;
  524.       EmacsScreenResourceFace ((EmacsScreenWidget)s->display.x->edit_widget,
  525.                    f);
  526.       UNBLOCK_INPUT;
  527.     }
  528.  */
  529. }
  530.  
  531.  
  532.  
  533. /* Allocating, freeing, and duplicating fonts, colors, and pixmaps.
  534.  
  535.    It would be cleaner if we parsed these things by simply calling the
  536.    currently-installed Xt resource converters; that would let folks set
  537.    the font of a face to "XtDefaultFont", and would make XPM support
  538.    automatic if the right resource converter was linked in.
  539.  
  540.    However, there are two problems with this approach: first, I couldn't
  541.    figure out how to make XtConvert() work at all.  Second, Xt is very
  542.    statically-minded; if you ask for the same pixel/font/pixmap twice from
  543.    the resource database, it returns the old value, not a copy, and doesn't
  544.    maintain a reference count or provide a way to free it.  So that would
  545.    mean that once emacs had allocated a color cell, or font, or pixmap,
  546.    there would be no way to free it, since we would have no way of knowing
  547.    whether some other widget in this process also had a pointer to it.
  548.  */
  549.  
  550. #ifdef HAVE_X_WINDOWS
  551.  
  552. static XFontStruct *
  553. load_font (struct screen *s, Lisp_Object name)
  554. {
  555.   XFontStruct *font;
  556.   if (NILP (name) || !SCREEN_IS_X (s))
  557.     return (XFontStruct *) FACE_DEFAULT;
  558.   CHECK_STRING (name, 0);
  559.   BLOCK_INPUT;
  560.   font = XLoadQueryFont (XtDisplay (s->display.x->widget),
  561.              (char *) XSTRING (name)->data);
  562.   UNBLOCK_INPUT;
  563.   if (! font)
  564.     while (1)
  565.       Fsignal (Qerror, Fcons (build_string ("couldn't load font"),
  566.                   Fcons (name, Qnil)));
  567.   return font;
  568. }
  569.  
  570. static void
  571. unload_font (struct screen *s, XFontStruct *font)
  572. {
  573.   if (!font || font == ((XFontStruct *) FACE_DEFAULT))
  574.     return;
  575.   XFreeFont (XtDisplay (s->display.x->widget), font);
  576. }
  577.  
  578. static unsigned long
  579. load_pixel (struct screen *s, Lisp_Object name)
  580. {
  581.   Widget widget;
  582.   Display *dpy;
  583.   Colormap cmap;
  584.   XColor color;
  585.   int result;
  586.  
  587.   if (NILP (name) || !SCREEN_IS_X (s))
  588.     return FACE_DEFAULT;
  589.  
  590.   widget = s->display.x->widget;
  591.   dpy = XtDisplay (widget);
  592.   cmap = DefaultColormapOfScreen (XtScreen (widget));
  593.  
  594.   CHECK_STRING (name, 0);
  595.   BLOCK_INPUT;
  596.   result = XParseColor (dpy, cmap, (char *) XSTRING (name)->data, &color);
  597.   UNBLOCK_INPUT;
  598.   if (! result)
  599.     return Fsignal (Qerror, Fcons (build_string ("unrecognised color"),
  600.                    Fcons (name, Qnil)));
  601.   BLOCK_INPUT;
  602.   result = XAllocColor (dpy, cmap, &color);
  603.   UNBLOCK_INPUT;
  604.   if (! result)
  605.     return Fsignal (Qerror, Fcons (build_string ("couldn't allocate color"),
  606.                    Fcons (name, Qnil)));
  607.   return (unsigned long) color.pixel;
  608. }
  609.  
  610. static void
  611. unload_pixel (struct screen *s, Pixel pixel)
  612. {
  613.   Widget widget;
  614.   Colormap cmap;
  615.   Display *dpy;
  616.   if (pixel == FACE_DEFAULT)
  617.     return;
  618.   widget = s->display.x->widget;
  619.   cmap = DefaultColormapOfScreen (XtScreen (widget));
  620.   dpy = XtDisplay (widget);
  621.   BLOCK_INPUT;
  622.   XFreeColors (dpy, cmap, &pixel, 1, 0);
  623.   UNBLOCK_INPUT;
  624. }
  625.  
  626. static int locate_pixmap_file (char *in, char *out);
  627.  
  628. Pixmap
  629. load_pixmap_1 (Display *dpy, Window window,
  630.            Lisp_Object name, unsigned int *wP, unsigned int *hP,
  631.            unsigned int *dP, Pixmap *maskP)
  632. {
  633.   int result;
  634.   char file [1024];
  635.   int xhot, yhot;
  636.   unsigned int w, h, d;
  637.   unsigned char *data = 0;
  638.   Pixmap new;
  639.   Pixmap mask = 0;
  640. #ifdef HAVE_XPM
  641.   XpmAttributes xpmattrs;
  642.   int retry_in_mono = 0;
  643. #endif /* HAVE_XPM */
  644.  
  645.   if (CONSP (name))
  646.     {
  647.       if (!CONSP (Fcdr (name)) ||
  648.       !CONSP (Fcdr (Fcdr (name))) ||
  649.       !NILP (Fcdr (Fcdr (Fcdr (name)))) ||
  650.       !FIXNUMP (Fcar (name)) ||
  651.       !FIXNUMP (Fcar (Fcdr (name))) ||
  652.       !STRINGP (Fcar (Fcdr (Fcdr (name)))))
  653.     return
  654.       Fsignal (Qerror,
  655.            Fcons (build_string ("must be of the form (W H \"bits\")"),
  656.               Fcons (name, Qnil)));
  657.       w = XINT (Fcar (name));
  658.       h = XINT (Fcar (Fcdr (name)));
  659.       if (w <= 0)
  660.     while (1) wrong_type_argument (Qnatnump, Fcar (name));
  661.       if (h <= 0)
  662.     while (1) wrong_type_argument (Qnatnump, Fcar (Fcdr (name)));
  663.       if ((w * h / 8) > XSTRING (Fcar (Fcdr (Fcdr (name))))->size)
  664.     while (1)
  665.       Fsignal (Qerror,
  666.            Fcons (build_string ("data is too short for W and H"),
  667.               Fcons (name, Qnil)));
  668.       data = (unsigned char *) XSTRING (Fcar (Fcdr (Fcdr (name))))->data;
  669.       xhot = yhot = 0;
  670.       new = XCreatePixmapFromBitmapData (dpy, window,
  671.                      (char *) data, w, h, 1, 0, 1);
  672.       d = 0;
  673.     }
  674.   else
  675.     {
  676.       CHECK_STRING (name, 0);
  677.       if (! locate_pixmap_file ((char *) XSTRING (name)->data, file))
  678.     return Fsignal (Qfile_error,
  679.             list3 (build_string ("Opening pixmap file"),
  680.                    build_string ("no such file or directory"),
  681.                    name));
  682.       name = build_string (file);
  683.  
  684. #ifdef HAVE_XPM
  685.       xpmattrs.valuemask = 0;
  686.     RETRY:
  687.       BLOCK_INPUT;
  688.       result = XpmReadFileToPixmap (dpy, window, file, &new, &mask, &xpmattrs);
  689.       w = xpmattrs.width;
  690.       h = xpmattrs.height;
  691.       XpmFreeAttributes (&xpmattrs);
  692.       UNBLOCK_INPUT;
  693.  
  694.       switch (result)
  695.     {
  696.     case XpmSuccess:
  697.       /* XpmReadFileToPixmap() doesn't return the depth (bogus!) so we
  698.          need to get it ourself. */
  699. #if 1
  700.       /* Actually, we might as well just assume that Xpm did the right
  701.          thing and gave us a pixmap of the same depth as the window we
  702.          passed it. */
  703.       /* #### but we shouldn't be using selected_screen here */
  704.       d = selected_screen->display.x->widget->core.depth;
  705. #else
  706.       {
  707.         Window root;
  708.         int x, y;
  709.         unsigned int w2, h2, bw;
  710.         BLOCK_INPUT;
  711.         if (!XGetGeometry (dpy, new, &root, &x, &y, &w2, &h2, &bw, &d))
  712.           abort ();
  713.         if (w != w2 || h != h2) abort ();
  714.         UNBLOCK_INPUT;
  715.       }
  716. #endif
  717.       
  718.       goto SUCCESS;
  719.  
  720.     case XpmFileInvalid:
  721.       /* Ok, we'll try to read it as an XBM and error if that fails */
  722.       break;
  723.       
  724.     case XpmColorFailed:
  725.       /* If we couldn't allocate any colors for this image, then silently
  726.          retry in monochrome.  If that fails too, then signal an error.
  727.        */
  728.       if (retry_in_mono) /* second time; blow out. */
  729.         return Fsignal (Qfile_error,
  730.                 list3 (build_string ("Reading pixmap file"),
  731.                    build_string ("color allocation failed"),
  732.                    name));
  733.       /* else... */
  734.       retry_in_mono = 1;
  735.       xpmattrs.depth = 1;
  736.       xpmattrs.valuemask |= XpmDepth;
  737.       goto RETRY;
  738.  
  739.     case XpmColorError:
  740.       {
  741.         /* Maybe we should just read it in monochrome instead of
  742.            allowing the colors to be substituted?
  743.          */
  744.         char buf [2000];
  745.         sprintf (buf, "color substitution performed for file \"%s\"",
  746.              (char *) XSTRING (name)->data);
  747.         message (buf);
  748.       }
  749.     case XpmNoMemory:
  750.       return Fsignal (Qfile_error,
  751.               list3 (build_string ("Reading pixmap file"),
  752.                  build_string ("out of memory"),
  753.                  name));
  754.     case XpmOpenFailed:
  755.       return
  756.         Fsignal (Qfile_error,
  757.              Fcons (build_string ("Opening pixmap file"),
  758.                 Fcons (build_string ("no such file or directory"),
  759.                    Fcons (name, Qnil))));
  760.     default:
  761.       return Fsignal (Qfile_error,
  762.               list4 (build_string ("Reading pixmap file"),
  763.                  build_string ("unknown error code"),
  764.                  make_number (result), name));
  765.     }
  766. #endif /* HAVE_XPM */
  767.       
  768.       BLOCK_INPUT;
  769.       result = XmuReadBitmapDataFromFile (file, &w, &h, &data, &xhot, &yhot);
  770.       UNBLOCK_INPUT;
  771.       
  772.       switch (result)
  773.     {
  774.     case BitmapSuccess:
  775.       BLOCK_INPUT;
  776.       new = XCreatePixmapFromBitmapData (dpy, window,
  777.                          (char *) data, w, h, 1, 0, 1);
  778.       d = 0;
  779.       XFree ((char *)data);
  780.       UNBLOCK_INPUT;
  781.       break;
  782.     case BitmapOpenFailed:
  783.       return
  784.         Fsignal (Qfile_error,
  785.              Fcons (build_string ("Opening bitmap file"),
  786.                 Fcons (build_string ("no such file or directory"),
  787.                    Fcons (name, Qnil))));
  788.     case BitmapFileInvalid:
  789.       return Fsignal (Qfile_error,
  790.               list3 (build_string ("Reading bitmap file"),
  791.                  build_string ("invalid bitmap data"),
  792.                  name));
  793.     case BitmapNoMemory:
  794.       return Fsignal (Qfile_error,
  795.               list3 (build_string ("Reading bitmap file"),
  796.                  build_string ("out of memory"),
  797.                  name));
  798.     default:
  799.       return Fsignal (Qfile_error,
  800.               list4 (build_string ("Reading bitmap file"),
  801.                  build_string ("unknown error code"),
  802.                  make_number (result), name));
  803.     }
  804.     }
  805.   
  806.  SUCCESS:
  807.   *wP = w;
  808.   *hP = h;
  809.   *dP = d;
  810.  
  811.   if (maskP)
  812.     *maskP = mask;
  813.   else if (mask)    /* not interested; lose it. */
  814.     {
  815.       BLOCK_INPUT;
  816.       XFreePixmap (dpy, mask);
  817.       UNBLOCK_INPUT;
  818.     }
  819.  
  820.   return new;
  821. }
  822.  
  823.  
  824. unsigned long
  825. load_pixmap (struct screen *s, Lisp_Object name,
  826.          unsigned int *wP, unsigned int *hP, unsigned int *dP,
  827.          unsigned long *maskP)
  828. {
  829.   if (NILP (name) || !SCREEN_IS_X (s))
  830.     {
  831.       *wP = *hP = *dP = 0;
  832.       return FACE_DEFAULT;
  833.     }
  834.   else if (!SCREEN_IS_X (s))
  835.     abort ();
  836.   else
  837.     {
  838.       Widget widget = s->display.x->widget;
  839.       return (unsigned long)
  840.     load_pixmap_1 (XtDisplay (widget), XtWindow (widget),
  841.                name, wP, hP, dP, (Pixmap *) maskP);
  842.     }
  843. }
  844.  
  845.  
  846. void
  847. unload_pixmap (struct screen *s, unsigned long pix)
  848. {
  849.   if (!pix || pix == FACE_DEFAULT)
  850.     return;
  851.   BLOCK_INPUT;
  852.   XFreePixmap (XtDisplay (s->display.x->widget), (Pixmap) pix);
  853.   UNBLOCK_INPUT;
  854. }
  855.  
  856.  
  857. extern Lisp_Object Vx_bitmap_file_path;
  858.  
  859. extern void initialize_x_bitmap_file_path (void);
  860.  
  861. static int
  862. locate_pixmap_file (char *in, char *out)
  863. {
  864.   Lisp_Object rest;
  865.   if (in [0] == '/' || (in [0] == '.' && in [1] == '/'))
  866.     {
  867.       strcpy (out, in);
  868.       return 1;
  869.     }
  870.   
  871.   if (NILP (Vx_bitmap_file_path))
  872.     initialize_x_bitmap_file_path ();
  873.   
  874.   for (rest = Vx_bitmap_file_path; CONSP (rest); rest = Fcdr (rest))
  875.     {
  876.       struct stat st;
  877.       int length = XSTRING (XCONS (rest)->car)->size;
  878.       if (length == 0) continue;
  879.       strncpy (out, (char *) XSTRING (XCONS (rest)->car)->data, length+1);
  880.       if (out [length] != '/')
  881.     out [length++] = '/';
  882.       strcpy (out + length, in);
  883.       if (stat (out, &st) >= 0            /* exists */
  884.       && (st.st_mode & S_IFMT) != S_IFDIR    /* not a directory */
  885.       && !access (out, R_OK))        /* readable */
  886.     return 1;
  887.     }
  888.   return 0;
  889. }
  890.  
  891. #endif /* HAVE_X_WINDOWS */
  892.  
  893.  
  894. /* screens */
  895.  
  896. extern int gc_currently_forbidden;
  897.  
  898. void
  899. init_screen_faces (struct screen *s)
  900. {
  901.   struct screen *other_screen = 0;
  902.   Lisp_Object rest;
  903.  
  904.   for (rest = Vscreen_list; !NILP (rest); rest = Fcdr (rest))
  905.     {
  906.       struct screen *s2 = XSCREEN (Fcar (rest));
  907.       if (s2 != s && SCREEN_IS_X (s2))
  908.     {
  909.       other_screen = s2;
  910.       break;
  911.     }
  912.     }
  913.  
  914.   if (other_screen)
  915.     /* make sure this screen's face vector is as big as the others */
  916.     ensure_face_ready (s, other_screen->n_faces);
  917.  
  918.     {
  919.       struct screen *oss = selected_screen;
  920.  
  921.       if (! NILP (Vpurify_flag))
  922.     return;
  923.  
  924.       /* There's no reason to bother doing specbinds here, because if
  925.      make-initial-faces signals an error, emacs is going to crash
  926.      immediately.
  927.        */
  928.       gc_currently_forbidden = 1;
  929.       Vinhibit_quit = Qt;
  930.       selected_screen = s;
  931.       call0 (intern ("make-screen-initial-faces"));
  932.       selected_screen = oss;
  933.       Vinhibit_quit = Qnil;
  934.       gc_currently_forbidden = 0;
  935.  
  936.       if (SCREEN_IS_X (s))
  937.     if (SCREEN_NORMAL_FACE (s).font == 0 ||
  938.         SCREEN_NORMAL_FACE (s).font == (XFontStruct *) FACE_DEFAULT)
  939.     fatal ("Unable to load any useable ISO8859-1 font; check X resources");
  940.     }
  941.   
  942.   if (SCREEN_IS_X (s))
  943.     {
  944.       build_face (s, &SCREEN_NORMAL_FACE (s));   /* the first two have GCs */
  945.       build_face (s, &SCREEN_MODELINE_FACE (s));
  946.     }
  947. }
  948.  
  949.  
  950. void
  951. free_screen_faces (struct screen *s)    /* called from Fdelete_screen() */
  952. {
  953.   Display *dpy = XtDisplay (s->display.x->widget);
  954.   int i;
  955.  
  956.   /* This may be able to free some GCs, but unfortunately it will cause
  957.      all screens to redisplay. */
  958.   invalidate_face_cache (s, 1);
  959.  
  960.   /* elts 0 and 1 of the face array are the only ones with GCs */
  961.   XFreeGC (dpy, SCREEN_NORMAL_FACE (s).facegc);
  962.   XFreeGC (dpy, SCREEN_MODELINE_FACE (s).facegc);
  963.   SCREEN_NORMAL_FACE (s).facegc = 0;
  964.   SCREEN_MODELINE_FACE (s).facegc = 0;
  965.  
  966.   for (i = 0; i < s->n_faces; i++)
  967.     {
  968.       struct face *face = s->faces [i];
  969.       if (! face)
  970.         continue;
  971.       if (face->facegc)
  972.     abort ();
  973.       unload_font (s, face->font);
  974.       unload_pixel (s, face->foreground);
  975.       unload_pixel (s, face->background);
  976.       unload_pixmap (s, face->back_pixmap);
  977.       xfree (face);
  978.     }
  979.   xfree (s->faces);
  980.   s->faces = 0;
  981.   s->n_faces = 0;
  982. }
  983.  
  984.  
  985. /* Lisp interface */
  986.  
  987. DEFUN ("screen-face-alist", Fscreen_face_alist, Sscreen_face_alist, 1, 1, 0,
  988.        "")
  989.      (screen)
  990.      Lisp_Object screen;
  991. {
  992.   CHECK_SCREEN (screen, 0);
  993.   return XSCREEN (screen)->face_alist;
  994. }
  995.  
  996. DEFUN ("set-screen-face-alist", Fset_screen_face_alist, Sset_screen_face_alist,
  997.        2, 2, 0, "")
  998.      (screen, value)
  999.      Lisp_Object screen, value;
  1000. {
  1001.   CHECK_SCREEN (screen, 0);
  1002.   XSCREEN (screen)->face_alist = value;
  1003.   return value;
  1004. }
  1005.  
  1006.  
  1007. DEFUN ("make-face-internal", Fmake_face_internal, Smake_face_internal,
  1008.        3, 3, 0, "")
  1009.      (name, object, id_number)
  1010.      Lisp_Object name, object, id_number;
  1011. {
  1012.   Lisp_Object rest;
  1013.   int id = XINT (id_number);
  1014.   CHECK_SYMBOL (name, 0);
  1015.   CHECK_VECTOR (object, 0);
  1016.   CHECK_FIXNUM (id_number, 0);
  1017.   if (id < 0)
  1018.     return Fsignal (Qerror, Fcons (build_string ("id must be positive"),
  1019.                    Fcons (id_number, Qnil)));
  1020.   for (rest = Vscreen_list; !NILP (rest); rest = XCONS (rest)->cdr)
  1021.     {
  1022.       struct screen *s = XSCREEN (XCONS (rest)->car);
  1023.       Lisp_Object old = Fassq (name, s->face_alist);
  1024.       if (NILP (old))
  1025.     {
  1026.       s->face_alist = Fcons (Fcons (name, object), s->face_alist);
  1027.       /* unless we're at the end now, copy the face object so that
  1028.          each screen has it's own structure (because they can be
  1029.          modified independently.)
  1030.        */
  1031.       if (!NILP (Fcdr (rest)))
  1032.         object = Fcopy_sequence (object);
  1033.     }
  1034.       else if (rest == Vscreen_list) /* first time */
  1035.     return Fsignal (Qerror,
  1036.             Fcons (build_string ("there is already a face named"),
  1037.                    Fcons (name, Qnil)));
  1038.       else                 /* second time */
  1039.     abort ();
  1040.  
  1041.       ensure_face_ready (s, id);
  1042.       if (! s->faces [id])
  1043.     abort ();
  1044.     }
  1045.   return Qnil;
  1046. }
  1047.  
  1048.  
  1049. DEFUN ("set-face-attribute-internal", Fset_face_attribute_internal,
  1050.        Sset_face_attribute_internal, 4, 4, 0, "")
  1051.      (face_id, attr_name, attr_value, screen)
  1052.      Lisp_Object face_id, attr_name, attr_value, screen;
  1053. {
  1054.   struct face *face;
  1055.   struct screen *s;
  1056.   int magic_p;
  1057.   int id;
  1058.   CHECK_SCREEN (screen, 0);
  1059.   CHECK_FIXNUM (face_id, 0);
  1060.   CHECK_SYMBOL (attr_name, 0);
  1061.   s = XSCREEN (screen);
  1062.   id = XINT (face_id);
  1063.   if (id < 0)
  1064.     return Fsignal (Qerror, Fcons (build_string ("invalid face id"),
  1065.                    Fcons (face_id, Fcons (screen, Qnil))));
  1066.   ensure_face_ready (s, id);
  1067.   face = s->faces [XFASTINT (face_id)];
  1068.   if (! face) abort ();
  1069.   magic_p = (NILP (attr_value) &&
  1070.          (XFASTINT (face_id) == 0 ||
  1071.           XFASTINT (face_id) == 1));
  1072.  
  1073.   if (EQ (attr_name, intern ("font")))
  1074.     {
  1075. #ifdef HAVE_X_WINDOWS
  1076.       XFontStruct *font;
  1077.       if (magic_p)
  1078.      error ("can't set the font of the `normal' or `modeline' faces to nil.");
  1079.       font = load_font (s, attr_value);
  1080.       unload_font (s, face->font);
  1081.       face->font = font;
  1082.  
  1083. #if 0
  1084.       if (face->font_name)
  1085.     xfree (face->font_name);
  1086.       if (font && font != ((XFontStruct *) FACE_DEFAULT))
  1087.     face->font_name =
  1088.       (char *) strdup ((char *) XSTRING (attr_value)->data);
  1089.       else
  1090.     face->font_name = 0;
  1091. #endif
  1092.  
  1093.       if (id == 0) /* the "default" face; update the ScreenWidget as well */
  1094.     {
  1095.       Arg av[10];
  1096.       int ac = 0;
  1097.       XtSetArg (av[ac], XtNfont, font); ac++;
  1098.       BLOCK_INPUT;
  1099.       XtSetValues (s->display.x->edit_widget, av, ac);
  1100.       UNBLOCK_INPUT;
  1101.     }
  1102.       invalidate_face_cache (s, 0);
  1103. #endif /* HAVE_X_WINDOWS */
  1104.     }
  1105.   else if (EQ (attr_name, intern ("foreground")))
  1106.     {
  1107. #ifdef HAVE_X_WINDOWS
  1108.       unsigned long new_pixel;
  1109.       if (magic_p)
  1110.     error ("can't set the colors of the `normal' or `modeline' faces to nil.");
  1111.       new_pixel = load_pixel (s, attr_value);
  1112.       unload_pixel (s, face->foreground);
  1113.       face->foreground = new_pixel;
  1114.       invalidate_face_cache (s, 0);
  1115.       if (id == 0) /* the "default" face; update the ScreenWidget as well */
  1116.     {       /* Possibly this isn't necessary for "foreground". */
  1117.       Arg av[10];
  1118.       int ac = 0;
  1119.       XtSetArg (av[ac], XtNforeground, new_pixel); ac++;
  1120.       BLOCK_INPUT;
  1121.       XtSetValues (s->display.x->edit_widget, av, ac);
  1122.       UNBLOCK_INPUT;
  1123.     }
  1124. #endif /* HAVE_X_WINDOWS */
  1125.     }
  1126.   else if (EQ (attr_name, intern ("background")))
  1127.     {
  1128. #ifdef HAVE_X_WINDOWS
  1129.       unsigned long new_pixel;
  1130.       if (magic_p)
  1131.     error ("can't set the colors of the `normal' or `modeline' faces to nil.");
  1132.       new_pixel = load_pixel (s, attr_value);
  1133.       unload_pixel (s, face->background);
  1134.       face->background = new_pixel;
  1135.       invalidate_face_cache (s, 0);
  1136.       if (id == 0) /* the "default" face; update the ScreenWidget as well */
  1137.     {
  1138.       Arg av[10];
  1139.       int ac = 0;
  1140.       XtSetArg (av[ac], XtNbackground, new_pixel); ac++;
  1141.       BLOCK_INPUT;
  1142.       XtSetValues (s->display.x->edit_widget, av, ac);
  1143.       UNBLOCK_INPUT;
  1144.     }
  1145. #endif /* HAVE_X_WINDOWS */
  1146.     }
  1147.   else if (EQ (attr_name, intern ("background-pixmap")))
  1148.     {
  1149. #ifdef HAVE_X_WINDOWS
  1150.       unsigned int w, h, d;
  1151.       unsigned long new_pixmap = load_pixmap (s, attr_value, &w, &h, &d, 0);
  1152.       unload_pixmap (s, face->back_pixmap);
  1153.       if (magic_p) new_pixmap = 0;
  1154.       face->back_pixmap = new_pixmap;
  1155.       face->pixmap_w = w;
  1156.       face->pixmap_h = h;
  1157. /*      face->pixmap_depth = d; */
  1158.       invalidate_face_cache (s, 0);
  1159. #endif /* HAVE_X_WINDOWS */
  1160.     }
  1161.   else if (EQ (attr_name, intern ("underline")))
  1162.     {
  1163.       int new = !NILP (attr_value);
  1164.       if (face->underline != new)
  1165.     invalidate_face_cache (s, 0);
  1166.       face->underline = new;
  1167.     }
  1168.   else
  1169.     return Fsignal (Qerror, Fcons (build_string ("unknown face attribute"),
  1170.                    Fcons (attr_name, Qnil)));
  1171.   return Qnil;
  1172. }
  1173.  
  1174.  
  1175.  
  1176. void
  1177. syms_of_faces ()
  1178. {
  1179.   face_cache_invalid = 0;
  1180.   face_cache_pending_flush = 0;
  1181.   defsubr (&Sscreen_face_alist);
  1182.   defsubr (&Sset_screen_face_alist);
  1183.   defsubr (&Smake_face_internal);
  1184.   defsubr (&Sset_face_attribute_internal);
  1185.  
  1186.   DEFVAR_INT ("mouse-highlight-priority", &mouse_highlight_priority,
  1187. "The priority to use for the mouse-highlighting pseudo-extent\n\
  1188. that is used to highlight extents with the `highlight' attribute set.\n\
  1189. See `set-extent-priority'.");
  1190.   mouse_highlight_priority = 10;
  1191. }
  1192.