shell: feature comparison table from uniq-faq

[sheet.git] / shell.plp

diff --git a/shell.plp b/shell.plp
new file mode 100644 (file)
index 0000000..85ababa
--- /dev/null
+++ b/shell.plp
@@ -0,0 +1,78 @@
+<(common.inc.plp)><:
+use List::Util qw(sum max first);
+
+Html({
+       title => 'Shell compatibility cheat sheet',
+       version => '1.0',
+       stylesheet => [qw'circus dark mono red light'],
+       data => ['shell.inc.pl'],
+});
+
+say "<h1>Shell compatibility</h1>\n";
+
+my $data = do 'shell.inc.pl' or die $@ || $!;
+my @agents = keys %{ $data->{agents} };
+
+print '<table class="mapped">';
+print '<col>';  # should match first thead row
+printf '<colgroup span="%d">', 1 for @agents;
+say '</colgroup><col>';
+
+my $header = join('',
+       '<tr>',
+       '<th>feature',
+       (map {
+               sprintf('<th>%s', Entity($_->{name}))
+       } @{ $data->{agents} }{@agents}),
+);
+print '<thead>', $header;
+say '</thead>';
+say '<tfoot>', $header;
+
+sub saytitlecol {
+       my ($row) = @_;
+       print '<td>', Entity($row->{title});
+}
+
+my %DSTATS = (
+       Y => 'feature can be done',
+       N => 'feature is not present',
+       F => 'feature can only be done by using the shells function mechanism',
+       L => 'the readline library must be linked into the shell to enable this feature',
+);
+my %CSTATS = (
+       N => 'l1',
+       F => 'l2',
+       L => 'l4',
+       Y => 'l5',
+);
+
+sub saysupportcols {
+       my ($row, $agent) = @_;
+       my $stat = $row->{support}->{$agent};
+       my $title = join(' ',
+               $DSTATS{$stat} // 'unknown support',
+               'in', $agent,
+       );
+       printf('<td class="%s" title="%s">%s',
+               join(' ',
+                       X => $CSTATS{$stat},
+               ),
+               $title,
+               $stat,
+       );
+}
+
+say '<tbody>';
+for my $row (sort {
+       $a->{title} cmp $b->{title}
+} @{ $data->{feature} }) {
+       (my $id = lc $row->{title}) =~ s/\W+/-/g;
+       printf '<tr id="%s">', $id;
+       saytitlecol($row);
+       saysupportcols($row, $_) for @agents;
+       say '</tr>';
+}
+say '</tbody>';
+say '</table>';
+