1#!/usr/bin/perl -w 2 3use strict; 4use XML::Parser; 5use Getopt::Long; 6 7my ($do_cfile,$do_hfile); 8my ($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 16my %typemap = ('b' => 'bool', 17 's' => 'string', 18 'i' => 'int', 19 'd' => 'float', 20 'as' => 'list:string'); 21 22 23my @schemas = (); 24 25for 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 40my $schema; 41sub 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 79sub 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 89sub 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 108sub 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 162my %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 369foreach 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 380sub 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 391sub sort_schemas { 392 @schemas = sort { $a->{'applyto'} cmp $b->{'applyto'} } @schemas; 393} 394 395sub number_schemas { 396 my $i = 0; 397 foreach my $schema (@schemas) { 398 $schema->{'i'} = $i++; 399 } 400} 401 402# ----------------------------------------------------------------------------- 403 404sub 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 417sub 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 .= "/**\n"; 475 $get_conf_code .= " * $id:\n"; 476 $get_conf_code .= " *\n"; 477 $get_conf_code .= " * Returns: (transfer none): A #GOConfNode\n"; 478 $get_conf_code .= " */\n"; 479 $get_conf_code .= "GOConfNode *\n"; 480 $get_conf_code .= "$id (void)\n"; 481 $get_conf_code .= "{\n"; 482 $get_conf_code .= "\treturn get_watch_node (&$watch_name);\n"; 483 $get_conf_code .= "}\n\n"; 484 } 485 $hfile .= "${ctypes}gnm_conf_get_$var (void);\n"; 486 $hfile .= "void gnm_conf_set_$var (${ctypes}x);\n\n"; 487 488 my $get_head = "$ctype\ngnm_conf_get_$var (void)"; 489 my $set_head = "void\ngnm_conf_set_$var (${ctypes}x)"; 490 491 my $short_desc = $schema->{'_summary'}; 492 my $long_desc = $schema->{'_description'}; 493 494 if ($type eq 'bool') { 495 $default = uc $default; 496 497 $cfile .= "static struct cb_watch_bool $watch_name = {\n"; 498 $cfile .= "\t0, \"$key\",\n"; 499 $cfile .= "\t" . "e_c_string ($short_desc) . ",\n"; 500 $cfile .= "\t" . "e_c_string ($long_desc) . ",\n"; 501 $cfile .= "\t$default,\n"; 502 $cfile .= "};\n\n"; 503 504 $cfile .= "$get_head\n"; 505 $cfile .= "{\n"; 506 $cfile .= "\tif (!$watch_name.handler)\n"; 507 $cfile .= "\t\twatch_bool (&$watch_name);\n"; 508 $cfile .= "\treturn $watch_name.var;\n"; 509 $cfile .= "}\n\n"; 510 511 $cfile .= "$set_head\n"; 512 $cfile .= "{\n"; 513 $cfile .= "\tif (!$watch_name.handler)\n"; 514 $cfile .= "\t\twatch_bool (&$watch_name);\n"; 515 $cfile .= "\tset_bool (&$watch_name, x);\n"; 516 $cfile .= "}\n\n"; 517 } elsif ($type eq 'int' || $type eq 'float') { 518 my $ltype = $type_to_ctype{$type}; 519 die "$0: No min for $key\n" unless defined $min; 520 die "$0: No max for $key\n" unless defined $max; 521 522 $cfile .= "static struct cb_watch_$ltype $watch_name = {\n"; 523 $cfile .= "\t0, \"$key\",\n"; 524 $cfile .= "\t" . "e_c_string ($short_desc) . ",\n"; 525 $cfile .= "\t" . "e_c_string ($long_desc) . ",\n"; 526 $cfile .= "\t$min, $max, $default,\n"; 527 $cfile .= "};\n\n"; 528 529 $cfile .= "$get_head\n"; 530 $cfile .= "{\n"; 531 $cfile .= "\tif (!$watch_name.handler)\n"; 532 $cfile .= "\t\twatch_$ltype (&$watch_name);\n"; 533 $cfile .= "\treturn $watch_name.var;\n"; 534 $cfile .= "}\n\n"; 535 536 $cfile .= "void\n"; 537 $cfile .= "gnm_conf_set_$var ($ctype x)\n"; 538 $cfile .= "{\n"; 539 $cfile .= "\tif (!$watch_name.handler)\n"; 540 $cfile .= "\t\twatch_$ltype (&$watch_name);\n"; 541 $cfile .= "\tset_$ltype (&$watch_name, x);\n"; 542 $cfile .= "}\n\n"; 543 } elsif ($type eq 'string' && $gtype eq '0') { 544 $cfile .= "static struct cb_watch_string $watch_name = {\n"; 545 $cfile .= "\t0, \"$key\",\n"; 546 $cfile .= "\t" . "e_c_string ($short_desc) . ",\n"; 547 $cfile .= "\t" . "e_c_string ($long_desc) . ",\n"; 548 $cfile .= "\t" . "e_c_string ($default) . ",\n"; 549 $cfile .= "};\n\n"; 550 551 $cfile .= "$get_head\n"; 552 $cfile .= "{\n"; 553 $cfile .= "\tif (!$watch_name.handler)\n"; 554 $cfile .= "\t\twatch_string (&$watch_name);\n"; 555 $cfile .= "\treturn $watch_name.var;\n"; 556 $cfile .= "}\n\n"; 557 558 $cfile .= "$set_head\n"; 559 $cfile .= "{\n"; 560 $cfile .= "\tg_return_if_fail (x != NULL);\n"; 561 $cfile .= "\tif (!$watch_name.handler)\n"; 562 $cfile .= "\t\twatch_string (&$watch_name);\n"; 563 $cfile .= "\tset_string (&$watch_name, x);\n"; 564 $cfile .= "}\n\n"; 565 } elsif ($type eq 'string' && $gtype ne '0') { 566 $cfile .= "static struct cb_watch_enum $watch_name = {\n"; 567 $cfile .= "\t0, \"$key\",\n"; 568 $cfile .= "\t" . "e_c_string ($short_desc) . ",\n"; 569 $cfile .= "\t" . "e_c_string ($long_desc) . ",\n"; 570 $cfile .= "\t$default,\n"; 571 $cfile .= "};\n\n"; 572 573 $cfile .= "$get_head\n"; 574 $cfile .= "{\n"; 575 $cfile .= "\tif (!$watch_name.handler)\n"; 576 $cfile .= "\t\twatch_enum (&$watch_name, $gtype);\n"; 577 $cfile .= "\treturn $watch_name.var;\n"; 578 $cfile .= "}\n\n"; 579 580 $cfile .= "void\n"; 581 $cfile .= "gnm_conf_set_$var ($ctype x)\n"; 582 $cfile .= "{\n"; 583 $cfile .= "\tif (!$watch_name.handler)\n"; 584 $cfile .= "\t\twatch_enum (&$watch_name, $gtype);\n"; 585 $cfile .= "\tset_enum (&$watch_name, x);\n"; 586 $cfile .= "}\n\n"; 587 } elsif ($type eq 'list:string') { 588 $cfile .= "static struct cb_watch_string_list $watch_name = {\n"; 589 $cfile .= "\t0, \"$key\",\n"; 590 $cfile .= "\t" . "e_c_string ($short_desc) . ",\n"; 591 $cfile .= "\t" . "e_c_string ($long_desc) . ",\n"; 592 $cfile .= "};\n\n"; 593 594 $cfile .= "/**\n * gnm_conf_get_$var:\n *\n"; 595 $cfile .= " * Returns: (element-type utf8) (transfer none):\n **/\n"; 596 $cfile .= "$get_head\n"; 597 $cfile .= "{\n"; 598 $cfile .= "\tif (!$watch_name.handler)\n"; 599 $cfile .= "\t\twatch_string_list (&$watch_name);\n"; 600 $cfile .= "\treturn $watch_name.var;\n"; 601 $cfile .= "}\n\n"; 602 603 $cfile .= "/**\n * gnm_conf_set_$var:\n"; 604 $cfile .= " * \@x: (element-type utf8): list of strings\n *\n **/\n"; 605 $cfile .= "$set_head\n"; 606 $cfile .= "{\n"; 607 $cfile .= "\tif (!$watch_name.handler)\n"; 608 $cfile .= "\t\twatch_string_list (&$watch_name);\n"; 609 $cfile .= "\tset_string_list (&$watch_name, x);\n"; 610 $cfile .= "}\n\n"; 611 } else { 612 die "$0: Unhandled type $type\n"; 613 } 614 615 $cfile .= $get_conf_code; 616 } 617 618 for my $dir (sort keys %dirs) { 619 my $var = $dir; 620 $var =~ s{[^a-zA-Z0-9_]}{_}g; 621 622 my $id = "gnm_conf_get_${var}_dir_node"; 623 624 $hfile .= "GOConfNode *$id (void);\n"; 625 626 $cfile .= "/**\n"; 627 $cfile .= " * $id:\n"; 628 $cfile .= " *\n"; 629 $cfile .= " * Returns: (transfer none): A #GOConfNode\n"; 630 $cfile .= " */\n"; 631 $cfile .= "GOConfNode *\n"; 632 $cfile .= "$id (void)\n"; 633 $cfile .= "{\n"; 634 $cfile .= "\treturn get_node (\"$dir\", NULL);\n"; 635 $cfile .= "}\n\n"; 636 } 637 638 $cfile =~ s/\n\n+$/\n/; 639 $hfile =~ s/\n\n+$/\n/; 640 641 print $hfile if $do_hfile; 642 print $cfile if $do_cfile; 643} 644 645# ----------------------------------------------------------------------------- 646 647sub create_reg { 648 my ($prefix) = @_; 649 650 # -------------------- 651 # Bizarre ordering of schemas. 652 653 my %dir_group; 654 my $i = 0; 655 my @groups; 656 foreach my $schema (@schemas) { 657 my $key = $schema->{'applyto'}; 658 my $dir = $key; $dir =~ s{/[^/]+$}{}; 659 660 my $group = $dir_group{$dir}; 661 if (!defined $group) { 662 $group = $dir_group{$dir} = $i++; 663 push @groups, []; 664 } 665 666 # Unshift to reverse the order within the group for no reason other 667 # than matching old code. 668 unshift @{$groups[$group]}, $schema; 669 } 670 @schemas = (); 671 foreach (@groups) { 672 push @schemas, @$_; 673 } 674 675 # -------------------- 676 677 print "REGEDIT4\n"; 678 679 my %dirs; 680 foreach my $schema (@schemas) { 681 my $key = $schema->{'applyto'}; 682 my $type = $schema->{'type'}; 683 $type .= ":" . $schema->{'list_type'} if $type eq 'list'; 684 my $default = $schema->{'default'}; 685 686 # Outdated; keys now start with /org/ 687 # next unless $key =~ s{^/apps/}{}; 688 689 next unless $key =~ s{^/org/gnome/}{}; 690 691 my $wkey = $prefix; 692 my @items = split ('/', $key); 693 my $var = pop @items; 694 foreach my $item (@items) { 695 next if $item eq ''; 696 $wkey .= "\\$item"; 697 if (!exists $dirs{$wkey}) { 698 print "\n[$wkey]\n"; 699 $dirs{$wkey} = 1; 700 } 701 } 702 703 print "\"$var\"="; 704 if ($type eq 'bool') { 705 printf "hex:0%d", ($default =~ /TRUE/i ? 1 : 0); 706 } elsif ($type eq 'int') { 707 printf "dword:%08x", $default; 708 } elsif ($type eq 'float') { 709 printf "\"%s\"", $default; 710 } elsif ($type eq 'string') { 711 print "e_c_string ($default); 712 } elsif ($type eq 'list:string') { 713 print "hex(1):"; 714 $default = "" unless defined $default; 715 if ($default =~ s{^\[(.*)\]$}{$1}) { 716 my $l = 7 + length ($var); 717 while ($default ne '') { 718 if ($l > 40) { 719 print "\\\n"; 720 $l = 0; 721 } 722 if ($default =~ m{^,}) { 723 print "0a,00,"; 724 $l += 6; 725 $default = substr ($default, 1); 726 } else { 727 my $c = ord (substr ($default, 0, 1)); 728 printf("%02x,00,", $c); 729 $l += 6; 730 $default = substr ($default, 1); 731 } 732 } 733 print "00,00"; 734 } 735 } else { 736 die "$0: Unhandled type $type\n"; 737 } 738 739 print "\n"; 740 } 741 742 print "\n"; 743} 744 745# ----------------------------------------------------------------------------- 746 747&sort_schemas (); 748&create_hcfile () if $do_hfile || $do_cfile; 749&create_reg ("HKEY_USERS\\.DEFAULT\\Software") if $do_reg; 750&create_reg ("HKEY_CURRENT_USER\\Software") if $do_hkcu_reg; 751