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