#!/usr/bin/perl

################################
################################
##     Written by ZiaTioN     ##
##       Title = pEdit        ##
## version 0.7 (beta release) ##
################################
################################

# The following comments are for perl2exe compilation!

#perl2exe_include Tk;
#perl2exe_include Tk::Text;
#perl2exe_include Tk::Menu;
#perl2exe_include Tk::Photo;
#perl2exe_include Tk::Scrollbar;
#perl2exe_include Tk::DialogBox;
#perl2exe_include Tk::Radiobutton;
#perl2exe_include strict;
#perl2exe_include File::Compare;
#perl2exe_include Win32::Printer;

#perl2exe_bundle "pedit.gif"

use Tk;
use Tk::Text;
use Tk::Menu;
use Tk::Scrollbar;
use Tk::DialogBox;
use Tk::Radiobutton;
use strict;
use File::Compare;
use Win32::Printer;

our($filename, $info, $line_number, $search_string,
    $count, $num, $last, $last_search, $trigger, $total_lines);

my $main_title = "pEdit v(0.7) - (beta release)";
my $text_coloring = 1;
our $Comment = '#';

our %Highlights = (
   Red_Keyword   => [qw(red bold)],
   Blue_Keyword  => [qw(blue bold)],
   Green_Keyword => [qw(green bold)],
   Brown_Keyword => [qw(brown bold)],
   Comment       => [qw(grey italic)],
   Found         => [qw(big_italic bold)],
);

our @Red_Keywords = qw(print sprintf);

our @Blue_Keywords = qw(if elsif else my our use sub);

our @Green_Keywords = qw(while foreach loop);

our @Brown_Keywords = qw(split glob substr length open close chomp cho
+p next unless push pop);

#our $All_Keys = "print|sprintf|if|elsif|else|my|our|use|sub|while|for
+each|loop|split|
#                 glob|substr|length|open|close|chomp|chop|next|unless
+|push|pop";

my $mw = MainWindow->new();
$mw->minsize(qw(350 200));
$mw->title($main_title);

# Create necessary widgets
my $t = $mw->Scrolled("Text", -scrollbars => 'e', -font => ['Courier N
+ew', '10'])->pack(-side => 'top', 
                     -fill => 'both', -expand => 1);
my $ts = $mw->Frame->pack(-side => 'top', -fill => 'x');
my $status = $mw->Scrolled("Text", -scrollbars => 'e', -height => '8',
+ -font => '12')->
                           pack(-side => 'top',-fill => 'x', -expand =
+> 0);

#####################################################
#Start of menubar creation
my $menubar = $mw->Menu;

my $file_menu = $menubar->cascade(-label => "~File", -tearoff => 0);
$file_menu->command(-label => '~Open',    
            -command => \&load);
$file_menu->command(-label => '~New/Clear',    
            -command => \&clear_new);
$file_menu->command(-label => '~Save',    
            -command => \&save_file);
$file_menu->command(-label => '~Save As',    
            -command => \&save_as);
$file_menu->command(-label => '~Print',    
            -command => \&print);
$file_menu->command(-label => '~Exit',    
            -command => \&close);

my $edit_menu = $menubar->cascade(-label => "~Edit", -tearoff => 0);
$edit_menu->command(-label => '~Find',    
            -command => sub {find($t, '1.0', 'end')});
$edit_menu->command(-label => '~Go To',    
            -command => \&go_to);
$edit_menu->command(-label => '~Text Formatting',    
            -command => \&color_text);
$edit_menu->command(-label => '~Total Lines',    
            -command => \&total_lines);
$edit_menu->command(-label => '~Refresh',    
            -command => \&refresh);

my $functions_menu = $menubar->cascade(-label => "~Functions", -tearof
+f => 0);
$functions_menu->command(-label => '~Test Syntax',    
            -command => \&interpret);
$functions_menu->command(-label => '~Run Script',    
            -command => \&run);

my $help_menu = $menubar->cascade(-label => "~Help", -tearoff => 0);
$help_menu->command(-label => '~About',    
            -command => \&about);
$help_menu->command(-label => '~Release Notes',    
            -command => \&release);

$mw->configure(-menu => $menubar);
#End of menubar creation
#######################################################

my $temp_dir = $ENV{TEMP} || $ENV{TMP} || ($^O eq "MSWin32" ? $ENV{WIN
+DIR} : '/tmp');

$mw->Label(-textvariable => \$info, -relief => 'ridge')->
   pack(-side => 'bottom', -fill => 'x');

if (-e $temp_dir."\\pedit.gif") {
   $ts->Photo('middle', -file=>$temp_dir."\\pedit.gif");
   $ts->Label(-image=>'middle')->pack(-side=>'bottom');
}

$t->tagConfigure("blue",   -foreground => "blue");
$t->tagConfigure("red",    -foreground => "red");
$t->tagConfigure("orange", -foreground => "orange");
$t->tagConfigure("brown",  -foreground => "brown");
$t->tagConfigure("grey",   -foreground => "grey");
$t->tagConfigure("green",  -foreground => "forest green");


$t->tagConfigure('bold',       -font => ['Courier New', 10, 'bold']);
$t->tagConfigure('italic',     -font => ['Courier New', 10, 'italic'])
+;
$t->tagConfigure('big_italic', -font => ['Times New Roman', 20, 'itali
+c']);

######################################################################
+#######
# Some of my own bindings!

$mw->bind('Tk::Text', '<Control-s>', [\&save_file]);
$mw->bind('Tk::Text', '<Control-a>', sub {$t->tagAdd('sel','1.0','end'
+)});
$mw->bind('Tk::Text', '<Control-o>', sub {load()});
$mw->bind('Tk::Text', '<Control-n>', [\&clear_new]);
$mw->bind('Tk::Text', '<Control-p>', [\&print]);
$mw->bind('<MouseWheel>' => 
[ sub { $_[0]->yview('scroll', -($_[1] / 120) * 4, 'units') }, Ev('D')
+ ]); 

# Automatically prepends $t to called sub's args
$t->bind('<KeyRelease>', [\&highlight_range, 'insert linestart', 'inse
+rt lineend']);

# Paste events may include more than one line to be formatted,
# so we rehighlight the entire text.
$t->bind('<<Paste>>', [\&highlight_range, '1.0', 'end']);
######################################################################
+#######

#$t->focus();

if ($ARGV[0]) {
   load($ARGV[0]);
}

MainLoop();

######################################################################
+###
# Remove all formatting so that updates will unhighlight things proper
+ly.
sub unhighlight_range {
  my $t     = shift;
  my $start = shift;
  my $end   = shift;

  foreach my $style (keys %Highlights) {
    foreach my $tag (@{$Highlights{$style}}) {
      $t->tagRemove($tag, $start, $end);
    }
  }
}

##################################################################
# This is the meat and potatoes of the text formatting (coloring).
sub highlight_range {
   my $t     = shift;
   my $start = shift;
   my $end   = shift;

   if ($text_coloring == 1) {
      unhighlight_range($t, $start, $end);

      my $word_len = length $Comment;
      my $next = $start;
      while (my $comm = $t->search(-regexp => $Comment, $next, $end)) 
+{
         $next = "$comm + $word_len chars";

         if($comm) {
            mark_word($t, $comm, "$comm lineend", 'Comment');
         }
      }
 
      foreach my $word (@Red_Keywords) {
         my $word_len = length $word;
         my $next = $start;
         while (my $from = $t->search(-regexp, "\\b\Q$word\E\\b", $nex
+t, $end)) {
            $next = "$from + $word_len chars";

            # Search for a comment character on the same line
            my $comment = $t->search(
               -regexp => $Comment,
               "$from linestart" => "$from lineend"
            );     

            # If comment found and is before keyword, skip keyword for
+matting
            unless($comment and $t->compare($comment, '<', $from)) {
               mark_word($t, $from, $next, 'Red_Keyword');
            }
         }
      } 

      foreach my $word (@Blue_Keywords) {
         my $word_len = length $word;
         my $next = $start;
         while (my $from = $t->search(-regexp, "\\b\Q$word\E\\b", $nex
+t, $end)) {
            $next = "$from + $word_len chars";

            # Search for a comment character on the same line
            my $comment = $t->search(
              -regexp => $Comment,
              "$from linestart" => "$from lineend"
            );

            # If comment found and is before keyword, skip formatting
            unless($comment and $t->compare($comment, '<', $from)) {
              mark_word($t, $from, $next, 'Blue_Keyword');
            }
         }
      }

      foreach my $word (@Green_Keywords) {
         my $word_len = length $word;
         my $next = $start;
         while (my $from = $t->search(-regexp, "\\b\Q$word\E\\b", $nex
+t, $end)) {
            $next = "$from + $word_len chars";

            # Search for a comment character on the same line
            my $comment = $t->search(
              -regexp => $Comment,
              "$from linestart" => "$from lineend"
            );

            # If comment found and is before keyword, skip formatting
            unless($comment and $t->compare($comment, '<', $from)) {
              mark_word($t, $from, $next, 'Green_Keyword');
            }
         }
      }

      foreach my $word (@Brown_Keywords) {
         my $word_len = length $word;
         my $next = $start;
         while (my $from = $t->search(-regexp, "\\b\Q$word\E\\b", $nex
+t, $end)) {
            $next = "$from + $word_len chars";
 
            # Search for a comment character on the same line
            my $comment = $t->search(
              -regexp => $Comment,
              "$from linestart" => "$from lineend"
            );

            # If comment found and is before keyword, skip formatting
            unless($comment and $t->compare($comment, '<', $from)) {
              mark_word($t, $from, $next, 'Brown_Keyword');
            }
         }
      }
   }
}

######################################################################
+######################
# mark_word does the actual tagging of text once "highlight_range" is 
+done parsing the file.
sub mark_word {
   my $text  = shift;
   my $start = shift;
   my $end   = shift;
   my $style = shift;

   return unless exists $Highlights{$style};

   foreach my $tag (@{$Highlights{$style}}) {
     $text->tagAdd($tag, $start, $end);
   }
}

######################################
# open does just that, opens the file.
sub load {
   my $browse = shift;

   if (!$browse) {$browse = $t->getOpenFile(-title => "Browse For A Fi
+le!");}
   if ($browse) {
      $t->delete("1.0", "end");
      $status->delete("1.0", "end");
      if (!open(TARGET, "$browse")) {
         $info = "Error!";
         $status->insert("end", "ERROR: Could not open $browse\n"); 
         return; 
      }
      $filename = $browse;

      $info = "Loading file '$filename'...";
      $total_lines = 0;
      while (<TARGET>) {
         $t->insert("end", $_);
         $total_lines++;
      }
      close(TARGET);
      $info = "File $filename loaded";
      $mw->title("$main_title ".$filename);

      highlight_range($t, '1.0', 'end');

   }else{
      return;
   }
}

######################################################################
+#############
# refresh simply refreshes the text formatting, total lines and the st
+atus section.
sub refresh {
   $status->delete("1.0", "end");
   chomp(my $data = $t->get("1.0", "end"));
   if (!$filename && $data ne /\s+/) {
      my @data = split(/\n/, $data);
      $total_lines = 1;
      foreach my $line (@data) {
         $total_lines++;
      }
   }

   if ($text_coloring == 1) {
      highlight_range($t, '1.0', 'end');
   }elsif ($text_coloring == 0) {
      unhighlight_range($t, '1.0', 'end');
   }
}

# clear_new initiates a new session.
sub clear_new {
   $t->delete("1.0", "end");
   $status->delete("1.0", "end");
   $filename = "";
   $total_lines = 0;
   $mw->title("$main_title ".$filename);
}

#########################################
# print does what it says it does, print!
sub print {
   $status->delete("1.0", "end");
   my $dc = new Win32::Printer(
                              papersize       => 1,
                              dialog          => NOSELECTION,
                              description     => 'subject',
                              unit            => 'mm'
                              );

   #my $font = $dc->Font('Arial Bold', 24);
   #$dc->Font($font);
   #$dc->Color(0, 0, 255);
   $status->insert("end", "Printing Document:\n".$filename);
   chomp(my $page = $t->get("1.0", "end"));
   my @page = split(/\n/, $page);
   my $y = 15;
   foreach (@page) {
      $dc->Write($_, 10, $y, 800, 100, [0x00000010]);
      $y+=3;
   }
   $dc->Close();
   $status->delete("1.0", "end");
   $info = "Print job complete!";
}

######################################################################
# save_as prompts user for directory and filename to save the file as.
sub save_as {
   my $save = $t->getSaveFile(-title => "Saving File!");
   $info = "Saving $save";
   chomp(my $data = $t->get("1.0", "end"));

   if ($save) {
      open (FH, ">$save") || $status->insert("end", "Cannot open \"$sa
+ve\"\n");
      print FH $data;
      close(FH);
      $info = "Saved.";
      $filename = $save;
      $mw->title("$main_title ".$filename);
      refresh();
   }else{
      $status->delete("1.0", "end");
      $status->insert("end", "File save has been cancelled!");
   }
}

###############################################################
# save_file saves the file using the filename in the Entry box.
sub save_file {
   if ($filename) {
      $info = "Saving $filename";
      chomp(my $data = $t->get("1.0", "end"));

      open (FH, ">$filename") || $status->insert("end", "Cannot open \
+"$filename\"\n");
      print FH $data;
      close(FH);

      $info = "Saved.";
   }else{
      $status->delete("1.0", "end");
      $status->insert("end", "Error while saving!\nYou must choose \"S
+ave As\" for new file.\n");
      save_as();
   }
}

######################################################################
+#########
# save_and_exit saves the current file to the current filename and the
+n exists.
sub save_and_exit {
   if ($filename) {
      chomp(my $data = $t->get("1.0", "end"));

      open (FH, ">$filename") || $status->insert("end", "Cannot open \
+"$filename\"\n");
      print FH $data;
      close(FH);

      exit 0;
   }else{
      $status->delete("1.0", "end");
      $status->insert("end", "Error while saving!\nYou must choose \"S
+ave As\" for new file.\n");
      save_as();
   }
}

######################################################################
+###########################
# total_lines keeps track of the amount of lines in a file and reports
+ this amount when prompted.
sub total_lines {
   chomp(my $data = $t->get("1.0", "end"));
   if (!$filename && $data ne /\s+/) {
      my @data = split(/\n/, $data);
      $total_lines = 0;
      foreach my $line (@data) {
         $total_lines++;
      }
   }

   if (!$total_lines) {
      $total_lines = 0;
   }#else{
    #  $total_lines--;
   #}
   
   my $tl = $mw->DialogBox(-title => "Number Of Lines", -buttons => ["
+Close"]);
   $tl->add("Entry", -text => \$total_lines)->pack();
   $tl->resizable('no','no');
   $tl->Show();
}

######################################################################
+###################
# color_text is a configurable setting window which will allow the use
+r to turn on or off
# the text formatting.
sub color_text {
   chomp(my $data = $t->get("1.0", "end"));

   if ($data) {
      my $ct = $mw->DialogBox(-title => "Color Code Text?", -buttons =
+> ["Turn On", "Turn Off"]);
      $ct->Label(-text => "Choose your preference for formatted text")
+->pack();
      $ct->resizable('no','no');
      my $response = $ct->Show();

      if ($response eq "Turn On") {
         $text_coloring = 1;
         refresh();
      }else{
         $text_coloring = 0;
         refresh();
      }
   }else{
      $status->delete("1.0", "end");
      $status->insert("end", "No text to format!\n");
   }
}

######################################################################
+####
# This sub program will scroll the file looking for the user input str
+ing.
sub find {
   my $t     = shift;
   my $start = shift;
   my $end   = shift;

   chomp(my $data = $t->get("1.0", "end"));
   
   if ($data ne /\s+/) {
      my $fw = $mw->DialogBox(-title => "Search", -buttons => ["Search
+", "Quit"], -popover => $status,
                              -command => sub {&search if ($search_str
+ing ne /\s/ && $_[0] eq "Search")});
      $fw->add("Entry", -text => \$search_string)->pack();
      $fw->resizable('no','no');
      $fw->Show();

      sub search {;
         my $next = "1.0";
         chomp(my $string = $search_string);
         $status->delete("1.0", "end");
         $status->insert("end", "Searching for \"$string\"\n----------
+-------------------");

         my $string_len = length $string;
         my $next = $start;
         while (my $found = $t->search(-regexp => $string, $next, $end
+)) {
            $next = "$found + $string_len chars";

            if($found) {
               my @line = split(/\./, $found);
               refresh();
               mark_word($t, $found, $next, 'Found');
               &go_to($line[0]);      
               my $fw = $mw->DialogBox(-title => "Find Next", -buttons
+ => ["Next", "Quit"], -popover => $status,
                                       -command => sub {last if ($_[0]
+ eq "Quit")});
               $fw->resizable('no', 'no');
               $fw->Show();
            }
         }
         refresh();
         $status->delete("1.0", "end");
         $status->insert("end", "Finished searching the document!\n");
      }
   }else{
      $status->delete("1.0", "end");
      $status->insert("end", "Error! You cannot search a blank file!!\
+n");
   }      
}

######################################################################
+#
# runs is what calls the perl interpretor and runs the script provided
+.
sub run {
   $info = "Executing script!";
   if (!$filename) {
      chomp(my $data = $t->get("1.0", "end"));
      if ($data =~ /\w+/) {
         open (IN, ">syn_check") || $t->insert("end", "Cannot open \"s
+yn_check\"\n");
         print IN $data;
         close(IN);
      }else{
         $status->delete("1.0", "end");
         $status->insert("end", "Error! No script was provided to run.
+\n");
      }
   }

   if ($filename) {
      my($fork);
      system qq[ start cmd /k perl "$filename" ];
      #system("perl -e\"system 'start cmd';\" /k perl \"$filename\"");
   }else{
      my($fork);
      system qq[ start cmd /k perl "syn_check" ];
   }
   $status->delete("1.0", "end");
   $status->insert("end", "If your script is a command line script ");
   $status->insert("end", "it will appear in the open command prompt.\
+n");
   $status->insert("end", "If it is a GUI interface then you will see 
+it ");
   $status->insert("end", "if you did everything right :-)\n");
}

################################################################
# interpret runs the script with new changes through the Perl
# intrepetor to check the syntax so user will know if there code
# is correct.
sub interpret {
   $info = "Checking script syntax.";
   chomp(my $data = $t->get("1.0", "end"));

   if ($data =~ /\w+/) {
      open (IN, ">syn_check") || $t->insert("end", "Cannot open \"syn_
+check\"\n");
      print IN $data;
      close(IN);
   }else{
      $status->delete("1.0", "end");
      $status->insert("end", "No source code to interpret was found!\n
+");
      $info = "Error while checking syntax!";
      next;
   }

   my $test = `perl -c syn_check 2>&1`;
   $info = "Syntax Tested\!";
   $status->delete("1.0", "end");
   if ($test) {
      if ($test =~ /syn_check syntax OK/i) {
         $status->insert("end", "Syntax passed!\n");
      }else{
         $status->insert("end", $test);
      }
   }else{
      $status->delete("1.0", "end");
      $status->insert("end", "There was an error while receiving respo
+nse from interpretor!\n");
   }
}

######################################################################
+#
# go_to opens a new window prompting user for line number to scroll to
+.
sub go_to {
   my $count = shift;
   chomp(my $data = $t->get("1.0", "end"));
   if (!$filename && $data ne /\s+/) {
      my @data = split(/\n/, $data);
      $total_lines = 1;
      foreach my $line (@data) {
         $total_lines++;
      }
   }

   if ($count) {
      chomp($line_number = $count);
      scroll_line();
   }

   if ($data ne /\s+/ && !$count) {
      my $sw = $mw->DialogBox(-title => "Go To Line", -buttons => ["Go
+"], -popover => $status);
      $sw->add("Entry", -text => \$line_number)->pack();
      $sw->resizable('no','no');
      my $response = $sw->Show();
      if ($line_number != 0 && $response eq "Go") {
         &scroll_line;
      }
   }elsif ($data eq /\s+/){
      $status->delete("1.0", "end");
      $status->insert("end", "Error! You cannot scroll a blank file!\n
+");
   }

   sub scroll_line {
      $line_number--;
      $t->yviewMoveto($line_number/$total_lines);
      $line_number++;
      
   }
}

######################################################################
+####
# release simply pops up a windows displaying the release notes docume
+nted
# in the README.txt file
sub release {
   my $rw = MainWindow->new();
   $rw->minsize(qw(350 200));
   $rw->title("Release Notes!"); 

   my $rt = $rw->Scrolled("Text", -scrollbars => 'e', -font => ['Couri
+er New', '10'])->pack(-side => 'top', 
                     -fill => 'both', -expand => 1);

   if (!open(RELEASE, "README.txt")) {
      $info = "Error!";
      $status->insert("end", "ERROR: Could not open README.txt\n"); 
      return; 
   }

   $info = "Opening release notes...";
   while (<RELEASE>) {
      $rt->insert("end", $_);
   }
   close(RELEASE);
   $info = "Release Notes being viewed!";
}

######################################################################
+###################
# close is triggered by the "Exit" button and performs a check to see 
+if any changes have
# been made before closing. If it detects an y changes it will prompt 
+to save changes.
sub close {
   my $empty = 0;

   chomp(my $data = $t->get("1.0", "end"));

   open (TEMP, ">compare") || $t->insert("end", "Cannot open \"compare
+\"\n");
   print TEMP $data;
   close(TEMP);

   if ($filename ne /\s/) {
      my $compare = compare($filename, "compare");
      if ($compare == 0) {
         exit 0;
      }elsif ($compare == -1) {
         $status->insert("end", "There was an error while comparing!\n
+");
      }else{
         my $sw = MainWindow->new(-title=>"Content Has Changed");
         my $frame = $sw->Frame->pack(-side => 'top', -fill => 'x');
         $frame->Label(-text => "Would you like to save before exiting
+?")->
                       pack(-side => 'left', -anchor => 'w');
         $frame->Button(-text => "No", -background => 'navy blue', -fo
+reground => 'white', -command => sub {exit 0;})->
                        pack(-side => 'right'); 
         $frame->Button(-text => "Yes", -background => 'navy blue', -f
+oreground => 'white', -command =>\&save_and_exit)->
                        pack(-side => 'right'); 
      }
   }elsif($filename eq /\s/ && $data){
      my $sw = MainWindow->new(-title=>"Content Has Changed");
      my $frame = $sw->Frame->pack(-side => 'top', -fill => 'x');
      $frame->Label(-text => "Would you like to save before exiting?")
+->
                    pack(-side => 'left', -anchor => 'w');
      $frame->Button(-text => "No", -background => 'navy blue', -foreg
+round => 'white', -command => sub {exit 0;})->
                     pack(-side => 'right'); 
      $frame->Button(-text => "Yes", -background => 'navy blue', -fore
+ground => 'white', -command =>\&save_as)->
                     pack(-side => 'right'); 
   }else{
      exit 0;
   }
}