#!/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" };
-
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.