383 lines
12 KiB
C
383 lines
12 KiB
C
/* widget.c
|
|
*
|
|
* $Id$
|
|
*
|
|
* Copyright 1990, 1991, 1992, 1993, 1994, 1995, Oliver Laumann, Berlin
|
|
* Copyright 2002, 2003 Sam Hocevar <sam@hocevar.net>, Paris
|
|
*
|
|
* This software was derived from Elk 1.2, which was Copyright 1987, 1988,
|
|
* 1989, Nixdorf Computer AG and TELES GmbH, Berlin (Elk 1.2 has been written
|
|
* by Oliver Laumann for TELES Telematic Services, Berlin, in a joint project
|
|
* between TELES and Nixdorf Microprocessor Engineering, Berlin).
|
|
*
|
|
* Oliver Laumann, TELES GmbH, Nixdorf Computer AG and Sam Hocevar, as co-
|
|
* owners or individual owners of copyright in this software, grant to any
|
|
* person or company a worldwide, royalty free, license to
|
|
*
|
|
* i) copy this software,
|
|
* ii) prepare derivative works based on this software,
|
|
* iii) distribute copies of this software or derivative works,
|
|
* iv) perform this software, or
|
|
* v) display this software,
|
|
*
|
|
* provided that this notice is not removed and that neither Oliver Laumann
|
|
* nor Teles nor Nixdorf are deemed to have made any representations as to
|
|
* the suitability of this software for any purpose nor are held responsible
|
|
* for any defects of this software.
|
|
*
|
|
* THERE IS ABSOLUTELY NO WARRANTY FOR THIS SOFTWARE.
|
|
*/
|
|
|
|
#include "xt.h"
|
|
|
|
static Object P_Destroy_Widget(Object);
|
|
|
|
Generic_Predicate (Widget)
|
|
|
|
Generic_Equal (Widget, WIDGET, widget)
|
|
|
|
Generic_Print (Widget, "#[widget %lu]", (unsigned int)(uintptr_t)POINTER(x))
|
|
|
|
static Object Internal_Make_Widget (int finalize, Widget widget) {
|
|
Object w;
|
|
|
|
if (widget == 0)
|
|
return Sym_None;
|
|
w = Find_Object (T_Widget, (GENERIC)0, Match_Xt_Obj, widget);
|
|
if (Nullp (w)) {
|
|
w = Alloc_Object (sizeof (struct S_Widget), T_Widget, 0);
|
|
WIDGET(w)->tag = Null;
|
|
WIDGET(w)->widget = widget;
|
|
WIDGET(w)->free = 0;
|
|
XtAddCallback (widget, XtNdestroyCallback, Destroy_Callback_Proc,
|
|
(XtPointer)0);
|
|
Register_Object (w, (GENERIC)0,
|
|
finalize ? P_Destroy_Widget : (PFO)0, 0);
|
|
}
|
|
return w;
|
|
}
|
|
|
|
/* Backwards compatibility: */
|
|
Object Make_Widget (Widget widget) {
|
|
return Internal_Make_Widget (1, widget);
|
|
}
|
|
|
|
Object Make_Widget_Foreign (Widget widget) {
|
|
return Internal_Make_Widget (0, widget);
|
|
}
|
|
|
|
void Check_Widget (Object w) {
|
|
Check_Type (w, T_Widget);
|
|
if (WIDGET(w)->free)
|
|
Primitive_Error ("invalid widget: ~s", w);
|
|
}
|
|
|
|
void Check_Widget_Class (Object w, WidgetClass class) {
|
|
Check_Widget (w);
|
|
if (XtClass (WIDGET(w)->widget) != class)
|
|
Primitive_Error ("widget not of expected class: ~s", w);
|
|
}
|
|
|
|
static Object P_Destroy_Widget (Object w) {
|
|
Check_Widget (w);
|
|
XtDestroyWidget (WIDGET(w)->widget);
|
|
return Void;
|
|
}
|
|
|
|
static Object P_Create_Shell (int argc, 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;
|
|
}
|
|
|
|
static Object P_Create_Widget (int argc, Object *argv) {
|
|
ArgList a;
|
|
char *name = 0;
|
|
Object x, class, parent, ret;
|
|
Alloca_Begin;
|
|
|
|
x = argv[0];
|
|
if (TYPE(x) != T_Class) {
|
|
name = Get_Strsym (x);
|
|
argv++; argc--;
|
|
}
|
|
class = argv[0];
|
|
parent = argv[1];
|
|
Check_Type (class, T_Class);
|
|
Check_Widget (parent);
|
|
if (name == 0)
|
|
name = CLASS(class)->name;
|
|
Encode_Arglist (argc-2, argv+2, a, WIDGET(parent)->widget,
|
|
CLASS(class)->wclass);
|
|
ret = Make_Widget (XtCreateWidget ((String)name, CLASS(class)->wclass,
|
|
WIDGET(parent)->widget, a, (Cardinal)(argc-2)/2));
|
|
Alloca_End;
|
|
return ret;
|
|
}
|
|
|
|
static Object P_Realize_Widget (Object w) {
|
|
Check_Widget (w);
|
|
XtRealizeWidget (WIDGET(w)->widget);
|
|
return Void;
|
|
}
|
|
|
|
static Object P_Unrealize_Widget (Object w) {
|
|
Check_Widget (w);
|
|
XtUnrealizeWidget (WIDGET(w)->widget);
|
|
return Void;
|
|
}
|
|
|
|
static Object P_Widget_Realizedp (Object w) {
|
|
Check_Widget (w);
|
|
return XtIsRealized (WIDGET(w)->widget) ? True : False;
|
|
}
|
|
|
|
static Object P_Widget_Display (Object w) {
|
|
Check_Widget (w);
|
|
return Make_Display (0, XtDisplayOfObject (WIDGET(w)->widget));
|
|
}
|
|
|
|
static Object P_Widget_Parent (Object w) {
|
|
Check_Widget (w);
|
|
return Make_Widget_Foreign (XtParent (WIDGET(w)->widget));
|
|
}
|
|
|
|
static Object P_Widget_Name (Object w) {
|
|
char *s;
|
|
|
|
Check_Widget (w);
|
|
s = XtName (WIDGET(w)->widget);
|
|
return Make_String (s, strlen (s));
|
|
}
|
|
|
|
static Object P_Widget_To_Window (Object w) {
|
|
Check_Widget (w);
|
|
return Make_Window (0, XtDisplayOfObject (WIDGET(w)->widget),
|
|
XtWindow (WIDGET(w)->widget));
|
|
}
|
|
|
|
static Object P_Widget_Compositep (Object w) {
|
|
Check_Widget (w);
|
|
return XtIsComposite (WIDGET(w)->widget) ? True : False;
|
|
}
|
|
|
|
static Object Manage_Unmanage (Object children, void (*f)()) {
|
|
register int i, n;
|
|
Widget *buf;
|
|
Object tail;
|
|
Alloca_Begin;
|
|
|
|
Check_List (children);
|
|
n = Fast_Length (children);
|
|
Alloca (buf, Widget*, n * sizeof (Widget));
|
|
for (i = 0, tail = children; i < n; i++, tail = Cdr (tail)) {
|
|
Object w;
|
|
|
|
w = Car (tail);
|
|
Check_Widget (w);
|
|
buf[i] = WIDGET(w)->widget;
|
|
}
|
|
f (buf, n);
|
|
Alloca_End;
|
|
return Void;
|
|
}
|
|
|
|
static Object P_Manage_Children (Object children) {
|
|
return Manage_Unmanage (children, XtManageChildren);
|
|
}
|
|
|
|
static Object P_Unmanage_Children (Object children) {
|
|
return Manage_Unmanage (children, XtUnmanageChildren);
|
|
}
|
|
|
|
static Object P_Widget_Managedp (Object w) {
|
|
Check_Widget (w);
|
|
return XtIsManaged (WIDGET(w)->widget) ? True : False;
|
|
}
|
|
|
|
static Object P_Widget_Class (Object w) {
|
|
Check_Widget (w);
|
|
return Make_Widget_Class (XtClass (WIDGET(w)->widget));
|
|
}
|
|
|
|
static Object P_Widget_Superclass (Object w) {
|
|
Check_Widget (w);
|
|
if (XtClass (WIDGET(w)->widget) == widgetClass)
|
|
return Sym_None;
|
|
return Make_Widget_Class (XtSuperclass (WIDGET(w)->widget));
|
|
}
|
|
|
|
static Object P_Widget_Subclassp (Object w, Object c) {
|
|
Check_Widget (w);
|
|
Check_Type (c, T_Class);
|
|
return XtIsSubclass (WIDGET(w)->widget, CLASS(c)->wclass) ? True : False;
|
|
}
|
|
|
|
static Object P_Set_Mapped_When_Managed (Object w, Object m) {
|
|
Check_Widget (w);
|
|
Check_Type (m, T_Boolean);
|
|
XtSetMappedWhenManaged (WIDGET(w)->widget, EQ(m, True));
|
|
return Void;
|
|
}
|
|
|
|
static Object P_Map_Widget (Object w) {
|
|
Check_Widget (w);
|
|
XtMapWidget (WIDGET(w)->widget);
|
|
return Void;
|
|
}
|
|
|
|
static Object P_Unmap_Widget (Object w) {
|
|
Check_Widget (w);
|
|
XtUnmapWidget (WIDGET(w)->widget);
|
|
return Void;
|
|
}
|
|
|
|
static Object P_Set_Values (int argc, Object *argv) {
|
|
ArgList a;
|
|
Widget w;
|
|
register int 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;
|
|
}
|
|
|
|
static Object P_Get_Values (int argc, Object *argv) {
|
|
Widget w;
|
|
|
|
Check_Widget (argv[0]);
|
|
w = WIDGET(argv[0])->widget;
|
|
return Get_Values (w, argc-1, argv+1);
|
|
}
|
|
|
|
static Object P_Widget_Context (Object w) {
|
|
Check_Widget (w);
|
|
return
|
|
Make_Context_Foreign (XtWidgetToApplicationContext (WIDGET(w)->widget));
|
|
}
|
|
|
|
static Object P_Set_Sensitive (Object w, Object s) {
|
|
Check_Widget (w);
|
|
Check_Type (s, T_Boolean);
|
|
XtSetSensitive (WIDGET(w)->widget, EQ(s, True));
|
|
return Void;
|
|
}
|
|
|
|
static Object P_Sensitivep (Object w) {
|
|
Check_Widget (w);
|
|
return XtIsSensitive (WIDGET(w)->widget) ? True : False;
|
|
}
|
|
|
|
static Object P_Window_To_Widget (Object w) {
|
|
Check_Type (w, T_Window);
|
|
return Make_Widget_Foreign (XtWindowToWidget (WINDOW(w)->dpy,
|
|
WINDOW(w)->win));
|
|
}
|
|
|
|
static Object P_Name_To_Widget (Object root, Object name) {
|
|
Check_Widget (root);
|
|
return Make_Widget_Foreign (XtNameToWidget (WIDGET(root)->widget,
|
|
Get_Strsym (name)));
|
|
}
|
|
|
|
static Object P_Widget_Translate_Coordinates (Object w, Object x, Object y) {
|
|
Position root_x, root_y;
|
|
|
|
Check_Widget (w);
|
|
XtTranslateCoords (WIDGET(w)->widget, Get_Integer (x), Get_Integer (y),
|
|
&root_x, &root_y);
|
|
return Cons (Make_Integer (root_x), Make_Integer (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
|
|
Boolean XtIsComposite (Widget object);
|
|
|
|
static int Widget_Visit (Object *root, int (*func)()) {
|
|
Object obj;
|
|
Widget w = WIDGET(*root)->widget;
|
|
|
|
if (WIDGET(*root)->free == 0 && XtIsComposite (w)) {
|
|
unsigned 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);
|
|
}
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
void elk_init_xt_widget () {
|
|
T_Widget = Define_Type (0, "widget", NOFUNC, sizeof (struct S_Widget),
|
|
Widget_Equal, Widget_Equal, Widget_Print, Widget_Visit);
|
|
Define_Primitive (P_Widgetp, "widget?", 1, 1, EVAL);
|
|
Define_Primitive (P_Destroy_Widget, "destroy-widget", 1, 1, EVAL);
|
|
Define_Primitive (P_Create_Shell, "create-shell", 4, MANY, VARARGS);
|
|
Define_Primitive (P_Create_Widget, "create-widget", 2, MANY, VARARGS);
|
|
Define_Primitive (P_Realize_Widget, "realize-widget", 1, 1, EVAL);
|
|
Define_Primitive (P_Unrealize_Widget, "unrealize-widget", 1, 1, EVAL);
|
|
Define_Primitive (P_Widget_Realizedp, "widget-realized?", 1, 1, EVAL);
|
|
Define_Primitive (P_Widget_Display, "widget-display", 1, 1, EVAL);
|
|
Define_Primitive (P_Widget_Parent, "widget-parent", 1, 1, EVAL);
|
|
Define_Primitive (P_Widget_Name, "widget-name", 1, 1, EVAL);
|
|
Define_Primitive (P_Widget_To_Window, "widget->window", 1, 1, EVAL);
|
|
Define_Primitive (P_Widget_Compositep, "widget-composite?", 1, 1, EVAL);
|
|
Define_Primitive (P_Manage_Children, "manage-children", 1, 1, EVAL);
|
|
Define_Primitive (P_Unmanage_Children, "unmanage-children", 1, 1, EVAL);
|
|
Define_Primitive (P_Widget_Managedp, "widget-managed?", 1, 1, EVAL);
|
|
Define_Primitive (P_Widget_Class, "widget-class", 1, 1, EVAL);
|
|
Define_Primitive (P_Widget_Superclass, "widget-superclass", 1, 1, EVAL);
|
|
Define_Primitive (P_Widget_Subclassp, "widget-subclass?", 2, 2, EVAL);
|
|
Define_Primitive (P_Set_Mapped_When_Managed,
|
|
"set-mapped-when-managed!", 2, 2, EVAL);
|
|
Define_Primitive (P_Map_Widget, "map-widget", 1, 1, EVAL);
|
|
Define_Primitive (P_Unmap_Widget, "unmap-widget", 1, 1, EVAL);
|
|
Define_Primitive (P_Set_Values, "set-values!", 1, MANY, VARARGS);
|
|
Define_Primitive (P_Get_Values, "get-values", 1, MANY, VARARGS);
|
|
Define_Primitive (P_Widget_Context, "widget-context", 1, 1, EVAL);
|
|
Define_Primitive (P_Set_Sensitive, "set-sensitive!", 2, 2, EVAL);
|
|
Define_Primitive (P_Sensitivep, "widget-sensitive?", 1, 1, EVAL);
|
|
Define_Primitive (P_Window_To_Widget, "window->widget", 1, 1, EVAL);
|
|
Define_Primitive (P_Name_To_Widget, "name->widget", 2, 2, EVAL);
|
|
Define_Primitive (P_Widget_Translate_Coordinates,
|
|
"widget-translate-coordinates", 3, 3, EVAL);
|
|
}
|