Beefy Boxes and Bandwidth Generously Provided by pair Networks
go ahead... be a heretic
 
PerlMonks  

ptknotes

by strredwolf (Chaplain)
on Apr 19, 2002 at 21:13 UTC ( #160673=sourcecode: print w/ replies, xml ) Need Help??

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;


Comment on ptknotes
Download Code
Re: ptknotes
by xjar (Pilgrim) on Jun 14, 2002 at 16:21 UTC
    The following line:
    $main_new=$main->Button(-text=>"New",-command=>'newnote', -padx=>0,-pady=>0)->pack;
    caused problems running this on a Win32 environment, but changing it to:
    $main_new=$main->Button(-text=>"New",-command=>sub{newnote;}, -padx=>0,-pady=>0)->pack;
    ran perfectly.

    Also, and this is just my own aesthetic preference, changing the geometry size of the notes to 100x100 makes them look a little more sticky-noteish, but that's just me.

    xjar

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://160673]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others avoiding work at the Monastery: (10)
As of 2014-11-23 11:07 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My preferred Perl binaries come from:














    Results (131 votes), past polls