tkgvizmakefile

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

#
# $Id: tkgvizmakefile,v 1.9 2005/12/08 22:49:56 eserte Exp $
# Author: Slaven Rezic
#
# Copyright (C) 2002,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 GraphViz::Makefile;
use strict;
use vars qw($VERSION);
$VERSION = sprintf("%d.%02d", q$Revision: 1.9 $ =~ /(\d+)\.(\d+)/);

{
    package GraphViz;
    use GraphViz;

    sub as_tk_canvas {
	my($self, $c) = @_;
	GraphViz::TkCanvas::graphviz($c, $self->as_plain);
    }
}

{
    package GraphViz::TkCanvas;
    use Text::ParseWords qw(shellwords);

    sub graphviz {
	my($c, $text) = @_;

	my $tfm = sub { my($x,$y) = @_; ($x*100,$y*100) };
	foreach my $l (split /\n/, $text) {
	    my(@w) = shellwords($l);
	    if ($w[0] eq 'graph') {
		$c->configure(-scrollregion => [$tfm->(0,0),$tfm->($w[2],$w[3])]);
	    } elsif ($w[0] eq 'node') {
		my($x,$y) = $tfm->($w[2],$w[3]);
		my($w,$h) = $tfm->($w[4],$w[5]);
		my $text = $w[6];
		$c->createOval($x-$w/2,$y-$h/2,$x+$w/2,$y+$h/2, -fill=>"gray");
		$c->createText($x,$y,-text => $text, -tag => ["rule","rule_$text"]);
	    } elsif ($w[0] eq 'edge') {
		my $no = $w[3];
		my @coords;
		for(my $i=0; $i<$no*2; $i+=2) {
		    push @coords, $tfm->($w[4+$i], $w[5+$i]);
		}
		$c->createLine(@coords, -arrow => "last", -smooth => 1);
	    } elsif ($w[0] eq 'stop') {
		return;
	    } else {
		warn "Ignore directive @w\n";
	    }
	}
    }
}

{
    package Tk::Canvas;

    # from Tk::CanvasUtil
    sub center_view {
	my($c, $x, $y, %args) = @_;
	my(@xview) = $c->xview;
	my(@yview) = $c->yview;
	my($xwidth) = $xview[1]-$xview[0];
	my($ywidth) = $yview[1]-$yview[0];
	my @scrollregion = ($Tk::VERSION == 800.017
			    ? $c->cget(-scrollregion)
			    : @{$c->cget(-scrollregion)});
	my $see_view = ($c->{Configure}{-seeview} ? $c->{Configure}{-seeview} : 'see_view');
	if (!defined $x || !defined $y) {
	    $c->$see_view(0.5, 0.5, %args);
	} else {
	    $c->$see_view
		(
		 ($x-$scrollregion[0])/($scrollregion[2]-$scrollregion[0])
		 - $xwidth/2,
		 ($y-$scrollregion[1])/($scrollregion[3]-$scrollregion[1])
		 - $ywidth/2,
		 %args
		);
	}
    }

    sub see_view {
	my($c, $tox, $toy) = @_;
	$c->xview('moveto' => $tox);
	$c->yview('moveto' => $toy);
    }

}

package main;
use Getopt::Long;

$ENV{MAKE}="make" if !defined $ENV{MAKE}; # to propagate MAKE to submakefiles

my $file       = "Makefile";
my $outputtype = "tkcanvas";
my $outputfile;
my $tkcanvastype = "best";
my $prefix = "";
my $reversed = 0;
if (!GetOptions("f|file=s" => \$file,
		"T=s" => \$outputtype,
		"o=s" => \$outputfile,
		"v!"  => \$GraphViz::Makefile::V,
		"tkcanvastype=s" => \$tkcanvastype,
		"prefix=s" => \$prefix,
		"reversed!" => \$reversed,
	       )) {
    require Pod::Usage;
    Pod::Usage::pod2usage(1);
}
my $rule = shift || "all";
my $gm;
generate_gm($file, $prefix, reversed => $reversed);

if ($outputtype eq 'tkcanvas') {
    tkcanvas_output();
} else {
    my $meth = "as_" . $outputtype;
    if (!defined $outputfile) {
	die "-o is missing";
    }
    open(O, ">$outputfile") or die "Can't write to $outputfile: $!";
    binmode O;
    print O $gm->{GraphViz}->$meth();
    close O;
}

sub generate_gm {
    my($file, $prefix, %args) = @_;
    $gm = GraphViz::Makefile->new(undef, $file, $prefix, %args);
    $gm->generate($rule);
}

sub tkcanvas_output {
    require Tk;
    my $mw = new MainWindow;
    my $c;
    $mw->configure(-menu => $mw->Menu(-menuitems => [
        [Cascade => "~File", -menuitems => [
	    [Button => "~Open", -command => sub { choose_new_file($mw) }],
	    [Button => "E~xit", -command => sub { $mw->destroy }],
	]],
        [Cascade => "~View", -menuitems => [
	    [Button => "Zoom ~in", -command => sub { zoom_in($c) }],
	    [Button => "Zoom ~out", -command => sub { zoom_out($c) }],
        ]],
        [Cascade => "~Help", -menuitems => [
	    [Button => "~About", -command => sub {
		 $mw->messageBox(
		     -icon => "info",
		     -message => "tkgvizmakefile\n(c)2002,2003 by Slaven Rezic",
		     -type => "ok"
		 );
	     }],
	    [Button => "tkgvizmakefile Doc", -command => sub {
		 require Tk::Pod;
		 $mw->Pod(-file => $0);
	     }],
	    [Button => "GraphViz::Makefile Doc", -command => sub {
		 require Tk::Pod;
		 $mw->Pod(-file => "GraphViz::Makefile");
	     }],
        ]],
    ]));

    if ($tkcanvastype =~ /^(best|tkgraphviz)$/ &&
	eval { require Tk::GraphViz }) {
	$tkcanvastype = "tkgraphviz";
    } else {
	$tkcanvastype = "tkcanvas";
    }

    if ($tkcanvastype eq 'tkgraphviz') {
	$c = $mw->Scrolled("GraphViz", -scrollbars => "osoe");
	$c->createBindings;
	$c->bind('node', '<Button-1>', sub {
		     my @tags = $c->gettags('current');
		     push @tags, undef unless (@tags % 2) == 0;
		     my %tags = @tags;
		     printf "Clicked node: '%s' => %s\n", $tags{node}, $tags{label};
		 }
		);
	$c->itemconfigure('edge', -activefill => 'green');
    } else {
	$c = $mw->Scrolled("Canvas", -scrollbars => "osoe");
    }
    $c->pack(-fill=>"both", -expand=>1);
    $mw->Advertise(Graph => $c);
    draw_graph($mw);
    &Tk::MainLoop;
}

sub draw_graph {
    my($w) = @_;
    my $c = $w->Subwidget("Graph");
    if ($tkcanvastype eq 'tkgraphviz') {
	$c->show($gm->{GraphViz});
    } else {
	$gm->{GraphViz}->as_tk_canvas($c);
    }
    my @c = $c->coords("rule_$rule");
    $c->idletasks;
    $c->center_view($c[0],$c[1]);
}

sub zoom_in {
    my $c = shift;
    zoom_any($c, 1.5);
}

sub zoom_out {
    my $c = shift;
    zoom_any($c, 1/1.5);
}

sub zoom_any {
    my($c, $scalefactor) = @_;
    $c->scale("all", 0, 0, $scalefactor, $scalefactor);
    my @scrollregion = @{ $c->cget(-scrollregion) };
    foreach (@scrollregion) { $_ *= $scalefactor }
    $c->configure(-scrollregion => \@scrollregion);
    my $canvas_font = $c->{OrigFont};
    if (!$canvas_font) {
	require Tk::Font;
	my $text_item = ($c->find(withtag => "rule"))[0];
	if (defined $text_item) {
	    $canvas_font = $c->{OrigFont}
		= $c->fontCreate("rulefont",
				 $c->fontActual($c->itemcget($text_item, "-font")));
	    $c->{WantFontSize} = $c->fontActual("rulefont", "-size");
	    $c->itemconfigure("rule", -font => "rulefont");
	}
    }
    my $curr_size = $c->{WantFontSize};
    my $new_size = $curr_size * $scalefactor;
    $c->{WantFontSize} = $new_size;
    if ($new_size > 0 && $new_size < 6) { $new_size = 6 }
    if ($new_size < 0 && $new_size > -6) { $new_size = -6 }
    $c->fontConfigure("rulefont", -size => $new_size);
}

sub choose_new_file {
    my($w) = @_;
    my $new_file = $w->getOpenFile;
    if (defined $new_file) {
	generate_gm($new_file);
	draw_graph($w);
    }
}

# REPO BEGIN
# REPO NAME is_in_path /home/e/eserte/src/repository 
# REPO MD5 1b42243230d92021e6c361e37c9771d1

sub is_in_path {
    my($prog) = @_;
    return $prog if (file_name_is_absolute($prog) and -f $prog and -x $prog);
    require Config;
    my $sep = $Config::Config{'path_sep'} || ':';
    foreach (split(/$sep/o, $ENV{PATH})) {
	if ($^O eq 'MSWin32') {
	    return "$_\\$prog"
		if (-x "$_\\$prog.bat" ||
		    -x "$_\\$prog.com" ||
		    -x "$_\\$prog.exe");
	} else {
	    return "$_/$prog" if (-x "$_/$prog");
	}
    }
    undef;
}
# REPO END

# REPO BEGIN
# REPO NAME file_name_is_absolute /home/e/eserte/src/repository 
# REPO MD5 a77759517bc00f13c52bb91d861d07d0

sub file_name_is_absolute {
    my $file = shift;
    my $r;
    eval {
        require File::Spec;
        $r = File::Spec->file_name_is_absolute($file);
    };
    if ($@) {
	if ($^O eq 'MSWin32') {
	    $r = ($file =~ m;^([a-z]:(/|\\)|\\\\|//);i);
	} else {
	    $r = ($file =~ m|^/|);
	}
    }
    $r;
}
# REPO END

=head1 NAME

tkgvizmakefile - create Tk graphs from Makefiles

=head1 SYNOPSIS

    tkgvizmakefile [-f makefile] [-T output] [-o outputfile]
                   [-reversed] [-prefix prefix] [-tkcanvatype type][rule]

=head1 OPTIONS

=over

=item -f F<makefile>

Use another makefile. Default is C<Makefile>

=item -T I<output>

Choose an output type. Every GraphViz-supported output type is
possible (see the description for the C<-T> option in the dot manpage)
and there is additionally the C<tkcanvas> type for dumping the graph
to a Canvas widget.

=item -o F<outputfile>

Write the output to the named file. Ignored for the C<tkcanvas> type.

=item -reversed

Reverse the arrows.

=item -prefix I<prefix>

Add the given prefix to each rule

=item rule

Start graph output from the named Makefile rule. If missing, the
C<all> or first rule is used.

=item -tkcanvastype I<type>

Only for C<tkcanvas> type: if I<type> is set to C<tkgraphviz>, then
use L<Tk::GraphViz>. if it set to C<tkcanvas>, then use L<Tk::Canvas>
as the output widget. The default is C<best>, which means try
C<Tk::GraphViz> first, then C<Tk::Canvas>.

=back

=head1 SEE ALSO

L<dot(1)>, L<GraphViz>, L<GraphViz::Makefile>, L<Tk>, L<Tk::GraphViz>, L<Tk::Canvas>.

=cut