aboutsummaryrefslogtreecommitdiff
path: root/xorg-server/xkbdata.src/rules/xml2lst.pl
diff options
context:
space:
mode:
Diffstat (limited to 'xorg-server/xkbdata.src/rules/xml2lst.pl')
-rw-r--r--xorg-server/xkbdata.src/rules/xml2lst.pl288
1 files changed, 288 insertions, 0 deletions
diff --git a/xorg-server/xkbdata.src/rules/xml2lst.pl b/xorg-server/xkbdata.src/rules/xml2lst.pl
new file mode 100644
index 000000000..478fce89c
--- /dev/null
+++ b/xorg-server/xkbdata.src/rules/xml2lst.pl
@@ -0,0 +1,288 @@
+#!/usr/bin/perl
+
+# converts the <rules>.xml file to the old format <rules>.lst file
+#
+# Usage:
+#
+# perl xml2lst.pl [lang] < filename.xml > filename.lst
+#
+# author Ivan Pascal
+
+if (@ARGV) {
+ $lang = shift @ARGV;
+} else {
+ $lang = '';
+}
+
+$doc = new_document( 0, '');
+parse('', $doc);
+
+($reg) = node_by_name($doc, '/xkbConfigRegistry');
+@models = node_by_name($reg, 'modelList/model/configItem');
+@layouts = node_by_name($reg, 'layoutList/layout/configItem');
+@options = node_by_name($reg, 'optionList/group/configItem');
+
+print "! model\n";
+for $i (@models) {
+ ($name) = node_by_name($i, 'name');
+ @desc = node_by_name($i, 'description');
+ $descr = with_attribute(\@desc, 'xml:lang='.$lang);
+ if (! defined $descr) {
+ $descr = with_attribute(\@desc, 'xml:lang=');
+ }
+ printf(" %-15s %s\n", text_child($name), text_child($descr));
+}
+
+print "\n! layout\n";
+for $i (@layouts) {
+ ($name) = node_by_name($i, 'name');
+ @desc = node_by_name($i, 'description');
+ $descr = with_attribute(\@desc, 'xml:lang='.$lang);
+ if (! defined $descr ) {
+ $descr = with_attribute(\@desc, 'xml:lang=');
+ }
+ printf(" %-15s %s\n", text_child($name), text_child($descr));
+}
+
+print "\n! variant\n";
+for $l (@layouts) {
+ ($lname) = node_by_name($l, 'name');
+ @variants = node_by_name($l, '../variantList/variant/configItem');
+ for $v (@variants) {
+ ($name) = node_by_name($v, 'name');
+ @desc = node_by_name($v, 'description');
+ $descr = with_attribute(\@desc, 'xml:lang='.$lang);
+ if (! defined $descr) {
+ $descr = with_attribute(\@desc, 'xml:lang=');
+ }
+ printf(" %-15s %s: %s\n",
+ text_child($name), text_child($lname), text_child($descr));
+ }
+}
+
+print "\n! option\n";
+for $g (@options) {
+ ($name) = node_by_name($g, 'name');
+ @desc = node_by_name($g, 'description');
+ $descr = with_attribute(\@desc, 'xml:lang='.$lang);
+ if (! defined $descr) {
+ $descr = with_attribute(\@desc, 'xml:lang=');
+ }
+ printf(" %-20s %s\n", text_child($name), text_child($descr));
+
+ @opts = node_by_name($g, '../option/configItem');
+ for $o (@opts) {
+ ($name) = node_by_name($o, 'name');
+ @desc = node_by_name($o, 'description');
+ $descr = with_attribute(\@desc, 'xml:lang='.$lang);
+ if (! defined $descr) {
+ $descr = with_attribute(\@desc, 'xml:lang=');
+ }
+ printf(" %-20s %s\n",
+ text_child($name), text_child($descr));
+ }
+}
+
+sub with_attribute {
+ local ($nodelist, $attrexpr) = @_;
+ local ($attr, $value) = split (/=/, $attrexpr);
+ local ($node, $attrvalue);
+ if (defined $value && $value ne '') {
+ $value =~ s/"//g;
+ foreach $node (@{$nodelist}) {
+ $attrvalue = node_attribute($node, $attr);
+ if (defined $attrvalue && $attrvalue eq $value) {
+ return $node;
+ }
+ }
+ } else {
+ foreach $node (@{$nodelist}) {
+ if (! defined node_attribute($node, $attr)) {
+ return $node;
+ }
+ }
+ }
+ undef;
+}
+
+# Subroutines
+
+sub parse {
+ local $intag = 0;
+ my (@node_stack, $parent);
+ $parent = @_[1];
+ local ($tag, $text);
+
+ while (<>) {
+ chomp;
+ @str = split /([<>])/;
+ shift @str if ($str[0] eq '' || $str[0] =~ /^[ \t]*$/);
+
+ while (scalar @str) {
+ $token = shift @str;
+ if ($token eq '<') {
+ $intag = 1;
+ if (defined $text) {
+ add_text_node($parent, $text);
+ undef $text;
+ }
+ } elsif ($token eq '>') {
+ $intag = 0;
+ if ($tag =~ /^\/(.*)/) { # close tag
+ $parent = pop @node_stack;
+ } elsif ($tag =~ /^([^\/]*)\/$/) {
+ empty_tag($parent, $1);
+ } else {
+ if (defined ($node = open_tag($parent, $tag))) {
+ push @node_stack, $parent;
+ $parent = $node;
+ }
+ }
+ undef $tag;
+ } else {
+ if ($intag == 1) {
+ if (defined $tag) {
+ $tag .= ' '. $token;
+ } else {
+ $tag = $token;
+ }
+ } else {
+ if (defined $text) {
+ $text .= "\n" . $token;
+ } else {
+ $text = $token;
+ }
+ }
+ }
+ }
+ }
+}
+
+sub new_document {
+ $doc = new_node( 0, '', 'DOCUMENT');
+ $doc->{CHILDREN} = [];
+ return $doc;
+}
+
+sub new_node {
+ local ($parent_node, $tag, $type) = @_;
+
+ my %node;
+ $node{PARENT} = $parent_node;
+ $node{TYPE} = $type;
+
+ if ($type eq 'COMMENT' || $type eq 'TEXT') {
+ $node{TEXT} = $tag;
+ $node{NAME} = $type;
+ return \%node;
+ }
+
+ local ($tname, $attr) = split(' ', $tag, 2);
+ $node{NAME} = $tname;
+
+ if (defined $attr && $attr ne '') {
+ my %attr_table;
+ local @attr_list = split ( /"/, $attr);
+ local ($name, $value);
+ while (scalar @attr_list) {
+ $name = shift @attr_list;
+ $name =~ s/[ =]//g;
+ next if ($name eq '');
+ $value = shift @attr_list;
+ $attr_table{$name} =$value;
+ }
+ $node{ATTRIBUTES} = \%attr_table;
+ }
+ return \%node;
+}
+
+sub add_node {
+ local ($parent_node, $node) = @_;
+ push @{$parent_node->{CHILDREN}}, $node;
+
+ local $tname = $node->{NAME};
+ if (defined $parent_node->{$tname}) {
+ push @{$parent_node->{$tname}}, $node
+ } else {
+ $parent_node->{$tname} = [ $node ];
+ }
+}
+
+sub empty_tag {
+ local ($parent_node, $tag) = @_;
+ local $node = new_node($parent_node, $tag, 'EMPTY');
+ add_node($parent_node, $node);
+}
+
+sub open_tag {
+ local ($parent_node, $tag) = @_;
+ local $node;
+
+ if ($tag =~ /^\?.*/ || $tag =~ /^\!.*/) {
+ $node = new_node($parent_node, $tag, 'COMMENT');
+ add_node($parent_node, $node);
+ undef; return;
+ } else {
+ $node = new_node($parent_node, $tag, 'NODE');
+ $node->{CHILDREN} = [];
+ add_node($parent_node, $node);
+ return $node;
+ }
+}
+
+sub add_text_node {
+ local ($parent_node, $text) = @_;
+ local $node = new_node($parent_node, $text, 'TEXT');
+ add_node($parent_node, $node);
+}
+
+sub node_by_name {
+ local ($node, $name) = @_;
+ local ($tagname, $path) = split(/\//, $name, 2);
+
+ my @nodelist;
+
+ if ($tagname eq '') {
+ while ($node->{PARENT} != 0) {
+ $node = $node->{PARENT};
+ }
+ sublist_by_name($node, $path, \@nodelist);
+ } else {
+ sublist_by_name($node, $name, \@nodelist);
+ }
+ return @nodelist;
+}
+
+sub sublist_by_name {
+ local ($node, $name, $res) = @_;
+ local ($tagname, $path) = split(/\//, $name, 2);
+
+ if (! defined $path) {
+ push @{$res}, (@{$node->{$tagname}});
+ return;
+ }
+
+ if ($tagname eq '..' && $node->{PARENT} != 0) {
+ $node = $node->{PARENT};
+ sublist_by_name($node, $path, $res);
+ } else {
+ local $n;
+ for $n (@{$node->{$tagname}}) {
+ sublist_by_name($n, $path, $res);
+ }
+ }
+}
+
+sub node_attribute {
+ local $node = @_[0];
+ if (defined $node->{ATTRIBUTES}) {
+ return $node->{ATTRIBUTES}{@_[1]};
+ }
+ undef;
+}
+
+sub text_child {
+ local ($node) = @_;
+ local ($child) = node_by_name($node, 'TEXT');
+ return $child->{TEXT};
+}