The Perl and Raku Conference 2025: Greenville, South Carolina - June 27-29 Learn more

HANJE / App-Codit-0.19 / lib / App / Codit / BaseClasses / TextModPlugin.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
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
—
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120

              
package App::Codit::BaseClasses::TextModPlugin;
=head1 NAME
App::Codit::BaseClasses::TextModPlugin - baseclass for plugins that respond to text modifications
=cut
use strict;
use warnings;
use vars qw( $VERSION );
$VERSION = '0.19';
use Tk;
use base qw( Tk::AppWindow::BaseClasses::Plugin );
require Tk::HList;
=head1 DESCRIPTION
=cut
sub new {
        my $class = shift;
        my $self = $class->SUPER::new(@_);
        return undef unless defined $self;
         
        $self->{ACTIVEDELAY} = 600;
        $self->cmdHookBefore('quit', 'selectBlock', $self);
        $self->cmdHookBefore('deferred_open', 'selectBlock', $self);
        $self->cmdHookAfter('modified', 'activate', $self);
        $self->cmdHookAfter('doc_select', 'docSelect', $self);
         
#       $self->after(1000, sub {
#               my $sel = $self->extGet('CoditMDI')->docSelected;
#               $self->docSelect($sel) if defined $sel;
#       });
        return $self;
}
sub activate {
        my $self = shift;
        my $id = $self->{'active_id'};
        $self->afterCancel($id) if defined $id;
        $self->{'active_id'} = $self->after($self->activeDelay, ['Refresh', $self]);
}
sub activeDelay {
        my $self = shift;
        $self->{ACTIVEDELAY} = shift if @_;
        return $self->{ACTIVEDELAY}
}
sub Clear {
}
sub docSelect {
        my $self = shift;
        if (exists $self->{'select_block'}) {
                $self->after(100, sub { delete $self->{'select_block'} });
        }
        my $mdi = $self->extGet('CoditMDI');
        return if $mdi->selectDisabled;
        $self->after(10, sub {
                $self->Refresh(0);
        });
}
sub Refresh {
        my $self = shift;
        delete $self->{'active_id'};
}
sub selectBlock {
        my $self = shift;
        $self->{'select_block'} = 1;
}
sub Unload {
        my $self = shift;
        my $id = $self->{'active_id'};
        $self->afterCancel($id) if defined $id;
        $self->cmdUnhookBefore('quit', 'selectBlock', $self);
        $self->cmdUnhookBefore('deferred_open', 'selectBlock', $self);
        $self->cmdUnhookAfter('modified', 'activate', $self);
        $self->cmdUnhookAfter('doc_select', 'docSelect', $self);
#       $self->cmdUnhookAfter('doc_close', 'docAfterClose', $self);
        return $self->SUPER::Unload
}
=head1 LICENSE
Same as Perl.
=head1 AUTHOR
Hans Jeuken (hanje at cpan dot org)
=head1 TODO
=over 4
=back
=head1 BUGS AND CAVEATS
If you find any bugs, please report them here L<https://github.com/haje61/App-Codit/issues>.
=head1 SEE ALSO
=over 4
=back
=cut
1;