The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w
#-*-perl-*-
# Autogenerated by fd2pl from fdesign file /root/clipboard.c
#
use X11::Xforms;
#

$clipboard = undef;
$TextBox = undef;
$SelectButton = undef;
$PasteButton = undef;
$DoneButton = undef;

$form_frozen = 0;

fl_initialize("ClipBoard");
create_the_forms();

fl_show_form($clipboard, FL_PLACE_FREE, FL_FULLBORDER, "Clipboard");

fl_do_forms();

exit(0);

sub create_form_clipboard {
  $obj = undef;
  $clipboard = fl_bgn_form(FL_NO_BOX, 280, 140);
  $obj = fl_add_box(FL_UP_BOX, 0, 0, 280, 140, "");
  $obj = fl_add_text(FL_NORMAL_TEXT, 10, 10, 260, 80, "This Text can be selected using the 'Select' button,\nor overwritten with the primary X selection\nusing the 'Paste' button");
  $TextBox = $obj;
  fl_set_object_boxtype($obj, FL_DOWN_BOX);
  fl_set_object_lalign($obj, FL_ALIGN_CENTER|FL_ALIGN_INSIDE);
  $obj = fl_add_button(FL_NORMAL_BUTTON, 10, 100, 80, 30, "Select");
  $SelectButton = $obj;
  fl_set_object_callback($obj, "process_select", 0);
  $obj = fl_add_button(FL_NORMAL_BUTTON, 100, 100, 80, 30, "Paste");
  $PasteButton = $obj;
  fl_set_object_callback($obj, "process_paste", 0);
  $obj = fl_add_button(FL_NORMAL_BUTTON, 190, 100, 80, 30, "Done");
  $DoneButton = $obj;
  fl_set_object_callback($obj, "process_done", 0);
  fl_end_form();
}

sub create_the_forms {
  create_form_clipboard();
}
 
sub process_select {

	my($obj, $val) = @_;
	fl_set_object_color($TextBox, FL_BLACK, FL_WHITE);
	fl_set_object_lcolor($TextBox, FL_WHITE);
    fl_stuff_clipboard($obj, $TextBox->label, "selection_lost");
}

sub process_paste {

	my($obj, $val) = @_;
	if (fl_request_clipboard($obj, "selection_obtained") == 0)
	{
		$form_frozen = 1;
		fl_freeze_form($clipboard);
	}
}

sub process_done {
	exit(0);
}

sub selection_lost {

	my($obj, $type) = @_;
	fl_set_object_color($TextBox, FL_TEXT_COL1, FL_TEXT_COL2);
	fl_set_object_lcolor($TextBox, FL_TEXT_LCOL);
	return 0;
}

sub selection_obtained {

	my($obj, $type, $data, $size) = @_;

	$data = "There is no selection" if ($size == 0);
	fl_set_object_color($TextBox, FL_TEXT_COL1, FL_TEXT_COL2);
	fl_set_object_lcolor($TextBox, FL_TEXT_LCOL);
	fl_set_object_label($TextBox, $data);

	if ($form_frozen)
	{
		fl_unfreeze_form($clipboard);
		$form_frozen = 0;
	}
	return 0;
}