source: perl/lib/BarnOwl.pm @ 4f746f8

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