Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
PerlMonks  

pEdit v0.8 Beta release

by Elijah (Hermit)
on Mar 29, 2004 at 19:52 UTC ( [id://340724]=sourcecode: print w/replies, xml ) Need Help??
Category: GUI Programming
Author/Contact Info Elijah/ZiaTioN ziation@perlskripts.com
Description: This is the newest release to pEdit which was already released to perlmonks a few weeks ago. This newest release has many improved features such as group indention addition and removal, group commenting and un-commenting, added "undo" and "redo" features, new parameter passing function while running scripts, and some new menu layout for better feel. 
#!/usr/bin/perl

################################
################################
##     Written by ZiaTioN     ##
##       Title = pEdit        ##
## version 0.8 (beta release) ##
## http://www.perlskripts.com ##
################################
################################

# The following comments are for perl2exe compilation!

#perl2exe_include Tk;
#perl2exe_include Tk::Text;
#perl2exe_include Tk::Menu;
#perl2exe_include Tk::TextUndo;
#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::TextUndo;
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.8) - (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);

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

# Create necessary widgets
my $t = $mw->Scrolled("TextUndo", -scrollbars => 'e', -font => ['Couri
+er New', '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->separator;
$file_menu->command(-label => '~Save',    
            -command => \&save_file);
$file_menu->command(-label => '~Save As',    
            -command => \&save_as);
$file_menu->separator;
$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 => '~Undo',    
            -command => sub {$t->undo()});
$edit_menu->command(-label => '~Redo',    
            -command => sub {$t->redo()});
$edit_menu->separator;
$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 => '~Total Lines',    
            -command => \&total_lines);
$edit_menu->separator;
$edit_menu->command(-label => '~Text Formatting',    
            -command => \&color_text);
$edit_menu->command(-label => '~Refresh',    
            -command => \&refresh);

my $functions_menu = $menubar->cascade(-label => "~Functions", -tearof
+f => 0);
$functions_menu->command(-label => '~Add Indention',    
            -command => \&addtab);
$functions_menu->command(-label => '~Remove Indention',    
            -command => \&detab);
$functions_menu->separator;
$functions_menu->command(-label => '~Comment',    
            -command => \&comment);
$functions_menu->command(-label => '~Un-Comment',    
            -command => \&uncomment);
$functions_menu->separator;
$functions_menu->command(-label => '~Test Syntax',    
            -command => \&interpret);
$functions_menu->command(-label => '~Run Script',    
            -command => \&run);
$functions_menu->command(-label => '~Run With Arguments',    
            -command => \&runwith);

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');
}elsif (-e "pedit.gif") {
   $ts->Photo('middle', -file=>"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::TextUndo', '<Control-s>', [\&save_file]);
$mw->bind('Tk::TextUndo', '<Control-a>', sub {$t->tagAdd('sel','1.0','
+end')});
$mw->bind('Tk::TextUndo', '<Control-o>', sub {load()});
$mw->bind('Tk::TextUndo', '<Control-n>', [\&clear_new]);
$mw->bind('Tk::TextUndo', '<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 => $t,
                              -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 => $t,
                                       -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 {
   my $args = "" || shift;

   $info = "Executing script!";
   if (!$filename) {
      chomp(my $data = $t->get("1.0", "end"));
      if ($data =~ /\w+/) {
         open (IN, ">syn_check") || $status->insert("end", "Error duri
+ng script execution!\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);
      if ($args) {
         system qq[ start cmd /k perl "$filename" $args];
      }else{
         system qq[ start cmd /k perl "$filename" ];
      }
   }else{
      my($fork);
      if ($args) {
         system qq[ start cmd /k perl "$filename" $args];
      }else{
         system qq[ start cmd /k perl "$filename" ];
      }
   }
   $status->delete("1.0", "end");
   $status->insert("end", "Program execution complete!");
}

sub runwith {
   my $args;

   my $argw = $mw->DialogBox(-title => "Enter Script Arguments", -butt
+ons => ["Run", "Cancel"], -popover => $t);
   $argw->add("Entry", -text => \$args)->pack();
   $argw->resizable('no','no');
   my $response = $argw->Show();

   run($args) if ($response eq "Run");
   $argw->destroy if ($response eq "Cancel");
}

##############################################
# addtab accomplishes a block indention level.
sub addtab {
   my ($tab, $spaces, $times);
   $spaces = 3;
   $times  = 0;
   while ($times < $spaces) {
      $tab .=" ";
      $times++;
   }   

   my $selected = $t->getSelected;
   $t->deleteSelected;
   my @splitsel = split(/\n/, $selected);
   foreach (@splitsel) {
      $t->Insert($tab);
      $t->Insert($_);
      $t->Insert("\n");
   }
   refresh();
}

########################################
# detab removes a block indention level.
sub detab {
   my ($spaces, $times, $whites, $char);
   $spaces = 3;
   ($whites, $times)  = 0;

   my $selected = $t->getSelected;
   $t->deleteSelected;
   my @splitsel = split(/\n/, $selected);
   foreach (@splitsel) {
      my @chars = split(//, $_);
      foreach my $char (@chars) {
         if ($char =~ /\s/) { $whites++; }else{ last; }
      }
      if ($whites >= $spaces) {
         $_ = substr($_, $spaces);
      }else{
         $_ = substr($_, $whites);
      }
      $t->Insert($_);
      $t->Insert("\n");
      $whites = 0;
   }
   refresh();
}

########################
# adds block commenting.
sub comment {
   my $selected = $t->getSelected;
   $t->deleteSelected;

   my @splitsel = split(/\n/, $selected);
   foreach (@splitsel) {
      $t->Insert("#");
      $t->Insert($_);
      $t->Insert("\n");
   }
   refresh();
}

###########################
# removes block commenting.
sub uncomment {
   my $selected = $t->getSelected;
   $t->deleteSelected;

   my @splitsel = split(/\n/, $selected);
   foreach (@splitsel) {
      $_ = substr($_, 1) if ($_ =~ /^#/);
      $t->Insert($_);
      $t->Insert("\n");
   }
   refresh();
}

################################################################
# 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
+", "Cancel"], -popover => $t);
      $sw->add("Entry", -text => \$line_number)->pack();
      $sw->resizable('no','no');
      my $response = $sw->Show();
      if ($line_number != 0 && $response eq "Go") {
         &scroll_line;
      }else{
         $sw->destroy;
      }
   }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 = $mw->DialogBox(-title => "Content Has Changed", -but
+tons => ["Save & Exit", "Discard"], -popover => $t);
         $sw->resizable('no','no');
         my $response = $sw->Show();
         if ($response eq "Save & Exit") {
            save_and_exit();
         }else{
            exit(0);
         }
      }
   }elsif($filename eq /\s/ && $data){
      my $sw = $mw->DialogBox(-title => "Content Has Changed", -button
+s => ["Save & Exit", "Discard"], -popover => $t);
      $sw->resizable('no','no');
      my $response = $sw->Show();
      if ($response eq "Save & Exit") {
         save_as();
      }else{
         exit(0);
      }
   }else{
      exit(0);
   }
}
Replies are listed 'Best First'.
Re: pEdit v0.8 Beta release
by Jouke (Curate) on Apr 02, 2004 at 13:42 UTC
    mmm...looks like someone stole my idea of naming applications written in Perl...I already have pVoice, pStory, pType (and more to come)...looks like I'll have to reserve pWordprocessor or something to prevent namespace-clashes :)


    Jouke Visser, Perl 'Adept'
    Using Perl to help the disabled: pVoice and pStory
[reply]

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?

www.com | www.net | www.org
Node Status?
node history
Node Type: sourcecode [id://340724]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others having an uproarious good time at the Monastery: (4)
As of 2024-04-19 22:12 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found