[Bioperl-guts-l] [14455] bioperl-live/trunk/Bio/Graphics/Glyph/gene.pm: fixed up the gene glyph so that it works properly with CDS-only genes

[Lincoln Stein]

Revision: 14455
Author:   lstein
Date:     2008-01-22 15:48:42 -0500 (Tue, 22 Jan 2008)

Log Message:
-----------
fixed up the gene glyph so that it works properly with CDS-only genes

Modified Paths:
--------------
    bioperl-live/trunk/Bio/Graphics/Glyph/gene.pm

Modified: bioperl-live/trunk/Bio/Graphics/Glyph/gene.pm
===================================================================
--- bioperl-live/trunk/Bio/Graphics/Glyph/gene.pm	2008-01-22 00:16:02 UTC (rev 14454)
+++ bioperl-live/trunk/Bio/Graphics/Glyph/gene.pm	2008-01-22 20:48:42 UTC (rev 14455)
@@ -44,7 +44,9 @@
 
 sub bump {
   my $self = shift;
-  return 1 if $self->{level} == 0; # top level bumps, other levels don't unless specified in config
+  return 1
+    if $self->{level} == 0
+      && lc $self->feature->primary_tag eq 'gene'; # top level bumps, other levels don't unless specified in config
   return $self->SUPER::bump;
 }
 
@@ -92,12 +94,16 @@
 sub _subfeat {
   my $class   = shift;
   my $feature = shift;
-  if ($feature->primary_tag eq 'gene') {
+  if (lc $feature->primary_tag eq 'gene') {
     my @transcripts;
     for my $t (qw/mRNA tRNA snRNA snoRNA miRNA ncRNA pseudogene/) {
       push @transcripts, $feature->get_SeqFeatures($t);
     }
     return @transcripts;
+  } elsif (lc $feature->primary_tag eq 'cds') {
+    my @parts = $feature->get_SeqFeatures();
+    return ($feature) if $class->{level} == 0 and !@parts;
+    return @parts;
   }
 
   my @subparts;