view release on metacpan or  search on metacpan

lib/Getopt/Janus/Tk.pm  view on Meta::CPAN

}

sub _text_describing_option {  # operates on an option
  my($self, $option) = @_;
  return join '',

    "Option name: \"", $self->_option_title($option),
    "\"\n\n",

    defined( $option->{'description'} )
      ? "$$option{'description'}\n\n" : (),

    "Type: $$option{'type'}\n",

    defined( $option->{'short'} )
      ? "Short command-line form: -$$option{'short'}\n" : (),

    defined( $option->{'long'} )
      ? "Long command-line form: --$$option{'long'}\n" : (),

    defined( $option->{'shortcut_key'} )
      ? "Shortcut key: $$option{'shortcut_key'}\n" : (),
  ;
}

sub _option_title { # operates on an option
  my($self, $option) = @_;
  return
     defined( $option->{'title'} ) ? $option->{'title'}
   : defined( $option->{'long'}  ) ? "--$$option{'long'}"
   : defined( $option->{'short'} ) ? "-$$option{'short'}"
   : "[???]" # should be unreachable
}

#==========================================================================

sub review_result_screen {
  my($self, $items) = @_;
  return unless @$items;
  DEBUG > 2 and print "Making a new window for ", scalar(@$items), " items\n";
  require Tk::Checkbutton;

  my $mainwindow = MainWindow->new;
  $mainwindow->title("Reviewing Output of $$self{'title'}");
  my $pane;
  if(@$items < 4) {
    $pane = $mainwindow;
  } else {
    $pane = $mainwindow->Scrolled( 'Pane',
     '-scrollbars' => 'osoe',
     '-sticky'     => 'nsew',
     #'-gridded'    => 'y'
    );
    $pane->pack( '-fill' => 'both',  '-expand' => 1 );
  }
  
  foreach my $i (@$items) {
    my($f,$d) = @$i;
    next unless defined $f or defined $d;

    require Tk::Menubutton;
    my $mb = $pane->Menubutton(
       qw/ -relief raised -takefocus 1 -indicatoron 1 -direction right/,
       -text => $f,
    );

    $mb->configure( -menu => $mb->menu(qw/-tearoff 0/) );

    defined $f and $self->can_open_files and $mb->command(
      -label => "Run this file",
      -command =>  sub { $self->open_file($f) },
    );

    defined $f and $self->can_open_directories and $mb->command(
      -label => "Open this directory",
      -command =>  sub { $self->open_directory($d) },
    );
    defined $f and $self->can_open_files and $mb->command(
      -label => "Copy this filespec", -command =>  sub {
        $mainwindow->clipboardClear;
        $mainwindow->clipboardAppend( '--', $f );
      },
    );
    $mb->pack;
  }

  # Just a divider:
  $pane->Frame(qw/ -relief ridge -bd 1 -height 3 /)->pack('-fill' => 'x' );

  # A frame for the button(s) at the bottom:
  my $button_bundle_frame = $pane->Frame();
  $button_bundle_frame->pack;
  
  my $done_button;
  ($done_button = $button_bundle_frame->Button(
    '-text'    => 'Done',
    '-command' => [ $mainwindow => 'destroy' ],
  ))->pack( qw< -side left  -pady 9 -padx 9  > );
  $done_button->focus;

  $mainwindow->bind('<Escape>' => [$mainwindow, 'destroy'] );

  DEBUG and print "\n";
  Tk::MainLoop();
  DEBUG and print "\n";
  return;
}

#==========================================================================

sub report_run_error {
  my($self, $error_text) = @_;
  $error_text ||= "Unknown error!?";

  DEBUG and print "Reporting error $@\n";

  my $m = MainWindow->new;
  $m->title("Error!");
  $m->label("An error occurred in the program:\n");
  
  my $t = $m->Scrolled( 'Text',
    -scrollbars => 'oe',