diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/hello.pl')
-rw-r--r-- | Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/hello.pl | 51 |
1 files changed, 51 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/hello.pl b/Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/hello.pl new file mode 100644 index 00000000000..08b1a8b52ec --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/hello.pl @@ -0,0 +1,51 @@ +# hello.pl + +use Config; +use Tk::widgets qw/ ROText /; +use vars qw/ $TOP /; +use strict; + +sub hello { + + my( $demo ) = @_; + + $TOP = $MW->WidgetDemo( + -name => $demo, + -text => [ "This demonstration describes the basics of Perl/Tk programming. Besides this small user guide, there are various FAQs and other resources and tutorials available on the web, such as: + +http://phaseit.net/claird/comp.lang.perl.tk/ptkFAQ.html +http://www.perltk.org +http://user.cs.tu-berlin.de/~eserte +http://www.lehigh.edu/sol0/ptk +", -wraplength => '7i' ], + -title => 'Perl/Tk User Guide', + -iconname => 'hello', + ); + + # Pipe perldoc help output via fileevent() into a Scrolled ROText widget. + + my $t = $TOP->Scrolled( + qw/ ROText -width 80 -height 25 -wrap none -scrollbars osoe/, + ); + $t->focus; + my $cmd = $Config{installbin} . '/perldoc -t Tk::UserGuide'; + $t->pack( qw/ -expand 1 -fill both / ); + + open( H, "$cmd|" ) or die "Cannot get pTk user guide: $!"; + $TOP->fileevent( \*H, 'readable' => [ \&hello_fill, $t ] ); + +} # end hello + +sub hello_fill { + + my( $t ) = @_; + + my $stat = sysread H, my $data, 4096; + die "sysread error: $!" unless defined $stat; + if( $stat == 0 ) { # EOF + $TOP->fileevent( \*H, 'readable' => '' ); + return; + } + $t->insert( 'end', $data ); + +} # end hello_fill |