use strict; use Tk; use Tk::Tree; use Tk::TextUndo; use Tk::DialogBox; my $h = 1; my %data; my $former; my @list; my $mw = MainWindow-> new ( -title => "EPod Builder", -height => 400, -width => 600 ); $mw->minsize ($mw->cget (-width), $mw->cget (-height)); my $menu = $mw->Menu (); { my %Menu_Bar = Get_Menu (); for my $keys (@{ $Menu_Bar{order} }) { my $t = $menu->cascade (-label => "$keys"); for (@{$Menu_Bar{$keys}->{order}}) { $t->separator and next if $_ eq "seperator"; $t->command (-label => $_, -command => $Menu_Bar{$keys}->{$_}); } } } $mw->configure (-menu => $menu); $mw->packPropagate (0); my $tree = $mw-> Scrolled ("Tree", -width => 25, -command => \&open_text )->pack ( -side => 'left', -anchor => 'nw', -fill => 'y', ); $tree->add ("0", -text => "POD"); $tree->autosetmode (); my $frame_right = $mw-> Frame ( )->pack ( -side => 'right', # -anchor => 'center', -fill => 'both', -expand => 1, ); my $label = $frame_right-> Label ( -text => "", )->pack ( -anchor => 'nw', ); my $main_text = $frame_right-> Scrolled ("TextUndo", -scrollbars => 'se', )->pack ( -fill => 'both', -pady => 40, -padx => 15, -expand => 1 ); MainLoop; sub new { my $name; my $dialog = $mw->DialogBox (-title => "Name", -buttons => ["Okay", "Cancel"]); $dialog->Label (-text => "Name:")->pack (-side => 'left'); $dialog->Entry (-textvariable => \$name)->pack (-side => 'right'); return 0 if $dialog->Show eq "Cancel"; $name = "New$h" if ! $name; my $sel = $tree->info ('selection'); $sel = 0 if ! $sel; #if (! $_[0]) #{ $tree->add ("$sel.$h", -text => "$name"); #} =pod else { my $do = $_[0]; return 0 if $sel == 0; my @it = split (/\./, $sel); delete $it[$#it]; my $sel2 = join (".", @it); $tree->add ("$sel2.$h", -text => "$name", -$do => $sel); $sel = $sel2; } =cut push(@list, "$sel.$h"); @list = sort @list; $h++; } sub delet { my $dialog = $mw->DialogBox (-title => "Delete", -buttons => ["Yes", "No"]); $dialog->Label (-text => "Are You Sure you Want to Delete?")->pack (-side => 'left'); return 0 if $dialog->Show eq "No"; my $sel; defined ($_[0])? $sel = $_[0] : $sel = $tree->info ('selection'); return 0 if ! defined $sel; $tree->delete ("offspring", $sel); $tree->delete ("entry", $sel)unless $sel == 0; foreach (0 .. $#list) { if ($list[$_] =~ /^$sel/) { delete $list[$_]; delete $data{$list[$_]}; } } $, = ", "; my @new_list; foreach (@list) { push @new_list, $_ unless m/^$/ }; @list = @new_list; } sub open_text { my $it = shift; if ($former) { $data{$former} = $main_text->get ('1.0', 'end'); $main_text->delete ('1.0', 'end'); }; $label->configure (-text => $tree->entrycget ($it, -text)); chomp $data{$it}; $main_text->insert ('1.0', $data{$it}); $former = $it; } sub save { my $file; $file = $mw->getSaveFile (-defaultextension => '.epod'); return 0 if ! $file; my $data; open_text (0); open (FILE, ">", $file)or return 0 and print "Cannot"; =pod my @copy = @list; my %compare_hash; foreach (0 .. @copy) { $copy[$_] =~ s/\.//; $copy[$_] .= 0; substr($copy[$_], 1, 0, "."); $compare_hash{ $list[$_] } = $copy[$_]; } @list = sort {$compare_hash{$a} <=> $compare_hash{$b}} @list; local $, = " "; print @list; print "\n"; =cut foreach (@list) { my @array = split (/\./, $_); my $length = $#array; my $it; if ($length > 3) { $it = "*" } else { $it = "=" }; my $number = $it x $length; $data = $data . "\n" . $number . ">" . " " . $tree->entrycget ($_, -text). "\n" . $data{$_}; $data = $data . "\n" . "/" . $number . ">" if $length > 3; } print FILE $data; close FILE; } sub about_dialog { my $dialog = $mw->DialogBox (-title => "Name"); $dialog->Label (-text => "This Program Was Created By William Gunther on Febuary 14, 2004.\nEmail WilliamGunther\@aol.com for bugs and suggestions\nCopyright 2004 William Gunther. You may redistribute it under the same liscense as Perl itself")->pack (-side => 'left'); $dialog->Show; } sub _rename { my $sel = $tree->info ('selection'); return 0 if $sel == 0; my $name = $tree->entrycget ($sel, -text); my $dialog = $mw->DialogBox (-title => "Name", -buttons => ["Okay", "Cancel"]); $dialog->Label (-text => "Name:")->pack (-side => 'left'); $dialog->Entry (-textvariable => \$name)->pack (-side => 'right'); return 0 if $dialog->Show eq "Cancel"; $tree->entryconfigure ($sel, -text => $name); } sub Get_Menu { my %Menu_Bar = ( order => ["~File", '~Edit', 'F~ormat', '~Help'], "~File" => { order => ["~New", "~Save", 'seperator', "~Exit"], "~New" => sub { delet (0); $h = 1 }, "~Save" => \&save, "~Exit" => sub { my $dialog = $mw->DialogBox (-title => "Name", -buttons => ["Yes", "No", "Cancel"]); $dialog->Label (-text => "Do you want to Save before leaving?")->pack (-side => 'left'); my $do = $dialog->Show if @list; return 0 if $do eq "Cancel"; exit if $do eq "No"; save ()and exit if $do eq "Yes"; exit; }, }, "~Help" => { order => ["~About"], "~About" => \&about_dialog }, "~Edit" => { order => ["~Undo", "~Redo", "seperator", "C~ut", "~Copy", "~Paste"], "~Undo" => sub { $main_text->undo }, "~Redo" => sub { $main_text->redo }, "C~ut" => sub { $main_text->clipboardCut }, "~Paste" => sub { $main_text->clipboardPaste }, "~Copy" => sub { $main_text->clipboardCopy }, }, "F~ormat" => { order => ["~Rename", 'seperator', "Insert New ~Child", 'seperator', "~Delete Selected"], "~Rename" => [\&_rename], "Insert New ~Child" => [\&new], "~Delete Selected" => [\&delet], }, ); } =pod =head1 Description This is a builder for the EPOD extension. Epod.pm is a Perl Module for easily creating and maintaining pod files in perl. This Perl/Tk Program takes that ease one step forward in creating a graphical interface to make PODs. This Documentation is being written in the EPod Builder. This Module will create an EPod file with the given input (there is a tree structure to it). Then, using the EPod Module, which is shiped with a script that can be called "epod2pod I". =head1 Getting Started Here's how to do it. First run it. You need to have the following Modules Installed: Tk Tk::Tree Tk::Undo Tk::DialogBox You should see a new Window pop up. On the left is a Tree Item. This is where the basic structure of the POD will go. On the Right is a text box that contains the text in the structure. To get started click on the Format Menu. You see some simple instructions. The ones you will be using the most are in the middle. The Insert Command. Click on the word "POD" in the tree section. Everything below this is in the POD currently. After "POD" is selected click Format > Insert New Child. You should see a dialog box pop up asking you to name the new child. Name it and click "Okay" You should notice that under POD you see a new child in which you named. Double Click on it. You now that the name appears above the TextBox. Write something in the TextBox. Save it, run epod2pod, and you have just created a new new POD file. Great isn't it? =head2 Commands =head3 Delete Deletes the currently selected Child. Confirmation Dialog Box appears. =head3 Insert New Child Currently the only Insertion Method. Inserts something below the currently selected child. If no Child is selected, inserts below POD. =head3 Rename Rename the currently Selected Child. Dialog Box will pop up. =head1 Author William Gunther (Pause ID: WILL) =head1 Bugs Lots of them Lurking. Not just Bugs. But lots of funny quirks. Like no Open button. I will fix these things when I get in the mood. =head1 SCRIPT CATEGORIES CPAN/Administrative =head1 Copyright Copyright 2004 William Gunther. You may edit, use, or redistribute it under the same license as Perl itself. =cut