fvwm 1:2.6.5.ds-3 / usr / lib / fvwm / 2.6.5 / FvwmGtkDebug

#!/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 ");
$event_list_button_box->pack_start($clear_all_button, 1, 1, 6);
$clear_all_button->signal_connect("clicked", sub {
	filter_stored_events(sub { 0 });
});

my $leave_this_type_button = new Gtk2::Button(" Leave t_ype ");
$event_list_button_box->pack_start($leave_this_type_button, 1, 1, 6);
$leave_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 $leave_this_one_button = new Gtk2::Button(" _Leave one ");
$event_list_button_box->pack_start($leave_this_one_button, 1, 1, 6);
$leave_this_one_button->signal_connect("clicked", sub {
	filter_stored_events(sub { $_[0] == $current_event_num });
});

$event_list_button_box->foreach(\&setup_button_size, 80);

sub update_current_event_widgets (;$) {
	# update event number
	my $max_num = @$stored_event_datas;
	my $min_num = $max_num > 0 ? 1 : 0;
	my $num = shift || ($stick_to_last_event ? $max_num : $current_event_num);
	$num = 1 if $num <= 0;
	$num = $max_num if $num > $max_num;
	my $current_event_num_changed = $current_event_num != $num;
	$current_event_num = $num;
	
	$event_num_adj->lower($min_num);
	$event_num_adj->upper($max_num);
	$event_num_adj->set_value($num);
	$event_num->update;
	$event_total_num->set_text($max_num);

	return unless $current_event_num_changed
		|| $event_list_size_changed || $current_event_possibly_dirty;
	$event_list_size_changed = 0;

	# update event name
	$event_name->set_text($num ? $stored_event_datas->[$num - 1]->{name} : "");

	# update event args
	if ($current_event_num_changed || $current_event_possibly_dirty) {
		$event_args_list_store->clear;
		foreach ($num ? @{$stored_event_datas->[$num - 1]->{args}} : ()) {
			my $data = $_;
			my $text = $data->{text};
			$text = $text->{label} if ref($text) eq 'HASH';
			my $iter = $event_args_list_store->append;
			$event_args_list_store->set($iter, 0 => $data->{name}, 1 => $text);
		}
		$current_event_possibly_dirty = 0;
	}

	# update event time
	my $time_string1 = "";
	my $time_string2 = "";
	if ($num) {
		my $time = $stored_event_datas->[$num - 1]->{time};
		my ($sec, $min, $hour, $day, $mon, $year) = localtime($time);
		$mon++; $year += 1900 if $year < 1900;
		$time_string1 = sprintf("%02d:%02d", $hour, $min);
		$time_string2 = sprintf("%s-%02d-%02d %02d:%02d:%02d",
			$year, $mon, $day, $hour, $min, $sec);
	}
	$event_time->set_text($time_string1);
	$tooltips->set_tip($event_time, $time_string2);

	# update event buttons
	my $current_type = $num ? $stored_event_datas->[$num - 1]->{type} : 0;
	my $has_other_types = 0;
	foreach ($num = 1; $num <= $max_num; $num++) {
		if ($current_type != $stored_event_datas->[$num - 1]->{type})
			{ $has_other_types = 1; last; }
	}
	$clear_this_one_button->set_sensitive($max_num > 0);
	$clear_this_type_button->set_sensitive($max_num > 0);
	$clear_all_button->set_sensitive($max_num > 0);
	$leave_this_type_button->set_sensitive($has_other_types);
	$leave_this_one_button->set_sensitive($max_num > 1);
}

sub update_current_event_number () {
	return if $event_num->get_value == $current_event_num;
	update_current_event_widgets($event_num->get_value);
}

my $in_switch_monitoring = 0;
sub switch_monitoring () {
	return if $in_switch_monitoring;
	$in_switch_monitoring = 1;
	$monitoring ^= 1;
	send_module_event_mask();
	$start_monitoring_button->child->set_label($monitoring
		? " _Stop monitoring events " : " _Start monitoring events ");
	$active_check_button->set_active($monitoring);
	$in_switch_monitoring = 0;
}

# ---- tools page ----
my $tools_page = new Gtk2::VBox(0, 0);
$tools_page->set_border_width(10);
$notebook->append_page($tools_page, new Gtk2::Label(" Tools "));

my $request_button_box = new Gtk2::HButtonBox();
$request_button_box->set_layout('edge');

$request_button_box_frame = new Gtk2::Frame(" Request module info ");
$tmp = new Gtk2::VBox(0, 0); $tmp->add($request_button_box); $tmp->set_border_width(5);
$request_button_box_frame->add($tmp);
$tools_page->pack_start($request_button_box_frame, 0, 0, 0);

my $send_configinfo_button = new Gtk2::Button(" Send__ConfigInfo ");
$request_button_box->pack_end($send_configinfo_button, 1, 1, 6);
$send_configinfo_button->signal_connect("clicked", sub {
	$module->send("Send_ConfigInfo");
});

my $send_windowlist_button = new Gtk2::Button(" Send__WindowList ");
$request_button_box->pack_end($send_windowlist_button, 1, 1, 6);
$send_windowlist_button->signal_connect("clicked", sub {
	$module->send("Send_WindowList");
});

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

my $reply_to_request = new Gtk2::Entry();
$reply_to_request->signal_connect("activate", sub {
	my $text = $reply_to_request->get_text;
	$module->request_reply($text, $context_window_id);
	$module->emulate_event(MX_REPLY, [ $context_window_id, 0, 12345, $text ])
		if $is_dummy;
	$reply_to_request->set_text("");
});

$request_reply_frame = new Gtk2::Frame(" Request reply ");
$tmp = new Gtk2::VBox(0, 0); $tmp->add($reply_to_request); $tmp->set_border_width(5);
$request_reply_frame->add($tmp);
$tools_page->pack_start($request_reply_frame, 0, 0, 10);

# ---- fvwm commands ----
my %cursor_to_stock_icon = (
	''      => 'gtk-yes',
	'-'     => 'gtk-about',
	DESTROY => 'gtk-close',
	SELECT  => 'gtk-find',
	RESIZE  => 'gtk-fullscreen',
	MOVE    => 'gtk-leave-fullscreen',
);

my $command_entries = Gtk2::ListStore->new(('Glib::String') x 3);
my $i = 0; my (%command_name_indexes, @command_names);
foreach ({ name => '', descr => 'Select fvwm command', cursor => '-' }, @FVWM::Commands::LIST) {
	push @command_names, $_->{name};
	$command_name_indexes{lc($_->{name})} = $i++;
	$command_entries->set($command_entries->append,
		0 => $cursor_to_stock_icon{$_->{cursor}} || 'gtk-no',
		1 => $_->{name},
		2 => $_->{descr},
	);
}

my $command_entries_combo_box = Gtk2::ComboBox->new($command_entries);
$renderer = Gtk2::CellRendererPixbuf->new;
$command_entries_combo_box->pack_start($renderer, 0);
$command_entries_combo_box->add_attribute($renderer, stock_id => 0);
$renderer = Gtk2::CellRendererText->new;
$command_entries_combo_box->pack_start($renderer, 1);
$command_entries_combo_box->add_attribute($renderer, text => 1);
$renderer = Gtk2::CellRendererText->new;
$renderer->set(scale => 0.8);
$command_entries_combo_box->pack_start($renderer, 0);
$command_entries_combo_box->add_attribute($renderer, text => 2);
$command_entries_combo_box->set_active(0);

my $window_list_cmd =
	'WindowList SortByResource, NoGeometry, NoDeskSort, NoCurrentDeskTitle, NoHotkeys';

my $command_history_filename = $module->user_data_dir . '/.FvwmConsole-History';
my @history_commands = -r $command_history_filename
	? map { chomp; $_ } `cat $command_history_filename`
	: ('Beep', $window_list_cmd);

my $command_to_send_combo_box = Gtk2::ComboBoxEntry->new_text;
$command_to_send_combo_box->prepend_text($_) foreach @history_commands;
my $command_to_send = $command_to_send_combo_box->child;
sub parse_command_to_send { $command_to_send->get_text =~ /^\s*(\W|\w+|)(.*)/ }
$command_to_send->signal_connect("activate", sub {
	my $text = $command_to_send->get_text;
	$module->send($text, $context_window_id);
	$command_to_send_combo_box->prepend_text($text);
	$command_to_send->set_text("");
	append_file($command_history_filename, \"$text\n");
});
$command_to_send->signal_connect("changed", sub {
	my $command_name = (parse_command_to_send())[0];
	my $index = $command_name_indexes{lc($command_name)} || 0;
	$command_entries_combo_box->set_active($index);
});
$command_entries_combo_box->signal_connect("changed", sub {
	my $command_name =
		$command_names[$command_entries_combo_box->get_active] or return;
	my ($name, $extra) = parse_command_to_send();
	$extra = " $extra" if $extra =~ /^\S/ && length $command_name > 1;
	$command_to_send->set_text($command_name . $extra);
});

my $extra_str = $is_dummy ? " (not connected to fvwm in dummy mode) " : "";
my $command_console_frame = new Gtk2::Frame(" Command console " . $extra_str);
$tmp = new Gtk2::VBox(0, 0); $tmp->add($command_to_send_combo_box);
$tmp->add($command_entries_combo_box); $tmp->set_border_width(5);
$command_console_frame->add($tmp);
$tools_page->pack_start($command_console_frame, 0, 0, 0);

# ---- context window ----
my $set_window_cmd = qq(Send_Reply set_window);
my $pick_window_cmd = qq(Pick $set_window_cmd);
my $select_window_list_cmd = qq($window_list_cmd, Function '$set_window_cmd');

my $context_window_name = "";
my $context_window_id_label = new Gtk2::Label("Window id:");
my $context_window_id_widget = new Gtk2::Label("");
my $context_window_name_label = new Gtk2::Label("Name:");
my $context_window_name_widget = new Gtk2::Label("");
my ($unset_window_button, $set_self_window_button);

sub update_context_window_widgets () {
	$context_window_id_widget->set_label($context_window_id
		? sprintf('0x%07lx', $context_window_id)
		: '(no window)'
	);
	$context_window_name = "" unless $context_window_id;
	$context_window_name_widget->set_label($context_window_name);
	if ($context_window_name) {
		$context_window_name_label->show;
		$context_window_name_widget->show;
	} else {
		$context_window_name_label->hide;
		$context_window_name_widget->hide;
	}
	$unset_window_button->set_sensitive($context_window_id);
	$set_self_window_button->set_sensitive($context_window_id != $self_window_id);
}

sub start_content_window_reply_tracker ($) {
	my $cmd_requesting_reply = shift;

	return $module->show_message("This action is disabled in dummy mode")
		if $is_dummy;

#	my $tracker = FVWM::Tracker->new($module);
	my $tracker = $module->track({ NoStart => 1 }, 'FVWM::Tracker');
	$tracker->add_handler(MX_REPLY, sub {
		my ($module, $event) = @_;
		$module->terminate if $event->_text eq 'end';
		my $selected_window_id = $event->_win_id;
		return unless $selected_window_id
			&& $context_window_id != $selected_window_id;
		$context_window_id = $event->_win_id;
		$context_window_name = "";
		update_context_window_widgets();
	});
	$module->postpone_send("$cmd_requesting_reply\nSend_Reply end");
	$tracker->start;
	$tracker->stop;
	delete $module->{trackers}->{'FVWM::Tracker'};
}

$module->add_handler(M_WINDOW_NAME, sub {
	my ($module, $event) = @_;
	if ($event->_win_id == $context_window_id) {
		$context_window_name = $event->_name;
		update_context_window_widgets();
	}
});

my $context_window_box = new Gtk2::HBox(0, 0);
$context_window_box->set_size_request(-1, 22);
$context_window_box->pack_start($context_window_id_label, 0, 0, 8);
$context_window_box->pack_start($context_window_id_widget, 0, 0, 0);
$context_window_box->pack_start($context_window_name_label, 0, 0, 8);
$context_window_box->pack_start($context_window_name_widget, 0, 0, 0);
$context_window_id_widget->set_selectable(1);
$context_window_name_widget->set_selectable(1);

my $select_context_window_box = new Gtk2::HButtonBox();
$select_context_window_box->set_layout('edge');

my $select_window_list_button = new Gtk2::Button(" Select from list ");
$select_context_window_box->pack_start($select_window_list_button, 0, 0, 0);
$select_window_list_button->signal_connect("clicked", sub {
	start_content_window_reply_tracker($select_window_list_cmd);
});

my $pick_window_button = new Gtk2::Button(" Pick ");
$select_context_window_box->pack_start($pick_window_button, 0, 0, 0);
$pick_window_button->signal_connect("clicked", sub {
	start_content_window_reply_tracker($pick_window_cmd);
});

$set_self_window_button = new Gtk2::Button(" Set itself ");
$select_context_window_box->pack_start($set_self_window_button, 0, 0, 0);
$set_self_window_button->signal_connect("clicked", sub {
	$context_window_id = $self_window_id;
	$context_window_name = "";
	update_context_window_widgets();
});

$unset_window_button = new Gtk2::Button(" Unset ");
$select_context_window_box->pack_start($unset_window_button, 0, 0, 0);
$unset_window_button->signal_connect("clicked", sub {
	$context_window_id = 0;
	update_context_window_widgets();
});

my $context_window_frame = new Gtk2::Frame(" Context window ");
$tmp = new Gtk2::VBox(0, 10); $tmp->add($context_window_box);
$tmp->add($select_context_window_box); $tmp->set_border_width(5);
$context_window_frame->add($tmp);
$tools_page->pack_start($context_window_frame, 0, 0, 10);

# ---- help and quit ----
my $quit_button_box = new Gtk2::HButtonBox();
$quit_button_box->set_layout('edge');
$tools_page->pack_end($quit_button_box, 0, 0, 0);

my $help_button = new Gtk2::Button(" _Help ");
$quit_button_box->pack_end($help_button, 1, 1, 6);
$help_button->signal_connect("clicked", sub {
	$module->show_message(<<ENDMSG, "FvwmGtkDebug Help");
This module captures the event information received from fvwm and shows it.
You should configure events you want to receive and then activate the
monitoring mode. The activation may be done either from the "Setup" or
"Stored events" pages. The received-event mask may be changed at any time.

You may then browse the stored event data, compare it or remove it.

Any module may request fvwm to send its config info or window list info or
any custom reply back. The module then receives the requested information
using events. Don't forget to enable relevant events for this to work.

Finally, you may send commands to fvwm, just like FvwmTalk does.

The best way to learn how this application works is to try all options,
it is safe. Good luck.
ENDMSG
});

my $quit_button = new Gtk2::Button(" _Quit ");
$quit_button_box->pack_end($quit_button, 1, 1, 6);
$quit_button->signal_connect("clicked", sub { Gtk2->main_quit; });

$quit_button_box->foreach(\&setup_button_size, 120);

# ---- last GUI preparations ----
update_check_buttons_from_new_mask();
update_current_event_widgets();

$window->signal_connect("destroy" => \&Gtk2::main_quit);
$window->set_default_size(500, 600);
$window->show_all;

$self_window_id = $window->window->XWINDOW;
update_context_window_widgets();

# ----------------------------------------------------------------------------
# main

send_module_event_mask();

$module->add_handler(MAX_MSG_MASK, \&store_event);
$module->add_handler(MAX_XMSG_MASK | M_EXTENDED_MSG, \&store_event);

sub emulate_some_events () {
	$module->emulate_event(M_NEW_DESK, [ $current_event_num ]);
	$module->emulate_event(M_MAP, [ 0x123, 0x456, 789 ]);
	$module->emulate_event(M_NEW_PAGE, [ 0, 0, 2, 800, 600, 3, 3 ]);
}

if ($is_dummy) {
	$module->show_message(
		"This module is executed in the dummy mode.\n\n" .
		"Every 20 seconds fake events are generated."
	);
	emulate_some_events();
	emulate_some_events();
	my $scheduler = $module->track('Scheduler');
	$scheduler->schedule(20, sub {
		emulate_some_events() if $monitoring;
		$scheduler->reschedule;
	});
}

$module->event_loop;

__END__

# ----------------------------------------------------------------------------
# man page

=head1 NAME

FvwmGtkDebug - graphical interactive fvwm module debugger

=head1 SYNOPSIS

FvwmGtkDebug should be spawned by fvwm(1).

To run this module, place this command somewhere in the configuration:

    Module FvwmGtkDebug

To stop this module, just close the GUI window, the usual KillModule works too.

You may also run this application as a regular program from the command
line shell.  But the communication with I<fvwm> is not established in this
dummy mode, so commands are not really sent and there are no real events
received.  However certain activity is emulated using dummy events.

=head1 DESCRIPTION

This module monitors all fvwm event information and shows it nicely in the
interactive gtk+ application. Good for debugging and educational purposes.

Among the features: command console with history and auto command help,
requesting to send back ConfigInfo (configuration of I<fvwm> and all
modules), WindowList (information about all windows) or custom Reply.

The fvwm commands may be executed within the context of some window.
The context window may be optionally set on invocation, like: "Next
(Navigator) FvwmGtkDebug", and be set/unset interactively at any time.

=head1 INVOCATION

There are several command line switches:

B<FvwmGtkDebug>
[ B<--mask> I<mask> ]
[ B<--xmask> I<mask> ]
[ B<--debug> I<level> ]

Long switches may be abbreviated to shorter switches.

B<-m>|B<--mask> I<mask> - set the initial module mask, 31 bit integer.
This mask may be changed interactively at any time.
By default almost all events are monitored (except for some flood events
like I<CONFIGURE_WINDOW> or I<FOCUS_WINDOW>. The special value of I<-1>
sets the maximal mask.

B<-x>|B<--xmask> I<mask> - set the initial module extended mask, 31 bit integer.
This mask may be changed interactively at any time.
By default almost all events are monitored (except for some flood events
like I<ENTER_WINDOW> or I<LEAVE_WINDOW>. The special value of I<-1>
sets the maximal extended mask.

B<-d>|B<--debug> I<level> - use the Perl library debugging mechanism.
The useful I<level>s are 2 to 4.

=head1 SEE ALSO

See also L<FvwmDebug>, "fvwm-perllib man events".

=head1 AUTHOR

Mikhael Goikhman <migo@homemail.com>.

=cut