mirror of
https://github.com/duncs/clusterssh.git
synced 2025-04-22 09:22:24 +00:00
Merge pull request #66 from cqexbesd/tiling
Take into account WM decorations when tiling
This commit is contained in:
Duncan Ferguson
GitHub
commit
d3b8bc0b0e
3 changed files with 101 additions and 58 deletions
19
Build.PL
19
Build.PL
|
|
@ -83,15 +83,16 @@ my $build = $class->new(
|
|||
dist_author => q{Duncan Ferguson <duncan_j_ferguson@yahoo.co.uk>},
|
||||
dist_version_from => 'lib/App/ClusterSSH.pm',
|
||||
requires => {
|
||||
'version' => '0',
|
||||
'Tk' => '800.022',
|
||||
'X11::Protocol' => '0.56',
|
||||
'Locale::Maketext' => 0,
|
||||
'Exception::Class' => '1.31',
|
||||
'Try::Tiny' => 0,
|
||||
'Getopt::Long' => 0,
|
||||
'File::Path' => 0,
|
||||
'File::Glob' => 0,
|
||||
'version' => '0',
|
||||
'Tk' => '800.022',
|
||||
'X11::Protocol' => '0.56',
|
||||
'X11::Protocol::WM' => '0',
|
||||
'Locale::Maketext' => 0,
|
||||
'Exception::Class' => '1.31',
|
||||
'Try::Tiny' => 0,
|
||||
'Getopt::Long' => 0,
|
||||
'File::Path' => 0,
|
||||
'File::Glob' => 0,
|
||||
},
|
||||
build_requires => {
|
||||
'Test::Pod::Coverage' => 0,
|
||||
|
|
|
|||
87
Makefile.PL
87
Makefile.PL
|
|
@ -1,49 +1,42 @@
|
|||
# Note: this file was auto-generated by Module::Build::Compat version 0.4218
|
||||
use ExtUtils::MakeMaker;
|
||||
WriteMakefile
|
||||
(
|
||||
'NAME' => 'App::ClusterSSH',
|
||||
'VERSION_FROM' => 'lib/App/ClusterSSH.pm',
|
||||
'PREREQ_PM' => {
|
||||
'CPAN::Changes' => '0.27',
|
||||
'Exception::Class' => '1.31',
|
||||
'File::Glob' => 0,
|
||||
'File::Path' => 0,
|
||||
'File::Slurp' => 0,
|
||||
'File::Temp' => 0,
|
||||
'File::Which' => 0,
|
||||
'Getopt::Long' => 0,
|
||||
'Locale::Maketext' => 0,
|
||||
'Readonly' => 0,
|
||||
'Test::Differences' => 0,
|
||||
'Test::DistManifest' => 0,
|
||||
'Test::PerlTidy' => 0,
|
||||
'Test::Pod' => 0,
|
||||
'Test::Pod::Coverage' => 0,
|
||||
'Test::Trap' => 0,
|
||||
'Tk' => '800.022',
|
||||
'Try::Tiny' => 0,
|
||||
'X11::Protocol' => '0.56',
|
||||
'version' => '0'
|
||||
},
|
||||
'INSTALLDIRS' => 'site',
|
||||
'EXE_FILES' => [
|
||||
'bin/ccon',
|
||||
'bin/clusterssh_bash_completion.dist',
|
||||
'bin/crsh',
|
||||
'bin/csftp',
|
||||
'bin/cssh',
|
||||
'bin/ctel'
|
||||
],
|
||||
'PL_FILES' => {
|
||||
'bin_PL/_build_docs' => [
|
||||
'bin/cssh',
|
||||
'bin/csftp',
|
||||
'bin/ccon',
|
||||
'bin/crsh',
|
||||
'bin/ctel',
|
||||
'bin/clusterssh_bash_completion.dist'
|
||||
]
|
||||
}
|
||||
)
|
||||
;
|
||||
WriteMakefile(
|
||||
'NAME' => 'App::ClusterSSH',
|
||||
'VERSION_FROM' => 'lib/App/ClusterSSH.pm',
|
||||
'PREREQ_PM' => {
|
||||
'CPAN::Changes' => '0.27',
|
||||
'Exception::Class' => '1.31',
|
||||
'File::Glob' => 0,
|
||||
'File::Path' => 0,
|
||||
'File::Slurp' => 0,
|
||||
'File::Temp' => 0,
|
||||
'File::Which' => 0,
|
||||
'Getopt::Long' => 0,
|
||||
'Locale::Maketext' => 0,
|
||||
'Readonly' => 0,
|
||||
'Test::Differences' => 0,
|
||||
'Test::DistManifest' => 0,
|
||||
'Test::PerlTidy' => 0,
|
||||
'Test::Pod' => 0,
|
||||
'Test::Pod::Coverage' => 0,
|
||||
'Test::Trap' => 0,
|
||||
'Tk' => '800.022',
|
||||
'Try::Tiny' => 0,
|
||||
'X11::Protocol' => '0.56',
|
||||
'X11::Protocol::WM' => 0,
|
||||
'version' => '0'
|
||||
},
|
||||
'INSTALLDIRS' => 'site',
|
||||
'EXE_FILES' => [
|
||||
'bin/ccon', 'bin/clusterssh_bash_completion.dist',
|
||||
'bin/crsh', 'bin/csftp',
|
||||
'bin/cssh', 'bin/ctel'
|
||||
],
|
||||
'PL_FILES' => {
|
||||
'bin_PL/_build_docs' => [
|
||||
'bin/cssh', 'bin/csftp',
|
||||
'bin/ccon', 'bin/crsh',
|
||||
'bin/ctel', 'bin/clusterssh_bash_completion.dist'
|
||||
]
|
||||
}
|
||||
);
|
||||
|
|
|
|||
|
|
@ -27,6 +27,7 @@ require Tk::Dialog;
|
|||
require Tk::LabEntry;
|
||||
use X11::Protocol;
|
||||
use X11::Protocol::Constants qw/ Shift Mod5 ShiftMask /;
|
||||
use X11::Protocol::WM;
|
||||
use vars qw/ %keysymtocode %keycodetosym /;
|
||||
use X11::Keysyms '%keysymtocode', 'MISCELLANY', 'XKB_KEYS', '3270', 'LATIN1',
|
||||
'LATIN2', 'LATIN3', 'LATIN4', 'KATAKANA', 'ARABIC', 'CYRILLIC', 'GREEK',
|
||||
|
|
@ -887,6 +888,17 @@ sub show_console() {
|
|||
return $self;
|
||||
}
|
||||
|
||||
# set the first argument to the second if the first is undefined
|
||||
# the equivalent of //= but works in older Perls (e.g. 5.8)
|
||||
sub slash_slash_equal(\$$) {
|
||||
|
||||
if ( !defined( ${ $_[0] } ) ) {
|
||||
${ $_[0] } = $_[1];
|
||||
}
|
||||
|
||||
return ${ $_[0] };
|
||||
}
|
||||
|
||||
# leave function def open here so we can be flexible in how it's called
|
||||
sub retile_hosts {
|
||||
my ( $self, $force ) = @_;
|
||||
|
|
@ -986,6 +998,34 @@ sub retile_hosts {
|
|||
|
||||
$self->config->dump("noexit") if ( $self->options->debug > 1 );
|
||||
|
||||
# now find the size of the window decorations
|
||||
if ( !exists( $self->config->{internal_terminal_wm_decoration_left} ) ) {
|
||||
|
||||
# use the first window as exemplary
|
||||
my ($wid) = $servers{ ( keys(%servers) )[0] }{wid};
|
||||
|
||||
if ( defined($wid) ) {
|
||||
|
||||
# get the WM decoration sizes
|
||||
( $self->config->{internal_terminal_wm_decoration_left},
|
||||
$self->config->{internal_terminal_wm_decoration_right},
|
||||
$self->config->{internal_terminal_wm_decoration_top},
|
||||
$self->config->{internal_terminal_wm_decoration_bottom}
|
||||
)
|
||||
= X11::Protocol::WM::get_net_frame_extents( $xdisplay, $wid );
|
||||
}
|
||||
|
||||
# in case the WM call failed we set some defaults
|
||||
slash_slash_equal(
|
||||
$self->config->{internal_terminal_wm_decoration_left}, 0 );
|
||||
slash_slash_equal(
|
||||
$self->config->{internal_terminal_wm_decoration_right}, 0 );
|
||||
slash_slash_equal(
|
||||
$self->config->{internal_terminal_wm_decoration_top}, 0 );
|
||||
slash_slash_equal(
|
||||
$self->config->{internal_terminal_wm_decoration_bottom}, 0 );
|
||||
}
|
||||
|
||||
# now we have the info, plot first window position
|
||||
my @hosts;
|
||||
my ( $current_x, $current_y, $current_row, $current_col ) = 0;
|
||||
|
|
@ -1049,14 +1089,18 @@ sub retile_hosts {
|
|||
$current_x
|
||||
+= $self->config->{terminal_reserve_left}
|
||||
+ $self->config->{terminal_reserve_right}
|
||||
+ $self->config->{internal_terminal_width};
|
||||
+ $self->config->{internal_terminal_width}
|
||||
+ $self->config->{internal_terminal_wm_decoration_left}
|
||||
+ $self->config->{internal_terminal_wm_decoration_right};
|
||||
|
||||
$current_col += 1;
|
||||
if ( $current_col == $self->config->{internal_columns} ) {
|
||||
$current_y
|
||||
+= $self->config->{terminal_reserve_top}
|
||||
+ $self->config->{terminal_reserve_bottom}
|
||||
+ $self->config->{internal_terminal_height};
|
||||
+ $self->config->{internal_terminal_height}
|
||||
+ $self->config->{internal_terminal_wm_decoration_top}
|
||||
+ $self->config->{internal_terminal_wm_decoration_bottom};
|
||||
$current_x = $self->config->{screen_reserve_left}
|
||||
+ $self->config->{terminal_reserve_left};
|
||||
$current_row++;
|
||||
|
|
@ -2239,6 +2283,11 @@ the code until this time.
|
|||
|
||||
=item resolve_names
|
||||
|
||||
=item slash_slash_equal
|
||||
|
||||
An implementation of the //= operator that works on older Perls.
|
||||
slash_slash_equal($a, 0) is equivalent to $a //= 0
|
||||
|
||||
=item retile_hosts
|
||||
|
||||
=item run
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue