diff options
Diffstat (limited to 'x.c')
| -rw-r--r-- | x.c | 540 |
1 files changed, 494 insertions, 46 deletions
@@ -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\ |