#!/usr/bin/perl
#
# This is a demo that uses the Motif 2.0 Container widget.
# It is initial code for a source code manager front end.
#

use X11::Wcl;

main();

# exit button was pressed
#
# $arg1 is from resource string that references the callback; it is an
#     integer that must be converted to a char * to be dereferenced
# $arg2 is the callback struct; it must be cast into the proper type
#     using the proper constructor
# $arg3 is the argument from callback registration time; it is
#     whatever PERL object was passed to X11::Wcl::WcRegisterCallback()
sub buttonCB
{
	exit(0);
}

# This callback routine tracks selection/deselection events in the
# container widget.
#
# $arg1 is from resource string that references the callback; it is an
#     integer that must be converted to a char * to be dereferenced
# $arg2 is the callback struct; it must be cast into the proper type
#     using the proper constructor
# $arg3 is the argument from callback registration time; it is
#     whatever PERL object was passed to X11::Wcl::WcRegisterCallback()
sub selectionCB
{
	my($arg1, $arg2, $arg3) = @_;
	my $x;
	my $y;

	print "*** selectionCB\n";

	# client data
	# cast it to a char * and print it
	$x = X11::Wcl::ptrcast(eval $arg1, "char *");
	print "    client data (", X11::Wcl::ptrvalue($x), ")\n";

	# registration data
	# it is a PERL variable, so print it without further manipulation
	print "    registration data ($arg3)\n";

	# callback struct
	# expecting XmContainerSelectCallbackStruct, so cast it to that
	$x = new XmContainerSelectCallbackStruct($arg2);
	# now dump the various fields in the struct, just as an example of
	# how to do it
	for (sort keys %{$x}) {
		# print field name and value
		print "    " . $_ . ", " . $x->{$_} . "\n";
		# the "event" field is itself a struct, do some further
		# processing on it
		if ($_ eq "event") {
			# decode the event.type field so we can see what kind of
			# event we have received
			if ($x->{$_}->{type} eq $X11::Wcl::KeyPress) {
				print "        type KeyPress\n";
			} elsif ($x->{$_}->{type} eq $X11::Wcl::KeyRelease) {
				print "        type KeyRelease\n";
			} elsif ($x->{$_}->{type} eq $X11::Wcl::ButtonPress) {
				print "        type ButtonPress\n";
			} elsif ($x->{$_}->{type} eq $X11::Wcl::ButtonRelease) {
				print "        type ButtonRelease\n";
			} elsif ($x->{$_}->{type} eq $X11::Wcl::MotionNotify) {
				print "        type MotionNotify\n";
			} elsif ($x->{$_}->{type} eq $X11::Wcl::EnterNotify) {
				print "        type EnterNotify\n";
			} elsif ($x->{$_}->{type} eq $X11::Wcl::LeaveNotify) {
				print "        type LeaveNotify\n";
			} elsif ($x->{$_}->{type} eq $X11::Wcl::FocusIn) {
				print "        type FocusIn\n";
			} elsif ($x->{$_}->{type} eq $X11::Wcl::FocusOut) {
				print "        type FocusOut\n";
			} elsif ($x->{$_}->{type} eq $X11::Wcl::KeymapNotify) {
				print "        type KeymapNotify\n";
			} elsif ($x->{$_}->{type} eq $X11::Wcl::Expose) {
				print "        type Expose\n";
			} elsif ($x->{$_}->{type} eq $X11::Wcl::GraphicsExpose) {
				print "        type GraphicsExpose\n";
			} elsif ($x->{$_}->{type} eq $X11::Wcl::NoExpose) {
				print "        type NoExpose\n";
			} elsif ($x->{$_}->{type} eq $X11::Wcl::VisibilityNotify) {
				print "        type VisibilityNotify\n";
			} elsif ($x->{$_}->{type} eq $X11::Wcl::CreateNotify) {
				print "        type CreateNotify\n";
			} elsif ($x->{$_}->{type} eq $X11::Wcl::DestroyNotify) {
				print "        type DestroyNotify\n";
			} elsif ($x->{$_}->{type} eq $X11::Wcl::UnmapNotify) {
				print "        type UnmapNotify\n";
			} elsif ($x->{$_}->{type} eq $X11::Wcl::MapNotify) {
				print "        type MapNotify\n";
			} elsif ($x->{$_}->{type} eq $X11::Wcl::MapRequest) {
				print "        type MapRequest\n";
			} elsif ($x->{$_}->{type} eq $X11::Wcl::ReparentNotify) {
				print "        type ReparentNotify\n";
			} elsif ($x->{$_}->{type} eq $X11::Wcl::ConfigureNotify) {
				print "        type ConfigureNotify\n";
			} elsif ($x->{$_}->{type} eq $X11::Wcl::ConfigureRequest) {
				print "        type ConfigureRequest\n";
			} elsif ($x->{$_}->{type} eq $X11::Wcl::GravityNotify) {
				print "        type GravityNotify\n";
			} elsif ($x->{$_}->{type} eq $X11::Wcl::ResizeRequest) {
				print "        type ResizeRequest\n";
			} elsif ($x->{$_}->{type} eq $X11::Wcl::CirculateNotify) {
				print "        type CirculateNotify\n";
			} elsif ($x->{$_}->{type} eq $X11::Wcl::CirculateRequest) {
				print "        type CirculateRequest\n";
			} elsif ($x->{$_}->{type} eq $X11::Wcl::PropertyNotify) {
				print "        type PropertyNotify\n";
			} elsif ($x->{$_}->{type} eq $X11::Wcl::SelectionClear) {
				print "        type SelectionClear\n";
			} elsif ($x->{$_}->{type} eq $X11::Wcl::SelectionRequest) {
				print "        type SelectionRequest\n";
			} elsif ($x->{$_}->{type} eq $X11::Wcl::SelectionNotify) {
				print "        type SelectionNotify\n";
			} elsif ($x->{$_}->{type} eq $X11::Wcl::ColormapNotify) {
				print "        type ColormapNotify\n";
			} elsif ($x->{$_}->{type} eq $X11::Wcl::ClientMessage) {
				print "        type ClientMessage\n";
			} elsif ($x->{$_}->{type} eq $X11::Wcl::MappingNotify) {
				print "        type MappingNotify\n";
			}
			# print the rest of the fields in event struct
#			for $y (sort keys %{$x->{$_}}) {
#				next if $y eq "type";
#				print "        " . $y . ", " . $x->{$_}->{$y} . "\n";
#			}
		}
	}

	# dump information about the selected widgets that are passed in
	# the callback struct
	# number of widgets
	my $cnt = $x->{'selected_item_count'};
	if ($cnt > 0) {
		# array of widgets
		my $z = $x->{'selected_items'};
		for ($i=0; $i<$cnt; ++$i) {
			# cast it to an int *
			my $y = X11::Wcl::ptrcast($z, "int *");
			# now get the int (which is the raw memory address, which
			# we saved in %WIDGETS when the widget was created
			$y = X11::Wcl::ptrvalue($y, $i);
			# print information about the widget
			print "    selected_items[$i] $y @{$WIDGETS{$y}}\n";
		}
	}
}

# register all of my PERL callback functions
sub RegisterApplication
{
	my($app_context) = @_;

	X11::Wcl::WcRegisterCallback($app_context,
							"buttonCB",
							\&buttonCB);
	X11::Wcl::WcRegisterCallback($app_context,
							"selectionCB",
							\&selectionCB,
							"optional registration time data");
}

# main routine
# This is pretty generic; copy it and modify for your application.
sub main
{
	# make an int for argc
	my $argc = X11::Wcl::ptrcreate("int", 0, 1);
	# make array of 20 char * pointers for argv
	my $argv = X11::Wcl::ptrcreate("char *", 0, 20);
	# make array of 20 XrmOptionDescRec structures
	my $options = new XrmOptionDescRec(0, 20);
	my $num_options;
	my $app_context;
	my $toplevel;
	my $i;
	my $x;

	# parse the resource specifications at the end of this file
	$main::initial_resources = get_resources();

	# set up argc and argv
	X11::Wcl::ptrset($argc, 3);
	X11::Wcl::ptrset($argv, "TEST", 0);
	X11::Wcl::ptrset($argv, "-rf", 1);
	X11::Wcl::ptrset($argv, "\$main::initial_resources", 2);
	X11::Wcl::ptrset($argv, X11::Wcl::ptrcast(0, "char *"), 3);

	$num_options = 0;

	# set up for option parsing
	$x = $options->idx($num_options++);
	$x->{option} = "-rf";
	$x->{specifier} = "*wclInitResFile";
	$x->{argKind} = $X11::Wcl::XrmoptionSepArg;
	#$x->{value} = undef;

	# more set up for option parsing
	# just to demonstrate how to handle more than one array element
	$x = $options->idx($num_options++);
	$x->{option} = "-rf";
	$x->{specifier} = "*wclInitResFile";
	$x->{argKind} = $X11::Wcl::XrmoptionSepArg;
	#$x->{value} = undef;

    # Initialize Toolkit creating the application shell
    $toplevel = X11::Wcl::XtInitialize("TEST",
								  "TEST",
								  $options,
								  $num_options,
								  $argc,
								  $argv
								  );

	# get application context
    $app_context = X11::Wcl::XtWidgetToApplicationContext($toplevel);

    # Register application specific callbacks and widget classes
	RegisterApplication($app_context);

    # Register all widget classes and constructors
    X11::Wcl::XmpRegisterAll($app_context);

    # Create widget tree below toplevel shell using Xrm database
	if (X11::Wcl::WcWidgetCreation($toplevel)) {
		exit(1);
	}

	# create the widgets to be displayed
	# just hard-coded for demo purposes
	add_project($toplevel, 		"proj1");
	add_directory($toplevel, 	"proj1", 	"a/b/c/d");
	add_file($toplevel, 		"proj1", 	"a/b/c/d", 	"file1");
	add_file($toplevel, 		"proj1", 	"a/b/c/d", 	"file2");
	add_directory($toplevel, 	"proj1", 	"a/b/d");
	add_file($toplevel, 		"proj1", 	"a/b/d",	"file");

    # Realize the widget tree
    X11::Wcl::XtRealizeWidget($toplevel);

	# not implemented at present
	#X11::Wcl::XmpAddMwmCloseCallback($toplevel, (XtCallbackProc)DeleteWindowCB, NULL);

    # finally, enter the main application loop
    X11::Wcl::XtMainLoop();
}

# function to add a new project to the display
sub add_project
{
	my($toplevel, $project) = @_;
	my $x;

	if (!exists $PROJECTS{$project}) {
		$PROJECTS{$project} = 1;
		# get container widget
		$x = X11::Wcl::WcFullNameToWidget($toplevel, "*container");
		# create a new project in the container, using the template
		# defined for projects
		$x = X11::Wcl::WcCreateChildFromTemplate($x, $project, '$project');
		# save widget pointer so we can detect its selection in callbacks
		# see how WIDGETS is used in the callback routine above
		$WIDGETS{$$x} = ["project", $project];
		# set the label displayed on the new widget
		X11::Wcl::WcSetValueFromString($x, "labelString", $project);
		# display the widget
		X11::Wcl::XtManageChild($x);
	}
}

# function to add a new directory to the display, under a given project
sub add_directory
{
	my($toplevel, $project, $directory) = @_;
	my $d;
	my $e;
	my $x;

	if (exists $PROJECTS{$project} && !exists $PROJECTS{$project}{$directory}) {
		if (($d, $e) = ($directory =~ m#^(.+)/(.+)$#)) {
			add_directory($toplevel, $project, $d);
		} else {
			$d = $project;
			$e = $directory;
		}
		$PROJECTS{$project}{$directory} = 1;
		# get container widget
		$x = X11::Wcl::WcFullNameToWidget($toplevel, "*container");
		# create a new directory in the container, using the template
		# defined for directories
		$x = X11::Wcl::WcCreateChildFromTemplate($x, $directory, '$directory');
		# save widget pointer so we can detect its selection in callbacks
		# see how WIDGETS is used in the callback routine above
		$WIDGETS{$$x} = ["directory", $project, $directory];
		# set the label displayed on the new widget
		X11::Wcl::WcSetValueFromString($x, "labelString", $e);
		# point back to parent project
		X11::Wcl::WcSetValueFromString($x, "entryParent", "*$d");
		# display the widget
		X11::Wcl::XtManageChild($x);
	}
}

# function to add a new file to the display, under a given project and directory
sub add_file
{
	my($toplevel, $project, $directory, $file) = @_;
	my $d;
	my $e;
	my $x;

	if (exists $PROJECTS{$project} &&
		exists $PROJECTS{$project}{$directory} &&
		!exists $PROJECTS{$project}{$directory}{$file}) {
		$PROJECTS{$project}{$directory}{$file} = 1;
		# get container widget
		$x = X11::Wcl::WcFullNameToWidget($toplevel, "*container");
		# create a new file in the container, using the template
		# defined for files
		$x = X11::Wcl::WcCreateChildFromTemplate($x, $file, '$file');
		# save widget pointer so we can detect its selection in callbacks
		# see how WIDGETS is used in the callback routine above
		$WIDGETS{$$x} = ["file", $project, $directory, $file];
		# set the label displayed on the new widget
		X11::Wcl::WcSetValueFromString($x, "labelString", $file);
		# point back to parent directory
		X11::Wcl::WcSetValueFromString($x, "entryParent", "*$directory");
		# display the widget
		X11::Wcl::XtManageChild($x);
	}
}

# parse <DATA> and set up variables that contain the X resources that
# the Widget Creation Library needs
sub get_resources
{
	my $main;
	my $variable;
	my $data;

	while (<DATA>) {
		if (/^MAIN\s*$/) {
			# start of top level resources
			if (defined $variable) {
				eval "\$$variable = \$data";
				$data = "";
			}
			$variable = "main";
		} elsif (/^TEMPLATE\s+(\S+)\s*$/) {
			# start of template resources
			if (defined $variable) {
				eval "\$$variable = \$data";
				$data = "";
			}
			$variable = $1;
		} else {
			$data .= $_;
		}
	}
	if (defined $variable) {
		eval "\$$variable = \$data";
	}

	# return top level resources
	$main;
}

__END__

MAIN
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
TEST.wcChildren: form

! constants
*wclVerboseWarnings:			True
!*wcPostCreateDumpResources:	True
!*wcPreCreateDumpResources:		True
!*wcTrace:						True
*background:					light gray
*foreground:					black
*FontList:						-*-courier-bold-r-*-*-*-140-100-100-*-*-*-*
*wclTemplateFiles:				$project, $directory, $file

*form.WcCreate:					XmForm
*form.WcChildren:				button container
*form.width:					500
*form.height:					500
*form.fractionBase:				1000
!*form.wcAfterChildren:			WcPrintTree(*form)

*button.WcCreate: XmPushButton
*button.labelString: EXIT
*button.activateCallback: 	buttonCB()
*button.topAttachment:		ATTACH_FORM
*button.leftAttachment:		ATTACH_FORM

*container.wcCreate:			XmContainer
*container.entryViewType:		XmSMALL_ICON
*container.layoutType:			XmDETAIL
*container.detailColumnHeading:	buttons, locked
*container.detailColumnHeadingCount: 2
*container.detailOrder:			1 2
*container.automaticSelection:	XmAUTO_SELECT
*container.selectionCallback:	selectionCB(testing)
*container.topAttachment:		ATTACH_WIDGET
*container.topWidget:			*button
*container.leftAttachment:		ATTACH_FORM
!*container.rightAttachment:	ATTACH_FORM
!*container.bottomAttachment:	ATTACH_FORM

TEMPLATE project
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

*background:					red
.wcCreate:						XmIconGadget
.detail:						jhpb
.detailCount:					1

TEMPLATE directory
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

*background:					blue
.wcCreate:						XmIconGadget
.detail:						jhpb
.detailCount:					1

TEMPLATE file
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

*background:					green
.wcCreate:						XmIconGadget
.detail:						jhpb
.detailCount:					1
