source: perl/lib/BarnOwl.pm @ 2be605a

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