source: perl/lib/BarnOwl/Hooks.pm @ a1d98e4

release-1.10release-1.6release-1.7release-1.8release-1.9
Last change on this file since a1d98e4 was b30c256, checked in by David Benjamin <davidben@mit.edu>, 15 years ago
Add edit:help command for zsh-style in-edit help zsh has this convenient feature where pressing M-h while typing a command will look up the man page for the current command and fully restore your editting session afterwards. This command brings a similar feature to BarnOwl. Instead of launching man, we open the usual popwin, which is much easier to restore from. Signed-off-by: David Benjamin <davidben@mit.edu>
  • Property mode set to 100644
File size: 7.1 KB
Line 
1use strict;
2use warnings;
3
4package BarnOwl::Hooks;
5
6use Carp;
7use List::Util qw(first);
8
9=head1 BarnOwl::Hooks
10
11=head1 DESCRIPTION
12
13C<BarnOwl::Hooks> exports a set of C<BarnOwl::Hook> objects made
14available by BarnOwl internally.
15
16=head2 USAGE
17
18Modules wishing to respond to events in BarnOwl should register
19functions with these hooks.
20
21=head2 EXPORTS
22
23None by default. Either import the hooks you need explicitly, or refer
24to them with fully-qualified names. Available hooks are:
25
26=over 4
27
28=item $startup
29
30Called on BarnOwl startup, and whenever modules are
31reloaded. Functions registered with the C<$startup> hook get a true
32argument if this is a reload, and false if this is a true startup
33
34=item $shutdown
35
36Called before BarnOwl shutdown
37
38=item $receiveMessage
39
40Called with a C<BarnOwl::Message> object every time BarnOwl receives a
41new incoming message.
42
43=item $newMessage
44
45Called with a C<BarnOwl::Message> object every time BarnOwl appends
46I<any> new message to the message list.
47
48=item $mainLoop
49
50Called on every pass through the C<BarnOwl> main loop. This is
51guaranteed to be called at least once/sec and may be called more
52frequently.
53
54=item $getBuddyList
55
56Called to display buddy lists for all protocol handlers. The result
57from every function registered with this hook will be appended and
58displayed in a popup window, with zephyr formatting parsed.
59
60=item $getQuickstart
61
62Called by :show quickstart to display 2-5 lines of help on how to
63start using the protocol. The result from every function registered
64with this hook will be appended and displayed in an admin message,
65with zephyr formatting parsed. The format should be
66"@b(Protocol:)\nSome text.\nMore text.\n"
67
68=back
69
70=cut
71
72use Exporter;
73
74our @EXPORT_OK = qw($startup $shutdown
75                    $receiveMessage $newMessage
76                    $mainLoop $getBuddyList
77                    $getQuickstart);
78
79our %EXPORT_TAGS = (all => [@EXPORT_OK]);
80
81our $startup = BarnOwl::Hook->new;
82our $shutdown = BarnOwl::Hook->new;
83our $receiveMessage = BarnOwl::Hook->new;
84our $newMessage = BarnOwl::Hook->new;
85our $mainLoop = BarnOwl::Hook->new;
86our $getBuddyList = BarnOwl::Hook->new;
87our $getQuickstart = BarnOwl::Hook->new;
88
89# Internal startup/shutdown routines called by the C code
90
91sub _load_perl_commands {
92    # Load builtin perl commands
93    BarnOwl::new_command(style => \&BarnOwl::Style::style_command,
94                       {
95                           summary => "creates a new style",
96                           usage   => "style <name> perl <function_name>",
97                           description =>
98                           "A style named <name> will be created that will\n" .
99                           "format messages using the perl function <function_name>.\n\n" .
100                           "SEE ALSO: show styles, view -s, filter -s\n\n" .
101                           "DEPRECATED in favor of BarnOwl::create_style(NAME, OBJECT)",
102                          });
103    BarnOwl::new_command('edit:complete' => \&BarnOwl::Completion::do_complete,
104                       {
105                           summary     => "Complete the word at point",
106                           usage       => "complete",
107                           description =>
108                           "This is the function responsible for tab-completion."
109                       });
110    BarnOwl::new_command('edit:help' => \&BarnOwl::Help::show_help,
111                       {
112                           summary     => "Display help for the current command",
113                           usage       => "help",
114                           description =>
115                           "Opens the help information on the current command.\n" .
116                           "Returns to the previous editing context afterwards.\n\n" .
117                           "SEE ALSO: help"
118                         });
119    BarnOwl::bindkey(editline => TAB => command => 'edit:complete');
120    BarnOwl::bindkey(editline => 'M-h' => command => 'edit:help');
121}
122
123sub _load_owlconf {
124    # load the config  file
125    if ( -r $BarnOwl::configfile ) {
126        undef $@;
127        package main;
128        do $BarnOwl::configfile;
129        if($@) {
130            BarnOwl::error("In startup: $@\n");
131            return;
132        }
133        package BarnOwl;
134        if(*BarnOwl::format_msg{CODE}) {
135            # if the config defines a legacy formatting function, add 'perl' as a style
136            BarnOwl::create_style("perl", BarnOwl::Style::Legacy->new(
137                "BarnOwl::format_msg",
138                "User-defined perl style that calls BarnOwl::format_msg"
139                . " with legacy global variable support",
140                1));
141             BarnOwl::set("-q default_style perl");
142        }
143    }
144}
145
146# These are the internal hooks called by the barnowl C code, which
147# take care of dispatching to the appropriate perl hooks, and deal
148# with compatibility by calling the old, fixed-name hooks.
149
150sub _startup {
151    _load_perl_commands();
152    _load_owlconf();
153
154    if(eval {require BarnOwl::ModuleLoader}) {
155        eval {
156            BarnOwl::ModuleLoader->load_all;
157        };
158        BarnOwl::error("$@") if $@;
159
160    } else {
161        BarnOwl::error("Can't load BarnOwl::ModuleLoader, loadable module support disabled:\n$@");
162    }
163   
164    $startup->run(0);
165    BarnOwl::startup() if *BarnOwl::startup{CODE};
166}
167
168sub _shutdown {
169    $shutdown->run;
170   
171    BarnOwl::shutdown() if *BarnOwl::shutdown{CODE};
172}
173
174sub _receive_msg {
175    my $m = shift;
176
177    $receiveMessage->run($m);
178   
179    BarnOwl::receive_msg($m) if *BarnOwl::receive_msg{CODE};
180}
181
182sub _new_msg {
183    my $m = shift;
184
185    $newMessage->run($m);
186   
187    BarnOwl::new_msg($m) if *BarnOwl::new_msg{CODE};
188}
189
190sub _mainloop_hook {
191    $mainLoop->run;
192    BarnOwl::mainloop_hook() if *BarnOwl::mainloop_hook{CODE};
193}
194
195sub _get_blist {
196    my @results = grep defined, $getBuddyList->run;
197    s/^\s+|\s+$//sg for (@results);
198    return join("\n", grep {length($_)} @results);
199}
200
201sub _get_quickstart {
202    return join("\n", $getQuickstart->run);
203}
204
205sub _new_command {
206    my $command = shift;
207    (my $symbol = $command) =~ s/-/_/g;
208    my $package = "BarnOwl";
209
210
211    if(!contains(\@BarnOwl::all_commands, $command)) {
212        push @BarnOwl::all_commands, $command;
213    }
214
215    if($symbol =~ m{^edit:(.+)$}) {
216        $symbol = $1;
217        $package = "BarnOwl::Editwin";
218    } else {
219        $symbol =~ s/:/_/;
220    }
221    {
222        no strict 'refs';
223        if(defined(*{"${package}::${symbol}"}{CODE})) {
224            return;
225        }
226        *{"${package}::${symbol}"} = sub {
227            if(@_ == 1 && $_[0] =~ m{\s}) {
228                carp "DEPRECATED: ${package}::${symbol}: Tokenizing argument on ' '.\n"
229                . "In future versions, the argument list will be passed to\n"
230                . "'$command' directly. Tokenize yourself, or use BarnOwl::command()\n";
231                BarnOwl::command("$command $_[0]");
232            } else {
233                BarnOwl::command($command, @_);
234            }
235          };
236        if(defined(*{"${package}::EXPORT_OK"}{ARRAY})
237          && !contains(*{"${package}::EXPORT_OK"}{ARRAY}, $symbol)) {
238            push @{*{"${package}::EXPORT_OK"}{ARRAY}}, $symbol;
239        }
240    }
241}
242
243sub contains {
244    my $list = shift;
245    my $what = shift;
246    return defined(first {$_ eq $what} @$list);
247}
248
2491;
Note: See TracBrowser for help on using the repository browser.