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
|
#
# This file is part of Config-Model-TkUI
#
# This software is Copyright (c) 2011 by Dominique Dumont.
#
# This is free software, licensed under:
#
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::Tk::NoteEditor ;
{
$Config::Model::Tk::NoteEditor::VERSION = '1.337';
}
use strict;
use warnings ;
use Carp ;
use Log::Log4perl ;
use base qw/Tk::Frame/;
use vars qw/$icon_path/ ;
use subs qw/menu_struct/ ;
use Tk::Dialog ;
use Tk::Photo ;
use Tk::Balloon ;
use Tk; # Needed to import Ev function
Construct Tk::Widget 'ConfigModelNoteEditor';
my @fbe1 = qw/-fill both -expand 1/ ;
my @fxe1 = qw/-fill x -expand 1/ ;
my @fx = qw/-fill x / ;
my $logger = Log::Log4perl::get_logger(__PACKAGE__);
sub ClassInit {
my ($cw, $args) = @_;
# ClassInit is often used to define bindings and/or other
# resources shared by all instances, e.g., images.
# cw->Advertise(name=>$widget);
}
# This widget is to be integrated directly in a ConfigModel editor widget
sub Populate {
my ($cw, $args) = @_;
my $obj = delete $args->{-object}
|| croak "NoteEditor: no -object option, got ",
join(',', keys %$args);
my $label = 'Edit Note' ;
my $status = $label;
$cw->Label( -textvariable => \$status )->pack() ;
my $note_w = $cw->Scrolled ( 'Text',
-height => 5 ,
-scrollbars => 'ow',
)
->pack(@fbe1);
my $balloon = $cw->Balloon(-state => 'balloon') ;
$balloon->attach($note_w,
-msg => 'You may enter a comment here');
# read annotation and set up a callback to save user's entry at
# every return
$note_w -> Contents($obj->annotation);
$note_w -> bind('<Return>',
sub { $obj->annotation($note_w-> Contents ) ; $status = $label ;}
);
$note_w -> bind ('<KeyPress>',
sub { my $k = Ev('k') ;
$status = $label.'(* hit enter to save)' if $k =~/\w/ ;},
);
#$cw->Button(label=>'ok');
}
1;
|
