323 lines
8.7 KiB
C
323 lines
8.7 KiB
C
/* #include "scxt.h" */
|
|
/* #include "scheme48.h" */
|
|
/* #include "xlib.h" */
|
|
|
|
/* extern void XtManageChildren(), XtUnmanageChildren(); */
|
|
|
|
/* static Object P_Destroy_Widget(); */
|
|
|
|
|
|
|
|
/* static Object P_Create_Shell (argc, argv) Object *argv; { */
|
|
/* register char *sn = 0, *sc = 0; */
|
|
/* ArgList a; */
|
|
/* Object name, class, w, d, ret; */
|
|
/* Alloca_Begin; */
|
|
|
|
/* name = argv[0], class = argv[1], w = argv[2], d = argv[3]; */
|
|
/* if (!EQ(name, False)) */
|
|
/* sn = Get_Strsym (name); */
|
|
/* if (!EQ(class, False)) */
|
|
/* sc = Get_Strsym (class); */
|
|
/* Check_Type (w, T_Class); */
|
|
/* Check_Type (d, T_Display); */
|
|
/* Encode_Arglist (argc-4, argv+4, a, (Widget)0, CLASS(w)->wclass); */
|
|
/* ret = Make_Widget (XtAppCreateShell (sn, sc, CLASS(w)->wclass, */
|
|
/* DISPLAY(d)->dpy, a, (Cardinal)(argc-4)/2)); */
|
|
/* Alloca_End; */
|
|
/* return ret; */
|
|
/* } */
|
|
|
|
|
|
/* implementation of resources lacks... */
|
|
s48_value scxt_Create_Shell(s48_value app_name, s48_value app_class,
|
|
s48_value Xwidget_parent, s48_value Xdisplay,
|
|
s48_value arg_list) {
|
|
ArgList a;
|
|
/* ... */
|
|
}
|
|
|
|
|
|
/* implementation of resources lacks... */
|
|
s48_value scxt_Create_Widget(s48_value w_name, s48_value w_class,
|
|
s48_value parent, s48_value args,
|
|
s48_value num_args, s48_value flag){
|
|
ArgList a_list;
|
|
Widget res;
|
|
/* ... decode the arg-list!!! */
|
|
|
|
/* ... */
|
|
if (s48_extract_boolean(flag)){
|
|
res = XtCreateManagedWidget(s48_extract_string(w_name),
|
|
SCTX_EXTRACT_WIDGET_CLASS(w_class),
|
|
SCTX_EXTRACT_WIDGET(parent), a_list,
|
|
(Cardinal)s48_extract_integer(num_args));
|
|
}else{
|
|
res = XtCreateWidget(s48_extract_string(w_name),
|
|
SCXT_EXTRACT_WIDGET_CLASS(w_class),
|
|
SCXT_EXTRACT_WIDGET(parent), a_list,
|
|
(Cardinal)s48_extract_integer(num_args));
|
|
}
|
|
/* add the callback */
|
|
XtAddCallback(res, XtNdestroyCallback, Destroy_Callback,(XtPointer)0);
|
|
return SCXT_ENTER_WIDGET(res);
|
|
}
|
|
|
|
|
|
s48_value scxt_Realize_Widget (s48_value w){
|
|
XtRealizeWidget(SCXT_EXTRACT_WIDGET(w));
|
|
return S48_UNSPECIFIC;
|
|
}
|
|
|
|
|
|
s48_value scxt_Unrealize_Widget (s48_value w) {
|
|
XtUnrealizeWidget(SCXT_EXTRACT_WIDGET(w));
|
|
return S48_UNSPECIFIC;
|
|
}
|
|
|
|
|
|
s48_value scxt_Widget_Realized_P (s48_value w) {
|
|
int is_real = XtIsRealized(SCXT_EXTRACT_WIDGET(w));
|
|
return S48_ENTER_BOOLEAN(is_real);
|
|
}
|
|
|
|
|
|
s48_value scxt_Widget_Display (s48_value w) {
|
|
return SCX_ENTER_DISPLAY(XtDisplayOfObject(SCTX_EXTRACT_WIDGET(w)));
|
|
}
|
|
|
|
|
|
/* Returns the parent's widget ID */
|
|
s48_value scxt_Widget_Parent (s48_value w) {
|
|
return SCXT_ENTER_WIDGET(XtParent(SCTX_EXTRACT_WIDGET(w)));
|
|
}
|
|
|
|
|
|
|
|
s48_value scxt_Widget_Name (s48_value w) {
|
|
return s48_enter_string(XtName(SCTX_EXRACT_WIDGET(w)));
|
|
}
|
|
|
|
|
|
/* Returns the window associated with the widget */
|
|
s48_value scxt_Widget_To_Window (s48_value w) {
|
|
return SCX_ENTER_WINDOW(XtWindow(SCTX_EXTRACT_WIDGET(w)));
|
|
}
|
|
|
|
|
|
|
|
s48_value sxct_Widget_Composite_P (s48_value) {
|
|
return s48_ENTER_BOOLEAN(XtIsComposite(SCXT_EXTRACT_WIDGET(w)));
|
|
}
|
|
|
|
|
|
|
|
s48_value scxt_Manage_Children (s48_value w_list, s48_value len) {
|
|
Widget* buf_list;
|
|
int i;
|
|
int length = (int)s48_extract_integet(len);
|
|
for (i = 0, i < length, i++) {
|
|
buf_list[i] = S48_CAR(w_list);
|
|
w_list = S48_CDR(w_list);
|
|
}
|
|
XtManageChildren(buf_list, length);
|
|
return S48_UNSPECIFIC;
|
|
}
|
|
|
|
|
|
|
|
s48_value scxt_Unmanage_Children (s48_value w_list, s48_value len) {
|
|
Widget* buf_list;
|
|
int length = (int)s48_extract_integer(len);
|
|
int i;
|
|
for (i = 0, i < length, i++) {
|
|
buf_list[i] = S48_CAR(w_list);
|
|
w_list = S48_CDR(w_list);
|
|
}
|
|
XtUnmanageChildren(buf_list, length);
|
|
return S48_UNSPECIFIC;
|
|
}
|
|
|
|
|
|
s48_value scxt_Widget_Managed_P (s48_value w) {
|
|
return S48_ENTER_BOOLEAN(XtIsManaged(SCXT_EXTRACT_WIDGET(w)));
|
|
}
|
|
|
|
|
|
|
|
s48_value scxt_Widget_Class (s48_value w) {
|
|
return SCXT_ENTER_WIDGET_CLASS(XtClass(SCXT_EXTRACT_WIDGET(w)));
|
|
}
|
|
|
|
|
|
|
|
s48_value scxt_Widget_Superclass (s48_value w) {
|
|
if (XtClass(SCXT_EXTRACT_WIDGET(w)) == widgetClass)
|
|
return S48_ENTER_BOOLEAN(0);
|
|
return SCXT_ENTER_WIDGET_CLASS(XtSuperclass(SCXT_EXTRACT_WIDGET(w)));
|
|
}
|
|
|
|
|
|
|
|
s48_value scxt_Widget_Subclass_P (s48_value w, s48_value w_class) {
|
|
return S48_ENTER_BOOLEAN(XtIsSubclass(SCXT_EXTRACT_WIDGET(w),
|
|
SCXT_EXTRACT_WIDGET_CLASS(w_class)));
|
|
}
|
|
|
|
|
|
s48_value scxt_Set_Mapped_When_Managed (s48_value w, s48_value bool) {
|
|
XtSetMappedWhenManaged (SCXT_EXTRACT_WIDGET(w), S48_EXTRACT_BOOLEAN(bool));
|
|
return S48_UNSPECIFIC;
|
|
}
|
|
|
|
|
|
s48_value scxt_Map_Widget (s48_value w) {
|
|
XtMapWidget(SCXT_EXTRACT_WIDGET(w));
|
|
return S48_UNSPECIFIC;
|
|
}
|
|
|
|
|
|
s48_value scxt_Unmap_Widget (s48_value w) {
|
|
XtUnmapWidget (SCXT_EXTRACT_WIDGET(w));
|
|
return S48_UNSPECIFIC;
|
|
}
|
|
|
|
|
|
/* static Object P_Set_Values (argc, argv) Object *argv; { */
|
|
/* ArgList a; */
|
|
/* Widget w; */
|
|
/* register i, n = (argc-1)/2; */
|
|
/* Alloca_Begin; */
|
|
|
|
/* Check_Widget (argv[0]); */
|
|
/* w = WIDGET(argv[0])->widget; */
|
|
/* Encode_Arglist (argc-1, argv+1, a, w, XtClass (w)); */
|
|
/* XtSetValues (w, a, (Cardinal)n); */
|
|
/* for (i = 0; i < n; i++) */
|
|
/* if (streq (a[i].name, XtNdestroyCallback)) */
|
|
/* Fiddle_Destroy_Callback (w); */
|
|
/* Alloca_End; */
|
|
/* return Void; */
|
|
/* } */
|
|
|
|
/* resources aren't ready... */
|
|
s48_value scxt_Set_Values(s48_value w, s48_value arg_list, s48_value n_args) {
|
|
ArgList a_list;
|
|
/* ... */
|
|
return S48_UNSPECIFIC;
|
|
}
|
|
|
|
|
|
|
|
/* resources aren't ready... */
|
|
s48_value scxt_Get_Values(s48_value w, s48_value arg_list, s48_value n_args) {
|
|
/* ... */
|
|
}
|
|
|
|
|
|
|
|
s48_value scxt_Widget_Context(s48_value w) {
|
|
return SCXT_ENTER_CONTEXT(XtWidgetToApplicationContext(SCXT_EXTRACT_WIDGET(w)));
|
|
}
|
|
|
|
|
|
|
|
s48_value scxt_Set_Sensitive(s48_value w, s48_value flag) {
|
|
XtSetSensitive(SCXT_EXTRACT_WIDGET(w), SCXT_EXTRACT_BOOLEAN(flag));
|
|
return S48_UNSPECIFIC;
|
|
}
|
|
|
|
|
|
|
|
s48_value scxt_Sensitive_P(s48_value w) {
|
|
return S48_ENTER_BOOLEAN(XtIsSensitive(SCXT_EXTRACT_WIDGET(w)));
|
|
}
|
|
|
|
|
|
|
|
s48_value scxt_Window_To_Widget(s48_value Xwindow, s48_value Xdisplay) {
|
|
return SCXT_ENTER_WIDGET(XtWindowToWidget(SCX_EXTRACT_DISPLAY(Xdisplay),
|
|
SCX_EXTRACT_WINDOW(Xwindow)));
|
|
}
|
|
|
|
|
|
|
|
s48_value scxt_Name_To_Widget(s48_value root_w, s48_value name) {
|
|
return SCXT_ENTER_WIDGET(XtNameToWindow (SCXT_EXTRACT_WIDGET(root_w),
|
|
s48_extract_string(name)));
|
|
}
|
|
|
|
|
|
s48_value scxt_Widget_Translate_Coordinates(s48_value w, s48_value x,
|
|
s48_value y) {
|
|
Position root_x, root_y;
|
|
XtTranslateCoords(SCXT_EXTRACT_WIDGET(w), (int)s48_extract_integer(x),
|
|
(int)s48_extract_integer(y), &root_x, &root_y);
|
|
return s48_cons(s48_enter_integer((int)root_x),
|
|
s48_enter_integer((int)root_y));
|
|
}
|
|
|
|
|
|
|
|
/* /* The GC-visit function for widgets. Visit the children of composite */
|
|
/* * widgets and all the parents of a widget. */
|
|
/* * Based on code contributed by Ken Fox <fox@pt0204.pto.ford.com>. */
|
|
/* */ */
|
|
|
|
/* #include <X11/IntrinsicP.h> */
|
|
/* #include <X11/CoreP.h> */
|
|
/* #include <X11/CompositeP.h> */
|
|
/* #undef XtIsComposite */
|
|
|
|
/* static Widget_Visit (root, func) Object *root; int (*func)(); { */
|
|
/* Object obj; */
|
|
/* Widget w = WIDGET(*root)->widget; */
|
|
|
|
/* if (WIDGET(*root)->free == 0 && XtIsComposite (w)) { */
|
|
/* int i; */
|
|
/* CompositeRec *comp = (CompositeRec *)w; */
|
|
|
|
/* for (i = 0; i < comp->composite.num_children; i++) { */
|
|
/* obj = Find_Object (T_Widget, (GENERIC)0, Match_Xt_Obj, */
|
|
/* comp->composite.children[i]); */
|
|
/* if (TYPE(obj) == T_Widget) */
|
|
/* func (&obj); */
|
|
/* } */
|
|
/* while (w = XtParent (w)) { */
|
|
/* obj = Find_Object (T_Widget, (GENERIC)0, Match_Xt_Obj, w); */
|
|
/* if (TYPE(obj) == T_Widget) */
|
|
/* func (&obj); */
|
|
/* } */
|
|
/* } */
|
|
/* } */
|
|
|
|
void scxt_init_widgets(void) {
|
|
S48_EXPORT_FUNCTION(scxt_Destroy_Widget);
|
|
S48_EXPORT_FUNCTION(scxt_Create_Shell);
|
|
S48_EXPORT_FUNCTION(scxt_Create_Widget);
|
|
S48_EXPORT_FUNCTION(scxt_Realize_Widget);
|
|
S48_EXPORT_FUNCTION(scxt_Unrealize_Widget);
|
|
S48_EXPORT_FUNCTION(scxt_Widget_Realized_P);
|
|
S48_EXPORT_FUNCTION(scxt_Widget_Display);
|
|
S48_EXPORT_FUNCTION(scxt_Widget_Parent);
|
|
S48_EXPORT_FUNCTION(scxt_Widget_Name);
|
|
S48_EXPORT_FUNCTION(scxt_Widget_To_Window);
|
|
S48_EXPORT_FUNCTION(scxt_Widget_Composite_P);
|
|
S48_EXPORT_FUNCTION(scxt_Manage_Children);
|
|
S48_EXPORT_FUNCTION(scxt_Unmanage_Children);
|
|
S48_EXPORT_FUNCTION(scxt_Widget_Managed_P);
|
|
S48_EXPORT_FUNCTION(scxt_Widget_Class);
|
|
S48_EXPORT_FUNCTION(scxt_Widget_Subclass_P);
|
|
S48_EXPORT_FUNCTION(scxt_Set_Mapped_When_Managed);
|
|
S48_EXPORT_FUNCTION(scxt_Map_Widget);
|
|
S48_EXPORT_FUNCTION(scxt_Unmap_Widget);
|
|
S48_EXPORT_FUNCTION(scxt_Set_Values);
|
|
S48_EXPORT_FUNCTION(scxt_Get_Values);
|
|
S48_EXPORT_FUNCTION(scxt_Widget_Context);
|
|
S48_EXPORT_FUNCTION(scxt_Set_Sensitive);
|
|
S48_EXPORT_FUNCTION(scxt_Widget_Sensitive_P);
|
|
S48_EXPORT_FUNCTION(scxt_Window_To_Widget);
|
|
S48_EXPORT_FUNCTION(scxt_Name_To_Widget);
|
|
S48_EXPORT_FUNCTION(scxt_Widget_Translate_Coordinates);
|
|
}
|