#!/usr/bin/env perl
$^W = 1;
#
# $Id: ppcfg_edit,v 1.1 2001/11/30 00:46:22 lorenz Exp $
#
# $Author: lorenz $
#
# Revision History and POD: See end of file
#===================================================================

use lib "$ENV{'HOME'}/lib/perl5";
use Pod::Text;
use Tk;
use Tk::Dialog;
use Tk::NoteBook;
use Getopt::ArgvFile qw(argvFile);
use Getopt::Long;
use MessageDialog;

use Data::Dumper;
use strict;

(my $me = $0) =~ s#.*/##;

my $top = MainWindow->new();

my $md = MessageDialog -> new($top);

my $VERSION = sprintf("%d.%02d", q/$Revision: 1.1 $/ =~ /(\d+)\.(\d+)/);
my $nix = "";                      # for using RCS keys in Usage, ...
my $Date = "Date ";

$top -> configure( -title => "$me   Revision: $VERSION");
#============================================================= Usage

sub Usage {
  my $opt = shift; # if called on command line with --help

  no strict;
  $^W = 0;

  if ($opt) {
    pod2text( $0 );
    exit;  # we're done
  }
  my @MM;
  open(HELP, "pod2text $0  |") or die "Cannot open pipe for help:$!\n";
  while(<HELP>) {
    push @MM, $_;
  }
  close(HELP);
  $md -> start ("$me   Revision: $VERSION", \@MM);

} # Usage


#==================================================== Parameter Loop

my %OPT;

argvFile( home => 1, default => 1);

GetOptions(
  \%OPT,
  "debug",
  "help",
  "version",
);

#======================================================= Script Body
Usage(1) if ($OPT{help});
if ($OPT{version}) {
  print "This is $me version $VERSION\n";
  print "$Date: 2001/11/30 00:46:22 $nix\n";
  exit;
}

my %PAGE;
my %OPT_DEFAULT;
my %TV;
my %pg;

scan_menues(); # get all options, and their positions in the menues

# Menubar
# -------
my $menubar = $top->Frame( -relief => "raised", -borderwidth => 2);

my $notebook;
########
# File #
########
my $mb_file = $menubar->Menubutton(
  -text      => "File",
  -underline => 0,
);

$mb_file->command(
  -label     => "Open", 
  -command   => \&open_hdl,
  -underline => 0,
);
$mb_file->command(
  -label     => "Save", 
  -command   => \&save_hdl,
  -underline => 0,
);
$mb_file->separator();
$mb_file->command(
  -label     => "Exit", 
  -command   => sub { exit 0} ,
  -underline => 0,
);
#-------

########
# Help #
########
my $mb_help = $menubar->Menubutton(
  -text      => "Help",
  -underline => 0,
);
$mb_help->command(
  -label     => "Contents",
  -command   => \&Usage,
  -underline => 0,
);
$mb_help->separator();
$mb_help->command(
  -label   => "About $me",
  -command => sub {
    my $okButton = "OK";
    my $dia = $top->Dialog(
      -title          => "About $me",
      -text           => "Autor: Lorenz Domke, lorenz.domke\@pixel.de\n\n" .
           "Revision: $VERSION \n$Date: 2001/11/30 00:46:22 $nix",
      -bitmap         => 'info',
      -buttons        => [ $okButton, " KK"],
      -default_button => $okButton,
      ) -> Show();
    },
  -underline => 0,
);
#-------

# Application window
# ------------------
$menubar -> pack(-side => "top", -fill => 'x');
$mb_file -> pack(-side => "left");
$mb_help -> pack(-side => "right");

$notebook = $top->NoteBook(
      -width => 500,
      -ipadx => 2,
      -ipady => 2,
      );
$notebook -> pack();

create_pages(); # create notebook pages
#print STDERR Dumper %pg, "\n";


# Status line
# -----------
my $status = "";
my $lb_status_line = $top->Label(
  -textvariable => \$status,
  -relief       => 'sunken',
);

# --------
$lb_status_line -> pack(-side => 'bottom', -expand => 'yes', -fill => 'x');

# Main Event Loop
# ---------------
MainLoop;

exit 0;
#================================================== Handler Routines

#-------------------------------------------------------------------
sub save_hdl {
  print "save called ...\n";
  foreach my $page ( sort keys %PAGE){
    print "## $page ------------------------\n";
    foreach my $optref ( @{$PAGE{$page}}){
      my $val =  defined $TV{$$optref{option_name}} ?  $TV{$$optref{option_name}} :  "";
      printf "--%-20s %s\n", $$optref{option_name}, $val;
    }
    print "\n";
  }
} # save_hdl

#-------------------------------------------------------------------
sub open_hdl {
  print "open called ...\n";
} # open_hdl

#-------------------------------------------------------------------
sub scan_menues {
  print STDERR "scan menues ...\n";
  my $file = "pp2html";
  my $skip = 1;
  my $page_head;
  my $opt_name;

  open (D, "$file")  or die "cannot open $file: $!\n";
  while(<D>){
    if (/my \%OPT =/){
      $skip = 0;
      next;
    }
    if (/my \@OPTIONS =/){
      $skip = 0;
      next;
    }

    last if /END OPTIONS/;
    $skip = 1 if /END DEFAULTS/;

    next if $skip;

    if (/^\s*(\w+)\s*=>\s*(\S+)/){  # option default
      $opt_name = $1;
      my $defval = $2;
      $defval =~ s/,//g;
      $defval =~ s/"//g;
      $OPT_DEFAULT{$opt_name} = $defval;
      $TV{$opt_name} = $defval;
      next;
    }

    if (/--- (\w+)/){  # new page in notebook
      $page_head = $1;
      last if $page_head eq "Special";
      next;
    }

    if (/"(\w+)/){  # option name
      $opt_name = $1;
      my $len=0;
      if (exists $PAGE{$page_head}){
         $len = scalar( @{$PAGE{$page_head}});
      }
      $PAGE{$page_head}[$len]->{option_name} = $opt_name;
      $PAGE{$page_head}[$len]->{option_text} = $opt_name;
      if (/=[is]/){
        $PAGE{$page_head}[$len]->{option_type}="s";
      } else {
        $PAGE{$page_head}[$len]->{option_type}="b";
      }
      if (/#\s*(.*)/){
        $PAGE{$page_head}[$len]->{option_text} = $1;
      }
    }
  }
  close(D);
} # scan_menues

sub create_pages {
  print STDERR "create pages ...\n";
  my $page;
  foreach $page (sort keys %PAGE){
  print STDERR " $page ...\n";
    $pg{$page} = $notebook->add($page,
      -label => $page,
      -anchor => 'e',
      );
    # $pg{$page}->pack();    
      ## warning: Loosing Tk::Frame=HASH(0x8489968) ...
                             ## don't know why
## order of objects ... (Mark Overmeer)
    my $opt;
    my $opt_name;
    my $opt_text;
    my $opt_type;
    my $rw = 1;

    foreach my $href (@{$PAGE{$page}} ) {
#print STDERR "$page ...";
      $opt_name = $$href{option_name};
#print STDERR Dumper $href;
      $opt_text = $$href{option_text};
      $opt_type = $$href{option_type};
      $opt = $pg{$page} -> Label(
         -text => $opt_text,
      );
      $opt-> grid(  -row, $rw, -column, 1, -sticky, "w" );

      $opt = $pg{$page} -> Entry(
         -textvariable => \$TV{$opt_name},
      );
      $opt-> grid(  -row, $rw, -column, 2, -sticky, "w" );

      $opt = $pg{$page} -> Button(
        #-bitmap => "questhead",
         -text => "Help",
         -background => "white",
         -command => sub{ display_help($opt_name) },
      );
      $opt-> grid(  -row, $rw, -column, 3, -sticky, "w" );

      $rw++;
    }
    print STDERR " pack $page ...";
    $pg{$page}->pack();    
  }

} # create_pages

#-------------------------------------------------------------------
sub display_help {
  my ($opt_name) = @_;
} # display_help

#===================================================================
__END__

=head1 NAME

TK

=head1 SYNOPSYS

TK [options]

=head1 DESCRIPTION

tell something about TK ...

=head1 OPTIONS

=over 4

=item B<--help>

Output of Usage

=item B<--version>

Output of version

=back


=head1 EXAMPLES

if any ...

=head1 FILES

=over 4

=item F<$PATH/.TK>

Global options file for C<TK>

=item F<$HOME/.TK>

Private options file. Here you can set most of the options
which do not change frequently.

=back

=head1 AUTHOR

Lorenz Domke, <lorenz.domke@pixel.de>

=head1 SEE ALSO

L<TK>

=cut



--------------------------------------------------------------------
Revision History:

$Log: ppcfg_edit,v $
Revision 1.1  2001/11/30 00:46:22  lorenz
new cvs version

Revision 1.1  2001/04/15 08:34:27  lorenz
Initial revision


Revision 1.1  1998/05/27 10:42:17  ldomke
Initial revision