git.shiar.nl / sheet.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
sitemap: prefer https protocol for absolute site references
[sheet.git] / Shiar_Sheet / Keyboard.pm
diff --git a/Shiar_Sheet/Keyboard.pm b/Shiar_Sheet/Keyboard.pm
index aecd0bc9773a04dd4a3eb3a2b57127f778d7dc04..c7e455b353616b10d7780c963c02c618cfba8e20 100644 (file)
--- a/Shiar_Sheet/Keyboard.pm
+++ b/Shiar_Sheet/Keyboard.pm
@@ -1,11 +1,12 @@
 package Shiar_Sheet::Keyboard;
 
 package Shiar_Sheet::Keyboard;
 
+use 5.010;
 use strict;
 use warnings;
 no  warnings 'uninitialized';  # save some useless checks for more legible code
 use Carp;
 
 use strict;
 use warnings;
 no  warnings 'uninitialized';  # save some useless checks for more legible code
 use Carp;
 
-our $VERSION = 'v2.03';
+our $VERSION = '2.10';
 
 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);
@@ -13,12 +14,12 @@ my %keyrows = do 'keys.inc.pl';
 # add first two cases of each row again with each char prepended by + (alt)
 push @$_, map { [map {"+$_"} @$_] } @$_[0,1] for map {@$_} values %keyrows;
 
 # add first two cases of each row again with each char prepended by + (alt)
 push @$_, map { [map {"+$_"} @$_] } @$_[0,1] for map {@$_} values %keyrows;
 
-my %keytrans = qw(
-       ^@ NUL ^a SOH ^b STX ^c ETX  ^d EOT ^e ENQ ^f ACK ^g BEL
-       ^h BS  ^i tab ^j LF  ^k VT   ^l FF  ^m CR  ^n SO  ^o SI
-       ^p DLE ^q DC1 ^r DC2 ^s DC3  ^t DC4 ^u NAK ^v SYN ^w ETB
-       ^x CAN ^y EM  ^z SUB ^[ ESC  ^\ FS  ^] GS  ^^ RS  ^_ US
-       ^? DEL
+my %keytrans = (
+       '^h' => "\x{232B}", # BS
+       '^i' => "\x{21E5}", # TAB
+       '^m' => "\x{21B5}", # CR
+       '^?' => "\x{2326}", # DEL
+       '^[' => "\x{238B}", # ESC
 );
 
 sub new {
 );
 
 sub new {
@@ -31,10 +32,13 @@ sub new {
 
        $self->{sign} ||= do {
                require Shiar_Sheet::KeySigns;
 
        $self->{sign} ||= do {
                require Shiar_Sheet::KeySigns;
-               Shiar_Sheet::KeySigns->VERSION(1.03);
+               Shiar_Sheet::KeySigns->VERSION(1.04);
                \%Shiar_Sheet::KeySigns::sign;
        };
 
                \%Shiar_Sheet::KeySigns::sign;
        };
 
+       $self->{showkeys} = $PLP::Script::showkeys;
+       $self->{style   } = $PLP::Script::style;
+
        bless $self, $class;
 }
 
        bless $self, $class;
 }
 
@@ -52,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 $_;
 }
@@ -64,6 +69,13 @@ sub escapehtml {
        return $_;
 }
 
        return $_;
 }
 
+sub escapedesc {
+       my $self = shift;
+       local $_ = shift;
+       s{ (< ([^>]*) >) }{ $self->{sign}->{$2} // $1 }xeg;
+       return $_;
+}
+
 sub keyunalias {
        my $self = shift;
        my ($key, $ancestry) = @_;
 sub keyunalias {
        my $self = shift;
        my ($key, $ancestry) = @_;
@@ -73,34 +85,44 @@ sub keyunalias {
        my $keyinfo = $self->{def}->{$mode}->{$key};
 
        return unless defined $keyinfo;
        my $keyinfo = $self->{def}->{$mode}->{$key};
 
        return unless defined $keyinfo;
-       return $keyinfo->[0] if ref $keyinfo;
+       $keyinfo =~ s/^=// or return $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);
 }
 
+sub print_letter {
+       my $self = shift;
+       my ($key, $mode) = @_;
+
+       return if $key eq '^0';
+       return 'Esc' if $key eq "\e";
+       return $keytrans{$key} if defined $keytrans{$key};
+       my $html = $self->{def}{$mode}{lead} . escapehtml($key);
+          $html =~ s{\^(?=.)}{<small>^</small>};  # element around ctrl-identifier
+          $html =~ s{\+(?=.)}{<small>+</small>};  # meta
+       return $html;
+}
+
 sub print_key {
        my $self = shift;
        my ($mode, $key, $flags) = @_;
 sub print_key {
        my $self = shift;
        my ($mode, $key, $flags) = @_;
+       my ($desc, $mnem);
 
        if (not defined $flags) {
 
        if (not defined $flags) {
-               $flags = [$key eq '^0' ? 'ni' : 'no'];
+               $flags = $key eq '^0' ? 'ni' : 'no';
        }
        }
-       elsif (not ref $flags) { # alias
-               my $desc = $self->{sign}->{alias};
-               $desc .= $flags eq "\e" ? 'esc' : $flags;
-               $flags = [$self->keyunalias($flags) . ' alias', $desc];
+       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;
        }
        }
-       my ($flags, $desc, $mnem) = @{$flags};
        if (my $txt = $self->{key}->{$mode.$key}) {
        if (my $txt = $self->{key}->{$mode.$key}) {
-               ($desc, $mnem) = split /\n/, $txt;
+               ($desc, $mnem) = split /\n/, $self->escapedesc($txt);
        }
 
        }
 
-#      $key = $keytrans{$key} if defined $keytrans{$key};
-       my $keytxt = $key eq "\e" ? 'Esc' : $self->{def}{$mode}{lead} . escapehtml($key) if $key ne '^0';
-          $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 .= "<small>$self->{sign}->{motion}</small>" if $flags =~ s/ ?\bargm\b//;  # motion argument
-          $keytxt =~ s{\^(?=.)}{<small>^</small>};  # element around ctrl-identifier
-          $keytxt =~ s{\+(?=.)}{<small>+</small>};  # meta
+          $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;
        my $keyhint = defined($mnem) && qq{ title="$mnem"};
           $keytxt  = "<b$keyhint>$keytxt</b>";
           $keytxt .= ' '.$desc if defined $desc;
@@ -109,6 +131,8 @@ sub print_key {
                ' onclick="setmode(%s)"',
                $1 eq '' ? '' : sprintf(q{'mode%s'}, escapeclass($1))
        );
                ' 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';
 
        print qq{\t\t<td class="$flags"$onclick>$keytxt};
        $flags .= ' chr'.ord(substr $key, -1) if $key ne '^0';
 
        print qq{\t\t<td class="$flags"$onclick>$keytxt};
@@ -117,28 +141,35 @@ sub print_key {
 
 sub print_rows {
        my $self = shift;
 
 sub print_rows {
        my $self = shift;
+       my ($rowsspec, $defrows) = @_;
+       $defrows ||= [2, 1, 0];
        my %moderows = (
        my %moderows = (
-               -DEFAULT => !@_ ? '' : split(/(?:\s*([^=\s]*)=\s*)/, shift),
+               -DEFAULT => defined $rowsspec && $rowsspec ne '' &&
+                       split(/\s* ([^=\s]*) = \s*/x, $rowsspec),
                # plus specific mode overrides prefixed by '='
        );
                # plus specific mode overrides prefixed by '='
        );
-       my $defrows = shift || [2, 1, 0];
        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++) {
                my $keyrow = $row < 0 ? [["\e"]] : $keyrows{$self->{map}}->[$row];
 
        for (my $row = -1; $row <= $#{ $keyrows{$self->{map}} }; $row++) {
                my $keyrow = $row < 0 ? [["\e"]] : $keyrows{$self->{map}}->[$row];
 
+#              grep {
+#                      defined $self->{def}->{''}->{$_} or defined $self->{def}->{g}->{$_}
+#              } map { @{$_} } @{$keyrow} or next;
+
                printf qq{<tbody class="row row%d">\n}, $row+1;
                for my $basemode (@modes) {
                        my @moderows = split /\s+/,
                printf qq{<tbody class="row row%d">\n}, $row+1;
                for my $basemode (@modes) {
                        my @moderows = split /\s+/,
-                               $row < 0 ? "0" :
-                               defined $moderows{$basemode} ? $moderows{$basemode} : $moderows{-DEFAULT};
+                               $row < 0 ? '1' : # top row (esc key) always unshifted
+                               $moderows{$basemode} // $moderows{-DEFAULT};
 
                for my $submode (@moderows ? @moderows : '') {
                        my $mode = $basemode . $submode;
 
                for my $submode (@moderows ? @moderows : '') {
                        my $mode = $basemode . $submode;
-                       my @caserows = $mode =~ s/(\d+)(?:-(\d+))?$//
-                               ? (map {$_ - 1} split //, $row == 0 && $2 || $1)  # user override
+                       my @caserows = $mode =~ s/(\d+)(?:-(\d*))?$//
+                               ? (map {$_ - 1} split //, $row == 0 ? $2 // $1 : $1)  # user override
                                : @$defrows;  # default
                        my $modekeys = $self->{def}{$mode};
 
                                : @$defrows;  # default
                        my $modekeys = $self->{def}{$mode};
 
@@ -154,7 +185,7 @@ sub print_rows {
                                        ' class="%s"', join ' ', @caseclass
                                );
                                printf('<th>%s<small>: %s</small></th>', # XXX insert &nbsp; here to fix msie<=6
                                        ' class="%s"', join ' ', @caseclass
                                );
                                printf('<th>%s<small>: %s</small></th>', # XXX insert &nbsp; here to fix msie<=6
-                                               $self->{mode}->{$mode} || "mode $basemode",
+                                               $self->escapedesc($self->{mode}->{$mode} || "mode $basemode"),
                                                "$rowdesc[$row] row $casedesc[$case]"
                                ) unless $row < 0;
                                print "\n";
                                                "$rowdesc[$row] row $casedesc[$case]"
                                ) unless $row < 0;
                                print "\n";
@@ -175,11 +206,11 @@ sub print_legend {
        my $self = shift;
        my ($class, $flags) = @_;
 
        my $self = shift;
        my ($class, $flags) = @_;
 
-       print qq{\t\t<dl class="legend $class">\n};
-       printf("\t\t".'<dt class="%s">%s'."\n\t\t\t".'<dd>%s'."\n",
-               $_, @{ $self->{flag}->{$_} || ["($_)", '...'] }
+       say qq{\t\t<dl class="legend $class">};
+       printf("\t\t".'<dt class="%s">%s'."\n\t\t\t".'<dd>%s</dd>'."\n",
+               $_, map { $self->escapedesc($_) } @{ $self->{flag}->{$_} || ["($_)", '...'] }
        ) for @$flags;
        ) for @$flags;
-       print "\t\t</dl>";
+       say "\t\t</dl>";
 }
 
 1;
 }
 
 1;
@@ -195,8 +226,8 @@ 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',
                        },
                },
                key => {
                        },
                },
                key => {
@@ -212,7 +243,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.
 
sheet.shiar.nl - software cheat sheets