source: perl/lib/BarnOwl.pm @ 7803326

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