source: perl/lib/BarnOwl.pm @ e89ec48

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