view release on metacpan or  search on metacpan

examples/Tkwic.perl  view on Meta::CPAN

    $corpus_area->grid(-sticky => 'ew');
    $query_area->grid(-sticky => 'ew');
    $output_area->grid(-sticky => 'nsew');
    $status_area->grid(-sticky => 'ew');
    $main_window->gridColumnconfigure(0, -weight => 1);
    $main_window->gridRowconfigure(3, -weight => 1);
    return $main_window;
}

sub _get_menu_title {
    my ($self, $text) = @_;

    my $underline = index $text, '_';
    if ($underline >= 0) {
        $text =~ s/_//o;
    }
    return ($text, $underline);
}

sub _add_menu_item {
    my ($self, $menutitle, $itemtitle, $accelerator, $command) = @_;

    my $menu = $self->{menu_widgets}{$menutitle};
    if ($itemtitle eq '-') {
        $menu->separator();
    } else {
        my ($label, $underline) = $self->_get_menu_title($itemtitle);
        $menu->command(-label => $label, -underline => $underline,
                       -accelerator => $accelerator, -command => $command);
    }
}

sub create_menu_bar {
    my ($self) = @_;

    my @menus = ({title => "_File",
                  items => [{title => "Save _Matches...",
                             command => \&file_save_matches},
                            {title => "Save Matches With _Context...",
                             command => \&file_save_matches_with_context},
                            {title => '-'},
                            {title => "_Quit",
                             command => \&file_exit}]},
                 {title => "_Edit",
                  items => [{title => "Clear Query",
                             command => \&clear_query}]},
                 {title => "_Tools",
                  items => [{title => "_Frequency Distributions...",
                             command => \&tools_frequency_distributions}]},
                 {title => "_Help",
                  items => [{title => "Available _Tags...",
                             command => \&help_available_tags},
                            {title => "Inf_o...",
                             command => \&help_about}]});
    my $main_window = $self->{main_window};
    my $menu_bar = $main_window->Frame(-relief => 'raised',
                                       -borderwidth => '2');
    for (my $i = 0, my $last = $#menus; $i <= $last; $i++) {
        my $menutitle = $menus[$i]->{title};
        my ($text, $underline) = $self->_get_menu_title($menutitle);
        my $menu = $menu_bar->Menubutton(-text => $text,
                                         -underline => $underline);
        $menu->pack(-side => ($i == $last) ? 'right' : 'left');
        $self->{menu_widgets}{$text} = $menu;
        my $itemsref = $menus[$i]->{items};
        foreach my $item (@$itemsref) {
            my $itemtitle = $item->{title};
            my $method = $item->{command};
            $self->_add_menu_item($text, $itemtitle, undef, [$method, $self]);
        }
    }
    return $menu_bar;
}

sub create_corpus_area {
    my ($self) = @_;

    my $main_window = $self->{main_window};
    my $hbox = $main_window->Frame();
    my $corpus_label = $hbox->Label(-text => "Corpus:");
    my $corpus = $hbox->Label(-textvariable => \$self->{corpus},
                              -relief => 'sunken', -pady => 4,
                              -anchor => 'w');
    my $corpus_button = $hbox->Button(-text => "Select corpus...",
                                      -command => [\&show_corpus_dialog,
                                                   $self]);
    $corpus_label->grid($corpus, $corpus_button, -sticky => 'ew');
    $hbox->gridColumnconfigure(1, -weight => 1);
    return $hbox;
}

sub highlight_text {
    my ($self, $entry, $query, $pattern, $tag_name) = @_;
    my ($i, $j);

    while ($query =~ m/$pattern/g) {
        $j = pos($query);
        $i = $j - length $&;
        $entry->tagAdd($tag_name, "1.0+${i}chars", "1.0+${j}chars");
    }
}

sub set_query {
    my ($self, $entry, $query) = @_;

    if ($UseTextWidget) {
        $entry->delete('1.0', 'end');
        $entry->insert('end', $query);
        $self->highlight_text($entry, $query, '\$[0-9]', 'argument');
        $self->highlight_text($entry, $query, '@|</?[a-zA-Z0-9_]+>', 'info');
    } else {
        $entry->delete(0, 'end');
        $entry->insert('end', $query);
    }
}

sub get_positional_attributes {
    my ($self)  = @_;
    my ($corpus, @list);

    $corpus = $self->{corpus};

examples/Tkwic.perl  view on Meta::CPAN

    if (open FILE, $filename) {
        my $state = 'none';

        while (<FILE>) {
            # Strip comments.  Lines that contain a quoted sharp are not
            # handled, so don't put comments into these lines.
            s/\#.*$// if !/([\'\"]).*\#.*\1/o;
            # Strip leading and trailing spaces.
            s/^\s*//o;
            s/\s*$//o;
            # Empty lines are skipped.
            next if !$_;
            if ($state eq 'macro') {
                # The end of the macro is reached if the line ends with a
                # semicolon.
                if (/;$/o) {
                    chop;
                    $state = 'none';
                }
                push(@{$macros[-1]->{body}}, $_) if $_;
            } else {
                my @list = /MACRO\s+(.*)\((.*)\)/o;
                if (@list) {
                    push @macros, {name => $list[0], body => []};
                    $state = 'macro';
                } else {
                    my $p = basename($0);
                    print STDERR "$p:$filename:$.: Syntax error near to `$_´\n";
                }
            }
        }
        close FILE;
    } else {
        my $p = basename($0);
        print STDERR "$p:$filename: Cannot open file\n";
    }
    return \@macros;
}

sub update_history_menu {
    my ($self) = @_;
    my ($menu, $history, $label);

    $menu = $self->{history_menu};
    $history = $self->{query_history};
    $menu->delete(1, 'end');
    foreach my $query (@$history) {
        $label = substr($query, 0, 40);
        $label =~ s/\n/ /go; 
        $menu->add('command', -label => $label,
                    -command => [\&copy_query, $self, $query]);
    } 
}

sub create_query_area {
    my ($self) = @_;

    my $main_window = $self->{main_window};
    my $vbox = $main_window->Frame(-relief => 'groove', -borderwidth => 2);
    my $popup = $self->{query_popup} =
        $vbox->Menu(-menuitems => [['command' => "Clear query",
                                    -command => [\&clear_query, $self]]],
                    -tearoff => 0);
    my $query_entry;
    for (my $i = 0; $i < $NumberOfQueryEntries; $i++) {
        if ($UseTextWidget) {
            my $scrolled = $vbox->Scrolled('Text', -scrollbars => 'osoe',
                                           -height => $QueryEntryHeight,
                                           -wrap => 'word');
            $query_entry = $scrolled->Subwidget('scrolled');
            $query_entry->tagConfigure('argument', -foreground => $ArgumentColor);
            $query_entry->tagConfigure('info', -foreground => $InfoColor);
            $query_entry->bind('Tk::Text', '<3>', '');
            $scrolled->pack(-fill => 'x', -expand => 1);
        } else {
            $query_entry = $vbox->Entry();
            $query_entry->pack(-fill => 'x', -expand => 1);
        }
        $query_entry->bind('<FocusIn>', [ \&query_focus_in, $self, $i ]);
        $query_entry->bind('<Button-3>',
                           sub { $popup->Popup(-popover => 'cursor', -popanchor => 'nw'); });
        $self->{query_entry}[$i] = $query_entry;
    }
    $self->{query_entry}[0]->focus();
    my $hbox = $vbox->Frame();
    my $history_button =
        $hbox->Menubutton(-text => "History", -indicatoron => 1,
                          -relief => 'raised', -pady => 5);
    $self->{history_menu} = $history_button->menu;
    my $execute_query_button = $hbox->Button(-text => "Start query",
                                          -command => [\&execute_query, $self]);
    $history_button->grid($execute_query_button, -sticky => 'ew');
    $hbox->gridColumnconfigure(1, -weight => 1);
    $hbox->pack(-fill => 'x', -expand => 1);
    return $vbox;
}

sub query_focus_in {
    my ($widget, $self, $n) = @_;

    for (my $i = 0; $i < $NumberOfQueryEntries; $i++) {
        if ($i != $n) {
            $self->{query_entry}[$i]->configure(-background =>
                                                $BackgroundColor);
        }
    }
    $widget->configure(-background => $SelectedQueryColor);
    $self->{current_query_entry} = $widget;
}

sub clear_query_area {
    my ($self) = @_;
    for (my $i = 0; $i < $NumberOfQueryEntries; $i++) {
        $self->set_query($self->{query_entry}[$i], '');
    }
}

sub create_output_area {
    my ($self) = @_;

    my $main_window = $self->{main_window};

    my $vbox = $main_window->Frame(-relief => 'groove', -borderwidth => 2);

    # Word, POS etc. buttons
    my $hbox1 = $vbox->Frame(-relief => 'groove', -borderwidth => 2);
    my $command = [sub {$self->show_matches($self->{query_first});}];
    my $word_button = $hbox1->Checkbutton(-text => "Word",
                                          -variable => \$self->{show_word},
                                          -command => $command);
    my $pos_button = $hbox1->Checkbutton(-text => "POS",
                                         -variable => \$self->{show_pos},
                                         -command => $command);
    my $lemma_button = $hbox1->Checkbutton(-text => "Lemma",
                                           -variable => \$self->{show_lemma},
                                           -command => $command);
    my $noun_chunks_button = $hbox1->Checkbutton(-text => "Noun chunks",
                                        -variable => \$self->{show_noun_chunks},
                                        -command => $command);
    $self->{noun_chunks_button} = $noun_chunks_button;
    if ($ManageNounChunksButton) {
        $word_button->grid($pos_button, $lemma_button, $noun_chunks_button,
                           -sticky => 'ew');
    } else {
        $word_button->grid($pos_button, $lemma_button, -sticky => 'ew');
    }
    my ($columns, $rows) = $hbox1->gridSize();