The Perl Toolchain Summit 2025 Needs You: You can help 🙏 Learn more

HANJE / Tk-AppWindow-0.19 / t / lib / Alternative / NameSpace / Plugins / Test.pm 

            

              
1
2
3
4
5
6
7
8
—
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74

              
package Alternative::NameSpace::Plugins::Test;
use strict;
use warnings;
use base qw( Tk::AppWindow::BaseClasses::Plugin );
my $plsub = sub { return 2 };
=head1 DESCRIPTION
This is for testing only. Yes, you read me, for TESTING. Didn't you hear me say? TESTING! TESTING! TESTING!
=cut
sub new {
        my $class = shift;
        my $self = $class->SUPER::new(@_);
        return undef unless defined $self;
        my $sb = $self->extGet('SideBars');
        my $page = $sb->pageAdd('navigator panel', 'Colors', 'fill-color', undef, 'Select and insert colors');
        $page->Label(-text => 'Colors')->pack(-expand => 1, -fill => 'both');
        $self->{QUITTER} = 1;
        $self->cmdHookBefore('plusser', $plsub);
#       $self->Require('Dummy');
        return $self;
}
sub CanQuit {
        my $self = shift;
        return $self->{QUITTER};
}
sub MenuItems {
        my $self = shift;
        return (
#This table is best viewed with tabsize 3.
#                        type                                   menupath                        label                                           cmd                                             icon                                    keyb                    config variable
                [       'menu',                                 undef,                  "~Test"], 
                [       'menu_normal',          'Test::',               "~PopTest",                             'poptest',                              'help-about',   'CTRL+T'                        ], 
        )
}
sub SettingsPage {
        return (
                Test => ['Label', -text => 'TestPage'],
        )
}
sub ToolItems {
        return (
#        type                                   label                   cmd                                     icon                                    help            
                [       'tool_button',          'Test', 'poptest',              'help-about',   'Pop up a message'],
        )
}
sub Unload {
        my $self = shift;
        if ($self->{QUITTER}) {
                $self->cmdUnhookBefore('plusser', $plsub);
                my $sb = $self->extGet('SideBars');
                $sb->pageDelete('navigator panel', 'Colors');
                return $self->SUPER::Unload
        }
        return 0
}
sub Quitter {
        my ($self, $val) = @_;
        $self->{QUITTER} = $val;
}
1;