home *** CD-ROM | disk | FTP | other *** search
/ PC World 2004 November / PCWorld_2004-11_cd.bin / software / topware / activeperl / ActivePerl-5.8.4.810-MSWin32-x86.exe / ActivePerl-5.8.4.810 / Perl / bin / gedi.bat < prev    next >
DOS Batch File  |  2004-06-01  |  10KB  |  330 lines
  1. @rem = '--*-Perl-*--
  2. @echo off
  3. if "%OS%" == "Windows_NT" goto WinNT
  4. perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
  5. goto endofperl
  6. :WinNT
  7. perl -x -S %0 %*
  8. if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
  9. if %errorlevel% == 9009 echo You do not have Perl in your PATH.
  10. if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
  11. goto endofperl
  12. @rem ';
  13. #!/usr/local/bin/perl -w
  14. #line 15
  15.  
  16. ###############################################################################
  17. # Copyright (c) 1999  Greg London
  18. # All rights reserved.
  19. # This program is free software.
  20. # You can redistribute it and/or modify it under the same terms as Perl itself.
  21. ###############################################################################
  22.  
  23. ###############################################################################
  24. # This is a perl application, called gedi, implementing a text editor.
  25. # gedi is short for Greg's EDItor. The "g" being pronounced like a "j".
  26. ###############################################################################
  27.  
  28.  
  29. require 5;
  30. use locale;
  31. use strict;
  32.  
  33. use Tk;
  34. use Tk::widgets qw(TextEdit);
  35. use File::Basename;
  36.  
  37. ###########################################
  38. # check command line parameter.
  39. # if none, start with file called 'NewFile'
  40. # if -help, print help
  41. # if filename, open file or die
  42. # note, wildcard automatically gets handled by perl interpreter,
  43. #    so that @ARGV contains list of matches.
  44. ###########################################
  45. my $argcount = @ARGV;
  46. my ($global_filename) = @ARGV;
  47.  
  48. if    ($argcount>1)
  49.     {
  50.     print "\n";
  51.     print "ERROR: too many files specified. \n";
  52.     die "\n";
  53.     }
  54.  
  55. if ($argcount == 0)
  56.     {$global_filename = 'NoName';}
  57.  
  58. if (
  59.     ($global_filename eq 'help') ||
  60.     ($global_filename eq '-help') ||
  61.     ($global_filename eq '-h') ||
  62.     ($global_filename eq '-?')
  63.     )
  64.     {
  65.     print "\n";
  66.     print "$0 expects one command line argument: \n";
  67.     print " the name of the file to edit \n";
  68.     die "\n";
  69.     }
  70.  
  71.  
  72. # want FileSelect to use the last used directory as the starting directory
  73. # store directory in $global_directory.
  74. my $global_directory = dirname($global_filename);
  75.  
  76. ##############################################
  77. ##############################################
  78. ## input parameters have been filtered.
  79. ## set up three frames to put everything into.
  80. ## menu_frame, text_frame, counter_frame
  81. ##############################################
  82. ##############################################
  83. my $top = MainWindow->new();
  84.  
  85. # my $menu_frame = $top->Frame->pack(-anchor=>'nw');
  86. my $text_frame = $top->Frame->pack
  87.     (-anchor=>'nw', expand=>'yes', -fill => 'both'); # autosizing
  88. my $counter_frame = $top->Frame->pack(-anchor=>'nw');
  89.  
  90. ##############################################
  91. ##############################################
  92. ## now set up text window with contents.
  93. ##############################################
  94. ##############################################
  95.  
  96. ## autosizing is set up such that when the outside window is
  97. ## resized, the text box adjusts to fill everything else in.
  98. ## the text frame and the text window in the frame are both
  99. ## set up for autosizing.
  100.  
  101. my $textwindow = $text_frame->Scrolled(
  102.     'TextEdit',
  103.     exportselection => 'true',  # 'sel' tag is associated with selections
  104.     # initial height, if it isnt 1, then autosizing fails
  105.     # once window shrinks below height
  106.     # and the line counters go off the screen.
  107.     # seems to be a problem with the Tk::pack command;
  108.     height => 1,
  109.     -background => 'white',
  110.     -wrap=> 'none',
  111.     -setgrid => 'true', # use this for autosizing
  112.     -scrollbars =>'se')
  113.     -> pack(-expand => 'yes' , -fill => 'both');    # autosizing
  114.  
  115. #$textwindow->FileName($global_filename);
  116.  
  117.  
  118. $top->protocol('WM_DELETE_WINDOW'=>
  119.  sub{$textwindow->ConfirmExit;}
  120.  );
  121.  
  122. $SIG{INT} = sub {$textwindow->ConfirmExit;};
  123.  
  124. ##############################################
  125. ##############################################
  126. ## set up current line number display
  127. ##############################################
  128. ##############################################
  129. my $current_line_label = $counter_frame
  130.     -> Label(text=>'line: 1')
  131.     -> grid(-row=>1,-column=>1, -sticky=>'nw' );
  132.  
  133. my $total_line_label = $counter_frame
  134.     -> Label(text=>'total lines: 1')
  135.     -> grid(-row=>2,-column=>1, -sticky=>'nw' );
  136.  
  137. my $current_column_label = $counter_frame
  138.     -> Label(text=>'column: 0')
  139.     -> grid(-row=>3,-column=>1, -sticky=>'nw' );
  140.  
  141. my $insert_overstrike_mode_label = $counter_frame
  142.     -> Label(text=>' ')
  143.     -> grid(-row=>5,-column=>1, -sticky=>'nw' );
  144.  
  145. sub update_indicators
  146. {
  147.     my ($line,$column)= split(/\./,$textwindow->index('insert'));
  148.     $current_line_label->configure (text=> "line: $line");
  149.     $current_column_label->configure (text=> "column: $column");
  150.  
  151.     my ($last_line,$last_col) = split(/\./,$textwindow->index('end'));
  152.     $total_line_label->configure (text=> "total lines: $last_line");
  153.  
  154.     my $mode = $textwindow->OverstrikeMode;
  155.     my $overstrke_insert='Insert Mode';
  156.     if ($mode)
  157.         {$overstrke_insert='Overstrike Mode';}
  158.     $insert_overstrike_mode_label->configure
  159.         (text=> "$overstrke_insert");
  160.  
  161.     my $filename = $textwindow->FileName;
  162.     $filename = 'NoName' unless(defined($filename));
  163.     my $edit_flag='';
  164.     if($textwindow->numberChanges)
  165.          {$edit_flag='edited';}
  166.     $top->configure(-title => "Gedi  $edit_flag $filename");
  167.     $textwindow->idletasks;
  168.  
  169. }
  170.  
  171. $textwindow->SetGUICallbacks (
  172.  [
  173.   \&update_indicators,
  174.   sub{$textwindow->HighlightAllPairsBracketingCursor}
  175.  ]
  176. );
  177.  
  178.  
  179. ##############################################
  180. ##############################################
  181. # call back functions
  182. ##############################################
  183. ##############################################
  184.  
  185. ########################################################################
  186. my $about_pop_up_reference;
  187. sub about_pop_up
  188. {
  189.     my $name = ref($about_pop_up_reference);
  190.     if (defined($about_pop_up_reference))
  191.         {
  192.         $about_pop_up_reference->raise;
  193.         $about_pop_up_reference->focus;
  194.         }
  195.     else
  196.         {
  197.         my $pop = $top->Toplevel();
  198.         $pop->title("About");
  199.  
  200.         $pop->Label(text=>"Gedi (Gregs EDItor)")->pack();
  201.         $pop->Label(text=>"Ver. 1.0")->pack();
  202.         $pop->Label(text=>"Copyright 1999")->pack();
  203.         $pop->Label(text=>"Greg London")->pack();
  204.         $pop->Label(text=>"All Rights Reserved.")->pack();
  205.         $pop->Label(text=>"This program is free software.")->pack();
  206.         $pop->Label(text=>"You can redistribute it and/or")->pack();
  207.         $pop->Label(text=>"modify it under the same terms")->pack();
  208.         $pop->Label(text=>"as Perl itself.")->pack();
  209.         $pop->Label(text=>"Special Thanks to")->pack();
  210.         $pop->Label(text=>"Nick Ing-Simmons.")->pack();
  211.  
  212.         my $button_ok = $pop->Button(text=>'OK',
  213.             command => sub {$pop->destroy();
  214.             $about_pop_up_reference = undef;
  215.             } )
  216.             ->pack();
  217.         $pop->resizable('no','no');
  218.         $about_pop_up_reference = $pop;
  219.         }
  220. }
  221.  
  222. ##############################################
  223. ##############################################
  224. ## now set up menu bar
  225. ##############################################
  226. ##############################################
  227.  
  228. my $menu = $textwindow->menu;
  229. $top->configure(-menu => $menu);
  230.  
  231. ##############################################
  232. # help menu
  233. ##############################################
  234. my $help_menu = $menu->cascade(-label=>'~Help', -tearoff => 0, -menuitems => [
  235.          [Command => 'A~bout', -command => \&about_pop_up]
  236.          ]);
  237.  
  238. ##############################################
  239. # debug menu
  240. ##############################################
  241.  
  242. if (0)
  243.     {
  244.     my $debug_menu = $menu->cascade(-label=>'debug', -underline=>0);
  245.  
  246.  
  247.     $debug_menu->command(-label => 'Tag names', -underline=> 0 ,
  248.         -command =>
  249.         sub{
  250.         my @tags = $textwindow->tagNames();
  251.         print " @tags\n";
  252.  
  253.         foreach my $tag (@tags)
  254.             {
  255.             my @ranges = $textwindow->tagRanges($tag);
  256.             print "tag: $tag  ranges: @ranges \n";
  257.             }
  258.  
  259.         print "\n\n\n";
  260.         my @marks = $textwindow->markNames;
  261.         print " @marks \n";
  262.         foreach my $mark (@marks)
  263.             {
  264.             my $mark_location = $textwindow->index($mark);
  265.             print "$mark is at $mark_location\n";
  266.             }
  267.  
  268.  
  269.         print "\n\n\n";
  270.         my @dump = $textwindow->dump ( '-tag', '1.0', '465.0' );
  271.         print "@dump \n";
  272.  
  273.         print "\n\n\n";
  274.         print "showing tops children:";
  275.         my @children = $top->children();
  276.         print "@children\n";
  277.  
  278.         foreach my $child (@children)
  279.             {
  280.             my $junk = ref($child);
  281.             print "ref of $child is $junk \n";
  282.             }
  283.  
  284.         my $overstrike = $textwindow->OverstrikeMode;
  285.         print "Overstrike is $overstrike \n";
  286.  
  287.         $textwindow->dump_array($textwindow);
  288.         });
  289.     }
  290.  
  291. ##############################################
  292. # set the window to a normal size and set the minimum size
  293. $top->minsize(30,1);
  294. $top->geometry("80x24");
  295.  
  296. #############################################################################
  297. #############################################################################
  298. #############################################################################
  299. #############################################################################
  300.  
  301.  
  302.  
  303.  
  304. ##############################################
  305. ## this line for debug
  306. ## $top->bind('<Key>', [sub{print "ARGS: @_\n";}, Ev('k'), Ev('K') ]  );
  307.  
  308. ##########################################
  309. ## fill the text window with initial file.
  310.  
  311. if ($argcount)
  312.     {
  313.     if (-e $global_filename) # if it doesn't exist, make it empty
  314.         {
  315.         # it may be a big file, draw the window, and then load it
  316.         # so that we know something is happening.
  317.         $top->update;
  318.         $textwindow->Load($global_filename);
  319.         }
  320.     }
  321.  
  322.  
  323. ##############################################
  324. $textwindow->CallNextGUICallback;
  325.  
  326. MainLoop();
  327.  
  328. __END__
  329. :endofperl
  330.