In the process of migrating the Perl application GCstar from Gtk2 to Gtk3 (
https://gitlab.com/Kerenoc/GCstar/tree/Gtk3), I stumbled upon a possible
bug of the add_custom method of FileFilter. When used in the "Save" mode of
a FileChooserDialog, editing a file name in the input form induces a
segmentation fault, a very impolite behaviour for an interpreted language!
It happens at least on Debian 10 (perl v5.28.1, libgtk-3-0  3.24.5-1) and
Fedora 31 (perl v5.30.1, gtk3 3.24.13-1.fc31) but strangely enough not on
Windows!

I'm sharing below a little script able to reproduce the problem: any
correction in the Perl Gtk3 binding or a workaround for the application is
welcome!

Best regards

     Kerenoc

#!/usr/bin/perl

use strict;
use Gtk3 -init;
use Glib ('TRUE','FALSE');

my $window = Gtk3::Window->new('toplevel');
$window->set_title ('FileFilter Problem');
$window->set_default_size(100,50);
$window->set_border_width(30);
$window->signal_connect('delete_event' => sub {Gtk3->main_quit()});

my $button = Gtk3::Button->new_with_label('Choose file');
$button->signal_connect('clicked' => \&clicked_cb);
$window->add($button);

$window -> show_all();
Gtk3->main();

sub clicked_cb
{
    my $open_dialog = Gtk3::FileChooserDialog->new('Pick a file',
                        $window,
                        'save',
                        ('gtk-cancel', 'cancel',
                        'gtk-open', 'accept'));
    $open_dialog->set_modal(TRUE);
    $open_dialog->signal_connect('response' => \&open_response_cb);

    my $filter;

    $filter = new Gtk3::FileFilter;
    $filter->set_name('HTML Custom');
    $filter->add_custom('filename', sub {
        my $ctx = shift;
        return 0 if ((! defined $ctx) || (! defined $ctx->{filename}));
        my $filename = lc($ctx->{filename});
        return ($filename =~ m/.html?$/);
        });
    $open_dialog->add_filter($filter);

    $open_dialog->show();
}

sub open_response_cb
{
    my ($dialog, $response_id) = @_;
    my $open_dialog = $dialog;
    my $file;
    if ($response_id eq 'accept') {
        print "accept\n";
        $file = $open_dialog->get_file();
        my $filename = $open_dialog->get_filename();
        print "openning: $filename \n";
        $dialog->destroy();
    }
    elsif ($response_id eq 'cancel') {
        print "cancelled\n";
        $dialog->destroy();
    }
}
_______________________________________________
gtk-perl-list mailing list
gtk-perl-list@gnome.org
https://mail.gnome.org/mailman/listinfo/gtk-perl-list

Reply via email to