#!/usr/bin/perl
use warnings;
use strict;
use Tk;

my $top = MainWindow->new;

my @color = qw/red yellow pink green purple orange blue/;

my $listbox = $top->Scrolled('Listbox')->pack;

for (0..99){
    $listbox->insert('end',$_);
    $listbox->itemconfigure($_, -background => $color[rand(@color)]);
}

MainLoop;
[download]

Sorry, i forgot to say I want to change the FONT color. this is the complete code:


#!/usr/bin/env perl 

use strict;
use warnings;
use utf8;
use Tk;

die unless $^O=~/linux/i;
my $mainframe = new MainWindow;
$mainframe->configure (-width=>"640",-height=>"480"); 

my $listbox = $mainframe->Listbox(
    -relief     => 'sunken',
  -width      => -1,       # -1 == Shrink to fit
  -setgrid    => 1,
  -selectmode => 'single',
)->grid(
        -row=>0, 
      -column=>0
);
my $scroll = $mainframe->Scrollbar(-command => [ 'yview', $listbox ]);
$listbox->configure(-yscrollcommand => [ 'set', $scroll ]);
$scroll->grid(-column=>1, -row=>0, -rowspan=>2, -sticky =>'nes');
$listbox->bind('<Double-1>', sub{
    my $temp = $listbox->get($listbox->curselection());
    if( -d $temp){
        $listbox->delete(0, $listbox->size());
        opendir(DIR, "./$temp");
        readDir();
        close(DIR);
        chdir("$temp");
    }else{
        `xdg-open "$temp"`;
    }
});
opendir(DIR, "./");
readDir();
close DIR;
$mainframe->Button(
    -text=>"Exit",
    -command=>sub{
        exit;
    })->grid(
        -row=>1,
        -column=>0
    );
MainLoop();   

sub readDir{
    my @all = readdir(DIR);
    for my $x (sort (@all)){
        next if($x =~ /^\.$/);
        $listbox->insert('end', $x);
        if(-d $x){
            print "$x\n";
            $listbox->itemconfigure($listbox->size()-1, -foreground=>"
+#F00");
        }
    }
}
[download]

Zentara,

Did you just cut and paste that from this node by thundergnat? It might be nice to give him or her credit for that...

---

s''(q.S:$/9=(T1';s;(..)(..);$..=substr+crypt($1,$2),2,3;eg;print$..$/

Did you just cut and paste that from this node by thundergnat? It might be nice to give him or her credit for that...

Oh please :) I've got a buch of tk examples in my misc directory -- copied from all over the place -- most are too short for attribution, just like this example

Update: 12Oct13 Sorry about the tone of this liverpole, as events have turned out, this little spat has caused me to take a break from any coding, and devote my mind to self-realization and developing my God-conciousness. This has been the best thing that ever happened to me. You were just God's way of moving me forward, and I hold no hard feelings, and feel grateful for the experience. Om namo bhagavate Vasudevaya

No liverpole, I didn't cut'n'paste that from thundergnat, although he may have been the original source. As Anonymous Monk pointed out ( and I thank him for defending me in my absence concerning this) I considered that script so simple of an example, that I just considered it a general purpose simple example, not requiring an original author attribute.

By the way, do I need to give original author attributes to all code which I post? I thought Perl and the code presented here is considered freely given by the license? So in any event, I think your attack on me stems from some other reason ... maybe your liver is sick, I don't know, I'm not your fucking doctor, and I'm not your fucking whipping boy. I whip back.

By the way, here is a list of Tk Listbox snippets which I started collecting way back in the days of the Usenet being the only source. I didn't bother to write down who posted them, unless it was such an unusual usage, that the author should be placed as a comment in the script. Did thundergnat put a comment line in the actual code, saying he was the original author of this simple script? So F U liverpole, as a result of this unwarrented personal attack on me, I'm praying to God that you suffer horribly.

dir-select-2-listbox* drag-n-drop-listbox* drag-n-drop-listbox1* listbox* listbox-array-manipulation* listbox-array-manipulation1* listbox-arrow-keys* listbox-arrow-keys1-return-color* listbox-arrow-keys-select* listbox-arrow-keys-select1* listbox-button-3* listbox-button-3-1* listbox-colors* listbox-colors-0* listbox-colors-1* listbox-colors-2* listbox-colors-3* listbox-colors-set* listbox-colors-set1* listbox-count-items* listbox-disabled.html listbox-DnD-drag-n-drop* listbox-Double_Callbacks.html listbox-exportselection* listbox-export-selection-0-why.html listbox-file-viewer* listbox-get-curselection* listbox-Getselected* listbox-grab-entry* listbox-grab-entry-delete* listbox-How_to_move_up_down_the_row_element.html listbox-Inactive_Scroll_Bar.html listbox-leaks* listbox-leaks-fix1* listbox-leaks-fix1a* listbox-leaks-fix2* listbox-looping* listbox-multi* listbox-multi1* listbox-multi-curselection* listbox-multi-curselection1* listbox-multiple-selections* listbox-multiple-selections1* listbox-multiple-with-scroll* listbox-scroll-2-bottom* listbox-scrolled-select-transfer* listbox-scrolled-tie-2-1-scrollbar* listbox-select-files* listbox-select-files1* listbox-select-from_array* listbox-side-by-side* listbox-side-by-side0* listbox-side-by-side0a-employees* listbox-side-by-side1* listbox-side-by-side-insert* listbox-switching-windows* listbox_text_color-slowness* listbox-tied-scrolled-xy* listbox-tied-scrolled-xy1* listbox-tied-scrolled-xy2* listbox-tied-scrolled-xy2a* listbox-tied-scrolled-xy2b* listbox-update-entry-button1-click* listbox-w-checkboxes* listbox-w-checkboxes1* listbox-w-text* listbox-x-y-scroll* listbox-y-scroll-manually* num-entry-selection-listbox* option-menu-to-scrolled-listboxs* popup-menu-select-listbox* popup-menu-select-listbox1* scales-listbox-tied* scrolledlistbox* selection-listbox*

---

I'm not really a human, but I play one on earth.
Old Perl Programmer Haiku ................... flash japh

(Written before you showed your code) Probably the reason is that readdir just returns the file name. If you want to do file tests on the file, you need to include the path... like so:

#!/usr/bin/perl
use warnings;
use strict;
use Tk;

my %tk;

$tk{mw} = MainWindow->new;

$tk{frame} = $tk{mw}->Frame->pack(
    -expand => 1,
    -fill   => 'both',
    -anchor => 'nw'
);

$tk{listbox} = $tk{frame}->Scrolled(
    'Listbox',
    -selectmode => 'single',
    -scrollbars => 'ose',
  )->pack(
    -expand => 1,
    -fill   => 'both',
    -padx   => 5,
    -pady   => 5,
  );

my $dir = q|/|;

readDir($dir);

MainLoop;

sub readDir{
    my $dir = shift;
    opendir(my $dh, $dir) or die "Can't opendir $dir: $!";
    my @all = readdir($dh);
    for my $x (sort (@all)){
        next if($x =~ /^\.$/);
        $tk{listbox}->insert('end', $x);
        if(-d $dir.$x){
            print "$x\n";
            $tk{listbox}->itemconfigure($tk{listbox}->size()-1, -foreg
+round=>"#F00");
        }
    }
    close $dh;
}
[download]

Thank you very much :)
Now everything works fine