source: perl/lib/BarnOwl.pm @ 216b1d0

release-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since 216b1d0 was d7bcff8, checked in by Nelson Elhage <nelhage@mit.edu>, 12 years ago
Keep a global list of all defined command names.
  • Property mode set to 100644
File size: 8.9 KB
Line 
1use strict;
2use warnings;
3
4package BarnOwl;
5
6use base qw(Exporter);
7our @EXPORT_OK = qw(command getcurmsg getnumcols getidletime
8                    zephyr_getsender zephyr_getrealm zephyr_zwrite
9                    zephyr_stylestrip zephyr_smartstrip_user zephyr_getsubs
10                    queue_message admin_message
11                    start_question start_password start_edit_win
12                    get_data_dir get_config_dir popless_text popless_ztext
13                    error debug
14                    create_style getnumcolors wordwrap
15                    add_dispath remove_dispatch
16                    new_command
17                    new_variable_int new_variable_bool new_variable_string
18                    quote);
19our %EXPORT_TAGS = (all => \@EXPORT_OK);
20
21BEGIN {
22# bootstrap in C bindings and glue
23    *owl:: = \*BarnOwl::;
24    bootstrap BarnOwl 1.2;
25};
26
27use lib(get_data_dir() . "/lib");
28use lib(get_config_dir() . "/lib");
29
30use BarnOwl::Hook;
31use BarnOwl::Hooks;
32use BarnOwl::Message;
33use BarnOwl::Style;
34use BarnOwl::Timer;
35use BarnOwl::Editwin;
36use BarnOwl::Completion;
37
38=head1 NAME
39
40BarnOwl
41
42=head1 DESCRIPTION
43
44The BarnOwl module contains the core of BarnOwl's perl
45bindings. Source in this module is also run at startup to bootstrap
46barnowl by defining things like the default style.
47
48=for NOTE
49These following functions are defined in perlglue.xs. Keep the
50documentation here in sync with the user-visible commands defined
51there!
52
53=head2 command STRING
54
55Executes a BarnOwl command in the same manner as if the user had
56executed it at the BarnOwl command prompt. If the command returns a
57value, return it as a string, otherwise return undef.
58
59=head2 getcurmsg
60
61Returns the current message as a C<BarnOwl::Message> subclass, or
62undef if there is no message selected
63
64=head2 getnumcols
65
66Returns the width of the display window BarnOwl is currently using
67
68=head2 getidletime
69
70Returns the length of time since the user has pressed a key, in
71seconds.
72
73=head2 zephyr_getrealm
74
75Returns the zephyr realm barnowl is running in
76
77=head2 zephyr_getsender
78
79Returns the fully-qualified name of the zephyr sender barnowl is
80running as, e.g. C<nelhage@ATHENA.MIT.EDU>
81
82=head2 zephyr_zwrite COMMAND MESSAGE
83
84Sends a zephyr programmatically. C<COMMAND> should be a C<zwrite>
85command line, and C<MESSAGE> is the zephyr body to send.
86
87=head2 ztext_stylestrip STRING
88
89Strips zephyr formatting from a string and returns the result
90
91=head2 zephyr_getsubs
92
93Returns the list of subscription triples <class,instance,recipient>,
94separated by newlines.
95
96=head2 queue_message MESSAGE
97
98Enqueue a message in the BarnOwl message list, logging it and
99processing it appropriately. C<MESSAGE> should be an instance of
100BarnOwl::Message or a subclass.
101
102=head2 admin_message HEADER BODY
103
104Display a BarnOwl B<Admin> message, with the given header and body.
105
106=head2 start_question PROMPT CALLBACK
107
108Displays C<PROMPT> on the screen and lets the user enter a line of
109text, and calls C<CALLBACK>, which must be a perl subroutine
110reference, with the text the user entered
111
112=head2 start_password PROMPT CALLBACK
113
114Like C<start_question>, but echoes the user's input as C<*>s when they
115input.
116
117=head2 start_edit_win PROMPT CALLBACK
118
119Like C<start_question>, but displays C<PROMPT> on a line of its own
120and opens the editwin. If the user cancels the edit win, C<CALLBACK>
121is not invoked.
122
123=head2 get_data_dir
124
125Returns the BarnOwl system data directory, where system libraries and
126modules are stored
127
128=head2 get_config_dir
129
130Returns the BarnOwl user configuration directory, where user modules
131and configuration are stored (by default, C<$HOME/.owl>)
132
133=head2 popless_text TEXT
134
135Show a popup window containing the given C<TEXT>
136
137=head2 popless_ztext TEXT
138
139Show a popup window containing the provided zephyr-formatted C<TEXT>
140
141=head2 error STRING
142
143Reports an error and log it in `show errors'. Note that in any
144callback or hook called in perl code from BarnOwl, a C<die> will be
145caught and passed to C<error>.
146
147=head2 debug STRING
148
149Logs a debugging message to BarnOwl's debug log
150
151=head2 getnumcolors
152
153Returns the number of colors this BarnOwl is capable of displaying
154
155=head2 add_dispatch FD CALLBACK
156
157Adds a file descriptor to C<BarnOwl>'s internal C<select()>
158loop. C<CALLBACK> will be invoked whenever data is available to be
159read from C<FD>.
160
161=head2 remove_dispatch FD
162
163Remove a file descriptor previously registered via C<add_dispatch>
164
165=head2 create_style NAME OBJECT
166
167Creates a new barnowl style with the given NAME defined by the given
168object. The object must have a C<description> method which returns a
169string description of the style, and a and C<format_message> method
170which accepts a C<BarnOwl::Message> object and returns a string that
171is the result of formatting the message for display.
172
173=cut
174
175# perlconfig.c will set this to the value of the -c command-line
176# switch, if present.
177our $configfile;
178
179our @all_commands;
180
181if(!$configfile && -f $ENV{HOME} . "/.barnowlconf") {
182    $configfile = $ENV{HOME} . "/.barnowlconf";
183}
184$configfile ||= $ENV{HOME}."/.owlconf";
185
186# populate global variable space for legacy owlconf files
187sub _receive_msg_legacy_wrap {
188    my ($m) = @_;
189    $m->legacy_populate_global();
190    return &BarnOwl::Hooks::_receive_msg($m);
191}
192
193=head2 new_command NAME FUNC [{ARGS}]
194
195Add a new owl command. When owl executes the command NAME, FUNC will
196be called with the arguments passed to the command, with NAME as the
197first argument.
198
199ARGS should be a hashref containing any or all of C<summary>,
200C<usage>, or C<description> keys:
201
202=over 4
203
204=item summary
205
206A one-line summary of the purpose of the command
207
208=item usage
209
210A one-line usage synopsis, showing available options and syntax
211
212=item description
213
214A longer description of the syntax and semantics of the command,
215explaining usage and options
216
217=back
218
219=cut
220
221sub new_command {
222    my $name = shift;
223    my $func = shift;
224    my $args = shift || {};
225    my %args = (
226        summary     => "",
227        usage       => "",
228        description => "",
229        %{$args}
230    );
231
232    BarnOwl::Internal::new_command($name, $func, $args{summary}, $args{usage}, $args{description});
233}
234
235=head2 new_variable_int NAME [{ARGS}]
236
237=head2 new_variable_bool NAME [{ARGS}]
238
239=head2 new_variable_string NAME [{ARGS}]
240
241Add a new owl variable, either an int, a bool, or a string, with the
242specified name.
243
244ARGS can optionally contain the following keys:
245
246=over 4
247
248=item default
249
250The default and initial value for the variable
251
252=item summary
253
254A one-line summary of the variable's purpose
255
256=item description
257
258A longer description of the function of the variable
259
260=back
261
262=cut
263
264sub new_variable_int {
265    unshift @_, \&BarnOwl::Internal::new_variable_int, 0;
266    goto \&_new_variable;
267}
268
269sub new_variable_bool {
270    unshift @_, \&BarnOwl::Internal::new_variable_bool, 0;
271    goto \&_new_variable;
272}
273
274sub new_variable_string {
275    unshift @_, \&BarnOwl::Internal::new_variable_string, "";
276    goto \&_new_variable;
277}
278
279sub _new_variable {
280    my $func = shift;
281    my $default_default = shift;
282    my $name = shift;
283    my $args = shift || {};
284    my %args = (
285        summary     => "",
286        description => "",
287        default     => $default_default,
288        %{$args});
289    $func->($name, $args{default}, $args{summary}, $args{description});
290}
291
292=head2 quote STRING
293
294Return a version of STRING fully quoted to survive processing by
295BarnOwl's command parser.
296
297=cut
298
299sub quote {
300    my $str = shift;
301    return "''" if $str eq '';
302    if ($str !~ /['" ]/) {
303        return "$str";
304    }
305    if ($str !~ /'/) {
306        return "'$str'";
307    }
308    $str =~ s/"/"'"'"/g;
309    return '"' . $str . '"';
310}
311
312=head2 Modify filters by appending text
313
314=cut
315
316BarnOwl::new_command("filterappend",
317    sub { filter_append_helper('appending', '', @_); },
318    {
319        summary => "append '<text>' to filter",
320        usage => "filterappend <filter> <text>",
321    });
322
323BarnOwl::new_command("filterand",
324    sub { filter_append_helper('and-ing', 'and', @_); },
325    {
326        summary => "append 'and <text>' to filter",
327        usage => "filterand <filter> <text>",
328    });
329
330BarnOwl::new_command("filteror",
331    sub { filter_append_helper('or-ing', 'or', @_); },
332    {
333        summary => "append 'or <text>' to filter",
334        usage => "filteror <filter> <text>",
335    });
336
337=head3 filter_append_helper ACTION SEP FUNC FILTER APPEND_TEXT
338
339Helper to append to filters.
340
341=cut
342
343sub filter_append_helper
344{
345    my $action = shift;
346    my $sep = shift;
347    my $func = shift;
348    my $filter = shift;
349    my @append = @_;
350    my $oldfilter = BarnOwl::getfilter($filter);
351    chomp $oldfilter;
352    my $newfilter = join(' ', $oldfilter, $sep, @_);
353    my $msgtext = "To filter '$filter' $action\n'".join(' ', @append)."' to get\n'$newfilter'";
354    if (BarnOwl::getvar('showfilterchange') eq 'on') {
355        BarnOwl::admin_message("Filter", $msgtext);
356    }
357    BarnOwl::filter($filter, $newfilter);
358    return;
359}
360BarnOwl::new_variable_bool("showfilterchange",
361                           { default => 1,
362                             summary => 'Show modifications to filters by filterappend and friends.'});
363
3641;
Note: See TracBrowser for help on using the repository browser.