conservatory
/
elk
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

* 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 2003-09-04 15:30:04 +00:00
parent c85894ea26
commit 82a9a039c9
27 changed files with 182 additions and 192 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
lib/xwidgets/accelerator.c
View File

@ -30,7 +30,7 @@
#include "xt.h" #include "xt.h"
XtAccelerators Get_Accelerators (a) Object a; { XtAccelerators Get_Accelerators (Object a) {
register char *s; register char *s;
XtAccelerators ret; XtAccelerators ret;
Alloca_Begin; Alloca_Begin;
@ -42,14 +42,14 @@ XtAccelerators Get_Accelerators (a) Object a; {
return ret; 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 (dst);
Check_Widget (src); Check_Widget (src);
XtInstallAccelerators (WIDGET(dst)->widget, WIDGET(src)->widget); XtInstallAccelerators (WIDGET(dst)->widget, WIDGET(src)->widget);
return Void; 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 (dst);
Check_Widget (src); Check_Widget (src);
XtInstallAllAccelerators (WIDGET(dst)->widget, WIDGET(src)->widget); 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, Define_Primitive (P_Install_Accelerators,
"install-accelerators", 2, 2, EVAL); "install-accelerators", 2, 2, EVAL);
Define_Primitive (P_Install_All_Accelerators, Define_Primitive (P_Install_All_Accelerators,

18
lib/xwidgets/action.c
View File

@ -40,16 +40,14 @@ typedef struct action {
ACTION *actions; ACTION *actions;
/*ARGSUSED*/ /*ARGSUSED*/
static void Dummy_Action (w, ep, argv, argc) Widget w; XEvent *ep; static void Dummy_Action (Widget w, XEvent *ep, String *argv, int *argc) {
String *argv; int *argc; {
} }
void Action_Hook (w, client_data, name, ep, argv, argc) void Action_Hook (Widget w, XtPointer client_data, char *name, XEvent *ep,
Widget w; XtPointer client_data; char *name; XEvent *ep; char **argv, int *argc) {
char **argv; int *argc; {
ACTION *ap; ACTION *ap;
Object args, params, tail; Object args, params, tail;
register i; register int i;
GC_Node3; GC_Node3;
for (ap = actions; ap; ap = ap->next) { 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; ACTION *ap;
XtActionsRec a; XtActionsRec a;
@ -92,10 +90,10 @@ static Object P_Context_Add_Action (c, s, p) Object c, s, p; {
return Void; return Void;
} }
void Free_Actions (con) XtAppContext con; { void Free_Actions (XtAppContext con) {
register ACTION *p, **pp; register ACTION *p, **pp;
for (pp = &actions; p = *pp; ) { for (pp = &actions; (p = *pp); ) {
if (p->con == con) { if (p->con == con) {
Deregister_Function (p->num); Deregister_Function (p->num);
XtFree (p->name); 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); Define_Primitive (P_Context_Add_Action, "context-add-action", 3, 3, EVAL);
} }

32
lib/xwidgets/callback.c
View File

@ -30,18 +30,20 @@
#include "xt.h" #include "xt.h"
void Remove_All_Callbacks (Widget w);
typedef struct { typedef struct {
PFX2S converter; PFX2S converter;
int num; int num;
} CLIENT_DATA; } CLIENT_DATA;
Object Get_Callbackfun (c) XtPointer c; { Object Get_Callbackfun (XtPointer c) {
register CLIENT_DATA *cd = (CLIENT_DATA *)c; register CLIENT_DATA *cd = (CLIENT_DATA *)c;
return cd ? Get_Function (cd->num) : False; return cd ? Get_Function (cd->num) : False;
} }
static void Callback_Proc (w, client_data, call_data) Widget w; static void Callback_Proc (Widget w, XtPointer client_data,
XtPointer client_data, call_data; { XtPointer call_data) {
register CLIENT_DATA *cd = (CLIENT_DATA *)client_data; register CLIENT_DATA *cd = (CLIENT_DATA *)client_data;
Object args; Object args;
GC_Node; GC_Node;
@ -56,8 +58,8 @@ static void Callback_Proc (w, client_data, call_data) Widget w;
} }
/*ARGSUSED*/ /*ARGSUSED*/
void Destroy_Callback_Proc (w, client_data, call_data) Widget w; void Destroy_Callback_Proc (Widget w, XtPointer client_data,
XtPointer client_data, call_data; { XtPointer call_data) {
Object x; Object x;
x = Find_Object (T_Widget, (GENERIC)0, Match_Xt_Obj, w); 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 * must be called to remove the Destroy_Callback_Proc() and put
* it back to the end of the callback list. * 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, XtRemoveCallback (w, XtNdestroyCallback, Destroy_Callback_Proc,
(XtPointer)0); (XtPointer)0);
XtAddCallback (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; Object tail;
Check_List (x); Check_List (x);
@ -91,9 +93,9 @@ void Check_Callback_List (x) Object x; {
Check_Procedure (Car (tail)); 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 char *s;
register n; register int n;
XtCallbackList callbacks; XtCallbackList callbacks;
Alloca_Begin; Alloca_Begin;
@ -114,10 +116,10 @@ static Object P_Add_Callbacks (w, name, cbl) Object w, name, cbl; {
return Void; return Void;
} }
void Fill_Callbacks (src, dst, n, conv) Object src; XtCallbackList dst; void Fill_Callbacks (Object src, XtCallbackList dst, register int n,
register n; PFX2S conv; { PFX2S conv) {
register CLIENT_DATA *cd; register CLIENT_DATA *cd;
register i, j; register int i, j;
Object tail; Object tail;
for (i = 0, tail = src; i < n; i++, tail = Cdr (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]; Arg a[1];
XtCallbackList c; XtCallbackList c;
XtResource *r; XtResource *r;
int nr, nc; int nr, nc;
register i, j; register int i, j;
Get_All_Resources (0, w, XtClass (w), &r, &nr, &nc); Get_All_Resources (0, w, XtClass (w), &r, &nr, &nc);
for (j = 0; j < nr; j++) { for (j = 0; j < nr; j++) {
@ -154,6 +156,6 @@ Remove_All_Callbacks (w) Widget w; {
XtFree ((char *)r); XtFree ((char *)r);
} }
elk_init_xt_callback () { void elk_init_xt_callback () {
Define_Primitive (P_Add_Callbacks, "add-callbacks", 3, 3, EVAL); Define_Primitive (P_Add_Callbacks, "add-callbacks", 3, 3, EVAL);
} }

32
lib/xwidgets/class.c
View File

@ -54,7 +54,7 @@ Generic_Simple_Equal (Class, CLASS, wclass)
Generic_Print (Class, "#[class %s]", CLASS(x)->name) 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; Object c;
c = Find_Object (T_Class, (GENERIC)0, Match_Xt_Obj, class); 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; return c;
} }
Object Make_Widget_Class (class) WidgetClass class; { Object Make_Widget_Class (WidgetClass class) {
register CLASS_INFO *p; register CLASS_INFO *p;
for (p = ctab; p < clast; p++) for (p = ctab; p < clast; p++)
@ -80,7 +80,7 @@ Object Make_Widget_Class (class) WidgetClass class; {
/*NOTREACHED*/ /*NOTREACHED*/
} }
static Object P_Find_Class (name) Object name; { static Object P_Find_Class (Object name) {
register CLASS_INFO *p; register CLASS_INFO *p;
register char *s = Get_Strsym (name); register char *s = Get_Strsym (name);
@ -92,7 +92,7 @@ static Object P_Find_Class (name) Object name; {
/*NOTREACHED*/ /*NOTREACHED*/
} }
static Object P_Class_Existsp (name) Object name; { static Object P_Class_Existsp (Object name) {
register CLASS_INFO *p; register CLASS_INFO *p;
register char *s = Get_Strsym (name); register char *s = Get_Strsym (name);
@ -103,7 +103,7 @@ static Object P_Class_Existsp (name) Object name; {
return False; return False;
} }
char *Class_Name (class) WidgetClass class; { char *Class_Name (WidgetClass class) {
register CLASS_INFO *p; register CLASS_INFO *p;
for (p = ctab; p < clast && p->class != class; p++) for (p = ctab; p < clast && p->class != class; p++)
@ -113,8 +113,8 @@ char *Class_Name (class) WidgetClass class; {
return p->name; return p->name;
} }
void Get_Sub_Resource_List (class, rp, np) WidgetClass class; void Get_Sub_Resource_List (WidgetClass class, XtResourceList *rp,
XtResourceList *rp; Cardinal *np; { Cardinal *np) {
register CLASS_INFO *p; register CLASS_INFO *p;
for (p = ctab; p < clast && p->class != class; 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; *rp = p->sub_resources;
} }
static Object P_Class_Resources (c) Object c; { static Object P_Class_Resources (Object c) {
Check_Type (c, T_Class); Check_Type (c, T_Class);
return Get_Resources (CLASS(c)->wclass, XtGetResourceList, 1); 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); Check_Type (c, T_Class);
return Get_Resources (CLASS(c)->wclass, XtGetConstraintResourceList, 1); 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); Check_Type (c, T_Class);
return Get_Resources (CLASS(c)->wclass, Get_Sub_Resource_List, 0); return Get_Resources (CLASS(c)->wclass, Get_Sub_Resource_List, 0);
} }
void Define_Class (name, class, r, nr) char *name; WidgetClass class; void Define_Class (char *name, WidgetClass class, XtResourceList r, int nr) {
XtResourceList r; {
Set_Error_Tag ("define-class"); Set_Error_Tag ("define-class");
if (clast == ctab+MAX_CLASS) if (clast == ctab+MAX_CLASS)
Primitive_Error ("too many widget classes"); Primitive_Error ("too many widget classes");
@ -166,7 +165,7 @@ void Define_Class (name, class, r, nr) char *name; WidgetClass class;
clast++; 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; register CLASS_INFO *p;
Set_Error_Tag ("define-callback"); Set_Error_Tag ("define-callback");
@ -182,8 +181,7 @@ void Define_Callback (cl, s, has_arg) char *cl, *s; {
Primitive_Error ("undefined class"); Primitive_Error ("undefined class");
} }
PFX2S Find_Callback_Converter (c, name, sname) WidgetClass c; char *name; PFX2S Find_Callback_Converter (WidgetClass c, char *name, Object sname) {
Object sname; {
register CLASS_INFO *p; register CLASS_INFO *p;
register CALLBACK_INFO *q; register CALLBACK_INFO *q;
PFX2S conv; PFX2S conv;
@ -208,7 +206,7 @@ PFX2S Find_Callback_Converter (c, name, sname) WidgetClass c; char *name;
if (conv == 0) { if (conv == 0) {
sprintf (msg, sprintf (msg,
"no callback converter for %s or %s", "no callback converter for %s or %s",
s1, s2, name); s1, s2);
Primitive_Error (msg); Primitive_Error (msg);
} }
} }
@ -221,7 +219,7 @@ PFX2S Find_Callback_Converter (c, name, sname) WidgetClass c; char *name;
/*NOTREACHED*/ /*NOTREACHED*/
} }
elk_init_xt_class () { void elk_init_xt_class () {
Generic_Define (Class, "class", "class?"); Generic_Define (Class, "class", "class?");
Define_Primitive (P_Find_Class, "find-class", 1, 1, EVAL); Define_Primitive (P_Find_Class, "find-class", 1, 1, EVAL);
Define_Primitive (P_Class_Resources, "class-resources", 1, 1, EVAL); Define_Primitive (P_Class_Resources, "class-resources", 1, 1, EVAL);

2
lib/xwidgets/classname.c
View File

@ -33,7 +33,7 @@
#include <X11/IntrinsicP.h> #include <X11/IntrinsicP.h>
#include <X11/CoreP.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, return Make_String (class->core_class.class_name,
strlen (class->core_class.class_name)); strlen (class->core_class.class_name));
} }

61
lib/xwidgets/context.c
View File

@ -52,7 +52,7 @@ Generic_Equal (Context, CONTEXT, context)
Generic_Print (Context, "#[context %lu]", POINTER(x)) 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; Object c;
c = Find_Object (T_Context, (GENERIC)0, Match_Xt_Obj, context); 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: */ /* Backwards compatibility: */
Object Make_Context (context) XtAppContext context; { Object Make_Context (XtAppContext context) {
return Internal_Make_Context (1, 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); return Internal_Make_Context (0, context);
} }
void Check_Context (c) Object c; { void Check_Context (Object c) {
Check_Type (c, T_Context); Check_Type (c, T_Context);
if (CONTEXT(c)->free) if (CONTEXT(c)->free)
Primitive_Error ("invalid context: ~s", c); Primitive_Error ("invalid context: ~s", c);
@ -89,7 +89,7 @@ static Object P_Create_Context () {
return Make_Context (XtCreateApplicationContext ()); return Make_Context (XtCreateApplicationContext ());
} }
static Object P_Destroy_Context (c) Object c; { static Object P_Destroy_Context (Object c) {
Check_Context (c); Check_Context (c);
Free_Actions (CONTEXT(c)->context); Free_Actions (CONTEXT(c)->context);
XtDestroyApplicationContext (CONTEXT(c)->context); XtDestroyApplicationContext (CONTEXT(c)->context);
@ -98,12 +98,12 @@ static Object P_Destroy_Context (c) Object c; {
return Void; return Void;
} }
static Object P_Initialize_Display (c, d, name, class) static Object P_Initialize_Display (Object c, Object d, Object name,
Object c, d, name, class; { Object class) {
register char *sn = 0, *sc = "", *sd = 0; register char *sn = 0, *sc = "", *sd = 0;
Display *dpy; Display *dpy;
extern char **Argv; extern char **Argv;
extern First_Arg, Argc; extern int First_Arg, Argc;
int argc = Argc - First_Arg + 1; int argc = Argc - First_Arg + 1;
Argv[First_Arg-1] = "elk"; 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]); (XrmOptionDescRec *)0, 0, &argc, &Argv[First_Arg-1]);
Argc = First_Arg + argc - 1; Argc = First_Arg + argc - 1;
if (dpy == 0) if (dpy == 0)
{
if (sd) if (sd)
Primitive_Error ("cannot open display ~s", d); Primitive_Error ("cannot open display ~s", d);
else else
Primitive_Error ("cannot open display"); Primitive_Error ("cannot open display");
}
return Make_Display (0, dpy); return Make_Display (0, dpy);
} }
/* Due to a bug in Xt this function drops core when invoked with a /* Due to a bug in Xt this function drops core when invoked with a
* display not owned by Xt. * 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); Check_Type (d, T_Display);
return return
Make_Context_Foreign (XtDisplayToApplicationContext (DISPLAY(d)->dpy)); 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 char **p = 0;
register i; register int i;
struct S_String *sp; struct S_String *sp;
Object con; Object con;
@ -164,19 +166,20 @@ static Object P_Set_Context_Fallback_Resources (argc, argv) Object *argv; {
return Void; return Void;
} }
static Object P_Context_Main_Loop (c) Object c; { static Object P_Context_Main_Loop (Object c) {
Check_Context (c); Check_Context (c);
XtAppMainLoop (CONTEXT(c)->context); XtAppMainLoop (CONTEXT(c)->context);
/*NOTREACHED*/ /*NOTREACHED*/
return Void;
} }
static Object P_Context_Pending (c) Object c; { static Object P_Context_Pending (Object c) {
Check_Context (c); Check_Context (c);
return Bits_To_Symbols ((unsigned long)XtAppPending (CONTEXT(c)->context), return Bits_To_Symbols ((unsigned long)XtAppPending (CONTEXT(c)->context),
1, XtIM_Syms); 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; XtInputMask mask = XtIMAll;
Check_Context (argv[0]); Check_Context (argv[0]);
@ -186,7 +189,7 @@ static Object P_Context_Process_Event (argc, argv) Object *argv; {
return Void; return Void;
} }
static Boolean Work_Proc (client_data) XtPointer client_data; { static Boolean Work_Proc (XtPointer client_data) {
Object ret; Object ret;
ret = Funcall (Get_Function ((int)client_data), Null, 0); 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); 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; XtWorkProcId id;
register i; register int i;
Check_Context (c); Check_Context (c);
Check_Procedure (p); 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); 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')); XtRemoveWorkProc ((XtWorkProcId)Use_Id (id, 'w'));
Deregister_Function (IDENTIFIER(id)->num); Deregister_Function (IDENTIFIER(id)->num);
return Void; return Void;
} }
static void Timeout_Proc (client_data, id) static void Timeout_Proc (XtPointer client_data, XtIntervalId *id) {
XtPointer client_data; XtIntervalId *id; {
Object proc, args; Object proc, args;
register i = (int)client_data; register int i = (int)client_data;
args = Cons (Make_Id ('t', (XtPointer)*id, i), Null); args = Cons (Make_Id ('t', (XtPointer)*id, i), Null);
proc = Get_Function (i); proc = Get_Function (i);
@ -223,9 +225,9 @@ static void Timeout_Proc (client_data, id)
(void)Funcall (proc, args, 0); (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; XtIntervalId id;
register i; register int i;
Check_Context (c); Check_Context (c);
Check_Procedure (p); 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); 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')); XtRemoveTimeOut ((XtIntervalId)Use_Id (id, 't'));
Deregister_Function (IDENTIFIER(id)->num); Deregister_Function (IDENTIFIER(id)->num);
return Void; return Void;
} }
/*ARGSUSED*/ /*ARGSUSED*/
static void Input_Proc (client_data, src, id) XtPointer client_data; int *src; static void Input_Proc (XtPointer client_data, int *src, XtInputId *id) {
XtInputId *id; {
Object p, args; Object p, args;
GC_Node2; 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); (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; Object c, src, p;
XtInputId id; XtInputId id;
XtInputMask m; XtInputMask m;
register i; register int i;
c = argv[0], src = argv[1], p = argv[2]; c = argv[0], src = argv[1], p = argv[2];
Check_Context (c); Check_Context (c);
@ -285,13 +286,13 @@ static Object P_Context_Add_Input (argc, argv) Object *argv; {
return Make_Id ('i', (XtPointer)id, i); 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')); XtRemoveInput ((XtInputId)Use_Id (id, 'i'));
Deregister_Function (IDENTIFIER(id)->num); Deregister_Function (IDENTIFIER(id)->num);
return Void; return Void;
} }
elk_init_xt_context () { void elk_init_xt_context () {
Generic_Define (Context, "context", "context?"); Generic_Define (Context, "context", "context?");
Define_Primitive (P_Create_Context, "create-context", 0, 0, EVAL); Define_Primitive (P_Create_Context, "create-context", 0, 0, EVAL);
Define_Primitive (P_Destroy_Context, "destroy-context", 1, 1, EVAL); Define_Primitive (P_Destroy_Context, "destroy-context", 1, 1, EVAL);

8
lib/xwidgets/converter.c
View File

@ -41,7 +41,7 @@ typedef struct {
static CONVERTER ctab[MAX_CONVERTER], *clast = ctab; 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"); Set_Error_Tag ("c->scheme");
if (clast == ctab+MAX_CONVERTER) if (clast == ctab+MAX_CONVERTER)
Primitive_Error ("too many converters"); Primitive_Error ("too many converters");
@ -51,7 +51,7 @@ void Define_Converter_To_Scheme (name, c) char *name; PFX2S c; {
clast++; 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"); Set_Error_Tag ("scheme->c");
if (clast == ctab+MAX_CONVERTER) if (clast == ctab+MAX_CONVERTER)
Primitive_Error ("too many converters"); Primitive_Error ("too many converters");
@ -61,7 +61,7 @@ void Define_Converter_To_C (name, c) char *name; PFS2X c; {
clast++; clast++;
} }
PFX2S Find_Converter_To_Scheme (name) char *name; { PFX2S Find_Converter_To_Scheme (char *name) {
register CONVERTER *p; register CONVERTER *p;
for (p = ctab; p < clast; p++) for (p = ctab; p < clast; p++)
@ -70,7 +70,7 @@ PFX2S Find_Converter_To_Scheme (name) char *name; {
return 0; return 0;
} }
PFS2X Find_Converter_To_C (name) char *name; { PFS2X Find_Converter_To_C (char *name) {
register CONVERTER *p; register CONVERTER *p;
for (p = ctab; p < clast; p++) for (p = ctab; p < clast; p++)

12
lib/xwidgets/function.c
View File

@ -30,11 +30,11 @@
#include "xt.h" #include "xt.h"
static max_functions = 512; static int max_functions = 512;
static Object Functions; static Object Functions;
int Register_Function (x) Object x; { int Register_Function (Object x) {
register i; register int i;
Object v; Object v;
GC_Node; GC_Node;
@ -53,15 +53,15 @@ int Register_Function (x) Object x; {
return i; return i;
} }
Object Get_Function (i) int i; { Object Get_Function (int i) {
return VECTOR(Functions)->data[i]; return VECTOR(Functions)->data[i];
} }
void Deregister_Function (i) int i; { void Deregister_Function (int i) {
VECTOR(Functions)->data[i] = Null; VECTOR(Functions)->data[i] = Null;
} }
elk_init_xt_function () { void elk_init_xt_function () {
Functions = Make_Vector (max_functions, Null); Functions = Make_Vector (max_functions, Null);
Global_GC_Link (Functions); Global_GC_Link (Functions);
} }

8
lib/xwidgets/identifier.c
View File

@ -32,14 +32,14 @@
Generic_Predicate (Identifier) 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); register struct S_Identifier *p = IDENTIFIER(x), *q = IDENTIFIER(y);
return p->type == q->type && p->val == q->val && !p->free && !q->free; return p->type == q->type && p->val == q->val && !p->free && !q->free;
} }
Generic_Print (Identifier, "#[identifier %lu]", POINTER(x)) 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; Object i;
i = Find_Object (T_Identifier, (GENERIC)0, Match_Xt_Obj, type, val); 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; return i;
} }
XtPointer Use_Id (x, type) Object x; { XtPointer Use_Id (Object x, int type) {
Check_Type (x, T_Identifier); Check_Type (x, T_Identifier);
if (IDENTIFIER(x)->type != type || IDENTIFIER(x)->free) if (IDENTIFIER(x)->type != type || IDENTIFIER(x)->free)
Primitive_Error ("invalid identifier"); Primitive_Error ("invalid identifier");
@ -64,6 +64,6 @@ XtPointer Use_Id (x, type) Object x; {
return IDENTIFIER(x)->val; return IDENTIFIER(x)->val;
} }
elk_init_xt_identifier () { void elk_init_xt_identifier () {
Generic_Define (Identifier, "identifier", "identifier?"); Generic_Define (Identifier, "identifier", "identifier?");
} }

17
lib/xwidgets/mkwidget.scm
View File

@ -64,7 +64,7 @@
(check-string 'c->scheme name 'name) (check-string 'c->scheme name 'name)
(define c-name (scheme-to-c-name name)) (define c-name (scheme-to-c-name name))
(string-set! c-name 0 #\S) (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) (display body f)
(format f "~%}~%~%") (format f "~%}~%~%")
(define s (define s
@ -76,7 +76,7 @@
(check-string 'scheme->c name 'name) (check-string 'scheme->c name 'name)
(define c-name (scheme-to-c-name name)) (define c-name (scheme-to-c-name name))
(string-set! c-name 0 #\C) (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) (display body f)
(format f "~%}~%~%") (format f "~%}~%~%")
(define s (define s
@ -91,18 +91,11 @@
(define c-name (scheme-to-c-name scheme-name)) (define c-name (scheme-to-c-name scheme-name))
(format f "static Object ~a (" c-name) (format f "static Object ~a (" c-name)
(do ((a args a)) ((null? a)) (do ((a args a)) ((null? a))
(display "Object " f)
(display (car a) f) (display (car a) f)
(set! a (cdr a)) (set! a (cdr a))
(if (not (null? a)) (display ", " f))) (if (not (null? a)) (display ", " f)))
(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)))
(newline f) (newline f)
(display body f) (display body f)
(format f "~%}~%~%") (format f "~%}~%~%")
@ -161,7 +154,7 @@
(load (car args)) (load (car args))
(if (not type-name) (if (not type-name)
(error 'mkwidget "no widget type defined")) (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)) (if (not (null? classes))
(format f " XtResourceList r = 0;~%")) (format f " XtResourceList r = 0;~%"))
(do ((c classes (cdr c))) ((null? c)) (do ((c classes (cdr c))) ((null? c))

2
lib/xwidgets/motif/init.c
View File

@ -30,6 +30,6 @@
#include "scheme.h" #include "scheme.h"
elk_init_motif_init () { void elk_init_motif_init () {
P_Provide (Intern ("motif-widgets.so")); P_Provide (Intern ("motif-widgets.so"));
} }

4
lib/xwidgets/motif/list.d
View File

@ -33,7 +33,7 @@
(prolog (prolog
"static Object String_Table_To_Scheme (tab, len) XmString *tab; { "static Object String_Table_To_Scheme (XmString *tab, int len) {
Object ret, tail; Object ret, tail;
char *text; char *text;
GC_Node2; GC_Node2;
@ -60,7 +60,7 @@
(prolog (prolog
"static Object Get_List_CB (p) XmListCallbackStruct *p; { "static Object Get_List_CB (XmListCallbackStruct *p) {
Object ret, s; Object ret, s;
char *text; char *text;
GC_Node2; GC_Node2;

6
lib/xwidgets/motif/row-column.d
View File

@ -44,8 +44,8 @@
(prolog (prolog
"static void Post_Handler (w, client_data, event, unused) Widget w; "static void Post_Handler (Widget w, XtPointer client_data, XEvent *event,
XtPointer client_data; XEvent *event; Boolean *unused; { Boolean *unused) {
unsigned int b; unsigned int b;
Arg a; Arg a;
XButtonPressedEvent *ep = (XButtonPressedEvent *)event; XButtonPressedEvent *ep = (XButtonPressedEvent *)event;
@ -61,7 +61,7 @@
(prolog (prolog
"static Object Get_Row_Column_CB (p) XmRowColumnCallbackStruct *p; { "static Object Get_Row_Column_CB (XmRowColumnCallbackStruct *p) {
Object ret, s; Object ret, s;
GC_Node2; GC_Node2;

2
lib/xwidgets/motif/scale.d
View File

@ -33,7 +33,7 @@
(prolog (prolog
"static Object Get_Scale_CB (p) XmScaleCallbackStruct *p; { "static Object Get_Scale_CB (XmScaleCallbackStruct *p) {
Object ret, s; Object ret, s;
extern SYMDESCR Reason_Syms[]; extern SYMDESCR Reason_Syms[];
GC_Node2; GC_Node2;

2
lib/xwidgets/motif/scroll-bar.d
View File

@ -33,7 +33,7 @@
(prolog (prolog
"static Object Get_Scrollbar_CB (p) XmScrollBarCallbackStruct *p; { "static Object Get_Scrollbar_CB (XmScrollBarCallbackStruct *p) {
Object ret, s; Object ret, s;
GC_Node2; GC_Node2;

6
lib/xwidgets/motif/support.d
View File

@ -76,7 +76,7 @@
(prolog (prolog
"Object Get_Any_CB (p) XmAnyCallbackStruct *p; { "Object Get_Any_CB (XmAnyCallbackStruct *p) {
Object args, ret; Object args, ret;
GC_Node2; GC_Node2;
@ -95,7 +95,7 @@
(prolog (prolog
"Object Get_Selection_CB (p) XmSelectionBoxCallbackStruct *p; { "Object Get_Selection_CB (XmSelectionBoxCallbackStruct *p) {
Object ret, s; Object ret, s;
char *text; char *text;
GC_Node2; GC_Node2;
@ -114,7 +114,7 @@
(prolog (prolog
"static XtArgVal Scheme_To_String_Table (x) Object x; { "static XtArgVal Scheme_To_String_Table (Object x) {
Object t; Object t;
char *s; char *s;
XmString *tab; XmString *tab;

8
lib/xwidgets/popup.c
View File

@ -37,7 +37,7 @@ static SYMDESCR Grab_Kind_Syms[] = {
{ 0, 0 } { 0, 0 }
}; };
static Object P_Create_Popup_Shell (argc, argv) Object *argv; { static Object P_Create_Popup_Shell (int argc, Object *argv) {
ArgList a; ArgList a;
char *name = 0; char *name = 0;
Object x, class, parent, ret; Object x, class, parent, ret;
@ -61,20 +61,20 @@ static Object P_Create_Popup_Shell (argc, argv) Object *argv; {
return ret; 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); Check_Widget (shell);
XtPopup (WIDGET(shell)->widget, Symbols_To_Bits (grab_kind, 0, XtPopup (WIDGET(shell)->widget, Symbols_To_Bits (grab_kind, 0,
Grab_Kind_Syms)); Grab_Kind_Syms));
return Void; return Void;
} }
static Object P_Popdown (shell) Object shell; { static Object P_Popdown (Object shell) {
Check_Widget (shell); Check_Widget (shell);
XtPopdown (WIDGET(shell)->widget); XtPopdown (WIDGET(shell)->widget);
return Void; return Void;
} }
elk_init_xt_popup () { void elk_init_xt_popup () {
Define_Primitive (P_Create_Popup_Shell, "create-popup-shell", Define_Primitive (P_Create_Popup_Shell, "create-popup-shell",
2, MANY, VARARGS); 2, MANY, VARARGS);
Define_Primitive (P_Popup, "popup", 2, 2, EVAL); Define_Primitive (P_Popup, "popup", 2, 2, EVAL);

26
lib/xwidgets/resource.c
View File

@ -48,7 +48,7 @@
#define T_Cardinal -10 #define T_Cardinal -10
#define T_Accelerators -11 #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)) if (streq (XtRAcceleratorTable, t))
return T_Accelerators; return T_Accelerators;
else if (streq (XtRBackingStore, t)) else if (streq (XtRBackingStore, t))
@ -102,8 +102,8 @@ static Resource_To_Scheme_Type (t) register char *t; {
return T_Unknown; return T_Unknown;
} }
void Get_All_Resources (sub, w, c, rp, np, cp) Widget w; WidgetClass c; void Get_All_Resources (int sub, Widget w, WidgetClass c, XtResource **rp,
XtResource **rp; int *np, *cp; { int *np, int *cp) {
XtResource *r, *sr, *cr; XtResource *r, *sr, *cr;
int nr, snr = 0, cnr = 0; 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; void Convert_Args (int ac, Object *av, ArgList to, Widget widget,
Widget widget; WidgetClass class; { WidgetClass class) {
register char *name, *res; register char *name, *res;
register i, j, k; register int i, j, k;
Object arg, val; Object arg, val;
XtResource *r; XtResource *r;
int nr, nc; int nr, nc;
@ -274,9 +274,9 @@ done: ;
XtFree ((char *)r); 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 char *name;
register i, j; register int i, j;
Object arg; Object arg;
XtResource *r; XtResource *r;
int nr, nc; int nr, nc;
@ -334,9 +334,9 @@ Object Get_Values (w, ac, av) Widget w; Object *av; {
if (converter) { if (converter) {
o = converter (*(XtArgVal *)val); 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); 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); o = converter (*(XtArgVal *)val);
} else if (t == T_String_Or_Symbol) { } else if (t == T_String_Or_Symbol) {
char *s = *(char **)val; char *s = *(char **)val;
@ -344,7 +344,7 @@ Object Get_Values (w, ac, av) Widget w; Object *av; {
if (s == 0) s = ""; if (s == 0) s = "";
o = Make_String (s, strlen (s)); o = Make_String (s, strlen (s));
} else if (t == T_Callbacklist) { } else if (t == T_Callbacklist) {
register i, n; register int i, n;
Object ret, tail; Object ret, tail;
XtCallbackList callbacks = *(XtCallbackList *)val; XtCallbackList callbacks = *(XtCallbackList *)val;
GC_Node; GC_Node;
@ -422,7 +422,7 @@ Object Get_Values (w, ac, av) Widget w; Object *av; {
/* Convert `mapped-when-managed' to `mappedWhenManaged'. /* Convert `mapped-when-managed' to `mappedWhenManaged'.
*/ */
void Make_Resource_Name (s) register char *s; { void Make_Resource_Name (register char *s) {
register char *p; register char *p;
for (p = s; *s; ) { for (p = s; *s; ) {
@ -437,7 +437,7 @@ void Make_Resource_Name (s) register char *s; {
*p = '\0'; *p = '\0';
} }
Object Get_Resources (c, fun, freeit) WidgetClass c; void (*fun)(); { Object Get_Resources (WidgetClass c, void (*fun)(), int freeit) {
XtResource *r; XtResource *r;
register XtResource *p; register XtResource *p;
int nr; int nr;

14
lib/xwidgets/translation.c
View File

@ -30,7 +30,7 @@
#include "xt.h" #include "xt.h"
XtTranslations Get_Translations (t) Object t; { XtTranslations Get_Translations (Object t) {
register char *s; register char *s;
XtTranslations ret; XtTranslations ret;
Alloca_Begin; Alloca_Begin;
@ -42,19 +42,19 @@ XtTranslations Get_Translations (t) Object t; {
return ret; return ret;
} }
static Object P_Augment_Translations (w, t) Object w, t; { static Object P_Augment_Translations (Object w, Object t) {
Check_Widget (w); Check_Widget (w);
XtAugmentTranslations (WIDGET(w)->widget, Get_Translations (t)); XtAugmentTranslations (WIDGET(w)->widget, Get_Translations (t));
return Void; return Void;
} }
static Object P_Override_Translations (w, t) Object w, t; { static Object P_Override_Translations (Object w, Object t) {
Check_Widget (w); Check_Widget (w);
XtOverrideTranslations (WIDGET(w)->widget, Get_Translations (t)); XtOverrideTranslations (WIDGET(w)->widget, Get_Translations (t));
return Void; return Void;
} }
static Object P_Uninstall_Translations (w) Object w; { static Object P_Uninstall_Translations (Object w) {
Check_Widget (w); Check_Widget (w);
XtUninstallTranslations (WIDGET(w)->widget); XtUninstallTranslations (WIDGET(w)->widget);
return Void; 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 /* Due to a bug in Xt these functions drop core when invoked with a
* display not owned by Xt. * 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); Check_Type (d, T_Display);
return Make_Integer (XtGetMultiClickTime (DISPLAY(d)->dpy)); 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); Check_Type (d, T_Display);
XtSetMultiClickTime (DISPLAY(d)->dpy, Get_Integer (t)); XtSetMultiClickTime (DISPLAY(d)->dpy, Get_Integer (t));
return Void; return Void;
} }
elk_init_xt_translation () { void elk_init_xt_translation () {
Define_Primitive (P_Augment_Translations, Define_Primitive (P_Augment_Translations,
"augment-translations", 2, 2, EVAL); "augment-translations", 2, 2, EVAL);
Define_Primitive (P_Override_Translations, Define_Primitive (P_Override_Translations,

83
lib/xwidgets/widget.c
View File

@ -40,7 +40,7 @@ Generic_Equal (Widget, WIDGET, widget)
Generic_Print (Widget, "#[widget %lu]", POINTER(x)) 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; Object w;
if (widget == 0) if (widget == 0)
@ -60,33 +60,33 @@ static Object Internal_Make_Widget (finalize, widget) Widget widget; {
} }
/* Backwards compatibility: */ /* Backwards compatibility: */
Object Make_Widget (widget) Widget widget; { Object Make_Widget (Widget widget) {
return Internal_Make_Widget (1, 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); return Internal_Make_Widget (0, widget);
} }
void Check_Widget (w) Object w; { void Check_Widget (Object w) {
Check_Type (w, T_Widget); Check_Type (w, T_Widget);
if (WIDGET(w)->free) if (WIDGET(w)->free)
Primitive_Error ("invalid widget: ~s", w); 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); Check_Widget (w);
if (XtClass (WIDGET(w)->widget) != class) if (XtClass (WIDGET(w)->widget) != class)
Primitive_Error ("widget not of expected class: ~s", w); 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); Check_Widget (w);
XtDestroyWidget (WIDGET(w)->widget); XtDestroyWidget (WIDGET(w)->widget);
return Void; 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; register char *sn = 0, *sc = 0;
ArgList a; ArgList a;
Object name, class, w, d, ret; Object name, class, w, d, ret;
@ -106,7 +106,7 @@ static Object P_Create_Shell (argc, argv) Object *argv; {
return ret; return ret;
} }
static Object P_Create_Widget (argc, argv) Object *argv; { static Object P_Create_Widget (int argc, Object *argv) {
ArgList a; ArgList a;
char *name = 0; char *name = 0;
Object x, class, parent, ret; Object x, class, parent, ret;
@ -131,34 +131,34 @@ static Object P_Create_Widget (argc, argv) Object *argv; {
return ret; return ret;
} }
static Object P_Realize_Widget (w) Object w; { static Object P_Realize_Widget (Object w) {
Check_Widget (w); Check_Widget (w);
XtRealizeWidget (WIDGET(w)->widget); XtRealizeWidget (WIDGET(w)->widget);
return Void; return Void;
} }
static Object P_Unrealize_Widget (w) Object w; { static Object P_Unrealize_Widget (Object w) {
Check_Widget (w); Check_Widget (w);
XtUnrealizeWidget (WIDGET(w)->widget); XtUnrealizeWidget (WIDGET(w)->widget);
return Void; return Void;
} }
static Object P_Widget_Realizedp (w) Object w; { static Object P_Widget_Realizedp (Object w) {
Check_Widget (w); Check_Widget (w);
return XtIsRealized (WIDGET(w)->widget) ? True : False; 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); Check_Widget (w);
return Make_Display (0, XtDisplayOfObject (WIDGET(w)->widget)); 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); Check_Widget (w);
return Make_Widget_Foreign (XtParent (WIDGET(w)->widget)); 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; char *s;
Check_Widget (w); Check_Widget (w);
@ -166,19 +166,19 @@ static Object P_Widget_Name (w) Object w; {
return Make_String (s, strlen (s)); 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); Check_Widget (w);
return Make_Window (0, XtDisplayOfObject (WIDGET(w)->widget), return Make_Window (0, XtDisplayOfObject (WIDGET(w)->widget),
XtWindow (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); Check_Widget (w);
return XtIsComposite (WIDGET(w)->widget) ? True : False; return XtIsComposite (WIDGET(w)->widget) ? True : False;
} }
static Object Manage_Unmanage (children, f) Object children; void (*f)(); { static Object Manage_Unmanage (Object children, void (*f)()) {
register i, n; register int i, n;
Widget *buf; Widget *buf;
Object tail; Object tail;
Alloca_Begin; Alloca_Begin;
@ -198,60 +198,60 @@ static Object Manage_Unmanage (children, f) Object children; void (*f)(); {
return Void; return Void;
} }
static Object P_Manage_Children (children) Object children; { static Object P_Manage_Children (Object children) {
return Manage_Unmanage (children, XtManageChildren); 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); return Manage_Unmanage (children, XtUnmanageChildren);
} }
static Object P_Widget_Managedp (w) Object w; { static Object P_Widget_Managedp (Object w) {
Check_Widget (w); Check_Widget (w);
return XtIsManaged (WIDGET(w)->widget) ? True : False; 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); Check_Widget (w);
return Make_Widget_Class (XtClass (WIDGET(w)->widget)); 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); Check_Widget (w);
if (XtClass (WIDGET(w)->widget) == widgetClass) if (XtClass (WIDGET(w)->widget) == widgetClass)
return Sym_None; return Sym_None;
return Make_Widget_Class (XtSuperclass (WIDGET(w)->widget)); 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_Widget (w);
Check_Type (c, T_Class); Check_Type (c, T_Class);
return XtIsSubclass (WIDGET(w)->widget, CLASS(c)->wclass) ? True : False; 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_Widget (w);
Check_Type (m, T_Boolean); Check_Type (m, T_Boolean);
XtSetMappedWhenManaged (WIDGET(w)->widget, EQ(m, True)); XtSetMappedWhenManaged (WIDGET(w)->widget, EQ(m, True));
return Void; return Void;
} }
static Object P_Map_Widget (w) Object w; { static Object P_Map_Widget (Object w) {
Check_Widget (w); Check_Widget (w);
XtMapWidget (WIDGET(w)->widget); XtMapWidget (WIDGET(w)->widget);
return Void; return Void;
} }
static Object P_Unmap_Widget (w) Object w; { static Object P_Unmap_Widget (Object w) {
Check_Widget (w); Check_Widget (w);
XtUnmapWidget (WIDGET(w)->widget); XtUnmapWidget (WIDGET(w)->widget);
return Void; return Void;
} }
static Object P_Set_Values (argc, argv) Object *argv; { static Object P_Set_Values (int argc, Object *argv) {
ArgList a; ArgList a;
Widget w; Widget w;
register i, n = (argc-1)/2; register int i, n = (argc-1)/2;
Alloca_Begin; Alloca_Begin;
Check_Widget (argv[0]); Check_Widget (argv[0]);
@ -265,7 +265,7 @@ static Object P_Set_Values (argc, argv) Object *argv; {
return Void; return Void;
} }
static Object P_Get_Values (argc, argv) Object *argv; { static Object P_Get_Values (int argc, Object *argv) {
Widget w; Widget w;
Check_Widget (argv[0]); 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); 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); Check_Widget (w);
return return
Make_Context_Foreign (XtWidgetToApplicationContext (WIDGET(w)->widget)); 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_Widget (w);
Check_Type (s, T_Boolean); Check_Type (s, T_Boolean);
XtSetSensitive (WIDGET(w)->widget, EQ(s, True)); XtSetSensitive (WIDGET(w)->widget, EQ(s, True));
return Void; return Void;
} }
static Object P_Sensitivep (w) Object w; { static Object P_Sensitivep (Object w) {
Check_Widget (w); Check_Widget (w);
return XtIsSensitive (WIDGET(w)->widget) ? True : False; 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); Check_Type (w, T_Window);
return Make_Widget_Foreign (XtWindowToWidget (WINDOW(w)->dpy, return Make_Widget_Foreign (XtWindowToWidget (WINDOW(w)->dpy,
WINDOW(w)->win)); WINDOW(w)->win));
} }
static Object P_Name_To_Widget (root, name) Object root, name; { static Object P_Name_To_Widget (Object root, Object name) {
register char *s;
Check_Widget (root); Check_Widget (root);
return Make_Widget_Foreign (XtNameToWidget (WIDGET(root)->widget, return Make_Widget_Foreign (XtNameToWidget (WIDGET(root)->widget,
Get_Strsym (name))); 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; Position root_x, root_y;
Check_Widget (w); Check_Widget (w);
@ -324,12 +322,12 @@ static Object P_Widget_Translate_Coordinates (w, x, y) Object w, x, y; {
#include <X11/CompositeP.h> #include <X11/CompositeP.h>
#undef XtIsComposite #undef XtIsComposite
static Widget_Visit (root, func) Object *root; int (*func)(); { static int Widget_Visit (Object *root, int (*func)()) {
Object obj; Object obj;
Widget w = WIDGET(*root)->widget; Widget w = WIDGET(*root)->widget;
if (WIDGET(*root)->free == 0 && XtIsComposite (w)) { if (WIDGET(*root)->free == 0 && XtIsComposite (w)) {
int i; unsigned int i;
CompositeRec *comp = (CompositeRec *)w; CompositeRec *comp = (CompositeRec *)w;
for (i = 0; i < comp->composite.num_children; i++) { 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) if (TYPE(obj) == T_Widget)
func (&obj); func (&obj);
} }
while (w = XtParent (w)) { while ((w = XtParent (w))) {
obj = Find_Object (T_Widget, (GENERIC)0, Match_Xt_Obj, w); obj = Find_Object (T_Widget, (GENERIC)0, Match_Xt_Obj, w);
if (TYPE(obj) == T_Widget) if (TYPE(obj) == T_Widget)
func (&obj); func (&obj);
} }
} }
return 0;
} }
elk_init_xt_widget () { void elk_init_xt_widget () {
T_Widget = Define_Type (0, "widget", NOFUNC, sizeof (struct S_Widget), T_Widget = Define_Type (0, "widget", NOFUNC, sizeof (struct S_Widget),
Widget_Equal, Widget_Equal, Widget_Print, Widget_Visit); Widget_Equal, Widget_Equal, Widget_Print, Widget_Visit);
Define_Primitive (P_Widgetp, "widget?", 1, 1, EVAL); Define_Primitive (P_Widgetp, "widget?", 1, 1, EVAL);

2
lib/xwidgets/xaw/grip.d
View File

@ -35,7 +35,7 @@
(c->scheme 'callback:grip-callback (c->scheme 'callback:grip-callback
" Object args, ret, t; " Object args, ret, t;
register i; register unsigned int i;
GripCallData p = (GripCallData)x; GripCallData p = (GripCallData)x;
GC_Node3; GC_Node3;

2
lib/xwidgets/xaw/init.c
View File

@ -30,6 +30,6 @@
#include "scheme.h" #include "scheme.h"
elk_init_xaw_init () { void elk_init_xaw_init () {
P_Provide (Intern ("xaw-widgets.so")); P_Provide (Intern ("xaw-widgets.so"));
} }

4
lib/xwidgets/xaw/list.d
View File

@ -31,8 +31,8 @@
(prolog (prolog
" "
static char **Get_List (x) Object x; { static char **Get_List (Object x) {
register i, n; register int i, n;
register char *s, **l; register char *s, **l;
Alloca_Begin; Alloca_Begin;

3
lib/xwidgets/xaw/stripchart.d
View File

@ -31,8 +31,7 @@
(prolog (prolog
"static void Get_Value (w, client_data, value) Widget w; "static void Get_Value (Widget w, XtPointer client_data, XtPointer value) {
XtPointer client_data; XtPointer value; {
Object ret; Object ret;
ret = Funcall (Get_Function ((int)client_data), Null, 0); ret = Funcall (Get_Function ((int)client_data), Null, 0);

4
lib/xwidgets/xterror.c
View File

@ -32,7 +32,7 @@
static Object V_Xt_Warning_Handler; static Object V_Xt_Warning_Handler;
void Xt_Warning (msg) char *msg; { void Xt_Warning (char *msg) {
Object args, fun; Object args, fun;
args = Cons (Make_String (msg, strlen (msg)), Null); args = Cons (Make_String (msg, strlen (msg)), Null);
@ -43,7 +43,7 @@ void Xt_Warning (msg) char *msg; {
(void)P_Newline (0, (Object *)0); (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); Define_Variable (&V_Xt_Warning_Handler, "xt-warning-handler", Null);
XtSetWarningHandler (Xt_Warning); XtSetWarningHandler (Xt_Warning);
} }

4
lib/xwidgets/xtinit.c
View File

@ -58,10 +58,10 @@ extern WidgetClass vendorShellWidgetClass;
* it isn't removed by the optimizer. * 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; extern WidgetClass vendorShellWidgetClass;
dummy(vendorShellWidgetClass); dummy(vendorShellWidgetClass);

4
lib/xwidgets/xtobjects.c
View File

@ -32,8 +32,8 @@
#include "xt.h" #include "xt.h"
Match_Xt_Obj (x, v) Object x; va_list v; { int Match_Xt_Obj (Object x, va_list v) {
register type = TYPE(x); register int type = TYPE(x);
if (type == T_Context) { if (type == T_Context) {
return va_arg (v, XtAppContext) == CONTEXT(x)->context; return va_arg (v, XtAppContext) == CONTEXT(x)->context;