source: perl/lib/BarnOwl.pm @ dcc3f80

release-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since dcc3f80 was dcc3f80, checked in by Nelson Elhage <nelhage@mit.edu>, 12 years ago
Merge branch 'zephyr-fixes'
  • Property mode set to 100644
File size: 11.6 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 redisplay);
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::Zephyr;
35use BarnOwl::Timer;
36use BarnOwl::Editwin;
37use BarnOwl::Completion;
38
39=head1 NAME
40
41BarnOwl
42
43=head1 DESCRIPTION
44
45The BarnOwl module contains the core of BarnOwl's perl
46bindings. Source in this module is also run at startup to bootstrap
47barnowl by defining things like the default style.
48
49=for NOTE
50These following functions are defined in perlglue.xs. Keep the
51documentation here in sync with the user-visible commands defined
52there!
53
54=head2 command STRING
55
56Executes a BarnOwl command in the same manner as if the user had
57executed it at the BarnOwl command prompt. If the command returns a
58value, return it as a string, otherwise return undef.
59
60=head2 getcurmsg
61
62Returns the current message as a C<BarnOwl::Message> subclass, or
63undef if there is no message selected
64
65=head2 getnumcols
66
67Returns the width of the display window BarnOwl is currently using
68
69=head2 getidletime
70
71Returns the length of time since the user has pressed a key, in
72seconds.
73
74=head2 zephyr_getrealm
75
76Returns the zephyr realm barnowl is running in
77
78=head2 zephyr_getsender
79
80Returns the fully-qualified name of the zephyr sender barnowl is
81running as, e.g. C<nelhage@ATHENA.MIT.EDU>
82
83=head2 zephyr_zwrite COMMAND MESSAGE
84
85Sends a zephyr programmatically. C<COMMAND> should be a C<zwrite>
86command line, and C<MESSAGE> is the zephyr body to send.
87
88=head2 ztext_stylestrip STRING
89
90Strips zephyr formatting from a string and returns the result
91
92=head2 zephyr_getsubs
93
94Returns the list of subscription triples <class,instance,recipient>,
95separated by newlines.
96
97=head2 queue_message MESSAGE
98
99Enqueue a message in the BarnOwl message list, logging it and
100processing it appropriately. C<MESSAGE> should be an instance of
101BarnOwl::Message or a subclass.
102
103=head2 admin_message HEADER BODY
104
105Display a BarnOwl B<Admin> message, with the given header and body.
106
107=head2 start_question PROMPT CALLBACK
108
109Displays C<PROMPT> on the screen and lets the user enter a line of
110text, and calls C<CALLBACK>, which must be a perl subroutine
111reference, with the text the user entered
112
113=head2 start_password PROMPT CALLBACK
114
115Like C<start_question>, but echoes the user's input as C<*>s when they
116input.
117
118=head2 start_edit_win PROMPT CALLBACK
119
120Like C<start_question>, but displays C<PROMPT> on a line of its own
121and opens the editwin. If the user cancels the edit win, C<CALLBACK>
122is not invoked.
123
124=head2 get_data_dir
125
126Returns the BarnOwl system data directory, where system libraries and
127modules are stored
128
129=head2 get_config_dir
130
131Returns the BarnOwl user configuration directory, where user modules
132and configuration are stored (by default, C<$HOME/.owl>)
133
134=head2 popless_text TEXT
135
136Show a popup window containing the given C<TEXT>
137
138=head2 popless_ztext TEXT
139
140Show a popup window containing the provided zephyr-formatted C<TEXT>
141
142=head2 error STRING
143
144Reports an error and log it in `show errors'. Note that in any
145callback or hook called in perl code from BarnOwl, a C<die> will be
146caught and passed to C<error>.
147
148=head2 debug STRING
149
150Logs a debugging message to BarnOwl's debug log
151
152=head2 getnumcolors
153
154Returns the number of colors this BarnOwl is capable of displaying
155
156=head2 add_dispatch FD CALLBACK
157
158Adds a file descriptor to C<BarnOwl>'s internal C<select()>
159loop. C<CALLBACK> will be invoked whenever data is available to be
160read from C<FD>.
161
162=head2 remove_dispatch FD
163
164Remove a file descriptor previously registered via C<add_dispatch>
165
166=head2 create_style NAME OBJECT
167
168Creates a new barnowl style with the given NAME defined by the given
169object. The object must have a C<description> method which returns a
170string description of the style, and a and C<format_message> method
171which accepts a C<BarnOwl::Message> object and returns a string that
172is the result of formatting the message for display.
173
174=head2 redisplay
175
176Redraw all of the messages on screen. This is useful if you've just
177changed how a style renders messages.
178
179=cut
180
181# perlconfig.c will set this to the value of the -c command-line
182# switch, if present.
183our $configfile;
184
185our @all_commands;
186
187if(!$configfile && -f $ENV{HOME} . "/.barnowlconf") {
188    $configfile = $ENV{HOME} . "/.barnowlconf";
189}
190$configfile ||= $ENV{HOME}."/.owlconf";
191
192# populate global variable space for legacy owlconf files
193sub _receive_msg_legacy_wrap {
194    my ($m) = @_;
195    $m->legacy_populate_global();
196    return &BarnOwl::Hooks::_receive_msg($m);
197}
198
199=head2 new_command NAME FUNC [{ARGS}]
200
201Add a new owl command. When owl executes the command NAME, FUNC will
202be called with the arguments passed to the command, with NAME as the
203first argument.
204
205ARGS should be a hashref containing any or all of C<summary>,
206C<usage>, or C<description> keys:
207
208=over 4
209
210=item summary
211
212A one-line summary of the purpose of the command
213
214=item usage
215
216A one-line usage synopsis, showing available options and syntax
217
218=item description
219
220A longer description of the syntax and semantics of the command,
221explaining usage and options
222
223=back
224
225=cut
226
227sub new_command {
228    my $name = shift;
229    my $func = shift;
230    my $args = shift || {};
231    my %args = (
232        summary     => "",
233        usage       => "",
234        description => "",
235        %{$args}
236    );
237
238    BarnOwl::Internal::new_command($name, $func, $args{summary}, $args{usage}, $args{description});
239}
240
241=head2 new_variable_int NAME [{ARGS}]
242
243=head2 new_variable_bool NAME [{ARGS}]
244
245=head2 new_variable_string NAME [{ARGS}]
246
247Add a new owl variable, either an int, a bool, or a string, with the
248specified name.
249
250ARGS can optionally contain the following keys:
251
252=over 4
253
254=item default
255
256The default and initial value for the variable
257
258=item summary
259
260A one-line summary of the variable's purpose
261
262=item description
263
264A longer description of the function of the variable
265
266=back
267
268=cut
269
270sub new_variable_int {
271    unshift @_, \&BarnOwl::Internal::new_variable_int, 0;
272    goto \&_new_variable;
273}
274
275sub new_variable_bool {
276    unshift @_, \&BarnOwl::Internal::new_variable_bool, 0;
277    goto \&_new_variable;
278}
279
280sub new_variable_string {
281    unshift @_, \&BarnOwl::Internal::new_variable_string, "";
282    goto \&_new_variable;
283}
284
285sub _new_variable {
286    my $func = shift;
287    my $default_default = shift;
288    my $name = shift;
289    my $args = shift || {};
290    my %args = (
291        summary     => "",
292        description => "",
293        default     => $default_default,
294        %{$args});
295    $func->($name, $args{default}, $args{summary}, $args{description});
296}
297
298=head2 quote LIST
299
300Quotes each of the strings in LIST and returns a string that will be
301correctly decoded to LIST by the BarnOwl command parser.  For example:
302
303    quote('zwrite', 'andersk', '-m', 'Hello, world!')
304    # returns "zwrite andersk -m 'Hello, world!'"
305
306=cut
307
308sub quote {
309    my @quoted;
310    for my $str (@_) {
311        if ($str eq '') {
312            push @quoted, "''";
313        } elsif ($str !~ /['" ]/) {
314            push @quoted, "$str";
315        } elsif ($str !~ /'/) {
316            push @quoted, "'$str'";
317        } else {
318            (my $qstr = $str) =~ s/"/"'"'"/g;
319            push @quoted, '"' . $qstr . '"';
320        }
321    }
322    return join(' ', @quoted);
323}
324
325=head2 Modify filters by appending text
326
327=cut
328
329sub register_builtin_commands {
330    # Filter modification
331    BarnOwl::new_command("filterappend",
332                         sub { filter_append_helper('appending', '', @_); },
333                       {
334                           summary => "append '<text>' to filter",
335                           usage => "filterappend <filter> <text>",
336                       });
337
338    BarnOwl::new_command("filterand",
339                         sub { filter_append_helper('and-ing', 'and', @_); },
340                       {
341                           summary => "append 'and <text>' to filter",
342                           usage => "filterand <filter> <text>",
343                       });
344
345    BarnOwl::new_command("filteror",
346                         sub { filter_append_helper('or-ing', 'or', @_); },
347                       {
348                           summary => "append 'or <text>' to filter",
349                           usage => "filteror <filter> <text>",
350                       });
351
352    # Date formatting
353    BarnOwl::new_command("showdate",
354                         sub { BarnOwl::time_format('showdate', '%Y-%m-%d %H:%M'); },
355                       {
356                           summary => "Show date in timestamps for supporting styles.",
357                           usage => "showdate",
358                       });
359
360    BarnOwl::new_command("hidedate",
361                         sub { BarnOwl::time_format('hidedate', '%H:%M'); },
362                       {
363                           summary => "Don't show date in timestamps for supporting styles.",
364                           usage => "hidedate",
365                       });
366
367    BarnOwl::new_command("timeformat",
368                         \&BarnOwl::time_format,
369                       {
370                           summary => "Set the format for timestamps and re-display messages",
371                           usage => "timeformat <format>",
372                       });
373
374}
375
376$BarnOwl::Hooks::startup->add("BarnOwl::register_builtin_commands");
377
378=head3 filter_append_helper ACTION SEP FUNC FILTER APPEND_TEXT
379
380Helper to append to filters.
381
382=cut
383
384sub filter_append_helper
385{
386    my $action = shift;
387    my $sep = shift;
388    my $func = shift;
389    my $filter = shift;
390    my @append = @_;
391    my $oldfilter = BarnOwl::getfilter($filter);
392    chomp $oldfilter;
393    my $newfilter = "$oldfilter $sep " . quote(@append);
394    my $msgtext = "To filter " . quote($filter) . " $action\n" . quote(@append) . "\nto get\n$newfilter";
395    if (BarnOwl::getvar('showfilterchange') eq 'on') {
396        BarnOwl::admin_message("Filter", $msgtext);
397    }
398    BarnOwl::filter($filter, $newfilter);
399    return;
400}
401BarnOwl::new_variable_bool("showfilterchange",
402                           { default => 1,
403                             summary => 'Show modifications to filters by filterappend and friends.'});
404
405=head3 time_format FORMAT
406
407Set the format for displaying times (variable timeformat) and redisplay
408messages.
409
410=cut
411
412my $timeformat = '%H:%M';
413
414sub time_format
415{
416    my $function = shift;
417    my $format = shift;
418    if(!$format)
419    {
420        return $timeformat;
421    }
422    if(shift)
423    {
424        return "Wrong number of arguments for command";
425    }
426    $timeformat = $format;
427    redisplay();
428}
429
430=head3 default_zephyr_signature
431
432Compute the default zephyr signature.
433
434=cut
435
436sub default_zephyr_signature
437{
438  my $zsig = getvar('zsig');
439  if (!$zsig && (my $zsigproc = getvar('zsigproc'))) {
440    $zsig = `$zsigproc`;
441  } elsif (!defined($zsig = get_zephyr_variable('zwrite-signature'))) {
442    $zsig = ((getpwuid($<))[6]);
443    $zsig =~ s/,.*//;
444  }
445  chomp($zsig);
446  return $zsig;
447}
448
449# Stub for owl::startup / BarnOwl::startup, so it isn't bound to the
450# startup command. This may be redefined in a user's configfile.
451sub startup
452{
453}
454
4551;
Note: See TracBrowser for help on using the repository browser.