ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/server/ext/help.ext
Revision: 1.23
Committed: Mon Nov 26 13:12:16 2012 UTC (11 years, 5 months ago) by root
Branch: MAIN
CVS Tags: rel-3_1, HEAD
Changes since 1.22: +12 -1 lines
Log Message:
order commands by preference

File Contents

# Content
1 #! perl # mandatory depends=doclet
2
3 our $TOPIC;
4 our %DOCLET;
5
6 our $HELP_CHANNEL = {
7 id => "help",
8 title => "Help",
9 reply => "help ",
10 tooltip => "Online Help",
11 };
12
13 # these commands should be preferred by the client completer
14 # we put them first in their own face.
15 our @PREFERRED = qw(chat say shout tell);
16
17 # considerable duplication between load_doclets and load_topics
18 sub load_doclets {
19 %DOCLET = ();
20
21 my %command_list;
22 my %preferred = map { $_ => undef } @PREFERRED;
23
24 for (
25 [standard => "command_help"],
26 [emote => "emote_help"],
27 [dm => "dmcommand_help"],
28 ) {
29 my ($type, $path) = @$_;
30
31 my $paragraphs = cf::pod::load_pod "$PODDIR/$path.pod"
32 or die "unable to load $path";
33
34 my $level = 1e9;
35 my $rpar;
36
37 for my $par (@$paragraphs) {
38 if ($par->{type} eq "head2") {
39 # this code taken almost verbatim from DC/Protocol.pm
40
41 if ($par->{markup} =~ /^(\S+) (?:\s+ \( ([^\)]*) \) )?/x) {
42 my $cmd = $1;
43 my @args = split /\|/, $2;
44 @args = (".*") unless @args;
45
46 $_ = $_ eq ".*" ? "" : " $_"
47 for @args;
48
49 my @variants = map "$cmd$_", sort { (length $a) <=> (length $b) } @args;
50
51 $rpar = \($DOCLET{$cmd} = &cf::pod::as_cfpod ([$par]));
52
53 push @{ $command_list{$type} }, @variants;
54 $level = $par->{level};
55 } else {
56 cf::error "$par->{markup}: unparsable command heading";
57 }
58 } elsif ($par->{level} > $level) {
59 $$rpar .= &cf::pod::as_cfpod ([$par]);
60 }
61
62 cf::cede_to_tick;
63 }
64 }
65
66 cf::cede_to_tick;
67
68 @$_ = grep !exists $preferred{$_}, @$_
69 for values %command_list;
70
71 $command_list{preferred} = \@PREFERRED;
72
73 while (my ($k, $v) = each %command_list) {
74 cf::cede_to_tick;
75 cf::client::set_command_face $k, $v;
76 }
77 }
78
79 our $DOCLET_HANDLER = ext::doclet::register command => sub {
80 my ($pl, $category, $command) = @_;
81
82 if ($command =~ /^(cast|invoke)\s+(.*)$/) { # not used currently
83 my ($cmd, $arg) = ($1, $2);
84 (ext::doclet::doclet $pl, command => $cmd)
85 . (ext::doclet::doclet $pl, spell => $arg)
86 } elsif ($command =~ /^(ready_skill|use_skill)\s+(.*)$/) {
87 my ($cmd, $arg) = ($1, $2);
88 (ext::doclet::doclet $pl, command => $cmd)
89 . (ext::doclet::doclet $pl, skill => $arg)
90 } else {
91 my $guard = cf::lock_acquire "ext::help::loading";
92
93 $DOCLET{$command}
94 || "B<No documentation available for '$category/$command'>"
95 }
96 };
97
98 sub load_topics($$) {
99 my ($type, $path) = @_;
100
101 my $paragraphs = cf::pod::load_pod "$PODDIR/$path.pod"
102 or die "unable to load $path";
103
104 my @topics;
105 my $level = 1e9;
106
107 for my $par (@$paragraphs) {
108 cf::cede_to_tick;
109 if ($par->{type} eq "head2") {
110 if ($par->{markup} =~ /^(\S+)/) {
111 push @topics, $1 => [$type => $par];
112 $level = $par->{level};
113 }
114 } elsif ($par->{level} > $level) {
115 push @{ $topics[-1] }, $par;
116 }
117 }
118
119 @topics
120 }
121
122 sub reload() {
123 my $guard1 = cf::lock_acquire "ext::help::loading";
124 my $guard2 = cf::lock_acquire "ext::resource";
125
126 local $Coro::current->{desc} = "help loader";
127
128 $TOPIC = {
129 (load_topics "DM Commands" => "dmcommand_help"),
130 (load_topics "Emotes" => "emote_help"),
131 (load_topics "Commands" => "command_help"),
132 (load_topics "Generic Help Topics" => "generic_help"),
133 };
134
135 load_doclets;
136
137 ()
138 }
139
140 cf::post_init {
141 cf::async_ext { reload };
142 Coro::cede; # make sure reload acquires the lock(s)
143 };
144
145 cf::register_command help => sub {
146 my ($pl, $topic) = @_;
147
148 if (cf::lock_active "ext::help::loading") {
149 $pl->send_msg ($HELP_CHANNEL => "help files are being loaded currently, try again in a few seconds.", cf::NDI_REPLY | cf::NDI_CLEAR);
150 return;
151 }
152
153 $topic = $1 if $topic =~ /(\S+)/;
154
155 if (!length $topic) {
156 # sort..
157
158 my %topics;
159 while (my ($k, $v) = each %$TOPIC) {
160 push @{$topics{$v->[0]}}, $k;
161 }
162
163 my $res;
164 while (my ($k, $v) = each %topics) {
165 $res .= "T<$k:>\n\n" . (join " ", sort @$v) . "\n\n";
166 }
167
168 $pl->send_msg ($HELP_CHANNEL => $res, cf::NDI_REPLY | cf::NDI_CLEAR);
169
170 } elsif (my $item = $TOPIC->{$topic}) {
171 my ($type, @pars) = @$item;
172 $pl->send_msg ($HELP_CHANNEL => (cf::pod::as_cfpod \@pars), cf::NDI_REPLY | cf::NDI_CLEAR);
173
174 } else {
175 $pl->send_msg ($HELP_CHANNEL => "'$topic' no such help topic, try just 'help' to get a list of topics.", cf::NDI_REPLY);
176 }
177 };
178