Don't like ads? PRO users don't see any ads ;-)
Public Pastes
Guest

TKX template

By: bgregmc on Jul 15th, 2012  |  syntax: Perl  |  size: 7.88 KB  |  hits: 237  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  1. use strict;
  2. use warnings FATAL => qw( all );
  3. use File::Find;
  4. use File::Path;
  5. use Tkx;
  6. use Tkx::LabEntry;
  7. use Carp;
  8. use YAML qw(DumpFile LoadFile);
  9. use File::Basename qw(basename);
  10. Tkx::package_require("BWidget");
  11. Tkx::package_require("ctext");
  12. Tkx::package_require("style");
  13.  
  14. my $VERSION = '';
  15. my %s;
  16. my %labFrame;
  17. my %frame;
  18. my %labEntry;
  19. my %button;
  20. my %mainWindow;
  21. my @errors;
  22. my @output;
  23.  
  24. $s{debug} = 1;
  25. my $settingFile = $0 . '.settings';
  26. my $errorFile   = $0 . '.errors';
  27.  
  28. buildGui();
  29. loadSettings();
  30.  
  31. Tkx::MainLoop();
  32. exit;
  33.  
  34. sub buildGui
  35. {
  36.     carp() if $s{debug};
  37.  
  38.     addMainWindow();
  39.     addWindowFrame();
  40.     setItemsForAllFrames();
  41.  
  42.     $labEntry{entry1}  = $frame{window}->new_tkx_LabEntry();
  43.     $labEntry{entry2}   = $frame{window}->new_tkx_LabEntry();
  44.     $labEntry{entry3}   = $frame{window}->new_tkx_LabEntry();
  45.     $labEntry{entry4}    = $frame{window}->new_tkx_LabEntry();
  46.  
  47.         addEntry1();
  48.         addEntry2();
  49.         addEntry3();
  50.         addEntry4();
  51.    
  52.     addStartButtons();
  53.        
  54.     setItemsForAllLabEntries();
  55.  
  56.     $mainWindow{mw}->configure( -menu => addMenuBar() );
  57.  
  58.     addSizeGrip();
  59. }
  60.  
  61. sub addSizeGrip
  62. {
  63.     my $sizeGrip = $mainWindow{mw}->new_ttk__sizegrip;
  64.     $sizeGrip->g_pack( -side => 'right' );
  65. }
  66.  
  67. sub addMainWindow
  68. {
  69.     carp() if $s{debug};
  70.     $mainWindow{mw} = Tkx::widget->new('.');
  71.     $mainWindow{mw}->g_wm_title("Template $VERSION");
  72.     #$mainWindow{mw}->g_wm_minsize( 200, 400 );  # force a size if needed.  Helps with some pack layouts
  73.     $mainWindow{mw}->g_wm_iconbitmap('c:\localdata\cockpit\rocket.ico');
  74. }
  75.  
  76. sub addWindowFrame
  77. {
  78.     carp() if $s{debug};
  79.     $frame{window} = $mainWindow{mw}->new_ttk__frame();
  80.     $frame{window}->g_pack( -fill => 'x' );
  81. }
  82.  
  83. sub setItemsForAllFrames
  84. {
  85.     carp() if $s{debug};
  86.     foreach my $key ( keys %labFrame )
  87.     {
  88.         $labFrame{$key}->configure(
  89.             -padding     => '5 5 5 5',
  90.             -borderwidth => 10,
  91.             -relief      => 'sunken'
  92.         );
  93.     }
  94. }
  95.  
  96. sub addEntry1
  97. {
  98.     carp() if $s{debug};
  99.     $labEntry{entry1}->configure(
  100.         -label        => 'Entry 1',
  101.         -textvariable => \$s{entry1}
  102.     );
  103.     $labEntry{entry1}->g_pack( -fill => 'x', -pady => 2 );
  104. }
  105.  
  106. sub addEntry2
  107. {
  108.     carp() if $s{debug};
  109.     $labEntry{entry2}->configure(
  110.         -label           => 'Entry 3',
  111.         -textvariable    => \$s{entry2},
  112.         -validate        => 'all',
  113.         -validatecommand => [
  114.             \&validate_entry2,
  115.             Tkx::Ev( '%d', '%i', '%P', '%s', '%S', '%v', '%V', '%W' ),
  116.             $labEntry{entry2}
  117.         ]
  118.     );
  119.     $labEntry{entry2}->g_pack( -fill => 'x', -pady => 2 );
  120. }
  121.  
  122. sub addEntry3
  123. {
  124.     carp() if $s{debug};
  125.     $labEntry{entry3}->configure(
  126.         -label           => 'Entry 5',
  127.         -textvariable    => \$s{entry3},
  128.         -validate        => 'all',
  129.         -validatecommand => [
  130.             \&validate_entry3,
  131.             Tkx::Ev( '%d', '%i', '%P', '%s', '%S', '%v', '%V', '%W' ),
  132.             $labEntry{entry3}
  133.         ]
  134.     );
  135.     $labEntry{entry3}->g_pack(-fill=>'x',-pady => 2);
  136. }
  137.  
  138. sub addEntry4
  139. {
  140.     carp() if $s{debug};
  141.     $labEntry{entry4}->configure(
  142.         -label           => 'Entry 6',
  143.         -textvariable    => \$s{entry4},
  144.         -validate        => 'all',
  145.         -validatecommand => [
  146.             \&validate_entry4,
  147.             Tkx::Ev( '%d', '%i', '%P', '%s', '%S', '%v', '%V', '%W' ),
  148.             $labEntry{entry4}
  149.         ]
  150.     );
  151.     $labEntry{entry4}->g_pack( -fill => 'x', -pady => 2 );
  152. }
  153. sub setItemsForAllLabEntries
  154. {
  155.     carp() if $s{debug};
  156.     foreach my $key ( keys %labEntry )
  157.     {
  158.         $labEntry{$key}->configure( -width => 30, -justify => 'left' );
  159.     }
  160. }
  161.  
  162. sub validate_entry1
  163. {
  164.     my ( $d, $i, $P, $s, $S, $v, $V, $W ) = @_;
  165.     if ( $s eq "" )
  166.     {
  167.  
  168.     }
  169.     else
  170.     {
  171.  
  172.     }
  173.     return 1;
  174. }
  175.  
  176. sub validate_entry2
  177. {
  178.     my ( $d, $i, $P, $s, $S, $v, $V, $W ) = @_;
  179.     if ( $s eq "" )
  180.     {
  181.     }
  182.     else
  183.     {
  184.     }
  185.     return 1;
  186. }
  187.  
  188. sub validate_entry3
  189. {
  190.     my ( $d, $i, $P, $s, $S, $v, $V, $W ) = @_;
  191.     if ( $s eq "" )
  192.     {
  193.     }
  194.     else
  195.     {
  196.     }
  197.     return 1;
  198. }
  199.  
  200. sub validate_entry4
  201. {
  202.     my ( $d, $i, $P, $s, $S, $v, $V, $W ) = @_;
  203.     if ( $s eq "" )
  204.     {
  205.     }
  206.     else
  207.     {
  208.     }
  209.     return 1;
  210. }
  211.  
  212. sub addStartButtons
  213. {
  214.     carp() if $s{debug};
  215.     $button{start} =
  216.       $frame{window}->new_ttk__button( -text => 'Start', -command => \&run );
  217.     $button{start}->g_pack( -fill=>'x' );
  218. }
  219. sub addMenuBar
  220. {
  221.     carp() if $s{debug};
  222.     Tkx::option_add( "*Menu.tearOff", 0 );
  223.     my $menuParent  = $mainWindow{mw}->new_menu();
  224.     my $fileMenu    = $menuParent->new_menu();
  225.     my $settingMenu             = $menuParent->new_menu();
  226.     my $helpMenu    = $menuParent->new_menu();
  227.     my $control     = "Control";
  228.     my $ctrl        = "Ctrl+";
  229.  
  230.     $menuParent->add_cascade( -label => "File",     -menu => $fileMenu );
  231.     $menuParent->add_cascade( -label => "Settings", -menu => $settingMenu );
  232.     $menuParent->add_cascade( -label => "Help",     -menu => $helpMenu );
  233.     $fileMenu->add_command(
  234.         -label       => "Exit",
  235.         -underline   => 1,
  236.         -accelerator => $ctrl . "Q",
  237.         -command     => [ \&Tkx::destroy, $mainWindow{mw} ],
  238.     );
  239.     Tkx::bind( "all", "<$control-q>", [ \&Tkx::destroy, $mainWindow{mw} ] );
  240.     $settingMenu->add_checkbutton(
  241.         -label    => "Option 1",
  242.         -variable => \$s{Option_1},
  243.         -onvalue  => 1,
  244.         -offvalue => 0
  245.     );
  246.     $settingMenu->add_checkbutton(
  247.         -label    => "Option 2",
  248.         -variable => \$s{Option_2},
  249.         -onvalue  => 1,
  250.         -offvalue => 0
  251.     );
  252.     $settingMenu->add_checkbutton(
  253.         -label    => "Option 3",
  254.         -variable => \$s{Option_3},
  255.         -onvalue  => 1,
  256.         -offvalue => 0
  257.     );
  258.     $settingMenu->add_checkbutton(
  259.         -label    => "Option 4",
  260.         -variable => \$s{Option_4},
  261.         -onvalue  => 1,
  262.         -offvalue => 0
  263.     );
  264.         $settingMenu->add_checkbutton(
  265.         -label    => "Save Settings",
  266.         -variable => \$s{save},
  267.         -onvalue  => 1,
  268.         -offvalue => 0
  269.     );
  270.     $helpMenu->add_command(
  271.         -label   => "View ReadMe file",
  272.         -command => sub { loadToPad('ReadMe.txt') },
  273.     );
  274.     $helpMenu->add_checkbutton(
  275.         -label    => "Debug Mode",
  276.         -variable => \$s{debug},
  277.         -onvalue  => 1,
  278.         -offvalue => 0
  279.     );
  280.     $helpMenu->add_command(
  281.         -label   => "About",
  282.         -command => sub {
  283.             Tkx::tk___messageBox(
  284.                 -parent  => $mainWindow{mw},
  285.                 -title   => "About svgrep",
  286.                 -type    => "ok",
  287.                 -icon    => "info",
  288.                 -message => "Template $VERSION using Tkx $Tkx::VERSION\n"
  289.                   . "Copyright ... ... ...  "
  290.                   . "All rights reserved.",
  291.             );
  292.         }
  293.     );
  294.     return $menuParent;
  295. }
  296. sub run
  297. {
  298.         return 0 unless $s{entry1} or $s{entry2} or $s{entry3} or $s{entry4};
  299.         foreach my $key (keys %s)
  300.         {
  301.                 trim($s{$key});
  302.         }
  303.        
  304.     writeSettings() if $s{save};
  305.     carp()          if $s{debug};
  306.     @errors = ();
  307.     Tkx::update();
  308. }
  309.  
  310.  
  311. sub writeSettings
  312. {
  313.     carp() if $s{debug};
  314.     DumpFile( $settingFile, \%s );
  315. }
  316.  
  317. sub loadSettings {
  318.     if ( -e $settingFile ) {
  319.         my $settings = LoadFile($settingFile);
  320.         foreach my $key ( keys %$settings ) {
  321.             $s{$key} = delete $settings->{$key};
  322.         }
  323.     }
  324. }
  325. sub makeErrorLog
  326. {
  327.     carp("@_") if $s{debug};
  328.     if ( $#errors > 0 )
  329.     {
  330.         open( ERROR_LOG, '>>' . "$errorFile" );
  331.         foreach (@errors) { print ERROR_LOG ( $_ . "\n" ); }
  332.         close(ERROR_LOG);
  333.     }
  334. }
  335.  
  336. sub trim
  337. {
  338.     carp() if $s{debug};
  339.     my $string = shift;
  340.     if ($string){
  341.                 chomp($string);
  342.                 $string =~ s/^\s+//;
  343.                 $string =~ s/\s+$//;
  344.                 return $string;
  345.         }
  346. }
  347. __END__
create a new version of this paste RAW Paste Data