line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# Term::GDBUI.pm |
2
|
|
|
|
|
|
|
# Scott Bronson |
3
|
|
|
|
|
|
|
# 3 Nov 2003 |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
# Makes it very easy to implement a GDB-like interface. |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
package Term::GDBUI; |
8
|
|
|
|
|
|
|
|
9
|
1
|
|
|
1
|
|
34753
|
use strict; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
40
|
|
10
|
|
|
|
|
|
|
|
11
|
1
|
|
|
1
|
|
1314
|
use Term::ReadLine (); |
|
1
|
|
|
|
|
4957
|
|
|
1
|
|
|
|
|
24
|
|
12
|
1
|
|
|
1
|
|
825
|
use Text::Shellwords::Cursor; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
45
|
|
13
|
|
|
|
|
|
|
|
14
|
1
|
|
|
1
|
|
9
|
use vars qw($VERSION); |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
530
|
|
15
|
|
|
|
|
|
|
$VERSION = '0.84'; |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
=head1 NAME |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
Term::GDBUI - A fully-featured shell-like command line environment |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
=head1 SYNOPSIS |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
use Term::GDBUI; |
25
|
|
|
|
|
|
|
my $term = new Term::GDBUI(commands => get_commands()); |
26
|
|
|
|
|
|
|
# (see below for the code to get_commands) |
27
|
|
|
|
|
|
|
$term->run(); |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
=head1 DESCRIPTION |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
Term::GDBUI uses the history and autocompletion features of L |
33
|
|
|
|
|
|
|
to present a sophisticated command-line interface to the user. It tries to |
34
|
|
|
|
|
|
|
make every feature you would expect to see in a fully interactive shell |
35
|
|
|
|
|
|
|
trivial to implement. |
36
|
|
|
|
|
|
|
You simply declare your command set and let GDBUI take |
37
|
|
|
|
|
|
|
care of the heavy lifting. |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
=head1 COMMAND SET |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
A command set is the data structure that |
42
|
|
|
|
|
|
|
describes your application's entire user interface. |
43
|
|
|
|
|
|
|
It's easiest to illustrate with a working example. |
44
|
|
|
|
|
|
|
We shall implement the following 6 Ls: |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
=over 4 |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
=item help |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
Prints the help for the given command. |
51
|
|
|
|
|
|
|
With no arguments, prints a list and short summary of all available commands. |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
=item h |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
This is just a synonym for "help". We don't want to list it in the |
56
|
|
|
|
|
|
|
possible completions. |
57
|
|
|
|
|
|
|
Of course, pressing "h" will autocomplete to "help" and |
58
|
|
|
|
|
|
|
then execute the help command. Including this command allows you to |
59
|
|
|
|
|
|
|
simply type "h". |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
=item exists |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
This command shows how to use the |
64
|
|
|
|
|
|
|
L |
65
|
|
|
|
|
|
|
routines to complete on file names, |
66
|
|
|
|
|
|
|
and how to provide more comprehensive help. |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
=item show |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
Demonstrates subcommands (like GDB's show command). |
71
|
|
|
|
|
|
|
This makes it easy to implement commands like "show warranty" |
72
|
|
|
|
|
|
|
and "show args". |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
=item show args |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
This shows more advanced argument processing. |
77
|
|
|
|
|
|
|
First, it uses cusom argument completion: a static completion for the |
78
|
|
|
|
|
|
|
first argument (either "create" or "delete") and the standard |
79
|
|
|
|
|
|
|
file completion for the second. When executed, it echoes its own command |
80
|
|
|
|
|
|
|
name followed by its arguments. |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
=item quit |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
How to nicely quit. |
85
|
|
|
|
|
|
|
Term::GDBUI also follows Term::ReadLine's default of quitting |
86
|
|
|
|
|
|
|
when Control-D is pressed. |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
=back |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
This code is fairly comprehensive because it attempts to |
91
|
|
|
|
|
|
|
demonstrate most of Term::GDBUI's many features. You can find a working |
92
|
|
|
|
|
|
|
version of this exact code titled "synopsis" in the examples directory. |
93
|
|
|
|
|
|
|
For a more real-world example, see the fileman-example in the same |
94
|
|
|
|
|
|
|
directory. |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
sub get_commands |
97
|
|
|
|
|
|
|
{ |
98
|
|
|
|
|
|
|
return { |
99
|
|
|
|
|
|
|
"help" => { |
100
|
|
|
|
|
|
|
desc => "Print helpful information", |
101
|
|
|
|
|
|
|
args => sub { shift->help_args(undef, @_); }, |
102
|
|
|
|
|
|
|
meth => sub { shift->help_call(undef, @_); } |
103
|
|
|
|
|
|
|
}, |
104
|
|
|
|
|
|
|
"h" => { syn => "help", exclude_from_completion=>1}, |
105
|
|
|
|
|
|
|
"exists" => { |
106
|
|
|
|
|
|
|
desc => "List whether files exist", |
107
|
|
|
|
|
|
|
args => sub { shift->complete_files(@_); }, |
108
|
|
|
|
|
|
|
proc => sub { |
109
|
|
|
|
|
|
|
print "exists: " . |
110
|
|
|
|
|
|
|
join(", ", map {-e($_) ? "<$_>":$_} @_) . |
111
|
|
|
|
|
|
|
"\n"; |
112
|
|
|
|
|
|
|
}, |
113
|
|
|
|
|
|
|
doc => <
|
114
|
|
|
|
|
|
|
Comprehensive documentation for our ls command. |
115
|
|
|
|
|
|
|
If a file exists, it is printed in . |
116
|
|
|
|
|
|
|
The help can\nspan\nmany\nlines |
117
|
|
|
|
|
|
|
EOL |
118
|
|
|
|
|
|
|
}, |
119
|
|
|
|
|
|
|
"show" => { |
120
|
|
|
|
|
|
|
desc => "An example of using subcommands", |
121
|
|
|
|
|
|
|
cmds => { |
122
|
|
|
|
|
|
|
"warranty" => { proc => "You have no warranty!\n" }, |
123
|
|
|
|
|
|
|
"args" => { |
124
|
|
|
|
|
|
|
minargs => 2, maxargs => 2, |
125
|
|
|
|
|
|
|
args => [ sub {qw(create delete)}, |
126
|
|
|
|
|
|
|
\&Term::GDBUI::complete_files ], |
127
|
|
|
|
|
|
|
desc => "Demonstrate method calling", |
128
|
|
|
|
|
|
|
meth => sub { |
129
|
|
|
|
|
|
|
my $self = shift; |
130
|
|
|
|
|
|
|
my $parms = shift; |
131
|
|
|
|
|
|
|
print $self->get_cname($parms->{cname}) . |
132
|
|
|
|
|
|
|
": " . join(" ",@_), "\n"; |
133
|
|
|
|
|
|
|
}, |
134
|
|
|
|
|
|
|
}, |
135
|
|
|
|
|
|
|
}, |
136
|
|
|
|
|
|
|
}, |
137
|
|
|
|
|
|
|
"quit" => { |
138
|
|
|
|
|
|
|
desc => "Quit using Fileman", |
139
|
|
|
|
|
|
|
maxargs => 0, |
140
|
|
|
|
|
|
|
meth => sub { shift->exit_requested(1); } |
141
|
|
|
|
|
|
|
}, |
142
|
|
|
|
|
|
|
}; |
143
|
|
|
|
|
|
|
} |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
=head1 COMMAND |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
This data structure describes a single command implemented |
149
|
|
|
|
|
|
|
by your application. |
150
|
|
|
|
|
|
|
"help", "exit", etc. |
151
|
|
|
|
|
|
|
All fields are optional. |
152
|
|
|
|
|
|
|
Commands are passed to Term::GDBUI using a L. |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
=over 4 |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
=item desc |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
A short, one-line description for the command. Normally this is |
159
|
|
|
|
|
|
|
a simple string, but it may also be a subroutine that |
160
|
|
|
|
|
|
|
will be called every time the description is printed. |
161
|
|
|
|
|
|
|
The subroutine takes two arguments, $self (the Term::GDBUI object), |
162
|
|
|
|
|
|
|
and $cmd (the command hash for the command), and returns the |
163
|
|
|
|
|
|
|
command's description as a string. |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
=item doc |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
A comprehensive, many-line description for the command. |
168
|
|
|
|
|
|
|
Like desc, this is normally a string but |
169
|
|
|
|
|
|
|
if you store a reference to a subroutine in this field, |
170
|
|
|
|
|
|
|
it will be called to calculate the documentation. |
171
|
|
|
|
|
|
|
Your subroutine should accept three arguments: self (the Term::GDBUI object), |
172
|
|
|
|
|
|
|
cmd (the command hash for the command), and the command's name. |
173
|
|
|
|
|
|
|
It should return a string containing the command's documentation. |
174
|
|
|
|
|
|
|
See examples/xmlexer to see how to read the doc |
175
|
|
|
|
|
|
|
for a command out of the pod. |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
=item minargs |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
=item maxargs |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
These set the minimum and maximum number of arguments that this |
182
|
|
|
|
|
|
|
command will accept. |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
=item proc |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
This contains a reference to the subroutine that should be executed |
187
|
|
|
|
|
|
|
when this command is called. Arguments are those passed on the |
188
|
|
|
|
|
|
|
command line and the return value is the value returned by |
189
|
|
|
|
|
|
|
call_cmd and process_a_cmd (i.e. it is ignored unless your |
190
|
|
|
|
|
|
|
application makes use of it). |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
If this field is a string instead of a subroutine ref, the string |
193
|
|
|
|
|
|
|
is printed when the command is executed (good for things like |
194
|
|
|
|
|
|
|
"Not implemented yet"). |
195
|
|
|
|
|
|
|
Examples of both subroutine and string procs can be seen in the example |
196
|
|
|
|
|
|
|
above. |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
=item meth |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
Similar to proc, but passes more arguments. Where proc simply passes |
201
|
|
|
|
|
|
|
the arguments for the command, meth also passes the Term::GDBUI object |
202
|
|
|
|
|
|
|
and the command's parms object (see L |
203
|
|
|
|
|
|
|
for more on parms). Most commands can be implemented entirely using |
204
|
|
|
|
|
|
|
a simple proc procedure, but sometimes they require addtional information |
205
|
|
|
|
|
|
|
supplied to the meth method. Like proc, meth may also be a string. |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
=item args |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
This tells how to complete the command's arguments. It is usually |
210
|
|
|
|
|
|
|
a subroutine. See L for an reasonably simple |
211
|
|
|
|
|
|
|
example, and the L routine for a description of the |
212
|
|
|
|
|
|
|
arguments and cmpl data structure. |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
Args can also be an arrayref. Each position in the array will be |
215
|
|
|
|
|
|
|
used as the corresponding argument. |
216
|
|
|
|
|
|
|
See "show args" in get_commands above for an example. |
217
|
|
|
|
|
|
|
The last argument is repeated indefinitely (see L |
218
|
|
|
|
|
|
|
for how to limit this). |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
Finally, args can also be a string. The string is intended to |
221
|
|
|
|
|
|
|
be a reminder and is printed whenever the user types tab twice |
222
|
|
|
|
|
|
|
(i.e. "a number between 0 and 65536"). |
223
|
|
|
|
|
|
|
It does not affect completion at all. |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
=item cmds |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
Command sets can be recursive. This allows a command to have |
228
|
|
|
|
|
|
|
subcommands (like GDB's info and show commands, and the |
229
|
|
|
|
|
|
|
show command in the example above). |
230
|
|
|
|
|
|
|
A command that has subcommands should only have two fields: |
231
|
|
|
|
|
|
|
cmds (of course), and desc (briefly describe this collection of subcommands). |
232
|
|
|
|
|
|
|
It may also implement doc, but GDBUI's default behavior of printing |
233
|
|
|
|
|
|
|
a summary of the command's subcommands is usually sufficient. |
234
|
|
|
|
|
|
|
Any other fields (args, meth, maxargs, etc) will be taken from |
235
|
|
|
|
|
|
|
the subcommand. |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
=item exclude_from_completion |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
If this field exists, then the command will be excluded from command-line |
240
|
|
|
|
|
|
|
completion. This is useful for one-letter abbreviations, such as |
241
|
|
|
|
|
|
|
"h"->"help": including "h" in the completions just clutters up |
242
|
|
|
|
|
|
|
the screen. |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
=item exclude_from_history |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
If this field exists, the command will never be stored in history. |
247
|
|
|
|
|
|
|
This is useful for commands like help and quit. |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
=back |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
=head2 Default Command |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
If your command set includes a command named '' (the empty |
254
|
|
|
|
|
|
|
string), this pseudo-command will be called any time the actual |
255
|
|
|
|
|
|
|
command cannot be found. Here's an example: |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
'' => { |
258
|
|
|
|
|
|
|
proc => "HA ha. No command here by that name\n", |
259
|
|
|
|
|
|
|
desc => "HA ha. No help for unknown commands.", |
260
|
|
|
|
|
|
|
doc => "Yet more taunting...\n", |
261
|
|
|
|
|
|
|
}, |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
Note that minargs and maxargs for the default command are ignored. |
264
|
|
|
|
|
|
|
meth and proc will be called no matter how many arguments the user |
265
|
|
|
|
|
|
|
entered. |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
=head1 CATEGORIES |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
Normally, when the user types 'help', she receives a short |
271
|
|
|
|
|
|
|
summary of all the commands in the command set. |
272
|
|
|
|
|
|
|
However, if your application has 30 or more commands, this can |
273
|
|
|
|
|
|
|
result in information overload. To manage this, you can organize |
274
|
|
|
|
|
|
|
your commands into help categories |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
All help categories are assembled into a hash and passed to the |
277
|
|
|
|
|
|
|
the default L and |
278
|
|
|
|
|
|
|
L methods. If you don't |
279
|
|
|
|
|
|
|
want to use help categories, simply pass undef for the categories. |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
Here is an example of how to declare a collection of help categories: |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
my $helpcats = { |
284
|
|
|
|
|
|
|
breakpoints => { |
285
|
|
|
|
|
|
|
desc => "Commands to halt the program", |
286
|
|
|
|
|
|
|
cmds => qw(break tbreak delete disable enable), |
287
|
|
|
|
|
|
|
}, |
288
|
|
|
|
|
|
|
data => { |
289
|
|
|
|
|
|
|
desc => "Commands to examine data", |
290
|
|
|
|
|
|
|
cmds => ['info', 'show warranty', 'show args'], |
291
|
|
|
|
|
|
|
} |
292
|
|
|
|
|
|
|
}; |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
"show warranty" and "show args" on the last line above |
295
|
|
|
|
|
|
|
are examples of how to include |
296
|
|
|
|
|
|
|
subcommands in a help category: separate the command and |
297
|
|
|
|
|
|
|
subcommands with whitespace. |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
=head1 CALLBACKS |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
Callbacks are functions supplied by GDBUI but intended to be called by |
302
|
|
|
|
|
|
|
your application. |
303
|
|
|
|
|
|
|
They implement common functions like 'help' and 'history'. |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
=over 4 |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
=item help_call(cats, parms, topic) |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
Call this routine to implement your help routine. Pass |
310
|
|
|
|
|
|
|
the help categories or undef, followed by the command-line |
311
|
|
|
|
|
|
|
arguments: |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
"help" => { desc => "Print helpful information", |
314
|
|
|
|
|
|
|
args => sub { shift->help_args($helpcats, @_); }, |
315
|
|
|
|
|
|
|
meth => sub { shift->help_call($helpcats, @_); } }, |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
=cut |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
sub help_call |
320
|
|
|
|
|
|
|
{ |
321
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
322
|
0
|
|
|
|
|
0
|
my $cats = shift; # help categories to use |
323
|
0
|
|
|
|
|
0
|
my $parms = shift; # data block passed to methods |
324
|
0
|
|
|
|
|
0
|
my $topic = $_[0]; # topics or commands to get help on |
325
|
|
|
|
|
|
|
|
326
|
0
|
|
|
|
|
0
|
my $cset = $parms->{cset}; |
327
|
0
|
|
|
|
|
0
|
my $OUT = $self->{OUT}; |
328
|
|
|
|
|
|
|
|
329
|
0
|
0
|
|
|
|
0
|
if(defined($topic)) { |
|
|
0
|
|
|
|
|
|
330
|
0
|
0
|
|
|
|
0
|
if(exists $cats->{$topic}) { |
331
|
0
|
|
|
|
|
0
|
print $OUT $self->get_category_help($cats->{$topic}, $cset); |
332
|
|
|
|
|
|
|
} else { |
333
|
0
|
|
|
|
|
0
|
print $OUT $self->get_cmd_help(\@_, $cset); |
334
|
|
|
|
|
|
|
} |
335
|
|
|
|
|
|
|
} elsif(defined($cats)) { |
336
|
|
|
|
|
|
|
# no topic -- print a list of the categories |
337
|
0
|
|
|
|
|
0
|
print $OUT "\nHelp categories:\n\n"; |
338
|
0
|
|
|
|
|
0
|
for(sort keys(%$cats)) { |
339
|
0
|
|
|
|
|
0
|
print $OUT $self->get_category_summary($_, $cats->{$_}); |
340
|
|
|
|
|
|
|
} |
341
|
|
|
|
|
|
|
} else { |
342
|
|
|
|
|
|
|
# no categories -- print a summary of all commands |
343
|
0
|
|
|
|
|
0
|
print $OUT $self->get_all_cmd_summaries($cset); |
344
|
|
|
|
|
|
|
} |
345
|
|
|
|
|
|
|
} |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
=item help_args |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
This provides argument completion for help commands. |
351
|
|
|
|
|
|
|
See the example above for how to call it. |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
=cut |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
sub help_args |
356
|
|
|
|
|
|
|
{ |
357
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
358
|
0
|
|
|
|
|
0
|
my $helpcats = shift; |
359
|
0
|
|
|
|
|
0
|
my $cmpl = shift; |
360
|
|
|
|
|
|
|
|
361
|
0
|
|
|
|
|
0
|
my $args = $cmpl->{'args'}; |
362
|
0
|
|
|
|
|
0
|
my $argno = $cmpl->{'argno'}; |
363
|
0
|
|
|
|
|
0
|
my $cset = $cmpl->{'cset'}; |
364
|
|
|
|
|
|
|
|
365
|
0
|
0
|
|
|
|
0
|
if($argno == 0) { |
366
|
|
|
|
|
|
|
# return both categories and commands if we're on the first argument |
367
|
0
|
|
|
|
|
0
|
return $self->get_cset_completions($cset, keys(%$helpcats)); |
368
|
|
|
|
|
|
|
} |
369
|
|
|
|
|
|
|
|
370
|
0
|
|
|
|
|
0
|
my($scset, $scmd, $scname, $sargs) = $self->get_deep_command($cset, $args); |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
# without this we'd complete with $scset for all further args |
373
|
0
|
0
|
|
|
|
0
|
return [] if $argno >= @$scname; |
374
|
|
|
|
|
|
|
|
375
|
0
|
|
|
|
|
0
|
return $self->get_cset_completions($scset); |
376
|
|
|
|
|
|
|
} |
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
=item complete_files |
381
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
Completes on filesystem objects (files, directories, etc). |
383
|
|
|
|
|
|
|
Use either |
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
args => sub { shift->complete_files(@_) }, |
386
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
or |
388
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
args => \&complete_files, |
390
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
Starts in the current directory. |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
=cut |
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
sub complete_files |
396
|
|
|
|
|
|
|
{ |
397
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
398
|
0
|
|
|
|
|
0
|
my $cmpl = shift; |
399
|
|
|
|
|
|
|
|
400
|
0
|
|
|
|
|
0
|
$self->suppress_completion_append_character(); |
401
|
|
|
|
|
|
|
|
402
|
1
|
|
|
1
|
|
6
|
use File::Spec; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
8263
|
|
403
|
0
|
|
0
|
|
|
0
|
my @path = File::Spec->splitdir($cmpl->{str} || "."); |
404
|
0
|
|
|
|
|
0
|
my $dir = File::Spec->catdir(@path[0..$#path-1]); |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
# eradicate non-matches immediately (this is important if |
407
|
|
|
|
|
|
|
# completing in a directory with 3000+ files) |
408
|
0
|
|
|
|
|
0
|
my $file = $path[$#path]; |
409
|
0
|
0
|
|
|
|
0
|
$file = '' unless $cmpl->{str}; |
410
|
0
|
|
|
|
|
0
|
my $flen = length($file); |
411
|
|
|
|
|
|
|
|
412
|
0
|
|
|
|
|
0
|
my @files = (); |
413
|
0
|
0
|
|
|
|
0
|
if(opendir(DIR, length($dir) ? $dir : '.')) { |
|
|
0
|
|
|
|
|
|
414
|
0
|
|
|
|
|
0
|
@files = grep { substr($_,0,$flen) eq $file } readdir DIR; |
|
0
|
|
|
|
|
0
|
|
415
|
0
|
|
|
|
|
0
|
closedir DIR; |
416
|
|
|
|
|
|
|
# eradicate dotfiles unless user's file begins with a dot |
417
|
0
|
0
|
|
|
|
0
|
@files = grep { /^[^.]/ } @files unless $file =~ /^\./; |
|
0
|
|
|
|
|
0
|
|
418
|
|
|
|
|
|
|
# reformat filenames to be exactly as user typed |
419
|
0
|
0
|
|
|
|
0
|
@files = map { length($dir) ? ($dir eq '/' ? "/$_" : "$dir/$_") : $_ } @files; |
|
0
|
0
|
|
|
|
0
|
|
420
|
|
|
|
|
|
|
} else { |
421
|
0
|
|
|
|
|
0
|
$self->completemsg("Couldn't read dir: $!\n"); |
422
|
|
|
|
|
|
|
} |
423
|
|
|
|
|
|
|
|
424
|
0
|
|
|
|
|
0
|
return \@files; |
425
|
|
|
|
|
|
|
} |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
=item complete_onlyfiles |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
Like L |
431
|
|
|
|
|
|
|
but excludes directories, device nodes, etc. |
432
|
|
|
|
|
|
|
It returns regular files only. |
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
=cut |
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
sub complete_onlyfiles |
437
|
|
|
|
|
|
|
{ |
438
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
439
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
# need to do our own escaping because we want to add a space ourselves |
441
|
0
|
|
|
|
|
0
|
$self->suppress_completion_escape(); |
442
|
0
|
0
|
|
|
|
0
|
my @c = grep { -f || -d } @{$self->complete_files(@_)}; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
443
|
0
|
|
|
|
|
0
|
$self->{parser}->parse_escape(\@c); |
444
|
|
|
|
|
|
|
# append a space if we've completed a unique file |
445
|
0
|
0
|
|
|
|
0
|
$c[0] .= (-f($c[0]) ? ' ' : '') if @c == 1; |
|
|
0
|
|
|
|
|
|
446
|
|
|
|
|
|
|
# append a helpful slash to indicate directories |
447
|
0
|
0
|
|
|
|
0
|
@c = map { -d($_) ? "$_/" : $_ } @c; |
|
0
|
|
|
|
|
0
|
|
448
|
0
|
|
|
|
|
0
|
return \@c; |
449
|
|
|
|
|
|
|
} |
450
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
=item complete_onlydirs |
453
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
Like L, |
455
|
|
|
|
|
|
|
but excludes files, device nodes, etc. |
456
|
|
|
|
|
|
|
It returns only directories. |
457
|
|
|
|
|
|
|
It I return the . and .. special directories so you'll need |
458
|
|
|
|
|
|
|
to remove those manually if you don't want to see them: |
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
args = sub { grep { !/^\.?\.$/ } complete_onlydirs(@_) }, |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
=cut |
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
sub complete_onlydirs |
465
|
|
|
|
|
|
|
{ |
466
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
467
|
0
|
|
|
|
|
0
|
my @c = grep { -d } @{$self->complete_files(@_)}; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
468
|
0
|
0
|
|
|
|
0
|
$c[0] .= '/' if @c == 1; # add a slash if it's a unique match |
469
|
0
|
|
|
|
|
0
|
return \@c; |
470
|
|
|
|
|
|
|
} |
471
|
|
|
|
|
|
|
|
472
|
|
|
|
|
|
|
|
473
|
|
|
|
|
|
|
=item complete_history |
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
Believe it or not, GDBUI provides tab completion on command history. |
476
|
|
|
|
|
|
|
To use this feature, specify the complete_history routine in |
477
|
|
|
|
|
|
|
your default command handler. Because the default command handler |
478
|
|
|
|
|
|
|
is run any time you enter an unrecognized command, it will be |
479
|
|
|
|
|
|
|
called to perform completion (unless you actually do have commands |
480
|
|
|
|
|
|
|
that begin with a bang). |
481
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
Here's an example of how you would add history completion to |
483
|
|
|
|
|
|
|
your command set: |
484
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
my $cset = { |
486
|
|
|
|
|
|
|
"" => { args => sub { shift->complete_history(@_) } }, |
487
|
|
|
|
|
|
|
# ... more commands go here |
488
|
|
|
|
|
|
|
}; |
489
|
|
|
|
|
|
|
|
490
|
|
|
|
|
|
|
To watch this in action, run your app, type a bang and then a tab ("!"). |
491
|
|
|
|
|
|
|
|
492
|
|
|
|
|
|
|
There is one catch: if you start using completion, be sure to enter the ENTIRE |
493
|
|
|
|
|
|
|
command. If you enter a partial command, Readline will unfortunately stop |
494
|
|
|
|
|
|
|
looking for the match after just the first word (usually the command |
495
|
|
|
|
|
|
|
name). This means that if you want to run "!abc def ghi", Readline will |
496
|
|
|
|
|
|
|
execute the first command that begins with "abc", even though you |
497
|
|
|
|
|
|
|
may have specified another command. |
498
|
|
|
|
|
|
|
Entering the entire command works around this |
499
|
|
|
|
|
|
|
limitation. (If Readline properly supported |
500
|
|
|
|
|
|
|
$term->Attribs->{history_word_delimiters}='\n', |
501
|
|
|
|
|
|
|
this limitation would go away). |
502
|
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
=cut |
504
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
sub complete_history |
506
|
|
|
|
|
|
|
{ |
507
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
508
|
0
|
|
|
|
|
0
|
my $cmpl = shift; |
509
|
|
|
|
|
|
|
|
510
|
0
|
0
|
|
|
|
0
|
return undef if $self->{disable_history_expansion}; |
511
|
|
|
|
|
|
|
|
512
|
|
|
|
|
|
|
# it's not a history command unless it starts with a bang. |
513
|
|
|
|
|
|
|
#return undef unless $cmpl->{tokno} < @{$cmpl->{cname}}; |
514
|
0
|
0
|
|
|
|
0
|
return undef unless substr($cmpl->{tokens}->[0], 0, 1) eq '!'; |
515
|
|
|
|
|
|
|
|
516
|
0
|
0
|
|
|
|
0
|
return undef unless $self->{term}->can('GetHistory'); |
517
|
0
|
|
|
|
|
0
|
my @history = $self->{term}->GetHistory(); |
518
|
0
|
0
|
|
|
|
0
|
return [] unless(@history); |
519
|
|
|
|
|
|
|
|
520
|
0
|
|
|
|
|
0
|
my %seen = (); # uniq history |
521
|
0
|
|
|
|
|
0
|
@history = grep { !$seen{$_}++ } @history; |
|
0
|
|
|
|
|
0
|
|
522
|
|
|
|
|
|
|
|
523
|
|
|
|
|
|
|
# remove items that start with the wrong text |
524
|
0
|
|
|
|
|
0
|
my $str = substr($cmpl->{rawline}, 1, $cmpl->{rawcursor}-1); |
525
|
0
|
|
|
|
|
0
|
my $strlen = length($str); |
526
|
0
|
|
|
|
|
0
|
@history = grep { substr($_,0,$strlen) eq $str } @history; |
|
0
|
|
|
|
|
0
|
|
527
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
# trim all tokens except for the one we're trying to complete |
529
|
|
|
|
|
|
|
# (no need to do this for the first token -- just the rest) |
530
|
0
|
0
|
|
|
|
0
|
if($cmpl->{tokno} > 0) { |
531
|
0
|
|
|
|
|
0
|
my $rawstart = $cmpl->{rawstart} - 1; # no bang so -1 |
532
|
0
|
|
|
|
|
0
|
@history = map { substr($_, $rawstart) } @history; |
|
0
|
|
|
|
|
0
|
|
533
|
|
|
|
|
|
|
} |
534
|
|
|
|
|
|
|
|
535
|
|
|
|
|
|
|
# put a bang on the front if it's the first token |
536
|
0
|
0
|
|
|
|
0
|
@history = map { "!$_" } @history if $cmpl->{tokno} == 0; |
|
0
|
|
|
|
|
0
|
|
537
|
|
|
|
|
|
|
|
538
|
|
|
|
|
|
|
# otherwise the commands would be modified |
539
|
0
|
|
|
|
|
0
|
$self->suppress_completion_escape(); |
540
|
|
|
|
|
|
|
|
541
|
0
|
|
|
|
|
0
|
return \@history; |
542
|
|
|
|
|
|
|
} |
543
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
|
545
|
|
|
|
|
|
|
=item history_call |
546
|
|
|
|
|
|
|
|
547
|
|
|
|
|
|
|
You can use this callback to implement the standard bash |
548
|
|
|
|
|
|
|
history command. This command supports: |
549
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
NUM display last N history items |
551
|
|
|
|
|
|
|
(displays all history if N is omitted) |
552
|
|
|
|
|
|
|
-c clear all history |
553
|
|
|
|
|
|
|
-d NUM delete an item from the history |
554
|
|
|
|
|
|
|
|
555
|
|
|
|
|
|
|
Add it to your command set using something like this: |
556
|
|
|
|
|
|
|
|
557
|
|
|
|
|
|
|
"history" => { desc => "Prints the command history", |
558
|
|
|
|
|
|
|
doc => "Specify a number to list the last N lines of history" . |
559
|
|
|
|
|
|
|
"Pass -c to clear the command history, " . |
560
|
|
|
|
|
|
|
"-d NUM to delete a single item\n", |
561
|
|
|
|
|
|
|
args => "[-c] [-d] [number]", |
562
|
|
|
|
|
|
|
meth => sub { shift->history_call(@_) }, |
563
|
|
|
|
|
|
|
}, |
564
|
|
|
|
|
|
|
|
565
|
|
|
|
|
|
|
=cut |
566
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
sub history_call |
568
|
|
|
|
|
|
|
{ |
569
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
570
|
0
|
|
|
|
|
0
|
my $parms = shift; |
571
|
0
|
|
|
|
|
0
|
my $arg = shift; |
572
|
|
|
|
|
|
|
|
573
|
|
|
|
|
|
|
# clear history? |
574
|
0
|
0
|
0
|
|
|
0
|
if($arg && $arg eq '-c') { |
575
|
0
|
|
|
|
|
0
|
$self->{term}->clear_history(); |
576
|
0
|
|
|
|
|
0
|
return; |
577
|
|
|
|
|
|
|
} |
578
|
0
|
0
|
0
|
|
|
0
|
if($arg && $arg eq '-d') { |
579
|
0
|
0
|
|
|
|
0
|
@_ or die "Need the indexes of the items to delete.\n"; |
580
|
0
|
|
|
|
|
0
|
for(@_) { |
581
|
0
|
0
|
|
|
|
0
|
/^\d+$/ or die "'$_' needs to be numeric.\n"; |
582
|
|
|
|
|
|
|
# function is autoloaded so we can't use can('remove_history') |
583
|
|
|
|
|
|
|
# to see if it exists. So, we'll eval it and pray... |
584
|
0
|
|
|
|
|
0
|
eval { $self->{term}->remove_history($_); } |
|
0
|
|
|
|
|
0
|
|
585
|
|
|
|
|
|
|
} |
586
|
0
|
|
|
|
|
0
|
return; |
587
|
|
|
|
|
|
|
} |
588
|
|
|
|
|
|
|
|
589
|
|
|
|
|
|
|
# number of lines to print (push maximum onto args if no arg supplied) |
590
|
0
|
|
|
|
|
0
|
my $num = -1; |
591
|
0
|
0
|
0
|
|
|
0
|
if($arg && $arg =~ /^(\d+)$/) { |
592
|
0
|
|
|
|
|
0
|
$num = $1; |
593
|
0
|
|
|
|
|
0
|
$arg = undef; |
594
|
|
|
|
|
|
|
} |
595
|
0
|
0
|
|
|
|
0
|
push @_, $arg if $arg; |
596
|
|
|
|
|
|
|
|
597
|
0
|
0
|
|
|
|
0
|
die "Unknown argument" . (@_==1?'':'s') . ": '" . |
|
|
0
|
|
|
|
|
|
598
|
|
|
|
|
|
|
join("', '", @_) . "'\n" if @_; |
599
|
|
|
|
|
|
|
|
600
|
0
|
0
|
|
|
|
0
|
die "Your readline lib doesn't support history!\n" |
601
|
|
|
|
|
|
|
unless $self->{term}->can('GetHistory'); |
602
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
# argh, this has evolved badly... seems to work though. |
604
|
0
|
|
|
|
|
0
|
my @history = $self->{term}->GetHistory(); |
605
|
0
|
|
|
|
|
0
|
my $where = @history; |
606
|
0
|
0
|
0
|
|
|
0
|
$num = @history if $num == -1 || $num > @history; |
607
|
0
|
|
|
|
|
0
|
@history = @history[@history-$num..$#history]; |
608
|
0
|
0
|
|
|
|
0
|
$where = $self->{term}->where_history() |
609
|
|
|
|
|
|
|
if $self->{term}->can('where_history'); |
610
|
0
|
|
|
|
|
0
|
my $i = $where - @history; |
611
|
0
|
|
|
|
|
0
|
for(@history) { |
612
|
0
|
|
|
|
|
0
|
print "$i: $_\n"; |
613
|
0
|
|
|
|
|
0
|
$i += 1; |
614
|
|
|
|
|
|
|
} |
615
|
|
|
|
|
|
|
} |
616
|
|
|
|
|
|
|
|
617
|
|
|
|
|
|
|
|
618
|
|
|
|
|
|
|
=back |
619
|
|
|
|
|
|
|
|
620
|
|
|
|
|
|
|
=head1 METHODS |
621
|
|
|
|
|
|
|
|
622
|
|
|
|
|
|
|
These are the routines that your application calls to create |
623
|
|
|
|
|
|
|
and use a Term::GDBUI object. |
624
|
|
|
|
|
|
|
Usually you simply call new() and then run() -- everything else |
625
|
|
|
|
|
|
|
is handled automatically. |
626
|
|
|
|
|
|
|
You only need to read this section if you wanted to do something out |
627
|
|
|
|
|
|
|
of the ordinary. |
628
|
|
|
|
|
|
|
|
629
|
|
|
|
|
|
|
=over 4 |
630
|
|
|
|
|
|
|
|
631
|
|
|
|
|
|
|
=item new Term::GDBUI(I>) |
632
|
|
|
|
|
|
|
|
633
|
|
|
|
|
|
|
Creates a new GDBUI object. |
634
|
|
|
|
|
|
|
|
635
|
|
|
|
|
|
|
It accepts the following named parameters: |
636
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
=over 3 |
638
|
|
|
|
|
|
|
|
639
|
|
|
|
|
|
|
=item app |
640
|
|
|
|
|
|
|
|
641
|
|
|
|
|
|
|
The name of this application (will be passed to L). |
642
|
|
|
|
|
|
|
Defaults to $0, the name of the current executable. |
643
|
|
|
|
|
|
|
|
644
|
|
|
|
|
|
|
=item term |
645
|
|
|
|
|
|
|
|
646
|
|
|
|
|
|
|
Usually Term::GDBUI uses its own Term::ReadLine object |
647
|
|
|
|
|
|
|
(created with C). However, if |
648
|
|
|
|
|
|
|
you can create a new Term::ReadLine object yourself and |
649
|
|
|
|
|
|
|
supply it using the term argument. |
650
|
|
|
|
|
|
|
|
651
|
|
|
|
|
|
|
=item blank_repeats_cmd |
652
|
|
|
|
|
|
|
|
653
|
|
|
|
|
|
|
This tells Term::GDBUI what to do when the user enters a blank |
654
|
|
|
|
|
|
|
line. Pass 0 (the default) to have it do nothing (like Bash), |
655
|
|
|
|
|
|
|
or 1 to have it repeat the last command (like GDB). |
656
|
|
|
|
|
|
|
|
657
|
|
|
|
|
|
|
=item commands |
658
|
|
|
|
|
|
|
|
659
|
|
|
|
|
|
|
A hashref containing all the commands that GDBUI will respond to. |
660
|
|
|
|
|
|
|
The format of this data structure can be found below in the |
661
|
|
|
|
|
|
|
L documentation. |
662
|
|
|
|
|
|
|
If you do not supply any commands to the constructor, you must call |
663
|
|
|
|
|
|
|
the L method to provide at least a minimal command set before |
664
|
|
|
|
|
|
|
using many of the following calls. You may add or delete commands or |
665
|
|
|
|
|
|
|
even change the entire command set at any time. |
666
|
|
|
|
|
|
|
|
667
|
|
|
|
|
|
|
=item history_file |
668
|
|
|
|
|
|
|
|
669
|
|
|
|
|
|
|
If defined then the command history is saved to this file on exit. |
670
|
|
|
|
|
|
|
It should probably specify a dotfile in the user's home directory. |
671
|
|
|
|
|
|
|
Tilde expansion is performed, so something like |
672
|
|
|
|
|
|
|
C<~/.myprog-history> is perfectly acceptable. |
673
|
|
|
|
|
|
|
|
674
|
|
|
|
|
|
|
=item history_max = 500 |
675
|
|
|
|
|
|
|
|
676
|
|
|
|
|
|
|
This tells how many items to save to the history file. |
677
|
|
|
|
|
|
|
The default is 500. |
678
|
|
|
|
|
|
|
|
679
|
|
|
|
|
|
|
Note that this parameter does not affect in-memory history. Term::GDBUI |
680
|
|
|
|
|
|
|
makes no attemt to cull history so you're at the mercy |
681
|
|
|
|
|
|
|
of the default of whatever ReadLine library you are using. |
682
|
|
|
|
|
|
|
See L for one way to change this. |
683
|
|
|
|
|
|
|
|
684
|
|
|
|
|
|
|
=item disable_history_expansion |
685
|
|
|
|
|
|
|
|
686
|
|
|
|
|
|
|
Term::GDBUI supports the incredibly complex readline4 history expansion |
687
|
|
|
|
|
|
|
(!! repeats last command, !$ is the last arg, etc). |
688
|
|
|
|
|
|
|
It's turned on by default because it can be very useful. |
689
|
|
|
|
|
|
|
If you want to disable it, pass C1>. |
690
|
|
|
|
|
|
|
|
691
|
|
|
|
|
|
|
=item keep_quotes |
692
|
|
|
|
|
|
|
|
693
|
|
|
|
|
|
|
Normally all unescaped, unnecessary quote marks are stripped. |
694
|
|
|
|
|
|
|
If you specify C1>, however, they are preserved. |
695
|
|
|
|
|
|
|
This is useful if your application uses quotes to delimit, say, |
696
|
|
|
|
|
|
|
Perl-style strings. |
697
|
|
|
|
|
|
|
|
698
|
|
|
|
|
|
|
=item backslash_continues_command |
699
|
|
|
|
|
|
|
|
700
|
|
|
|
|
|
|
Normally commands don't respect backslash continuation. If you |
701
|
|
|
|
|
|
|
pass backslash_continues_command=>1 to L, then whenever a line |
702
|
|
|
|
|
|
|
ends with a backslash, Term::GDBUI will continue reading. The backslash |
703
|
|
|
|
|
|
|
is replaced with a space, so |
704
|
|
|
|
|
|
|
$ abc \ |
705
|
|
|
|
|
|
|
> def |
706
|
|
|
|
|
|
|
|
707
|
|
|
|
|
|
|
Will produce the command string 'abc def'. |
708
|
|
|
|
|
|
|
|
709
|
|
|
|
|
|
|
=item prompt |
710
|
|
|
|
|
|
|
|
711
|
|
|
|
|
|
|
This is the prompt that should be displayed for every request. |
712
|
|
|
|
|
|
|
It can be changed at any time using the L method. |
713
|
|
|
|
|
|
|
The default is S<<"$0> ">> (see L above). |
714
|
|
|
|
|
|
|
|
715
|
|
|
|
|
|
|
If you specify a code reference, then the coderef is executed and |
716
|
|
|
|
|
|
|
its return value is set as the prompt. Two arguments are passed |
717
|
|
|
|
|
|
|
to the coderef: the Term::GDBUI object, and the raw command. |
718
|
|
|
|
|
|
|
The raw command is always "" unless you're using command completion, |
719
|
|
|
|
|
|
|
where the raw command is the command line entered so far. |
720
|
|
|
|
|
|
|
|
721
|
|
|
|
|
|
|
For example, the following |
722
|
|
|
|
|
|
|
line sets the prompt to "## > " where ## is the current number of history |
723
|
|
|
|
|
|
|
items. |
724
|
|
|
|
|
|
|
|
725
|
|
|
|
|
|
|
$term->prompt(sub { $term->{term}->GetHistory() . " > " }); |
726
|
|
|
|
|
|
|
|
727
|
|
|
|
|
|
|
If you specify an arrayref, then the first item is the normal prompt |
728
|
|
|
|
|
|
|
and the second item is the prompt when the command is being continued. |
729
|
|
|
|
|
|
|
For instance, this would emulate Bash's behavior ($ is the normal |
730
|
|
|
|
|
|
|
prompt, but > is the prompt when continuing). |
731
|
|
|
|
|
|
|
|
732
|
|
|
|
|
|
|
$term->prompt(['$', '>']); |
733
|
|
|
|
|
|
|
|
734
|
|
|
|
|
|
|
Of course, you specify backslash_continues_command=>1 to to L to cause |
735
|
|
|
|
|
|
|
commands to continue. |
736
|
|
|
|
|
|
|
|
737
|
|
|
|
|
|
|
And, of course, you can use an array of procs too. |
738
|
|
|
|
|
|
|
|
739
|
|
|
|
|
|
|
$term->prompt([sub {'$'}, sub {'<'}]); |
740
|
|
|
|
|
|
|
|
741
|
|
|
|
|
|
|
=item token_chars |
742
|
|
|
|
|
|
|
|
743
|
|
|
|
|
|
|
This argument specifies the characters that should be considered |
744
|
|
|
|
|
|
|
tokens all by themselves. For instance, if I pass |
745
|
|
|
|
|
|
|
token_chars=>'=', then 'ab=123' would be parsed to ('ab', '=', '123'). |
746
|
|
|
|
|
|
|
Without token_chars, 'ab=123' remains a single string. |
747
|
|
|
|
|
|
|
|
748
|
|
|
|
|
|
|
NOTE: you cannot change token_chars after the constructor has been |
749
|
|
|
|
|
|
|
called! The regexps that use it are compiled once (m//o). |
750
|
|
|
|
|
|
|
Also, until the Gnu Readline library can accept "=[]," without |
751
|
|
|
|
|
|
|
diving into an endless loop, we will not tell history expansion |
752
|
|
|
|
|
|
|
to use token_chars (it uses " \t\n()<>;&|" by default). |
753
|
|
|
|
|
|
|
|
754
|
|
|
|
|
|
|
=item display_summary_in_help |
755
|
|
|
|
|
|
|
|
756
|
|
|
|
|
|
|
Usually it's easier to have the command's summary (desc) printed first, |
757
|
|
|
|
|
|
|
then follow it with the documentation (doc). However, if the doc |
758
|
|
|
|
|
|
|
already contains its description (for instance, if you're reading it |
759
|
|
|
|
|
|
|
from a podfile), you don't want the summary up there too. Pass 0 |
760
|
|
|
|
|
|
|
to prevent printing the desc above the doc. Defaults to 1. |
761
|
|
|
|
|
|
|
|
762
|
|
|
|
|
|
|
=back |
763
|
|
|
|
|
|
|
|
764
|
|
|
|
|
|
|
=cut |
765
|
|
|
|
|
|
|
|
766
|
|
|
|
|
|
|
sub new |
767
|
|
|
|
|
|
|
{ |
768
|
1
|
|
|
1
|
1
|
28529
|
my $type = shift; |
769
|
1
|
|
|
|
|
67
|
my %args = ( |
770
|
|
|
|
|
|
|
app => $0, |
771
|
|
|
|
|
|
|
prompt => "$0> ", |
772
|
|
|
|
|
|
|
commands => undef, |
773
|
|
|
|
|
|
|
blank_repeats_cmd => 0, |
774
|
|
|
|
|
|
|
backslash_continues_command => 0, |
775
|
|
|
|
|
|
|
history_file => undef, |
776
|
|
|
|
|
|
|
history_max => 500, |
777
|
|
|
|
|
|
|
token_chars => '', |
778
|
|
|
|
|
|
|
keep_quotes => 0, |
779
|
|
|
|
|
|
|
debug_complete => 0, |
780
|
|
|
|
|
|
|
disable_history_expansion => 0, |
781
|
|
|
|
|
|
|
display_summary_in_help => 1, |
782
|
|
|
|
|
|
|
@_ |
783
|
|
|
|
|
|
|
); |
784
|
|
|
|
|
|
|
|
785
|
1
|
|
|
|
|
5
|
my $self = {}; |
786
|
1
|
|
|
|
|
7
|
bless $self, $type; |
787
|
|
|
|
|
|
|
|
788
|
1
|
|
|
|
|
11
|
$self->{done} = 0; |
789
|
|
|
|
|
|
|
|
790
|
|
|
|
|
|
|
$self->{parser} = Text::Shellwords::Cursor->new( |
791
|
|
|
|
|
|
|
token_chars => $args{token_chars}, |
792
|
|
|
|
|
|
|
keep_quotes => $args{keep_quotes}, |
793
|
|
|
|
|
|
|
debug => 0, |
794
|
0
|
|
|
0
|
|
0
|
error => sub { shift; $self->error(@_); }, |
|
0
|
|
|
|
|
0
|
|
795
|
1
|
|
|
|
|
53
|
); |
796
|
|
|
|
|
|
|
|
797
|
|
|
|
|
|
|
# expand tildes in the history file |
798
|
1
|
50
|
|
|
|
13
|
if($args{history_file}) { |
799
|
0
|
0
|
0
|
|
|
0
|
$args{history_file} =~ s/^~([^\/]*)/$1?(getpwnam($1))[7]: |
|
0
|
|
|
|
|
0
|
|
800
|
|
|
|
|
|
|
$ENV{HOME}||$ENV{LOGDIR}||(getpwuid($>))[7]/e; |
801
|
|
|
|
|
|
|
} |
802
|
|
|
|
|
|
|
|
803
|
1
|
|
|
|
|
10
|
for(keys %args) { |
804
|
13
|
100
|
|
|
|
29
|
next if $_ eq 'app'; # this param is not a member |
805
|
12
|
|
|
|
|
26
|
$self->{$_} = $args{$_}; |
806
|
|
|
|
|
|
|
} |
807
|
|
|
|
|
|
|
|
808
|
1
|
|
33
|
|
|
34
|
$self->{term} ||= new Term::ReadLine($args{'app'}); |
809
|
1
|
|
|
|
|
10
|
$self->{term}->MinLine(0); # manually call AddHistory |
810
|
|
|
|
|
|
|
|
811
|
1
|
|
|
|
|
7
|
my $attrs = $self->{term}->Attribs; |
812
|
|
|
|
|
|
|
# there appear to be catastrophic bugs with history_word_delimiters |
813
|
|
|
|
|
|
|
# it goes into an infinite loop when =,[] are in token_chars |
814
|
|
|
|
|
|
|
# $attrs->{history_word_delimiters} = " \t\n".$self->{token_chars}; |
815
|
1
|
|
|
0
|
|
11
|
$attrs->{completion_function} = sub { completion_function($self, @_); }; |
|
0
|
|
|
|
|
0
|
|
816
|
|
|
|
|
|
|
|
817
|
1
|
|
50
|
|
|
5
|
$self->{OUT} = $self->{term}->OUT || \*STDOUT; |
818
|
1
|
|
|
|
|
15
|
$self->{prevcmd} = ""; # cmd to run again if user hits return |
819
|
|
|
|
|
|
|
|
820
|
1
|
|
|
|
|
10
|
return $self; |
821
|
|
|
|
|
|
|
} |
822
|
|
|
|
|
|
|
|
823
|
|
|
|
|
|
|
|
824
|
|
|
|
|
|
|
=item process_a_cmd() |
825
|
|
|
|
|
|
|
|
826
|
|
|
|
|
|
|
Prompts for and returns the results from a single command. |
827
|
|
|
|
|
|
|
Returns undef if no command was called. |
828
|
|
|
|
|
|
|
|
829
|
|
|
|
|
|
|
=cut |
830
|
|
|
|
|
|
|
|
831
|
|
|
|
|
|
|
sub process_a_cmd |
832
|
|
|
|
|
|
|
{ |
833
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
834
|
|
|
|
|
|
|
|
835
|
0
|
|
|
|
|
|
$self->{completeline} = ""; |
836
|
0
|
|
|
|
|
|
my $OUT = $self->{'OUT'}; |
837
|
|
|
|
|
|
|
|
838
|
0
|
|
|
|
|
|
my $rawline = ""; |
839
|
0
|
|
|
|
|
|
for(;;) { |
840
|
0
|
|
|
|
|
|
my $prompt = $self->prompt(); |
841
|
0
|
0
|
|
|
|
|
$prompt = $prompt->[length $rawline ? 1 : 0] if ref $prompt eq 'ARRAY'; |
|
|
0
|
|
|
|
|
|
842
|
0
|
0
|
|
|
|
|
$prompt = $prompt->($self, $rawline) if ref $prompt eq 'CODE'; |
843
|
0
|
|
|
|
|
|
my $newline = $self->{term}->readline($prompt); |
844
|
|
|
|
|
|
|
|
845
|
|
|
|
|
|
|
# EOF exits |
846
|
0
|
0
|
|
|
|
|
unless(defined $newline) { |
847
|
0
|
|
|
|
|
|
print $OUT "\n"; |
848
|
0
|
|
|
|
|
|
$self->exit_requested(1); |
849
|
0
|
|
|
|
|
|
return undef; |
850
|
|
|
|
|
|
|
} |
851
|
|
|
|
|
|
|
|
852
|
0
|
|
|
|
|
|
my $continued = ($newline =~ s/\\$//); |
853
|
0
|
0
|
|
|
|
|
$rawline .= (length $rawline ? " " : "") . $newline; |
854
|
0
|
0
|
0
|
|
|
|
last unless $self->{backslash_continues_command} && $continued; |
855
|
|
|
|
|
|
|
} |
856
|
|
|
|
|
|
|
|
857
|
|
|
|
|
|
|
# is it a blank line? |
858
|
0
|
0
|
|
|
|
|
if($rawline =~ /^\s*$/) { |
859
|
0
|
|
|
|
|
|
$rawline = $self->blank_line(); |
860
|
0
|
0
|
0
|
|
|
|
return unless defined $rawline && $rawline !~ /^\s*$/; |
861
|
|
|
|
|
|
|
} |
862
|
|
|
|
|
|
|
|
863
|
0
|
|
|
|
|
|
my $tokens; |
864
|
0
|
|
|
|
|
|
my $expcode = 0; |
865
|
0
|
0
|
0
|
|
|
|
if($rawline =~ /^\s*[!^]/ && !$self->{disable_history_expansion}) { |
866
|
|
|
|
|
|
|
# check to see if this exact command is in the history. |
867
|
|
|
|
|
|
|
# if so, user used history completion to enter it and therefore we |
868
|
|
|
|
|
|
|
# won't subject it to history substitution. |
869
|
0
|
|
|
|
|
|
my $match; |
870
|
0
|
0
|
|
|
|
|
if($self->{term}->can('GetHistory')) { |
871
|
0
|
|
|
|
|
|
my @history = $self->{term}->GetHistory(); |
872
|
|
|
|
|
|
|
# reformat line as it will appear in history |
873
|
0
|
|
|
|
|
|
($tokens) = $self->{parser}->parse_line(substr($rawline,1), messages=>1); |
874
|
0
|
0
|
|
|
|
|
if($tokens) { |
875
|
0
|
|
|
|
|
|
my $rawl = $self->{parser}->join_line($tokens); |
876
|
0
|
|
|
|
|
|
$match = grep { $_ eq $rawl } @history; |
|
0
|
|
|
|
|
|
|
877
|
|
|
|
|
|
|
} |
878
|
|
|
|
|
|
|
} |
879
|
|
|
|
|
|
|
|
880
|
0
|
0
|
|
|
|
|
if(!$match) { |
881
|
0
|
|
|
|
|
|
$tokens = undef; # need to re-parse the expanded line |
882
|
|
|
|
|
|
|
# otherwise, we subject the line to history expansion |
883
|
|
|
|
|
|
|
# $self->{term}->can('history_expand') returns false??? |
884
|
|
|
|
|
|
|
# it's probably autoloaded dammit -- dunno what to do about that. |
885
|
0
|
|
|
|
|
|
($expcode, $rawline) = $self->{term}->history_expand($rawline); |
886
|
0
|
0
|
|
|
|
|
if($expcode == -1) { |
887
|
0
|
|
|
|
|
|
$self->error($rawline."\n"); |
888
|
0
|
|
|
|
|
|
return undef; |
889
|
|
|
|
|
|
|
} |
890
|
|
|
|
|
|
|
} |
891
|
|
|
|
|
|
|
} |
892
|
|
|
|
|
|
|
|
893
|
0
|
|
|
|
|
|
my $retval = undef; |
894
|
0
|
|
|
|
|
|
my $str = $rawline; |
895
|
0
|
|
|
|
|
|
my $save_to_history = 1; |
896
|
|
|
|
|
|
|
|
897
|
|
|
|
|
|
|
# parse the line unless it was already parsed as part of history expansion |
898
|
0
|
0
|
|
|
|
|
($tokens) = $self->{parser}->parse_line($rawline, messages=>1) unless $tokens; |
899
|
|
|
|
|
|
|
|
900
|
0
|
0
|
|
|
|
|
if(defined $tokens) { |
901
|
0
|
|
|
|
|
|
$str = $self->{parser}->join_line($tokens); |
902
|
0
|
0
|
|
|
|
|
if($expcode == 2) { |
903
|
|
|
|
|
|
|
# user did an expansion that asked to be printed only |
904
|
0
|
|
|
|
|
|
print $OUT "$str\n"; |
905
|
|
|
|
|
|
|
} else { |
906
|
0
|
0
|
|
|
|
|
print $OUT "$str\n" if $expcode == 1; |
907
|
|
|
|
|
|
|
|
908
|
0
|
|
|
|
|
|
my($cset, $cmd, $cname, $args) = $self->get_deep_command($self->commands(), $tokens); |
909
|
|
|
|
|
|
|
|
910
|
|
|
|
|
|
|
# this is a subset of the cmpl data structure |
911
|
0
|
|
|
|
|
|
my $parms = { |
912
|
|
|
|
|
|
|
cset => $cset, |
913
|
|
|
|
|
|
|
cmd => $cmd, |
914
|
|
|
|
|
|
|
cname => $cname, |
915
|
|
|
|
|
|
|
args => $args, |
916
|
|
|
|
|
|
|
tokens => $tokens, |
917
|
|
|
|
|
|
|
rawline => $rawline, |
918
|
|
|
|
|
|
|
}; |
919
|
|
|
|
|
|
|
|
920
|
0
|
|
|
|
|
|
$retval = $self->call_command($parms); |
921
|
|
|
|
|
|
|
|
922
|
0
|
0
|
|
|
|
|
if(exists $cmd->{exclude_from_history}) { |
923
|
0
|
|
|
|
|
|
$save_to_history = 0; |
924
|
|
|
|
|
|
|
} |
925
|
|
|
|
|
|
|
} |
926
|
|
|
|
|
|
|
} |
927
|
|
|
|
|
|
|
|
928
|
|
|
|
|
|
|
# Add to history unless it's a dupe of the previous command. |
929
|
0
|
0
|
0
|
|
|
|
if($save_to_history && $str ne $self->{prevcmd}) { |
930
|
0
|
|
|
|
|
|
$self->{term}->addhistory($str); |
931
|
|
|
|
|
|
|
} |
932
|
0
|
|
|
|
|
|
$self->{prevcmd} = $str; |
933
|
|
|
|
|
|
|
|
934
|
0
|
|
|
|
|
|
return $retval; |
935
|
|
|
|
|
|
|
} |
936
|
|
|
|
|
|
|
|
937
|
|
|
|
|
|
|
|
938
|
|
|
|
|
|
|
=item run() |
939
|
|
|
|
|
|
|
|
940
|
|
|
|
|
|
|
The main loop. Processes all commands until someone calls |
941
|
|
|
|
|
|
|
C(true)>. |
942
|
|
|
|
|
|
|
|
943
|
|
|
|
|
|
|
=cut |
944
|
|
|
|
|
|
|
|
945
|
|
|
|
|
|
|
sub run |
946
|
|
|
|
|
|
|
{ |
947
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
948
|
|
|
|
|
|
|
|
949
|
0
|
|
|
|
|
|
$self->load_history(); |
950
|
|
|
|
|
|
|
|
951
|
0
|
|
|
|
|
|
while(!$self->{done}) { |
952
|
0
|
|
|
|
|
|
$self->process_a_cmd(); |
953
|
|
|
|
|
|
|
} |
954
|
|
|
|
|
|
|
|
955
|
0
|
|
|
|
|
|
$self->save_history(); |
956
|
|
|
|
|
|
|
} |
957
|
|
|
|
|
|
|
|
958
|
|
|
|
|
|
|
|
959
|
|
|
|
|
|
|
# This is a utility function that implements a getter/setter. |
960
|
|
|
|
|
|
|
# Pass the field to modify for $self, and the new value for that |
961
|
|
|
|
|
|
|
# field (if any) in $new. |
962
|
|
|
|
|
|
|
|
963
|
|
|
|
|
|
|
sub getset |
964
|
|
|
|
|
|
|
{ |
965
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
966
|
0
|
|
|
|
|
|
my $field = shift; |
967
|
0
|
|
|
|
|
|
my $new = shift; # optional |
968
|
|
|
|
|
|
|
|
969
|
0
|
|
|
|
|
|
my $old = $self->{$field}; |
970
|
0
|
0
|
|
|
|
|
$self->{$field} = $new if defined $new; |
971
|
0
|
|
|
|
|
|
return $old; |
972
|
|
|
|
|
|
|
} |
973
|
|
|
|
|
|
|
|
974
|
|
|
|
|
|
|
|
975
|
|
|
|
|
|
|
=item prompt(newprompt) |
976
|
|
|
|
|
|
|
|
977
|
|
|
|
|
|
|
If supplied with an argument, this method sets the command-line prompt. |
978
|
|
|
|
|
|
|
Returns the old prompt. |
979
|
|
|
|
|
|
|
|
980
|
|
|
|
|
|
|
=cut |
981
|
|
|
|
|
|
|
|
982
|
0
|
|
|
0
|
1
|
|
sub prompt { return shift->getset('prompt', shift); } |
983
|
|
|
|
|
|
|
|
984
|
|
|
|
|
|
|
|
985
|
|
|
|
|
|
|
=item commands(newcmds) |
986
|
|
|
|
|
|
|
|
987
|
|
|
|
|
|
|
If supplied with an argument, it sets the current command set. |
988
|
|
|
|
|
|
|
This can be used to change the command set at any time. |
989
|
|
|
|
|
|
|
Returns the old command set. |
990
|
|
|
|
|
|
|
|
991
|
|
|
|
|
|
|
=cut |
992
|
|
|
|
|
|
|
|
993
|
0
|
|
|
0
|
1
|
|
sub commands { return shift->getset('commands', shift); } |
994
|
|
|
|
|
|
|
|
995
|
|
|
|
|
|
|
|
996
|
|
|
|
|
|
|
=item add_commands(newcmds) |
997
|
|
|
|
|
|
|
|
998
|
|
|
|
|
|
|
Takes a command set as its first argument. |
999
|
|
|
|
|
|
|
Adds all the commands in it the current command set. |
1000
|
|
|
|
|
|
|
It silently replaces any commands that have the same name. |
1001
|
|
|
|
|
|
|
|
1002
|
|
|
|
|
|
|
=cut |
1003
|
|
|
|
|
|
|
|
1004
|
|
|
|
|
|
|
sub add_commands |
1005
|
|
|
|
|
|
|
{ |
1006
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
1007
|
0
|
|
|
|
|
|
my $cmds = shift; |
1008
|
|
|
|
|
|
|
|
1009
|
0
|
|
0
|
|
|
|
my $cset = $self->commands() || {}; |
1010
|
0
|
|
|
|
|
|
for (keys %$cmds) { |
1011
|
0
|
|
|
|
|
|
$cset->{$_} = $cmds->{$_}; |
1012
|
|
|
|
|
|
|
} |
1013
|
|
|
|
|
|
|
} |
1014
|
|
|
|
|
|
|
|
1015
|
|
|
|
|
|
|
=item exit_requested(exitflag) |
1016
|
|
|
|
|
|
|
|
1017
|
|
|
|
|
|
|
If supplied with an argument, sets Term::GDBUI's finished flag |
1018
|
|
|
|
|
|
|
to the argument (1=exit, 0=don't exit). So, to get the |
1019
|
|
|
|
|
|
|
interpreter to exit at the end of processing the current |
1020
|
|
|
|
|
|
|
command, call C<$self-Eexit_requested(1)>. To cancel an exit |
1021
|
|
|
|
|
|
|
request before the command is finished, C<$self-Eexit_requested(0)>. |
1022
|
|
|
|
|
|
|
Returns the old state of the flag. |
1023
|
|
|
|
|
|
|
|
1024
|
|
|
|
|
|
|
=cut |
1025
|
|
|
|
|
|
|
|
1026
|
0
|
|
|
0
|
1
|
|
sub exit_requested { return shift->getset('done', shift); } |
1027
|
|
|
|
|
|
|
|
1028
|
|
|
|
|
|
|
=item get_cname(cname) |
1029
|
|
|
|
|
|
|
|
1030
|
|
|
|
|
|
|
This is a tiny utility function that turns the cname (array ref |
1031
|
|
|
|
|
|
|
of names for this command as returned by L) into |
1032
|
|
|
|
|
|
|
a human-readable string. |
1033
|
|
|
|
|
|
|
This function exists only to ensure that we do this consistently. |
1034
|
|
|
|
|
|
|
|
1035
|
|
|
|
|
|
|
=cut |
1036
|
|
|
|
|
|
|
|
1037
|
|
|
|
|
|
|
sub get_cname |
1038
|
|
|
|
|
|
|
{ |
1039
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
1040
|
0
|
|
|
|
|
|
my $cname = shift; |
1041
|
|
|
|
|
|
|
|
1042
|
0
|
|
|
|
|
|
return join(" ", @$cname); |
1043
|
|
|
|
|
|
|
} |
1044
|
|
|
|
|
|
|
|
1045
|
|
|
|
|
|
|
|
1046
|
|
|
|
|
|
|
|
1047
|
|
|
|
|
|
|
=head1 OVERRIDES |
1048
|
|
|
|
|
|
|
|
1049
|
|
|
|
|
|
|
These are routines that probably already do the right thing. |
1050
|
|
|
|
|
|
|
If not, however, they are designed to be overridden. |
1051
|
|
|
|
|
|
|
|
1052
|
|
|
|
|
|
|
=item blank_line() |
1053
|
|
|
|
|
|
|
|
1054
|
|
|
|
|
|
|
This routine is called when the user inputs a blank line. |
1055
|
|
|
|
|
|
|
It returns a string specifying the command to run or |
1056
|
|
|
|
|
|
|
undef if nothing should happen. |
1057
|
|
|
|
|
|
|
|
1058
|
|
|
|
|
|
|
By default, GDBUI simply presents another command line. Pass |
1059
|
|
|
|
|
|
|
C1> to L to get GDBUI to repeat the previous |
1060
|
|
|
|
|
|
|
command. Override this method to supply your own behavior. |
1061
|
|
|
|
|
|
|
|
1062
|
|
|
|
|
|
|
=cut |
1063
|
|
|
|
|
|
|
|
1064
|
|
|
|
|
|
|
sub blank_line |
1065
|
|
|
|
|
|
|
{ |
1066
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
1067
|
|
|
|
|
|
|
|
1068
|
0
|
0
|
|
|
|
|
if($self->{blank_repeats_cmd}) { |
1069
|
0
|
|
|
|
|
|
my $OUT = $self->{OUT}; |
1070
|
0
|
|
|
|
|
|
print $OUT $self->{prevcmd}, "\n"; |
1071
|
0
|
|
|
|
|
|
return $self->{prevcmd}; |
1072
|
|
|
|
|
|
|
} |
1073
|
|
|
|
|
|
|
|
1074
|
0
|
|
|
|
|
|
return undef; |
1075
|
|
|
|
|
|
|
} |
1076
|
|
|
|
|
|
|
|
1077
|
|
|
|
|
|
|
|
1078
|
|
|
|
|
|
|
=item error(msg) |
1079
|
|
|
|
|
|
|
|
1080
|
|
|
|
|
|
|
Called when an error occurrs. By default, the routine simply |
1081
|
|
|
|
|
|
|
prints the msg to stderr. Override it to change this behavior. |
1082
|
|
|
|
|
|
|
It takes any number of arguments, cocatenates them together and |
1083
|
|
|
|
|
|
|
prints them to stderr. |
1084
|
|
|
|
|
|
|
|
1085
|
|
|
|
|
|
|
=cut |
1086
|
|
|
|
|
|
|
|
1087
|
|
|
|
|
|
|
sub error |
1088
|
|
|
|
|
|
|
{ |
1089
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
1090
|
0
|
|
|
|
|
|
print STDERR @_; |
1091
|
|
|
|
|
|
|
} |
1092
|
|
|
|
|
|
|
|
1093
|
|
|
|
|
|
|
|
1094
|
|
|
|
|
|
|
|
1095
|
|
|
|
|
|
|
=head1 WRITING A COMPLETION ROUTINE |
1096
|
|
|
|
|
|
|
|
1097
|
|
|
|
|
|
|
Term::ReadLine makes writing a completion routine a |
1098
|
|
|
|
|
|
|
notoriously difficult task. |
1099
|
|
|
|
|
|
|
Term::GDBUI goes out of its way to make it as easy |
1100
|
|
|
|
|
|
|
as possible. The best way to write a completion routine |
1101
|
|
|
|
|
|
|
is to start with one that already does something similar to |
1102
|
|
|
|
|
|
|
what you want (see the L section for the completion |
1103
|
|
|
|
|
|
|
routines that come with GDBUI). |
1104
|
|
|
|
|
|
|
|
1105
|
|
|
|
|
|
|
Your routine returns either an arrayref of possible completions |
1106
|
|
|
|
|
|
|
or undef if an error prevented any completions from being generated. |
1107
|
|
|
|
|
|
|
Return an empty array if there are simply no applicable competions. |
1108
|
|
|
|
|
|
|
Be careful; the distinction between no completions and an error |
1109
|
|
|
|
|
|
|
can be significant. |
1110
|
|
|
|
|
|
|
|
1111
|
|
|
|
|
|
|
Your routine takes two arguments: a reference to the GDBUI |
1112
|
|
|
|
|
|
|
object and cmpl, a data structure that contains all the information you need |
1113
|
|
|
|
|
|
|
to calculate the completions. Set $term->{debug_complete}=5 |
1114
|
|
|
|
|
|
|
to see the contents of cmpl: |
1115
|
|
|
|
|
|
|
|
1116
|
|
|
|
|
|
|
=over 3 |
1117
|
|
|
|
|
|
|
|
1118
|
|
|
|
|
|
|
=item str |
1119
|
|
|
|
|
|
|
|
1120
|
|
|
|
|
|
|
The exact string that needs completion. Often, for simple completions, |
1121
|
|
|
|
|
|
|
you don't need anything more than this. |
1122
|
|
|
|
|
|
|
|
1123
|
|
|
|
|
|
|
NOTE: str does I respect token_chars! It is supplied unchanged |
1124
|
|
|
|
|
|
|
from Readline and so uses whatever tokenizing it implements. |
1125
|
|
|
|
|
|
|
Unfortunately, if you've changed token_chars, this will often |
1126
|
|
|
|
|
|
|
be different from how Term::GDBUI would tokenize the same string. |
1127
|
|
|
|
|
|
|
|
1128
|
|
|
|
|
|
|
=item cset |
1129
|
|
|
|
|
|
|
|
1130
|
|
|
|
|
|
|
Command set for the deepest command found (see L). |
1131
|
|
|
|
|
|
|
If no command was found then cset is set to the topmost command |
1132
|
|
|
|
|
|
|
set ($self->commands()). |
1133
|
|
|
|
|
|
|
|
1134
|
|
|
|
|
|
|
=item cmd |
1135
|
|
|
|
|
|
|
|
1136
|
|
|
|
|
|
|
The command hash for deepest command found or |
1137
|
|
|
|
|
|
|
undef if no command was found (see L). |
1138
|
|
|
|
|
|
|
cset is the command set that contains cmd. |
1139
|
|
|
|
|
|
|
|
1140
|
|
|
|
|
|
|
=item cname |
1141
|
|
|
|
|
|
|
|
1142
|
|
|
|
|
|
|
The full name of deepest command found as an array of tokens |
1143
|
|
|
|
|
|
|
(see L). Use L to convert |
1144
|
|
|
|
|
|
|
this into a human-readable string. |
1145
|
|
|
|
|
|
|
|
1146
|
|
|
|
|
|
|
=item args |
1147
|
|
|
|
|
|
|
|
1148
|
|
|
|
|
|
|
The arguments (as a list of tokens) that should be passed to the command |
1149
|
|
|
|
|
|
|
(see L). Valid only if cmd is non-null. Undef if no |
1150
|
|
|
|
|
|
|
args were passed. |
1151
|
|
|
|
|
|
|
|
1152
|
|
|
|
|
|
|
=item argno |
1153
|
|
|
|
|
|
|
|
1154
|
|
|
|
|
|
|
The index of the argument (in args) containing the cursor. |
1155
|
|
|
|
|
|
|
If the user is trying to complete on the command name, then |
1156
|
|
|
|
|
|
|
argno is negative (because the cursor comes before the arguments). |
1157
|
|
|
|
|
|
|
|
1158
|
|
|
|
|
|
|
=item tokens |
1159
|
|
|
|
|
|
|
|
1160
|
|
|
|
|
|
|
The tokenized command-line. |
1161
|
|
|
|
|
|
|
|
1162
|
|
|
|
|
|
|
=item tokno |
1163
|
|
|
|
|
|
|
|
1164
|
|
|
|
|
|
|
The index of the token containing the cursor. |
1165
|
|
|
|
|
|
|
|
1166
|
|
|
|
|
|
|
=item tokoff |
1167
|
|
|
|
|
|
|
|
1168
|
|
|
|
|
|
|
The character offset of the cursor in the token. |
1169
|
|
|
|
|
|
|
|
1170
|
|
|
|
|
|
|
For instance, if the cursor is on the first character of the |
1171
|
|
|
|
|
|
|
third token, tokno will be 2 and tokoff will be 0. |
1172
|
|
|
|
|
|
|
|
1173
|
|
|
|
|
|
|
=item twice |
1174
|
|
|
|
|
|
|
|
1175
|
|
|
|
|
|
|
True if user has hit tab twice in a row. This usually means that you |
1176
|
|
|
|
|
|
|
should print a message explaining the possible completions. |
1177
|
|
|
|
|
|
|
|
1178
|
|
|
|
|
|
|
If you return your completions as a list, then $twice is handled |
1179
|
|
|
|
|
|
|
for you automatically. You could use it, for instance, to display |
1180
|
|
|
|
|
|
|
an error message (using L) telling why no completions |
1181
|
|
|
|
|
|
|
could be found. |
1182
|
|
|
|
|
|
|
|
1183
|
|
|
|
|
|
|
=item rawline |
1184
|
|
|
|
|
|
|
|
1185
|
|
|
|
|
|
|
The command line as a string, exactly as entered by the user. |
1186
|
|
|
|
|
|
|
|
1187
|
|
|
|
|
|
|
=item rawstart |
1188
|
|
|
|
|
|
|
|
1189
|
|
|
|
|
|
|
The character position of the cursor in rawline. |
1190
|
|
|
|
|
|
|
|
1191
|
|
|
|
|
|
|
=back |
1192
|
|
|
|
|
|
|
|
1193
|
|
|
|
|
|
|
The following are utility routines that your completion function |
1194
|
|
|
|
|
|
|
can call. |
1195
|
|
|
|
|
|
|
|
1196
|
|
|
|
|
|
|
=item completemsg(msg) |
1197
|
|
|
|
|
|
|
|
1198
|
|
|
|
|
|
|
your completion routine should call this to display text onscreen |
1199
|
|
|
|
|
|
|
so that the command line being completed doesn't get messed up. |
1200
|
|
|
|
|
|
|
If your completion routine prints text without calling completemsg, |
1201
|
|
|
|
|
|
|
the cursor will no longer be displayed in the correct position. |
1202
|
|
|
|
|
|
|
|
1203
|
|
|
|
|
|
|
$self->completemsg("You cannot complete here!\n"); |
1204
|
|
|
|
|
|
|
|
1205
|
|
|
|
|
|
|
=cut |
1206
|
|
|
|
|
|
|
|
1207
|
|
|
|
|
|
|
sub completemsg |
1208
|
|
|
|
|
|
|
{ |
1209
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
1210
|
0
|
|
|
|
|
|
my $msg = shift; |
1211
|
|
|
|
|
|
|
|
1212
|
0
|
|
|
|
|
|
my $OUT = $self->{OUT}; |
1213
|
0
|
|
|
|
|
|
print $OUT $msg; |
1214
|
0
|
|
|
|
|
|
$self->{term}->rl_on_new_line(); |
1215
|
|
|
|
|
|
|
} |
1216
|
|
|
|
|
|
|
|
1217
|
|
|
|
|
|
|
|
1218
|
|
|
|
|
|
|
=item suppress_completion_append_character() |
1219
|
|
|
|
|
|
|
|
1220
|
|
|
|
|
|
|
When the ReadLine library finds a unique match among the list that |
1221
|
|
|
|
|
|
|
you returned, it automatically appends a space. Normally this is |
1222
|
|
|
|
|
|
|
what you want (i.e. when completing a command name, in help, etc.) |
1223
|
|
|
|
|
|
|
However, if you're navigating the filesystem, this is definitely |
1224
|
|
|
|
|
|
|
not desirable (picture having to hit backspace after completing |
1225
|
|
|
|
|
|
|
each directory). |
1226
|
|
|
|
|
|
|
|
1227
|
|
|
|
|
|
|
Your completion function needs to call this routine every time it |
1228
|
|
|
|
|
|
|
runs if it doesn't want a space automatically appended to the |
1229
|
|
|
|
|
|
|
completions that it returns. |
1230
|
|
|
|
|
|
|
|
1231
|
|
|
|
|
|
|
=cut |
1232
|
|
|
|
|
|
|
|
1233
|
|
|
|
|
|
|
sub suppress_completion_append_character |
1234
|
|
|
|
|
|
|
{ |
1235
|
0
|
|
|
0
|
1
|
|
shift->{term}->Attribs->{completion_suppress_append} = 1; |
1236
|
|
|
|
|
|
|
} |
1237
|
|
|
|
|
|
|
|
1238
|
|
|
|
|
|
|
=item suppress_completion_escape() |
1239
|
|
|
|
|
|
|
|
1240
|
|
|
|
|
|
|
Normally everything returned by your completion routine |
1241
|
|
|
|
|
|
|
is escaped so that it doesn't get destroyed by shell metacharacter |
1242
|
|
|
|
|
|
|
interpretation (quotes, backslashes, etc). To avoid escaping |
1243
|
|
|
|
|
|
|
twice (disastrous), a completion routine that does its own escaping |
1244
|
|
|
|
|
|
|
(perhaps using Lparse_escape) |
1245
|
|
|
|
|
|
|
must call suppress_completion_escape every time is called. |
1246
|
|
|
|
|
|
|
|
1247
|
|
|
|
|
|
|
=cut |
1248
|
|
|
|
|
|
|
|
1249
|
|
|
|
|
|
|
sub suppress_completion_escape |
1250
|
|
|
|
|
|
|
{ |
1251
|
0
|
|
|
0
|
1
|
|
shift->{suppress_completion_escape} = 1; |
1252
|
|
|
|
|
|
|
} |
1253
|
|
|
|
|
|
|
|
1254
|
|
|
|
|
|
|
|
1255
|
|
|
|
|
|
|
=item force_to_string(cmpl, commmpletions, default_quote) |
1256
|
|
|
|
|
|
|
|
1257
|
|
|
|
|
|
|
If all the completions returned by your completion routine should be |
1258
|
|
|
|
|
|
|
enclosed in single or double quotes, call force_to_string on them. |
1259
|
|
|
|
|
|
|
You will most likely need this routine if L is 1. |
1260
|
|
|
|
|
|
|
This is useful when completing a construct that you know must |
1261
|
|
|
|
|
|
|
always be quoted. |
1262
|
|
|
|
|
|
|
|
1263
|
|
|
|
|
|
|
force_to_string surrounds all completions with the quotes supplied by the user |
1264
|
|
|
|
|
|
|
or, if the user didn't supply any quotes, the quote passed in default_quote. |
1265
|
|
|
|
|
|
|
If the programmer didn't supply a default_quote and the user didn't start |
1266
|
|
|
|
|
|
|
the token with an open quote, then force_to_string won't change anything. |
1267
|
|
|
|
|
|
|
|
1268
|
|
|
|
|
|
|
Here's how to use it to force strings on two possible completions, |
1269
|
|
|
|
|
|
|
aaa and bbb. If the user doesn't supply any quotes, the completions |
1270
|
|
|
|
|
|
|
will be surrounded by double quotes. |
1271
|
|
|
|
|
|
|
|
1272
|
|
|
|
|
|
|
args => sub { shift->force_to_string(@_,['aaa','bbb'],'"') }, |
1273
|
|
|
|
|
|
|
|
1274
|
|
|
|
|
|
|
Calling force_to_string escapes your completions (unless your callback |
1275
|
|
|
|
|
|
|
calls suppress_completion_escape itself), then calls |
1276
|
|
|
|
|
|
|
suppress_completion_escape to ensure the final quote isn't mangled. |
1277
|
|
|
|
|
|
|
|
1278
|
|
|
|
|
|
|
=cut |
1279
|
|
|
|
|
|
|
|
1280
|
|
|
|
|
|
|
sub force_to_string |
1281
|
|
|
|
|
|
|
{ |
1282
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
1283
|
0
|
|
|
|
|
|
my $cmpl = shift; |
1284
|
0
|
|
|
|
|
|
my $results = shift; |
1285
|
0
|
|
|
|
|
|
my $bq = shift; # optional: this is the default quote to use if none |
1286
|
|
|
|
|
|
|
|
1287
|
0
|
|
|
|
|
|
my $fq = $bq; |
1288
|
0
|
|
|
|
|
|
my $try = substr($cmpl->{rawline}, $cmpl->{rawstart}-1, 1); |
1289
|
0
|
0
|
0
|
|
|
|
if($try eq '"' || $try eq "'") { |
1290
|
0
|
|
|
|
|
|
$fq = ''; |
1291
|
0
|
|
|
|
|
|
$bq = $try; |
1292
|
|
|
|
|
|
|
} |
1293
|
|
|
|
|
|
|
|
1294
|
0
|
0
|
|
|
|
|
if($bq) { |
1295
|
0
|
0
|
|
|
|
|
$self->{parser}->parse_escape($results) unless $self->{suppress_completion_escape}; |
1296
|
0
|
|
|
|
|
|
for(@$results) { |
1297
|
0
|
|
|
|
|
|
$_ = "$fq$_$bq"; |
1298
|
|
|
|
|
|
|
} |
1299
|
0
|
|
|
|
|
|
$self->suppress_completion_escape(); |
1300
|
|
|
|
|
|
|
} |
1301
|
|
|
|
|
|
|
|
1302
|
0
|
|
|
|
|
|
return $results; |
1303
|
|
|
|
|
|
|
} |
1304
|
|
|
|
|
|
|
|
1305
|
|
|
|
|
|
|
=head1 INTERNALS |
1306
|
|
|
|
|
|
|
|
1307
|
|
|
|
|
|
|
These commands are internal to GDBUI. |
1308
|
|
|
|
|
|
|
They are documented here only for completeness -- you |
1309
|
|
|
|
|
|
|
should never need to call them. |
1310
|
|
|
|
|
|
|
|
1311
|
|
|
|
|
|
|
=item get_deep_command |
1312
|
|
|
|
|
|
|
|
1313
|
|
|
|
|
|
|
Looks up the supplied command line in a command hash. |
1314
|
|
|
|
|
|
|
Follows all synonyms and subcommands. |
1315
|
|
|
|
|
|
|
Returns undef if the command could not be found. |
1316
|
|
|
|
|
|
|
|
1317
|
|
|
|
|
|
|
my($cset, $cmd, $cname, $args) = |
1318
|
|
|
|
|
|
|
$self->get_deep_command($self->commands(), $tokens); |
1319
|
|
|
|
|
|
|
|
1320
|
|
|
|
|
|
|
This call takes two arguments: |
1321
|
|
|
|
|
|
|
|
1322
|
|
|
|
|
|
|
=over 3 |
1323
|
|
|
|
|
|
|
|
1324
|
|
|
|
|
|
|
=item cset |
1325
|
|
|
|
|
|
|
|
1326
|
|
|
|
|
|
|
This is the command set to use. Pass $self->commands() |
1327
|
|
|
|
|
|
|
unless you know exactly what you're doing. |
1328
|
|
|
|
|
|
|
|
1329
|
|
|
|
|
|
|
=item tokens |
1330
|
|
|
|
|
|
|
|
1331
|
|
|
|
|
|
|
This is the command line that the command should be read from. |
1332
|
|
|
|
|
|
|
It is a reference to an array that has already been split |
1333
|
|
|
|
|
|
|
on whitespace using L. |
1334
|
|
|
|
|
|
|
|
1335
|
|
|
|
|
|
|
=back |
1336
|
|
|
|
|
|
|
|
1337
|
|
|
|
|
|
|
and it returns a list of 4 values: |
1338
|
|
|
|
|
|
|
|
1339
|
|
|
|
|
|
|
=over 3 |
1340
|
|
|
|
|
|
|
|
1341
|
|
|
|
|
|
|
=item 1. |
1342
|
|
|
|
|
|
|
|
1343
|
|
|
|
|
|
|
cset: the deepest command set found. Always returned. |
1344
|
|
|
|
|
|
|
|
1345
|
|
|
|
|
|
|
=item 2. |
1346
|
|
|
|
|
|
|
|
1347
|
|
|
|
|
|
|
cmd: the command hash for the command. Undef if no command was found. |
1348
|
|
|
|
|
|
|
|
1349
|
|
|
|
|
|
|
=item 3. |
1350
|
|
|
|
|
|
|
|
1351
|
|
|
|
|
|
|
cname: the full name of the command. This is an array of tokens, |
1352
|
|
|
|
|
|
|
i.e. ('show', 'info'). Returns as deep as it could find commands |
1353
|
|
|
|
|
|
|
even if the final command was not found. |
1354
|
|
|
|
|
|
|
|
1355
|
|
|
|
|
|
|
=item 4. |
1356
|
|
|
|
|
|
|
|
1357
|
|
|
|
|
|
|
args: the command's arguments (all remaining tokens after the |
1358
|
|
|
|
|
|
|
command is found). |
1359
|
|
|
|
|
|
|
|
1360
|
|
|
|
|
|
|
=back |
1361
|
|
|
|
|
|
|
|
1362
|
|
|
|
|
|
|
=cut |
1363
|
|
|
|
|
|
|
|
1364
|
|
|
|
|
|
|
sub get_deep_command |
1365
|
|
|
|
|
|
|
{ |
1366
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
1367
|
0
|
|
|
|
|
|
my $cset = shift; |
1368
|
0
|
|
|
|
|
|
my $tokens = shift; |
1369
|
0
|
|
0
|
|
|
|
my $curtok = shift || 0; # points to the command name |
1370
|
|
|
|
|
|
|
|
1371
|
|
|
|
|
|
|
#print "DBG get_deep_cmd: $#$tokens tokens: '" . join("', '", @$tokens) . "'\n"; |
1372
|
|
|
|
|
|
|
#print "DBG cset: (" . join(", ", keys %$cset) . ")\n"; |
1373
|
|
|
|
|
|
|
|
1374
|
0
|
|
|
|
|
|
my $name = $tokens->[$curtok]; |
1375
|
|
|
|
|
|
|
|
1376
|
|
|
|
|
|
|
# loop through all synonyms to find the actual command |
1377
|
0
|
|
0
|
|
|
|
while(exists($cset->{$name}) && exists($cset->{$name}->{'syn'})) { |
1378
|
0
|
|
|
|
|
|
$name = $cset->{$name}->{'syn'}; |
1379
|
|
|
|
|
|
|
} |
1380
|
|
|
|
|
|
|
|
1381
|
0
|
|
|
|
|
|
my $cmd = $cset->{$name}; |
1382
|
|
|
|
|
|
|
|
1383
|
|
|
|
|
|
|
# update the tokens with the actual name of this command |
1384
|
0
|
|
|
|
|
|
$tokens->[$curtok] = $name; |
1385
|
|
|
|
|
|
|
|
1386
|
|
|
|
|
|
|
# should we recurse into subcommands? |
1387
|
|
|
|
|
|
|
#print "$cmd " . exists($cmd->{'subcmds'}) . " (" . join(",", keys %$cmd) . ") $curtok < $#$tokens\n"; |
1388
|
0
|
0
|
0
|
|
|
|
if($cmd && exists($cmd->{cmds}) && $curtok < $#$tokens) { |
|
|
|
0
|
|
|
|
|
1389
|
|
|
|
|
|
|
#print "doing subcmd\n"; |
1390
|
0
|
|
|
|
|
|
my $subname = $tokens->[$curtok+1]; |
1391
|
0
|
|
|
|
|
|
my $subcmds = $cmd->{cmds}; |
1392
|
0
|
|
|
|
|
|
return $self->get_deep_command($subcmds, $tokens, $curtok+1); |
1393
|
|
|
|
|
|
|
} |
1394
|
|
|
|
|
|
|
|
1395
|
|
|
|
|
|
|
#print "DBG splitting (" . join(",",@$tokens) . ") at curtok=$curtok\n"; |
1396
|
|
|
|
|
|
|
|
1397
|
|
|
|
|
|
|
# split deep command name and its arguments into separate lists |
1398
|
0
|
|
|
|
|
|
my @cname = @$tokens; |
1399
|
0
|
0
|
|
|
|
|
my @args = ($#cname > $curtok ? splice(@cname, $curtok+1) : ()); |
1400
|
|
|
|
|
|
|
|
1401
|
|
|
|
|
|
|
#print "DBG tokens (" . join(",",@$tokens) . ")\n"; |
1402
|
|
|
|
|
|
|
#print "DBG cname (" . join(",",@cname) . ")\n"; |
1403
|
|
|
|
|
|
|
#print "DBG args (" . join(",",@args) . ")\n"; |
1404
|
|
|
|
|
|
|
|
1405
|
0
|
|
|
|
|
|
return ($cset, $cmd, \@cname, \@args); |
1406
|
|
|
|
|
|
|
} |
1407
|
|
|
|
|
|
|
|
1408
|
|
|
|
|
|
|
|
1409
|
|
|
|
|
|
|
=item get_cset_completions(cset) |
1410
|
|
|
|
|
|
|
|
1411
|
|
|
|
|
|
|
Returns a list of commands from the passed command set that are suitable |
1412
|
|
|
|
|
|
|
for completing. |
1413
|
|
|
|
|
|
|
|
1414
|
|
|
|
|
|
|
=cut |
1415
|
|
|
|
|
|
|
|
1416
|
|
|
|
|
|
|
sub get_cset_completions |
1417
|
|
|
|
|
|
|
{ |
1418
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
1419
|
0
|
|
|
|
|
|
my $cset = shift; |
1420
|
|
|
|
|
|
|
|
1421
|
|
|
|
|
|
|
# return all commands that aren't exluded from the completion |
1422
|
|
|
|
|
|
|
# also exclude the default command ''. |
1423
|
0
|
0
|
|
|
|
|
my @c = grep {$_ ne '' && !exists $cset->{$_}->{exclude_from_completion}} keys(%$cset); |
|
0
|
|
|
|
|
|
|
1424
|
|
|
|
|
|
|
|
1425
|
0
|
|
|
|
|
|
return \@c; |
1426
|
|
|
|
|
|
|
} |
1427
|
|
|
|
|
|
|
|
1428
|
|
|
|
|
|
|
|
1429
|
|
|
|
|
|
|
=item call_args |
1430
|
|
|
|
|
|
|
|
1431
|
|
|
|
|
|
|
Given a command set, does the correct thing at this stage in the |
1432
|
|
|
|
|
|
|
completion (a surprisingly nontrivial task thanks to GDBUI's |
1433
|
|
|
|
|
|
|
flexibility). Called by complete(). |
1434
|
|
|
|
|
|
|
|
1435
|
|
|
|
|
|
|
=cut |
1436
|
|
|
|
|
|
|
|
1437
|
|
|
|
|
|
|
sub call_args |
1438
|
|
|
|
|
|
|
{ |
1439
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
1440
|
0
|
|
|
|
|
|
my $cmpl = shift; |
1441
|
|
|
|
|
|
|
|
1442
|
0
|
|
|
|
|
|
my $cmd = $cmpl->{cmd}; |
1443
|
|
|
|
|
|
|
|
1444
|
0
|
|
|
|
|
|
my $retval; |
1445
|
0
|
0
|
|
|
|
|
if(exists($cmd->{args})) { |
1446
|
0
|
0
|
|
|
|
|
if(ref($cmd->{args}) eq 'CODE') { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1447
|
0
|
|
|
|
|
|
$retval = eval { &{$cmd->{args}}($self, $cmpl) }; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
1448
|
0
|
0
|
|
|
|
|
$self->completemsg($@) if $@; |
1449
|
|
|
|
|
|
|
} elsif(ref($cmd->{args}) eq 'ARRAY') { |
1450
|
|
|
|
|
|
|
# each element in array is a string describing corresponding argument |
1451
|
0
|
|
|
|
|
|
my $args = $cmd->{args}; |
1452
|
0
|
|
|
|
|
|
my $argno = $cmpl->{argno}; |
1453
|
|
|
|
|
|
|
# repeat last arg indefinitely (use maxargs to stop) |
1454
|
0
|
0
|
|
|
|
|
$argno = $#$args if $#$args < $argno; |
1455
|
0
|
|
|
|
|
|
my $arg = $args->[$argno]; |
1456
|
0
|
0
|
|
|
|
|
if(defined $arg) { |
1457
|
0
|
0
|
|
|
|
|
if(ref($arg) eq 'CODE') { |
|
|
0
|
|
|
|
|
|
1458
|
|
|
|
|
|
|
# it's a routine to call for this particular arg |
1459
|
0
|
|
|
|
|
|
$retval = eval { &$arg($self, $cmpl) }; |
|
0
|
|
|
|
|
|
|
1460
|
0
|
0
|
|
|
|
|
$self->completemsg($@) if $@; |
1461
|
|
|
|
|
|
|
} elsif(ref($arg) eq 'ARRAY') { |
1462
|
|
|
|
|
|
|
# it's an array of possible completions |
1463
|
0
|
|
|
|
|
|
$retval = @$arg; |
1464
|
|
|
|
|
|
|
} else { |
1465
|
|
|
|
|
|
|
# it's a string reiminder of what this arg is meant to be |
1466
|
0
|
0
|
|
|
|
|
$self->completemsg("$arg\n") if $cmpl->{twice}; |
1467
|
|
|
|
|
|
|
} |
1468
|
|
|
|
|
|
|
} |
1469
|
|
|
|
|
|
|
} elsif(ref($cmd->{args}) eq 'HASH') { |
1470
|
|
|
|
|
|
|
# not supported yet! (if ever...) |
1471
|
|
|
|
|
|
|
} else { |
1472
|
|
|
|
|
|
|
# this must be a string describing all arguments. |
1473
|
0
|
0
|
|
|
|
|
$self->completemsg($cmd->{args} . "\n") if $cmpl->{twice}; |
1474
|
|
|
|
|
|
|
} |
1475
|
|
|
|
|
|
|
} |
1476
|
|
|
|
|
|
|
|
1477
|
0
|
|
|
|
|
|
return $retval; |
1478
|
|
|
|
|
|
|
} |
1479
|
|
|
|
|
|
|
|
1480
|
|
|
|
|
|
|
=item complete |
1481
|
|
|
|
|
|
|
|
1482
|
|
|
|
|
|
|
This routine figures out the command set of the completion routine |
1483
|
|
|
|
|
|
|
that needs to be called, then calls call_args(). It is called |
1484
|
|
|
|
|
|
|
by completion_function. |
1485
|
|
|
|
|
|
|
|
1486
|
|
|
|
|
|
|
You should override this routine if your application has custom |
1487
|
|
|
|
|
|
|
completion needs (like non-trivial tokenizing, where you'll need |
1488
|
|
|
|
|
|
|
to modify the cmpl data structure). If you override |
1489
|
|
|
|
|
|
|
this routine, you will probably need to override |
1490
|
|
|
|
|
|
|
L as well. |
1491
|
|
|
|
|
|
|
|
1492
|
|
|
|
|
|
|
=cut |
1493
|
|
|
|
|
|
|
|
1494
|
|
|
|
|
|
|
sub complete |
1495
|
|
|
|
|
|
|
{ |
1496
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
1497
|
0
|
|
|
|
|
|
my $cmpl = shift; |
1498
|
|
|
|
|
|
|
|
1499
|
0
|
|
|
|
|
|
my $cset = $cmpl->{cset}; |
1500
|
0
|
|
|
|
|
|
my $cmd = $cmpl->{cmd}; |
1501
|
|
|
|
|
|
|
|
1502
|
0
|
|
|
|
|
|
my $cr; |
1503
|
0
|
0
|
|
|
|
|
if($cmpl->{tokno} < @{$cmpl->{cname}}) { |
|
0
|
|
|
|
|
|
|
1504
|
|
|
|
|
|
|
# if we're still in the command, return possible command completions |
1505
|
|
|
|
|
|
|
# make sure to still call the default arg handler of course |
1506
|
0
|
|
|
|
|
|
$cr = $self->get_cset_completions($cset); |
1507
|
|
|
|
|
|
|
# fix suggested by Erick Calder |
1508
|
0
|
0
|
|
|
|
|
$cr = [ grep {/^$cmpl->{str}/ && $_} @$cr ]; |
|
0
|
|
|
|
|
|
|
1509
|
|
|
|
|
|
|
} |
1510
|
|
|
|
|
|
|
|
1511
|
0
|
0
|
0
|
|
|
|
if($cr || !defined $cmd) { |
1512
|
|
|
|
|
|
|
# call default argument handler if it exists |
1513
|
0
|
0
|
|
|
|
|
if(exists $cset->{''}) { |
1514
|
0
|
|
|
|
|
|
my %c2 = %$cmpl; |
1515
|
0
|
|
|
|
|
|
$c2{cmd} = $cset->{''}; |
1516
|
0
|
|
|
|
|
|
my $r2 = $self->call_args(\%c2); |
1517
|
0
|
0
|
|
|
|
|
push @$cr, @$r2 if $r2; |
1518
|
|
|
|
|
|
|
} |
1519
|
0
|
|
|
|
|
|
return $cr; |
1520
|
|
|
|
|
|
|
} |
1521
|
|
|
|
|
|
|
|
1522
|
|
|
|
|
|
|
# don't complete if user has gone past max # of args |
1523
|
0
|
0
|
0
|
|
|
|
return () if exists($cmd->{maxargs}) && $cmpl->{argno} >= $cmd->{maxargs}; |
1524
|
|
|
|
|
|
|
|
1525
|
|
|
|
|
|
|
# everything checks out -- call the command's argument handler |
1526
|
0
|
|
|
|
|
|
return $self->call_args($cmpl); |
1527
|
|
|
|
|
|
|
} |
1528
|
|
|
|
|
|
|
|
1529
|
|
|
|
|
|
|
|
1530
|
|
|
|
|
|
|
=item completion_function |
1531
|
|
|
|
|
|
|
|
1532
|
|
|
|
|
|
|
This is the entrypoint to the ReadLine completion callback. |
1533
|
|
|
|
|
|
|
It sets up a bunch of data, then calls L to calculate |
1534
|
|
|
|
|
|
|
the actual completion. |
1535
|
|
|
|
|
|
|
|
1536
|
|
|
|
|
|
|
To watch and debug the completion process, you can set $self->{debug_complete} |
1537
|
|
|
|
|
|
|
to 2 (print tokenizing), 3 (print tokenizing and results) or 4 (print |
1538
|
|
|
|
|
|
|
everything including the cmpl data structure). |
1539
|
|
|
|
|
|
|
|
1540
|
|
|
|
|
|
|
Youu should never need to call or override this function. If |
1541
|
|
|
|
|
|
|
you do (but, trust me, you don't), set |
1542
|
|
|
|
|
|
|
$self->{term}->Attribs->{completion_function} to point to your own |
1543
|
|
|
|
|
|
|
routine. |
1544
|
|
|
|
|
|
|
|
1545
|
|
|
|
|
|
|
See the L documentation for a description of the arguments. |
1546
|
|
|
|
|
|
|
|
1547
|
|
|
|
|
|
|
=cut |
1548
|
|
|
|
|
|
|
|
1549
|
|
|
|
|
|
|
sub completion_function |
1550
|
|
|
|
|
|
|
{ |
1551
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
1552
|
0
|
|
|
|
|
|
my $text = shift; # the word directly to the left of the cursor |
1553
|
0
|
|
|
|
|
|
my $line = shift; # the entire line |
1554
|
0
|
|
|
|
|
|
my $start = shift; # the position in the line of the beginning of $text |
1555
|
|
|
|
|
|
|
|
1556
|
0
|
|
|
|
|
|
my $cursor = $start + length($text); |
1557
|
|
|
|
|
|
|
|
1558
|
|
|
|
|
|
|
# reset the suppress_append flag |
1559
|
|
|
|
|
|
|
# completion routine must set it every time it's called |
1560
|
0
|
|
|
|
|
|
$self->{term}->Attribs->{completion_suppress_append} = 0; |
1561
|
0
|
|
|
|
|
|
$self->{suppress_completion_escape} = 0; |
1562
|
|
|
|
|
|
|
|
1563
|
|
|
|
|
|
|
# Twice is true if the user has hit tab twice on the same string |
1564
|
0
|
|
|
|
|
|
my $twice = ($self->{completeline} eq $line); |
1565
|
0
|
|
|
|
|
|
$self->{completeline} = $line; |
1566
|
|
|
|
|
|
|
|
1567
|
0
|
|
|
|
|
|
my($tokens, $tokno, $tokoff) = $self->{parser}->parse_line($line, |
1568
|
|
|
|
|
|
|
messages=>0, cursorpos=>$cursor, fixclosequote=>1); |
1569
|
0
|
0
|
|
|
|
|
return unless defined($tokens); |
1570
|
|
|
|
|
|
|
|
1571
|
|
|
|
|
|
|
# this just prints a whole bunch of completion/parsing debugging info |
1572
|
0
|
0
|
|
|
|
|
if($self->{debug_complete} >= 1) { |
1573
|
0
|
|
|
|
|
|
print "\ntext='$text', line='$line', start=$start, cursor=$cursor"; |
1574
|
|
|
|
|
|
|
|
1575
|
0
|
0
|
|
|
|
|
print "\ntokens=(", join(", ", @$tokens), ") tokno=" . |
|
|
0
|
|
|
|
|
|
1576
|
|
|
|
|
|
|
(defined($tokno) ? $tokno : 'undef') . " tokoff=" . |
1577
|
|
|
|
|
|
|
(defined($tokoff) ? $tokoff : 'undef'); |
1578
|
|
|
|
|
|
|
|
1579
|
0
|
|
|
|
|
|
print "\n"; |
1580
|
0
|
|
|
|
|
|
my $str = " "; |
1581
|
0
|
|
|
|
|
|
print "<"; |
1582
|
0
|
|
|
|
|
|
my $i = 0; |
1583
|
0
|
|
|
|
|
|
for(@$tokens) { |
1584
|
0
|
|
|
|
|
|
my $s = (" " x length($_)) . " "; |
1585
|
0
|
0
|
|
|
|
|
substr($s,$tokoff,1) = '^' if $i eq $tokno; |
1586
|
0
|
|
|
|
|
|
$str .= $s; |
1587
|
0
|
|
|
|
|
|
print $_; |
1588
|
0
|
|
|
|
|
|
print ">"; |
1589
|
0
|
0
|
|
|
|
|
$str .= " ", print ", <" if $i != $#$tokens; |
1590
|
0
|
|
|
|
|
|
$i += 1; |
1591
|
|
|
|
|
|
|
} |
1592
|
0
|
|
|
|
|
|
print "\n$str\n"; |
1593
|
0
|
|
|
|
|
|
$self->{term}->rl_on_new_line(); |
1594
|
|
|
|
|
|
|
} |
1595
|
|
|
|
|
|
|
|
1596
|
0
|
|
|
|
|
|
my $str = $text; |
1597
|
|
|
|
|
|
|
|
1598
|
0
|
|
|
|
|
|
my($cset, $cmd, $cname, $args) = $self->get_deep_command($self->commands(), $tokens); |
1599
|
|
|
|
|
|
|
|
1600
|
|
|
|
|
|
|
# this structure hopefully contains everything you'll ever |
1601
|
|
|
|
|
|
|
# need to easily compute a match. |
1602
|
0
|
|
|
|
|
|
my $cmpl = { |
1603
|
|
|
|
|
|
|
str => $str, # the exact string that needs completion |
1604
|
|
|
|
|
|
|
# (usually, you don't need anything more than this) |
1605
|
|
|
|
|
|
|
|
1606
|
|
|
|
|
|
|
cset => $cset, # cset of the deepest command found |
1607
|
|
|
|
|
|
|
cmd => $cmd, # the deepest command or undef |
1608
|
|
|
|
|
|
|
cname => $cname, # full name of deepest command |
1609
|
|
|
|
|
|
|
args => $args, # anything that was determined to be an argument. |
1610
|
|
|
|
|
|
|
argno => $tokno - @$cname, # the argument containing the cursor |
1611
|
|
|
|
|
|
|
|
1612
|
|
|
|
|
|
|
tokens => $tokens, # tokenized command-line (arrayref). |
1613
|
|
|
|
|
|
|
tokno => $tokno, # the index of the token containing the cursor |
1614
|
|
|
|
|
|
|
tokoff => $tokoff, # the character offset of the cursor in $tokno. |
1615
|
|
|
|
|
|
|
twice => $twice, # true if user has hit tab twice in a row |
1616
|
|
|
|
|
|
|
|
1617
|
|
|
|
|
|
|
rawline => $line, # pre-tokenized command line |
1618
|
|
|
|
|
|
|
rawstart => $start, # position in rawline of the start of str |
1619
|
|
|
|
|
|
|
rawcursor => $cursor, # position in rawline of the cursor (end of str) |
1620
|
|
|
|
|
|
|
}; |
1621
|
|
|
|
|
|
|
|
1622
|
0
|
0
|
|
|
|
|
if($self->{debug_complete} >= 3) { |
1623
|
0
|
|
|
|
|
|
print "tokens=(" . join(",", @$tokens) . ") tokno=$tokno tokoff=$tokoff str=$str twice=$twice\n"; |
1624
|
0
|
0
|
|
|
|
|
print "cset=$cset cmd=" . (defined($cmd) ? $cmd : "(undef)") . |
1625
|
|
|
|
|
|
|
" cname=(" . join(",", @$cname) . ") args=(" . join(",", @$args) . ") argno=".$cmpl->{argno}."\n"; |
1626
|
0
|
|
|
|
|
|
print "rawline='$line' rawstart=$start rawcursor=$cursor\n"; |
1627
|
|
|
|
|
|
|
} |
1628
|
|
|
|
|
|
|
|
1629
|
0
|
|
|
|
|
|
my $retval = $self->complete($cmpl); |
1630
|
0
|
0
|
|
|
|
|
$retval = [] unless defined($retval); |
1631
|
0
|
0
|
|
|
|
|
die "User completion routine didn't return an arrayref: $retval\n" |
1632
|
|
|
|
|
|
|
unless ref($retval) eq 'ARRAY'; |
1633
|
|
|
|
|
|
|
|
1634
|
0
|
0
|
|
|
|
|
if($self->{debug_complete} >= 2) { |
1635
|
0
|
|
|
|
|
|
print "returning (", join(", ", @$retval), ")\n"; |
1636
|
|
|
|
|
|
|
} |
1637
|
|
|
|
|
|
|
|
1638
|
|
|
|
|
|
|
# escape the completions so they're valid on the command line |
1639
|
0
|
0
|
|
|
|
|
$self->{parser}->parse_escape($retval) unless $self->{suppress_completion_escape}; |
1640
|
|
|
|
|
|
|
|
1641
|
0
|
|
|
|
|
|
return @$retval; |
1642
|
|
|
|
|
|
|
} |
1643
|
|
|
|
|
|
|
|
1644
|
|
|
|
|
|
|
|
1645
|
|
|
|
|
|
|
# Converts a field name into a text string. |
1646
|
|
|
|
|
|
|
# All fields can be code, if so, then they're called to return string value. |
1647
|
|
|
|
|
|
|
# You need to ensure that the field exists before calling this routine. |
1648
|
|
|
|
|
|
|
|
1649
|
|
|
|
|
|
|
sub get_field |
1650
|
|
|
|
|
|
|
{ |
1651
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
1652
|
0
|
|
|
|
|
|
my $cmd = shift; |
1653
|
0
|
|
|
|
|
|
my $field = shift; |
1654
|
0
|
|
|
|
|
|
my $args = shift; |
1655
|
|
|
|
|
|
|
|
1656
|
0
|
|
|
|
|
|
my $val = $cmd->{$field}; |
1657
|
|
|
|
|
|
|
|
1658
|
0
|
0
|
|
|
|
|
if(ref($val) eq 'CODE') { |
1659
|
0
|
|
|
|
|
|
$val = eval { &$val($self, $cmd, @$args) }; |
|
0
|
|
|
|
|
|
|
1660
|
0
|
0
|
|
|
|
|
$self->error($@) if $@; |
1661
|
|
|
|
|
|
|
} |
1662
|
|
|
|
|
|
|
|
1663
|
0
|
|
|
|
|
|
return $val; |
1664
|
|
|
|
|
|
|
} |
1665
|
|
|
|
|
|
|
|
1666
|
|
|
|
|
|
|
|
1667
|
|
|
|
|
|
|
=item get_cmd_summary(tokens, cset) |
1668
|
|
|
|
|
|
|
|
1669
|
|
|
|
|
|
|
Prints a one-line summary for the given command. |
1670
|
|
|
|
|
|
|
Uses self->commands() if cset is not specified. |
1671
|
|
|
|
|
|
|
|
1672
|
|
|
|
|
|
|
=cut |
1673
|
|
|
|
|
|
|
|
1674
|
|
|
|
|
|
|
sub get_cmd_summary |
1675
|
|
|
|
|
|
|
{ |
1676
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
1677
|
0
|
|
|
|
|
|
my $tokens = shift; |
1678
|
0
|
|
0
|
|
|
|
my $topcset = shift || $self->commands(); |
1679
|
|
|
|
|
|
|
|
1680
|
|
|
|
|
|
|
# print "DBG print_cmd_summary: cmd=$cmd args=(" . join(", ", @$args), ")\n"; |
1681
|
|
|
|
|
|
|
|
1682
|
0
|
|
|
|
|
|
my($cset, $cmd, $cname, $args) = $self->get_deep_command($topcset, $tokens); |
1683
|
|
|
|
|
|
|
|
1684
|
0
|
|
|
|
|
|
my $desc; |
1685
|
0
|
0
|
|
|
|
|
if(!$cmd) { |
1686
|
0
|
0
|
|
|
|
|
if(exists $topcset->{''}) { |
1687
|
0
|
|
|
|
|
|
$cmd = $topcset->{''}; |
1688
|
|
|
|
|
|
|
} else { |
1689
|
0
|
|
|
|
|
|
return $self->get_cname($cname) . " doesn't exist.\n"; |
1690
|
|
|
|
|
|
|
} |
1691
|
|
|
|
|
|
|
} |
1692
|
|
|
|
|
|
|
|
1693
|
0
|
|
0
|
|
|
|
$desc = $self->get_field($cmd, 'desc', $args) || "(no description)"; |
1694
|
0
|
|
|
|
|
|
return sprintf("%20s -- $desc\n", $self->get_cname($cname)); |
1695
|
|
|
|
|
|
|
} |
1696
|
|
|
|
|
|
|
|
1697
|
|
|
|
|
|
|
=item get_cmd_help(tokens, cset) |
1698
|
|
|
|
|
|
|
|
1699
|
|
|
|
|
|
|
Prints the full help text for the given command. |
1700
|
|
|
|
|
|
|
Uses self->commands() if cset is not specified. |
1701
|
|
|
|
|
|
|
|
1702
|
|
|
|
|
|
|
=cut |
1703
|
|
|
|
|
|
|
|
1704
|
|
|
|
|
|
|
sub get_cmd_help |
1705
|
|
|
|
|
|
|
{ |
1706
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
1707
|
0
|
|
|
|
|
|
my $tokens = shift; |
1708
|
0
|
|
0
|
|
|
|
my $topcset = shift || $self->commands(); |
1709
|
|
|
|
|
|
|
|
1710
|
0
|
|
|
|
|
|
my $str = ""; |
1711
|
|
|
|
|
|
|
|
1712
|
|
|
|
|
|
|
# print "DBG print_cmd_help: cmd=$cmd args=(" . join(", ", @$args), ")\n"; |
1713
|
|
|
|
|
|
|
|
1714
|
0
|
|
|
|
|
|
my($cset, $cmd, $cname, $args) = $self->get_deep_command($topcset, $tokens); |
1715
|
0
|
0
|
|
|
|
|
if(!$cmd) { |
1716
|
0
|
0
|
|
|
|
|
if(exists $topcset->{''}) { |
1717
|
0
|
|
|
|
|
|
$cmd = $topcset->{''}; |
1718
|
|
|
|
|
|
|
} else { |
1719
|
0
|
|
|
|
|
|
return $self->get_cname($cname) . " doesn't exist.\n"; |
1720
|
|
|
|
|
|
|
} |
1721
|
|
|
|
|
|
|
} |
1722
|
|
|
|
|
|
|
|
1723
|
0
|
0
|
|
|
|
|
if($self->{display_summary_in_help}) { |
1724
|
0
|
0
|
|
|
|
|
if(exists($cmd->{desc})) { |
1725
|
0
|
|
|
|
|
|
$str .= $self->get_cname($cname).": ".$self->get_field($cmd,'desc',$args)."\n"; |
1726
|
|
|
|
|
|
|
} else { |
1727
|
0
|
|
|
|
|
|
$str .= "No description for " . $self->get_cname($cname) . "\n"; |
1728
|
|
|
|
|
|
|
} |
1729
|
|
|
|
|
|
|
} |
1730
|
|
|
|
|
|
|
|
1731
|
0
|
0
|
|
|
|
|
if(exists($cmd->{doc})) { |
|
|
0
|
|
|
|
|
|
1732
|
0
|
|
|
|
|
|
$str .= $self->get_field($cmd, 'doc', |
1733
|
|
|
|
|
|
|
[$self->get_cname($cname), @$args]); |
1734
|
|
|
|
|
|
|
} elsif(exists($cmd->{cmds})) { |
1735
|
0
|
|
|
|
|
|
$str .= $self->get_all_cmd_summaries($cmd->{cmds}); |
1736
|
|
|
|
|
|
|
} else { |
1737
|
|
|
|
|
|
|
# no data -- do nothing |
1738
|
|
|
|
|
|
|
} |
1739
|
|
|
|
|
|
|
|
1740
|
0
|
|
|
|
|
|
return $str; |
1741
|
|
|
|
|
|
|
} |
1742
|
|
|
|
|
|
|
|
1743
|
|
|
|
|
|
|
|
1744
|
|
|
|
|
|
|
=item get_category_summary(name, cats) |
1745
|
|
|
|
|
|
|
|
1746
|
|
|
|
|
|
|
Prints a one-line summary for the named category |
1747
|
|
|
|
|
|
|
in the category hash specified in cats. |
1748
|
|
|
|
|
|
|
|
1749
|
|
|
|
|
|
|
=cut |
1750
|
|
|
|
|
|
|
|
1751
|
|
|
|
|
|
|
sub get_category_summary |
1752
|
|
|
|
|
|
|
{ |
1753
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
1754
|
0
|
|
|
|
|
|
my $name = shift; |
1755
|
0
|
|
|
|
|
|
my $cat = shift; |
1756
|
|
|
|
|
|
|
|
1757
|
0
|
|
0
|
|
|
|
my $title = $cat->{desc} || "(no description)"; |
1758
|
0
|
|
|
|
|
|
return sprintf("%20s -- $title\n", $name); |
1759
|
|
|
|
|
|
|
} |
1760
|
|
|
|
|
|
|
|
1761
|
|
|
|
|
|
|
=item get_category_help(cat, cset) |
1762
|
|
|
|
|
|
|
|
1763
|
|
|
|
|
|
|
Returns a summary of the commands listed in cat. |
1764
|
|
|
|
|
|
|
You must pass the command set that contains those commands in cset. |
1765
|
|
|
|
|
|
|
|
1766
|
|
|
|
|
|
|
=cut |
1767
|
|
|
|
|
|
|
|
1768
|
|
|
|
|
|
|
sub get_category_help |
1769
|
|
|
|
|
|
|
{ |
1770
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
1771
|
0
|
|
|
|
|
|
my $cat = shift; |
1772
|
0
|
|
|
|
|
|
my $cset = shift; |
1773
|
|
|
|
|
|
|
|
1774
|
0
|
|
|
|
|
|
my $str .= "\n" . $cat->{desc} . "\n\n"; |
1775
|
0
|
|
|
|
|
|
for my $name (@{$cat->{cmds}}) { |
|
0
|
|
|
|
|
|
|
1776
|
0
|
|
|
|
|
|
my @line = split /\s+/, $name; |
1777
|
0
|
|
|
|
|
|
$str .= $self->get_cmd_summary(\@line, $cset); |
1778
|
|
|
|
|
|
|
} |
1779
|
0
|
|
|
|
|
|
$str .= "\n"; |
1780
|
|
|
|
|
|
|
|
1781
|
0
|
|
|
|
|
|
return $str; |
1782
|
|
|
|
|
|
|
} |
1783
|
|
|
|
|
|
|
|
1784
|
|
|
|
|
|
|
|
1785
|
|
|
|
|
|
|
=item get_all_cmd_summaries(cset) |
1786
|
|
|
|
|
|
|
|
1787
|
|
|
|
|
|
|
Pass it a command set, and it will return a string containing |
1788
|
|
|
|
|
|
|
the summaries for each command in the set. |
1789
|
|
|
|
|
|
|
|
1790
|
|
|
|
|
|
|
=cut |
1791
|
|
|
|
|
|
|
|
1792
|
|
|
|
|
|
|
sub get_all_cmd_summaries |
1793
|
|
|
|
|
|
|
{ |
1794
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
1795
|
0
|
|
|
|
|
|
my $cset = shift; |
1796
|
|
|
|
|
|
|
|
1797
|
0
|
|
|
|
|
|
my $str = ""; |
1798
|
|
|
|
|
|
|
|
1799
|
0
|
|
|
|
|
|
for(sort keys(%$cset)) { |
1800
|
|
|
|
|
|
|
# we now exclude synonyms from the command summaries. |
1801
|
|
|
|
|
|
|
# hopefully this is the right thing to do...? |
1802
|
0
|
0
|
|
|
|
|
next if exists $cset->{$_}->{syn}; |
1803
|
|
|
|
|
|
|
# don't show the default command in any summaries |
1804
|
0
|
0
|
|
|
|
|
next if $_ eq ''; |
1805
|
|
|
|
|
|
|
|
1806
|
0
|
|
|
|
|
|
$str .= $self->get_cmd_summary([$_], $cset); |
1807
|
|
|
|
|
|
|
} |
1808
|
|
|
|
|
|
|
|
1809
|
0
|
|
|
|
|
|
return $str; |
1810
|
|
|
|
|
|
|
} |
1811
|
|
|
|
|
|
|
|
1812
|
|
|
|
|
|
|
=item load_history() |
1813
|
|
|
|
|
|
|
|
1814
|
|
|
|
|
|
|
If $self->{history_file} is set (see L), this will load all |
1815
|
|
|
|
|
|
|
history from that file. Called by L on startup. If you |
1816
|
|
|
|
|
|
|
don't use run, you will need to call this command manually. |
1817
|
|
|
|
|
|
|
|
1818
|
|
|
|
|
|
|
=cut |
1819
|
|
|
|
|
|
|
|
1820
|
|
|
|
|
|
|
sub load_history |
1821
|
|
|
|
|
|
|
{ |
1822
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
1823
|
|
|
|
|
|
|
|
1824
|
0
|
0
|
0
|
|
|
|
return unless $self->{history_file} && $self->{history_max} > 0; |
1825
|
|
|
|
|
|
|
|
1826
|
0
|
0
|
|
|
|
|
if(open HIST, '<'.$self->{history_file}) { |
1827
|
0
|
|
|
|
|
|
while() { |
1828
|
0
|
|
|
|
|
|
chomp(); |
1829
|
0
|
0
|
|
|
|
|
next unless /\S/; |
1830
|
0
|
|
|
|
|
|
$self->{term}->addhistory($_); |
1831
|
|
|
|
|
|
|
} |
1832
|
0
|
|
|
|
|
|
close HIST; |
1833
|
|
|
|
|
|
|
} |
1834
|
|
|
|
|
|
|
} |
1835
|
|
|
|
|
|
|
|
1836
|
|
|
|
|
|
|
=item save_history() |
1837
|
|
|
|
|
|
|
|
1838
|
|
|
|
|
|
|
If $self->{history_file} is set (see L), this will save all |
1839
|
|
|
|
|
|
|
history to that file. Called by L on shutdown. If you |
1840
|
|
|
|
|
|
|
don't use run, you will need to call this command manually. |
1841
|
|
|
|
|
|
|
|
1842
|
|
|
|
|
|
|
The history routines don't use ReadHistory and WriteHistory so they |
1843
|
|
|
|
|
|
|
can be used even if other ReadLine libs are being used. save_history |
1844
|
|
|
|
|
|
|
requires that the ReadLine lib supply a GetHistory call. |
1845
|
|
|
|
|
|
|
|
1846
|
|
|
|
|
|
|
=cut |
1847
|
|
|
|
|
|
|
|
1848
|
|
|
|
|
|
|
sub save_history |
1849
|
|
|
|
|
|
|
{ |
1850
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
1851
|
|
|
|
|
|
|
|
1852
|
0
|
0
|
0
|
|
|
|
return unless $self->{history_file} && $self->{history_max} > 0; |
1853
|
0
|
0
|
|
|
|
|
return unless $self->{term}->can('GetHistory'); |
1854
|
|
|
|
|
|
|
|
1855
|
0
|
0
|
|
|
|
|
if(open HIST, '>'.$self->{history_file}) { |
1856
|
0
|
|
|
|
|
|
local $, = "\n"; |
1857
|
0
|
|
|
|
|
|
my @list = $self->{term}->GetHistory(); |
1858
|
0
|
0
|
|
|
|
|
if(@list) { |
1859
|
0
|
|
|
|
|
|
my $max = $#list; |
1860
|
0
|
0
|
|
|
|
|
$max = $self->{history_max}-1 if $self->{history_max}-1 < $max; |
1861
|
0
|
|
|
|
|
|
print HIST @list[$#list-$max..$#list]; |
1862
|
0
|
|
|
|
|
|
print HIST "\n"; |
1863
|
|
|
|
|
|
|
} |
1864
|
0
|
|
|
|
|
|
close HIST; |
1865
|
|
|
|
|
|
|
} else { |
1866
|
0
|
|
|
|
|
|
$self->error("Could not open ".$self->{history_file}." for writing $!\n"); |
1867
|
|
|
|
|
|
|
} |
1868
|
|
|
|
|
|
|
} |
1869
|
|
|
|
|
|
|
|
1870
|
|
|
|
|
|
|
=item call_command(parms) |
1871
|
|
|
|
|
|
|
|
1872
|
|
|
|
|
|
|
Executes a command and returns the result. It takes a single |
1873
|
|
|
|
|
|
|
argument: the parms data structure. |
1874
|
|
|
|
|
|
|
|
1875
|
|
|
|
|
|
|
parms is a subset of the cmpl data structure (see the L |
1876
|
|
|
|
|
|
|
routine for more). Briefly, it contains: |
1877
|
|
|
|
|
|
|
cset, cmd, cname, args (see L), |
1878
|
|
|
|
|
|
|
tokens and rawline (the tokenized and untokenized command lines). |
1879
|
|
|
|
|
|
|
See L for full descriptions of these fields. |
1880
|
|
|
|
|
|
|
|
1881
|
|
|
|
|
|
|
This call should be overridden if you have exotic command |
1882
|
|
|
|
|
|
|
processing needs. If you override this routine, you will probably |
1883
|
|
|
|
|
|
|
need to override the L routine too. |
1884
|
|
|
|
|
|
|
|
1885
|
|
|
|
|
|
|
=cut |
1886
|
|
|
|
|
|
|
|
1887
|
|
|
|
|
|
|
|
1888
|
|
|
|
|
|
|
# This is the low-level version of call_command. It does nothing but call. |
1889
|
|
|
|
|
|
|
# Use call_command -- it's much smarter. |
1890
|
|
|
|
|
|
|
|
1891
|
|
|
|
|
|
|
sub call_cmd |
1892
|
|
|
|
|
|
|
{ |
1893
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
1894
|
0
|
|
|
|
|
|
my $parms = shift; |
1895
|
|
|
|
|
|
|
|
1896
|
0
|
|
|
|
|
|
my $cmd = $parms->{cmd}; |
1897
|
0
|
|
|
|
|
|
my $OUT = $self->{OUT}; |
1898
|
|
|
|
|
|
|
|
1899
|
0
|
|
|
|
|
|
my $retval = undef; |
1900
|
0
|
0
|
|
|
|
|
if(exists $cmd->{meth}) { |
|
|
0
|
|
|
|
|
|
1901
|
|
|
|
|
|
|
# if meth is a code ref, call it, else it's a string, print it. |
1902
|
0
|
0
|
|
|
|
|
if(ref($cmd->{meth}) eq 'CODE') { |
1903
|
0
|
|
|
|
|
|
$retval = eval { &{$cmd->{meth}}($self, $parms, @{$parms->{args}}) }; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
1904
|
0
|
0
|
|
|
|
|
$self->error($@) if $@; |
1905
|
|
|
|
|
|
|
} else { |
1906
|
0
|
|
|
|
|
|
print $OUT $cmd->{meth}; |
1907
|
|
|
|
|
|
|
} |
1908
|
|
|
|
|
|
|
} elsif(exists $cmd->{proc}) { |
1909
|
|
|
|
|
|
|
# if proc is a code ref, call it, else it's a string, print it. |
1910
|
0
|
0
|
|
|
|
|
if(ref($cmd->{proc}) eq 'CODE') { |
1911
|
0
|
|
|
|
|
|
$retval = eval { &{$cmd->{proc}}(@{$parms->{args}}) }; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
1912
|
0
|
0
|
|
|
|
|
$self->error($@) if $@; |
1913
|
|
|
|
|
|
|
} else { |
1914
|
0
|
|
|
|
|
|
print $OUT $cmd->{proc}; |
1915
|
|
|
|
|
|
|
} |
1916
|
|
|
|
|
|
|
} else { |
1917
|
0
|
0
|
|
|
|
|
if(exists $cmd->{cmds}) { |
1918
|
|
|
|
|
|
|
# if not, but it has subcommands, then print a summary |
1919
|
0
|
|
|
|
|
|
print $OUT $self->get_all_cmd_summaries($cmd->{cmds}); |
1920
|
|
|
|
|
|
|
} else { |
1921
|
0
|
|
|
|
|
|
$self->error($self->get_cname($parms->{cname}) . " has nothing to do!\n"); |
1922
|
|
|
|
|
|
|
} |
1923
|
|
|
|
|
|
|
} |
1924
|
|
|
|
|
|
|
|
1925
|
0
|
|
|
|
|
|
return $retval; |
1926
|
|
|
|
|
|
|
} |
1927
|
|
|
|
|
|
|
|
1928
|
|
|
|
|
|
|
|
1929
|
|
|
|
|
|
|
sub call_command |
1930
|
|
|
|
|
|
|
{ |
1931
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
1932
|
0
|
|
|
|
|
|
my $parms = shift; |
1933
|
|
|
|
|
|
|
|
1934
|
0
|
0
|
|
|
|
|
if(!$parms->{cmd}) { |
1935
|
0
|
0
|
0
|
|
|
|
if( exists $parms->{cset}->{''} && |
|
|
|
0
|
|
|
|
|
1936
|
|
|
|
|
|
|
(exists($parms->{cset}->{''}->{proc}) || |
1937
|
|
|
|
|
|
|
exists($parms->{cset}->{''}->{meth}) ) |
1938
|
|
|
|
|
|
|
) { |
1939
|
|
|
|
|
|
|
# default command exists and is callable |
1940
|
0
|
|
|
|
|
|
my $save = $parms->{cmd}; |
1941
|
0
|
|
|
|
|
|
$parms->{cmd} = $parms->{cset}->{''}; |
1942
|
0
|
|
|
|
|
|
my $retval = $self->call_cmd($parms); |
1943
|
0
|
|
|
|
|
|
$parms->{cmd} = $save; |
1944
|
0
|
|
|
|
|
|
return $retval; |
1945
|
|
|
|
|
|
|
} |
1946
|
|
|
|
|
|
|
|
1947
|
0
|
|
|
|
|
|
$self->error( $self->get_cname($parms->{cname}) . ": unknown command\n"); |
1948
|
0
|
|
|
|
|
|
return undef; |
1949
|
|
|
|
|
|
|
} |
1950
|
|
|
|
|
|
|
|
1951
|
0
|
|
|
|
|
|
my $cmd = $parms->{cmd}; |
1952
|
|
|
|
|
|
|
|
1953
|
|
|
|
|
|
|
# check min and max args if they exist |
1954
|
0
|
0
|
0
|
|
|
|
if(exists($cmd->{minargs}) && @{$parms->{args}} < $cmd->{minargs}) { |
|
0
|
|
|
|
|
|
|
1955
|
0
|
|
|
|
|
|
$self->error("Too few args! " . $cmd->{minargs} . " minimum.\n"); |
1956
|
0
|
|
|
|
|
|
return undef; |
1957
|
|
|
|
|
|
|
} |
1958
|
0
|
0
|
0
|
|
|
|
if(exists($cmd->{maxargs}) && @{$parms->{args}} > $cmd->{maxargs}) { |
|
0
|
|
|
|
|
|
|
1959
|
0
|
|
|
|
|
|
$self->error("Too many args! " . $cmd->{maxargs} . " maximum.\n"); |
1960
|
0
|
|
|
|
|
|
return undef; |
1961
|
|
|
|
|
|
|
} |
1962
|
|
|
|
|
|
|
|
1963
|
|
|
|
|
|
|
# everything checks out -- call the command |
1964
|
0
|
|
|
|
|
|
return $self->call_cmd($parms); |
1965
|
|
|
|
|
|
|
} |
1966
|
|
|
|
|
|
|
|
1967
|
|
|
|
|
|
|
=back |
1968
|
|
|
|
|
|
|
|
1969
|
|
|
|
|
|
|
=head1 BUGS |
1970
|
|
|
|
|
|
|
|
1971
|
|
|
|
|
|
|
History expansion does not respect token_chars. To make it do |
1972
|
|
|
|
|
|
|
so would require either adding this feature to the readline |
1973
|
|
|
|
|
|
|
library or re-writing history_expand in Perl -- neither of which |
1974
|
|
|
|
|
|
|
sounds very realistic. |
1975
|
|
|
|
|
|
|
|
1976
|
|
|
|
|
|
|
=head1 LICENSE |
1977
|
|
|
|
|
|
|
|
1978
|
|
|
|
|
|
|
Copyright (c) 2003-2006 Scott Bronson, all rights reserved. |
1979
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify |
1980
|
|
|
|
|
|
|
it under the same terms as Perl itself. |
1981
|
|
|
|
|
|
|
|
1982
|
|
|
|
|
|
|
=head1 AUTHOR |
1983
|
|
|
|
|
|
|
|
1984
|
|
|
|
|
|
|
Scott Bronson Ebronson@rinspin.comE |
1985
|
|
|
|
|
|
|
|
1986
|
|
|
|
|
|
|
=cut |
1987
|
|
|
|
|
|
|
|
1988
|
|
|
|
|
|
|
1; |