source: perl/lib/BarnOwl.pm @ 69f74c2

release-1.10
Last change on this file since 69f74c2 was 69f74c2, checked in by David Benjamin <davidben@mit.edu>, 11 years ago
And now... the moment you've all been waiting for... Expose OWL_VARIABLE_OTHER variables to perl. Rewrite all perl variable entry points to use that one. From now on, C only thinks of these variables as strings. (This has one regression to be fixed in a later commit: you can't set/unset with no arguments since we don't know how to set from boolean.)
  • Property mode set to 100644
File size: 18.4 KB
RevLine 
[ee183be]1use strict;
2use warnings;
3
4package BarnOwl;
5
[2be605a]6use base qw(Exporter);
[b303ba2]7our @EXPORT_OK = qw(command getcurmsg getnumcols getnumlines getidletime
[2be605a]8                    zephyr_getsender zephyr_getrealm zephyr_zwrite
9                    zephyr_stylestrip zephyr_smartstrip_user zephyr_getsubs
10                    queue_message admin_message
[e89ec48]11                    start_edit
[2be605a]12                    start_question start_password start_edit_win
13                    get_data_dir get_config_dir popless_text popless_ztext
[eede1bf]14                    error debug
[2be605a]15                    create_style getnumcolors wordwrap
[ffc4df6]16                    add_dispatch remove_dispatch
17                    add_io_dispatch remove_io_dispatch
[2be605a]18                    new_command
19                    new_variable_int new_variable_bool new_variable_string
[4df918b]20                    quote redisplay);
[2be605a]21our %EXPORT_TAGS = (all => \@EXPORT_OK);
22
[fd8dfe7]23BEGIN {
24# bootstrap in C bindings and glue
25    *owl:: = \*BarnOwl::;
26    bootstrap BarnOwl 1.2;
27};
28
29use lib(get_data_dir() . "/lib");
30use lib(get_config_dir() . "/lib");
31
[9179fd7]32use Glib;
33use AnyEvent;
34
[fd8dfe7]35use BarnOwl::Hook;
36use BarnOwl::Hooks;
37use BarnOwl::Message;
38use BarnOwl::Style;
[df569c5]39use BarnOwl::Zephyr;
[fd8dfe7]40use BarnOwl::Timer;
[cf26b72]41use BarnOwl::Editwin;
[8eac1a5]42use BarnOwl::Completion;
[b30c256]43use BarnOwl::Help;
[fd8dfe7]44
[6700c605]45use List::Util qw(max);
46
[ee183be]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
[b8a3e00]55BarnOwl by defining things like the default style.
[ee183be]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
[b8a3e00]83Returns the zephyr realm BarnOwl is running in
[ee183be]84
85=head2 zephyr_getsender
86
[b8a3e00]87Returns the fully-qualified name of the zephyr sender BarnOwl is
[ee183be]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
[374089a]95=cut
96
97sub zephyr_zwrite {
98    my ($command, $message) = @_;
99    my $ret = BarnOwl::Internal::zephyr_zwrite($command, $message);
100    die "Error sending zephyr" unless $ret == 0;
101}
102
[ee183be]103=head2 ztext_stylestrip STRING
104
105Strips zephyr formatting from a string and returns the result
106
107=head2 zephyr_getsubs
108
109Returns the list of subscription triples <class,instance,recipient>,
110separated by newlines.
111
112=head2 queue_message MESSAGE
113
114Enqueue a message in the BarnOwl message list, logging it and
115processing it appropriately. C<MESSAGE> should be an instance of
[e89ec48]116BarnOwl::Message or a subclass.
[ee183be]117
118=head2 admin_message HEADER BODY
119
120Display a BarnOwl B<Admin> message, with the given header and body.
121
[e89ec48]122=head2 start_edit %ARGS
[ee183be]123
[e89ec48]124Displays a prompt on the screen and lets the user enter text,
125and calls a callback when the editwin is closed.
[ee183be]126
[e89ec48]127C<%ARGS> must contain the following keys:
128
129=over 4
130
131=item prompt
132
133The line to display on the screen
134
135=item type
136
137One of:
138
139=over 4
140
141=item edit_win
142
143Displays the prompt on a line of its own and opens the edit_win.
144
145=item question
146
147Displays prompt on the screen and lets the user enter a line of
148text.
149
150=item password
[ee183be]151
[e89ec48]152Like question, but echoes the user's input as C<*>s when they
[ee183be]153input.
154
[e89ec48]155=back
156
157=item callback
158
159A Perl subroutine that is called when the user closes the edit_win.
[7803326]160C<CALLBACK> gets called with two parameters: the text the user entered,
161and a C<SUCCESS> boolean parameter which is false if the user canceled
162the edit_win and true otherwise.
[e89ec48]163
164=back
165
166=head2 start_question PROMPT CALLBACK
167
168=head2 start_password PROMPT CALLBACK
169
[ee183be]170=head2 start_edit_win PROMPT CALLBACK
171
[7803326]172Roughly equivalent to C<start_edit> called with the appropriate parameters.
173C<CALLBACK> is only called on success, for compatibility.
174
175These are deprecated wrappers around L<BarnOwl::start_edit>, and should not
176be uesd in new code.
[e89ec48]177
178=cut
179
180sub start_edit {
181    my %args = (@_);
182    BarnOwl::Internal::start_edit($args{type}, $args{prompt}, $args{callback});
183}
184
185sub start_question {
186    my ($prompt, $callback) = @_;
[7803326]187    BarnOwl::start_edit(type => 'question', prompt => $prompt, callback => sub {
188            my ($text, $success) = @_;
189            $callback->($text) if $success;
190        });
[e89ec48]191}
192
193sub start_password {
194    my ($prompt, $callback) = @_;
[7803326]195    BarnOwl::start_edit(type => 'password', prompt => $prompt, callback => sub {
196            my ($text, $success) = @_;
197            $callback->($text) if $success;
198        });
[e89ec48]199}
200
201sub start_edit_win {
202    my ($prompt, $callback) = @_;
[7803326]203    BarnOwl::start_edit(type => 'edit_win', prompt => $prompt, callback => sub {
204            my ($text, $success) = @_;
205            $callback->($text) if $success;
206        });
[e89ec48]207}
[ee183be]208
209=head2 get_data_dir
210
211Returns the BarnOwl system data directory, where system libraries and
212modules are stored
213
214=head2 get_config_dir
215
216Returns the BarnOwl user configuration directory, where user modules
217and configuration are stored (by default, C<$HOME/.owl>)
218
219=head2 popless_text TEXT
220
221Show a popup window containing the given C<TEXT>
222
223=head2 popless_ztext TEXT
224
225Show a popup window containing the provided zephyr-formatted C<TEXT>
226
227=head2 error STRING
228
229Reports an error and log it in `show errors'. Note that in any
230callback or hook called in perl code from BarnOwl, a C<die> will be
231caught and passed to C<error>.
232
[eede1bf]233=head2 debug STRING
234
235Logs a debugging message to BarnOwl's debug log
236
[ee183be]237=head2 getnumcolors
238
239Returns the number of colors this BarnOwl is capable of displaying
240
241=head2 add_dispatch FD CALLBACK
242
243Adds a file descriptor to C<BarnOwl>'s internal C<select()>
244loop. C<CALLBACK> will be invoked whenever data is available to be
245read from C<FD>.
246
[bcde7926]247C<add_dispatch> has been deprecated in favor of C<AnyEvent>, and is
248now a wrapper for C<add_io_dispatch> called with C<mode> set to
249C<'r'>.
[ffc4df6]250
251=cut
252
253sub add_dispatch {
254    my $fd = shift;
255    my $cb = shift;
256    add_io_dispatch($fd, 'r', $cb);
257}
258
[ee183be]259=head2 remove_dispatch FD
260
261Remove a file descriptor previously registered via C<add_dispatch>
262
[bcde7926]263C<remove_dispatch> has been deprecated in favor of C<AnyEvent>.
[ffc4df6]264
265=cut
266
267*remove_dispatch = \&remove_io_dispatch;
268
269=head2 add_io_dispatch FD MODE CB
270
271Adds a file descriptor to C<BarnOwl>'s internal C<select()>
272loop. <MODE> can be 'r', 'w', or 'rw'. C<CALLBACK> will be invoked
273whenever C<FD> becomes ready, as specified by <MODE>.
274
275Only one callback can be registered per FD. If a new callback is
276registered, the old one is removed.
277
[bcde7926]278C<add_io_dispatch> has been deprecated in favor of C<AnyEvent>.
279
[ffc4df6]280=cut
281
[bcde7926]282our %_io_dispatches;
283
[ffc4df6]284sub add_io_dispatch {
285    my $fd = shift;
286    my $modeStr = shift;
287    my $cb = shift;
[bcde7926]288    my @modes;
289
290    push @modes, 'r' if $modeStr =~ /r/i; # Read
291    push @modes, 'w' if $modeStr =~ /w/i; # Write
292    if (@modes) {
293        BarnOwl::remove_io_dispatch($fd);
294        for my $mode (@modes) {
295            push @{$_io_dispatches{$fd}}, AnyEvent->io(fh => $fd,
296                                                       poll => $mode,
297                                                       cb => $cb);
298        }
[ffc4df6]299    } else {
300        die("Invalid I/O Dispatch mode: $modeStr");
301    }
302}
303
304=head2 remove_io_dispatch FD
305
306Remove a file descriptor previously registered via C<add_io_dispatch>
307
[bcde7926]308C<remove_io_dispatch> has been deprecated in favor of C<AnyEvent>.
309
310=cut
311
312sub remove_io_dispatch {
313    my $fd = shift;
314    undef $_ foreach @{$_io_dispatches{$fd}};
315    delete $_io_dispatches{$fd};
316}
317
[ee183be]318=head2 create_style NAME OBJECT
319
[b8a3e00]320Creates a new BarnOwl style with the given NAME defined by the given
[ee183be]321object. The object must have a C<description> method which returns a
322string description of the style, and a and C<format_message> method
323which accepts a C<BarnOwl::Message> object and returns a string that
324is the result of formatting the message for display.
325
[4df918b]326=head2 redisplay
327
328Redraw all of the messages on screen. This is useful if you've just
329changed how a style renders messages.
330
[ee183be]331=cut
332
333# perlconfig.c will set this to the value of the -c command-line
334# switch, if present.
335our $configfile;
336
[d7bcff8]337our @all_commands;
338
[8135737]339if(!$configfile) {
340    if (-f get_config_dir() . "/init.pl") {
341        $configfile = get_config_dir() . "/init.pl";
342    } elsif (-f $ENV{HOME} . "/.barnowlconf") {
343        $configfile = $ENV{HOME} . "/.barnowlconf";
344    } else {
345        $configfile = $ENV{HOME}."/.owlconf";
346    }
[ee183be]347}
348
349# populate global variable space for legacy owlconf files
350sub _receive_msg_legacy_wrap {
351    my ($m) = @_;
352    $m->legacy_populate_global();
353    return &BarnOwl::Hooks::_receive_msg($m);
354}
355
356=head2 new_command NAME FUNC [{ARGS}]
357
358Add a new owl command. When owl executes the command NAME, FUNC will
359be called with the arguments passed to the command, with NAME as the
360first argument.
361
362ARGS should be a hashref containing any or all of C<summary>,
363C<usage>, or C<description> keys:
364
365=over 4
366
367=item summary
368
369A one-line summary of the purpose of the command
370
371=item usage
372
373A one-line usage synopsis, showing available options and syntax
374
375=item description
376
377A longer description of the syntax and semantics of the command,
378explaining usage and options
379
380=back
381
382=cut
383
384sub new_command {
385    my $name = shift;
386    my $func = shift;
387    my $args = shift || {};
388    my %args = (
389        summary     => "",
390        usage       => "",
391        description => "",
392        %{$args}
393    );
394
395    BarnOwl::Internal::new_command($name, $func, $args{summary}, $args{usage}, $args{description});
396}
397
398=head2 new_variable_int NAME [{ARGS}]
399
400=head2 new_variable_bool NAME [{ARGS}]
401
402=head2 new_variable_string NAME [{ARGS}]
403
404Add a new owl variable, either an int, a bool, or a string, with the
405specified name.
406
407ARGS can optionally contain the following keys:
408
409=over 4
410
411=item default
412
413The default and initial value for the variable
414
415=item summary
416
417A one-line summary of the variable's purpose
418
419=item description
420
421A longer description of the function of the variable
422
423=back
424
425=cut
426
427sub new_variable_int {
[69f74c2]428    unshift @_, 0, "<int>", sub { "$_[0]" }, # to string
429                            sub { $_[0] =~ /^-?[0-9]+$/ }, # validate
430                            sub { 0 + $_[0] }; # from string
[ee183be]431    goto \&_new_variable;
432}
433
434sub new_variable_bool {
[69f74c2]435    unshift @_, 0, "on,off", sub { $_[0] ? "on" : "off" }, # to string
436                             sub { $_[0] eq "on" || $_[0] eq "off" }, # validate
437                             sub { $_[0] eq "on" }; # from string
[ee183be]438    goto \&_new_variable;
439}
440
441sub new_variable_string {
[69f74c2]442    unshift @_, "", "<string>", sub { $_[0] }, # to string
443                                sub { 1 }, # validate
444                                sub { $_[0] }; # from string
[ee183be]445    goto \&_new_variable;
446}
447
448sub _new_variable {
449    my $default_default = shift;
[69f74c2]450    my $validsettings = shift;
451    my $tostring_fn = shift;
452    my $validate_fn = shift;
453    my $fromstring_fn = shift;
454
[ee183be]455    my $name = shift;
456    my $args = shift || {};
457    my %args = (
458        summary     => "",
459        description => "",
460        default     => $default_default,
461        %{$args});
[69f74c2]462
463    # Store the value in a closure.
464    my $value = $args{default};
465
466    my $get_tostring_fn = sub { $tostring_fn->($value) };
467    my $set_fromstring_fn = sub {
468      my ($dummy, $newval) = @_;
469      return -1 unless $validate_fn->($newval);
470      $value = $fromstring_fn->($newval);
471      return 0;
472    };
473
474    BarnOwl::Internal::new_variable($name, $args{summary}, $args{description}, $validsettings,
475                                    $get_tostring_fn, $set_fromstring_fn, undef);
[ee183be]476}
477
[fc92e6e2]478=head2 quote LIST
[ee183be]479
[fc92e6e2]480Quotes each of the strings in LIST and returns a string that will be
481correctly decoded to LIST by the BarnOwl command parser.  For example:
482
483    quote('zwrite', 'andersk', '-m', 'Hello, world!')
484    # returns "zwrite andersk -m 'Hello, world!'"
[ee183be]485
486=cut
487
488sub quote {
[fc92e6e2]489    my @quoted;
490    for my $str (@_) {
491        if ($str eq '') {
492            push @quoted, "''";
[ef4700c]493        } elsif ($str !~ /['" \n\t]/) {
[fc92e6e2]494            push @quoted, "$str";
495        } elsif ($str !~ /'/) {
496            push @quoted, "'$str'";
497        } else {
498            (my $qstr = $str) =~ s/"/"'"'"/g;
499            push @quoted, '"' . $qstr . '"';
500        }
[ee183be]501    }
[fc92e6e2]502    return join(' ', @quoted);
[ee183be]503}
504
[22b54a7]505=head2 Modify filters by appending text
506
507=cut
508
[cff58b4]509sub register_builtin_commands {
[0b2afba]510    # Filter modification
[cff58b4]511    BarnOwl::new_command("filterappend",
512                         sub { filter_append_helper('appending', '', @_); },
513                       {
514                           summary => "append '<text>' to filter",
515                           usage => "filterappend <filter> <text>",
516                       });
517
518    BarnOwl::new_command("filterand",
519                         sub { filter_append_helper('and-ing', 'and', @_); },
520                       {
521                           summary => "append 'and <text>' to filter",
522                           usage => "filterand <filter> <text>",
523                       });
524
525    BarnOwl::new_command("filteror",
526                         sub { filter_append_helper('or-ing', 'or', @_); },
527                       {
528                           summary => "append 'or <text>' to filter",
529                           usage => "filteror <filter> <text>",
530                       });
531
[0b2afba]532    # Date formatting
533    BarnOwl::new_command("showdate",
534                         sub { BarnOwl::time_format('showdate', '%Y-%m-%d %H:%M'); },
535                       {
536                           summary => "Show date in timestamps for supporting styles.",
537                           usage => "showdate",
538                       });
539
540    BarnOwl::new_command("hidedate",
541                         sub { BarnOwl::time_format('hidedate', '%H:%M'); },
542                       {
543                           summary => "Don't show date in timestamps for supporting styles.",
544                           usage => "hidedate",
545                       });
546
547    BarnOwl::new_command("timeformat",
548                         \&BarnOwl::time_format,
549                       {
550                           summary => "Set the format for timestamps and re-display messages",
551                           usage => "timeformat <format>",
552                       });
553
[6700c605]554    # Receive window scrolling
555    BarnOwl::new_command("recv:shiftleft",
556                        \&BarnOwl::recv_shift_left,
557                        {
558                            summary => "scrolls receive window to the left",
559                            usage => "recv:shiftleft [<amount>]",
560                            description => <<END_DESCR
561By default, scroll left by 10 columns. Passing no arguments or 0 activates this default behavior.
562Otherwise, scroll by the number of columns specified as the argument.
563END_DESCR
564                        });
565
566    BarnOwl::new_command("recv:shiftright",
567                        \&BarnOwl::recv_shift_right,
568                        {
569                            summary => "scrolls receive window to the right",
570                            usage => "recv:shiftright [<amount>]",
571                            description => <<END_DESCR
572By default, scroll right by 10 columns. Passing no arguments or 0 activates this default behavior.
573Otherwise, scroll by the number of columns specified as the argument.
574END_DESCR
575                        });
576
[cff58b4]577}
578
579$BarnOwl::Hooks::startup->add("BarnOwl::register_builtin_commands");
[22b54a7]580
581=head3 filter_append_helper ACTION SEP FUNC FILTER APPEND_TEXT
582
583Helper to append to filters.
584
585=cut
586
587sub filter_append_helper
588{
589    my $action = shift;
590    my $sep = shift;
591    my $func = shift;
592    my $filter = shift;
593    my @append = @_;
594    my $oldfilter = BarnOwl::getfilter($filter);
595    chomp $oldfilter;
[0b5168d]596    my $newfilter = "$oldfilter $sep " . quote(@append);
597    my $msgtext = "To filter " . quote($filter) . " $action\n" . quote(@append) . "\nto get\n$newfilter";
[22b54a7]598    if (BarnOwl::getvar('showfilterchange') eq 'on') {
599        BarnOwl::admin_message("Filter", $msgtext);
600    }
[1b9a163]601    set_filter($filter, $newfilter);
[22b54a7]602    return;
603}
604BarnOwl::new_variable_bool("showfilterchange",
605                           { default => 1,
606                             summary => 'Show modifications to filters by filterappend and friends.'});
[ee183be]607
[1b9a163]608sub set_filter
609{
610    my $filtername = shift;
611    my $filtertext = shift;
612    my $cmd = 'filter ' . BarnOwl::quote($filtername) . ' ' . $filtertext;
613    BarnOwl::command($cmd);
614}
615
[0b2afba]616=head3 time_format FORMAT
617
618Set the format for displaying times (variable timeformat) and redisplay
619messages.
620
621=cut
622
[d694c55]623my $timeformat = '%H:%M';
[0b2afba]624
625sub time_format
626{
627    my $function = shift;
628    my $format = shift;
629    if(!$format)
630    {
631        return $timeformat;
632    }
633    if(shift)
634    {
635        return "Wrong number of arguments for command";
636    }
637    $timeformat = $format;
638    redisplay();
639}
640
[6700c605]641=head3 Receive window scrolling
642
643Permit scrolling the receive window left or right by arbitrary
644amounts (with a default of 10 characters).
645
646=cut
647
648sub recv_shift_left
649{
650    my $func = shift;
651    my $delta = shift;
[365950b]652    $delta = 10 unless defined($delta) && int($delta) > 0;
[6700c605]653    my $shift = BarnOwl::recv_getshift();
654    if($shift > 0) {
655        BarnOwl::recv_setshift(max(0, $shift-$delta));
656    } else {
657        return "Already full left";
658    }
659}
660
661sub recv_shift_right
662{
663    my $func = shift;
664    my $delta = shift;
[675a998]665    $delta = 10 unless defined($delta) && int($delta) > 0;
[6700c605]666    my $shift = BarnOwl::recv_getshift();
667    BarnOwl::recv_setshift($shift+$delta);
668}
669
[de3f641]670=head3 default_zephyr_signature
671
672Compute the default zephyr signature.
673
674=cut
675
676sub default_zephyr_signature
677{
[77c87b2]678  my $zsig = getvar('zsig');
[785ee77]679  if (!defined($zsig) || $zsig eq '') {
680      my $zsigproc = getvar('zsigproc');
681      if (defined($zsigproc) && $zsigproc ne '') {
[3c428d4]682          $zsig = `$zsigproc`;
683      } elsif (!defined($zsig = get_zephyr_variable('zwrite-signature'))) {
684          $zsig = ((getpwuid($<))[6]);
685          $zsig =~ s/,.*//;
686      }
[de3f641]687  }
[77c87b2]688  chomp($zsig);
689  return $zsig;
[de3f641]690}
691
[b120bd3]692=head3 random_zephyr_signature
693
694Retrieve a random line from ~/.zsigs (except those beginning with '#')
695and use it as the zephyr signature.
696
697=cut
698
699sub random_zephyr_signature
700{
701    my $zsigfile = "$ENV{'HOME'}/.zsigs";
702    open my $file, '<', $zsigfile or die "Error opening file $zsigfile: $!";
703    my @lines = grep !(/^#/ || /^\s*$/), <$file>;
704    close $file;
705    return '' if !@lines;
706    my $zsig = "$lines[int(rand(scalar @lines))]";
707    chomp $zsig;
708    return $zsig;
709}
710
[7589f0a]711# Stub for owl::startup / BarnOwl::startup, so it isn't bound to the
712# startup command. This may be redefined in a user's configfile.
713sub startup
714{
715}
716
[ee183be]7171;
Note: See TracBrowser for help on using the repository browser.