source: perl/lib/BarnOwl.pm @ 19b2766

release-1.5
Last change on this file since 19b2766 was 65fca7a0, checked in by Nelson Elhage <nelhage@mit.edu>, 15 years ago
Squelch an 'uninitialized' warning in recv:shift-left.
  • Property mode set to 100644
File size: 14.7 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_dispatch remove_dispatch
16                    add_io_dispatch remove_io_dispatch
17                    new_command
18                    new_variable_int new_variable_bool new_variable_string
19                    quote redisplay);
20our %EXPORT_TAGS = (all => \@EXPORT_OK);
21
22BEGIN {
23# bootstrap in C bindings and glue
24    *owl:: = \*BarnOwl::;
25    bootstrap BarnOwl 1.2;
26};
27
28use lib(get_data_dir() . "/lib");
29use lib(get_config_dir() . "/lib");
30
31use BarnOwl::Hook;
32use BarnOwl::Hooks;
33use BarnOwl::Message;
34use BarnOwl::Style;
35use BarnOwl::Zephyr;
36use BarnOwl::Timer;
37use BarnOwl::Editwin;
38use BarnOwl::Completion;
39
40use List::Util qw(max);
41
42=head1 NAME
43
44BarnOwl
45
46=head1 DESCRIPTION
47
48The BarnOwl module contains the core of BarnOwl's perl
49bindings. Source in this module is also run at startup to bootstrap
50barnowl by defining things like the default style.
51
52=for NOTE
53These following functions are defined in perlglue.xs. Keep the
54documentation here in sync with the user-visible commands defined
55there!
56
57=head2 command STRING
58
59Executes a BarnOwl command in the same manner as if the user had
60executed it at the BarnOwl command prompt. If the command returns a
61value, return it as a string, otherwise return undef.
62
63=head2 getcurmsg
64
65Returns the current message as a C<BarnOwl::Message> subclass, or
66undef if there is no message selected
67=head2 getnumcols
68
69Returns the width of the display window BarnOwl is currently using
70
71=head2 getidletime
72
73Returns the length of time since the user has pressed a key, in
74seconds.
75
76=head2 zephyr_getrealm
77
78Returns the zephyr realm barnowl is running in
79
80=head2 zephyr_getsender
81
82Returns the fully-qualified name of the zephyr sender barnowl is
83running as, e.g. C<nelhage@ATHENA.MIT.EDU>
84
85=head2 zephyr_zwrite COMMAND MESSAGE
86
87Sends a zephyr programmatically. C<COMMAND> should be a C<zwrite>
88command line, and C<MESSAGE> is the zephyr body to send.
89
90=head2 ztext_stylestrip STRING
91
92Strips zephyr formatting from a string and returns the result
93
94=head2 zephyr_getsubs
95
96Returns the list of subscription triples <class,instance,recipient>,
97separated by newlines.
98
99=head2 queue_message MESSAGE
100
101Enqueue a message in the BarnOwl message list, logging it and
102processing it appropriately. C<MESSAGE> should be an instance of
103BarnOwl::Message or a subclass.
104
105=head2 admin_message HEADER BODY
106
107Display a BarnOwl B<Admin> message, with the given header and body.
108
109=head2 start_question PROMPT CALLBACK
110
111Displays C<PROMPT> on the screen and lets the user enter a line of
112text, and calls C<CALLBACK>, which must be a perl subroutine
113reference, with the text the user entered
114
115=head2 start_password PROMPT CALLBACK
116
117Like C<start_question>, but echoes the user's input as C<*>s when they
118input.
119
120=head2 start_edit_win PROMPT CALLBACK
121
122Like C<start_question>, but displays C<PROMPT> on a line of its own
123and opens the editwin. If the user cancels the edit win, C<CALLBACK>
124is not invoked.
125
126=head2 get_data_dir
127
128Returns the BarnOwl system data directory, where system libraries and
129modules are stored
130
131=head2 get_config_dir
132
133Returns the BarnOwl user configuration directory, where user modules
134and configuration are stored (by default, C<$HOME/.owl>)
135
136=head2 popless_text TEXT
137
138Show a popup window containing the given C<TEXT>
139
140=head2 popless_ztext TEXT
141
142Show a popup window containing the provided zephyr-formatted C<TEXT>
143
144=head2 error STRING
145
146Reports an error and log it in `show errors'. Note that in any
147callback or hook called in perl code from BarnOwl, a C<die> will be
148caught and passed to C<error>.
149
150=head2 debug STRING
151
152Logs a debugging message to BarnOwl's debug log
153
154=head2 getnumcolors
155
156Returns the number of colors this BarnOwl is capable of displaying
157
158=head2 add_dispatch FD CALLBACK
159
160Adds a file descriptor to C<BarnOwl>'s internal C<select()>
161loop. C<CALLBACK> will be invoked whenever data is available to be
162read from C<FD>.
163
164C<add_dispatch> has been deprecated in favor of C<add_io_dispatch>,
165and is now a wrapper for it called with C<mode> set to C<'r'>.
166
167=cut
168
169sub add_dispatch {
170    my $fd = shift;
171    my $cb = shift;
172    add_io_dispatch($fd, 'r', $cb);
173}
174
175=head2 remove_dispatch FD
176
177Remove a file descriptor previously registered via C<add_dispatch>
178
179C<remove_dispatch> has been deprecated in favor of
180C<remove_io_dispatch>.
181
182=cut
183
184*remove_dispatch = \&remove_io_dispatch;
185
186=head2 add_io_dispatch FD MODE CB
187
188Adds a file descriptor to C<BarnOwl>'s internal C<select()>
189loop. <MODE> can be 'r', 'w', or 'rw'. C<CALLBACK> will be invoked
190whenever C<FD> becomes ready, as specified by <MODE>.
191
192Only one callback can be registered per FD. If a new callback is
193registered, the old one is removed.
194
195=cut
196
197sub add_io_dispatch {
198    my $fd = shift;
199    my $modeStr = shift;
200    my $cb = shift;
201    my $mode = 0;
202
203    $mode |= 0x1 if ($modeStr =~ /r/i); # Read
204    $mode |= 0x2 if ($modeStr =~ /w/i); # Write
205    if ($mode) {
206        $mode |= 0x4;                  # Exceptional
207        BarnOwl::Internal::add_io_dispatch($fd, $mode, $cb);
208    } else {
209        die("Invalid I/O Dispatch mode: $modeStr");
210    }
211}
212
213=head2 remove_io_dispatch FD
214
215Remove a file descriptor previously registered via C<add_io_dispatch>
216
217=head2 create_style NAME OBJECT
218
219Creates a new barnowl style with the given NAME defined by the given
220object. The object must have a C<description> method which returns a
221string description of the style, and a and C<format_message> method
222which accepts a C<BarnOwl::Message> object and returns a string that
223is the result of formatting the message for display.
224
225=head2 redisplay
226
227Redraw all of the messages on screen. This is useful if you've just
228changed how a style renders messages.
229
230=cut
231
232# perlconfig.c will set this to the value of the -c command-line
233# switch, if present.
234our $configfile;
235
236our @all_commands;
237
238if(!$configfile && -f $ENV{HOME} . "/.barnowlconf") {
239    $configfile = $ENV{HOME} . "/.barnowlconf";
240}
241$configfile ||= $ENV{HOME}."/.owlconf";
242
243# populate global variable space for legacy owlconf files
244sub _receive_msg_legacy_wrap {
245    my ($m) = @_;
246    $m->legacy_populate_global();
247    return &BarnOwl::Hooks::_receive_msg($m);
248}
249
250=head2 new_command NAME FUNC [{ARGS}]
251
252Add a new owl command. When owl executes the command NAME, FUNC will
253be called with the arguments passed to the command, with NAME as the
254first argument.
255
256ARGS should be a hashref containing any or all of C<summary>,
257C<usage>, or C<description> keys:
258
259=over 4
260
261=item summary
262
263A one-line summary of the purpose of the command
264
265=item usage
266
267A one-line usage synopsis, showing available options and syntax
268
269=item description
270
271A longer description of the syntax and semantics of the command,
272explaining usage and options
273
274=back
275
276=cut
277
278sub new_command {
279    my $name = shift;
280    my $func = shift;
281    my $args = shift || {};
282    my %args = (
283        summary     => "",
284        usage       => "",
285        description => "",
286        %{$args}
287    );
288
289    BarnOwl::Internal::new_command($name, $func, $args{summary}, $args{usage}, $args{description});
290}
291
292=head2 new_variable_int NAME [{ARGS}]
293
294=head2 new_variable_bool NAME [{ARGS}]
295
296=head2 new_variable_string NAME [{ARGS}]
297
298Add a new owl variable, either an int, a bool, or a string, with the
299specified name.
300
301ARGS can optionally contain the following keys:
302
303=over 4
304
305=item default
306
307The default and initial value for the variable
308
309=item summary
310
311A one-line summary of the variable's purpose
312
313=item description
314
315A longer description of the function of the variable
316
317=back
318
319=cut
320
321sub new_variable_int {
322    unshift @_, \&BarnOwl::Internal::new_variable_int, 0;
323    goto \&_new_variable;
324}
325
326sub new_variable_bool {
327    unshift @_, \&BarnOwl::Internal::new_variable_bool, 0;
328    goto \&_new_variable;
329}
330
331sub new_variable_string {
332    unshift @_, \&BarnOwl::Internal::new_variable_string, "";
333    goto \&_new_variable;
334}
335
336sub _new_variable {
337    my $func = shift;
338    my $default_default = shift;
339    my $name = shift;
340    my $args = shift || {};
341    my %args = (
342        summary     => "",
343        description => "",
344        default     => $default_default,
345        %{$args});
346    $func->($name, $args{default}, $args{summary}, $args{description});
347}
348
349=head2 quote LIST
350
351Quotes each of the strings in LIST and returns a string that will be
352correctly decoded to LIST by the BarnOwl command parser.  For example:
353
354    quote('zwrite', 'andersk', '-m', 'Hello, world!')
355    # returns "zwrite andersk -m 'Hello, world!'"
356
357=cut
358
359sub quote {
360    my @quoted;
361    for my $str (@_) {
362        if ($str eq '') {
363            push @quoted, "''";
364        } elsif ($str !~ /['" ]/) {
365            push @quoted, "$str";
366        } elsif ($str !~ /'/) {
367            push @quoted, "'$str'";
368        } else {
369            (my $qstr = $str) =~ s/"/"'"'"/g;
370            push @quoted, '"' . $qstr . '"';
371        }
372    }
373    return join(' ', @quoted);
374}
375
376=head2 Modify filters by appending text
377
378=cut
379
380sub register_builtin_commands {
381    # Filter modification
382    BarnOwl::new_command("filterappend",
383                         sub { filter_append_helper('appending', '', @_); },
384                       {
385                           summary => "append '<text>' to filter",
386                           usage => "filterappend <filter> <text>",
387                       });
388
389    BarnOwl::new_command("filterand",
390                         sub { filter_append_helper('and-ing', 'and', @_); },
391                       {
392                           summary => "append 'and <text>' to filter",
393                           usage => "filterand <filter> <text>",
394                       });
395
396    BarnOwl::new_command("filteror",
397                         sub { filter_append_helper('or-ing', 'or', @_); },
398                       {
399                           summary => "append 'or <text>' to filter",
400                           usage => "filteror <filter> <text>",
401                       });
402
403    # Date formatting
404    BarnOwl::new_command("showdate",
405                         sub { BarnOwl::time_format('showdate', '%Y-%m-%d %H:%M'); },
406                       {
407                           summary => "Show date in timestamps for supporting styles.",
408                           usage => "showdate",
409                       });
410
411    BarnOwl::new_command("hidedate",
412                         sub { BarnOwl::time_format('hidedate', '%H:%M'); },
413                       {
414                           summary => "Don't show date in timestamps for supporting styles.",
415                           usage => "hidedate",
416                       });
417
418    BarnOwl::new_command("timeformat",
419                         \&BarnOwl::time_format,
420                       {
421                           summary => "Set the format for timestamps and re-display messages",
422                           usage => "timeformat <format>",
423                       });
424
425    # Receive window scrolling
426    BarnOwl::new_command("recv:shiftleft",
427                        \&BarnOwl::recv_shift_left,
428                        {
429                            summary => "scrolls receive window to the left",
430                            usage => "recv:shiftleft [<amount>]",
431                            description => <<END_DESCR
432By default, scroll left by 10 columns. Passing no arguments or 0 activates this default behavior.
433Otherwise, scroll by the number of columns specified as the argument.
434END_DESCR
435                        });
436
437    BarnOwl::new_command("recv:shiftright",
438                        \&BarnOwl::recv_shift_right,
439                        {
440                            summary => "scrolls receive window to the right",
441                            usage => "recv:shiftright [<amount>]",
442                            description => <<END_DESCR
443By default, scroll right by 10 columns. Passing no arguments or 0 activates this default behavior.
444Otherwise, scroll by the number of columns specified as the argument.
445END_DESCR
446                        });
447
448}
449
450$BarnOwl::Hooks::startup->add("BarnOwl::register_builtin_commands");
451
452=head3 filter_append_helper ACTION SEP FUNC FILTER APPEND_TEXT
453
454Helper to append to filters.
455
456=cut
457
458sub filter_append_helper
459{
460    my $action = shift;
461    my $sep = shift;
462    my $func = shift;
463    my $filter = shift;
464    my @append = @_;
465    my $oldfilter = BarnOwl::getfilter($filter);
466    chomp $oldfilter;
467    my $newfilter = "$oldfilter $sep " . quote(@append);
468    my $msgtext = "To filter " . quote($filter) . " $action\n" . quote(@append) . "\nto get\n$newfilter";
469    if (BarnOwl::getvar('showfilterchange') eq 'on') {
470        BarnOwl::admin_message("Filter", $msgtext);
471    }
472    set_filter($filter, $newfilter);
473    return;
474}
475BarnOwl::new_variable_bool("showfilterchange",
476                           { default => 1,
477                             summary => 'Show modifications to filters by filterappend and friends.'});
478
479sub set_filter
480{
481    my $filtername = shift;
482    my $filtertext = shift;
483    my $cmd = 'filter ' . BarnOwl::quote($filtername) . ' ' . $filtertext;
484    BarnOwl::command($cmd);
485}
486
487=head3 time_format FORMAT
488
489Set the format for displaying times (variable timeformat) and redisplay
490messages.
491
492=cut
493
494my $timeformat = '%H:%M';
495
496sub time_format
497{
498    my $function = shift;
499    my $format = shift;
500    if(!$format)
501    {
502        return $timeformat;
503    }
504    if(shift)
505    {
506        return "Wrong number of arguments for command";
507    }
508    $timeformat = $format;
509    redisplay();
510}
511
512=head3 Receive window scrolling
513
514Permit scrolling the receive window left or right by arbitrary
515amounts (with a default of 10 characters).
516
517=cut
518
519sub recv_shift_left
520{
521    my $func = shift;
522    my $delta = shift;
523    $delta = 10 unless defined($delta) && int($delta) > 0;
524    my $shift = BarnOwl::recv_getshift();
525    if($shift > 0) {
526        BarnOwl::recv_setshift(max(0, $shift-$delta));
527    } else {
528        return "Already full left";
529    }
530}
531
532sub recv_shift_right
533{
534    my $func = shift;
535    my $delta = shift;
536    $delta = 10 unless int($delta) > 0;
537    my $shift = BarnOwl::recv_getshift();
538    BarnOwl::recv_setshift($shift+$delta);
539}
540
541=head3 default_zephyr_signature
542
543Compute the default zephyr signature.
544
545=cut
546
547sub default_zephyr_signature
548{
549  my $zsig = getvar('zsig');
550  if (!$zsig) {
551      if (my $zsigproc = getvar('zsigproc')) {
552          $zsig = `$zsigproc`;
553      } elsif (!defined($zsig = get_zephyr_variable('zwrite-signature'))) {
554          $zsig = ((getpwuid($<))[6]);
555          $zsig =~ s/,.*//;
556      }
557  }
558  chomp($zsig);
559  return $zsig;
560}
561
562# Stub for owl::startup / BarnOwl::startup, so it isn't bound to the
563# startup command. This may be redefined in a user's configfile.
564sub startup
565{
566}
567
5681;
Note: See TracBrowser for help on using the repository browser.