http://qs321.pair.com?node_id=233970
Category: GUI Programming
Author/Contact Info /msg tremere
Description: The beginnings of a Perl/TK Development Envirment. I will update this as things get better... (I'll clean it up a bit aswell)
#!/usr/bin/perl -w
#
#Program: pde -- Perl Development Envirment
#Author: Tristan Plumb
#Copyright: BSD Licence
#Usage:  pde [file]
#
#Uses:  Perl/Tk, etc.
#
#pde will includes PerlTk builder, syntax highlighting, function help,
+ etc.
#
#THIS IS pde VERSION 0.0.2 EXPECT LITTLE
#
#In Perl for Perl
#
#pde will be version 1.0.0 when I use it to develop itself
#
#TODO:
#fix bug where the height is not updated when window is resized
#Ask for saving/auto save.
#Prefs...
#
#
##(TODO later)
#text highlighting
#(s)ftp client
#debuging console
#Tk Builder -- might incorperate one from PerlMonks
#Reference Lib using pod
#
#Suggestions Welcome...

use strict;
use Tk;
use Tk::NoteBook;
use Tk::TextUndo;

my $main;
my $numopen = 0;
my %files;

#Define stuff

my $file_types = [
  ['Perl Scripts', '.pl'  ],
  ['Perl Modules', '.pm'  ],
  ['Text Files', ['.txt','.text']],
  ['All Files',  '*'  ]
];

my $version = "0.0.2";
my @about_text = <<END;

This is PDE version $version.

PDE is currently a work in progress, do not expect a huge amount.

PDE is copyrighted under the BSD Licence.

END

#Build the widgets

print "Building widgets... Please stand by.\n";

$main = MainWindow->new;
$main->title("Perl Development Envirment $version");

#MAIN MENU#####################################
my $menu_frame = $main->Frame(-relief => 'raised', -borderwidth => 2)-
+>pack(-expand => 0, -fill => 'both');
my $main_menu = $menu_frame->Menu(-relief => 'raised', -borderwidth =>
+ 2);
my %mainmenu;

$mainmenu{'file'} = $menu_frame->Menubutton(-text => 'File', -underlin
+e => 0)->pack(side => 'left', padx => 2);;
$mainmenu{'file'}->command(-label => 'New', -underline => 0, -command 
+=> sub { new_file() });
$mainmenu{'file'}->command(-label => 'Open...', -underline => 0, -comm
+and => sub { load_file() }); 
$mainmenu{'file'}->command(-label => 'Save', -underline => 0, -command
+ => sub { save_file() }); 
$mainmenu{'file'}->command(-label => 'Save As...', -underline => 5, -c
+ommand => sub { save_file_as() });
$mainmenu{'file'}->separator();
$mainmenu{'file'}->command(-label => 'Quit', -underline => 0, -command
+ => sub {$main->destroy });

$mainmenu{'edit'} = $menu_frame->Menubutton(text => 'Edit', -underline
+ => 0)->pack(side => 'left', padx => 2);
$mainmenu{'edit'}->command(-label => 'Undo', -underline => 0, -command
+ => sub { edit_undo() });

$mainmenu{'view'} = $menu_frame->Menubutton(text => 'View', -underline
+ => 0)->pack(side => 'left', padx => 2);

$mainmenu{'windows'} = $menu_frame->Menubutton(text => 'Windows', -und
+erline => 0)->pack(side => 'left', padx => 2);
$mainmenu{'windows'}->command(-label => 'Filler...', -underline => 0);

$mainmenu{'help'} = $menu_frame->Menubutton(text => 'Help', -underline
+ => 0)->pack(side => 'right', padx => 2);
$mainmenu{'help'}->command(-label => 'About', -underline => 0, -comman
+d => sub { about_pde() });

####The rest...(Editing and stuff)####
my $edit_frame = $main->Frame()->pack(-fill => 'both');
my $tabs = $edit_frame->NoteBook()->pack(-fill => 'both');
my @tab;
my @text;

##Load initial file###
unless ($#ARGV == -1) {
  my $file = shift @ARGV;
  chomp $file;
  load_file($file);
} else {
  new_file();
}

MainLoop;

sub new_file {
  $tab[$numopen] = $tabs->add("$numopen", -label => "NewProgram$numope
+n.pl", -state => 'normal');
  $text[$numopen] = $tab[$numopen]->TextUndo(-wrap => 'word', -state =
+> 'normal')->pack(-fill => 'both');
  $tabs->raise($numopen);
  $numopen++;
}

sub load_file {
  my $lfile = shift;
  new_file();
  unless ($lfile) {
    $lfile = $text[$tabs->raised()]->getOpenFile(-filetypes => $file_t
+ypes);
  }
  $text[$tabs->raised()]->Load($lfile);
  $tabs->pageconfigure($tabs->raised(), -label => $text[$tabs->raised(
+)]->FileName());
}

sub save_file {
  my $sfile = shift;
  unless ($sfile) {
    unless ($text[$tabs->raised()]->FileName()) {
      $sfile = $text[$tabs->raised()]->getSaveFile(-filetypes=>$file_t
+ypes);
    } else {
      $text[$tabs->raised()]->Save();
    }
  } else {
    if ($text[$tabs->raised()]->Save($sfile)) {
      $tabs->pageconfigure($tabs->raised(), -label => $text[$tabs->rai
+sed()]->FileName());
    }
  }
}

sub save_file_as {
  my $sfile = $text[$tabs->raised()]->getSaveFile(-filetypes => $file_
+types);
  if ($text[$tabs->raised()]->Save($sfile)) {
    $tabs->pageconfigure($tabs->raised(), -label => $text[$tabs->raise
+d()]->FileName());
  }
}

sub about_pde {
  $tab[$numopen] = $tabs->add("$numopen", -label => "About PDE $versio
+n", -state => 'normal');
  my $about_frame = $tab[$numopen]->Frame()->pack(-side => 'top', -fil
+l => 'both');
  my $about_textbox = $about_frame->Text(-wrap => 'word', -state => 'n
+ormal')->pack(-fill => 'both');
  $about_textbox->insert("0.0", @about_text);
  $about_frame->Button(-text => "Close About Tab", -command => sub {
     $tabs->delete($tabs->raised());
   $numopen--;
   })->pack(-side => 'bottom');
  $tabs->raise($numopen);
  $numopen++;
}

sub edit_undo {
 #Undo works how ??
}