"Fossies" - the Fresh Open Source Software Archive

Member "clusterssh-4.16/lib/App/ClusterSSH/Window/Tk.pm" (20 Jun 2020, 66294 Bytes) of package /linux/privat/clusterssh-4.16.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "Tk.pm" see the Fossies "Dox" file reference documentation and the latest Fossies "Diffs" side-by-side code changes report: 4.15_vs_4.16.

    1 use strict;
    2 use warnings;
    3 
    4 package App::ClusterSSH::Window::Tk;
    5 
    6 # ABSTRACT: Object for creating windows using Tk
    7 
    8 use English qw( -no_match_vars );
    9 
   10 use base qw/ App::ClusterSSH::Base /;
   11 use vars qw/ %keysymtocode %keycodetosym /;
   12 
   13 use Net::Domain qw(hostfqdn);
   14 use File::Temp qw/:POSIX/;
   15 use Fcntl;
   16 use POSIX ":sys_wait_h";
   17 use POSIX qw/:sys_wait_h strftime mkfifo/;
   18 use Tk 800.022;
   19 use Tk::Xlib;
   20 use Tk::ROText;
   21 require Tk::Dialog;
   22 require Tk::LabEntry;
   23 use Symbol qw/ gensym /;
   24 use IPC::Open3;
   25 use X11::Protocol 0.56;
   26 use X11::Protocol::Constants qw/ Shift Mod5 ShiftMask /;
   27 use X11::Protocol::WM 29;
   28 use X11::Keysyms '%keysymtocode', 'MISCELLANY', 'XKB_KEYS', '3270', 'LATIN1',
   29     'LATIN2', 'LATIN3', 'LATIN4', 'KATAKANA', 'ARABIC', 'CYRILLIC', 'GREEK',
   30     'TECHNICAL', 'SPECIAL', 'PUBLISHING', 'APL', 'HEBREW', 'THAI', 'KOREAN';
   31 
   32 # Module to contain all Tk specific functionality
   33 
   34 my %windows;    # hash for all window definitions
   35 my %menus;      # hash for all menu definitions
   36 my @servers;    # array of servers provided on cmdline
   37 my %servers;    # hash of server cx info
   38 my $xdisplay;
   39 my %keyboardmap;
   40 my $sysconfigdir = "/etc";
   41 my %ssh_hostnames;
   42 my $host_menu_static_items;    # number of items in the host menu that should
   43                                # not be touched by build_host_menu
   44 my (@dead_hosts);              # list of hosts whose sessions are now closed
   45 
   46 $keysymtocode{unknown_sym} = 0xFFFFFF;    # put in a default "unknown" entry
   47 $keysymtocode{EuroSign}
   48     = 0x20AC;    # Euro sign - missing from X11::Protocol::Keysyms
   49 
   50 # and also map it the other way
   51 %keycodetosym = reverse %keysymtocode;
   52 
   53 sub initialise {
   54     my ($self) = @_;
   55 
   56     # only get xdisplay if we got past usage and help stuff
   57     $xdisplay = X11::Protocol->new();
   58 
   59     if ( !$xdisplay ) {
   60         die("Failed to get X connection\n");
   61     }
   62 
   63     return $self;
   64 }
   65 
   66 # Pick a color based on a string.
   67 sub pick_color {
   68     my ($string)   = @_;
   69     my @components = qw(AA BB CC EE);
   70     my $color      = 0;
   71     for ( my $i = 0; $i < length($string); $i++ ) {
   72         $color += ord( substr( $string, $i, 1 ) );
   73     }
   74 
   75     srand($color);
   76     my $ans = '\\#';
   77     $ans .= $components[ int( 4 * rand() ) ];
   78     $ans .= $components[ int( 4 * rand() ) ];
   79     $ans .= $components[ int( 4 * rand() ) ];
   80     return $ans;
   81 }
   82 
   83 # close a specific host session
   84 sub terminate_host($) {
   85     my ( $self, $svr ) = @_;
   86     $self->debug( 2, "Killing session for $svr" );
   87     if ( !$servers{$svr} ) {
   88         $self->debug( 2, "Session for $svr not found" );
   89         return;
   90     }
   91 
   92     $self->debug( 2, "Killing process $servers{$svr}{pid}" );
   93     kill( 9, $servers{$svr}{pid} ) if kill( 0, $servers{$svr}{pid} );
   94     delete( $servers{$svr} );
   95     return $self;
   96 }
   97 
   98 sub terminate_all_hosts {
   99     my ($self) = @_;
  100 
  101     # for each of the client windows, send a kill.
  102     #     # to make sure we catch all children, even when they haven't
  103     #         # finished starting or received the kill signal, do it like this
  104     while (%servers) {
  105         foreach my $svr ( keys(%servers) ) {
  106             $self->terminate_host($svr);
  107         }
  108     }
  109 
  110     return $self;
  111 }
  112 
  113 sub send_text_to_all_servers {
  114     my $self = shift;
  115     my $text = join( '', @_ );
  116 
  117     foreach my $svr ( keys(%servers) ) {
  118         $self->send_text( $svr, $text )
  119             if ( $servers{$svr}{active} == 1 );
  120     }
  121 }
  122 
  123 sub send_variable_text_to_all_servers($&) {
  124     my ( $self, $code ) = @_;
  125 
  126     foreach my $svr ( keys(%servers) ) {
  127         $self->send_text( $svr, $code->($svr) )
  128             if ( $servers{$svr}{active} == 1 );
  129     }
  130 }
  131 
  132 sub open_client_windows(@) {
  133     my $self = shift;
  134     foreach (@_) {
  135         next unless ($_);
  136 
  137         my $server_object = App::ClusterSSH::Host->parse_host_string($_);
  138 
  139         my $username = $server_object->get_username();
  140         $username = $self->config->{user}
  141             if ( !$username && $self->config->{user} );
  142         my $port = $server_object->get_port();
  143         $port = $self->config->{port} if ( $self->config->{port} );
  144         my $server = $server_object->get_hostname();
  145         my $master = $server_object->get_master();
  146 
  147         my $given_server_name = $server_object->get_hostname();
  148 
  149         # see if we can find the hostname - if not, drop it
  150         my $realname = $server_object->get_realname();
  151         if ( !$realname ) {
  152             my $text = "WARNING: '$_' unknown";
  153 
  154             if (%ssh_hostnames) {
  155                 $text
  156                     .= " (unable to resolve and not in user ssh config file)";
  157             }
  158 
  159             warn( $text, $/ );
  160 
  161        #next;  # Debian bug 499935 - ignore warnings about hostname resolution
  162         }
  163 
  164         $self->debug( 3, "username=$username, server=$server, port=$port" );
  165 
  166         my $color = '';
  167         if ( $self->config->{terminal_colorize} ) {
  168             my $c = pick_color($server);
  169             if ( $self->config->{terminal_bg_style} eq 'dark' ) {
  170                 $color = "-bg \\#000000 -fg $c";
  171             }
  172             else {
  173                 $color = "-fg \\#000000 -bg $c";
  174             }
  175         }
  176 
  177         my $count = q{};
  178         while ( defined( $servers{ $server . q{ } . $count } ) ) {
  179             $count++;
  180         }
  181         $server .= q{ } . $count;
  182 
  183         $servers{$server}{connect_string} = $_;
  184         $servers{$server}{givenname}      = $given_server_name;
  185         $servers{$server}{realname}       = $realname;
  186         $servers{$server}{username}       = $self->config->{user};
  187         $servers{$server}{username}       = $username if ($username);
  188         $servers{$server}{username}       = $username || '';
  189         $servers{$server}{port}           = $port || '';
  190         $servers{$server}{master}         = $self->config->{mstr} || '';
  191         $servers{$server}{master}         = $master if ($master);
  192 
  193         $self->debug( 2, "Working on server $server for $_" );
  194 
  195         $servers{$server}{pipenm} = tmpnam();
  196 
  197         $self->debug( 2, "Set temp name to: $servers{$server}{pipenm}" );
  198         mkfifo( $servers{$server}{pipenm}, 0600 )
  199             or die("Cannot create pipe: $!");
  200 
  201        # NOTE: the PID is re-fetched from the xterm window (via helper_script)
  202        # later as it changes and we need an accurate PID as it is widely used
  203         $servers{$server}{pid} = fork();
  204         if ( !defined( $servers{$server}{pid} ) ) {
  205             die("Could not fork: $!");
  206         }
  207 
  208         if ( $servers{$server}{pid} == 0 ) {
  209 
  210           # this is the child
  211           # Since this is the child, we can mark any server unresolved without
  212           # affecting the main program
  213             $servers{$server}{realname} .= "==" if ( !$realname );
  214 
  215             # copy and amend the config provided to the helper script
  216             my $local_config = $self->config;
  217             $local_config->{command} = $self->substitute_macros( $server,
  218                 $local_config->{command} );
  219 
  220             my $exec = join( ' ',
  221                 $self->config->{terminal},
  222                 $color,
  223                 $self->config->{terminal_args},
  224                 $self->config->{terminal_allow_send_events},
  225                 $self->config->{terminal_title_opt},
  226                 "'"
  227                     . $self->config->{title} . ': '
  228                     . $servers{$server}{connect_string} . "'",
  229                 '-font ' . $self->config->{terminal_font},
  230                 "-e " . $^X . ' -e ',
  231                 "'" . $self->parent->helper->script( $self->config ) . "'",
  232                 " " . $servers{$server}{pipenm},
  233                 " " . $servers{$server}{givenname},
  234                 " '" . $servers{$server}{username} . "'",
  235                 " '" . $servers{$server}{port} . "'",
  236                 " '" . $servers{$server}{master} . "'",
  237             );
  238             $self->debug( 2, "Terminal exec line:\n$exec\n" );
  239             exec($exec) == 0 or warn("Failed: $!");
  240         }
  241     }
  242 
  243     # Now all the windows are open, get all their window IDs
  244     foreach my $server ( keys(%servers) ) {
  245         next if ( defined( $servers{$server}{active} ) );
  246 
  247         # sleep for a moment to give system time to come up
  248         select( undef, undef, undef, 0.1 );
  249 
  250         # block on open so we get the text when it comes in
  251         unless (
  252             sysopen(
  253                 $servers{$server}{pipehl}, $servers{$server}{pipenm},
  254                 O_RDONLY
  255             )
  256             )
  257         {
  258             warn(
  259                 "Cannot open pipe for reading when talking to $server: $!\n");
  260         }
  261         else {
  262 
  263             # NOTE: read both the xterm pid and the window ID here
  264             # get PID here as it changes from the fork above, and we need the
  265             # correct PID
  266             $self->debug( 2, "Performing sysread" );
  267             my $piperead;
  268             sysread( $servers{$server}{pipehl}, $piperead, 100 );
  269             ( $servers{$server}{pid}, $servers{$server}{wid} )
  270                 = split( /:/, $piperead, 2 );
  271             warn("Cannot determ pid of '$server' window\n")
  272                 unless $servers{$server}{pid};
  273             warn("Cannot determ window ID of '$server' window\n")
  274                 unless $servers{$server}{wid};
  275             $self->debug( 2, "Done and closing pipe" );
  276 
  277             close( $servers{$server}{pipehl} );
  278         }
  279         delete( $servers{$server}{pipehl} );
  280 
  281         unlink( $servers{$server}{pipenm} );
  282         delete( $servers{$server}{pipenm} );
  283 
  284         $servers{$server}{active} = 1;    # mark as active
  285         $self->config->{internal_activate_autoquit}
  286             = 1;                          # activate auto_quit if in use
  287     }
  288     $self->debug( 2, "All client windows opened" );
  289     $self->config->{internal_total} = int( keys(%servers) );
  290 
  291     return $self;
  292 }
  293 
  294 sub toggle_active_state() {
  295     my ($self) = @_;
  296     $self->debug( 2, "Toggling active state of all hosts" );
  297 
  298     foreach my $svr ( sort( keys(%servers) ) ) {
  299         $servers{$svr}{active} = not $servers{$svr}{active};
  300     }
  301 }
  302 
  303 sub set_all_active() {
  304     my ($self) = @_;
  305     $self->debug( 2, "Setting all hosts to be active" );
  306 
  307     foreach my $svr ( keys(%servers) ) {
  308         $servers{$svr}{active} = 1;
  309     }
  310 
  311 }
  312 
  313 sub set_half_inactive() {
  314     my ($self) = @_;
  315     $self->debug( 2, "Setting approx half of all hosts to inactive" );
  316 
  317     return if !%servers;
  318 
  319     my (@keys) = keys(%servers);
  320     $#keys /= 2;
  321     foreach my $svr (@keys) {
  322         $servers{$svr}{active} = 0;
  323     }
  324 }
  325 
  326 sub close_inactive_sessions() {
  327     my ($self) = @_;
  328     $self->debug( 2, "Closing all inactive sessions" );
  329 
  330     foreach my $svr ( sort( keys(%servers) ) ) {
  331         $self->terminate_host($svr) if ( !$servers{$svr}{active} );
  332     }
  333     $self->build_hosts_menu();
  334 }
  335 
  336 sub add_host_by_name() {
  337     my ($self) = @_;
  338     $self->debug( 2, "Adding host to menu here" );
  339 
  340     $windows{host_entry}->focus();
  341     my $answer = $windows{addhost}->Show();
  342 
  343     if ( !$answer || $answer ne "Add" ) {
  344         $menus{host_entry} = "";
  345         return;
  346     }
  347 
  348     if ( $menus{host_entry} ) {
  349         $self->debug( 2, "host=", $menus{host_entry} );
  350         my @names
  351             = $self->parent->resolve_names( split( /\s+/, $menus{host_entry} ) );
  352         $self->debug( 0, 'Opening to: ', join( ' ', @names ) ) if (@names);
  353         $self->open_client_windows(@names);
  354     }
  355 
  356     if ( defined $menus{listbox} && $menus{listbox}->curselection() ) {
  357         my @hosts = $menus{listbox}->get( $menus{listbox}->curselection() );
  358         $self->debug( 2, "host=", join( ' ', @hosts ) );
  359         $self->open_client_windows( $self->parent->resolve_names(@hosts) );
  360     }
  361 
  362     $self->build_hosts_menu();
  363     $menus{host_entry} = "";
  364 
  365     # retile, or bring console to front
  366     if ( $self->config->{window_tiling} eq "yes" ) {
  367         return $self->retile_hosts();
  368     }
  369     else {
  370         return $self->show_console();
  371     }
  372 }
  373 
  374 # attempt to re-add any hosts that have been closed since we started
  375 # the session - either through errors or deliberate log-outs
  376 sub re_add_closed_sessions() {
  377     my ($self) = @_;
  378     $self->debug( 2, "add closed sessions" );
  379 
  380     return if ( scalar(@dead_hosts) == 0 );
  381 
  382     my @new_hosts = @dead_hosts;
  383 
  384     # clear out the list in case open fails
  385     @dead_hosts = qw//;
  386 
  387     # try to open
  388     $self->open_client_windows(@new_hosts);
  389 
  390     # update hosts list with current state
  391     $self->build_hosts_menu();
  392 
  393     # retile, or bring console to front
  394     if ( $self->config->{window_tiling} eq "yes" ) {
  395         return $self->retile_hosts();
  396     }
  397     else {
  398         return $self->show_console();
  399     }
  400 }
  401 
  402 sub load_keyboard_map() {
  403     my ($self) = @_;
  404 
  405     # load up the keyboard map to convert keysyms to keyboardmap
  406     my $min      = $xdisplay->{min_keycode};
  407     my $count    = $xdisplay->{max_keycode} - $min;
  408     my @keyboard = $xdisplay->GetKeyboardMapping( $min, $count );
  409 
  410     # @keyboard arry
  411     #  0 = plain key
  412     #  1 = with shift
  413     #  2 = with Alt-GR
  414     #  3 = with shift + AltGr
  415     #  4 = same as 2 - control/alt?
  416     #  5 = same as 3 - shift-control-alt?
  417 
  418     $self->debug( 1, "Loading keymaps and keycodes" );
  419 
  420     my %keyboard_modifier_priority = (
  421         'sa' => 3,    # lowest
  422         'a'  => 2,
  423         's'  => 1,
  424         'n'  => 0,    # highest
  425     );
  426 
  427     my %keyboard_stringlike_modifiers = reverse %keyboard_modifier_priority;
  428 
  429   # try to associate $keyboard=X11->GetKeyboardMapping table with X11::Keysyms
  430     foreach my $i ( 0 .. $#keyboard ) {
  431         for my $modifier ( 0 .. 3 ) {
  432             if (   defined( $keyboard[$i][$modifier] )
  433                 && defined( $keycodetosym{ $keyboard[$i][$modifier] } ) )
  434             {
  435 
  436                 # keyboard layout contains the keycode at $modifier level
  437                 if (defined(
  438                         $keyboardmap{ $keycodetosym{ $keyboard[$i][$modifier]
  439                         } }
  440                     )
  441                     )
  442                 {
  443 
  444 # we already have a mapping, let's see whether current one is better (lower shift state)
  445                     my ( $mod_code, $key_code )
  446                         = $keyboardmap{ $keycodetosym{ $keyboard[$i]
  447                                 [$modifier] } } =~ /^(\D+)(\d+)$/;
  448 
  449       # it is not easy to get around our own alien logic storing modifiers ;-)
  450                     if ( $modifier < $keyboard_modifier_priority{$mod_code} )
  451                     {
  452 
  453                      # YES! current keycode have priority over old one (phew!)
  454                         $keyboardmap{ $keycodetosym{ $keyboard[$i][$modifier]
  455                         } }
  456                             = $keyboard_stringlike_modifiers{$modifier}
  457                             . ( $i + $min );
  458                     }
  459                 }
  460                 else {
  461 
  462                     # we don't yet have a mapping... piece of cake!
  463                     $keyboardmap{ $keycodetosym{ $keyboard[$i][$modifier] } }
  464                         = $keyboard_stringlike_modifiers{$modifier}
  465                         . ( $i + $min );
  466                 }
  467             }
  468             else {
  469 
  470                 # we didn't get the code from X11::Keysyms
  471                 if ( defined( $keyboard[$i][$modifier] )
  472                     && $keyboard[$i][$modifier] != 0 )
  473                 {
  474 
  475                     # ignore code=0
  476                     $self->debug(
  477                         2,
  478                         "Unknown keycode ",
  479                         $keyboard[$i][$modifier]
  480                     );
  481                 }
  482             }
  483         }
  484     }
  485 
  486     # don't know these two key combs yet...
  487     #$keyboardmap{ $keycodetosym { $keyboard[$_][4] } } = $_ + $min;
  488     #$keyboardmap{ $keycodetosym { $keyboard[$_][5] } } = $_ + $min;
  489 
  490     #print "$_ => $keyboardmap{$_}\n" foreach(sort(keys(%keyboardmap)));
  491     #print "keysymtocode: $keysymtocode{o}\n";
  492     #die;
  493 }
  494 
  495 sub get_keycode_state($) {
  496     my ( $self, $keysym ) = @_;
  497     $keyboardmap{$keysym} =~ m/^(\D+)(\d+)$/;
  498     my ( $state, $code ) = ( $1, $2 );
  499 
  500     $self->debug( 2, "keyboardmap=:", $keyboardmap{$keysym}, ":" );
  501     $self->debug( 2, "state=$state, code=$code" );
  502 
  503 SWITCH: for ($state) {
  504         /^n$/ && do {
  505             $state = 0;
  506             last SWITCH;
  507         };
  508         /^s$/ && do {
  509             $state = Shift();
  510             last SWITCH;
  511         };
  512         /^a$/ && do {
  513             $state = Mod5();
  514             last SWITCH;
  515         };
  516         /^sa$/ && do {
  517             $state = Shift() + Mod5();
  518             last SWITCH;
  519         };
  520 
  521         die("Should never reach here");
  522     }
  523 
  524     $self->debug( 2, "returning state=:$state: code=:$code:" );
  525 
  526     return ( $state, $code );
  527 }
  528 
  529 sub change_main_window_title() {
  530     my ($self) = @_;
  531     my $number = keys(%servers);
  532     $windows{main_window}->title( $self->config->{title} . " [$number]" );
  533 }
  534 
  535 sub show_history() {
  536     my ($self) = @_;
  537     if ( $self->config->{show_history} ) {
  538         $windows{history}->packForget();
  539         $windows{history}->selectAll();
  540         $windows{history}->deleteSelected();
  541         $self->config->{show_history} = 0;
  542     }
  543     else {
  544         $windows{history}->pack(
  545             -fill   => "x",
  546             -expand => 1,
  547         );
  548         $self->config->{show_history} = 1;
  549     }
  550 }
  551 
  552 sub update_display_text($) {
  553     my ( $self, $char ) = @_;
  554 
  555     return if ( !$self->config->{show_history} );
  556 
  557     $self->debug( 2, "Dropping :$char: into display" );
  558 
  559 SWITCH: {
  560         foreach ($char) {
  561             /^Return$/ && do {
  562                 $windows{history}->insert( 'end', "\n" );
  563                 last SWITCH;
  564             };
  565 
  566             /^BackSpace$/ && do {
  567                 $windows{history}->delete('end - 2 chars');
  568                 last SWITCH;
  569             };
  570 
  571             /^(:?Shift|Control|Alt)_(:?R|L)$/ && do {
  572                 last SWITCH;
  573             };
  574 
  575             length($char) > 1 && do {
  576                 $windows{history}
  577                     ->insert( 'end', chr( $keysymtocode{$char} ) )
  578                     if ( $keysymtocode{$char} );
  579                 last SWITCH;
  580             };
  581 
  582             do {
  583                 $windows{history}->insert( 'end', $char );
  584                 last SWITCH;
  585             };
  586         }
  587     }
  588     return $self;
  589 }
  590 
  591 sub substitute_macros {
  592     my ( $self, $svr, $text ) = @_;
  593 
  594     return $text unless ( $self->config->{macros_enabled} eq 'yes' );
  595 
  596     {
  597         my $macro_servername = $self->config->{macro_servername};
  598         ( my $servername = $svr ) =~ s/\s+//;
  599         $text =~ s!$macro_servername!$servername!xsmg;
  600         $ENV{CSSH_SERVERNAME} = $servername;
  601     }
  602     {
  603         my $macro_hostname = $self->config->{macro_hostname};
  604         my $hostname       = hostfqdn();
  605         $text =~ s!$macro_hostname!$hostname!xsmg;
  606         $ENV{CSSH_HOSTNAME} = $hostname;
  607     }
  608     {
  609         my $macro_username = $self->config->{macro_username};
  610         my $username       = $servers{$svr}{username};
  611         $username ||= getpwuid($UID);
  612         $text =~ s!$macro_username!$username!xsmg;
  613         $ENV{CSSH_USERNAME} = $username;
  614     }
  615     {
  616         my $macro_newline = $self->config->{macro_newline};
  617         $text =~ s!$macro_newline!\n!xsmg;
  618     }
  619     {
  620         my $macro_version = $self->config->{macro_version};
  621         my $version       = $self->parent->VERSION;
  622         $text =~ s/$macro_version/$version/xsmg;
  623         $ENV{CSSH_VERSION} = $version;
  624     }
  625 
  626     $ENV{CSSH_CONNECTION_STRING} = $servers{$svr}{connect_string};
  627     $ENV{CSSH_CONNECTION_PORT}   = $servers{$svr}{port};
  628 
  629     # Set up environment variables in the macro environment
  630     for my $i (qw/ 1 2 3 4 / ) {
  631         my $macro_user_command = 'macro_user_'.$i.'_command';
  632         my $macro_user = $self->config->{'macro_user_'.$i};
  633 
  634         next unless $text =~ $macro_user;
  635         if( ! $self->config->{ $macro_user_command } ) {
  636             $text =~ s/$macro_user//xsmg;
  637             next;
  638         }
  639 
  640         my $cmd = $self->config->{ $macro_user_command };
  641 
  642         local $SIG{CHLD} = undef;
  643 
  644         my $stderr_fh = gensym;
  645         my $stdout_fh = gensym;
  646         my $child_pid = eval { open3(undef, $stdout_fh, $stderr_fh, $cmd) };
  647 
  648         if (my $err=$@) {
  649             # error message is hardcoded into open3 - tidy it up a little for our users
  650             $err=~ s/ at .*//;
  651             $err=~ s/open3: //;
  652             $err =~ s/( failed)/' $1/;
  653             $err =~ s/(exec of) /$1 '/;
  654             warn "Macro failure for '$macro_user_command': $err";
  655             next;
  656         }
  657         waitpid($child_pid, 0);
  658         my $cmd_rc = $? >> 8;
  659 
  660         my @stdout = <$stdout_fh>;
  661         my @stderr = <$stderr_fh>;
  662 
  663         if ( $cmd_rc > 0 || @stderr ){
  664             warn "Macro failure for '$macro_user_command'",$/;
  665             warn "Exited with error output:: @stderr" if @stderr;
  666             warn "Exited with non-zero return code: $cmd_rc", $/ if $cmd_rc;
  667         } else {
  668             #$self->send_text_to_all_servers( $stdout );
  669             return join('', @stdout);
  670         }
  671     }
  672 
  673     return $text;
  674 }
  675 
  676 sub send_text($@) {
  677     my $self = shift;
  678     my $svr  = shift;
  679     my $text = join( "", @_ );
  680 
  681     $self->debug( 2, "servers{$svr}{wid}=$servers{$svr}{wid}" );
  682     $self->debug( 3, "Sending to '$svr' text:$text:" );
  683 
  684     $text = $self->substitute_macros( $svr, $text );
  685 
  686     foreach my $char ( split( //, $text ) ) {
  687         next if ( !defined($char) );
  688         my $ord = ord($char);
  689         $ord = 65293 if ( $ord == 10 );    # convert 'Return' to sym
  690 
  691         if ( !defined( $keycodetosym{$ord} ) ) {
  692             warn("Unknown character in xmodmap keytable: $char ($ord)\n");
  693             next;
  694         }
  695         my $keysym  = $keycodetosym{$ord};
  696         my $keycode = $keysymtocode{$keysym};
  697 
  698         $self->debug( 2, "Looking for char :$char: with ord :$ord:" );
  699         $self->debug( 2, "Looking for keycode :$keycode:" );
  700         $self->debug( 2, "Looking for keysym  :$keysym:" );
  701         $self->debug( 2, "Looking for keyboardmap :",
  702             $keyboardmap{$keysym}, ":" );
  703         my ( $state, $code ) = $self->get_keycode_state($keysym);
  704         $self->debug( 2, "Got state :$state: code :$code:" );
  705 
  706         for my $event (qw/KeyPress KeyRelease/) {
  707             $self->debug( 2,
  708                 "sending event=$event code=:$code: state=:$state:" );
  709             $xdisplay->SendEvent(
  710                 $servers{$svr}{wid},
  711                 0,
  712                 $xdisplay->pack_event_mask($event),
  713                 $xdisplay->pack_event(
  714                     'name'        => $event,
  715                     'detail'      => $code,
  716                     'state'       => $state,
  717                     'event'       => $servers{$svr}{wid},
  718                     'root'        => $xdisplay->root(),
  719                     'same_screen' => 1,
  720                 ),
  721             );
  722         }
  723     }
  724     $xdisplay->flush();
  725 }
  726 
  727 sub send_resizemove($$$$$) {
  728     my ( $self, $win, $x_pos, $y_pos, $x_siz, $y_siz ) = @_;
  729 
  730     $self->debug( 3,
  731         "Moving window $win to x:$x_pos y:$y_pos (size x:$x_siz y:$y_siz)" );
  732 
  733 #$self->debug( 2, "resize move normal: ", $xdisplay->atom('WM_NORMAL_HINTS') );
  734 #$self->debug( 2, "resize move size:   ", $xdisplay->atom('WM_SIZE_HINTS') );
  735 
  736     # set the window to have "user" set size & position, rather than "program"
  737     $xdisplay->req(
  738         'ChangeProperty',
  739         $win,
  740         $xdisplay->atom('WM_NORMAL_HINTS'),
  741         $xdisplay->atom('WM_SIZE_HINTS'),
  742         32,
  743         'Replace',
  744 
  745         # create data struct on-the-fly to set bitwise flags
  746         pack( 'LLLLL' . 'x[L]' x 12, 1 | 2, $x_pos, $y_pos, $x_siz, $y_siz ),
  747     );
  748 
  749     $xdisplay->req(
  750         'ConfigureWindow',
  751         $win,
  752         'x'      => $x_pos,
  753         'y'      => $y_pos,
  754         'width'  => $x_siz,
  755         'height' => $y_siz,
  756     );
  757 
  758     #$xdisplay->flush(); # dont flush here, but after all tiling worked out
  759 }
  760 
  761 sub get_font_size() {
  762     my ($self) = @_;
  763     $self->debug( 2, "Fetching font size" );
  764 
  765     # get atom name<->number relations
  766     my $quad_width = $xdisplay->atom("QUAD_WIDTH");
  767     my $pixel_size = $xdisplay->atom("PIXEL_SIZE");
  768 
  769     my $font          = $xdisplay->new_rsrc;
  770     my $terminal_font = $self->config->{terminal_font};
  771     $xdisplay->OpenFont( $font, $terminal_font );
  772 
  773     my %font_info;
  774 
  775     eval { (%font_info) = $xdisplay->QueryFont($font); }
  776         || die( "Fatal: Unrecognised font used ($terminal_font).\n"
  777             . "Please amend \$HOME/.clusterssh/config with a valid font (see man page).\n"
  778         );
  779 
  780     $self->config->{internal_font_width}
  781         = $font_info{properties}{$quad_width};
  782     $self->config->{internal_font_height}
  783         = $font_info{properties}{$pixel_size};
  784 
  785     if (   !$self->config->{internal_font_width}
  786         || !$self->config->{internal_font_height} )
  787     {
  788         die(      "Fatal: Unrecognised font used ($terminal_font).\n"
  789                 . "Please amend \$HOME/.clusterssh/config with a valid font (see man page).\n"
  790         );
  791     }
  792 
  793     $self->debug( 2, "Done with font size" );
  794     return $self;
  795 }
  796 
  797 sub show_console() {
  798     my ($self) = shift;
  799     $self->debug( 2, "Sending console to front" );
  800 
  801     $self->config->{internal_previous_state} = "mid-change";
  802 
  803     # fudge the counter to drop a redraw event;
  804     $self->config->{internal_map_count} -= 4;
  805 
  806     $xdisplay->flush();
  807     $windows{main_window}->update();
  808 
  809     select( undef, undef, undef, 0.2 );    #sleep for a mo
  810     $windows{main_window}->withdraw
  811         if $windows{main_window}->state ne "withdrawn";
  812 
  813     # Sleep for a moment to give WM time to bring console back
  814     select( undef, undef, undef, 0.5 );
  815 
  816     if ( $self->config->{menu_send_autotearoff} ) {
  817         $menus{send}->menu->tearOffMenu()->raise;
  818     }
  819 
  820     if ( $self->config->{menu_host_autotearoff} ) {
  821         $menus{hosts}->menu->tearOffMenu()->raise;
  822     }
  823 
  824     $windows{main_window}->deiconify;
  825     $windows{main_window}->raise;
  826     $windows{main_window}->focus( -force );
  827     $windows{text_entry}->focus( -force );
  828 
  829     $self->config->{internal_previous_state} = "normal";
  830 
  831     # fvwm seems to need this (Debian #329440)
  832     $windows{main_window}->MapWindow;
  833 
  834     return $self;
  835 }
  836 
  837 # leave function def open here so we can be flexible in how it's called
  838 sub retile_hosts {
  839     my ( $self, $force ) = @_;
  840     $force ||= "";
  841     $self->debug( 2, "Retiling windows" );
  842 
  843     my %config;
  844 
  845     if ( $self->config->{window_tiling} ne "yes" && !$force ) {
  846         $self->debug( 3,
  847             "Not meant to be tiling; just reshow windows as they were" );
  848 
  849         foreach my $server ( reverse( keys(%servers) ) ) {
  850             $xdisplay->req( 'MapWindow', $servers{$server}{wid} );
  851         }
  852         $xdisplay->flush();
  853         $self->show_console();
  854         return;
  855     }
  856 
  857     # ALL SIZES SHOULD BE IN PIXELS for consistency
  858 
  859     $self->debug( 2, "Count is currently ", $self->config->{internal_total} );
  860 
  861     if ( $self->config->{internal_total} == 0 ) {
  862 
  863         # If nothing to tile, don't bother doing anything, just show console
  864         return $self->show_console();
  865     }
  866 
  867     # work out terminal pixel size from terminal size & font size
  868     # does not include any title bars or scroll bars - purely text area
  869     $self->config->{internal_terminal_cols}
  870         = ( $self->config->{terminal_size} =~ /(\d+)x.*/ )[0];
  871     $self->config->{internal_terminal_width}
  872         = (   $self->config->{internal_terminal_cols}
  873             * $self->config->{internal_font_width} )
  874         + $self->config->{terminal_decoration_width};
  875 
  876     $self->config->{internal_terminal_rows}
  877         = ( $self->config->{terminal_size} =~ /.*x(\d+)/ )[0];
  878     $self->config->{internal_terminal_height}
  879         = (   $self->config->{internal_terminal_rows}
  880             * $self->config->{internal_font_height} )
  881         + $self->config->{terminal_decoration_height};
  882 
  883     # fetch screen size
  884     $self->config->{internal_screen_height} = $xdisplay->{height_in_pixels};
  885     $self->config->{internal_screen_width}  = $xdisplay->{width_in_pixels};
  886 
  887     # Now, work out how many columns of terminals we can fit on screen
  888     if ( $self->config->{rows} != -1 || $self->config->{cols} != -1 ) {
  889         if ( $self->config->{rows} != -1 ) {
  890             $self->config->{internal_rows}    = $self->config->{rows};
  891             $self->config->{internal_columns} = int(
  892                 (         $self->config->{internal_total}
  893                         / $self->config->{internal_rows}
  894                 ) + 0.999
  895             );
  896         }
  897         else {
  898             $self->config->{internal_columns} = $self->config->{cols};
  899             $self->config->{internal_rows}    = int(
  900                 (         $self->config->{internal_total}
  901                         / $self->config->{internal_columns}
  902                 ) + 0.999
  903             );
  904         }
  905     }
  906     else {
  907         $self->config->{internal_columns} = int(
  908             (         $self->config->{internal_screen_width}
  909                     - $self->config->{screen_reserve_left}
  910                     - $self->config->{screen_reserve_right}
  911             ) / (
  912                 $self->config->{internal_terminal_width}
  913                     + $self->config->{terminal_reserve_left}
  914                     + $self->config->{terminal_reserve_right}
  915             )
  916         );
  917 
  918       # Work out the number of rows we need to use to fit everything on screen
  919         $self->config->{internal_rows} = int(
  920             (         $self->config->{internal_total}
  921                     / $self->config->{internal_columns}
  922             ) + 0.999
  923         );
  924     }
  925     $self->debug( 2, "Screen Columns: ", $self->config->{internal_columns} );
  926     $self->debug( 2, "Screen Rows: ",    $self->config->{internal_rows} );
  927     $self->debug( 2, "Fill scree: ",     $self->config->{fillscreen} );
  928 
  929     # Now adjust the height of the terminal to either the max given,
  930     # or to get everything on screen
  931     if ( $self->config->{fillscreen} ne 'yes' ) {
  932         my $height = int(
  933             (   (         $self->config->{internal_screen_height}
  934                         - $self->config->{screen_reserve_top}
  935                         - $self->config->{screen_reserve_bottom}
  936                 ) - (
  937                     $self->config->{internal_rows} * (
  938                               $self->config->{terminal_reserve_top}
  939                             + $self->config->{terminal_reserve_bottom}
  940                     )
  941                 )
  942             ) / $self->config->{internal_rows}
  943         );
  944         $self->config->{internal_terminal_height} = (
  945               $height > $self->config->{internal_terminal_height}
  946             ? $self->config->{internal_terminal_height}
  947             : $height
  948         );
  949     }
  950     else {
  951         $self->config->{internal_terminal_height} = int(
  952             (   (         $self->config->{internal_screen_height}
  953                         - $self->config->{screen_reserve_top}
  954                         - $self->config->{screen_reserve_bottom}
  955                 ) - (
  956                     $self->config->{internal_rows} * (
  957                               $self->config->{terminal_reserve_top}
  958                             + $self->config->{terminal_reserve_bottom}
  959                     )
  960                 )
  961             ) / $self->config->{internal_rows}
  962         );
  963         $self->config->{internal_terminal_width} = int(
  964             (   (         $self->config->{internal_screen_width}
  965                         - $self->config->{screen_reserve_left}
  966                         - $self->config->{screen_reserve_right}
  967                 ) - (
  968                     $self->config->{internal_columns} * (
  969                               $self->config->{terminal_reserve_left}
  970                             + $self->config->{terminal_reserve_right}
  971                     )
  972                 )
  973             ) / $self->config->{internal_columns}
  974         );
  975     }
  976     $self->debug( 2, "Terminal h: ",
  977         $self->config->{internal_terminal_height},
  978         ", w: ", $self->config->{internal_terminal_width} );
  979 
  980     $self->config->dump("noexit") if ( $self->options->debug_level > 1 );
  981 
  982     # now find the size of the window decorations
  983     if ( !exists( $self->config->{internal_terminal_wm_decoration_left} ) ) {
  984 
  985    # Debian #842965 (https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=842965)
  986    # disable behavior added in https://github.com/duncs/clusterssh/pull/66
  987    # unless explicitly enabled with auto_wm_decoration_offsets => yes
  988 
  989         if ( $self->config->{auto_wm_decoration_offsets} =~ /yes/i ) {
  990 
  991             # use the first window as exemplary
  992             my ($wid) = $servers{ ( keys(%servers) )[0] }{wid};
  993 
  994             if ( defined($wid) ) {
  995 
  996                 # get the WM decoration sizes
  997                 (   $self->config->{internal_terminal_wm_decoration_left},
  998                     $self->config->{internal_terminal_wm_decoration_right},
  999                     $self->config->{internal_terminal_wm_decoration_top},
 1000                     $self->config->{internal_terminal_wm_decoration_bottom}
 1001                     )
 1002                     = X11::Protocol::WM::get_net_frame_extents( $xdisplay,
 1003                     $wid );
 1004             }
 1005         }
 1006 
 1007         # in case the WM call failed we set some defaults
 1008         for my $v (
 1009             qw/ internal_terminal_wm_decoration_left internal_terminal_wm_decoration_right internal_terminal_wm_decoration_top internal_terminal_wm_decoration_bottom /
 1010             )
 1011         {
 1012             $self->config->{$v} = 0 if ( !defined $self->config->{$v} );
 1013         }
 1014     }
 1015 
 1016     # now we have the info, plot first window position
 1017     my @hosts;
 1018     my ( $current_x, $current_y, $current_row, $current_col ) = 0;
 1019     if ( $self->config->{window_tiling_direction} =~ /right/i ) {
 1020         $self->debug( 2, "Tiling top left going bot right" );
 1021         @hosts     = $self->sort->( keys(%servers) );
 1022         $current_x = $self->config->{screen_reserve_left}
 1023             + $self->config->{terminal_reserve_left};
 1024         $current_y = $self->config->{screen_reserve_top}
 1025             + $self->config->{terminal_reserve_top};
 1026         $current_row = 0;
 1027         $current_col = 0;
 1028     }
 1029     else {
 1030         $self->debug( 2, "Tiling bot right going top left" );
 1031         @hosts = reverse( $self->sort->( keys(%servers) ) );
 1032         $current_x
 1033             = $self->config->{screen_reserve_right}
 1034             - $self->config->{internal_screen_width}
 1035             - $self->config->{terminal_reserve_right}
 1036             - $self->config->{internal_terminal_width};
 1037         $current_y
 1038             = $self->config->{screen_reserve_bottom}
 1039             - $self->config->{internal_screen_height}
 1040             - $self->config->{terminal_reserve_bottom}
 1041             - $self->config->{internal_terminal_height};
 1042 
 1043         $current_row = $self->config->{internal_rows} - 1;
 1044         $current_col = $self->config->{internal_columns} - 1;
 1045     }
 1046 
 1047     # Unmap windows (hide them)
 1048     # Move windows to new locatation
 1049     # Remap all windows in correct order
 1050     foreach my $server (@hosts) {
 1051         $self->debug( 3,
 1052             "x:$current_x y:$current_y, r:$current_row c:$current_col" );
 1053 
 1054         # sf tracker 3061999
 1055         # $xdisplay->req( 'UnmapWindow', $servers{$server}{wid} );
 1056 
 1057         if ( $self->config->{unmap_on_redraw} =~ /yes/i ) {
 1058             $xdisplay->req( 'UnmapWindow', $servers{$server}{wid} );
 1059         }
 1060 
 1061         $self->debug( 2, "Moving $server window" );
 1062         $self->send_resizemove(
 1063             $servers{$server}{wid},
 1064             $current_x,
 1065             $current_y,
 1066             $self->config->{internal_terminal_width},
 1067             $self->config->{internal_terminal_height}
 1068         );
 1069 
 1070         $xdisplay->flush();
 1071         select( undef, undef, undef, 0.1 );    # sleep for a moment for the WM
 1072 
 1073         if ( $self->config->{window_tiling_direction} =~ /right/i ) {
 1074 
 1075             # starting top left, and move right and down
 1076             $current_x
 1077                 += $self->config->{terminal_reserve_left}
 1078                 + $self->config->{terminal_reserve_right}
 1079                 + $self->config->{internal_terminal_width}
 1080                 + $self->config->{internal_terminal_wm_decoration_left}
 1081                 + $self->config->{internal_terminal_wm_decoration_right};
 1082 
 1083             $current_col += 1;
 1084             if ( $current_col == $self->config->{internal_columns} ) {
 1085                 $current_y
 1086                     += $self->config->{terminal_reserve_top}
 1087                     + $self->config->{terminal_reserve_bottom}
 1088                     + $self->config->{internal_terminal_height}
 1089                     + $self->config->{internal_terminal_wm_decoration_top}
 1090                     + $self->config->{internal_terminal_wm_decoration_bottom};
 1091                 $current_x = $self->config->{screen_reserve_left}
 1092                     + $self->config->{terminal_reserve_left};
 1093                 $current_row++;
 1094                 $current_col = 0;
 1095             }
 1096         }
 1097         else {
 1098 
 1099             # starting bottom right, and move left and up
 1100 
 1101             $current_col -= 1;
 1102             if ( $current_col < 0 ) {
 1103                 $current_row--;
 1104                 $current_col = $self->config->{internal_columns};
 1105             }
 1106         }
 1107     }
 1108 
 1109     # Now remap in right order to get overlaps correct
 1110     if ( $self->config->{window_tiling_direction} =~ /right/i ) {
 1111         foreach my $server ( reverse(@hosts) ) {
 1112             $self->debug( 2, "Setting focus on $server" );
 1113             $xdisplay->req( 'MapWindow', $servers{$server}{wid} );
 1114 
 1115             # flush every time and wait a moment (The WMs are so slow...)
 1116             $xdisplay->flush();
 1117             select( undef, undef, undef, 0.1 );    # sleep for a mo
 1118         }
 1119     }
 1120     else {
 1121         foreach my $server (@hosts) {
 1122             $self->debug( 2, "Setting focus on $server" );
 1123             $xdisplay->req( 'MapWindow', $servers{$server}{wid} );
 1124 
 1125             # flush every time and wait a moment (The WMs are so slow...)
 1126             $xdisplay->flush();
 1127             select( undef, undef, undef, 0.1 );    # sleep for a mo
 1128         }
 1129     }
 1130 
 1131     # and as a last item, set focus back onto the console
 1132     return $self->show_console();
 1133 }
 1134 
 1135 sub build_hosts_menu() {
 1136     my ($self) = @_;
 1137 
 1138     return if ( $self->config->{hide_menu} );
 1139 
 1140     $self->debug( 2, "Building hosts menu" );
 1141 
 1142     # first, empty the hosts menu from the last static entry + 1 on
 1143     my $menu = $menus{bar}->entrycget( 'Hosts', -menu );
 1144     $menu->delete( $host_menu_static_items, 'end' );
 1145 
 1146     $self->debug( 3, "Menu deleted" );
 1147 
 1148     # add back the separator
 1149     $menus{hosts}->separator;
 1150 
 1151     $self->debug( 3, "Parsing list" );
 1152 
 1153     my $menu_item_counter = $host_menu_static_items;
 1154     foreach my $svr ( $self->sort->( keys(%servers) ) ) {
 1155         $self->debug( 3, "Checking $svr and restoring active value" );
 1156         my $colbreak = 0;
 1157         if ( $menu_item_counter > $self->config->{max_host_menu_items} ) {
 1158             $colbreak          = 1;
 1159             $menu_item_counter = 1;
 1160         }
 1161         $menus{hosts}->checkbutton(
 1162             -label       => $svr,
 1163             -variable    => \$servers{$svr}{active},
 1164             -columnbreak => $colbreak,
 1165         );
 1166         $menu_item_counter++;
 1167     }
 1168     $self->debug( 3, "Changing window title" );
 1169     $self->change_main_window_title();
 1170     $self->debug( 2, "Done" );
 1171 }
 1172 
 1173 sub setup_repeat() {
 1174     my ($self) = @_;
 1175     $self->config->{internal_count} = 0;
 1176 
 1177     # if this is too fast then we end up with queued invocations
 1178     # with no time to run anything else
 1179     $windows{main_window}->repeat(
 1180         500,
 1181         sub {
 1182             $self->config->{internal_count} = 0
 1183                 if ( $self->config->{internal_count} > 60000 )
 1184                 ;    # reset if too high
 1185             $self->config->{internal_count}++;
 1186             my $build_menu = 0;
 1187             $self->debug(
 1188                 5,
 1189                 "Running repeat;count=",
 1190                 $self->config->{internal_count}
 1191             );
 1192 
 1193             # See if there are any commands in the external command pipe
 1194             if ( defined $self->{external_command_pipe_fh} ) {
 1195                 my $ext_cmd;
 1196                 sysread( $self->{external_command_pipe_fh}, $ext_cmd, 400 );
 1197                 if ($ext_cmd) {
 1198                     my @external_commands = split( /\n/, $ext_cmd );
 1199                     for my $cmd_line (@external_commands) {
 1200                         chomp($cmd_line);
 1201                         my ( $cmd, @tags ) = split /\s+/, $cmd_line;
 1202                         $self->debug( 2,
 1203                             "Got external command: $cmd -> @tags" );
 1204 
 1205                         for ($cmd) {
 1206                             if (m/^open$/) {
 1207                                 my @new_hosts = $self->parent->resolve_names(@tags);
 1208                                 $self->open_client_windows(@new_hosts);
 1209                                 $self->build_hosts_menu();
 1210                                 last;
 1211                             }
 1212                             if (m/^retile$/) {
 1213                                 $self->retile_hosts();
 1214                                 last;
 1215                             }
 1216                             warn "Unknown external command: $cmd_line", $/;
 1217                         }
 1218                     }
 1219                 }
 1220             }
 1221 
 1222 #$self->debug( 3, "Number of servers in hash is: ", scalar( keys(%servers) ) );
 1223 
 1224             foreach my $svr ( keys(%servers) ) {
 1225                 if ( defined( $servers{$svr}{pid} ) ) {
 1226                     if ( !kill( 0, $servers{$svr}{pid} ) ) {
 1227                         $build_menu = 1;
 1228                         push( @dead_hosts, $servers{$svr}{connect_string} );
 1229                         delete( $servers{$svr} );
 1230                         $self->debug( 0, "$svr session closed" );
 1231                     }
 1232                 }
 1233                 else {
 1234                     warn("Lost pid of $svr; deleting\n");
 1235                     delete( $servers{$svr} );
 1236                 }
 1237             }
 1238 
 1239             # get current number of clients
 1240             $self->config->{internal_total} = int( keys(%servers) );
 1241 
 1242         #$self->debug( 3, "Number after tidy is: ", $config{internal_total} );
 1243 
 1244             # get current number of clients
 1245             $self->config->{internal_total} = int( keys(%servers) );
 1246 
 1247         #$self->debug( 3, "Number after tidy is: ", $config{internal_total} );
 1248 
 1249             # If there are no hosts in the list and we are set to autoquit
 1250             if (   $self->config->{internal_total} == 0
 1251                 && $self->config->{auto_quit} =~ /yes/i )
 1252             {
 1253 
 1254                 # and some clients were actually opened...
 1255                 if ( $self->config->{internal_activate_autoquit} ) {
 1256                     $self->debug( 2, "Autoquitting" );
 1257                     $self->parent->exit_prog;
 1258                 }
 1259             }
 1260 
 1261             # rebuild host menu if something has changed
 1262             $self->build_hosts_menu() if ($build_menu);
 1263 
 1264             # clean out text area, anyhow
 1265             $menus{entrytext} = "";
 1266 
 1267             #$self->debug( 3, "repeat completed" );
 1268         }
 1269     );
 1270     $self->debug( 2, "Repeat setup" );
 1271 
 1272     return $self;
 1273 }
 1274 
 1275 ### Window and menu definitions ###
 1276 
 1277 sub create_windows() {
 1278     my ($self) = @_;
 1279     $self->debug( 2, "create_windows: started" );
 1280 
 1281     $windows{main_window}
 1282         = MainWindow->new( -title => "ClusterSSH", -class => 'cssh', );
 1283     $windows{main_window}->withdraw;    # leave withdrawn until needed
 1284 
 1285     if ( defined( $self->config->{console_position} )
 1286         && $self->config->{console_position} =~ /[+-]\d+[+-]\d+/ )
 1287     {
 1288         $windows{main_window}->geometry( $self->config->{console_position} );
 1289     }
 1290 
 1291     $menus{entrytext}    = "";
 1292     $windows{text_entry} = $windows{main_window}->Entry(
 1293         -textvariable      => \$menus{entrytext},
 1294         -insertborderwidth => 4,
 1295         -width             => 25,
 1296         -class             => 'cssh',
 1297     )->pack(
 1298         -fill   => "x",
 1299         -expand => 1,
 1300     );
 1301 
 1302     $windows{history} = $windows{main_window}->Scrolled(
 1303         "ROText",
 1304         -insertborderwidth => 4,
 1305         -width             => $self->config->{history_width},
 1306         -height            => $self->config->{history_height},
 1307         -state             => 'normal',
 1308         -takefocus         => 0,
 1309         -class             => 'cssh',
 1310     );
 1311     $windows{history}->bindtags(undef);
 1312 
 1313     if ( $self->config->{show_history} ) {
 1314         $windows{history}->pack(
 1315             -fill   => "x",
 1316             -expand => 1,
 1317         );
 1318     }
 1319 
 1320     $windows{main_window}
 1321         ->bind( '<Destroy>' => sub { $self->parent->exit_prog } );
 1322 
 1323     # remove all Paste events so we set them up cleanly
 1324     $windows{main_window}->eventDelete('<<Paste>>');
 1325 
 1326     # Set up paste events from scratch
 1327     if ( $self->config->{key_paste} && $self->config->{key_paste} ne "null" )
 1328     {
 1329         $windows{main_window}->eventAdd(
 1330             '<<Paste>>' => '<' . $self->config->{key_paste} . '>' );
 1331     }
 1332 
 1333     if (   $self->config->{mouse_paste}
 1334         && $self->config->{mouse_paste} ne "null" )
 1335     {
 1336         $windows{main_window}->eventAdd(
 1337             '<<Paste>>' => '<' . $self->config->{mouse_paste} . '>' );
 1338     }
 1339 
 1340     $windows{main_window}->bind(
 1341         '<<Paste>>' => sub {
 1342             $self->debug( 2, "PASTE EVENT" );
 1343 
 1344             $menus{entrytext} = "";
 1345             my $paste_text = '';
 1346 
 1347             # SelectionGet is fatal if no selection is given
 1348             Tk::catch {
 1349                 $paste_text = $windows{main_window}->SelectionGet;
 1350             };
 1351 
 1352             if ( !length($paste_text) ) {
 1353                 warn("Got empty paste event\n");
 1354                 return;
 1355             }
 1356 
 1357             $self->debug( 2, "Got text :", $paste_text, ":" );
 1358 
 1359             $self->update_display_text($paste_text);
 1360 
 1361             # now sent it on
 1362             foreach my $svr ( keys(%servers) ) {
 1363                 $self->send_text( $svr, $paste_text )
 1364                     if ( $servers{$svr}{active} == 1 );
 1365             }
 1366         }
 1367     );
 1368 
 1369     $windows{help} = $windows{main_window}->DialogBox(
 1370         -popover    => $windows{main_window},
 1371         -overanchor => "c",
 1372         -popanchor  => "c",
 1373         -class      => 'cssh',
 1374         -title      => 'About Cssh',
 1375     );
 1376 
 1377     my @helptext = (
 1378         "Title:   Cluster Administrator Console using SSH",
 1379         "Version: " . $App::ClusterSSH::VERSION,
 1380         "Project: https://github.com/duncs/clusterssh",
 1381         "Issues:  https://github.com/duncs/clusterssh/issues",
 1382     );
 1383 
 1384     $windows{helptext} = $windows{help}->Text(
 1385         -height => scalar(@helptext),
 1386         -width  => 62,
 1387     )->pack( -fill => 'both' );
 1388     $windows{helptext}->insert( 'end', join( $/, @helptext ) );
 1389     $windows{helptext}->configure( -state => 'disabled' );
 1390 
 1391     $windows{manpage} = $windows{main_window}->DialogBox(
 1392         -popanchor  => "c",
 1393         -overanchor => "c",
 1394         -title      => "Cssh Documentation",
 1395         -buttons    => ['Close'],
 1396         -class      => 'cssh',
 1397     );
 1398 
 1399     my $manpage = `pod2text -l -q=\"\" $0 2>/dev/null`;
 1400     if ( !$manpage ) {
 1401         $manpage
 1402             = "Help is missing.\nSee that command 'pod2text' is installed and in PATH.";
 1403     }
 1404     $windows{mantext}
 1405         = $windows{manpage}->Scrolled( "Text", )->pack( -fill => 'both' );
 1406     $windows{mantext}->insert( 'end', $manpage );
 1407     $windows{mantext}->configure( -state => 'disabled' );
 1408 
 1409     $windows{addhost} = $windows{main_window}->DialogBox(
 1410         -popover        => $windows{main_window},
 1411         -popanchor      => 'n',
 1412         -title          => "Add Host(s) or Cluster(s)",
 1413         -buttons        => [ 'Add', 'Cancel' ],
 1414         -default_button => 'Add',
 1415         -class          => 'cssh',
 1416     );
 1417 
 1418     my @tags = $self->{parent}->cluster->list_tags();
 1419     my @external_tags
 1420         = map {"$_ *"} $self->parent->cluster->list_external_clusters();
 1421     push( @tags, @external_tags );
 1422 
 1423     if ( $self->config->{max_addhost_menu_cluster_items}
 1424         && scalar @tags )
 1425     {
 1426         if ( scalar @tags < $self->config->{max_addhost_menu_cluster_items} )
 1427         {
 1428             $menus{listbox} = $windows{addhost}->Listbox(
 1429                 -selectmode => 'extended',
 1430                 -height     => scalar @tags,
 1431                 -class      => 'cssh',
 1432             )->pack();
 1433         }
 1434         else {
 1435             $menus{listbox} = $windows{addhost}->Scrolled(
 1436                 'Listbox',
 1437                 -scrollbars => 'e',
 1438                 -selectmode => 'extended',
 1439                 -height => $self->config->{max_addhost_menu_cluster_items},
 1440                 -class  => 'cssh',
 1441             )->pack();
 1442         }
 1443         $menus{listbox}->insert( 'end', sort @tags );
 1444 
 1445         if (@external_tags) {
 1446             $menus{addhost_text} = $windows{addhost}->add(
 1447                 'Label',
 1448                 -class => 'cssh',
 1449                 -text  => '* is external',
 1450             )->pack();
 1451 
 1452             #$menus{addhost_text}->insert('end','lkjh lkjj sdfl jklsj dflj ');
 1453         }
 1454     }
 1455 
 1456     $windows{host_entry} = $windows{addhost}->add(
 1457         'LabEntry',
 1458         -textvariable => \$menus{host_entry},
 1459         -width        => 20,
 1460         -label        => 'Host',
 1461         -labelPack    => [ -side => 'left', ],
 1462         -class        => 'cssh',
 1463     )->pack( -side => 'left' );
 1464     $self->debug( 2, "create_windows: completed" );
 1465 
 1466     return $self;
 1467 }
 1468 
 1469 sub capture_map_events() {
 1470     my ($self) = @_;
 1471 
 1472     # pick up on console minimise/maximise events so we can do all windows
 1473     $windows{main_window}->bind(
 1474         '<Map>' => sub {
 1475             $self->debug( 3, "Entering MAP" );
 1476 
 1477             my $state = $windows{main_window}->state();
 1478             $self->debug(
 1479                 3,
 1480                 "state=$state previous=",
 1481                 $self->config->{internal_previous_state}
 1482             );
 1483             $self->debug( 3, "Entering MAP" );
 1484 
 1485             if ( $self->config->{internal_previous_state} eq $state ) {
 1486                 $self->debug( 3, "repeating the same" );
 1487             }
 1488 
 1489             if ( $self->config->{internal_previous_state} eq "mid-change" ) {
 1490                 $self->debug( 3, "dropping out as mid-change" );
 1491                 return;
 1492             }
 1493 
 1494             $self->debug(
 1495                 3,
 1496                 "state=$state previous=",
 1497                 $self->config->{internal_previous_state}
 1498             );
 1499 
 1500             if ( $self->config->{internal_previous_state} eq "iconic" ) {
 1501                 $self->debug( 3, "running retile" );
 1502 
 1503                 $self->retile_hosts();
 1504 
 1505                 $self->debug( 3, "done with retile" );
 1506             }
 1507 
 1508             if ( $self->config->{internal_previous_state} ne $state ) {
 1509                 $self->debug( 3, "resetting prev_state" );
 1510                 $self->config->{internal_previous_state} = $state;
 1511             }
 1512         }
 1513     );
 1514 
 1515  #    $windows{main_window}->bind(
 1516  #        '<Unmap>' => sub {
 1517  #            $self->debug( 3, "Entering UNMAP" );
 1518  #
 1519  #            my $state = $windows{main_window}->state();
 1520  #            $self->debug( 3,
 1521  #                "state=$state previous=$config{internal_previous_state}" );
 1522  #
 1523  #            if ( $config{internal_previous_state} eq $state ) {
 1524  #                $self->debug( 3, "repeating the same" );
 1525  #            }
 1526  #
 1527  #            if ( $config{internal_previous_state} eq "mid-change" ) {
 1528  #                $self->debug( 3, "dropping out as mid-change" );
 1529  #                return;
 1530  #            }
 1531  #
 1532  #            if ( $config{internal_previous_state} eq "normal" ) {
 1533  #                $self->debug( 3, "withdrawing all windows" );
 1534  #                foreach my $server ( reverse( keys(%servers) ) ) {
 1535  #                    $xdisplay->req( 'UnmapWindow', $servers{$server}{wid} );
 1536  #                    if ( $config{unmap_on_redraw} =~ /yes/i ) {
 1537  #                        $xdisplay->req( 'UnmapWindow',
 1538  #                            $servers{$server}{wid} );
 1539  #                    }
 1540  #                }
 1541  #                $xdisplay->flush();
 1542  #            }
 1543  #
 1544  #            if ( $config{internal_previous_state} ne $state ) {
 1545  #                $self->debug( 3, "resetting prev_state" );
 1546  #                $config{internal_previous_state} = $state;
 1547  #            }
 1548  #        }
 1549  #    );
 1550 
 1551     return $self;
 1552 }
 1553 
 1554 # for all key event, event hotkeys so there is only 1 key binding
 1555 sub key_event {
 1556     my ($self)    = @_;
 1557     my $event     = $Tk::event->T;
 1558     my $keycode   = $Tk::event->k;
 1559     my $keysymdec = $Tk::event->N;
 1560     my $keysym    = $Tk::event->K;
 1561     my $state = $Tk::event->s || 0;
 1562 
 1563     $menus{entrytext} = "";
 1564 
 1565     $self->debug( 3, "=========" );
 1566     $self->debug( 3, "event    =$event" );
 1567     $self->debug( 3, "keysym   =$keysym (state=$state)" );
 1568     $self->debug( 3, "keysymdec=$keysymdec" );
 1569     $self->debug( 3, "keycode  =$keycode" );
 1570     $self->debug( 3, "state    =$state" );
 1571     $self->debug( 3, "codetosym=$keycodetosym{$keysymdec}" )
 1572         if ( $keycodetosym{$keysymdec} );
 1573     $self->debug( 3, "symtocode=$keysymtocode{$keysym}" );
 1574     $self->debug( 3, "keyboard =$keyboardmap{ $keysym }" )
 1575         if ( $keyboardmap{$keysym} );
 1576 
 1577     #warn("debug stop point here");
 1578     if ( $self->config->{use_hotkeys} eq "yes" ) {
 1579         my $combo = $Tk::event->s . $Tk::event->K;
 1580 
 1581         $combo =~ s/Mod\d-//;
 1582 
 1583         $self->debug( 3, "combo=$combo" );
 1584 
 1585         foreach my $hotkey ( grep( /key_/, keys( %{ $self->config } ) ) ) {
 1586             my $key = $self->config->{$hotkey};
 1587             next if ( $key eq "null" );    # ignore disabled keys
 1588 
 1589             $self->debug( 3, "key=:$key:" );
 1590             if ( $combo =~ /^$key$/ ) {
 1591                 $self->debug( 3, "matched combo" );
 1592                 if ( $event eq "KeyRelease" ) {
 1593                     $self->debug( 2, "Received hotkey: $hotkey" );
 1594                     $self->send_text_to_all_servers(
 1595                         $self->config->{macro_servername} )
 1596                         if ( $hotkey eq "key_clientname" );
 1597                     $self->send_text_to_all_servers(
 1598                         $self->config->{macro_hostname} )
 1599                         if ( $hotkey eq "key_localname" );
 1600                     $self->send_text_to_all_servers(
 1601                         $self->config->{macro_username} )
 1602                         if ( $hotkey eq "key_username" );
 1603                     $self->send_text_to_all_servers(
 1604                         $self->config->{macro_user_1} )
 1605                         if ( $hotkey eq "key_user_1" );
 1606                     $self->send_text_to_all_servers(
 1607                         $self->config->{macro_user_2} )
 1608                         if ( $hotkey eq "key_user_2" );
 1609                     $self->send_text_to_all_servers(
 1610                         $self->config->{macro_user_3} )
 1611                         if ( $hotkey eq "key_user_3" );
 1612                     $self->send_text_to_all_servers(
 1613                         $self->config->{macro_user_4} )
 1614                         if ( $hotkey eq "key_user_4" );
 1615                     $self->add_host_by_name()
 1616                         if ( $hotkey eq "key_addhost" );
 1617                     $self->retile_hosts("force")
 1618                         if ( $hotkey eq "key_retilehosts" );
 1619                     $self->show_history() if ( $hotkey eq "key_history" );
 1620                     $self->parent->exit_prog() if ( $hotkey eq "key_quit" );
 1621                 }
 1622                 return;
 1623             }
 1624         }
 1625     }
 1626 
 1627     # look for a <Control>-d and no hosts, so quit
 1628     $self->parent->exit_prog()
 1629         if ( $state =~ /Control/ && $keysym eq "d" and !%servers );
 1630 
 1631     $self->update_display_text( $keycodetosym{$keysymdec} )
 1632         if ( $event eq "KeyPress" && $keycodetosym{$keysymdec} );
 1633 
 1634     # for all servers
 1635     foreach ( keys(%servers) ) {
 1636 
 1637         # if active
 1638         if ( $servers{$_}{active} == 1 ) {
 1639             $self->debug( 3,
 1640                 "Sending event $event with code $keycode (state=$state) to window $servers{$_}{wid}"
 1641             );
 1642 
 1643             $xdisplay->SendEvent(
 1644                 $servers{$_}{wid},
 1645                 0,
 1646                 $xdisplay->pack_event_mask($event),
 1647                 $xdisplay->pack_event(
 1648                     'name'        => $event,
 1649                     'detail'      => $keycode,
 1650                     'state'       => $state,
 1651                     'event'       => $servers{$_}{wid},
 1652                     'root'        => $xdisplay->root(),
 1653                     'same_screen' => 1,
 1654                 )
 1655             ) || warn("Error returned from SendEvent: $!");
 1656         }
 1657     }
 1658     $xdisplay->flush();
 1659 
 1660     return $self;
 1661 }
 1662 
 1663 sub create_menubar() {
 1664     my ($self) = @_;
 1665     $self->debug( 2, "create_menubar: started" );
 1666     $menus{bar} = $windows{main_window}->Menu();
 1667 
 1668     $windows{main_window}->configure( -menu => $menus{bar}, )
 1669         unless $self->config->{hide_menu};
 1670 
 1671     $menus{file} = $menus{bar}->cascade(
 1672         -label     => 'File',
 1673         -menuitems => [
 1674             [   "command",
 1675                 "Show History",
 1676                 -command     => sub { $self->show_history; },
 1677                 -accelerator => $self->config->{key_history},
 1678             ],
 1679             [   "checkbutton",
 1680                 "Auto Quit",
 1681                 -variable => \$self->config->{auto_quit},
 1682                 -offvalue => 'no',
 1683                 -onvalue  => 'yes',
 1684             ],
 1685 
 1686            # While this autoclose menu works as expected, the functionality
 1687            # within terminals does not.  "auto_close" is set when the terminal
 1688            # is opened and is not updated when the variable is changed.
 1689            #
 1690            #    [   "cascade" => "Auto Close",
 1691            #        -menuitems => [
 1692            #            [   "radiobutton",
 1693            #                "Auto Close",
 1694            #                -variable    => \$self->config->{auto_close},
 1695            #                -label    => 'Off',
 1696            #                -value    => '0',
 1697            #            ],
 1698            #            [   "radiobutton",
 1699            #                "Auto Close",
 1700            #                -variable    => \$self->config->{auto_close},
 1701            #                -label    => '5 Seconds',
 1702            #                -value    => '5',
 1703            #            ],
 1704            #            [   "radiobutton",
 1705            #                "Auto Close",
 1706            #                -variable    => \$self->config->{auto_close},
 1707            #                -label    => '10 Seconds',
 1708            #                -value    => '10',
 1709            #            ],
 1710            #        ],
 1711            #    -tearoff => 0,
 1712            #    ],
 1713             [   "command",
 1714                 "Exit",
 1715                 -command     => sub { $self->parent->exit_prog },
 1716                 -accelerator => $self->config->{key_quit},
 1717             ]
 1718         ],
 1719         -tearoff => 0,
 1720     );
 1721 
 1722     my $host_menu_items = [
 1723         [   "command",
 1724             "Retile Windows",
 1725             -command     => sub { $self->retile_hosts },
 1726             -accelerator => $self->config->{key_retilehosts},
 1727         ],
 1728 
 1729 #         [ "command", "Capture Terminal",    -command => sub { $self->capture_terminal), ],
 1730         [   "command",
 1731             "Set all active",
 1732             -command => sub { $self->set_all_active() },
 1733         ],
 1734         [   "command",
 1735             "Set half inactive",
 1736             -command => sub { $self->set_half_inactive() },
 1737         ],
 1738         [   "command",
 1739             "Toggle active state",
 1740             -command => sub { $self->toggle_active_state() },
 1741         ],
 1742         [   "command",
 1743             "Close inactive sessions",
 1744             -command => sub { $self->close_inactive_sessions() },
 1745         ],
 1746         [   "command",
 1747             "Add Host(s) or Cluster(s)",
 1748             -command     => sub { $self->add_host_by_name, },
 1749             -accelerator => $self->config->{key_addhost},
 1750         ],
 1751         [   "command",
 1752             "Re-add closed session(s)",
 1753             -command => sub { $self->re_add_closed_sessions() },
 1754         ],
 1755         ''      # this is needed as build_host_menu always drops the
 1756                 # last item
 1757     ];
 1758 
 1759     $menus{hosts} = $menus{bar}->cascade(
 1760         -label     => 'Hosts',
 1761         -tearoff   => 1,
 1762         -menuitems => $host_menu_items
 1763     );
 1764 
 1765     $host_menu_static_items = scalar( @{$host_menu_items} );
 1766 
 1767     $menus{send} = $menus{bar}->cascade(
 1768         -label   => 'Send',
 1769         -tearoff => 1,
 1770     );
 1771 
 1772     $self->populate_send_menu();
 1773 
 1774     $menus{help} = $menus{bar}->cascade(
 1775         -label     => 'Help',
 1776         -menuitems => [
 1777             [ 'command', "About", -command => sub { $windows{help}->Show } ],
 1778             [   'command', "Documentation",
 1779                 -command => sub { $windows{manpage}->Show }
 1780             ],
 1781         ],
 1782         -tearoff => 0,
 1783     );
 1784 
 1785     $windows{main_window}->bind( '<KeyPress>' => [ $self => 'key_event' ], );
 1786     $windows{main_window}
 1787         ->bind( '<KeyRelease>' => [ $self => 'key_event' ], );
 1788     $self->debug( 2, "create_menubar: completed" );
 1789 }
 1790 
 1791 sub populate_send_menu_entries_from_xml {
 1792     my ( $self, $menu, $menu_xml ) = @_;
 1793 
 1794     foreach my $menu_ref ( @{ $menu_xml->{menu} } ) {
 1795         if ( $menu_ref->{menu} ) {
 1796             $menus{ $menu_ref->{title} }
 1797                 = $menu->cascade( -label => $menu_ref->{title}, );
 1798             $self->populate_send_menu_entries_from_xml(
 1799                 $menus{ $menu_ref->{title} }, $menu_ref, );
 1800             if ( $menu_ref->{detach} && $menu_ref->{detach} =~ m/y/i ) {
 1801                 $menus{ $menu_ref->{title} }->menu->tearOffMenu()->raise;
 1802             }
 1803         }
 1804         else {
 1805             my $accelerator = undef;
 1806             if ( $menu_ref->{accelerator} ) {
 1807                 $accelerator = $menu_ref->{accelerator};
 1808             }
 1809             if ( $menu_ref->{toggle} ) {
 1810                 $menus{send}->checkbutton(
 1811                     -label       => 'Use Macros',
 1812                     -variable    => \$self->config->{macros_enabled},
 1813                     -offvalue    => 'no',
 1814                     -onvalue     => 'yes',
 1815                     -accelerator => $accelerator,
 1816                 );
 1817             }
 1818             else {
 1819                 my $command = undef;
 1820                 if ( $menu_ref->{command} ) {
 1821                     $command = sub {
 1822                         $self->send_text_to_all_servers(
 1823                             $menu_ref->{command}[0] );
 1824                     };
 1825                 }
 1826                 $menu->command(
 1827                     -label       => $menu_ref->{title},
 1828                     -command     => $command,
 1829                     -accelerator => $accelerator,
 1830                 );
 1831             }
 1832         }
 1833     }
 1834 
 1835     return $self;
 1836 }
 1837 
 1838 sub populate_send_menu {
 1839     my ($self) = @_;
 1840 
 1841     #    my @menu_items = ();
 1842     if ( !-r $self->config->{send_menu_xml_file} ) {
 1843         $self->debug( 2, 'Using default send menu' );
 1844 
 1845         $menus{send}->checkbutton(
 1846             -label       => 'Use Macros',
 1847             -variable    => \$self->config->{macros_enabled},
 1848             -offvalue    => 'no',
 1849             -onvalue     => 'yes',
 1850             -accelerator => $self->config->{key_macros_enable},
 1851         );
 1852 
 1853         $menus{send}->command(
 1854             -label   => 'Remote Hostname',
 1855             -command => sub {
 1856                 $self->send_text_to_all_servers(
 1857                     $self->config->{macro_servername} );
 1858             },
 1859             -accelerator => $self->config->{key_clientname},
 1860         );
 1861         $menus{send}->command(
 1862             -label   => 'Local Hostname',
 1863             -command => sub {
 1864                 $self->send_text_to_all_servers(
 1865                     $self->config->{macro_hostname} );
 1866             },
 1867             -accelerator => $self->config->{key_localname},
 1868         );
 1869         $menus{send}->command(
 1870             -label   => 'Username',
 1871             -command => sub {
 1872                 $self->send_text_to_all_servers(
 1873                     $self->config->{macro_username} );
 1874             },
 1875             -accelerator => $self->config->{key_username},
 1876         );
 1877         $menus{send}->command(
 1878             -label   => 'Test Text',
 1879             -command => sub {
 1880                 $self->send_text_to_all_servers( 'echo ClusterSSH Version: '
 1881                         . $self->config->{macro_version}
 1882                         . $self->config->{macro_newline} );
 1883             },
 1884         );
 1885         $menus{send}->command(
 1886             -label   => 'Random Number',
 1887             -command => sub {
 1888                 $self->send_variable_text_to_all_servers(
 1889                     sub { int( rand(1024) ) } ),
 1890                     ;
 1891             },
 1892         );
 1893     }
 1894     else {
 1895         $self->debug(
 1896             2,
 1897             'Using xml send menu definition from ',
 1898             $self->config->{send_menu_xml_file}
 1899         );
 1900 
 1901         eval { require XML::Simple; };
 1902         die 'Cannot load XML::Simple - has it been installed?  ', $@ if ($@);
 1903 
 1904         my $xml      = XML::Simple->new( ForceArray => 1, );
 1905         my $menu_xml = $xml->XMLin( $self->config->{send_menu_xml_file} );
 1906 
 1907         $self->debug( 3, 'xml send menu: ', $/, $xml->XMLout($menu_xml) );
 1908 
 1909         if ( $menu_xml->{detach} && $menu_xml->{detach} =~ m/y/i ) {
 1910             $menus{send}->menu->tearOffMenu()->raise;
 1911         }
 1912 
 1913         $self->populate_send_menu_entries_from_xml( $menus{send}, $menu_xml );
 1914     }
 1915 
 1916     return $self;
 1917 }
 1918 
 1919 sub console_focus {
 1920     my ($self) = @_;
 1921 
 1922     $self->debug( 2, "Sorting focus on console" );
 1923     $windows{text_entry}->focus();
 1924 
 1925     $self->debug( 2, "Marking main window as user positioned" );
 1926 
 1927     # user puts it somewhere, leave it there
 1928     $windows{main_window}->positionfrom('user');
 1929 
 1930     return $self;
 1931 }
 1932 
 1933 sub mainloop {
 1934     my ($self) = @_;
 1935 
 1936     $self->debug( 2, "Starting MainLoop" );
 1937     MainLoop();
 1938     return $self;
 1939 }
 1940 
 1941 1;
 1942 
 1943 =pod
 1944 
 1945 =head1 NAME
 1946 
 1947 App::ClusterSSH::Window::TK - Base Tk windows object
 1948 
 1949 =head1 DESCRIPTION
 1950 
 1951 Base object for using Tk - must be pulled into App::ClusterSSH::Window for use
 1952 
 1953 =head1 METHODS
 1954 
 1955 =over 4
 1956 
 1957 =item add_host_by_name
 1958 
 1959 =item build_hosts_menu
 1960 
 1961 =item capture_map_events
 1962 
 1963 =item change_main_window_title
 1964 
 1965 =item close_inactive_sessions
 1966 
 1967 =item console_focus
 1968 
 1969 =item create_menubar
 1970 
 1971 =item create_windows
 1972 
 1973 =item get_font_size
 1974 
 1975 =item get_keycode_state
 1976 
 1977 =item initialise
 1978 
 1979 =item key_event
 1980 
 1981 =item load_keyboard_map
 1982 
 1983 =item mainloop
 1984 
 1985 =item open_client_windows
 1986 
 1987 =item pick_color
 1988 
 1989 =item populate_send_menu
 1990 
 1991 =item populate_send_menu_entries_from_xml
 1992 
 1993 =item re_add_closed_sessions
 1994 
 1995 =item retile_hosts
 1996 
 1997 =item send_resizemove
 1998 
 1999 =item send_text
 2000 
 2001 =item send_text_to_all_servers
 2002 
 2003 =item send_variable_text_to_all_servers
 2004 
 2005 =item set_all_active
 2006 
 2007 =item set_half_inactive
 2008 
 2009 =item setup_repeat
 2010 
 2011 =item show_console
 2012 
 2013 =item show_history
 2014 
 2015 =item substitute_macros
 2016 
 2017 =item terminate_all_hosts
 2018 
 2019 =item terminate_host
 2020 
 2021 =item toggle_active_state
 2022 
 2023 =item update_display_text
 2024 
 2025 =back