source: perl/lib/BarnOwl.pm @ 5b483a6

release-1.10release-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since 5b483a6 was de3f641, checked in by Karl Ramm <kcr@1ts.org>, 15 years ago
Perl callout for zsig computation + move default to perl Barnowl::default_zephyr_signature works out what your zsig should be. New owl variable zsigfunc, which contains a perl expression that is evaluated for the zsig. Defaults to the above. This is much more pleasant code in perl than in C.
  • Property mode set to 100644
File size: 11.7 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_dispath remove_dispatch
16                    new_command
17                    new_variable_int new_variable_bool new_variable_string
18                    quote redisplay);
19our %EXPORT_TAGS = (all => \@EXPORT_OK);
20
21BEGIN {
22# bootstrap in C bindings and glue
23    *owl:: = \*BarnOwl::;
24    bootstrap BarnOwl 1.2;
25};
26
27use lib(get_data_dir() . "/lib");
28use lib(get_config_dir() . "/lib");
29
30use BarnOwl::Hook;
31use BarnOwl::Hooks;
32use BarnOwl::Message;
33use BarnOwl::Style;
34use BarnOwl::Timer;
35use BarnOwl::Editwin;
36use BarnOwl::Completion;
37
38=head1 NAME
39
40BarnOwl
41
42=head1 DESCRIPTION
43
44The BarnOwl module contains the core of BarnOwl's perl
45bindings. Source in this module is also run at startup to bootstrap
46barnowl by defining things like the default style.
47
48=for NOTE
49These following functions are defined in perlglue.xs. Keep the
50documentation here in sync with the user-visible commands defined
51there!
52
53=head2 command STRING
54
55Executes a BarnOwl command in the same manner as if the user had
56executed it at the BarnOwl command prompt. If the command returns a
57value, return it as a string, otherwise return undef.
58
59=head2 getcurmsg
60
61Returns the current message as a C<BarnOwl::Message> subclass, or
62undef if there is no message selected
63
64=head2 getnumcols
65
66Returns the width of the display window BarnOwl is currently using
67
68=head2 getidletime
69
70Returns the length of time since the user has pressed a key, in
71seconds.
72
73=head2 zephyr_getrealm
74
75Returns the zephyr realm barnowl is running in
76
77=head2 zephyr_getsender
78
79Returns the fully-qualified name of the zephyr sender barnowl is
80running as, e.g. C<nelhage@ATHENA.MIT.EDU>
81
82=head2 zephyr_zwrite COMMAND MESSAGE
83
84Sends a zephyr programmatically. C<COMMAND> should be a C<zwrite>
85command line, and C<MESSAGE> is the zephyr body to send.
86
87=head2 ztext_stylestrip STRING
88
89Strips zephyr formatting from a string and returns the result
90
91=head2 zephyr_getsubs
92
93Returns the list of subscription triples <class,instance,recipient>,
94separated by newlines.
95
96=head2 queue_message MESSAGE
97
98Enqueue a message in the BarnOwl message list, logging it and
99processing it appropriately. C<MESSAGE> should be an instance of
100BarnOwl::Message or a subclass.
101
102=head2 admin_message HEADER BODY
103
104Display a BarnOwl B<Admin> message, with the given header and body.
105
106=head2 start_question PROMPT CALLBACK
107
108Displays C<PROMPT> on the screen and lets the user enter a line of
109text, and calls C<CALLBACK>, which must be a perl subroutine
110reference, with the text the user entered
111
112=head2 start_password PROMPT CALLBACK
113
114Like C<start_question>, but echoes the user's input as C<*>s when they
115input.
116
117=head2 start_edit_win PROMPT CALLBACK
118
119Like C<start_question>, but displays C<PROMPT> on a line of its own
120and opens the editwin. If the user cancels the edit win, C<CALLBACK>
121is not invoked.
122
123=head2 get_data_dir
124
125Returns the BarnOwl system data directory, where system libraries and
126modules are stored
127
128=head2 get_config_dir
129
130Returns the BarnOwl user configuration directory, where user modules
131and configuration are stored (by default, C<$HOME/.owl>)
132
133=head2 popless_text TEXT
134
135Show a popup window containing the given C<TEXT>
136
137=head2 popless_ztext TEXT
138
139Show a popup window containing the provided zephyr-formatted C<TEXT>
140
141=head2 error STRING
142
143Reports an error and log it in `show errors'. Note that in any
144callback or hook called in perl code from BarnOwl, a C<die> will be
145caught and passed to C<error>.
146
147=head2 debug STRING
148
149Logs a debugging message to BarnOwl's debug log
150
151=head2 getnumcolors
152
153Returns the number of colors this BarnOwl is capable of displaying
154
155=head2 add_dispatch FD CALLBACK
156
157Adds a file descriptor to C<BarnOwl>'s internal C<select()>
158loop. C<CALLBACK> will be invoked whenever data is available to be
159read from C<FD>.
160
161=head2 remove_dispatch FD
162
163Remove a file descriptor previously registered via C<add_dispatch>
164
165=head2 create_style NAME OBJECT
166
167Creates a new barnowl style with the given NAME defined by the given
168object. The object must have a C<description> method which returns a
169string description of the style, and a and C<format_message> method
170which accepts a C<BarnOwl::Message> object and returns a string that
171is the result of formatting the message for display.
172
173=head2 redisplay
174
175Redraw all of the messages on screen. This is useful if you've just
176changed how a style renders messages.
177
178=cut
179
180# perlconfig.c will set this to the value of the -c command-line
181# switch, if present.
182our $configfile;
183
184our @all_commands;
185
186if(!$configfile && -f $ENV{HOME} . "/.barnowlconf") {
187    $configfile = $ENV{HOME} . "/.barnowlconf";
188}
189$configfile ||= $ENV{HOME}."/.owlconf";
190
191# populate global variable space for legacy owlconf files
192sub _receive_msg_legacy_wrap {
193    my ($m) = @_;
194    $m->legacy_populate_global();
195    return &BarnOwl::Hooks::_receive_msg($m);
196}
197
198=head2 new_command NAME FUNC [{ARGS}]
199
200Add a new owl command. When owl executes the command NAME, FUNC will
201be called with the arguments passed to the command, with NAME as the
202first argument.
203
204ARGS should be a hashref containing any or all of C<summary>,
205C<usage>, or C<description> keys:
206
207=over 4
208
209=item summary
210
211A one-line summary of the purpose of the command
212
213=item usage
214
215A one-line usage synopsis, showing available options and syntax
216
217=item description
218
219A longer description of the syntax and semantics of the command,
220explaining usage and options
221
222=back
223
224=cut
225
226sub new_command {
227    my $name = shift;
228    my $func = shift;
229    my $args = shift || {};
230    my %args = (
231        summary     => "",
232        usage       => "",
233        description => "",
234        %{$args}
235    );
236
237    BarnOwl::Internal::new_command($name, $func, $args{summary}, $args{usage}, $args{description});
238}
239
240=head2 new_variable_int NAME [{ARGS}]
241
242=head2 new_variable_bool NAME [{ARGS}]
243
244=head2 new_variable_string NAME [{ARGS}]
245
246Add a new owl variable, either an int, a bool, or a string, with the
247specified name.
248
249ARGS can optionally contain the following keys:
250
251=over 4
252
253=item default
254
255The default and initial value for the variable
256
257=item summary
258
259A one-line summary of the variable's purpose
260
261=item description
262
263A longer description of the function of the variable
264
265=back
266
267=cut
268
269sub new_variable_int {
270    unshift @_, \&BarnOwl::Internal::new_variable_int, 0;
271    goto \&_new_variable;
272}
273
274sub new_variable_bool {
275    unshift @_, \&BarnOwl::Internal::new_variable_bool, 0;
276    goto \&_new_variable;
277}
278
279sub new_variable_string {
280    unshift @_, \&BarnOwl::Internal::new_variable_string, "";
281    goto \&_new_variable;
282}
283
284sub _new_variable {
285    my $func = shift;
286    my $default_default = shift;
287    my $name = shift;
288    my $args = shift || {};
289    my %args = (
290        summary     => "",
291        description => "",
292        default     => $default_default,
293        %{$args});
294    $func->($name, $args{default}, $args{summary}, $args{description});
295}
296
297=head2 quote LIST
298
299Quotes each of the strings in LIST and returns a string that will be
300correctly decoded to LIST by the BarnOwl command parser.  For example:
301
302    quote('zwrite', 'andersk', '-m', 'Hello, world!')
303    # returns "zwrite andersk -m 'Hello, world!'"
304
305=cut
306
307sub quote {
308    my @quoted;
309    for my $str (@_) {
310        if ($str eq '') {
311            push @quoted, "''";
312        } elsif ($str !~ /['" ]/) {
313            push @quoted, "$str";
314        } elsif ($str !~ /'/) {
315            push @quoted, "'$str'";
316        } else {
317            (my $qstr = $str) =~ s/"/"'"'"/g;
318            push @quoted, '"' . $qstr . '"';
319        }
320    }
321    return join(' ', @quoted);
322}
323
324=head2 Modify filters by appending text
325
326=cut
327
328sub register_builtin_commands {
329    # Filter modification
330    BarnOwl::new_command("filterappend",
331                         sub { filter_append_helper('appending', '', @_); },
332                       {
333                           summary => "append '<text>' to filter",
334                           usage => "filterappend <filter> <text>",
335                       });
336
337    BarnOwl::new_command("filterand",
338                         sub { filter_append_helper('and-ing', 'and', @_); },
339                       {
340                           summary => "append 'and <text>' to filter",
341                           usage => "filterand <filter> <text>",
342                       });
343
344    BarnOwl::new_command("filteror",
345                         sub { filter_append_helper('or-ing', 'or', @_); },
346                       {
347                           summary => "append 'or <text>' to filter",
348                           usage => "filteror <filter> <text>",
349                       });
350
351    # Date formatting
352    BarnOwl::new_command("showdate",
353                         sub { BarnOwl::time_format('showdate', '%Y-%m-%d %H:%M'); },
354                       {
355                           summary => "Show date in timestamps for supporting styles.",
356                           usage => "showdate",
357                       });
358
359    BarnOwl::new_command("hidedate",
360                         sub { BarnOwl::time_format('hidedate', '%H:%M'); },
361                       {
362                           summary => "Don't show date in timestamps for supporting styles.",
363                           usage => "hidedate",
364                       });
365
366    BarnOwl::new_command("timeformat",
367                         \&BarnOwl::time_format,
368                       {
369                           summary => "Set the format for timestamps and re-display messages",
370                           usage => "timeformat <format>",
371                       });
372
373}
374
375$BarnOwl::Hooks::startup->add("BarnOwl::register_builtin_commands");
376
377=head3 filter_append_helper ACTION SEP FUNC FILTER APPEND_TEXT
378
379Helper to append to filters.
380
381=cut
382
383sub filter_append_helper
384{
385    my $action = shift;
386    my $sep = shift;
387    my $func = shift;
388    my $filter = shift;
389    my @append = @_;
390    my $oldfilter = BarnOwl::getfilter($filter);
391    chomp $oldfilter;
392    my $newfilter = "$oldfilter $sep " . quote(@append);
393    my $msgtext = "To filter " . quote($filter) . " $action\n" . quote(@append) . "\nto get\n$newfilter";
394    if (BarnOwl::getvar('showfilterchange') eq 'on') {
395        BarnOwl::admin_message("Filter", $msgtext);
396    }
397    BarnOwl::filter($filter, $newfilter);
398    return;
399}
400BarnOwl::new_variable_bool("showfilterchange",
401                           { default => 1,
402                             summary => 'Show modifications to filters by filterappend and friends.'});
403
404=head3 time_format FORMAT
405
406Set the format for displaying times (variable timeformat) and redisplay
407messages.
408
409=cut
410
411my $timeformat = '%H:%M';
412
413sub time_format
414{
415    my $function = shift;
416    my $format = shift;
417    if(!$format)
418    {
419        return $timeformat;
420    }
421    if(shift)
422    {
423        return "Wrong number of arguments for command";
424    }
425    $timeformat = $format;
426    redisplay();
427}
428
429=head3 default_zephyr_signature
430
431Compute the default zephyr signature.
432
433=cut
434
435sub default_zephyr_signature
436{
437  if (my $zsig = getvar('zsig')) {
438    return $zsig;
439  }
440  if (my $zsigproc = getvar('zsigproc')) {
441    return `$zsigproc`;
442  }
443  my $zwrite_signature = get_zephyr_variable('zwrite-signature');
444  if (defined($zwrite_signature)) {
445    return $zwrite_signature;
446  }
447  my $name = ((getpwuid($<))[6]);
448  $name =~ s/,.*//;
449  return $name;
450}
451
452# Stub for owl::startup / BarnOwl::startup, so it isn't bound to the
453# startup command. This may be redefined in a user's configfile.
454sub startup
455{
456}
457
4581;
Note: See TracBrowser for help on using the repository browser.