<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">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-&gt;
new (
-title =&gt; "EPod Builder",
-height =&gt; 400,
-width =&gt; 600
);
$mw-&gt;minsize ($mw-&gt;cget (-width), $mw-&gt;cget (-height));
my $menu = $mw-&gt;Menu ();

{
  my %Menu_Bar = Get_Menu ();
  for my $keys (@{ $Menu_Bar{order} })
  {
    my $t = $menu-&gt;cascade (-label =&gt; "$keys");
    for (@{$Menu_Bar{$keys}-&gt;{order}})
    {
      $t-&gt;separator and next if $_ eq "seperator";
      $t-&gt;command (-label =&gt; $_, -command =&gt; $Menu_Bar{$keys}-&gt;{$_});
    }
  }
}

$mw-&gt;configure (-menu =&gt; $menu);
$mw-&gt;packPropagate (0);
my $tree = $mw-&gt;
Scrolled ("Tree",
-width =&gt; 25,
-command =&gt; \&amp;open_text
)-&gt;pack (
-side =&gt; 'left',
-anchor =&gt; 'nw',
-fill =&gt; 'y',
);
$tree-&gt;add ("0", -text =&gt; "POD");
$tree-&gt;autosetmode ();
my $frame_right = $mw-&gt;
Frame (
)-&gt;pack (
-side =&gt; 'right',
# -anchor =&gt; 'center',
-fill =&gt; 'both',
-expand =&gt; 1,
);
my $label = $frame_right-&gt;
Label (
-text =&gt; "",
)-&gt;pack (
-anchor =&gt; 'nw',
);

my $main_text = $frame_right-&gt;
Scrolled ("TextUndo",
-scrollbars =&gt; 'se',
)-&gt;pack (
-fill =&gt; 'both',
-pady =&gt; 40,
-padx =&gt; 15,
-expand =&gt; 1
);
MainLoop;

sub new
{
  my $name;
  my $dialog = $mw-&gt;DialogBox (-title =&gt; "Name", -buttons =&gt; ["Okay", "Cancel"]);
  $dialog-&gt;Label (-text =&gt; "Name:")-&gt;pack (-side =&gt; 'left');
  $dialog-&gt;Entry (-textvariable =&gt; \$name)-&gt;pack (-side =&gt; 'right');
  return 0 if $dialog-&gt;Show eq "Cancel";
  $name = "New$h" if ! $name;
  my $sel = $tree-&gt;info ('selection');
  $sel = 0 if ! $sel;
  #if (! $_[0])
  #{
    $tree-&gt;add ("$sel.$h", -text =&gt; "$name");
  #}
=pod
  else
  {
    my $do = $_[0];
    return 0 if $sel == 0;
    my @it = split (/\./, $sel);
    delete $it[$#it];
    my $sel2 = join (".", @it);
    $tree-&gt;add ("$sel2.$h", -text =&gt; "$name", -$do =&gt; $sel);
    $sel = $sel2;
  }
=cut
    push(@list, "$sel.$h");
    @list = sort @list;
    $h++;
}

sub delet
{
  my $dialog = $mw-&gt;DialogBox (-title =&gt; "Delete", -buttons =&gt; ["Yes", "No"]);
  $dialog-&gt;Label (-text =&gt; "Are You Sure you Want to Delete?")-&gt;pack (-side =&gt; 'left');
  return 0 if $dialog-&gt;Show eq "No";
  my $sel;
  defined ($_[0])? $sel = $_[0] : $sel = $tree-&gt;info ('selection');
  return 0 if ! defined $sel;
  $tree-&gt;delete ("offspring", $sel);
  $tree-&gt;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-&gt;get ('1.0', 'end');
  $main_text-&gt;delete ('1.0', 'end');
};
$label-&gt;configure (-text =&gt; $tree-&gt;entrycget ($it, -text));
chomp $data{$it};
$main_text-&gt;insert ('1.0', $data{$it});
$former = $it;
}

sub save
{
my $file;
$file = $mw-&gt;getSaveFile (-defaultextension =&gt; '.epod');
return 0 if ! $file;
my $data;
open_text (0);
open (FILE, "&gt;", $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} &lt;=&gt; $compare_hash{$b}} @list;
    local $, = " ";
    print @list;
    print "\n";
=cut

foreach (@list)
{
  my @array = split (/\./, $_);
  my $length = $#array;
  my $it;
  if ($length &gt; 3) { $it = "*" } else { $it = "=" };
  my $number = $it x $length;
  $data = $data . "\n" . $number . "&gt;" . " " . $tree-&gt;entrycget ($_, -text). "\n" . $data{$_};
  $data = $data . "\n" . "/" . $number . "&gt;" if $length &gt; 3;
}
print FILE $data;
close FILE;
}

sub about_dialog
{
my $dialog = $mw-&gt;DialogBox (-title =&gt; "Name");
$dialog-&gt;Label (-text =&gt; "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")-&gt;pack (-side =&gt; 'left');
$dialog-&gt;Show;
}
sub _rename
{
my $sel = $tree-&gt;info ('selection');
return 0 if $sel == 0;
my $name = $tree-&gt;entrycget ($sel, -text);
my $dialog = $mw-&gt;DialogBox (-title =&gt; "Name", -buttons =&gt; ["Okay", "Cancel"]);
$dialog-&gt;Label (-text =&gt; "Name:")-&gt;pack (-side =&gt; 'left');
$dialog-&gt;Entry (-textvariable =&gt; \$name)-&gt;pack (-side =&gt; 'right');
return 0 if $dialog-&gt;Show eq "Cancel";
$tree-&gt;entryconfigure ($sel, -text =&gt; $name);
}

sub Get_Menu
{
my %Menu_Bar = (
order =&gt; ["~File", '~Edit', 'F~ormat', '~Help'],
"~File" =&gt; {
  order =&gt; ["~New", "~Save", 'seperator', "~Exit"],
  "~New" =&gt; sub
  {
    delet (0); $h = 1
  },
    "~Save" =&gt; \&amp;save,
    "~Exit" =&gt; sub
    {
      my $dialog = $mw-&gt;DialogBox (-title =&gt; "Name", -buttons =&gt; ["Yes", "No", "Cancel"]);
      $dialog-&gt;Label (-text =&gt; "Do you want to Save before leaving?")-&gt;pack (-side =&gt; 'left');
      my $do = $dialog-&gt;Show if @list;
      return 0 if $do eq "Cancel";
      exit if $do eq "No";
      save ()and exit if $do eq "Yes";
      exit;
    },
  },
  "~Help" =&gt; {
    order =&gt; ["~About"],
    "~About" =&gt; \&amp;about_dialog
  },
  "~Edit" =&gt; {
    order =&gt; ["~Undo", "~Redo", "seperator", "C~ut", "~Copy", "~Paste"],
    "~Undo" =&gt; sub
    {
      $main_text-&gt;undo
    },
    "~Redo" =&gt; sub
    {
      $main_text-&gt;redo
    },
    "C~ut" =&gt; sub
    {
      $main_text-&gt;clipboardCut
    },
    "~Paste" =&gt; sub
    {
      $main_text-&gt;clipboardPaste
    },
    "~Copy" =&gt; sub
    {
      $main_text-&gt;clipboardCopy
    },
  },
  "F~ormat" =&gt; {
    order =&gt; ["~Rename", 'seperator', "Insert New ~Child", 'seperator', "~Delete Selected"],
    "~Rename" =&gt; [\&amp;_rename],
    "Insert New ~Child" =&gt; [\&amp;new],
    "~Delete Selected" =&gt; [\&amp;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&lt;file&gt;".

=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 &gt; 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
</pre></body></html>