← Back to branch summary

~ubuntu-branches/ubuntu/wily/padre/wily

« back to all changes in this revision

Viewing changes to eg/perl5/shell.pl

  • Committer: Bazaar Package Importer
  • Author(s): Damyan Ivanov
  • Date: 2009-08-12 14:44:55 UTC
  • mfrom: (1.1.5 upstream)
  • Revision ID: james.westby@ubuntu.com-20090812144455-yvk90oa92khfcnls
Tags: 0.42-1
* New Upstream Version
  + add explicit dependency on libtest-simple-perl (>= 0.88)
  + rules: use dh --with quilt (and bump quilt build-dependency to 0.46-7)
  + rules: no need to re-generate .mo files from .po. Upstream does it now
  + copyright: describe share/icons/padre/16x16/logo.png
    - describe share/icons/padre/16x16/toggle-comments.png
    - Padre license is the same as Perl (i.e. not Perl 5)
    - update list of copright holders
    - also list translators
  + drop libtest-most-perl from build-dependencies
  + add liblocale-msgfmt-perl to build-dependencies
  + add libcapture-tiny-perl to (build-)dependencies
  + add libfile-remove-perl (>= 1.42) to (build-)dependencies
  + drop libmodule-inspector-perl from (build-)dependencies
  + add libppix-editortools-perl to (build-)dependencies
  + add libparse-exuberantctags-perl to (build-)dependencies
  + patches:
    - drop lower-wx-requirement-to-2.8.7.patch and replace it with
      SKIP_WXWIDGETS_VERSION_CHECK=1 when configuring
      adjust README.debian accordingly
    - refresh disable-tcp-server.patch
    - drop don't-require-new-file-path.patch (applied upstream)
    - rework fix-pod2-errors.patch (new release, new errors :))
* add fix-perl-interpreter-path.patch fixing the path to the perl interpreter
  in three examples (thanks lintian)
* add more lintian overrides about script-not-executable for scripts that are
  treated as examples/templates
* add fix-whatis.patch fixing the whatis entry of Padre::Wx
* add menu and .desktop file

Show diffs side-by-side

added added

removed removed

Lines of Context:
eg/perl5/shell.pl
 
1
package main;
 
2
 
 
3
use 5.008;
 
4
use strict;
 
5
use warnings;
 
6
 
 
7
# use Demo::App;
 
8
 
 
9
my $app = Demo::App->new;
 
10
$app->run;
 
11
 
 
12
package Shell::App;
 
13
 
 
14
use strict;
 
15
use warnings;
 
16
use base 'Wx::App';
 
17
 
 
18
$| = 1;
 
19
 
 
20
our $frame;
 
21
sub OnInit {
 
22
    my ($self) = @_;
 
23
    $frame = Shell::App::Frame->new($self);
 
24
    $frame->Show( 1 );
 
25
}
 
26
 
 
27
sub new {
 
28
    my $class = shift;
 
29
    my $self = $class->SUPER::new(@_);
 
30
 
 
31
    return $self;
 
32
}
 
33
sub run {
 
34
    my ($self) = @_;
 
35
 
 
36
    $self->setup;
 
37
    $self->MainLoop;
 
38
}
 
39
 
 
40
sub setup {
 
41
}
 
42
 
 
43
sub commands {
 
44
    my ($self, @commands) = @_;
 
45
    $self->{commands}->{$_}++ for @commands;
 
46
    return;
 
47
}
 
48
 
 
49
sub args {
 
50
    my ($self) = @_;
 
51
    # wantarray?
 
52
    return $self->{args};
 
53
}
 
54
 
 
55
package Shell::App::Frame;
 
56
 
 
57
use strict;
 
58
use warnings;
 
59
use Wx qw(:everything);
 
60
 
 
61
use base 'Wx::Frame';
 
62
 
 
63
 
 
64
my ($out, $in);
 
65
 
 
66
sub new {
 
67
    my ($class, $app, $windows) = @_;
 
68
    $windows = 1 if not defined $windows;
 
69
    die if $windows !~ /^[123]$/;
 
70
 
 
71
    my $self = $class->SUPER::new( undef, -1,
 
72
                                 'Shell::App',
 
73
                                  wxDefaultPosition,  [600, 600],
 
74
                                 );
 
75
    $self->{_app} = $app;
 
76
    $self->{prompt} = '>';
 
77
    $self->{windows} = $windows;
 
78
 
 
79
    my $main = Wx::SplitterWindow->new(
 
80
                $self, -1, wxDefaultPosition, wxDefaultSize,
 
81
                wxNO_FULL_REPAINT_ON_RESIZE|wxCLIP_CHILDREN );
 
82
 
 
83
    if ($windows == 1) {
 
84
        $out = Wx::TextCtrl->new( $main, -1, '', wxDefaultPosition, wxDefaultSize,
 
85
            wxTE_MULTILINE|wxNO_FULL_REPAINT_ON_RESIZE
 
86
            );
 
87
        $in = $out;
 
88
 
 
89
    } elsif ($windows == 2) {
 
90
    
 
91
        $out = Wx::TextCtrl->new( $main, -1, '', wxDefaultPosition, wxDefaultSize,
 
92
            wxTE_READONLY|wxTE_MULTILINE|wxNO_FULL_REPAINT_ON_RESIZE
 
93
            );
 
94
        $in = Wx::TextCtrl->new( $main, -1, '', wxDefaultPosition, wxDefaultSize,
 
95
            wxTE_PROCESS_ENTER|wxNO_FULL_REPAINT_ON_RESIZE
 
96
            );
 
97
        Wx::Event::EVT_TEXT_ENTER($self, $in, \&enter);
 
98
        $main->SplitHorizontally( $out, $in, -50 );
 
99
    } else {
 
100
        die "windows=3 Not implemented yet\n";
 
101
    }
 
102
 
 
103
    #Wx::Event::EVT_TEXT($in, \&text_changed );  #here is where we can implement command line cleverness?
 
104
 
 
105
    $in->SetFocus;
 
106
    $out->AppendText($self->{prompt});
 
107
 
 
108
    Wx::Event::EVT_CLOSE( $self,  sub {
 
109
         my ( $self, $event ) = @_;
 
110
         $event->Skip;
 
111
    });
 
112
    return $self;
 
113
}
 
114
 
 
115
sub enter {
 
116
    my ($self, $event) = @_;
 
117
    my $output;
 
118
    if ($self->{windows} eq 1) {
 
119
       $output = $self->enter_1($event);
 
120
    } elsif ($self->{windows} eq 2) {
 
121
       $output = $self->enter_2($event);
 
122
    } else {
 
123
       $output = $self->enter_2($event);
 
124
    }
 
125
 
 
126
    return $output;
 
127
}
 
128
 
 
129
sub enter_1 {
 
130
    my ($self, $event) = @_;
 
131
    my $cmd_line = $in->GetValue;
 
132
 
 
133
    print $cmd_line;
 
134
}
 
135
 
 
136
sub enter_2 {
 
137
    my ($self, $event) = @_;
 
138
 
 
139
    my $cmd_line = $in->GetValue;
 
140
    #process
 
141
    $out->AppendText("$cmd_line\n");
 
142
    my ($cmd, $args) = split /\s+/, $cmd_line, 2;
 
143
    $self->{_app}->{args} = $args;
 
144
 
 
145
    if ($self->{_app}->{commands}->{$cmd}) {
 
146
        my $output = $self->{_app}->$cmd();
 
147
        $out->AppendText($output);
 
148
    } else {
 
149
        $out->AppendText("No such command '$cmd'\n");
 
150
    }
 
151
    $out->AppendText($self->{prompt});
 
152
    $in->SetValue('');
 
153
    #$out
 
154
 
 
155
    return;
 
156
}
 
157
 
 
158
package Demo::App;
 
159
 
 
160
use strict;
 
161
use warnings;
 
162
use base 'Shell::App';
 
163
 
 
164
sub setup {
 
165
    my ($self) = @_;
 
166
 
 
167
    $self->commands(qw(
 
168
            ls
 
169
            ));
 
170
 
 
171
    return;
 
172
}
 
173
 
 
174
sub ls {
 
175
    my ($self) = @_;
 
176
    my $dir = $self->args;
 
177
    $dir = '.' if not defined $dir;
 
178
 
 
179
    #return "running ls\n";
 
180
    my $res = '';
 
181
    if (opendir my $dh, $dir) {
 
182
       my @items = readdir $dh;
 
183
       foreach my $thing (@items) {
 
184
           $res .= "$thing\n";
 
185
       }
 
186
    } else {
 
187
       $res = "Could not open '$dir': $!";
 
188
    }   
 
189
 
 
190
    return $res;
 
191
}