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

declareExternalFunction(XtAddCallback)
	declareObject(widget);
	declareObject(callbackName);
	declareObject(callbackObject);
	declareObject(callbackProc);
	declareDaisyChain(tmp);

	sXtCallback				*sCallback;

	string					type;

	String					callback;

	HEADER
		declareHelpString("Add callback to a widget\n"
				"    3: widget\n"
				"    2: callback name (XmNactivateCallback)\n"
				"    1: expression\n"
				" -> 1: callback\n");
		numberOfArguments(3);
	FUNCTION
		if (initializationDone eq true) then
			pullFromStack(callbackProc, unknown);
			returnOnError(freeObject(callbackProc));

			pullFromStack(callbackName, string);
			returnOnError(freeObject(callbackProc); freeObject(callbackName));

			pullFromStack(widget, external);
			returnOnError(freeObject(callbackProc); freeObject(callbackName);
					freeObject(widget));

			ifIsExternal(widget, WIDGET) then
			orElse
				executionError("Type mismatch error");
				returnOnError(freeObject(callbackProc);
						freeObject(callbackName); freeObject(widget));
			endIf

			getString(callbackName, type);

			if (strcmp(type, "XmNactivateCallback") eq 0) then
				callback = XmNactivateCallback;
			orElse
				executionError("Unknown callback type");
				returnOnError(freeObject(callbackProc);
						freeObject(callbackName); freeObject(widget));
			endIf

			createExternalObject(callbackObject, CALLBACK);

			sCallback = allocate(size(sXtCallback));
			sCallback->status = procStatus(rpl_arguments);
			sCallback->callback = callbackProc;
			sCallback->widget = target(objectContainer(Widget, widget));
			objectOf(callbackObject) = sCallback;

			XtAddCallback(target(objectContainer(Widget, widget)),
					callback, rplCallback, (XtPointer) sCallback);

			tmp = allocate(size(daisyChain));
			tmp->next = lCallbacks;
			tmp->data = callbackObject;
			lCallbacks = tmp;

			dupObject(callbackObject);
			pushOnStack(callbackObject);
		orElse
			executionError("Application not initialized");
			returnOnError();
		endIf
	END
endExternalFunction

// vim: ts=4