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
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_edit
12                    start_question start_password start_edit_win
13                    get_data_dir get_config_dir popless_text popless_ztext
14                    error debug
15                    create_style getnumcolors wordwrap
16                    add_dispatch remove_dispatch
17                    add_io_dispatch remove_io_dispatch
18                    new_command
19                    new_variable_int new_variable_bool new_variable_string
20                    quote redisplay);
21our %EXPORT_TAGS = (all => \@EXPORT_OK);
22
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
32use Glib;
33use AnyEvent;
34
35use BarnOwl::Hook;
36use BarnOwl::Hooks;
37use BarnOwl::Message;
38use BarnOwl::Style;
39use BarnOwl::Zephyr;
40use BarnOwl::Timer;
41use BarnOwl::Editwin;
42use BarnOwl::Completion;
43use BarnOwl::Help;
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_edit %ARGS
115
116Displays a prompt on the screen and lets the user enter text,
117and calls a callback when the editwin is closed.
118
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
143
144Like question, but echoes the user's input as C<*>s when they
145input.
146
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
159=head2 start_edit_win PROMPT CALLBACK
160
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}
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
209=head2 debug STRING
210
211Logs a debugging message to BarnOwl's debug log
212
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
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'>.
226
227=cut
228
229sub add_dispatch {
230    my $fd = shift;
231    my $cb = shift;
232    add_io_dispatch($fd, 'r', $cb);
233}
234
235=head2 remove_dispatch FD
236
237Remove a file descriptor previously registered via C<add_dispatch>
238
239C<remove_dispatch> has been deprecated in favor of C<AnyEvent>.
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
254C<add_io_dispatch> has been deprecated in favor of C<AnyEvent>.
255
256=cut
257
258our %_io_dispatches;
259
260sub add_io_dispatch {
261    my $fd = shift;
262    my $modeStr = shift;
263    my $cb = shift;
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        }
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
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
294=head2 create_style NAME OBJECT
295
296Creates a new BarnOwl style with the given NAME defined by the given
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
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
307=cut
308
309# perlconfig.c will set this to the value of the -c command-line
310# switch, if present.
311our $configfile;
312
313our @all_commands;
314
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
426=head2 quote LIST
427
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!'"
433
434=cut
435
436sub quote {
437    my @quoted;
438    for my $str (@_) {
439        if ($str eq '') {
440            push @quoted, "''";
441        } elsif ($str !~ /['" \n\t]/) {
442            push @quoted, "$str";
443        } elsif ($str !~ /'/) {
444            push @quoted, "'$str'";
445        } else {
446            (my $qstr = $str) =~ s/"/"'"'"/g;
447            push @quoted, '"' . $qstr . '"';
448        }
449    }
450    return join(' ', @quoted);
451}
452
453=head2 Modify filters by appending text
454
455=cut
456
457sub register_builtin_commands {
458    # Filter modification
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
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
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
525}
526
527$BarnOwl::Hooks::startup->add("BarnOwl::register_builtin_commands");
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;
544    my $newfilter = "$oldfilter $sep " . quote(@append);
545    my $msgtext = "To filter " . quote($filter) . " $action\n" . quote(@append) . "\nto get\n$newfilter";
546    if (BarnOwl::getvar('showfilterchange') eq 'on') {
547        BarnOwl::admin_message("Filter", $msgtext);
548    }
549    set_filter($filter, $newfilter);
550    return;
551}
552BarnOwl::new_variable_bool("showfilterchange",
553                           { default => 1,
554                             summary => 'Show modifications to filters by filterappend and friends.'});
555
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
564=head3 time_format FORMAT
565
566Set the format for displaying times (variable timeformat) and redisplay
567messages.
568
569=cut
570
571my $timeformat = '%H:%M';
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
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;
600    $delta = 10 unless defined($delta) && int($delta) > 0;
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;
613    $delta = 10 unless defined($delta) && int($delta) > 0;
614    my $shift = BarnOwl::recv_getshift();
615    BarnOwl::recv_setshift($shift+$delta);
616}
617
618=head3 default_zephyr_signature
619
620Compute the default zephyr signature.
621
622=cut
623
624sub default_zephyr_signature
625{
626  my $zsig = getvar('zsig');
627  if (!defined($zsig) || $zsig eq '') {
628      my $zsigproc = getvar('zsigproc');
629      if (defined($zsigproc) && $zsigproc ne '') {
630          $zsig = `$zsigproc`;
631      } elsif (!defined($zsig = get_zephyr_variable('zwrite-signature'))) {
632          $zsig = ((getpwuid($<))[6]);
633          $zsig =~ s/,.*//;
634      }
635  }
636  chomp($zsig);
637  return $zsig;
638}
639
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
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
6651;
Note: See TracBrowser for help on using the repository browser.