#!@PERL@ -w # Copyright (C) 2002-2009 Mikhael Goikhman # # 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 = "@prefix@"; $datarootdir = "@datarootdir@"; $datadir = "@datadir@"; } use lib "@FVWM_PERLLIBDIR@"; 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(<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 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 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 [ B<--mask> I ] [ B<--xmask> I ] [ B<--debug> I ] Long switches may be abbreviated to shorter switches. B<-m>|B<--mask> I - 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 or I. The special value of I<-1> sets the maximal mask. B<-x>|B<--xmask> I - 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 or I. The special value of I<-1> sets the maximal extended mask. B<-d>|B<--debug> I - use the Perl library debugging mechanism. The useful Is are 2 to 4. =head1 SEE ALSO See also L, "fvwm-perllib man events". =head1 AUTHOR Mikhael Goikhman . =cut