#!/usr/bin/perl -w

# Copyright (C) 2002-2009 Mikhael Goikhman <migo@cpan.org>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

# Filter this script to pod2man to get a man page:
#   pod2man -c "Fvwm Module" FvwmGtkDebug | nroff -man | less -e

use 5.003;
use strict;

BEGIN {
	use vars qw($prefix $datarootdir $datadir);
	$prefix = "/usr";
	$datarootdir = "${prefix}/share";
	$datadir = "${datarootdir}";
}

use lib "${datadir}/fvwm/perllib";
use FVWM::Module::Gtk2;
use FVWM::EventNames;
use FVWM::Commands;
use FVWM::Tracker;
use General::FileSystem qw(append_file);
init Gtk2;

my $default_mask = MAX_MSG_MASK &
	~(M_FOCUS_CHANGE | M_CONFIGURE_WINDOW | M_VISIBLE_NAME | M_ICON_NAME);
my $default_xmask = MAX_XMSG_MASK &
	~(MX_ENTER_WINDOW | MX_LEAVE_WINDOW | MX_VISIBLE_ICON_NAME);
$default_xmask &= ~M_EXTENDED_MSG;

my $mask  = $default_mask;
my $xmask = $default_xmask;
my $debug = 0;

my $options = {
	'm|mask=i'  => \$mask,
	'x|xmask=i' => \$xmask,
	'd|debug=i' => \$debug,
};

my $module = new FVWM::Module::Gtk2(
	Name => "FvwmGtkDebug",
	EnableOptions => $options,
	Debug => \$debug,
);

$mask  = MAX_MSG_MASK  if $mask  == -1;
$xmask = MAX_XMSG_MASK if $xmask == -1;
my $new_mask  = $mask;
my $new_xmask = $xmask;

my $context_window_id = $module->{win_id};
my $self_window_id = 0;  # until mapped
my $is_dummy = $module->is_dummy;

# ----------------------------------------------------------------------------
# functions

my $monitoring = 0;
my $stored_event_datas = [];
my $current_event_num = -1;
my $event_list_size_changed = 0;
my $stick_to_last_event = 1;
my ($request_button_box_frame, $request_reply_frame);

sub event_arg_type_to_name ($) {
	my $type = shift;
	return
		$type == FVWM::EventNames::number ? "number" :
		$type == FVWM::EventNames::bool ? "boolean" :
		$type == FVWM::EventNames::window ? "window" :
		$type == FVWM::EventNames::pixel ? "color" :
		$type == FVWM::EventNames::string ? "string" :
		$type == FVWM::EventNames::looped ? "looped" :
		$type == FVWM::EventNames::wflags ? "wflags" :
		"unknown";
}

sub store_event ($$) {
	my ($module, $event) = @_;

	my @arg_names  = @{$event->arg_names};
	my @arg_types  = @{$event->arg_types};
	my @arg_values = @{$event->arg_values};

#	print STDERR $event->name, "\n";

	my $event_data = {
		type => $event->type,
		name => $event->name,
		time => time(),
		args => [],
	};
	while (@arg_names) {
		my $name  = shift @arg_names;
		my $type  = shift @arg_types;
		my $value = shift @arg_values;

		my $text;
		if ($type == FVWM::EventNames::number) {
			$text = $value;
			$text = "*undefined*" unless defined $value;
		} elsif ($type == FVWM::EventNames::bool) {
			$text = $value ? "True" : "False";
		} elsif ($type == FVWM::EventNames::window) {
			$text = sprintf("0x%07lx", $value);
		} elsif ($type == FVWM::EventNames::pixel) {
			$text = "rgb:" . join('/',
				sprintf("%06lx", $value) =~ /(..)(..)(..)/);
		} elsif ($type == FVWM::EventNames::string) {
			$text = qq("$value");
		} elsif ($type == FVWM::EventNames::looped) {
			my $loop_arg_names = $event->loop_arg_names;
			my $loop_arg_types = $event->loop_arg_types;
			my $j = 0;
			while ($j < @$value) {
				my $k = 0;
				foreach (@$loop_arg_names) {
					my $i = int($j / @$loop_arg_names) + 1;
					push @arg_names, "[$i] $_";
					push @arg_types, $loop_arg_types->[$k];
					push @arg_values, $value->[$j];
					$j++; $k++;
				}
			}
			$text = sprintf("(%d)", @$value / @$loop_arg_names);
		} elsif ($type == FVWM::EventNames::wflags) {
			my @words = unpack("l*", $value);
			my $label = join(" ",
				map { sprintf("%08x", $_) } @words);
			$text = { label => $label, value => \@words };
		} else {
			$text = qq([unsupported arg type $type] "$value");
		}

		push @{$event_data->{args}}, {
			name => $name,
			type => $type,
			text => $text,
		};

	}
	push @$stored_event_datas, $event_data;
	$event_list_size_changed = 1;
	&update_current_event_widgets();
}

sub update_frame_label ($$) {
	my $frame = shift;
	my $monitoring = shift;

	my $not_monitoring_label = ' (not monitoring) ';
	my $label = $frame->get_label;
	$label =~ s/ \Q$not_monitoring_label\E$//;
	$label .= $not_monitoring_label unless $monitoring;
	$frame->set_label($label);
}

sub send_module_event_mask () {
	if ($monitoring) {
		$module->mask($mask);
		$module->xmask($xmask);
	} else {
		$module->mask(0);
		$module->xmask(0);
	}
	update_frame_label($request_button_box_frame, $monitoring);
	update_frame_label($request_reply_frame, $is_dummy
		|| $monitoring && ($xmask & MX_REPLY));
}

my $update_event_mask_button;
my $revert_event_mask_button;

sub update_event_mask_change_buttons () {
	my $is_changed = $mask != $new_mask || $xmask != $new_xmask;
	$update_event_mask_button->set_sensitive($is_changed);
	$revert_event_mask_button->set_sensitive($is_changed);
}

sub setup_button_size ($$) {
	my $button = shift;
	my $width = shift;
	$button->set_size_request($width, 30);
}

# ----------------------------------------------------------------------------
# creating gui

my $tmp;  # there is a Gtk::Frame bug regarding set_border_width, so use tmp box
my $tooltips = Gtk2::Tooltips->new;

my $window = new Gtk2::Window;
$window->set_title($module->name);
$window->set_border_width(4);

my $notebook = new Gtk2::Notebook();
$notebook->set(homogeneous => 1);
$notebook->set_tab_border(4);
$window->add($notebook);

# ---- setup page ----
my $setup_page = new Gtk2::VBox(0, 0);
$notebook->append_page($setup_page, new Gtk2::Label(" Setup "));

my $event_mask_box = new Gtk2::HBox(0, 0);
$setup_page->pack_start($event_mask_box, 1, 1, 10);

my $event_mask_scroll = new Gtk2::ScrolledWindow();
$event_mask_scroll->set_policy("automatic", "always");

my $event_mask_scroll_frame = new Gtk2::Frame(" Event mask ");
$tmp = new Gtk2::VBox(0, 0); $tmp->add($event_mask_scroll); $tmp->set_border_width(5);
$event_mask_scroll_frame->add($tmp);
$event_mask_box->pack_start($event_mask_scroll_frame, 1, 1, 10);

my $event_type_box = new Gtk2::VButtonBox();
$event_type_box->set_spacing(0);
my $event_type_check_buttons = {};
my $type;
foreach $type (@{all_event_types()}) {
	my $check_button = Gtk2::CheckButton->new_with_label(event_name($type));
	$check_button->set_border_width(0);
	$check_button->set_focus_on_click(0);
	$event_type_box->pack_start($check_button, 0, 0, 0);
	$event_type_check_buttons->{$type} = $check_button;
	$check_button->signal_connect("clicked", sub {
		($type & M_EXTENDED_MSG ? $new_xmask : $new_mask) ^=
			($type & ~M_EXTENDED_MSG);
		update_event_mask_change_buttons();
	});
}
$event_mask_scroll->add_with_viewport($event_type_box);

sub update_check_buttons_from_new_mask () {
	my $current_mask = $new_mask; my $current_xmask = $new_xmask;
	my ($type, $check_button);
	while (($type, $check_button) = each %$event_type_check_buttons) {
		$check_button->set_active(
			($type & M_EXTENDED_MSG ? $new_xmask : $new_mask) &
				$type & ~M_EXTENDED_MSG
		);
	}
	# unfortunately set_active triggers "clicked" signal, so correct this
	$new_mask = $current_mask; $new_xmask = $current_xmask;
	update_event_mask_change_buttons();
}

my $event_mask_button_box = new Gtk2::VButtonBox();
$event_mask_button_box->set_spacing(10);
$event_mask_button_box->set_layout('start');
$event_mask_box->pack_start($event_mask_button_box, 0, 0, 10);

my $select_all_events_button = new Gtk2::Button(" Select _all events ");
$event_mask_button_box->pack_start($select_all_events_button, 1, 1, 6);
$select_all_events_button->signal_connect("clicked", sub {
	$new_mask = MAX_MSG_MASK; $new_xmask = MAX_XMSG_MASK;
	update_check_buttons_from_new_mask();
});

my $unselect_all_events_button = new Gtk2::Button(" Unselect all _events ");
$event_mask_button_box->pack_start($unselect_all_events_button, 1, 1, 6);
$unselect_all_events_button->signal_connect("clicked", sub {
	$new_mask = 0; $new_xmask = 0;
	update_check_buttons_from_new_mask();
});

my $select_default_events_button = new Gtk2::Button(" Select _default events ");
$event_mask_button_box->pack_start($select_default_events_button, 1, 1, 6);
$select_default_events_button->signal_connect("clicked", sub {
	$new_mask = $default_mask; $new_xmask = $default_xmask;
	update_check_buttons_from_new_mask();
});

$revert_event_mask_button = new Gtk2::Button(" _Restore current events ");
$event_mask_button_box->pack_start($revert_event_mask_button, 1, 1, 6);
$revert_event_mask_button->signal_connect("clicked", sub {
	$new_mask = $mask; $new_xmask = $xmask;
	update_check_buttons_from_new_mask();
});

$event_mask_button_box->foreach(\&setup_button_size, 172);

my $setup_button_box = new Gtk2::HButtonBox();
$setup_button_box->set_border_width(10);
$setup_button_box->set_spacing(20);
$setup_button_box->set_layout('edge');
$setup_page->pack_end($setup_button_box, 0, 0, 0);

$update_event_mask_button = new Gtk2::Button(" _Update event mask ");
$setup_button_box->pack_start($update_event_mask_button, 1, 1, 40);
$update_event_mask_button->signal_connect("clicked", sub {
	$mask = $new_mask; $xmask = $new_xmask;
	send_module_event_mask() if $monitoring;
	update_event_mask_change_buttons();
});

my $start_monitoring_button = new Gtk2::Button(" _Start monitoring events ");
$setup_button_box->pack_start($start_monitoring_button, 1, 1, 40);
$start_monitoring_button->signal_connect("clicked", \&switch_monitoring);

$setup_button_box->foreach(\&setup_button_size, 172);

# ---- event page ----
my $event_page = new Gtk2::VBox(0, 0);
$event_page->set_border_width(10);
$notebook->append_page($event_page, new Gtk2::Label(" Stored Events "));

my $event_name_line = new Gtk2::HBox(0, 0);
$event_page->pack_start($event_name_line, 0, 0, 0);

my $event_num_box = new Gtk2::HBox(0, 0);
$event_num_box->set_border_width(5);
my $event_num_frame = new Gtk2::Frame(" Event num ");
$event_num_frame->add($event_num_box);
$event_name_line->pack_start($event_num_frame, 0, 0, 0);

my $event_num_adj = new Gtk2::Adjustment(0, 0, 0, 1, 10, 0);
my $event_num = new Gtk2::SpinButton($event_num_adj, 0, 1);
$event_num->configure($event_num_adj, 0.5, 0);
$event_num->set_size_request(57, -1);
$event_num->signal_connect("changed", \&update_current_event_number);
$event_num_box->pack_start($event_num, 0, 0, 0);

my $event_total_num = new Gtk2::Entry();
$event_total_num->set_editable(0);
$event_total_num->set_size_request(42, -1);
$event_num_box->pack_start($event_total_num, 0, 0, 0);

my $event_name = new Gtk2::Entry();
$event_name->set_editable(0);
$event_name->set_size_request(154, -1);

my $event_name_frame = new Gtk2::Frame(" Event type ");
$tmp = new Gtk2::VBox(0, 0); $tmp->add($event_name); $tmp->set_border_width(5);
$event_name_frame->add($tmp);
$event_name_line->pack_start($event_name_frame, 0, 0, 10);

my $event_time = new Gtk2::Entry();
$event_time->set_size_request(46, -1);
$event_time->set_editable(0);

my $event_time_frame = new Gtk2::Frame(" Time ");
$tmp = new Gtk2::VBox(0, 0); $tmp->add($event_time); $tmp->set_border_width(5);
$event_time_frame->add($tmp);
$event_name_line->pack_start($event_time_frame, 0, 0, 0);

my $event_run_opts_button_box = new Gtk2::VButtonBox();
$event_run_opts_button_box->set_spacing(0);
$event_name_line->pack_end($event_run_opts_button_box, 0, 0, 0);

my $active_check_button = new Gtk2::CheckButton("Active");
$active_check_button->signal_connect("clicked", \&switch_monitoring);
$event_run_opts_button_box->pack_start($active_check_button, 0, 0, 0);

my $stick_check_button = new Gtk2::CheckButton("Stick to last");
$stick_check_button->set_active($stick_to_last_event);
$stick_check_button->signal_connect("clicked", sub {
	$stick_to_last_event ^= 1;
	&update_current_event_widgets()
		if $stick_to_last_event && $current_event_num != @$stored_event_datas;
});
$event_run_opts_button_box->pack_start($stick_check_button, 0, 0, 0);

# ---- next event page row ----
my $event_args_list_store = Gtk2::ListStore->new('Glib::String', 'Glib::String');
my $event_args_list = Gtk2::TreeView->new($event_args_list_store);
$event_args_list->set_rules_hint(1);
my $renderer = Gtk2::CellRendererText->new;
my $column1 = Gtk2::TreeViewColumn->new_with_attributes('Name',  $renderer, text => 0);
my $column2 = Gtk2::TreeViewColumn->new_with_attributes('Value', $renderer, text => 1);
$column1->set_min_width(140);
$column1->set_resizable(1);
$event_args_list->append_column($column1);
$event_args_list->append_column($column2);

$event_args_list->signal_connect("row-activated", sub {
	my ($widget, $path, $column) = @_;
	$stick_check_button->set_active(0);
	my $n = ($path->get_indices)[0];
	my $data = $stored_event_datas->[$current_event_num - 1]->{args}->[$n];
	return unless ref($data) eq 'HASH';
	my $text = $data->{text};
	if (ref($text) eq 'HASH') {
		$text = join("",
			map { sprintf("\n%032b", $_) } @{$text->{value}}
		);
	}
	$module->show_message(
		"$data->{name} (" . event_arg_type_to_name($data->{type}) .
		"): $text", $event_name->get_text() . " event argument"
	);
});

my $event_args_list_scroll = new Gtk2::ScrolledWindow();
$event_args_list_scroll->set_policy("automatic", "automatic");
$event_args_list_scroll->add_with_viewport($event_args_list);

my $event_args_list_scroll_frame = new Gtk2::Frame(" Event arguments ");
$tmp = new Gtk2::VBox(0, 0); $tmp->add($event_args_list_scroll); $tmp->set_border_width(5);
$event_args_list_scroll_frame->add($tmp);
$event_page->pack_start($event_args_list_scroll_frame, 1, 1, 10);

my $event_list_button_box = new Gtk2::HButtonBox();
$event_list_button_box->set_spacing(2);
$event_list_button_box->set_layout('edge');
$event_page->pack_end($event_list_button_box, 0, 0, 0);

my $current_event_possibly_dirty = 0;
sub filter_stored_events ($) {
	my $func = shift;
	my $initial_num = @$stored_event_datas;
	my $count = 0;
	my $index = 0;
	for ($count = 1; $count <= $initial_num; $count++) {
		if (&$func($count, $stored_event_datas->[$index]->{type})) {
			$index++;
		} else {
			splice(@$stored_event_datas, $index, 1);
		}
	}
	if ($initial_num != @$stored_event_datas) {
		$event_list_size_changed = 1;
		$current_event_possibly_dirty = 1;
		update_current_event_widgets();
	}
}

my $clear_this_one_button = new Gtk2::Button(" _Clear one ");
$event_list_button_box->pack_start($clear_this_one_button, 1, 1, 6);
$clear_this_one_button->signal_connect("clicked", sub {
	filter_stored_events(sub { $_[0] != $current_event_num });
});

my $clear_this_type_button = new Gtk2::Button(" Clear _type ");
$event_list_button_box->pack_start($clear_this_type_button, 1, 1, 6);
$clear_this_type_button->signal_connect("clicked", sub {
	my $current_type = $stored_event_datas->[$current_event_num - 1]->{type};
	filter_stored_events(sub { $_[1] != $current_type });
});

my $clear_all_button = new Gtk2::Button(" Cl_ear all ");
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     