sc: lotv patch v5.0.13 (2024-03-26)

[sheet.git] / Shiar_Sheet / Keyboard.pm

diff --git a/Shiar_Sheet/Keyboard.pm b/Shiar_Sheet/Keyboard.pm
index d4f78c8e7a86125a0c0e525bdd62ac8a928b841e..4d1c54eba23fb71f309ace67ecfa14572feeb19d 100644 (file)
--- a/Shiar_Sheet/Keyboard.pm
+++ b/Shiar_Sheet/Keyboard.pm
@@ -6,7 +6,7 @@ use warnings;
 no  warnings 'uninitialized';  # save some useless checks for more legible code
 use Carp;
 
 no  warnings 'uninitialized';  # save some useless checks for more legible code
 use Carp;
 

-our $VERSION = '2.09';
+our $VERSION = '3.01';

 
 my @casedesc = (undef, qw/shift ctrl meta/, 'shift meta');
 my @rowdesc = qw(numeric top home bottom);
 
 my @casedesc = (undef, qw/shift ctrl meta/, 'shift meta');
 my @rowdesc = qw(numeric top home bottom);


@@ -56,6 +56,7 @@ sub escapeclass {
        s/\+/_m/g;
        s/\[/_sbo/g;
        s/\]/_sbc/g;
        s/\+/_m/g;
        s/\[/_sbo/g;
        s/\]/_sbc/g;

+       s/\\/_b/g;

        s/^$/_/;
        return $_;
 }
        s/^$/_/;
        return $_;
 }


@@ -79,12 +80,13 @@ sub keyunalias {
        my $self = shift;
        my ($key, $ancestry) = @_;
 
        my $self = shift;
        my ($key, $ancestry) = @_;
 

-       $key =~ s/(\S*?)(\+?\^?\S)($|\s.*)/$2/;
+       $key =~ s/(\S*?)(\+?\^?\S$)/$2/;

        my $mode = $1;
        my $keyinfo = $self->{def}->{$mode}->{$key};
 
        return unless defined $keyinfo;
        my $mode = $1;
        my $keyinfo = $self->{def}->{$mode}->{$key};
 
        return unless defined $keyinfo;

-       $keyinfo =~ s/^=// or return $keyinfo;
+       return $keyinfo unless ref $keyinfo eq 'SCALAR';
+       $keyinfo = ${$keyinfo};

        return '' if $ancestry->{$key}++;  # endless loop failsafe
        return $self->keyunalias($keyinfo, $ancestry);
 }
        return '' if $ancestry->{$key}++;  # endless loop failsafe
        return $self->keyunalias($keyinfo, $ancestry);
 }


@@ -104,32 +106,44 @@ sub print_letter {
 
 sub print_key {
        my $self = shift;
 
 sub print_key {
        my $self = shift;

-       my ($mode, $key, $flags) = @_;
-       my ($desc, $mnem);
+       my ($mode, $key, $def) = @_;

 
 

-       if (not defined $flags) {
-               $flags = $key eq '^0' ? 'ni' : 'no';
+       if (not defined $def) {
+               $def = [$key eq '^0' ? 'ni' : 'no'];

        }
        }

-       elsif ($flags =~ s/^=(\S+)\s?//) { # alias
-               my $ref = $1;
-               $desc = $self->{sign}->{alias} . ($ref eq "\e" ? 'esc' : $ref);
-               $flags = join ' ', $self->keyunalias($ref), 'alias', $flags;
+       elsif (ref $def eq 'SCALAR') {
+               $def = [undef, $def];

        }
        }

-       if (my $txt = $self->{key}->{$mode.$key}) {
-               ($desc, $mnem) = split /\n/, $self->escapedesc($txt);
+       if (ref $def ne 'ARRAY') {
+               carp "print_key: invalid definition for $mode$key: $def";
+               return;

        }
        }

+       my ($flags, $txt) = @{$def};
+       if (ref $txt eq 'SCALAR') {
+               my $ref = ${$txt};
+               $def = $self->keyunalias($ref);
+               $ref = 'esc' if $ref eq "\e";
+               $flags //= $def->[0] if ref $def eq 'ARRAY';
+               $txt = $self->{sign}->{alias} . $ref;
+               $flags .= ' alias';
+       }
+       my ($desc, $mnem) = split /\n/, $self->escapedesc($txt);

 
 

+       my $onclick = $flags =~ s/ ?\bmode(\S*)// && defined $self->{def}{$1} && sprintf(
+               ' onclick="setmode(%s)"',
+               $1 eq '' ? '' : sprintf(q{'mode%s'}, escapeclass($1))
+       );
+       my $keyhint = defined($mnem) && qq{ title="$mnem"};
+       if ($self->{tableclass} =~ /\bbig\b/) {
+               $onclick .= $keyhint;
+               $keyhint = '';
+       }

        my $keytxt = $self->print_letter($key, $mode);
           $keytxt .= "<small>$self->{sign}->{motion}</small>" if $flags =~ s/ ?\bargm\b//;  # motion argument
           $keytxt .= $self->{sign}->{$1} while $flags =~ s/(?:^| )(arg[a-ln-z]?)\b//;  # arguments
        my $keytxt = $self->print_letter($key, $mode);
           $keytxt .= "<small>$self->{sign}->{motion}</small>" if $flags =~ s/ ?\bargm\b//;  # motion argument
           $keytxt .= $self->{sign}->{$1} while $flags =~ s/(?:^| )(arg[a-ln-z]?)\b//;  # arguments

-       my $keyhint = defined($mnem) && qq{ title="$mnem"};

           $keytxt  = "<b$keyhint>$keytxt</b>";
           $keytxt .= ' '.$desc if defined $desc;
           $keytxt = qq{<a href="/$1">$keytxt</a>} if $flags =~ s/ ?\blink(\S*)//;
           $keytxt  = "<b$keyhint>$keytxt</b>";
           $keytxt .= ' '.$desc if defined $desc;
           $keytxt = qq{<a href="/$1">$keytxt</a>} if $flags =~ s/ ?\blink(\S*)//;

-       my $onclick = $flags =~ s/ ?\bmode(\S*)// && defined $self->{def}{$1} && sprintf(
-               ' onclick="setmode(%s)"',
-               $1 eq '' ? '' : sprintf(q{'mode%s'}, escapeclass($1))
-       );

        $flags =~ s/\bx\w+/ext/;
        $flags =~ s/\bv\d+/new/;
        $flags .= ' chr'.ord(substr $key, -1) if $key ne '^0';
        $flags =~ s/\bx\w+/ext/;
        $flags =~ s/\bv\d+/new/;
        $flags .= ' chr'.ord(substr $key, -1) if $key ne '^0';


@@ -149,7 +163,7 @@ sub print_rows {
        );
        my @modes = sort keys %{ $self->{def} };
 
        );
        my @modes = sort keys %{ $self->{def} };
 

-       print '<table id="rows" class="keys">'."\n\n";
+       printf '<table id="rows" class="%s">'."\n\n", $self->{tableclass} // 'keys';

 
 print_row:
        for (my $row = -1; $row <= $#{ $keyrows{$self->{map}} }; $row++) {
 
 print_row:
        for (my $row = -1; $row <= $#{ $keyrows{$self->{map}} }; $row++) {


@@ -206,7 +220,7 @@ sub print_legend {
        my ($class, $flags) = @_;
 
        say qq{\t\t<dl class="legend $class">};
        my ($class, $flags) = @_;
 
        say qq{\t\t<dl class="legend $class">};

-       printf("\t\t".'<dt class="%s">%s'."\n\t\t\t".'<dd>%s'."\n",
+       printf("\t\t".'<dt class="%s">%s'."\n\t\t\t".'<dd>%s</dd>'."\n",

                $_, map { $self->escapedesc($_) } @{ $self->{flag}->{$_} || ["($_)", '...'] }
        ) for @$flags;
        say "\t\t</dl>";
                $_, map { $self->escapedesc($_) } @{ $self->{flag}->{$_} || ["($_)", '...'] }
        ) for @$flags;
        say "\t\t</dl>";


@@ -225,13 +239,10 @@ Shiar_Sheet::Keyboard - Output HTML for key sheets
        my $keys = Shiar_Sheet::Keyboard({
                def => {
                        'lead' => {
        my $keys = Shiar_Sheet::Keyboard({
                def => {
                        'lead' => {

-                               'A' => '=a', # alias
-                               'a' => 'classes',
+                               'A' => \'a', # alias
+                               'a' => ['classes', 'description', 'hover comments'],

                        },
                },
                        },
                },

-               key => {
-                       'leada' => ['description', 'comments (on hover)'],
-               },

                mode => {
                        'lead' => 'mode description',
                },
                mode => {
                        'lead' => 'mode description',
                },


@@ -242,7 +253,7 @@ Shiar_Sheet::Keyboard - Output HTML for key sheets
 
 =head1 DESCRIPTION
 
 
 =head1 DESCRIPTION
 

-Used by http://sheet.shiar.nl to display keyboard sheets.
+Used by https://sheet.shiar.nl to display keyboard sheets.

 Assumes specific stylesheets and javascript from this site,
 so probably not of much use elsewhere.
 
 Assumes specific stylesheets and javascript from this site,
 so probably not of much use elsewhere.