#include "src/rplexternals.h"
#include "motif.h"

declareExternalFunction(XtCreateWidget)
	declareObject(nameObject);
	declareObject(classObject);
	declareObject(parentObject);
	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"
				"    4: name\n"
				"    3: class\n"
				"    2: parent\n"
                "    1: { parameters }\n"
                " -> 1: widget\n");
		numberOfArguments(4);
	FUNCTION
		if (initializationDone eq true) then
			pullFromStack(parametersObject, list);
			returnOnError(freeObject(parametersObject));

			pullFromStack(parentObject, external);
			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);
					freeObject(classObject));

			pullFromStack(nameObject, string);
			returnOnError(freeObject(parametersObject);
					freeObject(parentObject);
					freeObject(classObject);
					freeObject(nameObject));

			getString(classObject, class);
			getString(nameObject, name);

			Xm_widgets_classes(class, wc);

			returnOnError(freeObject(parametersObject);
					freeObject(parentObject);
					freeObject(classObject);
					freeObject(nameObject));

			getDaisyChainFromList(parametersObject, current);
			argNum = 0;

			repeatWhile(not nullified(current))
				list = fetchElementFromDaisyChain(current);

				ifIsList(list) then
					getDaisyChainFromList(list, current2);

					if (nullified(current2)) then
						executionError("Too few arguments");
						returnOnError(freeObject(parametersObject);
								freeObject(parentObject);
								freeObject(classObject);
								freeObject(nameObject));
					endIf

					ifIsString(fetchElementFromDaisyChain(current2)) then
					orElse
						executionError("Type mismatch error");
						returnOnError(freeObject(parametersObject);
								freeObject(parentObject);
								freeObject(classObject);
								freeObject(nameObject));
					endIf

					current2 = nextElementOfDaisyChain(current2);

					if (nullified(current2)) then
						executionError("Too few arguments");
						returnOnError(freeObject(parametersObject);
								freeObject(parentObject);
								freeObject(classObject);
								freeObject(nameObject));
					endIf

					directive = fetchElementFromDaisyChain(current2);

					ifIsInteger(directive) then
					orElse
						ifIsString(directive) then
						orElse
							ifIsName(directive) then
							orElse
								executionError("Type mismatch error");
								returnOnError(freeObject(parametersObject);
										freeObject(parentObject);
										freeObject(classObject);
										freeObject(nameObject));
							endIf
						endIf
					endIf

					current2 = nextElementOfDaisyChain(current2);

					if (not nullified(current2)) then
						executionError("Type mismatch error");
						returnOnError(freeObject(parametersObject);
								freeObject(parentObject);
								freeObject(classObject);
								freeObject(nameObject));
					endIf
				orElse
					executionError("Type mismatch error");
					returnOnError(freeObject(parametersObject);
							freeObject(parentObject);
							freeObject(classObject);
							freeObject(nameObject));
				endIf

				current = nextElementOfDaisyChain(current);
				postIncr(argNum);
			endWhile

			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) 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

		freeObject(parametersObject);
		freeObject(parentObject);
		freeObject(classObject);
		freeObject(nameObject);
	END
endExternalFunction

// vim: ts=4