搭建 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 $modn"; ???? } } ?? 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 quitn"; ???????? 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__ =~ /^(helps+|?)(.*)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-cC-j" 'inf-perl-send-line) ???????????? (define-key cperl-mode-map "C-cC-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,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,$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,'O',-textcolor => 'blue',-anchor=> 'sw') gtksh> clear_canvas($c) ?? 如果函数出错，可以修改后选中函数再用 C-c C-r 使之重新定义一次就行了。 ?? 需要注意的是交互程序中所有变量都要是全局变量。所以 my 定义的局部变量 在一条语句执行完之后就出了作用域，下一次就没有定义了。