FIJISearchWidget.pm 4.01 KB
Newer Older
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
#-------------------------------------------------------------------------------
#  University of Applied Sciences Technikum Wien
#
#  Department of Embedded Systems
#  http://embsys.technikum-wien.at
#
#  Josef Ressel Center for Verification of Embedded Computing Systems
#  http://vecs.technikum-wien.at
#
#-------------------------------------------------------------------------------
#  Description:
#  Generic Search/Filter Widget
#-------------------------------------------------------------------------------

## @file
# @brief Contains class \ref Tk::FIJISearchWidget

## @class Tk::FIJISearchWidget
# @brief Tk Widget to search for and select one of a number of strings (usually net names)
package Tk::FIJISearchWidget;

use strict;
use warnings;
use utf8;

use Tk;
27
use Tk::widgets qw(Entry Button Frame Checkbutton Radiobutton Balloon);
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
use Tk::FIJIModalDialog;
use FIJI::TextGlob;
$FIJI::TextGlob::strict_wildcard_slash = 0;
$FIJI::TextGlob::strict_leading_dot    = 0;

use base qw(Tk::LabFrame);
Construct Tk::Widget 'FIJISearchWidget';

sub ClassInit {
    my ($class, $mw) = @_;
    $class->SUPER::ClassInit($mw);

    my $self = bless {}, $class;
    return $self;
}

sub callback {
    my ($self, $search_entry) = @_;

    my $string = $search_entry->get();
    my $msg;
    my $regex;
    if ($self->{'search_mode'} eq 'Glob') {
        $regex = FIJI::TextGlob::glob_to_regex($string);
    } elsif ($self->{'search_mode'} eq 'Regex') {
        # check if regex is valid:
        eval { "" =~ qr($string) };
        if ($@) {
            $msg = "Error in regular expression: $@";
        } else {
58
            $regex = "$string";
59
60
        }
    } elsif ($self->{'search_mode'} eq 'Substring') {
61
        $regex = "\Q$string\E";
62
63
64
65
66
67
68
69
70
71
72
73
74
75
    } else {
        $msg = "Invalid search mode. Please report a bug in module '" . $self->class() . "'!";
    }

    if (defined($msg)) {
        my $d = $self->MainWindow->FIJIModalDialog(
            -text       => $msg,
            -image      => Tk::FIJIUtils::error_image($self->MainWindow),
            -wraplength => 400,
            -title      => 'Error',
        )->Show();

        # $self->Unbusy; needed?
    } else {
76
77
        my $ci_str = ($self->{'case_insensitive'}) ? "(?i)" : "";
        $regex = qr/$ci_str$regex/;
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
        $self->cget('-callback')->($regex, $self->cget('-userdata'));
    }
}

sub Populate {
    my ($self, $args) = @_;

    $self->ConfigSpecs(
        -callback  => [qw/PASSIVE  undef  undef   undef/],
        -userdata  => [qw/PASSIVE  undef  undef   undef/],
    );

    $self->SUPER::Populate($args);

    my $balloon_widget = $self->Balloon();

    my $search_entry = $self->Entry()->grid(-row => 0, -column => 0, -padx => 5, -pady => 5, -sticky => 'ew');

    my $search_button = $self->Button(-text => 'Search', -command => [\&callback, $self, $search_entry,])->grid(-row => 0, -column => 1, -padx => 5, -pady => 5, -sticky => 'e');
    $search_entry->bind('<Return>', sub { $search_button->invoke; $_[0]->break; });
    $self->gridColumnconfigure(0, -weight => 1);
    $search_entry->focus();

    $self->{'search_mode'} = 'Substring';    # Default to substring
102
    my $search_mode_frame = $self->Frame()->grid(-row => 1, -column => 0, -padx => 5, -pady => 0, -sticky => 'ew');
103
104
105
106
107
108
109
110
111
    my $search_modes = [
        {text => 'Substring', tooltip => 'Search for a substring anywhere within the given string(s)'},
        {text => 'Glob',      tooltip => 'Search using standard globbing symbols ("*" and "?")'},
        {text => 'Regex',     tooltip => 'Search using Perl-compatible regular expressions (PCRE)'}
    ];
    foreach (@$search_modes) {
        my $rb = $search_mode_frame->Radiobutton(-text => $_->{text}, -value => $_->{text}, -variable => \$self->{'search_mode'})->pack(-side => 'left');
        $balloon_widget->attach($rb, -msg => $_->{tooltip});
    }
112
113
114

    my $insensitive_cb = $search_mode_frame->Checkbutton(-text => 'Case-insensitive', -variable => \$self->{'case_insensitive'})->pack(-side => 'right');
    $balloon_widget->attach($insensitive_cb, -msg => 'Use case-insensitive search if enabled');
115
}