* Muahaha! No more friggin K&R stuff!
git-svn-id: svn://svn.zoy.org/elk/trunk@93 55e467fa-43c5-0310-a8a2-de718669efc6
This commit is contained in:
sam
parent
c85894ea26
commit
82a9a039c9
|
|
@ -30,7 +30,7 @@
|
|||
|
||||
#include "xt.h"
|
||||
|
||||
XtAccelerators Get_Accelerators (a) Object a; {
|
||||
XtAccelerators Get_Accelerators (Object a) {
|
||||
register char *s;
|
||||
XtAccelerators ret;
|
||||
Alloca_Begin;
|
||||
|
|
@ -42,14 +42,14 @@ XtAccelerators Get_Accelerators (a) Object a; {
|
|||
return ret;
|
||||
}
|
||||
|
||||
static Object P_Install_Accelerators (dst, src) Object dst, src; {
|
||||
static Object P_Install_Accelerators (Object dst, Object src) {
|
||||
Check_Widget (dst);
|
||||
Check_Widget (src);
|
||||
XtInstallAccelerators (WIDGET(dst)->widget, WIDGET(src)->widget);
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Install_All_Accelerators (dst, src) Object dst, src; {
|
||||
static Object P_Install_All_Accelerators (Object dst, Object src) {
|
||||
Check_Widget (dst);
|
||||
Check_Widget (src);
|
||||
XtInstallAllAccelerators (WIDGET(dst)->widget, WIDGET(src)->widget);
|
||||
|
|
@ -57,7 +57,7 @@ static Object P_Install_All_Accelerators (dst, src) Object dst, src; {
|
|||
|
||||
}
|
||||
|
||||
elk_init_xt_accelerator () {
|
||||
void elk_init_xt_accelerator () {
|
||||
Define_Primitive (P_Install_Accelerators,
|
||||
"install-accelerators", 2, 2, EVAL);
|
||||
Define_Primitive (P_Install_All_Accelerators,
|
||||
|
|
|
|||
|
|
@ -40,16 +40,14 @@ typedef struct action {
|
|||
ACTION *actions;
|
||||
|
||||
/*ARGSUSED*/
|
||||
static void Dummy_Action (w, ep, argv, argc) Widget w; XEvent *ep;
|
||||
String *argv; int *argc; {
|
||||
static void Dummy_Action (Widget w, XEvent *ep, String *argv, int *argc) {
|
||||
}
|
||||
|
||||
void Action_Hook (w, client_data, name, ep, argv, argc)
|
||||
Widget w; XtPointer client_data; char *name; XEvent *ep;
|
||||
char **argv; int *argc; {
|
||||
void Action_Hook (Widget w, XtPointer client_data, char *name, XEvent *ep,
|
||||
char **argv, int *argc) {
|
||||
ACTION *ap;
|
||||
Object args, params, tail;
|
||||
register i;
|
||||
register int i;
|
||||
GC_Node3;
|
||||
|
||||
for (ap = actions; ap; ap = ap->next) {
|
||||
|
|
@ -74,7 +72,7 @@ void Action_Hook (w, client_data, name, ep, argv, argc)
|
|||
}
|
||||
}
|
||||
|
||||
static Object P_Context_Add_Action (c, s, p) Object c, s, p; {
|
||||
static Object P_Context_Add_Action (Object c, Object s, Object p) {
|
||||
ACTION *ap;
|
||||
XtActionsRec a;
|
||||
|
||||
|
|
@ -92,10 +90,10 @@ static Object P_Context_Add_Action (c, s, p) Object c, s, p; {
|
|||
return Void;
|
||||
}
|
||||
|
||||
void Free_Actions (con) XtAppContext con; {
|
||||
void Free_Actions (XtAppContext con) {
|
||||
register ACTION *p, **pp;
|
||||
|
||||
for (pp = &actions; p = *pp; ) {
|
||||
for (pp = &actions; (p = *pp); ) {
|
||||
if (p->con == con) {
|
||||
Deregister_Function (p->num);
|
||||
XtFree (p->name);
|
||||
|
|
@ -105,6 +103,6 @@ void Free_Actions (con) XtAppContext con; {
|
|||
}
|
||||
}
|
||||
|
||||
elk_init_xt_action () {
|
||||
void elk_init_xt_action () {
|
||||
Define_Primitive (P_Context_Add_Action, "context-add-action", 3, 3, EVAL);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -30,18 +30,20 @@
|
|||
|
||||
#include "xt.h"
|
||||
|
||||
void Remove_All_Callbacks (Widget w);
|
||||
|
||||
typedef struct {
|
||||
PFX2S converter;
|
||||
int num;
|
||||
} CLIENT_DATA;
|
||||
|
||||
Object Get_Callbackfun (c) XtPointer c; {
|
||||
Object Get_Callbackfun (XtPointer c) {
|
||||
register CLIENT_DATA *cd = (CLIENT_DATA *)c;
|
||||
return cd ? Get_Function (cd->num) : False;
|
||||
}
|
||||
|
||||
static void Callback_Proc (w, client_data, call_data) Widget w;
|
||||
XtPointer client_data, call_data; {
|
||||
static void Callback_Proc (Widget w, XtPointer client_data,
|
||||
XtPointer call_data) {
|
||||
register CLIENT_DATA *cd = (CLIENT_DATA *)client_data;
|
||||
Object args;
|
||||
GC_Node;
|
||||
|
|
@ -56,8 +58,8 @@ static void Callback_Proc (w, client_data, call_data) Widget w;
|
|||
}
|
||||
|
||||
/*ARGSUSED*/
|
||||
void Destroy_Callback_Proc (w, client_data, call_data) Widget w;
|
||||
XtPointer client_data, call_data; {
|
||||
void Destroy_Callback_Proc (Widget w, XtPointer client_data,
|
||||
XtPointer call_data) {
|
||||
Object x;
|
||||
|
||||
x = Find_Object (T_Widget, (GENERIC)0, Match_Xt_Obj, w);
|
||||
|
|
@ -77,13 +79,13 @@ void Destroy_Callback_Proc (w, client_data, call_data) Widget w;
|
|||
* must be called to remove the Destroy_Callback_Proc() and put
|
||||
* it back to the end of the callback list.
|
||||
*/
|
||||
void Fiddle_Destroy_Callback (w) Widget w; {
|
||||
void Fiddle_Destroy_Callback (Widget w) {
|
||||
XtRemoveCallback (w, XtNdestroyCallback, Destroy_Callback_Proc,
|
||||
(XtPointer)0);
|
||||
XtAddCallback (w, XtNdestroyCallback, Destroy_Callback_Proc, (XtPointer)0);
|
||||
}
|
||||
|
||||
void Check_Callback_List (x) Object x; {
|
||||
void Check_Callback_List (Object x) {
|
||||
Object tail;
|
||||
|
||||
Check_List (x);
|
||||
|
|
@ -91,9 +93,9 @@ void Check_Callback_List (x) Object x; {
|
|||
Check_Procedure (Car (tail));
|
||||
}
|
||||
|
||||
static Object P_Add_Callbacks (w, name, cbl) Object w, name, cbl; {
|
||||
static Object P_Add_Callbacks (Object w, Object name, Object cbl) {
|
||||
register char *s;
|
||||
register n;
|
||||
register int n;
|
||||
XtCallbackList callbacks;
|
||||
Alloca_Begin;
|
||||
|
||||
|
|
@ -114,10 +116,10 @@ static Object P_Add_Callbacks (w, name, cbl) Object w, name, cbl; {
|
|||
return Void;
|
||||
}
|
||||
|
||||
void Fill_Callbacks (src, dst, n, conv) Object src; XtCallbackList dst;
|
||||
register n; PFX2S conv; {
|
||||
void Fill_Callbacks (Object src, XtCallbackList dst, register int n,
|
||||
PFX2S conv) {
|
||||
register CLIENT_DATA *cd;
|
||||
register i, j;
|
||||
register int i, j;
|
||||
Object tail;
|
||||
|
||||
for (i = 0, tail = src; i < n; i++, tail = Cdr (tail)) {
|
||||
|
|
@ -130,12 +132,12 @@ void Fill_Callbacks (src, dst, n, conv) Object src; XtCallbackList dst;
|
|||
}
|
||||
}
|
||||
|
||||
Remove_All_Callbacks (w) Widget w; {
|
||||
void Remove_All_Callbacks (Widget w) {
|
||||
Arg a[1];
|
||||
XtCallbackList c;
|
||||
XtResource *r;
|
||||
int nr, nc;
|
||||
register i, j;
|
||||
register int i, j;
|
||||
|
||||
Get_All_Resources (0, w, XtClass (w), &r, &nr, &nc);
|
||||
for (j = 0; j < nr; j++) {
|
||||
|
|
@ -154,6 +156,6 @@ Remove_All_Callbacks (w) Widget w; {
|
|||
XtFree ((char *)r);
|
||||
}
|
||||
|
||||
elk_init_xt_callback () {
|
||||
void elk_init_xt_callback () {
|
||||
Define_Primitive (P_Add_Callbacks, "add-callbacks", 3, 3, EVAL);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -54,7 +54,7 @@ Generic_Simple_Equal (Class, CLASS, wclass)
|
|||
|
||||
Generic_Print (Class, "#[class %s]", CLASS(x)->name)
|
||||
|
||||
Object Make_Class (class, name) WidgetClass class; char *name; {
|
||||
Object Make_Class (WidgetClass class, char *name) {
|
||||
Object c;
|
||||
|
||||
c = Find_Object (T_Class, (GENERIC)0, Match_Xt_Obj, class);
|
||||
|
|
@ -70,7 +70,7 @@ Object Make_Class (class, name) WidgetClass class; char *name; {
|
|||
return c;
|
||||
}
|
||||
|
||||
Object Make_Widget_Class (class) WidgetClass class; {
|
||||
Object Make_Widget_Class (WidgetClass class) {
|
||||
register CLASS_INFO *p;
|
||||
|
||||
for (p = ctab; p < clast; p++)
|
||||
|
|
@ -80,7 +80,7 @@ Object Make_Widget_Class (class) WidgetClass class; {
|
|||
/*NOTREACHED*/
|
||||
}
|
||||
|
||||
static Object P_Find_Class (name) Object name; {
|
||||
static Object P_Find_Class (Object name) {
|
||||
register CLASS_INFO *p;
|
||||
register char *s = Get_Strsym (name);
|
||||
|
||||
|
|
@ -92,7 +92,7 @@ static Object P_Find_Class (name) Object name; {
|
|||
/*NOTREACHED*/
|
||||
}
|
||||
|
||||
static Object P_Class_Existsp (name) Object name; {
|
||||
static Object P_Class_Existsp (Object name) {
|
||||
register CLASS_INFO *p;
|
||||
register char *s = Get_Strsym (name);
|
||||
|
||||
|
|
@ -103,7 +103,7 @@ static Object P_Class_Existsp (name) Object name; {
|
|||
return False;
|
||||
}
|
||||
|
||||
char *Class_Name (class) WidgetClass class; {
|
||||
char *Class_Name (WidgetClass class) {
|
||||
register CLASS_INFO *p;
|
||||
|
||||
for (p = ctab; p < clast && p->class != class; p++)
|
||||
|
|
@ -113,8 +113,8 @@ char *Class_Name (class) WidgetClass class; {
|
|||
return p->name;
|
||||
}
|
||||
|
||||
void Get_Sub_Resource_List (class, rp, np) WidgetClass class;
|
||||
XtResourceList *rp; Cardinal *np; {
|
||||
void Get_Sub_Resource_List (WidgetClass class, XtResourceList *rp,
|
||||
Cardinal *np) {
|
||||
register CLASS_INFO *p;
|
||||
|
||||
for (p = ctab; p < clast && p->class != class; p++)
|
||||
|
|
@ -125,23 +125,22 @@ void Get_Sub_Resource_List (class, rp, np) WidgetClass class;
|
|||
*rp = p->sub_resources;
|
||||
}
|
||||
|
||||
static Object P_Class_Resources (c) Object c; {
|
||||
static Object P_Class_Resources (Object c) {
|
||||
Check_Type (c, T_Class);
|
||||
return Get_Resources (CLASS(c)->wclass, XtGetResourceList, 1);
|
||||
}
|
||||
|
||||
static Object P_Class_Constraint_Resources (c) Object c; {
|
||||
static Object P_Class_Constraint_Resources (Object c) {
|
||||
Check_Type (c, T_Class);
|
||||
return Get_Resources (CLASS(c)->wclass, XtGetConstraintResourceList, 1);
|
||||
}
|
||||
|
||||
static Object P_Class_Sub_Resources (c) Object c; {
|
||||
static Object P_Class_Sub_Resources (Object c) {
|
||||
Check_Type (c, T_Class);
|
||||
return Get_Resources (CLASS(c)->wclass, Get_Sub_Resource_List, 0);
|
||||
}
|
||||
|
||||
void Define_Class (name, class, r, nr) char *name; WidgetClass class;
|
||||
XtResourceList r; {
|
||||
void Define_Class (char *name, WidgetClass class, XtResourceList r, int nr) {
|
||||
Set_Error_Tag ("define-class");
|
||||
if (clast == ctab+MAX_CLASS)
|
||||
Primitive_Error ("too many widget classes");
|
||||
|
|
@ -166,7 +165,7 @@ void Define_Class (name, class, r, nr) char *name; WidgetClass class;
|
|||
clast++;
|
||||
}
|
||||
|
||||
void Define_Callback (cl, s, has_arg) char *cl, *s; {
|
||||
void Define_Callback (char *cl, char *s, int has_arg) {
|
||||
register CLASS_INFO *p;
|
||||
|
||||
Set_Error_Tag ("define-callback");
|
||||
|
|
@ -182,8 +181,7 @@ void Define_Callback (cl, s, has_arg) char *cl, *s; {
|
|||
Primitive_Error ("undefined class");
|
||||
}
|
||||
|
||||
PFX2S Find_Callback_Converter (c, name, sname) WidgetClass c; char *name;
|
||||
Object sname; {
|
||||
PFX2S Find_Callback_Converter (WidgetClass c, char *name, Object sname) {
|
||||
register CLASS_INFO *p;
|
||||
register CALLBACK_INFO *q;
|
||||
PFX2S conv;
|
||||
|
|
@ -208,7 +206,7 @@ PFX2S Find_Callback_Converter (c, name, sname) WidgetClass c; char *name;
|
|||
if (conv == 0) {
|
||||
sprintf (msg,
|
||||
"no callback converter for %s or %s",
|
||||
s1, s2, name);
|
||||
s1, s2);
|
||||
Primitive_Error (msg);
|
||||
}
|
||||
}
|
||||
|
|
@ -221,7 +219,7 @@ PFX2S Find_Callback_Converter (c, name, sname) WidgetClass c; char *name;
|
|||
/*NOTREACHED*/
|
||||
}
|
||||
|
||||
elk_init_xt_class () {
|
||||
void elk_init_xt_class () {
|
||||
Generic_Define (Class, "class", "class?");
|
||||
Define_Primitive (P_Find_Class, "find-class", 1, 1, EVAL);
|
||||
Define_Primitive (P_Class_Resources, "class-resources", 1, 1, EVAL);
|
||||
|
|
|
|||
|
|
@ -33,7 +33,7 @@
|
|||
#include <X11/IntrinsicP.h>
|
||||
#include <X11/CoreP.h>
|
||||
|
||||
Object Xt_Class_Name (class) WidgetClass class; {
|
||||
Object Xt_Class_Name (WidgetClass class) {
|
||||
return Make_String (class->core_class.class_name,
|
||||
strlen (class->core_class.class_name));
|
||||
}
|
||||
|
|
|
|||
|
|
@ -52,7 +52,7 @@ Generic_Equal (Context, CONTEXT, context)
|
|||
|
||||
Generic_Print (Context, "#[context %lu]", POINTER(x))
|
||||
|
||||
static Object Internal_Make_Context (finalize, context) XtAppContext context; {
|
||||
static Object Internal_Make_Context (int finalize, XtAppContext context) {
|
||||
Object c;
|
||||
|
||||
c = Find_Object (T_Context, (GENERIC)0, Match_Xt_Obj, context);
|
||||
|
|
@ -71,15 +71,15 @@ static Object Internal_Make_Context (finalize, context) XtAppContext context; {
|
|||
}
|
||||
|
||||
/* Backwards compatibility: */
|
||||
Object Make_Context (context) XtAppContext context; {
|
||||
Object Make_Context (XtAppContext context) {
|
||||
return Internal_Make_Context (1, context);
|
||||
}
|
||||
|
||||
Object Make_Context_Foreign (context) XtAppContext context; {
|
||||
Object Make_Context_Foreign (XtAppContext context) {
|
||||
return Internal_Make_Context (0, context);
|
||||
}
|
||||
|
||||
void Check_Context (c) Object c; {
|
||||
void Check_Context (Object c) {
|
||||
Check_Type (c, T_Context);
|
||||
if (CONTEXT(c)->free)
|
||||
Primitive_Error ("invalid context: ~s", c);
|
||||
|
|
@ -89,7 +89,7 @@ static Object P_Create_Context () {
|
|||
return Make_Context (XtCreateApplicationContext ());
|
||||
}
|
||||
|
||||
static Object P_Destroy_Context (c) Object c; {
|
||||
static Object P_Destroy_Context (Object c) {
|
||||
Check_Context (c);
|
||||
Free_Actions (CONTEXT(c)->context);
|
||||
XtDestroyApplicationContext (CONTEXT(c)->context);
|
||||
|
|
@ -98,12 +98,12 @@ static Object P_Destroy_Context (c) Object c; {
|
|||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Initialize_Display (c, d, name, class)
|
||||
Object c, d, name, class; {
|
||||
static Object P_Initialize_Display (Object c, Object d, Object name,
|
||||
Object class) {
|
||||
register char *sn = 0, *sc = "", *sd = 0;
|
||||
Display *dpy;
|
||||
extern char **Argv;
|
||||
extern First_Arg, Argc;
|
||||
extern int First_Arg, Argc;
|
||||
int argc = Argc - First_Arg + 1;
|
||||
|
||||
Argv[First_Arg-1] = "elk";
|
||||
|
|
@ -124,25 +124,27 @@ static Object P_Initialize_Display (c, d, name, class)
|
|||
(XrmOptionDescRec *)0, 0, &argc, &Argv[First_Arg-1]);
|
||||
Argc = First_Arg + argc - 1;
|
||||
if (dpy == 0)
|
||||
{
|
||||
if (sd)
|
||||
Primitive_Error ("cannot open display ~s", d);
|
||||
else
|
||||
Primitive_Error ("cannot open display");
|
||||
}
|
||||
return Make_Display (0, dpy);
|
||||
}
|
||||
|
||||
/* Due to a bug in Xt this function drops core when invoked with a
|
||||
* display not owned by Xt.
|
||||
*/
|
||||
static Object P_Display_To_Context (d) Object d; {
|
||||
static Object P_Display_To_Context (Object d) {
|
||||
Check_Type (d, T_Display);
|
||||
return
|
||||
Make_Context_Foreign (XtDisplayToApplicationContext (DISPLAY(d)->dpy));
|
||||
}
|
||||
|
||||
static Object P_Set_Context_Fallback_Resources (argc, argv) Object *argv; {
|
||||
static Object P_Set_Context_Fallback_Resources (int argc, Object *argv) {
|
||||
register char **p = 0;
|
||||
register i;
|
||||
register int i;
|
||||
struct S_String *sp;
|
||||
Object con;
|
||||
|
||||
|
|
@ -164,19 +166,20 @@ static Object P_Set_Context_Fallback_Resources (argc, argv) Object *argv; {
|
|||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Context_Main_Loop (c) Object c; {
|
||||
static Object P_Context_Main_Loop (Object c) {
|
||||
Check_Context (c);
|
||||
XtAppMainLoop (CONTEXT(c)->context);
|
||||
/*NOTREACHED*/
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Context_Pending (c) Object c; {
|
||||
static Object P_Context_Pending (Object c) {
|
||||
Check_Context (c);
|
||||
return Bits_To_Symbols ((unsigned long)XtAppPending (CONTEXT(c)->context),
|
||||
1, XtIM_Syms);
|
||||
}
|
||||
|
||||
static Object P_Context_Process_Event (argc, argv) Object *argv; {
|
||||
static Object P_Context_Process_Event (int argc, Object *argv) {
|
||||
XtInputMask mask = XtIMAll;
|
||||
|
||||
Check_Context (argv[0]);
|
||||
|
|
@ -186,7 +189,7 @@ static Object P_Context_Process_Event (argc, argv) Object *argv; {
|
|||
return Void;
|
||||
}
|
||||
|
||||
static Boolean Work_Proc (client_data) XtPointer client_data; {
|
||||
static Boolean Work_Proc (XtPointer client_data) {
|
||||
Object ret;
|
||||
|
||||
ret = Funcall (Get_Function ((int)client_data), Null, 0);
|
||||
|
|
@ -195,9 +198,9 @@ static Boolean Work_Proc (client_data) XtPointer client_data; {
|
|||
return Truep (ret);
|
||||
}
|
||||
|
||||
static Object P_Context_Add_Work_Proc (c, p) Object c, p; {
|
||||
static Object P_Context_Add_Work_Proc (Object c, Object p) {
|
||||
XtWorkProcId id;
|
||||
register i;
|
||||
register int i;
|
||||
|
||||
Check_Context (c);
|
||||
Check_Procedure (p);
|
||||
|
|
@ -206,16 +209,15 @@ static Object P_Context_Add_Work_Proc (c, p) Object c, p; {
|
|||
return Make_Id ('w', (XtPointer)id, i);
|
||||
}
|
||||
|
||||
static Object P_Remove_Work_Proc (id) Object id; {
|
||||
static Object P_Remove_Work_Proc (Object id) {
|
||||
XtRemoveWorkProc ((XtWorkProcId)Use_Id (id, 'w'));
|
||||
Deregister_Function (IDENTIFIER(id)->num);
|
||||
return Void;
|
||||
}
|
||||
|
||||
static void Timeout_Proc (client_data, id)
|
||||
XtPointer client_data; XtIntervalId *id; {
|
||||
static void Timeout_Proc (XtPointer client_data, XtIntervalId *id) {
|
||||
Object proc, args;
|
||||
register i = (int)client_data;
|
||||
register int i = (int)client_data;
|
||||
|
||||
args = Cons (Make_Id ('t', (XtPointer)*id, i), Null);
|
||||
proc = Get_Function (i);
|
||||
|
|
@ -223,9 +225,9 @@ static void Timeout_Proc (client_data, id)
|
|||
(void)Funcall (proc, args, 0);
|
||||
}
|
||||
|
||||
static Object P_Context_Add_Timeout (c, n, p) Object c, n, p; {
|
||||
static Object P_Context_Add_Timeout (Object c, Object n, Object p) {
|
||||
XtIntervalId id;
|
||||
register i;
|
||||
register int i;
|
||||
|
||||
Check_Context (c);
|
||||
Check_Procedure (p);
|
||||
|
|
@ -235,15 +237,14 @@ static Object P_Context_Add_Timeout (c, n, p) Object c, n, p; {
|
|||
return Make_Id ('t', (XtPointer)id, i);
|
||||
}
|
||||
|
||||
static Object P_Remove_Timeout (id) Object id; {
|
||||
static Object P_Remove_Timeout (Object id) {
|
||||
XtRemoveTimeOut ((XtIntervalId)Use_Id (id, 't'));
|
||||
Deregister_Function (IDENTIFIER(id)->num);
|
||||
return Void;
|
||||
}
|
||||
|
||||
/*ARGSUSED*/
|
||||
static void Input_Proc (client_data, src, id) XtPointer client_data; int *src;
|
||||
XtInputId *id; {
|
||||
static void Input_Proc (XtPointer client_data, int *src, XtInputId *id) {
|
||||
Object p, args;
|
||||
GC_Node2;
|
||||
|
||||
|
|
@ -256,11 +257,11 @@ static void Input_Proc (client_data, src, id) XtPointer client_data; int *src;
|
|||
(void)Funcall (Cdr (p), args, 0);
|
||||
}
|
||||
|
||||
static Object P_Context_Add_Input (argc, argv) Object *argv; {
|
||||
static Object P_Context_Add_Input (int argc, Object *argv) {
|
||||
Object c, src, p;
|
||||
XtInputId id;
|
||||
XtInputMask m;
|
||||
register i;
|
||||
register int i;
|
||||
|
||||
c = argv[0], src = argv[1], p = argv[2];
|
||||
Check_Context (c);
|
||||
|
|
@ -285,13 +286,13 @@ static Object P_Context_Add_Input (argc, argv) Object *argv; {
|
|||
return Make_Id ('i', (XtPointer)id, i);
|
||||
}
|
||||
|
||||
static Object P_Remove_Input (id) Object id; {
|
||||
static Object P_Remove_Input (Object id) {
|
||||
XtRemoveInput ((XtInputId)Use_Id (id, 'i'));
|
||||
Deregister_Function (IDENTIFIER(id)->num);
|
||||
return Void;
|
||||
}
|
||||
|
||||
elk_init_xt_context () {
|
||||
void elk_init_xt_context () {
|
||||
Generic_Define (Context, "context", "context?");
|
||||
Define_Primitive (P_Create_Context, "create-context", 0, 0, EVAL);
|
||||
Define_Primitive (P_Destroy_Context, "destroy-context", 1, 1, EVAL);
|
||||
|
|
|
|||
|
|
@ -41,7 +41,7 @@ typedef struct {
|
|||
|
||||
static CONVERTER ctab[MAX_CONVERTER], *clast = ctab;
|
||||
|
||||
void Define_Converter_To_Scheme (name, c) char *name; PFX2S c; {
|
||||
void Define_Converter_To_Scheme (char *name, PFX2S c) {
|
||||
Set_Error_Tag ("c->scheme");
|
||||
if (clast == ctab+MAX_CONVERTER)
|
||||
Primitive_Error ("too many converters");
|
||||
|
|
@ -51,7 +51,7 @@ void Define_Converter_To_Scheme (name, c) char *name; PFX2S c; {
|
|||
clast++;
|
||||
}
|
||||
|
||||
void Define_Converter_To_C (name, c) char *name; PFS2X c; {
|
||||
void Define_Converter_To_C (char *name, PFS2X c) {
|
||||
Set_Error_Tag ("scheme->c");
|
||||
if (clast == ctab+MAX_CONVERTER)
|
||||
Primitive_Error ("too many converters");
|
||||
|
|
@ -61,7 +61,7 @@ void Define_Converter_To_C (name, c) char *name; PFS2X c; {
|
|||
clast++;
|
||||
}
|
||||
|
||||
PFX2S Find_Converter_To_Scheme (name) char *name; {
|
||||
PFX2S Find_Converter_To_Scheme (char *name) {
|
||||
register CONVERTER *p;
|
||||
|
||||
for (p = ctab; p < clast; p++)
|
||||
|
|
@ -70,7 +70,7 @@ PFX2S Find_Converter_To_Scheme (name) char *name; {
|
|||
return 0;
|
||||
}
|
||||
|
||||
PFS2X Find_Converter_To_C (name) char *name; {
|
||||
PFS2X Find_Converter_To_C (char *name) {
|
||||
register CONVERTER *p;
|
||||
|
||||
for (p = ctab; p < clast; p++)
|
||||
|
|
|
|||
|
|
@ -30,11 +30,11 @@
|
|||
|
||||
#include "xt.h"
|
||||
|
||||
static max_functions = 512;
|
||||
static int max_functions = 512;
|
||||
static Object Functions;
|
||||
|
||||
int Register_Function (x) Object x; {
|
||||
register i;
|
||||
int Register_Function (Object x) {
|
||||
register int i;
|
||||
Object v;
|
||||
GC_Node;
|
||||
|
||||
|
|
@ -53,15 +53,15 @@ int Register_Function (x) Object x; {
|
|||
return i;
|
||||
}
|
||||
|
||||
Object Get_Function (i) int i; {
|
||||
Object Get_Function (int i) {
|
||||
return VECTOR(Functions)->data[i];
|
||||
}
|
||||
|
||||
void Deregister_Function (i) int i; {
|
||||
void Deregister_Function (int i) {
|
||||
VECTOR(Functions)->data[i] = Null;
|
||||
}
|
||||
|
||||
elk_init_xt_function () {
|
||||
void elk_init_xt_function () {
|
||||
Functions = Make_Vector (max_functions, Null);
|
||||
Global_GC_Link (Functions);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -32,14 +32,14 @@
|
|||
|
||||
Generic_Predicate (Identifier)
|
||||
|
||||
static Identifier_Equal (x, y) Object x, y; {
|
||||
static int Identifier_Equal (Object x, Object y) {
|
||||
register struct S_Identifier *p = IDENTIFIER(x), *q = IDENTIFIER(y);
|
||||
return p->type == q->type && p->val == q->val && !p->free && !q->free;
|
||||
}
|
||||
|
||||
Generic_Print (Identifier, "#[identifier %lu]", POINTER(x))
|
||||
|
||||
Object Make_Id (type, val, num) XtPointer val; {
|
||||
Object Make_Id (int type, XtPointer val, int num) {
|
||||
Object i;
|
||||
|
||||
i = Find_Object (T_Identifier, (GENERIC)0, Match_Xt_Obj, type, val);
|
||||
|
|
@ -55,7 +55,7 @@ Object Make_Id (type, val, num) XtPointer val; {
|
|||
return i;
|
||||
}
|
||||
|
||||
XtPointer Use_Id (x, type) Object x; {
|
||||
XtPointer Use_Id (Object x, int type) {
|
||||
Check_Type (x, T_Identifier);
|
||||
if (IDENTIFIER(x)->type != type || IDENTIFIER(x)->free)
|
||||
Primitive_Error ("invalid identifier");
|
||||
|
|
@ -64,6 +64,6 @@ XtPointer Use_Id (x, type) Object x; {
|
|||
return IDENTIFIER(x)->val;
|
||||
}
|
||||
|
||||
elk_init_xt_identifier () {
|
||||
void elk_init_xt_identifier () {
|
||||
Generic_Define (Identifier, "identifier", "identifier?");
|
||||
}
|
||||
|
|
|
|||
|
|
@ -64,7 +64,7 @@
|
|||
(check-string 'c->scheme name 'name)
|
||||
(define c-name (scheme-to-c-name name))
|
||||
(string-set! c-name 0 #\S)
|
||||
(format f "static Object ~a (x) XtArgVal x; {~%" c-name)
|
||||
(format f "static Object ~a (XtArgVal x) {~%" c-name)
|
||||
(display body f)
|
||||
(format f "~%}~%~%")
|
||||
(define s
|
||||
|
|
@ -76,7 +76,7 @@
|
|||
(check-string 'scheme->c name 'name)
|
||||
(define c-name (scheme-to-c-name name))
|
||||
(string-set! c-name 0 #\C)
|
||||
(format f "static XtArgVal ~a (x) Object x; {~%" c-name)
|
||||
(format f "static XtArgVal ~a (Object x) {~%" c-name)
|
||||
(display body f)
|
||||
(format f "~%}~%~%")
|
||||
(define s
|
||||
|
|
@ -91,18 +91,11 @@
|
|||
(define c-name (scheme-to-c-name scheme-name))
|
||||
(format f "static Object ~a (" c-name)
|
||||
(do ((a args a)) ((null? a))
|
||||
(display "Object " f)
|
||||
(display (car a) f)
|
||||
(set! a (cdr a))
|
||||
(if (not (null? a)) (display ", " f)))
|
||||
(display ") " f)
|
||||
(if (not (null? args))
|
||||
(begin
|
||||
(display "Object " f)
|
||||
(do ((a args a)) ((null? a))
|
||||
(display (car a) f)
|
||||
(set! a (cdr a))
|
||||
(if (not (null? a)) (display ", " f)))
|
||||
(display "; {" f)))
|
||||
(display ") {" f)
|
||||
(newline f)
|
||||
(display body f)
|
||||
(format f "~%}~%~%")
|
||||
|
|
@ -161,7 +154,7 @@
|
|||
(load (car args))
|
||||
(if (not type-name)
|
||||
(error 'mkwidget "no widget type defined"))
|
||||
(format f "elk_init_~a_~a () {~%" widget-set type-name)
|
||||
(format f "void elk_init_~a_~a () {~%" widget-set type-name)
|
||||
(if (not (null? classes))
|
||||
(format f " XtResourceList r = 0;~%"))
|
||||
(do ((c classes (cdr c))) ((null? c))
|
||||
|
|
|
|||
|
|
@ -30,6 +30,6 @@
|
|||
|
||||
#include "scheme.h"
|
||||
|
||||
elk_init_motif_init () {
|
||||
void elk_init_motif_init () {
|
||||
P_Provide (Intern ("motif-widgets.so"));
|
||||
}
|
||||
|
|
|
|||
|
|
@ -33,7 +33,7 @@
|
|||
|
||||
(prolog
|
||||
|
||||
"static Object String_Table_To_Scheme (tab, len) XmString *tab; {
|
||||
"static Object String_Table_To_Scheme (XmString *tab, int len) {
|
||||
Object ret, tail;
|
||||
char *text;
|
||||
GC_Node2;
|
||||
|
|
@ -60,7 +60,7 @@
|
|||
|
||||
(prolog
|
||||
|
||||
"static Object Get_List_CB (p) XmListCallbackStruct *p; {
|
||||
"static Object Get_List_CB (XmListCallbackStruct *p) {
|
||||
Object ret, s;
|
||||
char *text;
|
||||
GC_Node2;
|
||||
|
|
|
|||
|
|
@ -44,8 +44,8 @@
|
|||
|
||||
(prolog
|
||||
|
||||
"static void Post_Handler (w, client_data, event, unused) Widget w;
|
||||
XtPointer client_data; XEvent *event; Boolean *unused; {
|
||||
"static void Post_Handler (Widget w, XtPointer client_data, XEvent *event,
|
||||
Boolean *unused) {
|
||||
unsigned int b;
|
||||
Arg a;
|
||||
XButtonPressedEvent *ep = (XButtonPressedEvent *)event;
|
||||
|
|
@ -61,7 +61,7 @@
|
|||
|
||||
(prolog
|
||||
|
||||
"static Object Get_Row_Column_CB (p) XmRowColumnCallbackStruct *p; {
|
||||
"static Object Get_Row_Column_CB (XmRowColumnCallbackStruct *p) {
|
||||
Object ret, s;
|
||||
GC_Node2;
|
||||
|
||||
|
|
|
|||
|
|
@ -33,7 +33,7 @@
|
|||
|
||||
(prolog
|
||||
|
||||
"static Object Get_Scale_CB (p) XmScaleCallbackStruct *p; {
|
||||
"static Object Get_Scale_CB (XmScaleCallbackStruct *p) {
|
||||
Object ret, s;
|
||||
extern SYMDESCR Reason_Syms[];
|
||||
GC_Node2;
|
||||
|
|
|
|||
|
|
@ -33,7 +33,7 @@
|
|||
|
||||
(prolog
|
||||
|
||||
"static Object Get_Scrollbar_CB (p) XmScrollBarCallbackStruct *p; {
|
||||
"static Object Get_Scrollbar_CB (XmScrollBarCallbackStruct *p) {
|
||||
Object ret, s;
|
||||
GC_Node2;
|
||||
|
||||
|
|
|
|||
|
|
@ -76,7 +76,7 @@
|
|||
|
||||
(prolog
|
||||
|
||||
"Object Get_Any_CB (p) XmAnyCallbackStruct *p; {
|
||||
"Object Get_Any_CB (XmAnyCallbackStruct *p) {
|
||||
Object args, ret;
|
||||
GC_Node2;
|
||||
|
||||
|
|
@ -95,7 +95,7 @@
|
|||
|
||||
(prolog
|
||||
|
||||
"Object Get_Selection_CB (p) XmSelectionBoxCallbackStruct *p; {
|
||||
"Object Get_Selection_CB (XmSelectionBoxCallbackStruct *p) {
|
||||
Object ret, s;
|
||||
char *text;
|
||||
GC_Node2;
|
||||
|
|
@ -114,7 +114,7 @@
|
|||
|
||||
(prolog
|
||||
|
||||
"static XtArgVal Scheme_To_String_Table (x) Object x; {
|
||||
"static XtArgVal Scheme_To_String_Table (Object x) {
|
||||
Object t;
|
||||
char *s;
|
||||
XmString *tab;
|
||||
|
|
|
|||
|
|
@ -37,7 +37,7 @@ static SYMDESCR Grab_Kind_Syms[] = {
|
|||
{ 0, 0 }
|
||||
};
|
||||
|
||||
static Object P_Create_Popup_Shell (argc, argv) Object *argv; {
|
||||
static Object P_Create_Popup_Shell (int argc, Object *argv) {
|
||||
ArgList a;
|
||||
char *name = 0;
|
||||
Object x, class, parent, ret;
|
||||
|
|
@ -61,20 +61,20 @@ static Object P_Create_Popup_Shell (argc, argv) Object *argv; {
|
|||
return ret;
|
||||
}
|
||||
|
||||
static Object P_Popup (shell, grab_kind) Object shell, grab_kind; {
|
||||
static Object P_Popup (Object shell, Object grab_kind) {
|
||||
Check_Widget (shell);
|
||||
XtPopup (WIDGET(shell)->widget, Symbols_To_Bits (grab_kind, 0,
|
||||
Grab_Kind_Syms));
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Popdown (shell) Object shell; {
|
||||
static Object P_Popdown (Object shell) {
|
||||
Check_Widget (shell);
|
||||
XtPopdown (WIDGET(shell)->widget);
|
||||
return Void;
|
||||
}
|
||||
|
||||
elk_init_xt_popup () {
|
||||
void elk_init_xt_popup () {
|
||||
Define_Primitive (P_Create_Popup_Shell, "create-popup-shell",
|
||||
2, MANY, VARARGS);
|
||||
Define_Primitive (P_Popup, "popup", 2, 2, EVAL);
|
||||
|
|
|
|||
|
|
@ -48,7 +48,7 @@
|
|||
#define T_Cardinal -10
|
||||
#define T_Accelerators -11
|
||||
|
||||
static Resource_To_Scheme_Type (t) register char *t; {
|
||||
static int Resource_To_Scheme_Type (register char *t) {
|
||||
if (streq (XtRAcceleratorTable, t))
|
||||
return T_Accelerators;
|
||||
else if (streq (XtRBackingStore, t))
|
||||
|
|
@ -102,8 +102,8 @@ static Resource_To_Scheme_Type (t) register char *t; {
|
|||
return T_Unknown;
|
||||
}
|
||||
|
||||
void Get_All_Resources (sub, w, c, rp, np, cp) Widget w; WidgetClass c;
|
||||
XtResource **rp; int *np, *cp; {
|
||||
void Get_All_Resources (int sub, Widget w, WidgetClass c, XtResource **rp,
|
||||
int *np, int *cp) {
|
||||
XtResource *r, *sr, *cr;
|
||||
int nr, snr = 0, cnr = 0;
|
||||
|
||||
|
|
@ -126,10 +126,10 @@ void Get_All_Resources (sub, w, c, rp, np, cp) Widget w; WidgetClass c;
|
|||
}
|
||||
}
|
||||
|
||||
void Convert_Args (ac, av, to, widget, class) Object *av; ArgList to;
|
||||
Widget widget; WidgetClass class; {
|
||||
void Convert_Args (int ac, Object *av, ArgList to, Widget widget,
|
||||
WidgetClass class) {
|
||||
register char *name, *res;
|
||||
register i, j, k;
|
||||
register int i, j, k;
|
||||
Object arg, val;
|
||||
XtResource *r;
|
||||
int nr, nc;
|
||||
|
|
@ -274,9 +274,9 @@ done: ;
|
|||
XtFree ((char *)r);
|
||||
}
|
||||
|
||||
Object Get_Values (w, ac, av) Widget w; Object *av; {
|
||||
Object Get_Values (Widget w, int ac, Object *av) {
|
||||
register char *name;
|
||||
register i, j;
|
||||
register int i, j;
|
||||
Object arg;
|
||||
XtResource *r;
|
||||
int nr, nc;
|
||||
|
|
@ -334,9 +334,9 @@ Object Get_Values (w, ac, av) Widget w; Object *av; {
|
|||
|
||||
if (converter) {
|
||||
o = converter (*(XtArgVal *)val);
|
||||
} else if (converter = Find_Converter_To_Scheme (argl[i].name)) {
|
||||
} else if ((converter = Find_Converter_To_Scheme (argl[i].name))) {
|
||||
o = converter (*(XtArgVal *)val);
|
||||
} else if (converter = Find_Converter_To_Scheme (r[j].resource_type)) {
|
||||
} else if ((converter = Find_Converter_To_Scheme (r[j].resource_type))) {
|
||||
o = converter (*(XtArgVal *)val);
|
||||
} else if (t == T_String_Or_Symbol) {
|
||||
char *s = *(char **)val;
|
||||
|
|
@ -344,7 +344,7 @@ Object Get_Values (w, ac, av) Widget w; Object *av; {
|
|||
if (s == 0) s = "";
|
||||
o = Make_String (s, strlen (s));
|
||||
} else if (t == T_Callbacklist) {
|
||||
register i, n;
|
||||
register int i, n;
|
||||
Object ret, tail;
|
||||
XtCallbackList callbacks = *(XtCallbackList *)val;
|
||||
GC_Node;
|
||||
|
|
@ -422,7 +422,7 @@ Object Get_Values (w, ac, av) Widget w; Object *av; {
|
|||
|
||||
/* Convert `mapped-when-managed' to `mappedWhenManaged'.
|
||||
*/
|
||||
void Make_Resource_Name (s) register char *s; {
|
||||
void Make_Resource_Name (register char *s) {
|
||||
register char *p;
|
||||
|
||||
for (p = s; *s; ) {
|
||||
|
|
@ -437,7 +437,7 @@ void Make_Resource_Name (s) register char *s; {
|
|||
*p = '\0';
|
||||
}
|
||||
|
||||
Object Get_Resources (c, fun, freeit) WidgetClass c; void (*fun)(); {
|
||||
Object Get_Resources (WidgetClass c, void (*fun)(), int freeit) {
|
||||
XtResource *r;
|
||||
register XtResource *p;
|
||||
int nr;
|
||||
|
|
|
|||
|
|
@ -30,7 +30,7 @@
|
|||
|
||||
#include "xt.h"
|
||||
|
||||
XtTranslations Get_Translations (t) Object t; {
|
||||
XtTranslations Get_Translations (Object t) {
|
||||
register char *s;
|
||||
XtTranslations ret;
|
||||
Alloca_Begin;
|
||||
|
|
@ -42,19 +42,19 @@ XtTranslations Get_Translations (t) Object t; {
|
|||
return ret;
|
||||
}
|
||||
|
||||
static Object P_Augment_Translations (w, t) Object w, t; {
|
||||
static Object P_Augment_Translations (Object w, Object t) {
|
||||
Check_Widget (w);
|
||||
XtAugmentTranslations (WIDGET(w)->widget, Get_Translations (t));
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Override_Translations (w, t) Object w, t; {
|
||||
static Object P_Override_Translations (Object w, Object t) {
|
||||
Check_Widget (w);
|
||||
XtOverrideTranslations (WIDGET(w)->widget, Get_Translations (t));
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Uninstall_Translations (w) Object w; {
|
||||
static Object P_Uninstall_Translations (Object w) {
|
||||
Check_Widget (w);
|
||||
XtUninstallTranslations (WIDGET(w)->widget);
|
||||
return Void;
|
||||
|
|
@ -63,18 +63,18 @@ static Object P_Uninstall_Translations (w) Object w; {
|
|||
/* Due to a bug in Xt these functions drop core when invoked with a
|
||||
* display not owned by Xt.
|
||||
*/
|
||||
static Object P_Multi_Click_Time (d) Object d; {
|
||||
static Object P_Multi_Click_Time (Object d) {
|
||||
Check_Type (d, T_Display);
|
||||
return Make_Integer (XtGetMultiClickTime (DISPLAY(d)->dpy));
|
||||
}
|
||||
|
||||
static Object P_Set_Multi_Click_Time (d, t) Object d, t; {
|
||||
static Object P_Set_Multi_Click_Time (Object d, Object t) {
|
||||
Check_Type (d, T_Display);
|
||||
XtSetMultiClickTime (DISPLAY(d)->dpy, Get_Integer (t));
|
||||
return Void;
|
||||
}
|
||||
|
||||
elk_init_xt_translation () {
|
||||
void elk_init_xt_translation () {
|
||||
Define_Primitive (P_Augment_Translations,
|
||||
"augment-translations", 2, 2, EVAL);
|
||||
Define_Primitive (P_Override_Translations,
|
||||
|
|
|
|||
|
|
@ -40,7 +40,7 @@ Generic_Equal (Widget, WIDGET, widget)
|
|||
|
||||
Generic_Print (Widget, "#[widget %lu]", POINTER(x))
|
||||
|
||||
static Object Internal_Make_Widget (finalize, widget) Widget widget; {
|
||||
static Object Internal_Make_Widget (int finalize, Widget widget) {
|
||||
Object w;
|
||||
|
||||
if (widget == 0)
|
||||
|
|
@ -60,33 +60,33 @@ static Object Internal_Make_Widget (finalize, widget) Widget widget; {
|
|||
}
|
||||
|
||||
/* Backwards compatibility: */
|
||||
Object Make_Widget (widget) Widget widget; {
|
||||
Object Make_Widget (Widget widget) {
|
||||
return Internal_Make_Widget (1, widget);
|
||||
}
|
||||
|
||||
Object Make_Widget_Foreign (widget) Widget widget; {
|
||||
Object Make_Widget_Foreign (Widget widget) {
|
||||
return Internal_Make_Widget (0, widget);
|
||||
}
|
||||
|
||||
void Check_Widget (w) Object w; {
|
||||
void Check_Widget (Object w) {
|
||||
Check_Type (w, T_Widget);
|
||||
if (WIDGET(w)->free)
|
||||
Primitive_Error ("invalid widget: ~s", w);
|
||||
}
|
||||
|
||||
void Check_Widget_Class (w, class) Object w; WidgetClass class; {
|
||||
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 (w) Object w; {
|
||||
static Object P_Destroy_Widget (Object w) {
|
||||
Check_Widget (w);
|
||||
XtDestroyWidget (WIDGET(w)->widget);
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Create_Shell (argc, argv) Object *argv; {
|
||||
static Object P_Create_Shell (int argc, Object *argv) {
|
||||
register char *sn = 0, *sc = 0;
|
||||
ArgList a;
|
||||
Object name, class, w, d, ret;
|
||||
|
|
@ -106,7 +106,7 @@ static Object P_Create_Shell (argc, argv) Object *argv; {
|
|||
return ret;
|
||||
}
|
||||
|
||||
static Object P_Create_Widget (argc, argv) Object *argv; {
|
||||
static Object P_Create_Widget (int argc, Object *argv) {
|
||||
ArgList a;
|
||||
char *name = 0;
|
||||
Object x, class, parent, ret;
|
||||
|
|
@ -131,34 +131,34 @@ static Object P_Create_Widget (argc, argv) Object *argv; {
|
|||
return ret;
|
||||
}
|
||||
|
||||
static Object P_Realize_Widget (w) Object w; {
|
||||
static Object P_Realize_Widget (Object w) {
|
||||
Check_Widget (w);
|
||||
XtRealizeWidget (WIDGET(w)->widget);
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Unrealize_Widget (w) Object w; {
|
||||
static Object P_Unrealize_Widget (Object w) {
|
||||
Check_Widget (w);
|
||||
XtUnrealizeWidget (WIDGET(w)->widget);
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Widget_Realizedp (w) Object w; {
|
||||
static Object P_Widget_Realizedp (Object w) {
|
||||
Check_Widget (w);
|
||||
return XtIsRealized (WIDGET(w)->widget) ? True : False;
|
||||
}
|
||||
|
||||
static Object P_Widget_Display (w) Object w; {
|
||||
static Object P_Widget_Display (Object w) {
|
||||
Check_Widget (w);
|
||||
return Make_Display (0, XtDisplayOfObject (WIDGET(w)->widget));
|
||||
}
|
||||
|
||||
static Object P_Widget_Parent (w) Object w; {
|
||||
static Object P_Widget_Parent (Object w) {
|
||||
Check_Widget (w);
|
||||
return Make_Widget_Foreign (XtParent (WIDGET(w)->widget));
|
||||
}
|
||||
|
||||
static Object P_Widget_Name (w) Object w; {
|
||||
static Object P_Widget_Name (Object w) {
|
||||
char *s;
|
||||
|
||||
Check_Widget (w);
|
||||
|
|
@ -166,19 +166,19 @@ static Object P_Widget_Name (w) Object w; {
|
|||
return Make_String (s, strlen (s));
|
||||
}
|
||||
|
||||
static Object P_Widget_To_Window (w) Object w; {
|
||||
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 (w) Object w; {
|
||||
static Object P_Widget_Compositep (Object w) {
|
||||
Check_Widget (w);
|
||||
return XtIsComposite (WIDGET(w)->widget) ? True : False;
|
||||
}
|
||||
|
||||
static Object Manage_Unmanage (children, f) Object children; void (*f)(); {
|
||||
register i, n;
|
||||
static Object Manage_Unmanage (Object children, void (*f)()) {
|
||||
register int i, n;
|
||||
Widget *buf;
|
||||
Object tail;
|
||||
Alloca_Begin;
|
||||
|
|
@ -198,60 +198,60 @@ static Object Manage_Unmanage (children, f) Object children; void (*f)(); {
|
|||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Manage_Children (children) Object children; {
|
||||
static Object P_Manage_Children (Object children) {
|
||||
return Manage_Unmanage (children, XtManageChildren);
|
||||
}
|
||||
|
||||
static Object P_Unmanage_Children (children) Object children; {
|
||||
static Object P_Unmanage_Children (Object children) {
|
||||
return Manage_Unmanage (children, XtUnmanageChildren);
|
||||
}
|
||||
|
||||
static Object P_Widget_Managedp (w) Object w; {
|
||||
static Object P_Widget_Managedp (Object w) {
|
||||
Check_Widget (w);
|
||||
return XtIsManaged (WIDGET(w)->widget) ? True : False;
|
||||
}
|
||||
|
||||
static Object P_Widget_Class (w) Object w; {
|
||||
static Object P_Widget_Class (Object w) {
|
||||
Check_Widget (w);
|
||||
return Make_Widget_Class (XtClass (WIDGET(w)->widget));
|
||||
}
|
||||
|
||||
static Object P_Widget_Superclass (w) Object w; {
|
||||
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 (w, c) Object w, c; {
|
||||
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 (w, m) Object w, m; {
|
||||
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 (w) Object w; {
|
||||
static Object P_Map_Widget (Object w) {
|
||||
Check_Widget (w);
|
||||
XtMapWidget (WIDGET(w)->widget);
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Unmap_Widget (w) Object w; {
|
||||
static Object P_Unmap_Widget (Object w) {
|
||||
Check_Widget (w);
|
||||
XtUnmapWidget (WIDGET(w)->widget);
|
||||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Set_Values (argc, argv) Object *argv; {
|
||||
static Object P_Set_Values (int argc, Object *argv) {
|
||||
ArgList a;
|
||||
Widget w;
|
||||
register i, n = (argc-1)/2;
|
||||
register int i, n = (argc-1)/2;
|
||||
Alloca_Begin;
|
||||
|
||||
Check_Widget (argv[0]);
|
||||
|
|
@ -265,7 +265,7 @@ static Object P_Set_Values (argc, argv) Object *argv; {
|
|||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Get_Values (argc, argv) Object *argv; {
|
||||
static Object P_Get_Values (int argc, Object *argv) {
|
||||
Widget w;
|
||||
|
||||
Check_Widget (argv[0]);
|
||||
|
|
@ -273,39 +273,37 @@ static Object P_Get_Values (argc, argv) Object *argv; {
|
|||
return Get_Values (w, argc-1, argv+1);
|
||||
}
|
||||
|
||||
static Object P_Widget_Context (w) Object w; {
|
||||
static Object P_Widget_Context (Object w) {
|
||||
Check_Widget (w);
|
||||
return
|
||||
Make_Context_Foreign (XtWidgetToApplicationContext (WIDGET(w)->widget));
|
||||
}
|
||||
|
||||
static Object P_Set_Sensitive (w, s) Object w, s; {
|
||||
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 (w) Object w; {
|
||||
static Object P_Sensitivep (Object w) {
|
||||
Check_Widget (w);
|
||||
return XtIsSensitive (WIDGET(w)->widget) ? True : False;
|
||||
}
|
||||
|
||||
static Object P_Window_To_Widget (w) Object w; {
|
||||
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 (root, name) Object root, name; {
|
||||
register char *s;
|
||||
|
||||
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 (w, x, y) Object w, x, y; {
|
||||
static Object P_Widget_Translate_Coordinates (Object w, Object x, Object y) {
|
||||
Position root_x, root_y;
|
||||
|
||||
Check_Widget (w);
|
||||
|
|
@ -324,12 +322,12 @@ static Object P_Widget_Translate_Coordinates (w, x, y) Object w, x, y; {
|
|||
#include <X11/CompositeP.h>
|
||||
#undef XtIsComposite
|
||||
|
||||
static Widget_Visit (root, func) Object *root; int (*func)(); {
|
||||
static int Widget_Visit (Object *root, int (*func)()) {
|
||||
Object obj;
|
||||
Widget w = WIDGET(*root)->widget;
|
||||
|
||||
if (WIDGET(*root)->free == 0 && XtIsComposite (w)) {
|
||||
int i;
|
||||
unsigned int i;
|
||||
CompositeRec *comp = (CompositeRec *)w;
|
||||
|
||||
for (i = 0; i < comp->composite.num_children; i++) {
|
||||
|
|
@ -338,15 +336,16 @@ static Widget_Visit (root, func) Object *root; int (*func)(); {
|
|||
if (TYPE(obj) == T_Widget)
|
||||
func (&obj);
|
||||
}
|
||||
while (w = XtParent (w)) {
|
||||
while ((w = XtParent (w))) {
|
||||
obj = Find_Object (T_Widget, (GENERIC)0, Match_Xt_Obj, w);
|
||||
if (TYPE(obj) == T_Widget)
|
||||
func (&obj);
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
elk_init_xt_widget () {
|
||||
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);
|
||||
|
|
|
|||
|
|
@ -35,7 +35,7 @@
|
|||
|
||||
(c->scheme 'callback:grip-callback
|
||||
" Object args, ret, t;
|
||||
register i;
|
||||
register unsigned int i;
|
||||
GripCallData p = (GripCallData)x;
|
||||
GC_Node3;
|
||||
|
||||
|
|
|
|||
|
|
@ -30,6 +30,6 @@
|
|||
|
||||
#include "scheme.h"
|
||||
|
||||
elk_init_xaw_init () {
|
||||
void elk_init_xaw_init () {
|
||||
P_Provide (Intern ("xaw-widgets.so"));
|
||||
}
|
||||
|
|
|
|||
|
|
@ -31,8 +31,8 @@
|
|||
|
||||
(prolog
|
||||
"
|
||||
static char **Get_List (x) Object x; {
|
||||
register i, n;
|
||||
static char **Get_List (Object x) {
|
||||
register int i, n;
|
||||
register char *s, **l;
|
||||
Alloca_Begin;
|
||||
|
||||
|
|
|
|||
|
|
@ -31,8 +31,7 @@
|
|||
|
||||
(prolog
|
||||
|
||||
"static void Get_Value (w, client_data, value) Widget w;
|
||||
XtPointer client_data; XtPointer value; {
|
||||
"static void Get_Value (Widget w, XtPointer client_data, XtPointer value) {
|
||||
Object ret;
|
||||
|
||||
ret = Funcall (Get_Function ((int)client_data), Null, 0);
|
||||
|
|
|
|||
|
|
@ -32,7 +32,7 @@
|
|||
|
||||
static Object V_Xt_Warning_Handler;
|
||||
|
||||
void Xt_Warning (msg) char *msg; {
|
||||
void Xt_Warning (char *msg) {
|
||||
Object args, fun;
|
||||
|
||||
args = Cons (Make_String (msg, strlen (msg)), Null);
|
||||
|
|
@ -43,7 +43,7 @@ void Xt_Warning (msg) char *msg; {
|
|||
(void)P_Newline (0, (Object *)0);
|
||||
}
|
||||
|
||||
elk_init_xt_error () {
|
||||
void elk_init_xt_error () {
|
||||
Define_Variable (&V_Xt_Warning_Handler, "xt-warning-handler", Null);
|
||||
XtSetWarningHandler (Xt_Warning);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -58,10 +58,10 @@ extern WidgetClass vendorShellWidgetClass;
|
|||
* it isn't removed by the optimizer.
|
||||
*/
|
||||
|
||||
static dummy (w) WidgetClass w; {
|
||||
static void dummy (WidgetClass w) {
|
||||
}
|
||||
|
||||
elk_init_xt_init () {
|
||||
void elk_init_xt_init () {
|
||||
extern WidgetClass vendorShellWidgetClass;
|
||||
|
||||
dummy(vendorShellWidgetClass);
|
||||
|
|
|
|||
|
|
@ -32,8 +32,8 @@
|
|||
|
||||
#include "xt.h"
|
||||
|
||||
Match_Xt_Obj (x, v) Object x; va_list v; {
|
||||
register type = TYPE(x);
|
||||
int Match_Xt_Obj (Object x, va_list v) {
|
||||
register int type = TYPE(x);
|
||||
|
||||
if (type == T_Context) {
|
||||
return va_arg (v, XtAppContext) == CONTEXT(x)->context;
|
||||
|
|
|
|||
Loading…
Reference in New Issue