diff options
Diffstat (limited to 'konsole/doc/VT100/genTC.pl')
| -rwxr-xr-x | konsole/doc/VT100/genTC.pl | 434 |
1 files changed, 434 insertions, 0 deletions
diff --git a/konsole/doc/VT100/genTC.pl b/konsole/doc/VT100/genTC.pl new file mode 100755 index 000000000..a3a7c5669 --- /dev/null +++ b/konsole/doc/VT100/genTC.pl @@ -0,0 +1,434 @@ +#!/usr/bin/perl -w +use strict; + +my $source = "Table.Codes"; + +my $html = 1; +my $test = 0; + +# Syntax ----------------------------------------------------------------------- +# +# Dotted.Name Text +# Dotted.Name +# Text +# Lines +# +# The dotted names have to be unique. Conceptually, they form a tree. +# + +# Data Model ------------------------------------------------------------------ + +# This is currently pretty wierd. +# +# Empirically, we have +# +# NAME.head <Title Line> +# NAME.attr { lots ... } +# NAME.dflt Value ... +# NAME.code <Typ>|<Ide>|<Parm> +# NAME.text +# <text with some special tricks> +# NAME.table.TAB +# <"|"-separated head line> +# <"|"-separated data rows> +# +# Section.html +# <html-text> +# +# TABs +# - .XPS, used for instructions with subcodes +# Subcode|Emulation|Scope|Operation|Parameter|Meaning + +# ----------------------------------------------------------------------------- +# ----------------------------------------------------------------------------- +# Analyze Source -------------------------------------------------------------- +# ----------------------------------------------------------------------------- +# ----------------------------------------------------------------------------- + +my $all = {}; + +my $state = 0; +my $name = ''; +my $value = ''; + +sub parse +{ + sub chkstate + { my ($expect,$lineno,$line) = @_; + if ($state != $expect) + { + print STDERR "$source($lineno): line unexpected in state $state. : $line\n"; + } + } + + sub reduce + { + $all->{$name} = $value; + $state = 0; + $value = ''; + } + + open(CODES, $source) || die "cannot open file '" . $source . "'."; + while (<CODES>) + { + chop; # strip record separator + my @Fld = split(' ', $_); + + if ($#Fld == -1) + { + reduce() if $state != 0; + } + elsif (substr($_, 0, 1) eq '#') + { + ; #ignore + } + elsif (substr($_, 0, 1) eq ' ') + { &chkstate(1,$.,$_); + $value .= ($value eq "" ? "" : "\n") . $_; #FIXME: unchop + } + else + { + reduce() if $state != 0; + $name = $Fld[0]; + if ($#Fld == 0) + { + $state = 1; + } + else + { + $value = join ' ', @Fld[1..$#Fld]; + reduce(); + } + } + } + reduce() if ($state == 1); + chkstate(0,$.,$_); + + return $all; +} + +# ----------------------------------------------------------------------------- +# ----------------------------------------------------------------------------- +# Html Layout ----------------------------------------------------------------- +# ----------------------------------------------------------------------------- +# ----------------------------------------------------------------------------- + +sub head +{ + if ($html) + { + print "<table>\n"; + print "<tr><td width=10%%><td><td><td><td><td><td width=40%%>\n"; + } +} + +sub tail +{ + if ($html) + { + print "</table>\n"; + } +} + +my $color1 = " bgcolor=\"#D0D0D0\""; # table head // section head +my $color2 = " bgcolor=\"#5BA5B2\""; # table body (even) +my $color3 = " bgcolor=\"#5188B2\""; # table body (odd) +my $color4 = ""; # code, default +my $color5 = ""; # text + +sub txt2Html +{ + my ($Doku) = @_; + $_ = $Doku; + s/</</g; + s/>/>/g; + s/\\ref:([A-Z0-9]+)/<a href=#$1>$1<\/a>/g; + s/\n \.\n/\n <p>\n/g; + return $_; +} + +sub layout +{ my ($Name, $Head, $Code, $Doku, $Dflt, $Attr) = @_; + if ($html) + { + + print "<tr><td><p></td></tr>\n"; + + print "<tr><td $color1><a name=$Name>$Name</a>\n"; + if ($Attr eq '') + { + print " <td $color1 colspan=6><b>$Head</b>\n"; + } + else + { + print " <td colspan=5 $color1><b>$Head</b>\n"; + print " <td $color1>$Attr\n"; + } + + if ($Code ne '') + { + my @Part = split('\|',$Code); + my $Type = $Part[0]; + my $Indi = $#Part > 0 ? $Part[1] : ""; + my $Parm = $#Part > 1 ? $Part[2] : ""; + $Code = $Parm if $Type eq 'PRN'; + $Code = $Indi if $Type eq 'CTL'; + $Code = "ESC $Indi" if $Type eq 'ESC'; + $Code = "0x7f" if $Type eq 'DEL'; + $Code = "ESC # $Indi" if $Type eq 'HSH'; + $Code = "ESC $Parm" if $Type eq 'SCS'; + $Code = "ESC Y $Parm" if $Type eq 'VT5'; + $Code = "ESC [ $Parm $Indi" if $Type eq 'CSI'; + $Code = "ESC [ ? $Parm $Indi" if $Type eq 'PRI'; + print "<tr><td><p></td>\n"; + print "<tr><td>\n"; + print " <td colspan=5 $color4>", codeToHtml($Code), "\n"; + print " <td $color4>Default: $Dflt\n" if ($Dflt ne ''); + } + + print "<tr><td><p></td>\n"; + print "<tr><td></td>\n"; +# $_ = $Doku; +# s/</</g; +# s/>/>/g; +# s/\\ref:([A-Z0-9]+)/<a href=#$1>$1<\/a>/g; +# s/\n \.\n/\n <p>\n/g; + print " <td $color5 colspan=6>"; + print txt2Html($Doku); + print "\n"; + } + if ($test) + { + print "NAME: $Name\n"; + print "TEXT: $Head\n"; + print "CODE: $Code\n"; + print "ATTR: $Attr\n"; + print "DFLT: $Dflt\n"; + # print "DOCU: $Doku\n"; + } +} + +sub codeToHtml +{ my ($code) = @_; + my $res = '<code>'; + foreach (split(' ', $code)) + { + /^\{(.*)\}$/ && do { $res .= " <em>$1</em>"; next; }; + /^<$/ && do { $res .= ' <b><</b>'; next; }; + /^>$/ && do { $res .= ' <b>></b>'; next; }; + $res .= " <b>$_</b>"; + } + return $res . '</code>'; +} + +# ----------------------------------------------------------------------------- + +sub secthead +{ my ($Title) = @_; +print "<h2>\n"; +print "<table width=100%>\n"; +print "<tr><td align=center bgcolor=#d0d0d0></td></tr>\n"; +print "<tr><td align=center bgcolor=#d0d0d0>$Title</td></tr>\n"; +print "<tr><td align=center bgcolor=#d0d0d0></td></tr>\n"; +print "</table>\n"; +print "</h2>\n"; +} + +sub layout2 +{ my ($Name, $Head, $Code) = @_; + my @Part = split('\|',$Code); + my $Type = $#Part > -1 ? $Part[0] : ""; + my $Indi = $#Part > 0 ? $Part[1] : ""; + my $Parm = $#Part > 1 ? $Part[2] : ""; + if ($Type eq 'CTL') + { + $_ = $Indi; + s/0x00/@/; s/0x01/A/; s/0x02/B/; s/0x03/C/; + s/0x04/D/; s/0x05/E/; s/0x06/F/; s/0x07/G/; + s/0x08/H/; s/0x09/I/; s/0x0a/J/; s/0x0b/K/; + s/0x0c/L/; s/0x0d/M/; s/0x0e/N/; s/0x0f/O/; + s/0x10/P/; s/0x11/Q/; s/0x12/R/; s/0x13/S/; + s/0x14/T/; s/0x15/U/; s/0x16/V/; s/0x17/W/; + s/0x18/X/; s/0x19/Y/; s/0x1a/Z/; s/0x1b/[/; + s/0x1c/\\/; s/0x1d/]/; s/0x1e/^/; s/0x1f/_/; + $Indi = $_; + } + print "<tr>\n"; + print "<td $color1><a href=#$Name>$Name</a>\n"; + print "<td $color1>$Type\n"; + print "<td $color1>$Indi\n"; + print "<td $color1>$Parm\n"; + print "<td $color1>$Head\n"; +} + +sub layoutTable +{ + my ($Head, $t, $Include) = @_; + my $p; +print "<tr><td colspan=5><h3>$Head</h3>\n"; +foreach $p (sort keys %$t) +{ + my @Fld = split('\.', $p); + if ($#Fld == 1 && $Fld[1] eq 'head') + { + my $name = $Fld[0]; + my $head = $t->{$p}; + my $attr = exists $t->{"$name.sect"}?$t->{"$name.sect"}:""; + if ($attr =~ /$Include/) + { + layout2( $name, $head, exists $t->{"$name.code"}?$t->{"$name.code"}:""); + } + } +} +} + +sub sortTest +{ + my ($t) = @_; + my $p; + my $s = {}; + my $n = {}; + my $curr = ""; + foreach $p (keys %$t) + { + my @Fld = split('\.', $p); + if ($#Fld == 1 && $Fld[1] eq 'head') + { + my $name = $Fld[0]; + if (exists $t->{"$name.code"}) + { + $s->{$t->{"$name.code"}} = $name; + } + } + } + print "<table>\n"; + foreach $p (sort keys %$s) + { + my $name = $s->{$p}; + my @Fld = split('\|', $p); + if ($Fld[0] ne $curr) + { + print "<tr><td colspan=5><h3>$Fld[0] codes</h3>\n"; + } + $curr = $Fld[0]; + layout2($name,$t->{"$name.head"},$p); + } + print "</table>\n"; +} + +sub htmlsect +{ + my ($h) = @_; + $_ = $all->{"$h.html"}; + s/\n \.\n/\n <p>\n/g; + print "$_\n"; +} + +# ----------------------------------------------------------------------------- +# ----------------------------------------------------------------------------- +# MAIN ------------------------------------------------------------------------ +# ----------------------------------------------------------------------------- +# ----------------------------------------------------------------------------- + +my $t = parse(); +my $p; +my $table = 0; + +# ------------------------------- +htmlsect("Introduction"); +# ------------------------------- +secthead("Control Sequences"); +htmlsect("Sequences"); +# ------------------------------- +secthead("Host to Terminal (Instructions by Code)"); +sortTest($t); +# ------------------------------- +secthead("Host to Terminal (Instructions by Group)"); +htmlsect("Operations"); +print "<table>\n"; +layoutTable("Commands (Character Display Operation)",$t,"Command\.Display"); +layoutTable("Commands (Rendition related status)",$t,"Command\.RenderMode"); +layoutTable("Commands (Cursor)",$t,"Command\.Cursor"); +layoutTable("Commands (Cursor related status)",$t,"Command\.CursMode"); +layoutTable("Commands (Edit)",$t,"Command\.Erase|Command\.Insert|Command.\Delete"); +layoutTable("Commands (Miscellaneous)",$t,"Command[^.]|Command\$"); +layoutTable("Commands (General mode setting)",$t,"Command\.SetMode"); +layoutTable("Commands (Miscellaneous status)",$t,"Command\.Mode"); +layoutTable("Commands (VT52)",$t,"Command\.VT52"); +layoutTable("Commands (Not implemented)",$t,"Command\.NoImp"); +layoutTable("Commands (Ignored)",$t,"Command\.Ignored"); +layoutTable("Commands (Requests)",$t,"Command\.Request"); +print "</table>\n"; +# ------------------------------- +secthead("Terminal to Host"); +print "<table>\n"; +layoutTable("Replies",$t,"Reply"); +layoutTable("Events",$t,"Event"); +# ------------------------------- +print "</table>\n"; +secthead("Modes"); +print "<table>\n"; +layoutTable("Modes",$t,"Mode"); +#print "<h3>Other Codes</h3>\n"; +print "</table>\n"; +# ------------------------------- +secthead("Appendix A - Notion Details"); +htmlsect("ConceptDB"); +# ------------------------------- + +head(); +foreach $p (sort keys %$t) +{ + my @Fld = split('\.', $p); + if ($#Fld == 1 && $Fld[1] eq 'head') + { +# print "</table>\n" if ($table); + my $name = $Fld[0]; + my $head = $t->{$p}; + layout( $name, $head, + exists $t->{"$name.code"}?$t->{"$name.code"}:"", + exists $t->{"$name.text"}?$t->{"$name.text"}:"", + exists $t->{"$name.dflt"}?$t->{"$name.dflt"}:"", + exists $t->{"$name.emus"}?$t->{"$name.emus"}:"" ); + $table = 0; + } + if ($html && $#Fld == 2 && $Fld[1] eq 'table') + { + my $lines = $t->{$p}; + my $line; + my $field; + my @fldspan = (); + my $ln = 0; + print "<tr><td><p></td></tr>\n"; +# print "<tr><td $color1>$Fld[2]</td><td $color1>Meaning</td></tr>\n"; + foreach $line (split('\n', $lines)) + { + my $fn = 0; + @fldspan = split('\|',$line) if ($ln == 0); + print "<tr>\n"; + print "<td></td>\n"; + foreach $field (split('\|',$line)) + { + if ($ln == 0) + { + my @Parts = split(":",$field); + $field = $Parts[0]; + $fldspan[$fn] = ($#Parts > 0) ? $Parts[1] : 1; + } + print "<td"; + printf(" colspan=%s",$fldspan[$fn]); + print " $color1" if ($ln == 0); + print " $color2" if ($ln > 0 && $ln % 2 == 0); + print " $color3" if ($ln > 0 && $ln % 2 == 1); + print ">"; + print txt2Html($field); + print "</td>"; + $fn += 1; + } + print "</tr>\n"; + $ln += 1; + } + $table = 1; + } +} +tail(); |