tools/handle-conf-options

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use XML::Parser;
   5 use Getopt::Long;
   6
   7 my ($do_cfile,$do_hfile);
   8 my ($do_hkcu_reg,$do_reg);
   9 &GetOptions("cfile" => \$do_cfile,
  10             "hfile" => \$do_hfile,
  11             "hkcu-reg" => \$do_hkcu_reg,
  12             "reg" => \$do_reg);
  13
  14 # -----------------------------------------------------------------------------
  15
  16 my %typemap = ('b' => 'bool',
  17                's' => 'string',
  18                'i' => 'int',
  19                'd' => 'float',
  20                'as' => 'list:string');
  21
  22
  23 my @schemas = ();
  24
  25 for my $filename (@ARGV) {
  26     my $parser = new XML::Parser ('Style' => 'Tree');
  27     my $tree = $parser->parsefile ($filename);
  28
  29     my $mode = $tree->[0];
  30
  31     if ($mode eq 'gconfschemafile') {
  32         &walk_gconf_tree ([], [{},@$tree]);
  33     } elsif ($mode eq 'schemalist') {
  34         &walk_gsetting_tree ([], [{},@$tree]);
  35     } else {
  36         die "$0: Unknown type of xml [$mode].\n";
  37     }
  38 }
  39
  40 my $schema;
  41 sub walk_gconf_tree {
  42     my ($parents,$contents) = @_;
  43
  44     if (ref ($contents) eq 'ARRAY') {
  45         my @items = @$contents;
  46         my $attrs = shift @items;
  47
  48         while (@items) {
  49             my $tag = shift @items;
  50             my $args = shift @items;
  51
  52             if ($tag eq '0') {
  53                 # Text
  54                 if (@$parents > 2 && $parents->[-2] eq 'schema') {
  55                     my $key = $parents->[-1];
  56                     next if $key eq 'locale';
  57                     $schema->{$key} = $args;
  58                 }
  59                 if (@$parents > 3 &&
  60                     $parents->[-3] eq 'schema' &&
  61                     $parents->[-2] eq 'locale') {
  62                     my $key = $parents->[-1];
  63                     next if $key ne 'default';
  64                     $schema->{$key} = $args;
  65                 }
  66             } else {
  67                 $schema = {} if $tag eq 'schema';
  68                 if (@$parents > 1 && $parents->[-1] eq 'schema') {
  69                     # This handles empty defaults.
  70                     $schema->{$tag} = '';
  71                 }
  72                 &walk_gconf_tree ([@$parents,$tag],$args);
  73                 push @schemas, $schema if $tag eq 'schema';
  74             }
  75         }
  76     }
  77 }
  78
  79 sub unquote_gschema_string {
  80     my ($val) = @_;
  81     die "$0: invalid string value: $val\n" unless
  82         (length($val) >= 2 &&
  83          substr($val,0,1) eq substr($val,-1,1) &&
  84          $val =~ /^['"]/);
  85     $val = substr ($val, 1, length ($val) - 2);
  86     return $val;
  87 }
  88
  89 sub unquote_gschema_string_list {
  90     my ($val) = @_;
  91     return undef if $val eq '[]';
  92     die "$0: invalid string value: $val\n" unless
  93         (length($val) >= 2 &&
  94          substr($val,0,1) eq '[' &&
  95          substr($val,-1,1) eq ']');
  96     $val = substr ($val, 1, length ($val) - 2);
  97     my $res = '';
  98     while ($val =~ s/^'([^']*)'// or $val =~ s/^"([^']*)"//) {
  99         $res .= $1;
 100         last if $val eq '';
 101         $val =~ s/^,//;
 102         $res .= ',';
 103     }
 104
 105     return "[$res]";
 106 }
 107
 108 sub walk_gsetting_tree {
 109     my ($parents,$contents) = @_;
 110
 111     if (ref ($contents) eq 'ARRAY') {
 112         my @items = @$contents;
 113         my $attrs = shift @items;
 114
 115         while (@items) {
 116             my $tag = shift @items;
 117             my $args = shift @items;
 118
 119             if ($tag eq '0') {
 120                 # Text
 121                 if (@$parents > 2 && $parents->[-2] eq 'key') {
 122                     my $key = $parents->[-1];
 123                     my $val = $args;
 124                     if ($key eq 'default' && $schema->{'type'} eq 'string') {
 125                         $val = &unquote_gschema_string ($val);
 126                     } elsif ($key eq 'default' &&
 127                              $schema->{'type'} eq 'list' &&
 128                              $schema->{'list_type'} eq 'string') {
 129                         $val = &unquote_gschema_string_list ($val);
 130                     }
 131                     $schema->{$key} = $val;
 132                 }
 133             } else {
 134                 if ($tag eq 'key') {
 135                     $schema = {};
 136
 137                     my $thisattrs = $args->[0];
 138
 139                     $schema->{'applyto'} =
 140                         $attrs->{'path'} . $thisattrs->{'name'};
 141                     my $type = $typemap{$thisattrs->{'type'}};
 142                     if ($type =~ /^list:(.*)$/) {
 143                         $schema->{'type'} = 'list';
 144                         $schema->{'list_type'} = $1;
 145                     } else {
 146                         $schema->{'type'} = $type;
 147                     }
 148                 }
 149                 if (@$parents > 1 && $parents->[-1] eq 'schema') {
 150                     # This handles empty defaults.
 151                     $schema->{$tag} = '';
 152                 }
 153                 &walk_gsetting_tree ([@$parents,$tag],$args);
 154                 push @schemas, $schema if $tag eq 'key';
 155             }
 156         }
 157     }
 158 }
 159
 160 # -----------------------------------------------------------------------------
 161
 162 my %extra_attributes =
 163     ('/org/gnome/gnumeric/core/gui/editing/enter_moves_dir' => {
 164         'gtype' => 'GO_TYPE_DIRECTION',
 165         'default' => 'GO_DIRECTION_DOWN',  # Should match schema
 166      },
 167
 168      '/org/gnome/gnumeric/printsetup/preferred-unit' => {
 169          'gtype' => 'GTK_TYPE_UNIT',
 170          'default' => 'GTK_UNIT_MM',  # Should match schema
 171      },
 172
 173      '/apps/gnome-settings/gnumeric/toolbar_style' => {
 174          'noconfnode' => 1,
 175          'gtype' => 'GTK_TYPE_TOOLBAR_STYLE',
 176          'default' => 'GTK_TOOLBAR_ICONS',  # Should match schema
 177      },
 178
 179      '/org/gnome/gnumeric/core/gui/editing/recalclag' => {
 180          'min' => -5000,
 181          'max' => 5000
 182      },
 183
 184      '/org/gnome/gnumeric/core/gui/editing/autocomplete-min-chars' => {
 185          'min' => 1,
 186          'max' => 10
 187      },
 188
 189      '/org/gnome/gnumeric/core/gui/toolbars/format-position' => {
 190          'gtype' => 'GTK_TYPE_POSITION',
 191          'min' => 0,
 192          'max' => 3,
 193      },
 194
 195      '/org/gnome/gnumeric/core/gui/toolbars/object-position' => {
 196          'gtype' => 'GTK_TYPE_POSITION',
 197          'min' => 0,
 198          'max' => 3,
 199      },
 200
 201      '/org/gnome/gnumeric/core/gui/toolbars/standard-position' => {
 202          'gtype' => 'GTK_TYPE_POSITION',
 203          'min' => 0,
 204          'max' => 3,
 205      },
 206
 207      '/org/gnome/gnumeric/core/sort/dialog/max-initial-clauses' => {
 208          'min' => 0,
 209          'max' => 256,
 210      },
 211
 212      '/org/gnome/gnumeric/core/workbook/n-cols' => {
 213          'min' => 'GNM_MIN_COLS',
 214          'max' => 'GNM_MAX_COLS',
 215      },
 216
 217      '/org/gnome/gnumeric/core/workbook/n-rows' => {
 218          'min' => 'GNM_MIN_ROWS',
 219          'max' => 'GNM_MAX_ROWS',
 220      },
 221
 222      '/org/gnome/gnumeric/core/workbook/n-sheet' => {
 223          'min' => 1,
 224          'max' => 64,
 225      },
 226
 227      '/org/gnome/gnumeric/core/workbook/autosave_time' => {
 228          'min' => 0,
 229          'max' => '365 * 24 * 60 * 60',
 230      },
 231
 232      '/org/gnome/gnumeric/core/xml/compression-level' => {
 233          'min' => 0,
 234          'max' => 9,
 235      },
 236
 237      '/org/gnome/gnumeric/functionselector/num-of-recent' => {
 238          'min' => 0,
 239          'max' => 40,
 240      },
 241
 242      '/org/gnome/gnumeric/printsetup/paper-orientation' => {
 243          'min' => 'GTK_PAGE_ORIENTATION_PORTRAIT',
 244          'max' => 'GTK_PAGE_ORIENTATION_REVERSE_LANDSCAPE',
 245      },
 246
 247      '/org/gnome/gnumeric/printsetup/scale-height' => {
 248          'min' => 0,
 249          'max' => 100,
 250      },
 251
 252      '/org/gnome/gnumeric/printsetup/scale-width' => {
 253          'min' => 0,
 254          'max' => 100,
 255      },
 256
 257      '/org/gnome/gnumeric/undo/max_descriptor_width' => {
 258          'min' => 5,
 259          'max' => 256,
 260      },
 261
 262      '/org/gnome/gnumeric/undo/maxnum' => {
 263          'min' => 0,
 264          'max' => 10000,
 265      },
 266
 267      '/org/gnome/gnumeric/undo/size' => {
 268         'min' => 1,
 269         'max' => 1000000
 270      },
 271
 272      '/org/gnome/gnumeric/core/defaultfont/size' => {
 273          'min' => 1,
 274          'max' => 100,
 275      },
 276
 277      '/org/gnome/gnumeric/core/gui/screen/horizontaldpi' => {
 278          'min' => 10,
 279          'max' => 1000,
 280      },
 281
 282      '/org/gnome/gnumeric/core/gui/screen/verticaldpi' => {
 283          'min' => 10,
 284          'max' => 1000,
 285      },
 286
 287      '/org/gnome/gnumeric/core/gui/window/x' => {
 288          'min' => 0.1,
 289          'max' => 1,
 290      },
 291
 292      '/org/gnome/gnumeric/core/gui/window/y' => {
 293          'min' => 0.1,
 294          'max' => 1,
 295      },
 296
 297      '/org/gnome/gnumeric/core/gui/window/zoom' => {
 298          'min' => 0.1,
 299          'max' => 5,
 300      },
 301
 302      '/org/gnome/gnumeric/printsetup/hf-font-size' => {
 303          'min' => 1,
 304          'max' => 100,
 305      },
 306
 307      '/org/gnome/gnumeric/printsetup/margin-bottom' => {
 308          'min' => 0,
 309          'max' => 10000,
 310      },
 311
 312      '/org/gnome/gnumeric/printsetup/margin-gtk-bottom' => {
 313          'min' => 0,
 314          'max' => 720,
 315      },
 316
 317      '/org/gnome/gnumeric/printsetup/margin-gtk-left' => {
 318          'min' => 0,
 319          'max' => 720,
 320      },
 321
 322      '/org/gnome/gnumeric/printsetup/margin-gtk-right' => {
 323          'min' => 0,
 324          'max' => 720,
 325      },
 326
 327      '/org/gnome/gnumeric/printsetup/margin-gtk-top' => {
 328          'min' => 0,
 329          'max' => 720,
 330      },
 331
 332      '/org/gnome/gnumeric/printsetup/margin-top' => {
 333          'min' => 0,
 334          'max' => 10000,
 335      },
 336
 337      '/org/gnome/gnumeric/printsetup/scale-percentage-value' => {
 338          'min' => 1,
 339          'max' => 500,
 340      },
 341
 342      '/org/gnome/gnumeric/searchreplace/scope' => {
 343          'min' => 0,
 344          'max' => 2,
 345      },
 346
 347      '/org/gnome/gnumeric/searchreplace/error-behaviour' => {
 348          'min' => 0,
 349          'max' => 4,
 350      },
 351
 352      '/org/gnome/gnumeric/searchreplace/regex' => {
 353          'min' => 0,
 354          'max' => 2,
 355      },
 356
 357      '/org/gnome/gnumeric/stf/export/format' => {
 358         'gtype' => 'GNM_STF_FORMAT_MODE_TYPE',
 359         'default' => 'GNM_STF_FORMAT_AUTO',  # Should match schema
 360      },
 361
 362      '/org/gnome/gnumeric/stf/export/quoting' => {
 363         'gtype' => 'GSF_OUTPUT_CSV_QUOTING_MODE_TYPE',
 364         'default' => 'GSF_OUTPUT_CSV_QUOTING_MODE_AUTO',  # Should match schema
 365      },
 366
 367     );
 368
 369 foreach my $key (keys %extra_attributes) {
 370     my $newkey = $key;
 371     if ($newkey eq '/apps/gnome-settings/gnumeric/toolbar_style') {
 372         $newkey = '/org/gnome/gnumeric/toolbar-style';
 373     } else {
 374         $newkey = lc $newkey;
 375         $newkey =~ s/_/-/g;
 376     }
 377     $extra_attributes{$newkey} = $extra_attributes{$key};
 378 }
 379
 380 sub apply_extra_attributes {
 381     foreach my $schema (@schemas) {
 382         my $key = $schema->{'applyto'};
 383         my $e = $extra_attributes{$key};
 384         next unless $e;
 385         foreach my $k (keys %$e) {
 386             $schema->{$k} = $e->{$k};
 387         }
 388     }
 389 }
 390
 391 sub sort_schemas {
 392     @schemas = sort { $a->{'applyto'} cmp $b->{'applyto'} } @schemas;
 393 }
 394
 395 sub number_schemas {
 396     my $i = 0;
 397     foreach my $schema (@schemas) {
 398         $schema->{'i'} = $i++;
 399     }
 400 }
 401
 402 # -----------------------------------------------------------------------------
 403
 404 sub quote_c_string {
 405     my ($s) = @_;
 406
 407     return "NULL" unless defined $s;
 408
 409     return '"' . join ('',
 410                        map {
 411                            s/([\\""])/\\$1/;
 412                            s/\n/\\n/;
 413                            $_;
 414                        } (split (//, $s))) . '"';
 415 }
 416
 417 sub create_hcfile {
 418     &number_schemas ();
 419     &apply_extra_attributes ();
 420
 421     my %type_to_ctype =
 422         ('bool' => 'gboolean',
 423          'int' => 'int',
 424          'float' => 'double',
 425          'string' => 'const char *',
 426          'list:string' => 'GSList *',
 427          'GO_TYPE_DIRECTION' => 'GODirection',
 428          'GTK_TYPE_UNIT' => 'GtkUnit',
 429          'GTK_TYPE_TOOLBAR_STYLE' => 'GtkToolbarStyle',
 430          'GTK_TYPE_POSITION' => 'GtkPositionType',
 431          'GNM_STF_FORMAT_MODE_TYPE' => 'GnmStfFormatMode',
 432          'GSF_OUTPUT_CSV_QUOTING_MODE_TYPE' => 'GsfOutputCsvQuotingMode',
 433         );
 434
 435     my $cfile = "";
 436     my $hfile = "";
 437
 438     my %dirs;
 439
 440     foreach my $schema (@schemas) {
 441         my $i = $schema->{'i'};
 442         my $key = $schema->{'applyto'};
 443         my $type = $schema->{'type'};
 444         $type .= ":" . $schema->{'list_type'} if $type eq 'list';
 445         my $default = $schema->{'default'};
 446         my $min = $schema->{'min'};
 447         my $max = $schema->{'max'};
 448         my $gtype = ($schema->{'gtype'} || '0');
 449
 450         my $ctype = $type_to_ctype{$gtype || $type};
 451         my $ctypes = "$ctype "; $ctypes =~ s/\*\s/\*/;
 452
 453         my $var = $key;
 454         $var =~ s{^/org/gnome/gnumeric/}{};
 455         $var =~ s{^/apps/gnome-settings/gnumeric/}{};
 456         $var =~ s{[^a-zA-Z0-9_]}{_}g;
 457
 458         my $watch_name = "watch_$var";
 459
 460         my $needs_conf = 0;
 461         if ($key =~ s{/org/gnome/gnumeric/}{}) {
 462             my $dir = $key; $dir =~ s{/[^/]+$}{};
 463             $dirs{$dir} = 1;
 464             $needs_conf = 1;
 465             $needs_conf = 0 if $schema->{'noconfnode'};
 466         }
 467
 468         my $get_conf_code = "";
 469         if ($needs_conf) {
 470             my $id = "gnm_conf_get_${var}_node";
 471
 472             $hfile .= "GOConfNode *$id (void);\n";
 473
 474             $get_conf_code .= "GOConfNode *\n";
 475             $get_conf_code .= "$id (void)\n";
 476             $get_conf_code .= "{\n";
 477             $get_conf_code .= "\treturn get_watch_node (&$watch_name);\n";
 478             $get_conf_code .= "}\n\n";
 479         }
 480         $hfile .= "${ctypes}gnm_conf_get_$var (void);\n";
 481         $hfile .= "void gnm_conf_set_$var (${ctypes}x);\n\n";
 482
 483         my $get_head = "$ctype\ngnm_conf_get_$var (void)";
 484         my $set_head = "void\ngnm_conf_set_$var (${ctypes}x)";
 485
 486         my $short_desc = $schema->{'_summary'};
 487         my $long_desc = $schema->{'_description'};
 488
 489         if ($type eq 'bool') {
 490             $default = uc $default;
 491
 492             $cfile .= "static struct cb_watch_bool $watch_name = {\n";
 493             $cfile .= "\t0, \"$key\",\n";
 494             $cfile .= "\t" . &quote_c_string ($short_desc) . ",\n";
 495             $cfile .= "\t" . &quote_c_string ($long_desc) . ",\n";
 496             $cfile .= "\t$default,\n";
 497             $cfile .= "};\n\n";
 498
 499             $cfile .= "$get_head\n";
 500             $cfile .= "{\n";
 501             $cfile .= "\tif (!$watch_name.handler)\n";
 502             $cfile .= "\t\twatch_bool (&$watch_name);\n";
 503             $cfile .= "\treturn $watch_name.var;\n";
 504             $cfile .= "}\n\n";
 505
 506             $cfile .= "$set_head\n";
 507             $cfile .= "{\n";
 508             $cfile .= "\tif (!$watch_name.handler)\n";
 509             $cfile .= "\t\twatch_bool (&$watch_name);\n";
 510             $cfile .= "\tset_bool (&$watch_name, x);\n";
 511             $cfile .= "}\n\n";
 512         } elsif ($type eq 'int' || $type eq 'float') {
 513             my $ltype = $type_to_ctype{$type};
 514             die "$0: No min for $key\n" unless defined $min;
 515             die "$0: No max for $key\n" unless defined $max;
 516
 517             $cfile .= "static struct cb_watch_$ltype $watch_name = {\n";
 518             $cfile .= "\t0, \"$key\",\n";
 519             $cfile .= "\t" . &quote_c_string ($short_desc) . ",\n";
 520             $cfile .= "\t" . &quote_c_string ($long_desc) . ",\n";
 521             $cfile .= "\t$min, $max, $default,\n";
 522             $cfile .= "};\n\n";
 523
 524             $cfile .= "$get_head\n";
 525             $cfile .= "{\n";
 526             $cfile .= "\tif (!$watch_name.handler)\n";
 527             $cfile .= "\t\twatch_$ltype (&$watch_name);\n";
 528             $cfile .= "\treturn $watch_name.var;\n";
 529             $cfile .= "}\n\n";
 530
 531             $cfile .= "void\n";
 532             $cfile .= "gnm_conf_set_$var ($ctype x)\n";
 533             $cfile .= "{\n";
 534             $cfile .= "\tif (!$watch_name.handler)\n";
 535             $cfile .= "\t\twatch_$ltype (&$watch_name);\n";
 536             $cfile .= "\tset_$ltype (&$watch_name, x);\n";
 537             $cfile .= "}\n\n";
 538         } elsif ($type eq 'string' && $gtype eq '0') {
 539             $cfile .= "static struct cb_watch_string $watch_name = {\n";
 540             $cfile .= "\t0, \"$key\",\n";
 541             $cfile .= "\t" . &quote_c_string ($short_desc) . ",\n";
 542             $cfile .= "\t" . &quote_c_string ($long_desc) . ",\n";
 543             $cfile .= "\t" . &quote_c_string ($default) . ",\n";
 544             $cfile .= "};\n\n";
 545
 546             $cfile .= "$get_head\n";
 547             $cfile .= "{\n";
 548             $cfile .= "\tif (!$watch_name.handler)\n";
 549             $cfile .= "\t\twatch_string (&$watch_name);\n";
 550             $cfile .= "\treturn $watch_name.var;\n";
 551             $cfile .= "}\n\n";
 552
 553             $cfile .= "$set_head\n";
 554             $cfile .= "{\n";
 555             $cfile .= "\tg_return_if_fail (x != NULL);\n";
 556             $cfile .= "\tif (!$watch_name.handler)\n";
 557             $cfile .= "\t\twatch_string (&$watch_name);\n";
 558             $cfile .= "\tset_string (&$watch_name, x);\n";
 559             $cfile .= "}\n\n";
 560         } elsif ($type eq 'string' && $gtype ne '0') {
 561             $cfile .= "static struct cb_watch_enum $watch_name = {\n";
 562             $cfile .= "\t0, \"$key\",\n";
 563             $cfile .= "\t" . &quote_c_string ($short_desc) . ",\n";
 564             $cfile .= "\t" . &quote_c_string ($long_desc) . ",\n";
 565             $cfile .= "\t$default,\n";
 566             $cfile .= "};\n\n";
 567
 568             $cfile .= "$get_head\n";
 569             $cfile .= "{\n";
 570             $cfile .= "\tif (!$watch_name.handler)\n";
 571             $cfile .= "\t\twatch_enum (&$watch_name, $gtype);\n";
 572             $cfile .= "\treturn $watch_name.var;\n";
 573             $cfile .= "}\n\n";
 574
 575             $cfile .= "void\n";
 576             $cfile .= "gnm_conf_set_$var ($ctype x)\n";
 577             $cfile .= "{\n";
 578             $cfile .= "\tif (!$watch_name.handler)\n";
 579             $cfile .= "\t\twatch_enum (&$watch_name, $gtype);\n";
 580             $cfile .= "\tset_enum (&$watch_name, x);\n";
 581             $cfile .= "}\n\n";
 582         } elsif ($type eq 'list:string') {
 583             $cfile .= "static struct cb_watch_string_list $watch_name = {\n";
 584             $cfile .= "\t0, \"$key\",\n";
 585             $cfile .= "\t" . &quote_c_string ($short_desc) . ",\n";
 586             $cfile .= "\t" . &quote_c_string ($long_desc) . ",\n";
 587             $cfile .= "};\n\n";
 588
 589             $cfile .= "/**\n * gnm_conf_get_$var:\n *\n";
 590             $cfile .= " * Returns: (element-type char) (transfer none):\n **/\n";
 591             $cfile .= "$get_head\n";
 592             $cfile .= "{\n";
 593             $cfile .= "\tif (!$watch_name.handler)\n";
 594             $cfile .= "\t\twatch_string_list (&$watch_name);\n";
 595             $cfile .= "\treturn $watch_name.var;\n";
 596             $cfile .= "}\n\n";
 597
 598             $cfile .= "/**\n * gnm_conf_set_$var:\n";
 599             $cfile .= " * \@x: (element-type char): list of strings\n *\n **/\n";
 600             $cfile .= "$set_head\n";
 601             $cfile .= "{\n";
 602             $cfile .= "\tif (!$watch_name.handler)\n";
 603             $cfile .= "\t\twatch_string_list (&$watch_name);\n";
 604             $cfile .= "\tset_string_list (&$watch_name, x);\n";
 605             $cfile .= "}\n\n";
 606         } else {
 607             die "$0: Unhandled type $type\n";
 608         }
 609
 610         $cfile .= $get_conf_code;
 611     }
 612
 613     for my $dir (sort keys %dirs) {
 614         my $var = $dir;
 615         $var =~ s{[^a-zA-Z0-9_]}{_}g;
 616
 617         my $id = "gnm_conf_get_${var}_dir_node";
 618
 619         $hfile .= "GOConfNode *$id (void);\n";
 620
 621         $cfile .= "GOConfNode *\n";
 622         $cfile .= "$id (void)\n";
 623         $cfile .= "{\n";
 624         $cfile .= "\treturn get_node (\"$dir\", NULL);\n";
 625         $cfile .= "}\n\n";
 626     }
 627
 628     $cfile =~ s/\n\n+$/\n/;
 629     $hfile =~ s/\n\n+$/\n/;
 630
 631     print $hfile if $do_hfile;
 632     print $cfile if $do_cfile;
 633 }
 634
 635 # -----------------------------------------------------------------------------
 636
 637 sub create_reg {
 638     my ($prefix) = @_;
 639
 640     # --------------------
 641     # Bizarre ordering of schemas.
 642
 643     my %dir_group;
 644     my $i = 0;
 645     my @groups;
 646     foreach my $schema (@schemas) {
 647         my $key = $schema->{'applyto'};
 648         my $dir = $key; $dir =~ s{/[^/]+$}{};
 649
 650         my $group = $dir_group{$dir};
 651         if (!defined $group) {
 652             $group = $dir_group{$dir} = $i++;
 653             push @groups, [];
 654         }
 655
 656         # Unshift to reverse the order within the group for no reason other
 657         # than matching old code.
 658         unshift @{$groups[$group]}, $schema;
 659     }
 660     @schemas = ();
 661     foreach (@groups) {
 662         push @schemas, @$_;
 663     }
 664
 665     # --------------------
 666
 667     print "REGEDIT4\n";
 668
 669     my %dirs;
 670     foreach my $schema (@schemas) {
 671         my $key = $schema->{'applyto'};
 672         my $type = $schema->{'type'};
 673         $type .= ":" . $schema->{'list_type'} if $type eq 'list';
 674         my $default = $schema->{'default'};
 675
 676         # Outdated; keys now start with /org/
 677         # next unless $key =~ s{^/apps/}{};
 678
 679         next unless $key =~ s{^/org/gnome/}{};
 680
 681         my $wkey = $prefix;
 682         my @items = split ('/', $key);
 683         my $var = pop @items;
 684         foreach my $item (@items) {
 685             next if $item eq '';
 686             $wkey .= "\\$item";
 687             if (!exists $dirs{$wkey}) {
 688                 print "\n[$wkey]\n";
 689                 $dirs{$wkey} = 1;
 690             }
 691         }
 692
 693         print "\"$var\"=";
 694         if ($type eq 'bool') {
 695             printf "hex:0%d", ($default =~ /TRUE/i ? 1 : 0);
 696         } elsif ($type eq 'int') {
 697             printf "dword:%08x", $default;
 698         } elsif ($type eq 'float') {
 699             printf "\"%s\"", $default;
 700         } elsif ($type eq 'string') {
 701             print &quote_c_string ($default);
 702         } elsif ($type eq 'list:string') {
 703             print "hex(1):";
 704             $default = "" unless defined $default;
 705             if ($default =~ s{^\[(.*)\]$}{$1}) {
 706                 my $l = 7 + length ($var);
 707                 while ($default ne '') {
 708                     if ($l > 40) {
 709                         print "\\\n";
 710                         $l = 0;
 711                     }
 712                     if ($default =~ m{^,}) {
 713                         print "0a,00,";
 714                         $l += 6;
 715                         $default = substr ($default, 1);
 716                     } else {
 717                         my $c = ord (substr ($default, 0, 1));
 718                         printf("%02x,00,", $c);
 719                         $l += 6;
 720                         $default = substr ($default, 1);
 721                     }
 722                 }
 723                 print "00,00";
 724             }
 725         } else {
 726             die "$0: Unhandled type $type\n";
 727         }
 728
 729         print "\n";
 730     }
 731
 732     print "\n";
 733 }
 734
 735 # -----------------------------------------------------------------------------
 736
 737 &sort_schemas ();
 738 &create_hcfile () if $do_hfile || $do_cfile;
 739 &create_reg ("HKEY_USERS\\.DEFAULT\\Software") if $do_reg;
 740 &create_reg ("HKEY_CURRENT_USER\\Software") if $do_hkcu_reg;