summaryrefslogtreecommitdiffstats
path: root/konsole/doc/VT100/genPl.pl
diff options
context:
space:
mode:
authortoma <toma@283d02a7-25f6-0310-bc7c-ecb5cbfe19da>2009-11-25 17:56:58 +0000
committertoma <toma@283d02a7-25f6-0310-bc7c-ecb5cbfe19da>2009-11-25 17:56:58 +0000
commit4aed2c8219774f5d797760606b8489a92ddc5163 (patch)
tree3f8c130f7d269626bf6a9447407ef6c35954426a /konsole/doc/VT100/genPl.pl
downloadtdebase-4aed2c8219774f5d797760606b8489a92ddc5163.tar.gz
tdebase-4aed2c8219774f5d797760606b8489a92ddc5163.zip
Copy the KDE 3.5 branch to branches/trinity for new KDE 3.5 features.
BUG:215923 git-svn-id: svn://anonsvn.kde.org/home/kde/branches/trinity/kdebase@1054174 283d02a7-25f6-0310-bc7c-ecb5cbfe19da
Diffstat (limited to 'konsole/doc/VT100/genPl.pl')
-rwxr-xr-xkonsole/doc/VT100/genPl.pl300
1 files changed, 300 insertions, 0 deletions
diff --git a/konsole/doc/VT100/genPl.pl b/konsole/doc/VT100/genPl.pl
new file mode 100755
index 000000000..0a3bb648e
--- /dev/null
+++ b/konsole/doc/VT100/genPl.pl
@@ -0,0 +1,300 @@
+#!/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 TitleLine
+# NAME.emus { EmuName ... }
+# NAME.dflt { Number|'ScreenLines' ... }
+# NAME.sect DottedWord
+#
+# NAME.code <Typ>|<Ide>|<Parm>
+# NAME.text
+# <text with some special tricks>
+# NAME.table.TAB
+# <"|"-separated head line>
+# <"|"-separated data rows>
+#
+# TABs
+# - .XPS, used for instructions with subcodes
+# Subcode|Emulation|Scope|Operation|Parameter|Meaning
+# - .XEX, used for individual codes
+# Instruction|Scope|Operation|Parameter
+#
+# Alternative
+# - .impl Scope|Operation|Parameters
+# - .subc.SUBCODE.impl
+# - .subc.SUBCODE.attr
+# - .subc.SUBCODE.head
+
+# -----------------------------------------------------------------------------
+# -----------------------------------------------------------------------------
+# 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;
+}
+
+# -----------------------------------------------------------------------------
+# -----------------------------------------------------------------------------
+# Analyze Source --------------------------------------------------------------
+# -----------------------------------------------------------------------------
+# -----------------------------------------------------------------------------
+
+sub clausify
+{
+ my ($t) = @_;
+ my $p;
+ my $word;
+ foreach $p (keys %$t)
+ {
+ my $flag = 0;
+ print("dict([");
+ foreach $word (split('\.', $p))
+ {
+ print(", ") if ($flag);
+ print("\'$word\'");
+ $flag = 1;
+ }
+ print("], ");
+ my @Fld = split('\.', $p);
+ #
+ # head
+ #
+ if ($#Fld == 1 && $Fld[1] eq 'head')
+ {
+ print "\"",$t->{$p},"\"";
+ }
+ #
+ # emus
+ #
+ elsif ($#Fld == 1 && $Fld[1] eq 'emus')
+ {
+ my $emu;
+ $flag = 0;
+ print("[");
+ foreach $emu (split(' ', $t->{$p}))
+ {
+ print ", " if ($flag);
+ print "\'$emu\'";
+ $flag = 1;
+ }
+ print("]");
+ }
+ #
+ # dflt
+ #
+ elsif ($#Fld == 1 && $Fld[1] eq 'dflt')
+ {
+ my $dflt;
+ $flag = 0;
+ print("[");
+ foreach $dflt (split(' ', $t->{$p}))
+ {
+ print ", " if ($flag);
+ print $dflt if (length($dflt) == 1);
+ print "\'$dflt\'" if (length($dflt) > 1);
+ $flag = 1;
+ }
+ print("]");
+ }
+ #
+ # sect
+ #
+ elsif ($#Fld == 1 && $Fld[1] eq 'sect')
+ {
+ my $sect;
+ $flag = 0;
+ print("[");
+ foreach $sect (split('\.', $t->{$p}))
+ {
+ print ", " if ($flag);
+ print "\'$sect\'";
+ $flag = 1;
+ }
+ print("]");
+ }
+ #
+ # code
+ #
+ elsif ($#Fld == 1 && $Fld[1] eq 'code')
+ {
+ my @Code = split('\|', $t->{$p});
+ print("[");
+ print("\'$Code[0]\', ");
+ if ($#Code > 0 && $Code[1] ne '')
+ {
+ print("\"$Code[1]\", ") if ($Code[0] ne 'CTL');
+ printf("%d, ",eval($Code[1])) if ($Code[0] eq 'CTL');
+ }
+ else
+ {
+ print("none, ")
+ }
+ if ($#Code == 2 && $Code[2] ne '' && $Code[0] ne 'PRN')
+ {
+ $_ = $Code[2];
+ s/{/['/;
+ s/}/']/;
+ s/;/','/g;
+ s/'([0-9]+)'/$1/g;
+ print $_;
+ }
+ else
+ {
+ print "[]";
+ }
+ print("]");
+ }
+ #
+ # text
+ #
+ elsif ($#Fld == 1 && $Fld[1] eq 'text')
+ {
+ my $text;
+ $flag = 0;
+ print("[");
+ foreach $text (split('\n', $t->{$p}))
+ {
+ print ", " if ($flag);
+ $_ = $text;
+ s/^ //;
+ s/"/\\"/g;
+ s/\\ref:([A-Z0-9]+)/", ref('$1'), "/g;
+ print "\n \"$_\"" if ($_ ne '.');
+ print "\n nl" if ($_ eq '.');
+ $flag = 1;
+ }
+ print("]");
+ }
+ #
+ # table.* - subcodes
+ #
+ #elsif ($#Fld == 2 && $Fld[1] eq 'table' && $Fld[2] eq 'XPS')
+ elsif ($#Fld >= 1 && $Fld[1] eq 'table')
+ {
+ my $text;
+ $flag = 0;
+ print("[");
+ foreach $text (split('\n', $t->{$p}))
+ {
+ print ",\n " if ($flag);
+ $_ = $text;
+ s/^ //;
+ my $flag2 = 0;
+ my $col;
+ print("[");
+ foreach $col (split('\|', $_))
+ {
+ print ", " if ($flag2);
+ $_ = $col;
+ s/'/\\'/g;
+ print "\'$_\'";
+ $flag2 = 1;
+ }
+ print("]");
+ $flag = 1;
+ }
+ print("]");
+ }
+ #
+ # other (text, tables)
+ #
+ else
+ {
+ print("other");
+ }
+ print(").\n");
+ }
+}
+
+# -----------------------------------------------------------------------------
+# -----------------------------------------------------------------------------
+# MAIN ------------------------------------------------------------------------
+# -----------------------------------------------------------------------------
+# -----------------------------------------------------------------------------
+
+my $t = parse();
+my $p;
+my $table = 0;
+
+clausify($t);