搭建 Gtk2::Perl 单步执行代码的环境

所谓单步执行代码的环境有点类似 shell 那样，输入一条语句，执行一条语句
。可以实时看到结果。需要的程序如下：
  
    emacs 22 或更高版本
    inf-perl.el
    gtksh.pl
  
inf-perl.el 可以从 http://www.emacswiki.org/cgi-bin/emacs/inf-perl.el
下载。
  
gtksh.pl 是这样一个简单脚本：
  
#! /usr/bin/perl -w
package Gtksh::Subs;
use Data::Dumper qw(Dumper);
  
sub reload {
     my $mod = shift;
     (my $file = $mod) =~ s/::/\//g;
     delete $INC{$file.".pm"};
     eval("{
       require $mod;
       1;
     }");
     if ( $@ ) {
         print "Reload $mod failed: $@\n";
     } else {
         print "Successfully reload $mod\n";
     }
}
  
sub Dump {
     print Data::Dumper::Dumper(@_), "\n";
}
  
sub help {
     use Pod::Perldoc;
     my $kw = shift;
     print `perldoc $kw`;
}
  
package main;
  
use Getopt::Long qw(:config no_ignore_case auto_help);
use Gtk2 '-init';
use Glib  qw(TRUE FALSE);
  
{
     no warnings qw(all);
     *x = \&Gtksh::Subs::Dump;
     *reload = \&Gtksh::Subs::reload;
     sub Gtk2::main_quit {
         warn "Gtk2 quit\n";
         return FALSE;
     }
}
our $DEBUG = 0;
our $PROMPT = "gtksh> ";
my $start_up;
  
GetOptions(
     'debug' => \$DEBUG,
     'prompt=s' => \$PROMPT,
     'start-up=s' => \$start_up,
);
  
print "This is a simple perl shell for gtk-perl!\n";
  
if ( defined $start_up && -f $start_up ) {
     print "Load $start_up...\n";
     require $start_up;
}
  
# Turn all buffering off.
select((select(STDOUT), $| = 1)[0]);
select((select(STDERR), $| = 1)[0]);
select((select(STDIN),  $| = 1)[0]);
  
print $PROMPT;
Glib::IO->add_watch (fileno(STDIN), [qw/in/], \&watch_callback, \*STDIN);
Gtk2->main;
  
# make shell prompt print next line
END {
     print "\n";
}
  
sub watch_callback {
     my ($__fd__, $__condition__, $__fh__) = @_;
     # internal variable, strange name so that you seldom change them
     my $__exp__ = "";
     my $__line__;
     while (1) {
         $__line__ = <$__fh__>;
         unless (defined($__line__)) {
             exit;
         }
         chomp($__line__);
         if ($__line__ =~ s/\\\s*$//) {
             print "+> ";
             $__exp__ .= $__line__ . "\n";
         } else {
             last;
         }
     }
     $__exp__ .= $__line__ . "\n";
     print "\nYou just input: $__exp__\n" if $DEBUG;
     if ($__exp__ =~ /^(quit|exit|bye)$/) {
         exit;
     } elsif ( $__exp__ =~ /^(help\s+|\?)(.*)\s*$/ ) {
         Gtksh::Subs::help($2);
     } else {
         print "Eval '$__exp__'\n" if $DEBUG;
         my $res = eval(
             "{
                 no warnings 'all';
                 $__exp__;
             }"
         );
         if ($@) {
             print "Error: $@\n";
         }
         print "\nResult: ", $res, "\n" if defined $res;
     }
     print $PROMPT;
     return TRUE;
}
  
.emacs 配置：
  
(autoload 'run-perl "inf-perl" "perl shell" t)
(setq inf-perl-shell-program
       (expand-file-name "~/.emacs.d/gtksh.pl")
       inf-perl-start-file "~/.emacs.d/.psh_rc")
(add-hook 'inf-perl-mode-hook
           (lambda ()
             ;; customize key bindings
             (define-key cperl-mode-map "\C-c\C-j" 'inf-perl-send-line)
             (define-key cperl-mode-map "\C-c\C-s" 'inf-perl-set-cwd)))
  
使用方法，把 inf-perl.el 放到 load-path 里的一个目录中，gtksh.pl 放到
$HOME/.emacs.d 目录中。M-x run-perl 启动交互程序。在编辑 perl 文件的缓
冲区中预定义这些按键：
  
    C-c C-z 显示并切换到交互程序的缓冲区。当程序没有启动，会先启动
    C-x C-e 把当前行送到交互程序运行
    C-c C-r 把选中区域送到交互程序中运行
    C-c M-r 把选中区域送到交互程序中运行，并切换到该缓冲区
    C-c C-l 把当前缓冲区全部送到交互程序中运行
  
在交互程序中预定义这些命令：
  
    x $var 使用 Data::Dumper::Dumper 显示变量
    (help|?) str 相当于 `perldoc str`。
    reload "Module" 重新载入模块。
    (bye|exit|quit) 退出
  
使用的例子。先在一个文件中写上这几个函数：
  
sub newcan {
     my $win = Gtk2::Window->new('toplevel');
     my $vbox = Gtk2::VBox->new;
     my $swin = Gtk2::ScrolledWindow->new();
     $swin->set_shadow_type('in');
     require Goo::Canvas;
     my $canvas = Goo::Canvas->new;
     $canvas->set_size_request(600, 450);
     $canvas->set_bounds(0, 0, 600, 600);
  
     $win->add($vbox);
     $vbox->add($swin);
     $swin->add($canvas);
     $win->show_all;
     return $canvas;
}
  
sub dot {
     my $canvas = shift;
     my ($x, $y, @args) = @_;
     my ($label, %options);
     while ( @args && $args[0] !~ /^-/ ) {
         $label = shift @args;
     }
     %options = @args;
     $label = $options{-label} unless $label;
     my $anchor = $options{-anchor} || 'nw';
     my $size = $options{-size} || 2;
     my $color = $options{-color} || 'black';
     my $dist = $options{-dist} || 5;
     my $textcolor = $options{-textcolor} || 'black';
     my %shift = (
         'e'  => [ -1,  0 ],
         'se' => [ -0.5,  -0.5 ],
         's'  => [ 0,  -1 ],
         'sw' => [ 0.5, -0.5 ],
         'w'  => [ 1, 0 ],
         'nw' => [ 0.5, 0.5 ],
         'n'  => [ 0,  1 ],
         'ne' => [ -0.5,  0.5 ]
     );
     my @shift = map {$_*$dist} @{$shift{$anchor}};
     my $root = $canvas->get_root_item;
     Goo::Canvas::Ellipse->new(
         $root, $x, $y, $size, $size,
         'fill-color' => $color,
         'line-width' => 0,
     );
     if ( $label ) {
         Goo::Canvas::Text->new(
             $root, $label, $x+$shift[0], $y+$shift[1], -1, $anchor,
             'fill-color'=>$textcolor,
         );
     }
}
  
sub clear_canvas {
     my $canvas = shift;
     my $root = Goo::Canvas::Group->new();
     $canvas->set_root_item( $root );
}
  
用 C-c C-l 把整个文件送到交互程序运行。现在就可以交互程序中测试函数的
效果了：
  
gtksh> $c = newcan
gtksh> dot($c, 100, 100, 'O', -textcolor => 'blue', -anchor=> 'sw')
gtksh> clear_canvas($c)
  
如果函数出错，可以修改后选中函数再用 C-c C-r 使之重新定义一次就行了。
  
需要注意的是交互程序中所有变量都要是全局变量。所以 my 定义的局部变量
在一条语句执行完之后就出了作用域，下一次就没有定义了。