diff options
Diffstat (limited to 'data/xkbdata/rules/xml2lst.pl')
| -rw-r--r-- | data/xkbdata/rules/xml2lst.pl | 288 |
1 files changed, 0 insertions, 288 deletions
diff --git a/data/xkbdata/rules/xml2lst.pl b/data/xkbdata/rules/xml2lst.pl deleted file mode 100644 index 56cf0cdcd..000000000 --- a/data/xkbdata/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! options\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}; -} |