--- rpl/modules/motif/XtCreateWidget.rplc	2017/07/05 13:53:40	1.1
+++ rpl/modules/motif/XtCreateWidget.rplc	2017/07/10 14:47:59	1.5
@@ -8,15 +8,23 @@ declareExternalFunction(XtCreateWidget)
 	declareObject(parametersObject);
 	declareObject(list);
 	declareObject(directive);
+	declareObject(widget);
+
+	declareInteger(value);
 
 	declareDaisyChain(current);
 	declareDaisyChain(current2);
 
 	char			target(name);
 	char			target(class);
+	char			target(cvalue);
+	char			target(command);
 
+	ArgList			args;
 	Cardinal		argNum;
+	String			argument;
 	WidgetClass		wc;
+	XmString		x_string;
 
 	HEADER
 		declareHelpString("Create a Motif widget\n"
@@ -35,6 +43,13 @@ declareExternalFunction(XtCreateWidget)
 			returnOnError(freeObject(parametersObject);
 					freeObject(parentObject));
 
+			ifIsExternal(parentObject, WIDGET) then
+			orElse
+				executionError("Type mismatch error");
+				returnOnError(freeObject(parametersObject);
+						freeObject(parentObject));
+			endIf
+
 			pullFromStack(classObject, string);
 			returnOnError(freeObject(parametersObject);
 					freeObject(parentObject);
@@ -129,11 +144,109 @@ declareExternalFunction(XtCreateWidget)
 				current = nextElementOfDaisyChain(current);
 				postIncr(argNum);
 			endWhile
+
+uprintf("%d\n", argNum);
+			args = allocate(size(Arg) * argNum);
+			argNum = 0;
+			getDaisyChainFromList(parametersObject, current);
+
+			repeatWhile(not nullified(current))
+				list = fetchElementFromDaisyChain(current);
+				getDaisyChainFromList(list, current2);
+				getString(fetchElementFromDaisyChain(current2), command);
+				current2 = nextElementOfDaisyChain(current2);
+
+				XmN_constants(command, argument);
+
+				returnOnError(freeObject(parametersObject);
+						freeObject(parentObject);
+						freeObject(classObject);
+						freeObject(nameObject));
+
+				ifIsExternal(fetchElementFromDaisyChain(current2), WIDGET) then
+					if ((strcmp(command, "XmNtopWidget") eq 0) or
+							(strcmp(command, "XmNbottomWidget") eq 0) or
+							(strcmp(command, "XmNleftWidget") eq 0) or
+							(strcmp(command, "XmNrightWidget") eq 0)) then
+/*
+						XtSetArg(args[argNum], argument,
+								(XtArgVal) (*((sXtAppContext *)
+								objectContainer(fetchElementFromDaisyChain(
+								current2)))).widget);
+*/
+						XtSetArg(args[argNum], argument,
+								(XtArgVal) target((Widget *) objectContainer(
+								fetchElementFromDaisyChain(current2))));
+					orElse
+						executionError("Wait for XmN*Widget");
+						deallocate(args);
+						returnOnError(freeObject(parametersObject);
+								freeObject(parentObject);
+								freeObject(classObject);
+								freeObject(nameObject));
+					endIf
+				elseIfIsName(fetchElementFromDaisyChain(current2)) then
+					directive = fetchElementFromDaisyChain(current2);
+					dupObject(directive);
+					intrinsic(pshcntxt);
+					pushOnStack(directive);
+					intrinsic(eval);
+					pullFromStack(directive, unknown);
+					intrinsic(pulcntxt);
+
+					ifIsInteger(directive) then
+						getInteger(directive, value);
+						XtSetArg(args[argNum], argument, (XtArgVal) value);
+					elseIfIsExternal(directive, WIDGET) then
+						if ((strcmp(command, "XmNtopWidget") eq 0) or
+								(strcmp(command, "XmNbottomWidget") eq 0) or
+								(strcmp(command, "XmNleftWidget") eq 0) or
+								(strcmp(command, "XmNrightWidget") eq 0)) then
+						XtSetArg(args[argNum], argument,
+								(XtArgVal) target((Widget *) objectContainer(
+								directive)));
+						orElse
+							executionError("Wait for XmN*Widget");
+							deallocate(args);
+							returnOnError(freeObject(parametersObject);
+									freeObject(parentObject);
+									freeObject(classObject);
+									freeObject(nameObject));
+						endIf
+					endIf
+				elseIfIsInteger(fetchElementFromDaisyChain(current2)) then
+					getInteger(fetchElementFromDaisyChain(current2), value);
+					XtSetArg(args[argNum], argument, (XtArgVal) value);
+				orElse // Allowed types are integer, name, widget or string
+					getString(fetchElementFromDaisyChain(current2), cvalue);
+					x_string = XmStringCreate(cvalue, XmFONTLIST_DEFAULT_TAG);
+					XtSetArg(args[argNum], argument, (XtArgVal) x_string);
+				endIf
+
+				current = nextElementOfDaisyChain(current);
+				postIncr(argNum);
+			endWhile
+
+			createExternalObject(widget, WIDGET);
+			objectContainer(widget) = allocate(size(Widget));
+
+			target((Widget *) objectContainer(widget)) =
+					XtCreateWidget(name, wc, target((Widget *)
+					objectContainer(parentObject)), args, argNum);
+			XtManageChild(target((Widget *) objectContainer(widget)));
+
+			pushOnStack(widget);
+			deallocate(args);
 		orElse
 			executionError("Application not initialized");
 			returnOnError();
 		endIf
 
-		setFalse(initializationDone);
+		freeObject(parametersObject);
+		freeObject(parentObject);
+		freeObject(classObject);
+		freeObject(nameObject);
 	END
 endExternalFunction
+
+// vim: ts=4