view release on metacpan or  search on metacpan

orac_Shell.pm  view on Meta::CPAN

		$auto_ball = $sf->Label(-image=> $color_ball{green}, -borderwidth=> 2,
			-relief=> 'flat')->pack(  -side=> 'right', -anchor=>'w');
		$self->bind_message( $auto_ball, "Auto commit" );

		$chng_ball = $sf->Label(-image=> $color_ball{red}, -borderwidth=> 2,
			-relief=> 'flat')->pack(  -side=> 'right', -anchor=>'w');
		$self->bind_message( $chng_ball, "Any changed since last save" );

		$sf->Label( -textvariable => \$dbistatus )->pack(-side => 'left');


		$dbistatus = "Creating menu bar";
		my $f = $dbiwd->Frame( -relief => 'ridge', -borderwidth => 2 );
		$f->pack( -side => 'top', -anchor => 'n', -expand => 1, -fill => 'x' );

		# Put the logo on the menu bar.
		my $orac_logo = $dbiwd->Photo(-file=>'img/orac.gif');
		$f->Label(-image=> $orac_logo, -borderwidth=> 2,
			-relief=> 'flat')->pack(  -side=> 'left', -anchor=>'w');

		# Create a menu bar.
                my @menus;
		foreach (qw/File Edit Options Help/) {
			push( @menus, $f->Menubutton( -text => $_ , -tearoff => 0 ) );
		}

		$menus[3]->pack(-side => 'right' ); # Help
		$menus[0]->pack(-side => 'left' );  # File
		$menus[1]->pack(-side => 'left' );  # Edit
		$menus[2]->pack(-side => 'left' );  # Options

		#
		# Add some options to the menus.
		#
		# File menu
		$menus[0]->AddItems(
			[ "command" => "Load", -command => sub { $self->tba } ],
			[ "command" => "Save", -command => sub { $self->tba } ],
			"-",
			[ "command" => "Properties", -command => sub { $self->tba } ],
			"-",
			[ "command" => "Exit", -command => sub { $self->tba } ],
		);

		# About menu
		$menus[3]->AddItems(
			[ "command" => "Index", -command => sub { $self->tba } ],
			"-",
			[ "command" => "About", -command => sub { $self->tba } ],
		);

		# Options menu
		my $opt_disp = $menus[2]->menu->Menu;
		foreach (qw/raw neat box grid html/) {
			$opt_disp->radiobutton( -label => $_, 
				-variable => \$opt_dis_grid,
				-value => $_,
				);
		}

		$menus[2]->cascade( -label => "Display format..."); 
		$menus[2]->entryconfigure( "Display format...", -menu => $opt_disp);
		$opt_dis_grid = 'neat';

		# Create the entries for rows returned.
		my $opt_row = $menus[2]->menu->Menu;
		foreach (qw/1 10 25 50 100 all/) {
			$opt_row->radiobutton( -label => $_, -variable => \$opt_row_dis_c,
				-value => $_ );
		}
		$menus[2]->cascade( -label => "Rows return..." );
		$menus[2]->entryconfigure( "Rows return...", -menu => $opt_row);
		$opt_row_dis_c = 'all';

		# Create a button bar.
		$dbistatus = "Creating menu button bar";

		my $bf = $dbiwd->Frame( -relief => 'ridge', -borderwidth => 2 );
		$bf->pack( -side => 'top', -anchor => 'n', -expand => 1, -fill => 'x' );

		# need to invoke the execute in other parts of the application.
		$button_exe = $bf->Button( -text=> 'Execute',
			-command=> sub{ $self->execute_sql() }
			)->pack(side=>'left');

		$bf->Button( -text=> 'Clear',
			-command=>sub{
				$self->dbish_clear();
			}
		)->pack(side=>'left');

		$bf->Button( -text=> 'Tables',
			-command=> sub{ $self->tba() }
		)->pack(side=>'left');

		$bf->Button( -text=> 'Copy Results',
			-command=> sub{ $self->tba() }
		)->pack(side=>'left');

		$dbistatus = "Creating Close button";

		$bf->Button( -text => "Close",
			-command => sub { $dbiwd->withdraw;
			$self->{mw}->deiconify();
			$main::sub_win_but_hand{dbish}->configure(-state=>'active');
     } )->pack( -side => "right" ); #'

		# Create Text widget for command entry
		$dbistatus = "Creating Text entry widget";

		$entry_txt = $dbiwd->Scrolled( "Text", 
			-relief => 'groove',
			-width => 78,
			-height => 10,
			-cursor=>undef,
			-foreground=>$main::fc,
			-background=>$main::ec,
		)->pack( -side => 'bottom' );


		# Pick up the Return key ... see return_press.
		$entry_txt->bind( "<Return>", sub { $self->return_press() } );

		$dbiwd->Label(-text => ' ',
			-relief => 'groove' )->pack( -side => 'bottom', -fill => 'x' );

		# Create Text widget for results display.
		$dbistatus = "Creating Text results widget";

		$rslt_txt = $dbiwd->Scrolled( "Text", 
                                              -relief => 'groove',