busy results from the CPAN

CWB-CQI

view release on metacpan or search on metacpan

}

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

    my $main_window = $self->{main_window};
    $main_window->bind('<Visibility>', '');
    $main_window->afterIdle([\&connect, $self]);
}

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

    my $main_window = $self->{main_window};
    $main_window->Busy(-recurse => 1);
    my @kids = $main_window->children();
    foreach (@kids) {
        if ($_->class() eq 'Toplevel') {
            # Wenn man hier Busy() verwendet, kann es passieren, dass
            # einige Fenster trotz Unbusy() gesperrt bleiben. Damit
            # der Benutzer trotzdem ein Feedback bekommt, wird eine
            # Uhr als Mauszeiger verwendet.
            #$_->Busy(-recurse => 1);
            $_->configure(-cursor => 'watch');
        }
    }
}

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

    my $main_window = $self->{main_window};
    my @kids = $main_window->children();
    foreach (@kids) {
        if ($_->class() eq 'Toplevel') {
            #$_->Unbusy();
            $_->configure(-cursor => 'left_ptr');
        }
    }
    $main_window->Unbusy();
}

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

    $self->{main_window}->bell();
}

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

    $self->busy();
    $self->set_status_message("Connecting to server");
    my ($host, $port, $user, $passwd);
    if (@ARGV) {
        unless (@ARGV >=2 and @ARGV <= 4) {
          print STDERR "Usage:  Tkwic.perl [<user> <password> [<host> [<port>]]]\n";
          exit 1;
        }
        $user = shift @ARGV;
        $passwd = shift @ARGV;
        $host = (@ARGV) ? shift @ARGV : "localhost";

examples/Tkwic.perl view on Meta::CPAN

        ($user, $passwd, $host, $port) = cqi_server();
        $self->set_status_message("Connecting to $host on port $port");
        cqi_connect($user, $passwd, $host, $port);
    }
    $self->{connected} = 1;
    $Corpora = $self->get_corpora();
    # Use the first corpus by default.
    $self->{corpus} = $Corpora->[0];
    $self->switch_corpus();
    $self->set_status_message("Connected to $host on port $port");
    $self->unbusy();
}

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

    $self->busy();
    if ($self->{connected}) {
        $self->set_status_message("Disconnecting");
        cqi_bye();
        $self->{connected} = 0;
    }
    $self->unbusy();
}

sub get_corpora {
    my ($self) = @_;
    my @list;

    foreach (cqi_list_corpora()) {
        push @list, $_;
    }
    if ($SortCorporaAlphabetically) {

examples/Tkwic.perl view on Meta::CPAN

        pop @$history;
    }
    unshift @$history, ($query);
    $self->update_history_menu();
}

sub execute_query {
    my ($self) = @_;
    my ($corpus, $query, $status, $size, @match, @matchend);

    $self->busy();
    $corpus = $self->{corpus};
    $query = $self->{query} = $self->get_query();
    if ($query) {
        $self->set_status_message("Executing query");
        $status = cqi_query($corpus, "A", $query);
        if ($status == $CWB::CQI::STATUS_OK) {
            $self->add_query_to_history($query);
            $self->clear_output_area();
            $size = $self->{query_size} = cqi_subcorpus_size("$corpus:A");
            if ($size > 0) {

examples/Tkwic.perl view on Meta::CPAN

            } else {
                $self->set_status_message("No match");
            }
            cqi_drop_subcorpus("$corpus:A");
        } else {
            $self->set_status_message("Query failed", 'ERROR');
        }
    } else {
        $self->set_status_message("Cannot execute empty query", 'ERROR');
    }
    $self->unbusy();
}

sub print_kwic_line {
    my ($self, $match, $matchend) = @_;
    my ($hlist, $lb, $rb, $list_ref, $lists);

    $hlist = $self->{output_list};
    ($lb, $rb) = $self->get_boundaries($match, $matchend,
                                       $MatchWidgetContextSize);
    my $e = $hlist->addchild('', -data => [$match, $matchend]);

examples/Tkwic.perl view on Meta::CPAN

        $self->center_list();
    #    }
    
    # no selected kwic line -> erase context window
    $self->copy_match_to_work_area();
}

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

    $self->busy();
    $self->show_matches($self->{query_first} - $NumberOfDisplayedMatches);
    $self->unbusy();
}

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

    $self->busy();
    $self->show_matches($self->{query_first} + $NumberOfDisplayedMatches);
    $self->unbusy();
}

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

    my $main_window = $self->{main_window} = MainWindow->new();
    $Apptitle = $main_window->title();
    $main_window->protocol('WM_DELETE_WINDOW', [\&file_exit, $self]);
    $main_window->optionAdd('*Entry.background' => $BackgroundColor);
    $main_window->optionAdd('*Text.background' => $BackgroundColor);

examples/Tkwic.perl view on Meta::CPAN

    return $self->insert_lists($type, \@cpos, $word_ref, $pos_ref, $lemma_ref,
                               $noun_chunks_lb_ref, $noun_chunks_rb_ref);
}

sub copy_match_to_work_area {
    my ($self, $e) = @_;
    my ($hlist, $list_ref, $text_widget, $match, $matchend, $lb, $rb, $n);

    # call without 'selected line' ($e) to clear context window

    $self->busy();
    $hlist = $self->{output_list};
    $text_widget = $self->{output_text};

    if (not defined $e) {
        $self->clear_output_text();
        $self->unbusy();
        return;
    }

    $list_ref = $hlist->info('data', $e);
    $match = $list_ref->[0];
    $matchend = $list_ref->[1];
    ($lb, $rb) = $self->get_boundaries($match, $matchend,
                                       $ContextWidgetContextSize);
    $self->clear_output_text();
    $n = $self->output_context('context', $lb .. $match-1);
    if ($n > 0) { $text_widget->insert('end', ' '); }
    $n = $self->output_context('match', $match .. $matchend);
    if ($n > 0) { $text_widget->insert('end', ' '); }
    $n = $self->output_context('context', $matchend+1 .. $rb);
    $text_widget->see('match.first');
    $self->set_status_message($self->get_info_attrs($match, $matchend),
                              'INFO_ATTR');
    $self->unbusy();
}

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

    $self->{output_list}->delete('all');
}

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

examples/Tkwic.perl view on Meta::CPAN


    my $e = $hlist->info('anchor');
    if ($e eq '') {
        $self->bell();
    } else {
        my $corpus = $hlist->info('data', $e);
        if ($close_window)  {
            $dialog->destroy();
        }
        if ($corpus ne $self->{corpus}) {
            $self->busy();
            $self->{corpus} = $corpus;
            $self->switch_corpus();
            $self->unbusy();
        }
    }
}

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

    my ($columns, $rows);
    my $main_window = $self->{main_window};
    my $dialog = $self->{corpus_dialog} = $main_window->Toplevel();

examples/Tkwic.perl view on Meta::CPAN

    $scrolled->grid(-sticky => 'nsew');
    $hbox->grid(-sticky => 'ew');
    $dialog->gridColumnconfigure(0, -weight => 1);
    $dialog->gridRowconfigure(0, -weight => 1);
    return $dialog;
}

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

    $self->busy();
    my $corpus_dialog = $self->{corpus_dialog};
    if (Tk::Exists($corpus_dialog)) {
        $corpus_dialog->deiconify();
        $corpus_dialog->raise();
    } else {
        $self->create_corpus_dialog();
    }
    $self->unbusy();
}

sub get_frequency_single {
    my ($self, $corpus, $subcorpus) = @_;

    my $ok = 0;
    my $hlist = $self->{freq_list};
    my $cutoff_freq = $self->{cutoff_freq};
    my $field1 = $self->{field1};
    my $attr1 = $self->{attr1};

examples/Tkwic.perl view on Meta::CPAN

                                      -buttons => [ $continue, $cancel ],
                                      -default_button => $cancel);
    my $answer = $dialog->Show();
    $dialog->destroy();
    return ($answer eq $continue);
}

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

    $self->busy();
    my $hlist = $self->{freq_list};
    my $corpus = $self->{corpus};
    my $query = $self->get_query();
    if ($query) {
        my $status = cqi_query($corpus, "A", $query);
        if ($status == $CWB::CQI::STATUS_OK) {
            my $subcorpus = "$corpus:A";
            my $size = cqi_subcorpus_size($subcorpus);
            my $ok = 1;
            if ($size > $FreqDistribDialog_MaxNumberOfResults) {

examples/Tkwic.perl view on Meta::CPAN

                if ($ok) {
                    $self->set_status_message("Done");
                }
            }
        } else {
            $self->set_status_message("Query failed", 'ERROR');
        }
    } else {
        $self->set_status_message("Cannot execute empty query", 'ERROR');
    }
    $self->unbusy();
};

sub set_frequency_type {
    my ($self, $type_number) = @_;

    my $state;
    if ($type_number == 0) {
        $state = 'disabled';
    } else {
        $state = 'normal';

examples/Tkwic.perl view on Meta::CPAN

        $context_length = 25;
    }
    my $context_tokens = $context_length / 5;
    my $corpus_size = cqi_attribute_size("$corpus.word");

    my $matchref = $self->{query_matchref};
    my $matchendref = $self->{query_matchendref};

    my $ruler = '-' x 74;

    $self->busy();
    if (open TO, '>' . $filename) {
        print TO "#$ruler\n";
        print TO "#\n";
        print TO "# User:    $loginname ($username)\n";
        print TO "# Date:    $date\n";
        print TO "# Corpus:  $fullname\n";
        print TO "# Size:    $size intervals/matches\n";
        print TO "# Context: $context_length characters left, $context_length characters right\n";
        print TO "#\n";
        print TO "# Query: $corpus; $query;\n";

examples/Tkwic.perl view on Meta::CPAN

            }
            ++$line_count;
        }
        close TO;
        SetFilePermissions($filename);
        $self->set_status_message("Done");
    } else {
        $self->set_status_message("Cannot save $filename");
        $self->bell();
    }
    $self->unbusy();
}

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

    my $main_window = $self->{main_window};
    my $new_filename = $main_window->getSaveFile(-defaultextension => '.txt',
                                                 -filetypes => $FileTypes);
    $self->save_matches($new_filename, 0) if $new_filename;
    return 1;

examples/Tkwic.perl view on Meta::CPAN

    my $main_window = $self->{main_window};
    my $new_filename = $main_window->getSaveFile(-defaultextension => '.txt',
                                                 -filetypes => $FileTypes);
    $self->save_matches($new_filename, 1) if $new_filename;
    return 1;
}

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

    $self->busy();
    my $freq_dialog = $self->{freq_dialog};
    if (Tk::Exists($freq_dialog)) {
        $freq_dialog->deiconify();
        $freq_dialog->raise();
    } else {
        $self->create_freq_dialog();
        $self->update_freq_dialog();
    }
    $self->unbusy();
}

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

    $self->busy();
    my $tag_dialog = $self->{tag_dialog};
    if (Tk::Exists($tag_dialog)) {
        $tag_dialog->deiconify();
        $tag_dialog->raise();
    } else {
        $self->create_tag_dialog();
    }
    $self->unbusy();
}

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

    my $main_window = $self->{main_window};
    my $dialog = $main_window->Dialog(-title => "Info about " . $Apptitle,
                                      -text => $Apptitle . " " .
                                      "Version 2.1\n" .
                                      "Copyright (C) 2000-2001 IMS\n" .

( run in 0.863 second using v1.01-cache-2.11-cpan-87723dcf8b7 )