/usr/share/perl5/Config/Model/Tk/ListViewer.pm is in libconfig-model-tkui-perl 1.365-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 | #
# This file is part of Config-Model-TkUI
#
# This software is Copyright (c) 2008-2017 by Dominique Dumont.
#
# This is free software, licensed under:
#
# The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::Tk::ListViewer;
$Config::Model::Tk::ListViewer::VERSION = '1.365';
use strict;
use warnings;
use Carp;
use base qw/Tk::Frame Config::Model::Tk::AnyViewer/;
use subs qw/menu_struct/;
Construct Tk::Widget 'ConfigModelListViewer';
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 $list = $cw->{list} = delete $args->{-item}
|| die "ListViewer: no -item, got ", keys %$args;
my $path = delete $args->{-path}
|| die "ListViewer: no -path, got ", keys %$args;
my $cme_font = delete $args->{-font};
$cw->add_header( View => $list )->pack(@fx);
my $inst = $list->instance;
my $elt_frame = $cw->Frame(qw/-relief raised -borderwidth 2/)->pack(@fbe1);
my $str = $list->element_name . ' ' . $list->get_type . ' elements';
$elt_frame->Label( -text => $str )->pack();
my $rt = $elt_frame->Scrolled( 'ROText', -height => 10, )->pack(@fbe1);
my @insert =
$list->cargo_type eq 'leaf'
? $list->fetch_all_values( check => 'no' )
: $list->fetch_all_indexes;
foreach my $c (@insert) {
my $line = defined $c ? $c : '<undef>';
$rt->insert( 'end', $line . "\n" );
}
$cw->add_annotation($list)->pack(@fx);
$cw->add_warning( $list, 'view' )->pack(@fx);
$cw->add_summary($list)->pack(@fx);
$cw->add_description($list)->pack(@fbe1);
$cw->add_info_button()->pack( -side => 'left', @fxe1 );
$cw->add_editor_button($path)->pack( -side => 'right', @fxe1 );
$cw->ConfigSpecs(-font => [['SELF','DESCENDANTS'], 'font','Font', $cme_font ],);
$cw->SUPER::Populate($args);
}
sub get_info {
my $cw = shift;
my $info_frame = shift;
my $list = $cw->{list};
my @items = (
'type : ' . $list->get_type,
'index : ' . $list->index_type,
'cargo : ' . $list->cargo_type,
);
if ( $list->cargo_type eq 'node' ) {
push @items, "cargo class: " . $list->config_class_name;
}
if ( $list->cargo_type eq 'leaf' ) {
push @items, "leaf value type: " . ( $list->get_cargo_info('value_type') || '' );
}
foreach my $what (qw/min_index max_index/) {
my $v = $list->$what();
my $str = $what;
$str =~ s/_/ /g;
push @items, "$str: $v" if defined $v;
}
return $list->element_name, @items;
}
1;
|