http://www.perlmonks.org?node_id=160673
Category: GUI Programming
Author/Contact Info strredwolf
Description: Sticky notes in Perl/Tk. Crude but effective. Hit 'new' to make a new note, 'saved' to show all notes you've written and closed. Saves in ~/.ptknotes
#!/usr/bin/perl

use Tk;

$num=1;
sub newnote {
    my $txt=shift; my $t=shift; my %win;
    $t=$num++ unless($t); return if($winlist{$t});
    $win{main}=$main->Toplevel;
    $win{main}->geometry("240x320");$win{main}->title($t);
    $win{main}->protocol('WM_DELETE_WINDOW',[ sub{
    my $t = shift; my $w=$winlist{$t};
    $tlist{$t}=$w->{main_txt}->get("0.0","end");
    $tlist{$t}=~ s/\n+$/\n/m;
    $w->{main}->destroy; delete $winlist{$t};
    }, $t]);
    $win{main_txt}=$win{main}->Text(-background=>"#ffff00",-takefocus=
+>1)
    ->pack;
    $win{main_txt}->insert("end",$txt);
    $winlist{$t}=\%win;
}

$main=MainWindow->new; 
$main_new=$main->Button(-text=>"New",-command=>'newnote',
            -padx=>0,-pady=>0)->pack;
$main_old=$main->Button(-text=>"Saved",-command=>sub {
    foreach $t (keys %tlist) {
    newnote($tlist{$t},$t);
    }
},-padx=>0,-pady=>0)->pack;
$main->protocol('WM_DELETE_WINDOW',sub{
    my $t;
    foreach $t (keys %winlist) {
    my $w=$winlist{$t};
    $tlist{$t}=$w->{main_txt}->get("0.0","end");
    }
    system "rm $v/*";
    foreach $t (keys %tlist) {
    open(OUT,">$v/$t");
    print OUT $tlist{$t};
    }
    $main->destroy;
});

$v=$ENV{HOME}."/.ptknotes"; mkdir $v unless(-e $v);
opendir(DIR,$v); @n=readdir(DIR); closedir(DIR);
foreach $i (@n) { 
    next unless(-f "$v/$i");
    local $/; open(IN,"<$v/$i"); 
    $tlist{$num++}=<IN>;
}

MainLoop;