--- rpl/modules/motif/XtCreateWidget.rplc	2017/07/05 19:07:19	1.2
+++ rpl/modules/motif/XtCreateWidget.rplc	2017/08/22 11:22:04	1.8
@@ -8,17 +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"
@@ -37,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);
@@ -139,24 +152,93 @@ declareExternalFunction(XtCreateWidget)
 			repeatWhile(not nullified(current))
 				list = fetchElementFromDaisyChain(current);
 				getDaisyChainFromList(list, current2);
-				getString(fetchElementFromDaisyChain(current2), name);
+				getString(fetchElementFromDaisyChain(current2), command);
 				current2 = nextElementOfDaisyChain(current2);
 
-				XmN_constants(name, argument);
+				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) target(objectContainer(Widget,
+								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(objectContainer(Widget,
+								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);
+			objectOf(widget) = allocate(size(Widget));
+
+			target(objectContainer(Widget, widget)) =
+					XtCreateWidget(name, wc, target(
+					objectContainer(Widget, parentObject)), args, argNum);
+
+			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