29a9ad3f90
Source DBD files can include Pod blocks, as long as the dbdExpand.pl script doesn't try and include it in expanded DBD output files. This makes it easier to write the Pod, and perldoc can parse most of the result for checking (it complains about the =field directives though, which dbdToHtml.pl handles itself).
86 lines
2.1 KiB
Perl
86 lines
2.1 KiB
Perl
package DBD::Menu;
|
|
use DBD::Base;
|
|
@ISA = qw(DBD::Base);
|
|
|
|
sub init {
|
|
my ($this, $name) = @_;
|
|
$this->SUPER::init($name, "menu");
|
|
$this->{CHOICE_LIST} = [];
|
|
$this->{CHOICE_INDEX} = {};
|
|
$this->{COMMENTS} = [];
|
|
return $this;
|
|
}
|
|
|
|
sub add_choice {
|
|
my ($this, $name, $value) = @_;
|
|
$name = identifier($name, "Choice name");
|
|
unquote $value;
|
|
foreach $pair ($this->choices) {
|
|
dieContext("Duplicate menu choice name '$name'")
|
|
if ($pair->[0] eq $name);
|
|
dieContext("Duplicate menu choice string '$value'")
|
|
if ($pair->[1] eq $value);
|
|
}
|
|
push @{$this->{CHOICE_LIST}}, [$name, $value];
|
|
$this->{CHOICE_INDEX}->{$value} = $name;
|
|
}
|
|
|
|
sub choices {
|
|
return @{shift->{CHOICE_LIST}};
|
|
}
|
|
|
|
sub choice {
|
|
my ($this, $idx) = @_;
|
|
return $this->{CHOICE_LIST}[$idx];
|
|
}
|
|
|
|
sub legal_choice {
|
|
my ($this, $value) = @_;
|
|
unquote $value;
|
|
return exists $this->{CHOICE_INDEX}->{$value};
|
|
}
|
|
|
|
sub add_comment {
|
|
my $this = shift;
|
|
push @{$this->{COMMENTS}}, @_;
|
|
}
|
|
|
|
sub comments {
|
|
return @{shift->{COMMENTS}};
|
|
}
|
|
|
|
sub equals {
|
|
my ($a, $b) = @_;
|
|
return $a->SUPER::equals($b)
|
|
&& join(',', map "$_->[0]:$_->[1]", @{$a->{CHOICE_LIST}})
|
|
eq join(',', map "$_->[0]:$_->[1]", @{$b->{CHOICE_LIST}});
|
|
}
|
|
|
|
sub toDeclaration {
|
|
my $this = shift;
|
|
my $name = $this->name;
|
|
my @choices = map {
|
|
sprintf " %-31s /* %s */", @{$_}[0], escapeCcomment(@{$_}[1]);
|
|
} $this->choices;
|
|
return "typedef enum {\n" .
|
|
join(",\n", @choices) .
|
|
",\n ${name}_NUM_CHOICES\n" .
|
|
"} $name;\n\n";
|
|
}
|
|
|
|
sub toDefinition {
|
|
my $this = shift;
|
|
my $name = $this->name;
|
|
my @strings = map {
|
|
"\t\"" . escapeCstring(@{$_}[1]) . "\""
|
|
} $this->choices;
|
|
return "static const char * const ${name}ChoiceStrings[] = {\n" .
|
|
join(",\n", @strings) . "\n};\n" .
|
|
"const dbMenu ${name}MenuMetaData = {\n" .
|
|
"\t\"" . escapeCstring($name) . "\",\n" .
|
|
"\t${name}_NUM_CHOICES,\n" .
|
|
"\t${name}ChoiceStrings\n};\n\n";
|
|
}
|
|
|
|
1;
|