Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??
#!/usr/bin/perl -w use warnings; use Tk; use Tk::Font; use Tk::ItemStyle; use Tk::Adjuster; use Tk::Button; use Tk::HList; ## # # Main application # ## package App; sub new($) { my($class) = @_; my $self = {}; bless $self, $class; # read bundled data my(undef, %data) = split(/========\s+(.*?)\s+========\n/, join('', <::DATA>)); # misc vars $self->{ActiveItem} = undef; $self->{File} = undef; # main window $self->{TopWindow} = new MainWindow(); # icons $self->{Icons}{Plus} = $self->{TopWindow}->Pixmap(-data => $da +ta{'icon plus'}); $self->{Icons}{Minus} = $self->{TopWindow}->Pixmap(-data => $d +ata{'icon minus'}); $self->{Icons}{Up} = $self->{TopWindow}->Pixmap(-data => $data +{'icon up'}); $self->{Icons}{Down} = $self->{TopWindow}->Pixmap(-data => $da +ta{'icon down'}); $self->{Icons}{ToDo} = $self->{TopWindow}->Pixmap(-data => $da +ta{'icon todo'}); $self->{TopWindow}->iconmask(undef); #$self->{TopWindow}->iconbitmap(undef); $self->{TopWindow}->iconimage($self->{Icons}{ToDo}); # fonts $self->{Fonts}{Regular} = $self->{TopWindow}->Font(-family => +'Verdana', -size => 10); $self->{Fonts}{RegularBold} = $self->{TopWindow}->Font(-family + => 'Verdana', -size => 10, -weight => 'bold'); $self->{Fonts}{TextBox} = $self->{TopWindow}->Font(-family => +'Verdana', -size => 12); $self->{Fonts}{Button} = $self->{TopWindow}->Font(-family => ' +Verdana', -size => 10); # display item styles - for the main tree $self->{ItemStyles}{Regular} = $self->{TopWindow}->ItemStyle(' +imagetext', -font => $self->{Fonts}{Regular}); $self->{ItemStyles}{Bold} = $self->{TopWindow}->ItemStyle('ima +getext', -font => $self->{Fonts}{RegularBold}); $self->{ItemStyles}{RegularGray} = $self->{TopWindow}->ItemSty +le('imagetext', -font => $self->{Fonts}{Regular}, -foreground => 'gray'); $self->{ItemStyles}{BoldGray} = $self->{TopWindow}->ItemStyle( +'imagetext', -font => $self->{Fonts}{RegularBold}, -foreground => 'gray'); $self->{ItemStyles}{RegularUrgent} = $self->{TopWindow}->ItemS +tyle('imagetext', -font => $self->{Fonts}{Regular}, -foreground => 'red', -selectforeground => 'red', -act +iveforeground => 'red'); $self->{ItemStyles}{BoldUrgent} = $self->{TopWindow}->ItemStyl +e('imagetext', -font => $self->{Fonts}{RegularBold}, -foreground => 'red', -selectforeground => 'red', -act +iveforeground => 'red'); # the main tree widget $self->{ToDoTree} = $self->{TopWindow}->Scrolled('HList', -width => 70, -indent => 35, -scrollbars => 'osoe', -drawbranch => 0, -separator => '.', -selectmode => 'none', -command => sub { $self->toggleItem($_[0]) }, -browsecmd => sub { $self->setActiveItem($_[0]) }); $self->{ToDoTree}->add('root', -itemtype => 'imagetext', -text => "To Do", -image => $self->{Icons}{ToDo}); # r +oot item # popup invocation $self->{ToDoTree}->bind('<Button-3>' => sub { my $tree = $self->{ToDoTree}; # we select the item under cursor my $item = $tree->pointery() - $tree->rooty(); $item = $tree->nearest($item); $tree->selectionClear(); if(defined $item) { $tree->selectionSet($item); } # show the context menu $self->{ToDoTreeMenu}->Popup(-popover => 'cursor', -po +panchor => 'nw'); }); # tree popup menu $self->{ToDoTreeMenu} = $self->{TopWindow}->Menu(-tearoff => 0 +, -font => $self->{Fonts}{Button}); $self->{ToDoTreeMenu}->command(-label => 'Add Sub-item', -command => sub { my $sel = ($self->{ToDoTree}->info(' +selection'))[0]; $self->setActiveItem($self->addItemUnder($sel) +); }); $self->{ToDoTreeMenu}->command(-label => 'Remove', -command => sub { my $sel = ($self->{ToDoTree}->info(' +selection'))[0]; $self->removeItem($sel); }); # item editor $self->{ItemEditor} = $self->{TopWindow}->Text(-width => 40, -font => $self->{Fonts}{TextBox}, -wrap => 'word'); $self->{ItemEditor}->bind('<KeyPress>' => sub { $self->setItemContents($self->{ActiveItem}, $self->{ItemEditor}->get('0.0', 'end')) }); # toolbar my $toolbar = $self->{TopWindow}->Frame(); $toolbar->Button(-text => 'Load...', -font => $self->{Fonts}{Button}, -command => sub { my $file = $self->{TopWindow}->getOpenFile(-ti +tle => 'Open To Do File'); if($file ne '') { $self->loadFile($file) } })->pack(-side => 'left'); $toolbar->Button(-text => 'Save', -font => $self->{Fonts}{Button}, -command => sub { $self->saveFile($self->{File}) }) ->pack(-side => 'left'); $toolbar->Button(-text => 'Save As...', -font => $self->{Fonts}{Button}, -command => sub { my $file = $self->{TopWindow}->getSaveFile(-in +itialfile => $self->{File}, -title => 'Save To Do File'); if($file ne '') { $self->saveFile($file); } })->pack(-side => 'left'); # item toolbar my $itembar = $self->{TopWindow}->Frame(); $itembar->Button(-text => 'Shift Up', -image => $self->{Icons}{Up}, -font => $self->{Fonts}{Button}, -command => sub { my $sel = ($self->{ToDoTree}->info('selection' +))[0]; $self->shiftItem($sel, -1); })->pack(-side => 'left'); $itembar->Button(-text => 'Shift Down', -image => $self->{Icons}{Down}, -font => $self->{Fonts}{Button}, -command => sub { my $sel = ($self->{ToDoTree}->info('selection' +))[0]; $self->shiftItem($sel, 1); })->pack(-side => 'left'); # positioning $toolbar->pack(-side => 'top', -fill => 'x'); $itembar->pack(-side => 'top', -fill => 'x'); $self->{ItemEditor}->pack(-side => 'right', -fill => 'y'); $self->{TopWindow}->Adjuster(-widget => $self->{ItemEditor}, - +side => 'right') ->pack(-side => 'right', -fill => 'y'); $self->{ToDoTree}->pack(-expand => 1, -fill => 'both'); # kickoff $self->loadFile($ENV{'HOME'} . '/.todo.txt'); return $self; } # sets the current file path sub setFile($$) { my($self, $file) = @_; $self->{File} = $file; $self->{TopWindow}->configure(-title => "Todo - $file"); } # hides/unhides children of specified item sub toggleItem($$) { my($self, $path) = @_; return unless(defined $path && $path ne 'root'); my $direction = 0; my $tree = $self->{ToDoTree}; foreach($tree->info('children', $path)) { if($tree->info('hidden', $_)) { $tree->show('entry', $_); $direction = 1 } else { $tree->hide('entry', $_); $direction = -1 } } $self->updateItemStyle($path); } # shifts item sub shiftItem($$$) { my($self, $path, $offset) = @_; return unless(defined $path && $path ne 'root'); my $tree = $self->{ToDoTree}; # get the neighbor to hop over my $parent = $tree->info('parent', $path); my @siblings = $tree->info('children', $parent); my $myIndex = undef; foreach(0 .. $#siblings) { if($siblings[$_] eq $path) { $myIndex = $_; last; } } return unless(defined $myIndex); my $newIndex = $myIndex + ($offset > 0 ? 1 : -1); return if($newIndex < 0 or $newIndex > $#siblings); my $sibling = $siblings[$newIndex]; # move the item itself my $side = $offset > 0 ? -after : -before; my $newPath = $self->addItemUnder($parent, $side => $sibling); # do the copying my @queue = ($path, $newPath); while(scalar @queue) { my $from = shift @queue; my $to = shift @queue; $self->setItemContents($to, $self->getItemContents($fr +om)); # create children and schedule them for copying foreach($tree->info('children', $from)) { push @queue, $_, $self->addItemUnder($to); } } # delete old item $self->removeItem($path); $self->setActiveItem($newPath); } # sets the contents of the item and updates its appearance sub setItemContents($$$) { my($self, $path, $data) = @_; return unless(defined $path && $path ne 'root'); $data =~ s/\s+$//s; # remove trailing whitespace $data =~ s/^\n+//s; # remove leading newlines my $firstLine; if($data =~ /^(.*?)\n/) { $firstLine = "$1 (...)"; } elsif($data eq '') { $firstLine = '(blank)'; } else { $firstLine = $data; } $self->{ToDoTree}->entryconfigure($path, -text => $firstLine); $self->{ToDoTree}->entryconfigure($path, -data => $data); $self->updateItemStyle($path); } # resets the display style of the item sub updateItemStyle($$$) { my($self, $path) = @_; return unless(defined $path && $path ne 'root'); my $data = $self->getItemContents($path); my($firstChild) = $self->{ToDoTree}->info('children', $path); my $icon = undef; my $style = 'Regular'; if(defined $firstChild) { $style = 'Bold'; $icon = $self->{Icons}{Minus}; # see if it's expanded if($self->{ToDoTree}->info('hidden', $firstChild)) { $icon = $self->{Icons}{Plus}; } } if($data =~ /^\(?\!/o) { $style .= 'Urgent'; } elsif($data =~ /^\(wish/i) { $style .= 'Gray'; } $self->{ToDoTree}->itemConfigure($path, 0, -image => $icon, -style => $self->{ItemStyles}{$style}); } # gets the contents of the item sub getItemContents($$) { my($self, $path) = @_; return undef unless(defined $path && $path ne 'root'); my $data = $self->{ToDoTree}->info('data', $path); return defined $data ? $data : ''; } # makes the specified item active and editable # TODO: catch empty items sub setActiveItem($$) { my($self, $path) = @_; return unless(defined $path); $self->{ItemEditor}->delete('0.0', 'end'); $self->{ItemEditor}->insert('0.0', $self->{ToDoTree}->info('da +ta', $path)); $self->{ActiveItem} = $path; $self->{ToDoTree}->selectionClear(); $self->{ToDoTree}->selectionSet($path); $self->{ToDoTree}->anchorSet($path); $self->{ToDoTree}->see($path); } # adds an item under specified one sub addItemUnder($$@) { my($self, $path, @options) = @_; return unless(defined $path); # add the child my $newpath = $self->{ToDoTree}->addchild($path, -itemtype => +'imagetext', -text => "New Item", -style => $self->{ItemStyles}{Regular}, @options); $self->updateItemStyle($newpath); # expand parent and update style # root entry is always expanded if($path ne 'root') { foreach($self->{ToDoTree}->info('children', $path)) { +$self->{ToDoTree}->show('entry', $_); } $self->updateItemStyle($path); } return $newpath; } # removes specified item sub removeItem($$) { my($self, $path) = @_; return unless(defined $path && $path ne 'root'); my $parent = $self->{ToDoTree}->info('parent', $path); $self->{ToDoTree}->delete('entry', $path); # update parent's display $self->updateItemStyle($parent); # change focus $self->{ToDoTree}->selectionClear(); $self->{ToDoTree}->selectionSet($parent); $self->setActiveItem($parent); } # populates the todo tree widget from file sub loadFile($$) { my($self, $fileName) = @_; my $tree = $self->{ToDoTree}; open(FILE, $fileName) or return; my @lines = <FILE>; close(FILE); push @lines, '-'; $tree->delete('offsprings', 'root'); my($curText, $curHead, $line); my @parents = (['', 'root']); # list of 'head', 'entrypath' en +tries # heads are guaranteed to decrease in length sequentia +lly foreach $line (@lines) { chomp $line; if($line =~ /^\s*-/) { # take care of the entry so far if(defined $curText) { # go through parents and weed out ever +ything # but the elders (that removes sibling +s from list) while(length($curHead) <= length($pare +nts[0]->[0])) { shift(@parents); } # show the minus icon for the latest p +arent if(scalar @parents > 1) { $self->updat +eItemStyle($parents[0]->[1]); } # add ourselves under latest parent $path = $self->addItemUnder($parents[0 +]->[1]); $self->setItemContents($path, $curText +); # add ourselves as the latest parent unshift @parents, [ $curHead, $path ]; } # start new entry $line =~ s/^(\s*-)\s*//; $curHead = $1; $curText = $line; } elsif(defined $curText) { $line =~ s/^\s*//; if($line ne '') { $curText .= "\n" . $line; } } } $self->setActiveItem('root'); $self->setFile($fileName); } ## writes text file based on todo widget contents sub saveFile($$) { my($self, $fileName) = @_; my $tree = $self->{ToDoTree}; # recursively generate lines my(@lines, @paths); @paths = ('root', -1); while(scalar @paths) { my $path = shift @paths; my $offset = shift @paths; if($offset > -1) { my $head = "\t" x $offset; my @contentLines = split(/\n/, $self->getItemC +ontents($path)); push @lines, "$head- " . shift @contentLines; push @lines, map { $head . $_ } @contentLines; } unshift @paths, map { $_, $offset + 1 } $tree->info('c +hildren', $path); } open(FILE, ">$fileName"); print FILE join("\n", @lines), "\n"; close(FILE); $self->setFile($fileName); } ## # Main ## package main; my $app = new App(); MainLoop(); # data items are separated by strings of '======== (name) ========' __DATA__ ======== icon down ======== /* XPM */ static char *down[] = { /* columns rows colors chars-per-pixel */ "15 15 7 1", " c None", "X c black", "# c #C04040", "@ c #D08040", "O c #E0A040", "* c #F0C040", ". c #FFFF40", /* pixels */ " XXXXXX ", " X....X ", " X....X ", " X*.*.X ", " X*.*.X ", " X****X ", " XXXXO*O*XXXXX ", " XOOOOOOOOOOX ", " X@O@O@O@OX ", " X@@@@@@@X ", " X#@#@#X ", " XX###X ", " X##X ", " XXX ", " X " }; ======== icon up ======== /* XPM */ static char *up[] = { /* columns rows colors chars-per-pixel */ "15 15 7 1", " c None", "X c black", "# c #C04040", "@ c #D08040", "O c #E0A040", "* c #F0C040", ". c #FFFF40", /* pixels */ " X ", " XXX ", " X..X ", " XX...X ", " X.*.*.X ", " X*******X ", " X*O*O*O*OX ", " XOOOOOOOOOOX ", " XXXXO@O@XXXXX ", " X@@@@X ", " X@@@@X ", " X#@#@X ", " X####X ", " X####X ", " XXXXXX " }; ======== icon plus ======== /* XPM */ static char *item_plus[] = { /* columns rows colors chars-per-pixel */ "11 11 5 1", " c gray100", ". c #848484", "X c black", "o c gray100", "O c None", /* pixels */ "OOOOOOOOOOO", "O.........O", "O. .O", "O. X .O", "O. X .O", "O. XXXXX .O", "O. X .O", "O. X .O", "O. .O", "O.........O", "OOOOOOOOOOO" }; ======== icon minus ======== /* XPM */ static char *item_minus[] = { /* columns rows colors chars-per-pixel */ "11 11 5 1", " c gray100", ". c #848484", "X c black", "o c gray100", "O c None", /* pixels */ "OOOOOOOOOOO", "O.........O", "O. .O", "O. .O", "O. .O", "O. XXXXX .O", "O. .O", "O. .O", "O. .O", "O.........O", "OOOOOOOOOOO" }; ======== icon todo ======== /* XPM */ static char *todo[] = { /* columns rows colors chars-per-pixel */ "16 16 76 1", " c black", ". c #252626", "X c #262727", "o c #272828", "O c #353636 +", "+ c gray24", "@ c #6C0000", "# c #444545", "$ c gray27", "% c #484949", "& c #4A4B4B", "* c #4B4C4C", "= c #4C4C4 +C", "- c #535353", "; c #545555", ": c #5A5A5A", "> c #616262", ", c #686969", "< c #6C6C6C", "1 c #706C66", "2 c #716D +67", "3 c gray44", "4 c #777777", "5 c #7B7770", "6 c gray50", "7 c #1E6087", "8 c #1B6693", "9 c #1B6A97", "0 c #1B6C9 +9", "q c #1B6F9B", "w c #1C729E", "e c #1B789C", "r c #1C75A0", "t c #1C77A2", "y c #1C7AA5", "u c #3C6A83", "i c #D200 +00", "p c #FA0000", "a c #F64F4F", "s c #AD987A", "d c #958F87", "f c #9B958C", "g c #9C968D", "h c #A09A91", "j c #A29C +93", "k c #AFA088", "l c #A6A094", "z c #B2AA99", "x c #ACA8A0", "c c #B2AEA6", "v c #B7B3AB", "b c #CEB691", "n c #DEC4 +9C", "m c #D3C1A4", "M c #D5C7AF", "N c #E0C69E", "B c #E3CCA8", "V c #E3D0B1", "C c #E5D2B3", "Z c #E8D8BE", "A c #C9DD +E2", "S c #CCDFE4", "D c #CCE0E3", "F c #D4E3E6", "G c #D7E7E8", "H c #EADFC9", "J c #FFC0C0", "K c #EDE5D3", "L c #EEEB +DD", "P c #EFECDE", "I c #E0EBEB", "U c #E5EDED", "Y c #F2F2E9", "T c #F4F8F4", "R c #F7FFFF", "E c None", /* pixels */ "EEEEEEEEEEEEEEEE", "E6666666666666EE", "4RRRRRRRRRRRRR4E", "3Tu789qqw +wwyeT3E", "3TUGDAAAAASFIJ< ", ",YxcxvxcxcxcJp; ", ">PjPjLjPjPjJp@% ", ":KjjjJafh +jJp@l$ ", "-HjH@ppidJp@2z= ", "&Zjjg@ppap@25M&E", "$CjChm@pp@1kdV$E", "+Bjjjhd@@ +15dhB+E", "ONNNNNnbssbnNNOE", "EooooooXXXXoooEE", "EEEEEEEEEEEEEEEE", "EEEEEEEEE +EEEEEEE" };

In reply to Hierarchical Todo List by Anonymous Monk

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others about the Monastery: (5)
As of 2024-03-29 10:34 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found