From 42c8c9b37ea7acdc4bd33666205c3d9cd09365ef Mon Sep 17 00:00:00 2001 From: frese Date: Wed, 22 Aug 2001 11:57:51 +0000 Subject: [PATCH] implemented for scheme48. --- c/xlib/client.c | 812 ++++++++++++++++++++++++++++-------------------- c/xlib/key.c | 229 ++++++-------- 2 files changed, 575 insertions(+), 466 deletions(-) diff --git a/c/xlib/client.c b/c/xlib/client.c index 68e1d65..4463b31 100644 --- a/c/xlib/client.c +++ b/c/xlib/client.c @@ -1,390 +1,532 @@ #include "xlib.h" +#include "scheme48.h" -static s48_value Sym_Wm_Hints, Sym_Size_Hints; - -static s48_value P_Iconify_Window (w, scr) s48_value w, scr; { - Check_Type (w, T_Window); - if (!XIconifyWindow (WINDOW(w)->dpy, WINDOW(w)->win, - Get_Screen_Number (WINDOW(w)->dpy, scr))) - Primitive_Error ("cannot iconify window"); - return Void; +s48_value scx_Iconify_Window (s48_value Xdisplay, s48_value w, s48_value scr) { + if (!XIconifyWindow (SCX_EXTRACT_DISPLAY(Xdisplay), + SCX_EXTRACT_WINDOW(w), + s48_extract_integer(scr))) + return S48_FALSE; + else + return S48_UNSPECIFIC; } -static s48_value P_Withdraw_Window (w, scr) s48_value w, scr; { - Check_Type (w, T_Window); - if (!XWithdrawWindow (WINDOW(w)->dpy, WINDOW(w)->win, - Get_Screen_Number (WINDOW(w)->dpy, scr))) - Primitive_Error ("cannot withdraw window"); - return Void; +s48_value scx_Withdraw_Window (s48_value Xdisplay, s48_value w, s48_value scr) { + if (!XWithdrawWindow (SCX_EXTRACT_DISPLAY(Xdisplay), + SCX_EXTRACT_WINDOW(w), + s48_extract_integer(scr))) + return S48_FALSE; + else + return S48_UNSPECIFIC; } -static s48_value P_Reconfigure_Wm_Window (w, scr, conf) s48_value w, scr, conf; { - unsigned long mask; +s48_value scx_Reconfigure_Wm_Window (s48_value dpy, s48_value w, s48_value scr, + s48_value conf) { + XWindowChanges WC; + unsigned long mask = AList_To_XWindowChanges(conf, &WC); - Check_Type (w, T_Window); - mask = Vector_To_Record (conf, Conf_Size, Sym_Conf, Conf_Rec); - if (!XReconfigureWMWindow (WINDOW(w)->dpy, WINDOW(w)->win, - Get_Screen_Number (WINDOW(w)->dpy, scr), mask, &WC)) - Primitive_Error ("cannot reconfigure window"); - return Void; + if (!XReconfigureWMWindow (SCX_EXTRACT_DISPLAY(dpy), + SCX_EXTRACT_WINDOW(w), + s48_extract_integer(scr), + mask, &WC)) + return S48_FALSE; + else + return S48_UNSPECIFIC; } -static s48_value P_Wm_Command (w) s48_value w; { +s48_value scx_Wm_Command (s48_value dpy, s48_value w) { int i, ac; - char **av; - s48_value s, ret, t; - S48_DECLARE_GC_PROTECT(2); + char** av; + s48_value ret; + S48_DECLARE_GC_PROTECT(1); - Check_Type (w, T_Window); - Disable_Interrupts; - if (!XGetCommand (WINDOW(w)->dpy, WINDOW(w)->win, &av, &ac)) + // Disable_Interrupts; + if (!XGetCommand (SCX_EXTRACT_DISPLAY(dpy), + SCX_EXTRACT_WINDOW(w), + &av, &ac)) ac = 0; - Enable_Interrupts; - ret = t = P_Make_List (s48_enter_integer (ac), S48_NULL); - S48_GC_PROTECT_2 (ret, t); - for (i = 0; i < ac; i++, t = S48_CDR (t)) { - s = Make_String (av[i], strlen (av[i])); - S48_CAR (t) = s; + // Enable_Interrupts; + ret = s48_make_vector(ac, S48_FALSE); + S48_GC_PROTECT_1 (ret); + for (i = 0; i < ac; i++) { + S48_VECTOR_SET(ret, i, s48_enter_string(av[i])); } - S48_GC_UNPROTECT; + S48_GC_UNPROTECT(); if (ac) XFreeStringList (av); return ret; } -static String_List_To_Text_Property (x, ret) s48_value x; XTextProperty *ret; { - register i, n; - register char **s; - s48_value t; - Alloca_Begin; +int String_Vector_To_Text_Property (s48_value x, XTextProperty* ret) { + s48_value t = S48_FALSE; + int i, n = S48_VECTOR_LENGTH(x); + char* s[n]; - Check_List (x); - n = Fast_Length (x); - Alloca (s, char**, n * sizeof (char *)); - for (i = 0; i < n; i++, x = S48_CDR (x)) { - t = S48_CAR (x); - Get_Strsym_Stack (t, s[i]); - } - if (!XStringListToTextProperty (s, n, ret)) - Primitive_Error ("cannot create text property"); - Alloca_End; + for (i = 0; i < n; i++) { + t = S48_VECTOR_REF(x, i); + s[i] = S48_SYMBOL_P(t) ? s48_extract_symbol(t) : s48_extract_string(t); + } + + return XStringListToTextProperty (s, n, ret); + // Primitive_Error ("cannot create text property"); } -static s48_value Text_Property_To_String_List (p) XTextProperty *p; { - int n; - register i; - char **s; - s48_value x, ret, t; - S48_DECLARE_GC_PROTECT(2); +s48_value Text_Property_To_String_Vector (XTextProperty *p) { + int n, i; + char **s; + s48_value ret; + S48_DECLARE_GC_PROTECT(2); - if (!XTextPropertyToStringList (p, &s, &n)) - Primitive_Error ("cannot convert from text property"); - ret = t = P_Make_List (s48_enter_integer (n), S48_NULL); - S48_GC_PROTECT_2 (ret, t); - for (i = 0; i < n; i++, t = S48_CDR (t)) { - x = Make_String (s[i], strlen (s[i])); - S48_CAR (t) = x; - } - S48_GC_UNPROTECT; - XFreeStringList (s); - return ret; + if (!XTextPropertyToStringList (p, &s, &n)) + return S48_FALSE; + // Primitive_Error ("cannot convert from text property"); + + ret = s48_make_vector(n, S48_FALSE); + S48_GC_PROTECT_1 (ret); + for (i = 0; i < n; i++) { + S48_VECTOR_SET(ret, i, s48_enter_string(s[i])); + } + S48_GC_UNPROTECT(); + + XFreeStringList (s); + return ret; } -static s48_value P_Get_Text_Property (w, a) s48_value w, a; { - XTextProperty ret; - - Check_Type (w, T_Window); - Check_Type (a, T_Atom); - Disable_Interrupts; - if (!XGetTextProperty (WINDOW(w)->dpy, WINDOW(w)->win, &ret, - ATOM(a)->atom)) { - Enable_Interrupts; - return S48_FALSE; - } - Enable_Interrupts; - return Text_Property_To_String_List (&ret); +s48_value scx_Get_Text_Property (s48_value dpy, s48_value w, s48_value a) { + XTextProperty ret; + + // Disable_Interrupts; + if (!XGetTextProperty (SCX_EXTRACT_DISPLAY(dpy), + SCX_EXTRACT_WINDOW(w), + &ret, + SCX_EXTRACT_ATOM(a))) { + //Enable_Interrupts; + return S48_TRUE; // little hack to distinguish between this error and a + // possible Text_Pr._To_S._L. error + } + //Enable_Interrupts; + return Text_Property_To_String_Vector (&ret); } -static s48_value P_Set_Text_Property (w, prop, a) s48_value w, prop, a; { - XTextProperty p; - - Check_Type (w, T_Window); - Check_Type (a, T_Atom); - String_List_To_Text_Property (prop, &p); - XSetTextProperty (WINDOW(w)->dpy, WINDOW(w)->win, &p, ATOM(a)->atom); - XFree ((char *)p.value); - return Void; +s48_value scx_Set_Text_Property (s48_value dpy, s48_value w, s48_value prop, + s48_value a) { + XTextProperty p; + + if (!String_Vector_To_Text_Property (prop, &p)) + return S48_FALSE; + + XSetTextProperty (SCX_EXTRACT_DISPLAY(dpy), + SCX_EXTRACT_WINDOW(w), + &p, SCX_EXTRACT_ATOM(a)); + XFree ((char *)p.value); + return S48_UNSPECIFIC; } -static s48_value P_Wm_Protocols (w) s48_value w; { - Atom *p; - int i, n; - s48_value ret; - S48_DECLARE_GC_PROTECT(1); +s48_value scx_Wm_Protocols (s48_value Xdisplay, s48_value w) { + Atom *p; + int i, n; + s48_value ret; + S48_DECLARE_GC_PROTECT(1); - Check_Type (w, T_Window); - Disable_Interrupts; - if (!XGetWMProtocols (WINDOW(w)->dpy, WINDOW(w)->win, &p, &n)) - Primitive_Error ("cannot get WM protocols"); - Enable_Interrupts; - ret = s48_make_vector (n, S48_NULL); - S48_GC_PROTECT_1 (ret); - for (i = 0; i < n; i++) { - s48_value a; - - a = Make_Atom (p[i]); - S48_VECTOR_SET(ret, i, a;) - } - XFree ((char *)p); - S48_GC_UNPROTECT; - return ret; + //Disable_Interrupts; + if (!XGetWMProtocols (SCX_EXTRACT_DISPLAY(Xdisplay), + SCX_EXTRACT_WINDOW(w), &p, &n)) + return S48_FALSE; + //Enable_Interrupts; + + ret = s48_make_vector (n, S48_NULL); + S48_GC_PROTECT_1 (ret); + for (i = 0; i < n; i++) { + S48_VECTOR_SET(ret, i, SCX_ENTER_ATOM(p[i])); + } + XFree ((char *)p); + S48_GC_UNPROTECT(); + return ret; } -static s48_value P_Set_Wm_Protocols (w, v) s48_value w, v; { - Atom *p; - int i, n; - Alloca_Begin; - - Check_Type (w, T_Window); - Check_Type (v, T_Vector); - n = S48_VECTOR_LENGTH(v); - Alloca (p, Atom*, n * sizeof (Atom)); - for (i = 0; i < n; i++) { - s48_value a; - a = S48_VECTOR_REF(v, i); - Check_Type (a, T_Atom); - p[i] = ATOM(a)->atom; - } - if (!XSetWMProtocols (WINDOW(w)->dpy, WINDOW(w)->win, p, n)) - Primitive_Error ("cannot set WM protocols"); - Alloca_End; - return Void; +s48_value scx_Set_Wm_Protocols (s48_value Xdisplay, s48_value w, s48_value v) { + int i, n = S48_VECTOR_LENGTH(v); + Atom p[n]; + + for (i = 0; i < n; i++) + p[i] = SCX_EXTRACT_ATOM(S48_VECTOR_REF(v, i)); + + if (!XSetWMProtocols (SCX_EXTRACT_DISPLAY(Xdisplay), + SCX_EXTRACT_WINDOW(w), + p, n)) + return S48_FALSE; + else + return S48_UNSPECIFIC; } -static s48_value P_Wm_Class (w) s48_value w; { - s48_value ret, x; - XClassHint c; - S48_DECLARE_GC_PROTECT(1); +s48_value scx_Wm_Class (s48_value Xdisplay, s48_value w) { + s48_value ret, x; + XClassHint c; + S48_DECLARE_GC_PROTECT(1); - Check_Type (w, T_Window); - /* - * In X11.2 XGetClassHint() returns either 0 or Success, which happens - * to be defined as 0. So until this bug is fixed, we must - * explicitly check whether the XClassHint structure has been filled. - */ - c.res_name = c.res_class = 0; - Disable_Interrupts; - (void)XGetClassHint (WINDOW(w)->dpy, WINDOW(w)->win, &c); - Enable_Interrupts; - ret = s48_cons (S48_FALSE, S48_FALSE); - S48_GC_PROTECT_1 (ret); - if (c.res_name) { - x = Make_String (c.res_name, strlen (c.res_name)); - S48_CAR (ret) = x; - XFree (c.res_name); - } - if (c.res_class) { - x = Make_String (c.res_class, strlen (c.res_class)); - S48_CDR (ret) = x; - XFree (c.res_class); - } - S48_GC_UNPROTECT; - return ret; + // Elk says: + // > In X11.2 XGetClassHint() returns either 0 or Success, which happens + // > to be defined as 0. So until this bug is fixed, we must + // > explicitly check whether the XClassHint structure has been filled. + // but on the other hand, it doesn't even support X11.3, so I think + // is fixed! + + c.res_name = c.res_class = 0; + // Disable_Interrupts; + if (!XGetClassHint (SCX_EXTRACT_DISPLAY(Xdisplay), + SCX_EXTRACT_WINDOW(w), &c)) { + // Enable_Interrupts; + return S48_FALSE; + } + // Enable_Interrupts; + + ret = s48_cons (S48_FALSE, S48_FALSE); + S48_GC_PROTECT_1 (ret); + if (c.res_name) { + S48_SET_CAR(ret, s48_enter_string(c.res_name)); + XFree (c.res_name); + } + if (c.res_class) { + S48_SET_CDR(ret, s48_enter_string(c.res_class)); + XFree (c.res_class); + } + S48_GC_UNPROTECT(); + return ret; } -static s48_value P_Set_Wm_Class (w, name, class) s48_value w, name, class; { - XClassHint c; - - Check_Type (w, T_Window); - c.res_name = Get_Strsym (name); - c.res_class = Get_Strsym (class); - XSetClassHint (WINDOW(w)->dpy, WINDOW(w)->win, &c); - return Void; +s48_value scx_Set_Wm_Class (s48_value dpy, s48_value w, s48_value name, + s48_value class) { + XClassHint c; + c.res_name = s48_extract_string(name); + c.res_class = s48_extract_string(class); + XSetClassHint (SCX_EXTRACT_DISPLAY(dpy), + SCX_EXTRACT_WINDOW(dpy), + &c); + return S48_UNSPECIFIC; } -static s48_value P_Set_Wm_Command (w, cmd) s48_value w, cmd; { - register i, n; - register char **argv; - s48_value c; - Alloca_Begin; +s48_value scx_Set_Wm_Command (s48_value dpy, s48_value w, s48_value cmd) { + int i, n = S48_VECTOR_LENGTH(cmd); + char *argv[n]; + for (i = 0; i < n; i++) + argv[i] = s48_extract_string(S48_VECTOR_REF(cmd, i)); - Check_Type (w, T_Window); - Check_List (cmd); - n = Fast_Length (cmd); - Alloca (argv, char**, n * sizeof (char *)); - for (i = 0; i < n; i++, cmd = S48_CDR (cmd)) { - c = S48_CAR (cmd); - Get_Strsym_Stack (c, argv[i]); - } - XSetCommand (WINDOW(w)->dpy, WINDOW(w)->win, argv, n); - Alloca_End; - return Void; + XSetCommand (SCX_EXTRACT_DISPLAY(dpy), + SCX_EXTRACT_WINDOW(w), + argv, n); + return S48_UNSPECIFIC; } -static s48_value P_Wm_Hints (w) s48_value w; { - XWMHints *p; +s48_value scx_Wm_Hints (s48_value dpy, s48_value w) { + XWMHints* p = (XWMHints*)0; + s48_value res; + S48_DECLARE_GC_PROTECT(1); - Check_Type (w, T_Window); - Disable_Interrupts; - p = XGetWMHints (WINDOW(w)->dpy, WINDOW(w)->win); - Enable_Interrupts; - if (p) { - WMH = *p; - XFree ((char *)p); - } else { - WMH.flags = 0; - } - return Record_To_Vector (Wm_Hints_Rec, Wm_Hints_Size, Sym_Wm_Hints, - WINDOW(w)->dpy, (unsigned long)WMH.flags); -} - -static s48_value P_Set_Wm_Hints (w, h) s48_value w, h; { - unsigned long mask; - - Check_Type (w, T_Window); - mask = Vector_To_Record (h, Wm_Hints_Size, Sym_Wm_Hints, Wm_Hints_Rec); - WMH.flags = mask; - XSetWMHints (WINDOW(w)->dpy, WINDOW(w)->win, &WMH); - return Void; -} - -static s48_value P_Size_Hints (w, a) s48_value w, a; { - long supplied; - - Check_Type (w, T_Window); - Check_Type (a, T_Atom); - Disable_Interrupts; - if (!XGetWMSizeHints (WINDOW(w)->dpy, WINDOW(w)->win, &SZH, &supplied, - ATOM(a)->atom)) - SZH.flags = 0; - if (!(supplied & PBaseSize)) - SZH.flags &= ~PBaseSize; - if (!(supplied & PWinGravity)) - SZH.flags &= ~PWinGravity; - Enable_Interrupts; - if ((SZH.flags & (PPosition|USPosition)) == (PPosition|USPosition)) - SZH.flags &= ~PPosition; - if ((SZH.flags & (PSize|USSize)) == (PSize|USSize)) - SZH.flags &= ~PSize; - return Record_To_Vector (Size_Hints_Rec, Size_Hints_Size, Sym_Size_Hints, - WINDOW(w)->dpy, (unsigned long)SZH.flags); -} - -static s48_value P_Set_Size_Hints (w, a, h) s48_value w, a, h; { - unsigned long mask; - - Check_Type (w, T_Window); - Check_Type (a, T_Atom); - bzero ((char *)&SZH, sizeof (SZH)); /* Not portable? */ - mask = Vector_To_Record (h, Size_Hints_Size, Sym_Size_Hints, - Size_Hints_Rec); - if ((mask & (PPosition|USPosition)) == (PPosition|USPosition)) - mask &= ~PPosition; - if ((mask & (PSize|USSize)) == (PSize|USSize)) - mask &= ~PSize; - SZH.flags = mask; - XSetWMSizeHints (WINDOW(w)->dpy, WINDOW(w)->win, &SZH, ATOM(a)->atom); - return Void; -} - -static s48_value P_Icon_Sizes (w) s48_value w; { - XIconSize *p; - int i, n; - s48_value v; - S48_DECLARE_GC_PROTECT(1); + //Disable_Interrupts; + p = XGetWMHints (SCX_EXTRACT_DISPLAY(dpy), + SCX_EXTRACT_WINDOW(w)); + //Enable_Interrupts; + res = s48_make_vector(9, S48_NULL); + if (p) { + S48_GC_PROTECT_1(res); - Check_Type (w, T_Window); - Disable_Interrupts; - if (!XGetIconSizes (WINDOW(w)->dpy, WINDOW(w)->win, &p, &n)) - n = 0; - Enable_Interrupts; - v = s48_make_vector (n, S48_NULL); - S48_GC_PROTECT_1 (v); - for (i = 0; i < n; i++) { - register XIconSize *q = &p[i]; - s48_value t; - - t = P_Make_List (s48_enter_integer (6), S48_NULL); - S48_VECTOR_SET(v, i, t;) - S48_CAR (t) = s48_enter_integer (q->min_width); t = S48_CDR (t); - S48_CAR (t) = s48_enter_integer (q->min_height); t = S48_CDR (t); - S48_CAR (t) = s48_enter_integer (q->max_width); t = S48_CDR (t); - S48_CAR (t) = s48_enter_integer (q->max_height); t = S48_CDR (t); - S48_CAR (t) = s48_enter_integer (q->width_inc); t = S48_CDR (t); - S48_CAR (t) = s48_enter_integer (q->height_inc); + if (p->flags && InputHint) + S48_VECTOR_SET(res, 0, S48_ENTER_BOOLEAN(p->input)); + if (p->flags && StateHint) + S48_VECTOR_SET(res, 1, Bit_To_Symbol((unsigned long)p->initial_state, + Initial_State_Syms)); + if (p->flags && IconPixmapHint) + S48_VECTOR_SET(res, 2, SCX_ENTER_PIXMAP(p->icon_pixmap)); + if (p->flags && IconWindowHint) + S48_VECTOR_SET(res, 3, SCX_ENTER_WINDOW(p->icon_window)); + if (p->flags && IconPositionHint) { + S48_VECTOR_SET(res, 4, s48_enter_integer(p->icon_x)); + S48_VECTOR_SET(res, 5, s48_enter_integer(p->icon_y)); } - S48_GC_UNPROTECT; - if (n > 0) - XFree ((char *)p); - return v; + if (p->flags && IconMaskHint) + S48_VECTOR_SET(res, 6, SCX_ENTER_PIXMAP(p->icon_mask)); + if (p->flags && WindowGroupHint) + // Elk says a window-group is a window...?? + S48_VECTOR_SET(res, 7, SCX_ENTER_WINDOW(p->window_group)); + S48_VECTOR_SET(res, 8, S48_ENTER_BOOLEAN(p->flags && XUrgencyHint)); + // XLib man-pages say this constant is called UrgencyHint !! + + S48_GC_UNPROTECT(); + } + return res; } -static s48_value P_Set_Icon_Sizes (w, v) s48_value w, v; { - register i, n; - XIconSize *p; - Alloca_Begin; +s48_value scx_Set_Wm_Hints (s48_value dpy, s48_value w, s48_value alist) { + unsigned long mask = 0; + s48_value l, p, v; + XWMHints WMH; + char* cname; - Check_Type (w, T_Window); - Check_Type (v, T_Vector); - n = S48_VECTOR_LENGTH(v); - Alloca (p, XIconSize*, n * sizeof (XIconSize)); - for (i = 0; i < n; i++) { - register XIconSize *q = &p[i]; - s48_value t; - - t = S48_VECTOR_REF(v, i); - Check_List (t); - if (Fast_Length (t) != 6) - Primitive_Error ("invalid argument: ~s", t); - q->min_width = (int)s48_extract_integer (S48_CAR (t)); t = S48_CDR (t); - q->min_height = (int)s48_extract_integer (S48_CAR (t)); t = S48_CDR (t); - q->max_width = (int)s48_extract_integer (S48_CAR (t)); t = S48_CDR (t); - q->max_height = (int)s48_extract_integer (S48_CAR (t)); t = S48_CDR (t); - q->width_inc = (int)s48_extract_integer (S48_CAR (t)); t = S48_CDR (t); - q->height_inc = (int)s48_extract_integer (S48_CAR (t)); + for (l = alist; !S48_NULL_P(l); l = S48_CDR(l)) { + p = S48_CAR(l); + v = S48_CDR(p); + cname = s48_extract_symbol(S48_CAR(p)); + if (strcmp(cname, "input?") == 0) { + mask |= InputHint; + WMH.input = !S48_FALSE_P(v); + } else if (strcmp(cname, "initial-state") == 0) { + mask |= StateHint; + WMH.initial_state = Symbol_To_Bit((unsigned long)s48_extract_integer(v), + Initial_State_Syms); + } else if (strcmp(cname, "icon-pixmap") == 0) { + mask |= IconPixmapHint; + WMH.icon_pixmap = SCX_EXTRACT_PIXMAP(v); + } else if (strcmp(cname, "icon-window") == 0) { + mask |= IconWindowHint; + WMH.icon_window = SCX_EXTRACT_WINDOW(v); + } else if (strcmp(cname, "icon-x") == 0) { + mask |= IconPositionHint; + WMH.icon_x = (int)s48_extract_integer(v); + } else if (strcmp(cname, "icon-y") == 0) { + mask |= IconPositionHint; + WMH.icon_y = (int)s48_extract_integer(v); + } else if (strcmp(cname, "icon-mask") == 0) { + mask |= IconMaskHint; + WMH.icon_mask = SCX_EXTRACT_PIXMAP(v); + } else if (strcmp(cname, "window-group") == 0) { + mask |= WindowGroupHint; + WMH.window_group = SCX_EXTRACT_WINDOW(v); + } else if (strcmp(cname, "urgency") == 0) { + mask |= XUrgencyHint; + // XLib man-pages say this constant is called UrgencyHint !! } - XSetIconSizes (WINDOW(w)->dpy, WINDOW(w)->win, p, n); - Alloca_End; - return Void; + } + + XSetWMHints(SCX_EXTRACT_DISPLAY(dpy), + SCX_EXTRACT_WINDOW(w), + &WMH); + return S48_UNSPECIFIC; } -static s48_value P_Transient_For (w) s48_value w; { - Window win; +s48_value scx_Icon_Sizes (s48_value dpy, s48_value w) { + XIconSize *p; + int i, n; + s48_value v; + S48_DECLARE_GC_PROTECT(1); + + //Disable_Interrupts; + if (!XGetIconSizes (SCX_EXTRACT_DISPLAY(dpy), + SCX_EXTRACT_WINDOW(w), + &p, &n)) + n = 0; + //Enable_Interrupts; + + v = s48_make_vector (n, S48_NULL); + S48_GC_PROTECT_1 (v); + for (i = 0; i < n; i++) { + XIconSize* q = &p[i]; + s48_value t = s48_make_vector(6, S48_NULL); + S48_VECTOR_SET(v, i, t); - Disable_Interrupts; - if (!XGetTransientForHint (WINDOW(w)->dpy, WINDOW(w)->win, &win)) - win = None; - Enable_Interrupts; - return Make_Window (0, WINDOW(w)->dpy, win); + S48_VECTOR_SET(t, 0, s48_enter_integer (q->min_width)); + S48_VECTOR_SET(t, 1, s48_enter_integer (q->min_height)); + S48_VECTOR_SET(t, 2, s48_enter_integer (q->max_width)); + S48_VECTOR_SET(t, 3, s48_enter_integer (q->max_height)); + S48_VECTOR_SET(t, 4, s48_enter_integer (q->width_inc)); + S48_VECTOR_SET(t, 5, s48_enter_integer (q->height_inc)); + } + S48_GC_UNPROTECT(); + if (n > 0) + XFree ((char *)p); + return v; } -static s48_value P_Set_Transient_For (w, pw) s48_value w, pw; { - Check_Type (w, T_Window); - XSetTransientForHint (WINDOW(w)->dpy, WINDOW(w)->win, Get_Window (pw)); - return Void; +s48_value scx_Set_Icon_Sizes (s48_value dpy, s48_value w, s48_value v) { + int i, n = S48_VECTOR_LENGTH(v); + XIconSize p[n]; + + for (i = 0; i < n; i++) { + XIconSize *q = &p[i]; + s48_value t = S48_VECTOR_REF(v, i); + + q->min_width = (int)s48_extract_integer(S48_VECTOR_REF(t, 0)); + q->min_height = (int)s48_extract_integer(S48_VECTOR_REF(t, 1)); + q->max_width = (int)s48_extract_integer(S48_VECTOR_REF(t, 2)); + q->max_height = (int)s48_extract_integer(S48_VECTOR_REF(t, 3)); + q->width_inc = (int)s48_extract_integer(S48_VECTOR_REF(t, 4)); + q->height_inc = (int)s48_extract_integer(S48_VECTOR_REF(t, 5)); + } + + XSetIconSizes (SCX_EXTRACT_DISPLAY(dpy), + SCX_EXTRACT_WINDOW(w), + p, n); + + return S48_UNSPECIFIC; } -elk_init_xlib_client () { - Define_Symbol (&Sym_Wm_Hints, "wm-hints"); - Define_Symbol (&Sym_Size_Hints, "size-hints"); - Define_Primitive (P_Iconify_Window, "iconify-window", 2, 2, EVAL); - Define_Primitive (P_Withdraw_Window, "withdraw-window", 2, 2, EVAL); - Define_Primitive (P_Reconfigure_Wm_Window, - "xlib-reconfigure-wm-window", 3, 3, EVAL); - Define_Primitive (P_Wm_Command, "wm-command", 1, 1, EVAL); - Define_Primitive (P_Get_Text_Property,"get-text-property", 2, 2, EVAL); - Define_Primitive (P_Set_Text_Property,"set-text-property!",3, 3, EVAL); - Define_Primitive (P_Wm_Protocols, "wm-protocols", 1, 1, EVAL); - Define_Primitive (P_Set_Wm_Protocols, "set-wm-protocols!", 2, 2, EVAL); - Define_Primitive (P_Wm_Class, "wm-class", 1, 1, EVAL); - Define_Primitive (P_Set_Wm_Class, "set-wm-class!", 3, 3, EVAL); - Define_Primitive (P_Set_Wm_Command, "set-wm-command!", 2, 2, EVAL); - Define_Primitive (P_Wm_Hints, "xlib-wm-hints", 1, 1, EVAL); - Define_Primitive (P_Set_Wm_Hints, "xlib-set-wm-hints!",2, 2, EVAL); - Define_Primitive (P_Size_Hints, "xlib-wm-size-hints",2, 2, EVAL); - Define_Primitive (P_Set_Size_Hints, - "xlib-set-wm-size-hints!", 3, 3, EVAL); - Define_Primitive (P_Icon_Sizes, "icon-sizes", 1, 1, EVAL); - Define_Primitive (P_Set_Icon_Sizes, "set-icon-sizes!", 2, 2, EVAL); - Define_Primitive (P_Transient_For, "transient-for", 1, 1, EVAL); - Define_Primitive (P_Set_Transient_For,"set-transient-for!",2, 2, EVAL); +s48_value scx_Transient_For(s48_value dpy, s48_value w) { + Window win; + + //Disable_Interrupts; + if (!XGetTransientForHint(SCX_EXTRACT_DISPLAY(dpy), + SCX_EXTRACT_WINDOW(w), + &win)) + win = None; + //Enable_Interrupts; + return SCX_ENTER_WINDOW(win); +} + +s48_value scx_Set_Transient_For(s48_value dpy, s48_value w, s48_value pw) { + XSetTransientForHint (SCX_EXTRACT_DISPLAY(dpy), + SCX_EXTRACT_WINDOW(w), + SCX_EXTRACT_WINDOW(pw)); + return S48_UNSPECIFIC; +} + +s48_value scx_Wm_Normal_Hints(s48_value dpy, s48_value win) { + XSizeHints SH; + long supplied; + s48_value v; + S48_DECLARE_GC_PROTECT(1); + + if (!XGetWMNormalHints(SCX_EXTRACT_DISPLAY(dpy), + SCX_EXTRACT_WINDOW(win), + &SH, &supplied)) + SH.flags = 0; + + v = s48_make_vector(19, S48_NULL); + S48_GC_PROTECT_1(v); + + if ((SH.flags & PPosition) == PPosition) { + S48_VECTOR_SET(v, 0, s48_enter_integer(SH.x)); + S48_VECTOR_SET(v, 1, s48_enter_integer(SH.y)); + } + if ((SH.flags & PSize) == PSize) { + S48_VECTOR_SET(v, 2, s48_enter_integer(SH.width)); + S48_VECTOR_SET(v, 3, s48_enter_integer(SH.height)); + } + if ((SH.flags & USPosition) == USPosition) { + S48_VECTOR_SET(v, 0, s48_enter_integer(SH.x)); + S48_VECTOR_SET(v, 1, s48_enter_integer(SH.y)); + S48_VECTOR_SET(v, 4, S48_TRUE); // us-position -> #t + } + if ((SH.flags & USSize) == USSize) { + S48_VECTOR_SET(v, 2, s48_enter_integer(SH.width)); + S48_VECTOR_SET(v, 3, s48_enter_integer(SH.height)); + S48_VECTOR_SET(v, 5, S48_TRUE); // us-size -> #t + } + if ((SH.flags & PMinSize) == PMinSize) { + S48_VECTOR_SET(v, 6, s48_enter_integer(SH.min_width)); + S48_VECTOR_SET(v, 7, s48_enter_integer(SH.min_height)); + } + if ((SH.flags & PMaxSize) == PMaxSize) { + S48_VECTOR_SET(v, 8, s48_enter_integer(SH.max_width)); + S48_VECTOR_SET(v, 9, s48_enter_integer(SH.max_height)); + } + if ((SH.flags & PResizeInc) == PResizeInc) { + S48_VECTOR_SET(v, 10, s48_enter_integer(SH.width_inc)); + S48_VECTOR_SET(v, 11, s48_enter_integer(SH.height_inc)); + } + if ((SH.flags & PAspect) == PAspect) { + S48_VECTOR_SET(v, 12, s48_enter_integer(SH.min_aspect.x)); + S48_VECTOR_SET(v, 13, s48_enter_integer(SH.min_aspect.y)); + S48_VECTOR_SET(v, 14, s48_enter_integer(SH.max_aspect.x)); + S48_VECTOR_SET(v, 15, s48_enter_integer(SH.max_aspect.y)); + } + if ((SH.flags & PBaseSize) == PBaseSize) { + S48_VECTOR_SET(v, 16, s48_enter_integer(SH.base_width)); + S48_VECTOR_SET(v, 17, s48_enter_integer(SH.base_height)); + } + if ((SH.flags & PWinGravity) == PWinGravity) { + S48_VECTOR_SET(v, 18, Bit_To_Symbol(SH.win_gravity, Grav_Syms)); + } + + S48_GC_UNPROTECT(); + return v; +} + +s48_value scx_Set_Wm_Normal_Hints(s48_value dpy, s48_value win, + s48_value alist) { + XSizeHints SH; + long mask = 0; + s48_value l; + for (l = alist; !S48_NULL_P(l); l = S48_CDR(l)) { + s48_value p = S48_CAR(l); + char* name = s48_extract_string(S48_CAR(p)); + s48_value v = S48_CDR(p); + + if (strcmp(name, "x") == 0) { + mask |= PPosition; SH.x = s48_extract_integer(v); + } + if (strcmp(name, "y") == 0) { + mask |= PPosition; SH.y = s48_extract_integer(v); + } + if (strcmp(name, "width") == 0) { + mask |= PSize; SH.width = s48_extract_integer(v); + } + if (strcmp(name, "height") == 0) { + mask |= PSize; SH.height = s48_extract_integer(v); + } + if (strcmp(name, "min-width") == 0) { + mask |= PMinSize; SH.min_width = s48_extract_integer(v); + } + if (strcmp(name, "min-height") == 0) { + mask |= PMinSize; SH.min_height = s48_extract_integer(v); + } + if (strcmp(name, "max-width") == 0) { + mask |= PMaxSize; SH.max_width = s48_extract_integer(v); + } + if (strcmp(name, "max-height") == 0) { + mask |= PMaxSize; SH.max_height = s48_extract_integer(v); + } + if (strcmp(name, "width-inc") == 0) { + mask |= PResizeInc; SH.width_inc = s48_extract_integer(v); + } + if (strcmp(name, "height-inc") == 0) { + mask |= PResizeInc; SH.height_inc = s48_extract_integer(v); + } + if (strcmp(name, "min-aspect-x") == 0) { + mask |= PAspect; SH.min_aspect.x = s48_extract_integer(v); + } + if (strcmp(name, "min-aspect-y") == 0) { + mask |= PAspect; SH.min_aspect.y = s48_extract_integer(v); + } + if (strcmp(name, "max-aspect-x") == 0) { + mask |= PAspect; SH.max_aspect.x = s48_extract_integer(v); + } + if (strcmp(name, "max-aspect-y") == 0) { + mask |= PAspect; SH.max_aspect.y = s48_extract_integer(v); + } + if (strcmp(name, "base-width") == 0) { + mask |= PBaseSize; SH.base_width = s48_extract_integer(v); + } + if (strcmp(name, "base-height") == 0) { + mask |= PBaseSize; SH.base_height = s48_extract_integer(v); + } + if (strcmp(name, "gravity") == 0) { + mask |= PWinGravity; SH.win_gravity = Symbol_To_Bit(v, Grav_Syms); + } + } + SH.flags = mask; + + XSetWMNormalHints(SCX_EXTRACT_DISPLAY(dpy), + SCX_EXTRACT_WINDOW(win), + &SH); + + return S48_UNSPECIFIC; +} + +scx_init_client() { + S48_EXPORT_FUNCTION(scx_Iconify_Window); + S48_EXPORT_FUNCTION(scx_Withdraw_Window); + S48_EXPORT_FUNCTION(scx_Reconfigure_Wm_Window); + S48_EXPORT_FUNCTION(scx_Wm_Command); + S48_EXPORT_FUNCTION(scx_Get_Text_Property); + S48_EXPORT_FUNCTION(scx_Set_Text_Property); + S48_EXPORT_FUNCTION(scx_Wm_Protocols); + S48_EXPORT_FUNCTION(scx_Set_Wm_Protocols); + S48_EXPORT_FUNCTION(scx_Wm_Class); + S48_EXPORT_FUNCTION(scx_Set_Wm_Class); + S48_EXPORT_FUNCTION(scx_Set_Wm_Command); + S48_EXPORT_FUNCTION(scx_Wm_Hints); + S48_EXPORT_FUNCTION(scx_Set_Wm_Hints); + S48_EXPORT_FUNCTION(scx_Icon_Sizes); + S48_EXPORT_FUNCTION(scx_Set_Icon_Sizes); + S48_EXPORT_FUNCTION(scx_Transient_For); + S48_EXPORT_FUNCTION(scx_Set_Transient_For); + S48_EXPORT_FUNCTION(scx_Wm_Normal_Hints); + S48_EXPORT_FUNCTION(scx_Set_Wm_Normal_Hints); } diff --git a/c/xlib/key.c b/c/xlib/key.c index 2945678..b746336 100644 --- a/c/xlib/key.c +++ b/c/xlib/key.c @@ -1,159 +1,126 @@ #include "xlib.h" +#include "scheme48.h" -#ifdef XLIB_RELEASE_5_OR_LATER +//#ifdef XLIB_RELEASE_5_OR_LATER +// I don't know if XDisplayKeycodes() was already there in X11R4. +// else: dpy->min_keycode dpy->max_keycode -/* I don't know if XDisplayKeycodes() was already there in X11R4. - */ -static s48_value P_Display_Min_Keycode (d) s48_value d; { - int mink, maxk; - - Check_Type (d, T_Display); - XDisplayKeycodes(DISPLAY(d)->dpy, &mink, &maxk); - return s48_enter_integer (mink); +s48_value scx_Display_Min_Keycode (s48_value d) { + int mink, maxk; + XDisplayKeycodes(SCX_EXTRACT_DISPLAY(d), &mink, &maxk); + return s48_enter_integer(mink); } -static s48_value P_Display_Max_Keycode (d) s48_value d; { - int mink, maxk; - - Check_Type (d, T_Display); - XDisplayKeycodes(DISPLAY(d)->dpy, &mink, &maxk); - return s48_enter_integer (maxk); +s48_value scx_Display_Max_Keycode (s48_value d) { + int mink, maxk; + XDisplayKeycodes(SCX_EXTRACT_DISPLAY(d), &mink, &maxk); + return s48_enter_integer(maxk); } -#else -static s48_value P_Display_Min_Keycode (d) s48_value d; { - Check_Type (d, T_Display); - return s48_enter_integer (DISPLAY(d)->dpy->min_keycode); +//#ifdef XLIB_RELEASE_5_OR_LATER +// I'm not sure if this works correctly in X11R4: + +s48_value scx_Display_Keysyms_Per_Keycode (s48_value d) { + KeySym *ksyms; + int mink, maxk, ksyms_per_kode; + + XDisplayKeycodes(SCX_EXTRACT_DISPLAY(d), &mink, &maxk); + ksyms = XGetKeyboardMapping(SCX_EXTRACT_DISPLAY(d), (KeyCode)mink, + maxk - mink + 1, &ksyms_per_kode); + return s48_enter_integer(ksyms_per_kode); } -static s48_value P_Display_Max_Keycode (d) s48_value d; { - Check_Type (d, T_Display); - return s48_enter_integer (DISPLAY(d)->dpy->max_keycode); -} -#endif +//#else +//static s48_value P_Display_Keysyms_Per_Keycode (d) s48_value d; { +// Check_Type (d, T_Display); +// // Force initialization: +// Disable_Interrupts; +// (void)XKeycodeToKeysym (DISPLAY(d)->dpy, DISPLAY(d)->dpy->min_keycode, 0); +// Enable_Interrupts; +// return s48_enter_integer (DISPLAY(d)->dpy->keysyms_per_keycode); +//} +//#endif -#ifdef XLIB_RELEASE_5_OR_LATER - -/* I'm not sure if this works correctly in X11R4: - */ -static s48_value P_Display_Keysyms_Per_Keycode (d) s48_value d; { - KeySym *ksyms; - int mink, maxk, ksyms_per_kode; - - Check_Type (d, T_Display); - XDisplayKeycodes(DISPLAY(d)->dpy, &mink, &maxk); - ksyms = XGetKeyboardMapping(DISPLAY(d)->dpy, (KeyCode)mink, - maxk - mink + 1, &ksyms_per_kode); - return s48_enter_integer (ksyms_per_kode); +s48_value scx_String_To_Keysym (s48_value s) { + KeySym k = XStringToKeysym (s48_extract_string(s)); + return k == NoSymbol ? S48_FALSE : s48_enter_integer ((unsigned long)k); } -#else -static s48_value P_Display_Keysyms_Per_Keycode (d) s48_value d; { - Check_Type (d, T_Display); - /* Force initialization: */ - Disable_Interrupts; - (void)XKeycodeToKeysym (DISPLAY(d)->dpy, DISPLAY(d)->dpy->min_keycode, 0); - Enable_Interrupts; - return s48_enter_integer (DISPLAY(d)->dpy->keysyms_per_keycode); -} -#endif - -static s48_value P_String_To_Keysym (s) s48_value s; { - KeySym k; - - k = XStringToKeysym (Get_Strsym (s)); - return k == NoSymbol ? S48_FALSE : s48_enter_integer ((unsigned long)k); +s48_value scx_Keysym_To_String (s48_value k) { + char* s = XKeysymToString ((KeySym)s48_extract_integer(k)); + return s ? s48_enter_string(s) : S48_FALSE; } -static s48_value P_Keysym_To_String (k) s48_value k; { - register char *s; - - s = XKeysymToString ((KeySym)s48_extract_integer (k)); - return s ? Make_String (s, strlen (s)) : S48_FALSE; +s48_value scx_Keycode_To_Keysym (s48_value d, s48_value k, s48_value index) { + KeySym ks; + //Disable_Interrupts; + ks = XKeycodeToKeysym(SCX_EXTRACT_DISPLAY(d), + (int)s48_extract_integer (k), + (int)s48_extract_integer (index)); + //Enable_Interrupts; + return s48_enter_integer((unsigned long)ks); } -static s48_value P_Keycode_To_Keysym (d, k, index) s48_value d, k, index; { - s48_value ret; - - Check_Type (d, T_Display); - Disable_Interrupts; - ret = s48_enter_integer ((unsigned long)XKeycodeToKeysym (DISPLAY(d)->dpy, - (int)s48_extract_integer (k), (int)s48_extract_integer (index))); - Enable_Interrupts; - return ret; +s48_value scx_Keysym_To_Keycode (s48_value d, s48_value k) { + KeyCode kc; + //Disable_Interrupts; + kc = XKeysymToKeycode (SCX_EXTRACT_DISPLAY(d), + (KeySym)s48_extract_integer(k)); + //Enable_Interrupts; + return s48_enter_integer(kc); } -static s48_value P_Keysym_To_Keycode (d, k) s48_value d, k; { - s48_value ret; +s48_value scx_Lookup_String (s48_value d, s48_value k, s48_value mask) { + XKeyEvent e; + char buf[1024]; + int len; + KeySym keysym_return; + XComposeStatus status_return; - Check_Type (d, T_Display); - Disable_Interrupts; - ret = s48_enter_integer (XKeysymToKeycode (DISPLAY(d)->dpy, - (KeySym)s48_extract_integer (k))); - Enable_Interrupts; - return ret; + e.display = SCX_EXTRACT_DISPLAY(d); + e.keycode = (int)s48_extract_integer(k); + e.state = Symbols_To_Bits(mask, State_Syms); + //Disable_Interrupts; + len = XLookupString (&e, buf, 1024, &keysym_return, &status_return); + //Enable_Interrupts; + return s48_enter_string(buf); //is there a 0 at buf[len] ? } -static s48_value P_Lookup_String (d, k, mask) s48_value d, k, mask; { - XKeyEvent e; - char buf[1024]; - register len; - KeySym keysym_return; - XComposeStatus status_return; +s48_value scx_Rebind_Keysym (s48_value d, s48_value k, s48_value mods, + s48_value str) { + int i, n = S48_VECTOR_LENGTH(mods); + KeySym p[n]; - Check_Type (d, T_Display); - e.display = DISPLAY(d)->dpy; - e.keycode = (int)s48_extract_integer (k); - e.state = Symbols_To_Bits (mask, 1, State_Syms); - Disable_Interrupts; - len = XLookupString (&e, buf, 1024, &keysym_return, &status_return); - Enable_Interrupts; - return Make_String (buf, len); + for (i = 0; i < n; i++) + p[i] = (KeySym)s48_extract_integer(S48_VECTOR_REF(mods, i)); + XRebindKeysym (SCX_EXTRACT_DISPLAY(d), + (KeySym)s48_extract_integer (k), p, n, + (unsigned char *)s48_extract_string(str), + S48_STRING_LENGTH(str)); + return S48_UNSPECIFIC; } -static s48_value P_Rebind_Keysym (d, k, mods, str) s48_value d, k, mods, str; { - KeySym *p; - register i, n; - Alloca_Begin; +s48_value scx_Refresh_Keyboard_Mapping (s48_value d, s48_value w, + s48_value event) { + static XMappingEvent fake; - Check_Type (d, T_Display); - Check_Type (str, T_String); - Check_Type (mods, T_Vector); - n = S48_VECTOR_LENGTH(mods); - Alloca (p, KeySym*, n * sizeof (KeySym)); - for (i = 0; i < n; i++) - p[i] = (KeySym)s48_extract_integer (VECTOR(mods)->data[i]); - XRebindKeysym (DISPLAY(d)->dpy, (KeySym)s48_extract_integer (k), p, n, - (unsigned char *)STRING(str)->data, STRING(str)->size); - Alloca_End; - return Void; + fake.type = MappingNotify; + fake.display = SCX_EXTRACT_DISPLAY(d); + fake.window = SCX_EXTRACT_WINDOW(w); + fake.request = Symbol_To_Bit (event, Mapping_Syms); + XRefreshKeyboardMapping (&fake); + return S48_UNSPECIFIC; } -static s48_value P_Refresh_Keyboard_Mapping (w, event) s48_value w, event; { - static XMappingEvent fake; - - Check_Type (w, T_Window); - fake.type = MappingNotify; - fake.display = WINDOW(w)->dpy; - fake.window = WINDOW(w)->win; - fake.request = Symbols_To_Bits (event, 0, Mapping_Syms); - XRefreshKeyboardMapping (&fake); - return Void; -} - -elk_init_xlib_key () { - Define_Primitive (P_Display_Min_Keycode, "display-min-keycode", - 1, 1, EVAL); - Define_Primitive (P_Display_Max_Keycode, "display-max-keycode", - 1, 1, EVAL); - Define_Primitive (P_Display_Keysyms_Per_Keycode, - "display-keysyms-per-keycode", 1, 1, EVAL); - Define_Primitive (P_String_To_Keysym, "string->keysym", 1, 1, EVAL); - Define_Primitive (P_Keysym_To_String, "keysym->string", 1, 1, EVAL); - Define_Primitive (P_Keycode_To_Keysym, "keycode->keysym", 3, 3, EVAL); - Define_Primitive (P_Keysym_To_Keycode, "keysym->keycode", 2, 2, EVAL); - Define_Primitive (P_Lookup_String, "lookup-string", 3, 3, EVAL); - Define_Primitive (P_Rebind_Keysym, "rebind-keysym", 4, 4, EVAL); - Define_Primitive (P_Refresh_Keyboard_Mapping, - "refresh-keyboard-mapping", 2, 2, EVAL); +scx_init_key () { + S48_EXPORT_FUNCTION(scx_Display_Min_Keycode); + S48_EXPORT_FUNCTION(scx_Display_Max_Keycode); + S48_EXPORT_FUNCTION(scx_Display_Keysyms_Per_Keycode); + S48_EXPORT_FUNCTION(scx_String_To_Keysym); + S48_EXPORT_FUNCTION(scx_Keysym_To_String); + S48_EXPORT_FUNCTION(scx_Keycode_To_Keysym); + S48_EXPORT_FUNCTION(scx_Keysym_To_Keycode); + S48_EXPORT_FUNCTION(scx_Lookup_String); + S48_EXPORT_FUNCTION(scx_Rebind_Keysym); + S48_EXPORT_FUNCTION(scx_Refresh_Keyboard_Mapping); }