[Bio] / FigWebServices / protein.cgi Repository:
ViewVC logotype

View of /FigWebServices/protein.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.126 - (download) (annotate)
Wed Jun 29 04:33:02 2005 UTC (14 years, 9 months ago) by redwards
Branch: MAIN
Changes since 1.125: +33 -0 lines
Changes to javascript to externalize everything into FIG.js and clean up the code

# -*- perl -*-
use InterfaceRoutines;

use FIG;

my $sproutAvail = eval {
    require SproutFIG;
    require PageBuilder;
};

#if (!$sproutAvail) {
#    warn "Sprout library not available: $@\n";
#}

use FIGGenDB;
use FIGjs;

use URI::Escape;  # uri_escape
use HTML;
use Data::Dumper;

use strict;
use GenoGraphics;
use CGI;
use Tracer;

my $cgi = new CGI;

use Carp 'cluck';
my $traceData = $cgi->param('trace');
if ($traceData) {
	TSetup($traceData, "QUEUE");
	$traceData = 1;
} else {
	TSetup(0, "NONE");
	$traceData = 0;
}

if (0) {
    my $VAR1;
    eval(join("",`cat /tmp/protein_parms`));
    $cgi = $VAR1;
#   print STDERR &Dumper($cgi);
}

if (0) {
    print $cgi->header;
    my @params = $cgi->param;
    print "<pre>\n";
    foreach $_ (@params) {
		print "$_\t:",join(",",$cgi->param($_)),":\n";
    }

    if (0) {
        if (open(TMP,">/tmp/protein_parms")) {
	    	print TMP &Dumper($cgi);
	    	close(TMP);
		}
    }
    exit;
}

my($fig_or_sprout);

my $is_sprout;

my $html = [];

if ($cgi->param('SPROUT')) {
    $is_sprout = 1;
    $fig_or_sprout = new SproutFIG($FIG_Config::sproutDB, $FIG_Config::sproutData);
    unshift @$html, "<TITLE>The NMPDR Protein Page</TITLE>\n";
} else {
    $is_sprout = 0;
    $fig_or_sprout = new FIG;
    unshift @$html, "<TITLE>The SEED Protein Page</TITLE>\n";
}


my $prot = $cgi->param('prot');
if (! $prot) {
    unshift @$html, "<TITLE>The SEED: Protein Page</TITLE>\n";
    push(@$html,"<h1>Sorry, you need to specify a protein</h1>\n");
    &display_page($fig_or_sprout,$cgi,$html);
    exit;
}

if ($prot !~ /^fig\|/) {
    my @poss = &by_alias($fig_or_sprout,$prot);

    if (@poss > 0) {
		$prot = $poss[0];
    } else {
		unshift @$html, "<TITLE>The SEED: Protein Page</TITLE>\n";
		push(@$html,"<h1>Sorry, $prot appears not to have a FIG id at this point</h1>\n");
		&display_page($fig_or_sprout,$cgi,$html);
		exit;
    }
}


#
#  Allow previous and next actions in calls to the script -- GJO
#

my $adjust = $cgi->param('previous PEG') ? -1 : $cgi->param('next PEG') ? 1 : 0;
if ( $adjust ) {
    my ( $prefix, $protnum ) = $prot =~ /^(.*\.)(\d+)$/;
    if ( $prefix && $protnum ) {
        my $prot2 = $prefix . ($protnum + $adjust);
        if ( &translatable($fig_or_sprout, $prot2 ) ) {
            $prot = $prot2;
            $cgi->delete('prot');
            $cgi->param(-name => 'prot', -value => $prot);
        }
    }
    ( $adjust < 0 ) && $cgi->delete('previous PEG');
    ( $adjust > 0 ) && $cgi->delete('next PEG');
}

my $request = $cgi->param("request") || "";
#my $compute_ok = eval {


        if    ($request eq "use_protein_tool")       { &use_protein_tool($fig_or_sprout,$cgi,$html,$prot); }
	elsif ($request eq "view_annotations")       { &view_annotations($fig_or_sprout,$cgi,$html,$prot); }
	elsif ($request eq "view_all_annotations")   { &view_all_annotations($fig_or_sprout,$cgi,$html,$prot); }
	elsif ($request eq "aa_sequence")            { &aa_sequence($fig_or_sprout,$cgi,$html,$prot);  }
	elsif ($request eq "dna_sequence")           { &dna_sequence($fig_or_sprout,$cgi,$html,$prot); }
	elsif ($request eq "fast_assign")            { $html = &make_assignment($fig_or_sprout,$cgi,$html,$prot); }
	elsif ($request eq "show_coupling_evidence") { &show_coupling_evidence($fig_or_sprout,$cgi,$html,$prot); }
	elsif ($request eq "ec_to_maps")             { &show_ec_to_maps($fig_or_sprout,$cgi,$html); }
	elsif ($request eq "link_to_map")            { &link_to_map($fig_or_sprout,$cgi,$html); }
	elsif ($request eq "fusions")                { &show_fusions($fig_or_sprout,$cgi,$html,$prot); }
	else {
	    $html = &show_html_followed_by_initial($fig_or_sprout,$cgi,$html,$prot);
	}

        if ($cgi->param('SPROUT') && (ref($html) eq "ARRAY"))
        {
            $_ = {};
	    $_->{kv_pairs} = $html;
	    $html = $_;
	}
#};

#if (!$compute_ok) {
#    Trace($@);
#}

&display_page($fig_or_sprout,$cgi,$html);
exit;

#==============================================================================
#  use_protein_tool
#==============================================================================

sub use_protein_tool {
    my($fig_or_sprout,$cgi,$html,$prot) = @_;
    my($url,$method,@args,$line,$name,$val);

    my $seq = &get_translation($fig_or_sprout,$prot);
    if (! $seq) {
		unshift @$html, "<TITLE>The SEED: Protein Page</TITLE>\n";
		push(@$html,$cgi->h1("Sorry, $prot does not have a translation"));
		return;
    }
    my $protQ = quotemeta $prot;

    my $tool = $cgi->param('tool');
    $/ = "\n//\n";
    my @tools = grep { $_ =~ /^$tool\n/ } `cat $FIG_Config::global/LinksToTools`;
    if (@tools == 1) {
		chomp $tools[0];
		(undef,undef,$url,$method,@args) = split(/\n/,$tools[0]);
		my $args = [];
		foreach $line (@args) {
	    	($name,$val) = split(/\t/,$line);
	    	$val =~ s/FIGID/$prot/;
	    	$val =~ s/FIGSEQ/$seq/;
	    	$val =~ s/\\n/\n/g;
	    	push(@$args,[$name,$val]);
		}
		unshift @$html, "<TITLE>The SEED: Protein Tool</TITLE>\n";
		#$url='http://localhost/cgi-bin/extract_params.cgi'; in case I forget to delete this, it is just a script that grabs params from cgis RAE
		push(@$html,&HTML::get_html($url,$method,$args));
    }
}

#==============================================================================
#  make_assignment
#==============================================================================

sub make_assignment {
    my($fig_or_sprout,$cgi,$html,$prot) = @_;
    my($userR);

    my $function = $cgi->param('func');
    my $user     = $cgi->param('user');

    if ($function && $user && $prot) {
        if ($user =~ /master:(.*)/) {
	    	$userR = $1;
	    	&assign_function($fig_or_sprout,$prot,"master",$function,"");
	    	&add_annotation($fig_or_sprout,$cgi,$prot,$userR,"Set master function to\n$function\n");
        } else {
	    &assign_function($fig_or_sprout,$prot,$user,$function,"");
	    &add_annotation($fig_or_sprout,$cgi,$prot,$user,"Set function to\n$function\n");
	}
    }
    $cgi->delete("request");
    $cgi->delete("func");
    $html = &show_html_followed_by_initial($fig_or_sprout,$cgi,$html,$prot);
    return $html;
}

#==============================================================================
#  view_annotations
#==============================================================================

sub view_annotations {
    my($fig_or_sprout,$cgi,$html,$prot) = @_;

    unshift @$html, "<TITLE>The SEED: Protein Annotations</TITLE>\n";
    my $col_hdrs = ["who","when","annotation"];

    my $tab = [ map { [$_->[2],$_->[1],"<pre>" . $_->[3] . "<\/pre>"] } &feature_annotations($fig_or_sprout,$cgi,$prot) ];
    if (@$tab > 0) {
		push(@$html,&HTML::make_table($col_hdrs,$tab,"Annotations for $prot"));
    } else {
		push(@$html,"<h1>No Annotations for $prot</h1>\n");
    }
}

sub view_all_annotations {
    my($fig_or_sprout,$cgi,$html,$peg) = @_;
    my($ann);

    unshift @$html, "<TITLE>The SEED: Protein Annotations</TITLE>\n";
    if (&is_real_feature($fig_or_sprout,$peg)) {
		my $col_hdrs = ["who","when","PEG","genome","annotation"];
		my @related  = &related_by_func_sim($fig_or_sprout,$cgi,$peg,$cgi->param('user'));
		push(@related,$peg);

		my @annotations = &merged_related_annotations($fig_or_sprout,\@related);

		my $tab = [ map { $ann = $_;
				  [$ann->[2],$ann->[1],&HTML::fid_link($cgi,$ann->[0]),
				   &genus_species($fig_or_sprout,&genome_of($ann->[0])),
				   "<pre>" . $ann->[3] . "</pre>"
				   ] } @annotations];
		if (@$tab > 0) {
		    push(@$html,&HTML::make_table($col_hdrs,$tab,"All Related Annotations for $peg"));
		} else {
		    push(@$html,"<h1>No Annotations for $peg</h1>\n");
		}
    }
}

#==============================================================================
#  show_coupling_evidence
#==============================================================================

sub show_coupling_evidence {
    my($fig_or_sprout,$cgi,$html,$peg) = @_;
    my($pair,$peg1,$peg2,$link1,$link2);

    unshift @$html, "<TITLE>The SEED: Functional Coupling</TITLE>\n";
    my $user = $cgi->param('user');
    my $to   = $cgi->param('to');
    my @coup = grep { $_->[1] eq $to } &coupling_and_evidence($fig_or_sprout,$peg,5000,1.0e-10,4,1);

    if (@coup != 1) {
		push(@$html,"<h1>Sorry, no evidence that $peg is coupled to $to</h1>\n");
    } else {
		my $col_hdrs = ["Peg1","Function1","Peg2","Function2","Organism"];
		my $tab = [];
        foreach $pair (@{$coup[0]->[2]}) {
	    	($peg1,$peg2) = @$pair;
	    	$link1 = &HTML::fid_link($cgi,$peg1);
	    	$link2 = &HTML::fid_link($cgi,$peg2);
	    	push( @$tab, [ $link1,
	           	       scalar &function_ofS($fig_or_sprout,$peg1,$user),
			       $link2,
			       scalar &function_ofS($fig_or_sprout,$peg2,$user),
			       &org_of($fig_or_sprout,$peg1)
                         ]
	        );
        }
        push(@$html,&HTML::make_table($col_hdrs,$tab,"Evidence that $peg Is Coupled To $to"));
    }
}

#==============================================================================
#  psi_blast_prot_sequence
#==============================================================================

sub psi_blast_prot_sequence {
    my($fig_or_sprout,$cgi,$prot_id) = @_;
}

#==============================================================================
#  show_initial
#==============================================================================

sub show_initial {
    my($fig_or_sprout,$cgi,$html,$prot) = @_;

    unshift @{$html->{general}}, "<TITLE>The SEED: Protein Page</TITLE>\n";

    my $gs = &org_of($fig_or_sprout,$prot);
    Trace("got gs=$gs prot=$prot $fig_or_sprout\n") if T(2);
    if ($prot =~ /^fig\|\d+\.\d+\.peg/) {
        if (! &is_real_feature($fig_or_sprout,$prot)) {
            push(@{$html->{general}},"<h1>Sorry, $prot is an unknown identifier</h1>\n");
        } else {
            push(@{$html->{general}},"<h1>Protein $prot: $gs</h1>\n");
            &translation_piece($fig_or_sprout,$cgi,$html->{translate_status});
            &display_peg($fig_or_sprout,$cgi,$html,$prot);
        }
    } else {
        #   &display_external($fig_or_sprout,$cgi,$html,$prot);
    }
}

#==============================================================================
#  display_peg
#==============================================================================

sub display_peg {
    my($fig_or_sprout,$cgi,$html,$peg) = @_;
    my $loc;
    
    my $user = $cgi->param('user');
    my $org     = &genome_of($peg);
    my $domain  = &genome_domain($fig_or_sprout,$org);
    
    #...set default minimum size for euk or non-euk display region...
    my $half_sz = ($domain =~ m/^euk/i) ? 50000 : 5000;
    
    my $fc = $cgi->param('fc');
    my @fc_data;
    if ($fc) {
        # RAE Added the following lines so that you can define this in the URL
        # but the default behavior remains unchanged. I doubt anyone will ever
        # see this, but I use it sometimes to see what happens
        my ($bound,$sim_cutoff,$coupling_cutoff)=(5000, 1.0e-10, 4);
        if ($cgi->param('fcbound')) {$bound=$cgi->param('fcbound')}
        if ($cgi->param('fcsim')) {$sim_cutoff=$cgi->param('fcsim')}
        if ($cgi->param('fccoup')) {$coupling_cutoff=$cgi->param('fccoup')}
	
        @fc_data = &coupling_and_evidence($fig_or_sprout,$peg,$bound,$sim_cutoff,$coupling_cutoff,1);
    } else {
        @fc_data = ();
    }
    
    if ($loc = &feature_locationS($fig_or_sprout,$peg)) {
        my($contig,$beg,$end) = &boundaries_of($fig_or_sprout,$loc);
	
	my $len  = abs($end-$beg) + 1;
	if ($len > $half_sz)
	{
	    $half_sz = $len;
	}
	else
	{
	    $half_sz = $half_sz * (1 + 3*int($len/$half_sz));   #...set scale of region...
	}
#	print STDERR "half_sz = $half_sz\n";
	
        my $min  = &max(0,&min($beg,$end) - $half_sz);
        my $max  = &max($beg,$end) + $half_sz;
        Trace("display_peg: min=$min max=$max beg=$beg end=$end") if T(2);
	
        my($feat,$min,$max) = &genes_in_region($fig_or_sprout,$cgi,&genome_of($peg),$contig,$min,$max);
        Trace("beg=$beg end=$end New min = $min, max = $max, features = " . join(", ", @{$feat})) if T(3);

        my ($beg,$end,$genes) = &print_context($fig_or_sprout,$cgi,$html->{contig_context},$peg,$feat,$min,$max);
        Trace("Print context returned: beg=$beg, end=$end, genes = " . join(", ", @{$genes})) if T(3);
        &print_graphics_context($beg,$end,$genes,$html->{context_graphic});

        &print_assignments($fig_or_sprout,$cgi,$html->{assign_for_equiv_prots},$peg);
        &print_kv_pairs($is_sprout, $fig_or_sprout,$cgi,$html->{kv_pairs},$peg);
	&print_protein_fams($is_sprout, $fig_or_sprout,$cgi,$html->{kv_pairs},$peg,$user);
        &print_subsys_connections($fig_or_sprout,$cgi,$html->{subsys_connections},$peg,$user);
        &print_links($fig_or_sprout,$cgi,$html->{links},$peg);

        push @{$html->{javascript}}, "\n", &FIGjs::toolTipScript();

        my $has_translation = &translatable($fig_or_sprout,$peg);
        &print_services($fig_or_sprout,$cgi,$html->{services},$peg,$has_translation,\@fc_data);

        &print_sims_block($fig_or_sprout,$cgi,$html->{similarities},$peg,$user,$has_translation);

        if ($has_translation) {
            &show_tools($fig_or_sprout,$cgi,$html->{tools},$peg);
        }
    }
}

################# Table-Driven Show Tools  ############################

sub show_tools {
    my($fig_or_sprout,$cgi,$html,$peg) = @_;

    # generate the link to turn tools on or off
    my $toollink=$cgi->self_url;
    $toollink =~ s/[\&\;]fulltools.*[^\;\&]/\&/;
    my $fulltoolbutton  = $cgi->a({href=> $toollink . "&fulltools='1'"}, "> Show tool descriptions"); # define this here before we mess with ourself!
    my $brieftoolbutton = $cgi->a({href=> $toollink}, "< Hide tool descriptions");

    $cgi->param(-name => "request",
		-value => "use_protein_tool");
    my $url = $cgi->self_url();

    if (open(TMP,"<$FIG_Config::global/LinksToTools")) {
        my $col_hdrs = ["Tool","Description"];
        my $tab = [];

        $/ = "\n//\n";
	my $brieftools; # in case we don't want descriptions and whatnot
        while (defined($_ = <TMP>)) {
	    # allow comment lines in the file
	    next if (/^#/);
            my($tool,$desc) = split(/\n/,$_);
	    # RAE modified this so we can include column headers.
	    undef($desc) if ($desc eq "//"); # it is a separator
	    # RAE modified again so that we only get a short tool list instead of the big table if that is what we want.
	    if ($cgi->param('fulltools')) {
	     if ($desc) {push(@$tab,["<a href=\"$url\&tool=$tool\">$tool</a>",$desc])}
	     else {push(@$tab, [["<strong>$tool</strong>", "td colspan=2 align=center"]])}
	    }
	    else {
	     # Why doesn't this work $brieftools .= "<span class=\"tool\" style=\"border: 0 1px solid gray\"><a href=\"$url\&tool=$tool\">$tool</a></span>";
	     if ($desc) {$brieftools .= " &nbsp; <a href=\"$url\&tool=$tool\">$tool</a> &nbsp;|"}
	    }
        }
        close(TMP);
        $/ = "\n";
	if ($brieftools) {push(@$html, $cgi->p("|" . $brieftools), $fulltoolbutton)}
	else {push(@$html,&HTML::make_table($col_hdrs,$tab,"Tools to Analyze Protein Sequences"), $brieftoolbutton)}
    }
    $cgi->delete('request');
}

################# Functional Coupling  ############################

sub print_fc {
    my($fig_or_sprout,$cgi,$html,$peg,$fc_data) = @_;
    my($sc,$neigh);

    my $user  = $cgi->param('user');
    my @tab   = map { ($sc,$neigh) = @$_;
                        [&ev_link($cgi,$neigh,$sc),$neigh,scalar &function_ofS($fig_or_sprout,$neigh,$user)]
                    } @$fc_data;
    if (@tab > 0) {
        push(@$html,"<hr>\n");
        my $col_hdrs = ["Score","Peg","Function"];
        push(@$html,&HTML::make_table($col_hdrs,\@tab,"Functional Coupling"));
    }
}

sub ev_link {
    my($cgi,$neigh,$sc) = @_;

    my $prot = $cgi->param('prot');
    my $sprout = $cgi->param('SPROUT');
    my $link = $cgi->url() . "?request=show_coupling_evidence&prot=$prot&to=$neigh&SPROUT=$sprout";
    return "<a href=$link>$sc</a>";
}

################# Assignments  ############################

sub trans_function_of {
    my($cgi,$fig_or_sprout,$peg,$user) = @_;

    if (wantarray()) {
        my $x;
        my @funcs = &function_ofL($fig_or_sprout,$peg,$user);

        if ($cgi->param('translate')) {
            @funcs = map { $x = $_; $x->[1] = &translate_function($fig_or_sprout,$x->[1]); $x } @funcs;
        }
        return @funcs;
    } else {
        my $func = &function_ofS($fig_or_sprout,$peg,$user);
        if ($cgi->param('translate')) {
            $func = &translate_function($fig_or_sprout,$func);
        }
        return $func;
    }
}

##########################  Routines that build pieces of HTML ######################


sub print_sims_block {
    my($fig_or_sprout,$cgi,$html,$peg,$user,$has_translation) = @_;

    my $sims = $cgi->param('sims');
    if ( (! $sims ) && $has_translation)
    {
	my $short_form = 1;
	sims_request_form( $fig_or_sprout, $cgi, $html, $peg, $user, $short_form );
    }

    #  Added test $has_translation && (...) -- GJO
    elsif ( $has_translation && $sims)
    {
        print_similarities( $fig_or_sprout, $cgi, $html, $peg );
    }
}


sub print_services {
    my($fig_or_sprout,$cgi,$html,$peg,$has_translation,$fc_data) = @_;

    my $link1 = $cgi->self_url() . "&request=view_annotations";
    my $link2 = $cgi->self_url() . "&request=view_all_annotations";
    push(@$html,"<br><a href=$link1>To View Annotations</a> / <a href=$link2>To View All Related Annotations</a>\n");

    if ((! $cgi->param('SPROUT')) && &peg_in_gendb($fig_or_sprout,$cgi,$peg))
    {
	push(@$html, "<br/>".&FIGGenDB::linkPEGGenDB($peg));
	push(@$html, "<br/>".&FIGGenDB::importOrganismGenDB($peg));
    }

    my $link = $cgi->self_url() . "&request=aa_sequence";
    push(@$html,"<br><a href=$link>Protein Sequence</a>\n");

    $link = $cgi->self_url() . "&request=dna_sequence";
    push(@$html,"<br><a href=$link>DNA Sequence</a>\n");

    $link = $cgi->url();
    $link =~ s/protein.cgi/fid_checked.cgi/;
    my $sprout = $cgi->param('SPROUT') ? 1 : "";
    my $user = $cgi->param('user');
    if (! $user) {
        $user = "";
    } else {
        $link = $link . "?SPROUT=$sprout&fid=$prot&user=$user&checked=$prot&assign/annotate=assign/annotate";
        push(@$html,"<br><a href=$link target=checked_window>To Make an Annotation</a>\n");
    }

    if (! $sprout)
    {
	my $fc = $cgi->param('fc');
	if ((! $fc) && (&feature_locationS($fig_or_sprout,$peg))) {
	    my $link = $cgi->self_url() . "&fc=1";
	    push(@$html,"<br><a href=$link>To Get Detailed Functional Coupling Data</a>\n");
	} elsif ($fc) {
	    &print_fc($fig_or_sprout,$cgi,$html,$peg,$fc_data);
	}

	my $link = $cgi->self_url() . "&request=fusions";
	push(@$html,"<br><a href=$link>To Get Fusion Data</a>\n");

	my $link = &cgi_url . "/homologs_in_clusters.cgi?prot=$peg&user=$user\n";
	push(@$html,"<br><a href=$link>To Find Homologs in Clusters</a>\n");
    }

    if ((! $cgi->param('compare_region')) && $has_translation) {
        my $link = $cgi->self_url() . "&compare_region=1";
        push(@$html,"<br><a href=$link>To Compare Region</a>\n");
    } elsif ($cgi->param('compare_region')) {
        &print_compared_regions($fig_or_sprout,$cgi,$html,$peg);
    }
}

sub print_assignments {
    my($fig_or_sprout,$cgi,$html,$peg) = @_;
    my($who,$func,$ec,@ecs,@tmp,$id,$i,$master_func,$user_func,$x);

    my $user = $cgi->param('user');
    $user = defined($user) ? $user : "";

    my @funcs    = map { [$peg,@$_] } &trans_function_of($cgi,$fig_or_sprout,$peg);
    $user_func   = &trans_function_of($cgi,$fig_or_sprout,$peg);

    push(@$html,$cgi->h2("Current Assignment: $peg: $user_func"));

    my @maps_to  = grep { $_ ne $peg } map { $_->[0] } &mapped_prot_ids($fig_or_sprout,$cgi,$peg);

    foreach $id (@maps_to) {
	my $tmp;
        if (($id ne $peg) && ($tmp = &trans_function_of($cgi,$fig_or_sprout,$id)))
	{
            push(@funcs, [$id,&who($id),$tmp]);
        }
    }
    @funcs = map { ($_->[1] eq "master") ? [$_->[0],"",$_->[2]] : $_ } @funcs;


    push(@$html,"<hr>\n");

    if ((@funcs == 0) && (! $user_func)) {
        push(@$html,$cgi->h1("No function has been assigned"));
    }

    my $tab = [ map { ($id,$who,$func) = @$_;
		      [ &HTML::set_prot_links($cgi,$id),
			&org_of($fig_or_sprout,$id),
			$who ? $who : "&nbsp;",
			($user ? &assign_link($cgi,$func,$user_func) : "&nbsp;"),
			&set_ec_and_tc_links($fig_or_sprout,&genome_of($peg),$func)] } @funcs ];
    if (@$tab > 0) {
        my $col_hdrs = ["Id","Organism","Who","ASSIGN","Assignment"];
        my $title    = "Assignments for Essentially Identical Proteins";
        push(@$html,&HTML::make_table($col_hdrs,$tab,$title));
    }
}

sub print_kv_pairs {
    my($is_sprout, $fig_or_sprout,$cgi,$html,$peg) = @_;

    # we don't want to do this for SPROUT
    return if ($is_sprout);

    # RAE: modified this to allow the users to edit the key/value pairs.
    # there will be two choices: when the "Edit Attributes" button is pressed
    # we will redraw the table with input fields and what not.

    # If the Add Changes button is pressed we will save the changes
    # we will do this first before displaying the results

    my @attr=&get_attributes($fig_or_sprout,$peg);
    if ($cgi->param('Add Changes')) {
      my ($deleted, $added, $changed)=(undef, undef, undef);

      foreach my $key (@attr) {
         unless ($cgi->param("key.".$key->[1])) {
	    if (&delete_attribute($fig_or_sprout, $peg, $key->[1])) {
	      push @$deleted, [@$key, ["deleted", "td colspan=2 style=\"text-align: center\""]];
	    }
	 }
	 if (($cgi->param("value.".$key->[1]) ne $key->[2]) || ($cgi->param("url.".$key->[1]) ne $key->[3])) {
	    if (&change_attribute($fig_or_sprout,$peg, $key->[1], $cgi->param("value.".$key->[1]), $cgi->param("url.".$key->[1]))) {
	      push @$changed, [@$key, $cgi->param("value.".$key->[1]), $cgi->param("url.".$key->[1])];
	    }
	 }
      }
      for (my $i=0; $i<=5; $i++) {
         if ($cgi->param("key.$i")) {
	    if (&add_attribute($fig_or_sprout,$peg, $cgi->param("key.$i"), $cgi->param("value.$i"), $cgi->param("url.$i"))) {
	     push @$added, [$cgi->param("key.$i"), ["added", "td colspan=2 style=\"text-align: center\""], $cgi->param("value.$i"), $cgi->param("url.$i")];
	    }
	    else {
	     print STDERR $peg, " and ", $cgi->param("key.$i"), " not added\n";
	    }
	 }
      }

      my $tab = [];
      my $col_hdrs=["Attribute", "Original Value", "Original URL", "New Value", "New URL"];
      if ($changed) {push @$tab, [["<strong>Changed Attributes", "td colspan=5 bgcolor=gray style=\"text-align: center\""]], @$changed}
      if ($deleted) {push @$tab, [["<strong>Deleted Attributes", "td colspan=5 bgcolor=gray style=\"text-align: center\""]], @$deleted}
      if ($added)   {push @$tab, [["<strong>Added Attributes",   "td colspan=5 bgcolor=gray style=\"text-align: center\""]], @$added}

      push(@$html,&HTML::make_table($col_hdrs,$tab,"Changed Data"));
    }

    my @attr=&get_attributes($fig_or_sprout, $peg);
    my $col_hdrs=["Key","Value"];

    my $tab = [];
    if ($cgi->param('Edit Attributes') && $cgi->param('user')) {
       push @$col_hdrs, "URL";
       foreach my $key (sort {$a->[1] cmp $b->[1]} @attr) {
          push @$tab,
	      [
	          $cgi->textfield(-name=>"key.".$key->[1], -default=>$key->[1], -size=>30),
	          $cgi->textfield(-name=>"value.".$key->[1], -default=>$key->[2], -size=>30),
	          $cgi->textfield(-name=>"url.".$key->[1], -default=>$key->[3], -size=>30),
	      ];
       }
       for (my $i=0; $i<=5; $i++) {
	 push @$tab,
	    [
	         $cgi->textfield(-name=>"key.$i", -size=>30),
		 $cgi->textfield(-name=>"value.$i", -size=>30),
		 $cgi->textfield(-name=>"url.$i", -size=>30),
            ];
       }
    }
    #RAE we need to check that this is a scalar
    elsif (ref($attr[0]) eq "ARRAY") {
       foreach $_ (sort {$a->[0] cmp $b->[0]} @attr) {
           my($peg,$tag,$val,$url) = @$_;
 	   next unless ($url =~ /^http/);
           push(@$tab,[$tag,$url ? "<a href=\"$url\">$val</a>" : $val]);
       }
    }

    # Add the appropriate submit button to the table
    if ($cgi->param('user') && $cgi->param('Edit Attributes')) {
	# we want a Add button
	push @$tab, [[$cgi->submit('Add Changes'), "td colspan=3 style=\"text-align: center\""]];
    }
    elsif ($cgi->param('user')) {
	push @$tab, [[$cgi->submit('Edit Attributes'), "td colspan=2 style=\"text-align: center\""]];
    }
    push(@$html,$cgi->start_form(-action=>"protein.cgi"), $cgi->hidden("prot"), $cgi->hidden("user"));
    push(@$html,$cgi->br,$cgi->hr,&HTML::make_table($col_hdrs, $tab,"Attributes"),$cgi->hr);
    #  Add end of form -- GJO
    #  RAE: sorry about that Gary.
    push( @$html, $cgi->end_form );
}

sub print_protein_fams {

    ############## RAE 
    # This code adds the protein family table to the page. This can be shown/hidden at the discretion of the viewer. Hopefully.
    # On testing, this doesn't appear to work with safari, though it may be that I don't know what I am doing, so I have
    # reverted to the old code below.
    
    my($is_sprout, $fig_or_sprout,$cgi,$html,$peg,$user) = @_;
    # we don't want to do this for SPROUT
    return if ($is_sprout);
    
    push @$html, "<a href=\"javascript:toggleLayer('proteinfamilies');\" title=\"Show Protein Families\">Show/Hide Protein Families</a>";
    
    # get the families and other information
    my $tab=[];
    my @families=&families_for_protein($fig_or_sprout,$peg);
    return unless (scalar @families);
    foreach my $fam (@families)
    {
     my $link="<a href='/FIG/proteinfamilies.cgi?user=$user&prot=$peg&family=$fam&filter=fig&simpleshow=1'>$fam</a>";
     push @$tab, [$link, &family_function($fig_or_sprout, $fam), &sz_family($fig_or_sprout, $fam)];
    }
    my $col_hdrs=["Family ID<br><small>Link Investigates Family</small>", "Family Function", "Family Size"];
    push @$html, $cgi->br, $cgi->div({id=>"proteinfamilies"}, &HTML::make_table($col_hdrs, $tab, "Protein Families"));
}


sub old_print_protein_fams {

    ############## RAE 
    # This is functional code that displays the protein families, but I want to try it using
    # the CSS method. Therefore, I am keeping this code just for now, rather than munging it and being
    # stuck with nothing working. Just rename this method and it will be fine!
    
    my($is_sprout, $fig_or_sprout,$cgi,$html,$peg,$user) = @_;
   
    # we don't want to do this for SPROUT
    return if ($is_sprout);
    
    # generate the link to turn protein fams on or off
    my $link=$cgi->self_url;
    if ($link =~ /showproteinfams/) {
     $link =~ s/[\&\;]showproteinfams.*[^\;\&]/\&/;
     push @$html, "< &nbsp; " . $cgi->a({href=> $link}, "Hide Protein Families");
    
     # get the families and other information
     my $tab=[];
     my @families=&families_for_protein($fig_or_sprout,$peg);
     return unless (scalar @families);
     foreach my $fam (@families)
     {
      my $link="<a href='/FIG/proteinfamilies.cgi?user=$user&prot=$peg&family=$fam&filter=fig&simpleshow=1'>$fam</a>";
      push @$tab, [$link, &family_function($fig_or_sprout, $fam), &sz_family($fig_or_sprout, $fam)];
     }
     my $col_hdrs=["Family ID<br><small>Link Investigates Family</small>", "Family Function", "Family Size"];
     push @$html, $cgi->br, &HTML::make_table($col_hdrs, $tab, "Protein Families"), $cgi->hr;
    }
    else
    {
     push @$html, "> &nbsp; " . $cgi->a({href=> $link . "&showproteinfams='1'"}, "Show Protein Families"); # define this here before we mess with ourself!
    }
}

sub who {
    my($id) = @_;

    if ($id =~ /^fig\|/)           { return "FIG" }
    if ($id =~ /^gi\|/)            { return "" }
    if ($id =~ /^^[NXYZA]P_/)      { return "RefSeq" }
    if ($id =~ /^sp\|/)            { return "SwissProt" }
    if ($id =~ /^uni\|/)           { return "UniProt" }
    if ($id =~ /^tigr\|/)          { return "TIGR" }
    if ($id =~ /^pir\|/)           { return "PIR" }
    if ($id =~ /^kegg\|/)          { return "KEGG" }
}

sub print_subsys_connections {
    my($fig_or_sprout,$cgi,$html,$peg,$user) = @_;

    #
    # Show the subsystems in which this protein participates.
    #

    if (my @subsystems = &subsystems_for_peg($fig_or_sprout,$peg)) {
        push(@$html,
             $cgi->h2("Subsystems in which this peg is present"));

        my(@hdrs);
        my(@table);

        @hdrs = ("Subsystem", "Role");

        my $sprout = $cgi->param('SPROUT') ? 1 : "";

        for my $ent (@subsystems) {
            my($sub, $role) = @$ent;
            my $can_alter = (($user = $cgi->param('user')) && ($user eq subsystem_curator($fig_or_sprout,$sub)));
            my $esc_sub = uri_escape($sub);  # in URI::Escape
            my $url = $cgi->a({href => "subsys.cgi?can_alter=$can_alter&SPROUT=$sprout&user=$user&ssa_name=$esc_sub&request=show_ssa&show_clusters=1&sort=by_phylo"}, $sub);

            push(@table, [$url, $role]);
        }
        push(@$html, &HTML::make_table(\@hdrs, \@table));
    }
}

sub print_links {
    my($fig_or_sprout,$cgi,$html,$peg) = @_;

    my @links = &peg_links($fig_or_sprout,$peg);
    if (@links > 0) {
        my $col_hdrs = [1,2,3,4,5];
        my $title    = "Links to Related Entries in Other Sites";
        my $tab = [];
        my ($n,$i);
        for ($i=0; ($i < @links); $i += 5) {
            $n = (($i + (5-1)) < @links) ? $i+(5-1) : $i+(@links - $i);
            push(@$tab,[@links[$i..$n]]);
        }
        push(@$html,&HTML::make_table($col_hdrs,$tab,$title));
    }

    if (! $cgi->param('SPROUT')) {
        my $url = &cgi_url . "/add_links.cgi?peg=$peg";
        push(@$html,"<a href=$url>To Add New Links to this Gene</a>\n");
    }
}



################# Similarities  ############################


sub print_similarities {
    my( $fig_or_sprout, $cgi, $html, $peg ) = @_;

    if ($cgi->param('SPROUT'))
    {
	&print_similarities_SPROUT($fig_or_sprout, $cgi, $html, $peg );
    }
    else
    {
	&print_similarities_SEED($fig_or_sprout, $cgi, $html, $peg );
    }
}


sub print_similarities_SPROUT {
    my($fig_or_sprout, $cgi, $html, $peg ) = @_;

    $cgi->delete('sims');

    my $user = $cgi->param('user') || "";

    my $current_func = &trans_function_of($cgi,$fig_or_sprout,$peg,$user);

    push( @$html, $cgi->hr,
                  "<a name=Similarities>",
                  $cgi->h1(''),
                  "</a>\n"
        );

    my @sims = sort { $a->[1] <=> $b->[1] } &bbhs($fig_or_sprout,$peg,1.0e-10);

    my @from = $cgi->radio_group(-name => 'from',
                                 -nolabels => 1,
				 -override => 1,
                                 -values => ["",$peg,map { $_->[0] } @sims]);

    my $target = "window$$";
        # RAE: added a name to the form so tha the javascript works
    push( @$html, $cgi->start_form( -method => 'post',
				    -target => $target,
				    -action => 'fid_checked.cgi',
				    -name   => 'fid_checked'
				    ),
	          $cgi->hidden(-name => 'SPROUT', -value => 1),
	          $cgi->hidden(-name => 'fid', -value => $peg),
	          $cgi->hidden(-name => 'user', -value => $user),
	          $cgi->br,
                  "For Selected (checked) sequences: ",
	          $cgi->submit('align'),
            );

    if ($user) {
	my $help_url = "Html/help_for_assignments_and_rules.html";
	push ( @$html, $cgi->br, $cgi->br,
                       "<a href=$help_url target=\"SEED_or_SPROUT_help\">Help on Assignments, Rules, and Checkboxes</a>",
                       $cgi->br, $cgi->br,
                       $cgi->submit('assign/annotate')
	       );

	if ($cgi->param('translate')) {
	    push( @$html, $cgi->submit('add rules'),
		  $cgi->submit('check rules'),
		  $cgi->br
		  );
	}
    }

    push( @$html, $cgi->br,
	          $cgi->checkbox( -name    => 'checked',
				  -value   => $peg,
				  -override => 1,
				  -checked => 1,
				  -label   => ""
				  )
	  );

    my $col_hdrs;
    if ($user && $cgi->param('translate')) {
	push( @$html, " ASSIGN to/Translate from/SELECT current PEG", $cgi->br,
	              "ASSIGN/annotate with form: ", shift @from, $cgi->br,
                      "ASSIGN from/Translate to current PEG: ", shift @from
	      );
	$col_hdrs = [ "ASSIGN to<hr>Translate from",
                      "Similar sequence",
                      "E-val",
		      "In Sub",
                      "ASSIGN from<hr>Translate to",
		      "Function",
		      "Organism",
                      "Aliases"
		      ];
    } elsif ($user) {
	push( @$html, " ASSIGN to/SELECT current PEG", $cgi->br,
                      "ASSIGN/annotate with form: ", shift @from, $cgi->br,
                      "ASSIGN from current PEG: ", shift @from
	      );
	$col_hdrs = [ "ASSIGN to<hr>SELECT",
                          "Similar sequence",
                          "E-val",
                          "In Sub",
                          "ASSIGN from",
                          "Function",
                          "Organism",
                          "Aliases"
		      ];
    } else {
	push(@$html, " SELECT current PEG", $cgi->br );
	$col_hdrs = [ "SELECT",
		      "Similar sequence",
		      "E-val",
		      "In Sub",
		      "Function",
		      "Organism",
		      "Aliases"
		      ];
    }

    my $ncol = @$col_hdrs;
    push( @$html, "<TABLE border cols=$ncol>\n",
	          "\t<Caption><h2>Bidirectional Best Hits</h2></Caption>\n",
                  "\t<TR>\n\t\t<TH>",
                  join( "</TH>\n\t\t<TH>", @$col_hdrs ),
                  "</TH>\n\t</TR>\n"
	  );

    #  Add the table data, row-by-row

    my $sim;
    foreach $sim ( @sims ) {
	my($id2,$psc) = @$sim;
	my $cbox = &translatable($fig_or_sprout,$id2) ?
	    qq(<input type=checkbox name=checked value="$id2">) : "";
	my $id2_link = &HTML::set_prot_links($cgi,$id2);
	chomp $id2_link;

	my @in_sub  = &peg_to_subsystems($fig_or_sprout,$id2);
	my $in_sub;
	if (@in_sub > 0) {
	    $in_sub = @in_sub;
	} else {
	    $in_sub = "&nbsp;";
	}

	my $radio   = $user ? shift @from : undef;
	my $func2   = html_enc( scalar &trans_function_of( $cgi, $fig_or_sprout, $id2, $user ) );
	## RAE Added color3. This will color function tables that do not match the original
	## annotation. This makes is a lot easier to see what is different (e.g. caps/spaces, etc)
	my $color3="#FFFFFF";
	unless ($func2 eq $current_func) {$color3="#FFDEAD"}

	#
	# Colorize organisms:
	#
	# my $org     = html_enc( &org_of($fig_or_sprout, $id2 ) );
	my ($org,$oc) = &org_and_color_of($fig_or_sprout, $id2 );
	$org        = html_enc( $org );

	my $aliases = html_enc( join( ", ", &feature_aliasesL($fig_or_sprout,$id2) ) );

	$aliases = &HTML::set_prot_links($cgi,$aliases);

	#  Okay, everything is calculated, let's "print" the row datum-by-datum:

	$func2 = $func2 ? $func2 : "&nbsp;";
	$aliases = $aliases ? $aliases : "&nbsp;";

	push( @$html, "\t<TR>\n",
	      #
	      #  Colorize check box by Domain
	      #
	      "\t\t<TD Align=center Bgcolor=$oc>$cbox</TD>\n",
	      "\t\t<TD Nowrap>$id2_link</TD>\n",
	      "\t\t<TD Nowrap>$psc</TD>\n",
	      "\t\t<TD>$in_sub</TD>",
	      $user ? "\t\t<TD Align=center>$radio</TD>\n" : (),
	      "\t\t<TD Bgcolor=$color3>$func2</TD>\n",
	      #
	      #  Colorize organism by Domain
	      #
	      # "\t\t<TD>$org</TD>\n",
	      "\t\t<TD Bgcolor=$oc>$org</TD>\n",
	      "\t\t<TD>$aliases</TD>\n",
	      "\t</TR>\n"
	      );
    }
    push( @$html, "</TABLE>\n" );
    push( @$html, $cgi->end_form );
}


sub print_similarities_SEED {
    my( $fig_or_sprout, $cgi, $html, $peg ) = @_;

    my $user = $cgi->param('user') || "";
    my $current_func = &trans_function_of( $cgi, $fig_or_sprout, $peg, $user );

    push @$html, $cgi->hr,
                 "<a name=Similarities>",   #  Put an anchor on the heading
                 $cgi->h2('Similarities'),
                 "</a>\n";

    #  Generate the request form, and return current option values in hash

    my $short_form = 0;
    my $SimParams  = sims_request_form( $fig_or_sprout, $cgi, $html, $peg, $user, $short_form );

    my $maxN       = $SimParams->{ maxN };
    my $maxP       = $SimParams->{ maxP };
    my $max_expand = $SimParams->{ max_expand };
    my $select     = $SimParams->{ select };
    my $show_env   = $SimParams->{ show_env };
    my $hide_alias = $SimParams->{ hide_alias };
    my $group_by_genome = $SimParams->{ group_by_genome };

    #  These are active, but the values are only used in sims()
    # my $extra_opt = $SimParams->{ extra_opt };
    # my $min_q_cov = $SimParams->{ min_q_cov };
    # my $min_s_cov = $SimParams->{ min_s_cov };
    # my $min_sim   = $SimParams->{ min_sim };
    # my $sim_meas  = $SimParams->{ sim_meas };
    # my $sort_by   = $SimParams->{ sort_by };

    #  None of these are currently active: -- GJO
    # my $show_rep   = $SimParams->{ show_rep };
    # my $max_sim    = $SimParams->{ max_sim };
    # my $dyn_thrsh  = $SimParams->{ dyn_thrsh };
    # my $save_dist  = $SimParams->{ save_dist };
    # my $chk_which  = $SimParams->{ chk_which };

    #  There is currently no control to turn this on! -- GJO
    my $expand_groups = $SimParams->{ expand_groups };

    #  Move filtering of sims list out of display loop.  Avoids many problems,
    #  including display of table with no entries.  Anticipate more filters.
    #  -- GJO
    #
    #  All the filtering is now done in get_raw_sims and expand_raw_sims. -- GJO

    my @sims = sims( $fig_or_sprout,
                     $peg,
                     $maxN,
                     $maxP,
                     $select,
                     $max_expand,
                     $group_by_genome,
                     $SimParams
                   );

    if ( @sims ) {
	push( @$html, $cgi->hr );
	my @from = $cgi->radio_group( -name => 'from',
	                              -nolabels => 1,
	                              -override => 1,
	                              -values => [ "", $peg, map { $_->id2 } @sims ]
	                            );

        my $target = "window$$";
        # RAE: added a name to the form so tha the javascript works
        push( @$html, $cgi->start_form( -method => 'post',
	                                -target => $target,
	                                -action => 'fid_checked.cgi',
	                                -name   => 'fid_checked'
                                      ),
                      $cgi->hidden(-name => 'fid', -value => $peg),
                      $cgi->hidden(-name => 'user', -value => $user),
                      $cgi->br,
                      "For Selected (checked) sequences: ",
                           $cgi->submit('align'),
                           $cgi->submit('view annotations'),
                           $cgi->submit('get sequences'),
                           $cgi->submit('show regions')
            );

        if ($user) {
            my $help_url = "Html/help_for_assignments_and_rules.html";
            push ( @$html, $cgi->br, $cgi->br,
                       "<a href=$help_url target=\"SEED_or_SPROUT_help\">Help on Assignments, Rules, and Checkboxes</a>",
                       $cgi->br, $cgi->br,
                       $cgi->submit('assign/annotate')
             );

            if ($cgi->param('translate')) {
                push( @$html, $cgi->submit('add rules'),
                              $cgi->submit('check rules'),
                              $cgi->br
                    );
            }
        }

        push( @$html, $cgi->br,
                      $cgi->checkbox( -name    => 'checked',
                                      -value   => $peg,
                          -override => 1,
                                      -checked => 1,
                                      -label   => ""
                                    )
            );

        my $col_hdrs;
        my $color_help = "(<A href=\"Html/similarity_region_colors.html\" target=\"SEED_or_SPROUT_help\">colors explained</A>)";
        my $func_clr_help = "(<A href=\"Html/function_colors.html\" target=\"SEED_or_SPROUT_help\">function colors explained</A>)";

        if ($user && $cgi->param('translate')) {
            push( @$html, " ASSIGN to/Translate from/SELECT current PEG", $cgi->br,
                          "ASSIGN/annotate with form: ", shift @from, $cgi->br,
                          "ASSIGN from/Translate to current PEG: ", shift @from
            );
            $col_hdrs = [ "ASSIGN to<hr>Translate from",
                          $expand_groups ? "family" : (),
                          $expand_groups ? "size" : (),
                          "Similar sequence",
                          "E-val<br>% iden",
                          "region in<br>similar sequence<br>$color_help",
                          "region in<br>$peg<br>$color_help",
                          "ASSIGN from<hr>Translate to",
                          "In Sub",
                          "Function<br>$func_clr_help",
                          "Organism",
                          (! $hide_alias) ? "Aliases" : ()
                        ];
        } elsif ($user) {
            push( @$html, " ASSIGN to/SELECT current PEG", $cgi->br,
                          "ASSIGN/annotate with form: ", shift @from, $cgi->br,
                          "ASSIGN from current PEG: ", shift @from
            );
            $col_hdrs = [ "ASSIGN to<hr>SELECT",
                          $expand_groups ? "family" : (),
                          $expand_groups ? "size" : (),
                          "Similar sequence",
                          "E-val<br>% iden",
                          "region in<br>similar sequence<br>$color_help",
                          "region in<br>$peg<br>$color_help",
                          "ASSIGN from",
                          "In Sub",
                          "Function<br>$func_clr_help",
                          "Organism",
                          (! $hide_alias) ? "Aliases" : ()
                        ];
        } else {
            push(@$html, " SELECT current PEG", $cgi->br );
            $col_hdrs = [ "SELECT",
                          $expand_groups ? "family" : (),
                          $expand_groups ? "size" : (),
                          "Similar sequence",
                          "E-val<br>% iden",
                          "region in<br>similar sequence<br>$color_help",
                          "region in<br>$peg<br>$color_help",
                          "In Sub",
                          "Function<br>$func_clr_help",
                          "Organism",
                          (! $hide_alias) ? "Aliases" : ()
                        ];
        }

        # RAE Add the check all/uncheck all boxes.
        push (@$html, $cgi->br, &HTML::java_buttons("fid_checked", "checked"), $cgi->br);

        #
        # Total rewrite of sim table code: cleaner program flow; omitting
        # empty columns; colorizing region-of-similarity cells -- GJO
        #
        # Start the similarity table with "Caption" and header row

        my $ncol = @$col_hdrs;
        push( @$html, "<TABLE border cols=$ncol>\n",
                      "\t<Caption><h2>Similarities</h2></Caption>\n",
                      "\t<TR>\n\t\t<TH>",
                      join( "</TH>\n\t\t<TH>", @$col_hdrs ),
                      "</TH>\n\t</TR>\n"
            );

        #
        #  Grouping by genome is hard to see.  This is an attempt to make it more obvious
        #  by consolidating the "Organism" for all rows in which it is repeated.  -- GJO
        #
        #  Let's figure out the function here too.  This will allow color to be
        #  specific for more than one function.  For example, we can color:
        #
        #     Identical function white
        #     Most common alternative brown
        #     Next most common alternatives red, orange, yellow, green, blue, and violet
        #     Any additional alternatives gray
        #

        my $sim;
        my ( $id2, $func, $genome, $org, $color, $info, $prev_genome, $prev_sim );
        my %func_cnt = ();

        foreach $sim ( @sims ) {
            $id2  = $sim->id2;

            $func = html_enc( scalar trans_function_of( $cgi, $fig_or_sprout, $id2, $user ) );
            $func && $func_cnt{ $func }++;

            if ( $group_by_genome && ( ( $genome ) = $id2 =~ /fig\|(\d+\.\d+)\./ )
                                  && ( $genome eq $prev_genome ) )
            {
                $prev_sim->[-1]->[3]++;         # Increase row span of org
                push @$sim, [ $func, "", $color, 0 ];  # No org name, prev_color, no row span
            }
            else
            {
                ( $org, $color ) = org_and_color_of( $fig_or_sprout, $id2 );
                push @$sim, [ $func, html_enc( $org ), $color, 1 ];
                $prev_genome = $genome || "";
                $prev_sim = $sim;
            }
        }

        #  Build a function to color translation table based on frequence of function.
        #  Reserve white for the current function.

        my %func_color;
        $func_cnt{ $current_func } && delete $func_cnt{ $current_func };
        $func_color{ $current_func } = "#FFFFFF";

        #  Assign other colors until we run out:

        my @colors = qw( #EECCAA #FFAAAA #FFCC66 #FFFF00 #AAFFAA #BBBBFF #FFAAFF );
        for ( sort { $func_cnt{ $b } <=> $func_cnt{ $a } } keys %func_cnt )
        {
            $func_color{ $_ } = ( shift @colors ) || "#DDDDDD";
        }

        #  Add the table data, row-by-row

        my $alia = (! $hide_alias);
        foreach $sim ( @sims ) {
            my $id2  = $sim->id2;

            my $cbox = &translatable($fig_or_sprout,$id2) ?
                   qq(<input type=checkbox name=checked value="$id2">) : "";

            my( $family, $sz, $funcF, $fam_link );
	    $family = $sz = $funcF = $fam_link = "";

            my $id2_link = &HTML::set_prot_links($cgi,$id2);
            chomp $id2_link;

            my @in_sub  = &peg_to_subsystems($fig_or_sprout,$id2);
            my $in_sub;
            if (@in_sub > 0) {
                $in_sub = @in_sub;
            } else {
                $in_sub = "&nbsp;";
            }

            my $psc     = $sim->psc;
            my $iden    = $sim->iden;
            my $ln1     = $sim->ln1;
            my $ln2     = $sim->ln2;
            my $b1      = $sim->b1;
            my $e1      = $sim->e1;
            my $b2      = $sim->b2;
            my $e2      = $sim->e2;
            my $d1      = abs($e1 - $b1) + 1;
            my $d2      = abs($e2 - $b2) + 1;
            my $reg1    = "$b1-$e1 (<b>$d1/$ln1</b>)";
            my $color1  = match_color( $b1, $e1, $ln1 );
            my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";
            my $color2  = match_color( $b2, $e2, $ln2 );
            my $radio   = $user ? shift @from : undef;

            # Retrieve the Function and Organism data that was pushed on the end of the sim:

            my ( $func2, $org, $oc, $rowspan ) = @{$sim->[-1]};

            ## RAE Added color3. This will color function cells that do not match the original
            ## annotation. This makes is a lot easier to see what is different (e.g. caps/spaces, etc)

            my $color3 = $func2 && $func_color{ $func2 } || "#DDDDDD";

            if ( $funcF && ( $funcF ne $func2 ) ) { $func2 = "$funcF<br>$func2" }
            $func2 ||= "&nbsp;";

            my $aliases = undef;
            if ( $alia )
            {
                $aliases = html_enc( join( ", ", &feature_aliasesL($fig_or_sprout,$id2) ) );
                $aliases = &HTML::set_prot_links( $cgi, $aliases );
                $aliases ||= "&nbsp;";
            }

            #  Okay, everything is calculated, let's "print" the row datum-by-datum:

            push( @$html, "\t<TR>\n",
                          #
                          #  Colorize check box by Domain
                          #
                          "\t\t<TD Align=center Bgcolor=$oc>$cbox</TD>\n",
                          $expand_groups ? "\t\t<TD>$fam_link</TD>/n" : (),
                          $expand_groups ? "\t\t<TD>$sz</TD>\n" : (),
                          "\t\t<TD Nowrap>$id2_link</TD>\n",
                          "\t\t<TD Nowrap>$psc<br>$iden\%</TD>\n",
                          "\t\t<TD Nowrap Bgcolor=$color2>$reg2</TD>\n",
                          "\t\t<TD Nowrap Bgcolor=$color1>$reg1</TD>\n",
                          $user ? "\t\t<TD Align=center>$radio</TD>\n" : (),
                          "\t\t<TD Align=center>$in_sub</TD>",
                          "\t\t<TD Bgcolor=$color3>$func2</TD>\n",
                          #
                          #  Colorize organism by Domain
                          #
                          $rowspan ? "\t\t<TD Rowspan=$rowspan Bgcolor=$oc>$org</TD>\n" : (),
                          $alia ? "\t\t<TD>$aliases</TD>\n" : (),
                          "\t</TR>\n"
                );
        }

        push( @$html, "</TABLE>\n" );
        push( @$html, $cgi->end_form );
    }
}

#
#  Support functions for writing the similarities
#
#  This is a sufficient set of escaping for text in HTML:
#

sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }

#
#  Make a background color that reflects the position and extent of a
#  matching region.
#
#      Left side is red; right side is blue.
#      Long match is white or pastel; short match is saturated color.
#

sub match_color {
    my ( $b, $e, $n ) = @_;
    my ( $l, $r ) = ( $e > $b ) ? ( $b, $e ) : ( $e, $b );
    # my $hue = 3/4 * 0.5*($l+$r)/$n - 1/24;
    my $hue = 5/6 * 0.5*($l+$r)/$n - 1/12;
    my $cov = ( $r - $l + 1 ) / $n;
    my $sat = 1 - 10 * $cov / 9;
    my $br  = 1;
    rgb2html( hsb2rgb( $hue, $sat, $br ) );
}

#
#  Convert HSB to RGB.  Hue is taken to be in range 0 - 1 (red to red);
#

sub hsb2rgb {
    my ( $h, $s, $br ) = @_;
    $h = 6 * ($h - floor($h));      # Hue is made cyclic modulo 1
    if ( $s  > 1 ) { $s  = 1 } elsif ( $s  < 0 ) { $s  = 0 }
    if ( $br > 1 ) { $br = 1 } elsif ( $br < 0 ) { $br = 0 }
    my ( $r, $g, $b ) = ( $h <= 3 ) ? ( ( $h <= 1 ) ? ( 1,      $h,     0      )
                                      : ( $h <= 2 ) ? ( 2 - $h, 1,      0      )
                                      :               ( 0,      1,      $h - 2 )
                                      )
                                    : ( ( $h <= 4 ) ? ( 0,      4 - $h, 1      )
                                      : ( $h <= 5 ) ? ( $h - 4, 0,      1      )
                                      :               ( 1,      0,      6 - $h )
                                      );
    ( ( $r * $s + 1 - $s ) * $br,
      ( $g * $s + 1 - $s ) * $br,
      ( $b * $s + 1 - $s ) * $br
    )
}

#
#  Convert an RGB value to an HTML color string:
#

sub rgb2html {
    my ( $r, $g, $b ) = @_;
    if ( $r > 1 ) { $r = 1 } elsif ( $r < 0 ) { $r = 0 }
    if ( $g > 1 ) { $g = 1 } elsif ( $g < 0 ) { $g = 0 }
    if ( $b > 1 ) { $b = 1 } elsif ( $b < 0 ) { $b = 0 }
    sprintf("\"#%02x%02x%02x\"", int(255.999*$r), int(255.999*$g), int(255.999*$b) )
}

#
#  floor could be gotten from POSIX::, but why bother?
#

sub floor {
    my $x = $_[0];
    defined( $x ) || return undef;
    ( $x >= 0 ) || ( int($x) == $x ) ? int( $x ) : -1 - int( - $x )
}


#------------------------------------------------------------------------
#  Generate similarity query forms for the SEED.  Consolidates things like
#  style and defaults in one place.
#
#   my $user = $cgi->param('user') || "";
#   my $short_form = 0;
#   my $SimParam = sims_request_form( $fig, $cgi, $html, $peg, $user, $short_form );
#------------------------------------------------------------------------

sub sims_request_form {
    my ( $fig, $cgi, $html, $peg, $user, $short_form ) = @_;

    my $trans_role = $cgi->param('translate')            ||  0;

    if ($cgi->param('SPROUT'))
    {
	&sprout_sims_request_form($cgi,$html,$peg,$trans_role,$user);
	return;
    }

    #  Read available parameters, and fill in defaults:

    my $maxN       = defined( $cgi->param('maxN') )       ? $cgi->param('maxN')       : 50;
    my $max_expand = defined( $cgi->param('max_expand') ) ? $cgi->param('max_expand') :  5;
    my $maxP       = defined( $cgi->param('maxP') )       ? $cgi->param('maxP')       :  1.0e-5;
    my $select     = $cgi->param('select')               || 'all';
    my $show_env   = $cgi->param('show_env')             ||  0;
    my $hide_alias = $cgi->param('hide_alias')           ||  0;
    my $sort_by    = $cgi->param('sort_by')              || 'bits';
    my $group_by_genome = $cgi->param('group_by_genome') ||  0;
    my $expand_groups = $cgi->param('expand_groups')     ||  0;

    #  New similarity options

    #  Act on request for more or fewer sim options

    my $extra_opt = defined( $cgi->param('extra_opt') ) ? $cgi->param('extra_opt') : 0;
    if ( $cgi->param('more sim options') ) {
        $extra_opt = 1;
        $cgi->delete('more sim options');
    }
    if ( $cgi->param('fewer sim options') ) {
        $extra_opt = 0;
        $cgi->delete('fewer sim options');
    }

    #  Make defaults completely open (match original behavior)

    my $min_sim   = $extra_opt && defined( $cgi->param('min_sim') )   ? $cgi->param('min_sim')   : 0;
    my $sim_meas  = $extra_opt && defined( $cgi->param('sim_meas') )  ? $cgi->param('sim_meas')  : 'id';
    my $min_q_cov = $extra_opt && defined( $cgi->param('min_q_cov') ) ? $cgi->param('min_q_cov') : 0;
    my $min_s_cov = $extra_opt && defined( $cgi->param('min_s_cov') ) ? $cgi->param('min_s_cov') : 0;

    #  New parameters.  Not yet implimented.
    #  The defaults for representative sequences might be tuned:

    my $show_rep  = $extra_opt && defined( $cgi->param('show_rep') )  ? $cgi->param('show_rep')  : 0;
    my $max_sim   = $extra_opt && defined( $cgi->param('max_sim') )   ? $cgi->param('max_sim')   : 0.70;
    my $dyn_thrsh = $extra_opt && defined( $cgi->param('dyn_thrsh') ) ? $cgi->param('dyn_thrsh') : 0;
    my $save_dist = $extra_opt && defined( $cgi->param('save_dist') ) ? $cgi->param('save_dist') : 0.80;

    #  Mark some of the sequences automatically?

    my $chk_which = $extra_opt && defined( $cgi->param('chk_which') ) ? $cgi->param('chk_which')  : 'none';

    #  Use $cgi->param('more similarities') to drive increase in maxN and max_expand

    if ( $cgi->param('more similarities') ) {
        $maxN       *= 2;
        $max_expand *= 2;
        $cgi->delete('more similarities');
    }

    #  Sanity checks on fixed vocabulary parameter values:

    my %select_opts    = map { ( $_, 1 ) } qw( all  fig  figx  fig_pref  figx_pref );
    my %sort_opts      = map { ( $_, 1 ) } qw( bits  id  id2  bpp  bpp2 );
    my %sim_meas_opts  = map { ( $_, 1 ) } qw( id  bpp );
    my %chk_which_opts = map { ( $_, 1 ) } qw( none  all  rep );

    $select    = 'all'  unless $select_opts{ $select };
    $sort_by   = 'bits' unless $sort_opts{ $sort_by };
    $sim_meas  = 'id'   unless $sim_meas_opts{ $sim_meas };
    $chk_which = 'none' unless $chk_which_opts{ $chk_which };

    #  We have processed all options.  Use them to build forms.

    #  Checkmarks for input tags

    my $chk_select_all   = select_if( $select eq 'all' );
    my $chk_select_figp  = select_if( $select eq 'fig_pref' );
    my $chk_select_figxp = select_if( $select eq 'figx_pref' );
    my $chk_select_fig   = select_if( $select eq 'fig' );
    my $chk_select_figx  = select_if( $select eq 'figx' );
    my $chk_show_env     = chked_if( $show_env );
    my $chk_hide_alias   = chked_if( $hide_alias );
    my $chk_group_by_genome = chked_if( $group_by_genome );
    my $chk_sort_by_id    = select_if( $sort_by eq 'id' );
    my $chk_sort_by_id2   = select_if( $sort_by eq 'id2' );
    my $chk_sort_by_bits  = select_if( $sort_by eq 'bits' );
    my $chk_sort_by_bpp   = select_if( $sort_by eq 'bpp' );
    my $chk_sort_by_bpp2  = select_if( $sort_by eq 'bpp2' );

    #  Features unique to the long form:

    if ( $short_form )
    {
	#  Use a here document to push the short version of the similarities form
	#  on @$html (many values are passed as hidden inputs).

	push @$html, <<"End_Short_Form";

<FORM Action=\"protein.cgi#Similarities\">
    <input type=hidden name=prot      value=\"$peg\">
    <input type=hidden name=sims      value=1>
    <input type=hidden name=fid       value=\"$peg\">
    <input type=hidden name=user      value=\"$user\">
    <input type=hidden name=translate value=$trans_role>

    &nbsp;&nbsp;&nbsp; Max sims:<input type=text name=maxN size=5 value=$maxN> &nbsp;&nbsp;
    Max expand:<input type=text name=max_expand size=5 value=$max_expand> &nbsp;&nbsp;
    Max E-val:<input type=text name=maxP size=8 value=$maxP> &nbsp;&nbsp;
    <select name=select>
	<option value=all       $chk_select_all>Show all databases</option>
	<option value=fig_pref  $chk_select_figp>Prefer FIG IDs (to max exp)</option>
	<option value=figx_pref $chk_select_figxp>Prefer FIG IDs (all)</option>
	<option value=fig       $chk_select_fig>Just FIG IDs (to max exp)</option>
	<option value=figx      $chk_select_figx>Just FIG IDs (all)</option>
    </select> &nbsp;&nbsp;
    Show Env. samples:<input type=checkbox name=show_env value=1 $chk_show_env> &nbsp;&nbsp;
    Hide aliases:<input type=checkbox name=hide_alias value=1 $chk_hide_alias><br />

    <input type=submit name=Similarities value=Similarities> &nbsp;&nbsp;
    Sort by
    <select name=sort_by>
	<option value=bits $chk_sort_by_bits>score</option>
	<option value=id2  $chk_sort_by_id2>percent identity*</option>
	<option value=bpp2 $chk_sort_by_bpp2>score per position*</option>
	<option value=id   $chk_sort_by_id>percent identity</option>
	<option value=bpp  $chk_sort_by_bpp>score per position</option>
    </select> &nbsp;&nbsp;
    Group by genome:<input type=checkbox name=group_by_genome value=1 $chk_group_by_genome>
    &nbsp;&nbsp;&nbsp;
    <A href=\"Html/similarities_options.html\" target=\"SEED_or_SPROUT_help\">Help with SEED similarities options</A><BR />
</FORM>

End_Short_Form

    }
    else
    {
	#  Navigation buttons

	my ( $prev_peg_btn, $next_peg_btn ) = ( "", "" );
	my ( $prefix, $protnum ) = $peg =~ /^(.*\.)(\d+)$/;
	if ( $prefix && $protnum ) {
	    if ( ( $protnum > 1 ) && &translatable( $fig_or_sprout, $prefix . ($protnum-1) ) )
	    {
		$prev_peg_btn = $cgi->submit('previous PEG');
	    }
	    if ( &translatable( $fig_or_sprout, $prefix . ($protnum+1) ) )
	    {
		$next_peg_btn = $cgi->submit('next PEG');
	    }
	}

	#  Add/remove extra options button

	my $extra_opt_btn = $extra_opt ? $cgi->submit('fewer sim options')
	                               : $cgi->submit('more sim options');

	#  Checkmarks for input tags

	my $chk_sim_meas_id  = select_if( $sim_meas eq 'id' );
	my $chk_sim_meas_bpp = select_if( $sim_meas eq 'bpp' );
	my $chk_show_rep     = chked_if( $show_rep );
	my $chk_dyn_thrsh    = chked_if( $dyn_thrsh );
	my $chk_chk_none     = select_if( $chk_which eq 'none' );
	my $chk_chk_all      = select_if( $chk_which eq 'all' );
	my $chk_chk_rep      = select_if( $chk_which eq 'rep' );

	#  Finally time to write some HTML
	#
	#  Default options

	push @$html, <<"End_Default_Options";

<FORM Action=\"protein.cgi#Similarities\">
    <input type=hidden name=prot      value=\"$peg\">
    <input type=hidden name=sims      value=1>
    <input type=hidden name=fid       value=\"$peg\">
    <input type=hidden name=user      value=\"$user\">
    <input type=hidden name=translate value=$trans_role>

    Max sims:<input type=text name=maxN size=5 value=$maxN> &nbsp;&nbsp;
    Max expand:<input type=text name=max_expand size=5 value=$max_expand> &nbsp;&nbsp;
    Max E-val:<input type=text name=maxP size=8 value=$maxP> &nbsp;&nbsp;
    <select name=select>
	<option value=all       $chk_select_all>Show all databases</option>
	<option value=fig_pref  $chk_select_figp>Prefer FIG IDs (to max exp)</option>
	<option value=figx_pref $chk_select_figxp>Prefer FIG IDs (all)</option>
	<option value=fig       $chk_select_fig>Just FIG IDs (to max exp)</option>
	<option value=figx      $chk_select_figx>Just FIG IDs (all)</option>
    </select> &nbsp;&nbsp;
    Show Env. samples:<input type=checkbox name=show_env value=1 $chk_show_env> &nbsp;&nbsp;
    Hide aliases:<input type=checkbox name=hide_alias value=1 $chk_hide_alias><br />

    Sort by
    <select name=sort_by>
	<option value=bits $chk_sort_by_bits>score</option>
	<option value=id2  $chk_sort_by_id2>percent identity*</option>
	<option value=bpp2 $chk_sort_by_bpp2>score per position*</option>
	<option value=id   $chk_sort_by_id>percent identity</option>
	<option value=bpp  $chk_sort_by_bpp>score per position</option>
    </select> &nbsp;&nbsp;
    Group by genome:<input type=checkbox name=group_by_genome value=1 $chk_group_by_genome> &nbsp;&nbsp;&nbsp;
    <A href=\"Html/similarities_options.html\" target=\"SEED_or_SPROUT_help\">Help with SEED similarities options</A><br />
End_Default_Options

	#  Extra options

	push @$html, <<"End_Extra_Options" if $extra_opt;
    <input type=hidden name=extra_opt value=\"$extra_opt\">

    Min similarity:<input type=text name=min_sim size=5 value=$min_sim>
    defined by
    <select name=sim_meas>
	<option value=id  $chk_sim_meas_id>identities (0-100%)</option>
	<option value=bpp $chk_sim_meas_bpp>score per position (0-2 bits)</option>
    </select> &nbsp;&nbsp;
    Min query cover (%):<input type=text name=min_q_cov size=5 value=$min_q_cov> &nbsp;&nbsp;
    Min subject cover (%):<input type=text name=min_s_cov size=5 value=$min_s_cov><br />

    <!--  Hide unimplimented options
    <TABLE Cols=2>
        <TR>
            <TD Valign=top><input type=checkbox name=show_rep $chk_show_rep></TD>
            <TD> Show only representative sequences whose similarities to one another
                are less than <input type=text size=5 name=max_sim value=$max_sim>
                <br />
                <input type=checkbox name=dyn_thrsh value=1 $chk_dyn_thrsh> But keep sequences
                that are at least <input type=text size=5 name=save_dist value=$save_dist>
                times as distant from one another as from the query</TD>
        </TR>
    </TABLE>

    <input type=hidden name=chk_which value=\"$chk_which\">

    Automatically Select (check) which sequences:<select name=chk_which>
	<option value=none $chk_chk_none>none</option>
	<option value=all  $chk_chk_all>all shown</option>
	<option value=rep  $chk_chk_rep>representative set</option>
    </select><br />
    -->
End_Extra_Options

	#  Submit buttons

	push @$html, <<"End_of_Buttons";
    <input type=submit name='resubmit' value='resubmit'>
    <input type=submit name='more similarities' value='more similarities'>
    $prev_peg_btn
    $next_peg_btn
    $extra_opt_btn
</FORM>

End_of_Buttons

    }

    #  Return the current parameter values in a hash

    { maxN          => $maxN,
      maxP          => $maxP,
      max_expand    => $max_expand,
      select        => $select,
      show_env      => $show_env,
      hide_alias    => $hide_alias,
      group_by_genome => $group_by_genome,
      trans_role    => $trans_role,
      extra_opt     => $extra_opt,
      min_sim       => $min_sim,
      min_q_cov     => $min_q_cov,
      min_s_cov     => $min_s_cov,
      sim_meas      => $sim_meas,
      sort_by       => $sort_by,
      show_rep      => $show_rep,
      max_sim       => $max_sim,
      dyn_thrsh     => $dyn_thrsh,
      save_dist     => $save_dist,
      chk_which     => $chk_which,
      expand_groups => $expand_groups
    }
}

sub sprout_sims_request_form {
    my($cgi,$html,$peg,$trans_role,$user) = @_;

	push @$html, <<"End_Short_Form";

<FORM Action=\"protein.cgi\">
    <input type=hidden name=prot      value=\"$peg\">
    <input type=hidden name=sims      value=1>
    <input type=hidden name=SPROUT    value=1>
    <input type=hidden name=user      value=\"$user\">
    <input type=hidden name=translate value=$trans_role>
    <input type=submit name='Bidirectional Best Hits' value='Bidirectional Best Hits'>

</FORM>

End_Short_Form
}


#------------------------------------------------------------------------
#  Auxilliary function to acivate checkmark for input fields
#------------------------------------------------------------------------
sub chked_if { $_[0] ? 'checked ' : '' }

sub select_if { $_[0] ? 'selected ' : '' }



################# Context on the Chromosome ############################

sub print_context {
    my($fig_or_sprout,$cgi,$html,$peg,$feat,$beg,$end) = @_;

    if ($beg eq $end) { cluck "Have zero len"; }
    my($contig1,$beg1,$end1,$strand,$max_so_far,$gap,$comment,$fc,$aliases);
    my($fid1,$sz,$color,$map,$gg,$n,$link,$in_neighborhood);


    my $user = $cgi->param('user');
    my $sprout = $cgi->param('SPROUT') ? 1 : "";
    push(@$html,$cgi->start_form(-action => &cgi_url . "/chromosomal_clusters.cgi"),
	        $cgi->hidden(-name => 'SPROUT', -value => $sprout),
		$cgi->hidden(-name => "prot", -value => $peg),
		$cgi->hidden(-name => "uni", -value => 1),
	        $cgi->hidden(-name => "user", -value => $user));

    my $in_cluster = &in_cluster_with($fig_or_sprout,$cgi,$peg);
    my $col_hdrs;


    if ($cgi->param('SPROUT'))
    {
	$col_hdrs = ["fid","starts","ends","size","","gap","find<br>best<br>clusters","pins","fc-sc","comment","","","aliases"];
    }
    else
    {
	$col_hdrs = ["fid","starts","ends","size","","gap","find<br>best<br>clusters","pins","fc-sc","comment","aliases"];
    }

    my($tab) = [];
    my $genes = [];

    my %coupled;
    
    my $fc_sc;
    foreach $fid1 (@$feat) {
	my $best_clusters_link = "<a href=" . &cgi_url . "/homologs_in_clusters.cgi?prot=$fid1&user=$user&SPROUT=$sprout><img src=\"Html/button-cl.png\" border=\"0\"></a>";
	if (defined($fc_sc = $in_cluster->{$fid1})) 
	{
	    $fc = &pin_link($cgi,$fid1);
	}
	else
	{
	    $fc    = "";
	    $fc_sc = "";
	}

        my $aliases = join( ', ', &feature_aliasesL($fig_or_sprout,$fid1) );
        my $uniprot;
        if ($aliases =~ /(uni[^,]+)/) {
             # print STDERR "$1\n";
             $uniprot = $1;
        }
	$aliases = &HTML::set_prot_links($cgi,$aliases),
	$aliases =~ s/SPROUT=1/SPROUT=0/g;
	$aliases =~ s/[&;]user=[^&;]+[;&]/;/g;
	$aliases = $aliases ? $aliases : "&nbsp;";

	my($to_seed,$to_gbrowse);
	$to_seed = $to_gbrowse = "";
	if ($cgi->param('SPROUT') && ($fid1 =~ /peg/))
	{
	    $to_seed     = &cgi_url . "/protein.cgi?prot=$fid1";
	    $to_gbrowse  = &cgi_url . $fig_or_sprout->get_gbrowse_feature_link($fid1);
	}


        ($contig1,$beg1,$end1) = &boundaries_of($fig_or_sprout,&feature_locationS($fig_or_sprout,$fid1));;
        $strand = ($beg1 < $end1) ? "+" : "-";

        my $function = &function_ofS($fig_or_sprout,$fid1);
        my $info  = join ('<br/>', "<b>PEG:</b> ".$fid1, "<b>Contig:</b> ".$contig1, "<b>Begin:</b> ".$beg1,  "<b>End:</b> ".$end1,$function ? "<b>Function:</b> ".$function : '', $uniprot ? "<b>Uniprot ID:</b> ".$uniprot : '');

        if     ($fid1 eq $peg)    { $color = "green" }
        elsif  ($fc)              { $color = "blue" }
        else                      { $color = "red" }

        if ($fid1 =~ /peg\.(\d+)$/) {
            $n = $1;
	    my $sprout = $cgi->param('SPROUT');
	    $sprout = $sprout ? $sprout : "";
            $link = $cgi->url() . "?prot=$fid1&user=$user&SPROUT=$sprout";
        } elsif ($fid1 =~ /\.([a-z]+)\.\d+$/) {
            $n = uc $1;
            $link = "";
        } else {
            $n ="";
            $link = "";
        }

        push(@$genes,[&min($beg1,$end1),&max($beg1,$end1),($strand eq "+") ? "rightArrow" : "leftArrow", $color,$n,$link,$info]);
        if ($max_so_far) {
            $gap = (&min($beg1,$end1) - $max_so_far) - 1;
        } else {
            $gap = "";
        }
        $max_so_far = &max($beg1,$end1);


        if (&ftype($fid1) eq "peg") {
            $comment = &trans_function_of($cgi,$fig_or_sprout,$fid1,$user);
        } else {
            $comment = "";
        }
        $comment = &set_ec_and_tc_links($fig_or_sprout,&genome_of($fid1),$comment);
        if ($fid1 eq $peg) {
            $comment = "\@bgcolor=\"#00FF00\":$comment";
        }
        $sz = abs($end1-$beg1)+1;

	$comment = $comment ? $comment : "&nbsp;";
	if ($cgi->param('SPROUT'))
	{
	    my($s_link, $g_link);
	    if (0)
	    {
		$s_link = "<a href=$to_seed>S</a>";
		$g_link = "<a href=$to_gbrowse>G</a>";
	    }
	    else
	    {
		$s_link = "<a href=$to_seed><img src=\"Html/button-s.png\" border=\"0\"></a>";
		$g_link = "<a href=$to_gbrowse><img src=\"Html/button-g.png\" border=\"0\"></a>";
	    }
	    push(@$tab,[&HTML::fid_link($cgi,$fid1,"local"),$beg1,$end1,$sz,$strand,$gap,
			$best_clusters_link,
			$fc ? $fc : "&nbsp;",
			$fc_sc ? $fc_sc : "&nbsp;",
			$comment,
			$s_link,
			$g_link,
			$aliases]);
	}
	else
	{
	    push(@$tab,[&HTML::fid_link($cgi,$fid1,"local"),$beg1,$end1,$sz,$strand,$gap,
			$best_clusters_link,
			$fc,$fc_sc,
			$comment,
			$aliases]);
	}
    }
    push(@$html,&HTML::make_table($col_hdrs,$tab,"Context on contig $contig1 from base $beg to $end (".(abs($end-$beg)+1)." bp)"));
    push(@$html,$cgi->end_form);
    return ($beg,$end,$genes);
}

sub print_graphics_context {
    my($beg,$end,$genes,$html) = @_;

    my $map = ["",$beg,$end,$genes];
    my $gg = [$map];
    push(@$html,@{ &GenoGraphics::render($gg,700,4,0,1) });
    return;
}

sub assign_link {
    my($cgi,$func,$existing_func) = @_;
    my($assign_url,$assign_link);

    if ($func && ((! $existing_func) || ($existing_func ne $func))) {
        $cgi->delete('request');
        $assign_url  = $cgi->self_url() . "&request=fast_assign&func=$func";  ## must encode
        $assign_link = "<a href=\"$assign_url\">&nbsp;<=&nbsp;</a>";
    } else {
        $assign_link = "";
    }
    return $assign_link;
}

sub pin_link {
    my($cgi,$peg) = @_;
    my $user = $cgi->param('user');
    $user = defined($user) ? $user : "";

    my $sprout = $cgi->param('SPROUT') ? 1 : "";
    my $cluster_url  = "chromosomal_clusters.cgi?prot=$peg&user=$user&uni=1&SPROUT=$sprout";

    my $cluster_img = 0 ? "*" : '<img src="Html/button-pins-1.png" border="0">';
    my $cluster_link = "<a href=\"$cluster_url\" target=pinned_region.$$>$cluster_img</a>";
    return $cluster_link;
}

sub set_ec_and_tc_links {
    my($fig_or_sprout,$org,$func) = @_;

    if ($func =~ /^(.*)(\d+\.\d+\.\d+\.\d+)(.*)$/) {
        my $before = $1;
        my $ec     = $2;
        my $after  = $3;
        return &set_ec_and_tc_links($fig_or_sprout,$org,$before) . &set_ec_to_maps($fig_or_sprout,$org,$ec) . &set_ec_and_tc_links($fig_or_sprout,$org,$after);
    }
    elsif ($func =~ /^(.*)(TC \d+(\.[0-9A-Z]+){3,6})(.*)$/) {
        my $before = $1;
        my $tc     = $2;
        my $after  = $4;
        return &set_ec_and_tc_links($fig_or_sprout,$org,$before) . &set_tc_link($fig_or_sprout,$org,$tc) . &set_ec_and_tc_links($fig_or_sprout,$org,$after);
    }
    return $func;
}

sub set_tc_link {
    my($fig_or_sprout,$org,$tc) = @_;

    if ($tc =~ /^TC\s+(\S+)$/)
    {
        return "<a href=http://tcdb.ucsd.edu/tcdb/index.php?tc=$1&Submit=Lookup>$tc</a>";
    }
    return $tc;
}


sub set_ec_to_maps {
    my($fig_or_sprout,$org,$ec) = @_;

    my @maps = &ec_to_maps($fig_or_sprout,$ec);
    if (@maps > 0) {
        $cgi->delete('request');
        my $url  = $cgi->self_url() . "&request=ec_to_maps&ec=$ec&org=$org";
        my $link = "<a href=\"$url\">$ec</a>";
        return $link;
    }
    return $ec;
}

sub show_ec_to_maps {
    my($fig_or_sprout,$cgi,$html,$ec) = @_;

    my $ec = $cgi->param('ec');
    if (! $ec) {
        push(@$html,$cgi->h1("Missing EC number"));
        return;
    }

    my @maps = &ec_to_maps($fig_or_sprout,$ec);
    if (@maps > 0) {
        my $col_hdrs = ["map","metabolic topic"];
        my $map;
        my $tab      = [map { $map = $_; [&map_link($cgi,$map),&map_name($fig_or_sprout,$map)] } @maps];
        push(@$html,&HTML::make_table($col_hdrs,$tab,"$ec: " . &ec_name($fig_or_sprout,$ec)));
    }
}

sub map_link {
    my($cgi,$map) = @_;

    $cgi->delete('request');
    my $url  = $cgi->self_url() . "&request=link_to_map&map=$map";
    my $link = "<a href=\"$url\">$map</a>";
    return $link;
}

sub link_to_map {
    my($fig_or_sprout,$cgi,$html) = @_;

    my $map = $cgi->param('map');
    if (! $map) {
        push(@$html,$cgi->h1("Missing Map"));
        return;
    }

    my $org = $cgi->param('org');
    if (! $org) {
        push(@$html,$cgi->h1("Missing Org Parameter"));
        return;
    }
    my$user = $cgi->param('user');
    $user = $user ? $user : "";

    $ENV{"REQUEST_METHOD"} = "GET";
    $ENV{"QUERY_STRING"} = "user=$user&map=$map&org=$org";
    my @out = `./show_kegg_map.cgi`;
    &HTML::trim_output(\@out);
    push(@$html,@out);
}

sub aa_sequence {
    my($fig_or_sprout,$cgi,$html,$prot) = @_;
    my($seq,$func,$i);

    unshift @$html, "<TITLE>The SEED: Protein Sequence</TITLE>\n";
    if ($seq = &get_translation($fig_or_sprout,$prot)) {
        $func = &function_ofS($fig_or_sprout,$prot,$cgi->param('user'));
        push(@$html,$cgi->pre,">$prot $func\n");
        for ($i=0; ($i < length($seq)); $i += 60) {
            if ($i > (length($seq) - 60)) {
                push(@$html,substr($seq,$i) . "\n");
            } else {
                push(@$html,substr($seq,$i,60) . "\n");
            }
        }
        push(@$html,$cgi->end_pre);
    } else {
        push(@$html,$cgi->h1("No translation available for $prot"));
    }
}

sub dna_sequence {
    my($fig_or_sprout,$cgi,$html,$fid) = @_;
    my($seq,$func,$i);

    unshift @$html, "<TITLE>The SEED: Nucleotide Sequence</TITLE>\n";
    if ($seq = &dna_seq($fig_or_sprout,&genome_of($fid),&feature_locationS($fig_or_sprout,$fid))) {
        $func = &function_ofS($fig_or_sprout,$prot,$cgi->param('user'));
        push(@$html,$cgi->pre,">$fid $func\n");
        for ($i=0; ($i < length($seq)); $i += 60) {
            if ($i > (length($seq) - 60)) {
                push(@$html,substr($seq,$i) . "\n");
            } else {
                push(@$html,substr($seq,$i,60) . "\n");
            }
        }
        push(@$html,$cgi->end_pre);
    } else {
        push(@$html,$cgi->h1("No DNA sequence available for $fid"));
    }
}

sub show_fusions {
    my($fig_or_sprout,$cgi,$html,$prot) = @_;

    my $user = $cgi->param('user');
    $user = $user ? $user : "";
    my $sprout = $cgi->param('SPROUT') ? 1 : "";

    $ENV{"REQUEST_METHOD"} = "GET";
    $ENV{"QUERY_STRING"} = "peg=$prot&user=$user&SPROUT=$sprout";
    my @out = `./fusions.cgi`;
    print join("",@out);
    exit;
}

###########################################################################
sub print_compared_regions {
    my($fig_or_sprout,$cgi,$html,$peg) = @_;

    my $sz_region = $cgi->param('sz_region');
    $sz_region = $sz_region ? $sz_region : 16000;

    my $num_close = $cgi->param('num_close');
    $num_close = $num_close ? $num_close : 5;

    my @closest_pegs = &closest_pegs($fig_or_sprout,$cgi,$peg,$num_close);

    if (@closest_pegs > 0) {
        if (&possibly_truncated($fig_or_sprout,$peg)) {
            push(@closest_pegs,&possible_extensions($peg,\@closest_pegs));
        }
        @closest_pegs = &sort_fids_by_taxonomy($fig_or_sprout,@closest_pegs);
        unshift(@closest_pegs,$peg);
        my @all_pegs = ();

        my $gg = &build_maps($fig_or_sprout,\@closest_pegs,\@all_pegs,$sz_region);
        #warn Dumper($gg);
        my $color_sets = &cluster_genes($fig_or_sprout,$cgi,\@all_pegs,$peg);
        &set_colors_text_and_links($gg,\@all_pegs,$color_sets);
        ################################### add commentary capability

        my @parm_reset_form = ($cgi->hr);
        push(@parm_reset_form,$cgi->start_form(-action => &cgi_url . "/protein.cgi" ));
        my $param;
        foreach $param ($cgi->param()) {
            next if (($param eq "sz_region") || ($param eq "num_close"));
            push(@parm_reset_form,$cgi->hidden(-name => $param, -value => $cgi->param($param)));
        }
        push(@parm_reset_form,
                       "size region: ",
                   $cgi->textfield(-name => 'sz_region', -size =>  10, -value => $sz_region, -override => 1),
                   "&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; ",
                   "Number close genomes: ",
                   $cgi->textfield(-name => 'num_close', -size => 4, -value => $num_close, -override => 1),
                   $cgi->br,
                   $cgi->submit('Reset Parameters')
             );
        push(@parm_reset_form,$cgi->end_form);
        push(@$html,@parm_reset_form);
    ####
        my @commentary_form = ();
        my $ctarget = "window$$";
        my $user = $cgi->param('user');
        my $sprout = $cgi->param('SPROUT') ? 1 : "";

        push(@commentary_form,$cgi->start_form(-target => $ctarget,
                               -action => &cgi_url . "/chromosomal_clusters.cgi"
                               ));

        push(@commentary_form,$cgi->hidden(-name => 'SPROUT', -value => $sprout),
                                  $cgi->hidden(-name => "request", -value => "show_commentary"));
        push(@commentary_form,$cgi->hidden(-name => "prot", -value => $peg));
        push(@commentary_form,$cgi->hidden(-name => "uni", -value => 1));
        push(@commentary_form,$cgi->hidden(-name => "user", -value => $user));

        my($gene,$n,%how_many,$val,@vals,$x);
        my($i,$map);
        @vals = ();
        for ($i=(@$gg - 1); ($i >= 0); $i--) {
            my @vals1 = ();
            $map = $gg->[$i];
            my $found = 0;
            my $got_red = 0;
            undef %how_many;
            foreach $gene (@{$map->[3]}) {
                if (($x = $gene->[3]) ne "grey") {
                    $n = $gene->[4];
                    if ($n == 1) { $got_red = 1 }
                    $how_many{$n}++;
                    $gene->[5] =~ /(fig\|\d+\.\d+\.peg\.\d+)/;
                    $val = join("@",($n,$i,$1,$map->[0],$how_many{$n}));
                    push(@vals1,$val);
                    $found++;
                }
            }

            if (! $got_red) {
                splice(@$gg,$i,1);
            } else {
                push(@vals,@vals1);
            }
        }

        if (@$gg == 0) {
            push(@$html,$cgi->h1("Sorry, no pins worked out"));
        } else {
            push(@commentary_form,$cgi->hidden(-name => "show", -value => [@vals]));
            push(@commentary_form,$cgi->submit('commentary'));
            push(@commentary_form,$cgi->end_form());
            push(@$html,@commentary_form);
        }
        ################################################################end commentary
        push(@$html,@{ &GenoGraphics::render($gg,700,4,0,2) });
        if (! $cgi->param('SPROUT'))
        {
            push @$html, &FIGGenDB::linkClusterGenDB($peg);
        }
    }
}

sub closest_pegs {
    my($fig_or_sprout,$cgi,$peg,$n) = @_;
    my($id2,$d,$peg2,$i);

    my @closest;
    if ($cgi->param('SPROUT'))
    {
        @closest = map { $_->[0] } sort { $a->[1] <=> $b->[1] } &bbhs($fig_or_sprout,$peg, 1.0e-10);
    }
    else
    {
        @closest = map { $id2 = $_->id2; ($id2 =~ /^fig\|/) ? $id2 : () } &sims($fig_or_sprout,$peg,&FIG::max(20,$n*4),1.0e-20,"fig",&FIG::max(20,$n*4));
    }

    if (@closest > $n) { $#closest = $n-1 }
    my %closest = map { $_ => 1 } @closest;
    my @pinned_to = grep { $_ ne $peg} &in_pch_pin_with($fig_or_sprout,$peg);
    my $g1 = &genome_of($peg);
    @pinned_to =
        map {$_->[1] }
        sort { $a->[0] <=> $b->[0] }
        map { $peg2 = $_; $d = &crude_estimate_of_distance($fig_or_sprout,$g1,&genome_of($peg2)); [$d,$peg2] }
        @pinned_to;

    for ($i=0; ($i < @pinned_to) && ($i < $n); $i++) {
        $closest{$pinned_to[$i]} = 1;
    }
    return keys(%closest);
}

sub build_maps {
    my($fig_or_sprout,$pinned_pegs,$all_pegs,$sz_region) = @_;
    my($gg,$loc,$contig,$beg,$end,$mid,$min,$max,$genes,$feat,$fid);
    my($contig1,$beg1,$end1,$map,$peg);

    $gg = [];
    foreach $peg (@$pinned_pegs) {
        $loc = &feature_locationS($fig_or_sprout,$peg);
        ($contig,$beg,$end) = &boundaries_of($fig_or_sprout,$loc);
        if ($contig && $beg && $end) {
            $mid = int(($beg + $end) / 2);
            $min = int($mid - ($sz_region / 2));
            $max = int($mid + ($sz_region / 2));
            $genes = [];
            ($feat,undef,undef) = &genes_in_region($fig_or_sprout,$cgi,&genome_of($peg),$contig,$min,$max);
            foreach $fid (@$feat) {
                ($contig1,$beg1,$end1) = &boundaries_of($fig_or_sprout,&feature_locationS($fig_or_sprout,$fid));
                $beg1 = &in_bounds($min,$max,$beg1);
                $end1 = &in_bounds($min,$max,$end1);
                my $aliases = join( ', ', &feature_aliasesL($fig_or_sprout,$fid) );
                my $function = &function_ofS($fig_or_sprout,$fid);
                my $uniprot;
                if ($aliases =~ /(uni[^,]+)/) {
                        $uniprot = $1;
                }
                my $info  = join ('<br/>', "<b>PEG:</b> ".$fid, "<b>Contig:</b> ".$contig1, "<b>Begin:</b> ".$beg1,  "<b>End:</b> ".$end1,$function ? "<b>Function:</b> ".$function : '', $uniprot ? "<b>Uniprot ID:</b> ".$uniprot : '');

                my $sprout = $cgi->param('SPROUT') ? 1 : "";
                my $fmg;
                if ($sprout)
                {
                    $fmg = "<a href=\&quot;protein.cgi?SPROUT=$sprout&compare_region=1\&prot=$fid\&user=\&quot>show</a>";
                }
                else
                {
                    $fmg = join ('<br/>', "<a href=\&quot;protein.cgi?SPROUT=$sprout&compare_region=1\&prot=$fid\&user=\&quot>show</a>",
                            "<a onClick=\&quot;setValue('bound1', '$fid'); return false;\&quot;>set bound 1</a>",
                            "<a onClick=\&quot;setValue('bound2', '$fid'); return false;\&quot;>set bound 2</a>",
                            "<a onClick=\&quot;setValue('candidates', '$fid'); return false;\&quot;>set candidate</a>");
                }
                push(@$genes,[&min($beg1,$end1),
                          &max($beg1,$end1),
                          ($beg1 < $end1) ? "rightArrow" : "leftArrow",
                          "grey",
                          "",
                          $fid,
                          $info, $fmg]);

                if ($fid =~ /peg/) {
                    push(@$all_pegs,$fid);
                }
            }
            $map = [&abbrev(&org_of($fig_or_sprout,$peg)),0,$max+1-$min,
                ($beg < $end) ? &decr_coords($genes,$min) : &flip_map($genes,$min,$max)];
            push(@$gg,$map);
        }
    }
    &GenoGraphics::disambiguate_maps($gg);
    return $gg;
}

sub in {
    my($x,$xL) = @_;
    my($i);

    for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
    return ($i < @$xL);
}

sub in_bounds {
    my($min,$max,$x) = @_;

    if     ($x < $min)     { return $min }
    elsif  ($x > $max)     { return $max }
    else                   { return $x   }
}

sub decr_coords {
    my($genes,$min) = @_;
    my($gene);

    foreach $gene (@$genes) {
        $gene->[0] -= $min;
        $gene->[1] -= $min;
    }
    return $genes;
}

sub flip_map {
    my($genes,$min,$max) = @_;
    my($gene);

    foreach $gene (@$genes) {
        ($gene->[0],$gene->[1]) = ($max - $gene->[1],$max - $gene->[0]);
        $gene->[2] = ($gene->[2] eq "rightArrow") ? "leftArrow" : "rightArrow";
    }
    return $genes;
}

sub cluster_genes {
    my($fig_or_sprout,$cgi,$all_pegs,$peg) = @_;
    my(%seen,$i,$j,$k,$x,$cluster,$conn,$pegI,$red_set);

    my @color_sets = ();

    $conn = &get_connections_by_similarity($fig_or_sprout,$cgi,$all_pegs);

    for ($i=0; ($i < @$all_pegs); $i++) {
        if ($all_pegs->[$i] eq $peg) { $pegI = $i }
        if (! $seen{$i}) {
            $cluster = [$i];
            $seen{$i} = 1;
            for ($j=0; ($j < @$cluster); $j++) {
                $x = $conn->{$cluster->[$j]};
                foreach $k (@$x) {
                    if (! $seen{$k}) {
                        push(@$cluster,$k);
                        $seen{$k} = 1;
                    }
                }
            }

            if ((@$cluster > 1) || ($cluster->[0] eq $pegI)) {
                push(@color_sets,$cluster);
            }
        }
    }
    for ($i=0; ($i < @color_sets) && (! &in($pegI,$color_sets[$i])); $i++) {}
    $red_set = $color_sets[$i];
    splice(@color_sets,$i,1);
    @color_sets = sort { @$b <=> @$a } @color_sets;
    unshift(@color_sets,$red_set);

    my $color_sets = {};
    for ($i=0; ($i < @color_sets); $i++) {
        foreach $x (@{$color_sets[$i]}) {
            $color_sets->{$all_pegs->[$x]} = $i;
        }
    }
    return $color_sets;
}

sub get_connections_by_similarity {
    my($fig_or_sprout,$cgi,$all_pegs) = @_;

    if ($cgi->param('SPROUT'))
    {
	return &get_connections_by_similarity_SPROUT($fig_or_sprout,$all_pegs);
    }
    else
    {
	return &get_connections_by_similarity_SEED($fig_or_sprout,$all_pegs);
    }
}

sub get_connections_by_similarity_SPROUT {
    my($fig_or_sprout,$all_pegs) = @_;
    my(%in,$i,$j,$peg1,$peg2);

    my $conn = {};

    for ($i=0; $i < @$all_pegs; $i++)
    {
	$in{$all_pegs->[$i]} = $i;
    }

    foreach $peg1 (@$all_pegs)
    {
	$i = $in{$peg1};
	foreach $peg2 (map { $_->[0] } bbhs($fig_or_sprout,$peg1,1.0e-10))
	{
	    $j = $in{$peg2};
	    if (defined($i) && defined($j))
	    {
		push(@{$conn->{$i}},$j);
	    }
	}
    }
    return $conn;
}

sub get_connections_by_similarity_SEED {
    my($fig_or_sprout,$all_pegs) = @_;
    my($i,$j,$tmp,$peg,%pos_of);
    my($sim,%conn,$x,$y);

    for ($i=0; ($i < @$all_pegs); $i++) {
        $tmp = &maps_to_id($fig_or_sprout,$all_pegs->[$i]);
        push(@{$pos_of{$tmp}},$i);             # map the representative in nr to subscript in all_pegs
        if ($tmp ne $all_pegs->[$i]) {
            push(@{$pos_of{$all_pegs->[$i]}},$i);
        }
    }

    foreach $y (keys(%pos_of)) {
        $x = $pos_of{$y};
        for ($i=0; ($i < @$x); $i++) {
            for ($j=$i+1; ($j < @$x); $j++) {
                push(@{$conn{$x->[$i]}},$x->[$j]);
                push(@{$conn{$x->[$j]}},$x->[$i]);
            }
        }
    }

    for ($i=0; ($i < @$all_pegs); $i++) {
        foreach $sim (&sims($fig_or_sprout,$all_pegs->[$i],500,1.0e-5,"raw")) {
            if (defined($x = $pos_of{$sim->id2})) {
                foreach $y (@$x) {
                    push(@{$conn{$i}},$y);
                }
            }
        }
    }
    return \%conn;
}

sub set_colors_text_and_links {
    my($gg,$all_pegs,$color_sets) = @_;
    my($map,$gene,$peg,$color);

    foreach $map (@$gg) {
        foreach $gene (@{$map->[3]}) {
            $peg = $gene->[5];
            if (defined($color = $color_sets->{$peg})) {
                $gene->[3] = ($color == 0) ? "red" : "color$color";
                $gene->[4] = $color + 1;
            }
            $gene->[5] = &peg_url($cgi,$peg);
        }
    }
}

sub peg_url {
    my($cgi,$peg) = @_;

    my $prot = $cgi->param('prot');
    $cgi->delete('prot');
    my $url  = $cgi->self_url() . "&prot=$peg&compare_region=1";
    $cgi->delete('prot');
    $cgi->param(-name => 'prot', -value => $prot);

    return $url;
}

sub possible_extensions {
    my($peg,$closest_pegs) = @_;
    my($g,$sim,$id2,$peg1,%poss);

    $g = &genome_of($peg);

    foreach $peg1 (@$closest_pegs) {
        if ($g ne &genome_of($peg1)) {
            foreach $sim (&sims($fig_or_sprout,$peg1,500,1.0e-5,"all")) {
                $id2 = $sim->id2;
                if (($id2 ne $peg) && ($id2 =~ /^fig\|$g\./) && &possibly_truncated($fig_or_sprout,$id2)) {
                    $poss{$id2} = 1;
                }
            }
        }
    }
    return keys(%poss);
}

sub display_page {
    my($fig_or_sprout,$cgi,$html) = @_;

    if (ref($html) eq "ARRAY") {
        if ($traceData) {
            push @$html, QTrace('html');
        }
        &HTML::show_page($cgi,$html);
    } else {
        Trace(Dumper($html)) if T(2);
        if ($cgi->param('SPROUT')) {
            if ($traceData) {
                $html->{tracings} = "<h3>Trace Messages</h3>\n" . QTrace('html');
            } else {
                $html->{tracings} = "\n";
            }
            print "Content-Type: text/html\n";
            print "\n";
            my $templ = "$FIG_Config::fig/CGI/Html/Protein_tmpl.html";
            print PageBuilder::Build("<$templ", $html,"Html");
        } else {
            my $gathered = [];

            my $section;
            foreach $section (qw( javascript
                      general
                      translate_status
                      contig_context
                      context_graphic
                      subsys_connections
                      assign_for_equiv_prots
                      links
                      services
                      kv_pairs
                      compare_region
                      similarities
                      tools
                      ) ) {
                if (@{$html->{$section}} > 0) {
                    push(@$gathered,@{$html->{$section}});
                    push(@$gathered,$cgi->hr);
                }
            }
            pop @$gathered;
            &HTML::show_page($cgi,$gathered);
        }
    }
}

sub show_html_followed_by_initial {
    my($fig_or_sprout,$cgi,$html,$prot) = @_;

    my %html = ( general               => [],
		 contig_context        => [],
		 context_graphic       => [],
		 subsys_connections    => [],
		 links                 => [],
		 services              => [],
		 translate_status      => [],
		 tools                 => [],
		 kv_pairs              => [],
		 similarities          => [],
		 assign_for_equiv_prots => [],
		 javascript            => [],
		 compare_region        => []
	       );

    push(@{$html{general}},@$html);
    $html = \%html;
    &show_initial($fig_or_sprout,$cgi,$html,$prot);
    return $html;
}

sub translation_piece {
    my($fig_or_sprout,$cgi,$html) = @_;

    my $msg;
    my $url = $cgi->self_url();
    if ($cgi->param('translate')) {
        $url =~ s/[;&]translate(=[^;&])?//i or $url =~ s/translate(=[^;&])?[;&]//i;
        $msg = "Turn Off Function Translation";
    } else {
        $url .= ";translate=1";
        $msg = "Translate Function Assignments";
    }
    push(@$html, "<a href=\"$url\">$msg</a><br>\n");
}


#######################################################################################
sub sims {
    my( $fig_or_sprout, $peg, $max, $cutoff, $select, $expand, $group_by_genome, $filters ) = @_;
    my( @tmp, $id, $genome, @genomes, %sims, $sim );

    @tmp = $fig_or_sprout->sims( $peg, $max, $cutoff, $select, $expand, $filters );
    if (! $group_by_genome)  { return @tmp };

    #  Collect all sims from genome with the first occurance of the genome:

    foreach $sim ( @tmp )
    {
        $id = $sim->id2;
        $genome = ($id =~ /^fig\|(\d+\.\d+)\.peg\.\d+/) ? $1 : $id;
        if (! defined( $sims{ $genome } ) ) { push @genomes, $genome }
        push @{ $sims{ $genome } }, $sim;
    }
    return map { @{ $sims{$_} } } @genomes;
}

sub in_cluster_with {
    my($fig_or_sprout,$cgi,$peg) = @_;
    my %in_cluster;

    if ($fig_or_sprout->table_exists('fc_pegs') && $fig_or_sprout->is_complete(&FIG::genome_of($peg)))
    {
	%in_cluster = map { $_->[0] => &ev_link($cgi,$_->[0],$_->[1]) } $fig_or_sprout->coupled_to($peg);
	if (keys(%in_cluster) > 0)
	{
	    $in_cluster{$peg} = "";
	}
	elsif ($cgi->param('fc'))
	{
	    %in_cluster = map { $_ => "" } $fig_or_sprout->in_cluster_with($peg);
	}
    }
    return \%in_cluster;
}


MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3