Perl + Tk: передать ссылку на виджет (Scrolled / Listbox) в подпрограмму - PullRequest
Новая
       37

Perl + Tk: передать ссылку на виджет (Scrolled / Listbox) в подпрограмму

2 голосов
/ 14 января 2020

У меня проблема с передачей ссылок Listbox из подпрограммы в другую подпрограмму. В конце я хочу сделать следующее: после выбора в BoxA выяснить, каково значение выбранного элемента, и выбрать что-то в boxB на основе этого значения. 

#!/usr/bin/perl -w
use Tk;
use strict;
use warnings;

my $mw = MainWindow -> new();
my @arr = qw(1 2 3 4 5);
my $button = $mw -> Button (-text=>"Push me", -command => \&buttonCall) -> pack;

sub callee{
        my $boxARef = $_[0];
        my $boxBRef = $_[1];
        my $index = $boxARef -> curselection();
        $boxBRef -> selectionSet($index);
}

sub buttonCall{
        my $boxA = $mw -> Listbox(-exportselection=>0, -selectmode => 'browse') -> pack;
        $boxA -> insert('end', @arr);
        my $boxB = $mw -> Listbox(-exportselection=>0, -selectmode => 'multiple') -> pack;
        $boxB -> insert('end', @arr);
        $boxA -> bind ('<<ListboxSelect>>' => [\&callee,\$boxA,\$boxB] );
}

MainLoop;

Выполнение кода приводит к: 

Tk::Error: Can't call method "selectionSet" on unblessed reference at ./stack-test.pl line 14.
 <<ListboxSelect>>
 (command bound to event)

Я новичок в Perl и буду признателен за любую помощь со ссылками.

Ответы [ 2 ]

1 голос
/ 15 января 2020

Есть две проблемы:

Если вы используете форму [coderef, arg, arg...] для указания обратного вызова Tk, coderef всегда будет вызываться с виджетом, который вызвал событие, переданное в качестве первого аргумента. Так что это ваше $_[0]. Два аргумента, которые вы хотите передать, будут заканчиваться на $_[1] и $_[2].

Ваши переменные $boxA и $boxB уже являются ссылками, но вы передаете их с помощью дополнительного оператора \. Это означает, что вам придется разыменовывать их в своей подпрограмме обратного вызова, прежде чем пытаться вызывать на них методы Tk. - Или опустите \ в определении обратного вызова: 

use Tk;
use strict;
use warnings;

my $mw = MainWindow -> new();
my @arr = qw(1 2 3 4 5);
my $button = $mw -> Button (-text=>"Push me", -command => \&buttonCall) -> pack;

sub callee{
        my $boxARef = $_[1];
        my $boxBRef = $_[2];
        my $index = $boxARef -> curselection();
        $boxBRef -> selectionSet($index);
}

sub buttonCall{
        my $boxA = $mw -> Listbox(-exportselection=>0, -selectmode => 'browse') -> pack;
        $boxA -> insert('end', @arr);
        my $boxB = $mw -> Listbox(-exportselection=>0, -selectmode => 'multiple') -> pack;
        $boxB -> insert('end', @arr);
        $boxA -> bind ('<<ListboxSelect>>' => [\&callee,$boxA,$boxB] );
}

MainLoop;
0 голосов
/ 14 января 2020

Кажется, что-то странное происходит со ссылками на ящики, созданные в buttonCall(). У меня работает следующее: 

use strict;
use warnings;
use Tk;

my $mw = MainWindow -> new();
my @arr = qw(1 2 3 4 5);
my $boxA;
my $boxB;
my $button = $mw -> Button (
    -text=>"Push me",
    -command => sub { buttonCall( \$boxA, \$boxB ) }
) -> pack;

sub callee{
    my ( $boxARef, $boxBRef ) = @_;

    my $index = $$boxARef -> curselection();
    $$boxBRef -> selectionSet($index);
}

sub buttonCall{
    my ( $boxARef, $boxBRef ) = @_;
    if ( !defined $$boxARef ) {
        $$boxARef = $mw -> Listbox(-exportselection=>0, -selectmode => 'browse') -> pack;
        $$boxARef -> insert('end', @arr);
        $$boxBRef = $mw -> Listbox(
            -exportselection=>0, -selectmode => 'multiple'
        ) -> pack;
        $$boxBRef -> insert('end', @arr);
        $$boxARef -> bind ('<<ListboxSelect>>' => sub { callee( $boxARef, $boxBRef) });
    }
}

MainLoop;
...