summaryrefslogtreecommitdiffstats
path: root/x.c
diff options
context:
space:
mode:
authorLaMont Jones <lamont@debian.org>2003-05-07 08:36:40 -0600
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:27 -0800
commite21d47d7813159bb71e0671df9b52ec0470c358d (patch)
tree3c7770ea846123c291f599044e9f234ac17616bb /x.c
parent8cfce36c6a4fc2e0a0ab6ef2db66a23cbe462693 (diff)
parentdeda2c0fd8689349fea2a900199a76ff7ecb319e (diff)
downloadscm-e21d47d7813159bb71e0671df9b52ec0470c358d.tar.gz
scm-e21d47d7813159bb71e0671df9b52ec0470c358d.zip
Import Debian changes 5d6-3.2debian/5d6-3.2
scm (5d6-3.2) unstable; urgency=low * Fix hppa compile. Closes: #144062 scm (5d6-3.1) unstable; urgency=low * NMU with patch from James Troup, to fix FTBFS on sparc. Closes: #191171 scm (5d6-3) unstable; urgency=low * Add build depend on xlibs-dev (Closes: #148020) scm (5d6-2) unstable; urgency=low * Remove libregexx-dev from build-depends. * Change build to use ./scmlit rather than scmlit (should fix some build problems) (looks like alpha is mostly building) * New release (Closes: #140175) * Built with turtlegraphics last time (Closes: #58515) scm (5d6-1) unstable; urgency=low * New upstream. * Add xlib and turtlegr to requested list of features. (closes some bug) * Make clean actually clean most everything up. * Remove hacks renaming build to something else and just set build as a .PHONY target in debian/rules. * Add the turtlegr code. scm (5d5-1) unstable; urgency=low * New upstream * Has fixes for 64 bit archs. May fix alpha compile problem. Does fix (Closes: #140175) * Take out -O2 arg. scm (5d4-3) unstable; urgency=low * Don't link with regexx, but just use libc6's regular expression functions. * Define (terms) to output /usr/share/common-licenses/GPL (Closes: #119321) scm (5d4-2) unstable; urgency=low * Add texinfo to build depends (Closes: #107011) scm (5d4-1) unstable; urgency=low * New upstream release. * Move install-info --remove to prerm. scm (5d3-5) unstable; urgency=low * Move scm info files to section "The Algorithmic Language Scheme" to match up with guile. scm (5d3-4) unstable; urgency=low * Fix build depends (Closes: #76691) scm (5d3-3) unstable; urgency=low * Fix path in scm dhelp file. scm (5d3-2) unstable; urgency=low * Actually put the header files in the package. Oops. scm (5d3-1) unstable; urgency=low * New upstream. (Closes: #74761) * Make (terms) use new license location. * Make use libregexx rather than librx. * Fix build depends for above. * Using new regex lib seems to fix crash (Closes: #66787) * Consider adding scm-dev package with headers, but instead just add the headers to the scm package. (Closes: #70787) * Add doc-base support.
Diffstat (limited to 'x.c')
-rw-r--r--x.c540
1 files changed, 494 insertions, 46 deletions
diff --git a/x.c b/x.c
index 6070ef2..8b3a53c 100644
--- a/x.c
+++ b/x.c
@@ -15,26 +15,26 @@
* the Free Software Foundation, 59 Temple Place, Suite 330, Boston, MA 02111, USA.
*
* As a special exception, the Free Software Foundation gives permission
- * for additional uses of the text contained in its release of GUILE.
+ * for additional uses of the text contained in its release of SCM.
*
- * The exception is that, if you link the GUILE library with other files
+ * The exception is that, if you link the SCM library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
- * linking the GUILE library code into it.
+ * linking the SCM library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
- * Free Software Foundation under the name GUILE. If you copy
+ * Free Software Foundation under the name SCM. If you copy
* code from other Free Software Foundation releases into a copy of
- * GUILE, as the General Public License permits, the exception does
+ * SCM, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
- * If you write modifications of your own for GUILE, it is your choice
+ * If you write modifications of your own for SCM, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
@@ -57,7 +57,10 @@
#include <stdio.h>
#include <X11/X.h>
#include <X11/Xlib.h>
+#include <X11/Xcms.h>
+/*#include <X11/Xcmsint.h>*/ /* For IntensityTbl */
#include <X11/Xutil.h>
+#include <X11/Xatom.h>
#include "scm.h"
@@ -150,9 +153,12 @@ struct display_screen{
#define XCOLORMAP(x) (COLORMAP(x)->cm)
#define XGCONDISPLAY(x) (GCONTEXT(x)->dpy)
-/* Notice that types Visual and XEvent don't have struct wrappers. */
+/* Notice that types XVisualInfo, XcmsCCC, and XEvent don't have
+ struct wrappers. */
-#define XVISUAL(x) ((Visual *) CDR(x))
+#define XVISUALINFO(x) ((XVisualInfo *) CDR(x))
+#define XVISUAL(x) (XVISUALINFO(x)->visual)
+#define XCCC(x) ((XcmsCCC) CDR(x))
#define XEVENT(x) ((XEvent *) CDR(x))
/* Type predicates */
@@ -163,6 +169,7 @@ struct display_screen{
#define OPWINDOWP(x) (((0xffff | OPN) & (int)CAR(x))==(tc16_xwindow | OPN))
#define COLORMAPP(x) (TYP16(x)==tc16_xcolormap)
#define GCONTEXTP(x) (TYP16(x)==tc16_xgcontext)
+#define CCCP(x) (TYP16(x)==tc16_xccc)
#define CURSORP(x) (TYP16(x)==tc16_xcursor)
#define FONTP(x) (TYP16(x)==tc16_xfont)
#define VISUALP(x) (TYP16(x)==tc16_xvisual)
@@ -178,13 +185,16 @@ static char s_x_root_window[] = "x:root-window";
static char s_x_default_gcontext[] = "x:default-gc";
static char s_x_default_visual[] = "x:default-visual";
static char s_x_default_colormap[] = "x:default-colormap";
+static char s_x_default_ccc[] = "x:default-ccc";
+/* static char s_x_ccc_screen_info[] = "x:ccc-screen-info"; */
static char s_x_create_window[] = "x:create-window";
static char s_x_window_set[] = "x:window-set!";
-/* static char s_x_window_ref[] = "x:window-ref"; */
+static char s_x_window_ref[] = "x:window-ref";
static char s_x_create_pixmap[] = "x:create-pixmap";
+static char s_x_get_window_property[] = "x:get-window-property";
+static char s_x_list_properties[] = "x:list-properties";
static char s_x_map_window[] = "x:map-window";
-static char s_x_map_raised[] = "x:map-raised";
static char s_x_map_subwindows[] = "x:map-subwindows";
static char s_x_unmap_window[] = "x:unmap-window";
static char s_x_unmap_subwindows[] = "x:unmap-subwindows";
@@ -215,7 +225,10 @@ static char s_x_screen_dimm[] = "x:screen-dimensions";
static char s_x_screen_white[] = "x:screen-white";
static char s_x_screen_black[] = "x:screen-black";
static char s_x_make_visual[] = "x:make-visual";
+static char s_x_visual_class[] = "x:visual-class";
+static char s_x_visual_geometry[] = "x:visual-geometry";
static char s_x_window_geometry[] = "x:window-geometry";
+static char s_x_window_geometry_set[] = "x:window-geometry-set!";
static char s_x_create_colormap[] = "x:create-colormap";
static char s_x_recreate_colormap[] = "x:copy-colormap-and-free";
@@ -225,6 +238,8 @@ static char s_x_find_color[] = "x:colormap-find-color";
static char s_x_color_set[] = "x:colormap-set!";
static char s_x_color_ref[] = "x:colormap-ref";
static char s_x_install_colormap[] = "x:install-colormap";
+/* static char s_x_colormap_basis[] = "x:colormap-basis"; */
+/* static char s_x_colormap_limits[] = "x:colormap-limits"; */
static char s_x_clear_area[] = "x:clear-area";
static char s_x_fill_rectangle[] = "x:fill-rectangle";
@@ -238,6 +253,7 @@ static char s_x_image_string[] = "x:image-string";
static char s_x_flush[] = "x:flush";
static char s_x_event_ref[] = "x:event-ref";
+static char s_x_event_keysym[] = "x:event->keysym";
/* Type-name strings */
@@ -247,6 +263,7 @@ static char s_gc[] = "graphics-context";
#define s_cursor (&s_x_create_cursor[9])
#define s_font (&s_x_load_font[7])
#define s_colormap (&s_x_create_colormap[9])
+#define s_visual (&s_x_make_visual[7])
/* Scheme (SMOB) types defined in this module */
@@ -258,6 +275,8 @@ long tc16_xcursor;
long tc16_xfont;
long tc16_xvisual;
long tc16_xevent;
+long tc16_xccc;
+XContext xtc_ccc, xtc_cmp;
/* We use OPN (which is already defined and used for PTOB ports) to
keep track of whether objects of types Display and Window are open.
@@ -327,6 +346,9 @@ SCM make_xcolormap(sdpy, cmp)
{
SCM z;
struct xs_Colormap *xcm;
+ XPointer scmptr;
+ if (!XFindContext(XDISPLAY(sdpy), (XID)cmp, xtc_cmp, &scmptr))
+ return (SCM)scmptr;
DEFER_INTS;
z = must_malloc_cell((long)sizeof(struct xs_Colormap),
(SCM)tc16_xcolormap,
@@ -335,14 +357,18 @@ SCM make_xcolormap(sdpy, cmp)
xcm->display = sdpy;
xcm->dpy = DISPLAY(xcm->display)->dpy;
xcm->cm = cmp;
+ XSaveContext(XDISPLAY(sdpy), (XID)cmp, xtc_cmp, z);
ALLOW_INTS;
return z;
}
static SCM mark_xcolormap(ptr)
SCM ptr;
{
+ struct xs_Colormap *xcm;
if CLOSEDP(ptr) return BOOL_F;
- return COLORMAP(ptr)->display;
+ xcm = COLORMAP(ptr);
+ gc_mark(CCC2SCM_P(XcmsCCCOfColormap(xcm->dpy, xcm->cm)));
+ return xcm->display;
}
static sizet free_xcolormap(ptr)
CELLPTR ptr;
@@ -385,10 +411,10 @@ SCM make_xdisplay(d)
make_xwindow(z, idx, RootWindow(d, idx), (char) 0, (char) 1);
scrns[idx].default_gcontext =
make_xgcontext(z, idx, XDefaultGC(d, idx), !0);
+ scrns[idx].default_visual =
+ make_xvisual(visual2visualinfo(d, DefaultVisual(d, idx)));
scrns[idx].default_colormap =
make_xcolormap(z, DefaultColormap(d, idx));
- scrns[idx].default_visual =
- make_xvisual(DefaultVisual(d, idx));
}
return z;
}
@@ -401,10 +427,12 @@ static SCM mark_xdisplay(ptr)
struct xs_screen *scrns = (struct xs_screen *)(xsd + 1);
int idx = xsd->screen_count;
while (--idx) {
+ SCM scmp = scrns[idx].default_colormap;
gc_mark(scrns[idx].root_window);
gc_mark(scrns[idx].default_gcontext);
gc_mark(scrns[idx].default_visual);
- gc_mark(scrns[idx].default_colormap);
+ gc_mark(scmp);
+ gc_mark (CCC2SCM_P(XcmsCCCOfColormap(xsd->dpy, XCOLORMAP(scmp))));
}
gc_mark(scrns[idx].root_window);
gc_mark(scrns[idx].default_gcontext);
@@ -549,7 +577,7 @@ static sizet free_xfont(ptr)
}
SCM make_xvisual(vsl)
- Visual *vsl;
+ XVisualInfo *vsl;
{
SCM s_vsl;
NEWCELL(s_vsl);
@@ -560,6 +588,37 @@ SCM make_xvisual(vsl)
return s_vsl;
}
+SCM CCC2SCM_P(ccc)
+ XcmsCCC ccc;
+{
+ XPointer scmptr;
+ if (XFindContext(ccc->dpy, (XID)ccc, xtc_ccc, &scmptr))
+ return BOOL_F;
+ return (SCM)scmptr;
+}
+SCM CCC2SCM(ccc)
+ XcmsCCC ccc;
+{
+ SCM s_ccc = CCC2SCM_P(ccc);
+ if FALSEP(s_ccc) {
+ NEWCELL(s_ccc);
+ DEFER_INTS;
+ CAR(s_ccc) = tc16_xccc;
+ SETCDR(s_ccc, ccc);
+ XSaveContext(ccc->dpy, (XID)ccc, xtc_ccc, s_ccc);
+ ALLOW_INTS;
+ }
+ return s_ccc;
+}
+static sizet free_xccc(ptr)
+ CELLPTR ptr;
+{
+ XcmsCCC ccc = XCCC((SCM)ptr);
+ XDeleteContext(ccc->dpy, (XID)ccc, xtc_ccc);
+ XcmsFreeCCC(ccc);
+ return 0;
+}
+
SCM make_xevent(e)
XEvent *e;
{
@@ -571,7 +630,7 @@ XEvent *e;
NEWCELL(w);
DEFER_INTS;
CAR(w) = tc16_xevent;
- SETCDR(w,ec);
+ SETCDR(w, ec);
ALLOW_INTS;
return w;
}
@@ -683,7 +742,7 @@ int scm2xpointslen(sara, s_caller)
&& (1==adm[1].inc)
&& ARRAY_CONTP(sara)
&& (tc7_svect==TYP7(ARRAY_V(sara))))) return -1;
- len = adm[0].ubnd - adm[0].lbnd;
+ len = 1 + adm[0].ubnd - adm[0].lbnd;
if (len < 0) return 0;
return len;
}
@@ -719,7 +778,7 @@ SCM thevalue(obj)
SCM obj;
{
if (NIMP(obj) && SYMBOLP(obj))
- return ceval(obj, (SCM)EOL);
+ return ceval(obj, (SCM)EOL, (SCM)EOL);
else return obj;
}
@@ -780,15 +839,16 @@ int theuint(obj, s_caller)
return INUM(val);
}
-static int args2xgcvalmask(oargs)
+static int args2valmask(oargs, s_caller)
SCM oargs;
+ char *s_caller;
{
SCM args = oargs;
int attr, len, attr_mask = 0;
if (!(len = ilength(args))) return 0;
while (len) {
- ASSERT(NIMP(args), oargs, WNA, s_gc);
- attr = theint(CAR(args), s_gc); args = CDR(args);
+ ASSERT(NIMP(args), oargs, WNA, s_caller);
+ attr = theint(CAR(args), s_caller); args = CDR(args);
attr_mask |= attr;
len -= 1;
}
@@ -904,6 +964,36 @@ static int args2winattribs(vlu, oargs)
}
return attr_mask;
}
+static int args2wincfgs(vlu, oargs)
+ XWindowChanges *vlu;
+ SCM oargs;
+{
+ SCM sval, args = oargs;
+ int cfgs, len, cfgs_mask = 0;
+ /* (void)memset((char *)vlu, 0, sizeof(XWindowChanges)); */
+ if (!(len = ilength(args))) return 0;
+ ASSERT(len > 0 && (! (len & 1)), oargs, WNA, s_window);
+ while (len) {
+ ASSERT(NIMP(args), oargs, WNA, s_window);
+ cfgs = theint(CAR(args), s_window); args = CDR(args);
+ ASSERT(NIMP(args), oargs, WNA, s_window);
+ sval = CAR(args); args = CDR(args);
+ cfgs_mask |= cfgs;
+ switch (cfgs) {
+
+ case CWX: vlu->x = theuint(sval, s_window); break;
+ case CWY: vlu->y = theuint(sval, s_window); break;
+ case CWWidth: vlu->width = theuint(sval, s_window); break;
+ case CWHeight: vlu->height = theuint(sval, s_window); break;
+ case CWBorderWidth: vlu->border_width = theuint(sval, s_window); break;
+ case CWSibling: vlu->sibling =thepxmap(sval, s_window); break;
+ case CWStackMode: vlu->stack_mode = theint(sval, s_window); break;
+ default: ASSERT(0, MAKINUM(cfgs), ARGn, s_window);
+ }
+ len -= 2;
+ }
+ return cfgs_mask;
+}
/* Scheme-visible procedures */
@@ -1012,6 +1102,47 @@ SCM x_create_pixmap(obj, s_size, s_depth)
p = XCreatePixmap(dpy, drawable, size.x, size.y, depth);
return make_xwindow(display, scn, p, (char) 1, (char) 0);
}
+SCM x_window_ref(oargs)
+ SCM oargs;
+{
+ SCM swn, args = oargs, sval = BOOL_F;
+ SCM vals = cons(BOOL_T, EOL), valend = vals;
+ struct xs_Window *xwn;
+ XWindowAttributes vlu;
+ int attr, len = ilength(args);
+ /* (void)memset((char *)&vlu, 0, sizeof(XWindowAttributes)); */
+ ASSERT(len > 0, oargs, WNA, s_x_window_ref);
+ if (1==len--) return EOL;
+ swn = CAR(args); args = CDR(args);
+ ASSERT(NIMP(swn) && WINDOWP(swn), swn, ARG1, s_x_window_ref);
+ xwn = WINDOW(swn);
+ if (!XGetWindowAttributes(xwn->dpy, xwn->p.win, &vlu)) return BOOL_F;
+ while (len) {
+ attr = theint(CAR(args), s_x_window_ref); args = CDR(args);
+ switch (attr) {
+
+ case CWBackPixel: sval = MAKINUM(vlu.backing_pixel); break;
+ case CWBitGravity: sval = MAKINUM(vlu.bit_gravity); break;
+ case CWWinGravity: sval = MAKINUM(vlu.win_gravity); break;
+ case CWBackingStore: sval = MAKINUM(vlu.backing_store); break;
+ case CWBackingPlanes:sval = MAKINUM(vlu.backing_planes); break;
+ case CWBackingPixel: sval = MAKINUM(vlu.backing_pixel); break;
+ case CWOverrideRedirect:sval = x_make_bool(vlu.override_redirect); break;
+ case CWSaveUnder: sval = x_make_bool(vlu.save_under); break;
+ case CWEventMask: sval = MAKINUM(vlu.your_event_mask); break;
+ case CWDontPropagate:sval = MAKINUM(vlu.do_not_propagate_mask); break;
+ case CWColormap: sval = make_xcolormap(xwn->display, vlu.colormap); break;
+
+ default: ASSERT(0, MAKINUM(attr), ARGn, s_x_window_ref);
+ }
+ CAR(valend) = sval;
+ CDR(valend) = cons(BOOL_T, EOL);
+ len -= 1;
+ if (len) valend = CDR(valend);
+ else CDR(valend) = EOL;
+ }
+ return vals;
+}
SCM x_window_set(args)
SCM args;
{
@@ -1047,6 +1178,22 @@ SCM x_window_geometry(swin)
cons2(MAKINUM(w), MAKINUM(h), EOL),
cons2(MAKINUM(border_width), MAKINUM(depth), EOL));
}
+SCM x_window_geometry_set(args)
+ SCM args;
+{
+ SCM swn;
+ struct xs_Window *xwn;
+ XWindowChanges vlu;
+ unsigned long mask;
+
+ ASSERT(NIMP(args), args, WNA, s_x_window_geometry_set);
+ swn = CAR(args); args = CDR(args);
+ ASSERT(NIMP(swn) && WINDOWP(swn), swn, ARG1, s_x_window_geometry_set);
+ xwn = WINDOW(swn);
+ mask = args2wincfgs(&vlu, args);
+ XConfigureWindow(xwn->dpy, xwn->p.win, mask, &vlu);
+ return UNSPECIFIED;
+}
SCM x_close(obj)
SCM obj;
@@ -1121,6 +1268,25 @@ SCM x_install_colormap(s_cm, s_flg)
XInstallColormap(XDISPLAY(xcm->display), xcm->cm);
return UNSPECIFIED;
}
+/* SCM x_colormap_basis(svsl) */
+/* SCM svsl; */
+/* { */
+/* XColormapInfo *vsl; */
+/* ASSERT(NIMP(svsl) && COLORMAPP(svsl), svsl, ARG1, s_x_colormap_basis); */
+/* vsl = XCOLORMAPINFO(svsl); */
+/* return cons2(vsl->red_mult, vsl->green_mult, */
+/* cons2(vsl->blue_mult, vsl->base_pixel, EOL)); */
+/* } */
+/* SCM x_colormap_limits(svsl) */
+/* SCM svsl; */
+/* { */
+/* XColormapInfo *vsl; */
+/* ASSERT(NIMP(svsl) && COLORMAPP(svsl), svsl, ARG1, s_x_colormap_limits); */
+/* vsl = XCOLORMAPINFO(svsl); */
+/* return cons2(vsl->red_mult, vsl->green_mult, */
+/* cons2(vsl->blue_mult, vsl->base_pixel, EOL)); */
+/* } */
+
/* Colors in Colormap */
SCM x_alloc_color_cells(scmap, spxls, sargs)
@@ -1246,15 +1412,6 @@ SCM x_map_window(swin)
XMapWindow(w->dpy, w->p.win);
return UNSPECIFIED;
}
-SCM x_map_raised(swin)
- SCM swin;
-{
- struct xs_Window *w;
- ASSERT(NIMP(swin) && WINDOWP(swin), swin, ARG1, s_x_map_raised);
- w = WINDOW(swin);
- XMapRaised(w->dpy, w->p.win);
- return UNSPECIFIED;
-}
SCM x_map_subwindows(swin)
SCM swin;
{
@@ -1332,7 +1489,7 @@ SCM x_copy_gc(dst, src, args)
ASSERT(NIMP(src) && GCONTEXTP(src), src, ARG2, s_x_copy_gc);
dgc = GCONTEXT(dst);
sgc = GCONTEXT(src);
- mask = args2xgcvalmask(args);
+ mask = args2valmask(args, s_gc);
XCopyGC(dgc->dpy, sgc->gc, mask, dgc->gc);
return UNSPECIFIED;
}
@@ -1349,8 +1506,9 @@ SCM x_gc_ref(oargs)
ASSERT(len > 0, oargs, WNA, s_x_gc_ref);
if (1==len--) return EOL;
sgc = CAR(args); args = CDR(args);
+ ASSERT(NIMP(sgc) && GCONTEXTP(sgc), sgc, ARG1, s_x_gc_ref);
xgc = GCONTEXT(sgc);
- valuemask = args2xgcvalmask(args);
+ valuemask = args2valmask(args, s_gc);
/* printf("valuemask = %lx\n", valuemask); */
valuemask &= (GCFunction | GCPlaneMask | GCForeground | GCBackground |
GCLineWidth | GCLineStyle | GCCapStyle | GCJoinStyle |
@@ -1399,8 +1557,9 @@ SCM x_gc_ref(oargs)
}
CAR(valend) = sval;
CDR(valend) = cons(BOOL_T, EOL);
- valend = CDR(valend);
len -= 1;
+ if (len) valend = CDR(valend);
+ else CDR(valend) = EOL;
}
return vals;
}
@@ -1575,6 +1734,8 @@ SCM x_screen_depth(sd, si)
SCM sd, si;
{
struct display_screen dspscn;
+ if (UNBNDP(si) && NIMP(sd) && VISUALP(sd))
+ return MAKINUM(XVISUALINFO(sd)->depth);
scm2display_screen(sd, si, &dspscn, s_x_screen_depth);
return MAKINUM(DisplayPlanes(dspscn.dpy, dspscn.screen_number));
}
@@ -1630,20 +1791,65 @@ SCM x_screen_white(sd, si)
return ulong2num(WhitePixelOfScreen(scn));
}
+XVisualInfo *visual2visualinfo(dsp, vis)
+ Display *dsp;
+ Visual *vis;
+{
+ int nitems_return;
+ XVisualInfo vinfo_template;
+ XVisualInfo *vislst;
+ vinfo_template.visualid = XVisualIDFromVisual(vis);
+ vislst = XGetVisualInfo(dsp, VisualIDMask, &vinfo_template, &nitems_return);
+ if (1 != nitems_return) {
+ if (vislst) XFree(vislst);
+ wta(MAKINUM(nitems_return), (char *)WNA, s_visual);
+ }
+ return vislst;
+}
SCM x_make_visual(sd, sdepth, sclass)
SCM sd, sdepth, sclass;
{
+ int nitems_return;
struct display_screen dspscn;
- XVisualInfo vis;
- Status sts;
+ XVisualInfo vinfo_template;
+ XVisualInfo *vislst;
scm2display_screen(sd, UNDEFINED, &dspscn, s_x_make_visual);
- sts = XMatchVisualInfo(dspscn.dpy, dspscn.screen_number,
- theuint(sdepth, s_x_make_visual),
- theuint(sclass, s_x_make_visual),
- &vis);
- if (!sts) return BOOL_F;
- return make_xvisual(vis.visual);
+ vinfo_template.screen = dspscn.screen_number;
+ vinfo_template.depth = theuint(sdepth, s_x_make_visual);
+ vinfo_template.class = theuint(sclass, s_x_make_visual);
+ vislst =
+ XGetVisualInfo(dspscn.dpy,
+ VisualScreenMask | VisualDepthMask | VisualClassMask,
+ &vinfo_template,
+ &nitems_return);
+ if (0==nitems_return) return BOOL_F;
+ return make_xvisual(vislst);
+}
+static sizet free_visual(ptr)
+ CELLPTR ptr;
+{
+ XFree(XVISUALINFO(ptr));
+ return 0;
+}
+SCM x_visual_geometry(svsl)
+ SCM svsl;
+{
+ XVisualInfo *vsl;
+ ASSERT(NIMP(svsl) && VISUALP(svsl), svsl, ARG1, s_x_visual_geometry);
+ vsl = XVISUALINFO(svsl);
+ return cons2(MAKINUM(vsl->red_mask), MAKINUM(vsl->green_mask),
+ cons2(MAKINUM(vsl->blue_mask), MAKINUM(vsl->colormap_size),
+ EOL));
+}
+SCM x_visual_class(svsl)
+ SCM svsl;
+{
+ XVisualInfo *vsl;
+ ASSERT(NIMP(svsl) && VISUALP(svsl), svsl, ARG1, s_x_visual_class);
+ vsl = XVISUALINFO(svsl);
+ return MAKINUM(vsl->class);
}
+
SCM x_root_window(sdpy, sscr)
SCM sdpy, sscr;
{
@@ -1688,6 +1894,151 @@ SCM x_default_visual(sdpy, sscr)
scrns = (struct xs_screen *)(xsd + 1);
return scrns[dspscn.screen_number].default_visual;
}
+SCM x_default_ccc(sdpy, sscr)
+ SCM sdpy, sscr;
+{
+ struct display_screen dspscn;
+ XcmsCCC ccc;
+ if (NIMP(sdpy) && COLORMAPP(sdpy) && UNBNDP(sscr)) {
+ struct xs_Colormap *cmp = COLORMAP(sdpy);
+ ccc = XcmsCCCOfColormap(cmp->dpy, cmp->cm);
+ }
+ else {
+ scm2display_screen(sdpy, sscr, &dspscn, s_x_default_ccc);
+ ccc = XcmsDefaultCCC(dspscn.dpy, dspscn.screen_number);
+ }
+ return CCC2SCM(ccc);
+}
+/*
+SCM x_ccc_screen_info(sccc, sfmt)
+ SCM sccc;
+ SCM sfmt;
+{
+ XcmsCCC xccc;
+ XcmsPerScrnInfo *pPerScrnInfo;
+ ASSERT(NIMP(sccc) && CCCP(sccc), sccc, ARG1, s_x_ccc_screen_info);
+ ASSERT(NIMP(sfmt) && STRINGP(sfmt), sfmt, ARG2, s_x_ccc_screen_info);
+ xccc = XCCC(sccc);
+ pPerScrnInfo = (XcmsFunctionSet *)xccc->pPerScrnInfo;
+ return ;
+}
+*/
+ /* Window Information */
+
+SCM x_propdata2scm(type, format, nitems, data)
+ Atom type;
+ int format;
+ unsigned long nitems;
+ unsigned char* data;
+{
+ SCM datum = EOL;
+ SCM lst = EOL;
+ int cnt;
+ for (cnt = nitems; cnt--;) {
+ switch (type) {
+ case XA_ATOM:
+ case XA_VISUALID:
+ case XA_CARDINAL:
+ switch (format) {
+ case 8: datum = MAKINUM(((unsigned char *)data)[cnt]); break;
+ case 16: datum = MAKINUM(((unsigned short *)data)[cnt]); break;
+ case 32: datum = ulong2num(((unsigned long *)data)[cnt]); break;
+ default: return MAKINUM(format);
+ } break;
+ case XA_INTEGER:
+ switch (format) {
+ case 8: datum = MAKINUM(((char *)data)[cnt]); break;
+ case 16: datum = MAKINUM(((short *)data)[cnt]); break;
+ case 32: datum = long2num(((long *)data)[cnt]); break;
+ default: return MAKINUM(format);
+ } break;
+ case XA_STRING:
+ switch (format) {
+ case 8: return makfrom0str(data);
+ default: return MAKINUM(format);
+ } break;
+ case XA_ARC:
+ case XA_BITMAP:
+ case XA_COLORMAP:
+ case XA_CURSOR:
+ case XA_DRAWABLE:
+ case XA_FONT:
+ case XA_PIXMAP:
+ case XA_POINT:
+ case XA_RECTANGLE:
+ case XA_RGB_COLOR_MAP:
+ case XA_WINDOW:
+ case XA_WM_HINTS:
+ case XA_WM_SIZE_HINTS:
+ default:
+ /* datum = BOOL_F; */
+ return MAKINUM(-type);
+ }
+ lst = cons(datum, lst);
+ }
+ return lst;
+}
+SCM x_get_window_property(swin, sprop, sargs)
+ SCM swin, sprop, sargs;
+{
+ struct xs_Window *xwn;
+ Atom property;
+ Atom actual_type_return;
+ int actual_format_return;
+ unsigned long nitems_return;
+ unsigned long bytes_after_return;
+ unsigned char *prop_return;
+ int sarglen = ilength(sargs);
+ ASSERT(IMP(sprop) ? INUMP(sprop) : STRINGP(sprop),
+ sprop, ARG2, s_x_get_window_property);
+ ASSERT(sarglen >= 0 && sarglen < 2, sargs, WNA, s_x_get_window_property);
+ if (1 == sarglen) {
+ ASSERT(NFALSEP(booleanp(CAR(sargs))), sargs, ARG3, s_x_get_window_property);
+ }
+ ASSERT(NIMP(swin) && WINDOWP(swin), swin, ARG1, s_x_map_window);
+ xwn = WINDOW(swin);
+ if (INUMP(sprop))
+ property = INUM(sprop);
+ else
+ property = XInternAtom(xwn->dpy, CHARS(sprop), !0);
+
+ if (None == property) return BOOL_F;
+ if (XGetWindowProperty(xwn->dpy, xwn->p.win, property, 0L, 65536L,
+ (1 == sarglen) && NFALSEP(CAR(sargs)), AnyPropertyType,
+ &actual_type_return, &actual_format_return,
+ &nitems_return, &bytes_after_return,
+ &prop_return)
+ != Success)
+ return BOOL_F;
+ {
+ SCM ans = x_propdata2scm(actual_type_return, actual_format_return,
+ nitems_return, prop_return);
+ XFree(prop_return);
+ return ans;
+ }
+}
+SCM x_list_properties(swin)
+ SCM swin;
+{
+ struct xs_Window *xwn;
+ Atom *atoms;
+ int num_prop_return;
+ SCM lst;
+ ASSERT(NIMP(swin) && WINDOWP(swin), swin, ARG1, s_x_map_window);
+ xwn = WINDOW(swin);
+ atoms = XListProperties(xwn->dpy, xwn->p.win, &num_prop_return);
+ {
+ int i = num_prop_return;
+ lst = EOL;
+ while (i--) {
+ char *name = XGetAtomName(xwn->dpy, atoms[i]);
+ lst = cons(makfrom0str(name), lst);
+ XFree(name);
+ }
+ }
+ XFree(atoms);
+ return lst;
+}
/* Rendering */
@@ -1856,6 +2207,24 @@ SCM x_fill_poly(sdbl, sgc, sargs)
return xldraw_lines(sdbl, sgc, sargs, 2, s_x_fill_poly);
}
+static char s_x_read_bitmap_file[] = "x:read-bitmap-file";
+SCM x_read_bitmap_file(sdbl, sfname)
+ SCM sdbl, sfname;
+{
+ unsigned int w, h;
+ int x, y;
+ Pixmap pxmp;
+ ASSERT(NIMP(sdbl) && WINDOWP(sdbl), sdbl, ARG1, s_x_read_bitmap_file);
+ if (XReadBitmapFile(XWINDISPLAY(sdbl),
+ WINDOW(sdbl)->p.pm,
+ CHARS(sfname),
+ &w, &h, &pxmp, &x, &y) == BitmapSuccess)
+ return make_xwindow(WINDOW(sdbl)->display,
+ WINDOW(sdbl)->screen_number,
+ pxmp, (char) 1, (char) 0);
+ else return BOOL_F;
+}
+
/* XEvents */
/* x_make_bool() is used in xevent.h */
@@ -1895,6 +2264,26 @@ static char *x__event_name(type)
if (type==event_names[i].type) return event_names[i].name;
return "unknown";
}
+
+SCM x_event_keysym(sevent)
+ SCM sevent;
+{
+ XKeyEvent *ev;
+ KeySym ans;
+ ASRTGO(NIMP(sevent) && XEVENTP(sevent), badarg);
+ ev = (XKeyEvent *)CHARS(sevent);
+ switch (((XEvent*)ev)->type) {
+ badarg:
+ default: wta(sevent, (char *)ARG1, s_x_event_keysym);
+ case KeyPress:
+ case KeyRelease:
+ ;
+ }
+ ans = XLookupKeysym(ev, ev->state);
+ if (ans) return MAKINUM(ans);
+ else return BOOL_F;
+}
+
/* SMOB print routines */
static int print_xevent(exp, f, writing)
@@ -1972,13 +2361,56 @@ static int print_xgcontext(exp, f, writing)
lputc('>', f);
return 1;
}
+
+char *xvisualclass2name(class)
+ int class;
+{
+ switch (class) {
+ case StaticGray: return "StaticGray";
+ case GrayScale: return "GrayScale";
+ case StaticColor: return "StaticColor";
+ case PseudoColor: return "PseudoColor";
+ case TrueColor: return "TrueColor";
+ case DirectColor: return "DirectColor";
+ default: return "??";
+ }
+}
+
static int print_xvisual(exp, f, writing)
SCM exp;
SCM f;
int writing;
{
+ XVisualInfo *xvi = XVISUALINFO(exp);
lputs("#<X visual #x", f);
- intprint((long) XVisualIDFromVisual(XVISUAL(exp)), 16, f);
+ intprint((long) xvi->visualid, 16, f);
+ lputs(" ", f);
+ lputs(xvisualclass2name(xvi->class), f);
+ lputc(' ', f);
+ intprint((long) xvi->depth, 10, f);
+ lputc('x', f);
+ intprint((long) xvi->colormap_size, 10, f);
+ lputc('>', f);
+ return 1;
+}
+static int print_xccc(exp, f, writing)
+ SCM exp;
+ SCM f;
+ int writing;
+{
+ XcmsColorSpace **papColorSpaces;
+ XcmsCCC xccc = XCCC(exp);
+ lputs("#<X CCC", f);
+ papColorSpaces =
+ ((XcmsFunctionSet *)xccc->pPerScrnInfo->functionSet)->DDColorSpaces;
+ if (papColorSpaces != NULL) {
+ while (*papColorSpaces != NULL) {
+ lputs(" ", f);
+ lputs((*papColorSpaces)->prefix, f);
+ papColorSpaces++;
+ }
+ }
+
lputc('>', f);
return 1;
}
@@ -1989,7 +2421,8 @@ static smobfuns smob_xcursor = {mark_xcursor, free_xcursor, print_xcursor, 0};
static smobfuns smob_xfont = {mark_xfont, free_xfont, print_xfont, 0};
static smobfuns smob_xgcontext = {mark_xgcontext, free_xgcontext, print_xgcontext, 0};
static smobfuns smob_xcolormap = {mark_xcolormap, free_xcolormap, print_xcolormap, 0};
-static smobfuns smob_xvisual = {mark0, free0, print_xvisual, 0};
+static smobfuns smob_xvisual = {mark0, free_visual, print_xvisual, 0};
+static smobfuns smob_xccc = {mark0, free_xccc, print_xccc, 0};
static smobfuns smob_xevent = {mark0, x_free_xevent, print_xevent, 0};
static iproc x_subr3s[] = {
@@ -2005,6 +2438,7 @@ static iproc x_lsubr2s[] = {
{s_x_create_cursor, x_create_cursor},
{s_x_alloc_color_cells, x_alloc_color_cells},
{s_x_free_color_cells, x_free_color_cells},
+ {s_x_get_window_property, x_get_window_property},
{s_x_clear_area, x_clear_area},
{s_x_fill_rectangle, x_fill_rectangle},
{s_x_draw_string, x_draw_string},
@@ -2022,7 +2456,8 @@ static iproc x_lsubrs[] = {
{s_x_gc_ref, x_gc_ref},
{s_x_copy_gc, x_copy_gc},
{s_x_window_set, x_window_set},
-/* {s_x_window_ref, x_window_ref}, */
+ {s_x_window_geometry_set, x_window_geometry_set},
+ {s_x_window_ref, x_window_ref},
{0, 0}
};
@@ -2031,6 +2466,7 @@ static iproc x_subr2s[] = {
{s_x_find_color, x_find_color},
{s_x_color_ref, x_color_ref},
{s_x_load_font, x_load_font},
+ {s_x_read_bitmap_file, x_read_bitmap_file},
{0, 0}
};
@@ -2057,6 +2493,7 @@ static iproc x_subr2os[] = {
{s_x_default_visual, x_default_visual},
{s_x_default_colormap, x_default_colormap},
{s_x_install_colormap, x_install_colormap},
+ {s_x_default_ccc, x_default_ccc},
{s_x_flush, x_flush},
{0, 0}
};
@@ -2066,12 +2503,17 @@ static iproc x_subr1s[] = {
{s_x_close, x_close},
{s_x_default_screen, x_default_screen},
{s_x_window_geometry, x_window_geometry},
+ {s_x_list_properties, x_list_properties},
{s_x_map_window, x_map_window},
- {s_x_map_raised, x_map_raised},
{s_x_map_subwindows, x_map_subwindows},
{s_x_unmap_window, x_unmap_window},
{s_x_unmap_subwindows, x_unmap_subwindows},
{s_x_recreate_colormap, x_recreate_colormap},
+ {s_x_visual_geometry, x_visual_geometry},
+ {s_x_visual_class, x_visual_class},
+ {s_x_event_keysym, x_event_keysym},
+/* {s_x_colormap_basis, x_colormap_basis}, */
+/* {s_x_colormap_limits, x_colormap_limits}, */
{0, 0}
};
@@ -2099,10 +2541,16 @@ void init_x()
tc16_xgcontext = newsmob(&smob_xgcontext);
tc16_xvisual = newsmob(&smob_xvisual);
tc16_xevent = newsmob(&smob_xevent);
+ tc16_xccc = newsmob(&smob_xccc);
+ xtc_ccc = XUniqueContext();
+ xtc_cmp = XUniqueContext();
scm_ldprog("x11.scm");
scm_ldprog("xevent.scm");
- scm_ldstr("\
+ /* Redefines STRING */
+/* scm_ldprog("xatoms.scm"); */
+ scm_ldstr("\
+(define x:ccc x:default-ccc)\n\
(define x:GC-Clip-Origin (logior x:GC-Clip-X-Origin x:GC-Clip-Y-Origin))\n\
(define x:GC-Tile-Stip-Origin \n\
(logior x:GC-Tile-Stip-X-Origin x:GC-Tile-Stip-Y-Origin))\n\