apps/konsole/developer-doc/old-documents/VT100/genTC.pl

   1 #!/usr/bin/perl -w
   2 use strict;
   3
   4 my $source = "Table.Codes";
   5
   6 my $html = 1;
   7 my $test = 0;
   8
   9 # Syntax -----------------------------------------------------------------------
  10 #
  11 # Dotted.Name Text
  12 # Dotted.Name
  13 #   Text
  14 #   Lines
  15 #
  16 # The dotted names have to be unique. Conceptually, they form a tree.
  17 #
  18
  19 # Data Model ------------------------------------------------------------------
  20
  21 # This is currently pretty wierd.
  22 #
  23 # Empirically, we have
  24 #
  25 # NAME.head <Title Line>
  26 # NAME.attr { lots ... }
  27 # NAME.dflt Value ...
  28 # NAME.code <Typ>|<Ide>|<Parm>
  29 # NAME.text
  30 #   <text with some special tricks>
  31 # NAME.table.TAB
  32 #   <"|"-separated head line>
  33 #   <"|"-separated data rows>
  34 #
  35 # Section.html
  36 #   <html-text>
  37 #
  38 # TABs
  39 # - .XPS, used for instructions with subcodes
  40 #   Subcode|Emulation|Scope|Operation|Parameter|Meaning
  41
  42 # -----------------------------------------------------------------------------
  43 # -----------------------------------------------------------------------------
  44 # Analyze Source --------------------------------------------------------------
  45 # -----------------------------------------------------------------------------
  46 # -----------------------------------------------------------------------------
  47
  48 my $all = {};
  49
  50 my $state = 0;
  51 my $name = '';
  52 my $value = '';
  53
  54 sub parse
  55 {
  56   sub chkstate
  57   { my ($expect,$lineno,$line) = @_;
  58     if ($state != $expect)
  59     {
  60       print STDERR "$source($lineno): line unexpected in state $state. : $line\n";
  61     }
  62   }
  63
  64   sub reduce
  65   {
  66     $all->{$name} = $value;
  67     $state = 0;
  68     $value = '';
  69   }
  70
  71   open(CODES, $source) || die "cannot open file '" . $source . "'.";
  72   while (<CODES>)
  73   {
  74     chop;        # strip record separator
  75     my @Fld = split(' ', $_);
  76
  77     if ($#Fld == -1)
  78     {
  79       reduce() if $state != 0;
  80     }
  81     elsif (substr($_, 0, 1) eq '#')
  82     {
  83       ; #ignore
  84     }
  85     elsif (substr($_, 0, 1) eq ' ')
  86     { &chkstate(1,$.,$_);
  87       $value .= ($value eq "" ? "" : "\n") . $_; #FIXME: unchop
  88     }
  89     else
  90     {
  91       reduce() if $state != 0;
  92       $name = $Fld[0];
  93       if ($#Fld == 0)
  94       {
  95         $state = 1;
  96       }
  97       else
  98       {
  99         $value = join ' ', @Fld[1..$#Fld];
 100         reduce();
 101       }
 102     }
 103   }
 104   reduce() if ($state == 1);
 105   chkstate(0,$.,$_);
 106
 107   return $all;
 108 }
 109
 110 # -----------------------------------------------------------------------------
 111 # -----------------------------------------------------------------------------
 112 # Html Layout -----------------------------------------------------------------
 113 # -----------------------------------------------------------------------------
 114 # -----------------------------------------------------------------------------
 115
 116 sub head
 117 {
 118   if ($html)
 119   {
 120     print "<table>\n";
 121     print "<tr><td width=10%%><td><td><td><td><td><td width=40%%>\n";
 122   }
 123 }
 124
 125 sub tail
 126 {
 127   if ($html)
 128   {
 129     print "</table>\n";
 130   }
 131 }
 132
 133 my $color1 = " bgcolor=\"#D0D0D0\""; # table head // section head
 134 my $color2 = " bgcolor=\"#5BA5B2\""; # table body (even)
 135 my $color3 = " bgcolor=\"#5188B2\""; # table body (odd)
 136 my $color4 = ""; # code, default
 137 my $color5 = ""; # text
 138
 139 sub txt2Html
 140 {
 141   my ($Doku) = @_;
 142   $_ = $Doku;
 143   s/</&lt;/g;
 144   s/>/&gt;/g;
 145   s/\\ref:([A-Z0-9]+)/<a href=#$1>$1<\/a>/g;
 146   s/\n  \.\n/\n  <p>\n/g;
 147   return $_;
 148 }
 149
 150 sub layout
 151 { my ($Name, $Head, $Code, $Doku, $Dflt, $Attr) = @_;
 152   if ($html)
 153   {
 154
 155     print "<tr><td><p></td></tr>\n";
 156
 157     print "<tr><td $color1><a name=$Name>$Name</a>\n";
 158     if ($Attr eq '')
 159     {
 160       print "    <td $color1 colspan=6><b>$Head</b>\n";
 161     }
 162     else
 163     {
 164       print "    <td colspan=5 $color1><b>$Head</b>\n";
 165       print "    <td $color1>$Attr\n";
 166     }
 167
 168     if ($Code ne '')
 169     {
 170       my @Part = split('\|',$Code);
 171       my $Type = $Part[0];
 172       my $Indi = $#Part > 0 ? $Part[1] : "";
 173       my $Parm = $#Part > 1 ? $Part[2] : "";
 174       $Code = $Parm                 if $Type eq 'PRN';
 175       $Code = $Indi                 if $Type eq 'CTL';
 176       $Code = "ESC $Indi"           if $Type eq 'ESC';
 177       $Code = "0x7f"                if $Type eq 'DEL';
 178       $Code = "ESC # $Indi"         if $Type eq 'HSH';
 179       $Code = "ESC $Parm"           if $Type eq 'SCS';
 180       $Code = "ESC Y $Parm"         if $Type eq 'VT5';
 181       $Code = "ESC [ $Parm $Indi"   if $Type eq 'CSI';
 182       $Code = "ESC [ ? $Parm $Indi" if $Type eq 'PRI';
 183       print "<tr><td><p></td>\n";
 184       print "<tr><td>\n";
 185       print "    <td colspan=5 $color4>", codeToHtml($Code), "\n";
 186       print "    <td $color4>Default: $Dflt\n" if ($Dflt ne '');
 187     }
 188
 189     print "<tr><td><p></td>\n";
 190     print "<tr><td></td>\n";
 191 #   $_ = $Doku;
 192 #   s/</&lt;/g;
 193 #   s/>/&gt;/g;
 194 #   s/\\ref:([A-Z0-9]+)/<a href=#$1>$1<\/a>/g;
 195 #   s/\n  \.\n/\n  <p>\n/g;
 196     print "    <td $color5 colspan=6>";
 197     print txt2Html($Doku);
 198     print "\n";
 199   }
 200   if ($test)
 201   {
 202     print "NAME: $Name\n";
 203     print "TEXT: $Head\n";
 204     print "CODE: $Code\n";
 205     print "ATTR: $Attr\n";
 206     print "DFLT: $Dflt\n";
 207     # print "DOCU: $Doku\n";
 208   }
 209 }
 210
 211 sub codeToHtml
 212 { my ($code) = @_;
 213   my $res = '<code>';
 214   foreach (split(' ', $code))
 215   {
 216     /^\{(.*)\}$/ && do { $res .= " <em>$1</em>";   next; };
 217     /^<$/        && do { $res .= ' <b>&lt;</b>'; next; };
 218     /^>$/        && do { $res .= ' <b>&gt;</b>'; next; };
 219     $res .= " <b>$_</b>";
 220   }
 221   return $res . '</code>';
 222 }
 223
 224 # -----------------------------------------------------------------------------
 225
 226 sub secthead
 227 { my ($Title) = @_;
 228 print "<h2>\n";
 229 print "<table width=100%>\n";
 230 print "<tr><td align=center bgcolor=#d0d0d0></td></tr>\n";
 231 print "<tr><td align=center bgcolor=#d0d0d0>$Title</td></tr>\n";
 232 print "<tr><td align=center bgcolor=#d0d0d0></td></tr>\n";
 233 print "</table>\n";
 234 print "</h2>\n";
 235 }
 236
 237 sub layout2
 238 { my ($Name, $Head, $Code) = @_;
 239   my @Part = split('\|',$Code);
 240   my $Type = $#Part > -1 ? $Part[0] : "";
 241   my $Indi = $#Part > 0 ? $Part[1] : "";
 242   my $Parm = $#Part > 1 ? $Part[2] : "";
 243   if ($Type eq 'CTL')
 244   {
 245     $_ = $Indi;
 246     s/0x00/@/; s/0x01/A/; s/0x02/B/; s/0x03/C/;
 247     s/0x04/D/; s/0x05/E/; s/0x06/F/; s/0x07/G/;
 248     s/0x08/H/; s/0x09/I/; s/0x0a/J/; s/0x0b/K/;
 249     s/0x0c/L/; s/0x0d/M/; s/0x0e/N/; s/0x0f/O/;
 250     s/0x10/P/; s/0x11/Q/; s/0x12/R/; s/0x13/S/;
 251     s/0x14/T/; s/0x15/U/; s/0x16/V/; s/0x17/W/;
 252     s/0x18/X/; s/0x19/Y/; s/0x1a/Z/; s/0x1b/[/;
 253     s/0x1c/\\/; s/0x1d/]/; s/0x1e/^/; s/0x1f/_/;
 254     $Indi = $_;
 255   }
 256   print "<tr>\n";
 257   print "<td $color1><a href=#$Name>$Name</a>\n";
 258   print "<td $color1>$Type\n";
 259   print "<td $color1>$Indi\n";
 260   print "<td $color1>$Parm\n";
 261   print "<td $color1>$Head\n";
 262 }
 263
 264 sub layoutTable
 265 {
 266   my ($Head, $t, $Include) = @_;
 267   my $p;
 268 print "<tr><td colspan=5><h3>$Head</h3>\n";
 269 foreach $p (sort keys %$t)
 270 {
 271   my @Fld = split('\.', $p);
 272   if ($#Fld == 1 && $Fld[1] eq 'head')
 273   {
 274     my $name = $Fld[0];
 275     my $head = $t->{$p};
 276     my $attr = exists $t->{"$name.sect"}?$t->{"$name.sect"}:"";
 277     if ($attr =~ /$Include/)
 278     {
 279     layout2( $name, $head, exists $t->{"$name.code"}?$t->{"$name.code"}:"");
 280     }
 281   }
 282 }
 283 }
 284
 285 sub sortTest
 286 {
 287   my ($t) = @_;
 288   my $p;
 289   my $s = {};
 290   my $n = {};
 291   my $curr = "";
 292   foreach $p (keys %$t)
 293   {
 294     my @Fld = split('\.', $p);
 295     if ($#Fld == 1 && $Fld[1] eq 'head')
 296     {
 297       my $name = $Fld[0];
 298       if (exists $t->{"$name.code"})
 299       {
 300         $s->{$t->{"$name.code"}} = $name;
 301       }
 302     }
 303   }
 304   print "<table>\n";
 305   foreach $p (sort keys %$s)
 306   {
 307     my $name = $s->{$p};
 308     my @Fld = split('\|', $p);
 309     if ($Fld[0] ne $curr)
 310     {
 311       print "<tr><td colspan=5><h3>$Fld[0] codes</h3>\n";
 312     }
 313     $curr = $Fld[0];
 314     layout2($name,$t->{"$name.head"},$p);
 315   }
 316   print "</table>\n";
 317 }
 318
 319 sub htmlsect
 320 {
 321   my ($h) = @_;
 322   $_ = $all->{"$h.html"};
 323   s/\n  \.\n/\n  <p>\n/g;
 324   print "$_\n";
 325 }
 326
 327 # -----------------------------------------------------------------------------
 328 # -----------------------------------------------------------------------------
 329 # MAIN ------------------------------------------------------------------------
 330 # -----------------------------------------------------------------------------
 331 # -----------------------------------------------------------------------------
 332
 333 my $t = parse();
 334 my $p;
 335 my $table = 0;
 336
 337 # -------------------------------
 338 htmlsect("Introduction");
 339 # -------------------------------
 340 secthead("Control Sequences");
 341 htmlsect("Sequences");
 342 # -------------------------------
 343 secthead("Host to Terminal (Instructions by Code)");
 344 sortTest($t);
 345 # -------------------------------
 346 secthead("Host to Terminal (Instructions by Group)");
 347 htmlsect("Operations");
 348 print "<table>\n";
 349 layoutTable("Commands (Character Display Operation)",$t,"Command\.Display");
 350 layoutTable("Commands (Rendition related status)",$t,"Command\.RenderMode");
 351 layoutTable("Commands (Cursor)",$t,"Command\.Cursor");
 352 layoutTable("Commands (Cursor related status)",$t,"Command\.CursMode");
 353 layoutTable("Commands (Edit)",$t,"Command\.Erase|Command\.Insert|Command.\Delete");
 354 layoutTable("Commands (Miscellaneous)",$t,"Command[^.]|Command\$");
 355 layoutTable("Commands (General mode setting)",$t,"Command\.SetMode");
 356 layoutTable("Commands (Miscellaneous status)",$t,"Command\.Mode");
 357 layoutTable("Commands (VT52)",$t,"Command\.VT52");
 358 layoutTable("Commands (Not implemented)",$t,"Command\.NoImp");
 359 layoutTable("Commands (Ignored)",$t,"Command\.Ignored");
 360 layoutTable("Commands (Requests)",$t,"Command\.Request");
 361 print "</table>\n";
 362 # -------------------------------
 363 secthead("Terminal to Host");
 364 print "<table>\n";
 365 layoutTable("Replies",$t,"Reply");
 366 layoutTable("Events",$t,"Event");
 367 # -------------------------------
 368 print "</table>\n";
 369 secthead("Modes");
 370 print "<table>\n";
 371 layoutTable("Modes",$t,"Mode");
 372 #print "<h3>Other Codes</h3>\n";
 373 print "</table>\n";
 374 # -------------------------------
 375 secthead("Appendix A - Notion Details");
 376 htmlsect("ConceptDB");
 377 # -------------------------------
 378
 379 head();
 380 foreach $p (sort keys %$t)
 381 {
 382   my @Fld = split('\.', $p);
 383   if ($#Fld == 1 && $Fld[1] eq 'head')
 384   {
 385 #   print "</table>\n" if ($table);
 386     my $name = $Fld[0];
 387     my $head = $t->{$p};
 388     layout( $name, $head,
 389             exists $t->{"$name.code"}?$t->{"$name.code"}:"",
 390             exists $t->{"$name.text"}?$t->{"$name.text"}:"",
 391             exists $t->{"$name.dflt"}?$t->{"$name.dflt"}:"",
 392             exists $t->{"$name.emus"}?$t->{"$name.emus"}:"" );
 393     $table = 0;
 394   }
 395   if ($html && $#Fld == 2 && $Fld[1] eq 'table')
 396   {
 397     my $lines = $t->{$p};
 398     my $line;
 399     my $field;
 400     my @fldspan = ();
 401     my $ln = 0;
 402     print "<tr><td><p></td></tr>\n";
 403 #   print "<tr><td $color1>$Fld[2]</td><td $color1>Meaning</td></tr>\n";
 404     foreach $line (split('\n', $lines))
 405     {
 406       my $fn = 0;
 407       @fldspan =  split('\|',$line) if ($ln == 0);
 408       print "<tr>\n";
 409       print "<td></td>\n";
 410       foreach $field (split('\|',$line))
 411       {
 412         if ($ln == 0)
 413         {
 414           my @Parts = split(":",$field);
 415           $field = $Parts[0];
 416           $fldspan[$fn] = ($#Parts > 0) ? $Parts[1] : 1;
 417         }
 418         print "<td";
 419         printf(" colspan=%s",$fldspan[$fn]);
 420         print " $color1" if ($ln == 0);
 421         print " $color2" if ($ln > 0 && $ln % 2 == 0);
 422         print " $color3" if ($ln > 0 && $ln % 2 == 1);
 423         print ">";
 424         print txt2Html($field);
 425         print "</td>";
 426         $fn += 1;
 427       }
 428       print "</tr>\n";
 429       $ln += 1;
 430     }
 431     $table = 1;
 432   }
 433 }
 434 tail();