/usr/share/perl5/Config/Model/Tk/CheckListViewer.pm is in libconfig-model-tkui-perl 1.340-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 121 122 | #
# This file is part of Config-Model-TkUI
#
# This software is Copyright (c) 2013 by Dominique Dumont.
#
# This is free software, licensed under:
#
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::Tk::CheckListViewer ;
{
$Config::Model::Tk::CheckListViewer::VERSION = '1.340';
}
use strict;
use warnings ;
use Carp ;
use base qw/Tk::Frame Config::Model::Tk::AnyViewer/;
use subs qw/menu_struct/ ;
use Tk::ROText ;
Construct Tk::Widget 'ConfigModelCheckListViewer';
my @fbe1 = qw/-fill both -expand 1/ ;
my @fxe1 = qw/-fill x -expand 1/ ;
my @fx = qw/-fill x/ ;
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);
}
sub Populate {
my ($cw, $args) = @_;
my $leaf = $cw->{leaf} = delete $args->{-item}
|| die "CheckListViewer: no -item, got ",keys %$args;
my $path = delete $args->{-path}
|| die "CheckListViewer: no -path, got ",keys %$args;
my $inst = $leaf->instance ;
$cw->add_header(View => $leaf)->pack(@fx) ;
my $rt = $cw->Scrolled ( 'ROText',
-scrollbars => 'osoe',
-height => 6,
) ->pack(@fbe1) ;
$rt->tagConfigure('in',-background => 'black', -foreground => 'white') ;
my %h = $leaf->get_checked_list_as_hash ;
foreach my $c ($leaf->get_choice) {
my $tag = $h{$c} ? 'in' : 'out' ;
$rt->insert('end', $c."\n" , $tag) ;
}
$cw->add_annotation($leaf)->pack(@fx) ;
$cw->add_summary($leaf)->pack(@fx) ;
my ($help_frame, $help_widget) = $cw->add_help(value => '',1);
$help_frame->pack(@fx);
$cw->{value_help_widget} = $help_widget ;
$cw->set_value_help($leaf->get_checked_list);
$cw->add_description($leaf)->pack(@fx) ;
$cw->add_info_button()->pack(@fxe1, -side => 'left') ;
$cw->add_editor_button($path)-> pack(@fxe1, -side => 'right') ;
$cw->ConfigSpecs(
#-fill => [ qw/SELF fill Fill both/],
#-expand => [ qw/SELF expand Expand 1/],
-relief => [qw/SELF relief Relief groove/ ],
-borderwidth => [qw/SELF borderwidth Borderwidth 2/] ,
DEFAULT => [ qw/SELF/ ],
);
$cw->SUPER::Populate($args) ;
}
sub add_value_help {
my $cw = shift ;
my $help_frame = $cw->Frame(-relief => 'groove',
-borderwidth => 2,
)->pack(@fbe1);
my $leaf = $cw->{leaf} ;
$help_frame->Label(-text => 'value help: ')->pack(-side => 'left');
$help_frame->Label(-textvariable => \$cw->{help})
->pack(-side => 'left', -fill => 'x', -expand => 1);
}
sub set_value_help {
my $cw = shift ;
my @set = @_ ;
my $w = $cw->{value_help_widget};
$w->delete('0.0','end');
foreach my $v (@set) {
my $value_help = $cw->{leaf}->get_help($v);
$w->insert('end',"$v: ".$value_help."\n") if defined $value_help ;
}
}
sub get_info {
my $cw = shift ;
my @items = () ;
my $leaf = $cw->{leaf} ;
if (defined $leaf->refer_to) {
push @items, "refer_to: ".$leaf->refer_to ;
}
push @items, "ordered: ". ($leaf->ordered ? 'yes' : 'no');
return $leaf->element_name, @items ;
}
1;
|