modules/FvwmDebug/FvwmGtkDebug.in

   1 #!@PERL@ -w
   2
   3 # Copyright (C) 2002-2009 Mikhael Goikhman <migo@cpan.org>
   4 #
   5 # This program is free software; you can redistribute it and/or modify
   6 # it under the terms of the GNU General Public License as published by
   7 # the Free Software Foundation; either version 2 of the License, or
   8 # (at your option) any later version.
   9 #
  10 # This program is distributed in the hope that it will be useful,
  11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 # GNU General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with this program; if not, write to the Free Software
  17 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  18
  19 # Filter this script to pod2man to get a man page:
  20 #   pod2man -c "Fvwm Module" FvwmGtkDebug | nroff -man | less -e
  21
  22 use 5.003;
  23 use strict;
  24
  25 BEGIN {
  26         use vars qw($prefix $datarootdir $datadir);
  27         $prefix = "@prefix@";
  28         $datarootdir = "@datarootdir@";
  29         $datadir = "@datadir@";
  30 }
  31
  32 use lib "@FVWM_PERLLIBDIR@";
  33 use FVWM::Module::Gtk2;
  34 use FVWM::EventNames;
  35 use FVWM::Commands;
  36 use FVWM::Tracker;
  37 use General::FileSystem qw(append_file);
  38 init Gtk2;
  39
  40 my $default_mask = MAX_MSG_MASK &
  41         ~(M_FOCUS_CHANGE | M_CONFIGURE_WINDOW | M_VISIBLE_NAME | M_ICON_NAME);
  42 my $default_xmask = MAX_XMSG_MASK &
  43         ~(MX_ENTER_WINDOW | MX_LEAVE_WINDOW | MX_VISIBLE_ICON_NAME);
  44 $default_xmask &= ~M_EXTENDED_MSG;
  45
  46 my $mask  = $default_mask;
  47 my $xmask = $default_xmask;
  48 my $debug = 0;
  49
  50 my $options = {
  51         'm|mask=i'  => \$mask,
  52         'x|xmask=i' => \$xmask,
  53         'd|debug=i' => \$debug,
  54 };
  55
  56 my $module = new FVWM::Module::Gtk2(
  57         Name => "FvwmGtkDebug",
  58         EnableOptions => $options,
  59         Debug => \$debug,
  60 );
  61
  62 $mask  = MAX_MSG_MASK  if $mask  == -1;
  63 $xmask = MAX_XMSG_MASK if $xmask == -1;
  64 my $new_mask  = $mask;
  65 my $new_xmask = $xmask;
  66
  67 my $context_window_id = $module->{win_id};
  68 my $self_window_id = 0;  # until mapped
  69 my $is_dummy = $module->is_dummy;
  70
  71 # ----------------------------------------------------------------------------
  72 # functions
  73
  74 my $monitoring = 0;
  75 my $stored_event_datas = [];
  76 my $current_event_num = -1;
  77 my $event_list_size_changed = 0;
  78 my $stick_to_last_event = 1;
  79 my ($request_button_box_frame, $request_reply_frame);
  80
  81 sub event_arg_type_to_name ($) {
  82         my $type = shift;
  83         return
  84                 $type == FVWM::EventNames::number ? "number" :
  85                 $type == FVWM::EventNames::bool ? "boolean" :
  86                 $type == FVWM::EventNames::window ? "window" :
  87                 $type == FVWM::EventNames::pixel ? "color" :
  88                 $type == FVWM::EventNames::string ? "string" :
  89                 $type == FVWM::EventNames::looped ? "looped" :
  90                 $type == FVWM::EventNames::wflags ? "wflags" :
  91                 "unknown";
  92 }
  93
  94 sub store_event ($$) {
  95         my ($module, $event) = @_;
  96
  97         my @arg_names  = @{$event->arg_names};
  98         my @arg_types  = @{$event->arg_types};
  99         my @arg_values = @{$event->arg_values};
 100
 101 #       print STDERR $event->name, "\n";
 102
 103         my $event_data = {
 104                 type => $event->type,
 105                 name => $event->name,
 106                 time => time(),
 107                 args => [],
 108         };
 109         while (@arg_names) {
 110                 my $name  = shift @arg_names;
 111                 my $type  = shift @arg_types;
 112                 my $value = shift @arg_values;
 113
 114                 my $text;
 115                 if ($type == FVWM::EventNames::number) {
 116                         $text = $value;
 117                         $text = "*undefined*" unless defined $value;
 118                 } elsif ($type == FVWM::EventNames::bool) {
 119                         $text = $value ? "True" : "False";
 120                 } elsif ($type == FVWM::EventNames::window) {
 121                         $text = sprintf("0x%07lx", $value);
 122                 } elsif ($type == FVWM::EventNames::pixel) {
 123                         $text = "rgb:" . join('/',
 124                                 sprintf("%06lx", $value) =~ /(..)(..)(..)/);
 125                 } elsif ($type == FVWM::EventNames::string) {
 126                         $text = qq("$value");
 127                 } elsif ($type == FVWM::EventNames::looped) {
 128                         my $loop_arg_names = $event->loop_arg_names;
 129                         my $loop_arg_types = $event->loop_arg_types;
 130                         my $j = 0;
 131                         while ($j < @$value) {
 132                                 my $k = 0;
 133                                 foreach (@$loop_arg_names) {
 134                                         my $i = int($j / @$loop_arg_names) + 1;
 135                                         push @arg_names, "[$i] $_";
 136                                         push @arg_types, $loop_arg_types->[$k];
 137                                         push @arg_values, $value->[$j];
 138                                         $j++; $k++;
 139                                 }
 140                         }
 141                         $text = sprintf("(%d)", @$value / @$loop_arg_names);
 142                 } elsif ($type == FVWM::EventNames::wflags) {
 143                         my @words = unpack("l*", $value);
 144                         my $label = join(" ",
 145                                 map { sprintf("%08x", $_) } @words);
 146                         $text = { label => $label, value => \@words };
 147                 } else {
 148                         $text = qq([unsupported arg type $type] "$value");
 149                 }
 150
 151                 push @{$event_data->{args}}, {
 152                         name => $name,
 153                         type => $type,
 154                         text => $text,
 155                 };
 156
 157         }
 158         push @$stored_event_datas, $event_data;
 159         $event_list_size_changed = 1;
 160         &update_current_event_widgets();
 161 }
 162
 163 sub update_frame_label ($$) {
 164         my $frame = shift;
 165         my $monitoring = shift;
 166
 167         my $not_monitoring_label = ' (not monitoring) ';
 168         my $label = $frame->get_label;
 169         $label =~ s/ \Q$not_monitoring_label\E$//;
 170         $label .= $not_monitoring_label unless $monitoring;
 171         $frame->set_label($label);
 172 }
 173
 174 sub send_module_event_mask () {
 175         if ($monitoring) {
 176                 $module->mask($mask);
 177                 $module->xmask($xmask);
 178         } else {
 179                 $module->mask(0);
 180                 $module->xmask(0);
 181         }
 182         update_frame_label($request_button_box_frame, $monitoring);
 183         update_frame_label($request_reply_frame, $is_dummy
 184                 || $monitoring && ($xmask & MX_REPLY));
 185 }
 186
 187 my $update_event_mask_button;
 188 my $revert_event_mask_button;
 189
 190 sub update_event_mask_change_buttons () {
 191         my $is_changed = $mask != $new_mask || $xmask != $new_xmask;
 192         $update_event_mask_button->set_sensitive($is_changed);
 193         $revert_event_mask_button->set_sensitive($is_changed);
 194 }
 195
 196 sub setup_button_size ($$) {
 197         my $button = shift;
 198         my $width = shift;
 199         $button->set_size_request($width, 30);
 200 }
 201
 202 # ----------------------------------------------------------------------------
 203 # creating gui
 204
 205 my $tmp;  # there is a Gtk::Frame bug regarding set_border_width, so use tmp box
 206 my $tooltips = Gtk2::Tooltips->new;
 207
 208 my $window = new Gtk2::Window;
 209 $window->set_title($module->name);
 210 $window->set_border_width(4);
 211
 212 my $notebook = new Gtk2::Notebook();
 213 $notebook->set(homogeneous => 1);
 214 $notebook->set_tab_border(4);
 215 $window->add($notebook);
 216
 217 # ---- setup page ----
 218 my $setup_page = new Gtk2::VBox(0, 0);
 219 $notebook->append_page($setup_page, new Gtk2::Label(" Setup "));
 220
 221 my $event_mask_box = new Gtk2::HBox(0, 0);
 222 $setup_page->pack_start($event_mask_box, 1, 1, 10);
 223
 224 my $event_mask_scroll = new Gtk2::ScrolledWindow();
 225 $event_mask_scroll->set_policy("automatic", "always");
 226
 227 my $event_mask_scroll_frame = new Gtk2::Frame(" Event mask ");
 228 $tmp = new Gtk2::VBox(0, 0); $tmp->add($event_mask_scroll); $tmp->set_border_width(5);
 229 $event_mask_scroll_frame->add($tmp);
 230 $event_mask_box->pack_start($event_mask_scroll_frame, 1, 1, 10);
 231
 232 my $event_type_box = new Gtk2::VButtonBox();
 233 $event_type_box->set_spacing(0);
 234 my $event_type_check_buttons = {};
 235 my $type;
 236 foreach $type (@{all_event_types()}) {
 237         my $check_button = Gtk2::CheckButton->new_with_label(event_name($type));
 238         $check_button->set_border_width(0);
 239         $check_button->set_focus_on_click(0);
 240         $event_type_box->pack_start($check_button, 0, 0, 0);
 241         $event_type_check_buttons->{$type} = $check_button;
 242         $check_button->signal_connect("clicked", sub {
 243                 ($type & M_EXTENDED_MSG ? $new_xmask : $new_mask) ^=
 244                         ($type & ~M_EXTENDED_MSG);
 245                 update_event_mask_change_buttons();
 246         });
 247 }
 248 $event_mask_scroll->add_with_viewport($event_type_box);
 249
 250 sub update_check_buttons_from_new_mask () {
 251         my $current_mask = $new_mask; my $current_xmask = $new_xmask;
 252         my ($type, $check_button);
 253         while (($type, $check_button) = each %$event_type_check_buttons) {
 254                 $check_button->set_active(
 255                         ($type & M_EXTENDED_MSG ? $new_xmask : $new_mask) &
 256                                 $type & ~M_EXTENDED_MSG
 257                 );
 258         }
 259         # unfortunately set_active triggers "clicked" signal, so correct this
 260         $new_mask = $current_mask; $new_xmask = $current_xmask;
 261         update_event_mask_change_buttons();
 262 }
 263
 264 my $event_mask_button_box = new Gtk2::VButtonBox();
 265 $event_mask_button_box->set_spacing(10);
 266 $event_mask_button_box->set_layout('start');
 267 $event_mask_box->pack_start($event_mask_button_box, 0, 0, 10);
 268
 269 my $select_all_events_button = new Gtk2::Button(" Select _all events ");
 270 $event_mask_button_box->pack_start($select_all_events_button, 1, 1, 6);
 271 $select_all_events_button->signal_connect("clicked", sub {
 272         $new_mask = MAX_MSG_MASK; $new_xmask = MAX_XMSG_MASK;
 273         update_check_buttons_from_new_mask();
 274 });
 275
 276 my $unselect_all_events_button = new Gtk2::Button(" Unselect all _events ");
 277 $event_mask_button_box->pack_start($unselect_all_events_button, 1, 1, 6);
 278 $unselect_all_events_button->signal_connect("clicked", sub {
 279         $new_mask = 0; $new_xmask = 0;
 280         update_check_buttons_from_new_mask();
 281 });
 282
 283 my $select_default_events_button = new Gtk2::Button(" Select _default events ");
 284 $event_mask_button_box->pack_start($select_default_events_button, 1, 1, 6);
 285 $select_default_events_button->signal_connect("clicked", sub {
 286         $new_mask = $default_mask; $new_xmask = $default_xmask;
 287         update_check_buttons_from_new_mask();
 288 });
 289
 290 $revert_event_mask_button = new Gtk2::Button(" _Restore current events ");
 291 $event_mask_button_box->pack_start($revert_event_mask_button, 1, 1, 6);
 292 $revert_event_mask_button->signal_connect("clicked", sub {
 293         $new_mask = $mask; $new_xmask = $xmask;
 294         update_check_buttons_from_new_mask();
 295 });
 296
 297 $event_mask_button_box->foreach(\&setup_button_size, 172);
 298
 299 my $setup_button_box = new Gtk2::HButtonBox();
 300 $setup_button_box->set_border_width(10);
 301 $setup_button_box->set_spacing(20);
 302 $setup_button_box->set_layout('edge');
 303 $setup_page->pack_end($setup_button_box, 0, 0, 0);
 304
 305 $update_event_mask_button = new Gtk2::Button(" _Update event mask ");
 306 $setup_button_box->pack_start($update_event_mask_button, 1, 1, 40);
 307 $update_event_mask_button->signal_connect("clicked", sub {
 308         $mask = $new_mask; $xmask = $new_xmask;
 309         send_module_event_mask() if $monitoring;
 310         update_event_mask_change_buttons();
 311 });
 312
 313 my $start_monitoring_button = new Gtk2::Button(" _Start monitoring events ");
 314 $setup_button_box->pack_start($start_monitoring_button, 1, 1, 40);
 315 $start_monitoring_button->signal_connect("clicked", \&switch_monitoring);
 316
 317 $setup_button_box->foreach(\&setup_button_size, 172);
 318
 319 # ---- event page ----
 320 my $event_page = new Gtk2::VBox(0, 0);
 321 $event_page->set_border_width(10);
 322 $notebook->append_page($event_page, new Gtk2::Label(" Stored Events "));
 323
 324 my $event_name_line = new Gtk2::HBox(0, 0);
 325 $event_page->pack_start($event_name_line, 0, 0, 0);
 326
 327 my $event_num_box = new Gtk2::HBox(0, 0);
 328 $event_num_box->set_border_width(5);
 329 my $event_num_frame = new Gtk2::Frame(" Event num ");
 330 $event_num_frame->add($event_num_box);
 331 $event_name_line->pack_start($event_num_frame, 0, 0, 0);
 332
 333 my $event_num_adj = new Gtk2::Adjustment(0, 0, 0, 1, 10, 0);
 334 my $event_num = new Gtk2::SpinButton($event_num_adj, 0, 1);
 335 $event_num->configure($event_num_adj, 0.5, 0);
 336 $event_num->set_size_request(57, -1);
 337 $event_num->signal_connect("changed", \&update_current_event_number);
 338 $event_num_box->pack_start($event_num, 0, 0, 0);
 339
 340 my $event_total_num = new Gtk2::Entry();
 341 $event_total_num->set_editable(0);
 342 $event_total_num->set_size_request(42, -1);
 343 $event_num_box->pack_start($event_total_num, 0, 0, 0);
 344
 345 my $event_name = new Gtk2::Entry();
 346 $event_name->set_editable(0);
 347 $event_name->set_size_request(154, -1);
 348
 349 my $event_name_frame = new Gtk2::Frame(" Event type ");
 350 $tmp = new Gtk2::VBox(0, 0); $tmp->add($event_name); $tmp->set_border_width(5);
 351 $event_name_frame->add($tmp);
 352 $event_name_line->pack_start($event_name_frame, 0, 0, 10);
 353
 354 my $event_time = new Gtk2::Entry();
 355 $event_time->set_size_request(46, -1);
 356 $event_time->set_editable(0);
 357
 358 my $event_time_frame = new Gtk2::Frame(" Time ");
 359 $tmp = new Gtk2::VBox(0, 0); $tmp->add($event_time); $tmp->set_border_width(5);
 360 $event_time_frame->add($tmp);
 361 $event_name_line->pack_start($event_time_frame, 0, 0, 0);
 362
 363 my $event_run_opts_button_box = new Gtk2::VButtonBox();
 364 $event_run_opts_button_box->set_spacing(0);
 365 $event_name_line->pack_end($event_run_opts_button_box, 0, 0, 0);
 366
 367 my $active_check_button = new Gtk2::CheckButton("Active");
 368 $active_check_button->signal_connect("clicked", \&switch_monitoring);
 369 $event_run_opts_button_box->pack_start($active_check_button, 0, 0, 0);
 370
 371 my $stick_check_button = new Gtk2::CheckButton("Stick to last");
 372 $stick_check_button->set_active($stick_to_last_event);
 373 $stick_check_button->signal_connect("clicked", sub {
 374         $stick_to_last_event ^= 1;
 375         &update_current_event_widgets()
 376                 if $stick_to_last_event && $current_event_num != @$stored_event_datas;
 377 });
 378 $event_run_opts_button_box->pack_start($stick_check_button, 0, 0, 0);
 379
 380 # ---- next event page row ----
 381 my $event_args_list_store = Gtk2::ListStore->new('Glib::String', 'Glib::String');
 382 my $event_args_list = Gtk2::TreeView->new($event_args_list_store);
 383 $event_args_list->set_rules_hint(1);
 384 my $renderer = Gtk2::CellRendererText->new;
 385 my $column1 = Gtk2::TreeViewColumn->new_with_attributes('Name',  $renderer, text => 0);
 386 my $column2 = Gtk2::TreeViewColumn->new_with_attributes('Value', $renderer, text => 1);
 387 $column1->set_min_width(140);
 388 $column1->set_resizable(1);
 389 $event_args_list->append_column($column1);
 390 $event_args_list->append_column($column2);
 391
 392 $event_args_list->signal_connect("row-activated", sub {
 393         my ($widget, $path, $column) = @_;
 394         $stick_check_button->set_active(0);
 395         my $n = ($path->get_indices)[0];
 396         my $data = $stored_event_datas->[$current_event_num - 1]->{args}->[$n];
 397         return unless ref($data) eq 'HASH';
 398         my $text = $data->{text};
 399         if (ref($text) eq 'HASH') {
 400                 $text = join("",
 401                         map { sprintf("\n%032b", $_) } @{$text->{value}}
 402                 );
 403         }
 404         $module->show_message(
 405                 "$data->{name} (" . event_arg_type_to_name($data->{type}) .
 406                 "): $text", $event_name->get_text() . " event argument"
 407         );
 408 });
 409
 410 my $event_args_list_scroll = new Gtk2::ScrolledWindow();
 411 $event_args_list_scroll->set_policy("automatic", "automatic");
 412 $event_args_list_scroll->add_with_viewport($event_args_list);
 413
 414 my $event_args_list_scroll_frame = new Gtk2::Frame(" Event arguments ");
 415 $tmp = new Gtk2::VBox(0, 0); $tmp->add($event_args_list_scroll); $tmp->set_border_width(5);
 416 $event_args_list_scroll_frame->add($tmp);
 417 $event_page->pack_start($event_args_list_scroll_frame, 1, 1, 10);
 418
 419 my $event_list_button_box = new Gtk2::HButtonBox();
 420 $event_list_button_box->set_spacing(2);
 421 $event_list_button_box->set_layout('edge');
 422 $event_page->pack_end($event_list_button_box, 0, 0, 0);
 423
 424 my $current_event_possibly_dirty = 0;
 425 sub filter_stored_events ($) {
 426         my $func = shift;
 427         my $initial_num = @$stored_event_datas;
 428         my $count = 0;
 429         my $index = 0;
 430         for ($count = 1; $count <= $initial_num; $count++) {
 431                 if (&$func($count, $stored_event_datas->[$index]->{type})) {
 432                         $index++;
 433                 } else {
 434                         splice(@$stored_event_datas, $index, 1);
 435                 }
 436         }
 437         if ($initial_num != @$stored_event_datas) {
 438                 $event_list_size_changed = 1;
 439                 $current_event_possibly_dirty = 1;
 440                 update_current_event_widgets();
 441         }
 442 }
 443
 444 my $clear_this_one_button = new Gtk2::Button(" _Clear one ");
 445 $event_list_button_box->pack_start($clear_this_one_button, 1, 1, 6);
 446 $clear_this_one_button->signal_connect("clicked", sub {
 447         filter_stored_events(sub { $_[0] != $current_event_num });
 448 });
 449
 450 my $clear_this_type_button = new Gtk2::Button(" Clear _type ");
 451 $event_list_button_box->pack_start($clear_this_type_button, 1, 1, 6);
 452 $clear_this_type_button->signal_connect("clicked", sub {
 453         my $current_type = $stored_event_datas->[$current_event_num - 1]->{type};
 454         filter_stored_events(sub { $_[1] != $current_type });
 455 });
 456
 457 my $clear_all_button = new Gtk2::Button(" Cl_ear all ");
 458 $event_list_button_box->pack_start($clear_all_button, 1, 1, 6);
 459 $clear_all_button->signal_connect("clicked", sub {
 460         filter_stored_events(sub { 0 });
 461 });
 462
 463 my $leave_this_type_button = new Gtk2::Button(" Leave t_ype ");
 464 $event_list_button_box->pack_start($leave_this_type_button, 1, 1, 6);
 465 $leave_this_type_button->signal_connect("clicked", sub {
 466         my $current_type = $stored_event_datas->[$current_event_num - 1]->{type};
 467         filter_stored_events(sub { $_[1] == $current_type });
 468 });
 469
 470 my $leave_this_one_button = new Gtk2::Button(" _Leave one ");
 471 $event_list_button_box->pack_start($leave_this_one_button, 1, 1, 6);
 472 $leave_this_one_button->signal_connect("clicked", sub {
 473         filter_stored_events(sub { $_[0] == $current_event_num });
 474 });
 475
 476 $event_list_button_box->foreach(\&setup_button_size, 80);
 477
 478 sub update_current_event_widgets (;$) {
 479         # update event number
 480         my $max_num = @$stored_event_datas;
 481         my $min_num = $max_num > 0 ? 1 : 0;
 482         my $num = shift || ($stick_to_last_event ? $max_num : $current_event_num);
 483         $num = 1 if $num <= 0;
 484         $num = $max_num if $num > $max_num;
 485         my $current_event_num_changed = $current_event_num != $num;
 486         $current_event_num = $num;
 487
 488         $event_num_adj->lower($min_num);
 489         $event_num_adj->upper($max_num);
 490         $event_num_adj->set_value($num);
 491         $event_num->update;
 492         $event_total_num->set_text($max_num);
 493
 494         return unless $current_event_num_changed
 495                 || $event_list_size_changed || $current_event_possibly_dirty;
 496         $event_list_size_changed = 0;
 497
 498         # update event name
 499         $event_name->set_text($num ? $stored_event_datas->[$num - 1]->{name} : "");
 500
 501         # update event args
 502         if ($current_event_num_changed || $current_event_possibly_dirty) {
 503                 $event_args_list_store->clear;
 504                 foreach ($num ? @{$stored_event_datas->[$num - 1]->{args}} : ()) {
 505                         my $data = $_;
 506                         my $text = $data->{text};
 507                         $text = $text->{label} if ref($text) eq 'HASH';
 508                         my $iter = $event_args_list_store->append;
 509                         $event_args_list_store->set($iter, 0 => $data->{name}, 1 => $text);
 510                 }
 511                 $current_event_possibly_dirty = 0;
 512         }
 513
 514         # update event time
 515         my $time_string1 = "";
 516         my $time_string2 = "";
 517         if ($num) {
 518                 my $time = $stored_event_datas->[$num - 1]->{time};
 519                 my ($sec, $min, $hour, $day, $mon, $year) = localtime($time);
 520                 $mon++; $year += 1900 if $year < 1900;
 521                 $time_string1 = sprintf("%02d:%02d", $hour, $min);
 522                 $time_string2 = sprintf("%s-%02d-%02d %02d:%02d:%02d",
 523                         $year, $mon, $day, $hour, $min, $sec);
 524         }
 525         $event_time->set_text($time_string1);
 526         $tooltips->set_tip($event_time, $time_string2);
 527
 528         # update event buttons
 529         my $current_type = $num ? $stored_event_datas->[$num - 1]->{type} : 0;
 530         my $has_other_types = 0;
 531         foreach ($num = 1; $num <= $max_num; $num++) {
 532                 if ($current_type != $stored_event_datas->[$num - 1]->{type})
 533                         { $has_other_types = 1; last; }
 534         }
 535         $clear_this_one_button->set_sensitive($max_num > 0);
 536         $clear_this_type_button->set_sensitive($max_num > 0);
 537         $clear_all_button->set_sensitive($max_num > 0);
 538         $leave_this_type_button->set_sensitive($has_other_types);
 539         $leave_this_one_button->set_sensitive($max_num > 1);
 540 }
 541
 542 sub update_current_event_number () {
 543         return if $event_num->get_value == $current_event_num;
 544         update_current_event_widgets($event_num->get_value);
 545 }
 546
 547 my $in_switch_monitoring = 0;
 548 sub switch_monitoring () {
 549         return if $in_switch_monitoring;
 550         $in_switch_monitoring = 1;
 551         $monitoring ^= 1;
 552         send_module_event_mask();
 553         $start_monitoring_button->child->set_label($monitoring
 554                 ? " _Stop monitoring events " : " _Start monitoring events ");
 555         $active_check_button->set_active($monitoring);
 556         $in_switch_monitoring = 0;
 557 }
 558
 559 # ---- tools page ----
 560 my $tools_page = new Gtk2::VBox(0, 0);
 561 $tools_page->set_border_width(10);
 562 $notebook->append_page($tools_page, new Gtk2::Label(" Tools "));
 563
 564 my $request_button_box = new Gtk2::HButtonBox();
 565 $request_button_box->set_layout('edge');
 566
 567 $request_button_box_frame = new Gtk2::Frame(" Request module info ");
 568 $tmp = new Gtk2::VBox(0, 0); $tmp->add($request_button_box); $tmp->set_border_width(5);
 569 $request_button_box_frame->add($tmp);
 570 $tools_page->pack_start($request_button_box_frame, 0, 0, 0);
 571
 572 my $send_configinfo_button = new Gtk2::Button(" Send__ConfigInfo ");
 573 $request_button_box->pack_end($send_configinfo_button, 1, 1, 6);
 574 $send_configinfo_button->signal_connect("clicked", sub {
 575         $module->send("Send_ConfigInfo");
 576 });
 577
 578 my $send_windowlist_button = new Gtk2::Button(" Send__WindowList ");
 579 $request_button_box->pack_end($send_windowlist_button, 1, 1, 6);
 580 $send_windowlist_button->signal_connect("clicked", sub {
 581         $module->send("Send_WindowList");
 582 });
 583
 584 $request_button_box->foreach(\&setup_button_size, 172);
 585
 586 my $reply_to_request = new Gtk2::Entry();
 587 $reply_to_request->signal_connect("activate", sub {
 588         my $text = $reply_to_request->get_text;
 589         $module->request_reply($text, $context_window_id);
 590         $module->emulate_event(MX_REPLY, [ $context_window_id, 0, 12345, $text ])
 591                 if $is_dummy;
 592         $reply_to_request->set_text("");
 593 });
 594
 595 $request_reply_frame = new Gtk2::Frame(" Request reply ");
 596 $tmp = new Gtk2::VBox(0, 0); $tmp->add($reply_to_request); $tmp->set_border_width(5);
 597 $request_reply_frame->add($tmp);
 598 $tools_page->pack_start($request_reply_frame, 0, 0, 10);
 599
 600 # ---- fvwm commands ----
 601 my %cursor_to_stock_icon = (
 602         ''      => 'gtk-yes',
 603         '-'     => 'gtk-about',
 604         DESTROY => 'gtk-close',
 605         SELECT  => 'gtk-find',
 606         RESIZE  => 'gtk-fullscreen',
 607         MOVE    => 'gtk-leave-fullscreen',
 608 );
 609
 610 my $command_entries = Gtk2::ListStore->new(('Glib::String') x 3);
 611 my $i = 0; my (%command_name_indexes, @command_names);
 612 foreach ({ name => '', descr => 'Select fvwm command', cursor => '-' }, @FVWM::Commands::LIST) {
 613         push @command_names, $_->{name};
 614         $command_name_indexes{lc($_->{name})} = $i++;
 615         $command_entries->set($command_entries->append,
 616                 0 => $cursor_to_stock_icon{$_->{cursor}} || 'gtk-no',
 617                 1 => $_->{name},
 618                 2 => $_->{descr},
 619         );
 620 }
 621
 622 my $command_entries_combo_box = Gtk2::ComboBox->new($command_entries);
 623 $renderer = Gtk2::CellRendererPixbuf->new;
 624 $command_entries_combo_box->pack_start($renderer, 0);
 625 $command_entries_combo_box->add_attribute($renderer, stock_id => 0);
 626 $renderer = Gtk2::CellRendererText->new;
 627 $command_entries_combo_box->pack_start($renderer, 1);
 628 $command_entries_combo_box->add_attribute($renderer, text => 1);
 629 $renderer = Gtk2::CellRendererText->new;
 630 $renderer->set(scale => 0.8);
 631 $command_entries_combo_box->pack_start($renderer, 0);
 632 $command_entries_combo_box->add_attribute($renderer, text => 2);
 633 $command_entries_combo_box->set_active(0);
 634
 635 my $window_list_cmd =
 636         'WindowList SortByResource, NoGeometry, NoDeskSort, NoCurrentDeskTitle, NoHotkeys';
 637
 638 my $command_history_filename = $module->user_data_dir . '/.FvwmConsole-History';
 639 my @history_commands = -r $command_history_filename
 640         ? map { chomp; $_ } `cat $command_history_filename`
 641         : ('Beep', $window_list_cmd);
 642
 643 my $command_to_send_combo_box = Gtk2::ComboBoxEntry->new_text;
 644 $command_to_send_combo_box->prepend_text($_) foreach @history_commands;
 645 my $command_to_send = $command_to_send_combo_box->child;
 646 sub parse_command_to_send { $command_to_send->get_text =~ /^\s*(\W|\w+|)(.*)/ }
 647 $command_to_send->signal_connect("activate", sub {
 648         my $text = $command_to_send->get_text;
 649         $module->send($text, $context_window_id);
 650         $command_to_send_combo_box->prepend_text($text);
 651         $command_to_send->set_text("");
 652         append_file($command_history_filename, \"$text\n");
 653 });
 654 $command_to_send->signal_connect("changed", sub {
 655         my $command_name = (parse_command_to_send())[0];
 656         my $index = $command_name_indexes{lc($command_name)} || 0;
 657         $command_entries_combo_box->set_active($index);
 658 });
 659 $command_entries_combo_box->signal_connect("changed", sub {
 660         my $command_name =
 661                 $command_names[$command_entries_combo_box->get_active] or return;
 662         my ($name, $extra) = parse_command_to_send();
 663         $extra = " $extra" if $extra =~ /^\S/ && length $command_name > 1;
 664         $command_to_send->set_text($command_name . $extra);
 665 });
 666
 667 my $extra_str = $is_dummy ? " (not connected to fvwm in dummy mode) " : "";
 668 my $command_console_frame = new Gtk2::Frame(" Command console " . $extra_str);
 669 $tmp = new Gtk2::VBox(0, 0); $tmp->add($command_to_send_combo_box);
 670 $tmp->add($command_entries_combo_box); $tmp->set_border_width(5);
 671 $command_console_frame->add($tmp);
 672 $tools_page->pack_start($command_console_frame, 0, 0, 0);
 673
 674 # ---- context window ----
 675 my $set_window_cmd = qq(Send_Reply set_window);
 676 my $pick_window_cmd = qq(Pick $set_window_cmd);
 677 my $select_window_list_cmd = qq($window_list_cmd, Function '$set_window_cmd');
 678
 679 my $context_window_name = "";
 680 my $context_window_id_label = new Gtk2::Label("Window id:");
 681 my $context_window_id_widget = new Gtk2::Label("");
 682 my $context_window_name_label = new Gtk2::Label("Name:");
 683 my $context_window_name_widget = new Gtk2::Label("");
 684 my ($unset_window_button, $set_self_window_button);
 685
 686 sub update_context_window_widgets () {
 687         $context_window_id_widget->set_label($context_window_id
 688                 ? sprintf('0x%07lx', $context_window_id)
 689                 : '(no window)'
 690         );
 691         $context_window_name = "" unless $context_window_id;
 692         $context_window_name_widget->set_label($context_window_name);
 693         if ($context_window_name) {
 694                 $context_window_name_label->show;
 695                 $context_window_name_widget->show;
 696         } else {
 697                 $context_window_name_label->hide;
 698                 $context_window_name_widget->hide;
 699         }
 700         $unset_window_button->set_sensitive($context_window_id);
 701         $set_self_window_button->set_sensitive($context_window_id != $self_window_id);
 702 }
 703
 704 sub start_content_window_reply_tracker ($) {
 705         my $cmd_requesting_reply = shift;
 706
 707         return $module->show_message("This action is disabled in dummy mode")
 708                 if $is_dummy;
 709
 710 #       my $tracker = FVWM::Tracker->new($module);
 711         my $tracker = $module->track({ NoStart => 1 }, 'FVWM::Tracker');
 712         $tracker->add_handler(MX_REPLY, sub {
 713                 my ($module, $event) = @_;
 714                 $module->terminate if $event->_text eq 'end';
 715                 my $selected_window_id = $event->_win_id;
 716                 return unless $selected_window_id
 717                         && $context_window_id != $selected_window_id;
 718                 $context_window_id = $event->_win_id;
 719                 $context_window_name = "";
 720                 update_context_window_widgets();
 721         });
 722         $module->postpone_send("$cmd_requesting_reply\nSend_Reply end");
 723         $tracker->start;
 724         $tracker->stop;
 725         delete $module->{trackers}->{'FVWM::Tracker'};
 726 }
 727
 728 $module->add_handler(M_WINDOW_NAME, sub {
 729         my ($module, $event) = @_;
 730         if ($event->_win_id == $context_window_id) {
 731                 $context_window_name = $event->_name;
 732                 update_context_window_widgets();
 733         }
 734 });
 735
 736 my $context_window_box = new Gtk2::HBox(0, 0);
 737 $context_window_box->set_size_request(-1, 22);
 738 $context_window_box->pack_start($context_window_id_label, 0, 0, 8);
 739 $context_window_box->pack_start($context_window_id_widget, 0, 0, 0);
 740 $context_window_box->pack_start($context_window_name_label, 0, 0, 8);
 741 $context_window_box->pack_start($context_window_name_widget, 0, 0, 0);
 742 $context_window_id_widget->set_selectable(1);
 743 $context_window_name_widget->set_selectable(1);
 744
 745 my $select_context_window_box = new Gtk2::HButtonBox();
 746 $select_context_window_box->set_layout('edge');
 747
 748 my $select_window_list_button = new Gtk2::Button(" Select from list ");
 749 $select_context_window_box->pack_start($select_window_list_button, 0, 0, 0);
 750 $select_window_list_button->signal_connect("clicked", sub {
 751         start_content_window_reply_tracker($select_window_list_cmd);
 752 });
 753
 754 my $pick_window_button = new Gtk2::Button(" Pick ");
 755 $select_context_window_box->pack_start($pick_window_button, 0, 0, 0);
 756 $pick_window_button->signal_connect("clicked", sub {
 757         start_content_window_reply_tracker($pick_window_cmd);
 758 });
 759
 760 $set_self_window_button = new Gtk2::Button(" Set itself ");
 761 $select_context_window_box->pack_start($set_self_window_button, 0, 0, 0);
 762 $set_self_window_button->signal_connect("clicked", sub {
 763         $context_window_id = $self_window_id;
 764         $context_window_name = "";
 765         update_context_window_widgets();
 766 });
 767
 768 $unset_window_button = new Gtk2::Button(" Unset ");
 769 $select_context_window_box->pack_start($unset_window_button, 0, 0, 0);
 770 $unset_window_button->signal_connect("clicked", sub {
 771         $context_window_id = 0;
 772         update_context_window_widgets();
 773 });
 774
 775 my $context_window_frame = new Gtk2::Frame(" Context window ");
 776 $tmp = new Gtk2::VBox(0, 10); $tmp->add($context_window_box);
 777 $tmp->add($select_context_window_box); $tmp->set_border_width(5);
 778 $context_window_frame->add($tmp);
 779 $tools_page->pack_start($context_window_frame, 0, 0, 10);
 780
 781 # ---- help and quit ----
 782 my $quit_button_box = new Gtk2::HButtonBox();
 783 $quit_button_box->set_layout('edge');
 784 $tools_page->pack_end($quit_button_box, 0, 0, 0);
 785
 786 my $help_button = new Gtk2::Button(" _Help ");
 787 $quit_button_box->pack_end($help_button, 1, 1, 6);
 788 $help_button->signal_connect("clicked", sub {
 789         $module->show_message(<<ENDMSG, "FvwmGtkDebug Help");
 790 This module captures the event information received from fvwm and shows it.
 791 You should configure events you want to receive and then activate the
 792 monitoring mode. The activation may be done either from the "Setup" or
 793 "Stored events" pages. The received-event mask may be changed at any time.
 794
 795 You may then browse the stored event data, compare it or remove it.
 796
 797 Any module may request fvwm to send its config info or window list info or
 798 any custom reply back. The module then receives the requested information
 799 using events. Don't forget to enable relevant events for this to work.
 800
 801 Finally, you may send commands to fvwm, just like FvwmTalk does.
 802
 803 The best way to learn how this application works is to try all options,
 804 it is safe. Good luck.
 805 ENDMSG
 806 });
 807
 808 my $quit_button = new Gtk2::Button(" _Quit ");
 809 $quit_button_box->pack_end($quit_button, 1, 1, 6);
 810 $quit_button->signal_connect("clicked", sub { Gtk2->main_quit; });
 811
 812 $quit_button_box->foreach(\&setup_button_size, 120);
 813
 814 # ---- last GUI preparations ----
 815 update_check_buttons_from_new_mask();
 816 update_current_event_widgets();
 817
 818 $window->signal_connect("destroy" => \&Gtk2::main_quit);
 819 $window->set_default_size(500, 600);
 820 $window->show_all;
 821
 822 $self_window_id = $window->window->XWINDOW;
 823 update_context_window_widgets();
 824
 825 # ----------------------------------------------------------------------------
 826 # main
 827
 828 send_module_event_mask();
 829
 830 $module->add_handler(MAX_MSG_MASK, \&store_event);
 831 $module->add_handler(MAX_XMSG_MASK | M_EXTENDED_MSG, \&store_event);
 832
 833 sub emulate_some_events () {
 834         $module->emulate_event(M_NEW_DESK, [ $current_event_num ]);
 835         $module->emulate_event(M_MAP, [ 0x123, 0x456, 789 ]);
 836         $module->emulate_event(M_NEW_PAGE, [ 0, 0, 2, 800, 600, 3, 3 ]);
 837 }
 838
 839 if ($is_dummy) {
 840         $module->show_message(
 841                 "This module is executed in the dummy mode.\n\n" .
 842                 "Every 20 seconds fake events are generated."
 843         );
 844         emulate_some_events();
 845         emulate_some_events();
 846         my $scheduler = $module->track('Scheduler');
 847         $scheduler->schedule(20, sub {
 848                 emulate_some_events() if $monitoring;
 849                 $scheduler->reschedule;
 850         });
 851 }
 852
 853 $module->event_loop;
 854
 855 __END__
 856
 857 # ----------------------------------------------------------------------------
 858 # man page
 859
 860 =head1 NAME
 861
 862 FvwmGtkDebug - graphical interactive fvwm module debugger
 863
 864 =head1 SYNOPSIS
 865
 866 FvwmGtkDebug should be spawned by fvwm(1).
 867
 868 To run this module, place this command somewhere in the configuration:
 869
 870     Module FvwmGtkDebug
 871
 872 To stop this module, just close the GUI window, the usual KillModule works too.
 873
 874 You may also run this application as a regular program from the command
 875 line shell.  But the communication with I<fvwm> is not established in this
 876 dummy mode, so commands are not really sent and there are no real events
 877 received.  However certain activity is emulated using dummy events.
 878
 879 =head1 DESCRIPTION
 880
 881 This module monitors all fvwm event information and shows it nicely in the
 882 interactive gtk+ application. Good for debugging and educational purposes.
 883
 884 Among the features: command console with history and auto command help,
 885 requesting to send back ConfigInfo (configuration of I<fvwm> and all
 886 modules), WindowList (information about all windows) or custom Reply.
 887
 888 The fvwm commands may be executed within the context of some window.
 889 The context window may be optionally set on invocation, like: "Next
 890 (Navigator) FvwmGtkDebug", and be set/unset interactively at any time.
 891
 892 =head1 INVOCATION
 893
 894 There are several command line switches:
 895
 896 B<FvwmGtkDebug>
 897 [ B<--mask> I<mask> ]
 898 [ B<--xmask> I<mask> ]
 899 [ B<--debug> I<level> ]
 900
 901 Long switches may be abbreviated to shorter switches.
 902
 903 B<-m>|B<--mask> I<mask> - set the initial module mask, 31 bit integer.
 904 This mask may be changed interactively at any time.
 905 By default almost all events are monitored (except for some flood events
 906 like I<CONFIGURE_WINDOW> or I<FOCUS_WINDOW>. The special value of I<-1>
 907 sets the maximal mask.
 908
 909 B<-x>|B<--xmask> I<mask> - set the initial module extended mask, 31 bit integer.
 910 This mask may be changed interactively at any time.
 911 By default almost all events are monitored (except for some flood events
 912 like I<ENTER_WINDOW> or I<LEAVE_WINDOW>. The special value of I<-1>
 913 sets the maximal extended mask.
 914
 915 B<-d>|B<--debug> I<level> - use the Perl library debugging mechanism.
 916 The useful I<level>s are 2 to 4.
 917
 918 =head1 SEE ALSO
 919
 920 See also L<FvwmDebug>, "fvwm-perllib man events".
 921
 922 =head1 AUTHOR
 923
 924 Mikhael Goikhman <migo@homemail.com>.
 925
 926 =cut