bin/fvwm-themes-config.in

   1 #!@PERL@ -w
   2 # for speed testing add: -d:DProf and use dprofpp
   3
   4 # Filter this script to pod2man to get a man page:
   5 #   pod2man -c "FVWM Utility" fvwm-themes-config | nroff -man | less -e
   6
   7 use strict;
   8 use Getopt::Long;
   9
  10 my $prefix = $ENV{'prefix'} || '@prefix@';
  11 my $ROOT_PREFIX = $ENV{'ROOT_PREFIX'} || '@ROOT_PREFIX@';
  12 $ROOT_PREFIX = $ENV{'DESTDIR'} if $ENV{'DESTDIR'};
  13 my $bindir = "@bindir@";
  14 my $datadir = "@datadir@";
  15 my $ftDataDir = "@FT_DATADIR@";
  16
  17 my $version = '@VERSION@';
  18 my $fvwmVersion = '@FVWM_VERSION@';
  19 my $fvwmDefaultImagePath = '@FVWM_DEFAULT_IMAGEPATH@';
  20 my $versionInfo = '@FT_VERSION_INFO@';
  21 my $buildId = '@FT_BUILD_ID@';
  22
  23 my $scriptName = ($0 =~ m:([^/]+)$:, $1);
  24 my $scriptFile = "$bindir/$scriptName";
  25 my $rcFile = "themes-rc";
  26 my $rcFile2 = "$rcFile-2";
  27 # maybe we may use .$rcFile-3
  28 my $rcFile3 = "$rcFile-3";
  29 my $userHome = $ENV{'HOME'} || "./.";
  30 my $userDir = $ENV{'FVWM_USERDIR'} || "$userHome/.fvwm";
  31 my @searchPath = ($userDir, $ftDataDir);
  32 my ($workDir, $siteDir);
  33 my $themesSubDir = 'themes';
  34 my $currentThemeName = 'current';
  35 my $currentThemeSubDir = "$themesSubDir/$currentThemeName";
  36 my $imagesSubDir = 'images';
  37 my $themeCfgFile = 'theme.cfg';
  38 my $mainDirFile = 'main';
  39 my $defaultReadCommand = 'Read "%f"';
  40 my $cfgCacheFileName = '.cfg-cache.pl';
  41
  42 my $idKey = 'file';
  43 my $themeKey = 'theme';
  44 my $componentKey = 'component';
  45 my $componentGroupKey = 'group';
  46 my $pipe = 0;  # produce fvwm commands for fvwm's PipeRead if set
  47 my $printRc3 = 0; # experimental (no doc)
  48 my $useRestart = $ENV{'FT_USE_RESTART'}? 1: 0;
  49 #ccds 1 (here for easy Minimal/Global switching)
  50 my $setMinimalReload = "";
  51
  52 # ----------------------------------------------------------------------------
  53
  54 sub showHelp {
  55         print "The fvwm-themes management utility.\n";
  56         print "Usage: $scriptName [OPTIONS]\n";
  57         print "Options:\n";
  58         print "\t--help             show this help and exit\n";
  59         print "\t--version          show the version and exit\n";
  60         print "\t--info             show the configured information and exit\n";
  61         print "\t--site             use site config dir for output, not user's\n";
  62         print "\t--com-mode         run under the communication mode\n";
  63         print "\t--com-name name    name for communication with fvwm-themes-com\n";
  64         print "\t--show-themes      show all themes list\n";
  65         print "\t--show-components  show components in all themes\n";
  66         print "\t--show-dir         show all theme directory full paths\n";
  67         print "\t--theme theme      limit --show-* only to this/these theme(s)\n";
  68         print "\t--show-info        shows info for component given in --component\n";
  69         print "\t--show-cfg         shows cfg for component given in --component\n";
  70         print "\t--show-value key   shows value for component given in --component\n";
  71         print "\t--component comp   defines a working component\n";
  72         print "\t--only-site        limit --show-* only to the site directory\n";
  73         print "\t--only-user        limit --show-* only to the user directory\n";
  74         print "\t--fvwmscript       format output of --show-* differently\n";
  75         print "\t--expand-rc file   expand fvwm configuration file to stdout\n";
  76         print "\t--fresh            refresh (regenerate) current theme configs\n";
  77         print "\t--reset            reset all components to default theme\n";
  78         print "\t--no-cfg-cache     don't use (build) the configuration cache file\n";
  79         print "\t--set-minimal-reload=i switch between minimal and full reloading\n";
  80         print "\t--load [cmp]\@theme load the given theme component(s)\n";
  81         print "\t--drop cmp[\@theme] unload the current theme component\n";
  82         print "\t--option cmp:opt=v change the component option value.\n";
  83         print "\t--variant cmp=var  change the component variant\n";
  84         print "\t--set-locked cmp=v set or unset the component's lock\n";
  85         print "\t--pipe             generate fvwm commands\n";
  86         #print "\t--print-rc3        print to STDOUT themes-rc-3\n";
  87         print "\t--install theme..  install theme.tar.gz or theme.tar.bz2 files\n";
  88         print "\t--force-install    replace old themes without prompting\n";
  89         print "\t--create-pack pack theme..   create a pack from given themes\n";
  90         print "\t--pack-prefix pre  replace ft by pre in the name of the pack\n";
  91         print "\t--pack-extra-version x.x   add _x.x to the version of the pack\n";
  92         print "\t--tmp-dir          full path to a temporary directory\n";
  93         exit 0;
  94 }
  95
  96 sub showVersion {
  97         print "$version\n";
  98         exit 0;
  99 }
 100
 101 sub showInfo {
 102         print "Package: @PACKAGE@\n";
 103         print "Version: $version\n";
 104         print "FVWM version when this package was built: $fvwmVersion\n";
 105         print "\n";
 106         print "Instalation options:\n";
 107         print "\tprefix: $prefix\n";
 108         print "\tbindir: $bindir\n";
 109         print "\tdatadir: $datadir\n";
 110         print "\tmandir: @mandir@\n";
 111         print "\n";
 112         print "Built-in paths:\n";
 113         print "\tData directory: $ftDataDir\n";
 114         print "\tDefault UserDir: $userDir\n";
 115         print "\tDefault ImagePath: $fvwmDefaultImagePath\n";
 116         exit 0;
 117 }
 118
 119 sub wrongUsage {
 120         print STDERR "Try '$scriptName --help' for more information.\n";
 121         exit -1;
 122 }
 123
 124 sub errDie ($) {
 125         my $msg = shift;
 126         $msg .= "\n" unless $msg =~ /\n$/s;
 127         if ($pipe) {
 128                 $msg =~ s/\n/^n/sg;
 129                 $msg =~ s/"/^q/sg;
 130                 print qq(FuncFvwmShowMessage "$scriptName error" "$msg" '-center -xrm "*form*background:rgb:c0/50/50" -xrm "*form*okay*background:rgb:90/40/40" -xrm "*form*message*background:rgb:f0/60/60"'\n);
 131                 exit -1;
 132         } else {
 133                 die $msg;
 134         }
 135 }
 136
 137 #" <- a fix for my xemacs (olicha)
 138
 139 sub errWarn ($) {
 140         my $msg = shift;
 141         $msg .= "\n" unless $msg =~ /\n$/s;
 142         if ($pipe) {
 143                 $msg =~ s/\n/^n/sg;
 144                 $msg =~ s/"/^q/sg;
 145                 print qq(FuncFvwmShowMessage "$scriptName warning" "$msg" '-center -xrm "*form*background:rgb:90/90/50" -xrm "*form*okay*background:rgb:70/70/40" -xrm "*form*message*background:rgb:b0/b0/60"'\n);
 146         } else {
 147                 warn $msg;
 148         }
 149 }
 150
 151 #" <- a fix for my xemacs (olicha)
 152
 153 sub sysDie ($) {
 154         my $msg = shift;
 155         $msg =~ s/\s+$//s;
 156         errDie("$msg: [$!]");
 157 }
 158
 159 sub isArrayElement ($$) {
 160         my $array = shift;
 161         my $element = shift;
 162         return int(grep { /^\Q$element\E$/ } @$array);
 163 }
 164
 165 sub getArrayElementIndex ($$) {
 166         my $array = shift;
 167         my $element = shift;
 168         my $i;
 169         foreach ($i = 0; $i < @$array; $i++) {
 170                 return $i if $array->[$i] eq $element;
 171         }
 172         return undef;
 173 }
 174
 175 sub conjunctArrays ($$) {
 176         my $array1 = shift;
 177         my $array2 = shift;
 178         return [ grep { isArrayElement($array2, $_) } @$array1 ];
 179 }
 180
 181 sub dumpPerlValue ($;$$) {
 182         my ($value, $level, $inline) = @_;
 183         $level ||= 0;
 184         $inline ||= 0;
 185         my $ref = ref($value);
 186         my $str = $ref;
 187         my @subValues = ();
 188
 189         if (!$ref) {
 190                 $str = $value;
 191                 $str = '(undef)' unless defined $str;
 192         } elsif ($ref eq 'ARRAY') {
 193                 @subValues = @$value;
 194         } elsif ($ref eq 'HASH') {
 195                 @subValues = map {
 196                         "$_\t" . &dumpPerlValue($value->{$_}, $level + 1, 1)
 197                 } sort keys %$value;
 198         } elsif ($ref eq 'SCALAR') {
 199                 @subValues = ($$value);
 200         } else {
 201                 #errDie("Unsupported perl type $ref");
 202         }
 203         $str = ("\t" x $level) . "$str\n" unless $inline;
 204         my $str2 = "";
 205         foreach (@subValues) { $str2 .= &dumpPerlValue($_, $level + 1); }
 206         if ($inline && $str2 =~ /^(.*)\n$/s) { $str .= "\n"; $str2 = $1; }
 207         return "$str$str2";
 208 }
 209
 210 sub clonePerlValue ($) {
 211         my $value = shift;
 212         my $ref = ref($value);
 213
 214         if (!$ref) {
 215                 return $value;
 216         } elsif ($ref eq 'ARRAY') {
 217                 my $array = [ map { &clonePerlValue($_) } @$value ];
 218                 return $array;
 219         } elsif ($ref eq 'HASH') {
 220                 my $hash = {};
 221                 foreach (keys %$value) { $hash->{$_} = &clonePerlValue($value->{$_}); }
 222                 return $hash;
 223         } elsif ($ref eq 'SCALAR') {
 224                 my $scalar = $$value;
 225                 return \$scalar;
 226         } else {
 227                 #errDie("Unsupported perl type $ref");
 228                 return $value;
 229         }
 230 }
 231
 232 # ----------------------------------------------------------------------------
 233
 234 sub loadFile ($) {
 235         my $fileName = shift;
 236
 237         open(FILE, "<$fileName") || sysDie("Can't open $fileName");
 238         my $fileContent = join("", <FILE>);
 239         close(FILE) || sysDie("Can't close $fileName");
 240         return \$fileContent;
 241 }
 242
 243 sub saveFile ($$;$$) {
 244         my ($fileName, $fileContentRef, $createDirs, $perm) = @_;
 245
 246         if ($createDirs) {
 247                 my $dirName = $fileName; $dirName =~ s:(^|/)[^/]*$::;
 248                 makePath($dirName, $perm) unless -d $dirName;
 249         }
 250         open(FILE, ">$fileName") || sysDie("Can't open $fileName");
 251         print FILE $$fileContentRef;
 252         close(FILE) || sysDie("Can't close $fileName");
 253 }
 254
 255 sub makePath ($;$) {
 256         my $dirName = shift;
 257         my $perm = shift || 0775;
 258         return if -d $dirName;
 259
 260         my $parentDir = $dirName; $parentDir =~ s:(^|/)[^/]+/?$::;
 261         &makePath($parentDir, $perm) unless -d $parentDir;
 262         mkdir($dirName, $perm) || sysDie("Can't mkdir $dirName");
 263 }
 264
 265 # should be internationalized?
 266 sub quantifyString ($$) {
 267         my ($num, $str) = @_;
 268         return "$num $str" . ($num != 1? "s": "");
 269 }
 270
 271 # ----------------------------------------------------------------------------
 272
 273 sub getExpandedRc ($) {
 274         my $file = shift;
 275         ### should detect infinitive loops?
 276         if (!-f $file) {
 277                 foreach (@searchPath) {
 278                         if (-f "$_/$file") { $file = "$_/$file"; last; }
 279                 }
 280         }
 281         if (!-f $file) {
 282                 return "#| File '$file' is not found\n";
 283         }
 284         my $dir = "";
 285         $dir = $1 if ($file =~ /^(\/.+\/)/);
 286
 287         my $output = "";
 288         foreach (`cat $file`) {
 289                 chomp; $_ .= "\n";
 290                 /^read\s+['`"]?([^\s'`"]+)/i && do { #`
 291                         my $file = $1;
 292                         if ($dir ne "" && $file =~ /^\$\.\/(.+)$/) {
 293                                 $file = "$dir/$1";
 294                         }
 295                         $output .= "#.---- start: $_";
 296                         $output .= &getExpandedRc($file);
 297                         $output .= "#`====== end: $_\n";
 298                         next;
 299                 };
 300                 $output .= $_;
 301         }
 302         return $output;
 303 }
 304
 305 sub searchThemeCfgIncludeFile ($$) {
 306         my ($file, $theme) = @_;
 307         my @subDirs = ($theme);
 308         if ($file =~ /^\.\.\/(.*)/) {
 309                 $file = $1;
 310                 unshift @subDirs, ".";
 311         }
 312         my $dir;
 313         foreach $dir (@searchPath) {
 314                 foreach (@subDirs) {
 315                         my $file = "$dir/$themesSubDir/$_/$file";
 316                         return $file if -f $file;
 317                 }
 318         }
 319         return undef;
 320 }
 321
 322 # unfortunately fvwm is inconsistent, so the second parameter.
 323 sub escapeMenuName ($;$) {
 324         my $name = shift;
 325         $name = "unknown" unless defined $name;  # maybe die?
 326         my $hasUnderline = shift;
 327         my $escapeStr = $hasUnderline? '\\': '&';
 328         $name =~ s/\\/\\\\/g;
 329         $name =~ s/&/$escapeStr&/g;
 330         $name;
 331 }
 332
 333 sub decodeCfgEntry ($;$) {
 334         my $str = shift;
 335         my $entry = shift || {};
 336
 337         $str =~ s/\s+$//s;
 338         $str =~ s/\r/\n/sg;
 339         foreach (split(/\n/s, $str)) {
 340                 s/^\s+//s;
 341                 next if /^#/;
 342                 next if $_ eq '';
 343
 344                 my ($key, $value) = split(/=/, $_, 2);
 345                 errDie("Incorrect cfg line: $_\n") unless $key && defined $value;
 346                 ## key1.key2:key3+key=value
 347                 ## $entry->{key1}->[-1]->{key2}->{key3}->[-1]->{key}=value
 348                 my $hash = $entry;
 349                 $key =~ /^(.*?)([^\+\.\:]+\+?)$/;
 350                 $key = $2;
 351                 my $lastKey = "_";
 352                 foreach (split(/([\+\.\:]+)/, $1)) {
 353                         /^:/ and do {
 354                                 $hash = ($hash->{$lastKey} ||= {});
 355                                 next;
 356                         };
 357                         /^[\+\.]/ and do {
 358                                 my $array = ($hash->{$lastKey} ||= []);
 359                                 /^\+/ and push @$array, {};
 360                                 $hash = $array->[-1];
 361                                 next;
 362                         };
 363                         errDie("Incorrect line key $_, not enough +'s")
 364                                 unless defined $hash;
 365                         $lastKey = $_;
 366                 }
 367                 if ($key =~ /^(.*)\+$/) {
 368                         $key = $1;
 369                         $hash->{$key} = []
 370                                 unless exists $hash->{$key} && ref($hash->{$key}) eq 'ARRAY';
 371                         push @{$hash->{$key}}, $value;
 372                 } else {
 373                         $hash->{$key} = $value;
 374                 }
 375         }
 376         return $entry;
 377 }
 378
 379 sub encodeCfgEntry ($) {
 380         my $entry = shift;
 381         my $str = "";
 382
 383         foreach (sort keys %$entry) {
 384                 my ($key, $value) = ($_, $entry->{$_});
 385                 if (!ref($value)) {
 386                         $str .= "$key=$value\n";
 387                 } elsif (ref($value) eq 'ARRAY') {
 388                         # ARRAY in HASH
 389                         next unless @$value;
 390                         my $ref = ref($value->[0]);
 391                         if (!$ref) {
 392                                 foreach (@$value) {
 393                                         $str .= "$key+=$_\n";
 394                                 }
 395                         } elsif ($ref eq 'ARRAY') {
 396                                 errDie("ARRAY in ARRAY is not supported");
 397                         } elsif ($ref eq 'HASH') {
 398                                 # ARRAY of HASH's in HASH
 399                                 foreach (@$value) {
 400                                         my $subStr = &encodeCfgEntry($_);
 401                                         my ($d, $c) = ('+', '.');
 402                                         $subStr =~ s/^(.*)$/my $a = "$key$d$1"; $d = $c; $a/mge;
 403                                         $str .= $subStr;
 404                                 }
 405                         } else {
 406                                 errDie("Unsupported perl type ($ref) in ARRAY");
 407                         }
 408                 } elsif (ref($value) eq 'HASH') {
 409                         # HASH in HASH
 410                         my $subStr = &encodeCfgEntry($value);
 411                         my $d = ':';
 412                         $subStr =~ s/^(.*)$/$key$d$1/mg;
 413                         $str .= $subStr;
 414                 } else {
 415                         errDie("Unsupported perl type ($value) in HASH");
 416                 }
 417         }
 418         return $str;
 419 }
 420
 421 use vars qw($cfgFileCache $cfgCacheFileStatus);
 422 BEGIN { $cfgFileCache = {}; $cfgCacheFileStatus = 0; }
 423
 424 my @dependencyKeys = qw(
 425         provides requires complements precedes follows
 426         local-imagepath start-stop uses auto-drops
 427         load-unload reload-unreload reload-read-command
 428         depends stronglydepends weakdepends
 429 );
 430
 431 # returns 0 if the given condition is false (so should be hidden), 1 - if true
 432 sub checkUnhideIf ($) {
 433         my $check = shift;
 434
 435         my ($cmd, $arg) = split(/[\s:]+/, $check, 2);
 436         if ($cmd eq 'in-path') {
 437                 my $dir;
 438                 my @pathDirs = split(':', $ENV{'PATH'});
 439                 foreach $dir (@pathDirs) {
 440                         return 1 if -x "$dir/$arg";
 441                 }
 442                 return 0;
 443         }
 444         if ($cmd eq 'env') {
 445                 # it is good to have the same logic as perl, 0 or "" is false
 446                 return !!$ENV{$arg};
 447         }
 448         if ($cmd eq 'fvwm-supports') {
 449                 return system("fvwm-config --supports-$arg") == 0;
 450         }
 451         if ($cmd eq 'has-fonts') {
 452                 my @fonts = split(',', $arg);
 453                 foreach (@fonts) {
 454                         s/^\s+//; s/\s+$//;
 455                         return 0 if `xlsfonts -fn '$_' 2> /dev/null` eq "";
 456                 }
 457                 return 1;
 458         }
 459
 460         #errWarn("Unsupported condition ($check) in unhide-if");
 461         return 1;
 462 }
 463
 464 sub loadThemeCfg ($) {
 465         my $theme = shift;
 466         loadCfgCacheFile() if $cfgCacheFileStatus == 0;
 467         return $cfgFileCache->{$theme} if exists $cfgFileCache->{$theme};
 468         my $cfgFile = searchThemeCfgIncludeFile($themeCfgFile, $theme);
 469         $cfgFile ||= searchThemeCfgIncludeFile($themeCfgFile, "default");
 470         errDie("No $themeCfgFile for $theme found") unless defined $cfgFile;
 471
 472         #return $cfgFileCache->{$theme} if exists $cfgFileCache->{$theme};
 473         my $cfg = [{}, {}];
 474
 475         my $strRef = loadFile($cfgFile);
 476         my %visitedFiles = ();
 477         while ($$strRef =~ s/^!include(-quiet)?\s+(.*)\s*$/
 478                 my $subCfgFile = searchThemeCfgIncludeFile($2, $theme);
 479                 errDir("No include $2 in $cfgFile") unless $1 || defined $subCfgFile;
 480                 if (defined $subCfgFile) {
 481                         if ($visitedFiles{$subCfgFile}) { errWarn(
 482                                 "Endless loop $cfgFile - $subCfgFile"); $subCfgFile = undef }
 483                         else { $visitedFiles{$subCfgFile} = 1; }
 484                 }
 485                 defined $subCfgFile? ${loadFile($subCfgFile)}: ""
 486         /meg) {}
 487
 488         while (1) {
 489                 last unless $$strRef =~ /(?:^|\n)\[(\w+)\](.*?)(|\n\[.*)$/s;
 490                 $$strRef = $3;
 491                 my $entryTag = $1;
 492                 my $entryStr = $2;
 493                 my $entry = {};
 494
 495                 if ($entryTag eq 'theme') {
 496                         $cfg->[0] = $entry;
 497                 } elsif ($entryTag eq 'component') {
 498                         $entryStr =~ /^$idKey\s*=\s*(.*)\s*$/m;
 499                         my $key = $1;
 500                         errDie("No '$idKey' value in entry [$entryTag] in $cfgFile") unless $key;
 501                         # check for unhide-if
 502                         while ($theme ne 'current' &&
 503                                 $entryStr =~ s/^unhide-if\s*=\s*(.*)\s*$//m)
 504                         {
 505                                 my $cmd = $1;
 506                                 $entry->{'hidden'} = 1 unless checkUnhideIf($cmd);
 507                         }
 508
 509                         # these defaults are probably ok
 510                         my $reuseDependences = 1;
 511                         my $reuseProperties = 0;
 512                         while ($entry =~ s/^!(reuse|reset)-(dependences|properties)\s*$//) {
 513                                 ($2 eq "dependences"? $reuseDependences: $reuseProperties) =
 514                                         ($1 eq "reuse"? 1: 0);
 515                         }
 516
 517                         if ($cfg->[1]->{$key} && ($reuseDependences || $reuseProperties)) {
 518                                 my $oldEntry = $cfg->[1]->{$key};
 519                                 if ($reuseProperties) {
 520                                         $entry = $oldEntry;
 521                                         unless ($reuseDependences) {
 522                                                 foreach (@dependencyKeys) {
 523                                                         delete $entry->{$_} if exists $entry->{$_};
 524                                                 }
 525                                         }
 526                                 } else {  # if ($reuseDependences)
 527                                         foreach (@dependencyKeys) {
 528                                                 $entry->{$_} = $oldEntry->{$_} if exists $oldEntry->{$_};
 529                                         }
 530                                 }
 531                         }
 532                         $cfg->[1]->{$key} = $entry;
 533                 } else {
 534                         print STDERR "Warning: unknown entry [$entryTag], ignoring...\n";
 535                         next;
 536                 }
 537                 decodeCfgEntry($entryStr, $entry);
 538         }
 539
 540         # check for unhide-if
 541         my $components = $cfg->[0]->{$componentKey};
 542         my @allComponents = ();
 543         if ($theme ne 'current' && defined $components) {
 544                 push @allComponents, @$components;
 545         }
 546         my $comp;
 547         foreach $comp (@allComponents) {
 548                 my $contains = $cfg->[1]->{$comp}->{'contains'};
 549                 next unless ref($contains) eq 'ARRAY';
 550                 my $subComponent;
 551                 foreach $subComponent (@$contains) {
 552                         push @allComponents, "$comp/$subComponent";
 553                         if ($cfg->[1]->{"$comp"}->{'hidden'}) {
 554                                 $cfg->[1]->{"$comp/$subComponent"}->{'hidden'} = 1;
 555                         }
 556                 }
 557         }
 558         foreach $comp (@allComponents) {
 559                 my $variants = $cfg->[1]->{$comp}->{'variant'};
 560                 next unless ref($variants) eq 'ARRAY';
 561                 my $i;
 562                 for ($i = 0; $i < @$variants; $i++) {
 563                         my $unhideIfs = $variants->[$i]->{'unhide-if'};
 564                         next unless defined $unhideIfs;
 565                         $unhideIfs = [ $unhideIfs ] if ref($unhideIfs) ne 'ARRAY';
 566                         foreach (@$unhideIfs) {
 567                                 $variants->[$i]->{'hidden'} = 1 unless checkUnhideIf($_);
 568                         }
 569                         delete $variants->[$i]->{'unhide-if'};
 570                 }
 571         }
 572
 573 #       # leave only real components
 574 #       my $components = $cfg->[0]->{$componentKey};
 575 #       errDie("No '$componentKey' in entry [theme]") unless ref($components) eq 'ARRAY';
 576 #       my @realComponents = ();
 577 #       foreach (@$components) {
 578 #               my $themeDir = getThemeDir($cfg->[1]->{$_}->{$themeKey});
 579 #               my $file = "$themeDir/$_";
 580 #               push @realComponents, $_ if -e $file;
 581 #       }
 582 #       $cfg->[0]->{$componentKey} = [sort @realComponents];
 583
 584         $cfgFileCache->{$theme} = $cfg;
 585         saveCfgCacheFile($theme,$cfg);
 586         return $cfg;
 587 }
 588
 589 sub loadCfgCacheFile () {
 590         $cfgCacheFileStatus = 1;
 591         return if $workDir ne $userDir;
 592
 593         my @cacheFiles = ("$userDir/$cfgCacheFileName");
 594         my $file;
 595         foreach $file (@cacheFiles) {
 596                 if (-f "$file") {
 597                         eval {
 598                                 require "$file";
 599                         };
 600                         if ($@) {
 601                                 print STDERR "Warning: a problem arised when loading " .
 602                                         "$file:\n$@\n";
 603                                 unlink "$file";
 604                         }
 605                 }
 606         }
 607 }
 608
 609 sub saveCfgCacheFile ($$) {
 610         my $theme = shift;
 611         my $cfg = shift;
 612         return if $theme eq "current" || $workDir ne $userDir;
 613         if ($cfgCacheFileStatus == 1) {
 614                 open(CACHE_FILE,">$userDir/$cfgCacheFileName");
 615                 $cfgCacheFileStatus = 2;
 616         }
 617         {
 618                 require Data::Dumper;
 619                 # compact as possible: 50% more fast
 620                 local $Data::Dumper::Indent;
 621                 local $Data::Dumper::Quotekeys;
 622                 $Data::Dumper::Indent = 0;
 623                 $Data::Dumper::Quotekeys = 0;
 624                 my $str = "";
 625                 my $var = "\$cfgFileCache->{'$theme'}";
 626                 $str = Data::Dumper->Dump([$cfg],["$var"]);
 627                 print CACHE_FILE $str . "\n";
 628         }
 629 }
 630
 631 sub saveThemeCfg ($$) {
 632         my ($theme, $cfg) = @_;
 633         errDie("Parameter should be ARRAY") unless ref($cfg) eq 'ARRAY';
 634         my ($themeCfg, $componentCfgs) = @$cfg;
 635         errDie("Parameter should be [HASH, HASH]")
 636                 unless ref($themeCfg) eq 'HASH' && ref($componentCfgs) eq 'HASH';
 637
 638         my $str = "";
 639         $str .= "[theme]\n" . encodeCfgEntry($themeCfg) . "\n";
 640         foreach (sort keys %$componentCfgs) {
 641                 $str .= "[component]\n" . encodeCfgEntry($componentCfgs->{$_}) . "\n";
 642         }
 643
 644         my $cfgFile = "$workDir/$themesSubDir/$theme/$themeCfgFile";
 645         saveFile($cfgFile, \$str, 1);
 646 }
 647
 648 sub parseComponentName ($) {
 649         my $name = shift;
 650         return ($2, $1) if $name =~ /^(.*?)@(.*)$/;
 651 #       errDie("Incorrect component name $name, should be component\@theme");
 652         return (undef, $name);
 653 }
 654
 655 sub getThemeDir ($) {
 656         my $theme = shift;
 657         my $dir;
 658         foreach $dir (@searchPath) {
 659                 my $dir = "$dir/$themesSubDir/$theme";
 660                 return $dir if -d $dir;
 661         }
 662         errDie("No theme '$theme' found");
 663 }
 664
 665 sub getThemeComponents ($) {
 666         my $theme = shift;
 667
 668         my $themeDir = getThemeDir($theme);
 669         my @allComponents = keys %{loadThemeCfg($theme)->[1]};
 670         return [ sort @allComponents ] if $theme eq $currentThemeName;
 671
 672         my @components = ();
 673         foreach (@allComponents) {
 674                 next if m:/:; ### for now
 675                 my $file = "$themeDir/$_";
 676                 push @components, $_ if -e $file || -d "$file.d";
 677         }
 678         return [sort @components];
 679
 680 #       my @components = keys %{loadThemeCfg($theme)->[1]};
 681 #       return \@components;
 682 }
 683
 684 sub getThemeNameAndComponentsAndGroups ($) {
 685         my $theme = shift;
 686
 687         my $components = getThemeComponents($theme);
 688         my $themeCfg = loadThemeCfg($theme)->[0];
 689         my $name = $themeCfg->{'name'} || ucfirst($theme);
 690         my $groups = clonePerlValue($themeCfg->{$componentGroupKey});
 691         # use reasonable default if not given
 692         $groups = [ { 'name' => "all", $componentKey => ['*'] } ] unless ref($groups) eq 'ARRAY';
 693         foreach (@$groups) {
 694                 my $groupComponents = $_->{$componentKey};
 695                 # for technical reasons [ "" ] represents all components to load
 696                 $_->{$componentKey} =
 697                         (ref($groupComponents) ne 'ARRAY' || @$groupComponents == 1 && $groupComponents->[0] =~ /^\*?$/)?
 698                         [ "" ]: conjunctArrays($components, $groupComponents);
 699         }
 700         return ($name, $components, $groups);
 701 }
 702
 703 ### for backward compatibility, should be removed and all usage updated
 704 sub getThemeComponentsAndGroups ($) {
 705         my ($name, $components, $groups) = getThemeNameAndComponentsAndGroups($_[0]);
 706         return ($components, $groups);
 707 }
 708
 709 sub getAllThemes (;$$) {
 710         my $onlySite = shift || 0;
 711         my $onlyUser = shift || 0;
 712         my @dirList = ();
 713         push @dirList, $siteDir if $onlySite;
 714         push @dirList, $userDir if $onlyUser;
 715         @dirList = @searchPath unless @dirList;
 716         my $themes = {};
 717         my $dir;
 718         foreach $dir (@dirList) {
 719                 my $dir = "$dir/$themesSubDir";
 720                 opendir(DIR, $dir);
 721                 foreach (readdir(DIR)) {
 722                         next if /^\./ || $_ =~ /^$currentThemeName/;
 723                         next unless -d "$dir/$_";
 724                         next if exists $themes->{$_};
 725                         $themes->{$_} = 1;
 726                 }
 727                 closedir(DIR);
 728         }
 729         return [sort keys %$themes];
 730 }
 731
 732 sub showThemeComponents ($$$$$$) {
 733         my ($themes, $withComponents, $component, $script, $onlySite, $onlyUser) = @_;
 734         my $output = "";
 735         my $delim0 = $script? "    ": "\t";
 736         my $delim1 = $script? "|": "\n";
 737         $themes = getAllThemes($onlySite, $onlyUser) unless @$themes;
 738
 739         my $theme;
 740         foreach $theme (@$themes) {
 741                 my $components = getThemeComponents($theme);
 742                 next if defined $component && !isArrayElement($components, $component);
 743                 $output .= $theme . $delim1;
 744                 if ($withComponents) {
 745                         foreach (@$components) {
 746                                 $output .= $delim0 . $_ . $delim1;
 747                         }
 748                 }
 749                 $output =~ s/\Q$delim1\E$/\n/ if $script;
 750         }
 751         print $output;
 752         exit(0);
 753 }
 754
 755 sub showThemeDirs ($) {
 756         my $themes = shift;
 757         $themes = getAllThemes() unless @$themes;
 758         my $theme;
 759         foreach $theme (@$themes) {
 760                 print getThemeDir($theme) . "\n";
 761         }
 762         exit(0);
 763 }
 764
 765 sub getComponentCfgByName ($) {
 766         my $component = shift;
 767         my $theme;
 768         ($theme, $component) = parseComponentName($component);
 769         errDie("No component name in '$component' given") unless $component;
 770         $theme ||= 'current';
 771
 772         my $cc = loadThemeCfg($theme)->[1]->{$component};
 773         errDie("Can't find component '$component' in theme '$theme'") unless $cc;
 774         return ($cc, $theme, $component);
 775 }
 776
 777 sub showThemeComponentInfo ($) {
 778         my $component = shift;
 779         my ($cc, $theme);
 780         ($cc, $theme, $component) = getComponentCfgByName($component);
 781
 782         $theme = $cc->{'theme'} if $cc->{'theme'};
 783         my $numComponents = @{getThemeComponents($theme)};
 784         my ($str, @propStrs, @currStrs) = ("");
 785         my $lockedStr = $cc->{'locked'}? " (locked)": "";
 786         my $readFile = $cc->{'read-file'};
 787
 788         push @propStrs, quantifyString(0 + @{$cc->{'contains'}}, "subcomponent")
 789                 if $cc->{'contains'};
 790         my $variants = $cc->{'variant'};
 791         if (ref($variants) eq 'ARRAY') {
 792                 push @propStrs, quantifyString(0 + @$variants, "variant");
 793                 push @currStrs, $variants->[$cc->{'current'} - 1]->{'name'} || '*error*';
 794         }
 795         my $options = $cc->{'option'};
 796         if (ref($options) eq 'ARRAY') {
 797                 my $num = @$options;
 798                 my $valuesStr = join(' * ', map { 0 + @{$_->{'value'}} } @$options);
 799                 push @propStrs, quantifyString($num, "option") . " ($valuesStr choices)";
 800                 foreach (@$options) {
 801                         push @currStrs, $_->{'name'} . ": " .
 802                                 ($_->{'value'}->[$_->{'current'} - 1]->{'name'} || '*error*');
 803                 }
 804         }
 805
 806
 807         $str .= "Theme:      $theme ($numComponents components)\n";
 808         $str .= "Component:  $component$lockedStr\n";
 809         $str .= "Properties: " . (@propStrs? join(", ", @propStrs): "none") . "\n";
 810         $str .= "Current:    " . join("; ", @currStrs) . "\n" if @currStrs;
 811         $str .= "Read File:  $readFile\n" if $readFile;
 812
 813         $str = q(FuncFvwmShowMessage "Component Info" ') .
 814                 join('^n', split(/\n/, $str)) . q(') if $pipe;
 815         print $str;
 816         exit(0);
 817 }
 818
 819 sub showThemeComponentCfg ($) {
 820         my $component = shift;
 821         my ($cc, $theme);
 822         ($cc, $theme, $component) = getComponentCfgByName($component);
 823
 824         print dumpPerlValue($cc);
 825         exit(0);
 826 }
 827
 828 sub showThemeComponentValues ($$) {
 829         my ($component, $keys) = @_;
 830         my ($cc, $theme);
 831         ($cc, $theme, $component) = getComponentCfgByName($component);
 832
 833         my $key;
 834         foreach $key (@$keys) {
 835                 my $value = $cc->{$key};
 836 #               errDie("No key '$key' defined in component '$component\@$theme' cfg")
 837                 $value = "*undefined*"
 838                         unless defined $value;
 839                 print dumpPerlValue($value);
 840         }
 841         exit(0);
 842 }
 843
 844 sub createCurrentImageDirLinks ($$) {
 845         my ($theme, $subdirs) = @_;
 846         my $srcDir = getThemeDir($theme) . "/$imagesSubDir";
 847         my $dstDir = "$workDir/$currentThemeSubDir/$imagesSubDir";
 848         makePath($dstDir) unless -d $dstDir;
 849         foreach (@$subdirs) {
 850                 my $srcFile = "$srcDir/$_";
 851                 my $dstLink = "$dstDir/$_";
 852                 unlink($dstLink); # || sysDie("Can't unlink $dstLink")
 853                         #if -e $dstLink;
 854                 symlink($srcFile, $dstLink) || sysDie("Can't symlink $srcFile $dstLink");
 855         }
 856 }
 857
 858 sub getHashIdArrayIndex ($$) {
 859         my ($array, $id) = @_;
 860         my ($index, $i) = -1;
 861         for ($i = 0; $i < @$array; $i++) {
 862                 if ($id eq $array->[$i]->{$idKey}) {
 863                         $index = $i + 1; last;
 864                 }
 865         }
 866         $index = $1 if $index < 0 && $id =~ /^\s*(\d+)\s*$/;
 867         return $index;
 868 }
 869
 870 # ----------------------------------------------------------------------------
 871
 872 package FVWM::ThemeCfg;
 873
 874 sub AUTOLOAD ($@) {
 875         my $func = $FVWM::ThemeCfg::AUTOLOAD;
 876         $func =~ s/.*://g;
 877         $func = "main::$func";
 878         no strict 'refs';
 879         &$func(@_);
 880 }
 881
 882 sub DESTROY ($) {}
 883
 884 sub new ($$;$$) {
 885         my $this  = shift;
 886         my $class = ref($this) || $this;
 887         my $theme = shift;
 888         my $loadTheme = shift || $theme;
 889         my $fresh = shift || 0;
 890
 891         my $self = {
 892                 $idKey => $theme,
 893                 'name' => ucfirst($theme),
 894                 'cc'   => {},
 895         };
 896         bless($self, $class);
 897         $self->setModified($fresh || $theme ne $loadTheme? 1: 0);
 898
 899         my ($themeCfg, $componentCfgs) = @{loadThemeCfg($loadTheme)};
 900         my ($key, $value);
 901         while (($key, $value) = each %$themeCfg) {
 902                 $self->{$key} = ($key eq $componentKey
 903                         && $loadTheme !~ /^$currentThemeName/)?
 904                         getThemeComponents($loadTheme): $value;
 905         }
 906         errDie("No '$componentKey' key in theme '$loadTheme' cfg") unless exists $self->{$componentKey};
 907         my $dir = getThemeDir($loadTheme);
 908         my @components = ('_core', @{$self->{$componentKey}});
 909
 910         my $subComponentParentTheme = {};  # to handle newly added subcomponents
 911         my $cindex = -1;  # because of '_core'
 912         my $component;
 913         while ($component = shift(@components)) {
 914                 my $componentCfg = $componentCfgs->{$component};
 915                 my $realTheme = $loadTheme;
 916                 my $cc;
 917                 if ($fresh) {
 918                         $realTheme = $componentCfg->{$themeKey}
 919                                 || $subComponentParentTheme->{$component} || "*unknown*";
 920                         my $origComponentCfg = loadThemeCfg($realTheme)->[1]->{$component};
 921                         unless ($origComponentCfg) {
 922                                 errWarn("Theme '$realTheme' has no component '$component' anymore, auto-dropping");
 923                                 splice(@{$self->{$componentKey}}, $cindex, 1);
 924                                 next;
 925                         }
 926                         $dir = getThemeDir($realTheme);
 927                         $cc = clonePerlValue($origComponentCfg);
 928
 929                         $cc->{'memory'} = $componentCfg->{'memory'}
 930                                 if exists $componentCfg->{'memory'};
 931                         $cc->{'stop'} = $componentCfg->{'stop'}
 932                                 if exists $componentCfg->{'stop'};
 933                         $cc->{'locked'} = $componentCfg->{'locked'}
 934                                 if exists $componentCfg->{'locked'};
 935                         $cc->{'current'} = $componentCfg->{'current'}
 936                                 if exists $componentCfg->{'current'};
 937                         $cc->{'minimalReload'} = $componentCfg->{'minimalReload'}
 938                                 if exists $componentCfg->{'minimalReload'};
 939                         if (ref($componentCfg->{'option'}) eq 'ARRAY') {
 940                                 my $i;
 941                                 for ($i = 0; $i < @{$componentCfg->{'option'}}; $i++) {
 942                                         my $currIndex = $componentCfg->{'option'}->[$i]->{'current'};
 943                                         $cc->{'option'}->[$i]->{'current'} = $currIndex if $currIndex;
 944                                 }
 945                         }
 946                 } else {
 947                         $cc = clonePerlValue($componentCfg);
 948                 }
 949                 $cc->{$themeKey} = $realTheme unless $cc->{$themeKey};
 950                 if (ref($cc->{'contains'}) eq 'ARRAY') {
 951                         push @components, map {
 952                                 my $component0 = "$component/$_";
 953                                 $subComponentParentTheme->{$component0} = $cc->{$themeKey};
 954                                 $component0
 955                         } @{$cc->{'contains'}};
 956                 }
 957
 958                 my $readFile;
 959                 unless (exists $cc->{'read-file'}) {
 960                         if (ref($cc->{'contains'}) eq 'ARRAY') {
 961                                 $readFile = "";
 962                         } elsif ($component eq '_core') {
 963                                 $readFile = "*virtual*";
 964                         } else {
 965                                 $readFile = "$dir/$component";
 966                                 $readFile .= ".d" if -d "$readFile.d" && !-e $readFile;
 967                                 $readFile .= "/$mainDirFile" if -d $readFile;
 968                         }
 969                         $cc->{'read-file'} = $readFile;
 970                 }
 971                 $cc->{'locked'} = 0 unless exists $cc->{'locked'};
 972                 $cc->{'used'} = 1;
 973                 $cc->{'used'} = 3 if (($fresh && $cc->{'used'})||$loadTheme eq 'default');
 974                 errDie("Duplicated component '$component' for theme '$theme'")
 975                         if exists $self->{'cc'}->{$component} &&
 976                                 $self->{'cc'}->{$component}->{'used'};
 977                 $self->{'cc'}->{$component} = $cc;
 978                 $cindex++;
 979         }
 980         return $self;
 981 }
 982
 983 sub save ($) {
 984         my $self = shift;
 985
 986         my ($themeCfg, $componentCfgs) = ( {}, {} );
 987
 988         my ($key, $value, $comp, $cfg);
 989         while (($key, $value) = each %$self) {
 990                 next if $key =~ /^_/ || $key eq 'cc' || $key eq 'mc';
 991                 $themeCfg->{$key} = $value;
 992         }
 993         while (($comp, $cfg) = each %{$self->{'cc'}}) {
 994                 $componentCfgs->{$comp} = {};
 995                 while (($key, $value) = each %$cfg)
 996                         { $componentCfgs->{$comp}->{$key} = $value; }
 997         }
 998         saveThemeCfg($self->{$idKey}, [$themeCfg, $componentCfgs]);
 999 }
1000
1001 sub isModified ($) {
1002         my $self = shift;
1003         return $self->{'_isModified'};
1004 }
1005
1006 sub setModified ($;$) {
1007         my $self = shift;
1008         $self->{'_isModified'} = @_? shift: 1;
1009 }
1010
1011 sub setMinimalReload ($;$) {
1012         my $self = shift;
1013         my $value = shift;
1014         my $mr = 1;
1015         if (defined $self->{'cc'}->{'_core'}->{'minimalReload'}) {
1016                 $mr = $self->{'cc'}->{'_core'}->{'minimalReload'}
1017         }
1018         if ($value != $mr) {
1019                 $self->{'cc'}->{'_core'}->{'minimalReload'} = $value;
1020                 $self->setModified();
1021         }
1022 }
1023
1024 sub isMinimalReload ($) {
1025         my $self = shift;
1026         my $value = 1;
1027         if (defined $self->{'cc'}->{'_core'}->{'minimalReload'}) {
1028                 $value = $self->{'cc'}->{'_core'}->{'minimalReload'}
1029         }
1030         return $value;
1031 }
1032
1033 sub hasComponent ($$) {
1034         my $self = shift;
1035         my $component = shift;
1036         return isArrayElement($self->{$componentKey}, $component);
1037 }
1038
1039 #olicha: maybe not useful??
1040 sub hasComponentCfg ($$) {
1041         my $self = shift;
1042         my $component = shift;
1043         return 1 if $self->{'cc'}->{$component};
1044         return 0;
1045 }
1046
1047 sub getComponentCfg ($$) {
1048         my $self = shift;
1049         my $component = shift;
1050         my $cfg = $self->{'cc'}->{$component};
1051         errDie("No component '$component' cfg in theme $self->{'name'}")
1052                 unless defined $cfg;
1053         return $cfg;
1054 }
1055
1056 sub setComponentCfg ($$$) {
1057         my $self = shift;
1058         my $component = shift;
1059         $self->{'cc'}->{$component} = shift;
1060 }
1061
1062 sub storeThemeComponentMemory ($$$) {
1063         my $self = shift;
1064         my ($theme, $component) = @_;
1065         my $cc = $self->getComponentCfg($component);
1066         my $cm = {};
1067
1068         if (ref($cc->{'variant'}) eq 'ARRAY' && $cc->{'current'} &&
1069                 !$cc->{'variant'}->[$cc->{'current'} - 1]->{'hidden'})
1070         {
1071                 $cm->{'current'} = $cc->{'current'};
1072         }
1073         my $options = $cc->{'option'};
1074         if (ref($options) eq 'ARRAY' && @$options) {
1075                 my $o;
1076                 $cm->{'option'} = [];
1077                 my $isSet = 0;
1078                 for ($o = 0; $o < @$options; $o++) {
1079                         my $index = $options->[$o]->{'current'};
1080                         ### we should probably store names not indexes (or both)
1081                         push @{$cm->{'option'}}, { 'current' => ($index || "") };
1082                         $isSet = 1 if $index;
1083                 }
1084                 delete $cm->{'option'} unless $isSet;
1085         }
1086
1087         return unless keys %$cm;
1088         $cm->{'time'} = time();
1089
1090         my $_c = $self->getComponentCfg("_core");
1091         my $memory = ( $_c->{'memory'} ||= {} );
1092         my $themeMemory = ( $memory->{$theme} ||= {} );
1093         $themeMemory->{$component} = $cm;
1094 }
1095
1096 sub applyThemeComponentMemory ($$$) {
1097         my $self = shift;
1098         my ($theme, $component) = @_;
1099
1100         my $_c = $self->getComponentCfg("_core");
1101         my $memory = $_c->{'memory'};
1102         return unless ref($memory) eq 'HASH';
1103         my $themeMemory = $memory->{$theme};
1104         return unless ref($themeMemory) eq 'HASH';
1105         my $cm = $themeMemory->{$component};
1106         return unless ref($cm) eq 'HASH';
1107
1108         # delete component memory if older then 6 months
1109         if (time() - $cm->{'time'} > 6 * 30 * 24 * 60 * 60) {
1110                 delete $themeMemory->{$component};
1111                 return;
1112         }
1113         my $cc = $self->getComponentCfg($component);
1114
1115         if ($cm->{'current'} && ref($cc->{'variant'}) eq 'ARRAY') {
1116                 if ($cc->{'variant'}->[$cm->{'current'} - 1]->{'hidden'}) {
1117                         delete $themeMemory->{$component};
1118                         return;
1119                 }
1120                 $cc->{'current'} = $cm->{'current'};
1121         }
1122
1123         my $mOptions = $cm->{'option'};
1124         my $options = $cc->{'option'};
1125         if (ref($mOptions) eq 'ARRAY' && ref($options) eq 'ARRAY') {
1126                 if (@$mOptions != @$options) {
1127                         delete $themeMemory->{$component};
1128                         return;
1129                 }
1130                 my $o;
1131                 for ($o = 0; $o < @$options; $o++) {
1132                         my $currIndex = $mOptions->[$o]->{'current'};
1133                         $options->[$o]->{'current'} = $currIndex if $currIndex;
1134                 }
1135         }
1136 }
1137
1138 # olicha: I've done a lot of modif in this function:
1139 # subcomponent are automaticaly (un)loaded and option and
1140 # variant are saved here. I've used a new "cfg command" called
1141 # 'used' for unloading the 'cc' component since I've got some
1142 # difficulty to do the unloading by freeing memory ...
1143 sub useNewComponents ($$$;$) {
1144         my $self = shift;
1145         my $loadComponents = shift;
1146         my $dropComponents = shift;
1147         my $isSubComponent = shift || 0;
1148         return unless @$loadComponents || @$dropComponents;
1149         $self->setModified();
1150
1151         foreach (@$dropComponents) {
1152                 my ($theme, $component) = parseComponentName($_);
1153                 errDie("Wrong component '$_' to drop specified")
1154                         unless $component;
1155                 my $index = getArrayElementIndex($self->{$componentKey}, $component);
1156                 errDie("Can't find component '$component' to drop")
1157                         unless (defined $index || $isSubComponent);
1158                 my $cc = $self->getComponentCfg($component);
1159                 my $origTheme = $cc->{'theme'};
1160                 errDie("Can't find component '$component\@$theme' to drop")
1161                         if $theme && $theme ne $origTheme;
1162
1163                 ### not finished, should check dependancies before deleting
1164                 ### olicha: still not finished but subcomponent are automatically
1165                 ### unloaded
1166                 splice(@{$self->{$componentKey}}, $index, 1) if defined $index;
1167
1168                 if ($self->hasComponentCfg($component)) {
1169                         $self->storeThemeComponentMemory($origTheme, $component);
1170                         $cc->{'used'} = 0;
1171                         my $contains = $cc->{'contains'};
1172                         if (ref($contains) eq 'ARRAY') {
1173                                 my @dropSubComponents =
1174                                         map { "$component/$_" } @$contains;
1175                                 $self->useNewComponents([], \@dropSubComponents, 1);
1176                         }
1177                 } else {
1178                         errDie("Internal error; component $component.");
1179                 }
1180         }
1181
1182         ### not very correct implementation temporarily
1183         ### olicha: still not correct but there is a support for sub components
1184         foreach (@$loadComponents) {
1185                 my ($theme, $component) = parseComponentName($_);
1186                 if ($theme && $component eq "") {
1187                         my @components = grep {
1188                                 my $cc = $self->{'cc'}->{$_}; !$cc || !$cc->{'locked'}
1189                         } @{getThemeComponents($theme)};
1190                         foreach (@components) { $_ .= "\@$theme"; }
1191                         errDie("All components in \@$theme are locked, unlock first")
1192                                 unless @components;
1193                         $self->useNewComponents(\@components, []);
1194                         next;
1195                 }
1196                 errDie("Wrong component '$_' to load specified")
1197                         unless $component && $theme;
1198
1199                 $self->useNewComponents([], [$component], 0)
1200                         if $self->hasComponent($component);
1201                 push @{$self->{$componentKey}}, $component
1202                         unless $isSubComponent;
1203
1204                 my $themeCfg = new FVWM::ThemeCfg($theme);
1205                 my $cc = $themeCfg->getComponentCfg($component);
1206                 #ccds 1
1207                 $cc->{'used'} = 3;
1208                 $self->setComponentCfg($component, $cc);
1209                 $self->applyThemeComponentMemory($theme, $component);
1210
1211                 if (ref($cc->{'auto-drops'}) eq 'ARRAY') {
1212                         my @compsToDrop = grep {
1213                                 $self->hasComponent($_) &&
1214                                         !($self->getComponentCfg($_)->{'locked'} || 0)
1215                         } @{$cc->{'auto-drops'}};
1216                         $self->useNewComponents([], \@compsToDrop, 0) if @compsToDrop;
1217                 }
1218
1219                 my $imageDirs = $cc->{'local-imagepath'};
1220                 createCurrentImageDirLinks($theme, $imageDirs)
1221                         if ref($imageDirs) eq 'ARRAY';
1222
1223                 my $contains = $cc->{'contains'};
1224                 if (ref($contains) eq 'ARRAY') {
1225                         my $load = [];
1226                         @$load = map { "$component/$_\@$theme" } @{$cc->{'contains'}};
1227                         $self->useNewComponents($load, [], 1);
1228                 }
1229
1230         }
1231 }
1232
1233 sub setNewComponentValues ($$$$) {
1234         my $self = shift;
1235         my ($options, $variants, $setLocks) = @_;
1236         return unless keys %$options || keys %$variants || keys %$setLocks;
1237         $self->setModified();
1238
1239         my ($key, $value);
1240         while (($key, $value) = each %$options) {
1241                 my ($component, $option) = split(':', $key);
1242                 errDie("Bad option format '$key'")
1243                         unless defined $component && defined $option;
1244                 my $cc = $self->getComponentCfg($component);
1245                 my $options = $cc->{'option'};
1246                 my $index = getHashIdArrayIndex($options, $option);
1247                 errDie("Unexisting option '$option' in component '$component'")
1248                         if $index <= 0 || $index > @$options;
1249                 my $optionEntry = $options->[$index - 1];
1250                 my $values = $optionEntry->{'value'};
1251                 my $index2 = getHashIdArrayIndex($values, $value);
1252                 $index2 = ($optionEntry->{'default'} || 1) if $index2 == 0;
1253                 errDie("Unexisting option value '$index2' in option '$component:$option'")
1254                         if $index2 <= 0 || $index2 > @$values;
1255                 #ccds: 1
1256                 $cc->{'used'} = 3;
1257                 $self->setComponentCfg($component, $cc);
1258                 $optionEntry->{'current'} = $index2;
1259         }
1260
1261         my ($component, $variant);
1262         while (($component, $variant) = each %$variants) {
1263                 my $cc = $self->getComponentCfg($component);
1264                 my $variants = $cc->{'variant'};
1265                 my $index = getHashIdArrayIndex($variants, $variant);
1266                 $index = $cc->{'default'} if $index == 0;
1267                 errDie("Unexisting variant '$variant' in component '$component'")
1268                         if $index <= 0 || $index > @$variants;
1269                 if ($variants->[$index-1]->{'hidden'}) {
1270                         $index = $cc->{'default'};
1271                         errWarn(
1272                                 "Variant '$variant' in component '$component' is not supported " .
1273                                 "by your system.\nUse the default variant, you may need " .
1274                                 "to refresh with no cache.\n"
1275                         );
1276                 }
1277                 #ccds: 1
1278                 $cc->{'used'} = 3;
1279                 $self->setComponentCfg($component, $cc);
1280                 $cc->{'current'} = $index;
1281         }
1282
1283         while (($component, $value) = each %$setLocks) {
1284                 errDie("The locked value should be 0 or 1, not '$value'")
1285                         if $value !~ /^[01]$/;
1286                 my $cc = $self->getComponentCfg($component);
1287                 $cc->{'locked'} = $value;
1288         }
1289 }
1290
1291 sub getAllThemeSubMenusRc ($) {
1292         my $self = shift;
1293         my $currentComponents = $self->{$componentKey};
1294         my $allThemes = getAllThemes();
1295         my $listRc = "";
1296         my $menuRc = "";
1297
1298         my $theme;
1299         foreach $theme (@$allThemes) {
1300                 my ($name, $components, $groups) =
1301                         getThemeNameAndComponentsAndGroups($theme);
1302                 my $used = 0;
1303
1304                 $menuRc .= qq(DestroyMenu "MenuFvwmTheme-$theme"\n);
1305                 $menuRc .= qq(AddToMenu   "MenuFvwmTheme-$theme" "Load components" Title\n);
1306                 foreach (@$groups) {
1307                         my $name = escapeMenuName($_->{'name'});
1308                         my $groupComponents = $_->{$componentKey};
1309                         my $groupAction = !@$groupComponents? "Nop":
1310                                 'FuncFvwmThemesConfigAndUpdate "' . join(' ',
1311                                         map { "--load $_\@$theme" } @$groupComponents) . '"';
1312                         $menuRc .= qq(+ "[ $name ]%menu/item.xpm%"\t$groupAction\n);
1313                 }
1314                 $menuRc .= qq(+ "" Nop\n);
1315                 $menuRc .= join('', map {
1316                         my $used0 = isArrayElement($currentComponents, $_) &&
1317                                 ($self->getComponentCfg($_)->{$themeKey} || "") eq $theme;
1318                         $used ||= $used0;
1319                         my $label = "$_"; $label .= "\t(used)" if $used0;
1320 #                       m:/:? "":  # ignore contained components for now
1321                         qq(+ "$label%menu/item.xpm%"\tFuncFvwmThemesLoad "$_\@$theme"\n)
1322                 } @$components);
1323
1324                 my $readmeFile = getThemeDir($theme) . "/README";
1325                 if (-r $readmeFile) {
1326                         $menuRc .= qq(+ "" Nop\n);
1327                         $menuRc .= qq(+ "README%menu/information.xpm%"\tFuncFvwmViewFile "$readmeFile"\n);
1328                 }
1329                 my $label = "$name"; $label .= "\t(used)" if $used;
1330                 $listRc .= qq(+ "$label%menu/folder.xpm%"\tPopup "MenuFvwmTheme-$theme"\n);
1331         }
1332         return ($listRc, $menuRc);
1333 }
1334
1335 sub getOwnThemeSubMenusRc ($) {
1336         my $self = shift;
1337         my $currentComponents = [sort keys %{$self->{cc}}];  # $self->{$componentKey};
1338         my $name = $self->{'name'};
1339         my $id = $self->{$idKey};
1340         my $selfMenuName = "MenuFvwmTheme-$id";
1341         my $listRc = qq(+ "$name%menu/folder.xpm%"\tPopup "$selfMenuName"\n);
1342         my @menuRc = ("", "", "");  # 3 parts of the component menu
1343         my $menusRc = "";
1344         my $dropExtraArgs = "";
1345
1346         # check if the menustyle implies no mini icon:
1347         my $noIconsInMenus = 0;
1348         my $hints = $self->getComponentNamedValue("menustyle", 'hints');
1349         if (defined $hints) {
1350                 foreach (@$hints) {
1351                         $noIconsInMenus = 1 if $_ eq "no_icons_in_menus";
1352                 }
1353         }
1354
1355         $menuRc[0] .= qq(DestroyMenu "$selfMenuName"\n);
1356         $menuRc[0] .= qq(AddToMenu   "$selfMenuName" "$name Theme" Title\n);
1357         foreach (@$currentComponents) {
1358                 next if /^_/;
1359                 my $cc = $self->getComponentCfg($_);
1360                 next unless $cc->{'used'};
1361                 next if $cc->{'hidden'};
1362                 $dropExtraArgs .= " --drop $_" if /-extra$/;
1363
1364                 my $name = escapeMenuName($cc->{'name'} || $_);
1365                 my $currMenu = "$selfMenuName/$_";
1366                 $menusRc .= qq(DestroyMenu "$currMenu"\n);
1367                 $menusRc .= qq(AddToMenu   "$currMenu" "$name" Title\n);
1368                 my $m = 2;
1369                 my $contains = $cc->{'contains'};
1370
1371                 if (ref($contains) eq 'ARRAY') {
1372                         # a complex component, create a menu of subcomponents
1373                         my $subComponent;
1374                         foreach $subComponent (@$contains) {
1375                                 my $subcc = $self->getComponentCfg("$_/$subComponent");
1376                                 next if $subcc->{'hidden'};
1377                                 my $name = $subcc->{'name'};
1378                                 $name = escapeMenuName($name || $subComponent);
1379                                 $menusRc .= qq(+ "$name"\tPopup "$currMenu/$subComponent"\n);
1380                         }
1381                         $m = $cc->{'priority'}? 0: 1;
1382                 } else {
1383                         my $options = $cc->{'option'};
1384                         if (ref($options) eq 'ARRAY') {
1385                                 my $o;
1386                                 my $inline = $cc->{'inline'};
1387                                 my $subRc1 = "";
1388                                 my $subRc2 = "";
1389                                 for ($o = 0; $o < @$options; $o++) {
1390                                         my $optionEntry = $options->[$o];
1391                                         my $name = escapeMenuName($optionEntry->{'name'});
1392                                         my $optionFile = $optionEntry->{'file'};
1393                                         my $values = $optionEntry->{'value'};
1394                                         errDie("option.value missing, incorrect cfg for some $_ option")
1395                                                 if ref($values) ne 'ARRAY';
1396                                         $optionEntry->{'current'} ||= ($optionEntry->{'default'} || 1);
1397                                         my $index = $optionEntry->{'current'} - 1;
1398                                         if ($index < 0 || $index >= @$values) {
1399                                                 $index = 0;  # maybe die on this error?
1400                                                 $optionEntry->{'current'} = $index + 1;
1401                                         }
1402                                         if ($inline || $name eq "") {
1403                                                 $menusRc .= $name ne ""? qq(+ "$name" Title\n):
1404                                                         $menusRc =~ / Title\n$/? "": qq(+ "" Nop\n);
1405                                         } else {
1406                                                 $subRc1 .= qq(+ "$name"\tPopup "$currMenu-$optionFile"\n);
1407                                                 $subRc2 .= qq(DestroyMenu "$currMenu-$optionFile"\n);
1408                                                 $subRc2 .= qq(AddToMenu   "$currMenu-$optionFile"\n);
1409                                         }
1410                                         my $i;
1411                                         for ($i = 0; $i < @$values; $i++) {
1412                                                 my $isCurrent = $i eq $index;
1413                                                 my $name = escapeMenuName($values->[$i]->{'name'}, !$isCurrent);
1414                                                 my $star = $isCurrent? "": "&";
1415                                                 my $icon = $isCurrent? "choice-yes": "empty";
1416                                                 my $mark = ($isCurrent && $noIconsInMenus) ? "\t(+)" : "";
1417                                                 my $n = $i + 1;
1418                                                 my $menuItem = qq(+ "%menu/$icon.xpm%$star$name$mark"\tFuncFvwmThemesOption $_:$optionFile=$n\n);
1419                                                 ($inline? $menusRc: $subRc2) .= $menuItem;
1420                                         }
1421                                         #$menusRc .= qq(+ "" Nop\n);
1422                                 }
1423                                 $menusRc .= "$subRc1$subRc2" . "AddToMenu   $currMenu\n"
1424                                         unless $inline;
1425                                 $m = 1;
1426                         }
1427                         my $variants = $cc->{'variant'};
1428                         if (ref($variants) eq 'ARRAY') {
1429                                 $cc->{'current'} ||= $cc->{'default'};
1430                                 my $index = $cc->{'current'} - 1;
1431                                 if ($variants->[$index]->{'hidden'}) {
1432                                         errWarn(
1433                                                 "Variant $variants->[$index]->{'name'} of component " .
1434                                                 "$name\@$cc->{'theme'}\nis not supported by your " .
1435                                                 "system, you may need to refresh with no cache.\n"
1436                                         );
1437                                         $cc->{'current'} = $cc->{'default'};
1438                                         $index = $cc->{'current'} - 1;
1439                                 }
1440                                 if ($index < 0 || $index >= @$variants) {
1441                                         $index = 0;  # maybe die on this error?
1442                                         $cc->{'current'} = $index + 1;
1443                                 }
1444                                 my $readFile = $cc->{'read-file'};
1445                                 $readFile =~ s:/[^/]+$:/$variants->[$index]->{'file'}:;
1446                                 if ($readFile ne $cc->{'read-file'}) {
1447                                         $cc->{'read-file'} = $readFile;
1448                                         $self->setModified();
1449                                 }
1450                                 my $i;
1451                                 for ($i = 0; $i < @$variants; $i++) {
1452                                         next if $variants->[$i]->{'hidden'};
1453                                         my $isCurrent = $i eq $index;
1454                                         my $name = escapeMenuName($variants->[$i]->{'name'}, !$isCurrent);
1455                                         my $icon = $isCurrent? "choice-yes": "empty";
1456                                         my $star = $isCurrent? "": "&";
1457                                         my $mark = ($isCurrent && $noIconsInMenus) ? "\t(+)" : "";
1458                                         my $n = $i + 1;
1459                                         $menusRc .= qq(+ "%menu/$icon.xpm%$star$name$mark"\tFuncFvwmThemesVariant $_=$n\n);
1460                                 }
1461                                 $m = 1;
1462                         }
1463                 }
1464                 $menusRc .= qq(+ "" Nop\n) unless $m == 2;
1465                 ### Temporarily hardcoded
1466                 my $dropCommand = !/^(settings|colors$|menus|globallook)/ || /-extra$/?
1467                         qq(FuncFvwmThemesDrop "$_"):
1468                         'Exec xmessage "Dropping of this component is not supported"';
1469                 my $lockLabel = $cc->{'locked'}? "Unlock": "Lock";
1470                 my $nonLocked = 1 - $cc->{'locked'};
1471                 my $lockCommand = qq(FuncFvwmThemesSetLocked "$_=$nonLocked");
1472                 my $infoCommand = qq(FuncFvwmShowComponentInfo "$_");
1473                 $menusRc .= qq(+ "%menu/choice-no.xpm%&Drop this component"\t$dropCommand\n);
1474                 $menusRc .= qq(+ "%menu/lock.xpm%&$lockLabel this component"\t$lockCommand\n);
1475                 $menusRc .= qq(+ "%menu/information.xpm%&Info for $_\@$cc->{'theme'}"\t$infoCommand\n);
1476
1477                 my $lockIcon = $cc->{'locked'}? "lock": "empty";
1478                 # use $name instead of $_?
1479                 $menuRc[$m] .= qq(+ "%menu/$lockIcon.xpm%$_"\tPopup "$selfMenuName/$_"\n) unless m:/:;
1480         }
1481         if ($dropExtraArgs) {
1482                 push @menuRc, qq(+ "%menu/choice-no.xpm%&Drop all extra"\tFuncFvwmThemesConfigAndUpdate "$dropExtraArgs"\n);
1483         }
1484         my $menuRc = join(qq(+ "" Nop\n), @menuRc) . "\n$menusRc";
1485         $menuRc =~ s/(\+ "" Nop\n){2,}/$1/sg;
1486         return ($listRc, $menuRc);
1487 }
1488
1489 # sorts all current components to be read according to their dependancies
1490 sub getSortedComponentsToRead ($) {
1491         my $self = shift;
1492         my @currentComponents;
1493
1494         my $precedes = {};
1495         my $requires = {};
1496         my $provides = {};
1497         my $complements = {};
1498         my $component;
1499
1500         # prepare components to be sorted
1501         foreach $component (sort keys %{$self->{'cc'}}) {
1502                 my $cc = $self->getComponentCfg($component);
1503                 next if $component =~ /^_/;
1504                 #olicha 1
1505                 next unless $cc->{'used'};
1506                 next if $cc->{'hidden'};
1507                 next unless $cc->{'read-file'};
1508                 if (exists $cc->{'complements'}) {
1509                         my $mainComponent = $cc->{'complements'} || '*none*';
1510                         $complements->{$mainComponent} ||= [];
1511                         push @{$complements->{$mainComponent}}, $component;
1512                         next;
1513                 }
1514                 push @currentComponents, $component;
1515                 $precedes->{$component} = {};
1516         }
1517
1518         # process 'precedes' and 'follows' dependances; prepare to the next step
1519         foreach $component (@currentComponents) {
1520                 my $cc = $self->getComponentCfg($component);
1521                 my $precedes0 = {};
1522                 if (ref($cc->{'precedes'}) eq 'ARRAY') {
1523                         foreach (@{$cc->{'precedes'}}) {
1524                                 $precedes0->{$_} = 1;
1525                         }
1526                 }
1527                 if (ref($cc->{'follows'}) eq 'ARRAY') {
1528                         foreach (@{$cc->{'follows'}}) {
1529                                 $precedes0->{$_} = -1;
1530                         }
1531                 }
1532                 if (keys %$precedes0) {
1533                         my ($c2, $cmp);
1534                         while (($c2, $cmp) = (each %$precedes0)) {
1535                                 $precedes->{$component}->{$c2} = +$cmp;
1536                                 $precedes->{$c2}->{$component} = -$cmp;
1537                         }
1538                 }
1539
1540                 $requires->{$component} = $cc->{'requires'} || [];
1541
1542                 if (ref($cc->{'provides'}) eq 'ARRAY') {
1543                         $provides->{$component} = {};
1544                         foreach (@{$cc->{'provides'}}) {
1545                                 $provides->{$component}->{$_} = 1;
1546                         }
1547                 }
1548                 #$provides->{$component}->{$component} = 1;
1549         }
1550
1551         # process 'provides' and 'requires' dependances
1552         my $cnum = @currentComponents;
1553         my ($i, $j);
1554         for ($i = 0; $i < $cnum - 1; $i++) {
1555                 my $c1 = $currentComponents[$i];
1556                 for ($j = $i + 1; $j < $cnum; $j++) {
1557                         my $c2 = $currentComponents[$j];
1558                         my $cmp = undef;
1559                         foreach (@{$requires->{$c1}}) {
1560                                 $cmp = -1 if $_ eq $c2
1561                                         || exists $provides->{$c2} && $provides->{$c2}->{$_};
1562                         }
1563                         foreach (@{$requires->{$c2}}) {
1564                                 $cmp = +1 if $_ eq $c1
1565                                         || exists $provides->{$c1} && $provides->{$c1}->{$_};
1566                         }
1567                         next unless defined $cmp;
1568                         $precedes->{$c1}->{$c2} = +$cmp;
1569                         $precedes->{$c2}->{$c1} = -$cmp;
1570                 }
1571         }
1572
1573         for ($i = 0; $i < $cnum - 1; $i++) {
1574                 my $d = 1;
1575                 CURRENT_COMPONENT: while (1) {
1576                         my $c1 = $currentComponents[$i];
1577                         for ($j = $i + $d; $j < $cnum; $j++) {
1578                                 my $c2 = $currentComponents[$j];
1579                                 my $cmp = $precedes->{$c1}->{$c2};
1580                                 next unless defined $cmp;
1581                                 if ($cmp < 0) {
1582                                         splice(@currentComponents, $j, 1);
1583                                         splice(@currentComponents, $i, 0, $c2);
1584                                         $d++;
1585                                         redo CURRENT_COMPONENT;
1586                                 }
1587                         }
1588                         last;
1589                 }
1590         }
1591
1592         # implant complementing components into the sorted array
1593         foreach $component (keys %$complements) {
1594                 my $index = getArrayElementIndex(\@currentComponents, $component);
1595                 errDie("Complemented component '$component' for (@{$complements->{$component}}) does not exist")
1596                         unless defined $index;
1597                 splice @currentComponents, $index + 1, 0, @{$complements->{$component}};
1598         }
1599
1600         return \@currentComponents;
1601 }
1602
1603 # set the 'used' flag:
1604 #  0: component is dropped during this theme switching!
1605 #  1: the component is used but nothing have to be done about this component
1606 #     during theme switching (if isMinimalReloading !!!!)
1607 #  2: the component must be reloaded but not (re)started
1608 #  3: the component must be (re)started
1609 sub setUsedFlags($) {
1610         my $self = shift;
1611
1612         my @currentComponents;
1613         my $component;
1614
1615         my $isModified = 1;
1616         my $step = 0;
1617
1618         while($isModified) {
1619                 $isModified = 0;
1620                 $step++;
1621                 foreach $component (keys %{$self->{'cc'}}) {
1622                         next if $component =~ /^_/;
1623                         my $cc = $self->getComponentCfg($component);
1624                         #next unless $cc->{'used'};
1625                         next if $cc->{'hidden'};
1626
1627                         my @strongComp = ();
1628                         my @weakComp = ();
1629                         my @symStrongComp = ();
1630                         my @dependsComp = ();
1631                         my $comp;
1632                         push @symStrongComp, $cc->{'complements'}
1633                                 if (exists $cc->{'complements'});
1634                         push @strongComp, @{$cc->{'stronglydepends'}}
1635                                 if defined $cc->{'stronglydepends'} &&
1636                                         ref($cc->{'stronglydepends'}) eq 'ARRAY';
1637                         push @weakComp, @{$cc->{'weakdepends'}}
1638                                 if defined $cc->{'weakdepends'} &&
1639                                         ref($cc->{'weakdepends'}) eq 'ARRAY';
1640                         push @dependsComp, @{$cc->{'depends'}}
1641                                 if defined $cc->{'depends'} &&
1642                                         ref($cc->{'depends'}) eq 'ARRAY';
1643
1644                         foreach $comp (@symStrongComp) {
1645                                 next if !defined $self->{'cc'}->{$comp};
1646                                 my $dd = $self->getComponentCfg($comp);
1647                                 if ($dd->{'used'}) {
1648                                         if ($cc->{'used'} >= 2 && $dd->{'used'} < $cc->{'used'}) {
1649                                                 $dd->{'used'} = $cc->{'used'};
1650                                                 $self->setComponentCfg($comp, $dd);
1651                                                 $isModified = 1;
1652                                         }
1653                                         if ($cc->{'used'} == 0 && $dd->{'used'} < 3) {
1654                                                 $dd->{'used'} = 3;
1655                                                 $self->setComponentCfg($comp, $dd);
1656                                                 $isModified = 1;
1657                                         }
1658                                 }
1659                                 if ($cc->{'used'}) {
1660                                         if ($dd->{'used'} >= 2 && $cc->{'used'} < $dd->{'used'}) {
1661                                                 $cc->{'used'} = $dd->{'used'};
1662                                                 $self->setComponentCfg($component, $cc);
1663                                                 $isModified = 1;
1664                                         }
1665                                         if ($dd->{'used'} == 0 && $cc->{'used'} < 3 && $cc->{'used'}) {
1666                                                 $cc->{'used'} = 3;
1667                                                 $self->setComponentCfg($component, $cc);
1668                                                 $isModified = 1;
1669                                         }
1670                                 }
1671                         }
1672                         next unless $cc->{'used'};
1673                         foreach $comp (@strongComp) {
1674                                 next if !defined $self->{'cc'}->{$comp};
1675                                 my $dd = $self->getComponentCfg($comp);
1676                                 if ($dd->{'used'} >= 2 && $cc->{'used'} < $dd->{'used'}) {
1677                                         $cc->{'used'} = $dd->{'used'};
1678                                         $self->setComponentCfg($component, $cc);
1679                                         $isModified = 1;
1680                                 }
1681                                 if ($dd->{'used'} == 0 && $cc->{'used'} < 3) {
1682                                         $cc->{'used'} = 3;
1683                                         $self->setComponentCfg($component, $cc);
1684                                         $isModified = 1;
1685                                 }
1686                         }
1687                         foreach $comp (@weakComp) {
1688                                 next if !defined $self->{'cc'}->{$comp};
1689                                 my $dd = $self->getComponentCfg($comp);
1690                                 if (($dd->{'used'} >= 3||$dd->{'used'} == 0)&& $cc->{'used'} < 2) {
1691                                         $cc->{'used'} = 2;
1692                                         $self->setComponentCfg($component, $cc);
1693                                         $isModified = 1;
1694                                 }
1695                         }
1696                         foreach $comp (@dependsComp) {
1697                                 next if !defined $self->{'cc'}->{$comp};
1698                                 my $dd = $self->getComponentCfg($comp);
1699                                 if (($dd->{'used'} >= 2||$dd->{'used'} == 0) && $cc->{'used'} < 2) {
1700                                         $cc->{'used'} = 2;
1701                                         $self->setComponentCfg($component, $cc);
1702                                         $isModified = 1;
1703                                 }
1704                         }
1705                 }
1706                 $isModified = 0 if ($step > 100);
1707         }
1708
1709         if ($self->isMinimalReload()) {
1710                 return;
1711         }
1712
1713         # every thing have to be at least reloaded
1714         foreach $component (keys %{$self->{'cc'}}) {
1715                 my $cc = $self->getComponentCfg($component);
1716                 if ($cc->{'used'} == 1) {
1717                         $cc->{'used'} = 2;
1718                         $self->setComponentCfg($component, $cc);
1719                 }
1720         }
1721
1722 }
1723
1724 # returns component key value, which can be overridden by the current variant
1725 # or options key values. If it is array, all found values are joined together.
1726 sub getComponentNamedValue ($$$) {
1727         my $self = shift;
1728         my $component = shift;
1729         my $name = shift;
1730
1731         my $cc = $self->getComponentCfg($component);
1732         return undef unless $cc->{'used'};
1733         my $value = $cc->{$name};
1734
1735         my $variants = $cc->{'variant'};
1736         if (ref($variants) eq 'ARRAY') {
1737                 my $index = defined $cc->{'current'}?
1738                         $cc->{'current'}: $cc->{'default'};
1739                 $index = $index - 1;
1740                 $index = 0 if ($index < 0 || $index >= @$variants);
1741                 my $variant = $variants->[$index];
1742                 my $newValue = $variant->{$name};
1743                 if (defined $newValue) {
1744                         errDie("Mixed '$name' types (" . (ref($value) || "scalar") . " and "
1745                                 . (ref($newValue) || "scalar") . ") for component $component")
1746                                 if defined $value && ref($value) ne ref($newValue);
1747                         if (ref($newValue) eq 'ARRAY') {
1748                                 $value ||= [];
1749                                 push @$value, @$newValue;
1750                         } else {
1751                                 $value = $newValue;
1752                         }
1753                 }
1754         }
1755         ### should probably handle the named value of all current options here
1756
1757         return $value;
1758 }
1759
1760 sub getAdditionalImagePath ($) {
1761         my $self = shift;
1762         my $currentComponents = [keys %{$self->{cc}}];
1763         my @imagePathDirs = ([], []);  # one before and one after '+'
1764
1765         foreach (@$currentComponents) {
1766                 my $dirs = $self->getComponentNamedValue($_, 'external-imagepath');
1767                 next unless defined $dirs;
1768                 errDie("external-imagepath ($dirs) in component '$_' is not ARRAY")
1769                         unless ref($dirs) eq 'ARRAY';
1770                 foreach (@$dirs) {
1771                         my $i = /wm-icons(;.*)?$/? 0: 1;  # we are wm-icons compatible
1772                         next if isArrayElement($imagePathDirs[$i], $_);
1773                         push @{$imagePathDirs[$i]}, $_;
1774                 }
1775         }
1776         my $imagePath = "+";
1777         $imagePath = join(':', @{$imagePathDirs[0]}, $imagePath);
1778         $imagePath = join(':', $imagePath, @{$imagePathDirs[1]});
1779         return $imagePath;
1780 }
1781
1782 sub getAllHooksRc ($) {
1783         my $self = shift;
1784         my $currentComponents = [keys %{$self->{cc}}];
1785         my $startItems = [];
1786         my $stopItems = [];
1787         my $loadItems = [];
1788         my $colorsIsChanged = 0;
1789         my $colorsModules = 0;
1790
1791         my $_c = $self->getComponentCfg("_core");
1792         my $saveStop = ( $_c->{'stop'} ||= {} );
1793         my $cs = {};
1794
1795         my $startHooksRc =
1796                 "DestroyFunc FuncFvwmStartAllHooks\n" .
1797                 "AddToFunc   FuncFvwmStartAllHooks\n";
1798         my $stopHooksRc = "";
1799         my $loadHooksRc =
1800                 "DestroyFunc FuncFvwmLoadAllHooks\n" .
1801                 "AddToFunc   FuncFvwmLoadAllHooks\n";
1802         my $hardCodedStopHooks = "";
1803         my $hardCodedStartHooks = "";
1804         my $c;
1805         foreach $c (@$currentComponents) {
1806                 my $cc = $self->getComponentCfg($c);
1807                 next if defined $cc->{'hidden'};
1808
1809                 # get the saved "stop" functions
1810                 my @savedStopFunctions = ();
1811                 my @savedUnloadFunctions = ();
1812                 my @savedUnReloadFunctions = ();
1813                 if (defined $saveStop->{$c} && ref($saveStop->{$c}) eq 'HASH') {
1814                         if (defined $saveStop->{$c}->{'start-stop'} &&
1815                                 ref($saveStop->{$c}->{'start-stop'}) eq 'ARRAY')
1816                         {
1817                                 @savedStopFunctions = @{$saveStop->{$c}->{'start-stop'}};
1818                         }
1819                         if (defined $saveStop->{$c}->{'load-unload'} &&
1820                                 ref($saveStop->{$c}->{'load-unload'}) eq 'ARRAY')
1821                         {
1822                                 @savedUnloadFunctions = @{$saveStop->{$c}->{'load-unload'}};
1823                         }
1824                         if (defined $saveStop->{$c}->{'reload-unreload'} &&
1825                                 ref($saveStop->{$c}->{'reload-unreload'}) eq 'ARRAY')
1826                         {
1827                                 @savedUnReloadFunctions = @{$saveStop->{$c}->{'reload-unreload'}};
1828                         }
1829                         delete $saveStop->{$c};
1830                 }
1831
1832                 # for "ColorsModules" be independent of the order
1833                 if ($c eq "colors" && $cc->{'used'} >= 2) {
1834                         $hardCodedStopHooks .= "FuncFvwmRestartFvwmTheme\n"
1835                                 if $fvwmVersion =~ /^2\.4\..*/;
1836                         $colorsIsChanged = 1;
1837                         if ($colorsModules) {
1838                                 $hardCodedStopHooks .= "FuncFvwmUnReloadColorsModules\n";
1839                                 $hardCodedStartHooks .= "+ I FuncFvwmReloadColorsModules\n";
1840                         }
1841                 }
1842                 if ($c eq "modules" && $cc->{'used'} == 2) {
1843                         my $hints = $self->getComponentNamedValue($c,'hints');
1844                         if (defined $hints) {
1845                                 foreach(@$hints) {
1846                                         $colorsModules = 1 if $_ eq "reload-unreload-ColorsModules";
1847                                 }
1848                         }
1849                         if ($colorsIsChanged && $colorsModules) {
1850                                 $hardCodedStopHooks .= "FuncFvwmUnReloadColorsModules\n";
1851                                 $hardCodedStartHooks .= "+ I FuncFvwmReloadColorsModules\n";
1852                         }
1853                 }
1854
1855                 my $startStop = $self->getComponentNamedValue($c,'start-stop');
1856                 my $loadUnload = $self->getComponentNamedValue($c,'load-unload');
1857                 my $reloadUnreload = $self->getComponentNamedValue($c,'reload-unreload');
1858
1859                 next unless defined $startStop || $loadUnload || $reloadUnreload ||
1860                         @savedStopFunctions || (@savedUnloadFunctions && $cc->{'used'} >= 3) ||
1861                                 (@savedUnReloadFunctions &&  $cc->{'used'} < 3);
1862
1863                 errDie("start-stop ($startStop) in component '$c' is not ARRAY")
1864                         unless !defined $startStop || ref($startStop) eq 'ARRAY';
1865                 errDie("start-stop ($loadUnload) in component '$c' is not ARRAY")
1866                         unless !defined $loadUnload || ref($loadUnload) eq 'ARRAY';
1867                 errDie("start-stop ($reloadUnreload) in component '$c' is not ARRAY")
1868                         unless !defined $reloadUnreload || ref($reloadUnreload) eq 'ARRAY';
1869
1870                 # prepare to save the "stop" functions
1871                 if (defined $startStop) {
1872                         $cs->{$c}->{'start-stop'} = $startStop;
1873                 }
1874                 if (defined $loadUnload) {
1875                         $cs->{$c}->{'load-unload'} = $loadUnload;
1876                 }
1877                 if (defined $reloadUnreload) {
1878                         $cs->{$c}->{'reload-unreload'} = $reloadUnreload;
1879                 }
1880
1881                 my $startFunctions = [];
1882                 my $loadFunctions = [];
1883                 my @stopFunctions = ();
1884                 my $loadFunctionsType = "Start";
1885                 my $startFunctionsType = "Start";
1886                 my $stopFunctionsType = "Stop";
1887                 if (defined $loadUnload) {
1888                         $loadFunctions = $loadUnload;
1889                         $loadFunctionsType = "Load";
1890                 }
1891                 elsif (defined $startStop) {
1892                         $loadFunctions = $startStop;
1893                 }
1894                 if ($cc->{'used'} < 3) {
1895                         if (defined $reloadUnreload) {
1896                                 $startFunctions = $reloadUnreload;
1897                                 $startFunctionsType = "Reload";
1898                         }
1899                         elsif (defined $startStop) {
1900                                 $startFunctions = $startStop;
1901                         }
1902                         if (@savedUnReloadFunctions) {
1903                                 @stopFunctions = @savedUnReloadFunctions;
1904                                 $stopFunctionsType = "UnReload";
1905                         }
1906                         elsif (@savedStopFunctions) {
1907                                 @stopFunctions = @savedStopFunctions;
1908                         }
1909                 }
1910                 else {
1911                         if (defined $loadUnload) {
1912                                 $startFunctions = $loadUnload;
1913                                 $startFunctionsType = "Load";
1914                         }
1915                         elsif (defined $startStop) {
1916                                 $startFunctions = $startStop;
1917                         }
1918                         if (@savedUnloadFunctions) {
1919                                 @stopFunctions = @savedUnloadFunctions;
1920                                 $stopFunctionsType = "Unload";
1921                         }
1922                         elsif (@savedStopFunctions) {
1923                                 @stopFunctions = @savedStopFunctions;
1924                         }
1925                 }
1926
1927                 foreach (@$startFunctions) {
1928                         next if isArrayElement($startItems, $_);
1929                         if ($cc->{'used'} >= 2) {
1930                                 push @$startItems, $_;
1931                                 $startHooksRc .= "+ I FuncFvwm$startFunctionsType$_\n";
1932                         }
1933                 }
1934
1935                 foreach (@stopFunctions) {
1936                         next if isArrayElement($stopItems, $_);
1937                         if ($cc->{'used'} >= 2) {
1938                                 push @$stopItems, $_;
1939                                 $stopHooksRc .= "FuncFvwm$stopFunctionsType$_\n";
1940                         }
1941                 }
1942
1943                 foreach (@$loadFunctions) {
1944                         next if isArrayElement($loadItems, $_);
1945                         push @$loadItems, $_;
1946                         $loadHooksRc .= "+ I FuncFvwm$loadFunctionsType$_\n";
1947                 }
1948
1949         }
1950
1951         # get the remaining stop functions ("dropped" component)
1952         foreach $c (keys %$saveStop) {
1953                 my @stopFunctions = ();
1954                 my $stopFunctionsType = "Stop";
1955                 # from the strongest
1956                 if (ref($saveStop->{$c}) eq 'HASH') {
1957                         if (defined $saveStop->{$c}->{'load-unload'} &&
1958                                 ref($saveStop->{$c}->{'load-unload'}) eq 'ARRAY')
1959                         {
1960                                 @stopFunctions = @{$saveStop->{$c}->{'load-unload'}};
1961                                 $stopFunctionsType = "Unload";
1962                         }
1963                         elsif (defined $saveStop->{$c}->{'start-stop'} &&
1964                                 ref($saveStop->{$c}->{'start-stop'}) eq 'ARRAY')
1965                         {
1966                                 @stopFunctions = @{$saveStop->{$c}->{'start-stop'}};
1967                         }
1968                         elsif (defined $saveStop->{$c}->{'reload-unreload'} &&
1969                                 ref($saveStop->{$c}->{'reload-unreload'}) eq 'ARRAY')
1970                         {
1971                                 # should not happen ?
1972                                 @stopFunctions = @{$saveStop->{$c}->{'reload-unreload'}};
1973                                 $stopFunctionsType = "Unload";
1974                         }
1975                         delete $saveStop->{$c};
1976                 }
1977
1978                 foreach (@stopFunctions) {
1979                         next if isArrayElement($stopItems, $_);
1980                         push @$stopItems, $_;
1981                         $stopHooksRc  .= "FuncFvwm$stopFunctionsType$_\n";
1982                 }
1983         }
1984
1985         # save the stop functions
1986         $_c->{'stop'} = $cs;
1987
1988         return
1989                 ("$loadHooksRc\n",
1990                 "$stopHooksRc" . "$hardCodedStopHooks\n" .
1991                 "$startHooksRc" . "$hardCodedStartHooks\n");
1992 }
1993
1994 sub getReadsRc($) {
1995         my $self = shift;
1996         my $rc = "### We will decide later whether to use full paths here.\n";
1997         my $switchRc = "";
1998
1999         foreach (@{$self->getSortedComponentsToRead()}) {
2000                 my $cc = $self->getComponentCfg($_);
2001                 my $readFile = $cc->{'read-file'};
2002                 my $optionReadAfterward = $cc->{'option-read-afterward'};
2003                 my $options = $cc->{'option'};
2004                 my $optionExports = [];
2005                 my $o;
2006                 my ($readRc1, $readRc2) = ("", "");
2007                 my ($switchReadRc2, $switchReadRc1) = ("", "");
2008                 for ($o = 0; ref($options) eq 'ARRAY' && $o < @$options; $o++) {
2009                         my $optionEntry = $options->[$o];
2010                         my $optionFile = $optionEntry->{'file'};
2011
2012                         $optionFile = (
2013                                 (
2014                                         $readFile =~ /^(.*\/)$mainDirFile$/
2015                                                 || ref($cc->{'variant'}) eq 'ARRAY'
2016                                                 && $readFile =~ /^(.*\/)[^\/]+$/
2017                                 )? $1: "$readFile."
2018                         ) . $optionFile;
2019
2020                         my $current = $optionEntry->{'current'};
2021                         my $index = $current - 1;
2022                         my $valueFile0 = $optionEntry->{'value'}->[$index]->{'file'};
2023                         my $valueFile = $optionFile . (-d $optionFile? "/": ".")
2024                                 . $valueFile0;
2025                         $optionFile =~ s/^$ROOT_PREFIX//;
2026                         $valueFile =~ s/^$ROOT_PREFIX//;
2027
2028                         push @$optionExports, {
2029                                 'f' => $valueFile, 'c' => $current, 'v' => $valueFile0
2030                         };
2031                         my $command = $optionEntry->{'read-command'};
2032                         next if defined $command && $command eq "";
2033
2034                         $command ||= $defaultReadCommand;
2035                         $command =~ s/%f/$valueFile/sg;
2036                         $command =~ s/%F/$valueFile0/sg;  # to be obsolete?
2037                         $command =~ s/%v/$valueFile0/sg;
2038                         $command =~ s/%d/$optionFile/sg;
2039
2040                         my $readAfterward = $optionEntry->{'read-afterward'};
2041                         $readAfterward = $optionReadAfterward unless defined $readAfterward;
2042                         ($readAfterward? $readRc2: $readRc1) .= "$command\n";
2043
2044                         my $reloadCommand = $command;
2045                         if (defined $optionEntry->{'reload-read-command'} && $cc->{'used'} < 3) {
2046                                 $reloadCommand = $optionEntry->{'reload-read-command'};
2047                                 $reloadCommand =~ s/%f/$valueFile/sg;
2048                                 $reloadCommand =~ s/%F/$valueFile0/sg;  # to be obsolete?
2049                                 $reloadCommand =~ s/%v/$valueFile0/sg;
2050                                 $reloadCommand =~ s/%d/$optionFile/sg;
2051                                 next if $reloadCommand eq "*none*";
2052                         }
2053                         ($readAfterward? $switchReadRc2: $switchReadRc1) .= "$reloadCommand\n";
2054
2055 #                       if (($optionEntry->{'read-file'} || "") ne $valueFile) {
2056 #                               $optionEntry->{'read-file'} = $valueFile;
2057 #                               $self->setModified();
2058 #                       }
2059                 }
2060                 my $command = $cc->{'read-command'} || $defaultReadCommand;
2061                 $readFile =~ s/^$ROOT_PREFIX//;
2062                 $command =~ s/%f/$readFile/sg;
2063                 $command =~ s/%d/getThemeDir($cc->{$themeKey})/seg;
2064                 $command =~ s/%o([\d]+)(\w)/$optionExports->[$1-1]->{$2} || ""/seg;
2065                 $rc .= "$readRc1$command\n$readRc2";
2066
2067                 my $reloadCommand = $command;
2068                 if (defined $cc->{'reload-read-command'} && $cc->{'used'} < 3) {
2069                         $reloadCommand = $cc->{'reload-read-command'};
2070                         next if $reloadCommand eq "*none*";
2071                         $reloadCommand =~ s/%f/$readFile/sg;
2072                         $reloadCommand =~ s/%d/getThemeDir($cc->{$themeKey})/seg;
2073                         $reloadCommand =~ s/%o([\d]+)(\w)/$optionExports->[$1-1]->{$2}||""/seg;
2074                 }
2075                 $switchRc .= "$switchReadRc1$reloadCommand\n$switchReadRc2"
2076                         if $cc->{'used'} >= 2;
2077         }
2078         return ($rc,$switchRc);
2079 }
2080
2081 sub getMenusAndHooksAndReadsRc ($) {
2082         my $self = shift;
2083         my $currentComponents = [keys %{$self->{cc}}];  # $self->{$componentKey};
2084         my $rc = "";
2085         my $switchRc = "";
2086
2087         my ($ownThemeListRc, $ownThemeMenuRc) = $self->getOwnThemeSubMenusRc();
2088         my ($allThemeListRc, $allThemeMenuRc) = $self->getAllThemeSubMenusRc();
2089
2090         # set the "reload" rules
2091         $self->setUsedFlags();
2092         # add current theme hooks
2093         ($rc,$switchRc) = $self->getAllHooksRc();
2094
2095         # include components themselves (Read)
2096         my ($tmpRc,$tmpSwitchRc) = $self->getReadsRc();
2097         $rc .= $tmpRc;
2098         $switchRc .= $tmpSwitchRc;
2099
2100         # add main menu entries
2101         my $menu = "";
2102         my $minimalSwitch = "";
2103         if ($self->isMinimalReload()) {
2104                 $minimalSwitch =
2105                         qq(+ "&Use full reloading%menu/restart.xpm%" FuncFvwmThemesSetMinimalReload 0\n);
2106         } else {
2107                 $minimalSwitch =
2108                         qq(+ "&Use partial reloading%menu/restart.xpm%" FuncFvwmThemesSetMinimalReload 1\n);
2109         }
2110         $menu .= qq(\n\n);
2111         $menu .= qq(DestroyMenu "MenuFvwmThemes"\n);
2112         $menu .= qq(AddToMenu   "MenuFvwmThemes" "Theme Management" Title\n);
2113         $menu .= $ownThemeListRc;
2114         $menu .= qq(+ "" Nop\n);
2115         $menu .= $allThemeListRc;
2116         $menu .= qq(+ "" Nop\n);
2117         $menu .= qq(+ "&Refresh and Reload%menu/restart.xpm%" Popup MenuFvwmThemesRefreshReload\n);
2118         $menu .= qq(DestroyMenu "MenuFvwmThemesRefreshReload"\n);
2119         $menu .= qq(AddToMenu   "MenuFvwmThemesRefreshReload" "Refresh and Reload" Title\n);
2120         $menu .= qq(+ "&Refresh the current theme%menu/restart.xpm%" FuncFvwmThemesFresh\n);
2121         $menu .= qq(+ "Refresh with no &cache%menu/restart.xpm%" FuncFvwmThemesFreshUncached\n);
2122         $menu .= $minimalSwitch;
2123         $menu .= qq(+ "" Nop\n);
2124         $menu .= qq(+ "Reset all to the &default%menu/restart.xpm%" FvwmScript FvwmScript-Confirm --line1 "Themes Management" --line2 "Are you sure you want to reset all changes to the default?" --line3 "__________" --ok Yes --cancel No --command FuncFvwmThemesReset\n);
2125         $menu .= "\n";
2126
2127         # add own theme menus
2128         $menu .= "$ownThemeMenuRc\n";
2129
2130         # add all theme menus
2131         $menu .= "$allThemeMenuRc\n";
2132
2133         $rc .= $menu;
2134         $switchRc .= $menu;
2135         return ($rc,$switchRc);
2136 }
2137
2138 sub generateThemesRc ($) {
2139         my $self = shift;
2140
2141         my $verStr = sprintf("%-7s", $fvwmVersion);
2142         my $curDateStr = `date +%d-%b-%Y`; chomp($curDateStr);
2143         my $userIdent = ($ENV{'USER'} || 'unknown') . '@' .
2144                 ($ENV{'HOST'} || $ENV{'HOSTNAME'} || 'somewhere');
2145
2146         my $header = q{
2147 # Auto-generated by $scriptName for $userIdent.
2148 #
2149 #         .================================================.
2150 #         |                ____ _  _ _    _     | The best |
2151 #         |  Designed for (  __X \/ X \/\/ )\/\ `----------|
2152 #         |                ) _) \  / \    /    \           |
2153 #         |-------------. (__) * \/ * \/\(_/\/\_) - $verStr|
2154 #         | $curDateStr |                                  |
2155 #         `================================================'
2156 #  _______________________________________________________________
2157 # (   _________________________   ________________________________)
2158 #  ) (__  _  _  _    _  .      ) (  __ __  ____       .  ____* ___
2159 # (   __)( \/ )( \/\/ )/\/\ * (   )(  )  )(  __)* /\/\  (  __)/ __)
2160 #  ) ( .  \  /* \    //    \ . ) (  ) _ ( *) _). /    \* ) _).\__ \
2161 # (___)  * \/  . \/\/(_/\/\_) (___)(__(__)(____)(_/\/\_)(____)(___/
2162 };
2163
2164         $header =~ s/\$(\w+)/eval "\$$1"/eg;
2165
2166         my $contents = "# fvwm/$rcFile $version $buildId$header";
2167         $contents .= q{
2168 DestroyFunc FuncFvwmResetInitFunctions
2169 AddToFunc   FuncFvwmResetInitFunctions
2170 + I DestroyFunc StartFunction
2171 + I DestroyFunc InitFunction
2172 + I DestroyFunc RestartFunction
2173 + I DestroyFunc SessionInitFunction
2174 + I DestroyFunc SessionRestartFunction
2175 + I AddToFunc StartFunction
2176 + I + I FuncFvwmLoadAllHooks
2177
2178 DestroyFunc FuncFvwmRestartFvwmTheme
2179 AddToFunc   FuncFvwmRestartFvwmTheme
2180 + I KillModule FvwmTheme
2181 + I DestroyModuleConfig FvwmTheme: *
2182 + I ModuleSynchronous FvwmTheme
2183
2184 DestroyFunc FuncFvwmShowVersionInfo
2185 AddToFunc   FuncFvwmShowVersionInfo
2186 + I FuncFvwmShowMessage "FVWM Version" "$[version.line]^n@$versionInfo@"
2187
2188 DestroyFunc FuncFvwmShowComponentInfo
2189 AddToFunc   FuncFvwmShowComponentInfo
2190 + I PipeRead `@$scriptFile@ --pipe --show-info --component $0`
2191
2192 FuncFvwmResetInitFunctions
2193
2194 DestroyFunc FuncFvwmThemesConfigAndUpdate
2195 AddToFunc   FuncFvwmThemesConfigAndUpdate
2196 + I FvwmScript FvwmScript-NoteMessage "Theme switching"
2197 + I Wait FvwmScript-NoteMessage
2198 + I PipeRead `@$scriptFile@ $0 --pipe`
2199 #+ I FuncFvwmResetInitFunctions
2200 + I Read @$rcFile3@
2201 + I FuncFvwmStartAllHooks
2202 + I All (FvwmScript-NoteMessage) Delete
2203
2204 DestroyFunc FuncFvwmThemesCenterUpdate
2205 AddToFunc   FuncFvwmThemesCenterUpdate
2206 + I FvwmScript FvwmScript-NoteMessage "Theme switching"
2207 + I Wait FvwmScript-NoteMessage
2208 #+ I FuncFvwmResetInitFunctions
2209 + I Read @$rcFile3@
2210 + I FuncFvwmStartAllHooks
2211 + I All (FvwmScript-NoteMessage) Delete
2212
2213 DestroyFunc FuncFvwmThemesReset
2214 AddToFunc   FuncFvwmThemesReset
2215 + I FuncFvwmThemesConfigAndUpdate --reset
2216
2217 DestroyFunc FuncFvwmThemesFresh
2218 AddToFunc   FuncFvwmThemesFresh
2219 + I FuncFvwmThemesConfigAndUpdate --fresh
2220
2221 DestroyFunc FuncFvwmThemesFreshUncached
2222 AddToFunc   FuncFvwmThemesFreshUncached
2223 + I FuncFvwmThemesConfigAndUpdate "--fresh --no-cfg-cache"
2224
2225 DestroyFunc FuncFvwmThemesSetMinimalReload
2226 AddToFunc   FuncFvwmThemesSetMinimalReload
2227 + I FuncFvwmThemesConfigAndUpdate "--set-minimal-reload=$0"
2228
2229 DestroyFunc FuncFvwmThemesLoad
2230 AddToFunc   FuncFvwmThemesLoad
2231 + I FuncFvwmThemesConfigAndUpdate "--load=$0"
2232
2233 DestroyFunc FuncFvwmThemesDrop
2234 AddToFunc   FuncFvwmThemesDrop
2235 + I FuncFvwmThemesConfigAndUpdate "--drop=$0"
2236
2237 DestroyFunc FuncFvwmThemesOption
2238 AddToFunc   FuncFvwmThemesOption
2239 + I FuncFvwmThemesConfigAndUpdate "--option=$0"
2240
2241 DestroyFunc FuncFvwmThemesVariant
2242 AddToFunc   FuncFvwmThemesVariant
2243 + I FuncFvwmThemesConfigAndUpdate "--variant=$0"
2244
2245 DestroyFunc FuncFvwmThemesSetLocked
2246 AddToFunc   FuncFvwmThemesSetLocked
2247 + I FuncFvwmThemesConfigAndUpdate "--set-locked=$0"
2248
2249 # ---------------------------------------------------
2250 # Some global functions, extending FVWM functionality
2251
2252 DestroyFunc FuncFvwmStopModule
2253 AddToFunc   FuncFvwmStopModule
2254 + I KillModule $0
2255
2256 DestroyFunc FuncFvwmStopModuleByAlias
2257 AddToFunc   FuncFvwmStopModuleByAlias
2258 + I KillModule $0 $1
2259
2260 DestroyFunc FuncFvwmRestartModule
2261 AddToFunc   FuncFvwmRestartModule
2262 + I FuncFvwmStopModule $0
2263 + I Module $0
2264
2265 DestroyFunc FuncFvwmRestartModuleByAlias
2266 AddToFunc   FuncFvwmRestartModuleByAlias
2267 + I FuncFvwmStopModuleByAlias $0 $1
2268 + I Module $0 $1 $2
2269
2270 DestroyFunc FuncFvwmRemoveAllButtons
2271 AddToFunc   FuncFvwmRemoveAllButtons
2272 + I Style "*" NoButton 1, NoButton 3, NoButton 5, NoButton 7, NoButton 9
2273 + I Style "*" NoButton 2, NoButton 4, NoButton 6, NoButton 8, NoButton 0
2274 + I TitleStyle Height 5
2275
2276 Read @$rcFile2@
2277 };
2278
2279         $contents =~ s/@\$(\w+)@/eval "\$$1"/eg;
2280         # use Restart to switch themes if asked
2281         my $f = "FuncFvwmThemesConfigAndUpdate";
2282         $contents =~ s{(DestroyFunc\s+$f\nAddToFunc\s+$f\n)((?:[^\n]+\n)*(\+ I PipeRead[^\n]+\n)(?:[^\n]+\n)*)}
2283                 {$1$2\n$1$3\+ I Restart\n}s if $useRestart;
2284         saveFile("$workDir/$rcFile", \$contents);
2285
2286         my $imagePath = "$workDir/$currentThemeSubDir/images:$workDir/images";
2287         $imagePath .= ":$siteDir/images" if $workDir ne $siteDir;
2288         $imagePath .= ":$fvwmDefaultImagePath" if $fvwmDefaultImagePath;
2289         $imagePath =~ s=(^|:)\Q$userDir\E(/|:|$)=$1\$FVWM_USERDIR$2=g;
2290         $imagePath =~ s=(^|:)\Q$userHome\E(/|:|$)=$1\$HOME$2=g;
2291         $imagePath =~ s=(^|:)\Q$siteDir\E(/|:|$)=$1\$FT_DATADIR$2=g;
2292         my $addImagePath = $self->getAdditionalImagePath();
2293         $imagePath .= "\nImagePath $addImagePath" if $addImagePath =~ /\+/;
2294         my ($menusAndHooksRc, $switchMenusAndHooksRc) =
2295                         $self->getMenusAndHooksAndReadsRc();
2296         my $funcFvwmRestartFvwmTheme = $fvwmVersion =~ /^2\.4\..*/?
2297                 "\nFuncFvwmRestartFvwmTheme\n": "";
2298
2299         $contents = "# fvwm/$rcFile2 $version$header";
2300         $contents .= qq{
2301 SetEnv FT_DATADIR '$siteDir'
2302 ImagePath $imagePath
2303 $funcFvwmRestartFvwmTheme
2304 $menusAndHooksRc
2305 Mouse 2 A CM Menu MenuFvwmThemes
2306 };
2307         saveFile("$workDir/$rcFile2", \$contents);
2308
2309         $contents = "# fvwm/$rcFile3 $version$header";
2310         $contents .= qq{
2311 SetEnv FT_DATADIR '$siteDir'
2312 ImagePath $imagePath
2313
2314 $switchMenusAndHooksRc
2315 Mouse 2 A CM Menu MenuFvwmThemes
2316 };
2317
2318         if ($printRc3) {
2319                 print $contents;
2320         }
2321         else {
2322                 saveFile("$workDir/$rcFile3", \$contents);
2323         }
2324
2325 }
2326
2327 # ----------------------------------------------------------------------------
2328
2329 package main;
2330
2331 my $site = 0;
2332 my $showThemes = 0;
2333 my $showComponents = 0;
2334 my $showDir = 0;
2335 my $themes = [];
2336 my $showCfg = 0;
2337 my $showValues = [];
2338 my $showInfo = 0;
2339 my $component = undef;
2340 my $expandFile = undef;
2341 my $fresh = 0;
2342 my $reset = 0;
2343 my $loadComponents = [];
2344 my $dropComponents = [];
2345 my $options = {};
2346 my $variants = {};
2347 my $setLockeds = {};
2348 my $comMode = 0;
2349 my $comName = "config";
2350 my @comPid = qw(0 0 0 0);
2351 my $install = 0;
2352 my $createPack = undef;
2353 my $packPrefix = "ft";
2354 my $packExtraVersion = "0";
2355 my $tmpDir = "/tmp";
2356 my $forceInstall = 0;
2357 my $fvwmscript = 0;
2358 my $onlySite = 0;
2359 my $onlyUser = 0;
2360 my $configCenter = 0;
2361 my $noCfgCache = 0;
2362
2363 GetOptions(
2364         "help|h"      => \&showHelp,
2365         "version"     => \&showVersion,
2366         "info"        => \&showInfo,
2367         "i"           => sub { showInfo() unless @ARGV; $install = 1; },
2368         "site|s"      => \$site,
2369         "theme=s@"    => $themes,
2370         "show-themes!"     => \$showThemes,
2371         "show-components!" => \$showComponents,
2372         "show-dir!"        => \$showDir,
2373         "component=s"      => \$component,
2374         "show-info"        => \$showInfo,
2375         "show-cfg"         => \$showCfg,
2376         "show-value=s@"    => $showValues,
2377         "expand-rc:s" => \$expandFile,
2378         "fresh|f"     => \$fresh,
2379         "reset|r"     => \$reset,
2380         "load|l=s@"   => $loadComponents,
2381         "drop|d=s@"   => $dropComponents,
2382         "option=s%"   => $options,
2383         "variant=s%"  => $variants,
2384         "set-locked=s%" => $setLockeds,
2385         "pipe"        => \$pipe,
2386         "print-rc3"   => \$printRc3,
2387         "install"       => \$install,
2388         "force-install" => \$forceInstall,
2389         "create-pack=s" => \$createPack,
2390         "pack-extra-version=s" => \$packExtraVersion,
2391         "pack-prefix=s" => \$packPrefix,
2392         "tmp-dir=s"     => \$tmpDir,
2393         "com-mode"    => \$comMode,
2394         "com-name=s"  => \$comName,
2395         "fvwmscript"  => \$fvwmscript,
2396         "only-site"   => \$onlySite,
2397         "only-user"   => \$onlyUser,
2398         "config-center" => \$configCenter,
2399         "set-minimal-reload=i" => \$setMinimalReload,
2400         "no-cfg-cache" => \$noCfgCache,
2401 ) || wrongUsage();
2402
2403 shift @searchPath if $site;
2404 $workDir = $searchPath[0];
2405 $siteDir = $searchPath[-1];
2406
2407 if ($install) {
2408         my $themesDir = "$workDir";
2409         my $version = $version;
2410         $version =~ s/\.\d+$/.x/;
2411         my $dir = `pwd`;
2412         chomp($dir);
2413         errDie("Cannot chdir to $themesDir") unless chdir "$themesDir";
2414         errDie("No $workDir/$themesSubDir dir found")
2415                 unless -d "$workDir/$themesSubDir";
2416         my $file;
2417         foreach $file (@ARGV) {
2418                 $file = "$dir/$file" unless $file =~ m:^/:;
2419                 errDie("No such file $file") unless -f $file;
2420                 my ($dir,$outDir,$ext) = $file =~ m:^(.*/|)([^/]+)\.tar\.(gz|bz2)$:;
2421                 errDie("File '$file' is not a .tar.gz or .tar.bz2")
2422                         unless defined $dir || defined $outDir || defined $ext;
2423                 my ($ver, $extraVer) = $outDir =~ /^[\w-]*[\w\d]*[-]+([\.\dx]+)([_\d\.]+|)$/;
2424                 errDie("File '$file' does not follow fvwm-themes naming convention")
2425                         unless defined $ver && defined $extraVer;
2426                 $ver =~ s/\.(?:[\d]+|x)$/.x/;
2427                 if ($ver ne $version) {
2428                         print "WARNING: fvwm-themes version and tarball version are not compatible\n";
2429                         if (!$forceInstall) {
2430                                 print "Use the --force-install option if you really want to " .
2431                                         "install this tarball.\n";
2432                                 exit(0);
2433                         }
2434                 }
2435                 errDie("Theme name '$outDir' contains unacceptable symbols")
2436                         unless $outDir =~ /^[.\w\d-]+$/;
2437                 my $zcatProg = $ext eq 'gz'? "gzip -cd": "bzip2 -cd";
2438                 open(TAR, "$zcatProg $file| tar xvf - $outDir|")
2439                         || sysDie("Can't open untar for $file");
2440                 my $output = join('', <TAR>);
2441                 close(TAR) || errDie("\nErrors while installing $file");
2442                 opendir(DIR, $outDir);
2443                 print "\n";
2444                 my $theme;
2445                 foreach $theme (readdir(DIR)) {
2446                         next if $theme =~ /^\./;
2447                         errDie("Theme name '$theme' contains unacceptable symbols")
2448                                 unless $theme =~ /^[\w\d-]+$/;
2449                         my $answer = "y";
2450                         if (-d "$workDir/$themesSubDir/$theme") {
2451                                 my $prompt = 2;
2452                                 $prompt = 0 if $forceInstall;
2453                                 if ($prompt) {
2454                                         print "Warning: A theme named $theme is already installed, ".
2455                                                 "Replace it (y/n)? ";
2456                                 }
2457                                 while ($prompt > 0) {
2458                                         $answer = readline(*STDIN);
2459                                         chomp($answer);
2460                                         last if $answer eq "y" || $answer eq "n";
2461                                         print "Please answer y or n, or Ctrl-C to cancel: [n] "
2462                                                 if --$prompt > 0;
2463                                 }
2464                         }
2465                         if ($answer eq "y") {
2466                                 if (-d "$workDir/$themesSubDir/$theme") {
2467                                         system ("rm -rf $workDir/$themesSubDir/$theme");
2468                                 }
2469                                 rename "$outDir/$theme", "$workDir/$themesSubDir/$theme";
2470                                 print "Theme $theme is successfully installed in $themesDir\n\n";
2471                         }
2472                         else {
2473                                 print "Theme $theme is not installed\n\n";
2474                                 system ("rm -rf $outDir/$theme");
2475                         }
2476                 }
2477                 close(DIR);
2478                 rmdir "$outDir";
2479                 print "Installation of $outDir is completed\n";
2480         }
2481         print "Now \"Refresh with no cache\" and have fun...\n\n";
2482         exit(0);
2483 }
2484
2485 if (defined $createPack) {
2486         errDie("Pack name '$createPack' contains unacceptable symbols")
2487                 unless $createPack =~ /^[\w\d-]+$/;
2488         errDie("No theme names to pack listed") unless @ARGV;
2489         my $version = $version;
2490         $version =~ s/\.\d+$/.x/;
2491         my $themesDir = "$workDir/$themesSubDir";
2492         my $tarName = "$createPack-$version";
2493         $tarName = $tarName . "_$packExtraVersion"
2494                 if ("$packExtraVersion" ne "0" && $packExtraVersion !~ /^[.\d]$/);
2495         $tarName = $packPrefix . "-" . $tarName
2496                 if ("$packPrefix" ne "" && $packPrefix !~ /^[\w\d]$/);
2497         my $tarDir = "$tmpDir/$tarName";
2498         errDie("$tmpDir must exist for creating themes pack " .
2499                 "(see --tmp-dir option)") unless -d $tmpDir;
2500         if (-d "$tarDir") {
2501                 system("rm -rf '$tarDir'");
2502         }
2503         makePath ("$tarDir") ||
2504                 errDie("Cannot create $tarDir (see the --tmp-dir option)");
2505         errDie("Cannot chdir to $themesDir") unless chdir "$themesDir";
2506         my $theme;
2507         foreach $theme (@ARGV) {
2508                 errDie("Theme name '$theme' contains unacceptable symbols")
2509                         unless $theme =~ /^[\w\d-]+$/;
2510                 errDie("No such theme $theme in $themesDir") unless -d $theme;
2511                 system("cp -ard $theme $tarDir/");
2512         }
2513         chdir("$tmpDir") || errDie("Cannot chdir to $tmpDir");
2514         system("tar cf - $tarName | gzip -9 >$tarName.tar.gz");
2515         system("rm -rf $tarDir");
2516         print "Pack $tarName.tar.gz created in $tmpDir\n";
2517         exit(0);
2518 }
2519
2520 errDie("Unexpected parameters @ARGV") if @ARGV;
2521
2522 if (defined $expandFile) {
2523         $expandFile ||= $rcFile;
2524         unshift @searchPath, ".";
2525         print getExpandedRc($expandFile);
2526         exit(0);
2527 }
2528
2529 if ($reset || $noCfgCache) {
2530         unlink "$userDir/$cfgCacheFileName"
2531                 if -f "$userDir/$cfgCacheFileName";
2532         unlink "$userDir/$currentThemeSubDir/$cfgCacheFileName"
2533                 if -f "$userDir/$currentThemeSubDir/$cfgCacheFileName";
2534 }
2535
2536 showThemeComponents($themes, $showComponents, $component, $fvwmscript,
2537         $onlySite, $onlyUser) if $showThemes || $showComponents;
2538 showThemeDirs($themes) if $showDir;
2539 showThemeComponentInfo($component) if $component && $showInfo;
2540 showThemeComponentCfg($component) if $component && $showCfg;
2541 showThemeComponentValues($component, $showValues) if $component && @$showValues;
2542
2543 wrongUsage() unless
2544         $fresh || $reset ||
2545         @$loadComponents || @$dropComponents ||
2546         keys %$options || keys %$variants ||
2547         keys %$setLockeds || $comMode || $configCenter ||
2548         $setMinimalReload ne "";
2549
2550 my $cfg = FVWM::ThemeCfg->new('current', $reset? 'default': 'current', $fresh);
2551 if ($comMode) {
2552         $comPid[0] = $comName;
2553         $comPid[0] =~ s/config-//;
2554         $comPid[0] = 0 if ($comPid[0] !~ /^\d+$/);
2555         #$pipe = 1;
2556         $cfg->comLoop($comName);
2557         # we never return here
2558 }
2559 if ($configCenter) {
2560         $cfg->showInfoForConfigCenter();
2561         # we never return here
2562 }
2563 #ccds 1
2564 $cfg->setMinimalReload($setMinimalReload) if $setMinimalReload ne "";
2565 $cfg->useNewComponents($loadComponents, $dropComponents);
2566 $cfg->setNewComponentValues($options, $variants, $setLockeds);
2567 $cfg->generateThemesRc();
2568 $cfg->save() if $cfg->isModified();
2569
2570 exit(0);
2571
2572 #-----------------------------------------------------------------------------
2573 #
2574 # build info for the config center
2575 #
2576 #-----------------------------------------------------------------------------
2577
2578 sub showInfoForConfigCenter {
2579         my $self = shift;
2580         my $return = "";
2581         my $user = "";
2582         my $site = "";
2583         my $cc = $self->{'cc'};
2584
2585         my @components = ("globalfeel");
2586         my $allThemes = getAllThemes();
2587         my $userThemes = getAllThemes(0, 1);
2588
2589         # get themes-rc-3 without the menus
2590         my $dd = $self->getComponentCfg("globalfeel");
2591         $dd->{'used'} = 3;
2592         $self->setComponentCfg("globalfeel", $dd);
2593         $self->setUsedFlags();
2594         my ($dummy,$switchRc) = $self->getAllHooksRc();
2595         my $tmpSwitchRc;
2596         ($dummy,$tmpSwitchRc) = $self->getReadsRc();
2597         $switchRc .= $tmpSwitchRc;
2598         $switchRc =~ s/\n.+globalfeel\"\n/\n/;
2599         print $switchRc;
2600         $return .= "END\n";
2601
2602         foreach (@$userThemes) {
2603                 $return .= "$_\n";
2604         }
2605         my $c;
2606         foreach $c (@components) {
2607                 $return .= "configuration of $c for the Config Center\n";
2608                 my $theme = $cc->{$c}->{'theme'} || "";
2609                 $return .= "$theme\n";
2610                 foreach $theme (@$allThemes) {
2611                         my ($comps, $groups) = getThemeComponentsAndGroups($theme);
2612                         next unless isArrayElement($comps, $c);
2613                         $return .= "$theme\n";
2614                         my $themeCfg = new FVWM::ThemeCfg($theme);
2615                         my $dd = $themeCfg->getComponentCfg($c);
2616                         my $file = $dd->{'read-file'} || "";
2617                         $return .= "$file\n";
2618                         my $options = $cc->{$c}->{'option'};
2619                         if (ref($options) eq 'ARRAY') {
2620                                 $return .= "OPTIONS\n";
2621                                 my $opt;
2622                                 foreach $opt (@$options) {
2623                                         $return .= "$opt->{'file'}:$opt->{'current'}\n";
2624                                 }
2625                                 $return .= "END\n";
2626                         }
2627                 }
2628         }
2629
2630         print $return;
2631         exit(0);
2632 }
2633
2634 #-----------------------------------------------------------------------------
2635 #
2636 # communication loop
2637 #
2638 #-----------------------------------------------------------------------------
2639 # All that follows need a clean up.
2640
2641 sub comLoop {
2642         my $self = shift;
2643         my $outFifo = ".tmp-com-out-" . $comName;
2644         my $inFifo = ".tmp-com-in-" . $comName;
2645         my $command = "";
2646         my $return = "";
2647
2648         my $maxLength = 21;
2649         my $maxLengthOpt = 29;
2650         my %componentToLoad = ();
2651         my %optionToSet = ();
2652         my %variantToSet = ();
2653         my %componentToLock = ();
2654         my %componentToDrop = ();
2655
2656         my $allThemes = getAllThemes();
2657         my $tmp = $self->{$componentKey};
2658         my @currentComponents = sort @$tmp;
2659         my $CC = $self->{cc};
2660
2661         my $settingsConfig = $self->getAllSubComponents("default", "settings");
2662
2663         my ($currentSession, $sessionList, $uptime) = sessionInfo();
2664
2665         chdir($userDir) || die "No FvwmConfigHome $userDir";
2666         unlink($outFifo) if -p "$outFifo";
2667         unlink($inFifo) if -p "$inFifo";
2668
2669         while(1) {
2670
2671                 # read the command.
2672                 myMakeFifo($inFifo) if ! -p "$inFifo";
2673                 eval {
2674                         local $SIG{ALRM} = \&checkScript;
2675                         alarm(10);
2676                         # block unless FvwmScript write on $inFifo
2677                         #open(IN,"<$inFifo") || die "cannot open $inFifo";
2678                         sysopen(IN,"$inFifo", 0) || die "cannot open $inFifo";
2679                         alarm(0);
2680                         ($command)=(<IN>);
2681                         close(IN);
2682                 };
2683                 if ($@ =~ /^cannot/) {
2684                         print STDERR "$comName: cannot read in fifo $inFifo\n";
2685                         unlink("$inFifo");
2686                         exit(1);
2687                 }
2688                 if ($@ =~ /^NoScript/) {
2689                         print STDERR "$comName: No more FvwmScript: exit!\n";
2690                         unlink("$inFifo") if -p "$inFifo";
2691                         my $i;
2692                         for($i = 1; $i < 4; $i++) {
2693                                 kill(9, $comPid[$i]) if $comPid[$i];
2694                         }
2695                         exit(0);
2696                 }
2697                 if ($@ =~ /^Script/) {
2698                         next;
2699                 }
2700
2701                 unlink($inFifo);
2702
2703                 # build the answer
2704                 chomp($command);
2705                 my @tt = split(/\|/,$command);
2706
2707                 # flush the message that does not need an answer
2708                 my $s;
2709                 for ($s = 0; $s < @tt; $s++) {
2710                         if ($tt[$s] =~ /^remove-to-pid-list\s+(\d+)\s+(\d+)$/) {
2711                                 my $id = $1;
2712                                 $comPid[$id] = 0;
2713                                 $tt[$s] = "";
2714                         }
2715                         elsif ($tt[$s] =~ /^add-to-pid-list\s+(\d+)\s+(\d+)$/) {
2716                                 my $id = $1;
2717                                 my $p = $2;
2718                                 $comPid[$id] = $p;
2719                                 $tt[$s] = "";
2720                         }
2721                         elsif ($tt[$s] eq "exit") {
2722                                 exit(0);
2723                         }
2724                 }
2725
2726                 # now answer the first message which needs one
2727                 $command = "";
2728                 for ($s = @tt-1; $s >= 0; $s--) {
2729                         $command = $tt[$s] if $tt[$s] ne "";
2730                 }
2731
2732                 next if ($command eq "");
2733
2734                 my $return = "";
2735                 if ($command =~ /^all-startup-stuff$/)
2736                 {
2737                         #--- themes-list
2738                         my $tlR = $self->getScriptThemeList(
2739                                 $allThemes,
2740                                 \@currentComponents,
2741                                 \%componentToLoad,
2742                                 $maxLength
2743                         );
2744
2745                         #---- current-config
2746                         my $ccR = $self->getScriptCurrentConfig(
2747                                 \@currentComponents,
2748                                 \%componentToLoad,
2749                                 \%componentToLock,
2750                                 \%componentToDrop,
2751                                 \%optionToSet,
2752                                 \%variantToSet,
2753                                 $maxLength
2754                         );
2755
2756                         #---- settings-config
2757                         my $scR = getScriptSettingsConfig($settingsConfig,\%variantToSet);
2758
2759                         #---- session-info
2760                         my $scL = "Default|";
2761                         my $sL = "";
2762                         foreach(@$sessionList) {
2763                                 $sL .= "$_";
2764                                 $scL .= "$_|";
2765                                 $sL .= " "x10 . "(Current)" if $_ eq $currentSession;
2766                                 $sL .= "|";
2767                         }
2768                         $sL =~ s/\|$//;
2769                         $scL =~ s/\|$//;
2770
2771                         #------- build the answer:
2772                         $return = mergeScriptAnswerForParse(
2773                                 "$tlR\n$ccR\n$scR\n$currentSession\n$uptime\n$sL\n$scL");
2774                 }
2775                 # -----------------------------------------
2776                 elsif ($command =~ /^theme-components\s+(\d+)$/) {
2777                         my $index = $1 - 1;
2778                         my ($r1,$r2,$r3) =
2779                                 $self->getScriptComponentInfo(
2780                                         $allThemes, $index,
2781                                         \@currentComponents,
2782                                         \%componentToLoad,
2783                                         $maxLength
2784                                 );
2785                         $return = mergeScriptAnswerForParse("$r1\n$r2\n$r3");
2786                 }
2787                 # -----------------------------------------
2788                 elsif ($command =~ /^current-config\s+(\d+)$/) {
2789                         my $index = $1;
2790                         my $l;
2791                         my $ccReturn = $self->getScriptCurrentConfig(
2792                                 \@currentComponents,
2793                                 \%componentToLoad,
2794                                 \%componentToLock,
2795                                 \%componentToDrop,
2796                                 \%optionToSet,
2797                                 \%variantToSet,
2798                                 $maxLength
2799                         );
2800                         #----- current-comp-name
2801                         my ($ccnReturn1,$ccnReturn2,$ccnReturn3) =
2802                                 $self->getScriptCurrentCompName(
2803                                         $index,\@currentComponents,
2804                                         \%componentToLoad,
2805                                         \%componentToLock,
2806                                         \%componentToDrop,
2807                                         \%optionToSet,
2808                                         \%variantToSet
2809                                 );
2810
2811                         #------- build the answer:
2812                         $return = mergeScriptAnswerForParse(
2813                                 "$ccReturn\n$ccnReturn1\n$ccnReturn2\n$ccnReturn3"
2814                         );
2815                 }
2816                 # -----------------------------------------
2817                 elsif ($command =~ /^current-comp-name\s+(\d+)$/) {
2818                         my $index = $1;
2819                         my ($ccnReturn1,$ccnReturn2,$ccnReturn3) =
2820                                 $self->getScriptCurrentCompName(
2821                                         $index,\@currentComponents,
2822                                         \%componentToLoad,
2823                                         \%componentToLock,
2824                                         \%componentToDrop,
2825                                         \%optionToSet,
2826                                         \%variantToSet
2827                                 );
2828                         $return = mergeScriptAnswerForParse(
2829                                 "$ccnReturn1\n$ccnReturn2\n$ccnReturn3"
2830                         );
2831                 }
2832
2833                 #-------------------------------------------
2834                 elsif ($command =~ /^all-ts-lists\s+(\d+)\s+(\d+)$/)
2835                 {
2836                         my $tcIndex = $1 - 1;
2837                         my $ccnIndex = $2;
2838                         my $l;
2839                         my $theme;
2840
2841                         #--- themes-list
2842                         my $tlReturn = $self->getScriptThemeList(
2843                                 $allThemes,
2844                                 \@currentComponents,
2845                                 \%componentToLoad,
2846                                 $maxLength
2847                         );
2848
2849                         #---- theme-components
2850                         my ($tcReturn1,$tcReturn2,$tcReturn3) =
2851                                 $self->getScriptComponentInfo(
2852                                         $allThemes, $tcIndex,
2853                                         \@currentComponents,
2854                                         \%componentToLoad,
2855                                         $maxLength
2856                                 );
2857
2858                         #---- current-config
2859                         my $ccReturn = $self->getScriptCurrentConfig(
2860                                 \@currentComponents,
2861                                         \%componentToLoad,
2862                                         \%componentToLock,
2863                                         \%componentToDrop,
2864                                         \%optionToSet,
2865                                         \%variantToSet,
2866                                         $maxLength
2867                                 );
2868                         #----- current-comp-name
2869                         my ($ccnReturn1,$ccnReturn2,$ccnReturn3) =
2870                                 $self->getScriptCurrentCompName(
2871                                         $ccnIndex, \@currentComponents,
2872                                         \%componentToLoad,
2873                                         \%componentToLock,
2874                                         \%componentToDrop,
2875                                         \%optionToSet,
2876                                         \%variantToSet
2877                                 );
2878                         #------- build the answer:
2879                         $return = mergeScriptAnswerForParse(
2880                                 "$tlReturn\n$tcReturn1\n$ccReturn\n" .
2881                                 "$ccnReturn1\n$ccnReturn2\n$ccnReturn3");
2882                 }
2883
2884                 # -------------------------------------------------
2885                 elsif ($command =~ /^restore\s+(.+)$/) {
2886                         my $comp = $1;
2887                         my $theme = "";
2888                         my $cc;
2889                         delete($componentToLock{$comp}) if (defined $componentToLock{$comp});
2890                         delete($componentToDrop{$comp}) if (defined $componentToDrop{$comp});
2891                         if (defined $componentToLoad{$comp}) {
2892                                 $theme=$componentToLoad{$comp};
2893                                 delete($componentToLoad{$comp});
2894                                 my $i = 0;
2895                                 my @tmp = @currentComponents;
2896                                 foreach (@tmp) {
2897                                         splice @currentComponents, $i, 1
2898                                                 if (! defined $self->{'cc'}->{$_} && $_ eq $comp);
2899                                         $i++;
2900                                 }
2901                                 my $themeCfg = new FVWM::ThemeCfg($theme);
2902                                 $cc = $themeCfg->getComponentCfg($comp);
2903                         } else {
2904                                 delete $componentToDrop{$comp}
2905                                         if (defined $componentToDrop{$comp});
2906                                 $cc = $self->getComponentCfg($comp);
2907                                 $theme = $cc->{'theme'};
2908                         }
2909                         my $contains = $cc->{'contains'};
2910                         my $options  = $cc->{'option'};
2911                         my $variants = $cc->{'variant'};
2912                         if (ref($options) eq 'ARRAY') {
2913                                 foreach (keys %optionToSet) {
2914                                         delete $optionToSet{$_} if /^$theme\/$comp:/;
2915                                 }
2916                         }
2917                         if (ref($variants) eq 'ARRAY') {
2918                                 foreach (keys %variantToSet) {
2919                                         delete $variantToSet{$_} if /^$theme\/$comp/;
2920                                 }
2921                         }
2922                         if (ref($contains) eq 'ARRAY') {
2923                                 foreach (keys %variantToSet) {
2924                                         delete $variantToSet{$_} if /^$theme\/$comp\//;
2925                                 }
2926                         }
2927                 }
2928                 #----------------------------------------
2929                 elsif ($command =~ /^lock\s+(.+)$/) {
2930                         my $comp = $1;
2931                         my $cc;
2932                         if (defined $self->{'cc'}->{$comp}) {
2933                                 my $cc = $self->getComponentCfg($comp);
2934                                 if (! defined $componentToLoad{$comp}) {
2935                                         if (defined $componentToLock{$comp}) {
2936                                                 delete $componentToLock{$comp};
2937                                         } else {
2938                                                 $componentToLock{$comp}= ($cc->{'locked'}) ? 0:1;
2939                                         }
2940                                 } else {
2941                                         if (defined $componentToLock{$comp}) {
2942                                                 delete $componentToLock{$comp};
2943                                         } else {
2944                                                 $componentToLock{$comp}= 1;
2945                                         }
2946                                 }
2947                         } elsif (defined $componentToLock{$comp} &&
2948                                 defined $componentToLoad{$comp}) {
2949                                 delete $componentToLock{$comp};
2950                         } elsif (defined $componentToLoad{$comp}) {
2951                                 $componentToLock{$comp} = 1;
2952                         }
2953                 }
2954                 #----------------------------------------
2955                 elsif ($command =~ /^drop\s+(.+)$/) {
2956                         my $comp = $1;
2957                         my $cc;
2958                         if (defined $self->{'cc'}->{$comp}) {
2959                                 my $cc = $self->getComponentCfg($comp);
2960                                 if (! defined $componentToDrop{$comp}) {
2961                                         if (defined $componentToDrop{$comp}) {
2962                                                 delete $componentToDrop{$comp};
2963                                         } else {
2964                                                 $componentToDrop{$comp}= ($cc->{'locked'}) ? 0:1;
2965                                         }
2966                                 } else {
2967                                         if (defined $componentToDrop{$comp}) {
2968                                                 delete $componentToDrop{$comp};
2969                                         } else {
2970                                                 $componentToDrop{$comp}= 1;
2971                                         }
2972                                 }
2973                         } elsif (defined $componentToDrop{$comp} &&
2974                                 defined $componentToDrop{$comp}) {
2975                                 delete $componentToDrop{$comp};
2976                         } elsif (defined $componentToDrop{$comp}) {
2977                                 $componentToDrop{$comp} = 1;
2978                         }
2979                 }
2980                 #----------------------------------------
2981                 elsif ($command =~ /^load-all\s+(.+)$/) {
2982                         my ($components, $groups) = getThemeComponentsAndGroups($1);
2983                         foreach (@$components) {
2984                                 next if ((defined $self->{'cc'}->{$_} &&
2985                                         $self->{'cc'}->{$_}->{'locked'} &&
2986                                         ! defined $componentToLoad{$_}) ||
2987                                         (defined $componentToLock{$_} && $componentToLock{$_}));
2988                                 $componentToLoad{$_} = $1;
2989                                 updateCurrentComponents(\@currentComponents,$_);
2990                         }
2991                 }
2992                 #----------------------------------------------
2993                 elsif ($command =~ /^load-main-look\s+(.+)$/) {
2994                         my ($components, $groups) = getThemeComponentsAndGroups($1);
2995                         my $g;
2996                         foreach $g (@$groups) {
2997                                 my $name = $g->{'name'};
2998                                 if ($name eq "basic look") {
2999                                         my $groupComponents = $g->{$componentKey};
3000                                         foreach (@$groupComponents) {
3001                                                 delete $componentToLock{$_} if defined $componentToLock{$_};
3002                                                 delete $componentToDrop{$_} if defined $componentToDrop{$_};
3003                                                 $componentToLoad{$_} = $1;
3004                                                 updateCurrentComponents(\@currentComponents,$_);
3005                                         }
3006                                 }
3007                         }
3008                 }
3009                 # ----------------------------------------------
3010                 elsif ($command =~ /^load-one\s+(.+)\s+(.+)$/) {
3011                         $componentToLoad{$2} = $1;
3012                         delete $componentToLock{$2} if defined $componentToLoad{$2};
3013                         delete $componentToDrop{$2} if defined $componentToDrop{$2};
3014                         updateCurrentComponents(\@currentComponents,$2);
3015                 }
3016                 # -----------------------------------------------------
3017                 elsif ($command =~ /^component-name\s+(.+)\s+(\d+)$/) {
3018                         my ($components, $groups) = getThemeComponents($1);
3019                         my $i = 1;
3020                         foreach (@$components) {
3021                                 next if $_ eq "settings";
3022                                 $return = $_ if $i == $2;
3023                                 $i++;
3024                         }
3025                 }
3026                 # -----------------------------------------
3027                 elsif ($command =~ /^apply-ts-cmd-opts$/) {
3028                         my @compLoad = ();
3029                         my @compDrop = ();
3030                         my %compLock = ();
3031                         my %optLoad = ();
3032                         my %variantLoad = ();
3033                         my @deleteOpt = ();
3034                         my @deleteVariant = ();
3035                         my @deleteLock = ();
3036                         foreach (keys %componentToLoad) {
3037                                 $return .= "--load $_\@$componentToLoad{$_} ";
3038                                 push @compLoad, "$_\@$componentToLoad{$_}";
3039                         }
3040                         foreach (keys %componentToDrop) {
3041                                 $return .= "--drop $_ ";
3042                                 push @compDrop, "$_";
3043                         }
3044                         $self->useNewComponents(\@compLoad, \@compDrop);
3045                         foreach (keys %componentToLock) {
3046                                 if (defined $CC->{$_}) {
3047                                         $return .= "--set-locked $_=$componentToLock{$_} ";
3048                                         $compLock{$_}=$componentToLock{$_};
3049                                         push @deleteLock, $_;
3050                                 }
3051                         }
3052                         foreach (keys %optionToSet) {
3053                                 my $opt = substr($_,index($_,"/")+1);
3054                                 my $theme = substr($_,0,index($_,"/"));
3055                                 my $comp = substr($opt,0,rindex($opt,":"));
3056                                 if (defined $CC->{$comp} && $CC->{$comp}->{'theme'} eq $theme) {
3057                                         $return .= "--option $opt=$optionToSet{$_} ";
3058                                         $optLoad{$opt} = "$optionToSet{$_}";
3059                                         push @deleteOpt, $_;
3060                                 }
3061                         }
3062                         foreach (keys %variantToSet) {
3063                                 my $comp = substr($_,index($_,"/")+1);
3064                                 my $theme = substr($_,0,index($_,"/"));
3065                                 if (defined $CC->{$comp} && $CC->{$comp}->{'theme'} eq $theme) {
3066                                         $return .= "--variant $comp=$variantToSet{$_} ";
3067                                         $variantLoad{$comp} = "$variantToSet{$_}";
3068                                         push @deleteVariant, $_;
3069                                 }
3070                         }
3071                         if ($return ne "") {
3072                                 $return = "FuncFvwmThemesCenterUpdate";
3073                         }
3074                         $self->setNewComponentValues(\%optLoad, \%variantLoad, \%compLock);
3075                         $self->generateThemesRc();
3076                         if ($self->isModified()) {
3077                                 $self->save() if $self->isModified();
3078                         }
3079                         %componentToLoad = ();
3080                         %componentToDrop = ();
3081                         foreach (@deleteOpt) { delete $optionToSet{$_} }
3082                         foreach (@deleteVariant) { delete $variantToSet{$_} }
3083                         foreach (@deleteLock) { delete $componentToLock{$_} }
3084                         # reset
3085                         my %compToRemove = ();
3086                         foreach (@currentComponents) {
3087                                 if (defined $self->{'cc'}->{$_}) {
3088                                         my $cc = $self->getComponentCfg($_);
3089                                         $cc->{'used'} = 1 if defined $cc->{used} && $cc->{used} > 0;
3090                                         $cc->{'used'} = 0 if defined $cc->{used} && $cc->{used} < 0;
3091                                         $compToRemove{$_} = 1 if defined $cc->{used} && $cc->{used} == 0;
3092                                         $self->setComponentCfg($_, $cc);
3093                                 }
3094                         }
3095                         my $config;
3096                         foreach $config (@$settingsConfig) {
3097                                 my $comp = "$config->{comp}";
3098                                 if (defined $self->{'cc'}->{$comp}) {
3099                                         my $cc = $self->getComponentCfg($comp);
3100                                         $cc->{'used'} = 1 if defined $cc->{used} && $cc->{used} > 1;
3101                                         $cc->{'used'} = 0 if defined $cc->{used} && $cc->{used} < 0;
3102                                         $self->setComponentCfg($comp, $cc);
3103                                 }
3104                         }
3105                         $settingsConfig = $self->getAllSubComponents("default", "settings");
3106                         @currentComponents = ();
3107                         $tmp = $self->{$componentKey};
3108                         foreach (sort @$tmp) {
3109                                 next if defined $compToRemove{$_};
3110                                 push @currentComponents, $_;
3111                         }
3112                 }
3113                 # -----------------------------------------
3114                 elsif ($command =~ /^options-variants\s+(.+)\s+(.+)\s+(\d+)$/) {
3115                         my $comp = $1;
3116                         my $theme = $2;
3117                         my $o = $3-1;
3118                         $return = $self->getScriptOptionsVariants($theme,$comp,$o,
3119                                                                                                                                         \%optionToSet,
3120                                                                                                                                         \%variantToSet,
3121                                                                                                                                         $maxLengthOpt);
3122                 }
3123                 # --------------------------------------------
3124                 elsif ($command =~ /^options\s+(.+)\s+(.+)\s+(\d+)$/) {
3125                         my $comp = $1;
3126                         my $theme = $2;
3127                         my $o = $3;
3128                         my $themeCfg = new FVWM::ThemeCfg($theme);
3129                         my $cc = $themeCfg->getComponentCfg($comp);
3130                         my $contains = $cc->{'contains'};
3131                         my $options  = $cc->{'option'};
3132                         my $variants = $cc->{'variant'};
3133                         my $i = 0;
3134                         my $type = "";
3135                         my $list = "";
3136                         if (ref($options) eq 'ARRAY' && ref($variants) eq 'ARRAY') {
3137                                 $type = "Options & Variants";
3138                         }
3139                         if (ref($options) eq 'ARRAY') {
3140                                 my $opt;
3141                                 $type = "Options" if $type eq "";
3142                                 foreach $opt (@$options) {
3143                                         $i++;
3144                                         $list .= "$opt->{'name'}|";
3145                                 }
3146                         }
3147                         if (ref($variants) eq 'ARRAY') {
3148                                 $type = "Variants" if $type eq "";
3149                                 $i++;
3150                                 $list .= "$comp variants"
3151                         }
3152                         elsif (ref($contains) eq 'ARRAY') {
3153                                 $type = "Sub Components";
3154                                 my $c;
3155                                 foreach $c (@$contains) {
3156                                         $i++;
3157                                         my $name = $themeCfg->getComponentCfg("$comp/$c")->{'name'};
3158                                         $name = $name || $c;
3159                                         $list .= "$name|";
3160                                 }
3161                         }
3162                         $list =~ s/\|$//;
3163
3164                         my $ol = $self->getScriptOptionsVariants(
3165                                 $theme, $comp, $o,
3166                                 \%optionToSet,
3167                                 \%variantToSet,
3168                                 $maxLengthOpt
3169                         );
3170                         $return = mergeScriptAnswerForParse("$i\n$type\n$list\n$ol");
3171                         #print STDERR $return ."\n";
3172                 }
3173                 # --------------------------------------------
3174                 elsif ($command =~ /^set-options\s+(.+)\s+(.+)\s+(\d+)\s+(\d+)$/) {
3175                         my $comp = $1;
3176                         my $theme = $2;
3177                         my $o = $3-1;
3178                         my $value = $4;
3179                         my $themeCfg = new FVWM::ThemeCfg($theme);
3180                         my $cc = $themeCfg->getComponentCfg($comp);
3181                         my $contains = $cc->{'contains'};
3182                         my $options  = $cc->{'option'};
3183                         my $variants = $cc->{'variant'};
3184                         if (ref($options) eq 'ARRAY' && defined $options->[$o]) {
3185                                 my $optionEntry = $options->[$o];
3186                                 my $optionFile = $optionEntry->{'file'};
3187                                 $optionToSet{"$theme/$comp:$optionFile"} = $value;
3188                         } elsif (ref($variants) eq 'ARRAY') {
3189                                 my $i;
3190                                 my $v = $value;
3191                                 for ($i = 0; $i < @$variants; $i++) {
3192                                         $value++ if $variants->[$i]->{'hidden'} && $i < $value;
3193                                 }
3194                                 $variantToSet{"$theme/$comp"} = "$value";
3195                         } elsif (ref($contains) eq 'ARRAY' && defined $contains->[$o]) {
3196                                 my $c = $contains->[$o];
3197                                 my $dd = $themeCfg->getComponentCfg("$comp/$c");
3198                                 my $subVariants = $dd->{'variant'};
3199                                 if (ref($subVariants) eq 'ARRAY') {
3200                                         $variantToSet{"$theme/$comp/$c"}="$value";
3201                                 } else {
3202                                         # Need To Drop ..
3203                                 }
3204                         }
3205                 }
3206                 elsif ($command =~ /^update\s+(\d+)$/) {
3207                         my $fresh = $1;
3208                         $cfgFileCache = {};
3209                         unlink "$userDir/$cfgCacheFileName"
3210                                 if -f "$userDir/$cfgCacheFileName";
3211                         unlink "$userDir/$currentThemeSubDir/$cfgCacheFileName"
3212                                 if -f "$userDir/$currentThemeSubDir/$cfgCacheFileName";
3213                         $self = FVWM::ThemeCfg->new('current', 'current', $fresh);
3214                         $allThemes = getAllThemes();
3215                         $tmp = $self->{$componentKey};
3216                         @currentComponents = sort @$tmp;
3217                         $CC = $self->{cc};
3218                         $settingsConfig = $self->getAllSubComponents("default", "settings");
3219                         ($currentSession,$sessionList,$uptime) = sessionInfo();
3220                 }
3221                 #-----------------------------------------------------------------------
3222                 # GS
3223
3224                 # -----------------------------------------
3225                 elsif ($command =~ /^settings-config-and-variant\s+(.+)\s+(.+)\s+(\d+)$/) {
3226                         my $comp = $1;
3227                         my $theme = $2;
3228                         my $o = $3-1;
3229
3230                         my $r1 = getScriptSettingsConfig($settingsConfig,\%variantToSet);
3231                         my $r2 = $self->getScriptOptionsVariants(
3232                                 $theme, $comp, $o,
3233                                 \%optionToSet,
3234                                 \%variantToSet,
3235                                 $maxLengthOpt
3236                         );
3237                         $return = mergeScriptAnswerForParse("$r1\n$r2");
3238                 }
3239                 # -----------------------------------------
3240                 elsif ($command =~ /^settings-config$/) {
3241                         $return = getScriptSettingsConfig($settingsConfig,\%variantToSet);
3242                 }
3243                 # -----------------------------------------
3244                 elsif ($command =~ /^settings-comp\s+(\d+)$/) {
3245                         my $r1 = "$settingsConfig->[$1-1]->{'name'}";
3246                         my $r2 = "$settingsConfig->[$1-1]->{'comp'}";
3247                         my $isSet = 0;
3248                         $isSet = 1
3249                                 if defined $variantToSet{"default/$settingsConfig->[$1-1]->{comp}"};
3250                         my $r3 = $isSet;
3251                         my $r4 = $self->getScriptOptionsVariants(
3252                                 'default', $r2, $1, \%optionToSet,
3253                                  \%variantToSet, $maxLengthOpt);
3254                         $return = mergeScriptAnswerForParse("$r1\n$r2\n$r3\n$r4");
3255                 }
3256                 #-----------------------------------------------------------------------
3257                 # SM
3258                 elsif ($command =~ /^session-info$/) {
3259                         my $configList = "Default|";
3260                         my $tmp = "";
3261                         foreach(@$sessionList) {
3262                                 $tmp .= "$_";
3263                                 $configList .= "$_|";
3264                                 $tmp .= " "x10 . "(Current)" if $_ eq $currentSession;
3265                                 $tmp .= "|";
3266                         }
3267                         $tmp =~ s/\|$//;
3268                         $configList =~ s/\|$//;
3269                         $return = mergeScriptAnswerForParse(
3270                                 "$currentSession\n$uptime\n$tmp\n$configList"
3271                         );
3272                 }
3273                 # --------------------------------------
3274                 elsif ($command =~ /^session-uptime$/) {
3275                         my $current = "$userDir/themes/current";
3276                         $return = upTime($current,1);
3277                 }
3278                 # --------------------------------------
3279                 elsif ($command =~ /^session-name\s+(\d+)$/) {
3280                         my $index = $1-1;
3281                         $return = $$sessionList[$index] if defined $$sessionList[$index] &&
3282                                 $index >= 0;
3283                 }
3284                 # --------------------------
3285                 elsif ($command =~ /^edit-session\s+(.+)$/) {
3286                         my $opt = $1;
3287                         my @opt = split(":",$opt);
3288                         # orig_session:new_session_name:int
3289                         # int is the value of Widget 52
3290                         $return = "Err1" if $#opt != 2;
3291                         $return = "Err1" if $opt[0] eq "";
3292                         foreach (@$sessionList) {
3293                                 next if $opt[1] eq $opt[0];
3294                                 $return = "Err2" if $opt[1] eq $_;
3295                         }
3296                         if ($return eq "") {
3297                                 # $themesSubDir = themes
3298                                 # $currentThemeName = current
3299                                 # $currentThemeSubDir = themes/current
3300                                 my $orig = "$currentThemeSubDir-$opt[0]";
3301                                 my $dest = "$currentThemeSubDir-$opt[1]";
3302                                 my $i = 1;
3303                                 my $dirConfig = "";
3304                                 foreach (@$sessionList) {
3305                                                 $i++;
3306                                                 $dirConfig = "$currentThemeSubDir-$$sessionList[$i-2]"
3307                                                         if $i == $opt[2];
3308                                 }
3309                                 if ($dest ne $orig) {
3310                                         rename($orig, $dest);
3311                                 }
3312                                 # change the symlinks if needed
3313                                 if ($currentSession eq $opt[0] && $dest ne $orig) {
3314                                         chdir("$themesSubDir");
3315                                         unlink("$currentThemeName") ||
3316                                                 sysDie("Can't unlink $userDir/$currentThemeSubDir");
3317                                         symlink("$currentThemeName-$opt[1]","$currentThemeName");
3318                                         chdir("$userDir");
3319                                         unlink("themes-rc-2") ||
3320                                                 sysDie("Can't unlink $userDir/themes-rc-2");
3321                                         symlink("$currentThemeSubDir-$opt[1]/themes-rc-2","themes-rc-2");
3322                                 }
3323                                 if ($dirConfig ne $orig) {
3324                                         system("rm -rf themes/current-$opt[1]/images");
3325                                         #unlink("themes/current-$opt[1]/theme.cfg");
3326                                         #unlink("themes/current-$opt[1]/$rcFile2");
3327                                         if ($dirConfig eq "") {
3328                                                 # need to use the default config
3329                                                 system("cp -f $siteDir/$rcFile2 '$dest/'; " .
3330                                                         "cp -f $siteDir/themes/current/theme.cfg '$dest/'");
3331                                         } else {
3332                                                 chdir($dirConfig) || sysDie("Can't chdir '$dirConfig'");
3333                                                 system("cp -af * '../../$dest'");
3334                                                 chdir($userDir);
3335                                         }
3336                                 }
3337                                 ($currentSession,$sessionList,$uptime) = sessionInfo();
3338                                 $i = 0;
3339                                 foreach (@$sessionList) {
3340                                         $i++;
3341                                         $return = $i if $_ eq $opt[1];
3342                                 }
3343                         }
3344                 }
3345                 # --------------------------
3346                 elsif ($command =~ /^add-session\s+(.+)$/) {
3347                         my $opt = $1;
3348                         my @opt = split(":",$opt);
3349                         $return = "Err1" if $#opt != 1;
3350                         $return = "Err1" if $opt[0] eq "";
3351                         foreach (@$sessionList) {
3352                                 $return = "Err2" if $opt[0] eq $_;
3353                         }
3354
3355                         if ($return eq "") {
3356                                 my $dirConfig = "";
3357                                 my $i = 1;
3358                                 foreach (@$sessionList) {
3359                                         $i++;
3360                                         $dirConfig = "themes/current-$$sessionList[$i-2]"
3361                                                 if $i == $opt[1];
3362                                 }
3363                                 makePath("$userDir/$currentThemeSubDir-$opt[0]");
3364                                 if ($dirConfig ne "") {
3365                                         chdir($dirConfig);
3366                                         system("cp -rdp * '../../$currentThemeSubDir-$opt[0]'");
3367                                         chdir($userDir);
3368                                 }
3369                                 ($currentSession,$sessionList,$uptime) = sessionInfo();
3370                                 $i = 0;
3371                                 foreach (@$sessionList) {
3372                                         $i++;
3373                                         $return = $i if $_ eq $opt[0];
3374                                 }
3375                         }
3376                 }
3377                 # --------------------------
3378                 elsif ($command =~ /^remove-session\s+(.+)$/) {
3379                         my $session = $1;
3380                         my $i = 0;
3381                         my $index = -1;
3382                         foreach (@$sessionList) {
3383                                 $index = $i if $session eq $_;
3384                                 $i++;
3385                         }
3386                         if ($index == -1) {
3387                                 $return = "Err3";
3388                         } else {
3389                                 system("rm -rf themes/current-$session");
3390                                 ($currentSession,$sessionList,$uptime) = sessionInfo();
3391                                 if (! defined $$sessionList[$index]) {
3392                                         $index--;
3393                                 }
3394                                 $i = $index+1;
3395                                 $return = mergeScriptAnswerForParse("$$sessionList[$index]\n$i");
3396                         }
3397                 }
3398                 # --------------------------
3399                 elsif ($command =~ /^apply-sm\s+(.+)$/) {
3400                         my $newSession = $1;
3401                         my $create = 0;
3402                         my $rcRef = "";
3403                         my $rcNew = "";
3404                         # all that follows need a lot of optimisation
3405
3406                         chdir("$userDir/$themesSubDir");
3407                         # we should create a themes-rc-3 to execute the stop func of the
3408                         # current theme!
3409                         system("fvwm-themes-config --fresh");
3410                         $rcRef = loadFile("$userDir/$rcFile3");
3411                         while (1) {
3412                                 last unless $$rcRef =~ /(\w+)(.*?)(|\n.*)$/s;
3413                                 $$rcRef = $3;
3414                                 my $t = $1;
3415                                 $rcNew = $rcNew . $t . "\n" if ($t =~ /FuncFvwm/);
3416                         }
3417                         saveFile("$userDir/$rcFile3",\$rcNew,0);
3418                         unlink("$currentThemeName") ||
3419                                 sysDie("Can't unlink $userDir/$currentThemeSubDir");
3420                         makePath("$userDir/$themesSubDir/current-$newSession")
3421                                 if ! -d "current-$newSession";
3422                         symlink("current-$newSession","$currentThemeName");
3423                         chdir("$userDir");
3424                         if (! -f "$currentThemeSubDir-$newSession/$rcFile2") {
3425                                 system("touch $currentThemeName-$newSession/$rcFile2");
3426                                 $create = 1;
3427                         }
3428                         unlink("themes-rc-2");
3429                         symlink("$currentThemeSubDir-$newSession/themes-rc-2","themes-rc-2");
3430                         if ($create) {
3431                                 system("fvwm-themes-config --reset");
3432                                 #system("fvwm-themes-config --load \@personal 2>/dev/null");
3433                         }
3434                         ($currentSession,$sessionList,$uptime) = sessionInfo();
3435                         $cfgFileCache = {};
3436                         unlink "$userDir/$cfgCacheFileName"
3437                                 if -f "$userDir/$cfgCacheFileName";
3438                         unlink "$userDir/$currentThemeSubDir/$cfgCacheFileName"
3439                                 if -f "$userDir/$currentThemeSubDir/$cfgCacheFileName";
3440                         $self = FVWM::ThemeCfg->new('current', 'current', 1);
3441                         $allThemes = getAllThemes();
3442                         $tmp = $self->{$componentKey};
3443                         @currentComponents = sort @$tmp;
3444                         $CC = $self->{cc};
3445                         $settingsConfig = $self->getAllSubComponents("default", "settings");
3446                         # discard the change in ts
3447                         %componentToLoad = ();
3448                         %componentToDrop = ();
3449                         %componentToLock = ();
3450                         %optionToSet = ();
3451                         %variantToSet = ();
3452                 }
3453                 # --------------------------
3454                 else {
3455                         print STDERR "$comName: unknown command $command\n";
3456                         $return = "0";
3457                 }
3458
3459                 # answer
3460                 $return = "1" if $return eq "";
3461                 myMakeFifo($outFifo);
3462                 eval {
3463                         local $SIG{ALRM} = sub { die "Timeout" };
3464                         alarm(10);
3465                         # this line block until com take the answer
3466                         open(OUT,">$outFifo") || die "$comName: cannot write fifo $outFifo";
3467                         alarm(0);
3468                         print OUT $return;
3469                         close(OUT);
3470                         unlink($outFifo);
3471                 };
3472                 if ($@ =~ /cannot/) {
3473                         print STDERR "$comName: cannot write on fifo $outFifo\n";
3474                         unlink($outFifo);
3475                         unlink($inFifo);
3476                         exit(1);
3477                 }
3478                 if ($@ =~ /Timeout/) {
3479                         print STDERR "$comName: com do not read my answer on $outFifo!\n";
3480                 }
3481
3482         }
3483 }
3484
3485 #----------------------------------------------------------------------------
3486 # useful functions which may be useful not only for the com loop
3487
3488 #--------------------------------------
3489 sub getOptionIndex {
3490         my $self = shift;
3491         my $theme = shift;
3492         my $comp = shift;
3493         my $optionEntry = shift;
3494         my $o = shift;
3495
3496         my $themeCfg = new FVWM::ThemeCfg($theme);
3497         my $cc = $themeCfg->getComponentCfg($comp);
3498         my $CC = $self->{cc};
3499         my $_core = $self->getComponentCfg("_core");
3500
3501         my $values = $optionEntry->{'value'};
3502         my $index =
3503                 $optionEntry->{'current'} || ($optionEntry->{'default'} || 1);
3504         # see if $comp@$theme is "current"
3505         if (defined $CC->{$comp}->{'theme'} &&
3506                 $CC->{$comp}->{'theme'} eq $theme)
3507         {
3508                 my $OptE = $CC->{$comp}->{'option'}->[$o];
3509                 $index = $OptE->{'current'} || ($OptE->{'default'} || 1);
3510                 # if not see if we have a memeory
3511         } elsif (defined $_core->{'memory'}->{$theme}->{$comp}) {
3512                 my $cm = $_core->{'memory'}->{$theme}->{$comp};
3513                 my $mOptions = $cm->{'option'};
3514                 if (time() - $cm->{'time'} <= 6 * 30 * 24 * 60 * 60 &&
3515                         ref($mOptions) eq 'ARRAY' &&
3516                         defined $mOptions->[$o]->{'current'})
3517                 {
3518                         $index = $mOptions->[$o]->{'current'}
3519                 }
3520         }
3521         $index--;
3522         $index = 0 if $index < 0 || $index >= @$values;
3523
3524         return $index;
3525 }
3526
3527 #--------------------------------------
3528 sub getVariantIndex {
3529         my $self = shift;
3530         my $theme = shift;
3531         my $comp = shift;
3532         my $val = shift;
3533
3534         my $themeCfg = new FVWM::ThemeCfg($theme);
3535         my $cc = $themeCfg->getComponentCfg($comp);
3536         my $CC = $self->{cc};
3537         my $_core = $self->getComponentCfg("_core");
3538
3539         my $index = $cc->{'current'} || $cc->{'default'};
3540         if (defined $CC->{"$comp"}->{'theme'} &&
3541                 $CC->{"$comp"}->{'theme'} eq $theme)
3542         {
3543                 $index = $CC->{"$comp"}->{'current'} || $index;
3544                 # if not see if we have a memory
3545         } elsif (defined $_core->{'memory'}->{"$theme"}->{"$comp"}) {
3546                 my $cm = $_core->{'memory'}->{$theme}->{"$comp"};
3547                 if (time() - $cm->{'time'} <= 6 * 30 * 24 * 60 * 60 &&
3548                         $cm->{'current'})
3549                 {
3550                         $index = $cm->{'current'};
3551                 }
3552         }
3553         $index--;
3554         $index = 0 if $index < 0 || $index >= $val;
3555         return $index;
3556 }
3557
3558 #--------------------------------------
3559 sub getAllSubComponents ($$$;$$) {
3560         my $self = shift;
3561         my $theme = shift;
3562         my $component = shift;
3563         my $themeCfg = shift || new FVWM::ThemeCfg($theme);
3564         my $name = shift;
3565         my $configs = [];
3566         my $cc = $themeCfg->getComponentCfg($component);
3567         my $contains = $cc->{'contains'};
3568
3569         return undef if (ref($contains) ne 'ARRAY');
3570         my $c;
3571         foreach $c (@$contains) {
3572                 my $dd = $themeCfg->getComponentCfg("$component/$c");
3573                 next if $dd->{'hidden'};
3574                 my $subConfigs = $self->getAllSubComponents($theme, "$component/$c",
3575                         $themeCfg, $dd->{'name'});
3576                 if (defined $subConfigs) {
3577                         push @$configs, @$subConfigs;
3578                 } else {
3579                         my $config = {};
3580                         my $dd = $themeCfg->getComponentCfg("$component/$c");
3581                         $config->{'name'} = defined $name ? "$name " : "";
3582                         $config->{'name'} .= $dd->{'name'};
3583                         $config->{'comp'} = "$component/$c";
3584                         my $variants = $dd->{'variant'};
3585                         if (ref($variants) eq 'ARRAY') {
3586                                 my $j = getVariantIndex($self,$theme,"$component/$c",@$variants);
3587                                 $config->{'index'} = $j;
3588                                 $config->{'current'} = $variants->[$j]->{'name'};
3589                         }
3590                         push @$configs, $config;
3591                 }
3592         }
3593         return $configs;
3594 }
3595 #--------------------------------------
3596 sub sessionInfo {
3597         my @sessionList;
3598         my $dir = "$userDir/themes";
3599         my $current = "$userDir/themes/current";
3600         my $currentSession = readlink($current);
3601         my $uptime = upTime($current,1);
3602         $currentSession =~ s/^current-//;
3603         opendir(DIR,"$dir");
3604         foreach (readdir(DIR)) {
3605                 if (/^current-(.+)/) { push @sessionList, $1; }
3606         }
3607         close(DIR);
3608         @sessionList = sort @sessionList;
3609         return ($currentSession, \@sessionList, $uptime);
3610 }
3611
3612 # ----------------------
3613 sub upTime {
3614         my $file = shift;
3615         my $isSymbolic = shift || 0;
3616         my @stat = $isSymbolic ? lstat($file) : stat($file);
3617         my $uptime = time - $stat[9];
3618         $uptime = secToUptime($uptime);
3619         return $uptime;
3620 }
3621
3622 # ----------------------
3623 sub secToUptime {
3624         my $time = shift;
3625         my $day = int($time/(60*60*24));
3626         $time = $time%(60*60*24);
3627         my $hours = int($time/(60*60));
3628         $time = $time % (60*60);
3629         my $min = int($time/60);
3630         $min = "0$min" if length($min) == 1;
3631         my $ret = "";
3632         $ret .= "$day days " if $day > 1;
3633         $ret .= "$day day " if $day == 1;
3634         $ret .= "$hours h $min min";
3635         return $ret;
3636 }
3637
3638 #----------------------------------------------------------------------------
3639 # useful functions for the com loop
3640
3641 #---------------------------------------
3642 # merging lines in one line for the Parse FvwmScript instruction
3643 sub mergeScriptAnswerForParse($) {
3644         my $in = shift;
3645         my $out = "";
3646         my $l;
3647
3648         foreach (split(/\n/,$in)) {
3649                 $l = length($_);
3650                 $out .= "0" x (4-length($l)) . "$l" . $_;
3651         }
3652
3653         return $out;
3654 }
3655
3656 #---------------------------------------
3657 # list of all themes
3658 sub getScriptThemeList($$$$$) {
3659         my $self = shift;
3660         my $allThemes = shift;
3661         my $currentComponents = shift;
3662         my $componentToLoad = shift;
3663         my $maxLength = shift;
3664         my $l;
3665         my $return = "";
3666         my $theme;
3667
3668         foreach $theme (@$allThemes) {
3669                 my ($components, $groups) = getThemeComponentsAndGroups($theme);
3670                 my $used = 0;
3671                 my $set = 0;
3672                 my $useFlag = "";
3673                 foreach (@$components) {
3674                         my $used0 = 0;
3675                         $used0 = 1 if isArrayElement($currentComponents, $_) &&
3676                                 defined $self->{'cc'}->{$_} &&
3677                                         ($self->getComponentCfg($_)->{$themeKey} || "") eq $theme;
3678                         $used ||= $used0;
3679                 }
3680                 my $key;
3681                 foreach $key (keys %$componentToLoad) {
3682                         $set = 1 if $componentToLoad->{$key} eq $theme;
3683                 }
3684                 $l = $maxLength - length($theme);
3685                 $l = 1 if $l < 1;
3686                 $useFlag .= " " x $l . "(" if $used || $set;
3687                 $useFlag .= "used" if $used;
3688                 $useFlag .= "/" if $used && $set;
3689                 $useFlag .= "set" if $set;
3690                 $useFlag .= ")" if $used || $set;
3691                 $return .= "$theme$useFlag|";
3692         }
3693         $return =~ s/\|$//;
3694         return $return;
3695 }
3696
3697 #---------------------------------------
3698 # info for a component
3699 sub getScriptComponentInfo($$$$$) {
3700         my $self = shift;
3701         my $allThemes = shift;
3702         my $index = shift;
3703         my $currentComponents = shift;
3704         my $componentToLoad = shift;
3705         my $maxLength = shift;
3706         my $l;
3707         my ($r1,$r2,$r3) = ("","","");
3708         my $theme;
3709
3710         if ($index < 0 || !defined $$allThemes[$index]) {
3711                 return ("None","None","None");
3712         }
3713
3714         $theme = $$allThemes[$index];
3715         my ($components, $groups) = getThemeComponentsAndGroups($theme);
3716         foreach (@$components) {
3717                 next if $_ eq "settings";
3718                 my $useFlag = "";
3719                 my $set = 0;
3720                 my $unset = 0;
3721                 my $used = isArrayElement($currentComponents, $_) &&
3722                         defined $self->{'cc'}->{$_} &&
3723                                 ($self->getComponentCfg($_)->{$themeKey} || "") eq $theme;
3724                 $set = 1 if defined $componentToLoad->{$_} &&
3725                         $componentToLoad->{$_} eq $theme;
3726                 $unset = 1 if defined $componentToLoad->{$_} && !$set;
3727                 $l = $maxLength - length($_);
3728                 $l = 1 if $l < 1;
3729                 $useFlag .= " " x $l . "(" if $used || $set;
3730                 $useFlag .= "used" if $used && !$unset;
3731                 $useFlag .= "unset" if $used && $unset;
3732                 $useFlag .= "/" if $used && $set;
3733                 $useFlag .= "set" if $set;
3734                 $useFlag .= ")" if $used || $set;
3735                 $r1 .= "$_$useFlag|";
3736         }
3737         $r1 =~ s/\|$//;
3738         $r2 = $theme;
3739         $r3 = getThemeDir($theme);
3740         return ($r1,$r2,$r3);
3741 }
3742
3743 #---------------------------------------
3744 # the current config
3745 sub getScriptCurrentConfig($$$$$$$$) {
3746         my $self = shift;
3747         my $currentComponents = shift;
3748         my $componentToLoad = shift;
3749         my $componentToLock = shift;
3750         my $componentToDrop = shift;
3751         my $optionToSet = shift;
3752         my $variantToSet = shift;
3753         my $maxLength = shift;
3754
3755         my $l;
3756         my $return = "";
3757
3758         foreach (@$currentComponents) {
3759                 next if $_ eq "settings";
3760                 my $dd;
3761                 my $usedString;
3762                 my $set = 0;
3763                 my $theme;
3764                 my $cc;
3765                 if (defined $self->{'cc'}->{$_}) {
3766                         $cc = $self->getComponentCfg($_);
3767                         $theme = $cc->{'theme'};
3768                         $usedString = ($cc->{'locked'}) ? "Locked: " : "Used: ";
3769                         $usedString .= "$theme";
3770                 } else {
3771                         $usedString = "Not Used";
3772                         $set = -1;
3773                 }
3774                 my $stateString = "";
3775                 my $setOrLock = "Set: ";
3776                 if (defined $componentToLoad->{$_}) {
3777                         $set = 1;
3778                         $theme = $componentToLoad->{$_};
3779                         $setOrLock = "Lock: "
3780                                 if (defined $componentToLock->{$_} &&
3781                                         $componentToLock->{$_} == 1);
3782                 } elsif (defined $componentToDrop->{$_}) {
3783                         $set = -1;
3784                 } elsif (defined $componentToLock->{$_}) {
3785                         $set = 2;
3786                         $setOrLock = ($componentToLock->{"$_"}) ? "Lock it" : "Unlock it";
3787                         $setOrLock = "" if ($componentToLock->{"$_"} == $cc->{'locked'})
3788                 }
3789                 $usedString = "(" . $usedString . ")" if $set == 1;
3790                 $l = $maxLength - length($usedString);
3791                 $l = 1 if $l < 1;
3792                 $stateString = " " x $l . $setOrLock . "$componentToLoad->{$_}"
3793                         if $set == 1;
3794                 $stateString = " " x $l . "Drop it!"
3795                         if $set == -1;
3796                 $stateString = " " x $l . $setOrLock
3797                         if $set == 2;
3798                 my $l1 = $maxLength - 3 - length($stateString) + $l;
3799                 $l1 = 1 if $l1 < 1;
3800                 if ($set == 1) {
3801                         my $themeCfg = new FVWM::ThemeCfg($componentToLoad->{$_});
3802                         $dd = $themeCfg->getComponentCfg($_);
3803                         $theme = $dd->{'theme'};
3804                 } elsif ($set == 0 || $set == 2) {
3805                         $dd = $self->getComponentCfg($_);
3806                 }
3807                 my $contains = $dd->{'contains'};
3808                 my $options  = $dd->{'option'};
3809                 my $variants = $dd->{'variant'};
3810                 my $propertiesStr = "";
3811                 my $t = "";
3812                 if (ref($options) eq 'ARRAY') {
3813                         $propertiesStr = " " x $l1 ."Opt";
3814                         my $opt;
3815                         foreach $opt (@$options) {
3816                                 my $optFile = $opt->{'file'};
3817                                 $t = "(S)" if defined $optionToSet->{"$theme/$_:$optFile"};
3818                         }
3819                 }
3820                 if (ref($variants) eq 'ARRAY') {
3821                         $propertiesStr = " " x $l1 . ($propertiesStr? "V/O": "Var");
3822                         my $v;
3823                         foreach $v (@$variants) {
3824                                                 $t = "(S)" if defined $variantToSet->{"$theme/$_"};
3825                                         }
3826                 }
3827                 elsif (ref($contains) eq 'ARRAY') {
3828                         $propertiesStr = " " x $l1 ."Sub";
3829                         my $c;
3830                         # dropped ?
3831                         foreach $c (@$contains) {
3832                                 $t = "(S)" if defined $variantToSet->{"$theme/$_/$c"};
3833                         }
3834                 }
3835                 $propertiesStr .= $t;
3836                 $l = $maxLength - length($_);
3837                 $l = 1 if $l < 1;
3838                 $return .= "$_" . " " x $l . $usedString . $stateString .
3839                         $propertiesStr . "|";
3840         }
3841         $return =~ s/\|$//;
3842         return $return;
3843 }
3844
3845 #---------------------------------------
3846 #
3847 sub getScriptCurrentCompName($$$$$$$$) {
3848         my $self = shift;
3849         my $index = shift;
3850         my $currentComponents = shift;
3851         my $componentToLoad = shift;
3852         my $componentToLock = shift;
3853         my $componentToDrop = shift;
3854         my $optionToSet = shift;
3855         my $variantToSet = shift;
3856
3857         my $l;
3858         my ($r1,$r2,$r3) = "";
3859
3860         if ($index == 0) {
3861                 return ("None","None","None");
3862         }
3863
3864         my $dd = [];
3865         my $i = 1;
3866         my ($comp,$theme,$hasProperties,$drop,$set,$lock) =
3867                 ("", "", "0", "0", "0", "0");
3868         foreach (@$currentComponents) {
3869                 next if $_ eq "settings";
3870                 if ($i == $index) {
3871                         $comp = "$_";
3872                         if (defined $componentToLoad->{$_}) {
3873                                 $set = 1;
3874                                 $theme = "$componentToLoad->{$_}";
3875                         } else {
3876                                 my $cc = $self->getComponentCfg($_);
3877                                 $theme = "$cc->{'theme'}";
3878                                 $lock = "$cc->{'locked'}";
3879                         }
3880                         if (defined $componentToLock->{$_}) {
3881                                 $lock = $componentToLock->{$_};
3882                                 $set = 1;
3883                         }
3884                         if (defined $componentToDrop->{$_}) {
3885                                 $set = 1;
3886                         }
3887                 }
3888                 $i++;
3889         }
3890         if ($set) {
3891                 my $themeCfg = new FVWM::ThemeCfg($theme);
3892                 $dd = $themeCfg->getComponentCfg($comp);
3893         } else {
3894                 $dd = $self->getComponentCfg($comp);
3895         }
3896         my $contains = $dd->{'contains'};
3897         my $options  = $dd->{'option'};
3898         my $variants = $dd->{'variant'};
3899         if (ref($options) eq 'ARRAY') {
3900                 $hasProperties = 1;
3901                 my $opt;
3902                 foreach $opt (@$options) {
3903                         my $optFile = $opt->{'file'};
3904                         $set = 1 if defined $optionToSet->{"$theme/$comp:$optFile"};
3905                 }
3906         }
3907         if (ref($variants) eq 'ARRAY') {
3908                 $hasProperties = 1;
3909                 my $c;
3910                 foreach $c (@$variants) {
3911                         $set = 1 if defined $variantToSet->{"$theme/$comp"};
3912                 }
3913         }
3914         elsif (ref($contains) eq 'ARRAY') {
3915                 $hasProperties = 1;
3916                 my $c;
3917                 # dropped ?
3918                 foreach $c (@$contains) {
3919                         $set = 1 if defined $variantToSet->{"$theme/$comp/$c"};
3920                 }
3921         }
3922         $drop = ($comp !~ /^(settings|colors$|menus|globallook)/
3923                                 || $comp =~ /-extra$/)? 1 : 0;
3924         $r1 = $comp;
3925         $r2 = $theme;
3926         $r3 = $hasProperties . $set . $drop . $lock;
3927         return ($r1,$r2,$r3);
3928 }
3929
3930 #---------------------------------------
3931 #
3932 sub getScriptSettingsConfig($$) {
3933         my $settingsConfig = shift;
3934         my $variantToSet = shift;
3935         my $config;
3936         my $return = "";
3937
3938         foreach $config (@$settingsConfig) {
3939                 my $l = 26 - length($config->{'name'});
3940                 $l = 1 if $l <= 0;
3941                 $return .= $config->{'name'} . " "x$l . "U: " .
3942                         $config->{'current'};
3943                 if (defined $variantToSet->{"default/$config->{comp}"}) {
3944                         my $j = $variantToSet->{"default/$config->{comp}"};
3945                         my $themeCfg = new FVWM::ThemeCfg('default');
3946                         my $dd = $themeCfg->getComponentCfg("$config->{comp}");
3947                         my $variants = $dd->{'variant'};
3948                         my $set = $variants->[$j-1]->{'name'};
3949                         $l = 28 - length($config->{'current'});
3950                         $l = 1 if $l <= 0;
3951                         $return .= " "x$l . "S: $set";
3952                 }
3953                 $return .=      "|";
3954         }
3955         $return =~ s/\|$//;
3956         return $return;
3957 }
3958
3959 #---------------------------------------
3960 #
3961 sub getScriptOptionsVariants($$$$$$$) {
3962         my $self = shift;
3963         my $theme = shift;
3964         my $comp = shift;
3965         my $o = shift;
3966         my $optionToSet = shift;
3967         my $variantToSet = shift;
3968         my $maxLengthOpt = shift;
3969         my $return = "";
3970
3971         if ($comp eq "None" || $theme eq "None") {
3972                 return "None";
3973         }
3974
3975         my $themeCfg = new FVWM::ThemeCfg($theme);
3976         my $cc = $themeCfg->getComponentCfg($comp);
3977         my $contains = $cc->{'contains'};
3978         my $options  = $cc->{'option'};
3979         my $variants = $cc->{'variant'};
3980         if (ref($options) eq 'ARRAY' && defined $options->[$o]) {
3981                 my $optionEntry = $options->[$o];
3982                 my $i = getOptionIndex($self,$theme,$comp,$optionEntry,$o);
3983                 my $optFile = $optionEntry->{'file'};
3984                 my $isSet = -1;
3985                 $isSet = $optionToSet->{"$theme/$comp:$optFile"}
3986                 if defined $optionToSet->{"$theme/$comp:$optFile"};
3987                 my $values = $optionEntry->{'value'};
3988                 $return = variantsOptionsScriptList(
3989                         $values, $i, $isSet, $maxLengthOpt, $theme, $comp
3990                 );
3991         }
3992         elsif (ref($variants) eq 'ARRAY') {
3993                 my $i = getVariantIndex($self,$theme,$comp,@$variants);
3994                 my $isSet = -1;
3995                 $isSet = $variantToSet->{"$theme/$comp"}
3996                 if defined $variantToSet->{"$theme/$comp"};
3997                 $return = variantsOptionsScriptList(
3998                         $variants, $i, $isSet, $maxLengthOpt, $theme, $comp
3999                 );
4000         }
4001         elsif (ref($contains) eq 'ARRAY' && defined $contains->[$o]) {
4002                 my $c = $contains->[$o];
4003                 my $dd = $themeCfg->getComponentCfg("$comp/$c");
4004                 my $sVariants = $dd->{'variant'};
4005                 if (ref($sVariants) eq 'ARRAY') {
4006                         my $i = getVariantIndex($self,$theme,"$comp/$c",@$sVariants);
4007                         my $isSet = -1;
4008                         $isSet = $variantToSet->{"$theme/$comp/$c"}
4009                         if defined $variantToSet->{"$theme/$comp/$c"};
4010                         $return = variantsOptionsScriptList(
4011                                 $sVariants, $i, $isSet, $maxLengthOpt, $theme, $comp
4012                         );
4013                 }
4014                 $return .= "Drop This component";
4015         }
4016         $return =~ s/\|$//;
4017         return $return;
4018 }
4019
4020 #---------------------------------------
4021 #
4022 sub variantsOptionsScriptList {
4023         my $variants = shift;
4024         my $index = shift;
4025         my $isSet = shift;
4026         my $max = shift;
4027         my $theme = shift;
4028         my $comp = shift;
4029         my $usedS = "Used";
4030         my $setS = "Set";
4031
4032         my $return = "";
4033         my $i;
4034         for ($i = 0; $i < @$variants; $i++) {
4035                 next if $variants->[$i]->{'hidden'};
4036                 my $isCurrent = $i eq $index;
4037                 my $set = 0;
4038                 my $used = "";
4039                 my $name = $variants->[$i]->{'name'};
4040                 $name =~ s/\t/ /g;
4041                 #FIXME
4042                 if ($comp eq 'buttons' && $name =~ /\[/ &&
4043                         ($theme eq 'multichoice' || $theme eq "nanogui"))
4044                 {
4045                         $name =~ s/Options/O/;
4046                         $name =~ s/Maximize/M/;
4047                         $name =~ s/Iconify/I/;
4048                         $name =~ s/Shade/Sh/g;
4049                         $name =~ s/Stick/St/;
4050                         $name =~ s/Close/C/;
4051                         $name =~ s/Up/U/;
4052                         $name =~ s/Down/D/;
4053                         $name =~ s/\s+/ /g;
4054                         $name =~ s/-//g;
4055                         my $cst1 = ($theme eq 'multichoice')? 10 : 15;
4056                         my $cst2 = ($theme eq 'multichoice')? 7 : 2;
4057                         my $tmp = $name;
4058                         my @t = split(/\[|\]/,$name);
4059                         $name = $t[0] . " " x ($cst1 - length($t[0]))."[" .
4060                                 $t[1] . "]" ." " x ($cst2 - length($t[1])).$t[2];
4061                         $name =~ s/\[ \]/\//g;
4062                         $max = 34;
4063                         #$usedS = "U";
4064                         #$setS = "S";
4065                 }
4066                 $set = 1 if $isSet == $i+1;
4067                 my $l = $max - length($name);
4068                 $l = 1 if $l < 1;
4069                 $used = " " x $l . "(" if $isCurrent || $set;
4070                 $used .= $isCurrent? "$usedS": "";
4071                 $used .= "/" if $isCurrent && $set;
4072                 $used .= "$setS" if $set;
4073                 $used .= ")" if $isCurrent || $set;
4074                 $return .= "$name$used|";
4075         }
4076         return $return;
4077 }
4078
4079 #---------------------------------------
4080 #
4081 sub updateCurrentComponents {
4082         my $currentComponents = shift;
4083         my $comp = shift;
4084         my $test = 1;
4085
4086         foreach (@$currentComponents) {
4087                 $test = 0 if $_ eq $comp;
4088         }
4089         if ($test) {
4090                 push @$currentComponents, $comp;
4091                 @$currentComponents = sort @$currentComponents;
4092         }
4093 }
4094
4095 #----------------------------------------------------------------------------
4096 # An alarm handler (called from eval block):
4097 sub checkScript {
4098
4099         die "Script" unless ($comPid[0]);
4100
4101         my $test = 0;
4102         my $inFifo = ".tmp-com-in-" . $comName;
4103
4104         $test = 1 if kill 0 => $comPid[0];
4105
4106         if ($test) { die "Script"; }
4107         else { unlink($inFifo) if -p "$inFifo"; die "NoScript"; }
4108 }
4109
4110 #-----------------------------------------------------------------------------
4111 #
4112 sub myMakeFifo {
4113         my ($fifo) = @_;
4114         #unlink("$fifo");
4115         system("mkfifo '$fifo'");  # not portable: mknod '$fifo' p
4116 }
4117
4118 #-----------------------------------------------------------------------------
4119 # For killing FvwmScript-ThemesCenter if an error happen in this script!
4120 END {
4121         if ($comMode) {
4122                 if ($?) {
4123                         my $outFifo = ".tmp-com-out-" . $comName;
4124                         my $inFifo = ".tmp-com-in-" . $comName;
4125                         my $message = "fvwm-themes-config: internal error $?\n";
4126                         # actually $@ is never defined in END
4127                         $message .= "\teval error: $@\n" if $@;
4128                         $message .= "\tOS error: $!\n" if $!;
4129                         # actually the following is never executed on unix
4130                         $message .= "\tOS error 2: $^E\n" if $^E && !($! && $^E eq $!);
4131
4132                         unlink($outFifo) if -p "$outFifo";
4133                         unlink($inFifo) if -p "$inFifo";
4134                         if ($comPid[0]) {
4135                                 kill(9, $comPid[0]);
4136                                 $message .= "\tkilling FvwmScript-ThemesCenter";
4137                         }
4138                         my $i;
4139                         for($i = 1; $i < 4; $i++) {
4140                                 kill(9, $comPid[$i]) if $comPid[$i];
4141                         }
4142                         print STDERR "$message\n";
4143                 }
4144         }
4145 }
4146
4147 __END__
4148
4149 # ---------------------------------------------------------------------------
4150
4151 =head1 NAME
4152
4153 fvwm-themes-config - fvwm-themes manager and configurator
4154
4155 =head1 SYNOPSIS
4156
4157 B<fvwm-themes-config>
4158 [ B<--help>|B<-h> ]
4159 [ B<--version>|B<-v> ]
4160 [ B<--info>|B<-i> ]
4161 [ B<--site> ]
4162 [ B<--pipe> ]
4163 [ B<--show-themes> ]
4164 [ B<--show-components> ]
4165 [ B<--show-dir> ]
4166 [ B<--theme>|B<-t> I<theme> ]
4167 [ B<--show-info> ]
4168 [ B<--show-cfg> ]
4169 [ B<--show-value> I<key> ]
4170 [ B<--component> I<component> ]
4171 [ B<--only-site> ]
4172 [ B<--only-user> ]
4173 [ B<--fvwmscript> ]
4174 [ B<--expand-rc>|B<-e> I<[file]> ]
4175 [ B<--fresh>|B<-fr> ]
4176 [ B<--reset>|B<-r> ]
4177 [ B<--no-cfg-cache> ]
4178 [ B<--load>|B<-l> I<component@theme> ]
4179 [ B<--drop>|B<-u> I<component@theme> ]
4180 [ B<--option>|B<-o> I<component:option=value> ]
4181 [ B<--variant>|B<-v> I<component=variant> ]
4182 [ B<--set-locked> I<component=0|1> ]
4183 [ B<--install>|B<-i> I<file ...> ]
4184 [ B<--force-install>|B<-fo> ]
4185 [ B<--create-pack> I<name> I<file ...>]
4186 [ B<--pack-prefix> I<prefix> ]
4187 [ B<--pack-extra-version> I<x.x> ]
4188 [ B<--tmp-dir> I<dir> ]
4189 [ B<--com-mode> ]
4190 [ B<--com-name> I<name> ]
4191
4192 =head1 DESCRIPTION
4193
4194 This scripts creates and changes fvwm configuration to use with fvwm-themes
4195 accordingly to theme component definitions and user choices.
4196
4197 It builds I<themes-rc> in $FVWM_USERDIR, which is a replacement for .fvwm2rc.
4198
4199 =head1 OPTIONS
4200
4201 B<--help>    - show the help and exit
4202
4203 B<--version> - show the version and exit
4204
4205 B<--info>    - show the configured information and exit
4206
4207 B<--site> - use site configuration directory for output. The default is to
4208 use the user's directory.
4209
4210 B<--pipe> - generate fvwm commands suitable to use within fvwm's PipeRead
4211 (instead of error messages, for example).
4212
4213 B<--show-themes> - shows list of all themes (or ones specified by B<--theme>).
4214
4215 B<--show-components> - shows all themes (or ones specified by B<--theme>)
4216 with all their components (components are TAB justified).
4217
4218 B<--show-dir> - shows the theme directory of all themes (or ones specified
4219 by B<--theme>). These directories sit in themes/ parent directory of either
4220 user or site place.
4221
4222 B<--theme> I<theme> - only theme(s) given by this parameter are queried,
4223 if given. Several instances of B<--theme> may be given.
4224 By default all themes are queried.
4225
4226 B<--show-info> - shows an info for the component given in C<--component>
4227 parameter.
4228
4229 B<--show-cfg> - shows an entire configuration hash for the component given
4230 in C<--component> parameter. To show only one or several specified named
4231 values, B<--show-value> may be used.
4232
4233 B<--show-value> I<key> - shows a value by the key for the component given in
4234 C<--component> parameter. Several instances of B<--show-value> may be given.
4235
4236 B<--component> I<component> - a working component for other parameters,
4237 may be of form component@theme.
4238
4239 Example:
4240   fvwm-themes-config --component colors --show-value theme --show-value read-file
4241
4242 B<--only-site> - when specified together with B<--show-themes>
4243 or B<--show-components> causes to take into account only the site directory.
4244
4245 B<--only-user> - when specified together with B<--show-themes>
4246 or B<--show-components> causes to take into account only the user directory.
4247
4248 B<--fvwmscript> - when specified together with B<--show-themes>
4249 or B<--show-components> causes the output to be formatted for FvwmScript.
4250
4251 B<--expand-rc> I<[file]> - gets an FVWM configuration file and expands all
4252 includes in one very long file, printed to standard output. If the file is
4253 not given $FVWM_USERDIR/themes-rc is taken.
4254 This parameter can't be used with others.
4255
4256 B<--fresh> - refresh (regenerate) the fvwm configuration files needed to
4257 load themes, this includes files in the user's directory:
4258 $FVWM_USERDIR/themes-rc, $FVWM_USERDIR/themes-rc-2 and
4259 $FVWM_USERDIR/themes/current/theme.cfg.
4260
4261 B<--reset> - forget all the currently used components, use the components
4262 from the default theme and regenerate the user's configuration cache.
4263
4264 B<--no-cfg-cache> - don't use the existing configuration cache file,
4265 this file will be regenerated.
4266
4267 B<--set-minimal-reload> I<value> - if value is 1, then minimal theme switching
4268 is used, if value is 0, then full theme switching is used.
4269
4270 B<--load> I<component> - multiple C<--load> parameters may be given. If the
4271 parameter is of form component@theme, this specific theme component is used,
4272 if it is of form @theme, all components of the given theme will be used.
4273
4274 The process of "loading" components consists of adding new components or
4275 replacing existing ones in the B<current> theme. It is possible that
4276 there will be conflicts during this operation. In this case, nothing is
4277 changed, negative status is returned and the error message is printed.
4278
4279 B<--drop> I<component> - the opponent for C<--load>, these parameters
4280 may be mixed. Tries to unload the given component without breaking
4281 dependancies. [@theme] part of I<component> name may be omitted.
4282
4283 B<--option> I<component:option=value> - set another component option value.
4284 The I<option> may be either the option name or its index in the option list
4285 starting from 1 (use 0 to represent the default option).
4286 The I<value> may be either the value name or its index in the option value list
4287 starting from 1 (use 0 to represent the default option value).
4288
4289 B<--variant> I<component=variant> - set another component variant if a given
4290 I<component> has variants. The I<variant> may be either the variant name or
4291 its index in the variant list starting from 1 (use 0 to represent the
4292 default component variant).
4293
4294 B<--set-locked> I<component=value> - set (if I<value> is 1) or unset (if
4295 I<value> is 0) a locked state of the given component. When the component
4296 from the current theme is locked, C<--load @theme> will not replace it,
4297 it can only be replaced by explicit C<--load component@theme>.
4298
4299 Five last parameters may be combined together and multiple parameters are
4300 possible. If B<--load> and B<--drop> parameters are given, first it will
4301 be unloaded all given components and then loaded all given components, not
4302 vice versus. After that B<--variant> and B<--option> parameters will take
4303 place, i.e. it is possible to load a component and immediately change its
4304 options.
4305
4306 B<--install> I<theme.tar.{gz,bz2} ...> - install the specified tarballs
4307 into the site (if B<--site> is alos given) or into the user's I<themes>
4308 directory by verifying and unpacking the contents of the tarballs.
4309
4310 B<--force-install> - during the installation of a theme remove existing
4311 theme with the same name without prompting.
4312
4313 B<--create-pack> I<pack> I<theme1 theme2 ...> - create a gzipped tarball named
4314 ft-pack-VERSION.tar.gz made of the specified theme(s) found in the
4315 user's themes directory or in the site directory if B<--site> is
4316 also given. VERSION is the version of FVWM Themes.
4317
4318 B<--pack-prefix> I<prefix> - replace "ft" by "prefix" in the name of
4319 the gzipped tarball created via the B<--create-pack> option.
4320
4321 B<--pack-extra-version> I<x.x> - add I<_x.x> to VERSION in the name of
4322 the gzipped tarball created via the B<--create-pack> option.
4323
4324 B<--tmp-dir> I<dir> - full path to a directory that can be use as a
4325 temporary working directory. Default is /tmp. This option is used only with
4326 B<--create-pack>.
4327
4328 B<--com-mode> - run fvwm-themes-config under the "communication mode". See,
4329 the fvwm-themes-com and fvwm-themes-menuapp manual pages for more information
4330 on this option.
4331 You need to read the code to know the communication commands.
4332
4333 B<--com-name> I<name> - use name as name for communication with fvwm-themes-com.
4334 By default, "config" is used, but you should use  "config-pid" as name
4335 where pid is the pid of the program that
4336 want to talk to fvwm-themes-config so that fvwm-themes-config can
4337 exit if this program exit and so that fvwm-themes-config can kill the program
4338 if an internal error happen in fvwm-themes-config. On the other hand,
4339 if you want to talk with fvwm-themes-config in, say, a terminal you must
4340 not give an name as "config-an_integer" as name.
4341
4342 =head1 USAGE
4343
4344 Usually you don't need to run this script manually, it is called using
4345 different interfaces (menus and more).
4346
4347 To start with fvwm-themes, run this:
4348
4349   fvwm-themes-config --reset
4350
4351 This command automatically called in B<fvwm-themes-start> when needed,
4352 it will create the "current" theme in the user space, equivalent to the
4353 "default" one. If C<--site> parameter is also given, it will be created
4354 in the system space instead.
4355
4356 Info examples:
4357
4358   fvwm-themes-config --show-themes  # shows a list of all themes
4359   fvwm-themes-config --show-components  # show all themes+components
4360   fvwm-themes-config --show-themes --component windowlook
4361   fvwm-themes-config --show-components --theme migo --theme default
4362
4363   fvwm-themes-config --component colors \
4364     --show-value theme --show-value read-file
4365   fvwm-themes-config --component colors@cde --show-value option
4366   fvwm-themes-config --component _core --show-value memory
4367
4368 Other examples:
4369
4370   fvwm-themes-config --load @afterstep  # load theme "afterstep"
4371   fvwm-themes-config --drop modules@afterstep  # unload component
4372   fvwm-themes-config --variant settings/stroke=2  # turn on stroke
4373   fvwm-themes-config --variant settings/stroke=0  # use default (1)
4374   fvwm-themes-config --option bindings:switch-mouse-2-3=no
4375   fvwm-themes-config --set-locked colors=1 --set-locked globalfeel=0
4376
4377   fvwm-themes-config --install --site metallic.tar.gz wooden.tar.gz
4378   fvwm-themes-config --create-pack martyns -tmp-dir . metallic wooden
4379
4380 =head1 AUTHORS
4381
4382 Mikhael Goikhman <migo@homemail.com>, 31 Dec 1999.
4383
4384 Olivier Chapuis <olivier.chapuis@free.fr> (some small things and
4385 the communication loop implementation).
4386
4387 =head1 COPYING
4388
4389 The script is distributed by the same terms as fvwm-themes itself.
4390 See GNU General Public License for details.
4391
4392 =head1 BUGS
4393
4394 Report bugs to fvwm-themes-devel@lists.sourceforge.net.
4395
4396 =cut
4397
4398 # ===========================================================================