/usr/local/CPAN/Devel-PDB/Devel/PDB/SourceView.pm

• package Devel::PDB::SourceView
  • new
  • layout
  • source
  • scroll_to_line
  • draw
  • scroll_to_cursor
  • cursor_up
  • cursor_down
  • cursor_pageup
  • cursor_pagedown
  • real_search
  • search
  • search_next
  • search_prev
  • goto
• EOF

# vi: set autoindent shiftwidth=4 tabstop=8 softtabstop=4 expandtab:
package Devel::PDB::SourceView;

use strict;
use warnings;

use Curses;
use Curses::UI::Widget;
use Curses::UI::Common;

use Devel::PDB::Source;

use vars qw(
    $VERSION 
    @ISA
);

$VERSION = '0.1';

@ISA = qw(
    Curses::UI::Widget
);

sub new ()
{
    my ($class, %userargs) = @_;

    keys_to_lowercase(\%userargs);

    my %args = (
        -parent         => undef,    # the parent window
        -width          => undef,    # the width of the label
        -height         => undef,    # the height of the label
        -x              => 0,        # the hor. pos. rel. to the parent
        -y              => 0,        # the vert. pos. rel. to the parent
        -bg             => -1,
        -fg             => -1,
        -source         => undef,

        %userargs,
        
        -routines       => {
	    'cursor-up'		=> \&cursor_up,
	    'cursor-down'	=> \&cursor_down,
	    'cursor-ppage'	=> \&cursor_pageup,
	    'cursor-npage'	=> \&cursor_pagedown,
            'search'            => \&search,
            'search-next'       => \&search_next,
            'search-prev'       => \&search_prev,
            'goto'              => \&goto,
	},
        -bindings       => {
	    KEY_UP() 		=> 'cursor-up',
	    'k' 		=> 'cursor-up',
	    KEY_DOWN() 		=> 'cursor-down',
	    'j' 		=> 'cursor-down',
	    KEY_PPAGE()		=> 'cursor-ppage',
	    "\cB"		=> 'cursor-ppage',
	    KEY_NPAGE()		=> 'cursor-npage',
	    "\cF"		=> 'cursor-npage',
            '/'                 => 'search',
            'n'                 => 'search-next',
            'N'                 => 'search-prev',
            "\cG"               => 'goto',
	},

        -nocursor       => 0,
    );

    # Create the widget.
    my $this = $class->SUPER::new(%args);

    $this->layout();

    return $this;
}

sub layout()
{
    my $this = shift;
    $this->SUPER::layout or return;
    
    return $this;
}

sub source {
    my $this = shift;
    
    if (@_) {
        my $source = shift;
	$this->{-source}->view(undef) if $this->{-source};
        $this->{-source} = $source;
	$this->{-source}->view($this);
        return $this;
    }

    return $this->{-source};
}

sub scroll_to_line {
    my $this = shift;
    my $source = $this->{-source};
    my $current_line = $source->current_line;
    my $y1 = $source->scr_y;
    my $y2 = $y1 + $this->canvasheight;
    
    if ($current_line < $y1 || $current_line >= $y2) {
	$y1 = $current_line - ($this->canvasheight >> 1);
	$y1 = 0 if $y1 < 0;
	$source->scr_y($y1);
    }
}

sub draw(;$)
{
    my $this = shift;
    my $no_update = shift || 0;
    my $source = $this->{-source};
        
    $this->{-title} = $source->filename . ':' . ($source->cur_y + 1);
 
    # Draw the widget.
    $this->SUPER::draw(1) or return $this;

    my $canvas = $this->{-canvasscr};
    
    # Clear all attributes.
    $canvas->attrset(A_NORMAL);

    # Let there be color
    my $color;
    
    if ($Curses::UI::color_support) {
        $color = COLOR_PAIR($Curses::UI::color_object->get_color_pair($this->{-fg}, $this->{-bg}));
        $canvas->attron($color);
    }
    
    my $current_line = $source->current_line;
    my $lines = $source->lines;
    my $breaks = $source->breaks;
    my $cwidth = $this->canvaswidth - 2;
    my $cheight = $this->canvasheight;

    for (my ($n, $y) = ($source->scr_y, 0); $n < @$lines && $y < $cheight; ++$n, ++$y) {
        my $line = $lines->[$n] || '#';
        my $reverse = $current_line == $n;

        chomp $line;
        # Clip it if it is too long.
        $line = substr($line, 0, $cwidth) if length($line) > $cwidth;

        if ($reverse) {
            $canvas->attron(A_REVERSE);
            $canvas->addstr($y, 0, ' ' x $cwidth);
        }

        if ($breaks->{$n}) {
            $canvas->attron(COLOR_PAIR($Curses::UI::color_object->get_color_pair('red', $this->{-bg}))) if $color;
            $canvas->addch($y, 0, '*');
            $canvas->attron($color) if $color;
        }
        $canvas->addstr($y, 2, $line);

        $canvas->attroff(A_REVERSE) if $reverse;
    }
    
    $canvas->move($source->cur_y - $source->scr_y, $source->cur_x - $source->scr_x + 2);
    
    $canvas->noutrefresh;
    doupdate() unless $no_update;

    return $this;
}

sub scroll_to_cursor {
    my ($this) = @_;
    my $source = $this->source;
    my $cur_y = $source->cur_y;
    my $scr_y = $source->scr_y;
    my $height = $this->canvasheight;

    $source->scr_y($cur_y - $height + 1) if $cur_y >= $scr_y + $height;
    $source->scr_y($cur_y) if $cur_y < $scr_y;

    $this->intellidraw;
}

sub cursor_up(;$)
{
    my $this = shift;
    shift; # stub for bindings handling.
    my $amount = shift || 1;
    my $source = $this->source;
    
    $source->cur_y($source->cur_y - $amount);
    $this->scroll_to_cursor;
    
    return $this;
}

sub cursor_down(;$)
{
    my $this = shift;
    shift; # stub for bindings handling.
    my $amount = shift || 1;
    my $source = $this->source;
    
    $source->cur_y($source->cur_y + $amount);
    $this->scroll_to_cursor;
    
    return $this;
}

sub cursor_pageup(;$)
{
    my $this = shift;
    
    $this->cursor_up(undef, $this->canvasheight - 1);
    
    return $this;
}

sub cursor_pagedown(;$)
{
    my $this = shift;
    
    $this->cursor_down(undef, $this->canvasheight - 1);
    
    return $this;
}

sub real_search {
    my ($this, $dir, $regex) = @_;

    $regex = $Curses::UI::rootobject->question('Please enter a RegEx to search for') if !$regex;

    if ($regex) {
        my $source = $this->source;
        my $lines = $source->lines;
        my $cnt = @$lines;
        my $i = $source->cur_y + $dir;
        for (; $i >= 0 && $i < $cnt; $i += $dir) {
            if ($lines->[$i] =~ /$regex/i) {
                $source->cur_y($i);
                $this->scroll_to_cursor;
                last;
            }
        }
        $this->{-lastsearch} = $regex;
    }
}

sub search {
    my $this = shift;
    $this->real_search(1);
}

sub search_next {
    my $this = shift;
    $this->real_search(1, $this->{-lastsearch});
}

sub search_prev {
    my $this = shift;
    $this->real_search(-1, $this->{-lastsearch});
}

sub goto {
    my $this = shift;

    my $line = $Curses::UI::rootobject->question('Destination line number');
    $line = int $line if defined $line;
    if ($line > 0) {
        my $source = $this->source;
        my $cnt = @{$source->lines};

        $line = $cnt if $line > $cnt;
        $source->cur_y($line - 1);
        $this->scroll_to_cursor;
    }
}

1;