#!/usr/local/bin/perl -w

eval 'exec /usr/local/bin/perl -w -S $0 ${1+"$@"}'
    if 0; # not running under some shell
# -*- perl -*-

#
# $Id: tkxmlview,v 1.6 2000/08/20 20:55:27 eserte Exp $
# Author: Slaven Rezic
#
# Copyright (C) 2000 Slaven Rezic. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# Mail: eserte@cs.tu-berlin.de
# WWW:  http://user.cs.tu-berlin.de/~eserte/
#

use Tk;
use Tk::XMLViewer;
use Getopt::Long;

my $indent;
my $mainbg;

$top = new MainWindow;

GetOptions("indent=i" => \$indent,
	   "mainbg=s" => \$mainbg,
	  );

my $file = shift;
$xmlviewer = $top->Scrolled("XMLViewer", -scrollbars => "osw"
			   )->pack(-expand => 1, -fill => "both");
$xmlviewer->configure(-background => $mainbg) if defined $mainbg;
$xmlviewer->SetIndent($indent) if defined $indent;
$xmlviewer->XMLMenu;
if ($Tk::VERSION >= 800.015) {
    my $textmenu = $xmlviewer->menu;
    if ($textmenu) {
	my $filemenu = $textmenu->entrycget(0, -menu);
	$filemenu->command(-label => 'Open',
			   -command => sub { openxml(); viewxml() });
	$filemenu->command(-label => 'Re-Open',
			   -command => sub { 
			       if ($xmlviewer->SourceType eq 'file'){
				   viewxml();
			       }
			   });

	my $editmenu = $textmenu->entrycget(1, -menu);
	$editmenu->separator;
	$editmenu->command
	    (-label => 'Edit file...',
	     -command => sub {
		 require Tk::TextEdit;
		 package Tk::TextEdit;
		 sub Save {
		     my $self = shift;
		     my $r = $self->SUPER::Save(@_);
		     main::viewxml();
		     $r;
		 }

		 package main;
		 my $top_editor = $top->Toplevel;
		 $top_editor->title("Edit $file");
		 my $editor = $top_editor->Scrolled
		     ('TextEdit',
		      -scrollbars => "osoe",
		      -wrap => "none",
		     )->pack;
		 # XXX workaround bug in 3.004
		 $editor->SetGUICallbacks([]);
		 $editor->FileName($file);
		 $editor->Load;
	     });

	my $helpmenu = $textmenu->cascade(-tearoff => 0,
					  -label => 'Help');
	$helpmenu->command(-label => 'About',
			   -command => sub {
			       $top->messageBox
				   (-title   => 'About tkxmlview',
				    -message => "An XML viewer for Perl/Tk\n" .
				                "(c) 2000 by Slaven Rezic",
				    -type    => 'OK');
			   });
	$helpmenu->command(-label => 'Tk::XMLViewer POD',
			   -command => sub {
			       require Tk::Pod;
			       $top->Pod(-file => 'Tk/XMLViewer',
					 -title => 'Tk::XMLViewer POD');
			   });
    }
}
if (!defined $file) {
    openxml();
}
viewxml();
MainLoop;

sub openxml {
    my $dir;
    if(defined $file && (index($file, "/") >= 0) ) {
	$dir = substr($file, 0, rindex($file, "/"));
    }
    $file = $top->getOpenFile(-filetypes => [['XML Files', '*.xml'],
					     ['All Files', '*']],
			      (defined $dir ? (-initialdir => $dir) : ()),
			     );
}

sub viewxml {
    if (defined $file) {
	my $fname;
	if(length $file > 40) {
	    if(rindex($file, "/") >= 0 ) {
		$fname = substr($file, rindex($file, "/")+1);
	    } else {
		$fname = $file;
	    }
	    if (length $fname > 40) {
		$fname = substr($fname, -38);
	    }
	    $fname = "... " .$fname;
	} else {
	    $fname = $file;
	}
	$top->title("XMLView: ".$fname);
	$xmlviewer->delete("1.0", "end");
	$xmlviewer->insertXML(-file => $file);
    }
}

__END__