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

#
# $Id: tkxmlview,v 1.12 2003/08/01 12:58:37 eserte Exp $
# Author: Slaven Rezic
#
# Copyright (C) 2000, 2003 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: slaven@rezic.de
# WWW:  http://www.rezic.de/eserte
#

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

my $indent;
my $mainbg;
my $ua;

my $top = new MainWindow;

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

my $string;
my @url_history;
my $file = shift;
my $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 ($xmlviewer->can("menu")) {
    my $textmenu = $xmlviewer->menu;
    if ($textmenu) {
	my $filemenu = $textmenu->entrycget(0, -menu);
	$filemenu->command(-label => 'Open',
			   -command => sub { openxml(); viewxml() });
	if (eval { require LWP::UserAgent }) {
	    $filemenu->command(-label => "Open URL",
			       -command => sub { guiopenurl() });
	}
	$filemenu->command(-label => 'Re-Open',
			   -command => sub {
			       if ($xmlviewer->SourceType eq 'file'){
				   open_file_or_url();
			       }
			   });

	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();
} else {
    open_file_or_url();
}

MainLoop;

sub open_file_or_url {
    # guess if it's an URL
    if ($file =~ /^(http|https|file|ftp):/) {
	openandviewurl();
    } else {
	viewxml();
    }
}

sub openxml {
    my $dir;
    if(defined $file && (index($file, "/") >= 0) ) {
	$dir = substr($file, 0, rindex($file, "/"));
    }
    $file = $top->getOpenFile
	(-filetypes => [['Generic XML Files', '*.xml'],
			['XSLT Files', ['*.xslt','.xsl']],
			['RSS Files', '*.rss'],
			['RDF Files', '*.rdf'],
			['WML Files', '*.wml'],
			['All Files', '*']],
	 (defined $dir ? (-initialdir => $dir) : ()),
	);
}

sub guiopenurl {
    # XXX Dialog?
    my $t = $top->Toplevel(-title => "Open URL");
    $t->transient($top);
    my $e;
    my $continue = 0;
    my $url;
    my $Entry = "Entry";
    eval {
        # try loading the module, otherwise $Entry is left to the value "Entry"
        require Tk::HistEntry;
        $Entry = "SimpleHistEntry";
    };
    Tk::grid(
	     $t->Label(-text => "URL:"),
	     $e = $t->$Entry(-textvariable => \$url),
	     $t->Button(-text => "OK",
			-command => sub { $continue = 1 }),
	     $t->Button(-text => "Cancel",
			-command => sub { $continue = -1 }),
	    );
    if ($e->can('history')) {
	$e->history(\@url_history);
    }
    $e->bind("<Return>" => sub { $continue = 1 });
    $e->bind("<Escape>" => sub { $continue = -1 });
    $e->focus;
    $t->waitVariable(\$continue);
    $t->destroy if Tk::Exists($t);
    if ($continue == 1) {
	$file = $url;
	return openandviewurl();
    } else {
	0;
    }
}

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);
    }
}

sub openandviewurl {
    my($url) = $file;

    push @url_history, $url;

    if (!$ua) {
	$ua = LWP::UserAgent->new(env_proxy => 1);
    }
    my $resp = $ua->get($url);
    if (!$resp->is_success) {
	$top->messageBox(-title => "Error",
			 -message => "GET was not successful: " . $resp->code,
			 -icon => "error",
			);
	return 0;
    }

    $top->title("XMLView: ".$url);
    $xmlviewer->delete("1.0", "end");
    $xmlviewer->insertXML(-text => $resp->content);

    1;
}

__END__
