view release on metacpan or  search on metacpan

lib/Config/Model/Tk/HashEditor.pm  view on Meta::CPAN

        -image   => $remove_img,
        -command => sub { $cw->remove_all_elements; $item = ''; },
    )->pack( -side => 'left', @fxe1 );
    $balloon->attach( $rm_all_b, -msg => 'Remove all keys' );

    $cw->ConfigModelNoteEditor( -object => $hash )->pack(qw/-anchor n/);

    # set all buttons to their default state
    $cw->update_state( tklist => '', entry => '' );

    $cw->add_warning( $hash, 'edit' )->pack(@fx);
    $cw->add_info_button()->pack( @fx, qw/-anchor n/ );
    $cw->add_summary($hash)->pack(@fx);
    $cw->add_description($hash)->pack(@fbe1);

    $cw->ConfigSpecs(-font => [['SELF','DESCENDANTS'], 'font','Font', $cme_font ],);

    $cw->Tk::Frame::Populate($args);
}

sub reset_value {
    my $cw = shift ;
    $cw->Subwidget('tklist')->delete( 0, 'end' );
    $cw->insert( end => $cw->{hash}->fetch_all_indexes );
}


# the following function is used to make multi-line keys (like Files
# entries in Debian copyright files) more manageable: LF are replaced
# by \n to enable editing a multi line entry in a Tk::Entry.
sub insert {
    my $cw = shift ;
    my $where = shift ;
    my @what = apply { s/\n/\\n/g; $_; } @_ ;
    $cw->Subwidget('tklist')->insert($where => @what);
}

# this function (not a method) restore the LF in a multi line key
# (reverse the operation done above
sub restore_keys {
    return apply { s/\\n/\n/g; $_; } @_ ;
}

sub remove_all_elements {
    my $cw     = shift;
    my $dialog = $cw->Dialog(
        -title          => "Delete ?",
        -text           => "Are you sure you want to delete all elements ?",
        -buttons        => [qw/Yes No/],
        -default_button => 'Yes',
    );
    my $answer = $dialog->Show;
    return unless $answer eq 'Yes';
    $cw->{hash}->clear;
    $cw->Subwidget('tklist')->delete( 0, 'end' );
    $cw->reload_tree();
}

# update buttons state according to entry and list widget
# this method is called whenever one of them changes its content
sub update_state {
    my ( $cw, %content ) = @_;

    my $wat = \%widget_activation_table;

    foreach my $button ( keys %$wat ) {
        my $new = 1;
        foreach my $c ( keys %content ) {
            $new &&= $wat->{$button}{$c} || $content{$c};
        }
        my $subwidget = $cw->Subwidget($button) || next;
        $subwidget->configure( -state => length($new) > 0 ? 'normal' : 'disabled' );
    }
}

sub add_entry {
    my $cw     = shift;
    my $add    = shift;
    my $tklist = $cw->Subwidget('tklist');
    my $hash   = $cw->{hash};

    $logger->debug("add_entry: $add");

    if ( $hash->exists(restore_keys($add)) ) {
        $cw->Dialog(
            -title => "Add item error",
            -text  => "Entry $add already exists",
        )->Show();
        return 0;
    }

    # add entry in hash
    eval { $hash->fetch_with_id(restore_keys($add)) };

    if ($@) {
        $cw->CmeDialog(
            -title => 'Hash index error',
            -text  => $@->as_string,
        )->Show;
        return 0;
    }

    $logger->debug( "new hash idx: " . join( ',', $hash->fetch_all_indexes ) );

    # ensure correct order for ordered hash
    my @selected = $tklist->curselection();

    $tklist->selectionClear( 0, 'end' );

    if ( @selected and $hash->ordered ) {
        my $idx = $tklist->get( $selected[0] );
        $logger->debug("add_entry on ordered hash: swap $idx and $add");
        $hash->move_after( restore_keys($add, $idx) );
        $logger->debug( "new hash idx: " . join( ',', $hash->fetch_all_indexes ) );
        my $new_idx = $selected[0] + 1;
        $cw->insert( $new_idx, $add );
        $tklist->selectionSet($new_idx);
        $tklist->see($new_idx);
    }
    elsif ( $hash->ordered ) {