line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Term::TUI; |
2
|
|
|
|
|
|
|
# Copyright (c) 1999-2021 Sullivan Beck. All rights reserved. |
3
|
|
|
|
|
|
|
# This program is free software; you can redistribute it and/or modify it |
4
|
|
|
|
|
|
|
# under the same terms as Perl itself. |
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
######################################################################## |
7
|
|
|
|
|
|
|
# TODO |
8
|
|
|
|
|
|
|
######################################################################## |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
# improve completion: |
11
|
|
|
|
|
|
|
# /math |
12
|
|
|
|
|
|
|
# ad |
13
|
|
|
|
|
|
|
# completes correctly to add but |
14
|
|
|
|
|
|
|
# /math/ad |
15
|
|
|
|
|
|
|
# doesn't autocomplete. |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
# add abbreviation |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
# case insensitivity |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
# add .. and . to valid mode strings |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
# "Hr. Jochen Stenzel" |
24
|
|
|
|
|
|
|
# alias command |
25
|
|
|
|
|
|
|
# history file (stored last commands) |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
# config file (store commands to execute) |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
######################################################################## |
30
|
|
|
|
|
|
|
|
31
|
2
|
|
|
2
|
|
15888
|
use warnings; |
|
2
|
|
|
|
|
11
|
|
|
2
|
|
|
|
|
79
|
|
32
|
2
|
|
|
2
|
|
12
|
use vars qw($VERSION); |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
117
|
|
33
|
|
|
|
|
|
|
$VERSION="1.24"; |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
require 5.000; |
36
|
|
|
|
|
|
|
require Exporter; |
37
|
|
|
|
|
|
|
|
38
|
2
|
|
|
2
|
|
1039
|
use Term::ReadLine; |
|
2
|
|
|
|
|
5521
|
|
|
2
|
|
|
|
|
68
|
|
39
|
2
|
|
|
2
|
|
1002
|
use Text::ParseWords; |
|
2
|
|
|
|
|
2727
|
|
|
2
|
|
|
|
|
231
|
|
40
|
|
|
|
|
|
|
#use Text::Abbrev; |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
@ISA = qw(Exporter); |
43
|
|
|
|
|
|
|
@EXPORT = qw(TUI_Run); |
44
|
|
|
|
|
|
|
@EXPORT_OK = qw(TUI_Script TUI_Out TUI_Version); |
45
|
|
|
|
|
|
|
%EXPORT_TAGS = (all => [ @EXPORT, @EXPORT_OK ]); |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
$| = 1; |
48
|
|
|
|
|
|
|
|
49
|
2
|
|
|
2
|
|
16
|
use strict "vars"; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
1219
|
|
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
sub TUI_Version { |
52
|
0
|
|
|
0
|
1
|
|
return $VERSION; |
53
|
|
|
|
|
|
|
} |
54
|
|
|
|
|
|
|
|
55
|
0
|
|
|
|
|
0
|
BEGIN { |
56
|
2
|
|
|
2
|
|
3196
|
our($term,$out); |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
# |
59
|
|
|
|
|
|
|
# Takes a program name (to be used in the prompt) and an interface |
60
|
|
|
|
|
|
|
# description, and runs with it. |
61
|
|
|
|
|
|
|
# |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
# |
64
|
|
|
|
|
|
|
# Interactive version. |
65
|
|
|
|
|
|
|
# |
66
|
|
|
|
|
|
|
sub TUI_Run { |
67
|
0
|
|
|
0
|
1
|
|
my($program,$hashref)=@_; |
68
|
0
|
|
|
|
|
|
my(@mode,$line,$err); |
69
|
0
|
|
|
|
|
|
my($prompt)="$program> "; |
70
|
0
|
|
|
|
|
|
$term=new Term::ReadLine $program; |
71
|
0
|
|
|
|
|
|
$term->ornaments(0); |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
# Command line completion |
74
|
0
|
|
|
|
|
|
$term->Attribs->{'do_expand'}=1; |
75
|
|
|
|
|
|
|
$term->Attribs->{'completion_entry_function'} = |
76
|
0
|
|
|
|
|
|
$term->Attribs->{'list_completion_function'}; |
77
|
|
|
|
|
|
|
|
78
|
0
|
|
0
|
|
|
|
$out=$term->OUT || STDOUT; |
79
|
|
|
|
|
|
|
|
80
|
0
|
|
|
|
|
|
my($ret)=0; |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
# Command line completion |
83
|
|
|
|
|
|
|
# The strings for completion |
84
|
0
|
|
|
|
|
|
my(@completions) = _GetStrings(\@mode,$hashref); |
85
|
0
|
|
|
|
|
|
$term->Attribs->{'completion_word'} = \@completions; |
86
|
|
|
|
|
|
|
|
87
|
0
|
|
|
|
|
|
while (defined ($line=$term->readline($prompt)) ) { |
88
|
0
|
|
|
|
|
|
$err=_Line(\@mode,$hashref,$line); |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
# Command line completion |
91
|
0
|
|
|
|
|
|
@completions = _GetStrings(\@mode,$hashref); |
92
|
0
|
|
|
|
|
|
$term->Attribs->{'completion_word'} = \@completions; |
93
|
|
|
|
|
|
|
|
94
|
0
|
0
|
0
|
|
|
|
if ($err && $err =~ /^exit\[(\d+)\]$/) { |
95
|
0
|
|
|
|
|
|
$ret=$1; |
96
|
0
|
|
|
|
|
|
last; |
97
|
|
|
|
|
|
|
} |
98
|
0
|
0
|
0
|
|
|
|
print $out $err if ($err && $err !~ /^\d+$/); |
99
|
|
|
|
|
|
|
|
100
|
0
|
0
|
|
|
|
|
if (@mode) { |
101
|
0
|
|
|
|
|
|
$prompt=$program . ":" . join("/",@mode) . "> "; |
102
|
|
|
|
|
|
|
} else { |
103
|
0
|
|
|
|
|
|
$prompt="$program> "; |
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
} |
106
|
0
|
|
|
|
|
|
return $ret; |
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
# |
110
|
|
|
|
|
|
|
# Non-interactive version. |
111
|
|
|
|
|
|
|
# |
112
|
|
|
|
|
|
|
sub TUI_Script { |
113
|
0
|
|
|
0
|
1
|
|
my($hashref,$script,$sep)=@_; |
114
|
0
|
|
|
|
|
|
$out=STDOUT; |
115
|
|
|
|
|
|
|
|
116
|
0
|
0
|
|
|
|
|
$sep=";" if (! $sep); |
117
|
0
|
|
|
|
|
|
my(@cmd)=split(/$sep/,$script); |
118
|
|
|
|
|
|
|
|
119
|
0
|
|
|
|
|
|
my($err,$cmd,@mode); |
120
|
0
|
|
|
|
|
|
my($ret)=0; |
121
|
0
|
|
|
|
|
|
foreach $cmd (@cmd) { |
122
|
0
|
|
|
|
|
|
$err=_Line(\@mode,$hashref,$cmd); |
123
|
0
|
0
|
|
|
|
|
if ($err =~ /^exit\[(\d+)\]$/) { |
124
|
0
|
|
|
|
|
|
$ret=$1; |
125
|
0
|
|
|
|
|
|
last; |
126
|
|
|
|
|
|
|
} |
127
|
0
|
0
|
|
|
|
|
print $out $err if ($err); |
128
|
|
|
|
|
|
|
} |
129
|
0
|
|
|
|
|
|
return $ret; |
130
|
|
|
|
|
|
|
} |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
# |
133
|
|
|
|
|
|
|
# Prints a message. |
134
|
|
|
|
|
|
|
# |
135
|
|
|
|
|
|
|
sub TUI_Out { |
136
|
0
|
|
|
0
|
1
|
|
my($mess)=@_; |
137
|
0
|
|
|
|
|
|
print $out $mess; |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
} |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
######################################################################## |
143
|
|
|
|
|
|
|
# NOT FOR EXPORT |
144
|
|
|
|
|
|
|
######################################################################## |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
{ |
147
|
|
|
|
|
|
|
# Stuff for doing completion. |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
my $i; |
150
|
|
|
|
|
|
|
my @matches; |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
sub _TUI_completion_function { |
153
|
0
|
|
|
0
|
|
|
my($text,$state)=@_; |
154
|
0
|
0
|
|
|
|
|
$i = ($state ? $i : 0); |
155
|
|
|
|
|
|
|
|
156
|
0
|
0
|
|
|
|
|
if (! $i) { |
157
|
0
|
0
|
|
|
|
|
if ($text =~ /^\s*(\S+)\s+(\S+)$/) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
158
|
|
|
|
|
|
|
# MODE CMD^ |
159
|
|
|
|
|
|
|
# completes CMD |
160
|
|
|
|
|
|
|
# MODE/CMD OPTION^ |
161
|
|
|
|
|
|
|
# no matches |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
} elsif ($text =~ /^\s*(\S+)\s+$/) { |
164
|
|
|
|
|
|
|
# MODE ^ |
165
|
|
|
|
|
|
|
# completes CMD |
166
|
|
|
|
|
|
|
# MODE/CMD ^ |
167
|
|
|
|
|
|
|
# no matches |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
} elsif ($text =~ /^\s*(\S+)$/) { |
170
|
|
|
|
|
|
|
# MODE^ |
171
|
|
|
|
|
|
|
# MODE/CMD^ |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
} else { |
174
|
0
|
|
|
|
|
|
@matches=(); |
175
|
|
|
|
|
|
|
} |
176
|
|
|
|
|
|
|
} |
177
|
|
|
|
|
|
|
} |
178
|
|
|
|
|
|
|
} |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
# |
181
|
|
|
|
|
|
|
# Takes the current mode (as a list), the interface description, and |
182
|
|
|
|
|
|
|
# the current line and acts on the line. |
183
|
|
|
|
|
|
|
# |
184
|
|
|
|
|
|
|
sub _Line { |
185
|
0
|
|
|
0
|
|
|
my($moderef,$cmdref,$line)=@_; |
186
|
|
|
|
|
|
|
|
187
|
0
|
|
|
|
|
|
$line =~ s/\s+$//; |
188
|
0
|
|
|
|
|
|
$line =~ s/^\s+//; |
189
|
0
|
0
|
|
|
|
|
return if (! $line); |
190
|
|
|
|
|
|
|
|
191
|
0
|
|
|
|
|
|
my(@cmd)=shellwords($line); |
192
|
0
|
|
|
|
|
|
return _Cmd($moderef,$cmdref,@cmd); |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
|
195
|
0
|
|
|
|
|
|
BEGIN { |
196
|
2
|
|
|
2
|
|
37
|
my(%Cmds) = |
197
|
|
|
|
|
|
|
( |
198
|
|
|
|
|
|
|
".." => [ "Go up one level", "_Mode",0 ], |
199
|
|
|
|
|
|
|
"/" => [ "Go to top level", "_Mode",1 ], |
200
|
|
|
|
|
|
|
"help" => [ "Online help", "_Help" ], |
201
|
|
|
|
|
|
|
"exit" => [ "Exit", "_Exit",0 ], |
202
|
|
|
|
|
|
|
"quit" => [ "An alias for exit", "_Exit",0 ], |
203
|
|
|
|
|
|
|
"abort" => [ "Exit without saving", "_Exit",1 ] |
204
|
|
|
|
|
|
|
); |
205
|
2
|
|
|
|
|
292
|
my($Moderef,$Cmdref); |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
# |
208
|
|
|
|
|
|
|
# Returns an array of strings (commands or modes) that can be |
209
|
|
|
|
|
|
|
# entered given a mode |
210
|
|
|
|
|
|
|
# |
211
|
|
|
|
|
|
|
sub _GetStrings { |
212
|
0
|
|
|
0
|
|
|
my ($moderef,$cmdref) = @_; |
213
|
0
|
|
|
|
|
|
my @strings; |
214
|
|
|
|
|
|
|
|
215
|
0
|
0
|
0
|
|
|
|
if (!defined $Cmdref || ref $Cmdref ne "HASH") { |
216
|
0
|
|
|
|
|
|
$Cmdref = $cmdref; |
217
|
|
|
|
|
|
|
} |
218
|
0
|
|
|
|
|
|
my $desc = _GetMode(@{$moderef}); |
|
0
|
|
|
|
|
|
|
219
|
0
|
0
|
|
|
|
|
if ( ref $desc eq "HASH" ) { |
220
|
0
|
|
|
|
|
|
@strings = grep !/^\./, sort keys %$desc; |
221
|
|
|
|
|
|
|
} |
222
|
0
|
|
|
|
|
|
push @strings,keys %Cmds; |
223
|
0
|
|
|
|
|
|
return @strings; |
224
|
|
|
|
|
|
|
} |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
# |
227
|
|
|
|
|
|
|
# Takes the current mode (as a list), the interface description, and the |
228
|
|
|
|
|
|
|
# current command (as a list) and executes the command. |
229
|
|
|
|
|
|
|
# |
230
|
|
|
|
|
|
|
sub _Cmd { |
231
|
0
|
|
|
0
|
|
|
my($moderef,$cmdref,@args)=@_; |
232
|
0
|
|
|
|
|
|
my($cmd)=shift(@args); |
233
|
0
|
|
|
|
|
|
$Moderef=$moderef; |
234
|
0
|
|
|
|
|
|
$Cmdref=$cmdref; |
235
|
0
|
|
|
|
|
|
my(@mode,$desc,$mode,$help); |
236
|
|
|
|
|
|
|
|
237
|
0
|
0
|
|
|
|
|
if (exists $Cmds{lc $cmd}) { |
238
|
0
|
|
|
|
|
|
$desc=$Cmds{lc $cmd}; |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
} else { |
241
|
0
|
|
|
|
|
|
($mode,@mode)=_CheckMode(\$cmd); |
242
|
|
|
|
|
|
|
|
243
|
0
|
0
|
0
|
|
|
|
if ($mode && $cmd) { |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
244
|
|
|
|
|
|
|
# |
245
|
|
|
|
|
|
|
# MODE/CMD [ARGS] |
246
|
|
|
|
|
|
|
# CMD [ARGS] |
247
|
|
|
|
|
|
|
# |
248
|
0
|
|
|
|
|
|
$desc=_CheckCmd($mode,$cmd); |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
} elsif ($mode && @args) { |
251
|
|
|
|
|
|
|
# |
252
|
|
|
|
|
|
|
# MODE CMD [ARGS] |
253
|
|
|
|
|
|
|
# |
254
|
0
|
|
|
|
|
|
$cmd=shift(@args); |
255
|
0
|
|
|
|
|
|
$desc=_CheckCmd($mode,$cmd); |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
} elsif ($mode) { |
258
|
|
|
|
|
|
|
# |
259
|
|
|
|
|
|
|
# MODE |
260
|
|
|
|
|
|
|
# |
261
|
0
|
|
|
|
|
|
$desc=[ "","_Mode",2,@mode ] |
262
|
|
|
|
|
|
|
} |
263
|
|
|
|
|
|
|
} |
264
|
|
|
|
|
|
|
|
265
|
0
|
|
|
|
|
|
my(@args0); |
266
|
0
|
0
|
|
|
|
|
if (ref $desc eq "ARRAY") { |
267
|
0
|
|
|
|
|
|
($help,$cmd,@args0)=@$desc; |
268
|
0
|
0
|
|
|
|
|
if (! defined &$cmd) { |
269
|
0
|
|
|
|
|
|
$cmd="::$cmd"; |
270
|
0
|
0
|
|
|
|
|
if (! defined &$cmd) { |
271
|
0
|
|
|
|
|
|
return "ERROR: invalid subroutine\n"; |
272
|
|
|
|
|
|
|
} |
273
|
|
|
|
|
|
|
} |
274
|
0
|
|
|
|
|
|
return &$cmd(@args0,@args); |
275
|
|
|
|
|
|
|
} else { |
276
|
0
|
|
|
|
|
|
return "ERROR: unknown command\n"; |
277
|
|
|
|
|
|
|
} |
278
|
|
|
|
|
|
|
} |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
# |
281
|
|
|
|
|
|
|
# Takes a mode and/or command (as a list) and determines the mode |
282
|
|
|
|
|
|
|
# to use. Returns a description of that mode. |
283
|
|
|
|
|
|
|
# |
284
|
|
|
|
|
|
|
sub _CheckMode { |
285
|
0
|
|
|
0
|
|
|
my($cmdref)=@_; |
286
|
0
|
|
|
|
|
|
my($cmd)=$$cmdref; |
287
|
0
|
|
|
|
|
|
my(@mode,$tmp2); |
288
|
|
|
|
|
|
|
|
289
|
0
|
0
|
|
|
|
|
if ($cmd =~ s,^/,,) { |
290
|
0
|
|
|
|
|
|
@mode=split(m|/|,$cmd); |
291
|
|
|
|
|
|
|
} else { |
292
|
0
|
|
|
|
|
|
@mode=(@$Moderef,split(m|/|,$cmd)); |
293
|
|
|
|
|
|
|
} |
294
|
|
|
|
|
|
|
|
295
|
0
|
|
|
|
|
|
my($tmp)=_GetMode(@mode); |
296
|
0
|
0
|
|
|
|
|
if ($tmp) { |
297
|
0
|
|
|
|
|
|
$$cmdref=""; |
298
|
|
|
|
|
|
|
} else { |
299
|
0
|
|
|
|
|
|
$tmp2=pop(@mode); |
300
|
0
|
|
|
|
|
|
$tmp=_GetMode(@mode); |
301
|
0
|
0
|
|
|
|
|
$$cmdref=$tmp2 if ($tmp); |
302
|
|
|
|
|
|
|
} |
303
|
|
|
|
|
|
|
|
304
|
0
|
0
|
|
|
|
|
@mode=() if (! $tmp); |
305
|
0
|
|
|
|
|
|
return ($tmp,@mode); |
306
|
|
|
|
|
|
|
} |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
# |
309
|
|
|
|
|
|
|
# Takes a mode (as a list) and returns it's description (or "" if it's |
310
|
|
|
|
|
|
|
# not a mode). |
311
|
|
|
|
|
|
|
# |
312
|
|
|
|
|
|
|
sub _GetMode { |
313
|
0
|
|
|
0
|
|
|
my(@mode)=@_; |
314
|
0
|
|
|
|
|
|
my($tmp)=$Cmdref; |
315
|
0
|
|
|
|
|
|
my($mode); |
316
|
|
|
|
|
|
|
|
317
|
0
|
|
|
|
|
|
foreach $mode (@mode) { |
318
|
0
|
0
|
0
|
|
|
|
if (exists $$tmp{$mode} && |
319
|
|
|
|
|
|
|
ref $$tmp{$mode} eq "HASH") { |
320
|
0
|
|
|
|
|
|
$tmp=$$tmp{$mode}; |
321
|
|
|
|
|
|
|
} else { |
322
|
0
|
|
|
|
|
|
$tmp=""; |
323
|
0
|
|
|
|
|
|
last; |
324
|
|
|
|
|
|
|
} |
325
|
|
|
|
|
|
|
} |
326
|
0
|
|
|
|
|
|
$tmp; |
327
|
|
|
|
|
|
|
} |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
############################################## |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
# |
332
|
|
|
|
|
|
|
# A command to change the mode. |
333
|
|
|
|
|
|
|
# .. op=0 |
334
|
|
|
|
|
|
|
# / op=1 |
335
|
|
|
|
|
|
|
# MODE op=2 |
336
|
|
|
|
|
|
|
# |
337
|
|
|
|
|
|
|
sub _Mode { |
338
|
0
|
|
|
0
|
|
|
my($op,@mode)=@_; |
339
|
|
|
|
|
|
|
|
340
|
0
|
0
|
|
|
|
|
if ($op==0) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
341
|
|
|
|
|
|
|
# Up one level |
342
|
0
|
0
|
|
|
|
|
if ($#$Moderef>=0) { |
343
|
0
|
|
|
|
|
|
pop(@$Moderef); |
344
|
|
|
|
|
|
|
} else { |
345
|
0
|
|
|
|
|
|
return "WARNING: Invalid operation\n"; |
346
|
|
|
|
|
|
|
} |
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
} elsif ($op==1) { |
349
|
|
|
|
|
|
|
# Top |
350
|
0
|
|
|
|
|
|
@$Moderef=(); |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
} elsif ($op==2) { |
353
|
|
|
|
|
|
|
# Change modes |
354
|
0
|
|
|
|
|
|
@$Moderef=@mode; |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
} else { |
357
|
0
|
|
|
|
|
|
return "ERROR: Invalid mode operation: $op\n"; |
358
|
|
|
|
|
|
|
} |
359
|
0
|
|
|
|
|
|
return ""; |
360
|
|
|
|
|
|
|
} |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
sub _Help { |
363
|
0
|
|
|
0
|
|
|
my($cmd,@args)=@_; |
364
|
|
|
|
|
|
|
|
365
|
0
|
|
|
|
|
|
my($tmp,$mode,@mode); |
366
|
|
|
|
|
|
|
|
367
|
0
|
0
|
|
|
|
|
($tmp,@mode)=_CheckMode(\$cmd) if ($cmd); |
368
|
0
|
0
|
|
|
|
|
if (! $tmp) { |
369
|
0
|
|
|
|
|
|
@mode=@$Moderef; |
370
|
0
|
0
|
|
|
|
|
if (@mode) { |
371
|
0
|
|
|
|
|
|
$tmp=_GetMode(@mode); |
372
|
|
|
|
|
|
|
} else { |
373
|
0
|
|
|
|
|
|
$tmp=$Cmdref; |
374
|
|
|
|
|
|
|
} |
375
|
|
|
|
|
|
|
} |
376
|
|
|
|
|
|
|
|
377
|
0
|
0
|
|
|
|
|
return "IMPOSSIBLE: invalid mode\n" if (! $tmp); |
378
|
|
|
|
|
|
|
|
379
|
0
|
|
|
|
|
|
my($mess); |
380
|
0
|
0
|
0
|
|
|
|
$cmd=shift(@args) if (! $cmd && @args); |
381
|
0
|
0
|
|
|
|
|
if ($cmd) { |
382
|
|
|
|
|
|
|
# |
383
|
|
|
|
|
|
|
# Help on a command |
384
|
|
|
|
|
|
|
# |
385
|
0
|
0
|
|
|
|
|
if (exists $Cmds{$cmd}) { |
|
|
0
|
|
|
|
|
|
386
|
0
|
|
|
|
|
|
$tmp=$Cmds{$cmd}; |
387
|
0
|
|
|
|
|
|
$mess=$$tmp[0]; |
388
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
} elsif (exists $$tmp{$cmd}) { |
390
|
0
|
|
|
|
|
|
$tmp=$$tmp{$cmd}; |
391
|
0
|
0
|
|
|
|
|
if (ref $tmp ne "ARRAY") { |
392
|
0
|
|
|
|
|
|
$mess="Invalid command $cmd"; |
393
|
|
|
|
|
|
|
} else { |
394
|
0
|
|
|
|
|
|
$mess=$$tmp[0]; |
395
|
0
|
0
|
|
|
|
|
$mess="No help available" if (! $mess); |
396
|
|
|
|
|
|
|
} |
397
|
|
|
|
|
|
|
} else { |
398
|
0
|
|
|
|
|
|
$mess="Invalid command: $cmd"; |
399
|
|
|
|
|
|
|
} |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
} else { |
402
|
|
|
|
|
|
|
# |
403
|
|
|
|
|
|
|
# Help on a mode |
404
|
|
|
|
|
|
|
# |
405
|
0
|
0
|
|
|
|
|
if (exists $$tmp{".HELP"}) { |
406
|
0
|
|
|
|
|
|
$mess=$$tmp{".HELP"}; |
407
|
0
|
|
|
|
|
|
my(@gc)=sort grep /^([^.]|\.\.)/i,keys %Cmds; |
408
|
0
|
|
|
|
|
|
my(@cmd)=sort grep /^[^.]/,keys %{ $tmp }; |
|
0
|
|
|
|
|
|
|
409
|
0
|
|
|
|
|
|
my(@m,@c)=(); |
410
|
0
|
|
|
|
|
|
foreach $cmd (@cmd) { |
411
|
0
|
0
|
|
|
|
|
if (ref $$tmp{$cmd} eq "ARRAY") { |
|
|
0
|
|
|
|
|
|
412
|
0
|
|
|
|
|
|
push(@c,$cmd); |
413
|
|
|
|
|
|
|
} elsif (ref $$tmp{$cmd} eq "HASH") { |
414
|
0
|
|
|
|
|
|
push(@m,$cmd); |
415
|
|
|
|
|
|
|
} |
416
|
|
|
|
|
|
|
} |
417
|
0
|
|
|
|
|
|
$mess .= "\n\nAdditional help:\n\n"; |
418
|
0
|
0
|
|
|
|
|
$mess .= " Modes: @m\n" if (@m); |
419
|
0
|
|
|
|
|
|
$mess .= " Cmds : @gc"; |
420
|
0
|
0
|
|
|
|
|
$mess .= "\n" if (@c); |
421
|
0
|
0
|
|
|
|
|
$mess .= " @c" if (@c); |
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
} else { |
424
|
0
|
|
|
|
|
|
$mess="No help available"; |
425
|
|
|
|
|
|
|
} |
426
|
|
|
|
|
|
|
} |
427
|
|
|
|
|
|
|
|
428
|
0
|
|
|
|
|
|
return "\n$mess\n\n"; |
429
|
|
|
|
|
|
|
} |
430
|
|
|
|
|
|
|
} |
431
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
# |
433
|
|
|
|
|
|
|
# Takes a mode and command and return a description of the command. |
434
|
|
|
|
|
|
|
# |
435
|
|
|
|
|
|
|
sub _CheckCmd { |
436
|
0
|
|
|
0
|
|
|
my($moderef,$cmd)=@_; |
437
|
|
|
|
|
|
|
return $$moderef{$cmd} |
438
|
|
|
|
|
|
|
if (exists $$moderef{$cmd} && |
439
|
0
|
0
|
0
|
|
|
|
ref $$moderef{$cmd} eq "ARRAY"); |
440
|
0
|
|
|
|
|
|
return (); |
441
|
|
|
|
|
|
|
} |
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
sub _Exit { |
444
|
0
|
|
|
0
|
|
|
my($flag)=@_; |
445
|
0
|
|
|
|
|
|
return "exit[$flag]"; |
446
|
|
|
|
|
|
|
} |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
# sub { |
449
|
|
|
|
|
|
|
# map {lc($_)} (keys %commands, keys %aliases) |
450
|
|
|
|
|
|
|
# }; |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
# $term->Attribs->{'do_expand'}=1; |
453
|
|
|
|
|
|
|
# $term->Attribs->{'completion_entry_function'} = |
454
|
|
|
|
|
|
|
# sub { |
455
|
|
|
|
|
|
|
# $term->Attribs->{'line_buffer'} =~ /\s/ ? |
456
|
|
|
|
|
|
|
# &{$term->Attribs->{'filename_completion_function'}}(@_) : |
457
|
|
|
|
|
|
|
# &{$term->Attribs->{'list_completion_function'}}(@_) |
458
|
|
|
|
|
|
|
# }; |
459
|
|
|
|
|
|
|
# $term->Attribs->{'completion_word'}=[(map {lc($_)} (keys %commands))]; |
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
1; |
462
|
|
|
|
|
|
|
# Local Variables: |
463
|
|
|
|
|
|
|
# mode: cperl |
464
|
|
|
|
|
|
|
# indent-tabs-mode: nil |
465
|
|
|
|
|
|
|
# cperl-indent-level: 3 |
466
|
|
|
|
|
|
|
# cperl-continued-statement-offset: 2 |
467
|
|
|
|
|
|
|
# cperl-continued-brace-offset: 0 |
468
|
|
|
|
|
|
|
# cperl-brace-offset: 0 |
469
|
|
|
|
|
|
|
# cperl-brace-imaginary-offset: 0 |
470
|
|
|
|
|
|
|
# cperl-label-offset: -2 |
471
|
|
|
|
|
|
|
# End: |