source: trunk/tkcon/docs/perl.txt @ 931

Last change on this file since 931 was 931, checked in by toby, 11 years ago

include rest of files

File size: 2.4 KB
RevLine 
[931]1#!/usr/local/bin/perl -w
2 
3# tkcon.pl - a Perl/Tk  "shell" companion for tkcon.tcl.
4#
5# Variable $MW is an object reference to the main window, from which you can
6# create and manipulate child widgets.  Variable names beginning with an
7# underscore are reserved for this application.
8#
9# Stephen O. Lidie, 96/08/25
10 
11require 5.002;
12use English;
13use Tk;
14use Tk::Pretty qw(Pretty);
15use Tk::Dialog;
16use strict;
17use subs qw(doit tkcon);
18my($MW, $_TKCON, $_VERSION, $_HELP, $_SHELL, $_TAB, $_PARA, @_ERRORS, $_MES);
19 
20tkcon;                          # main
21 
22sub doit {
23 
24    # Eval some code without use strict constraints.
25 
26    my($code) = @ARG;
27 
28    {
29        no strict;
30        if ($_MES) {
31            $_MES->packForget;
32            $_MES->destroy;
33            $_MES = 0;
34        }
35        @_ERRORS = ();
36        $SIG{'__WARN__'} = sub {push @_ERRORS, @ARG};
37        my $_res = eval $code;
38        push @_ERRORS, $EVAL_ERROR if $EVAL_ERROR;
39        push @_ERRORS, $_res;
40    }
41 
42} # end doit
43 
44sub tkcon {
45 
46    # Nothing fancy here, just create the main window and the help dialog
47    # object, and display a pointer to the help.
48 
49    $_TKCON = 'tkcon.pl';
50    $_VERSION = '0.2';
51    $_SHELL = '/bin/sh';
52    $_SHELL = $ENV{'SHELL'} if $ENV{'SHELL'};
53    $_TAB = 0;
54    $_PARA = '';
55 
56    $MW = MainWindow->new;
57    $MW->title($_TKCON);
58    $MW->iconname($_TKCON);
59    $_HELP = $MW->Dialog(
60        -title      => "$_TKCON Help",
61        -font       => 'fixed',
62        -wraplength => '6i',
63        -justify    => 'left',
64        -text       =>
65            "?    - this text.\n" .
66            "|    - pass arguments to your shell (default /bin/sh).\n" .
67            "p    - use Tk::Pretty to \"pretty-print\" arguments.\n" .
68            "+    - a tab starts/stops multiline input mode.\n" .
69            "exit - quit $_TKCON.\n" .
70            "\nOther input is assumed to be a Perl/Tk command.\n" .
71            "\n\$MW is the MainWindow.\n",
72                         );
73    $_HELP->configure(-foreground => 'blue');
74    $_MES = $MW->Label(-text => "\nEnter ? for help.\n")->pack;
75    MainLoop;
76 
77} # end tkcon
78 
79sub Tk::Receive {
80 
81    shift();
82    $ARG = shift();
83    if (/^\?(.*)/) {            # help
84        $_HELP->Show;
85    } elsif (/^\|(.*)/) {       # bang
86        @_ERRORS = ();
87        push @_ERRORS, `$_SHELL -c $1 2>&1`;
88    } elsif (/^\+$/) {
89        $_TAB++;
90        if ($_TAB % 2) {
91            @_ERRORS = ();
92            $_PARA = '';
93            push @_ERRORS, '+';
94        } else {
95            doit $_PARA;
96        }
97    } else {                    # Perl/Tk command
98        $ARG = "Pretty($1)" if (/^p\s(.*)$/);
99        if ($_TAB % 2) {
100            $_PARA .= $ARG;
101            push @_ERRORS, '+';
102        } else {
103            doit $ARG;
104        }
105    } # ifend
106 
107    return @_ERRORS;
108 
109} # end Tk::Receive
Note: See TracBrowser for help on using the repository browser.