aboutsummaryrefslogtreecommitdiff
path: root/xorg-server/xkbdata.src/rules/xml2lst.pl
diff options
context:
space:
mode:
authormarha <marha@users.sourceforge.net>2010-07-13 07:48:55 +0000
committermarha <marha@users.sourceforge.net>2010-07-13 07:48:55 +0000
commitd8f81c980a46279ac619312a914b563144894512 (patch)
tree3d2dce1c24fa37edf81c47af2311dbaf56a763f6 /xorg-server/xkbdata.src/rules/xml2lst.pl
parent1812c17dc8e8f071d8731716849957e97bb2b974 (diff)
downloadvcxsrv-d8f81c980a46279ac619312a914b563144894512.tar.gz
vcxsrv-d8f81c980a46279ac619312a914b563144894512.tar.bz2
vcxsrv-d8f81c980a46279ac619312a914b563144894512.zip
Renamed xkbdata.src also on trunk since the current merging of subversion will loose all the changes in xkbdata.src when the directory is renamed on the source branch.
Diffstat (limited to 'xorg-server/xkbdata.src/rules/xml2lst.pl')
-rw-r--r--xorg-server/xkbdata.src/rules/xml2lst.pl288
1 files changed, 0 insertions, 288 deletions
diff --git a/xorg-server/xkbdata.src/rules/xml2lst.pl b/xorg-server/xkbdata.src/rules/xml2lst.pl
deleted file mode 100644
index 478fce89c..000000000
--- a/xorg-server/xkbdata.src/rules/xml2lst.pl
+++ /dev/null
@@ -1,288 +0,0 @@
-#!/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};
-}