in reply to Re: Tk-messageBox -padx
in thread Tk-messageBox -padx

I can post the code i found at Tk.pm and Dialog.pm: Tk.pm
sub messageBox { my ($widget,%args) = @_; # remove in a later version: if (exists $args{'-text'}) { warn "The -text option is deprecated. Please use -message instead"; if (!exists $args{'-message'}) { $args{'-message'} = delete $args{'-text'}; } } $args{'-type'} = (exists $args{'-type'}) ? lc($args{'-type'}) : + 'ok'; $args{'-default'} = lc($args{'-default'}) if (exists $args{'-default' +}); ucfirst tk_messageBox(-parent => $widget, %args); }
sub Methods { my ($package) = caller; no strict 'refs'; foreach my $meth (@_) { my $name = $meth; *{$package."::$meth"} = sub { shift->WidgetMethod($name,@_) }; } } my %dialog = ( tk_chooseColor => 'ColorDialog', tk_messageBox => 'MessageBox', ...
sub MessageBox { my ($kind,%args) = @_; require Tk::Dialog; my $parent = delete $args{'-parent'}; my $args = \%args; $args->{-bitmap} = delete $args->{-icon} if defined $args->{-icon} +; $args->{-text} = delete $args->{-message} if defined $args->{-mess +age}; $args->{-type} = 'OK' unless defined $args->{-type}; my $type; if (defined($type = delete $args->{-type})) { delete $args->{-type}; my @buttons = grep($_,map(ucfirst($_), split(/(abort|retry|ignore|yes|no|cancel|ok)/, lc($type)))); $args->{-buttons} = [@buttons]; $args->{-default_button} = ucfirst(delete $args->{-default}) if defined $args->{-default}; if (not defined $args->{-default_button} and scalar(@buttons) == 1 +) { $args->{-default_button} = $buttons[0]; } my $md = $parent->Dialog(%$args); my $an = $md->Show; $md->destroy if Tk::Exists($md); return $an; } } # end messageBox
Then in Dialog.pm:
sub MessageBox { my ($kind,%args) = @_; require Tk::Dialog; my $parent = delete $args{'-parent'}; my $args = \%args; $args->{-bitmap} = delete $args->{-icon} if defined $args->{-icon} +; $args->{-text} = delete $args->{-message} if defined $args->{-mess +age}; $args->{-type} = 'OK' unless defined $args->{-type}; my $type; if (defined($type = delete $args->{-type})) { delete $args->{-type}; my @buttons = grep($_,map(ucfirst($_), split(/(abort|retry|ignore|yes|no|cancel|ok)/, lc($type)))); $args->{-buttons} = [@buttons]; $args->{-default_button} = ucfirst(delete $args->{-default}) if defined $args->{-default}; if (not defined $args->{-default_button} and scalar(@buttons) == 1 +) { $args->{-default_button} = $buttons[0]; } my $md = $parent->Dialog(%$args); my $an = $md->Show; $md->destroy if Tk::Exists($md); return $an; } } # end messageBox

Replies are listed 'Best First'.
Re^3: Tk-messageBox -padx
by marinersk (Priest) on Jul 31, 2013 at 23:41 UTC
    I can post the code i found at Tk.pm and Dialog.pm

    No thanks. Posting your code would be helpful, though.

Re^3: Tk-messageBox -padx
by Anonymous Monk on Jul 31, 2013 at 23:20 UTC

    I can post the code i found at Tk.pm and Dialog.pm: Tk.pm

    lol