source: perl/lib/BarnOwl.pm @ 09bd74c

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